// 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. // vm.c -- DVX BASIC virtual machine implementation // // Stack-based p-code interpreter. Executes one instruction per // basVmStep() call, or runs until completion via basVmRun(). // PRINT/INPUT, forms and extern calls go through host-provided // callbacks; file, directory and path statements use the C library // (stdio, dirent, fnmatch, stat) and the DVX platform helpers. #include "vm.h" #include "../compiler/opcodes.h" #include "basErrors.h" #include "dvxPlat.h" #include "dvxPrefs.h" #include #include #include #include #include #include #include #include #include #include #include #include #include // ============================================================ // Prototypes // ============================================================ // Capacity of the work buffers used by the numeric formatter shared by // OP_PRINT_USING and OP_FORMAT. Bounds the worst-case output of a // pathological format string or numeric magnitude. #define BAS_FORMAT_BUF_SIZE 256 // Fixed (non-argument) stack operands an OP_CALL_METHOD carries: the // method-name value and the control-reference value, both below the args. #define BAS_CALL_METHOD_FIXED_OPERANDS 2 // File attribute bits returned/accepted by GETATTR/SETATTR (BASIC vbReadOnly/ // vbDirectory). #define BAS_ATTR_READONLY 1 // file is read-only #define BAS_ATTR_DIRECTORY 16 // path is a directory // Scratch buffer capacities used by individual opcode handlers. #define BAS_INPUT_PROMPT_LEN 512 // OP_INPUT: user prompt + "? " #define BAS_INPUT_LINE_LEN 1024 // OP_INPUT: longest line the host input callback may return #define BAS_FILE_LINE_CHUNK 1024 // INPUT #/LINE INPUT #: fgets chunk while growing a line #define BAS_RADIX_STR_LEN 16 // HEX$/OCT$ output ("FFFFFFFF", "37777777777") #define BAS_TIME_STR_LEN 16 // TIME$ "HH:MM:SS" #define BAS_DATE_STR_LEN 32 // DATE$ "MM-DD-YYYY" #define BAS_SCI_FMT_LEN 32 // printf format built for PRINT USING ^^^^ #define BAS_FORMAT_PERCENT "PERCENT" // FORMAT$ named format #define BAS_FORMAT_OVERFLOW_MARK '%' // PRINT USING: value wider than its field #define BAS_USING_ESCAPE '_' // PRINT USING: next format character is literal #define BAS_PRINT_ZONE_WIDTH 14 // PRINT comma: width of one print zone #define BAS_PRINTER_NEWLINE "\r\n" // line end sent to a printer #define BAS_PRINTER_NEWLINE_LEN 2 #define BAS_PRINTER_NAME_PRN "PRN" // the printer in the settings #define BAS_PRINTER_NAME_LPT "LPT" // LPT1..LPT3 #define BAS_PRINTER_NAME_MAX 5 // "LPT1:" / "PRN:" #define BAS_PRINTER_FIRST_DIGIT '1' #define BAS_SPOOL_CHUNK 512 // spool bytes sent per printer write #define BAS_LOC_SEQ_BLOCK 128 // LOC on a sequential channel counts 128-byte blocks (QB) #define BAS_SCI_MARKER "^^^^" // PRINT USING scientific-notation marker // Directory permission bits for MKDIR on POSIX hosts (rwxr-xr-x). #define BAS_MKDIR_MODE 0755 // Largest count STRING$/SPACE$/INPUT$ accept (VB3 string space limit). #define BAS_STRING_FUNC_MAX 65535 // References a REDIM PRESERVE source array holds when the REDIM'd variable // is its only owner: the variable itself plus the copy the statement // loaded onto the eval stack. More means another variable shares it, so // preserved TYPE elements are cloned rather than aliased. #define BAS_REDIM_OWNER_REFS 2 // Classic BASIC FUNCTION result slot (the compiler stores the return // value in local 0; the epilogue is LOAD_LOCAL 0 + RET_VAL). #define BAS_FUNC_RESULT_SLOT 0 // TIMER: seconds per hour/minute and microseconds per second. #define BAS_SECS_PER_HOUR 3600.0 #define BAS_SECS_PER_MINUTE 60.0 #define BAS_USEC_PER_SEC 1000000.0 // SLEEP: pause between event pumps while waiting (microseconds). #define BAS_SLEEP_POLL_USEC 10000 // RND: rand() scaled by RAND_MAX + 1 so the result stays below 1.0, and // the multiplier that spreads a negative RND(n) argument's fraction into // the reseed value (RND(-1.5) and RND(-1) must seed differently). #define BAS_RND_SCALE ((double)RAND_MAX + 1.0) #define BAS_RND_SEED_SPREAD 65536.0 // A seed is reduced modulo 2^32 before it becomes srand's unsigned int, so // huge and negative seeds convert without undefined behaviour. #define BAS_RND_SEED_MODULUS 4294967296.0 // RGB packing: bit offsets and per-channel mask. #define BAS_RGB_RED_SHIFT 16 #define BAS_RGB_GREEN_SHIFT 8 #define BAS_RGB_CHANNEL_MASK 0xFF #define BAS_CHAR_MASK 0xFF // Divergence between the PRINT USING and FORMAT$ numeric formatters, // captured as options so a single helper serves both call sites. typedef struct BasNumFormatT { bool hasDecimal; bool hasComma; bool plusAtStart; bool plusAtEnd; bool minusAtEnd; bool asteriskFill; bool dollarFloat; bool markOverflow; // PRINT USING: prefix '%' when the value does not fit the field int32_t width; // field width the result is right-aligned in int32_t minIntDigits; // integer digits forced by '0' placeholders (zero padded) int32_t digitsAfter; } BasNumFormatT; // One decoded TYPE layout entry (see BAS_LAYOUT_* in opcodes.h). typedef struct BasLayoutEntryT { uint8_t type; int32_t fixedLen; // STRING: 0 = variable length int32_t typeId; // UDT int32_t fieldCount; // UDT } BasLayoutEntryT; // Output sink for PUT: writes to fp, or with fp NULL only counts the // bytes (a RANDOM PUT measures its record before writing it). typedef struct BasPutSinkT { FILE *fp; int32_t bytes; } BasPutSinkT; static BasVmResultE allocArray(BasVmT *vm, int32_t dims, uint8_t elementType, bool preserve, BasArrayT **outArr); static void arrayClear(BasArrayT *arr); static BasVmResultE basVmStepExec(BasVmT *vm); static BasVmResultE boundOp(BasVmT *vm, uint8_t op); static int32_t clampComponent(int32_t c); static void clearErrorState(BasVmT *vm); static bool closeChannel(BasVmT *vm, int32_t channel); static BasStringT *commandArg(const char *args, int32_t n); static BasCallFrameT *currentFrame(BasVmT *vm); static void defaultPrint(void *ctx, const char *text, bool newline); static BasValueT *derefSlot(BasValueT *slot); static void dirClose(BasVmT *vm); static const char *dirNext(BasVmT *vm); static void discardFrame(BasVmT *vm); static bool dispatchError(BasVmT *vm, BasVmResultE result, int32_t floorDepth, int32_t faultPc); static BasVmResultE divByZero(BasVmT *vm); static int64_t divMod32(uint8_t op, int32_t ia, int32_t ib); static void dropValues(BasVmT *vm, int32_t count); static const char *errorText(int32_t errNum); static BasVmResultE execArith(BasVmT *vm, uint8_t op); static BasVmResultE execCompare(BasVmT *vm, uint8_t op); static BasVmResultE execFileOp(BasVmT *vm, uint8_t op); static BasVmResultE execFsOp(BasVmT *vm, uint8_t op); static BasVmResultE execLogical(BasVmT *vm, uint8_t op); static BasVmResultE execLprint(BasVmT *vm, uint8_t phase); static BasVmResultE execMath(BasVmT *vm, uint8_t op); static BasVmResultE execPrint(BasVmT *vm); static BasVmResultE execStrAppend(BasVmT *vm); static BasVmResultE execStringOp(BasVmT *vm, uint8_t op); static BasStringT *fillString(char ch, int32_t count); static BasValueT forCounterValue(uint8_t varType, bool stepFractional, double v); static void formatNumber(double n, const BasNumFormatT *f, char *out, size_t outSize); static int32_t forStackFloor(BasVmT *vm); static void forStackTrim(BasVmT *vm, int32_t newDepth); static BasValueT iniRead(const char *path, const char *sec, const char *key, BasStringT *defStr); static BasVmResultE iniWrite(BasVmT *vm, const char *path, const char *sec, const char *key, const char *val); static BasValueT integralValue(double v); static BasValueT intResult(int32_t v); static int32_t intValue(BasValueT v); static BasStringT *ioReadBytes(FILE *fp, int32_t len, bool pad); static BasStringT *ioReadPrefixedString(FILE *fp); static BasValueT ioReadScalar(FILE *fp, uint8_t type); static void ioWritePrefixedString(BasPutSinkT *sink, const BasStringT *s); static void ioWriteScalar(BasPutSinkT *sink, uint8_t type, BasValueT val); static bool isIntegerType(uint8_t type); static bool layoutNext(const BasStringT *layout, int32_t *pos, BasLayoutEntryT *out); static void localNow(struct tm *out, int32_t *outUsec); static void lprintWrite(BasVmT *vm, const char *data, int32_t len); static BasVmResultE mathRangeError(BasVmT *vm, double result); static int32_t nextStatementPc(BasVmT *vm, int32_t start, bool includeStart); static BasVmResultE noFormRuntime(BasVmT *vm); static BasVmResultE openPrinterChannel(BasVmT *vm, int32_t channel, int32_t port, uint8_t mode, int32_t recLen); static bool operandFits(BasVmT *vm, int32_t size); static void parseNumFormat(const char *fmt, int32_t fmtLen, BasNumFormatT *f, bool *outSci); static bool pop(BasVmT *vm, BasValueT *val); static bool popArgs(BasVmT *vm, int32_t count, ...); static BasVmResultE popArrayElement(BasVmT *vm, int32_t dims, BasValueT *outArr, int32_t *outIdx); static void popCallFrame(BasVmT *vm); static BasVmResultE popFileChannel(BasVmT *vm, int32_t *outChannel, bool requireOpen); static bool popPair(BasVmT *vm, BasValueT *a, BasValueT *b); static bool popStringArg(BasVmT *vm, BasValueT *out); static void primeModuleFrame(BasVmT *vm); static int32_t *printColumnOf(BasVmT *vm); static bool printerDevice(const char *name, int32_t *outPort); static BasStringT *printString(BasValueT val); static void printText(BasVmT *vm, const char *text, bool newline); static int32_t procLocalCount(const BasVmT *vm, int32_t codeAddr, int32_t minCount); static bool push(BasVmT *vm, BasValueT val); static BasCallFrameT *pushFrame(BasVmT *vm, int32_t returnPc, int32_t codeAddr, int32_t minLocals); static void putBounded(char *out, int32_t *idx, int32_t limit, char c); static BasVmResultE putValue(BasVmT *vm, BasPutSinkT *sink, int32_t mode, BasValueT val, const BasStringT *layout); static BasStringT *readField(FILE *fp); static int16_t readInt16(BasVmT *vm); static BasStringT *readLine(FILE *fp); static void readRaw(FILE *fp, void *dst, size_t size); static uint16_t readUint16(BasVmT *vm); static uint8_t readUint8(BasVmT *vm); static BasVmResultE recordBegin(BasVmT *vm, int32_t channel, int32_t recno, long *start); static BasVmResultE recordEnd(BasVmT *vm, int32_t channel, long start, bool writing); static void releaseVmState(BasVmT *vm); static BasVmResultE roundedOperand(BasVmT *vm, BasValueT v, int32_t *out); static bool runSubLoop(BasVmT *vm, int32_t savedPc, int32_t savedCallDepth, bool savedRunning); static void runtimeError(BasVmT *vm, int32_t errNum, const char *msg); static BasValueT *scopedVarSlot(BasVmT *vm, uint16_t varIdx, uint8_t scopeTag); static void seedRandom(double seed); static BasVmResultE seekRecord(BasVmT *vm, int32_t channel, int32_t pos); static bool sendSpool(BasVmT *vm, BasFileChannelT *ch); static void sinkFill(BasPutSinkT *sink, char c, int32_t count); static void sinkWrite(BasPutSinkT *sink, const void *data, int32_t len); static bool sleepSeconds(BasVmT *vm, int32_t secs); static bool storeElement(BasVmT *vm, BasValueT *target, BasValueT val); static void storeValue(BasValueT *target, BasValueT val); static int32_t stringFind(const BasStringT *haystack, int32_t start, const BasStringT *needle, bool ignoreCase); static BasValueT strValue(BasStringT *s); static BasValueT udtDetach(BasValueT val); static BasUdtT *udtFromLayout(BasVmT *vm, const BasStringT *layout, int32_t *pos, int32_t typeId, int32_t fieldCount, int32_t depth); static BasVmResultE udtGet(BasVmT *vm, FILE *fp, BasUdtT *udt, const BasStringT *layout, int32_t *pos, int32_t depth); static BasVmResultE udtPut(BasVmT *vm, BasPutSinkT *sink, const BasUdtT *udt, const BasStringT *layout, int32_t *pos, int32_t depth); static BasVmResultE uiTarget(BasVmT *vm, bool hasCallback, BasValueT target); static int32_t usingFieldLen(const char *fmt, int32_t fmtLen, int32_t pos); static BasStringT *usingFormat(BasVmT *vm, const BasStringT *fmt, BasValueT val, bool last); static bool validArrayDims(BasVmT *vm, int32_t dims); static double wallSeconds(void); static BasValueT zeroValue(uint8_t type); // Shared body of OP_DIM_ARRAY / OP_REDIM: pops the UDT typeId/fieldCount // pair (UDT element type only) and the (lbound, ubound) pairs for each // dimension and allocates the array. With preserve set (REDIM PRESERVE) // the old array reference left on top of the stack supplies every element // whose subscripts exist in both shapes, element by element, so a changed // row stride keeps each value at its own subscript. UDT elements not // preserved get fresh instances. On success *outArr holds a refCount-1 // array. static BasVmResultE allocArray(BasVmT *vm, int32_t dims, uint8_t elementType, bool preserve, BasArrayT **outArr) { if (!validArrayDims(vm, dims)) { return BAS_VM_ERROR; } int32_t udtTypeId = -1; int32_t udtFieldCnt = 0; BasValueT layoutVal; memset(&layoutVal, 0, sizeof(layoutVal)); if (elementType == BAS_TYPE_UDT) { BasValueT fcVal; BasValueT tiVal; if (!popArgs(vm, 3, &fcVal, &tiVal, &layoutVal)) { return BAS_VM_STACK_UNDERFLOW; } udtFieldCnt = basValToInt32(fcVal); udtTypeId = basValToInt32(tiVal); basValRelease(&fcVal); basValRelease(&tiVal); if (layoutVal.type != BAS_TYPE_STRING || !layoutVal.strVal) { basValRelease(&layoutVal); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Bad TYPE layout"); return BAS_VM_TYPE_MISMATCH; } } int32_t lbounds[BAS_ARRAY_MAX_DIMS]; int32_t ubounds[BAS_ARRAY_MAX_DIMS]; // Pop bounds in reverse order (last dim first) for (int32_t d = dims - 1; d >= 0; d--) { BasValueT ubVal; BasValueT lbVal; if (!popArgs(vm, 2, &ubVal, &lbVal)) { basValRelease(&layoutVal); return BAS_VM_STACK_UNDERFLOW; } ubounds[d] = basValToInt32(ubVal); lbounds[d] = basValToInt32(lbVal); basValRelease(&ubVal); basValRelease(&lbVal); } BasArrayT *arr = basArrayNew(dims, lbounds, ubounds, elementType); if (!arr) { basValRelease(&layoutVal); runtimeError(vm, BAS_ERR_OUT_OF_MEMORY, "Out of memory allocating array"); return BAS_VM_OUT_OF_MEMORY; } const BasArrayT *oldArr = NULL; if (preserve && vm->sp > 0) { const BasValueT *top = &vm->stack[vm->sp - 1]; if (top->type == BAS_TYPE_ARRAY && top->arrVal && top->arrVal->dims == dims) { oldArr = top->arrVal; } } bool oldShared = oldArr && oldArr->refCount > BAS_REDIM_OWNER_REFS; int32_t idx[BAS_ARRAY_MAX_DIMS]; memcpy(idx, lbounds, sizeof(int32_t) * dims); for (int32_t flat = 0; flat < arr->totalElements; flat++) { int32_t oldFlat = oldArr ? basArrayIndex((BasArrayT *)oldArr, idx, dims) : -1; if (oldFlat >= 0) { BasValueT v = basValCopy(oldArr->elements[oldFlat]); basValRelease(&arr->elements[flat]); arr->elements[flat] = oldShared ? udtDetach(v) : v; } else if (elementType == BAS_TYPE_UDT) { int32_t pos = 0; BasUdtT *udt = udtFromLayout(vm, layoutVal.strVal, &pos, udtTypeId, udtFieldCnt, 0); if (!udt) { basArrayFree(arr); basValRelease(&layoutVal); return BAS_VM_ERROR; } arr->elements[flat].type = BAS_TYPE_UDT; arr->elements[flat].udtVal = udt; } // Advance the subscript counter, last dimension fastest. for (int32_t d = dims - 1; d >= 0; d--) { if (++idx[d] <= ubounds[d]) { break; } idx[d] = lbounds[d]; } } basValRelease(&layoutVal); *outArr = arr; return BAS_VM_OK; } // ERASE on a fixed array: every element goes back to its declared zero // value (TYPE elements keep their instance and have each field reset). static void arrayClear(BasArrayT *arr) { for (int32_t i = 0; i < arr->totalElements; i++) { BasValueT *elem = &arr->elements[i]; if (elem->type == BAS_TYPE_UDT && elem->udtVal) { BasUdtT *udt = elem->udtVal; for (int32_t f = 0; f < udt->fieldCount; f++) { BasValueT zero = zeroValue(udt->fields[f].type); basValRelease(&udt->fields[f]); udt->fields[f] = zero; } continue; } BasValueT zero = zeroValue(arr->elementType); basValRelease(elem); *elem = zero; } } bool basVmCallSub(BasVmT *vm, int32_t codeAddr) { // Thin wrapper: no args, no out-args. basVmCallSubWithArgsOut handles // NULL args / zero counts and contains the full validation + frame setup. return basVmCallSubWithArgsOut(vm, codeAddr, NULL, 0, NULL, 0); } bool basVmCallSubWithArgs(BasVmT *vm, int32_t codeAddr, const BasValueT *args, int32_t argCount) { // Thin wrapper: in-args only, no out-args. return basVmCallSubWithArgsOut(vm, codeAddr, args, argCount, NULL, 0); } bool basVmCallSubWithArgsOut(BasVmT *vm, int32_t codeAddr, const BasValueT *args, int32_t argCount, BasValueT *outArgs, int32_t outCount) { if (!vm || !vm->module) { return false; } if (vm->debugPaused) { return false; } if (codeAddr < 0 || codeAddr >= vm->module->codeLen) { return false; } if (vm->callDepth >= BAS_VM_CALL_STACK_SIZE - 1 || argCount < 0 || argCount > BAS_VM_MAX_LOCALS) { return false; } int32_t savedPc = vm->pc; int32_t savedCallDepth = vm->callDepth; bool savedRunning = vm->running; BasCallFrameT *frame = pushFrame(vm, savedPc, codeAddr, argCount); for (int32_t i = 0; i < argCount; i++) { frame->locals[i] = basValCopy(args[i]); } vm->pc = codeAddr; vm->running = true; // Arrange for the returning frame's locals to be copied into outArgs by // OP_RET/OP_RET_VAL, BEFORE those opcodes release the locals. Reading // them after runSubLoop returns would be a use-after-free because the // RET path has already released every local in the frame. The fields // are not reentrant, so save and restore them around the call in case // the running sub itself makes another out-arg call. BasValueT *savedOutArgs = vm->outArgs; int32_t savedOutArgCount = vm->outArgCount; int32_t savedOutArgFrame = vm->outArgFrame; vm->outArgs = (outArgs && outCount > 0) ? outArgs : NULL; vm->outArgCount = outCount; vm->outArgFrame = savedCallDepth; bool ok = runSubLoop(vm, savedPc, savedCallDepth, savedRunning); vm->outArgs = savedOutArgs; vm->outArgCount = savedOutArgCount; vm->outArgFrame = savedOutArgFrame; return ok; } BasVmT *basVmCreate(void) { BasVmT *vm = (BasVmT *)calloc(1, sizeof(BasVmT)); if (!vm) { return NULL; } vm->printFn = defaultPrint; vm->stepOverDepth = -1; vm->stepOutDepth = -1; vm->runToCursorLine = -1; vm->outArgFrame = -1; return vm; } void basVmDestroy(BasVmT *vm) { if (!vm) { return; } // Release eval stack, globals, call-frame locals and FOR-stack values releaseVmState(vm); for (int32_t i = 0; i < BAS_VM_MAX_FILES; i++) { closeChannel(vm, i); } if (vm->lprintJob) { vm->printer.close(vm->printer.ctx, vm->lprintJob); } dirClose(vm); free(vm->commandArgs); free(vm->externCache); free(vm); } const char *basVmGetError(const BasVmT *vm) { return vm ? vm->errorMsg : ""; } void basVmLoadModule(BasVmT *vm, BasModuleT *module) { if (!module) { vm->module = NULL; snprintf(vm->errorMsg, sizeof(vm->errorMsg), "No program loaded"); return; } if (module->globalCount > BAS_VM_MAX_GLOBALS) { vm->module = NULL; snprintf(vm->errorMsg, sizeof(vm->errorMsg), "Program needs %d global variables; the limit is %d", (int)module->globalCount, (int)BAS_VM_MAX_GLOBALS); return; } // One extern-cache slot per constant, so OP_CALL_EXTERN finds a // resolved function by its name index without searching. BasExternCacheEntryT *cache = NULL; if (module->constCount > 0) { cache = (BasExternCacheEntryT *)calloc(module->constCount, sizeof(BasExternCacheEntryT)); if (!cache) { vm->module = NULL; snprintf(vm->errorMsg, sizeof(vm->errorMsg), "Out of memory loading program"); return; } } free(vm->externCache); vm->externCache = cache; vm->externCacheCount = module->constCount; vm->module = module; vm->pc = module->entryPoint; clearErrorState(vm); // Initialize globals whose declared type requires a non-numeric // default. Uninitialized slots are zero (type=INTEGER, value=0), // which breaks STRING operations: `DIM s AS STRING : s = s + "x"` // would do numeric addition instead of concatenation. STATIC // variables also alias global slots, so the same issue applies. // globalInits survives the compiler's strip pass, unlike debugVars. for (int32_t i = 0; i < module->globalInitCount; i++) { BasGlobalInitT *g = &module->globalInits[i]; if (g->index < 0 || g->index >= BAS_VM_MAX_GLOBALS) { continue; } if (g->dataType == BAS_TYPE_STRING) { basValRelease(&vm->globals[g->index]); vm->globals[g->index].type = BAS_TYPE_STRING; vm->globals[g->index].strVal = basStringNew("", 0); } } // Prime the implicit main (module-level) frame. The IDE and test // harness used to set this by hand; doing it here makes every entry // path (including compiled apps via the stub) consistent. primeModuleFrame(vm); vm->stmtPc = -1; } BasVmResultE basVmRun(BasVmT *vm) { // basVmLoadModule refused the module (too many globals): report why // instead of returning a clean HALTED for a program that never ran. if (!vm->module && vm->errorMsg[0] != '\0') { return BAS_VM_ERROR; } vm->running = true; vm->stepCount = 0; while (vm->running) { // Check step limit if (vm->stepLimit > 0 && vm->stepCount >= vm->stepLimit) { return BAS_VM_STEP_LIMIT; } // Save PC before each instruction for RESUME support int32_t savedPc = vm->pc; BasVmResultE result = basVmStep(vm); vm->stepCount++; if (result != BAS_VM_OK) { // Debugger pauses are not errors: hand them straight back to // the host without consulting ON ERROR handlers. if (result == BAS_VM_BREAKPOINT) { vm->running = false; return result; } // Trappable error with a handler in scope: the dispatcher has // unwound to the handler frame and pointed pc at it. if (dispatchError(vm, result, 0, savedPc)) { continue; } vm->running = false; return result; } } // Host callbacks (property setters, method dispatch, etc.) can // abort execution by writing an error message and clearing // vm->running. The step itself returns OK because the VM did // nothing wrong; the failure happened on the host side. If the // host left an error message, surface it as BAS_VM_ERROR so the // caller (IDE, stub) can navigate to the line and stop the // program instead of treating the halt as a normal END. if (vm->errorMsg[0] != '\0') { return BAS_VM_ERROR; } return BAS_VM_HALTED; } void basVmRunToCursor(BasVmT *vm, int32_t line) { if (vm) { vm->runToCursorLine = line; } } void basVmSetBreakpoints(BasVmT *vm, int32_t *lines, int32_t count) { if (!vm) { return; } vm->breakpoints = lines; vm->breakpointCount = count; } bool basVmSetCommand(BasVmT *vm, const char *args) { free(vm->commandArgs); vm->commandArgs = (args && args[0]) ? strdup(args) : NULL; return vm->commandArgs != NULL || !args || !args[0]; } void basVmSetCurrentForm(BasVmT *vm, void *formRef) { vm->currentForm = formRef; } void basVmSetCurrentFormVars(BasVmT *vm, BasValueT *vars, int32_t count) { vm->currentFormVars = vars; vm->currentFormVarCount = count; } void basVmSetDoEventsCallback(BasVmT *vm, BasDoEventsFnT fn, void *ctx) { vm->doEventsFn = fn; vm->doEventsCtx = ctx; } void basVmSetExternCallbacks(BasVmT *vm, const BasExternCallbacksT *ext) { vm->ext = *ext; } void basVmSetInputCallback(BasVmT *vm, BasInputFnT fn, void *ctx) { vm->inputFn = fn; vm->inputCtx = ctx; } void basVmSetPrintCallback(BasVmT *vm, BasPrintFnT fn, void *ctx) { vm->printFn = fn; vm->printCtx = ctx; } void basVmSetPrinterCallbacks(BasVmT *vm, const BasPrinterCallbacksT *printer) { vm->printer = *printer; } void basVmSetSqlCallbacks(BasVmT *vm, const BasSqlCallbacksT *sql) { vm->sql = *sql; } void basVmSetStepLimit(BasVmT *vm, int32_t limit) { vm->stepLimit = limit; } void basVmSetUiCallbacks(BasVmT *vm, const BasUiCallbacksT *ui) { vm->ui = *ui; } BasVmResultE basVmStep(BasVmT *vm) { BasVmResultE result = basVmStepExec(vm); // A string allocation that failed during the step substituted an // empty string; surface it as Out of string space instead of letting // the program continue on lost data. if (basStringAllocFailed) { basStringAllocFailed = false; if (result == BAS_VM_OK) { runtimeError(vm, BAS_ERR_OUT_OF_STRING, "Out of string space"); result = BAS_VM_OUT_OF_MEMORY; } } return result; } // Executes one instruction: the body of basVmStep, which adds the // string-allocation check around it. static BasVmResultE basVmStepExec(BasVmT *vm) { // A prior step's operand read ran past code[] and clamped pc to codeLen. // Check this BEFORE the halt guard below, otherwise pc == codeLen would // report a clean BAS_VM_HALTED and mask the corruption. badOperand can // only have been set while vm->module was non-NULL, so no NULL check here. if (vm->badOperand) { vm->badOperand = false; vm->running = false; return BAS_VM_BAD_OPCODE; } if (!vm->module || vm->pc < 0 || vm->pc >= vm->module->codeLen) { vm->running = false; return BAS_VM_HALTED; } vm->currentOpPc = vm->pc; uint8_t op = vm->module->code[vm->pc++]; switch (op) { case OP_NOP: break; // ============================================================ // Stack operations // ============================================================ case OP_PUSH_INT16: { int16_t val = readInt16(vm); if (!push(vm, basValInteger(val))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_PUSH_INT32: { int16_t lo = readInt16(vm); int16_t hi = readInt16(vm); // Reconstruct through unsigned math: left-shifting a negative // sign-extended high half would be signed-overflow UB. int32_t val = (int32_t)(((uint32_t)(uint16_t)hi << 16) | (uint16_t)lo); if (!push(vm, basValLong(val))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_PUSH_FLT64: { double val = 0.0; if (operandFits(vm, (int32_t)sizeof(double))) { memcpy(&val, &vm->module->code[vm->pc], sizeof(double)); vm->pc += sizeof(double); } if (!push(vm, basValDouble(val))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_PUSH_STR: { uint16_t idx = readUint16(vm); BasStringT *str = (idx < (uint16_t)vm->module->constCount) ? vm->module->constants[idx] : basEmptyString; if (!push(vm, basValString(str))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_PUSH_TRUE: if (!push(vm, basValBool(true))) { return BAS_VM_STACK_OVERFLOW; } break; case OP_PUSH_FALSE: if (!push(vm, basValBool(false))) { return BAS_VM_STACK_OVERFLOW; } break; case OP_POP: { BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } basValRelease(&val); break; } case OP_DUP: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } if (!push(vm, basValCopy(vm->stack[vm->sp - 1]))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_STMT: // Release-build statement boundary: same bookkeeping as OP_LINE // minus the line number and debugger checks. vm->stmtSp = vm->sp; vm->stmtPc = vm->currentOpPc; break; // ============================================================ // Variable access // ============================================================ case OP_LOAD_LOCAL: { uint16_t idx = readUint16(vm); BasCallFrameT *frame = currentFrame(vm); if (idx >= (uint16_t)frame->localCount) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid local variable index"); return BAS_VM_ERROR; } // ByRef: if the local holds a reference, dereference it BasValueT *slot = derefSlot(&frame->locals[idx]); if (!slot) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Subscript out of range"); return BAS_VM_SUBSCRIPT_RANGE; } if (!push(vm, basValCopy(*slot))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_STORE_LOCAL: { uint16_t idx = readUint16(vm); BasCallFrameT *frame = currentFrame(vm); BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } if (idx >= (uint16_t)frame->localCount) { basValRelease(&val); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid local variable index"); return BAS_VM_ERROR; } // ByRef: if the local holds a reference, store through it BasValueT *slot = derefSlot(&frame->locals[idx]); if (!slot) { basValRelease(&val); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Subscript out of range"); return BAS_VM_SUBSCRIPT_RANGE; } storeValue(slot, val); break; } case OP_LOAD_GLOBAL: { uint16_t idx = readUint16(vm); if (idx >= BAS_VM_MAX_GLOBALS) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid global variable index"); return BAS_VM_ERROR; } if (!push(vm, basValCopy(vm->globals[idx]))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_STORE_GLOBAL: { uint16_t idx = readUint16(vm); BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } if (idx >= BAS_VM_MAX_GLOBALS) { basValRelease(&val); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid global variable index"); return BAS_VM_ERROR; } storeValue(&vm->globals[idx], val); break; } case OP_PUSH_LOCAL_ADDR: { uint16_t idx = readUint16(vm); BasCallFrameT *frame = currentFrame(vm); if (idx >= (uint16_t)frame->localCount) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid local variable index"); return BAS_VM_ERROR; } // A local that is itself a ByRef parameter passes its // reference straight through (an ELEM_REF copy counts the // array again), so a callee two levels down still reaches the // original variable. Only a plain slot gets a new reference. BasValueT *slot = &frame->locals[idx]; BasValueT ref; if (slot->type == BAS_TYPE_REF || slot->type == BAS_TYPE_ELEM_REF) { ref = basValCopy(*slot); } else { ref.type = BAS_TYPE_REF; ref.refVal = slot; } if (!push(vm, ref)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_PUSH_GLOBAL_ADDR: { uint16_t idx = readUint16(vm); if (idx >= BAS_VM_MAX_GLOBALS) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid global variable index"); return BAS_VM_ERROR; } BasValueT ref; ref.type = BAS_TYPE_REF; ref.refVal = &vm->globals[idx]; if (!push(vm, ref)) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // Arithmetic // ============================================================ case OP_ADD_INT: case OP_SUB_INT: case OP_MUL_INT: case OP_IDIV_INT: case OP_MOD_INT: case OP_DIV_FLT: case OP_POW: return execArith(vm, op); case OP_NEG_INT: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; // Negating the most negative INTEGER / LONG does not fit the // type: promote exactly as 0 - x does in execArith. (The // literal -2147483648 is folded by the compiler and never // reaches here.) if (top->type == BAS_TYPE_INTEGER) { *top = (top->intVal == INT16_MIN) ? basValLong(-(int32_t)INT16_MIN) : basValInteger((int16_t)-top->intVal); } else if (top->type == BAS_TYPE_LONG) { *top = (top->longVal == INT32_MIN) ? basValDouble(-(double)INT32_MIN) : basValLong(-top->longVal); } else { double n = basValToNumber(*top); basValRelease(top); *top = basValDouble(-n); } break; } // ============================================================ // String operations // ============================================================ case OP_STR_CONCAT: case OP_STR_LEFT: case OP_STR_RIGHT: case OP_STR_MID: case OP_STR_MID2: case OP_STR_LEN: case OP_STR_INSTR: case OP_STR_INSTR3: case OP_STR_UCASE: case OP_STR_LCASE: case OP_STR_TRIM: case OP_STR_LTRIM: case OP_STR_RTRIM: case OP_STR_CHR: case OP_STR_ASC: case OP_STR_SPACE: case OP_STR_FIXLEN: case OP_STR_MID_ASGN: return execStringOp(vm, op); case OP_STR_APPEND: return execStrAppend(vm); // ============================================================ // Comparison // ============================================================ case OP_CMP_EQ: case OP_CMP_NE: case OP_CMP_LT: case OP_CMP_GT: case OP_CMP_LE: case OP_CMP_GE: return execCompare(vm, op); // ============================================================ // Logical / bitwise // ============================================================ case OP_AND: case OP_OR: case OP_NOT: case OP_XOR: case OP_EQV: case OP_IMP: return execLogical(vm, op); // ============================================================ // Control flow // ============================================================ case OP_JMP: { int16_t offset = readInt16(vm); vm->pc += offset; break; } case OP_JMP_TRUE: { int16_t offset = readInt16(vm); BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } if (basValIsTruthy(val)) { vm->pc += offset; } basValRelease(&val); break; } case OP_JMP_FALSE: { int16_t offset = readInt16(vm); BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } if (!basValIsTruthy(val)) { vm->pc += offset; } basValRelease(&val); break; } case OP_CALL: { uint16_t addr = readUint16(vm); uint8_t argc = readUint8(vm); uint8_t baseSlot = readUint8(vm); // Guard the locals window: baseSlot and argc come straight from // bytecode, and a corrupt module could otherwise make the arg // copy below write past locals[]. Drain the pushed args first // so the eval stack stays balanced. if ((int32_t)baseSlot + (int32_t)argc > BAS_VM_MAX_LOCALS) { dropValues(vm, argc); runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "CALL argument slots out of range"); return BAS_VM_ERROR; } if (vm->callDepth >= BAS_VM_CALL_STACK_SIZE) { return BAS_VM_CALL_OVERFLOW; } BasCallFrameT *frame = pushFrame(vm, vm->pc, addr, baseSlot + argc); // Pop arguments into locals starting at baseSlot (in reverse // order). A BYVAL TYPE argument must be the callee's own copy. for (int32_t i = baseSlot + argc - 1; i >= baseSlot; i--) { if (!pop(vm, &frame->locals[i])) { return BAS_VM_STACK_UNDERFLOW; } frame->locals[i] = udtDetach(frame->locals[i]); } // The callee starts with no handler; if it raises an error // the dispatcher will unwind to the nearest frame with one. vm->pc = addr; break; } case OP_RET: { // The module frame (depth 1) is never popped: a RET reached at // module level (corrupt bytecode) ends the program, otherwise // later local accesses would use a frame teardown cannot see. if (vm->callDepth <= 1) { vm->running = false; return BAS_VM_HALTED; } popCallFrame(vm); break; } case OP_RET_VAL: { // Like RET but leaves TOS as the return value BasValueT retVal; if (!pop(vm, &retVal)) { return BAS_VM_STACK_UNDERFLOW; } if (vm->callDepth <= 1) { basValRelease(&retVal); vm->running = false; return BAS_VM_HALTED; } popCallFrame(vm); if (!push(vm, retVal)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_GOSUB: { int16_t offset = readInt16(vm); if (vm->gosubDepth >= BAS_VM_GOSUB_STACK_SIZE) { return BAS_VM_STACK_OVERFLOW; } vm->gosubStack[vm->gosubDepth++] = vm->pc; vm->pc += offset; break; } case OP_GOSUB_RET: { // Only a GOSUB made by the current SUB/FUNCTION (or the module // level) can be returned from. int32_t gosubFloor = (vm->callDepth > 0) ? vm->callStack[vm->callDepth - 1].savedGosubDepth : 0; if (vm->gosubDepth <= gosubFloor) { runtimeError(vm, BAS_ERR_RETURN_NO_GOSUB, errorText(BAS_ERR_RETURN_NO_GOSUB)); return BAS_VM_ERROR; } vm->pc = vm->gosubStack[--vm->gosubDepth]; break; } case OP_FOR_INIT: { uint16_t varIdx = readUint16(vm); uint8_t scopeTag = readUint8(vm); int16_t skipOffset = readInt16(vm); BasValueT stepVal; BasValueT limitVal; if (!popArgs(vm, 2, &stepVal, &limitVal)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *varSlot = scopedVarSlot(vm, varIdx, scopeTag); if (!varSlot) { basValRelease(&stepVal); basValRelease(&limitVal); return BAS_VM_ERROR; } // Re-entering a FOR whose frame is still live (a GOTO back to // the FOR statement, or a jump that skipped its NEXT) must not // stack a second frame: discard the old context and everything // nested inside it, as classic BASIC does. Only frames owned // by the current call frame are considered. int32_t forFloor = forStackFloor(vm); for (int32_t k = vm->forDepth - 1; k >= forFloor; k--) { if (vm->forStack[k].varIdx == (int32_t)varIdx && vm->forStack[k].scopeTag == scopeTag) { forStackTrim(vm, k); break; } } if (vm->forDepth >= BAS_VM_MAX_FOR_DEPTH) { basValRelease(&stepVal); basValRelease(&limitVal); runtimeError(vm, BAS_ERR_FOR_NESTING, "FOR loop nesting too deep"); return BAS_VM_ERROR; } double stepNum = basValToNumber(stepVal); double limNum = basValToNumber(limitVal); double curVal = basValToNumber(*varSlot); // Entry check: if the loop's range is already empty (e.g. // FOR i = 10 TO 5 with positive step), skip the body without // pushing FOR state. QBASIC semantics: body executes zero // times when the range is empty. bool enter = (stepNum >= 0) ? (curVal <= limNum) : (curVal >= limNum); if (!enter) { basValRelease(&stepVal); basValRelease(&limitVal); vm->pc += skipOffset; break; } BasForStateT *fs = &vm->forStack[vm->forDepth++]; fs->varIdx = varIdx; fs->scopeTag = scopeTag; fs->integral = isIntegerType(limitVal.type) && isIntegerType(stepVal.type); fs->stepFractional = (stepNum != floor(stepNum)); fs->limit = limitVal; fs->step = stepVal; fs->loopTop = vm->pc; break; } case OP_FOR_NEXT: { uint16_t varIdx = readUint16(vm); uint8_t scopeTag = readUint8(vm); int16_t loopTopOffset = readInt16(vm); if (vm->forDepth <= 0) { runtimeError(vm, BAS_ERR_NEXT_WITHOUT_FOR, "NEXT without FOR"); return BAS_VM_ERROR; } BasForStateT *fs = &vm->forStack[vm->forDepth - 1]; if (fs->varIdx != (int32_t)varIdx || fs->scopeTag != scopeTag) { // A jump out of an inner FOR (EXIT DO, GOTO) leaves its // frame on the FOR stack. Search down to this call frame's // floor for the loop this NEXT belongs to and discard the // stale frames above it, matching classic BASIC semantics. int32_t forFloor = forStackFloor(vm); int32_t matchIdx = -1; for (int32_t k = vm->forDepth - 2; k >= forFloor; k--) { if (vm->forStack[k].varIdx == (int32_t)varIdx && vm->forStack[k].scopeTag == scopeTag) { matchIdx = k; break; } } if (matchIdx < 0) { runtimeError(vm, BAS_ERR_NEXT_WITHOUT_FOR, "NEXT variable mismatch"); return BAS_VM_ERROR; } forStackTrim(vm, matchIdx + 1); fs = &vm->forStack[matchIdx]; } BasValueT *varSlot = scopedVarSlot(vm, varIdx, scopeTag); if (!varSlot) { return BAS_VM_ERROR; } // Increment var by step and test against the limit: continue // while var <= limit for a non-negative step, var >= limit for // a negative one. INTEGER/LONG counters with an INTEGER/LONG // limit and step stay in integer math. uint8_t varType = varSlot->type; bool cont; if (fs->integral && isIntegerType(varType)) { int32_t stepInt = intValue(fs->step); int32_t limInt = intValue(fs->limit); int64_t next = (int64_t)intValue(*varSlot) + stepInt; cont = (stepInt >= 0) ? (next <= limInt) : (next >= limInt); *varSlot = forCounterValue(varType, false, (double)next); } else { double stepNum = basValToNumber(fs->step); double varVal = basValToNumber(*varSlot) + stepNum; cont = (stepNum >= 0) ? (varVal <= basValToNumber(fs->limit)) : (varVal >= basValToNumber(fs->limit)); basValRelease(varSlot); *varSlot = forCounterValue(varType, fs->stepFractional, varVal); } if (cont) { vm->pc += loopTopOffset; } else { // Loop done -- pop FOR state basValRelease(&fs->limit); basValRelease(&fs->step); vm->forDepth--; } break; } case OP_FOR_POP: { if (vm->forDepth <= 0) { runtimeError(vm, BAS_ERR_NEXT_WITHOUT_FOR, "FOR stack underflow"); return BAS_VM_ERROR; } BasForStateT *fs = &vm->forStack[--vm->forDepth]; basValRelease(&fs->limit); basValRelease(&fs->step); break; } // ============================================================ // Type conversion // ============================================================ case OP_CONV_INT_FLT: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; double n = basValToNumber(*top); basValRelease(top); *top = basValSingle((float)n); break; } case OP_CONV_FLT_INT: case OP_CONV_STR_INT: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; int32_t n; if (!basValRoundToInt32(*top, INT16_MIN, INT16_MAX, &n)) { runtimeError(vm, BAS_ERR_OVERFLOW, "Overflow"); return BAS_VM_ERROR; } basValRelease(top); *top = basValInteger((int16_t)n); break; } case OP_CONV_INT_STR: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; BasValueT conv = basValToString(*top); basValRelease(top); *top = conv; break; } case OP_CONV_STR_FLT: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; BasValueT conv = basValToDouble(*top); basValRelease(top); *top = conv; break; } case OP_CONV_INT_LONG: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; int32_t n; if (!basValRoundToInt32(*top, INT32_MIN, INT32_MAX, &n)) { runtimeError(vm, BAS_ERR_OVERFLOW, "Overflow"); return BAS_VM_ERROR; } basValRelease(top); *top = basValLong(n); break; } // ============================================================ // I/O // ============================================================ case OP_PRINT: return execPrint(vm); case OP_PRINT_NL: printText(vm, "", true); break; case OP_LPRINT: return execLprint(vm, readUint8(vm)); case OP_PRINT_TAB: { // Comma: advance to the next print zone. int32_t column = *printColumnOf(vm); int32_t target = (column / BAS_PRINT_ZONE_WIDTH + 1) * BAS_PRINT_ZONE_WIDTH; char spaces[BAS_PRINT_ZONE_WIDTH + 1]; int32_t count = target - column; memset(spaces, ' ', count); spaces[count] = '\0'; printText(vm, spaces, false); break; } case OP_PRINT_SPC_N: { BasValueT nVal; if (!pop(vm, &nVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t count = basValToInt32(nVal); basValRelease(&nVal); if (count < 0) { count = 0; } if (count > BAS_PRINT_SPC_MAX) { count = BAS_PRINT_SPC_MAX; } char spaces[BAS_PRINT_SPC_MAX + 1]; memset(spaces, ' ', count); spaces[count] = '\0'; printText(vm, spaces, false); break; } case OP_PRINT_TAB_N: { BasValueT nVal; if (!pop(vm, &nVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t col = basValToInt32(nVal); basValRelease(&nVal); if (col < 1) { col = 1; } if (col > BAS_PRINT_SPC_MAX) { col = BAS_PRINT_SPC_MAX; } // TAB(n) pads to column n (1-based). When the cursor is // already past it, QB starts a new line first. if (*printColumnOf(vm) > col - 1) { printText(vm, "", true); } char spaces[BAS_PRINT_SPC_MAX + 1]; int32_t count = col - 1 - *printColumnOf(vm); memset(spaces, ' ', count); spaces[count] = '\0'; printText(vm, spaces, false); break; } case OP_PRINT_USING: { // [uint8 flags] pop value and format string (format is below // value on stack); push the format back for the next value, // then the literal text and formatted field for this one. uint8_t flags = readUint8(vm); BasValueT val; BasValueT fmtVal; if (!popArgs(vm, 2, &val, &fmtVal)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT fmtStr = basValToString(fmtVal); basValRelease(&fmtVal); if (flags & BAS_USING_FIRST) { vm->usingPos = 0; } BasStringT *out = usingFormat(vm, fmtStr.strVal, val, (flags & BAS_USING_LAST) != 0); basValRelease(&val); if (!out) { basValRelease(&fmtStr); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "PRINT USING field does not match the value"); return BAS_VM_TYPE_MISMATCH; } if (!push(vm, fmtStr)) { basStringUnref(out); return BAS_VM_STACK_OVERFLOW; } if (!push(vm, strValue(out))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_INPUT: { // Pop the prompt string pushed by the parser BasValueT promptVal; if (!pop(vm, &promptVal)) { return BAS_VM_STACK_UNDERFLOW; } // Build the full prompt: "user prompt? " char promptBuf[BAS_INPUT_PROMPT_LEN]; const char *userPrompt = ""; if (promptVal.type == BAS_TYPE_STRING && promptVal.strVal) { userPrompt = promptVal.strVal->data; } if (userPrompt[0]) { snprintf(promptBuf, sizeof(promptBuf), "%s? ", userPrompt); } else { snprintf(promptBuf, sizeof(promptBuf), "? "); } char buf[BAS_INPUT_LINE_LEN]; buf[0] = '\0'; if (vm->inputFn) { if (!vm->inputFn(vm->inputCtx, promptBuf, buf, sizeof(buf))) { buf[0] = '\0'; } } basValRelease(&promptVal); if (!push(vm, basValStringFromC(buf))) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // Math built-ins // ============================================================ case OP_MATH_ABS: case OP_MATH_INT: case OP_MATH_FIX: case OP_MATH_SGN: case OP_MATH_SQR: case OP_MATH_SIN: case OP_MATH_COS: case OP_MATH_TAN: case OP_MATH_ATN: case OP_MATH_LOG: case OP_MATH_EXP: case OP_MATH_RND: case OP_MATH_RANDOMIZE: return execMath(vm, op); case OP_RGB: { // RGB(r, g, b) -> long color 0x00RRGGBB BasValueT vb; BasValueT vg; BasValueT vr; if (!popArgs(vm, 3, &vb, &vg, &vr)) { return BAS_VM_STACK_UNDERFLOW; } int32_t r = clampComponent(basValToInt32(vr)); int32_t g = clampComponent(basValToInt32(vg)); int32_t b = clampComponent(basValToInt32(vb)); basValRelease(&vr); basValRelease(&vg); basValRelease(&vb); if (!push(vm, basValLong((r << BAS_RGB_RED_SHIFT) | (g << BAS_RGB_GREEN_SHIFT) | b))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_GET_RED: case OP_GET_GREEN: case OP_GET_BLUE: { BasValueT vc; if (!pop(vm, &vc)) { return BAS_VM_STACK_UNDERFLOW; } int32_t color = basValToInt32(vc); basValRelease(&vc); int32_t component; if (op == OP_GET_RED) { component = (color >> BAS_RGB_RED_SHIFT) & BAS_RGB_CHANNEL_MASK; } else if (op == OP_GET_GREEN) { component = (color >> BAS_RGB_GREEN_SHIFT) & BAS_RGB_CHANNEL_MASK; } else { component = color & BAS_RGB_CHANNEL_MASK; } if (!push(vm, basValInteger((int16_t)component))) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // Conversion built-ins // ============================================================ case OP_STR_VAL: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; double n = basValToNumber(*top); basValRelease(top); *top = basValDouble(n); break; } case OP_STR_STRF: { // STR$(n): VB convention -- leading space for positive, "-" for negative if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; BasValueT num = *top; // Same digits as PRINT (basValFormatString), so STR$ and PRINT // never disagree; booleans and strings go through as numbers. if (num.type == BAS_TYPE_BOOLEAN || num.type == BAS_TYPE_STRING) { num = basValDouble(basValToNumber(num)); } BasStringT *digits = basValFormatString(num); BasStringT *result; if (digits->data[0] == '-') { result = basStringRef(digits); } else { BasStringT *space = basStringNew(" ", 1); result = basStringConcat(space, digits); basStringUnref(space); } basStringUnref(digits); basValRelease(top); *top = strValue(result); break; } case OP_STR_HEX: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; int32_t n = basValToInt32(*top); char buf[BAS_RADIX_STR_LEN]; snprintf(buf, sizeof(buf), "%X", (unsigned int)n); basValRelease(top); *top = basValStringFromC(buf); break; } case OP_STR_OCT: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; int32_t n = basValToInt32(*top); char buf[BAS_RADIX_STR_LEN]; snprintf(buf, sizeof(buf), "%o", (unsigned int)n); basValRelease(top); *top = basValStringFromC(buf); break; } case OP_CONV_BOOL: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; bool truthy; if (top->type == BAS_TYPE_STRING) { truthy = (top->strVal && top->strVal->len > 0); } else { truthy = (basValToNumber(*top) != 0.0); } basValRelease(top); top->type = BAS_TYPE_BOOLEAN; top->boolVal = truthy ? -1 : 0; break; } case OP_STR_STRING: { // STRING$(n, char) BasValueT charVal; BasValueT countVal; if (!popArgs(vm, 2, &charVal, &countVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t count = basValToInt32(countVal); basValRelease(&countVal); char ch; if (charVal.type == BAS_TYPE_STRING && charVal.strVal && charVal.strVal->len > 0) { ch = charVal.strVal->data[0]; } else { ch = (char)(basValToInt32(charVal) & BAS_CHAR_MASK); } basValRelease(&charVal); if (count < 0 || count > BAS_STRING_FUNC_MAX) { runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } if (!push(vm, strValue(fillString(ch, count)))) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // Extended built-ins // ============================================================ case OP_MATH_TIMER: { // Push seconds since midnight as a double, with sub-second // resolution so timing loops do not stall for up to a second. struct tm t; int32_t usec; localNow(&t, &usec); double secs = (double)t.tm_hour * BAS_SECS_PER_HOUR + (double)t.tm_min * BAS_SECS_PER_MINUTE + (double)t.tm_sec + (double)usec / BAS_USEC_PER_SEC; if (!push(vm, basValDouble(secs))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_DATE_STR: { // Push DATE$ as "MM-DD-YYYY" struct tm t; char buf[BAS_DATE_STR_LEN]; localNow(&t, NULL); snprintf(buf, sizeof(buf), "%02d-%02d-%04d", t.tm_mon + 1, t.tm_mday, t.tm_year + 1900); if (!push(vm, basValStringFromC(buf))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_TIME_STR: { // Push TIME$ as "HH:MM:SS" struct tm t; char buf[BAS_TIME_STR_LEN]; localNow(&t, NULL); snprintf(buf, sizeof(buf), "%02d:%02d:%02d", t.tm_hour, t.tm_min, t.tm_sec); if (!push(vm, basValStringFromC(buf))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_SLEEP: { BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } int32_t secs = basValToInt32(val); basValRelease(&val); if (!sleepSeconds(vm, secs)) { vm->running = false; return BAS_VM_HALTED; } break; } case OP_ENVIRON: { // Pop env var name, push value string BasValueT nameVal; if (!pop(vm, &nameVal)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT nameStr = basValToString(nameVal); basValRelease(&nameVal); const char *envVal = getenv(nameStr.strVal->data); basValRelease(&nameStr); if (envVal == NULL) { envVal = ""; } if (!push(vm, basValStringFromC(envVal))) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // File I/O // ============================================================ case OP_FILE_OPEN: case OP_FILE_CLOSE: case OP_FILE_PRINT: case OP_FILE_INPUT: case OP_FILE_EOF: case OP_FILE_LINE_INPUT: case OP_FILE_WRITE: case OP_FILE_WRITE_SEP: case OP_FILE_WRITE_NL: case OP_FILE_GET: case OP_FILE_PUT: case OP_FILE_PUT_UDT: case OP_FILE_SEEK: case OP_FILE_SEEK_GET: case OP_FILE_LOF: case OP_FILE_LOC: case OP_FILE_FREEFILE: case OP_FILE_INPUT_N: return execFileOp(vm, op); case OP_FS_KILL: case OP_FS_NAME: case OP_FS_FILECOPY: case OP_FS_MKDIR: case OP_FS_RMDIR: case OP_FS_CHDIR: case OP_FS_CHDRIVE: case OP_FS_CURDIR: case OP_FS_DIR: case OP_FS_DIR_NEXT: case OP_FS_FILELEN: case OP_FS_GETATTR: case OP_FS_SETATTR: return execFsOp(vm, op); // ============================================================ // DoEvents // ============================================================ case OP_DO_EVENTS: if (vm->doEventsFn) { if (!vm->doEventsFn(vm->doEventsCtx)) { vm->running = false; return BAS_VM_HALTED; } } break; // ============================================================ // Error handling // ============================================================ case OP_ON_ERROR: { int16_t handler = readInt16(vm); int32_t target = (handler == 0) ? 0 : vm->pc + handler; // Record the handler on the current call frame. The error // dispatcher walks frames (innermost outward) to find a // handler and unwinds the stack to that frame before // jumping. Module-level code lives in frame 0. currentFrame(vm)->errorHandler = target; break; } case OP_ERR_NUM: if (!push(vm, basValLong(vm->errorNumber))) { return BAS_VM_STACK_OVERFLOW; } break; case OP_ERL: if (!push(vm, basValLong(vm->errorLine))) { return BAS_VM_STACK_OVERFLOW; } break; case OP_RESUME: case OP_RESUME_NEXT: { // RESUME re-executes the statement that raised the error; // RESUME NEXT continues at the statement after it. Only this // frame's own running handler can resume (QBASIC error 20). BasCallFrameT *frame = currentFrame(vm); if (!frame->inHandler) { runtimeError(vm, BAS_ERR_RESUME_WITHOUT_ERR, "RESUME without error"); return BAS_VM_ERROR; } int32_t target = (op == OP_RESUME) ? frame->resumePc : frame->resumeNextPc; if (target < 0) { runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "RESUME NEXT has no statement to continue at"); return BAS_VM_ERROR; } vm->pc = target; frame->inHandler = false; clearErrorState(vm); break; } case OP_RAISE_ERR: { BasValueT errVal; if (!pop(vm, &errVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t errNum = basValToInt32(errVal); basValRelease(&errVal); runtimeError(vm, errNum, errorText(errNum)); return BAS_VM_ERROR; } // ============================================================ // Array / UDT operations // ============================================================ case OP_DIM_ARRAY: { uint8_t dims = readUint8(vm); uint8_t elementType = readUint8(vm); // dims=0 with elementType=BAS_TYPE_UDT means allocate a UDT instance if (dims == 0 && elementType == BAS_TYPE_UDT) { BasValueT fieldCountVal; BasValueT typeIdVal; BasValueT layoutVal; if (!popArgs(vm, 3, &fieldCountVal, &typeIdVal, &layoutVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t fieldCount = basValToInt32(fieldCountVal); int32_t typeId = basValToInt32(typeIdVal); basValRelease(&fieldCountVal); basValRelease(&typeIdVal); if (layoutVal.type != BAS_TYPE_STRING || !layoutVal.strVal) { basValRelease(&layoutVal); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Bad TYPE layout"); return BAS_VM_TYPE_MISMATCH; } int32_t pos = 0; BasUdtT *udt = udtFromLayout(vm, layoutVal.strVal, &pos, typeId, fieldCount, 0); basValRelease(&layoutVal); if (!udt) { return BAS_VM_ERROR; } BasValueT udtVal; udtVal.type = BAS_TYPE_UDT; udtVal.udtVal = udt; if (!push(vm, udtVal)) { return BAS_VM_STACK_OVERFLOW; } break; } BasArrayT *arr; BasVmResultE rc = allocArray(vm, dims, elementType, false, &arr); if (rc != BAS_VM_OK) { return rc; } BasValueT arrVal; arrVal.type = BAS_TYPE_ARRAY; arrVal.arrVal = arr; if (!push(vm, arrVal)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_LOAD_ARRAY: { uint8_t dims = readUint8(vm); BasValueT arrRef; int32_t flatIdx; BasVmResultE rc = popArrayElement(vm, dims, &arrRef, &flatIdx); if (rc != BAS_VM_OK) { return rc; } BasValueT elem = basValCopy(arrRef.arrVal->elements[flatIdx]); basValRelease(&arrRef); if (!push(vm, elem)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_PUSH_ARR_ADDR: { // Pass `arr(i)` as a BYREF parameter: push a BAS_TYPE_ELEM_REF // that owns a counted reference to the array plus the element // index. Holding the reference keeps the element storage alive // even if the callee REDIMs or ERASEs the array variable, and // the index is resolved on every load/store instead of caching // a raw element pointer. uint8_t dims = readUint8(vm); BasValueT arrRef; int32_t flatIdx; BasVmResultE rc = popArrayElement(vm, dims, &arrRef, &flatIdx); if (rc != BAS_VM_OK) { return rc; } // The popped arrRef's reference count transfers to the REF. BasValueT ref; ref.type = BAS_TYPE_ELEM_REF; ref.elemRef.arr = arrRef.arrVal; ref.elemRef.idx = flatIdx; if (!push(vm, ref)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_STORE_ARRAY: case OP_STORE_ARRAY_FIELD: { // [uint8 dims] (STORE_ARRAY_FIELD adds [uint16 fieldIdx]): pop // the value, then the subscripts and array reference. uint8_t dims = readUint8(vm); uint16_t fieldIdx = (op == OP_STORE_ARRAY_FIELD) ? readUint16(vm) : 0; BasValueT storeVal; if (!pop(vm, &storeVal)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT arrRef; int32_t flatIdx; BasVmResultE rc = popArrayElement(vm, dims, &arrRef, &flatIdx); if (rc != BAS_VM_OK) { basValRelease(&storeVal); return rc; } BasValueT *target = &arrRef.arrVal->elements[flatIdx]; if (op == OP_STORE_ARRAY_FIELD) { // Element must be a UDT if (target->type != BAS_TYPE_UDT || !target->udtVal) { basValRelease(&arrRef); basValRelease(&storeVal); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Array element is not a TYPE instance"); return BAS_VM_TYPE_MISMATCH; } if (fieldIdx >= (uint16_t)target->udtVal->fieldCount) { basValRelease(&arrRef); basValRelease(&storeVal); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid field index"); return BAS_VM_ERROR; } target = &target->udtVal->fields[fieldIdx]; } bool stored = storeElement(vm, target, storeVal); basValRelease(&arrRef); if (!stored) { return BAS_VM_TYPE_MISMATCH; } break; } case OP_REDIM: { uint8_t dims = readUint8(vm); uint8_t preserve = readUint8(vm); uint8_t elementType = readUint8(vm); // Same stack layout as OP_DIM_ARRAY (bounds, then UDT typeId and // fieldCount), with the old array reference underneath; PRESERVE // copies its elements while it is still on the stack. BasArrayT *newArr; BasVmResultE rc = allocArray(vm, dims, elementType, preserve != 0, &newArr); if (rc != BAS_VM_OK) { return rc; } BasValueT oldRef; if (!pop(vm, &oldRef)) { basArrayUnref(newArr); return BAS_VM_STACK_UNDERFLOW; } basValRelease(&oldRef); BasValueT arrVal; arrVal.type = BAS_TYPE_ARRAY; arrVal.arrVal = newArr; if (!push(vm, arrVal)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_ERASE: { // [uint8 mode] A fixed array keeps its bounds and has every // element reset; a dynamic array is released and stays // undimensioned until the next REDIM. uint8_t mode = readUint8(vm); BasValueT arrRef; if (!pop(vm, &arrRef)) { return BAS_VM_STACK_UNDERFLOW; } if (mode == BAS_ERASE_ZERO && arrRef.type == BAS_TYPE_ARRAY && arrRef.arrVal) { arrayClear(arrRef.arrVal); if (!push(vm, arrRef)) { return BAS_VM_STACK_OVERFLOW; } break; } basValRelease(&arrRef); // Push an empty/zero value to store back BasValueT empty; memset(&empty, 0, sizeof(empty)); if (!push(vm, empty)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_LBOUND: case OP_UBOUND: return boundOp(vm, op); case OP_LOAD_FIELD: { uint16_t fieldIdx = readUint16(vm); BasValueT udtRef; if (!pop(vm, &udtRef)) { return BAS_VM_STACK_UNDERFLOW; } if (udtRef.type != BAS_TYPE_UDT || !udtRef.udtVal) { basValRelease(&udtRef); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Not a TYPE instance"); return BAS_VM_TYPE_MISMATCH; } if (fieldIdx >= (uint16_t)udtRef.udtVal->fieldCount) { basValRelease(&udtRef); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid field index"); return BAS_VM_ERROR; } BasValueT fieldVal = basValCopy(udtRef.udtVal->fields[fieldIdx]); basValRelease(&udtRef); if (!push(vm, fieldVal)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_STORE_FIELD: { uint16_t fieldIdx = readUint16(vm); BasValueT storeVal; if (!pop(vm, &storeVal)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT udtRef; if (!pop(vm, &udtRef)) { basValRelease(&storeVal); return BAS_VM_STACK_UNDERFLOW; } if (udtRef.type != BAS_TYPE_UDT || !udtRef.udtVal) { basValRelease(&udtRef); basValRelease(&storeVal); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Not a TYPE instance"); return BAS_VM_TYPE_MISMATCH; } if (fieldIdx >= (uint16_t)udtRef.udtVal->fieldCount) { basValRelease(&udtRef); basValRelease(&storeVal); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid field index"); return BAS_VM_ERROR; } bool stored = storeElement(vm, &udtRef.udtVal->fields[fieldIdx], storeVal); basValRelease(&udtRef); if (!stored) { return BAS_VM_TYPE_MISMATCH; } break; } // ============================================================ // DATA/READ/RESTORE // ============================================================ case OP_READ_DATA: { if (vm->dataPtr >= vm->module->dataCount) { runtimeError(vm, BAS_ERR_OUT_OF_DATA, "Out of DATA"); return BAS_VM_ERROR; } if (!push(vm, basValCopy(vm->module->dataPool[vm->dataPtr++]))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_RESTORE: vm->dataPtr = 0; break; // ============================================================ // FORMAT$ // ============================================================ case OP_FORMAT: { // Pop format string, then value BasValueT fmtVal; BasValueT val; if (!popArgs(vm, 2, &fmtVal, &val)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT fmtStr = basValToString(fmtVal); basValRelease(&fmtVal); const char *fmt = fmtStr.strVal->data; int32_t fmtLen = fmtStr.strVal->len; double n = basValToNumber(val); basValRelease(&val); char buf[BAS_FORMAT_BUF_SIZE]; buf[0] = '\0'; if (strcasecmp(fmt, BAS_FORMAT_PERCENT) == 0) { snprintf(buf, sizeof(buf), "%.0f%%", n * 100.0); } else { BasNumFormatT f; bool sciNotation; parseNumFormat(fmt, fmtLen, &f, &sciNotation); formatNumber(n, &f, buf, sizeof(buf)); } basValRelease(&fmtStr); if (!push(vm, basValStringFromC(buf))) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // SHELL // ============================================================ case OP_SHELL: { BasValueT cmdVal; if (!pop(vm, &cmdVal)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT cmdStr = basValToString(cmdVal); basValRelease(&cmdVal); int32_t result = 0; if (cmdStr.strVal && cmdStr.strVal->len > 0) { result = system(cmdStr.strVal->data); } basValRelease(&cmdStr); if (!push(vm, basValInteger((int16_t)result))) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // COMPARE_MODE // ============================================================ case OP_COMPARE_MODE: { uint8_t mode = readUint8(vm); vm->compareTextMode = (mode == BAS_COMPARE_MODE_TEXT); break; } // ============================================================ // Halt // ============================================================ case OP_END: case OP_HALT: // Any error state left here belongs to a handler that ended // the program, which has dealt with it: clear it so the host // does not report a trapped error as an unhandled one. clearErrorState(vm); vm->running = false; vm->ended = vm->ended || (op == OP_END); return BAS_VM_HALTED; // ============================================================ // UI / Event opcodes (name-based resolution) // ============================================================ case OP_LOAD_PROP: { BasValueT propNameVal; BasValueT ctrlRefVal; if (!popArgs(vm, 2, &propNameVal, &ctrlRefVal)) { return BAS_VM_STACK_UNDERFLOW; } BasVmResultE rc = uiTarget(vm, vm->ui.getProp != NULL, ctrlRefVal); if (rc != BAS_VM_OK) { basValRelease(&propNameVal); basValRelease(&ctrlRefVal); return rc; } BasValueT sv = basValToString(propNameVal); BasValueT result = vm->ui.getProp(vm->ui.ctx, ctrlRefVal.objVal, sv.strVal->data); basValRelease(&sv); basValRelease(&propNameVal); basValRelease(&ctrlRefVal); if (!push(vm, result)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_STORE_PROP: { BasValueT value; BasValueT propNameVal; BasValueT ctrlRefVal; if (!popArgs(vm, 3, &value, &propNameVal, &ctrlRefVal)) { return BAS_VM_STACK_UNDERFLOW; } BasVmResultE rc = uiTarget(vm, vm->ui.setProp != NULL, ctrlRefVal); if (rc == BAS_VM_OK) { BasValueT sv = basValToString(propNameVal); vm->ui.setProp(vm->ui.ctx, ctrlRefVal.objVal, sv.strVal->data, value); basValRelease(&sv); } basValRelease(&value); basValRelease(&propNameVal); basValRelease(&ctrlRefVal); return rc; } case OP_CALL_METHOD: { uint8_t argc = readUint8(vm); int32_t argCount = argc; BasValueT methodNameVal; BasValueT ctrlRefVal; BasValueT args[BAS_VM_MAX_CALL_ARGS]; // Reject an over-limit argc rather than silently truncating, which // would leak the un-popped args and desync the eval stack. Drain // every pushed operand (args + method name + control ref) first to // keep the stack balanced, then raise the error. if (argc > BAS_VM_MAX_CALL_ARGS) { dropValues(vm, argc + BAS_CALL_METHOD_FIXED_OPERANDS); runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Too many arguments in method call"); return BAS_VM_ERROR; } // Pop args in reverse for (int32_t i = argCount - 1; i >= 0; i--) { if (!pop(vm, &args[i])) { for (int32_t j = i + 1; j < argCount; j++) { basValRelease(&args[j]); } return BAS_VM_STACK_UNDERFLOW; } } if (!pop(vm, &methodNameVal)) { for (int32_t i = 0; i < argCount; i++) { basValRelease(&args[i]); } return BAS_VM_STACK_UNDERFLOW; } if (!pop(vm, &ctrlRefVal)) { // methodNameVal was already popped -- release it too or // its reference leaks on this underflow path. basValRelease(&methodNameVal); for (int32_t i = 0; i < argCount; i++) { basValRelease(&args[i]); } return BAS_VM_STACK_UNDERFLOW; } BasValueT result = basValInteger(0); BasVmResultE rc = uiTarget(vm, vm->ui.callMethod != NULL, ctrlRefVal); if (rc == BAS_VM_OK) { BasValueT sv = basValToString(methodNameVal); result = vm->ui.callMethod(vm->ui.ctx, ctrlRefVal.objVal, sv.strVal->data, args, argCount); basValRelease(&sv); } for (int32_t i = 0; i < argCount; i++) { basValRelease(&args[i]); } basValRelease(&methodNameVal); basValRelease(&ctrlRefVal); if (rc != BAS_VM_OK) { return rc; } if (!push(vm, result)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_LOAD_FORM: { BasValueT nameVal; if (!pop(vm, &nameVal)) { return BAS_VM_STACK_UNDERFLOW; } void *formRef = NULL; if (vm->ui.loadForm) { BasValueT sv = basValToString(nameVal); formRef = vm->ui.loadForm(vm->ui.ctx, sv.strVal->data); basValRelease(&sv); } // Set as current form for subsequent FIND_CTRL calls if (formRef) { vm->currentForm = formRef; } basValRelease(&nameVal); if (!vm->ui.loadForm) { return noFormRuntime(vm); } if (!push(vm, basValObject(formRef))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_UNLOAD_FORM: { BasValueT formVal; if (!pop(vm, &formVal)) { return BAS_VM_STACK_UNDERFLOW; } BasVmResultE rc = uiTarget(vm, vm->ui.unloadForm != NULL, formVal); if (rc == BAS_VM_OK) { vm->ui.unloadForm(vm->ui.ctx, formVal.objVal); } basValRelease(&formVal); return rc; } case OP_SHOW_FORM: { uint8_t modal = readUint8(vm); BasValueT formVal; if (!pop(vm, &formVal)) { return BAS_VM_STACK_UNDERFLOW; } BasVmResultE rc = uiTarget(vm, vm->ui.showForm != NULL, formVal); if (rc == BAS_VM_OK) { vm->ui.showForm(vm->ui.ctx, formVal.objVal, modal != 0); } basValRelease(&formVal); return rc; } case OP_HIDE_FORM: { BasValueT formVal; if (!pop(vm, &formVal)) { return BAS_VM_STACK_UNDERFLOW; } BasVmResultE rc = uiTarget(vm, vm->ui.hideForm != NULL, formVal); if (rc == BAS_VM_OK) { vm->ui.hideForm(vm->ui.ctx, formVal.objVal); } basValRelease(&formVal); return rc; } case OP_MSGBOX: { // Stack: [message, flags, title] -- title on top BasValueT titleVal; BasValueT flagsVal; BasValueT msgVal; if (!popArgs(vm, 3, &titleVal, &flagsVal, &msgVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t flags = basValToInt32(flagsVal); int32_t result = 1; // default OK if (vm->ui.msgBox) { BasValueT sv = basValToString(msgVal); BasValueT tv = basValToString(titleVal); result = vm->ui.msgBox(vm->ui.ctx, sv.strVal->data, flags, tv.strVal->data); basValRelease(&sv); basValRelease(&tv); } basValRelease(&titleVal); basValRelease(&flagsVal); basValRelease(&msgVal); if (!vm->ui.msgBox) { return noFormRuntime(vm); } if (!push(vm, basValInteger((int16_t)result))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_INPUTBOX: { BasValueT defaultVal; BasValueT titleVal; BasValueT promptVal; if (!popArgs(vm, 3, &defaultVal, &titleVal, &promptVal)) { return BAS_VM_STACK_UNDERFLOW; } BasStringT *result = NULL; if (vm->ui.inputBox) { BasValueT sp = basValToString(promptVal); BasValueT st = basValToString(titleVal); BasValueT sd = basValToString(defaultVal); result = vm->ui.inputBox(vm->ui.ctx, sp.strVal->data, st.strVal->data, sd.strVal->data); basValRelease(&sp); basValRelease(&st); basValRelease(&sd); } basValRelease(&defaultVal); basValRelease(&titleVal); basValRelease(&promptVal); if (!vm->ui.inputBox) { return noFormRuntime(vm); } if (!push(vm, strValue(result ? result : basStringRef(basEmptyString)))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_ME_REF: if (!push(vm, basValObject(vm->currentForm))) { return BAS_VM_STACK_OVERFLOW; } break; case OP_CREATE_CTRL: { BasValueT nameVal; BasValueT typeVal; BasValueT formVal; if (!popArgs(vm, 3, &nameVal, &typeVal, &formVal)) { return BAS_VM_STACK_UNDERFLOW; } void *ctrlRef = NULL; BasVmResultE rc = uiTarget(vm, vm->ui.createCtrl != NULL, formVal); if (rc == BAS_VM_OK) { BasValueT sv1 = basValToString(typeVal); BasValueT sv2 = basValToString(nameVal); ctrlRef = vm->ui.createCtrl(vm->ui.ctx, formVal.objVal, sv1.strVal->data, sv2.strVal->data); basValRelease(&sv1); basValRelease(&sv2); } basValRelease(&nameVal); basValRelease(&typeVal); basValRelease(&formVal); if (rc != BAS_VM_OK) { return rc; } if (!push(vm, basValObject(ctrlRef))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_CREATE_CTRL_EX: { // Stack: [formRef, typeStr, nameStr, parentRef] -- parent on top BasValueT parentVal; BasValueT nameVal; BasValueT typeVal; BasValueT formVal; if (!popArgs(vm, 4, &parentVal, &nameVal, &typeVal, &formVal)) { return BAS_VM_STACK_UNDERFLOW; } void *ctrlRef = NULL; BasVmResultE rc = uiTarget(vm, vm->ui.createCtrlEx != NULL, formVal); if (rc == BAS_VM_OK) { BasValueT sv1 = basValToString(typeVal); BasValueT sv2 = basValToString(nameVal); void *parentRef = (parentVal.type == BAS_TYPE_OBJECT) ? parentVal.objVal : NULL; ctrlRef = vm->ui.createCtrlEx(vm->ui.ctx, formVal.objVal, sv1.strVal->data, sv2.strVal->data, parentRef); basValRelease(&sv1); basValRelease(&sv2); } basValRelease(&parentVal); basValRelease(&nameVal); basValRelease(&typeVal); basValRelease(&formVal); if (rc != BAS_VM_OK) { return rc; } if (!push(vm, basValObject(ctrlRef))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FIND_CTRL: { BasValueT nameVal; BasValueT formVal; if (!popArgs(vm, 2, &nameVal, &formVal)) { return BAS_VM_STACK_UNDERFLOW; } void *ctrlRef = NULL; if (vm->ui.findCtrl) { // Use current form if formRef is NULL or not an object void *formRef = (formVal.type == BAS_TYPE_OBJECT) ? formVal.objVal : vm->currentForm; BasValueT sv = basValToString(nameVal); ctrlRef = vm->ui.findCtrl(vm->ui.ctx, formRef, sv.strVal->data); basValRelease(&sv); } basValRelease(&nameVal); basValRelease(&formVal); if (!vm->ui.findCtrl) { return noFormRuntime(vm); } if (!push(vm, basValObject(ctrlRef))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FIND_CTRL_IDX: { // Stack: [formRef, ctrlName, index] -- index on top BasValueT idxVal; BasValueT nameVal; BasValueT formVal; if (!popArgs(vm, 3, &idxVal, &nameVal, &formVal)) { return BAS_VM_STACK_UNDERFLOW; } void *ctrlRef = NULL; if (vm->ui.findCtrlIdx) { void *formRef = (formVal.type == BAS_TYPE_OBJECT) ? formVal.objVal : vm->currentForm; int32_t index = basValToInt32(idxVal); BasValueT sv = basValToString(nameVal); ctrlRef = vm->ui.findCtrlIdx(vm->ui.ctx, formRef, sv.strVal->data, index); basValRelease(&sv); } basValRelease(&idxVal); basValRelease(&nameVal); basValRelease(&formVal); if (!vm->ui.findCtrlIdx) { return noFormRuntime(vm); } if (!push(vm, basValObject(ctrlRef))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_CREATE_FORM: { // Stack: [nameStr, width, height] -- height on top BasValueT heightVal; BasValueT widthVal; BasValueT nameVal; if (!popArgs(vm, 3, &heightVal, &widthVal, &nameVal)) { return BAS_VM_STACK_UNDERFLOW; } void *formRef = NULL; if (vm->ui.createForm) { BasValueT sv = basValToString(nameVal); int32_t w = basValToInt32(widthVal); int32_t h = basValToInt32(heightVal); formRef = vm->ui.createForm(vm->ui.ctx, sv.strVal->data, w, h); basValRelease(&sv); } basValRelease(&nameVal); basValRelease(&widthVal); basValRelease(&heightVal); if (!vm->ui.createForm) { return noFormRuntime(vm); } if (!push(vm, basValObject(formRef))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_SET_EVENT: { // Stack: [ctrlRef, eventNameStr, handlerNameStr] -- handler on top BasValueT handlerVal; BasValueT eventVal; BasValueT ctrlVal; if (!popArgs(vm, 3, &handlerVal, &eventVal, &ctrlVal)) { return BAS_VM_STACK_UNDERFLOW; } BasVmResultE rc = uiTarget(vm, vm->ui.setEvent != NULL, ctrlVal); if (rc == BAS_VM_OK) { BasValueT sv1 = basValToString(eventVal); BasValueT sv2 = basValToString(handlerVal); vm->ui.setEvent(vm->ui.ctx, ctrlVal.objVal, sv1.strVal->data, sv2.strVal->data); basValRelease(&sv1); basValRelease(&sv2); } basValRelease(&handlerVal); basValRelease(&eventVal); basValRelease(&ctrlVal); return rc; } case OP_REMOVE_CTRL: { // Stack: [formRef, ctrlNameStr] -- name on top BasValueT nameVal; BasValueT formVal; if (!popArgs(vm, 2, &nameVal, &formVal)) { return BAS_VM_STACK_UNDERFLOW; } BasVmResultE rc = uiTarget(vm, vm->ui.removeCtrl != NULL, formVal); if (rc == BAS_VM_OK) { BasValueT sv = basValToString(nameVal); vm->ui.removeCtrl(vm->ui.ctx, formVal.objVal, sv.strVal->data); basValRelease(&sv); } basValRelease(&nameVal); basValRelease(&formVal); return rc; } // ============================================================ // Form-level variables // ============================================================ case OP_LOAD_FORM_VAR: { uint16_t idx = readUint16(vm); if (!vm->currentFormVars || idx >= (uint16_t)vm->currentFormVarCount) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Form variable access outside form context"); return BAS_VM_ERROR; } if (!push(vm, basValCopy(vm->currentFormVars[idx]))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_STORE_FORM_VAR: { uint16_t idx = readUint16(vm); BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } if (!vm->currentFormVars || idx >= (uint16_t)vm->currentFormVarCount) { basValRelease(&val); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Form variable access outside form context"); return BAS_VM_ERROR; } storeValue(&vm->currentFormVars[idx], val); break; } case OP_PUSH_FORM_ADDR: { uint16_t idx = readUint16(vm); if (!vm->currentFormVars || idx >= (uint16_t)vm->currentFormVarCount) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Form variable address outside form context"); return BAS_VM_ERROR; } BasValueT ref; ref.type = BAS_TYPE_REF; ref.refVal = &vm->currentFormVars[idx]; if (!push(vm, ref)) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // External library calls // ============================================================ case OP_CALL_EXTERN: { uint16_t libNameIdx = readUint16(vm); uint16_t funcNameIdx = readUint16(vm); uint8_t argc = readUint8(vm); uint8_t retType = readUint8(vm); const char *libName = (libNameIdx < (uint16_t)vm->module->constCount) ? vm->module->constants[libNameIdx]->data : ""; const char *funcName = (funcNameIdx < (uint16_t)vm->module->constCount) ? vm->module->constants[funcNameIdx]->data : ""; void *funcPtr = NULL; // The cache holds one entry per function-name constant; a hit // must also come from the same library. BasExternCacheEntryT *cached = (funcNameIdx < (uint16_t)vm->externCacheCount) ? &vm->externCache[funcNameIdx] : NULL; if (cached && cached->funcPtr && cached->libNameIdx == libNameIdx) { funcPtr = cached->funcPtr; } else { if (vm->ext.resolveExtern) { funcPtr = vm->ext.resolveExtern(vm->ext.ctx, libName, funcName); } if (!funcPtr) { char msg[BAS_VM_ERROR_MSG_LEN]; dropValues(vm, argc); snprintf(msg, sizeof(msg), "External function not found: %s", funcName[0] ? funcName : "?"); runtimeError(vm, BAS_ERR_EXTERNAL_NOT_FOUND, msg); return BAS_VM_ERROR; } if (cached) { cached->funcPtr = funcPtr; cached->libNameIdx = libNameIdx; } } // Reject an over-limit argc rather than silently truncating, which // would leak the un-popped args and desync the eval stack. Drain // the pushed args (extern has no extra fixed operands) to keep the // stack balanced, then raise the error. if (argc > BAS_VM_MAX_CALL_ARGS) { dropValues(vm, argc); runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Too many arguments in external call"); return BAS_VM_ERROR; } // Pop arguments (reverse order) BasValueT args[BAS_VM_MAX_CALL_ARGS]; int32_t argCount = argc; for (int32_t i = argCount - 1; i >= 0; i--) { if (!pop(vm, &args[i])) { for (int32_t j = i + 1; j < argCount; j++) { basValRelease(&args[j]); } return BAS_VM_STACK_UNDERFLOW; } } // Call through host callback BasValueT result = basValInteger(0); if (vm->ext.callExtern) { result = vm->ext.callExtern(vm->ext.ctx, funcPtr, libName, funcName, args, argCount, retType); } for (int32_t i = 0; i < argCount; i++) { basValRelease(&args[i]); } // Push return value (void functions still push a dummy 0) if (!push(vm, result)) { return BAS_VM_STACK_OVERFLOW; } break; } // ============================================================ // Debugger statement boundaries // ============================================================ case OP_LINE: { uint16_t lineNum = readUint16(vm); vm->currentLine = lineNum; // Snapshot the eval-stack depth at this statement boundary so an // ON ERROR GOTO dispatch can release any operands left half-pushed // by an error mid-expression and reset sp to here. Also remember // where the statement starts: RESUME re-executes it from here and // RESUME NEXT scans from here for the following statement. vm->stmtSp = vm->sp; vm->stmtPc = vm->currentOpPc; // Step into: break at any OP_LINE if (vm->debugBreak) { vm->debugBreak = false; return BAS_VM_BREAKPOINT; } // Step over: break when call depth returns to target level if (vm->stepOverDepth >= 0 && vm->callDepth <= vm->stepOverDepth) { vm->stepOverDepth = -1; return BAS_VM_BREAKPOINT; } // Step out: break when call depth drops below target if (vm->stepOutDepth >= 0 && vm->callDepth < vm->stepOutDepth) { vm->stepOutDepth = -1; return BAS_VM_BREAKPOINT; } // Run to cursor if (vm->runToCursorLine >= 0 && (int32_t)lineNum == vm->runToCursorLine) { vm->runToCursorLine = -1; return BAS_VM_BREAKPOINT; } // Breakpoint check (linear scan, typically < 20 entries) for (int32_t i = 0; i < vm->breakpointCount; i++) { if (vm->breakpoints[i] == (int32_t)lineNum) { return BAS_VM_BREAKPOINT; } } break; } case OP_COMMAND: { // Replace the argument index on top with COMMAND$(n) if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; int32_t n = basValToInt32(*top); if (n < 0) { runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } basValRelease(top); *top = strValue(commandArg(vm->commandArgs, n)); break; } case OP_APP_PATH: case OP_APP_CONFIG: case OP_APP_DATA: { const char *path = (op == OP_APP_PATH) ? vm->appPath : (op == OP_APP_CONFIG) ? vm->appConfig : vm->appData; if (!push(vm, basValStringFromC(path))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_INI_READ: { // Stack: file, section, key, default -> result string BasValueT defVal; BasValueT keyVal; BasValueT secVal; BasValueT fileVal; if (!popArgs(vm, 4, &defVal, &keyVal, &secVal, &fileVal)) { return BAS_VM_STACK_UNDERFLOW; } BasStringT *fileStr = basValFormatString(fileVal); BasStringT *secStr = basValFormatString(secVal); BasStringT *keyStr = basValFormatString(keyVal); BasStringT *defStr = basValFormatString(defVal); BasValueT resultVal = iniRead(fileStr->data, secStr->data, keyStr->data, defStr); basStringUnref(fileStr); basStringUnref(secStr); basStringUnref(keyStr); basStringUnref(defStr); basValRelease(&fileVal); basValRelease(&secVal); basValRelease(&keyVal); basValRelease(&defVal); if (!push(vm, resultVal)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_INI_WRITE: { // Stack: file, section, key, value BasValueT valVal; BasValueT keyVal; BasValueT secVal; BasValueT fileVal; if (!popArgs(vm, 4, &valVal, &keyVal, &secVal, &fileVal)) { return BAS_VM_STACK_UNDERFLOW; } BasStringT *fileStr = basValFormatString(fileVal); BasStringT *secStr = basValFormatString(secVal); BasStringT *keyStr = basValFormatString(keyVal); BasStringT *valStr = basValFormatString(valVal); BasVmResultE rc = iniWrite(vm, fileStr->data, secStr->data, keyStr->data, valStr->data); basStringUnref(fileStr); basStringUnref(secStr); basStringUnref(keyStr); basStringUnref(valStr); basValRelease(&fileVal); basValRelease(&secVal); basValRelease(&keyVal); basValRelease(&valVal); return rc; } default: runtimeError(vm, BAS_ERR_BAD_OPCODE, "Bad opcode"); return BAS_VM_BAD_OPCODE; } return BAS_VM_OK; } void basVmStepInto(BasVmT *vm) { if (vm) { vm->debugBreak = true; } } void basVmStepOut(BasVmT *vm) { if (vm) { vm->stepOutDepth = vm->callDepth; } } void basVmStepOver(BasVmT *vm) { if (vm) { vm->stepOverDepth = vm->callDepth; } } // OP_LBOUND / OP_UBOUND: [uint8 dim] array ref on stack -> LONG bound. static BasVmResultE boundOp(BasVmT *vm, uint8_t op) { uint8_t dim = readUint8(vm); BasValueT arrRef; if (!pop(vm, &arrRef)) { return BAS_VM_STACK_UNDERFLOW; } if (arrRef.type != BAS_TYPE_ARRAY || !arrRef.arrVal) { basValRelease(&arrRef); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Not an array"); return BAS_VM_TYPE_MISMATCH; } if (dim < 1 || dim > (uint8_t)arrRef.arrVal->dims) { basValRelease(&arrRef); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, (op == OP_LBOUND) ? "Invalid dimension for LBOUND" : "Invalid dimension for UBOUND"); return BAS_VM_SUBSCRIPT_RANGE; } int32_t bound = (op == OP_LBOUND) ? arrRef.arrVal->lbound[dim - 1] : arrRef.arrVal->ubound[dim - 1]; basValRelease(&arrRef); if (!push(vm, basValLong(bound))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } // Clamps an RGB channel value into [0, BAS_RGB_COMPONENT_MAX]. static int32_t clampComponent(int32_t c) { if (c < 0) { return 0; } if (c > BAS_RGB_COMPONENT_MAX) { return BAS_RGB_COMPONENT_MAX; } return c; } // Clears the Err state (ERR, ERL and the error message). static void clearErrorState(BasVmT *vm) { vm->errorNumber = 0; vm->errorLine = 0; vm->errorMsg[0] = '\0'; } // Closes a file channel if it is open and marks it free. // A printer channel's spooled output goes to the printer first; false // when that failed or was cancelled. static bool closeChannel(BasVmT *vm, int32_t channel) { BasFileChannelT *ch = &vm->files[channel]; bool ok = true; if (ch->printJob) { ok = sendSpool(vm, ch); } if (ch->handle) { fclose((FILE *)ch->handle); } ch->handle = NULL; ch->printJob = NULL; ch->mode = BAS_FILE_MODE_CLOSED; return ok; } // COMMAND$(n): the whole launch argument string for n = 0, else its nth // argument without quotes ("" when there are fewer). An argument is // never longer than the whole string, so that sizes the result. static BasStringT *commandArg(const char *args, int32_t n) { const char *p = args ? args : ""; int32_t len = (int32_t)strlen(p); if (n == 0) { return basStringNew(p, len); } BasStringT *s = basStringAlloc(len + 1); bool quoted = false; if (s->cap <= len) { return s; } for (int32_t i = 0; i < n && p; i++) { p = dvxNextArg(p, s->data, s->cap, "ed); } if (!p) { s->data[0] = '\0'; } s->len = (int32_t)strlen(s->data); return s; } static BasCallFrameT *currentFrame(BasVmT *vm) { if (vm->callDepth <= 0) { // Module-level: use callStack[0] as implicit main frame return &vm->callStack[0]; } return &vm->callStack[vm->callDepth - 1]; } static void defaultPrint(void *ctx, const char *text, bool newline) { (void)ctx; fputs(text, stdout); if (newline) { fputc('\n', stdout); } } // Resolves a variable slot through any ByRef indirection it holds: a plain // slot is returned as-is, a BAS_TYPE_REF yields the referenced slot, and a // BAS_TYPE_ELEM_REF yields the array element it names (NULL if the index // no longer exists in that array). static BasValueT *derefSlot(BasValueT *slot) { if (slot->type == BAS_TYPE_REF) { return slot->refVal; } if (slot->type == BAS_TYPE_ELEM_REF) { BasArrayT *arr = slot->elemRef.arr; if (!arr || slot->elemRef.idx < 0 || slot->elemRef.idx >= arr->totalElements) { return NULL; } return &arr->elements[slot->elemRef.idx]; } return slot; } // Dir$ state lives in BasVmT (vm->dirHandle/dirPattern/dirPath) so that a // second embedded VM cannot close another VM's in-progress enumeration. static void dirClose(BasVmT *vm) { if (vm->dirHandle) { closedir((DIR *)vm->dirHandle); vm->dirHandle = NULL; } } // Next Dir$ match. Like QB/VB Dir$ without a directory attribute, only // files are returned: ".", ".." and subdirectories are skipped. static const char *dirNext(BasVmT *vm) { if (!vm->dirHandle) { return NULL; } struct dirent *ent; while ((ent = readdir((DIR *)vm->dirHandle)) != NULL) { if (ent->d_name[0] == '.' && (ent->d_name[1] == '\0' || (ent->d_name[1] == '.' && ent->d_name[2] == '\0'))) { continue; } if (fnmatch(vm->dirPattern, ent->d_name, FNM_CASEFOLD) != 0) { continue; } char full[DVX_MAX_PATH]; struct stat st; snprintf(full, sizeof(full), "%s/%s", vm->dirPath, ent->d_name); if (stat(full, &st) == 0 && S_ISDIR(st.st_mode)) { continue; } return ent->d_name; } dirClose(vm); return NULL; } // Releases the top call frame without returning through it: its locals // are released, its FOR frames dropped and the caller's statement // boundary restored. Used when an error unwinds frames (dispatchError, // runSubLoop's failure and shutdown paths); no out-arg copy-back and no // error-state change, unlike popCallFrame. static void discardFrame(BasVmT *vm) { BasCallFrameT *frame = &vm->callStack[vm->callDepth - 1]; for (int32_t i = 0; i < frame->localCount; i++) { basValRelease(&frame->locals[i]); } forStackTrim(vm, frame->savedForDepth); vm->gosubDepth = frame->savedGosubDepth; vm->stmtPc = frame->savedStmtPc; vm->stmtSp = frame->savedStmtSp; vm->callDepth--; } // ON ERROR dispatch shared by basVmRun and runSubLoop. Given a failing // step result, finds the innermost frame (never below floorDepth) whose // ON ERROR GOTO handler can trap -- one is installed and is not already // running; an error raised inside a running handler passes to the // caller's handler, as in VB. When one exists, the frames above it are // discarded, the eval stack is truncated to the failing statement's // boundary, the frame's RESUME / RESUME NEXT targets are recorded and pc // points at the handler; returns true. Returns false, leaving every // frame in place for the host and debugger, when the error is untrapped. // // Without the unwind an error raised inside a called SUB would fire the // outer SUB's handler but OP_RET would then pop the inner frame and resume // after the call site (effectively RESUME NEXT semantics), which is not // what ON ERROR promises. static bool dispatchError(BasVmT *vm, BasVmResultE result, int32_t floorDepth, int32_t faultPc) { if (result == BAS_VM_HALTED || result == BAS_VM_BAD_OPCODE) { return false; } // Eval/call stack exhaustion bypasses runtimeError(), so give the // handler a real ERR value instead of 0. if (result == BAS_VM_STACK_OVERFLOW || result == BAS_VM_STACK_UNDERFLOW || result == BAS_VM_CALL_OVERFLOW) { runtimeError(vm, BAS_ERR_OUT_OF_STACK, "Out of stack space"); } int32_t trapDepth = vm->callDepth; while (trapDepth > floorDepth) { const BasCallFrameT *frame = &vm->callStack[trapDepth - 1]; if (frame->errorHandler != 0 && !frame->inHandler) { break; } trapDepth--; } if (trapDepth <= floorDepth) { return false; } // Discard the frames above the handler's. RESUME must land in the // handler frame's code, never in a discarded callee's: the resume // point becomes the call that led out of the handler frame. int32_t resumeStart = faultPc; bool unwound = false; while (vm->callDepth > trapDepth) { resumeStart = vm->callStack[vm->callDepth - 1].returnPc; unwound = true; discardFrame(vm); } // Release any operands the failed statement half-pushed before the // error fired, then truncate the eval stack back to the statement // boundary so trapped errors in a loop don't leak values and grow sp // without bound. while (vm->sp > vm->stmtSp) { basValRelease(&vm->stack[--vm->sp]); } // The eval stack is now at the failing statement's boundary, so RESUME // re-runs that statement from its start and RESUME NEXT continues where // nextStatementPc says the statement ends -- never mid-statement. BasCallFrameT *frame = &vm->callStack[trapDepth - 1]; frame->inHandler = true; frame->resumePc = (vm->stmtPc >= 0) ? vm->stmtPc : resumeStart; frame->resumeNextPc = nextStatementPc(vm, resumeStart, unwound); vm->errorPc = frame->resumePc; vm->pc = frame->errorHandler; return true; } static BasVmResultE divByZero(BasVmT *vm) { runtimeError(vm, BAS_ERR_DIV_BY_ZERO, "Division by zero"); return BAS_VM_DIV_BY_ZERO; } // \ and MOD of 32-bit operands (ib != 0) in 32-bit arithmetic: a 64-bit // division is a libgcc call on the 486. ib == -1 is handled without // dividing because INT32_MIN / -1 traps; that one quotient does not fit // 32 bits, so the result comes back widened for the caller to promote. static int64_t divMod32(uint8_t op, int32_t ia, int32_t ib) { if (ib == -1) { return (op == OP_IDIV_INT) ? -(int64_t)ia : 0; } return (op == OP_IDIV_INT) ? ia / ib : ia % ib; } // Pops and releases up to count values (drains operands on an error path). static void dropValues(BasVmT *vm, int32_t count) { for (int32_t i = 0; i < count && vm->sp > 0; i++) { basValRelease(&vm->stack[--vm->sp]); } } // Standard message for a runtime error number (ERROR n raises it with the // same text the VM uses when it raises that error itself). static const char *errorText(int32_t errNum) { switch (errNum) { case BAS_ERR_NEXT_WITHOUT_FOR: return "NEXT without FOR"; case BAS_ERR_RETURN_NO_GOSUB: return "RETURN without GOSUB"; case BAS_ERR_OUT_OF_DATA: return "Out of DATA"; case BAS_ERR_ILLEGAL_FUNC_CALL: return "Illegal function call"; case BAS_ERR_OVERFLOW: return "Overflow"; case BAS_ERR_OUT_OF_MEMORY: return "Out of memory"; case BAS_ERR_SUBSCRIPT_RANGE: return "Subscript out of range"; case BAS_ERR_DIV_BY_ZERO: return "Division by zero"; case BAS_ERR_TYPE_MISMATCH: return "Type mismatch"; case BAS_ERR_OUT_OF_STRING: return "Out of string space"; case BAS_ERR_RESUME_WITHOUT_ERR: return "RESUME without error"; case BAS_ERR_FOR_NESTING: return "FOR loop nesting too deep"; case BAS_ERR_OUT_OF_STACK: return "Out of stack space"; case BAS_ERR_BAD_FILE_NUM: return "Bad file number"; case BAS_ERR_FILE_NOT_FOUND: return "File not found"; case BAS_ERR_BAD_FILE_MODE: return "Bad file mode"; case BAS_ERR_DEVICE_IO: return "Device I/O error"; case BAS_ERR_FILE_EXISTS: return "File already exists"; case BAS_ERR_BAD_RECORD_LEN: return "Bad record length"; case BAS_ERR_BAD_RECORD_NUM: return "Bad record number"; case BAS_ERR_TOO_MANY_FILES: return "Too many files"; case BAS_ERR_DEVICE_UNAVAILABLE: return "Device unavailable"; case BAS_ERR_PATH_FILE_ACCESS: return "Path/File access error"; case BAS_ERR_PATH_NOT_FOUND: return "Path not found"; case BAS_ERR_OBJECT_NOT_SET: return "Object variable not set"; default: return "User-defined error"; } } static BasVmResultE execArith(BasVmT *vm, uint8_t op) { BasValueT a; BasValueT b; if (!popPair(vm, &a, &b)) { return BAS_VM_STACK_UNDERFLOW; } // VB behavior: + on two strings concatenates if (op == OP_ADD_INT && a.type == BAS_TYPE_STRING && b.type == BAS_TYPE_STRING) { BasStringT *sa = a.strVal ? a.strVal : basEmptyString; BasStringT *sb = b.strVal ? b.strVal : basEmptyString; BasStringT *cat = basStringConcat(sa, sb); basValRelease(&a); basValRelease(&b); if (!push(vm, strValue(cat))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } // Integer-integer fast path -- avoids double conversion and FPU for // tight integer loops. Only promotes on overflow/division range. if (op != OP_POW && op != OP_DIV_FLT && isIntegerType(a.type) && isIntegerType(b.type)) { int32_t ia = intValue(a); int32_t ib = intValue(b); int64_t wide = 0; bool handled = true; switch (op) { case OP_ADD_INT: wide = (int64_t)ia + (int64_t)ib; break; case OP_SUB_INT: wide = (int64_t)ia - (int64_t)ib; break; case OP_MUL_INT: wide = (int64_t)ia * (int64_t)ib; break; case OP_IDIV_INT: case OP_MOD_INT: if (ib == 0) { return divByZero(vm); } wide = divMod32(op, ia, ib); break; default: handled = false; break; } if (handled && wide >= INT32_MIN && wide <= INT32_MAX) { if (!push(vm, intResult((int32_t)wide))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } } // Capture operand types BEFORE release so we know whether to keep // the result as a float. The parser always emits OP_ADD_INT (the // VM promotes based on operand types), so the opcode alone can't // tell us whether this is an integer or floating-point op. uint8_t aType = a.type; uint8_t bType = b.type; bool hadFloat = (aType == BAS_TYPE_SINGLE || aType == BAS_TYPE_DOUBLE || bType == BAS_TYPE_SINGLE || bType == BAS_TYPE_DOUBLE); double na = basValToNumber(a); double nb = basValToNumber(b); basValRelease(&a); basValRelease(&b); double result; switch (op) { case OP_ADD_INT: result = na + nb; break; case OP_SUB_INT: result = na - nb; break; case OP_MUL_INT: result = na * nb; break; case OP_IDIV_INT: case OP_MOD_INT: { // \ and MOD round their operands to LONG first (11.5 \ 2 = 6, // 7.5 MOD 2 = 0) and raise Overflow when they do not fit. int32_t ia; int32_t ib; BasVmResultE rc = roundedOperand(vm, basValDouble(na), &ia); if (rc != BAS_VM_OK) { return rc; } rc = roundedOperand(vm, basValDouble(nb), &ib); if (rc != BAS_VM_OK) { return rc; } if (ib == 0) { return divByZero(vm); } result = (double)divMod32(op, ia, ib); break; } case OP_DIV_FLT: if (nb == 0.0) { return divByZero(vm); } result = na / nb; break; case OP_POW: result = pow(na, nb); break; default: result = 0.0; break; } // BASIC never yields infinity or NaN: an out-of-range result is an // Overflow, an undefined one (negative base, fractional power) an // Illegal function call. if (!isfinite(result)) { return mathRangeError(vm, result); } // Return appropriate type. An op that would normally produce an // integer result (OP_ADD_INT, etc.) still has to yield a float when // either operand was a float -- otherwise 1.5 + 2.25 truncates to 3. bool intOp = (op == OP_ADD_INT || op == OP_SUB_INT || op == OP_MUL_INT || op == OP_IDIV_INT || op == OP_MOD_INT); if (!push(vm, (intOp && !hadFloat) ? integralValue(result) : basValDouble(result))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } static BasVmResultE execCompare(BasVmT *vm, uint8_t op) { BasValueT a; BasValueT b; if (!popPair(vm, &a, &b)) { return BAS_VM_STACK_UNDERFLOW; } int32_t cmp; // Same-type integer fast path: loop conditions like i < n hit this on // every iteration. Skip basValCompare's mixed-type handling. if (a.type == BAS_TYPE_INTEGER && b.type == BAS_TYPE_INTEGER) { cmp = (a.intVal < b.intVal) ? -1 : (a.intVal > b.intVal ? 1 : 0); } else if (a.type == BAS_TYPE_LONG && b.type == BAS_TYPE_LONG) { cmp = (a.longVal < b.longVal) ? -1 : (a.longVal > b.longVal ? 1 : 0); } else { cmp = vm->compareTextMode ? basValCompareCI(a, b) : basValCompare(a, b); } basValRelease(&a); basValRelease(&b); bool result; switch (op) { case OP_CMP_EQ: result = (cmp == 0); break; case OP_CMP_NE: result = (cmp != 0); break; case OP_CMP_LT: result = (cmp < 0); break; case OP_CMP_GT: result = (cmp > 0); break; case OP_CMP_LE: result = (cmp <= 0); break; case OP_CMP_GE: result = (cmp >= 0); break; default: result = false; break; } if (!push(vm, basValBool(result))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } static BasVmResultE execFileOp(BasVmT *vm, uint8_t op) { switch (op) { case OP_FILE_OPEN: { uint8_t mode = readUint8(vm); BasValueT recLenVal; if (!pop(vm, &recLenVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t recLen = basValToInt32(recLenVal); basValRelease(&recLenVal); int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, false); if (chResult != BAS_VM_OK) { // popFileChannel consumed only the channel; the filename // operand below it must come off too or the untrapped error // path strands it on the eval stack. A channel underflow // means the stack was empty, so this drop is a no-op there. dropValues(vm, 1); return chResult; } BasValueT fnStr; if (!popStringArg(vm, &fnStr)) { return BAS_VM_STACK_UNDERFLOW; } if (recLen < 1 || recLen > BAS_VM_MAX_RECORD_LEN) { basValRelease(&fnStr); runtimeError(vm, BAS_ERR_BAD_RECORD_LEN, "Bad record length"); return BAS_VM_FILE_ERROR; } const char *modeStr; switch (mode) { case BAS_FILE_MODE_INPUT: modeStr = "rb"; break; case BAS_FILE_MODE_OUTPUT: modeStr = "wb"; break; case BAS_FILE_MODE_APPEND: modeStr = "ab"; break; case BAS_FILE_MODE_RANDOM: case BAS_FILE_MODE_BINARY: modeStr = "r+b"; break; default: basValRelease(&fnStr); runtimeError(vm, BAS_ERR_BAD_FILE_MODE, "Bad file mode"); return BAS_VM_FILE_ERROR; } int32_t port; if (printerDevice(fnStr.strVal->data, &port)) { basValRelease(&fnStr); return openPrinterChannel(vm, channel, port, mode, recLen); } // A valid OPEN replaces whatever the channel had open closeChannel(vm, channel); // For RANDOM/BINARY: create file if it doesn't exist, then reopen r+b if (mode == BAS_FILE_MODE_RANDOM || mode == BAS_FILE_MODE_BINARY) { FILE *test = fopen(fnStr.strVal->data, "r"); if (!test) { // Create the file test = fopen(fnStr.strVal->data, "w+b"); } if (test) { fclose(test); } } FILE *fp = fopen(fnStr.strVal->data, modeStr); basValRelease(&fnStr); if (!fp) { runtimeError(vm, BAS_ERR_FILE_NOT_FOUND, "File not found or cannot open"); return BAS_VM_FILE_ERROR; } vm->files[channel].handle = fp; vm->files[channel].mode = mode; vm->files[channel].recLen = recLen; break; } case OP_FILE_CLOSE: { int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, false); if (chResult != BAS_VM_OK) { return chResult; } if (!closeChannel(vm, channel)) { runtimeError(vm, BAS_ERR_DEVICE_IO, errorText(BAS_ERR_DEVICE_IO)); return BAS_VM_FILE_ERROR; } break; } case OP_FILE_PRINT: { // Writes one value without a trailing newline. The parser emits // OP_FILE_WRITE_NL separately when the PRINT statement finishes // without a trailing ; so multi-value PRINT with `;` separator // works correctly. Values are formatted exactly as PRINT does. BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { basValRelease(&val); return chResult; } BasStringT *s = printString(val); basValRelease(&val); fwrite(s->data, 1, s->len, (FILE *)vm->files[channel].handle); basStringUnref(s); break; } case OP_FILE_INPUT: case OP_FILE_LINE_INPUT: { // INPUT # reads one comma-delimited, optionally quoted field; // LINE INPUT # reads the whole line. Neither has a length cap. int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { return chResult; } FILE *fp = (FILE *)vm->files[channel].handle; BasStringT *s = (op == OP_FILE_INPUT) ? readField(fp) : readLine(fp); if (!push(vm, strValue(s))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FILE_EOF: { int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { return chResult; } FILE *fp = (FILE *)vm->files[channel].handle; bool isEof; if (vm->files[channel].mode == BAS_FILE_MODE_INPUT) { // Peek one byte: no seek, so the stdio read buffer survives // the usual DO WHILE NOT EOF(n) loop. int32_t c = fgetc(fp); isEof = (c == EOF); if (!isEof) { ungetc(c, fp); } } else { // Read/write channels: a read-ahead would need a seek before // the next write, so compare against the end instead. long curPos = ftell(fp); fseek(fp, 0, SEEK_END); long endPos = ftell(fp); fseek(fp, curPos, SEEK_SET); isEof = (curPos >= endPos); } if (!push(vm, basValBool(isEof))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FILE_WRITE: { // Pop value and channel, write value in WRITE format BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { basValRelease(&val); return chResult; } FILE *fp = (FILE *)vm->files[channel].handle; if (val.type == BAS_TYPE_STRING) { // Strings: enclosed in quotes fputc('"', fp); if (val.strVal) { fwrite(val.strVal->data, 1, val.strVal->len, fp); } fputc('"', fp); } else { // Numbers: no leading space (unlike PRINT) BasStringT *s = basValFormatString(val); fputs(s->data, fp); basStringUnref(s); } basValRelease(&val); break; } case OP_FILE_WRITE_SEP: case OP_FILE_WRITE_NL: { // Pop channel, write the comma separator or record newline int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { return chResult; } fputc((op == OP_FILE_WRITE_SEP) ? ',' : '\n', (FILE *)vm->files[channel].handle); break; } case OP_FILE_GET: { // Pop type, [current string value | udt + layout], recno, // channel; read data; push value. A STRING target carries // its current value so BINARY mode knows how many bytes to // read; a TYPE target carries the instance to fill in place // and the compiler's field layout. BasValueT typeVal; if (!pop(vm, &typeVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t dataType = basValToInt32(typeVal); int32_t strLen = 0; BasValueT udtVal; BasValueT layoutVal; basValRelease(&typeVal); memset(&udtVal, 0, sizeof(udtVal)); memset(&layoutVal, 0, sizeof(layoutVal)); if (dataType == BAS_TYPE_STRING) { BasValueT curVal; if (!pop(vm, &curVal)) { return BAS_VM_STACK_UNDERFLOW; } strLen = (curVal.type == BAS_TYPE_STRING && curVal.strVal) ? curVal.strVal->len : 0; basValRelease(&curVal); } else if (dataType == BAS_TYPE_UDT) { if (!popArgs(vm, 2, &layoutVal, &udtVal)) { return BAS_VM_STACK_UNDERFLOW; } if (layoutVal.type != BAS_TYPE_STRING || !layoutVal.strVal || udtVal.type != BAS_TYPE_UDT || !udtVal.udtVal) { basValRelease(&layoutVal); basValRelease(&udtVal); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Not a TYPE instance"); return BAS_VM_TYPE_MISMATCH; } } BasValueT recnoVal; if (!pop(vm, &recnoVal)) { basValRelease(&layoutVal); basValRelease(&udtVal); return BAS_VM_STACK_UNDERFLOW; } int32_t recno = basValToInt32(recnoVal); basValRelease(&recnoVal); int32_t channel; long start = 0; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult == BAS_VM_OK) { chResult = recordBegin(vm, channel, recno, &start); } if (chResult != BAS_VM_OK) { basValRelease(&layoutVal); basValRelease(&udtVal); return chResult; } FILE *fp = (FILE *)vm->files[channel].handle; BasValueT result; switch (dataType) { case BAS_TYPE_INTEGER: case BAS_TYPE_LONG: case BAS_TYPE_SINGLE: case BAS_TYPE_DOUBLE: case BAS_TYPE_BOOLEAN: result = ioReadScalar(fp, (uint8_t)dataType); break; case BAS_TYPE_STRING: // BINARY reads as many raw bytes as the variable // already holds (QB semantics); RANDOM records carry // an int16 length prefix written by PUT. if (vm->files[channel].mode == BAS_FILE_MODE_BINARY) { result = strValue(ioReadBytes(fp, strLen, false)); } else { result = strValue(ioReadPrefixedString(fp)); } break; case BAS_TYPE_UDT: { int32_t pos = 0; BasVmResultE rc = udtGet(vm, fp, udtVal.udtVal, layoutVal.strVal, &pos, 0); basValRelease(&layoutVal); if (rc != BAS_VM_OK) { basValRelease(&udtVal); return rc; } result = udtVal; break; } default: result = basValInteger(0); break; } BasVmResultE endResult = recordEnd(vm, channel, start, false); if (endResult != BAS_VM_OK) { basValRelease(&result); return endResult; } if (!push(vm, result)) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FILE_PUT: case OP_FILE_PUT_UDT: { // PUT: pop value, recno, channel. PUT_UDT: pop layout, udt, // recno, channel. The record is measured first so a value // longer than a RANDOM record raises error 59 before a single // byte is written over the next record. BasValueT layoutVal; BasValueT val; BasValueT recnoVal; memset(&layoutVal, 0, sizeof(layoutVal)); if (op == OP_FILE_PUT_UDT && !pop(vm, &layoutVal)) { return BAS_VM_STACK_UNDERFLOW; } if (!popArgs(vm, 2, &val, &recnoVal)) { basValRelease(&layoutVal); return BAS_VM_STACK_UNDERFLOW; } int32_t recno = basValToInt32(recnoVal); basValRelease(&recnoVal); int32_t channel; BasVmResultE rc = popFileChannel(vm, &channel, true); if (rc == BAS_VM_OK && op == OP_FILE_PUT_UDT && (layoutVal.type != BAS_TYPE_STRING || !layoutVal.strVal || val.type != BAS_TYPE_UDT || !val.udtVal)) { runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Not a TYPE instance"); rc = BAS_VM_TYPE_MISMATCH; } BasPutSinkT measure = { NULL, 0 }; if (rc == BAS_VM_OK) { rc = putValue(vm, &measure, vm->files[channel].mode, val, layoutVal.strVal); } if (rc == BAS_VM_OK && vm->files[channel].mode == BAS_FILE_MODE_RANDOM && measure.bytes > vm->files[channel].recLen) { runtimeError(vm, BAS_ERR_BAD_RECORD_LEN, "Record longer than LEN"); rc = BAS_VM_FILE_ERROR; } long start = 0; if (rc == BAS_VM_OK) { rc = recordBegin(vm, channel, recno, &start); } if (rc == BAS_VM_OK) { BasPutSinkT out = { (FILE *)vm->files[channel].handle, 0 }; putValue(vm, &out, vm->files[channel].mode, val, layoutVal.strVal); rc = recordEnd(vm, channel, start, true); } basValRelease(&layoutVal); basValRelease(&val); return rc; } case OP_FILE_SEEK: { // SEEK #n, pos: a record number on RANDOM channels, a byte // position otherwise; both are 1-based. BasValueT posVal; if (!pop(vm, &posVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t pos = basValToInt32(posVal); basValRelease(&posVal); int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { return chResult; } if (pos < 1) { runtimeError(vm, BAS_ERR_BAD_RECORD_NUM, "Bad record number"); return BAS_VM_FILE_ERROR; } return seekRecord(vm, channel, pos); } case OP_FILE_LOF: { // Pop channel, push file length int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { return chResult; } FILE *fp = (FILE *)vm->files[channel].handle; long savedPos = ftell(fp); fseek(fp, 0, SEEK_END); long length = ftell(fp); fseek(fp, savedPos, SEEK_SET); if (!push(vm, basValLong((int32_t)length))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FILE_SEEK_GET: { // SEEK(n): the 1-based record number the next GET/PUT uses on a // RANDOM channel, the 1-based byte position otherwise. int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { return chResult; } long pos = ftell((FILE *)vm->files[channel].handle); if (vm->files[channel].mode == BAS_FILE_MODE_RANDOM) { pos /= vm->files[channel].recLen; } if (!push(vm, basValLong((int32_t)(pos + 1)))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FILE_LOC: { // Pop channel, push LOC int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { return chResult; } // QB: BINARY reports the last byte read or written, RANDOM the // last record number, sequential modes the 128-byte block count. long pos = ftell((FILE *)vm->files[channel].handle); int32_t loc; if (vm->files[channel].mode == BAS_FILE_MODE_BINARY) { loc = (int32_t)pos; } else if (vm->files[channel].mode == BAS_FILE_MODE_RANDOM) { loc = (int32_t)(pos / vm->files[channel].recLen); } else { loc = (int32_t)(pos / BAS_LOC_SEQ_BLOCK); } if (!push(vm, basValLong(loc))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FILE_FREEFILE: { // Push the next available file channel number int32_t freeNum = 0; for (int32_t i = 1; i < BAS_VM_MAX_FILES; i++) { if (!vm->files[i].handle) { freeNum = i; break; } } if (freeNum == 0) { runtimeError(vm, BAS_ERR_TOO_MANY_FILES, "Too many files open"); return BAS_VM_FILE_ERROR; } if (!push(vm, basValInteger((int16_t)freeNum))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FILE_INPUT_N: { // Pop channel and n, read n chars, push string int32_t channel; BasVmResultE chResult = popFileChannel(vm, &channel, true); if (chResult != BAS_VM_OK) { // Same shape as OP_FILE_OPEN: the count operand below the // channel must be drained on the error path. dropValues(vm, 1); return chResult; } BasValueT nVal; if (!pop(vm, &nVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t n = basValToInt32(nVal); basValRelease(&nVal); if (n < 0 || n > BAS_STRING_FUNC_MAX) { runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } if (!push(vm, strValue(ioReadBytes((FILE *)vm->files[channel].handle, n, false)))) { return BAS_VM_STACK_OVERFLOW; } break; } default: return BAS_VM_BAD_OPCODE; } return BAS_VM_OK; } static BasVmResultE execFsOp(BasVmT *vm, uint8_t op) { switch (op) { case OP_FS_KILL: { BasValueT fnStr; if (!popStringArg(vm, &fnStr)) { return BAS_VM_STACK_UNDERFLOW; } int32_t rc = remove(fnStr.strVal->data); basValRelease(&fnStr); if (rc != 0) { runtimeError(vm, BAS_ERR_FILE_NOT_FOUND, "File not found"); return BAS_VM_FILE_ERROR; } break; } case OP_FS_NAME: { BasValueT newStr; BasValueT oldStr; if (!popStringArg(vm, &newStr)) { return BAS_VM_STACK_UNDERFLOW; } if (!popStringArg(vm, &oldStr)) { basValRelease(&newStr); return BAS_VM_STACK_UNDERFLOW; } int32_t rc = rename(oldStr.strVal->data, newStr.strVal->data); basValRelease(&oldStr); basValRelease(&newStr); if (rc != 0) { runtimeError(vm, BAS_ERR_FILE_EXISTS, "File already exists or rename failed"); return BAS_VM_FILE_ERROR; } break; } case OP_FS_FILECOPY: { BasValueT dstStr; BasValueT srcStr; if (!popStringArg(vm, &dstStr)) { return BAS_VM_STACK_UNDERFLOW; } if (!popStringArg(vm, &srcStr)) { basValRelease(&dstStr); return BAS_VM_STACK_UNDERFLOW; } bool copied = platformCopyFile(srcStr.strVal->data, dstStr.strVal->data); basValRelease(&srcStr); basValRelease(&dstStr); if (!copied) { runtimeError(vm, BAS_ERR_FILE_NOT_FOUND, "File not found or cannot create destination"); return BAS_VM_FILE_ERROR; } break; } case OP_FS_MKDIR: { BasValueT pathStr; if (!popStringArg(vm, &pathStr)) { return BAS_VM_STACK_UNDERFLOW; } #ifdef _WIN32 int32_t rc = mkdir(pathStr.strVal->data); #else int32_t rc = mkdir(pathStr.strVal->data, BAS_MKDIR_MODE); #endif basValRelease(&pathStr); if (rc != 0) { runtimeError(vm, BAS_ERR_PATH_FILE_ACCESS, "Path/File access error"); return BAS_VM_FILE_ERROR; } break; } case OP_FS_RMDIR: { BasValueT pathStr; if (!popStringArg(vm, &pathStr)) { return BAS_VM_STACK_UNDERFLOW; } int32_t rc = rmdir(pathStr.strVal->data); basValRelease(&pathStr); if (rc != 0) { runtimeError(vm, BAS_ERR_PATH_FILE_ACCESS, "Path/File access error"); return BAS_VM_FILE_ERROR; } break; } case OP_FS_CHDIR: { BasValueT pathStr; if (!popStringArg(vm, &pathStr)) { return BAS_VM_STACK_UNDERFLOW; } int32_t rc = platformChdir(pathStr.strVal->data); basValRelease(&pathStr); if (rc != 0) { runtimeError(vm, BAS_ERR_PATH_NOT_FOUND, "Path not found"); return BAS_VM_FILE_ERROR; } break; } case OP_FS_CHDRIVE: { BasValueT driveStr; if (!popStringArg(vm, &driveStr)) { return BAS_VM_STACK_UNDERFLOW; } // Drive letters are a DOS-ism; platformChdir is a no-op on // platforms without them. if (driveStr.strVal->data[0]) { char drivePath[4]; drivePath[0] = driveStr.strVal->data[0]; drivePath[1] = ':'; drivePath[2] = '\0'; platformChdir(drivePath); } basValRelease(&driveStr); break; } case OP_FS_CURDIR: { char cwd[DVX_MAX_PATH]; if (!getcwd(cwd, sizeof(cwd))) { cwd[0] = '\0'; } if (!push(vm, basValStringFromC(cwd))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FS_DIR: { BasValueT patStr; if (!popStringArg(vm, &patStr)) { return BAS_VM_STACK_UNDERFLOW; } dirClose(vm); // Split pattern into directory + filename pattern const char *pat = patStr.strVal->data; const char *lastSep = NULL; for (const char *c = pat; *c; c++) { if (*c == '/' || *c == '\\') { lastSep = c; } } if (lastSep) { int32_t dirLen = (int32_t)(lastSep - pat); if (dirLen >= (int32_t)sizeof(vm->dirPath)) { dirLen = (int32_t)sizeof(vm->dirPath) - 1; } memcpy(vm->dirPath, pat, dirLen); vm->dirPath[dirLen] = '\0'; snprintf(vm->dirPattern, sizeof(vm->dirPattern), "%s", lastSep + 1); } else { snprintf(vm->dirPath, sizeof(vm->dirPath), "."); snprintf(vm->dirPattern, sizeof(vm->dirPattern), "%s", pat); } basValRelease(&patStr); if (vm->dirPattern[0] == '\0') { snprintf(vm->dirPattern, sizeof(vm->dirPattern), "*"); } vm->dirHandle = opendir(vm->dirPath); if (!push(vm, basValStringFromC(dirNext(vm)))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FS_DIR_NEXT: { if (!push(vm, basValStringFromC(dirNext(vm)))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FS_FILELEN: { BasValueT fnStr; if (!popStringArg(vm, &fnStr)) { return BAS_VM_STACK_UNDERFLOW; } struct stat st; int32_t rc = stat(fnStr.strVal->data, &st); basValRelease(&fnStr); if (rc != 0) { runtimeError(vm, BAS_ERR_FILE_NOT_FOUND, "File not found"); return BAS_VM_FILE_ERROR; } if (!push(vm, basValLong((int32_t)st.st_size))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FS_GETATTR: { BasValueT fnStr; if (!popStringArg(vm, &fnStr)) { return BAS_VM_STACK_UNDERFLOW; } struct stat st; int32_t attrs = 0; int32_t rc = stat(fnStr.strVal->data, &st); basValRelease(&fnStr); if (rc != 0) { runtimeError(vm, BAS_ERR_FILE_NOT_FOUND, "File not found"); return BAS_VM_FILE_ERROR; } if (S_ISDIR(st.st_mode)) { attrs |= BAS_ATTR_DIRECTORY; } if (!(st.st_mode & S_IWUSR)) { attrs |= BAS_ATTR_READONLY; } if (!push(vm, basValInteger((int16_t)attrs))) { return BAS_VM_STACK_OVERFLOW; } break; } case OP_FS_SETATTR: { BasValueT attrVal; BasValueT fnStr; if (!pop(vm, &attrVal)) { return BAS_VM_STACK_UNDERFLOW; } if (!popStringArg(vm, &fnStr)) { basValRelease(&attrVal); return BAS_VM_STACK_UNDERFLOW; } int32_t attrs = basValToInt32(attrVal); basValRelease(&attrVal); struct stat st; if (stat(fnStr.strVal->data, &st) != 0) { basValRelease(&fnStr); runtimeError(vm, BAS_ERR_FILE_NOT_FOUND, "File not found"); return BAS_VM_FILE_ERROR; } mode_t mode = st.st_mode; if (attrs & BAS_ATTR_READONLY) { mode &= ~(S_IWUSR | S_IWGRP | S_IWOTH); } else { mode |= S_IWUSR; } int32_t rc = chmod(fnStr.strVal->data, mode); basValRelease(&fnStr); if (rc != 0) { runtimeError(vm, BAS_ERR_PATH_FILE_ACCESS, "Path/File access error"); return BAS_VM_FILE_ERROR; } break; } default: return BAS_VM_BAD_OPCODE; } return BAS_VM_OK; } static BasVmResultE execLogical(BasVmT *vm, uint8_t op) { // Bitwise operators work on LONG operands: round (never truncate) so // NOT 0.6 is NOT 1 = -2, and raise Overflow when a value does not fit. if (op == OP_NOT) { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; int32_t n; BasVmResultE rc = roundedOperand(vm, *top, &n); if (rc != BAS_VM_OK) { return rc; } basValRelease(top); int32_t r = ~n; // Promote to LONG when the result exceeds INTEGER range, matching // execArith -- truncation corrupts LONG masks like NOT &H10000. *top = intResult(r); return BAS_VM_OK; } BasValueT a; BasValueT b; if (!popPair(vm, &a, &b)) { return BAS_VM_STACK_UNDERFLOW; } int32_t na; int32_t nb; BasVmResultE rc = roundedOperand(vm, a, &na); if (rc == BAS_VM_OK) { rc = roundedOperand(vm, b, &nb); } basValRelease(&a); basValRelease(&b); if (rc != BAS_VM_OK) { return rc; } int32_t result; switch (op) { case OP_AND: result = na & nb; break; case OP_OR: result = na | nb; break; case OP_XOR: result = na ^ nb; break; case OP_EQV: result = ~(na ^ nb); break; case OP_IMP: result = (~na) | nb; break; default: result = 0; break; } // Promote to LONG when the result exceeds INTEGER range, matching // execArith -- truncation corrupts LONG masks like c& AND &HFF0000. if (!push(vm, intResult(result))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } // LPRINT statement start (open the program's print job on first use) // and end (report a failed or cancelled output; the job is closed so // the next LPRINT starts a new one). static BasVmResultE execLprint(BasVmT *vm, uint8_t phase) { if (phase == BAS_LPRINT_BEGIN) { if (!vm->lprintJob && vm->printer.open) { vm->lprintJob = vm->printer.open(vm->printer.ctx, BAS_PRINTER_DEFAULT); } if (!vm->lprintJob) { runtimeError(vm, BAS_ERR_DEVICE_UNAVAILABLE, errorText(BAS_ERR_DEVICE_UNAVAILABLE)); return BAS_VM_FILE_ERROR; } vm->lprinting = true; vm->lprintFailed = false; return BAS_VM_OK; } vm->lprinting = false; if (vm->lprintFailed) { vm->printer.close(vm->printer.ctx, vm->lprintJob); vm->lprintJob = NULL; vm->lprintColumn = 0; runtimeError(vm, BAS_ERR_DEVICE_IO, errorText(BAS_ERR_DEVICE_IO)); return BAS_VM_FILE_ERROR; } return BAS_VM_OK; } static BasVmResultE execMath(BasVmT *vm, uint8_t op) { if (op == OP_MATH_RND) { // QBasic RND(n): n > 0 the next number, n = 0 the last one again, // n < 0 reseeds from n first (the same n always gives the same // number). The result is a DOUBLE in [0, 1). BasValueT argVal; if (!pop(vm, &argVal)) { return BAS_VM_STACK_UNDERFLOW; } double n = basValToNumber(argVal); basValRelease(&argVal); if (n < 0) { seedRandom(n * BAS_RND_SEED_SPREAD); } if (n != 0) { vm->rndLast = (double)rand() / BAS_RND_SCALE; } if (!push(vm, basValDouble(vm->rndLast))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } if (op == OP_MATH_RANDOMIZE) { BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } double n = basValToNumber(val); basValRelease(&val); if (n == BAS_RANDOMIZE_TIMER_SEED) { srand((unsigned int)time(NULL)); } else { seedRandom(n); } return BAS_VM_OK; } // All other math ops take one argument if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; double n = basValToNumber(*top); double result; // Domain errors are Illegal function call in BASIC, never NaN. if ((op == OP_MATH_SQR && n < 0) || (op == OP_MATH_LOG && n <= 0)) { runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } switch (op) { case OP_MATH_ABS: result = fabs(n); break; case OP_MATH_INT: result = floor(n); break; case OP_MATH_FIX: result = (n >= 0) ? floor(n) : ceil(n); break; case OP_MATH_SGN: result = (n > 0) ? 1.0 : (n < 0) ? -1.0 : 0.0; break; case OP_MATH_SQR: result = sqrt(n); break; case OP_MATH_SIN: result = sin(n); break; case OP_MATH_COS: result = cos(n); break; case OP_MATH_TAN: result = tan(n); break; case OP_MATH_ATN: result = atan(n); break; case OP_MATH_LOG: result = log(n); break; case OP_MATH_EXP: result = exp(n); break; default: result = 0.0; break; } if (!isfinite(result)) { return mathRangeError(vm, result); } basValRelease(top); // INT, FIX and SGN return the INTEGER type the compiler's builtin // table declares, widening to LONG / DOUBLE only when the value does // not fit; the other functions return DOUBLE. if (op == OP_MATH_INT || op == OP_MATH_FIX || op == OP_MATH_SGN) { *top = integralValue(result); } else { *top = basValDouble(result); } return BAS_VM_OK; } static BasVmResultE execPrint(BasVmT *vm) { BasValueT val; if (!pop(vm, &val)) { return BAS_VM_STACK_UNDERFLOW; } BasStringT *s = printString(val); basValRelease(&val); printText(vm, s->data, false); basStringUnref(s); return BAS_VM_OK; } // OP_STR_APPEND: var = var + x (or var & x). The variable is not on the // eval stack, so when it holds the only reference to its string the value // is appended in place; otherwise the result is computed exactly as // OP_ADD_INT / OP_STR_CONCAT would and stored back. static BasVmResultE execStrAppend(BasVmT *vm) { uint8_t flags = readUint8(vm); uint8_t scopeTag = readUint8(vm); uint16_t varIdx = readUint16(vm); bool isAmp = (flags & BAS_APPEND_AMP) != 0; BasValueT b; if (!pop(vm, &b)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *slot = scopedVarSlot(vm, varIdx, scopeTag); if (!slot) { basValRelease(&b); return BAS_VM_ERROR; } if (slot->type == BAS_TYPE_STRING && slot->strVal && (isAmp || b.type == BAS_TYPE_STRING)) { BasValueT sb = basValToString(b); basValRelease(&b); if (basStringAppend(&slot->strVal, sb.strVal)) { basValRelease(&sb); return BAS_VM_OK; } b = sb; } if (!push(vm, basValCopy(*slot))) { basValRelease(&b); return BAS_VM_STACK_OVERFLOW; } if (!push(vm, b)) { return BAS_VM_STACK_OVERFLOW; } BasVmResultE rc = isAmp ? execStringOp(vm, OP_STR_CONCAT) : execArith(vm, OP_ADD_INT); BasValueT result; if (rc != BAS_VM_OK) { return rc; } if (!pop(vm, &result)) { return BAS_VM_STACK_UNDERFLOW; } // The operators never run BASIC code, so slot is still valid. storeValue(slot, result); return BAS_VM_OK; } static BasVmResultE execStringOp(BasVmT *vm, uint8_t op) { switch (op) { case OP_STR_CONCAT: { BasValueT sb; BasValueT sa; if (!popStringArg(vm, &sb)) { return BAS_VM_STACK_UNDERFLOW; } if (!popStringArg(vm, &sa)) { basValRelease(&sb); return BAS_VM_STACK_UNDERFLOW; } BasStringT *result = basStringConcat(sa.strVal, sb.strVal); basValRelease(&sa); basValRelease(&sb); if (!push(vm, strValue(result))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } case OP_STR_LEFT: case OP_STR_RIGHT: { BasValueT nVal; BasValueT sv; if (!pop(vm, &nVal)) { return BAS_VM_STACK_UNDERFLOW; } if (!popStringArg(vm, &sv)) { basValRelease(&nVal); return BAS_VM_STACK_UNDERFLOW; } int32_t n = basValToInt32(nVal); basValRelease(&nVal); if (n < 0) { basValRelease(&sv); runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } int32_t start = 0; if (op == OP_STR_RIGHT) { start = sv.strVal->len - n; if (start < 0) { start = 0; } } BasStringT *result = basStringSub(sv.strVal, start, n); basValRelease(&sv); if (!push(vm, strValue(result))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } case OP_STR_MID: case OP_STR_MID2: { // MID$(s$, start[, len]); a missing len means "to the end". BasValueT lenVal; BasValueT startVal; BasValueT sv; int32_t len = -1; if (op == OP_STR_MID) { if (!pop(vm, &lenVal)) { return BAS_VM_STACK_UNDERFLOW; } len = basValToInt32(lenVal); basValRelease(&lenVal); } if (!pop(vm, &startVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t start = basValToInt32(startVal); basValRelease(&startVal); if (!popStringArg(vm, &sv)) { return BAS_VM_STACK_UNDERFLOW; } if (start < 1 || (op == OP_STR_MID && len < 0)) { basValRelease(&sv); runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } BasStringT *result = basStringSub(sv.strVal, start - 1, len); basValRelease(&sv); if (!push(vm, strValue(result))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } case OP_STR_LEN: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; BasValueT sv = basValToString(*top); int32_t len = sv.strVal->len; basValRelease(&sv); basValRelease(top); *top = basValLong(len); return BAS_VM_OK; } case OP_STR_INSTR: case OP_STR_INSTR3: { // INSTR([start,] string, find); positions are 1-based, LONG. BasValueT fv; BasValueT sv; BasValueT startVal; int32_t startPos = 0; if (!popStringArg(vm, &fv)) { return BAS_VM_STACK_UNDERFLOW; } if (!popStringArg(vm, &sv)) { basValRelease(&fv); return BAS_VM_STACK_UNDERFLOW; } if (op == OP_STR_INSTR3) { if (!pop(vm, &startVal)) { basValRelease(&fv); basValRelease(&sv); return BAS_VM_STACK_UNDERFLOW; } startPos = basValToInt32(startVal) - 1; basValRelease(&startVal); if (startPos < 0) { basValRelease(&fv); basValRelease(&sv); runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } } int32_t pos = 0; // OPTION COMPARE TEXT makes the search case-insensitive, as it // does for the comparison operators. if (startPos < sv.strVal->len) { int32_t found = stringFind(sv.strVal, startPos, fv.strVal, vm->compareTextMode); if (found >= 0) { pos = found + 1; } } basValRelease(&sv); basValRelease(&fv); if (!push(vm, basValLong(pos))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } case OP_STR_UCASE: case OP_STR_LCASE: case OP_STR_TRIM: case OP_STR_LTRIM: case OP_STR_RTRIM: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; BasValueT sv = basValToString(*top); basValRelease(top); BasStringT *src = sv.strVal; BasStringT *result; if (op == OP_STR_UCASE || op == OP_STR_LCASE) { result = basStringNew(src->data, src->len); for (int32_t i = 0; i < result->len; i++) { if (op == OP_STR_UCASE && result->data[i] >= 'a' && result->data[i] <= 'z') { result->data[i] -= ('a' - 'A'); } else if (op == OP_STR_LCASE && result->data[i] >= 'A' && result->data[i] <= 'Z') { result->data[i] += ('a' - 'A'); } } } else { int32_t start = 0; int32_t end = src->len; if (op == OP_STR_LTRIM || op == OP_STR_TRIM) { while (start < end && src->data[start] == ' ') { start++; } } if (op == OP_STR_RTRIM || op == OP_STR_TRIM) { while (end > start && src->data[end - 1] == ' ') { end--; } } result = basStringSub(src, start, end - start); } basValRelease(&sv); *top = strValue(result); return BAS_VM_OK; } case OP_STR_CHR: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } // A one-byte string, length-sized so CHR$(0) is a real NUL // character rather than an empty string. BasValueT *top = &vm->stack[vm->sp - 1]; char ch = (char)(basValToInt32(*top) & BAS_CHAR_MASK); basValRelease(top); *top = strValue(basStringNew(&ch, 1)); return BAS_VM_OK; } case OP_STR_ASC: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; BasValueT sv = basValToString(*top); int32_t code = (sv.strVal->len > 0) ? (unsigned char)sv.strVal->data[0] : 0; basValRelease(&sv); basValRelease(top); *top = basValInteger((int16_t)code); return BAS_VM_OK; } case OP_STR_SPACE: { if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; int32_t n = basValToInt32(*top); if (n < 0 || n > BAS_STRING_FUNC_MAX) { runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } basValRelease(top); *top = strValue(fillString(' ', n)); return BAS_VM_OK; } case OP_STR_FIXLEN: { // [uint16 len] pop string, pad/truncate to fixed length, push result uint16_t fixLen = readUint16(vm); if (vm->sp < 1) { return BAS_VM_STACK_UNDERFLOW; } BasValueT *top = &vm->stack[vm->sp - 1]; BasValueT sv = basValToString(*top); basValRelease(top); BasStringT *src = sv.strVal; BasStringT *result = basStringAlloc(fixLen + 1); if (result->cap >= (int32_t)fixLen + 1) { int32_t copyLen = DVX_MIN(src->len, (int32_t)fixLen); result->len = fixLen; memcpy(result->data, src->data, copyLen); // Pad with spaces for (int32_t i = copyLen; i < (int32_t)fixLen; i++) { result->data[i] = ' '; } result->data[fixLen] = '\0'; } basValRelease(&sv); *top = strValue(result); return BAS_VM_OK; } case OP_STR_MID_ASGN: { // Pop replacement, len, start, str; push modified string BasValueT replVal; BasValueT lenVal; BasValueT startVal; BasValueT strVal; if (!popArgs(vm, 4, &replVal, &lenVal, &startVal, &strVal)) { return BAS_VM_STACK_UNDERFLOW; } BasValueT sv = basValToString(strVal); BasValueT rv = basValToString(replVal); int32_t start = basValToInt32(startVal) - 1; // 1-based to 0-based int32_t len = basValToInt32(lenVal); basValRelease(&strVal); basValRelease(&startVal); basValRelease(&lenVal); basValRelease(&replVal); if (start < 0 || (len < 0 && len != BAS_MID_LEN_OMITTED)) { basValRelease(&sv); basValRelease(&rv); runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); return BAS_VM_ERROR; } BasStringT *src = sv.strVal; BasStringT *repl = rv.strVal; int32_t srcLen = src->len; int32_t replLen = repl->len; // An omitted length replaces as much of the replacement as // fits; an explicit 0 replaces nothing. if (len == BAS_MID_LEN_OMITTED) { len = replLen; } // Clamp to available replacement length if (len > replLen) { len = replLen; } // Create a copy of the original string BasStringT *result = basStringNew(src->data, srcLen); // Replace characters if (start < srcLen && len > 0) { int32_t maxReplace = srcLen - start; if (len > maxReplace) { len = maxReplace; } memcpy(result->data + start, repl->data, len); } basValRelease(&sv); basValRelease(&rv); if (!push(vm, strValue(result))) { return BAS_VM_STACK_OVERFLOW; } return BAS_VM_OK; } default: return BAS_VM_BAD_OPCODE; } } // A new string of count copies of ch. static BasStringT *fillString(char ch, int32_t count) { BasStringT *s = basStringAlloc(count + 1); if (s->cap >= count + 1) { memset(s->data, ch, count); s->data[count] = '\0'; s->len = count; } return s; } // Shared numeric formatter for OP_PRINT_USING (numeric fields) and OP_FORMAT. // Renders n per the flags in f, right-aligned in f->width: the sign (or a // trailing sign), the floating dollar, the thousands-separated integer part // zero-extended to f->minIntDigits, the decimals and the trailing sign make // up the body; the remaining positions are filled with spaces or asterisks. // Every cursor write is bounded against outSize, and every intermediate // buffer is sized to BAS_FORMAT_BUF_SIZE and clamped, so a pathological // format string or numeric magnitude cannot overflow the caller's buffer. // The value a FOR counter of varType holds after an increment to v. The // counter keeps its type: SINGLE stays SINGLE and INTEGER/LONG widen to // LONG/DOUBLE only when v leaves their range, so the value read back next // iteration matches the one the continue test used (an INTEGER counter // crossing 32767 must not wrap). An integer counter stepped by a // fractional STEP becomes DOUBLE so it can progress (FOR a = 0 TO 6.3 // STEP 0.2 with a holding the INTEGER 0). static BasValueT forCounterValue(uint8_t varType, bool stepFractional, double v) { if (varType == BAS_TYPE_SINGLE) { return basValSingle((float)v); } if (varType == BAS_TYPE_INTEGER && !stepFractional) { return integralValue(v); } if (varType == BAS_TYPE_LONG && !stepFractional && v >= (double)INT32_MIN && v <= (double)INT32_MAX) { return basValLong((int32_t)v); } return basValDouble(v); } static void formatNumber(double n, const BasNumFormatT *f, char *out, size_t outSize) { bool isNeg = (n < 0); double absN = isNeg ? -n : n; int32_t decimals = f->hasDecimal ? f->digitsAfter : 0; int32_t limit = (int32_t)outSize - 1; int32_t idx = 0; char numBuf[BAS_FORMAT_BUF_SIZE]; // A magnitude or decimal count too wide for the work buffer cannot be // laid out digit by digit: fall back to scientific notation (behind // the '%' overflow mark for PRINT USING) rather than emit a truncated, // wrong digit string. if (snprintf(numBuf, sizeof(numBuf), "%.*f", (int)decimals, absN) >= (int)sizeof(numBuf)) { char mark[2] = { f->markOverflow ? BAS_FORMAT_OVERFLOW_MARK : '\0', '\0' }; snprintf(out, outSize, "%s%E", mark, n); return; } // Split into integer and decimal parts. char intPart[BAS_FORMAT_BUF_SIZE]; char decPart[BAS_FORMAT_BUF_SIZE]; char *dot = strchr(numBuf, '.'); intPart[0] = '\0'; decPart[0] = '\0'; if (dot) { int32_t intLen = (int32_t)(dot - numBuf); if (intLen > (int32_t)sizeof(intPart) - 1) { intLen = (int32_t)sizeof(intPart) - 1; } memcpy(intPart, numBuf, intLen); intPart[intLen] = '\0'; strncpy(decPart, dot + 1, sizeof(decPart) - 1); decPart[sizeof(decPart) - 1] = '\0'; } else { strncpy(intPart, numBuf, sizeof(intPart) - 1); intPart[sizeof(intPart) - 1] = '\0'; } // Zero-extend to the '0' placeholders, then apply the thousands separator. char fmtIntPart[BAS_FORMAT_BUF_SIZE]; int32_t intLen = (int32_t)strlen(intPart); int32_t zeroPad = f->minIntDigits - intLen; int32_t dstIdx = 0; if (zeroPad < 0) { zeroPad = 0; } for (int32_t i = 0; i < zeroPad + intLen; i++) { if (f->hasComma && i > 0 && (zeroPad + intLen - i) % 3 == 0) { putBounded(fmtIntPart, &dstIdx, (int32_t)sizeof(fmtIntPart) - 1, ','); } putBounded(fmtIntPart, &dstIdx, (int32_t)sizeof(fmtIntPart) - 1, (i < zeroPad) ? '0' : intPart[i - zeroPad]); } fmtIntPart[dstIdx] = '\0'; // Sign placement: a leading '+' position always shows the sign; a // trailing '+' or '-' position carries it at the end; otherwise a // negative value gets a floating leading '-'. char lead = '\0'; char trail = '\0'; if (f->plusAtStart) { lead = isNeg ? '-' : '+'; } else if (f->plusAtEnd) { trail = isNeg ? '-' : '+'; } else if (f->minusAtEnd) { trail = isNeg ? '-' : ' '; } else if (isNeg) { lead = '-'; } int32_t decLen = (int32_t)strlen(decPart); int32_t bodyLen = (lead ? 1 : 0) + (f->dollarFloat ? 1 : 0) + dstIdx + (f->hasDecimal ? 1 + decimals : 0) + (trail ? 1 : 0); int32_t pad = f->width - bodyLen; if (pad < 0) { pad = 0; if (f->markOverflow) { putBounded(out, &idx, limit, BAS_FORMAT_OVERFLOW_MARK); } } for (int32_t i = 0; i < pad; i++) { putBounded(out, &idx, limit, f->asteriskFill ? '*' : ' '); } if (lead) { putBounded(out, &idx, limit, lead); } if (f->dollarFloat) { putBounded(out, &idx, limit, '$'); } for (int32_t i = 0; fmtIntPart[i]; i++) { putBounded(out, &idx, limit, fmtIntPart[i]); } // decimals comes from the runtime format string, so it can exceed the // digits snprintf produced into decPart -- never read past decLen. if (f->hasDecimal) { putBounded(out, &idx, limit, '.'); for (int32_t i = 0; i < decimals; i++) { putBounded(out, &idx, limit, (i < decLen) ? decPart[i] : '0'); } } if (trail) { putBounded(out, &idx, limit, trail); } out[idx] = '\0'; } // Lowest forStack index the currently-executing call frame may unwind // to. FOR frames below this belong to callers and must never be // touched by NEXT mismatch recovery or FOR re-entry cleanup. static int32_t forStackFloor(BasVmT *vm) { if (vm->callDepth > 0) { return vm->callStack[vm->callDepth - 1].savedForDepth; } return 0; } // Release FOR-stack entries above newDepth and truncate the stack to it. // Used when returning from a call frame, unwinding to an error handler, // and discarding stale frames left by EXIT DO / GOTO jumps out of FORs. static void forStackTrim(BasVmT *vm, int32_t newDepth) { while (vm->forDepth > newDepth) { BasForStateT *fs = &vm->forStack[--vm->forDepth]; basValRelease(&fs->limit); basValRelease(&fs->step); } } // IniRead: the value of key in [sec] of path through dvxPrefs, or a // copy of defStr when the file, section or key is missing. static BasValueT iniRead(const char *path, const char *sec, const char *key, BasStringT *defStr) { PrefsHandleT *h = prefsLoad(path); const char *value = prefsGetString(h, sec, key, NULL); BasValueT result = value ? basValStringFromC(value) : basValString(defStr); prefsClose(h); return result; } // IniWrite: sets key = value in [sec] of path through dvxPrefs. Every // other line is written back unchanged (lines end in CR LF); a missing // key is added after its section's last key and a missing section at the // end of the file. A file that exists but cannot be read is never // rewritten, and a failed save leaves the old file intact (error 75). static BasVmResultE iniWrite(BasVmT *vm, const char *path, const char *sec, const char *key, const char *val) { PrefsHandleT *h = prefsLoad(path); if (!h) { runtimeError(vm, BAS_ERR_OUT_OF_MEMORY, "Out of memory"); return BAS_VM_OUT_OF_MEMORY; } prefsSetString(h, sec, key, val); bool saved = prefsSave(h); prefsClose(h); if (!saved) { runtimeError(vm, BAS_ERR_PATH_FILE_ACCESS, "Cannot write INI file"); return BAS_VM_FILE_ERROR; } return BAS_VM_OK; } // A whole-number result as the narrowest of INTEGER, LONG and DOUBLE that // holds it (the promotion rule execArith uses). static BasValueT integralValue(double v) { if (v >= (double)INT32_MIN && v <= (double)INT32_MAX) { return intResult((int32_t)v); } return basValDouble(v); } // An integer result as INTEGER when it fits, LONG otherwise. static BasValueT intResult(int32_t v) { return (v >= INT16_MIN && v <= INT16_MAX) ? basValInteger((int16_t)v) : basValLong(v); } // Integer value of an INTEGER or LONG (callers check isIntegerType). static int32_t intValue(BasValueT v) { return (v.type == BAS_TYPE_INTEGER) ? (int32_t)v.intVal : v.longVal; } // Reads up to len raw bytes into a new string sized by the bytes actually // read, so a short record never exposes uninitialized heap. With pad set // a short read is space-filled to len instead: a fixed-length TYPE field // always holds exactly its declared length. static BasStringT *ioReadBytes(FILE *fp, int32_t len, bool pad) { BasStringT *s = basStringAlloc(len + 1); if (s->cap < len + 1) { return s; } int32_t got = (int32_t)fread(s->data, 1, len, fp); if (pad) { memset(s->data + got, ' ', len - got); got = len; } s->data[got] = '\0'; s->len = got; return s; } // GET of a variable-length string as PUT wrote it: an int16 length // prefix, then the bytes. static BasStringT *ioReadPrefixedString(FILE *fp) { int16_t prefix = 0; readRaw(fp, &prefix, sizeof(prefix)); return ioReadBytes(fp, (prefix < 0) ? 0 : prefix, false); } // GET of one numeric value in its binary form (INTEGER and BOOLEAN 2 // bytes, LONG 4, SINGLE 4, DOUBLE 8). Shared by scalar GET and TYPE fields. static BasValueT ioReadScalar(FILE *fp, uint8_t type) { switch (type) { case BAS_TYPE_LONG: { int32_t val = 0; readRaw(fp, &val, sizeof(val)); return basValLong(val); } case BAS_TYPE_SINGLE: { float val = 0.0f; readRaw(fp, &val, sizeof(val)); return basValSingle(val); } case BAS_TYPE_DOUBLE: { double val = 0.0; readRaw(fp, &val, sizeof(val)); return basValDouble(val); } case BAS_TYPE_BOOLEAN: { int16_t val = 0; readRaw(fp, &val, sizeof(val)); return basValBool(val != 0); } default: { int16_t val = 0; readRaw(fp, &val, sizeof(val)); return basValInteger(val); } } } // PUT counterpart of ioReadPrefixedString. The length is clamped before // the int16 cast so an over-long string can't wrap to a negative prefix. static void ioWritePrefixedString(BasPutSinkT *sink, const BasStringT *s) { int32_t slen = s ? s->len : 0; if (slen > INT16_MAX) { slen = INT16_MAX; } int16_t len = (int16_t)slen; sinkWrite(sink, &len, sizeof(len)); sinkWrite(sink, s ? s->data : "", len); } // PUT counterpart of ioReadScalar; val is converted to the layout type. static void ioWriteScalar(BasPutSinkT *sink, uint8_t type, BasValueT val) { switch (type) { case BAS_TYPE_LONG: { int32_t v = basValToInt32(val); sinkWrite(sink, &v, sizeof(v)); break; } case BAS_TYPE_SINGLE: { float v = (float)basValToNumber(val); sinkWrite(sink, &v, sizeof(v)); break; } case BAS_TYPE_DOUBLE: { double v = basValToNumber(val); sinkWrite(sink, &v, sizeof(v)); break; } case BAS_TYPE_BOOLEAN: { int16_t v = basValIsTruthy(val) ? -1 : 0; sinkWrite(sink, &v, sizeof(v)); break; } default: { int16_t v = (int16_t)basValToInt32(val); sinkWrite(sink, &v, sizeof(v)); break; } } } // INTEGER or LONG: the types the integer fast paths handle. static bool isIntegerType(uint8_t type) { return type == BAS_TYPE_INTEGER || type == BAS_TYPE_LONG; } // Reads the next TYPE layout entry (see BAS_LAYOUT_* in opcodes.h). // Returns false when the layout is exhausted or truncated. static bool layoutNext(const BasStringT *layout, int32_t *pos, BasLayoutEntryT *out) { if (*pos >= layout->len) { return false; } const uint8_t *d = (const uint8_t *)layout->data; memset(out, 0, sizeof(*out)); out->type = d[*pos]; *pos += 1; if (out->type == BAS_TYPE_STRING) { if (*pos + 2 > layout->len) { return false; } out->fixedLen = d[*pos] | (d[*pos + 1] << 8); *pos += 2; } else if (out->type == BAS_TYPE_UDT) { if (*pos + 4 > layout->len) { return false; } out->typeId = d[*pos] | (d[*pos + 1] << 8); out->fieldCount = d[*pos + 2] | (d[*pos + 3] << 8); *pos += 4; } return true; } // Local wall-clock time, with the sub-second part in microseconds when // outUsec is non-NULL. Shared by TIMER, DATE$ and TIME$. static void localNow(struct tm *out, int32_t *outUsec) { struct timeval tv; gettimeofday(&tv, NULL); time_t secs = tv.tv_sec; struct tm *local = localtime(&secs); if (local) { *out = *local; } else { memset(out, 0, sizeof(*out)); } if (outUsec) { *outUsec = (int32_t)tv.tv_usec; } } // Send LPRINT output; after a failure the rest of the statement is dropped. static void lprintWrite(BasVmT *vm, const char *data, int32_t len) { if (!vm->lprintFailed && len > 0) { vm->lprintFailed = !vm->printer.write(vm->printer.ctx, vm->lprintJob, data, len); } } // Raises the error for a math result BASIC cannot represent: Overflow for // an infinity, Illegal function call for NaN (an undefined result). static BasVmResultE mathRangeError(BasVmT *vm, double result) { if (isnan(result)) { runtimeError(vm, BAS_ERR_ILLEGAL_FUNC_CALL, "Illegal function call"); } else { runtimeError(vm, BAS_ERR_OVERFLOW, "Overflow"); } return BAS_VM_ERROR; } // Returns the bytecode address the error dispatcher records for RESUME // NEXT: where execution continues with the eval stack at the failing // statement's boundary. Walks forward from start -- the failing // instruction, or with includeStart the return address of a call whose // callee was unwound -- to the first of: // - the next statement boundary, or a structural opcode that IS what runs // after the statement (a loop-closing OP_JMP/OP_FOR_NEXT, a SUB's OP_RET, // OP_END/OP_HALT, a FUNCTION's LOAD_LOCAL result + RET_VAL epilogue); // - a conditional jump (IF/ELSEIF/WHILE/DO/LOOP condition): resume as if // it were taken when it jumps forward and not taken when it jumps // backward, so a failed condition skips its block or leaves its loop; // - OP_FOR_INIT (a failed FOR header): continue past the whole loop. // A GOSUB is stepped over so the walk continues at its return address. // Returns -1 when the walk reaches an // opcode that would pop values the trap already released or runs off the // end of the code. static int32_t nextStatementPc(BasVmT *vm, int32_t start, bool includeStart) { const uint8_t *code = vm->module->code; int32_t codeLen = vm->module->codeLen; int32_t pc = start; while (pc >= 0 && pc < codeLen) { uint8_t op = code[pc]; int32_t operand = basOpcodeOperandSize(op); if (operand < 0 || pc + 1 + operand > codeLen) { return -1; } int32_t after = pc + 1 + operand; if (pc > start || includeStart) { if (op == OP_LINE || op == OP_STMT || op == OP_JMP || op == OP_FOR_NEXT || op == OP_RET || op == OP_END || op == OP_HALT) { return pc; } if (op == OP_LOAD_LOCAL && after < codeLen && code[after] == OP_RET_VAL && basReadU16LE(code + pc + 1) == BAS_FUNC_RESULT_SLOT) { return pc; } if (op == OP_JMP_TRUE || op == OP_JMP_FALSE) { int16_t offset = basReadI16LE(code + pc + 1); return (offset > 0) ? after + offset : after; } if (op == OP_FOR_INIT) { return after + basReadI16LE(code + pc + BAS_FOR_OFFSET_OPERAND); } if (op == OP_RET_VAL || op == OP_GOSUB_RET) { return -1; } } pc = after; } return -1; } // Form/control opcode executed with no form runtime attached (headless // runs such as basrun or the test harnesses). static BasVmResultE noFormRuntime(BasVmT *vm) { runtimeError(vm, BAS_ERR_NO_FORM_RUNTIME, "No form runtime"); return BAS_VM_ERROR; } // OPEN "LPTn:" / "PRN" FOR OUTPUT or APPEND: the channel writes to an // anonymous spool file that goes to the printer at CLOSE. static BasVmResultE openPrinterChannel(BasVmT *vm, int32_t channel, int32_t port, uint8_t mode, int32_t recLen) { if (mode != BAS_FILE_MODE_OUTPUT && mode != BAS_FILE_MODE_APPEND) { runtimeError(vm, BAS_ERR_BAD_FILE_MODE, errorText(BAS_ERR_BAD_FILE_MODE)); return BAS_VM_FILE_ERROR; } closeChannel(vm, channel); void *job = vm->printer.open ? vm->printer.open(vm->printer.ctx, port) : NULL; if (!job) { runtimeError(vm, BAS_ERR_DEVICE_UNAVAILABLE, errorText(BAS_ERR_DEVICE_UNAVAILABLE)); return BAS_VM_FILE_ERROR; } FILE *spool = tmpfile(); if (!spool) { vm->printer.close(vm->printer.ctx, job); runtimeError(vm, BAS_ERR_PATH_FILE_ACCESS, "Cannot create the printer spool file"); return BAS_VM_FILE_ERROR; } vm->files[channel].handle = spool; vm->files[channel].printJob = job; vm->files[channel].mode = mode; vm->files[channel].recLen = recLen; return BAS_VM_OK; } // Returns whether `size` bytes can be read at vm->pc without running past // the end of code[]. On overflow it flags the VM and clamps pc to codeLen so // the next basVmStep entry raises BAS_VM_BAD_OPCODE. Compared as // `codeLen - size` (not `pc + size`) to avoid signed overflow; codeLen is // always >= 0 and size is a small operand width. static inline bool operandFits(BasVmT *vm, int32_t size) { if (vm->pc < 0 || vm->pc > vm->module->codeLen - size) { vm->badOperand = true; vm->pc = vm->module->codeLen; return false; } return true; } // Scans a PRINT USING / FORMAT$ numeric format string into f. Both // statements share the placeholder grammar: '#' and '0' (and '*' before // the decimal point) are digit positions, '0' also fixes the minimum // number of integer digits, '.' and ',' set the decimal and thousands // flags, a leading '+' or a trailing '+'/'-' selects the sign style, // leading "**" and "$$" select fills, and "^^^^" requests scientific // notation (reported through outSci). The field width is the length of // the format string. static void parseNumFormat(const char *fmt, int32_t fmtLen, BasNumFormatT *f, bool *outSci) { memset(f, 0, sizeof(*f)); int32_t scanStart = (fmtLen > 0 && fmt[0] == '+') ? 1 : 0; f->plusAtStart = (scanStart == 1); f->asteriskFill = (fmtLen >= scanStart + 2 && fmt[scanStart] == '*' && fmt[scanStart + 1] == '*'); if (f->asteriskFill) { scanStart += 2; } f->dollarFloat = (fmtLen >= scanStart + 2 && fmt[scanStart] == '$' && fmt[scanStart + 1] == '$'); f->plusAtEnd = (fmtLen > scanStart && fmt[fmtLen - 1] == '+'); f->minusAtEnd = (fmtLen > scanStart && fmt[fmtLen - 1] == '-'); f->width = fmtLen; *outSci = (strstr(fmt, BAS_SCI_MARKER) != NULL); int32_t intDigits = 0; for (int32_t i = 0; i < fmtLen; i++) { if (fmt[i] == '.') { f->hasDecimal = true; } else if (fmt[i] == ',') { f->hasComma = true; } else if (fmt[i] == '#' || fmt[i] == '0' || (fmt[i] == '*' && !f->hasDecimal)) { if (f->hasDecimal) { f->digitsAfter++; } else { intDigits++; if (fmt[i] == '0' && f->minIntDigits == 0) { // Every position from the first '0' to the decimal // point is a forced digit. f->minIntDigits = -intDigits; } } } } if (f->minIntDigits < 0) { f->minIntDigits = intDigits + f->minIntDigits + 1; } } static bool pop(BasVmT *vm, BasValueT *val) { if (vm->sp <= 0) { return false; } *val = vm->stack[--vm->sp]; return true; } // Pops count values, top of stack first, into the BasValueT pointers that // follow. On underflow every value already popped is released so a // malformed program cannot leak them, and false is returned. static bool popArgs(BasVmT *vm, int32_t count, ...) { va_list ap; va_start(ap, count); for (int32_t i = 0; i < count; i++) { BasValueT *out = va_arg(ap, BasValueT *); if (!pop(vm, out)) { va_end(ap); va_start(ap, count); for (int32_t j = 0; j < i; j++) { basValRelease(va_arg(ap, BasValueT *)); } va_end(ap); return false; } } va_end(ap); return true; } // Pops dims subscripts and the array reference beneath them and resolves // the element they name. On success *outArr holds the popped (counted) // array reference, which the caller releases, and *outIdx the flat element // index. On failure everything popped is released and the error raised. static BasVmResultE popArrayElement(BasVmT *vm, int32_t dims, BasValueT *outArr, int32_t *outIdx) { if (!validArrayDims(vm, dims)) { return BAS_VM_ERROR; } int32_t indices[BAS_ARRAY_MAX_DIMS]; // Subscripts were pushed first dimension first, so pop in reverse for (int32_t d = dims - 1; d >= 0; d--) { BasValueT idxVal; if (!pop(vm, &idxVal)) { return BAS_VM_STACK_UNDERFLOW; } indices[d] = basValToInt32(idxVal); basValRelease(&idxVal); } if (!pop(vm, outArr)) { return BAS_VM_STACK_UNDERFLOW; } if (outArr->type != BAS_TYPE_ARRAY || !outArr->arrVal) { basValRelease(outArr); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Not an array"); return BAS_VM_TYPE_MISMATCH; } *outIdx = basArrayIndex(outArr->arrVal, indices, dims); if (*outIdx < 0) { basValRelease(outArr); runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Subscript out of range"); return BAS_VM_SUBSCRIPT_RANGE; } return BAS_VM_OK; } // Pops the top call frame (the shared SUB/FUNCTION return epilogue used by // OP_RET and OP_RET_VAL). The caller MUST have already verified callDepth > 0. // Copies out-args, releases locals and restores PC. static void popCallFrame(BasVmT *vm) { BasCallFrameT *frame = &vm->callStack[--vm->callDepth]; // Copy out-args (for basVmCallSubWithArgsOut) BEFORE releasing the // locals -- reading them after release is a use-after-free. if (vm->outArgs && vm->callDepth == vm->outArgFrame) { for (int32_t i = 0; i < vm->outArgCount && i < frame->localCount; i++) { vm->outArgs[i] = basValCopy(frame->locals[i]); } vm->outArgFrame = -1; } // Release locals for (int32_t i = 0; i < frame->localCount; i++) { basValRelease(&frame->locals[i]); } // Discard any FOR frames the callee left open (EXIT SUB/FUNCTION // from inside a FOR body jumps straight to this epilogue) and // restore the caller's statement boundary for error dispatch. forStackTrim(vm, frame->savedForDepth); vm->gosubDepth = frame->savedGosubDepth; vm->stmtPc = frame->savedStmtPc; vm->stmtSp = frame->savedStmtSp; vm->pc = frame->returnPc; // A procedure returning from inside its own running handler has dealt // with the error: QBASIC documents that an unresumed handler is cleared // when the procedure that installed it returns. A procedure that merely // installed a handler leaves the caller's Err state alone. if (frame->inHandler) { clearErrorState(vm); } frame->errorHandler = 0; frame->inHandler = false; } static BasVmResultE popFileChannel(BasVmT *vm, int32_t *outChannel, bool requireOpen) { BasValueT channelVal; if (!pop(vm, &channelVal)) { return BAS_VM_STACK_UNDERFLOW; } int32_t channel = basValToInt32(channelVal); basValRelease(&channelVal); if (channel < 1 || channel >= BAS_VM_MAX_FILES || (requireOpen && !vm->files[channel].handle)) { runtimeError(vm, BAS_ERR_BAD_FILE_NUM, requireOpen ? "Bad file number or file not open" : "Bad file channel number"); return BAS_VM_FILE_ERROR; } *outChannel = channel; return BAS_VM_OK; } // Pops the two operands of a binary operator: *b from the top of the // stack, *a from beneath it. static bool popPair(BasVmT *vm, BasValueT *a, BasValueT *b) { if (vm->sp < 2) { return false; } *b = vm->stack[vm->sp - 1]; *a = vm->stack[vm->sp - 2]; vm->sp -= 2; return true; } // Pops one operand and converts it to a STRING value (*out always holds a // non-NULL strVal on success). Returns false on stack underflow. static bool popStringArg(BasVmT *vm, BasValueT *out) { BasValueT raw; if (!pop(vm, &raw)) { return false; } *out = basValToString(raw); basValRelease(&raw); return true; } // Primes callStack[0] as the implicit main (module-level) frame. Module // code runs in frame 0; without callDepth >= 1 the error dispatcher's // unwind never inspects that frame, so a module-level ON ERROR GOTO never // traps. Module-level variables are globals, so the frame has no locals. // Frames an untrapped error left on a reused VM are released first. static void primeModuleFrame(BasVmT *vm) { while (vm->callDepth > 1) { discardFrame(vm); } vm->callDepth = 1; vm->gosubDepth = 0; vm->callStack[0].localCount = 0; vm->callStack[0].errorHandler = 0; vm->callStack[0].inHandler = false; vm->callStack[0].savedForDepth = 0; vm->callStack[0].savedGosubDepth = 0; vm->callStack[0].savedStmtPc = -1; vm->callStack[0].savedStmtSp = 0; // Hosts that run module-level expressions (the IDE's watch evaluator) // widen localCount themselves, so leave the slots zeroed. memset(vm->callStack[0].locals, 0, sizeof(vm->callStack[0].locals)); } // The output column of what PRINT is writing to: the screen, or the // printer during an LPRINT. static int32_t *printColumnOf(BasVmT *vm) { return vm->lprinting ? &vm->lprintColumn : &vm->printColumn; } // True when name is a printer device: "LPT1".."LPT3" (outPort 0..2) or // "PRN" (BAS_PRINTER_DEFAULT), in any case, with or without a colon. static bool printerDevice(const char *name, int32_t *outPort) { char dev[BAS_PRINTER_NAME_MAX + 1]; int32_t len = (int32_t)strlen(name); if (len > 0 && name[len - 1] == ':') { len--; } if (len >= (int32_t)sizeof(dev)) { return false; } for (int32_t i = 0; i < len; i++) { dev[i] = (char)toupper((unsigned char)name[i]); } dev[len] = '\0'; if (strcmp(dev, BAS_PRINTER_NAME_PRN) == 0) { *outPort = BAS_PRINTER_DEFAULT; return true; } int32_t lptLen = (int32_t)strlen(BAS_PRINTER_NAME_LPT); if (len == lptLen + 1 && strncmp(dev, BAS_PRINTER_NAME_LPT, (size_t)lptLen) == 0 && dev[lptLen] >= BAS_PRINTER_FIRST_DIGIT && dev[lptLen] < BAS_PRINTER_FIRST_DIGIT + BAS_PRINTER_PORTS) { *outPort = dev[lptLen] - BAS_PRINTER_FIRST_DIGIT; return true; } return false; } // PRINT / PRINT # text for one value: its string form, followed by the // space PRINT puts after every non-string value. static BasStringT *printString(BasValueT val) { BasStringT *text = basValFormatString(val); if (val.type == BAS_TYPE_STRING) { return text; } BasStringT *out = basStringAlloc(text->len + 2); if (out->cap >= text->len + 2) { memcpy(out->data, text->data, text->len); out->data[text->len] = ' '; out->data[text->len + 1] = '\0'; out->len = text->len + 1; } basStringUnref(text); return out; } // Every PRINT byte goes through here so the output column is known for // comma zones and TAB(). static void printText(BasVmT *vm, const char *text, bool newline) { int32_t *column = printColumnOf(vm); if (vm->lprinting) { lprintWrite(vm, text, (int32_t)strlen(text)); if (newline) { lprintWrite(vm, BAS_PRINTER_NEWLINE, BAS_PRINTER_NEWLINE_LEN); } } else if (vm->printFn) { vm->printFn(vm->printCtx, text, newline); } for (const char *c = text; *c; c++) { *column = (*c == '\n') ? 0 : *column + 1; } if (newline) { *column = 0; } } // Local-slot count for a call to codeAddr: the procedure's recorded local // count (the proc table is sorted by code address), never less than // minCount (the slots the arguments fill). Code without a proc entry gets // the full BAS_VM_MAX_LOCALS. The compiler and the module loader reject a // count over BAS_VM_MAX_LOCALS; the final bound keeps the frame inside // locals[] whatever built the module. static int32_t procLocalCount(const BasVmT *vm, int32_t codeAddr, int32_t minCount) { const BasProcEntryT *procs = vm->module->procs; int32_t lo = 0; int32_t hi = vm->module->procCount - 1; int32_t count = BAS_VM_MAX_LOCALS; while (lo <= hi) { int32_t mid = lo + (hi - lo) / 2; if (procs[mid].codeAddr < codeAddr) { lo = mid + 1; } else if (procs[mid].codeAddr > codeAddr) { hi = mid - 1; } else { count = (procs[mid].localCount < minCount) ? minCount : procs[mid].localCount; break; } } return (count > BAS_VM_MAX_LOCALS) ? BAS_VM_MAX_LOCALS : count; } // Pushes val, taking ownership of it: on stack overflow the value is // released here so no caller has to remember to. static bool push(BasVmT *vm, BasValueT val) { if (vm->sp >= BAS_VM_STACK_SIZE) { basValRelease(&val); return false; } vm->stack[vm->sp++] = val; return true; } // Pushes a call frame for a call to codeAddr returning to returnPc (the // caller has checked the call-stack depth). Only the procedure's own // local slots are zeroed; every local access is bounded by localCount, // and popCallFrame/discardFrame release exactly those slots. static BasCallFrameT *pushFrame(BasVmT *vm, int32_t returnPc, int32_t codeAddr, int32_t minLocals) { BasCallFrameT *frame = &vm->callStack[vm->callDepth++]; frame->returnPc = returnPc; frame->localCount = procLocalCount(vm, codeAddr, minLocals); frame->errorHandler = 0; frame->inHandler = false; frame->savedForDepth = vm->forDepth; frame->savedGosubDepth = vm->gosubDepth; frame->savedStmtPc = vm->stmtPc; frame->savedStmtSp = vm->stmtSp; memset(frame->locals, 0, sizeof(BasValueT) * frame->localCount); return frame; } // Bounded single-character append used throughout formatNumber: writes c at // out[*idx] and advances *idx only while it stays under limit, so no formatter // cursor write can overflow the caller's buffer. static void putBounded(char *out, int32_t *idx, int32_t limit, char c) { if (*idx < limit) { out[(*idx)++] = c; } } // Encodes one PUT value into sink: numerics in their binary form, strings // raw on BINARY channels and length-prefixed otherwise, a TYPE instance // field by field from layout (non-NULL only for PUT of a TYPE). static BasVmResultE putValue(BasVmT *vm, BasPutSinkT *sink, int32_t mode, BasValueT val, const BasStringT *layout) { if (layout) { int32_t pos = 0; return udtPut(vm, sink, val.udtVal, layout, &pos, 0); } switch (val.type) { case BAS_TYPE_INTEGER: case BAS_TYPE_LONG: case BAS_TYPE_SINGLE: case BAS_TYPE_DOUBLE: case BAS_TYPE_BOOLEAN: ioWriteScalar(sink, val.type, val); break; case BAS_TYPE_STRING: if (mode == BAS_FILE_MODE_BINARY) { if (val.strVal) { sinkWrite(sink, val.strVal->data, val.strVal->len); } } else { ioWritePrefixedString(sink, val.strVal); } break; default: { int16_t zero = 0; sinkWrite(sink, &zero, sizeof(zero)); break; } } return BAS_VM_OK; } // INPUT #: reads one field the way WRITE # wrote it -- leading blanks are // skipped, a quoted field runs to the closing quote, an unquoted field runs // to the next comma or end of line, and the field's delimiter (comma or // line end) is consumed. Returns the field as a new string. static BasStringT *readField(FILE *fp) { int32_t ch = fgetc(fp); while (ch == ' ' || ch == '\t') { ch = fgetc(fp); } if (ch == EOF) { return basStringRef(basEmptyString); } // An empty line between records is its own (empty) field. if (ch == '\n' || ch == '\r') { if (ch == '\r') { ch = fgetc(fp); if (ch != '\n' && ch != EOF) { ungetc(ch, fp); } } return basStringRef(basEmptyString); } int32_t cap = BAS_FILE_LINE_CHUNK; int32_t len = 0; char *buf = (char *)malloc(cap); bool quoted = (ch == '"'); if (!buf) { return basStringRef(basEmptyString); } if (!quoted) { ungetc(ch, fp); } for (;;) { ch = fgetc(fp); if (ch == EOF) { break; } if (quoted) { if (ch == '"') { // Skip to the field delimiter that follows the closing quote. do { ch = fgetc(fp); } while (ch == ' ' || ch == '\t'); if (ch != ',' && ch != '\n' && ch != '\r' && ch != EOF) { ungetc(ch, fp); } break; } } else if (ch == ',' || ch == '\n' || ch == '\r') { break; } if (len + 1 >= cap) { int32_t newCap = cap * 2; char *grown = (char *)realloc(buf, newCap); if (!grown) { break; } buf = grown; cap = newCap; } buf[len++] = (char)ch; } // Swallow the LF of a CR LF pair so the next field starts cleanly. if (ch == '\r') { ch = fgetc(fp); if (ch != '\n' && ch != EOF) { ungetc(ch, fp); } } // Unquoted fields drop trailing blanks, as QB does (the growth check // above always leaves room for the terminator). if (!quoted) { buf[len] = '\0'; len = dvxTrimRight(buf); } BasStringT *s = basStringNew(buf, len); free(buf); return s; } // memcpy with constant size is folded to a single load by the compiler and // is alignment-safe (bytecode operands aren't guaranteed 2-byte aligned). static inline int16_t readInt16(BasVmT *vm) { int16_t val = 0; if (operandFits(vm, (int32_t)sizeof(int16_t))) { memcpy(&val, &vm->module->code[vm->pc], sizeof(int16_t)); vm->pc += sizeof(int16_t); } return val; } // LINE INPUT #: reads a whole line of any length (fgets chunks are joined // until the newline arrives), with the trailing CR/LF stripped. Returns an // empty string at end of file. static BasStringT *readLine(FILE *fp) { int32_t cap = BAS_FILE_LINE_CHUNK; int32_t len = 0; char *buf = (char *)malloc(cap); if (!buf) { return basStringRef(basEmptyString); } buf[0] = '\0'; while (fgets(buf + len, cap - len, fp)) { len += (int32_t)strlen(buf + len); if (len > 0 && buf[len - 1] == '\n') { break; } if (len + 1 >= cap - 1) { int32_t newCap = cap * 2; char *grown = (char *)realloc(buf, newCap); if (!grown) { break; } buf = grown; cap = newCap; } } while (len > 0 && (buf[len - 1] == '\n' || buf[len - 1] == '\r')) { len--; } BasStringT *s = basStringNew(buf, len); free(buf); return s; } // GET/PUT record read whose short-read result is deliberately ignored: a // record past end of file yields the caller's zero default. static void readRaw(FILE *fp, void *dst, size_t size) { size_t got = fread(dst, 1, size, fp); (void)got; } static inline uint16_t readUint16(BasVmT *vm) { uint16_t val = 0; if (operandFits(vm, (int32_t)sizeof(uint16_t))) { memcpy(&val, &vm->module->code[vm->pc], sizeof(uint16_t)); vm->pc += sizeof(uint16_t); } return val; } static inline uint8_t readUint8(BasVmT *vm) { if (!operandFits(vm, (int32_t)sizeof(uint8_t))) { return 0; } return vm->module->code[vm->pc++]; } // Positions a channel for GET/PUT (see seekRecord; 0 keeps the current // position, a negative number is Bad record number) and stores the start // offset in *start so recordEnd can frame the transfer. static BasVmResultE recordBegin(BasVmT *vm, int32_t channel, int32_t recno, long *start) { if (recno < 0) { runtimeError(vm, BAS_ERR_BAD_RECORD_NUM, "Bad record number"); return BAS_VM_FILE_ERROR; } if (recno > 0) { BasVmResultE rc = seekRecord(vm, channel, recno); if (rc != BAS_VM_OK) { return rc; } } *start = ftell((FILE *)vm->files[channel].handle); return BAS_VM_OK; } // Completes a GET/PUT. RANDOM channels always transfer whole LEN-byte // records: a PUT pads the record with zeros and a GET skips to the next // record; a GET that read past LEN raises error 59 (PUT measures its // record beforehand). static BasVmResultE recordEnd(BasVmT *vm, int32_t channel, long start, bool writing) { FILE *fp = (FILE *)vm->files[channel].handle; if (vm->files[channel].mode == BAS_FILE_MODE_RANDOM) { long recLen = vm->files[channel].recLen; long used = ftell(fp) - start; if (used > recLen) { runtimeError(vm, BAS_ERR_BAD_RECORD_LEN, "Record longer than LEN"); return BAS_VM_FILE_ERROR; } if (writing) { for (long i = used; i < recLen; i++) { fputc(0, fp); } } else { fseek(fp, start + recLen, SEEK_SET); } } if (writing) { fflush(fp); } return BAS_VM_OK; } // Releases every refcounted value the VM holds: the eval stack, the // globals, all call-frame locals across callDepth, and the FOR-stack // limit/step across forDepth. Must run BEFORE the caller zeroes // sp/callDepth/forDepth, because the loops use those counts. static void releaseVmState(BasVmT *vm) { // Release eval stack values for (int32_t i = 0; i < vm->sp; i++) { basValRelease(&vm->stack[i]); } // Release global variables for (int32_t i = 0; i < BAS_VM_MAX_GLOBALS; i++) { basValRelease(&vm->globals[i]); } // Release call frame locals for (int32_t d = 0; d < vm->callDepth; d++) { for (int32_t i = 0; i < vm->callStack[d].localCount; i++) { basValRelease(&vm->callStack[d].locals[i]); } } // Release FOR stack for (int32_t i = 0; i < vm->forDepth; i++) { basValRelease(&vm->forStack[i].limit); basValRelease(&vm->forStack[i].step); } } // Rounds a numeric operand to LONG (banker's rounding) for the integer // operators; raises Overflow when it does not fit. static BasVmResultE roundedOperand(BasVmT *vm, BasValueT v, int32_t *out) { if (!basValRoundToInt32(v, INT32_MIN, INT32_MAX, out)) { runtimeError(vm, BAS_ERR_OVERFLOW, "Overflow"); return BAS_VM_ERROR; } return BAS_VM_OK; } // Executes instructions until callDepth drops back to savedCallDepth // (meaning the subroutine returned). Periodically yields via the // doEvents callback to keep the GUI responsive during long-running // event handlers. static bool runSubLoop(BasVmT *vm, int32_t savedPc, int32_t savedCallDepth, bool savedRunning) { int32_t stepsSinceYield = 0; bool hadBreakpoint = false; while (vm->running && vm->callDepth > savedCallDepth) { int32_t stepPc = vm->pc; // save for ON ERROR dispatch BasVmResultE result = basVmStep(vm); if (result == BAS_VM_HALTED) { break; } if (result == BAS_VM_BREAKPOINT) { // Pause in place: yield to the GUI until the host resumes. // This ensures the sub runs to completion before returning // to the caller (critical for form init code, event handlers). vm->running = false; hadBreakpoint = true; // Notify host to update debug UI (highlight line, locals, etc.) if (vm->breakpointFn) { vm->breakpointFn(vm->breakpointCtx, vm->currentLine); } while (!vm->running && vm->doEventsFn) { if (!vm->doEventsFn(vm->doEventsCtx)) { // Host is shutting down: drop the paused frames like // every other exit path before handing back. while (vm->callDepth > savedCallDepth) { discardFrame(vm); } vm->pc = savedPc; vm->running = savedRunning; return false; } } // User resumed -- continue executing the sub stepsSinceYield = 0; continue; } if (result != BAS_VM_OK) { // Try ON ERROR GOTO within the current sub-call boundary // (savedCallDepth) so event handlers fired via basVmCallSub // behave like module-level code when it comes to trapping. if (dispatchError(vm, result, savedCallDepth, stepPc)) { stepsSinceYield = 0; continue; } // Untrapped: the frames still hold refcounted locals; discard // them so force-restoring callDepth cannot orphan them above // releaseVmState's reach. Not popCallFrame: no out-arg // copy-back on the failure path, and it would clear the error // state the host reads. while (vm->callDepth > savedCallDepth) { discardFrame(vm); } vm->pc = savedPc; vm->running = savedRunning; return false; } // Yield periodically to keep the GUI responsive if (++stepsSinceYield >= BAS_VM_DEFAULT_STEP_SLICE) { stepsSinceYield = 0; if (vm->doEventsFn && !vm->doEventsFn(vm->doEventsCtx)) { vm->running = false; break; } } } // END/OP_HALT and doEvents aborts break out of the loop with the // callee's frames still pushed (OP_RET never ran for them). Pop them // properly -- out-arg copy-back, local release, FOR-stack trim -- // instead of force-lowering callDepth, which would strand the frames' // refcounted locals above callDepth where releaseVmState never walks, // and would drop ByRef out-args (e.g. Cancel = 1 set before END). while (vm->callDepth > savedCallDepth) { popCallFrame(vm); } vm->pc = savedPc; vm->running = savedRunning; // If we paused at a breakpoint during this sub, notify the host // so it can pause the event loop before any new event fires. if (hadBreakpoint && vm->breakpointFn) { vm->breakpointFn(vm->breakpointCtx, -1); } return true; } static void runtimeError(BasVmT *vm, int32_t errNum, const char *msg) { vm->errorNumber = errNum; vm->errorLine = vm->currentLine; vm->lprinting = false; if (vm->currentLine > 0) { snprintf(vm->errorMsg, sizeof(vm->errorMsg), "Runtime error %d on line %d: %s", (int)errNum, (int)vm->currentLine, msg); } else { snprintf(vm->errorMsg, sizeof(vm->errorMsg), "Runtime error %d at PC %d: %s", (int)errNum, (int)vm->currentOpPc, msg); } } // Resolves a variable operand (local, form or global slot, by scope tag) // through any ByRef indirection, the way OP_LOAD_LOCAL/OP_STORE_LOCAL do, // so FOR or an append on a ByRef parameter reaches the caller's variable. Raises the runtime error // and returns NULL when the slot does not exist. static BasValueT *scopedVarSlot(BasVmT *vm, uint16_t varIdx, uint8_t scopeTag) { BasValueT *slot = NULL; const char *what = "Invalid global variable index"; if (scopeTag == SCOPE_LOCAL) { BasCallFrameT *frame = currentFrame(vm); what = "Invalid local variable index"; if (varIdx < (uint16_t)frame->localCount) { slot = &frame->locals[varIdx]; } } else if (scopeTag == SCOPE_FORM) { what = "Invalid form variable index"; if (vm->currentFormVars && varIdx < (uint16_t)vm->currentFormVarCount) { slot = &vm->currentFormVars[varIdx]; } } else if (varIdx < BAS_VM_MAX_GLOBALS) { slot = &vm->globals[varIdx]; } if (!slot) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, what); return NULL; } slot = derefSlot(slot); if (!slot) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Subscript out of range"); } return slot; } // srand with the integer part of seed taken modulo 2^32 (a non-finite // seed counts as 0). static void seedRandom(double seed) { double reduced = isfinite(seed) ? fmod(seed, BAS_RND_SEED_MODULUS) : 0.0; srand((unsigned int)(int64_t)reduced); } // Positions a channel at a 1-based record number (RANDOM) or byte // position (every other mode) for GET/PUT and SEEK. A position whose // byte offset does not fit a long raises Bad record number. static BasVmResultE seekRecord(BasVmT *vm, int32_t channel, int32_t pos) { long unit = (vm->files[channel].mode == BAS_FILE_MODE_RANDOM) ? vm->files[channel].recLen : 1; if ((long)(pos - 1) > LONG_MAX / unit) { runtimeError(vm, BAS_ERR_BAD_RECORD_NUM, "Bad record number"); return BAS_VM_FILE_ERROR; } fseek((FILE *)vm->files[channel].handle, (long)(pos - 1) * unit, SEEK_SET); return BAS_VM_OK; } // A printer channel's spool to its job with CR LF line ends (PRINT # // writes LF), then the job is closed. False when anything failed. static bool sendSpool(BasVmT *vm, BasFileChannelT *ch) { FILE *fp = (FILE *)ch->handle; char in[BAS_SPOOL_CHUNK]; char out[BAS_SPOOL_CHUNK * BAS_PRINTER_NEWLINE_LEN]; bool ok = true; bool prevCr = false; size_t n; rewind(fp); while (ok && (n = fread(in, 1, sizeof(in), fp)) > 0) { int32_t len = 0; for (size_t i = 0; i < n; i++) { if (in[i] == '\n' && !prevCr) { out[len++] = '\r'; } prevCr = (in[i] == '\r'); out[len++] = in[i]; } ok = vm->printer.write(vm->printer.ctx, ch->printJob, out, len); } return vm->printer.close(vm->printer.ctx, ch->printJob) && ok; } // Appends count copies of c to a PUT sink (fixed-length string padding). static void sinkFill(BasPutSinkT *sink, char c, int32_t count) { for (int32_t i = 0; i < count; i++) { sinkWrite(sink, &c, 1); } } // Appends len bytes to a PUT sink (counted only when it has no file). static void sinkWrite(BasPutSinkT *sink, const void *data, int32_t len) { if (sink->fp && len > 0) { fwrite(data, 1, len, sink->fp); } sink->bytes += len; } // SLEEP: waits secs seconds while pumping the host's event loop, so the // GUI keeps running; SLEEP 0 (or a negative count) yields to the host // once. Returns false when the host asks the program to stop. Without an // event pump (headless runs) the process just sleeps. static bool sleepSeconds(BasVmT *vm, int32_t secs) { if (!vm->doEventsFn) { if (secs > 0) { sleep((unsigned int)secs); } return true; } double deadline = wallSeconds() + secs; do { if (!vm->doEventsFn(vm->doEventsCtx)) { return false; } if (secs > 0) { usleep(BAS_SLEEP_POLL_USEC); } } while (wallSeconds() < deadline); return true; } // Stores into an array element or TYPE field. An array reference is // refused there: the compiler never emits one (elements and fields are // scalars or TYPE instances) and a corrupt module storing an array // inside itself would build a reference cycle nothing ever frees. static bool storeElement(BasVmT *vm, BasValueT *target, BasValueT val) { if (val.type == BAS_TYPE_ARRAY) { basValRelease(&val); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Array reference cannot be stored in an element"); return false; } storeValue(target, val); return true; } // Replaces *target with val, releasing the old value. A TYPE value that is // still shared with another variable is deep-copied first so assignment has // value semantics (b = a must not alias a). static void storeValue(BasValueT *target, BasValueT val) { basValRelease(target); *target = udtDetach(val); } // Length-aware substring search (strings may contain NUL bytes). Returns // the 0-based offset of the first occurrence of needle in haystack at or // after start, or -1; ignoreCase compares ASCII letters case-insensitively. // An empty needle matches at start (INSTR semantics). static int32_t stringFind(const BasStringT *haystack, int32_t start, const BasStringT *needle, bool ignoreCase) { if (needle->len == 0) { return start; } for (int32_t i = start; i + needle->len <= haystack->len; i++) { bool match = true; if (!ignoreCase) { match = (memcmp(haystack->data + i, needle->data, needle->len) == 0); } else { for (int32_t k = 0; k < needle->len && match; k++) { match = (toupper((unsigned char)haystack->data[i + k]) == toupper((unsigned char)needle->data[k])); } } if (match) { return i; } } return -1; } // Wraps a string the caller already owns a reference to (no extra ref). static BasValueT strValue(BasStringT *s) { BasValueT v; v.type = BAS_TYPE_STRING; v.strVal = s; return v; } // Gives val its own TYPE instance when the one it carries is shared. The // shared reference is released; a clone failure leaves the value shared. static BasValueT udtDetach(BasValueT val) { if (val.type != BAS_TYPE_UDT || !val.udtVal || val.udtVal->refCount <= 1) { return val; } BasUdtT *copy = basUdtClone(val.udtVal); if (!copy) { return val; } basUdtUnref(val.udtVal); val.udtVal = copy; return val; } // Builds a TYPE instance from its layout: fixed strings start as spaces, // variable strings empty, numerics as typed zeros, nested types are // built recursively. NULL on a malformed layout or out of memory. static BasUdtT *udtFromLayout(BasVmT *vm, const BasStringT *layout, int32_t *pos, int32_t typeId, int32_t fieldCount, int32_t depth) { if (depth >= BAS_LAYOUT_MAX_DEPTH || fieldCount < 0) { runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Bad TYPE layout"); return NULL; } BasUdtT *udt = basUdtNew(typeId, fieldCount); if (!udt) { runtimeError(vm, BAS_ERR_OUT_OF_MEMORY, "Out of memory allocating TYPE"); return NULL; } for (int32_t i = 0; i < fieldCount; i++) { BasLayoutEntryT entry; if (!layoutNext(layout, pos, &entry)) { basUdtUnref(udt); runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Bad TYPE layout"); return NULL; } if (entry.type == BAS_TYPE_UDT) { BasUdtT *child = udtFromLayout(vm, layout, pos, entry.typeId, entry.fieldCount, depth + 1); if (!child) { basUdtUnref(udt); return NULL; } udt->fields[i].type = BAS_TYPE_UDT; udt->fields[i].udtVal = child; } else if (entry.type == BAS_TYPE_STRING && entry.fixedLen > 0) { udt->fields[i] = strValue(fillString(' ', entry.fixedLen)); } else { udt->fields[i] = zeroValue(entry.type); } } return udt; } // GET into a TYPE instance: walks the compiler's layout (one entry per // field, nested types inline) and fills each field in place. static BasVmResultE udtGet(BasVmT *vm, FILE *fp, BasUdtT *udt, const BasStringT *layout, int32_t *pos, int32_t depth) { if (depth >= BAS_LAYOUT_MAX_DEPTH) { runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "TYPE nesting too deep"); return BAS_VM_TYPE_MISMATCH; } for (int32_t i = 0; i < udt->fieldCount; i++) { BasLayoutEntryT entry; if (!layoutNext(layout, pos, &entry)) { runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Bad TYPE layout"); return BAS_VM_TYPE_MISMATCH; } uint8_t type = entry.type; int32_t fixedLen = entry.fixedLen; BasValueT *field = &udt->fields[i]; if (type == BAS_TYPE_UDT) { if (field->type != BAS_TYPE_UDT || !field->udtVal) { runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Not a TYPE instance"); return BAS_VM_TYPE_MISMATCH; } BasVmResultE rc = udtGet(vm, fp, field->udtVal, layout, pos, depth + 1); if (rc != BAS_VM_OK) { return rc; } continue; } if (type == BAS_TYPE_STRING) { storeValue(field, strValue(fixedLen > 0 ? ioReadBytes(fp, fixedLen, true) : ioReadPrefixedString(fp))); continue; } storeValue(field, ioReadScalar(fp, type)); } return BAS_VM_OK; } // PUT counterpart of udtGet. static BasVmResultE udtPut(BasVmT *vm, BasPutSinkT *sink, const BasUdtT *udt, const BasStringT *layout, int32_t *pos, int32_t depth) { if (depth >= BAS_LAYOUT_MAX_DEPTH) { runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "TYPE nesting too deep"); return BAS_VM_TYPE_MISMATCH; } for (int32_t i = 0; i < udt->fieldCount; i++) { BasLayoutEntryT entry; if (!layoutNext(layout, pos, &entry)) { runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Bad TYPE layout"); return BAS_VM_TYPE_MISMATCH; } uint8_t type = entry.type; int32_t fixedLen = entry.fixedLen; BasValueT field = udt->fields[i]; if (type == BAS_TYPE_UDT) { if (field.type != BAS_TYPE_UDT || !field.udtVal) { runtimeError(vm, BAS_ERR_TYPE_MISMATCH, "Not a TYPE instance"); return BAS_VM_TYPE_MISMATCH; } BasVmResultE rc = udtPut(vm, sink, field.udtVal, layout, pos, depth + 1); if (rc != BAS_VM_OK) { return rc; } continue; } if (type == BAS_TYPE_STRING) { BasValueT sv = basValToString(field); if (fixedLen > 0) { int32_t copyLen = DVX_MIN(sv.strVal->len, fixedLen); sinkWrite(sink, sv.strVal->data, copyLen); sinkFill(sink, ' ', fixedLen - copyLen); } else { ioWritePrefixedString(sink, sv.strVal); } basValRelease(&sv); continue; } ioWriteScalar(sink, type, field); } return BAS_VM_OK; } // Checks a form/control opcode can run: the host must provide the // callback (no form runtime otherwise) and the target must be an object // reference -- an unset object variable holds a number and raises Object // variable not set. A NULL object is passed on for the host to report. static BasVmResultE uiTarget(BasVmT *vm, bool hasCallback, BasValueT target) { if (!hasCallback) { return noFormRuntime(vm); } if (target.type != BAS_TYPE_OBJECT) { runtimeError(vm, BAS_ERR_OBJECT_NOT_SET, "Object variable not set"); return BAS_VM_ERROR; } return BAS_VM_OK; } // Length of the PRINT USING field starting at fmt[pos], or 0 when the // character there is literal text. String fields are '!', '&' and a // backslash pair; numeric fields start with '#', '.', "**", "$$" or a // '+' followed by one of those, run over the digit, comma and point // positions, and may end in "^^^^" and a trailing sign. static int32_t usingFieldLen(const char *fmt, int32_t fmtLen, int32_t pos) { char c = fmt[pos]; if (c == '!' || c == '&') { return 1; } if (c == '\\') { for (int32_t i = pos + 1; i < fmtLen; i++) { if (fmt[i] == '\\') { return i - pos + 1; } } return 0; } int32_t i = pos; bool hasFill = false; bool leadPlus = (c == '+'); if (leadPlus) { i++; } if (i + 1 < fmtLen && fmt[i] == '*' && fmt[i + 1] == '*') { hasFill = true; i += 2; } if (i + 1 < fmtLen && fmt[i] == '$' && fmt[i + 1] == '$') { hasFill = true; i += 2; } // A numeric field needs a digit position ('#' or ".#") or a fill; // a lone '+' (for example the end of "Total+") is literal text. if (!hasFill && (i >= fmtLen || (fmt[i] != '#' && !(fmt[i] == '.' && i + 1 < fmtLen && fmt[i + 1] == '#')))) { return 0; } while (i < fmtLen && (fmt[i] == '#' || fmt[i] == '0' || fmt[i] == ',' || fmt[i] == '.')) { i++; } if (i + (int32_t)strlen(BAS_SCI_MARKER) <= fmtLen && strncmp(fmt + i, BAS_SCI_MARKER, strlen(BAS_SCI_MARKER)) == 0) { i += (int32_t)strlen(BAS_SCI_MARKER); } if (!leadPlus && i < fmtLen && (fmt[i] == '+' || fmt[i] == '-')) { i++; } return i - pos; } // Formats one PRINT USING value: emits the literal text from the current // scan position up to the next field, the field rendered from val, and, // for the last value of the statement, the literal text after it. The // scan wraps to the start of the format when it runs out of fields. // Returns NULL when the field type does not match the value. static BasStringT *usingFormat(BasVmT *vm, const BasStringT *fmt, BasValueT val, bool last) { int32_t valLen = (val.type == BAS_TYPE_STRING && val.strVal) ? val.strVal->len : 0; int32_t cap = fmt->len * 2 + valLen + BAS_FORMAT_BUF_SIZE + 1; char *buf = (char *)malloc(cap); if (!buf) { return basStringRef(basEmptyString); } int32_t idx = 0; int32_t limit = cap - 1; int32_t fieldLen = 0; bool wrapped = false; // Literal text up to the next field; wrap at most once. while (vm->usingPos < fmt->len || !wrapped) { if (vm->usingPos >= fmt->len) { wrapped = true; vm->usingPos = 0; if (fmt->len == 0) { break; } } char c = fmt->data[vm->usingPos]; if (c == BAS_USING_ESCAPE && vm->usingPos + 1 < fmt->len) { putBounded(buf, &idx, limit, fmt->data[vm->usingPos + 1]); vm->usingPos += 2; continue; } fieldLen = usingFieldLen(fmt->data, fmt->len, vm->usingPos); if (fieldLen > 0) { break; } putBounded(buf, &idx, limit, c); vm->usingPos++; } if (fieldLen == 0) { // No field anywhere in the format: the value prints as-is. BasStringT *plain = basValFormatString(val); for (int32_t i = 0; i < plain->len; i++) { putBounded(buf, &idx, limit, plain->data[i]); } basStringUnref(plain); buf[idx] = '\0'; BasStringT *result = basStringNew(buf, idx); free(buf); return result; } const char *field = fmt->data + vm->usingPos; bool strField = (field[0] == '!' || field[0] == '&' || field[0] == '\\'); vm->usingPos += fieldLen; if (strField != (val.type == BAS_TYPE_STRING)) { free(buf); return NULL; } if (strField) { const char *src = val.strVal ? val.strVal->data : ""; int32_t srcLen = val.strVal ? val.strVal->len : 0; int32_t width = (field[0] == '!') ? 1 : (field[0] == '&') ? srcLen : fieldLen; for (int32_t i = 0; i < width; i++) { putBounded(buf, &idx, limit, (i < srcLen) ? src[i] : ' '); } } else { double n = basValToNumber(val); BasNumFormatT f; bool sciNotation; char numBuf[BAS_FORMAT_BUF_SIZE]; parseNumFormat(field, fieldLen, &f, &sciNotation); f.markOverflow = true; if (sciNotation) { char sciFmt[BAS_SCI_FMT_LEN]; int32_t decimals = f.hasDecimal ? f.digitsAfter : 0; snprintf(sciFmt, sizeof(sciFmt), "%%%d.%dE", (int)fieldLen, (int)decimals); snprintf(numBuf, sizeof(numBuf), sciFmt, n); } else { formatNumber(n, &f, numBuf, sizeof(numBuf)); } for (int32_t i = 0; numBuf[i]; i++) { putBounded(buf, &idx, limit, numBuf[i]); } } // Trailing literal text after the last value, up to the next field. if (last) { while (vm->usingPos < fmt->len) { char c = fmt->data[vm->usingPos]; if (c == BAS_USING_ESCAPE && vm->usingPos + 1 < fmt->len) { putBounded(buf, &idx, limit, fmt->data[vm->usingPos + 1]); vm->usingPos += 2; continue; } if (usingFieldLen(fmt->data, fmt->len, vm->usingPos) > 0) { break; } putBounded(buf, &idx, limit, c); vm->usingPos++; } } buf[idx] = '\0'; BasStringT *result = basStringNew(buf, idx); free(buf); return result; } static bool validArrayDims(BasVmT *vm, int32_t dims) { if (dims < 1 || dims > BAS_ARRAY_MAX_DIMS) { runtimeError(vm, BAS_ERR_SUBSCRIPT_RANGE, "Invalid array dimension count"); return false; } return true; } // Wall-clock time in seconds (sub-second resolution), for SLEEP deadlines. static double wallSeconds(void) { struct timeval tv; gettimeofday(&tv, NULL); return (double)tv.tv_sec + (double)tv.tv_usec / BAS_USEC_PER_SEC; } // The declared zero of a data type: "" for strings, False for booleans, // a typed numeric zero otherwise. static BasValueT zeroValue(uint8_t type) { switch (type) { case BAS_TYPE_STRING: return strValue(basStringRef(basEmptyString)); case BAS_TYPE_BOOLEAN: return basValBool(false); case BAS_TYPE_LONG: return basValLong(0); case BAS_TYPE_SINGLE: return basValSingle(0.0f); case BAS_TYPE_DOUBLE: return basValDouble(0.0); default: return basValInteger(0); } }