AI_Slop/DVX_GUI
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
DVX_GUI/src/apps/kpunch/dvxbasic/compiler/parser.c

6990 lines
216 KiB
C
Raw Blame History

// The MIT License (MIT)
//
// Copyright (C) 2026 Scott Duensing
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to
// deal in the Software without restriction, including without limitation the
// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
// sell copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
// IN THE SOFTWARE.
// parser.c -- DVX BASIC recursive descent parser
//
// Single-pass compiler: reads tokens from the lexer and emits
// p-code directly via the code generator. No AST.
//
// Embeddable: no DVX dependencies, pure C.
#include "parser.h"
#include "opcodes.h"
#include "thirdparty/stb_ds_wrap.h"
#include <ctype.h>
#include <stdio.h>
#include <string.h>
// ============================================================
// Built-in function table
// ============================================================
typedef struct {
const char *name;
uint8_t opcode;
int32_t minArgs;
int32_t maxArgs;
uint8_t resultType;
} BuiltinFuncT;
static const BuiltinFuncT builtinFuncs[] = {
// String functions
{"ASC", OP_STR_ASC, 1, 1, BAS_TYPE_INTEGER},
{"CHR$", OP_STR_CHR, 1, 1, BAS_TYPE_STRING},
{"DATE$", OP_DATE_STR, 0, 0, BAS_TYPE_STRING},
{"ENVIRON$", OP_ENVIRON, 1, 1, BAS_TYPE_STRING},
{"FORMAT$", OP_FORMAT, 2, 2, BAS_TYPE_STRING},
{"HEX$", OP_STR_HEX, 1, 1, BAS_TYPE_STRING},
{"INSTR", OP_STR_INSTR, 2, 3, BAS_TYPE_INTEGER},
{"LCASE$", OP_STR_LCASE, 1, 1, BAS_TYPE_STRING},
{"LEFT$", OP_STR_LEFT, 2, 2, BAS_TYPE_STRING},
{"LEN", OP_STR_LEN, 1, 1, BAS_TYPE_INTEGER},
{"LTRIM$", OP_STR_LTRIM, 1, 1, BAS_TYPE_STRING},
{"MID$", OP_STR_MID2, 2, 3, BAS_TYPE_STRING},
{"OCT$", OP_STR_OCT, 1, 1, BAS_TYPE_STRING},
{"RIGHT$", OP_STR_RIGHT, 2, 2, BAS_TYPE_STRING},
{"RTRIM$", OP_STR_RTRIM, 1, 1, BAS_TYPE_STRING},
{"SPACE$", OP_STR_SPACE, 1, 1, BAS_TYPE_STRING},
{"STR$", OP_STR_STRF, 1, 1, BAS_TYPE_STRING},
{"STRING$", OP_STR_STRING, 2, 2, BAS_TYPE_STRING},
{"TRIM$", OP_STR_TRIM, 1, 1, BAS_TYPE_STRING},
{"UCASE$", OP_STR_UCASE, 1, 1, BAS_TYPE_STRING},
{"VAL", OP_STR_VAL, 1, 1, BAS_TYPE_DOUBLE},
// File I/O functions
{"FREEFILE", OP_FILE_FREEFILE, 0, 0, BAS_TYPE_INTEGER},
{"LOC", OP_FILE_LOC, 1, 1, BAS_TYPE_LONG},
{"LOF", OP_FILE_LOF, 1, 1, BAS_TYPE_LONG},
// Conversion functions
{"CBOOL", OP_CONV_BOOL, 1, 1, BAS_TYPE_BOOLEAN},
{"CDBL", OP_CONV_STR_FLT, 1, 1, BAS_TYPE_DOUBLE}, // any value -> DOUBLE
{"CINT", OP_CONV_FLT_INT, 1, 1, BAS_TYPE_INTEGER},
{"CLNG", OP_CONV_INT_LONG, 1, 1, BAS_TYPE_LONG},
{"CSNG", OP_CONV_INT_FLT, 1, 1, BAS_TYPE_SINGLE},
{"CSTR", OP_CONV_INT_STR, 1, 1, BAS_TYPE_STRING},
// Math functions
{"ABS", OP_MATH_ABS, 1, 1, BAS_TYPE_DOUBLE},
{"ATN", OP_MATH_ATN, 1, 1, BAS_TYPE_DOUBLE},
{"COS", OP_MATH_COS, 1, 1, BAS_TYPE_DOUBLE},
{"EXP", OP_MATH_EXP, 1, 1, BAS_TYPE_DOUBLE},
{"FIX", OP_MATH_FIX, 1, 1, BAS_TYPE_INTEGER},
{"GETBLUE", OP_GET_BLUE, 1, 1, BAS_TYPE_INTEGER},
{"GETGREEN", OP_GET_GREEN, 1, 1, BAS_TYPE_INTEGER},
{"GETRED", OP_GET_RED, 1, 1, BAS_TYPE_INTEGER},
{"INT", OP_MATH_INT, 1, 1, BAS_TYPE_INTEGER},
{"LOG", OP_MATH_LOG, 1, 1, BAS_TYPE_DOUBLE},
{"RGB", OP_RGB, 3, 3, BAS_TYPE_LONG},
{"RND", OP_MATH_RND, 0, 1, BAS_TYPE_DOUBLE},
{"SGN", OP_MATH_SGN, 1, 1, BAS_TYPE_INTEGER},
{"SIN", OP_MATH_SIN, 1, 1, BAS_TYPE_DOUBLE},
{"SQR", OP_MATH_SQR, 1, 1, BAS_TYPE_DOUBLE},
{"TAN", OP_MATH_TAN, 1, 1, BAS_TYPE_DOUBLE},
{"TIME$", OP_TIME_STR, 0, 0, BAS_TYPE_STRING},
{"TIMER", OP_MATH_TIMER, 0, 0, BAS_TYPE_DOUBLE},
{NULL, 0, 0, 0, 0}
};
// ============================================================
// Module-scope declarations
// ============================================================
// Relative jump operands are 2 bytes; the VM takes the jump from the
// PC positioned just past the operand.
#define BAS_JUMP_OPERAND_SIZE 2
// Parsed SUB/FUNCTION parameter list. Every declaration form (SUB,
// FUNCTION, DEF FN, DECLARE, DECLARE LIBRARY, prescan) goes through
// parseParamList so the grammar exists exactly once.
typedef struct {
int32_t count;
int32_t required; // index of the last non-OPTIONAL parameter + 1
uint8_t types[BAS_MAX_PARAMS];
bool byVal[BAS_MAX_PARAMS];
bool optional[BAS_MAX_PARAMS];
} ParamListT;
// parseParamList behaviour flags
#define PARAM_REGISTER (1u << 0) // add each parameter as a SCOPE_LOCAL variable symbol
#define PARAM_PRESCAN (1u << 1) // accept AS <name> for a TYPE not parsed yet
#define PARAM_FORCE_BYVAL (1u << 2) // DEF FN: parameters are always by value
// State saved around a FOR / DO / WHILE loop body.
typedef struct {
ExitListT list;
int32_t selectBase;
} LoopSaveT;
// State saved around a SUB / FUNCTION body: EXIT lists, loop bookkeeping
// and SELECT depth all restart at zero inside the procedure so an EXIT
// or RETURN in the body can never be patched against the caller's
// constructs.
typedef struct {
ExitListT exitFor;
ExitListT exitDo;
ExitListT exitSub;
ExitListT exitFunc;
int32_t forSelectBase;
int32_t doSelectBase;
int32_t selectDepth;
int32_t forDepth;
int32_t doDepth;
int32_t lastLabelSelectDepth;
int32_t prologueJmp; // operand address of the JMP at the procedure entry
int32_t bodyAddr; // first byte of the body (prologue jumps back here)
bool isFunction;
} ProcSaveT;
// ============================================================
// Prototypes
// ============================================================
static void addPatchAddr(BasSymbolT *sym, int32_t addr);
static void addPredefConst(BasParserT *p, const char *name, int32_t val);
static void addPredefConsts(BasParserT *p);
static void advance(BasParserT *p);
static void applyParamList(BasSymbolT *sym, const ParamListT *pl);
bool basParse(BasParserT *p);
BasModuleT *basParserBuildModule(BasParserT *p);
void basParserFree(BasParserT *p);
void basParserInit(BasParserT *p, const char *source, int32_t sourceLen);
static bool check(BasParserT *p, BasTokenTypeE type);
static bool checkCtrlArrayAccess(BasParserT *p);
static void checkIdentLength(BasParserT *p);
static bool checkKeyword(BasParserT *p, const char *kw);
static bool clampArgCount(BasParserT *p, int32_t argc);
static bool clampParamCount(BasParserT *p, int32_t paramCount);
static void closeSelectCase(BasParserT *p, int32_t **endJumps);
static void collectDebugGlobals(BasParserT *p);
static void collectDebugLocals(BasParserT *p, int32_t procIndex);
static void emitByRefArg(BasParserT *p);
static void emitCallWithArgs(BasParserT *p, BasSymbolT *sym, int32_t argc);
static void emitFunctionCall(BasParserT *p, BasSymbolT *sym);
static void emitInputConv(BasParserT *p, const BasSymbolT *sym);
static void emitGotoWithSelectPops(BasParserT *p, const char *labelName);
static int32_t emitJump(BasParserT *p, uint8_t opcode);
static void emitJumpToLabel(BasParserT *p, uint8_t opcode, const char *labelName);
static void emitLoad(BasParserT *p, BasSymbolT *sym);
static void emitMethodCallStatement(BasParserT *p);
static void emitSelectPops(BasParserT *p, int32_t count);
static void emitStore(BasParserT *p, BasSymbolT *sym);
static void emitStoreConv(BasParserT *p, uint8_t dataType);
static void emitUdtInit(BasParserT *p, int32_t udtTypeId);
static BasSymbolT *ensureVariable(BasParserT *p, const char *name);
static void error(BasParserT *p, const char *msg);
static void errorExpected(BasParserT *p, const char *what);
static void exitListAdd(ExitListT *el, int32_t addr);
static void exitListInit(ExitListT *el);
static void exitListPatch(ExitListT *el, BasParserT *p);
static void expect(BasParserT *p, BasTokenTypeE type);
static void expectEndOfStatement(BasParserT *p);
static bool exprEnter(BasParserT *p);
static void exprLeave(BasParserT *p);
static const BuiltinFuncT *findBuiltin(const char *name);
static BasSymbolT *findTypeDef(BasParserT *p, const char *name);
static BasSymbolT *findTypeDefById(BasParserT *p, int32_t typeId);
static void loopBegin(BasParserT *p, bool isFor, LoopSaveT *save);
static void loopEnd(BasParserT *p, bool isFor, LoopSaveT *save);
static bool match(BasParserT *p, BasTokenTypeE type);
static bool nameHasTypeSuffix(const char *name);
static void parseAddExpr(BasParserT *p);
static void parseAndExpr(BasParserT *p);
static void parseAssignOrCall(BasParserT *p);
static void parseBeginForm(BasParserT *p);
static int32_t parseCallArgs(BasParserT *p, BasSymbolT *sym, bool parens);
static void parseChDir(BasParserT *p);
static void parseChDrive(BasParserT *p);
static void parseClose(BasParserT *p);
static void parseCompareExpr(BasParserT *p);
static void parseConcatExpr(BasParserT *p);
static void parseConst(BasParserT *p);
static void parseData(BasParserT *p);
static void parseDeclare(BasParserT *p);
static void parseDeclareLibrary(BasParserT *p);
static void parseDef(BasParserT *p);
static void parseDefType(BasParserT *p, uint8_t dataType);
static void parseDim(BasParserT *p);
static void parseDimBounds(BasParserT *p, int32_t *outDims);
static void parseDo(BasParserT *p);
static void parseEnd(BasParserT *p);
static void parseEndForm(BasParserT *p);
static void parseEqvExpr(BasParserT *p);
static void parseErase(BasParserT *p);
static void parseExit(BasParserT *p);
static void parseExpression(BasParserT *p);
static void parseFileCopy(BasParserT *p);
static void parseFor(BasParserT *p);
static void parseFunction(BasParserT *p);
static void parseGet(BasParserT *p);
static void parseGosub(BasParserT *p);
static void parseGoto(BasParserT *p);
static void parseIdivExpr(BasParserT *p);
static void parseIf(BasParserT *p);
static void parseImpExpr(BasParserT *p);
static void parseInput(BasParserT *p);
static void parseKill(BasParserT *p);
static void parseLineInput(BasParserT *p);
static void parseMkDir(BasParserT *p);
static void parseModule(BasParserT *p);
static void parseMulDivExpr(BasParserT *p);
static void parseMulExpr(BasParserT *p);
static void parseName(BasParserT *p);
static void parseNotExpr(BasParserT *p);
static void parseOn(BasParserT *p);
static void parseOnError(BasParserT *p);
static void parseOpen(BasParserT *p);
static void parseOption(BasParserT *p);
static void parseOrExpr(BasParserT *p);
static bool parseParamList(BasParserT *p, ParamListT *pl, uint32_t flags);
static void parsePowExpr(BasParserT *p);
static void parsePowOperand(BasParserT *p);
static void parsePrimary(BasParserT *p);
static void parsePrint(BasParserT *p);
static void parsePut(BasParserT *p);
static void parseRead(BasParserT *p);
static void parseRedim(BasParserT *p);
static void parseRemoveControl(BasParserT *p);
static void parseRestore(BasParserT *p);
static void parseResume(BasParserT *p);
static void parseRmDir(BasParserT *p);
static void parseSeek(BasParserT *p);
static void parseSelectCase(BasParserT *p);
static void parseSetAttr(BasParserT *p);
static void parseSetEvent(BasParserT *p);
static void parseShell(BasParserT *p);
static uint8_t parseShowModalFlag(BasParserT *p);
static void parseSleep(BasParserT *p);
static void parseStatement(BasParserT *p);
static void parseStatic(BasParserT *p);
static void parseSub(BasParserT *p);
static void parseSwap(BasParserT *p);
static void parseType(BasParserT *p);
static void parseUnaryExpr(BasParserT *p);
static void parseWhile(BasParserT *p);
static void parseWrite(BasParserT *p);
static void parseXorExpr(BasParserT *p);
static void patchCallAddrs(BasParserT *p, BasSymbolT *sym);
static void patchJump(BasParserT *p, int32_t addr);
static void patchLabelRefs(BasParserT *p, BasSymbolT *sym);
static void prescanSignatures(BasParserT *p);
static void procBegin(BasParserT *p, ProcSaveT *save, bool isFunction);
static void procEnd(BasParserT *p, ProcSaveT *save);
static int16_t relJumpOffset(BasParserT *p, int32_t target, int32_t operandAddr);
static int32_t resolveFieldIndex(BasSymbolT *typeSym, const char *fieldName);
static uint8_t resolveParamType(BasParserT *p, bool prescan, int32_t *outUdtTypeId);
static uint8_t resolveTypeName(BasParserT *p);
static void shiftBackpatchAddrs(BasParserT *p, int32_t from, int32_t delta);
static void skipNewlines(BasParserT *p);
static uint8_t suffixToType(const char *name);
// Record a code position that must be patched once sym (a forward-
// referenced SUB/FUNCTION/label) is defined.
static void addPatchAddr(BasSymbolT *sym, int32_t addr) {
arrput(sym->patchAddrs, addr);
sym->patchCount = (int32_t)arrlen(sym->patchAddrs);
}
static void addPredefConst(BasParserT *p, const char *name, int32_t val) {
BasSymbolT *sym = basSymTabAdd(&p->sym, name, SYM_CONST, BAS_TYPE_LONG);
if (sym) {
sym->constInt = val;
sym->isDefined = true;
sym->scope = SCOPE_GLOBAL;
}
}
static void addPredefConsts(BasParserT *p) {
// MsgBox button flags (VB3 compatible)
addPredefConst(p, "vbOKOnly", 0x0000);
addPredefConst(p, "vbOKCancel", 0x0001);
addPredefConst(p, "vbYesNo", 0x0002);
addPredefConst(p, "vbYesNoCancel", 0x0003);
addPredefConst(p, "vbRetryCancel", 0x0004);
// MsgBox icon flags
addPredefConst(p, "vbInformation", 0x0010);
addPredefConst(p, "vbExclamation", 0x0020);
addPredefConst(p, "vbCritical", 0x0030);
addPredefConst(p, "vbQuestion", 0x0040);
// MsgBox return values
addPredefConst(p, "vbOK", 1);
addPredefConst(p, "vbCancel", 2);
addPredefConst(p, "vbYes", 3);
addPredefConst(p, "vbNo", 4);
addPredefConst(p, "vbRetry", 5);
// Show mode flags
addPredefConst(p, "vbModal", 1);
// File attribute constants
addPredefConst(p, "vbNormal", 0);
addPredefConst(p, "vbReadOnly", 1);
addPredefConst(p, "vbHidden", 2);
addPredefConst(p, "vbSystem", 4);
addPredefConst(p, "vbDirectory", 16);
addPredefConst(p, "vbArchive", 32);
}
static void advance(BasParserT *p) {
if (p->hasError) {
return;
}
p->prevLine = p->lex.token.line;
basLexerNext(&p->lex);
if (p->lex.token.type == TOK_ERROR) {
error(p, p->lex.error);
return;
}
checkIdentLength(p);
}
// Copy a parsed parameter list onto a SUB/FUNCTION symbol and mark the
// signature as known (call-site arity checks trust hasSignature).
static void applyParamList(BasSymbolT *sym, const ParamListT *pl) {
sym->paramCount = pl->count;
sym->requiredParams = pl->required;
sym->hasSignature = true;
for (int32_t i = 0; i < pl->count; i++) {
sym->paramTypes[i] = pl->types[i];
sym->paramByVal[i] = pl->byVal[i];
sym->paramOptional[i] = pl->optional[i];
}
}
bool basParse(BasParserT *p) {
parseModule(p);
// The code generator silently caps the constant pool at 16-bit
// indices; if it overflowed, surface it as a compile error so we
// never emit a module with truncated constant references.
if (p->cg.overflow) {
error(p, "Too many string constants (constant pool index exceeds 16 bits)");
}
// OP_CALL operands are absolute 16-bit unsigned addresses, so code
// beyond the uint16 range is unreachable by calls; reject cleanly
// instead of silently miscompiling. Relative jump spans are signed
// 16-bit and are range-checked individually in relJumpOffset, so
// modules between 32K and 64K stay compilable.
if (p->cg.codeLen > UINT16_MAX) {
error(p, "Module too large (code size exceeds 16-bit address range)");
}
// The VM's global slot table is fixed-size; a module needing more
// would be refused at load time with no source position.
if (p->sym.nextGlobalIdx > BAS_VM_MAX_GLOBALS) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Too many module-level variables (%d, limit is %d)", (int)p->sym.nextGlobalIdx, (int)BAS_VM_MAX_GLOBALS);
error(p, buf);
}
return !p->hasError;
}
BasModuleT *basParserBuildModule(BasParserT *p) {
if (p->hasError) {
return NULL;
}
// Collect global and form-scope variables for the debugger
collectDebugGlobals(p);
p->cg.globalCount = p->sym.nextGlobalIdx;
return basCodeGenBuildModuleWithProcs(&p->cg, &p->sym);
}
void basParserFree(BasParserT *p) {
basCodeGenFree(&p->cg);
// Free all symbols and the symbol array.
basSymTabFree(&p->sym);
// EXIT-target backpatch lists are normally arrfree'd by exitListPatch at
// the close of each loop/proc; an error early-return can skip that, so
// release the top-level lists here too.
arrfree(p->exitForList.patchAddr);
arrfree(p->exitDoList.patchAddr);
arrfree(p->exitSubList.patchAddr);
arrfree(p->exitFuncList.patchAddr);
p->exitForList.patchAddr = NULL;
p->exitDoList.patchAddr = NULL;
p->exitSubList.patchAddr = NULL;
p->exitFuncList.patchAddr = NULL;
}
void basParserInit(BasParserT *p, const char *source, int32_t sourceLen) {
memset(p, 0, sizeof(BasParserT));
memset(p->defType, BAS_DEFTYPE_NONE, sizeof(p->defType));
basLexerInit(&p->lex, source, sourceLen);
basCodeGenInit(&p->cg);
basSymTabInit(&p->sym);
p->formInitJmpAddr = -1;
p->formInitCodeStart = -1;
addPredefConsts(p);
// basLexerInit already primes the first token -- no advance needed,
// but the primed token bypassed advance(), so vet it here.
if (p->lex.token.type == TOK_ERROR) {
error(p, p->lex.error);
} else {
checkIdentLength(p);
}
}
void basParserSetValidator(BasParserT *p, const BasCtrlValidatorT *v) {
p->validator = v;
}
static bool check(BasParserT *p, BasTokenTypeE type) {
return p->lex.token.type == type;
}
// Check if current token '(' is followed by a matching ')' then '.'.
// This disambiguates control array access Name(idx).Property from
// function calls Name(args). Saves and restores lexer state.
// Must be called when current token is TOK_LPAREN.
static bool checkCtrlArrayAccess(BasParserT *p) {
BasLexerT savedLex = p->lex;
bool savedErr = p->hasError;
basLexerNext(&p->lex); // consume (
int32_t depth = 1;
while (depth > 0 && p->lex.token.type != TOK_EOF && !p->hasError) {
if (p->lex.token.type == TOK_LPAREN) {
depth++;
} else if (p->lex.token.type == TOK_RPAREN) {
depth--;
if (depth == 0) {
break;
}
}
basLexerNext(&p->lex);
}
// Advance past the closing )
if (p->lex.token.type == TOK_RPAREN) {
basLexerNext(&p->lex);
}
bool dotFollows = (p->lex.token.type == TOK_DOT);
// Restore lexer state
p->lex = savedLex;
p->hasError = savedErr;
return dotFollows;
}
// Identifiers must fit BasSymbolT.name. The lexer accepts names up to
// BAS_MAX_TOKEN_LEN, so reject longer ones here (the one place every
// token passes through) rather than truncating them into a name that no
// later reference would match.
static void checkIdentLength(BasParserT *p) {
if (p->lex.token.type == TOK_IDENT && p->lex.token.textLen >= BAS_MAX_IDENT) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Identifier too long (maximum is %d characters)", (int)(BAS_MAX_IDENT - 1));
error(p, buf);
}
}
static bool checkKeyword(BasParserT *p, const char *kw) {
return p->lex.token.type == TOK_IDENT && strcasecmp(p->lex.token.text, kw) == 0;
}
// Guard against emitting a call with more than BAS_VM_MAX_CALL_ARGS
// arguments. The VM encodes the argument count in a single byte, so a
// call may not exceed that bound. Returns true (and reports an error)
// when argc exceeds the limit, signalling the caller to abort the
// current call emission.
static bool clampArgCount(BasParserT *p, int32_t argc) {
if (argc > BAS_VM_MAX_CALL_ARGS) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Too many arguments (max %d)", (int)BAS_VM_MAX_CALL_ARGS);
error(p, buf);
return true;
}
return false;
}
// Guard against declaring more than BAS_MAX_PARAMS parameters. The
// typed param arrays on a symbol are fixed at BAS_MAX_PARAMS, so a
// declaration may not exceed that bound. Returns true (and reports an
// error) when paramCount has reached the limit, signalling the caller
// to stop the parameter loop.
static bool clampParamCount(BasParserT *p, int32_t paramCount) {
if (paramCount >= BAS_MAX_PARAMS) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Too many parameters (maximum is %d)", (int)BAS_MAX_PARAMS);
error(p, buf);
return true;
}
return false;
}
// Emit the shared END SELECT epilogue: land every pending end-of-case jump on
// the OP_POP that discards the SELECT test value, free the jump list, and drop
// the select-depth marker. Every exit from parseSelectCase runs this so the
// test value is popped exactly once and selectDepth stays balanced.
static void closeSelectCase(BasParserT *p, int32_t **endJumps) {
for (int32_t i = 0; i < (int32_t)arrlen(*endJumps); i++) {
patchJump(p, (*endJumps)[i]);
}
basEmit8(&p->cg, OP_POP);
arrfree(*endJumps);
p->selectDepth--;
}
// Snapshot global variables for the debugger at the end of compilation.
static void collectDebugGlobals(BasParserT *p) {
for (int32_t i = 0; i < p->sym.count; i++) {
BasSymbolT *s = p->sym.symbols[i];
if (s->scope == SCOPE_GLOBAL && s->kind == SYM_VARIABLE) {
basCodeGenAddDebugVar(&p->cg, s->name, SCOPE_GLOBAL, s->dataType, s->index, -1, NULL);
} else if (s->scope == SCOPE_FORM && s->kind == SYM_VARIABLE) {
basCodeGenAddDebugVar(&p->cg, s->name, SCOPE_FORM, s->dataType, s->index, -1, s->formName);
} else if (s->kind == SYM_TYPE_DEF && s->fields) {
// Collect UDT type definitions for watch window field access
BasDebugUdtDefT def;
memset(&def, 0, sizeof(def));
snprintf(def.name, BAS_MAX_IDENT, "%s", s->name);
def.typeId = s->index;
def.fieldCount = (int32_t)arrlen(s->fields);
def.fields = (BasDebugFieldT *)malloc(def.fieldCount * sizeof(BasDebugFieldT));
if (def.fields) {
for (int32_t f = 0; f < def.fieldCount; f++) {
snprintf(def.fields[f].name, BAS_MAX_IDENT, "%s", s->fields[f].name);
def.fields[f].dataType = s->fields[f].dataType;
}
} else {
// Allocation failed: record the type name but no fields so
// the debugger never walks a NULL field array.
def.fieldCount = 0;
}
arrput(p->cg.debugUdtDefs, def);
p->cg.debugUdtDefCount = (int32_t)arrlen(p->cg.debugUdtDefs);
}
}
}
// Snapshot local variables for the debugger before leaving local scope.
// procIndex is the index into the proc table for the current procedure.
// Also saves the local count on the proc symbol for BasProcEntryT.
static void collectDebugLocals(BasParserT *p, int32_t procIndex) {
// Save localCount on the proc symbol
if (p->currentProc[0]) {
BasSymbolT *procSym = basSymTabFind(&p->sym, p->currentProc);
if (procSym) {
procSym->localCount = p->sym.nextLocalIdx;
}
}
for (int32_t i = 0; i < p->sym.count; i++) {
BasSymbolT *s = p->sym.symbols[i];
if (s->scope == SCOPE_LOCAL && s->kind == SYM_VARIABLE) {
basCodeGenAddDebugVar(&p->cg, s->name, SCOPE_LOCAL, s->dataType, s->index, procIndex, NULL);
}
}
}
// Try to emit a ByRef argument (push address of variable).
// If the current token is a simple variable name not followed by
// '(' or '.', we emit PUSH_LOCAL_ADDR/PUSH_GLOBAL_ADDR.
// Otherwise, we fall back to parseExpression (effectively ByVal).
static void emitByRefArg(BasParserT *p) {
if (!check(p, TOK_IDENT)) {
parseExpression(p);
return;
}
// Save the identifier name before peeking ahead
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, sizeof(name) - 1);
name[sizeof(name) - 1] = '\0';
// Look up the symbol -- must be a variable (simple or array)
BasSymbolT *sym = basSymTabFind(&p->sym, name);
if (!sym || sym->kind != SYM_VARIABLE) {
parseExpression(p);
return;
}
// Save lexer state to peek at what follows the identifier
int32_t savedPos = p->lex.pos;
int32_t savedLine = p->lex.line;
int32_t savedCol = p->lex.col;
BasTokenT savedTok = p->lex.token;
advance(p); // consume the identifier
// Array element as BYREF: `arr(i)` or `arr(i, j)`. Emit LOAD of
// the array ref, then the indices, then OP_PUSH_ARR_ADDR which
// produces a BAS_TYPE_REF pointing at the element. Writes through
// that ref in the callee update the actual array element.
if (sym->isArray && check(p, TOK_LPAREN)) {
advance(p); // consume (
// Push the array reference
emitLoad(p, sym);
// Parse indices
int32_t dims = 0;
parseExpression(p);
dims++;
while (match(p, TOK_COMMA)) {
parseExpression(p);
dims++;
}
expect(p, TOK_RPAREN);
// If the next token isn't an argument delimiter, this wasn't
// a simple `arr(i)` -- rewind and fall back. (rare; e.g.
// `arr(i).field` not supported as BYREF.)
if (!check(p, TOK_COMMA) && !check(p, TOK_RPAREN) && !check(p, TOK_NEWLINE) && !check(p, TOK_COLON) && !check(p, TOK_EOF) && !check(p, TOK_ELSE)) {
// Too late to rewind cleanly -- we've already emitted code.
// Treat this as an error. Callers can restructure as a
// simple variable BYREF or BYVAL.
error(p, "Complex BYREF array expression not supported; use a temporary variable");
return;
}
basEmit8(&p->cg, OP_PUSH_ARR_ADDR);
basEmit8(&p->cg, (uint8_t)dims);
return;
}
// The token after the identifier must be an argument delimiter
// (comma, rparen, newline, colon, EOF, ELSE) for this to be a
// bare variable reference. Anything else (operator, dot, paren)
// means it's part of an expression -- fall back to parseExpression.
bool isDelim = check(p, TOK_COMMA) || check(p, TOK_RPAREN) || check(p, TOK_NEWLINE) || check(p, TOK_COLON) || check(p, TOK_EOF) || check(p, TOK_ELSE);
if (!isDelim) {
// Restore and let parseExpression handle the full expression
p->lex.pos = savedPos;
p->lex.line = savedLine;
p->lex.col = savedCol;
p->lex.token = savedTok;
parseExpression(p);
return;
}
// It's a bare variable reference -- push its address
if (sym->scope == SCOPE_LOCAL) {
basEmit8(&p->cg, OP_PUSH_LOCAL_ADDR);
} else if (sym->scope == SCOPE_FORM) {
basEmit8(&p->cg, OP_PUSH_FORM_ADDR);
} else {
basEmit8(&p->cg, OP_PUSH_GLOBAL_ADDR);
}
basEmitU16(&p->cg, (uint16_t)sym->index);
}
// Emit the call of a SUB/FUNCTION whose argc arguments are already on
// the stack: validate the count against the signature, pad omitted
// OPTIONAL parameters with zero-values, then emit OP_CALL_EXTERN or
// OP_CALL (recording a forward reference when the body is not yet
// defined). Shared by every call form: name(args), bare "name args",
// CALL name(args) and CALL name.
static void emitCallWithArgs(BasParserT *p, BasSymbolT *sym, int32_t argc) {
if (p->hasError) {
return;
}
// Minimum acceptable count: everything up to the last required
// parameter when OPTIONALs are declared, otherwise the full list.
int32_t minArgs = sym->paramCount;
bool hasOptional = false;
for (int32_t i = 0; i < sym->paramCount; i++) {
if (sym->paramOptional[i]) {
hasOptional = true;
break;
}
}
if (hasOptional) {
minArgs = sym->requiredParams;
}
if (argc < minArgs || argc > sym->paramCount) {
char buf[BAS_PARSE_ERR_SCRATCH];
const char *what = (sym->kind == SYM_FUNCTION) ? "Function" : "Sub";
if (minArgs == sym->paramCount) {
snprintf(buf, sizeof(buf), "%s '%s' expects %d arguments, got %d", what, sym->name, (int)sym->paramCount, (int)argc);
} else {
snprintf(buf, sizeof(buf), "%s '%s' expects %d to %d arguments, got %d", what, sym->name, (int)minArgs, (int)sym->paramCount, (int)argc);
}
error(p, buf);
return;
}
// Push default zero-values for omitted optional parameters
for (int32_t i = argc; i < sym->paramCount; i++) {
if (sym->paramTypes[i] == BAS_TYPE_STRING) {
uint16_t emptyIdx = basAddConstant(&p->cg, "", 0);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, emptyIdx);
} else {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0);
}
}
argc = sym->paramCount;
if (clampArgCount(p, argc)) {
return;
}
// External library function: emit OP_CALL_EXTERN
if (sym->isExtern) {
basEmit8(&p->cg, OP_CALL_EXTERN);
basEmitU16(&p->cg, sym->externLibIdx);
basEmitU16(&p->cg, sym->externFuncIdx);
basEmit8(&p->cg, (uint8_t)argc);
basEmit8(&p->cg, sym->dataType);
return;
}
// Internal BASIC procedure: emit OP_CALL
// baseSlot: functions reserve slot 0 for the return value
uint8_t baseSlot = (sym->kind == SYM_FUNCTION) ? 1 : 0;
basEmit8(&p->cg, OP_CALL);
int32_t addrPos = basCodePos(&p->cg);
basEmitU16(&p->cg, (uint16_t)sym->codeAddr);
basEmit8(&p->cg, (uint8_t)argc);
basEmit8(&p->cg, baseSlot);
// If not yet defined, record the address for backpatching
if (!sym->isDefined) {
addPatchAddr(sym, addrPos);
}
}
// name(arg, ...) in either statement or expression context.
static void emitFunctionCall(BasParserT *p, BasSymbolT *sym) {
int32_t argc = parseCallArgs(p, sym, true);
emitCallWithArgs(p, sym, argc);
}
// Emit a jump to a GOTO target, discarding the live test values of any
// SELECT CASE blocks the jump leaves. Shared by GOTO and the ON expr
// GOTO arms so both discard the same way.
static void emitGotoWithSelectPops(BasParserT *p, const char *labelName) {
// A GOTO out of one or more SELECT CASE blocks must discard their
// live test values -- but only for the blocks actually being left.
// A label may sit inside the same SELECT, so the number of pops is
// the GOTO site's depth minus the label's depth.
BasSymbolT *sym = basSymTabFind(&p->sym, labelName);
if (sym != NULL && sym->kind == SYM_LABEL && sym->isDefined) {
// Backward GOTO: the label's SELECT depth was recorded in
// sym->localCount when it was defined.
int32_t depthDiff = p->selectDepth - sym->localCount;
if (depthDiff > 0) {
emitSelectPops(p, depthDiff);
}
emitJumpToLabel(p, OP_JMP, labelName);
return;
}
// Forward GOTO: the label's depth is unknown until it is defined.
// Reserve one OP_NOP per currently-open SELECT ahead of the jump and
// encode this site's depth in the jump's placeholder operand;
// patchLabelRefs converts the needed number of NOPs to OP_POP once
// the label's depth is known. Unconverted NOPs execute harmlessly.
for (int32_t i = 0; i < p->selectDepth; i++) {
basEmit8(&p->cg, OP_NOP);
}
emitJumpToLabel(p, OP_JMP, labelName);
if (p->selectDepth > 0 && !p->hasError) {
sym = basSymTabFind(&p->sym, labelName);
if (sym != NULL && sym->patchCount > 0) {
basPatch16(&p->cg, sym->patchAddrs[sym->patchCount - 1], (int16_t)p->selectDepth);
}
}
}
// INPUT / INPUT # read a string; convert it for a numeric target. The
// INTEGER conversion range-checks to 16 bits itself; every other numeric
// type goes through the double conversion and is narrowed by emitStore.
static void emitInputConv(BasParserT *p, const BasSymbolT *sym) {
if (sym->dataType == BAS_TYPE_STRING) {
return;
}
if (sym->dataType == BAS_TYPE_INTEGER) {
basEmit8(&p->cg, OP_CONV_STR_INT);
} else {
basEmit8(&p->cg, OP_CONV_STR_FLT);
}
}
static int32_t emitJump(BasParserT *p, uint8_t opcode) {
basEmit8(&p->cg, opcode);
int32_t addr = basCodePos(&p->cg);
basEmit16(&p->cg, 0); // placeholder
return addr;
}
static void emitJumpToLabel(BasParserT *p, uint8_t opcode, const char *labelName) {
// Look up label; if defined, emit direct jump; if not, create forward ref
BasSymbolT *sym = basSymTabFind(&p->sym, labelName);
if (sym != NULL && sym->kind == SYM_LABEL && sym->isDefined) {
// Label already defined -- emit jump to known address
basEmit8(&p->cg, opcode);
int32_t here = basCodePos(&p->cg);
int16_t offset = relJumpOffset(p, sym->codeAddr, here);
basEmit16(&p->cg, offset);
return;
}
// Forward reference -- create label symbol if needed
if (sym == NULL) {
sym = basSymTabAdd(&p->sym, labelName, SYM_LABEL, 0);
if (sym == NULL) {
error(p, "Symbol table full");
return;
}
sym->scope = SCOPE_GLOBAL;
sym->isDefined = false;
sym->codeAddr = 0;
}
// Emit jump with placeholder offset
basEmit8(&p->cg, opcode);
int32_t patchAddr = basCodePos(&p->cg);
basEmit16(&p->cg, 0);
// Record patch address for backpatching when label is defined
arrput(sym->patchAddrs, patchAddr);
sym->patchCount = (int32_t)arrlen(sym->patchAddrs);
}
static void emitLoad(BasParserT *p, BasSymbolT *sym) {
// Only variables and constants have a value to load; a SUB, label or
// TYPE name used as an operand would otherwise read slot `index` of
// the globals as if it were a variable.
if (sym->kind != SYM_VARIABLE && sym->kind != SYM_CONST) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "'%s' is not a variable", sym->name);
error(p, buf);
return;
}
if (sym->kind == SYM_CONST) {
// Emit the constant value directly
if (sym->dataType == BAS_TYPE_STRING) {
uint16_t idx = basAddConstant(&p->cg, sym->constStr, (int32_t)strlen(sym->constStr));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, idx);
} else if (sym->dataType == BAS_TYPE_INTEGER || sym->dataType == BAS_TYPE_LONG) {
basEmit8(&p->cg, OP_PUSH_INT32);
basEmit16(&p->cg, (int16_t)(sym->constInt & 0xFFFF));
basEmit16(&p->cg, (int16_t)((sym->constInt >> 16) & 0xFFFF));
} else if (sym->dataType == BAS_TYPE_BOOLEAN) {
basEmit8(&p->cg, sym->constInt ? OP_PUSH_TRUE : OP_PUSH_FALSE);
} else {
// Float constant
basEmit8(&p->cg, OP_PUSH_FLT64);
basEmitDouble(&p->cg, sym->constDbl);
}
return;
}
if (sym->scope == SCOPE_LOCAL) {
basEmit8(&p->cg, OP_LOAD_LOCAL);
basEmitU16(&p->cg, (uint16_t)sym->index);
} else if (sym->scope == SCOPE_FORM) {
basEmit8(&p->cg, OP_LOAD_FORM_VAR);
basEmitU16(&p->cg, (uint16_t)sym->index);
} else {
basEmit8(&p->cg, OP_LOAD_GLOBAL);
basEmitU16(&p->cg, (uint16_t)sym->index);
}
}
// Statement-form method call "obj.Method arg, arg": the object and
// method name are already on the stack. Arguments are comma-separated
// (VB style, no parentheses); the return value is discarded.
static void emitMethodCallStatement(BasParserT *p) {
int32_t argc = 0;
while (!check(p, TOK_NEWLINE) && !check(p, TOK_COLON) && !check(p, TOK_EOF) && !check(p, TOK_ELSE) && !p->hasError) {
if (argc > 0) {
expect(p, TOK_COMMA);
}
parseExpression(p);
argc++;
}
if (clampArgCount(p, argc)) {
return;
}
basEmit8(&p->cg, OP_CALL_METHOD);
basEmit8(&p->cg, (uint8_t)argc);
basEmit8(&p->cg, OP_POP); // discard return value (statement form)
}
// Emit OP_POP `count` times. Used to discard the live SELECT CASE test
// values from the eval stack when EXIT/GOTO jumps out of one or more
// enclosing SELECT constructs (see selectDepth).
static void emitSelectPops(BasParserT *p, int32_t count) {
for (int32_t i = 0; i < count; i++) {
basEmit8(&p->cg, OP_POP);
}
}
static void emitStore(BasParserT *p, BasSymbolT *sym) {
// Storing into a CONST would emit OP_STORE_GLOBAL at its index 0
// (CONSTs never allocate a slot), corrupting the first real global.
// Reject here so every store path (FOR/READ/INPUT/SWAP/MID$/GET/SET)
// is covered, not just the plain-assignment path.
if (sym->kind == SYM_CONST) {
error(p, "Cannot assign to a constant");
return;
}
// Likewise a SUB/FUNCTION/label/TYPE name is not a store target; the
// FUNCTION return-value assignment is handled before reaching here.
if (sym->kind != SYM_VARIABLE) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Cannot assign to '%s'", sym->name);
error(p, buf);
return;
}
// Fixed-length string: pad/truncate before storing. Skip for arrays:
// OP_STR_FIXLEN would convert the array reference being stored at DIM
// time into a fixed-width string, destroying the array (per-element
// fixed length is not modelled, so the '* n' is simply ignored here).
if (sym->fixedLen > 0 && !sym->isArray) {
basEmit8(&p->cg, OP_STR_FIXLEN);
basEmitU16(&p->cg, (uint16_t)sym->fixedLen);
}
// Explicitly typed scalar: coerce the value to the declared type so
// i% = 1.7 stores 2 and i% = 40000 raises Overflow. Arrays store a
// reference here (DIM/REDIM); their elements convert in the
// OP_STORE_ARRAY path.
if (sym->isTyped && !sym->isArray) {
emitStoreConv(p, sym->dataType);
}
if (sym->scope == SCOPE_LOCAL) {
basEmit8(&p->cg, OP_STORE_LOCAL);
basEmitU16(&p->cg, (uint16_t)sym->index);
} else if (sym->scope == SCOPE_FORM) {
basEmit8(&p->cg, OP_STORE_FORM_VAR);
basEmitU16(&p->cg, (uint16_t)sym->index);
} else {
basEmit8(&p->cg, OP_STORE_GLOBAL);
basEmitU16(&p->cg, (uint16_t)sym->index);
}
}
// Emit the conversion that coerces the value on top of the stack to a
// declared numeric type before it is stored. Shared by scalar, array
// element and TYPE field stores. STRING, DOUBLE, BOOLEAN, OBJECT and
// user types store the value as it is.
static void emitStoreConv(BasParserT *p, uint8_t dataType) {
switch (dataType) {
case BAS_TYPE_INTEGER:
basEmit8(&p->cg, OP_CONV_FLT_INT);
break;
case BAS_TYPE_LONG:
basEmit8(&p->cg, OP_CONV_INT_LONG);
break;
case BAS_TYPE_SINGLE:
basEmit8(&p->cg, OP_CONV_INT_FLT);
break;
default:
break;
}
}
// emitUdtInit -- emit code to initialize nested UDT fields after a UDT
// has been created and is on top of the stack. For each field that is
// itself a UDT, we DUP the parent, allocate the child UDT, and store it
// into the field.
static void emitUdtInit(BasParserT *p, int32_t udtTypeId) {
BasSymbolT *typeSym = findTypeDefById(p, udtTypeId);
if (!typeSym) {
return;
}
for (int32_t i = 0; i < typeSym->fieldCount; i++) {
if (typeSym->fields[i].dataType != BAS_TYPE_UDT) {
continue;
}
int32_t childTypeId = typeSym->fields[i].udtTypeId;
BasSymbolT *childType = findTypeDefById(p, childTypeId);
if (!childType) {
continue;
}
// DUP parent, allocate child UDT, STORE_FIELD
basEmit8(&p->cg, OP_DUP);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)childTypeId);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)childType->fieldCount);
basEmit8(&p->cg, OP_DIM_ARRAY);
basEmit8(&p->cg, 0);
basEmit8(&p->cg, BAS_TYPE_UDT);
// Recursively init the child's nested UDT fields
emitUdtInit(p, childTypeId);
basEmit8(&p->cg, OP_STORE_FIELD);
basEmitU16(&p->cg, (uint16_t)i);
}
}
static BasSymbolT *ensureVariable(BasParserT *p, const char *name) {
BasSymbolT *sym = basSymTabFind(&p->sym, name);
if (sym != NULL) {
return sym;
}
// When in local scope, check if a shared global exists before auto-declaring
if (p->sym.inLocalScope) {
BasSymbolT *globalSym = basSymTabFindGlobal(&p->sym, name);
if (globalSym != NULL && globalSym->isShared) {
return globalSym;
}
}
// OPTION EXPLICIT: require explicit DIM
if (p->optionExplicit) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Variable not declared: %s (OPTION EXPLICIT is on)", name);
error(p, buf);
return NULL;
}
// Auto-declare (QB implicit declaration)
// Use suffix type if present, otherwise defType for the first letter
uint8_t dt = suffixToType(name);
bool isTyped = nameHasTypeSuffix(name);
if (!isTyped && name[0] != '\0') {
// suffixToType returns SINGLE both for an explicit '!' suffix and
// for no suffix at all. Only apply the DEFxxx override when there
// is NO explicit suffix; an explicit '!' must stay SINGLE.
char firstLetter = (char)toupper((unsigned char)name[0]);
if (firstLetter >= 'A' && firstLetter <= 'Z') {
uint8_t defDt = p->defType[firstLetter - 'A'];
if (defDt != BAS_DEFTYPE_NONE) {
dt = defDt;
isTyped = true;
}
}
}
sym = basSymTabAdd(&p->sym, name, SYM_VARIABLE, dt);
if (sym == NULL) {
error(p, "Symbol table full");
return NULL;
}
sym->isTyped = isTyped;
// QB semantics: a variable first used inside a SUB/FUNCTION is local
// to that procedure. Anywhere else (module level, form scope) it is
// a module global. Implicit STRING locals are initialised to "" by
// the procedure prologue (see procEnd) since there is no DIM to emit
// the init at.
if (p->sym.inLocalScope) {
sym->scope = SCOPE_LOCAL;
sym->index = basSymTabAllocSlot(&p->sym);
sym->isImplicit = true;
} else {
sym->scope = SCOPE_GLOBAL;
sym->index = basSymTabAllocGlobalSlot(&p->sym);
}
sym->isDefined = true;
return sym;
}
static void error(BasParserT *p, const char *msg) {
if (p->hasError) {
return;
}
p->hasError = true;
// If the current token is on a later line than the previous token,
// the error is about the previous line (e.g. missing token at EOL).
int32_t line = p->lex.token.line;
if (p->prevLine > 0 && line > p->prevLine) {
line = p->prevLine;
}
p->errorLine = line;
snprintf(p->error, sizeof(p->error), "Line %d: %s", (int)line, msg);
}
static void errorExpected(BasParserT *p, const char *what) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Expected %s, got %s", what, basTokenName(p->lex.token.type));
error(p, buf);
}
static void exitListAdd(ExitListT *el, int32_t addr) {
arrput(el->patchAddr, addr);
}
static void exitListInit(ExitListT *el) {
el->patchAddr = NULL;
}
static void exitListPatch(ExitListT *el, BasParserT *p) {
int32_t target = basCodePos(&p->cg);
int32_t n = (int32_t)arrlen(el->patchAddr);
for (int32_t i = 0; i < n; i++) {
int16_t offset = relJumpOffset(p, target, el->patchAddr[i]);
basPatch16(&p->cg, el->patchAddr[i], offset);
}
arrfree(el->patchAddr);
el->patchAddr = NULL;
}
static void expect(BasParserT *p, BasTokenTypeE type) {
if (p->hasError) {
return;
}
if (p->lex.token.type != type) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Expected %s, got %s", basTokenName(type), basTokenName(p->lex.token.type));
error(p, buf);
return;
}
advance(p);
}
static void expectEndOfStatement(BasParserT *p) {
if (p->hasError) {
return;
}
// Statement must end with newline, colon, EOF, or ELSE (single-line IF)
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_ELSE)) {
return;
}
if (check(p, TOK_COLON)) {
advance(p);
return;
}
errorExpected(p, "end of statement");
}
// Recursion guard for expression parsing. Returns false (with an error
// set) once the nesting limit is hit; callers return immediately.
static bool exprEnter(BasParserT *p) {
if (p->exprDepth >= BAS_MAX_EXPR_DEPTH) {
error(p, "Expression nested too deeply");
return false;
}
p->exprDepth++;
return true;
}
static void exprLeave(BasParserT *p) {
p->exprDepth--;
}
static const BuiltinFuncT *findBuiltin(const char *name) {
for (int32_t i = 0; builtinFuncs[i].name != NULL; i++) {
if (strcasecmp(name, builtinFuncs[i].name) == 0) {
return &builtinFuncs[i];
}
}
return NULL;
}
static BasSymbolT *findTypeDef(BasParserT *p, const char *name) {
for (int32_t i = 0; i < p->sym.count; i++) {
if (p->sym.symbols[i]->kind == SYM_TYPE_DEF && strcasecmp(p->sym.symbols[i]->name, name) == 0) {
return p->sym.symbols[i];
}
}
return NULL;
}
static BasSymbolT *findTypeDefById(BasParserT *p, int32_t typeId) {
for (int32_t i = 0; i < p->sym.count; i++) {
if (p->sym.symbols[i]->kind == SYM_TYPE_DEF && p->sym.symbols[i]->index == typeId) {
return p->sym.symbols[i];
}
}
return NULL;
}
// Open a FOR (isFor) or DO/WHILE loop: start a fresh EXIT list, record
// the SELECT depth EXIT must unwind to, and bump the loop depth that
// makes a stray EXIT FOR / EXIT DO a compile error.
static void loopBegin(BasParserT *p, bool isFor, LoopSaveT *save) {
ExitListT *list = isFor ? &p->exitForList : &p->exitDoList;
int32_t *base = isFor ? &p->forSelectBase : &p->doSelectBase;
save->list = *list;
save->selectBase = *base;
exitListInit(list);
*base = p->selectDepth;
if (isFor) {
p->forDepth++;
} else {
p->doDepth++;
}
}
// Close the loop opened by loopBegin: land every EXIT on the current
// position (freeing the list) and restore the enclosing loop's state.
// Runs on the error path too, so no EXIT list is ever leaked.
static void loopEnd(BasParserT *p, bool isFor, LoopSaveT *save) {
ExitListT *list = isFor ? &p->exitForList : &p->exitDoList;
int32_t *base = isFor ? &p->forSelectBase : &p->doSelectBase;
exitListPatch(list, p);
*list = save->list;
*base = save->selectBase;
if (isFor) {
p->forDepth--;
} else {
p->doDepth--;
}
}
static bool match(BasParserT *p, BasTokenTypeE type) {
// Once an error is set, advance() is a no-op (the token is frozen),
// so a true return here would spin any 'while (match(...))' loop
// forever. Report no match so error unwinding terminates the loop.
if (p->hasError) {
return false;
}
if (p->lex.token.type == type) {
advance(p);
return true;
}
return false;
}
// Report whether a name carries an explicit BASIC type-suffix character.
// Lets callers distinguish an explicitly typed name like "a!" from a bare
// "a", which suffixToType cannot do alone because it returns
// BAS_TYPE_SINGLE for both. Shares the lexer's basIsTypeSuffixChar so the
// suffix character set has a single source of truth.
static bool nameHasTypeSuffix(const char *name) {
int32_t len = (int32_t)strlen(name);
if (len == 0) {
return false;
}
return basIsTypeSuffixChar(name[len - 1]);
}
static void parseAddExpr(BasParserT *p) {
parseMulExpr(p);
while (!p->hasError) {
if (check(p, TOK_PLUS)) {
advance(p);
parseMulExpr(p);
basEmit8(&p->cg, OP_ADD_INT); // VM handles type promotion
} else if (check(p, TOK_MINUS)) {
advance(p);
parseMulExpr(p);
basEmit8(&p->cg, OP_SUB_INT);
} else {
break;
}
}
}
static void parseAndExpr(BasParserT *p) {
parseNotExpr(p);
while (!p->hasError && check(p, TOK_AND)) {
advance(p);
parseNotExpr(p);
basEmit8(&p->cg, OP_AND);
}
}
static void parseAssignOrCall(BasParserT *p) {
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// MID$ statement: MID$(var$, start [, len]) = replacement$
if (strcasecmp(name, "MID$") == 0 && check(p, TOK_LPAREN)) {
expect(p, TOK_LPAREN);
// First arg: target string variable
if (!check(p, TOK_IDENT)) {
errorExpected(p, "string variable name");
return;
}
char varName[BAS_MAX_TOKEN_LEN];
strncpy(varName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
varName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *varSym = ensureVariable(p, varName);
if (varSym == NULL) {
return;
}
// Load the original string
emitLoad(p, varSym);
expect(p, TOK_COMMA);
parseExpression(p); // start position
// Optional length
if (match(p, TOK_COMMA)) {
parseExpression(p); // length
} else {
// Push 0 as sentinel meaning "use replacement length"
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0);
}
expect(p, TOK_RPAREN);
expect(p, TOK_EQ);
// Parse replacement expression
parseExpression(p);
// Emit MID$ assignment: pops replacement, len, start, str; pushes result
basEmit8(&p->cg, OP_STR_MID_ASGN);
// Store back to the variable
emitStore(p, varSym);
return;
}
BasSymbolT *sym = basSymTabFind(&p->sym, name);
// Dot member access: UDT field or control property/method
if (check(p, TOK_DOT)) {
// Check for UDT field access first
if (sym != NULL && sym->dataType == BAS_TYPE_UDT && sym->udtTypeId >= 0) {
emitLoad(p, sym);
int32_t curTypeId = sym->udtTypeId;
// Walk the dot chain: a.b.c = expr
// For intermediate fields, emit LOAD_FIELD (navigate into nested UDT).
// For the final field, emit STORE_FIELD with the assigned value.
while (check(p, TOK_DOT) && curTypeId >= 0) {
advance(p); // consume DOT
if (!check(p, TOK_IDENT)) {
errorExpected(p, "field name");
return;
}
BasSymbolT *typeSym = findTypeDefById(p, curTypeId);
if (typeSym == NULL) {
error(p, "Unknown TYPE definition");
return;
}
int32_t fieldIdx = resolveFieldIndex(typeSym, p->lex.token.text);
if (fieldIdx < 0) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Unknown field '%s' in TYPE '%s'", p->lex.token.text, typeSym->name);
error(p, buf);
return;
}
advance(p); // consume field name
// Check if this field is a nested UDT with more dots coming
bool fieldIsUdt = (typeSym->fields[fieldIdx].dataType == BAS_TYPE_UDT);
if (fieldIsUdt && check(p, TOK_DOT)) {
// Intermediate level: load this field and continue
basEmit8(&p->cg, OP_LOAD_FIELD);
basEmitU16(&p->cg, (uint16_t)fieldIdx);
curTypeId = typeSym->fields[fieldIdx].udtTypeId;
} else {
// Final field: store value
expect(p, TOK_EQ);
parseExpression(p);
emitStoreConv(p, typeSym->fields[fieldIdx].dataType);
basEmit8(&p->cg, OP_STORE_FIELD);
basEmitU16(&p->cg, (uint16_t)fieldIdx);
return;
}
}
error(p, "Expected '=' in UDT field assignment");
return;
}
// Control property/method access: CtrlName.Member
// Emit: push current form ref, push ctrl name, FIND_CTRL
advance(p); // consume DOT
// Accept any identifier or keyword as a member name -- keywords
// like Load, Show, Hide, Clear are valid method names on controls.
if (!isalpha((unsigned char)p->lex.token.text[0]) && p->lex.token.text[0] != '_') {
errorExpected(p, "property or method name");
return;
}
char memberName[BAS_MAX_TOKEN_LEN];
strncpy(memberName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
memberName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p); // consume member name
// If `name` is a regular variable, the user is dereferencing an
// object reference (typically a form or control returned by
// CreateForm / CreateControl). Use the variable's value as the
// ref directly instead of treating `name` as a literal control
// name.
bool isVarRef = (sym != NULL && sym->kind == SYM_VARIABLE);
// Special form methods: Show, Hide
if (strcasecmp(memberName, "Show") == 0) {
// name.Show [modal]
if (isVarRef) {
emitLoad(p, sym);
} else {
uint16_t nameIdx = basAddConstant(&p->cg, name, (int32_t)strlen(name));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, nameIdx);
basEmit8(&p->cg, OP_LOAD_FORM);
}
uint8_t modal = parseShowModalFlag(p);
basEmit8(&p->cg, OP_SHOW_FORM);
basEmit8(&p->cg, modal);
return;
}
if (strcasecmp(memberName, "Hide") == 0) {
if (isVarRef) {
emitLoad(p, sym);
} else {
uint16_t nameIdx = basAddConstant(&p->cg, name, (int32_t)strlen(name));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, nameIdx);
basEmit8(&p->cg, OP_LOAD_FORM);
}
basEmit8(&p->cg, OP_HIDE_FORM);
return;
}
if (check(p, TOK_EQ)) {
// Property assignment: CtrlName.Property = expr
advance(p); // consume =
// Compile-time validation: if the host provided a validator
// (IDE), check that the property exists on the widget type.
// Skip when `name` is a variable reference (dynamic ctrl we
// can't statically type) or when the ctrl isn't in the map
// (e.g. created via CreateControl at runtime).
if (!isVarRef && p->validator && p->validator->lookupCtrlType && p->validator->isPropValid) {
const char *wgtType = p->validator->lookupCtrlType(p->validator->ctx, name);
if (wgtType && !p->validator->isPropValid(p->validator->ctx, wgtType, memberName)) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Unknown property '%s.%s' (type '%s' has no such property)", name, memberName, wgtType);
error(p, buf);
return;
}
}
// Push ctrl/form ref
if (isVarRef) {
emitLoad(p, sym);
} else {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0);
uint16_t ctrlNameIdx = basAddConstant(&p->cg, name, (int32_t)strlen(name));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, ctrlNameIdx);
basEmit8(&p->cg, OP_FIND_CTRL);
}
// Push property name
uint16_t propNameIdx = basAddConstant(&p->cg, memberName, (int32_t)strlen(memberName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, propNameIdx);
// Parse value expression
parseExpression(p);
// Store property
basEmit8(&p->cg, OP_STORE_PROP);
return;
}
// Method call: CtrlName.Method [args]
// Same compile-time validation as above, but for methods.
if (!isVarRef && p->validator && p->validator->lookupCtrlType && p->validator->isMethodValid) {
const char *wgtType = p->validator->lookupCtrlType(p->validator->ctx, name);
if (wgtType && !p->validator->isMethodValid(p->validator->ctx, wgtType, memberName)) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Unknown method '%s.%s' (type '%s' has no such method)", name, memberName, wgtType);
error(p, buf);
return;
}
}
// Push ctrl/form ref
if (isVarRef) {
emitLoad(p, sym);
} else {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0);
uint16_t ctrlNameIdx = basAddConstant(&p->cg, name, (int32_t)strlen(name));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, ctrlNameIdx);
basEmit8(&p->cg, OP_FIND_CTRL);
}
// Push method name
uint16_t methodNameIdx = basAddConstant(&p->cg, memberName, (int32_t)strlen(memberName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, methodNameIdx);
emitMethodCallStatement(p);
return;
}
// Array assignment, sub/function call, or control array access: var(index)
if (check(p, TOK_LPAREN)) {
// Could be a function call as a statement (discard result)
// or array assignment
if (sym != NULL && (sym->kind == SYM_SUB || sym->kind == SYM_FUNCTION)) {
emitFunctionCall(p, sym);
if (sym->kind == SYM_FUNCTION) {
basEmit8(&p->cg, OP_POP); // discard return value
}
return;
}
// Control array property/method: Name(idx).Prop = expr OR Name(idx).Method args
if (sym == NULL && checkCtrlArrayAccess(p)) {
expect(p, TOK_LPAREN);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0); // NULL form ref = current form
uint16_t ctrlNameIdx = basAddConstant(&p->cg, name, (int32_t)strlen(name));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, ctrlNameIdx);
parseExpression(p); // index expression
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FIND_CTRL_IDX);
expect(p, TOK_DOT);
if (!isalpha((unsigned char)p->lex.token.text[0]) && p->lex.token.text[0] != '_') {
errorExpected(p, "property or method name");
return;
}
char memberName[BAS_MAX_TOKEN_LEN];
strncpy(memberName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
memberName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
if (check(p, TOK_EQ)) {
// Property assignment: Name(idx).Prop = expr
advance(p);
uint16_t propNameIdx = basAddConstant(&p->cg, memberName, (int32_t)strlen(memberName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, propNameIdx);
parseExpression(p);
basEmit8(&p->cg, OP_STORE_PROP);
} else {
// Method call: Name(idx).Method args
uint16_t methodNameIdx = basAddConstant(&p->cg, memberName, (int32_t)strlen(memberName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, methodNameIdx);
emitMethodCallStatement(p);
}
return;
}
// Array element assignment
if (sym == NULL) {
sym = ensureVariable(p, name);
}
if (sym == NULL) {
return;
}
emitLoad(p, sym);
expect(p, TOK_LPAREN);
int32_t dims = 0;
parseExpression(p);
dims++;
while (match(p, TOK_COMMA)) {
parseExpression(p);
dims++;
}
expect(p, TOK_RPAREN);
// Array-of-UDT field store: arr(i).field = expr
if (sym->dataType == BAS_TYPE_UDT && sym->udtTypeId >= 0 && check(p, TOK_DOT)) {
advance(p); // consume DOT
if (!check(p, TOK_IDENT)) {
errorExpected(p, "field name");
return;
}
BasSymbolT *typeSym = findTypeDefById(p, sym->udtTypeId);
if (typeSym == NULL) {
error(p, "Unknown TYPE definition");
return;
}
int32_t fieldIdx = resolveFieldIndex(typeSym, p->lex.token.text);
if (fieldIdx < 0) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Unknown field '%s' in TYPE '%s'", p->lex.token.text, typeSym->name);
error(p, buf);
return;
}
advance(p); // consume field name
expect(p, TOK_EQ);
parseExpression(p);
emitStoreConv(p, typeSym->fields[fieldIdx].dataType);
basEmit8(&p->cg, OP_STORE_ARRAY_FIELD);
basEmit8(&p->cg, (uint8_t)dims);
basEmitU16(&p->cg, (uint16_t)fieldIdx);
return;
}
expect(p, TOK_EQ);
parseExpression(p);
if (sym->isTyped) {
emitStoreConv(p, sym->dataType);
}
basEmit8(&p->cg, OP_STORE_ARRAY);
basEmit8(&p->cg, (uint8_t)dims);
return;
}
// Simple assignment: var = expr
if (check(p, TOK_EQ)) {
advance(p);
if (sym == NULL) {
sym = ensureVariable(p, name);
}
if (sym == NULL) {
return;
}
// Assigning to the enclosing FUNCTION's own name sets its return
// value. Any other procedure name is not a store target (a
// STORE_LOCAL 0 here would clobber the caller's first slot).
if (sym->kind == SYM_FUNCTION) {
if (!p->currentProcIsFunction || strcasecmp(name, p->currentProc) != 0) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Cannot assign to function '%s' outside its own body", sym->name);
error(p, buf);
return;
}
parseExpression(p);
// Store to the implicit return-value local slot (index 0 in function scope)
basEmit8(&p->cg, OP_STORE_LOCAL);
basEmitU16(&p->cg, 0);
return;
}
parseExpression(p);
emitStore(p, sym);
return;
}
// Sub call without parens: SUBName arg1, arg2 ...
// If the identifier is unknown, treat it as a forward-referenced sub.
if (sym == NULL) {
sym = basSymTabAdd(&p->sym, name, SYM_SUB, BAS_TYPE_INTEGER);
if (sym == NULL) {
error(p, "Symbol table full");
return;
}
sym->scope = SCOPE_GLOBAL;
sym->isDefined = false;
sym->codeAddr = 0;
}
if (sym->kind == SYM_SUB) {
int32_t argc = parseCallArgs(p, sym, false);
emitCallWithArgs(p, sym, argc);
return;
}
// If nothing else, it's an assignment missing the =
errorExpected(p, "'=' or '('");
}
// BEGINFORM "FormName" enters form scope: DIM at module level
// creates per-form variables. ENDFORM exits form scope.
static void parseBeginForm(BasParserT *p) {
advance(p); // consume BEGINFORM
if (!check(p, TOK_STRING_LIT)) {
errorExpected(p, "form name string");
return;
}
if (p->lex.token.textLen >= BAS_MAX_IDENT) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Form name too long (maximum is %d characters)", (int)(BAS_MAX_IDENT - 1));
error(p, buf);
return;
}
char formName[BAS_MAX_IDENT];
strcpy(formName, p->lex.token.text);
advance(p);
if (p->sym.inFormScope) {
error(p, "Nested BEGINFORM is not allowed");
return;
}
if (p->sym.inLocalScope) {
error(p, "BEGINFORM inside SUB/FUNCTION is not allowed");
return;
}
basSymTabEnterFormScope(&p->sym, formName);
// Emit a forward JMP to skip over form init code. All module-level
// bytecode inside the form scope (array DIMs, UDT init, executable
// statements, JMPs over SUB bodies) goes into the init block that
// runs at form load time, not at program startup.
basEmit8(&p->cg, OP_JMP);
p->formInitJmpAddr = basCodePos(&p->cg);
basEmit16(&p->cg, 0); // placeholder -- patched at ENDFORM
p->formInitCodeStart = basCodePos(&p->cg);
}
// Parse the argument list of a SUB/FUNCTION call and push each value (or
// address, for BYREF parameters). parens=true expects "(args)"; false
// parses the bare "name arg, arg" statement form up to end of statement.
// Returns the number of arguments parsed.
static int32_t parseCallArgs(BasParserT *p, BasSymbolT *sym, bool parens) {
int32_t argc = 0;
bool more;
if (parens) {
expect(p, TOK_LPAREN);
more = !check(p, TOK_RPAREN);
} else {
more = !check(p, TOK_NEWLINE) && !check(p, TOK_EOF) && !check(p, TOK_COLON) && !check(p, TOK_ELSE);
}
while (more && !p->hasError) {
if (argc < sym->paramCount && !sym->paramByVal[argc]) {
emitByRefArg(p);
} else {
parseExpression(p);
}
argc++;
more = match(p, TOK_COMMA);
}
if (parens) {
expect(p, TOK_RPAREN);
}
return argc;
}
static void parseChDir(BasParserT *p) {
// CHDIR path
advance(p);
parseExpression(p);
basEmit8(&p->cg, OP_FS_CHDIR);
}
static void parseChDrive(BasParserT *p) {
// CHDRIVE drive
advance(p);
parseExpression(p);
basEmit8(&p->cg, OP_FS_CHDRIVE);
}
static void parseClose(BasParserT *p) {
// CLOSE #channel
advance(p); // consume CLOSE
// Optional # prefix
match(p, TOK_HASH);
// Channel number
parseExpression(p);
basEmit8(&p->cg, OP_FILE_CLOSE);
}
static void parseCompareExpr(BasParserT *p) {
parseConcatExpr(p);
while (!p->hasError) {
if (check(p, TOK_EQ)) {
advance(p);
parseConcatExpr(p);
basEmit8(&p->cg, OP_CMP_EQ);
} else if (check(p, TOK_NE)) {
advance(p);
parseConcatExpr(p);
basEmit8(&p->cg, OP_CMP_NE);
} else if (check(p, TOK_LT)) {
advance(p);
parseConcatExpr(p);
basEmit8(&p->cg, OP_CMP_LT);
} else if (check(p, TOK_GT)) {
advance(p);
parseConcatExpr(p);
basEmit8(&p->cg, OP_CMP_GT);
} else if (check(p, TOK_LE)) {
advance(p);
parseConcatExpr(p);
basEmit8(&p->cg, OP_CMP_LE);
} else if (check(p, TOK_GE)) {
advance(p);
parseConcatExpr(p);
basEmit8(&p->cg, OP_CMP_GE);
} else {
break;
}
}
}
static void parseConcatExpr(BasParserT *p) {
parseAddExpr(p);
while (!p->hasError && check(p, TOK_AMPERSAND)) {
advance(p);
parseAddExpr(p);
basEmit8(&p->cg, OP_STR_CONCAT);
}
}
static void parseConst(BasParserT *p) {
// CONST name [AS type] = value
advance(p); // consume CONST
if (!check(p, TOK_IDENT)) {
errorExpected(p, "constant name");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// Optional type annotation (declarative; value's literal type still
// determines runtime representation).
if (match(p, TOK_AS)) {
(void)resolveTypeName(p);
}
expect(p, TOK_EQ);
// Parse the constant value (must be a literal)
bool isNeg = false;
if (check(p, TOK_MINUS)) {
isNeg = true;
advance(p);
}
BasSymbolT *sym = NULL;
if (check(p, TOK_INT_LIT) || check(p, TOK_LONG_LIT)) {
int32_t val = check(p, TOK_INT_LIT) ? p->lex.token.intVal : (int32_t)p->lex.token.longVal;
if (isNeg) {
val = -val;
}
sym = basSymTabAdd(&p->sym, name, SYM_CONST, BAS_TYPE_LONG);
if (sym != NULL) {
sym->constInt = val;
sym->isDefined = true;
sym->scope = SCOPE_GLOBAL;
}
advance(p);
} else if (check(p, TOK_FLOAT_LIT)) {
double val = p->lex.token.dblVal;
if (isNeg) {
val = -val;
}
sym = basSymTabAdd(&p->sym, name, SYM_CONST, BAS_TYPE_DOUBLE);
if (sym != NULL) {
sym->constDbl = val;
sym->isDefined = true;
sym->scope = SCOPE_GLOBAL;
}
advance(p);
} else if (check(p, TOK_STRING_LIT) && !isNeg) {
sym = basSymTabAdd(&p->sym, name, SYM_CONST, BAS_TYPE_STRING);
if (sym != NULL) {
strncpy(sym->constStr, p->lex.token.text, sizeof(sym->constStr) - 1);
sym->constStr[sizeof(sym->constStr) - 1] = '\0';
sym->isDefined = true;
sym->scope = SCOPE_GLOBAL;
}
advance(p);
} else if (check(p, TOK_TRUE_KW) && !isNeg) {
sym = basSymTabAdd(&p->sym, name, SYM_CONST, BAS_TYPE_BOOLEAN);
if (sym != NULL) {
sym->constInt = -1;
sym->isDefined = true;
sym->scope = SCOPE_GLOBAL;
}
advance(p);
} else if (check(p, TOK_FALSE_KW) && !isNeg) {
sym = basSymTabAdd(&p->sym, name, SYM_CONST, BAS_TYPE_BOOLEAN);
if (sym != NULL) {
sym->constInt = 0;
sym->isDefined = true;
sym->scope = SCOPE_GLOBAL;
}
advance(p);
} else {
error(p, "Constant value must be a literal");
}
if (sym == NULL && !p->hasError) {
error(p, "Duplicate constant or symbol table full");
}
}
static void parseData(BasParserT *p) {
// DATA val1, val2, "string", ...
// Collect all values into the data pool. No runtime code is emitted.
advance(p); // consume DATA
for (;;) {
if (p->hasError) {
return;
}
bool isNeg = false;
if (check(p, TOK_MINUS)) {
isNeg = true;
advance(p);
}
if (check(p, TOK_INT_LIT)) {
// Hex/octal/binary literals arrive as TOK_INT_LIT with up to
// 32 significant bits; keep the wide ones as LONG.
int32_t val = p->lex.token.intVal;
if (isNeg) {
val = -val;
}
BasValueT v = (val >= INT16_MIN && val <= INT16_MAX) ? basValInteger((int16_t)val) : basValLong(val);
basAddData(&p->cg, v);
advance(p);
} else if (check(p, TOK_LONG_LIT)) {
int32_t val = (int32_t)p->lex.token.longVal;
if (isNeg) {
val = -val;
}
BasValueT v = basValLong(val);
basAddData(&p->cg, v);
advance(p);
} else if (check(p, TOK_FLOAT_LIT)) {
double val = p->lex.token.dblVal;
if (isNeg) {
val = -val;
}
BasValueT v = basValDouble(val);
basAddData(&p->cg, v);
advance(p);
} else if (check(p, TOK_STRING_LIT) && !isNeg) {
BasValueT v = basValStringFromC(p->lex.token.text);
basAddData(&p->cg, v);
basValRelease(&v);
advance(p);
} else {
// Unquoted text -- read as string up to comma/newline/EOF
// In QB, unquoted DATA values are treated as strings
if (isNeg) {
// Negative sign without a number -- treat "-" as string data
BasValueT v = basValStringFromC("-");
basAddData(&p->cg, v);
basValRelease(&v);
} else if (check(p, TOK_IDENT)) {
BasValueT v = basValStringFromC(p->lex.token.text);
basAddData(&p->cg, v);
basValRelease(&v);
advance(p);
} else {
error(p, "Expected DATA value");
return;
}
}
if (!match(p, TOK_COMMA)) {
break;
}
}
}
static void parseDeclare(BasParserT *p) {
// DECLARE SUB name(params)
// DECLARE FUNCTION name(params) AS type
// DECLARE LIBRARY "name" ... END DECLARE
advance(p); // consume DECLARE
// DECLARE LIBRARY block
if (checkKeyword(p, "LIBRARY")) {
parseDeclareLibrary(p);
return;
}
BasSymKindE kind;
if (check(p, TOK_SUB)) {
kind = SYM_SUB;
advance(p);
} else if (check(p, TOK_FUNCTION)) {
kind = SYM_FUNCTION;
advance(p);
} else {
error(p, "Expected SUB, FUNCTION, or LIBRARY after DECLARE");
return;
}
if (!check(p, TOK_IDENT)) {
errorExpected(p, "subroutine/function name");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
ParamListT pl;
if (!parseParamList(p, &pl, 0)) {
return;
}
// Return type for FUNCTION
uint8_t returnType = suffixToType(name);
if (kind == SYM_FUNCTION && match(p, TOK_AS)) {
returnType = resolveTypeName(p);
}
if (p->hasError) {
return;
}
// Add to symbol table as forward declaration
BasSymbolT *sym = basSymTabFindGlobal(&p->sym, name);
if (sym == NULL) {
sym = basSymTabAdd(&p->sym, name, kind, returnType);
if (sym == NULL) {
error(p, "Symbol table full");
return;
}
sym->scope = SCOPE_GLOBAL;
sym->isDefined = false;
sym->codeAddr = 0;
} else if (sym->kind != kind) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "'%s' is already declared as something else", sym->name);
error(p, buf);
return;
}
// The prescan (or an earlier definition/DECLARE) may already have
// recorded the real signature; a DECLARE that disagrees with it is an
// error rather than a silent partial overwrite. A call-site stub has
// no signature yet and simply takes this one.
if (sym->hasSignature) {
bool matches = (sym->paramCount == pl.count);
for (int32_t i = 0; matches && i < pl.count; i++) {
matches = (sym->paramTypes[i] == pl.types[i]);
}
if (!matches) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "DECLARE for '%s' does not match its definition", sym->name);
error(p, buf);
}
return;
}
applyParamList(sym, &pl);
}
// Declares external native functions from a dynamically loaded
// library. The library name is stored in the constant pool.
// Each function inside the block is registered as an extern symbol.
// At runtime, OP_CALL_EXTERN resolves the function via the host's
// resolveExtern callback (typically dlsym).
static void parseDeclareLibrary(BasParserT *p) {
advance(p); // consume LIBRARY
if (!check(p, TOK_STRING_LIT)) {
errorExpected(p, "library name string");
return;
}
uint16_t libNameIdx = basAddConstant(&p->cg, p->lex.token.text, p->lex.token.textLen);
advance(p);
skipNewlines(p);
// Parse function declarations until END DECLARE
while (!p->hasError && !check(p, TOK_EOF)) {
skipNewlines(p);
// Check for END DECLARE
if (check(p, TOK_END)) {
advance(p);
if (check(p, TOK_DECLARE)) {
advance(p);
break;
}
error(p, "Expected DECLARE after END in DECLARE LIBRARY block");
return;
}
// Must be DECLARE SUB or DECLARE FUNCTION
if (!check(p, TOK_DECLARE)) {
errorExpected(p, "DECLARE or END DECLARE");
return;
}
advance(p); // consume DECLARE
BasSymKindE kind;
if (check(p, TOK_SUB)) {
kind = SYM_SUB;
advance(p);
} else if (check(p, TOK_FUNCTION)) {
kind = SYM_FUNCTION;
advance(p);
} else {
error(p, "Expected SUB or FUNCTION in DECLARE LIBRARY block");
return;
}
if (!check(p, TOK_IDENT)) {
errorExpected(p, "function name");
return;
}
char funcName[BAS_MAX_TOKEN_LEN];
strncpy(funcName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
funcName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// Strip type suffix ($%&!#) from extern name so dlsym finds the
// C function. The suffix is still used for return type via suffixToType.
char externName[BAS_MAX_TOKEN_LEN];
strncpy(externName, funcName, BAS_MAX_TOKEN_LEN - 1);
externName[BAS_MAX_TOKEN_LEN - 1] = '\0';
int32_t enLen = (int32_t)strlen(externName);
if (enLen > 0) {
char last = externName[enLen - 1];
if (basIsTypeSuffixChar(last)) {
externName[enLen - 1] = '\0';
}
}
uint16_t funcNameIdx = basAddConstant(&p->cg, externName, (int32_t)strlen(externName));
ParamListT pl;
if (!parseParamList(p, &pl, 0)) {
return;
}
// Return type for FUNCTION
uint8_t returnType = suffixToType(funcName);
if (kind == SYM_FUNCTION && match(p, TOK_AS)) {
returnType = resolveTypeName(p);
}
if (p->hasError) {
return;
}
// Register as extern symbol (the prescan may already have added
// it from this same DECLARE line; reuse that entry).
BasSymbolT *sym = basSymTabFindGlobal(&p->sym, funcName);
if (sym == NULL) {
sym = basSymTabAdd(&p->sym, funcName, kind, returnType);
if (sym == NULL) {
error(p, "Symbol table full");
return;
}
} else if (sym->kind != kind) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "'%s' is already declared as something else", sym->name);
error(p, buf);
return;
}
sym->scope = SCOPE_GLOBAL;
sym->dataType = returnType;
sym->isDefined = true;
sym->isExtern = true;
sym->externLibIdx = libNameIdx;
sym->externFuncIdx = funcNameIdx;
applyParamList(sym, &pl);
}
}
static void parseDef(BasParserT *p) {
// DEF FNname(params) = expression
advance(p); // consume DEF
if (!check(p, TOK_IDENT)) {
errorExpected(p, "function name (FNname)");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
if ((name[0] != 'F' && name[0] != 'f') || (name[1] != 'N' && name[1] != 'n')) {
error(p, "DEF function name must start with FN");
return;
}
// A DEF FN body gets its own local scope; opening one inside a
// SUB/FUNCTION would reset that procedure's slot numbering and free
// its locals on exit. QB forbids it too.
if (p->sym.inLocalScope) {
error(p, "DEF FN is not allowed inside SUB or FUNCTION");
return;
}
advance(p);
int32_t skipJump = emitJump(p, OP_JMP);
int32_t funcAddr = basCodePos(&p->cg);
basSymTabEnterLocal(&p->sym);
basSymTabAllocSlot(&p->sym); // slot 0 for return value
ParamListT pl;
if (!parseParamList(p, &pl, PARAM_REGISTER | PARAM_FORCE_BYVAL)) {
return;
}
expect(p, TOK_EQ);
parseExpression(p);
basEmit8(&p->cg, OP_RET_VAL);
// A DEF FN occupies a proc-table slot (it is a defined FUNCTION
// symbol), and the proc table is sorted by code address to match the
// source-order debugProcCount indices -- so consume a debug proc index
// here even though no debug locals are emitted for it. DEF FN params
// are tiny/transient, so skipping their debug info is safe.
p->cg.debugProcCount++;
basSymTabLeaveLocal(&p->sym);
uint8_t returnType = suffixToType(name);
BasSymbolT *funcSym = basSymTabAdd(&p->sym, name, SYM_FUNCTION, returnType);
if (funcSym == NULL) {
error(p, "Could not register DEF function");
return;
}
funcSym->codeAddr = funcAddr;
funcSym->isDefined = true;
funcSym->scope = SCOPE_GLOBAL;
applyParamList(funcSym, &pl);
patchCallAddrs(p, funcSym);
patchJump(p, skipJump);
}
// Sets the default type for variables whose names start with
// letters in the given range. Example: DEFINT A-Z makes all
// untyped variables default to INTEGER.
static void parseDefType(BasParserT *p, uint8_t dataType) {
advance(p); // consume DEFxxx keyword
while (!p->hasError) {
if (!check(p, TOK_IDENT)) {
errorExpected(p, "letter or letter range");
return;
}
char startLetter = (char)toupper((unsigned char)p->lex.token.text[0]);
if (startLetter < 'A' || startLetter > 'Z') {
error(p, "Expected letter A-Z");
return;
}
advance(p);
char endLetter = startLetter;
if (match(p, TOK_MINUS)) {
if (!check(p, TOK_IDENT)) {
errorExpected(p, "letter after '-'");
return;
}
endLetter = (char)toupper((unsigned char)p->lex.token.text[0]);
if (endLetter < 'A' || endLetter > 'Z') {
error(p, "Expected letter A-Z");
return;
}
advance(p);
}
if (endLetter < startLetter) {
error(p, "Letter range must be in ascending order (e.g. A-Z)");
return;
}
// Set default type for the range
for (char c = startLetter; c <= endLetter; c++) {
p->defType[c - 'A'] = dataType;
}
if (!match(p, TOK_COMMA)) {
break;
}
}
}
static void parseDim(BasParserT *p) {
// DIM [SHARED] var AS type
// DIM var(ubound) AS type
// DIM var(lbound TO ubound) AS type
// DIM var AS UdtType
advance(p); // consume DIM
// Check for SHARED keyword
bool isShared = false;
if (check(p, TOK_SHARED)) {
isShared = true;
advance(p);
}
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
bool isArray = false;
int32_t dims = 0;
// Check for array bounds
if (check(p, TOK_LPAREN)) {
isArray = true;
advance(p);
parseDimBounds(p, &dims);
expect(p, TOK_RPAREN);
}
// Optional AS type
uint8_t dt = suffixToType(name);
bool isTyped = nameHasTypeSuffix(name);
int32_t udtTypeId = -1;
int32_t fixedLen = 0;
if (match(p, TOK_AS)) {
dt = resolveTypeName(p);
isTyped = true;
if (dt == BAS_TYPE_UDT) {
udtTypeId = p->lastUdtTypeId;
}
// Check for STRING * n (fixed-length string)
if (dt == BAS_TYPE_STRING && check(p, TOK_STAR)) {
advance(p);
if (!check(p, TOK_INT_LIT)) {
error(p, "Expected integer after STRING *");
} else if (p->lex.token.intVal < 1 || p->lex.token.intVal > UINT16_MAX) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "STRING * length must be 1 to %d", (int)UINT16_MAX);
error(p, buf);
} else {
fixedLen = p->lex.token.intVal;
advance(p);
}
}
}
if (p->hasError) {
return;
}
// Determine the scope this DIM would create (local > form > global)
// so duplicate detection only rejects a name already declared in the
// SAME scope. basSymTabFind falls back to form/global from a SUB, so a
// plain isDefined check wrongly blocked a local DIM from shadowing a
// module-level variable (standard QB semantics, see dvx_basic_reference).
BasScopeE newScope;
if (p->sym.inLocalScope) {
newScope = SCOPE_LOCAL;
} else if (p->sym.inFormScope) {
newScope = SCOPE_FORM;
} else {
newScope = SCOPE_GLOBAL;
}
// Check for duplicates. Only a VARIABLE from an outer scope may be
// shadowed; a CONST/label/type of the same name must be rejected
// regardless of scope, because local-first lookup would make every
// later use of that name silently bind to the new variable. A
// SUB/FUNCTION is rejected even when not yet defined: prescan
// registers every signature before bodies parse, so the name is
// already committed to a procedure (a shadowed FUNCTION call would
// otherwise compile as an array load on a scalar).
BasSymbolT *existing = basSymTabFind(&p->sym, name);
bool isDupSymbol = false;
if (existing != NULL) {
if (existing->kind == SYM_SUB || existing->kind == SYM_FUNCTION) {
isDupSymbol = true;
} else if (existing->isDefined && (existing->kind != SYM_VARIABLE || existing->scope == newScope)) {
isDupSymbol = true;
}
}
if (isDupSymbol) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "'%s' already declared", name);
error(p, buf);
return;
}
BasSymbolT *sym = basSymTabAdd(&p->sym, name, SYM_VARIABLE, dt);
if (sym == NULL) {
error(p, "Symbol table full or duplicate name");
return;
}
sym->index = basSymTabAllocSlot(&p->sym);
sym->isDefined = true;
sym->isArray = isArray;
sym->isShared = isShared;
sym->udtTypeId = udtTypeId;
sym->fixedLen = fixedLen;
sym->isTyped = isTyped;
sym->scope = newScope;
if (isArray) {
if (dt == BAS_TYPE_UDT && udtTypeId >= 0) {
// For UDT arrays, push typeId and fieldCount so elements
// can be properly initialized
BasSymbolT *typeSym = findTypeDefById(p, udtTypeId);
if (typeSym != NULL) {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)udtTypeId);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)typeSym->fieldCount);
}
}
basEmit8(&p->cg, OP_DIM_ARRAY);
basEmit8(&p->cg, (uint8_t)dims);
basEmit8(&p->cg, dt);
emitStore(p, sym);
} else if (dt == BAS_TYPE_UDT && udtTypeId >= 0) {
// Allocate a UDT instance
BasSymbolT *typeSym = findTypeDefById(p, udtTypeId);
if (typeSym != NULL) {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)udtTypeId);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)typeSym->fieldCount);
// OP_DIM_ARRAY with dims=0 signals UDT allocation
basEmit8(&p->cg, OP_DIM_ARRAY);
basEmit8(&p->cg, 0);
basEmit8(&p->cg, BAS_TYPE_UDT);
// Initialize nested UDT fields
emitUdtInit(p, udtTypeId);
emitStore(p, sym);
}
} else if (dt == BAS_TYPE_STRING) {
// STRING slots must start as an empty string, not numeric 0.
// Arithmetic falls through basValToNumber so numeric defaults
// stay harmless, but STRING concat checks actual slot type.
uint16_t idx = basAddConstant(&p->cg, "", 0);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, idx);
emitStore(p, sym);
}
}
static void parseDimBounds(BasParserT *p, int32_t *outDims) {
// Parse each dimension bound, pushing (lbound, ubound) pairs onto the stack.
// Supports both "ubound" (lbound=optionBase) and "lbound TO ubound" syntax.
*outDims = 0;
for (;;) {
// Save code position before parsing the first expression
int32_t exprStart = basCodePos(&p->cg);
parseExpression(p);
if (match(p, TOK_TO)) {
// "lbound TO ubound" -- first expr is lbound, parse ubound next
parseExpression(p);
} else {
// Single value = ubound, lbound defaults to optionBase.
// Ubound expression already emitted. Insert PUSH_INT16 before it.
int16_t lbound = (int16_t)p->optionBase;
int32_t exprLen = basCodePos(&p->cg) - exprStart;
int32_t insertLen = (int32_t)(1 + sizeof(lbound)); // opcode byte + int16 operand
{
// Grow the array to make room for the insertion
for (int32_t pad = 0; pad < insertLen; pad++) {
arrput(p->cg.code, 0);
}
memmove(&p->cg.code[exprStart + insertLen], &p->cg.code[exprStart], exprLen);
p->cg.code[exprStart] = OP_PUSH_INT16;
memcpy(&p->cg.code[exprStart + 1], &lbound, sizeof(lbound));
p->cg.codeLen = (int32_t)arrlen(p->cg.code);
// The ubound expression was just moved forward by insertLen.
// Any forward-CALL or label-ref patch address that landed
// inside it now points at stale bytes; shift them so they
// patch the relocated operand instead of corrupting code.
shiftBackpatchAddrs(p, exprStart, insertLen);
}
}
(*outDims)++;
if (!match(p, TOK_COMMA)) {
break;
}
}
}
static void parseDo(BasParserT *p) {
// DO [WHILE|UNTIL cond]
// ...
// LOOP [WHILE|UNTIL cond]
advance(p); // consume DO
LoopSaveT save;
loopBegin(p, false, &save);
int32_t loopTop = basCodePos(&p->cg);
bool hasPreCondition = false;
int32_t preCondJump = 0;
// DO WHILE cond / DO UNTIL cond
if (check(p, TOK_WHILE)) {
hasPreCondition = true;
advance(p);
parseExpression(p);
preCondJump = emitJump(p, OP_JMP_FALSE);
} else if (check(p, TOK_UNTIL)) {
hasPreCondition = true;
advance(p);
parseExpression(p);
preCondJump = emitJump(p, OP_JMP_TRUE);
}
expectEndOfStatement(p);
skipNewlines(p);
// Loop body
while (!p->hasError && !check(p, TOK_LOOP) && !check(p, TOK_EOF)) {
parseStatement(p);
skipNewlines(p);
}
if (p->hasError) {
loopEnd(p, false, &save);
return;
}
expect(p, TOK_LOOP);
// LOOP WHILE cond / LOOP UNTIL cond
if (check(p, TOK_WHILE)) {
advance(p);
parseExpression(p);
// Jump back to loopTop if condition is true
basEmit8(&p->cg, OP_JMP_TRUE);
int16_t backOffset = relJumpOffset(p, loopTop, basCodePos(&p->cg));
basEmit16(&p->cg, backOffset);
} else if (check(p, TOK_UNTIL)) {
advance(p);
parseExpression(p);
// Jump back to loopTop if condition is false
basEmit8(&p->cg, OP_JMP_FALSE);
int16_t backOffset = relJumpOffset(p, loopTop, basCodePos(&p->cg));
basEmit16(&p->cg, backOffset);
} else {
// Plain LOOP -- unconditional jump back
basEmit8(&p->cg, OP_JMP);
int16_t backOffset = relJumpOffset(p, loopTop, basCodePos(&p->cg));
basEmit16(&p->cg, backOffset);
}
// Backpatch pre-condition jump (exits the loop)
if (hasPreCondition) {
patchJump(p, preCondJump);
}
// Patch all EXIT DO jumps to here
loopEnd(p, false, &save);
}
static void parseEnd(BasParserT *p) {
// END -- by itself = terminate program
// END IF / END SUB / END FUNCTION / END SELECT are handled by their parsers
advance(p); // consume END
basEmit8(&p->cg, OP_END);
}
static void parseEndForm(BasParserT *p) {
advance(p); // consume ENDFORM
if (!p->sym.inFormScope) {
error(p, "ENDFORM without BEGINFORM");
return;
}
// Capture form name before leaving scope
char formName[BAS_MAX_IDENT];
strncpy(formName, p->sym.formScopeName, sizeof(formName) - 1);
formName[sizeof(formName) - 1] = '\0';
int32_t varCount = basSymTabLeaveFormScope(&p->sym);
// Close the form init block: add OP_RET and patch the JMP
basEmit8(&p->cg, OP_RET);
int32_t initAddr = p->formInitCodeStart;
int32_t initLen = basCodePos(&p->cg) - p->formInitCodeStart;
// Patch the JMP to skip over the entire init block
int16_t offset = relJumpOffset(p, basCodePos(&p->cg), p->formInitJmpAddr);
basPatch16(&p->cg, p->formInitJmpAddr, offset);
p->formInitJmpAddr = -1;
p->formInitCodeStart = -1;
// Record form variable info (init code always exists once BEGINFORM ran,
// so initAddr >= 0 here -- the entry is recorded unconditionally).
BasFormVarInfoT info;
memset(&info, 0, sizeof(info));
snprintf(info.formName, sizeof(info.formName), "%s", formName);
info.varCount = varCount;
info.initCodeAddr = initAddr;
info.initCodeLen = initLen;
arrput(p->cg.formVarInfo, info);
p->cg.formVarInfoCount = (int32_t)arrlen(p->cg.formVarInfo);
}
static void parseEqvExpr(BasParserT *p) {
parseOrExpr(p);
while (!p->hasError && check(p, TOK_EQV)) {
advance(p);
parseOrExpr(p);
basEmit8(&p->cg, OP_EQV);
}
}
static void parseErase(BasParserT *p) {
// ERASE arrayVar
advance(p); // consume ERASE
if (!check(p, TOK_IDENT)) {
errorExpected(p, "array variable name");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *sym = basSymTabFind(&p->sym, name);
if (sym == NULL || !sym->isArray) {
error(p, "ERASE requires an array variable");
return;
}
emitLoad(p, sym);
basEmit8(&p->cg, OP_ERASE);
emitStore(p, sym);
}
static void parseExit(BasParserT *p) {
advance(p); // consume EXIT
// Each form is only legal inside its construct; the depth counters
// and currentProc flags are reset per procedure (procBegin), so an
// EXIT can never be patched against a loop or procedure of the caller.
if (check(p, TOK_FOR)) {
advance(p);
if (p->forDepth == 0) {
error(p, "EXIT FOR outside FOR loop");
return;
}
// Discard the test values of any SELECT CASE bodies this EXIT
// jumps out of, then drop the VM for-frame and jump.
emitSelectPops(p, p->selectDepth - p->forSelectBase);
basEmit8(&p->cg, OP_FOR_POP);
int32_t addr = emitJump(p, OP_JMP);
exitListAdd(&p->exitForList, addr);
} else if (check(p, TOK_DO)) {
advance(p);
if (p->doDepth == 0) {
error(p, "EXIT DO outside DO or WHILE loop");
return;
}
emitSelectPops(p, p->selectDepth - p->doSelectBase);
int32_t addr = emitJump(p, OP_JMP);
exitListAdd(&p->exitDoList, addr);
} else if (check(p, TOK_SUB)) {
advance(p);
if (!p->sym.inLocalScope || p->currentProcIsFunction) {
error(p, "EXIT SUB outside SUB");
return;
}
// Leaving the procedure entirely: pop every open SELECT value.
emitSelectPops(p, p->selectDepth);
int32_t addr = emitJump(p, OP_JMP);
exitListAdd(&p->exitSubList, addr);
} else if (check(p, TOK_FUNCTION)) {
advance(p);
if (!p->sym.inLocalScope || !p->currentProcIsFunction) {
error(p, "EXIT FUNCTION outside FUNCTION");
return;
}
emitSelectPops(p, p->selectDepth);
int32_t addr = emitJump(p, OP_JMP);
exitListAdd(&p->exitFuncList, addr);
} else {
error(p, "Expected FOR, DO, SUB, or FUNCTION after EXIT");
}
}
static void parseExpression(BasParserT *p) {
if (!exprEnter(p)) {
return;
}
parseImpExpr(p);
exprLeave(p);
}
static void parseFileCopy(BasParserT *p) {
// FILECOPY source, dest
advance(p);
parseExpression(p);
expect(p, TOK_COMMA);
parseExpression(p);
basEmit8(&p->cg, OP_FS_FILECOPY);
}
static void parseFor(BasParserT *p) {
// FOR var = start TO limit [STEP step]
// ...
// NEXT [var]
advance(p); // consume FOR
// Loop variable
if (!check(p, TOK_IDENT)) {
errorExpected(p, "loop variable");
return;
}
char varName[BAS_MAX_TOKEN_LEN];
strncpy(varName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
varName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *loopVar = ensureVariable(p, varName);
if (loopVar == NULL) {
return;
}
// Open the loop (fresh EXIT FOR list, SELECT depth for EXIT to unwind
// to) only once the header is known to be well-formed.
LoopSaveT save;
loopBegin(p, true, &save);
// = start
expect(p, TOK_EQ);
parseExpression(p);
emitStore(p, loopVar);
// TO limit
expect(p, TOK_TO);
parseExpression(p); // limit is on stack
// STEP step (optional, default 1)
if (match(p, TOK_STEP)) {
parseExpression(p); // step is on stack
} else {
// Default step = 1
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 1);
}
// Emit FOR_INIT -- sets up the for-loop state in the VM. The
// trailing int16 is a forward offset the VM uses to skip the body
// when the loop's range is already empty at entry (e.g. FOR i = 10
// TO 5). We patch it after the body is emitted.
basEmit8(&p->cg, OP_FOR_INIT);
basEmitU16(&p->cg, (uint16_t)loopVar->index);
basEmit8(&p->cg, (uint8_t)loopVar->scope);
int32_t skipOffsetPos = basCodePos(&p->cg);
basEmit16(&p->cg, 0); // placeholder
int32_t loopBody = basCodePos(&p->cg);
expectEndOfStatement(p);
skipNewlines(p);
// Loop body
while (!p->hasError && !check(p, TOK_NEXT) && !check(p, TOK_EOF)) {
parseStatement(p);
skipNewlines(p);
}
if (p->hasError) {
loopEnd(p, true, &save);
return;
}
expect(p, TOK_NEXT);
// Optional variable name after NEXT must name this loop's variable
if (check(p, TOK_IDENT)) {
if (strcasecmp(p->lex.token.text, loopVar->name) != 0) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "NEXT %s does not match FOR %s", p->lex.token.text, loopVar->name);
error(p, buf);
loopEnd(p, true, &save);
return;
}
advance(p);
}
// Emit FOR_NEXT with backward jump to loop body
basEmit8(&p->cg, OP_FOR_NEXT);
basEmitU16(&p->cg, (uint16_t)loopVar->index);
basEmit8(&p->cg, (uint8_t)loopVar->scope);
int16_t backOffset = relJumpOffset(p, loopBody, basCodePos(&p->cg));
basEmit16(&p->cg, backOffset);
// Patch FOR_INIT's forward skip offset to point past FOR_NEXT.
patchJump(p, skipOffsetPos);
// Patch all EXIT FOR jumps to here
loopEnd(p, true, &save);
}
static void parseFunction(BasParserT *p) {
// FUNCTION name(params) AS type
// ...
// END FUNCTION
advance(p); // consume FUNCTION
if (!check(p, TOK_IDENT)) {
errorExpected(p, "function name");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
if (p->sym.inLocalScope) {
error(p, "FUNCTION cannot be defined inside SUB or FUNCTION");
return;
}
// Save current proc name for STATIC variable mangling
strncpy(p->currentProc, name, BAS_MAX_TOKEN_LEN - 1);
p->currentProc[BAS_MAX_TOKEN_LEN - 1] = '\0';
// Jump over the function body in module-level code
int32_t skipJump = emitJump(p, OP_JMP);
int32_t funcAddr = basCodePos(&p->cg);
// Enter local scope
basSymTabEnterLocal(&p->sym);
ProcSaveT save;
procBegin(p, &save, true);
// Allocate slot 0 for return value
basSymTabAllocSlot(&p->sym);
ParamListT pl;
if (!parseParamList(p, &pl, PARAM_REGISTER)) {
procEnd(p, &save);
return;
}
// Return type
uint8_t returnType = suffixToType(name);
if (match(p, TOK_AS)) {
returnType = resolveTypeName(p);
}
// Register the function in the symbol table (global scope entry).
// The prescan / a DECLARE / a call-site stub may already have added
// it; a symbol that is already defined is a duplicate body.
BasSymbolT *existing = basSymTabFindGlobal(&p->sym, name);
BasSymbolT *funcSym = NULL;
if (existing != NULL && existing->kind == SYM_FUNCTION) {
if (existing->isDefined) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Function '%s' is already defined", existing->name);
error(p, buf);
procEnd(p, &save);
return;
}
funcSym = existing;
} else {
// Temporarily store the local state, add globally
bool savedLocal = p->sym.inLocalScope;
p->sym.inLocalScope = false;
funcSym = basSymTabAdd(&p->sym, name, SYM_FUNCTION, returnType);
p->sym.inLocalScope = savedLocal;
}
if (funcSym == NULL) {
error(p, "Could not register function");
procEnd(p, &save);
return;
}
funcSym->codeAddr = funcAddr;
funcSym->isDefined = true;
funcSym->scope = SCOPE_GLOBAL;
funcSym->dataType = returnType;
applyParamList(funcSym, &pl);
// Record the owning form -- see parseSub for the rationale.
if (p->sym.inFormScope && p->sym.formScopeName[0]) {
strncpy(funcSym->formName, p->sym.formScopeName, BAS_MAX_IDENT - 1);
funcSym->formName[BAS_MAX_IDENT - 1] = '\0';
}
// Backpatch any forward-reference calls to this function
patchCallAddrs(p, funcSym);
expectEndOfStatement(p);
skipNewlines(p);
// Parse function body
while (!p->hasError && !check(p, TOK_EOF)) {
// Check for END FUNCTION
if (check(p, TOK_END)) {
// Peek ahead -- we need to see if it's END FUNCTION
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_FUNCTION)) {
advance(p);
break;
}
// Not END FUNCTION, restore and parse as statement
p->lex = savedLex;
}
parseStatement(p);
skipNewlines(p);
}
// Patch EXIT FUNCTION jumps, emit the epilogue and prologue, and
// restore the enclosing state
procEnd(p, &save);
// Leave local scope
collectDebugLocals(p, p->cg.debugProcCount++);
basSymTabLeaveLocal(&p->sym);
// Patch the skip jump
patchJump(p, skipJump);
}
static void parseGet(BasParserT *p) {
// GET #channel, [recno], var
advance(p); // consume GET
match(p, TOK_HASH); // optional #
// Channel number
parseExpression(p);
expect(p, TOK_COMMA);
// Optional record number
if (check(p, TOK_COMMA)) {
// No record number specified -- push 0 (current position)
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0);
} else {
parseExpression(p);
}
expect(p, TOK_COMMA);
// Target variable
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char varName[BAS_MAX_TOKEN_LEN];
strncpy(varName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
varName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *sym = ensureVariable(p, varName);
if (sym == NULL) {
return;
}
// A STRING target reads as many bytes as it already holds in BINARY
// mode, so its current value goes on the stack ahead of the type.
if (sym->dataType == BAS_TYPE_STRING) {
emitLoad(p, sym);
}
// Push variable type so VM knows how many bytes to read
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)sym->dataType);
basEmit8(&p->cg, OP_FILE_GET);
emitStore(p, sym);
}
static void parseGosub(BasParserT *p) {
// GOSUB label -- push return PC, then JMP to label
advance(p); // consume GOSUB
if (!check(p, TOK_IDENT)) {
errorExpected(p, "label name");
return;
}
char labelName[BAS_MAX_TOKEN_LEN];
strncpy(labelName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
labelName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// Push the return PC (address after the JMP instruction)
// OP_PUSH_INT32 = 1 + 4 bytes, OP_JMP = 1 + 2 bytes
int32_t pushPos = basCodePos(&p->cg);
basEmit8(&p->cg, OP_PUSH_INT32);
basEmit16(&p->cg, 0); // placeholder lo
basEmit16(&p->cg, 0); // placeholder hi
// Emit the jump to the label
emitJumpToLabel(p, OP_JMP, labelName);
// Backpatch the return address (PC is now right after the JMP)
int32_t returnPc = basCodePos(&p->cg);
int16_t lo = (int16_t)(returnPc & 0xFFFF);
int16_t hi = (int16_t)((returnPc >> 16) & 0xFFFF);
basPatch16(&p->cg, pushPos + 1, lo);
basPatch16(&p->cg, pushPos + 3, hi);
}
static void parseGoto(BasParserT *p) {
// GOTO label
advance(p); // consume GOTO
if (!check(p, TOK_IDENT)) {
errorExpected(p, "label name");
return;
}
char labelName[BAS_MAX_TOKEN_LEN];
strncpy(labelName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
labelName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
emitGotoWithSelectPops(p, labelName);
}
static void parseIdivExpr(BasParserT *p) {
parseMulDivExpr(p);
while (!p->hasError && check(p, TOK_BACKSLASH)) {
advance(p);
parseMulDivExpr(p);
basEmit8(&p->cg, OP_IDIV_INT);
}
}
static void parseIf(BasParserT *p) {
// IF expr THEN
// ...
// [ELSEIF expr THEN]
// ...
// [ELSE]
// ...
// END IF
advance(p); // consume IF
parseExpression(p);
expect(p, TOK_THEN);
if (p->hasError) {
return;
}
// Check for single-line IF: IF cond THEN stmt [: stmt]...
if (!check(p, TOK_NEWLINE) && !check(p, TOK_EOF)) {
// Single-line IF. QuickBASIC semantics: ALL colon-separated
// statements after THEN (and after ELSE) belong to that branch.
// parseStatement consumes a trailing colon, so loop until the
// branch terminator (ELSE/NEWLINE/EOF) is reached.
int32_t falseJump = emitJump(p, OP_JMP_FALSE);
while (!p->hasError && !check(p, TOK_ELSE) && !check(p, TOK_NEWLINE) && !check(p, TOK_EOF)) {
parseStatement(p);
}
if (check(p, TOK_ELSE)) {
advance(p);
int32_t endJump = emitJump(p, OP_JMP);
patchJump(p, falseJump);
while (!p->hasError && !check(p, TOK_NEWLINE) && !check(p, TOK_EOF)) {
parseStatement(p);
}
patchJump(p, endJump);
} else {
patchJump(p, falseJump);
}
return;
}
// Multi-line IF
expectEndOfStatement(p);
skipNewlines(p);
int32_t falseJump = emitJump(p, OP_JMP_FALSE);
// Collect end-of-chain jumps for backpatching (stb_ds dynamic array)
int32_t *endJumps = NULL;
// Parse THEN block
while (!p->hasError && !check(p, TOK_ELSEIF) && !check(p, TOK_ELSE) && !check(p, TOK_EOF)) {
// Check for END IF
if (check(p, TOK_END)) {
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_IF)) {
advance(p);
patchJump(p, falseJump);
// Patch all end jumps
for (int32_t i = 0; i < (int32_t)arrlen(endJumps); i++) {
patchJump(p, endJumps[i]);
}
arrfree(endJumps);
return;
}
p->lex = savedLex;
}
parseStatement(p);
skipNewlines(p);
}
// ELSEIF chain
while (!p->hasError && check(p, TOK_ELSEIF)) {
// Jump from previous true-block to end of chain
arrput(endJumps, emitJump(p, OP_JMP));
// Patch the previous false jump to here
patchJump(p, falseJump);
advance(p); // consume ELSEIF
parseExpression(p);
expect(p, TOK_THEN);
falseJump = emitJump(p, OP_JMP_FALSE);
expectEndOfStatement(p);
skipNewlines(p);
while (!p->hasError && !check(p, TOK_ELSEIF) && !check(p, TOK_ELSE) && !check(p, TOK_EOF)) {
if (check(p, TOK_END)) {
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_IF)) {
advance(p);
patchJump(p, falseJump);
for (int32_t i = 0; i < (int32_t)arrlen(endJumps); i++) {
patchJump(p, endJumps[i]);
}
arrfree(endJumps);
return;
}
p->lex = savedLex;
}
parseStatement(p);
skipNewlines(p);
}
}
// ELSE block
if (!p->hasError && check(p, TOK_ELSE)) {
arrput(endJumps, emitJump(p, OP_JMP));
patchJump(p, falseJump);
falseJump = -1; // no more false jump needed
advance(p); // consume ELSE
expectEndOfStatement(p);
skipNewlines(p);
while (!p->hasError && !check(p, TOK_EOF)) {
if (check(p, TOK_END)) {
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_IF)) {
advance(p);
for (int32_t i = 0; i < (int32_t)arrlen(endJumps); i++) {
patchJump(p, endJumps[i]);
}
arrfree(endJumps);
return;
}
p->lex = savedLex;
}
parseStatement(p);
skipNewlines(p);
}
}
// Patch the last false jump if no ELSE block
if (falseJump >= 0) {
patchJump(p, falseJump);
}
// Patch all end-of-chain jumps
for (int32_t i = 0; i < (int32_t)arrlen(endJumps); i++) {
patchJump(p, endJumps[i]);
}
arrfree(endJumps);
// If we got here without END IF, that's an error
if (!p->hasError) {
error(p, "Expected END IF");
}
}
static void parseImpExpr(BasParserT *p) {
parseEqvExpr(p);
while (!p->hasError && check(p, TOK_IMP)) {
advance(p);
parseEqvExpr(p);
basEmit8(&p->cg, OP_IMP);
}
}
static void parseInput(BasParserT *p) {
// INPUT #channel, var
// INPUT [prompt;] var
advance(p); // consume INPUT
// Check for file I/O: INPUT #channel, var
if (check(p, TOK_HASH)) {
advance(p); // consume #
// Channel number
parseExpression(p);
// Comma separator
expect(p, TOK_COMMA);
// One OP_FILE_INPUT per comma-separated target. Each consumes
// the channel, so it is duplicated ahead of every field but the
// last.
for (;;) {
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char varName[BAS_MAX_TOKEN_LEN];
strncpy(varName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
varName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
bool more = check(p, TOK_COMMA);
if (more) {
basEmit8(&p->cg, OP_DUP);
}
basEmit8(&p->cg, OP_FILE_INPUT);
BasSymbolT *sym = ensureVariable(p, varName);
if (sym == NULL) {
return;
}
emitInputConv(p, sym);
emitStore(p, sym);
if (!match(p, TOK_COMMA)) {
return;
}
}
}
// Check for optional prompt string
if (check(p, TOK_STRING_LIT)) {
uint16_t idx = basAddConstant(&p->cg, p->lex.token.text, p->lex.token.textLen);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, idx);
advance(p);
// Semicolon after prompt
if (match(p, TOK_SEMICOLON)) {
// nothing extra
} else if (match(p, TOK_COMMA)) {
// comma -- no question mark (just prompt)
}
} else {
// No prompt -- push empty string
uint16_t idx = basAddConstant(&p->cg, "", 0);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, idx);
}
// Emit INPUT opcode -- pops prompt, pushes input string
basEmit8(&p->cg, OP_INPUT);
// Target variable
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char varName[BAS_MAX_TOKEN_LEN];
strncpy(varName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
varName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *sym = ensureVariable(p, varName);
if (sym == NULL) {
return;
}
emitInputConv(p, sym);
emitStore(p, sym);
}
static void parseKill(BasParserT *p) {
// KILL filename
advance(p);
parseExpression(p);
basEmit8(&p->cg, OP_FS_KILL);
}
static void parseLineInput(BasParserT *p) {
// LINE INPUT #channel, var
advance(p); // consume LINE
if (!check(p, TOK_INPUT)) {
error(p, "Expected INPUT after LINE");
return;
}
advance(p); // consume INPUT
// Must have # for file I/O
if (!match(p, TOK_HASH)) {
error(p, "Expected # for file channel in LINE INPUT");
return;
}
// Channel expression
parseExpression(p);
// Comma separator
expect(p, TOK_COMMA);
// Target variable
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char varName[BAS_MAX_TOKEN_LEN];
strncpy(varName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
varName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
basEmit8(&p->cg, OP_FILE_LINE_INPUT);
BasSymbolT *sym = ensureVariable(p, varName);
if (sym != NULL) {
emitStore(p, sym);
}
}
static void parseMkDir(BasParserT *p) {
// MKDIR path
advance(p);
parseExpression(p);
basEmit8(&p->cg, OP_FS_MKDIR);
}
static void parseModule(BasParserT *p) {
// VB semantics: all SUB/FUNCTION declarations are visible from
// anywhere in the module regardless of source order. Do a
// pre-scan that walks the token stream, extracts every
// SUB/FUNCTION signature, and registers it in the symbol table.
// Call sites encountered later (including module-level code
// that precedes the SUB definition in source) can then validate
// argument count / types against the real signature instead of
// falling back to a paramCount=0 placeholder.
prescanSignatures(p);
skipNewlines(p);
while (!p->hasError && !check(p, TOK_EOF)) {
parseStatement(p);
skipNewlines(p);
}
// Check for unresolved forward references (skip externs from DECLARE LIBRARY)
if (!p->hasError) {
for (int32_t i = 0; i < p->sym.count; i++) {
BasSymbolT *sym = p->sym.symbols[i];
if ((sym->kind == SYM_SUB || sym->kind == SYM_FUNCTION) && !sym->isDefined && !sym->isExtern) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Undefined %s: %s",
sym->kind == SYM_SUB ? "Sub" : "Function", sym->name);
error(p, buf);
break;
}
}
}
// End of module -- emit HALT
basEmit8(&p->cg, OP_HALT);
}
// QuickBASIC precedence (high to low): ^, unary -, (* /), \, MOD, +, -.
// The multiplicative operators occupy THREE distinct levels, so the chain is
// parseAddExpr -> parseMulExpr (MOD) -> parseIdivExpr (\) ->
// parseMulDivExpr (* /) -> parseUnaryExpr -> parsePowExpr -> parsePrimary.
// This makes 8 MOD 3 * 2 == 2 and 10 \ 2 * 3 == 1 (matching QB), and keeps
// -2^2 = -(2^2) = -4.
static void parseMulDivExpr(BasParserT *p) {
parseUnaryExpr(p);
while (!p->hasError) {
if (check(p, TOK_STAR)) {
advance(p);
parseUnaryExpr(p);
basEmit8(&p->cg, OP_MUL_INT);
} else if (check(p, TOK_SLASH)) {
advance(p);
parseUnaryExpr(p);
basEmit8(&p->cg, OP_DIV_FLT);
} else {
break;
}
}
}
static void parseMulExpr(BasParserT *p) {
parseIdivExpr(p);
while (!p->hasError && check(p, TOK_MOD)) {
advance(p);
parseIdivExpr(p);
basEmit8(&p->cg, OP_MOD_INT);
}
}
static void parseName(BasParserT *p) {
// NAME oldname AS newname
advance(p);
parseExpression(p);
expect(p, TOK_AS);
parseExpression(p);
basEmit8(&p->cg, OP_FS_NAME);
}
static void parseNotExpr(BasParserT *p) {
if (check(p, TOK_NOT)) {
advance(p);
if (!exprEnter(p)) {
return;
}
parseNotExpr(p);
exprLeave(p);
basEmit8(&p->cg, OP_NOT);
return;
}
parseCompareExpr(p);
}
static void parseOn(BasParserT *p) {
// ON ERROR GOTO label -- error handler
// ON expr GOTO label1, label2, ... -- computed goto
// ON expr GOSUB label1, label2, ... -- computed gosub
advance(p); // consume ON
// ON ERROR GOTO is a special form
if (check(p, TOK_ERROR_KW)) {
parseOnError(p);
return;
}
// ON expr GOTO/GOSUB label1, label2, ...
parseExpression(p);
bool isGosub;
if (check(p, TOK_GOTO)) {
isGosub = false;
advance(p);
} else if (check(p, TOK_GOSUB)) {
isGosub = true;
advance(p);
} else {
error(p, "Expected GOTO or GOSUB after ON expression");
return;
}
// Track end-of-gosub jumps for patching (stb_ds dynamic array)
int32_t *endJumps = NULL;
int32_t labelIdx = 1;
for (;;) {
if (p->hasError) {
arrfree(endJumps);
return;
}
if (!check(p, TOK_IDENT)) {
errorExpected(p, "label name");
arrfree(endJumps);
return;
}
char labelName[BAS_MAX_TOKEN_LEN];
strncpy(labelName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
labelName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// DUP the selector
basEmit8(&p->cg, OP_DUP);
// PUSH the 1-based index
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)labelIdx);
// Compare
basEmit8(&p->cg, OP_CMP_EQ);
// JMP_FALSE to skip this branch
int32_t skipAddr = emitJump(p, OP_JMP_FALSE);
// Match: POP the selector value
basEmit8(&p->cg, OP_POP);
if (isGosub) {
// Push return PC before jumping
int32_t pushPos = basCodePos(&p->cg);
basEmit8(&p->cg, OP_PUSH_INT32);
basEmit16(&p->cg, 0); // placeholder lo
basEmit16(&p->cg, 0); // placeholder hi
emitJumpToLabel(p, OP_JMP, labelName);
// Backpatch the return address
int32_t returnPc = basCodePos(&p->cg);
int16_t lo = (int16_t)(returnPc & 0xFFFF);
int16_t hi = (int16_t)((returnPc >> 16) & 0xFFFF);
basPatch16(&p->cg, pushPos + 1, lo);
basPatch16(&p->cg, pushPos + 3, hi);
// After GOSUB returns, jump to end of ON...GOSUB
arrput(endJumps, emitJump(p, OP_JMP));
} else {
// GOTO: jump to the label, discarding the live test values
// of any SELECT CASE blocks being left (same as plain GOTO).
emitGotoWithSelectPops(p, labelName);
}
// Patch the skip (no-match continues to next branch)
patchJump(p, skipAddr);
labelIdx++;
if (!match(p, TOK_COMMA)) {
break;
}
}
// No match: POP the selector and fall through
basEmit8(&p->cg, OP_POP);
// Patch all end-of-gosub jumps to here
int32_t endTarget = basCodePos(&p->cg);
int32_t n = (int32_t)arrlen(endJumps);
for (int32_t i = 0; i < n; i++) {
int16_t offset = relJumpOffset(p, endTarget, endJumps[i]);
basPatch16(&p->cg, endJumps[i], offset);
}
arrfree(endJumps);
}
static void parseOnError(BasParserT *p) {
// ON ERROR GOTO label
// ON ERROR GOTO 0 (disable)
// Note: ON and ERROR already consumed by parseOn dispatcher
advance(p); // consume ERROR
if (!check(p, TOK_GOTO)) {
error(p, "Expected GOTO after ON ERROR");
return;
}
advance(p); // consume GOTO
// ON ERROR GOTO 0 -- disable error handler
if (check(p, TOK_INT_LIT) && p->lex.token.intVal == 0) {
advance(p);
basEmit8(&p->cg, OP_ON_ERROR);
basEmit16(&p->cg, 0);
return;
}
// ON ERROR GOTO label
if (!check(p, TOK_IDENT)) {
errorExpected(p, "label name or 0");
return;
}
char labelName[BAS_MAX_TOKEN_LEN];
strncpy(labelName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
labelName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// Look up the label
BasSymbolT *sym = basSymTabFind(&p->sym, labelName);
if (sym != NULL && sym->kind == SYM_LABEL && sym->isDefined) {
// Label already defined -- emit ON_ERROR with offset to handler
basEmit8(&p->cg, OP_ON_ERROR);
int32_t here = basCodePos(&p->cg);
int16_t offset = relJumpOffset(p, sym->codeAddr, here);
basEmit16(&p->cg, offset);
} else {
// Forward reference
if (sym == NULL) {
sym = basSymTabAdd(&p->sym, labelName, SYM_LABEL, 0);
if (sym == NULL) {
error(p, "Symbol table full");
return;
}
sym->scope = SCOPE_GLOBAL;
sym->isDefined = false;
sym->codeAddr = 0;
}
basEmit8(&p->cg, OP_ON_ERROR);
int32_t patchAddr = basCodePos(&p->cg);
basEmit16(&p->cg, 0);
arrput(sym->patchAddrs, patchAddr);
sym->patchCount = (int32_t)arrlen(sym->patchAddrs);
}
}
static void parseOpen(BasParserT *p) {
// OPEN filename FOR mode AS #channel
advance(p); // consume OPEN
// Filename expression
parseExpression(p);
// FOR keyword
expect(p, TOK_FOR);
// Mode: INPUT, OUTPUT, APPEND
uint8_t mode;
if (check(p, TOK_INPUT)) {
mode = BAS_FILE_MODE_INPUT;
advance(p);
} else if (check(p, TOK_OUTPUT)) {
mode = BAS_FILE_MODE_OUTPUT;
advance(p);
} else if (check(p, TOK_APPEND)) {
mode = BAS_FILE_MODE_APPEND;
advance(p);
} else if (check(p, TOK_RANDOM)) {
mode = BAS_FILE_MODE_RANDOM;
advance(p);
} else if (check(p, TOK_BINARY)) {
mode = BAS_FILE_MODE_BINARY;
advance(p);
} else {
error(p, "Expected INPUT, OUTPUT, APPEND, RANDOM, or BINARY after FOR");
return;
}
// AS keyword
expect(p, TOK_AS);
// Optional # prefix
match(p, TOK_HASH);
// Channel number expression
parseExpression(p);
// Optional LEN = recordsize: the RANDOM-mode record length used by
// GET/PUT record numbers. Defaults when omitted.
if (checkKeyword(p, "LEN")) {
advance(p); // consume LEN
expect(p, TOK_EQ);
parseExpression(p);
} else {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, BAS_VM_RANDOM_RECORD_SIZE);
}
// Emit: stack has [filename, channel, recLen] -- OP_FILE_OPEN reads mode byte
basEmit8(&p->cg, OP_FILE_OPEN);
basEmit8(&p->cg, mode);
}
static void parseOption(BasParserT *p) {
// OPTION BASE 0 | OPTION BASE 1
// OPTION COMPARE BINARY | OPTION COMPARE TEXT
advance(p); // consume OPTION
if (check(p, TOK_BASE)) {
advance(p); // consume BASE
if (!check(p, TOK_INT_LIT)) {
error(p, "Expected 0 or 1 after OPTION BASE");
return;
}
int32_t base = p->lex.token.intVal;
if (base != 0 && base != 1) {
error(p, "OPTION BASE must be 0 or 1");
return;
}
p->optionBase = base;
advance(p);
return;
}
if (checkKeyword(p, "COMPARE")) {
advance(p); // consume COMPARE
if (check(p, TOK_BINARY)) {
advance(p);
basEmit8(&p->cg, OP_COMPARE_MODE);
basEmit8(&p->cg, BAS_COMPARE_MODE_BINARY);
} else if (checkKeyword(p, "TEXT")) {
advance(p);
basEmit8(&p->cg, OP_COMPARE_MODE);
basEmit8(&p->cg, BAS_COMPARE_MODE_TEXT);
} else {
error(p, "Expected BINARY or TEXT after OPTION COMPARE");
}
return;
}
if (check(p, TOK_EXPLICIT)) {
advance(p);
p->optionExplicit = true;
return;
}
error(p, "Expected BASE, COMPARE, or EXPLICIT after OPTION");
}
static void parseOrExpr(BasParserT *p) {
parseXorExpr(p);
while (!p->hasError && check(p, TOK_OR)) {
advance(p);
parseXorExpr(p);
basEmit8(&p->cg, OP_OR);
}
}
// Parse an optional "(param, ...)" list for any SUB/FUNCTION
// declaration form. Each parameter is [OPTIONAL] [BYVAL] name [AS type].
// With PARAM_REGISTER the parameters are also added as SCOPE_LOCAL
// variables in slot order (the caller has already entered local scope).
// Returns false with an error set on any problem.
static bool parseParamList(BasParserT *p, ParamListT *pl, uint32_t flags) {
memset(pl, 0, sizeof(*pl));
if (!match(p, TOK_LPAREN)) {
return !p->hasError;
}
bool seenOptional = false;
while (!check(p, TOK_RPAREN) && !check(p, TOK_EOF) && !p->hasError) {
if (pl->count > 0) {
expect(p, TOK_COMMA);
}
bool optional = match(p, TOK_OPTIONAL);
if (optional) {
seenOptional = true;
} else if (seenOptional) {
error(p, "Required parameter cannot follow Optional parameter");
return false;
}
bool byVal = match(p, TOK_BYVAL) || (flags & PARAM_FORCE_BYVAL) != 0;
if (!check(p, TOK_IDENT)) {
errorExpected(p, "parameter name");
return false;
}
if (clampParamCount(p, pl->count)) {
return false;
}
char paramName[BAS_MAX_TOKEN_LEN];
strncpy(paramName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
paramName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
uint8_t pdt = suffixToType(paramName);
bool pTyped = nameHasTypeSuffix(paramName);
int32_t pUdtTypeId = -1;
if (match(p, TOK_AS)) {
pdt = resolveParamType(p, (flags & PARAM_PRESCAN) != 0, &pUdtTypeId);
pTyped = true;
}
if (p->hasError) {
return false;
}
if (flags & PARAM_REGISTER) {
BasSymbolT *paramSym = basSymTabAdd(&p->sym, paramName, SYM_VARIABLE, pdt);
if (paramSym == NULL) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Duplicate parameter name '%s'", paramName);
error(p, buf);
return false;
}
paramSym->scope = SCOPE_LOCAL;
paramSym->index = basSymTabAllocSlot(&p->sym);
paramSym->isDefined = true;
paramSym->udtTypeId = pUdtTypeId;
paramSym->isTyped = pTyped;
}
pl->types[pl->count] = pdt;
pl->byVal[pl->count] = byVal;
pl->optional[pl->count] = optional;
if (!optional) {
pl->required = pl->count + 1;
}
pl->count++;
}
expect(p, TOK_RPAREN);
return !p->hasError;
}
static void parsePowExpr(BasParserT *p) {
parsePrimary(p);
while (!p->hasError && check(p, TOK_CARET)) {
advance(p);
// The exponent operand may carry a leading sign (QB: 2 ^ -3 == 0.125).
// A leading sign on the BASE is handled higher up by parseUnaryExpr,
// so only the RHS needs parsePowOperand.
parsePowOperand(p);
basEmit8(&p->cg, OP_POW);
}
}
static void parsePowOperand(BasParserT *p) {
if (check(p, TOK_MINUS) || check(p, TOK_PLUS)) {
bool negate = check(p, TOK_MINUS);
advance(p); // unary plus is a no-op
if (!exprEnter(p)) {
return;
}
parsePowOperand(p);
exprLeave(p);
if (negate) {
basEmit8(&p->cg, OP_NEG_INT);
}
return;
}
parsePrimary(p);
}
static void parsePrimary(BasParserT *p) {
if (p->hasError) {
return;
}
BasTokenTypeE tt = p->lex.token.type;
// App.Path / App.Config / App.Data
if (tt == TOK_APP) {
advance(p);
expect(p, TOK_DOT);
if (checkKeyword(p,"Path")) {
advance(p);
basEmit8(&p->cg, OP_APP_PATH);
} else if (checkKeyword(p,"Config")) {
advance(p);
basEmit8(&p->cg, OP_APP_CONFIG);
} else if (checkKeyword(p,"Data") || p->lex.token.type == TOK_DATA) {
// "Data" tokenizes as TOK_DATA (the DATA/READ keyword) rather
// than TOK_IDENT, so accept it directly by token type too.
advance(p);
basEmit8(&p->cg, OP_APP_DATA);
} else {
error(p, "Expected 'Path', 'Config', or 'Data' after 'App.'");
}
return;
}
// Integer literal
if (tt == TOK_INT_LIT) {
int32_t val = p->lex.token.intVal;
if (val >= INT16_MIN && val <= INT16_MAX) {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)val);
} else {
basEmit8(&p->cg, OP_PUSH_INT32);
basEmit16(&p->cg, (int16_t)(val & 0xFFFF));
basEmit16(&p->cg, (int16_t)(((uint32_t)val >> 16) & 0xFFFF));
}
advance(p);
return;
}
// Long literal
if (tt == TOK_LONG_LIT) {
int32_t val = (int32_t)p->lex.token.longVal;
basEmit8(&p->cg, OP_PUSH_INT32);
basEmit16(&p->cg, (int16_t)(val & 0xFFFF));
basEmit16(&p->cg, (int16_t)((val >> 16) & 0xFFFF));
advance(p);
return;
}
// Float literal
if (tt == TOK_FLOAT_LIT) {
basEmit8(&p->cg, OP_PUSH_FLT64);
basEmitDouble(&p->cg, p->lex.token.dblVal);
advance(p);
return;
}
// String literal
if (tt == TOK_STRING_LIT) {
uint16_t idx = basAddConstant(&p->cg, p->lex.token.text, p->lex.token.textLen);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, idx);
advance(p);
return;
}
// Boolean literals
if (tt == TOK_TRUE_KW) {
basEmit8(&p->cg, OP_PUSH_TRUE);
advance(p);
return;
}
if (tt == TOK_FALSE_KW) {
basEmit8(&p->cg, OP_PUSH_FALSE);
advance(p);
return;
}
// Me -- reference to current form
if (tt == TOK_ME) {
advance(p);
basEmit8(&p->cg, OP_ME_REF);
return;
}
// Nothing -- null object reference
if (tt == TOK_NOTHING) {
advance(p);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0);
return;
}
// CreateForm(name$, width%, height%) -- create a form in code
if (tt == TOK_CREATEFORM) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p); // name
expect(p, TOK_COMMA);
parseExpression(p); // width
expect(p, TOK_COMMA);
parseExpression(p); // height
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_CREATE_FORM);
return;
}
// CreateControl(form, typeName$, ctrlName$ [, parent]) -- create a control
if (tt == TOK_CREATECONTROL) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p); // form ref
expect(p, TOK_COMMA);
parseExpression(p); // type name
expect(p, TOK_COMMA);
parseExpression(p); // control name
if (match(p, TOK_COMMA)) {
// Optional parent parameter
parseExpression(p); // parent ctrl ref
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_CREATE_CTRL_EX);
} else {
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_CREATE_CTRL);
}
return;
}
// EOF(#channel) -- file end-of-file test
if (tt == TOK_EOF_KW) {
advance(p);
expect(p, TOK_LPAREN);
match(p, TOK_HASH); // optional #
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FILE_EOF);
return;
}
// SEEK(n) -- return current file position (function form)
if (tt == TOK_SEEK) {
advance(p);
if (check(p, TOK_LPAREN)) {
expect(p, TOK_LPAREN);
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FILE_LOC);
return;
}
// Not a function call -- error (SEEK as statement is handled elsewhere)
error(p, "SEEK requires parentheses when used as a function");
return;
}
// TIMER -- seconds since midnight (no args needed)
if (tt == TOK_TIMER) {
advance(p);
basEmit8(&p->cg, OP_MATH_TIMER);
return;
}
// ERR -- current error number
if (tt == TOK_ERR) {
advance(p);
basEmit8(&p->cg, OP_ERR_NUM);
return;
}
// CurDir$ -- current directory (no args)
if (tt == TOK_CURDIR) {
advance(p);
if (check(p, TOK_LPAREN)) {
expect(p, TOK_LPAREN);
expect(p, TOK_RPAREN);
}
basEmit8(&p->cg, OP_FS_CURDIR);
return;
}
// Dir$(pattern) or Dir$() for next match
if (tt == TOK_DIR) {
advance(p);
if (check(p, TOK_LPAREN)) {
expect(p, TOK_LPAREN);
if (check(p, TOK_RPAREN)) {
// Dir$() -- no args, get next match
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FS_DIR_NEXT);
} else {
// Dir$(pattern)
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FS_DIR);
}
} else {
// Dir with no parens -- next match
basEmit8(&p->cg, OP_FS_DIR_NEXT);
}
return;
}
// FileLen(filename) -- file size without opening
if (tt == TOK_FILELEN) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FS_FILELEN);
return;
}
// GetAttr(filename) -- file attributes
if (tt == TOK_GETATTR) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FS_GETATTR);
return;
}
// InputBox$(prompt [, title [, default]])
if (tt == TOK_INPUTBOX) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p); // prompt
if (match(p, TOK_COMMA)) {
parseExpression(p); // title
} else {
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, basAddConstant(&p->cg, "", 0));
}
if (match(p, TOK_COMMA)) {
parseExpression(p); // default
} else {
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, basAddConstant(&p->cg, "", 0));
}
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_INPUTBOX);
return;
}
// MsgBox(message [, flags [, title]]) -- function form returning button ID
if (tt == TOK_MSGBOX) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p); // message
if (match(p, TOK_COMMA)) {
parseExpression(p); // flags
} else {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0); // default flags = vbOKOnly
}
if (match(p, TOK_COMMA)) {
parseExpression(p); // title
} else {
uint16_t emptyIdx = basAddConstant(&p->cg, "", 0);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, emptyIdx);
}
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_MSGBOX);
return;
}
// IniRead$(file, section, key, default)
if (tt == TOK_INIREAD) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p); // file
expect(p, TOK_COMMA);
parseExpression(p); // section
expect(p, TOK_COMMA);
parseExpression(p); // key
expect(p, TOK_COMMA);
parseExpression(p); // default
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_INI_READ);
return;
}
// SHELL("command") -- as function expression
if (tt == TOK_SHELL) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_SHELL);
return;
}
// LBOUND(array [, dim])
if (tt == TOK_LBOUND) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p);
uint8_t dim = 1;
if (match(p, TOK_COMMA)) {
if (check(p, TOK_INT_LIT)) {
dim = (uint8_t)p->lex.token.intVal;
advance(p);
} else {
error(p, "LBOUND dimension must be a constant integer");
}
}
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_LBOUND);
basEmit8(&p->cg, dim);
return;
}
// UBOUND(array [, dim])
if (tt == TOK_UBOUND) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p);
uint8_t dim = 1;
if (match(p, TOK_COMMA)) {
if (check(p, TOK_INT_LIT)) {
dim = (uint8_t)p->lex.token.intVal;
advance(p);
} else {
error(p, "UBOUND dimension must be a constant integer");
}
}
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_UBOUND);
basEmit8(&p->cg, dim);
return;
}
// Parenthesized expression
if (tt == TOK_LPAREN) {
advance(p);
parseExpression(p);
expect(p, TOK_RPAREN);
return;
}
// Identifier: variable, function call, or built-in
if (tt == TOK_IDENT) {
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// INPUT$(n, #channel) -- special handling for optional # in second arg
if (strcasecmp(name, "INPUT$") == 0 && check(p, TOK_LPAREN)) {
expect(p, TOK_LPAREN);
parseExpression(p); // n (number of chars)
expect(p, TOK_COMMA);
match(p, TOK_HASH); // optional #
parseExpression(p); // channel number
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FILE_INPUT_N);
return;
}
// Check for built-in function
const BuiltinFuncT *builtin = findBuiltin(name);
if (builtin != NULL) {
int32_t argc = 0;
// Zero-arg builtins can be used without parens
if (builtin->minArgs == 0 && builtin->maxArgs == 0 && !check(p, TOK_LPAREN)) {
basEmit8(&p->cg, builtin->opcode);
return;
}
if (check(p, TOK_LPAREN)) {
expect(p, TOK_LPAREN);
// RND/zero-arg builtins can be called with empty parens
if (!check(p, TOK_RPAREN)) {
parseExpression(p);
argc++;
while (match(p, TOK_COMMA)) {
parseExpression(p);
argc++;
}
}
expect(p, TOK_RPAREN);
}
if (p->hasError) {
return;
}
if (argc < builtin->minArgs || argc > builtin->maxArgs) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Built-in '%s' expects %d-%d arguments, got %d", builtin->name, (int)builtin->minArgs, (int)builtin->maxArgs, (int)argc);
error(p, buf);
return;
}
// MID$ with 3 args uses a different opcode than 2 args
if (builtin->opcode == OP_STR_MID2 && argc == 3) {
basEmit8(&p->cg, OP_STR_MID);
} else if (builtin->opcode == OP_STR_INSTR && argc == 3) {
basEmit8(&p->cg, OP_STR_INSTR3);
} else if (builtin->opcode == OP_MATH_RND && argc == 0) {
// Push -1 as dummy arg for RND()
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, -1);
basEmit8(&p->cg, OP_MATH_RND);
} else {
basEmit8(&p->cg, builtin->opcode);
}
return;
}
// Check symbol table for user-defined function or variable
BasSymbolT *sym = basSymTabFind(&p->sym, name);
// Function call with parens
if (check(p, TOK_LPAREN)) {
if (sym != NULL && (sym->kind == SYM_FUNCTION || sym->kind == SYM_SUB)) {
emitFunctionCall(p, sym);
return;
}
// Could be an array access -- treat as load + array index
if (sym != NULL && sym->isArray) {
emitLoad(p, sym);
expect(p, TOK_LPAREN);
int32_t dims = 0;
parseExpression(p);
dims++;
while (match(p, TOK_COMMA)) {
parseExpression(p);
dims++;
}
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_LOAD_ARRAY);
basEmit8(&p->cg, (uint8_t)dims);
// Array-of-UDT field access: arr(i).field
if (sym->dataType == BAS_TYPE_UDT && sym->udtTypeId >= 0 && check(p, TOK_DOT)) {
advance(p); // consume DOT
if (!check(p, TOK_IDENT)) {
errorExpected(p, "field name");
return;
}
BasSymbolT *typeSym = findTypeDefById(p, sym->udtTypeId);
if (typeSym == NULL) {
error(p, "Unknown TYPE definition");
return;
}
int32_t fieldIdx = resolveFieldIndex(typeSym, p->lex.token.text);
if (fieldIdx < 0) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Unknown field '%s' in TYPE '%s'", p->lex.token.text, typeSym->name);
error(p, buf);
return;
}
advance(p); // consume field name
basEmit8(&p->cg, OP_LOAD_FIELD);
basEmitU16(&p->cg, (uint16_t)fieldIdx);
}
return;
}
// Unknown identifier + '(' -- could be forward-ref function or
// control array access: Name(index).Property
if (sym == NULL) {
if (checkCtrlArrayAccess(p)) {
// Control array read: Name(idx).Property
expect(p, TOK_LPAREN);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0); // NULL form ref = current form
uint16_t ctrlNameIdx = basAddConstant(&p->cg, name, (int32_t)strlen(name));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, ctrlNameIdx);
parseExpression(p); // index expression
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FIND_CTRL_IDX);
expect(p, TOK_DOT);
if (!check(p, TOK_IDENT)) {
errorExpected(p, "property name");
return;
}
char memberName[BAS_MAX_TOKEN_LEN];
strncpy(memberName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
memberName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
uint16_t propNameIdx = basAddConstant(&p->cg, memberName, (int32_t)strlen(memberName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, propNameIdx);
basEmit8(&p->cg, OP_LOAD_PROP);
return;
}
// Not a control array -- forward-ref function call
sym = basSymTabAdd(&p->sym, name, SYM_FUNCTION, suffixToType(name));
if (sym == NULL) {
error(p, "Symbol table full");
return;
}
sym->scope = SCOPE_GLOBAL;
sym->isDefined = false;
sym->codeAddr = 0;
}
emitFunctionCall(p, sym);
return;
}
// Check for dot access: UDT field or control property
if (check(p, TOK_DOT)) {
// If we already know this is a UDT variable, do field access
sym = basSymTabFind(&p->sym, name);
if (sym != NULL && sym->dataType == BAS_TYPE_UDT && sym->udtTypeId >= 0) {
emitLoad(p, sym);
int32_t curTypeId = sym->udtTypeId;
// Loop to handle nested UDT field access: a.b.c
while (check(p, TOK_DOT) && curTypeId >= 0) {
advance(p); // consume DOT
if (!check(p, TOK_IDENT)) {
errorExpected(p, "field name");
return;
}
BasSymbolT *typeSym = findTypeDefById(p, curTypeId);
if (typeSym == NULL) {
error(p, "Unknown TYPE definition");
return;
}
int32_t fieldIdx = resolveFieldIndex(typeSym, p->lex.token.text);
if (fieldIdx < 0) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Unknown field '%s' in TYPE '%s'", p->lex.token.text, typeSym->name);
error(p, buf);
return;
}
advance(p); // consume field name
basEmit8(&p->cg, OP_LOAD_FIELD);
basEmitU16(&p->cg, (uint16_t)fieldIdx);
// If this field is also a UDT, allow further dot access
if (typeSym->fields[fieldIdx].dataType == BAS_TYPE_UDT) {
curTypeId = typeSym->fields[fieldIdx].udtTypeId;
} else {
curTypeId = -1;
}
}
return;
}
// Not a UDT -- treat as control property/method: CtrlName.Member
advance(p); // consume DOT
if (!isalpha((unsigned char)p->lex.token.text[0]) && p->lex.token.text[0] != '_') {
errorExpected(p, "property or method name");
return;
}
char memberName[BAS_MAX_TOKEN_LEN];
strncpy(memberName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
memberName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
bool isVarRef2 = (sym != NULL && sym->kind == SYM_VARIABLE);
// Compile-time validation for expression-context reads /
// method returns. Peek ahead: if '(' follows, memberName
// is a method; otherwise it's a property read. Skip when
// the host didn't attach a validator or the ctrl is dynamic.
if (!isVarRef2 && p->validator && p->validator->lookupCtrlType) {
const char *wgtType = p->validator->lookupCtrlType(p->validator->ctx, name);
if (wgtType) {
bool isMethodCall = check(p, TOK_LPAREN);
bool valid = true;
if (isMethodCall && p->validator->isMethodValid) {
valid = p->validator->isMethodValid(p->validator->ctx, wgtType, memberName);
} else if (!isMethodCall && p->validator->isPropValid) {
valid = p->validator->isPropValid(p->validator->ctx, wgtType, memberName);
}
if (!valid) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Unknown %s '%s.%s' (type '%s' has no such %s)",
isMethodCall ? "method" : "property",
name, memberName, wgtType,
isMethodCall ? "method" : "property");
error(p, buf);
return;
}
}
}
// If `name` is a regular variable holding an object reference
// (form/control returned by CreateForm/CreateControl), use its
// value directly instead of treating `name` as a literal name.
if (isVarRef2) {
emitLoad(p, sym);
} else {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0);
uint16_t ctrlNameIdx = basAddConstant(&p->cg, name, (int32_t)strlen(name));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, ctrlNameIdx);
basEmit8(&p->cg, OP_FIND_CTRL);
}
// If followed by '(', this is a method call with args
if (check(p, TOK_LPAREN)) {
advance(p); // consume '('
uint16_t methodNameIdx = basAddConstant(&p->cg, memberName, (int32_t)strlen(memberName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, methodNameIdx);
int32_t argc = 0;
if (!check(p, TOK_RPAREN)) {
parseExpression(p);
argc++;
while (match(p, TOK_COMMA)) {
parseExpression(p);
argc++;
}
}
expect(p, TOK_RPAREN);
if (clampArgCount(p, argc)) {
return;
}
basEmit8(&p->cg, OP_CALL_METHOD);
basEmit8(&p->cg, (uint8_t)argc);
} else {
// Property read
uint16_t propNameIdx = basAddConstant(&p->cg, memberName, (int32_t)strlen(memberName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, propNameIdx);
basEmit8(&p->cg, OP_LOAD_PROP);
}
return;
}
// A FUNCTION named without an argument list is a call with no
// arguments (QB allows "x = f" for a parameterless FUNCTION).
if (sym != NULL && sym->kind == SYM_FUNCTION) {
emitCallWithArgs(p, sym, 0);
return;
}
// Plain variable reference
sym = ensureVariable(p, name);
if (sym != NULL) {
emitLoad(p, sym);
}
return;
}
// Nothing matched
errorExpected(p, "expression");
}
static void parsePrint(BasParserT *p) {
// PRINT [#channel, expr]
// PRINT [expr] [; expr] [, expr] [;]
// PRINT USING "fmt"; expr [; expr] ...
advance(p); // consume PRINT
// File I/O: PRINT #channel, expr [; expr | , expr ]* [;]
//
// Channel is pushed once and DUP'd per value. `;` means no separator
// between values; `,` is treated the same (tab-zone separator not
// supported for file output). Trailing `;` suppresses the final newline.
if (check(p, TOK_HASH)) {
advance(p); // consume #
// Channel number -- stays on stack as "keep" for the whole statement.
parseExpression(p);
expect(p, TOK_COMMA);
bool trailingSep = false;
for (;;) {
// Bail on error: parseExpression leaves the token frozen, and
// a stuck ';'/',' would otherwise re-satisfy the separator
// check below and spin (advance() is a no-op under error).
if (p->hasError) {
break;
}
// Duplicate the channel for this OP_FILE_PRINT.
basEmit8(&p->cg, OP_DUP);
parseExpression(p);
basEmit8(&p->cg, OP_FILE_PRINT);
if (check(p, TOK_SEMICOLON) || check(p, TOK_COMMA)) {
advance(p);
trailingSep = true;
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_COLON) || check(p, TOK_ELSE)) {
break;
}
trailingSep = false;
continue;
}
break;
}
// No trailing ; or , -> write newline. Otherwise, just drop the
// kept channel value.
if (trailingSep) {
basEmit8(&p->cg, OP_POP);
} else {
basEmit8(&p->cg, OP_FILE_WRITE_NL);
}
return;
}
// Check for PRINT USING
if (checkKeyword(p, "USING")) {
advance(p); // consume USING
// Parse format string expression
parseExpression(p);
// Semicolon separates format from values
expect(p, TOK_SEMICOLON);
// Parse values, each one gets formatted with PRINT_USING
for (;;) {
// Bail on error: a stuck ';' would re-satisfy the separator
// check below and spin (advance() is a no-op under error).
if (p->hasError) {
break;
}
parseExpression(p);
basEmit8(&p->cg, OP_PRINT_USING);
basEmit8(&p->cg, OP_PRINT);
if (check(p, TOK_SEMICOLON)) {
advance(p);
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_COLON) || check(p, TOK_ELSE)) {
break;
}
continue;
}
break;
}
// The format string pushed at the top of this branch is re-pushed by
// each OP_PRINT_USING and left on the stack after the final OP_PRINT;
// pop it so PRINT USING doesn't leak one eval slot per execution.
basEmit8(&p->cg, OP_POP);
basEmit8(&p->cg, OP_PRINT_NL);
return;
}
bool trailingSemicolon = false;
// Empty PRINT = just newline
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_COLON) || check(p, TOK_ELSE)) {
basEmit8(&p->cg, OP_PRINT_NL);
return;
}
while (!p->hasError) {
trailingSemicolon = false;
if (check(p, TOK_SEMICOLON)) {
// Just a semicolon -- no space
trailingSemicolon = true;
advance(p);
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_COLON) || check(p, TOK_ELSE)) {
break;
}
continue;
}
if (check(p, TOK_COMMA)) {
// Comma -- print tab
basEmit8(&p->cg, OP_PRINT_TAB);
advance(p);
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_COLON) || check(p, TOK_ELSE)) {
trailingSemicolon = true; // comma at end suppresses newline too
break;
}
continue;
}
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_COLON) || check(p, TOK_ELSE)) {
break;
}
// Check for SPC(n) and TAB(n) inside PRINT
if (checkKeyword(p, "SPC")) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_PRINT_SPC_N);
continue;
}
if (checkKeyword(p, "TAB")) {
advance(p);
expect(p, TOK_LPAREN);
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_PRINT_TAB_N);
continue;
}
// Expression
parseExpression(p);
basEmit8(&p->cg, OP_PRINT);
}
// Print newline unless suppressed by trailing semicolon/comma
if (!trailingSemicolon) {
basEmit8(&p->cg, OP_PRINT_NL);
}
}
static void parsePut(BasParserT *p) {
// PUT #channel, [recno], var
advance(p); // consume PUT
match(p, TOK_HASH); // optional #
// Channel number
parseExpression(p);
expect(p, TOK_COMMA);
// Optional record number
if (check(p, TOK_COMMA)) {
// No record number specified -- push 0 (current position)
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0);
} else {
parseExpression(p);
}
expect(p, TOK_COMMA);
// Value expression
parseExpression(p);
basEmit8(&p->cg, OP_FILE_PUT);
}
static void parseRead(BasParserT *p) {
// READ var1, var2, ...
advance(p); // consume READ
for (;;) {
if (p->hasError) {
return;
}
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *sym = ensureVariable(p, name);
if (sym == NULL) {
return;
}
basEmit8(&p->cg, OP_READ_DATA);
emitStore(p, sym);
if (!match(p, TOK_COMMA)) {
break;
}
}
}
static void parseRedim(BasParserT *p) {
// REDIM [PRESERVE] var(bounds) [AS type]
advance(p); // consume REDIM
uint8_t preserve = 0;
if (check(p, TOK_PRESERVE)) {
preserve = 1;
advance(p);
}
if (!check(p, TOK_IDENT)) {
errorExpected(p, "array variable name");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// ensureVariable finds an existing symbol or auto-declares one; a
// SUB/FUNCTION/label/CONST of that name is not a REDIM target.
BasSymbolT *sym = ensureVariable(p, name);
if (sym == NULL) {
return;
}
if (sym->kind != SYM_VARIABLE) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "'%s' is not a variable", name);
error(p, buf);
return;
}
sym->isArray = true;
// Load the old array reference
emitLoad(p, sym);
// Parse new bounds
int32_t dims = 0;
expect(p, TOK_LPAREN);
parseDimBounds(p, &dims);
expect(p, TOK_RPAREN);
// Element type: the AS clause when given, else the variable's own
// declared type (a first REDIM adopts the AS type so later element
// and field accesses resolve against it).
uint8_t dt = sym->dataType;
int32_t udtTypeId = sym->udtTypeId;
if (match(p, TOK_AS)) {
dt = resolveTypeName(p);
udtTypeId = (dt == BAS_TYPE_UDT) ? p->lastUdtTypeId : -1;
sym->dataType = dt;
sym->udtTypeId = udtTypeId;
}
if (p->hasError) {
return;
}
// UDT element arrays carry typeId and fieldCount after the bounds,
// exactly as OP_DIM_ARRAY does, so REDIM can seed every element.
if (dt == BAS_TYPE_UDT) {
BasSymbolT *typeSym = (udtTypeId >= 0) ? findTypeDefById(p, udtTypeId) : NULL;
if (typeSym == NULL) {
error(p, "Unknown TYPE definition");
return;
}
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)udtTypeId);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, (int16_t)typeSym->fieldCount);
}
basEmit8(&p->cg, OP_REDIM);
basEmit8(&p->cg, (uint8_t)dims);
basEmit8(&p->cg, preserve);
basEmit8(&p->cg, dt);
emitStore(p, sym);
}
static void parseRemoveControl(BasParserT *p) {
// REMOVECONTROL formRef, ctrlName$
advance(p); // consume REMOVECONTROL
parseExpression(p); // form reference
expect(p, TOK_COMMA);
parseExpression(p); // control name string
basEmit8(&p->cg, OP_REMOVE_CTRL);
}
static void parseRestore(BasParserT *p) {
// RESTORE -- reset the DATA read pointer to the beginning
advance(p); // consume RESTORE
basEmit8(&p->cg, OP_RESTORE);
}
static void parseResume(BasParserT *p) {
// RESUME -- re-execute the statement that caused the error
// RESUME NEXT -- continue at the next statement after the error
advance(p); // consume RESUME
if (check(p, TOK_NEXT)) {
advance(p);
basEmit8(&p->cg, OP_RESUME_NEXT);
} else {
basEmit8(&p->cg, OP_RESUME);
}
}
static void parseRmDir(BasParserT *p) {
// RMDIR path
advance(p);
parseExpression(p);
basEmit8(&p->cg, OP_FS_RMDIR);
}
static void parseSeek(BasParserT *p) {
// SEEK #channel, position
advance(p); // consume SEEK
match(p, TOK_HASH); // optional #
// Channel number
parseExpression(p);
expect(p, TOK_COMMA);
// Position
parseExpression(p);
basEmit8(&p->cg, OP_FILE_SEEK);
}
static void parseSelectCase(BasParserT *p) {
// SELECT CASE expr
// CASE val [, val] ...
// ...
// [CASE ELSE]
// ...
// END SELECT
advance(p); // consume SELECT
expect(p, TOK_CASE);
// Evaluate the test expression -- stays on stack throughout
parseExpression(p);
// The test value is now live on the eval stack for the whole
// construct; track it so EXIT/GOTO can pop it on the way out.
p->selectDepth++;
expectEndOfStatement(p);
skipNewlines(p);
int32_t *endJumps = NULL; // stb_ds dynamic array
while (!p->hasError && !check(p, TOK_EOF)) {
// Check for END SELECT
if (check(p, TOK_END)) {
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_SELECT)) {
advance(p);
closeSelectCase(p, &endJumps);
return;
}
p->lex = savedLex;
}
if (!check(p, TOK_CASE)) {
error(p, "Expected CASE or END SELECT");
arrfree(endJumps);
p->selectDepth--;
return;
}
advance(p); // consume CASE
// CASE ELSE -- always matches, no comparison needed
if (check(p, TOK_ELSE)) {
advance(p);
expectEndOfStatement(p);
skipNewlines(p);
// Parse body until END SELECT
while (!p->hasError && !check(p, TOK_EOF)) {
if (check(p, TOK_END)) {
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_SELECT)) {
advance(p);
closeSelectCase(p, &endJumps);
return;
}
p->lex = savedLex;
}
parseStatement(p);
skipNewlines(p);
}
continue;
}
// CASE val [, val | val TO val | IS op val] ...
//
// Strategy for multi-value CASE using JMP_TRUE chaining:
// For each item:
// Plain value: DUP, push val, CMP_EQ, JMP_TRUE -> body
// Range (val TO val): DUP, push lo, CMP_GE, JMP_FALSE -> skip,
// DUP, push hi, CMP_LE, JMP_TRUE -> body, skip:
// IS op val: DUP, push val, CMP_xx, JMP_TRUE -> body
// JMP -> next_case (none of the items matched)
// body:
// ...statements...
// JMP -> end_select
// next_case:
int32_t *bodyJumps = NULL; // stb_ds dynamic array
for (;;) {
if (check(p, TOK_IS)) {
// CASE IS <op> value
advance(p); // consume IS
uint8_t cmpOp;
switch (p->lex.token.type) {
case TOK_LT:
cmpOp = OP_CMP_LT;
break;
case TOK_GT:
cmpOp = OP_CMP_GT;
break;
case TOK_LE:
cmpOp = OP_CMP_LE;
break;
case TOK_GE:
cmpOp = OP_CMP_GE;
break;
case TOK_EQ:
cmpOp = OP_CMP_EQ;
break;
case TOK_NE:
cmpOp = OP_CMP_NE;
break;
default:
error(p, "Expected comparison operator after IS");
arrfree(bodyJumps);
arrfree(endJumps);
p->selectDepth--;
return;
}
advance(p);
basEmit8(&p->cg, OP_DUP);
parseExpression(p);
basEmit8(&p->cg, cmpOp);
arrput(bodyJumps, emitJump(p, OP_JMP_TRUE));
} else {
// Parse first value -- could be plain or start of range
basEmit8(&p->cg, OP_DUP);
parseExpression(p);
if (check(p, TOK_TO)) {
// CASE low TO high
advance(p); // consume TO
// Stack: testval testval low
// Check testval >= low
basEmit8(&p->cg, OP_CMP_GE);
int32_t skipRange = emitJump(p, OP_JMP_FALSE);
// Check testval <= high
basEmit8(&p->cg, OP_DUP);
parseExpression(p);
basEmit8(&p->cg, OP_CMP_LE);
arrput(bodyJumps, emitJump(p, OP_JMP_TRUE));
patchJump(p, skipRange);
} else {
// Plain value -- equality test
basEmit8(&p->cg, OP_CMP_EQ);
arrput(bodyJumps, emitJump(p, OP_JMP_TRUE));
}
}
if (!match(p, TOK_COMMA)) {
break;
}
}
// None matched -- jump to next case
int32_t nextCaseJump = emitJump(p, OP_JMP);
// Patch all body jumps to here (start of body)
for (int32_t i = 0; i < (int32_t)arrlen(bodyJumps); i++) {
patchJump(p, bodyJumps[i]);
}
arrfree(bodyJumps);
// Parse the CASE body
expectEndOfStatement(p);
skipNewlines(p);
while (!p->hasError && !check(p, TOK_CASE) && !check(p, TOK_EOF)) {
if (check(p, TOK_END)) {
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_SELECT)) {
advance(p);
// Both the no-match fall-through (nextCaseJump) and
// earlier matched bodies (endJumps) land ON the pop.
patchJump(p, nextCaseJump);
closeSelectCase(p, &endJumps);
return;
}
p->lex = savedLex;
}
parseStatement(p);
skipNewlines(p);
}
// Jump to end of SELECT (skip remaining cases)
arrput(endJumps, emitJump(p, OP_JMP));
// Patch the next-case jump to here
patchJump(p, nextCaseJump);
}
// Reached if EOF hit without END SELECT -- patch pending end jumps
// and clean up. End jumps land on the pop, then fall through to it.
closeSelectCase(p, &endJumps);
if (!p->hasError) {
error(p, "Expected END SELECT");
}
}
static void parseSetAttr(BasParserT *p) {
// SETATTR filename, attributes
advance(p);
parseExpression(p);
expect(p, TOK_COMMA);
parseExpression(p);
basEmit8(&p->cg, OP_FS_SETATTR);
}
static void parseSetEvent(BasParserT *p) {
// SETEVENT ctrlRef, eventName$, handlerName$
advance(p); // consume SETEVENT
parseExpression(p); // control reference
expect(p, TOK_COMMA);
parseExpression(p); // event name string
expect(p, TOK_COMMA);
parseExpression(p); // handler name string
basEmit8(&p->cg, OP_SET_EVENT);
}
static void parseShell(BasParserT *p) {
// SHELL "command" -- execute an OS command (discard return value)
// SHELL -- no argument, no-op in embedded context
advance(p); // consume SHELL
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_COLON) || check(p, TOK_ELSE)) {
// No argument -- push empty string and call SHELL (no-op)
uint16_t idx = basAddConstant(&p->cg, "", 0);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, idx);
} else {
parseExpression(p);
}
basEmit8(&p->cg, OP_SHELL);
basEmit8(&p->cg, OP_POP); // discard return value in statement form
}
// Optional modal flag after form.Show / Me.Show: a literal, TRUE/FALSE
// or a CONST. OP_SHOW_FORM takes the flag as an immediate operand, so a
// variable cannot be accepted here.
static uint8_t parseShowModalFlag(BasParserT *p) {
uint8_t modal = 0;
if (check(p, TOK_INT_LIT)) {
modal = (p->lex.token.intVal != 0);
advance(p);
} else if (check(p, TOK_TRUE_KW)) {
modal = 1;
advance(p);
} else if (check(p, TOK_FALSE_KW)) {
advance(p);
} else if (check(p, TOK_IDENT)) {
BasSymbolT *modSym = basSymTabFind(&p->sym, p->lex.token.text);
if (modSym == NULL || modSym->kind != SYM_CONST) {
error(p, "Show modal flag must be a literal or CONST");
return 0;
}
modal = (modSym->constInt != 0);
advance(p);
}
return modal;
}
static void parseSleep(BasParserT *p) {
// SLEEP [seconds]
// If no argument, default to 1 second
advance(p); // consume SLEEP
if (check(p, TOK_NEWLINE) || check(p, TOK_EOF) || check(p, TOK_COLON) || check(p, TOK_ELSE)) {
// No argument -- push 1 second
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 1);
} else {
parseExpression(p);
}
basEmit8(&p->cg, OP_SLEEP);
}
static void parseStatement(BasParserT *p) {
if (p->hasError) {
return;
}
skipNewlines(p);
if (check(p, TOK_EOF)) {
return;
}
// Every nested block (IF/FOR/DO/SELECT/SUB body) recurses through
// here; bound the depth so a pathological input is an error, not a
// stack overflow.
if (p->blockDepth >= BAS_MAX_BLOCK_DEPTH) {
error(p, "Statements nested too deeply");
return;
}
p->blockDepth++;
// Emit source line number for debugger (before statement code)
basEmit8(&p->cg, OP_LINE);
basEmitU16(&p->cg, (uint16_t)p->lex.token.line);
// A label "Name:" consumes its own colon and may be followed by a
// statement on the same line, so it skips the end-of-statement check.
bool endOfStatement = true;
BasTokenTypeE tt = p->lex.token.type;
switch (tt) {
case TOK_PRINT:
parsePrint(p);
break;
case TOK_DIM:
parseDim(p);
break;
case TOK_DATA:
parseData(p);
break;
case TOK_READ:
parseRead(p);
break;
case TOK_RESTORE:
parseRestore(p);
break;
case TOK_STATIC:
parseStatic(p);
break;
case TOK_DEF:
parseDef(p);
break;
case TOK_DEFINT:
parseDefType(p, BAS_TYPE_INTEGER);
break;
case TOK_DEFLNG:
parseDefType(p, BAS_TYPE_LONG);
break;
case TOK_DEFSNG:
parseDefType(p, BAS_TYPE_SINGLE);
break;
case TOK_DEFDBL:
parseDefType(p, BAS_TYPE_DOUBLE);
break;
case TOK_DEFSTR:
parseDefType(p, BAS_TYPE_STRING);
break;
case TOK_DECLARE:
parseDeclare(p);
break;
case TOK_IF:
parseIf(p);
break;
case TOK_FOR:
parseFor(p);
break;
case TOK_DO:
parseDo(p);
break;
case TOK_WHILE:
parseWhile(p);
break;
case TOK_SELECT:
parseSelectCase(p);
break;
case TOK_SUB:
parseSub(p);
break;
case TOK_FUNCTION:
parseFunction(p);
break;
case TOK_EXIT:
parseExit(p);
break;
case TOK_CONST:
parseConst(p);
break;
case TOK_END:
parseEnd(p);
break;
case TOK_ERROR_KW:
// ERROR n -- raise a runtime error
advance(p);
parseExpression(p);
basEmit8(&p->cg, OP_RAISE_ERR);
break;
case TOK_ERASE:
parseErase(p);
break;
case TOK_TYPE:
parseType(p);
break;
case TOK_REDIM:
parseRedim(p);
break;
case TOK_FILECOPY:
parseFileCopy(p);
break;
case TOK_INPUT:
parseInput(p);
break;
case TOK_KILL:
parseKill(p);
break;
case TOK_MKDIR:
parseMkDir(p);
break;
case TOK_NAME:
parseName(p);
break;
case TOK_OPEN:
parseOpen(p);
break;
case TOK_CHDIR:
parseChDir(p);
break;
case TOK_CHDRIVE:
parseChDrive(p);
break;
case TOK_CLOSE:
parseClose(p);
break;
case TOK_GET:
parseGet(p);
break;
case TOK_PUT:
parsePut(p);
break;
case TOK_SEEK:
parseSeek(p);
break;
case TOK_WRITE:
parseWrite(p);
break;
case TOK_LINE:
parseLineInput(p);
break;
case TOK_GOTO:
parseGoto(p);
break;
case TOK_GOSUB:
parseGosub(p);
break;
case TOK_ON:
parseOn(p);
break;
case TOK_OPTION:
parseOption(p);
break;
case TOK_SHELL:
parseShell(p);
break;
case TOK_RESUME:
parseResume(p);
break;
case TOK_RMDIR:
parseRmDir(p);
break;
case TOK_SETATTR:
parseSetAttr(p);
break;
case TOK_RETURN:
advance(p);
if (p->sym.inLocalScope) {
// Inside SUB/FUNCTION: return from subroutine
basEmit8(&p->cg, OP_RET);
} else {
// Module level: GOSUB return (pop PC from eval stack).
// Any SELECT CASE opened since the handler's label still
// has its test value above the return address; discard
// those first or OP_GOSUB_RET would pop a test value.
emitSelectPops(p, p->selectDepth - p->lastLabelSelectDepth);
basEmit8(&p->cg, OP_GOSUB_RET);
}
break;
case TOK_SLEEP:
parseSleep(p);
break;
case TOK_SWAP:
parseSwap(p);
break;
case TOK_CALL: {
advance(p); // consume CALL
if (!check(p, TOK_IDENT)) {
errorExpected(p, "subroutine name");
break;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *sym = basSymTabFind(&p->sym, name);
if (sym == NULL) {
// Forward reference
sym = basSymTabAdd(&p->sym, name, SYM_SUB, BAS_TYPE_INTEGER);
if (sym == NULL) {
error(p, "Symbol table full");
break;
}
sym->scope = SCOPE_GLOBAL;
sym->isDefined = false;
sym->codeAddr = 0;
} else if (sym->kind != SYM_SUB && sym->kind != SYM_FUNCTION) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "'%s' is not a SUB or FUNCTION", sym->name);
error(p, buf);
break;
}
// CALL name(args) or bare CALL name (no arguments)
int32_t argc = 0;
if (check(p, TOK_LPAREN)) {
argc = parseCallArgs(p, sym, true);
}
emitCallWithArgs(p, sym, argc);
if (sym->kind == SYM_FUNCTION) {
basEmit8(&p->cg, OP_POP); // discard return value
}
break;
}
case TOK_RANDOMIZE:
advance(p);
if (check(p, TOK_TIMER)) {
advance(p);
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, BAS_RANDOMIZE_TIMER_SEED);
} else {
parseExpression(p);
}
basEmit8(&p->cg, OP_MATH_RANDOMIZE);
break;
case TOK_DOEVENTS:
advance(p);
basEmit8(&p->cg, OP_DO_EVENTS);
break;
case TOK_CREATEFORM:
// CreateForm used as statement (discard return value)
parsePrimary(p);
basEmit8(&p->cg, OP_POP);
break;
case TOK_CREATECONTROL:
// CreateControl used as statement (discard return value)
parsePrimary(p);
basEmit8(&p->cg, OP_POP);
break;
case TOK_SETEVENT:
parseSetEvent(p);
break;
case TOK_REMOVECONTROL:
parseRemoveControl(p);
break;
case TOK_SET:
// SET var = expr (object assignment)
advance(p); // consume SET
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
break;
}
{
char varName[BAS_MAX_TOKEN_LEN];
strncpy(varName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
varName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
expect(p, TOK_EQ);
parseExpression(p);
BasSymbolT *varSym = ensureVariable(p, varName);
if (varSym) {
varSym->dataType = BAS_TYPE_OBJECT;
emitStore(p, varSym);
}
}
break;
case TOK_LOAD:
// Load FormName (identifier, not string)
advance(p);
if (!check(p, TOK_IDENT)) {
errorExpected(p, "form name");
break;
}
{
uint16_t nameIdx = basAddConstant(&p->cg, p->lex.token.text, (int32_t)strlen(p->lex.token.text));
advance(p);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, nameIdx);
basEmit8(&p->cg, OP_LOAD_FORM);
basEmit8(&p->cg, OP_POP);
}
break;
case TOK_UNLOAD:
// Unload FormName (identifier, not string)
advance(p);
if (!check(p, TOK_IDENT)) {
errorExpected(p, "form name");
break;
}
{
uint16_t nameIdx = basAddConstant(&p->cg, p->lex.token.text, (int32_t)strlen(p->lex.token.text));
advance(p);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, nameIdx);
basEmit8(&p->cg, OP_LOAD_FORM);
basEmit8(&p->cg, OP_UNLOAD_FORM);
}
break;
case TOK_INPUTBOX:
// InputBox$ prompt [, title [, default]] (statement form, discard result)
advance(p);
parseExpression(p); // prompt
if (match(p, TOK_COMMA)) {
parseExpression(p); // title
} else {
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, basAddConstant(&p->cg, "", 0));
}
if (match(p, TOK_COMMA)) {
parseExpression(p); // default
} else {
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, basAddConstant(&p->cg, "", 0));
}
basEmit8(&p->cg, OP_INPUTBOX);
basEmit8(&p->cg, OP_POP); // discard result
break;
case TOK_MSGBOX: {
// MsgBox message [, flags [, title]] (statement form, discards result)
advance(p);
parseExpression(p); // message
if (match(p, TOK_COMMA)) {
parseExpression(p); // flags
} else {
basEmit8(&p->cg, OP_PUSH_INT16);
basEmit16(&p->cg, 0); // default flags = MB_OK
}
if (match(p, TOK_COMMA)) {
parseExpression(p); // title
} else {
uint16_t emptyIdx = basAddConstant(&p->cg, "", 0);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, emptyIdx);
}
basEmit8(&p->cg, OP_MSGBOX);
basEmit8(&p->cg, OP_POP); // discard result
break;
}
case TOK_INIWRITE:
// IniWrite file, section, key, value
advance(p);
parseExpression(p); // file
expect(p, TOK_COMMA);
parseExpression(p); // section
expect(p, TOK_COMMA);
parseExpression(p); // key
expect(p, TOK_COMMA);
parseExpression(p); // value
basEmit8(&p->cg, OP_INI_WRITE);
break;
case TOK_ME: {
// Me.Show / Me.Hide / Me.CtrlName.Property = expr
advance(p); // consume Me
if (!check(p, TOK_DOT)) {
errorExpected(p, "'.' after Me");
break;
}
advance(p); // consume DOT
if (!isalpha((unsigned char)p->lex.token.text[0]) && p->lex.token.text[0] != '_') {
errorExpected(p, "method or member name after Me.");
break;
}
char meMember[BAS_MAX_TOKEN_LEN];
strncpy(meMember, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
meMember[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
if (strcasecmp(meMember, "Show") == 0) {
// Me.Show [modal]
basEmit8(&p->cg, OP_ME_REF);
uint8_t modal = parseShowModalFlag(p);
basEmit8(&p->cg, OP_SHOW_FORM);
basEmit8(&p->cg, modal);
} else if (strcasecmp(meMember, "Hide") == 0) {
// Me.Hide
basEmit8(&p->cg, OP_ME_REF);
basEmit8(&p->cg, OP_HIDE_FORM);
} else if (check(p, TOK_LPAREN) || check(p, TOK_DOT)) {
// Me.CtrlName(idx).Property OR Me.CtrlName.Property
bool hasIndex = check(p, TOK_LPAREN);
// Push form ref (Me), ctrl name
basEmit8(&p->cg, OP_ME_REF);
uint16_t ctrlIdx = basAddConstant(&p->cg, meMember, (int32_t)strlen(meMember));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, ctrlIdx);
if (hasIndex) {
// Me.CtrlName(idx) -- parse index, use FIND_CTRL_IDX
expect(p, TOK_LPAREN);
parseExpression(p);
expect(p, TOK_RPAREN);
basEmit8(&p->cg, OP_FIND_CTRL_IDX);
} else {
basEmit8(&p->cg, OP_FIND_CTRL);
}
expect(p, TOK_DOT);
if (!check(p, TOK_IDENT)) {
errorExpected(p, "property name");
break;
}
char propName[BAS_MAX_TOKEN_LEN];
strncpy(propName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
propName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
if (check(p, TOK_EQ)) {
// Property assignment
advance(p);
uint16_t propIdx = basAddConstant(&p->cg, propName, (int32_t)strlen(propName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, propIdx);
parseExpression(p);
basEmit8(&p->cg, OP_STORE_PROP);
} else {
// Method call
uint16_t methodIdx = basAddConstant(&p->cg, propName, (int32_t)strlen(propName));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, methodIdx);
emitMethodCallStatement(p);
}
} else if (check(p, TOK_EQ)) {
// Me.Property = expr (form-level property set)
advance(p); // consume =
basEmit8(&p->cg, OP_ME_REF);
uint16_t propIdx = basAddConstant(&p->cg, meMember, (int32_t)strlen(meMember));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, propIdx);
parseExpression(p);
basEmit8(&p->cg, OP_STORE_PROP);
} else {
// Me.Method [args] (form-level method call)
basEmit8(&p->cg, OP_ME_REF);
uint16_t methodIdx = basAddConstant(&p->cg, meMember, (int32_t)strlen(meMember));
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, methodIdx);
emitMethodCallStatement(p);
}
break;
}
case TOK_LET:
advance(p); // consume LET, then fall through to assignment
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name after LET");
break;
}
parseAssignOrCall(p);
break;
case TOK_IDENT: {
// Check for form scope directives (injected by IDE)
if (checkKeyword(p, "BEGINFORM")) {
parseBeginForm(p);
break;
}
if (checkKeyword(p, "ENDFORM")) {
parseEndForm(p);
break;
}
// Check for label: identifier followed by colon
BasLexerT savedLex = p->lex;
char labelName[BAS_MAX_TOKEN_LEN];
strncpy(labelName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
labelName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
if (check(p, TOK_COLON)) {
advance(p); // consume colon
// Record the label at the current code position. For
// SYM_LABEL, localCount is repurposed to hold the SELECT
// depth at the definition, so GOTO can pop only the test
// values of the SELECT blocks it actually leaves.
BasSymbolT *sym = basSymTabFind(&p->sym, labelName);
if (sym != NULL && sym->kind == SYM_LABEL) {
if (sym->isDefined) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Duplicate label '%s'", labelName);
error(p, buf);
break;
}
// Forward-declared label -- now define it
sym->codeAddr = basCodePos(&p->cg);
sym->isDefined = true;
sym->localCount = p->selectDepth;
patchLabelRefs(p, sym);
} else if (sym == NULL) {
bool savedLocal = p->sym.inLocalScope;
p->sym.inLocalScope = false;
sym = basSymTabAdd(&p->sym, labelName, SYM_LABEL, 0);
p->sym.inLocalScope = savedLocal;
if (sym == NULL) {
error(p, "Symbol table full");
break;
}
sym->scope = SCOPE_GLOBAL;
sym->isDefined = true;
sym->codeAddr = basCodePos(&p->cg);
sym->localCount = p->selectDepth;
} else {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Name '%s' already used", labelName);
error(p, buf);
break;
}
p->lastLabelSelectDepth = p->selectDepth;
// After the label, there may be a statement on the same line
// which will be parsed on the next iteration
endOfStatement = false;
break;
}
// Not a label -- restore and parse as assignment/call
p->lex = savedLex;
parseAssignOrCall(p);
break;
}
case TOK_REM:
// Comment -- skip to end of line
advance(p);
break;
default: {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Unexpected token: %s", basTokenName(tt));
error(p, buf);
break;
}
}
p->blockDepth--;
if (endOfStatement && !p->hasError) {
expectEndOfStatement(p);
}
}
static void parseStatic(BasParserT *p) {
// STATIC var AS type
// Only valid inside SUB/FUNCTION. Creates a global variable with a
// mangled name (procName$varName) that persists across calls.
advance(p); // consume STATIC
if (!p->sym.inLocalScope) {
error(p, "STATIC is only valid inside SUB or FUNCTION");
return;
}
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char varName[BAS_MAX_TOKEN_LEN];
strncpy(varName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
varName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// Optional AS type
uint8_t dt = suffixToType(varName);
bool isTyped = nameHasTypeSuffix(varName);
if (match(p, TOK_AS)) {
dt = resolveTypeName(p);
isTyped = true;
}
if (p->hasError) {
return;
}
// STATIC of a user-defined type is not supported: parseStatic neither
// records the UDT typeId nor emits the one-time allocation, so field
// access would fault at runtime. Reject it cleanly instead of silently
// mis-compiling.
if (dt == BAS_TYPE_UDT) {
error(p, "STATIC of a user type is not supported");
return;
}
// Create a mangled global name: "procName$varName". It must fit a
// symbol name like any other; the symbol table never truncates.
char mangledName[BAS_MAX_IDENT * 2 + 1];
int32_t mangledLen = snprintf(mangledName, sizeof(mangledName), "%s$%s", p->currentProc, varName);
if (mangledLen >= BAS_MAX_IDENT) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "STATIC name '%s' is too long (procedure plus variable name must be under %d characters)", varName, (int)BAS_MAX_IDENT);
error(p, buf);
return;
}
// Create the global variable with the mangled name
bool savedLocal = p->sym.inLocalScope;
p->sym.inLocalScope = false;
BasSymbolT *globalSym = basSymTabAdd(&p->sym, mangledName, SYM_VARIABLE, dt);
p->sym.inLocalScope = savedLocal;
if (globalSym == NULL) {
error(p, "Symbol table full or duplicate STATIC variable");
return;
}
globalSym->scope = SCOPE_GLOBAL;
globalSym->index = basSymTabAllocGlobalSlot(&p->sym);
globalSym->isDefined = true;
globalSym->isTyped = isTyped;
// Create a local alias that maps to this global's index
BasSymbolT *localSym = basSymTabAdd(&p->sym, varName, SYM_VARIABLE, dt);
if (localSym == NULL) {
error(p, "Symbol table full or duplicate variable name");
return;
}
localSym->scope = SCOPE_GLOBAL; // accessed as global
localSym->index = globalSym->index;
localSym->isDefined = true;
}
static void parseSub(BasParserT *p) {
// SUB name(params)
// ...
// END SUB
advance(p); // consume SUB
if (!check(p, TOK_IDENT)) {
errorExpected(p, "subroutine name");
return;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
if (p->sym.inLocalScope) {
error(p, "SUB cannot be defined inside SUB or FUNCTION");
return;
}
// Save current proc name for STATIC variable mangling
strncpy(p->currentProc, name, BAS_MAX_TOKEN_LEN - 1);
p->currentProc[BAS_MAX_TOKEN_LEN - 1] = '\0';
// Jump over the sub body in module-level code
int32_t skipJump = emitJump(p, OP_JMP);
int32_t subAddr = basCodePos(&p->cg);
// Enter local scope
basSymTabEnterLocal(&p->sym);
ProcSaveT save;
procBegin(p, &save, false);
ParamListT pl;
if (!parseParamList(p, &pl, PARAM_REGISTER)) {
procEnd(p, &save);
return;
}
// Register the sub in the symbol table (global scope). See
// parseFunction for the duplicate-body rule.
BasSymbolT *existing = basSymTabFindGlobal(&p->sym, name);
BasSymbolT *subSym = NULL;
if (existing != NULL && existing->kind == SYM_SUB) {
if (existing->isDefined) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Sub '%s' is already defined", existing->name);
error(p, buf);
procEnd(p, &save);
return;
}
subSym = existing;
} else {
bool savedLocal = p->sym.inLocalScope;
p->sym.inLocalScope = false;
subSym = basSymTabAdd(&p->sym, name, SYM_SUB, BAS_TYPE_INTEGER);
p->sym.inLocalScope = savedLocal;
}
if (subSym == NULL) {
error(p, "Could not register subroutine");
procEnd(p, &save);
return;
}
subSym->codeAddr = subAddr;
subSym->isDefined = true;
subSym->scope = SCOPE_GLOBAL;
applyParamList(subSym, &pl);
// Record the owning form so fireCtrlEvent can bind the SUB's
// form-scope variables at call time. Prescan adds SUB symbols
// before the BEGINFORM directive is consumed, so the formName
// wasn't populated by basSymTabAdd; set it here once we know we
// are inside a form scope.
if (p->sym.inFormScope && p->sym.formScopeName[0]) {
strncpy(subSym->formName, p->sym.formScopeName, BAS_MAX_IDENT - 1);
subSym->formName[BAS_MAX_IDENT - 1] = '\0';
}
// Backpatch any forward-reference calls to this sub
patchCallAddrs(p, subSym);
expectEndOfStatement(p);
skipNewlines(p);
// Parse sub body
while (!p->hasError && !check(p, TOK_EOF)) {
if (check(p, TOK_END)) {
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_SUB)) {
advance(p);
break;
}
p->lex = savedLex;
}
parseStatement(p);
skipNewlines(p);
}
// Patch EXIT SUB jumps, emit the epilogue and prologue, and restore
// the enclosing state
procEnd(p, &save);
// Leave local scope
collectDebugLocals(p, p->cg.debugProcCount++);
basSymTabLeaveLocal(&p->sym);
// Patch the skip jump
patchJump(p, skipJump);
}
static void parseSwap(BasParserT *p) {
// SWAP a, b -- swap the values of two variables
advance(p); // consume SWAP
// First variable
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char nameA[BAS_MAX_TOKEN_LEN];
strncpy(nameA, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
nameA[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *symA = ensureVariable(p, nameA);
if (symA == NULL) {
return;
}
expect(p, TOK_COMMA);
// Second variable
if (!check(p, TOK_IDENT)) {
errorExpected(p, "variable name");
return;
}
char nameB[BAS_MAX_TOKEN_LEN];
strncpy(nameB, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
nameB[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
BasSymbolT *symB = ensureVariable(p, nameB);
if (symB == NULL) {
return;
}
// Emit: load a, load b, store a, store b
emitLoad(p, symA);
emitLoad(p, symB);
emitStore(p, symA);
emitStore(p, symB);
}
static void parseType(BasParserT *p) {
// TYPE name
// field AS type
// ...
// END TYPE
advance(p); // consume TYPE
if (!check(p, TOK_IDENT)) {
errorExpected(p, "type name");
return;
}
char typeName[BAS_MAX_TOKEN_LEN];
strncpy(typeName, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
typeName[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
// Add TYPE_DEF symbol
bool savedLocal = p->sym.inLocalScope;
p->sym.inLocalScope = false;
BasSymbolT *typeSym = basSymTabAdd(&p->sym, typeName, SYM_TYPE_DEF, BAS_TYPE_UDT);
p->sym.inLocalScope = savedLocal;
if (typeSym == NULL) {
error(p, "Symbol table full or duplicate TYPE name");
return;
}
typeSym->scope = SCOPE_GLOBAL;
typeSym->isDefined = true;
typeSym->index = p->sym.count - 1;
typeSym->fieldCount = 0;
expectEndOfStatement(p);
skipNewlines(p);
// Parse fields until END TYPE
while (!p->hasError && !check(p, TOK_EOF)) {
if (check(p, TOK_END)) {
BasLexerT savedLex = p->lex;
advance(p);
if (check(p, TOK_TYPE)) {
advance(p);
break;
}
p->lex = savedLex;
}
if (!check(p, TOK_IDENT)) {
errorExpected(p, "field name or END TYPE");
return;
}
BasFieldDefT field;
memset(&field, 0, sizeof(field));
// Identifiers are already bounded by checkIdentLength.
snprintf(field.name, sizeof(field.name), "%s", p->lex.token.text);
advance(p);
if (resolveFieldIndex(typeSym, field.name) >= 0) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "Duplicate field '%s' in TYPE '%s'", field.name, typeSym->name);
error(p, buf);
return;
}
expect(p, TOK_AS);
field.dataType = resolveTypeName(p);
if (field.dataType == BAS_TYPE_UDT) {
field.udtTypeId = p->lastUdtTypeId;
// The TYPE symbol is registered before its fields so nested
// types resolve; a field of the type being defined would make
// emitUdtInit recurse without end.
if (field.udtTypeId == typeSym->index) {
char buf[BAS_PARSE_ERR_SCRATCH];
snprintf(buf, sizeof(buf), "TYPE '%s' cannot contain a field of its own type", typeSym->name);
error(p, buf);
return;
}
}
arrput(typeSym->fields, field);
typeSym->fieldCount = (int32_t)arrlen(typeSym->fields);
expectEndOfStatement(p);
skipNewlines(p);
}
}
static void parseUnaryExpr(BasParserT *p) {
if (check(p, TOK_MINUS) || check(p, TOK_PLUS)) {
bool negate = check(p, TOK_MINUS);
// Let the lexer accept the magnitude of LONG's most negative
// value so "-2147483648" is a literal rather than an overflow.
p->lex.allowNegMagnitude = negate;
advance(p); // unary plus is a no-op
p->lex.allowNegMagnitude = false;
if (!exprEnter(p)) {
return;
}
if (negate && check(p, TOK_LONG_LIT) && p->lex.token.longVal == BAS_LONG_NEG_MAGNITUDE) {
// Fold the sign into the literal: the positive magnitude does
// not fit LONG, its negation does.
basEmit8(&p->cg, OP_PUSH_INT32);
basEmit16(&p->cg, (int16_t)(INT32_MIN & 0xFFFF));
basEmit16(&p->cg, (int16_t)((INT32_MIN >> 16) & 0xFFFF));
advance(p);
exprLeave(p);
return;
}
parseUnaryExpr(p);
exprLeave(p);
if (negate) {
basEmit8(&p->cg, OP_NEG_INT);
}
return;
}
parsePowExpr(p);
}
static void parseWhile(BasParserT *p) {
// WHILE cond
// ...
// WEND
advance(p); // consume WHILE
// WHILE/WEND shares the DO exit list: EXIT DO leaves it.
LoopSaveT save;
loopBegin(p, false, &save);
int32_t loopTop = basCodePos(&p->cg);
parseExpression(p);
int32_t falseJump = emitJump(p, OP_JMP_FALSE);
expectEndOfStatement(p);
skipNewlines(p);
while (!p->hasError && !check(p, TOK_WEND) && !check(p, TOK_EOF)) {
parseStatement(p);
skipNewlines(p);
}
if (p->hasError) {
loopEnd(p, false, &save);
return;
}
expect(p, TOK_WEND);
// Jump back to loop top
basEmit8(&p->cg, OP_JMP);
int16_t backOffset = relJumpOffset(p, loopTop, basCodePos(&p->cg));
basEmit16(&p->cg, backOffset);
// Patch the false jump to exit
patchJump(p, falseJump);
// Patch EXIT DO jumps (WHILE/WEND uses the DO exit list)
loopEnd(p, false, &save);
}
static void parseWrite(BasParserT *p) {
// WRITE #channel, expr1, expr2, ...
// Values are comma-delimited. Strings are quoted. Numbers undecorated.
// Each WRITE statement ends with a newline.
advance(p); // consume WRITE
if (!check(p, TOK_HASH)) {
error(p, "Expected # after WRITE");
return;
}
advance(p); // consume #
// Channel number expression
parseExpression(p);
// Comma separator between channel and first value
expect(p, TOK_COMMA);
// Parse each value
bool first = true;
while (!p->hasError) {
if (!first) {
// Emit comma separator to file
basEmit8(&p->cg, OP_DUP); // dup channel for separator
basEmit8(&p->cg, OP_FILE_WRITE_SEP);
}
first = false;
// Duplicate channel for the write operation
basEmit8(&p->cg, OP_DUP);
// Parse value expression
parseExpression(p);
// Write value in WRITE format (strings quoted, numbers undecorated)
basEmit8(&p->cg, OP_FILE_WRITE);
if (!match(p, TOK_COMMA)) {
break;
}
}
// Write newline to file (channel still on stack)
basEmit8(&p->cg, OP_FILE_WRITE_NL);
}
static void parseXorExpr(BasParserT *p) {
parseAndExpr(p);
while (!p->hasError && check(p, TOK_XOR)) {
advance(p);
parseAndExpr(p);
basEmit8(&p->cg, OP_XOR);
}
}
static void patchCallAddrs(BasParserT *p, BasSymbolT *sym) {
// Backpatch all forward-reference CALL addresses
uint16_t addr = (uint16_t)sym->codeAddr;
for (int32_t i = 0; i < sym->patchCount; i++) {
int32_t pos = sym->patchAddrs[i];
if (pos >= 0 && pos + 2 <= p->cg.codeLen) {
memcpy(&p->cg.code[pos], &addr, sizeof(uint16_t));
}
}
sym->patchCount = 0;
}
static void patchJump(BasParserT *p, int32_t addr) {
int32_t target = basCodePos(&p->cg);
int16_t offset = relJumpOffset(p, target, addr);
basPatch16(&p->cg, addr, offset);
}
static void patchLabelRefs(BasParserT *p, BasSymbolT *sym) {
// Backpatch all forward-reference jumps to this label
int32_t target = sym->codeAddr;
for (int32_t i = 0; i < sym->patchCount; i++) {
int32_t patchAddr = sym->patchAddrs[i];
// A forward GOTO reserves one OP_NOP per SELECT open at its site
// directly before the jump opcode and stores that count in the
// placeholder operand (all other label refs leave it at 0). Now
// that the label's own SELECT depth is known (sym->localCount),
// convert one NOP to OP_POP per block the jump actually leaves.
if (patchAddr + 2 <= p->cg.codeLen) {
int16_t gotoDepth = 0;
memcpy(&gotoDepth, &p->cg.code[patchAddr], sizeof(gotoDepth));
if (gotoDepth > 0) {
int32_t pops = gotoDepth - sym->localCount;
if (pops > gotoDepth) {
pops = gotoDepth;
}
int32_t nopStart = patchAddr - 1 - gotoDepth;
if (nopStart >= 0) {
for (int32_t j = 0; j < pops; j++) {
if (p->cg.code[nopStart + j] == OP_NOP) {
p->cg.code[nopStart + j] = OP_POP;
}
}
}
}
}
int16_t offset = relJumpOffset(p, target, patchAddr);
basPatch16(&p->cg, patchAddr, offset);
}
sym->patchCount = 0;
}
// Walk the token stream from current position, find every
// top-level SUB/FUNCTION declaration, extract the signature
// (name, params, return type), and register it in the symbol
// table. Does not emit code. Saves and restores lexer position
// so the main parse pass starts from the same point. This gives
// VB-style forward visibility: call sites that appear earlier in
// the source than the SUB definition still resolve to the right
// paramCount / types.
//
// Lexer errors are skipped here (the main pass reports them with full
// context); a malformed signature is a real syntax error and is
// reported immediately, before a call site can misreport it as an
// arity mismatch against a half-registered signature.
static void prescanSignatures(BasParserT *p) {
BasLexerT savedLex = p->lex;
while (!check(p, TOK_EOF)) {
// Clear a latched lexer error so the walk continues; advance()
// refuses to move while hasError is set, so leaving it latched
// would spin this loop forever.
if (p->hasError) {
p->hasError = false;
p->errorLine = 0;
p->error[0] = '\0';
}
// "END SUB" / "END FUNCTION" consume the END and the following
// keyword as separate tokens; skip END so the next-iteration
// SUB/FUNCTION check doesn't misinterpret it as a declaration.
if (check(p, TOK_END)) {
advance(p);
continue;
}
bool isFn = check(p, TOK_FUNCTION);
bool isSub = check(p, TOK_SUB);
if (!isFn && !isSub) {
advance(p);
continue;
}
advance(p); // consume SUB / FUNCTION
if (!check(p, TOK_IDENT)) {
continue;
}
char name[BAS_MAX_TOKEN_LEN];
strncpy(name, p->lex.token.text, BAS_MAX_TOKEN_LEN - 1);
name[BAS_MAX_TOKEN_LEN - 1] = '\0';
advance(p);
ParamListT pl;
if (!parseParamList(p, &pl, PARAM_PRESCAN)) {
break;
}
// FUNCTION return type (AS clause; or suffix on name)
uint8_t returnType = suffixToType(name);
if (isFn && match(p, TOK_AS)) {
int32_t udtTypeId;
returnType = resolveParamType(p, true, &udtTypeId);
}
if (p->hasError) {
break;
}
// Register / update the symbol. If a call site already
// created a forward-ref stub, update it in place.
BasSymbolT *sym = basSymTabFindGlobal(&p->sym, name);
if (sym == NULL) {
bool savedLocal = p->sym.inLocalScope;
p->sym.inLocalScope = false;
sym = basSymTabAdd(&p->sym, name, isFn ? SYM_FUNCTION : SYM_SUB, returnType);
p->sym.inLocalScope = savedLocal;
}
if (sym != NULL) {
sym->scope = SCOPE_GLOBAL;
sym->dataType = returnType;
applyParamList(sym, &pl);
// basSymTabAdd defaults isDefined=true; clear it so
// call sites that encounter this symbol before the real
// body is parsed register themselves as forward-refs
// (patchAddrs). The real parseSub/parseFunction pass
// sets isDefined=true and fills in codeAddr, at which
// point patchCallAddrs backpatches the forward refs.
sym->isDefined = false;
sym->codeAddr = 0;
}
}
p->lex = savedLex;
}
// Enter a SUB/FUNCTION body: save the enclosing EXIT lists and loop /
// SELECT bookkeeping, start them fresh, and emit the entry jump the
// prologue (procEnd) will patch.
static void procBegin(BasParserT *p, ProcSaveT *save, bool isFunction) {
save->exitFor = p->exitForList;
save->exitDo = p->exitDoList;
save->exitSub = p->exitSubList;
save->exitFunc = p->exitFuncList;
save->forSelectBase = p->forSelectBase;
save->doSelectBase = p->doSelectBase;
save->selectDepth = p->selectDepth;
save->forDepth = p->forDepth;
save->doDepth = p->doDepth;
save->lastLabelSelectDepth = p->lastLabelSelectDepth;
save->isFunction = isFunction;
exitListInit(&p->exitForList);
exitListInit(&p->exitDoList);
exitListInit(&p->exitSubList);
exitListInit(&p->exitFuncList);
p->forSelectBase = 0;
p->doSelectBase = 0;
p->selectDepth = 0;
p->forDepth = 0;
p->doDepth = 0;
p->lastLabelSelectDepth = 0;
p->currentProcIsFunction = isFunction;
// Entry jump to the prologue. Implicit STRING locals only become
// known while the body is parsed, so their "" initialisation is
// emitted after the body and reached through this jump.
save->prologueJmp = emitJump(p, OP_JMP);
save->bodyAddr = basCodePos(&p->cg);
}
// Leave a SUB/FUNCTION body: land EXIT SUB/FUNCTION on the epilogue,
// emit the return, emit the prologue for implicit STRING locals, and
// restore the enclosing state. Runs on the error path too so the EXIT
// lists opened by procBegin are never leaked.
static void procEnd(BasParserT *p, ProcSaveT *save) {
exitListPatch(&p->exitSubList, p);
exitListPatch(&p->exitFuncList, p);
if (save->isFunction) {
// Load return value from slot 0 and return
basEmit8(&p->cg, OP_LOAD_LOCAL);
basEmitU16(&p->cg, 0);
basEmit8(&p->cg, OP_RET_VAL);
} else {
basEmit8(&p->cg, OP_RET);
}
// Prologue: "" into every implicit STRING local, then back to the
// body. With nothing to initialise the entry jump falls through.
int32_t prologueStart = basCodePos(&p->cg);
for (int32_t i = 0; i < p->sym.count; i++) {
BasSymbolT *sym = p->sym.symbols[i];
if (sym->scope == SCOPE_LOCAL && sym->kind == SYM_VARIABLE && sym->isImplicit && sym->dataType == BAS_TYPE_STRING) {
uint16_t emptyIdx = basAddConstant(&p->cg, "", 0);
basEmit8(&p->cg, OP_PUSH_STR);
basEmitU16(&p->cg, emptyIdx);
basEmit8(&p->cg, OP_STORE_LOCAL);
basEmitU16(&p->cg, (uint16_t)sym->index);
}
}
if (basCodePos(&p->cg) != prologueStart) {
basEmit8(&p->cg, OP_JMP);
basEmit16(&p->cg, relJumpOffset(p, save->bodyAddr, basCodePos(&p->cg)));
basPatch16(&p->cg, save->prologueJmp, relJumpOffset(p, prologueStart, save->prologueJmp));
} else {
basPatch16(&p->cg, save->prologueJmp, relJumpOffset(p, save->bodyAddr, save->prologueJmp));
}
// A loop left open by an error still owns its EXIT list.
arrfree(p->exitForList.patchAddr);
arrfree(p->exitDoList.patchAddr);
p->exitForList = save->exitFor;
p->exitDoList = save->exitDo;
p->exitSubList = save->exitSub;
p->exitFuncList = save->exitFunc;
p->forSelectBase = save->forSelectBase;
p->doSelectBase = save->doSelectBase;
p->selectDepth = save->selectDepth;
p->forDepth = save->forDepth;
p->doDepth = save->doDepth;
p->lastLabelSelectDepth = save->lastLabelSelectDepth;
p->currentProcIsFunction = false;
p->currentProc[0] = '\0';
}
// Compute the operand for a relative jump whose 2-byte operand lives at
// operandAddr. A span outside the signed 16-bit range would silently
// wrap and jump somewhere wild, so surface it as a compile error; the
// module-size check in basParse only bounds absolute call addresses.
static int16_t relJumpOffset(BasParserT *p, int32_t target, int32_t operandAddr) {
int32_t span = target - (operandAddr + BAS_JUMP_OPERAND_SIZE);
if (span < INT16_MIN || span > INT16_MAX) {
error(p, "Jump distance exceeds 16-bit limit");
}
return (int16_t)span;
}
static int32_t resolveFieldIndex(BasSymbolT *typeSym, const char *fieldName) {
for (int32_t i = 0; i < typeSym->fieldCount; i++) {
if (strcasecmp(typeSym->fields[i].name, fieldName) == 0) {
return i;
}
}
return -1;
}
// Type after AS in a parameter list or FUNCTION return clause. During
// the prescan the TYPE statements have not been parsed yet, so an
// unknown identifier is accepted as a user type there (the main pass
// validates it); otherwise this is resolveTypeName plus the UDT id.
static uint8_t resolveParamType(BasParserT *p, bool prescan, int32_t *outUdtTypeId) {
*outUdtTypeId = -1;
if (prescan && check(p, TOK_IDENT) && findTypeDef(p, p->lex.token.text) == NULL) {
advance(p);
return BAS_TYPE_UDT;
}
uint8_t dt = resolveTypeName(p);
if (dt == BAS_TYPE_UDT) {
*outUdtTypeId = p->lastUdtTypeId;
}
return dt;
}
static uint8_t resolveTypeName(BasParserT *p) {
// Expect a type keyword after AS
if (check(p, TOK_INTEGER)) {
advance(p);
return BAS_TYPE_INTEGER;
}
if (check(p, TOK_LONG)) {
advance(p);
return BAS_TYPE_LONG;
}
if (check(p, TOK_SINGLE)) {
advance(p);
return BAS_TYPE_SINGLE;
}
if (check(p, TOK_DOUBLE)) {
advance(p);
return BAS_TYPE_DOUBLE;
}
if (check(p, TOK_STRING_KW)) {
advance(p);
return BAS_TYPE_STRING;
}
if (check(p, TOK_BOOLEAN)) {
advance(p);
return BAS_TYPE_BOOLEAN;
}
// Check for user-defined TYPE name
if (check(p, TOK_IDENT)) {
BasSymbolT *typeSym = findTypeDef(p, p->lex.token.text);
if (typeSym != NULL) {
p->lastUdtTypeId = typeSym->index;
advance(p);
return BAS_TYPE_UDT;
}
}
error(p, "Expected type name (Integer, Long, Single, Double, String, Boolean, or TYPE name)");
return BAS_TYPE_INTEGER;
}
// Add delta to every recorded backpatch ADDRESS >= from. Used when
// emitted code is moved (e.g. parseDimBounds prepending a default
// lbound), so that pending forward-CALL and label-reference patch
// positions still point at the operand bytes after the shift. The
// operands themselves are computed at patch time from the (already
// shifted) stored address, so only the stored address needs adjusting.
static void shiftBackpatchAddrs(BasParserT *p, int32_t from, int32_t delta) {
// Per-symbol forward-CALL and label-reference patch addresses.
// Only the live patch set (patchCount) matters: entries already
// consumed by patchCallAddrs/patchLabelRefs leave patchCount at 0
// and are never re-applied, so they need no shifting.
for (int32_t i = 0; i < p->sym.count; i++) {
BasSymbolT *s = p->sym.symbols[i];
for (int32_t j = 0; j < s->patchCount; j++) {
if (s->patchAddrs[j] >= from) {
s->patchAddrs[j] += delta;
}
}
}
// Active EXIT FOR / EXIT DO / EXIT SUB / EXIT FUNCTION lists.
ExitListT *exitLists[] = {&p->exitForList, &p->exitDoList, &p->exitSubList, &p->exitFuncList};
int32_t exitListCount = (int32_t)(sizeof(exitLists) / sizeof(exitLists[0]));
for (int32_t i = 0; i < exitListCount; i++) {
int32_t n = (int32_t)arrlen(exitLists[i]->patchAddr);
for (int32_t j = 0; j < n; j++) {
if (exitLists[i]->patchAddr[j] >= from) {
exitLists[i]->patchAddr[j] += delta;
}
}
}
// Pending JMP over a form's init block.
if (p->formInitJmpAddr >= from) {
p->formInitJmpAddr += delta;
}
}
static void skipNewlines(BasParserT *p) {
while (!p->hasError && check(p, TOK_NEWLINE)) {
advance(p);
}
}
static uint8_t suffixToType(const char *name) {
int32_t len = (int32_t)strlen(name);
if (len == 0) {
return BAS_TYPE_SINGLE; // QB default
}
int32_t dt = basTypeSuffixType(name[len - 1]);
if (dt < 0) {
return BAS_TYPE_SINGLE; // QB default
}
return (uint8_t)dt;
}
Reference in a new issue View git blame Copy permalink