// 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 #include #include // ============================================================ // 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 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 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; }