1654 lines
48 KiB
C
1654 lines
48 KiB
C
// 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.
|
|
|
|
|
|
// genStmt.c -- DVX BASIC generator: statements
|
|
//
|
|
// Every executable statement starts with OP_LINE (the debugger's line,
|
|
// the statement boundary error recovery unwinds to). Declarations that
|
|
// emit no code get none. Store targets of READ, INPUT, GET, SWAP and
|
|
// LSET have their subscripts evaluated before the value they receive is
|
|
// produced (a subscript that cannot change meanwhile is evaluated at the
|
|
// store instead of being parked in a temporary).
|
|
|
|
#include "front.h"
|
|
#include "thirdparty/stb_ds_wrap.h"
|
|
|
|
#include <string.h>
|
|
|
|
// LSET / RSET of a string: OP_BUILTIN BAS_FN_LSET / BAS_FN_RSET's arguments.
|
|
#define BAS_LSET_ARGS 2
|
|
|
|
// Size of an opcode byte (forward GOTO pop placeholders sit just before it).
|
|
#define BAS_OPCODE_LEN 1
|
|
|
|
// A store target prepared ahead of its value.
|
|
typedef struct {
|
|
const BasNodeT *node; // NK_VAR, NK_ELEM or an NK_FIELD chain on either
|
|
const BasCallT *elem; // the element at the chain's root (NULL: a variable)
|
|
int32_t temps[BAS_ARRAY_MAX_DIMS]; // parked subscripts (-1: evaluated at the store)
|
|
} LvalueT;
|
|
|
|
// Function prototypes (alphabetical)
|
|
void basGenBody(BasCompilerT *c, const BasNodeT *list);
|
|
void basGenFlushProcSkip(BasCompilerT *c);
|
|
void basGenLine(BasCompilerT *c, const BasNodeT *s);
|
|
void basGenStatement(BasCompilerT *c, const BasNodeT *s);
|
|
void basGenSymChanges(BasCompilerT *c, const BasNodeT *at);
|
|
static void genAssign(BasCompilerT *c, const BasStmtT *s);
|
|
static void genBuiltinStatement(BasCompilerT *c, uint8_t fn, int32_t argc);
|
|
static void genCallStmt(BasCompilerT *c, const BasStmtT *s);
|
|
static void genData(BasCompilerT *c, const BasStmtT *s);
|
|
static void genDo(BasCompilerT *c, const BasLoopT *loop);
|
|
static void genExit(BasCompilerT *c, const BasStmtT *s);
|
|
static void genFor(BasCompilerT *c, const BasLoopT *loop);
|
|
static void genForEach(BasCompilerT *c, const BasLoopT *loop);
|
|
static void genGet(BasCompilerT *c, const BasStmtT *s);
|
|
static void genGoto(BasCompilerT *c, BasSymT *label);
|
|
static void genIf(BasCompilerT *c, const BasIfT *n);
|
|
static void genInput(BasCompilerT *c, const BasStmtT *s);
|
|
static void genInputConv(BasCompilerT *c, uint8_t dataType);
|
|
static void genJumpToLabel(BasCompilerT *c, uint8_t op, BasSymT *label, int32_t gotoDepth);
|
|
static void genLabel(BasCompilerT *c, const BasStmtT *s);
|
|
static void genLineInput(BasCompilerT *c, const BasStmtT *s);
|
|
static void genLoopEnd(BasCompilerT *c);
|
|
static void genLoopStart(BasCompilerT *c, bool isFor, bool isForEach);
|
|
static void genLset(BasCompilerT *c, const BasStmtT *s);
|
|
static void genObjectPrint(BasCompilerT *c, const BasStmtT *s);
|
|
static void genObjectPrintCall(BasCompilerT *c, const BasNodeT *objNode, int32_t obj, const BasNodeT *value, int32_t mode);
|
|
static void genOnGoto(BasCompilerT *c, const BasStmtT *s);
|
|
static void genPops(BasCompilerT *c, int32_t count);
|
|
static void genPrint(BasCompilerT *c, const BasPrintT *pr);
|
|
static void genPrintUsing(BasCompilerT *c, const BasPrintT *pr);
|
|
static void genPrompt(BasCompilerT *c, const BasNodeT *prompt);
|
|
static void genPut(BasCompilerT *c, const BasStmtT *s);
|
|
static void genRestore(BasCompilerT *c, BasSymT *label);
|
|
static void genSelect(BasCompilerT *c, const BasSelectT *sel);
|
|
static void genSwap(BasCompilerT *c, const BasStmtT *s);
|
|
static void genWhile(BasCompilerT *c, const BasLoopT *loop);
|
|
static void genWith(BasCompilerT *c, const BasWithT *w);
|
|
static void genWrite(BasCompilerT *c, const BasStmtT *s);
|
|
static bool isDeclaration(uint8_t kind);
|
|
static void lvLoad(BasCompilerT *c, const LvalueT *lv, const BasNodeT *n);
|
|
static void lvPrepare(BasCompilerT *c, LvalueT *lv, const BasNodeT *target, bool varsStable);
|
|
static void lvPushElement(BasCompilerT *c, const LvalueT *lv, const BasCallT *elem);
|
|
static void lvStore(BasCompilerT *c, const LvalueT *lv);
|
|
static const BasSymT *lvSymbol(const LvalueT *lv);
|
|
static uint8_t lvType(const LvalueT *lv);
|
|
static bool stableExpr(const BasNodeT *n, bool varsStable);
|
|
|
|
|
|
// Generates the statements of a list.
|
|
void basGenBody(BasCompilerT *c, const BasNodeT *list) {
|
|
for (const BasNodeT *s = list; s != NULL && !c->hasError; s = s->next) {
|
|
basGenStatement(c, s);
|
|
}
|
|
}
|
|
|
|
|
|
// Lands the jump over the procedures defined since the last module code
|
|
// on the module code about to be emitted (a procedure's own statements
|
|
// leave it).
|
|
void basGenFlushProcSkip(BasCompilerT *c) {
|
|
if (c->procSkipJump >= 0 && !c->inProc) {
|
|
basGenPatchHere(c, c->procSkipJump);
|
|
c->procSkipJump = -1;
|
|
}
|
|
}
|
|
|
|
|
|
// A statement's start: module code after procedures lands the jump over
|
|
// them, the temporaries are free again, and OP_LINE marks the boundary.
|
|
void basGenLine(BasCompilerT *c, const BasNodeT *s) {
|
|
basGenFlushProcSkip(c);
|
|
c->tempUsed = 0;
|
|
basEmit8(&c->cg, OP_LINE);
|
|
basEmitU16(&c->cg, (uint16_t)s->line);
|
|
}
|
|
|
|
|
|
void basGenStatement(BasCompilerT *c, const BasNodeT *s) {
|
|
if (c->hasError) {
|
|
return;
|
|
}
|
|
|
|
if (isDeclaration(s->kind)) {
|
|
basGenDeclaration(c, s);
|
|
return;
|
|
}
|
|
|
|
if (s->kind == ST_LABEL) {
|
|
basGenFlushProcSkip(c);
|
|
genLabel(c, (const BasStmtT *)s);
|
|
return;
|
|
}
|
|
|
|
if (s->kind == ST_DATA) {
|
|
genData(c, (const BasStmtT *)s);
|
|
return;
|
|
}
|
|
|
|
basGenLine(c, s);
|
|
|
|
const BasStmtT *st = (const BasStmtT *)s;
|
|
|
|
switch (s->kind) {
|
|
case ST_ASSIGN:
|
|
basGenSymChanges(c, s);
|
|
genAssign(c, st);
|
|
break;
|
|
|
|
case ST_CALL:
|
|
genCallStmt(c, st);
|
|
break;
|
|
|
|
case ST_EXPR:
|
|
basGenExpr(c, st->a);
|
|
basEmit8(&c->cg, OP_POP);
|
|
break;
|
|
|
|
case ST_SIMPLE:
|
|
basGenArgs(c, st->b);
|
|
basEmit8(&c->cg, (uint8_t)st->ival);
|
|
break;
|
|
|
|
case ST_SCREEN:
|
|
basGenArgs(c, st->b);
|
|
genBuiltinStatement(c, (uint8_t)st->ival, st->ival2);
|
|
break;
|
|
|
|
case ST_PRINT:
|
|
genPrint(c, (const BasPrintT *)s);
|
|
break;
|
|
|
|
case ST_IF:
|
|
genIf(c, (const BasIfT *)s);
|
|
break;
|
|
|
|
case ST_FOR:
|
|
genFor(c, (const BasLoopT *)s);
|
|
break;
|
|
|
|
case ST_FOREACH:
|
|
genForEach(c, (const BasLoopT *)s);
|
|
break;
|
|
|
|
case ST_DO:
|
|
genDo(c, (const BasLoopT *)s);
|
|
break;
|
|
|
|
case ST_WITH:
|
|
genWith(c, (const BasWithT *)s);
|
|
break;
|
|
|
|
case ST_WHILE:
|
|
genWhile(c, (const BasLoopT *)s);
|
|
break;
|
|
|
|
case ST_SELECT:
|
|
genSelect(c, (const BasSelectT *)s);
|
|
break;
|
|
|
|
case ST_EXIT:
|
|
genExit(c, st);
|
|
break;
|
|
|
|
case ST_GOTO:
|
|
genGoto(c, st->sym);
|
|
break;
|
|
|
|
case ST_GOSUB:
|
|
genJumpToLabel(c, OP_GOSUB, st->sym, 0);
|
|
break;
|
|
|
|
case ST_RETURN:
|
|
genPops(c, st->ival);
|
|
basEmit8(&c->cg, OP_GOSUB_RET);
|
|
break;
|
|
|
|
case ST_ONGOTO:
|
|
genOnGoto(c, st);
|
|
break;
|
|
|
|
case ST_ONERROR:
|
|
if (st->ival == BAS_ON_ERROR_RESUME_NEXT) {
|
|
basEmit8(&c->cg, OP_ON_ERROR_NEXT);
|
|
} else if (st->sym == NULL) {
|
|
basEmit8(&c->cg, OP_ON_ERROR);
|
|
basEmit32(&c->cg, 0);
|
|
} else {
|
|
genJumpToLabel(c, OP_ON_ERROR, st->sym, 0);
|
|
}
|
|
|
|
break;
|
|
|
|
case ST_RESUME:
|
|
// RESUME label: the handler ends, then a GOTO to the label
|
|
if (st->sym != NULL) {
|
|
basEmit8(&c->cg, OP_RESUME_LABEL);
|
|
genGoto(c, st->sym);
|
|
} else {
|
|
basEmit8(&c->cg, st->ival ? OP_RESUME_NEXT : OP_RESUME);
|
|
}
|
|
|
|
break;
|
|
|
|
case ST_END:
|
|
basEmit8(&c->cg, OP_END);
|
|
break;
|
|
|
|
case ST_REDIM: {
|
|
const BasSymT *sym = st->sym;
|
|
int32_t dims = basNodeCount(st->a);
|
|
|
|
basGenSymChanges(c, s);
|
|
basGenLoadVar(c, sym);
|
|
|
|
for (const BasNodeT *bn = st->a; bn != NULL; bn = bn->next) {
|
|
basGenExpr(c, ((const BasBoundT *)bn)->lower);
|
|
basGenExpr(c, ((const BasBoundT *)bn)->upper);
|
|
}
|
|
|
|
if (sym->dataType == BAS_TYPE_UDT && !basGenUdtSpec(c, sym->udtTypeId)) {
|
|
break;
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_REDIM);
|
|
basEmit8(&c->cg, (uint8_t)dims);
|
|
basEmit8(&c->cg, (st->ival & BAS_DIM_PRESERVE) ? 1 : 0);
|
|
basEmit8(&c->cg, sym->dataType);
|
|
basGenStore(c, sym);
|
|
break;
|
|
}
|
|
|
|
case ST_ERASE:
|
|
for (const BasNodeT *a = st->a; a != NULL; a = a->next) {
|
|
const BasSymT *sym = ((const BasNameT *)a)->sym;
|
|
|
|
basGenLoadVar(c, sym);
|
|
basEmit8(&c->cg, OP_ERASE);
|
|
basEmit8(&c->cg, (sym->flags & SF_DYNAMIC) ? BAS_ERASE_FREE : BAS_ERASE_ZERO);
|
|
basGenStore(c, sym);
|
|
}
|
|
|
|
break;
|
|
|
|
case ST_MIDASSIGN:
|
|
basGenLoadVar(c, st->sym);
|
|
basGenExpr(c, st->a);
|
|
|
|
if (st->b != NULL) {
|
|
basGenExpr(c, st->b);
|
|
} else {
|
|
basGenPushInt16(c, BAS_MID_LEN_OMITTED);
|
|
}
|
|
|
|
basGenExpr(c, st->c);
|
|
basEmit8(&c->cg, OP_STR_MID_ASGN);
|
|
basGenStoreFrom(c, st->sym, BAS_TYPE_STRING);
|
|
break;
|
|
|
|
case ST_LSET:
|
|
genLset(c, st);
|
|
break;
|
|
|
|
case ST_SWAP:
|
|
genSwap(c, st);
|
|
break;
|
|
|
|
case ST_READ:
|
|
for (const BasNodeT *t = st->a; t != NULL && !c->hasError; t = t->next) {
|
|
int32_t mark = c->tempUsed;
|
|
LvalueT lv;
|
|
|
|
lvPrepare(c, &lv, t, true);
|
|
basEmit8(&c->cg, OP_READ_DATA);
|
|
lvStore(c, &lv);
|
|
c->tempUsed = mark;
|
|
}
|
|
|
|
break;
|
|
|
|
case ST_RESTORE:
|
|
genRestore(c, st->sym);
|
|
break;
|
|
|
|
case ST_INPUT:
|
|
genInput(c, st);
|
|
break;
|
|
|
|
case ST_LINEINPUT:
|
|
genLineInput(c, st);
|
|
break;
|
|
|
|
case ST_OPEN:
|
|
basGenExpr(c, st->a);
|
|
basGenExpr(c, st->b);
|
|
|
|
if (st->c != NULL) {
|
|
basGenExpr(c, st->c);
|
|
} else {
|
|
basGenPushInt16(c, BAS_VM_RANDOM_RECORD_SIZE);
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_FILE_OPEN);
|
|
basEmit8(&c->cg, (uint8_t)st->ival);
|
|
break;
|
|
|
|
case ST_GET:
|
|
genGet(c, st);
|
|
break;
|
|
|
|
case ST_PUT:
|
|
genPut(c, st);
|
|
break;
|
|
|
|
case ST_WRITE:
|
|
genWrite(c, st);
|
|
break;
|
|
|
|
case ST_LOAD:
|
|
basGenPushCStr(c, st->name);
|
|
basEmit8(&c->cg, OP_LOAD_FORM);
|
|
basEmit8(&c->cg, OP_POP);
|
|
break;
|
|
|
|
case ST_UNLOAD:
|
|
if (st->name != NULL) {
|
|
basGenPushCStr(c, st->name);
|
|
basEmit8(&c->cg, OP_LOAD_FORM);
|
|
} else if (st->a != NULL) {
|
|
basGenExpr(c, st->a);
|
|
} else {
|
|
basEmit8(&c->cg, OP_ME_REF);
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_UNLOAD_FORM);
|
|
break;
|
|
|
|
case ST_RAISEEVENT:
|
|
for (const BasNodeT *a = st->b; a != NULL; a = a->next) {
|
|
basGenExpr(c, a);
|
|
|
|
if (a->flags & NF_SHAREDARG) {
|
|
basGenTempRef(c);
|
|
}
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_RAISE_EVENT);
|
|
basEmitU16(&c->cg, (uint16_t)st->ival);
|
|
basEmit8(&c->cg, (uint8_t)st->ival2);
|
|
break;
|
|
|
|
default:
|
|
basErrorNode(c, s, "Internal error: statement kind %d", (int)s->kind);
|
|
break;
|
|
}
|
|
}
|
|
|
|
|
|
// The symbol changes statement at makes take effect for the code after
|
|
// it (see basSymChange).
|
|
void basGenSymChanges(BasCompilerT *c, const BasNodeT *at) {
|
|
for (int32_t i = 0; i < (int32_t)arrlen(c->symChanges); i++) {
|
|
const BasSymChangeT *ch = &c->symChanges[i];
|
|
|
|
if (ch->at == at) {
|
|
ch->sym->dataType = ch->afterType;
|
|
ch->sym->udtTypeId = ch->afterUdtTypeId;
|
|
ch->sym->flags = ch->afterFlags;
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
// target = value (SET with NF_SET).
|
|
static void genAssign(BasCompilerT *c, const BasStmtT *s) {
|
|
bool isSet = (s->h.flags & NF_SET) != 0;
|
|
const BasNodeT *target = s->a;
|
|
|
|
if (s->ival2 == BAS_STORE_RECORD) {
|
|
// Copied into the record the target holds: a reference taken
|
|
// earlier sees the new value
|
|
basGenRef(c, target);
|
|
basGenExpr(c, s->b);
|
|
basEmit8(&c->cg, OP_BUILTIN);
|
|
basEmit8(&c->cg, BAS_FN_RECORD_ASSIGN);
|
|
basEmit8(&c->cg, BAS_RECORD_ASSIGN_ARGS);
|
|
basEmit8(&c->cg, OP_POP);
|
|
return;
|
|
}
|
|
|
|
switch (target->kind) {
|
|
case NK_VAR: {
|
|
const BasSymT *sym = ((const BasNameT *)target)->sym;
|
|
|
|
if (s->ival2 == BAS_STORE_APPEND) {
|
|
basGenExpr(c, s->b);
|
|
basEmit8(&c->cg, OP_STR_APPEND);
|
|
basEmit8(&c->cg, (s->ival == TOK_AMPERSAND) ? BAS_APPEND_AMP : 0);
|
|
basEmit8(&c->cg, (uint8_t)basStorageScope(sym));
|
|
basEmitU16(&c->cg, (uint16_t)sym->index);
|
|
return;
|
|
}
|
|
|
|
bool scalar = !(sym->flags & SF_ARRAY);
|
|
|
|
uint8_t conv = basGenStoreValue(c, s->b, (scalar && (sym->flags & SF_TYPED)) ? sym->dataType : BAS_TYPE_VARIANT, scalar ? sym->fixedLen : 0, scalar ? sym->objClass : BAS_CLASS_NONE, isSet, true);
|
|
|
|
basGenStoreSlot(c, basStorageScope(sym), sym->index, conv);
|
|
return;
|
|
}
|
|
|
|
case NK_RESULT: {
|
|
const BasSymT *sym = ((const BasNameT *)target)->sym;
|
|
|
|
uint8_t conv = basGenStoreValue(c, s->b, (sym->flags & SF_TYPED) ? sym->dataType : BAS_TYPE_VARIANT, 0, sym->objClass, isSet, true);
|
|
|
|
basGenStoreSlot(c, SCOPE_LOCAL, BAS_FUNC_RESULT_SLOT, conv);
|
|
return;
|
|
}
|
|
|
|
case NK_ELEM: {
|
|
const BasCallT *elem = (const BasCallT *)target;
|
|
const BasSymT *sym = ((const BasNameT *)elem->callee)->sym;
|
|
bool array = (sym->flags & SF_ARRAY) != 0;
|
|
|
|
basGenLoadVar(c, sym);
|
|
basGenArgs(c, elem->args);
|
|
basGenStoreValue(c, s->b, (array && (sym->flags & SF_TYPED)) ? sym->dataType : BAS_TYPE_VARIANT, 0, array ? sym->objClass : BAS_CLASS_NONE, isSet, false);
|
|
basEmit8(&c->cg, OP_STORE_ARRAY);
|
|
basEmit8(&c->cg, (uint8_t)elem->argc);
|
|
return;
|
|
}
|
|
|
|
case NK_FIELD: {
|
|
const BasMemberT *m = (const BasMemberT *)target;
|
|
const BasFieldT *f = (const BasFieldT *)m->target;
|
|
const BasNodeT *base = m->base;
|
|
|
|
// A field of an array element is stored through the array
|
|
if (base->kind == NK_ELEM && (((const BasNameT *)((const BasCallT *)base)->callee)->sym->flags & SF_ARRAY)) {
|
|
const BasCallT *elem = (const BasCallT *)base;
|
|
|
|
basGenExpr(c, elem->callee);
|
|
basGenArgs(c, elem->args);
|
|
basGenStoreValue(c, s->b, f->dataType, f->fixedLen, BAS_CLASS_NONE, isSet, false);
|
|
basEmit8(&c->cg, OP_STORE_ARRAY_FIELD);
|
|
basEmit8(&c->cg, (uint8_t)elem->argc);
|
|
basEmitU16(&c->cg, (uint16_t)m->aux);
|
|
return;
|
|
}
|
|
|
|
basGenExpr(c, base);
|
|
basGenStoreValue(c, s->b, f->dataType, f->fixedLen, BAS_CLASS_NONE, isSet, false);
|
|
basEmit8(&c->cg, OP_STORE_FIELD);
|
|
basEmitU16(&c->cg, (uint16_t)m->aux);
|
|
return;
|
|
}
|
|
|
|
case NK_PROP: {
|
|
const BasMemberT *m = (const BasMemberT *)target;
|
|
|
|
basGenExpr(c, m->base);
|
|
basGenPushCStr(c, m->name);
|
|
basGenStoreValue(c, s->b, BAS_TYPE_VARIANT, 0, BAS_CLASS_NONE, isSet, false);
|
|
|
|
if (isSet) {
|
|
basEmit8(&c->cg, OP_PROP_ASSIGN);
|
|
basEmit8(&c->cg, 0);
|
|
basEmit8(&c->cg, BAS_ASSIGN_SET);
|
|
} else {
|
|
basEmit8(&c->cg, OP_STORE_PROP);
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
case NK_OBJMEMBER: {
|
|
// obj.P(args) = value, early bound: a variable (args index it),
|
|
// Property Let or Set
|
|
const BasCallT *call = (const BasCallT *)target;
|
|
|
|
basGenExpr(c, call->callee);
|
|
basGenArgs(c, call->args);
|
|
basGenStoreValue(c, s->b, BAS_TYPE_VARIANT, 0, BAS_CLASS_NONE, isSet, false);
|
|
basGenObjMember(c, OP_OBJ_PUT, call);
|
|
return;
|
|
}
|
|
|
|
case NK_FCALL: {
|
|
// Me.P(args) = value in P's class: its Property Let / Set called
|
|
const BasCallT *call = (const BasCallT *)target;
|
|
|
|
basGenArgs(c, call->args);
|
|
basGenStoreValue(c, s->b, BAS_TYPE_VARIANT, 0, BAS_CLASS_NONE, isSet, false);
|
|
basGenCall(c, (BasSymT *)call->target, call->argc + 1);
|
|
return;
|
|
}
|
|
|
|
case NK_METHOD: {
|
|
// obj.P(args) = value
|
|
const BasCallT *call = (const BasCallT *)target;
|
|
|
|
basGenExpr(c, call->callee);
|
|
basGenPushCStr(c, (const char *)call->target);
|
|
basGenArgs(c, call->args);
|
|
basGenStoreValue(c, s->b, BAS_TYPE_VARIANT, 0, BAS_CLASS_NONE, isSet, false);
|
|
basEmit8(&c->cg, OP_PROP_ASSIGN);
|
|
basEmit8(&c->cg, (uint8_t)call->argc);
|
|
basEmit8(&c->cg, isSet ? BAS_ASSIGN_SET : 0);
|
|
return;
|
|
}
|
|
|
|
default:
|
|
basErrorNode(c, target, "Internal error: store target kind %d", (int)target->kind);
|
|
return;
|
|
}
|
|
}
|
|
|
|
|
|
// OP_BUILTIN function fn on the argc arguments pushed, as a statement
|
|
// (its result dropped).
|
|
static void genBuiltinStatement(BasCompilerT *c, uint8_t fn, int32_t argc) {
|
|
basEmit8(&c->cg, OP_BUILTIN);
|
|
basEmit8(&c->cg, fn);
|
|
basEmit8(&c->cg, (uint8_t)argc);
|
|
basEmit8(&c->cg, OP_POP);
|
|
}
|
|
|
|
|
|
// A call statement: a SUB / FUNCTION (a FUNCTION's result dropped), a
|
|
// method (its result dropped), Show / Hide of a form, an object Print.
|
|
static void genCallStmt(BasCompilerT *c, const BasStmtT *s) {
|
|
if (s->ival == BAS_ARGS_DRAWING) {
|
|
genObjectPrint(c, s);
|
|
return;
|
|
}
|
|
|
|
basGenExpr(c, s->a);
|
|
|
|
if (s->ival2) {
|
|
basEmit8(&c->cg, OP_POP);
|
|
}
|
|
}
|
|
|
|
|
|
// DATA items go to the module's data pool; no code.
|
|
static void genData(BasCompilerT *c, const BasStmtT *s) {
|
|
for (const BasNodeT *it = s->a; it != NULL; it = it->next) {
|
|
const BasLitT *lit = (const BasLitT *)it;
|
|
BasValueT v;
|
|
|
|
if (it->kind == NK_STR) {
|
|
v = basValEmpty();
|
|
v.type = BAS_TYPE_STRING;
|
|
v.strVal = basStringNew(lit->str, lit->slen);
|
|
} else if (it->kind == NK_DBL) {
|
|
v = (it->type == BAS_TYPE_CURRENCY) ? basValCurrency(lit->cval) : basValDouble(lit->dval);
|
|
} else if (it->type == BAS_TYPE_INTEGER) {
|
|
v = basValInteger((int16_t)lit->ival);
|
|
} else {
|
|
v = basValLong(lit->ival);
|
|
}
|
|
|
|
basAddData(&c->cg, v);
|
|
basValRelease(&v);
|
|
}
|
|
}
|
|
|
|
|
|
// DO [WHILE | UNTIL cond] ... LOOP [WHILE | UNTIL cond]
|
|
static void genDo(BasCompilerT *c, const BasLoopT *loop) {
|
|
genLoopStart(c, false, false);
|
|
|
|
int32_t top = basCodePos(&c->cg);
|
|
int32_t preJump = -1;
|
|
|
|
if (loop->preCond != NULL) {
|
|
basGenExpr(c, loop->preCond);
|
|
preJump = basGenJump(c, loop->preUntil ? OP_JMP_TRUE : OP_JMP_FALSE);
|
|
}
|
|
|
|
basGenBody(c, loop->body);
|
|
|
|
if (loop->postCond != NULL) {
|
|
basGenExpr(c, loop->postCond);
|
|
basGenJumpTo(c, loop->postUntil ? OP_JMP_FALSE : OP_JMP_TRUE, top);
|
|
} else {
|
|
basGenJumpTo(c, OP_JMP, top);
|
|
}
|
|
|
|
if (preJump >= 0) {
|
|
basGenPatchHere(c, preJump);
|
|
}
|
|
|
|
genLoopEnd(c);
|
|
}
|
|
|
|
|
|
// EXIT FOR / DO leave the innermost loop of the kind (the test values of
|
|
// the SELECT blocks opened inside it dropped, a FOR's frame popped);
|
|
// EXIT SUB / FUNCTION / PROPERTY jump to the procedure's return.
|
|
static void genExit(BasCompilerT *c, const BasStmtT *s) {
|
|
if (s->ival != TOK_FOR && s->ival != TOK_DO) {
|
|
genPops(c, c->genSelectDepth);
|
|
arrput(c->exitProcPatches, basGenJump(c, OP_JMP));
|
|
return;
|
|
}
|
|
|
|
bool isFor = (s->ival == TOK_FOR);
|
|
|
|
for (int32_t i = (int32_t)arrlen(c->loops) - 1; i >= 0; i--) {
|
|
BasGenLoopT *loop = &c->loops[i];
|
|
|
|
if (loop->isFor != isFor) {
|
|
continue;
|
|
}
|
|
|
|
genPops(c, c->genSelectDepth - loop->selectBase);
|
|
|
|
if (isFor && !loop->isForEach) {
|
|
basEmit8(&c->cg, OP_FOR_POP);
|
|
}
|
|
|
|
arrput(loop->exitPatches, basGenJump(c, OP_JMP));
|
|
return;
|
|
}
|
|
}
|
|
|
|
|
|
// FOR var = start TO limit [STEP step] ... NEXT: OP_FOR_INIT skips the
|
|
// body when the range is empty at entry.
|
|
static void genFor(BasCompilerT *c, const BasLoopT *loop) {
|
|
const BasSymT *var = ((const BasNameT *)loop->var)->sym;
|
|
|
|
genLoopStart(c, true, false);
|
|
uint8_t conv = basGenStoreValue(c, loop->from, (var->flags & SF_TYPED) ? var->dataType : BAS_TYPE_VARIANT, var->fixedLen, var->objClass, false, true);
|
|
|
|
basGenStoreSlot(c, basStorageScope(var), var->index, conv);
|
|
basGenExpr(c, loop->to);
|
|
|
|
if (loop->step != NULL) {
|
|
basGenExpr(c, loop->step);
|
|
} else {
|
|
basGenPushInt16(c, 1);
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_FOR_INIT);
|
|
basEmitU16(&c->cg, (uint16_t)var->index);
|
|
basEmit8(&c->cg, (uint8_t)basStorageScope(var));
|
|
|
|
int32_t skip = basCodePos(&c->cg);
|
|
|
|
basEmit32(&c->cg, 0);
|
|
|
|
int32_t body = basCodePos(&c->cg);
|
|
|
|
basGenBody(c, loop->body);
|
|
basEmit8(&c->cg, OP_FOR_NEXT);
|
|
basEmitU16(&c->cg, (uint16_t)var->index);
|
|
basEmit8(&c->cg, (uint8_t)basStorageScope(var));
|
|
basEmit32(&c->cg, body - (basCodePos(&c->cg) + BAS_CODE_ADDR_SIZE));
|
|
basGenPatchHere(c, skip);
|
|
genLoopEnd(c);
|
|
}
|
|
|
|
|
|
// FOR EACH item IN group ... NEXT: the group and the position live in two
|
|
// compiler variables; the count is read on every pass, so items removed
|
|
// inside the loop end it early.
|
|
static void genForEach(BasCompilerT *c, const BasLoopT *loop) {
|
|
const BasSymT *item = ((const BasNameT *)loop->var)->sym;
|
|
const BasSymT *group = loop->hidden[0];
|
|
const BasSymT *index = loop->hidden[1];
|
|
|
|
basGenExpr(c, loop->from);
|
|
basGenStoreRaw(c, group);
|
|
basGenPushInt16(c, 0);
|
|
basGenStoreRaw(c, index);
|
|
genLoopStart(c, true, true);
|
|
|
|
int32_t top = basCodePos(&c->cg);
|
|
|
|
basGenLoadVar(c, index);
|
|
basGenLoadVar(c, group);
|
|
basEmit8(&c->cg, OP_BUILTIN);
|
|
basEmit8(&c->cg, BAS_FN_EACH_COUNT);
|
|
basEmit8(&c->cg, 1);
|
|
basEmit8(&c->cg, OP_CMP_LT);
|
|
|
|
int32_t done = basGenJump(c, OP_JMP_FALSE);
|
|
|
|
basGenLoadVar(c, group);
|
|
basGenLoadVar(c, index);
|
|
basEmit8(&c->cg, OP_BUILTIN);
|
|
basEmit8(&c->cg, BAS_FN_EACH_ITEM);
|
|
basEmit8(&c->cg, BAS_EACH_ITEM_ARGS);
|
|
basGenStore(c, item);
|
|
basGenBody(c, loop->body);
|
|
basGenLoadVar(c, index);
|
|
basEmit8(&c->cg, OP_ADD_K16);
|
|
basEmit16(&c->cg, 1);
|
|
basGenStoreRaw(c, index);
|
|
basGenJumpTo(c, OP_JMP, top);
|
|
basGenPatchHere(c, done);
|
|
|
|
// EXIT FOR lands here too; then the loop lets go of the group
|
|
genLoopEnd(c);
|
|
basGenPushSpecial(c, BAS_SPECIAL_EMPTY);
|
|
basGenStoreRaw(c, group);
|
|
}
|
|
|
|
|
|
// GET #channel, [record], target: a TYPE target is filled in place, a
|
|
// STRING one reads as many bytes as it holds (BINARY), an element of
|
|
// another type is loaded first so a bad subscript fails before the read.
|
|
static void genGet(BasCompilerT *c, const BasStmtT *s) {
|
|
LvalueT lv;
|
|
|
|
basGenExpr(c, s->a);
|
|
|
|
if (s->b != NULL) {
|
|
basGenExpr(c, s->b);
|
|
} else {
|
|
basGenPushInt16(c, 0);
|
|
}
|
|
|
|
lvPrepare(c, &lv, s->c, true);
|
|
|
|
const BasSymT *sym = lvSymbol(&lv);
|
|
|
|
if (sym->dataType == BAS_TYPE_UDT) {
|
|
lvLoad(c, &lv, lv.node);
|
|
|
|
if (!basGenUdtLayout(c, sym->udtTypeId)) {
|
|
return;
|
|
}
|
|
|
|
basGenPushInt16(c, BAS_TYPE_UDT);
|
|
basEmit8(&c->cg, OP_FILE_GET);
|
|
|
|
if (lv.elem != NULL) {
|
|
basEmit8(&c->cg, OP_POP);
|
|
} else {
|
|
basGenStore(c, sym);
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
if (sym->dataType == BAS_TYPE_STRING || lv.elem != NULL) {
|
|
lvLoad(c, &lv, lv.node);
|
|
|
|
if (sym->dataType != BAS_TYPE_STRING) {
|
|
basEmit8(&c->cg, OP_POP);
|
|
}
|
|
}
|
|
|
|
basGenPushInt16(c, sym->dataType);
|
|
basEmit8(&c->cg, OP_FILE_GET);
|
|
lvStore(c, &lv);
|
|
}
|
|
|
|
|
|
// GOTO label: the test values of the SELECT blocks the jump leaves are
|
|
// dropped first. A label not generated yet whose depth is not known (a
|
|
// module label in a later unit) gets one OP_NOP per open SELECT, turned
|
|
// into OP_POPs when the label is defined.
|
|
static void genGoto(BasCompilerT *c, BasSymT *label) {
|
|
if (label->flags & SF_DEFINED) {
|
|
genPops(c, c->genSelectDepth - label->u.label->selectDepth);
|
|
genJumpToLabel(c, OP_JMP, label, 0);
|
|
return;
|
|
}
|
|
|
|
for (int32_t i = 0; i < c->genSelectDepth; i++) {
|
|
basEmit8(&c->cg, OP_NOP);
|
|
}
|
|
|
|
genJumpToLabel(c, OP_JMP, label, c->genSelectDepth);
|
|
}
|
|
|
|
|
|
static void genIf(BasCompilerT *c, const BasIfT *n) {
|
|
int32_t *endJumps = NULL;
|
|
|
|
basGenExpr(c, n->cond);
|
|
|
|
int32_t falseJump = basGenJump(c, OP_JMP_FALSE);
|
|
|
|
basGenBody(c, n->thenBody);
|
|
|
|
for (const BasNodeT *ei = n->elseIfs; ei != NULL && !c->hasError; ei = ei->next) {
|
|
const BasIfT *e = (const BasIfT *)ei;
|
|
|
|
arrput(endJumps, basGenJump(c, OP_JMP));
|
|
basGenPatchHere(c, falseJump);
|
|
basGenExpr(c, e->cond);
|
|
falseJump = basGenJump(c, OP_JMP_FALSE);
|
|
basGenBody(c, e->thenBody);
|
|
}
|
|
|
|
if (n->hasElse) {
|
|
arrput(endJumps, basGenJump(c, OP_JMP));
|
|
basGenPatchHere(c, falseJump);
|
|
basGenBody(c, n->elseBody);
|
|
} else {
|
|
basGenPatchHere(c, falseJump);
|
|
}
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(endJumps); i++) {
|
|
basGenPatchHere(c, endJumps[i]);
|
|
}
|
|
|
|
arrfree(endJumps);
|
|
}
|
|
|
|
|
|
// INPUT #channel, targets (one OP_FILE_INPUT each, the channel kept for
|
|
// all but the last) / INPUT ["prompt";] target.
|
|
static void genInput(BasCompilerT *c, const BasStmtT *s) {
|
|
LvalueT lv;
|
|
|
|
if (s->a != NULL) {
|
|
basGenExpr(c, s->a);
|
|
|
|
for (const BasNodeT *t = s->c; t != NULL && !c->hasError; t = t->next) {
|
|
int32_t mark = c->tempUsed;
|
|
|
|
lvPrepare(c, &lv, t, true);
|
|
|
|
if (t->next != NULL) {
|
|
basEmit8(&c->cg, OP_DUP);
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_FILE_INPUT);
|
|
genInputConv(c, lvType(&lv));
|
|
lvStore(c, &lv);
|
|
c->tempUsed = mark;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
genPrompt(c, s->b);
|
|
basEmit8(&c->cg, OP_INPUT);
|
|
lvPrepare(c, &lv, s->c, true);
|
|
genInputConv(c, lvType(&lv));
|
|
lvStore(c, &lv);
|
|
}
|
|
|
|
|
|
// INPUT reads a string: a numeric target takes the number it starts with
|
|
// as VAL reads it (0 when none: QBasic, and VB's Input #), a DOUBLE the
|
|
// store narrows.
|
|
static void genInputConv(BasCompilerT *c, uint8_t dataType) {
|
|
if (dataType != BAS_TYPE_STRING && dataType != BAS_TYPE_DATE) {
|
|
basEmit8(&c->cg, OP_STR_VAL);
|
|
}
|
|
}
|
|
|
|
|
|
// A jump (GOTO, GOSUB, ON ERROR) to label; one not generated yet is
|
|
// patched when it is. gotoDepth: the SELECT depth of a GOTO whose pops
|
|
// wait for the label (0: none).
|
|
static void genJumpToLabel(BasCompilerT *c, uint8_t op, BasSymT *label, int32_t gotoDepth) {
|
|
BasLabelInfoT *info = label->u.label;
|
|
|
|
if (info->hasCode) {
|
|
basGenJumpTo(c, op, info->codeAddr);
|
|
return;
|
|
}
|
|
|
|
arrput(info->patches, basGenJump(c, op));
|
|
arrput(info->patchDepths, gotoDepth);
|
|
}
|
|
|
|
|
|
// "Name:" -- the jumps waiting for the label land here (a forward GOTO's
|
|
// placeholders become the pops it needs), the RESTOREs of it get the DATA
|
|
// items before it; a line number is noted for ERL.
|
|
static void genLabel(BasCompilerT *c, const BasStmtT *s) {
|
|
BasLabelInfoT *info = s->sym->u.label;
|
|
|
|
info->codeAddr = basCodePos(&c->cg);
|
|
info->dataIndex = c->cg.dataCount;
|
|
info->hasCode = true;
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(info->dataPatches); i++) {
|
|
basWriteI32LE(&c->cg.code[info->dataPatches[i]], info->dataIndex);
|
|
}
|
|
|
|
if (s->ival == BAS_LABEL_LINE_NUMBER) {
|
|
BasLineNumberT ln;
|
|
|
|
ln.line = s->h.line;
|
|
ln.number = s->ival2;
|
|
arrput(c->cg.lineNumbers, ln);
|
|
}
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(info->patches); i++) {
|
|
int32_t pos = info->patches[i];
|
|
int32_t pops = info->patchDepths[i] - info->selectDepth;
|
|
|
|
for (int32_t j = 0; j < pops; j++) {
|
|
c->cg.code[pos - BAS_OPCODE_LEN - info->patchDepths[i] + j] = OP_POP;
|
|
}
|
|
|
|
basGenPatchHere(c, pos);
|
|
}
|
|
|
|
arrfree(info->patches);
|
|
arrfree(info->patchDepths);
|
|
arrfree(info->dataPatches);
|
|
info->patches = NULL;
|
|
info->patchDepths = NULL;
|
|
info->dataPatches = NULL;
|
|
}
|
|
|
|
|
|
// LINE INPUT #channel, target / LINE INPUT [;] ["prompt";] target
|
|
static void genLineInput(BasCompilerT *c, const BasStmtT *s) {
|
|
LvalueT lv;
|
|
|
|
if (s->a != NULL) {
|
|
basGenExpr(c, s->a);
|
|
lvPrepare(c, &lv, s->c, true);
|
|
basEmit8(&c->cg, OP_FILE_LINE_INPUT);
|
|
lvStore(c, &lv);
|
|
return;
|
|
}
|
|
|
|
genPrompt(c, s->b);
|
|
basEmit8(&c->cg, OP_BUILTIN);
|
|
basEmit8(&c->cg, BAS_FN_LINE_INPUT);
|
|
basEmit8(&c->cg, 1);
|
|
lvPrepare(c, &lv, s->c, true);
|
|
genInputConv(c, lvType(&lv));
|
|
lvStore(c, &lv);
|
|
}
|
|
|
|
|
|
// Closes the innermost loop: its EXITs land here.
|
|
static void genLoopEnd(BasCompilerT *c) {
|
|
BasGenLoopT *loop = &arrlast(c->loops);
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(loop->exitPatches); i++) {
|
|
basGenPatchHere(c, loop->exitPatches[i]);
|
|
}
|
|
|
|
arrfree(loop->exitPatches);
|
|
arrsetlen(c->loops, arrlen(c->loops) - 1);
|
|
}
|
|
|
|
|
|
static void genLoopStart(BasCompilerT *c, bool isFor, bool isForEach) {
|
|
BasGenLoopT loop;
|
|
|
|
memset(&loop, 0, sizeof(loop));
|
|
loop.selectBase = c->genSelectDepth;
|
|
loop.isFor = isFor;
|
|
loop.isForEach = isForEach;
|
|
arrput(c->loops, loop);
|
|
}
|
|
|
|
|
|
// LSET / RSET target = value; LSET rec1 = rec2 copies a whole record byte
|
|
// by byte.
|
|
static void genLset(BasCompilerT *c, const BasStmtT *s) {
|
|
LvalueT lv;
|
|
|
|
lvPrepare(c, &lv, s->a, true);
|
|
lvLoad(c, &lv, lv.node);
|
|
|
|
int32_t typeId = basExprUdtType(c, s->a);
|
|
|
|
if (typeId >= 0) {
|
|
LvalueT src;
|
|
|
|
lvPrepare(c, &src, s->c, true);
|
|
lvLoad(c, &src, src.node);
|
|
|
|
if (!basGenUdtLayout(c, typeId) || !basGenUdtLayout(c, basExprUdtType(c, s->c))) {
|
|
return;
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_BUILTIN);
|
|
basEmit8(&c->cg, BAS_FN_LSET_TYPE);
|
|
basEmit8(&c->cg, BAS_LSET_TYPE_ARGS);
|
|
lvStore(c, &lv);
|
|
return;
|
|
}
|
|
|
|
basGenExpr(c, s->c);
|
|
basEmit8(&c->cg, OP_BUILTIN);
|
|
basEmit8(&c->cg, s->ival ? BAS_FN_RSET : BAS_FN_LSET);
|
|
basEmit8(&c->cg, BAS_LSET_ARGS);
|
|
lvStore(c, &lv);
|
|
}
|
|
|
|
|
|
// obj.Print items: one Print call per item (the object kept in a
|
|
// temporary, unless it is Me), ',' a print zone, SPC / TAB, and the end
|
|
// of the line unless the last item is ';' or ','.
|
|
static void genObjectPrint(BasCompilerT *c, const BasStmtT *s) {
|
|
const BasCallT *method = (const BasCallT *)s->a;
|
|
int32_t obj = -1;
|
|
bool newline = true;
|
|
|
|
if (method->callee->kind != NK_ME) {
|
|
obj = basGenTemp(c);
|
|
basGenExpr(c, method->callee);
|
|
basGenStoreTemp(c, obj);
|
|
}
|
|
|
|
for (const BasNodeT *it = s->b; it != NULL && !c->hasError; it = it->next) {
|
|
const BasPrintItemT *item = (const BasPrintItemT *)it;
|
|
|
|
switch (item->kind) {
|
|
case BAS_ITEM_SEMI:
|
|
newline = false;
|
|
break;
|
|
|
|
case BAS_ITEM_COMMA:
|
|
genObjectPrintCall(c, method->callee, obj, NULL, BAS_OBJ_PRINT_ZONE);
|
|
newline = false;
|
|
break;
|
|
|
|
case BAS_ITEM_SPC:
|
|
genObjectPrintCall(c, method->callee, obj, item->expr, BAS_OBJ_PRINT_SPC);
|
|
newline = true;
|
|
break;
|
|
|
|
case BAS_ITEM_TAB:
|
|
genObjectPrintCall(c, method->callee, obj, item->expr, BAS_OBJ_PRINT_TAB);
|
|
newline = true;
|
|
break;
|
|
|
|
default:
|
|
genObjectPrintCall(c, method->callee, obj, item->expr, BAS_OBJ_PRINT_TEXT);
|
|
newline = true;
|
|
break;
|
|
}
|
|
}
|
|
|
|
if (newline) {
|
|
genObjectPrintCall(c, method->callee, obj, NULL, BAS_OBJ_PRINT_NEWLINE);
|
|
}
|
|
}
|
|
|
|
|
|
// One object Print call: the object (temporary obj, or objNode itself
|
|
// when obj < 0), "Print", the value (NULL: 0, for the modes that take
|
|
// none) and the mode.
|
|
static void genObjectPrintCall(BasCompilerT *c, const BasNodeT *objNode, int32_t obj, const BasNodeT *value, int32_t mode) {
|
|
if (obj >= 0) {
|
|
basGenLoadTemp(c, obj);
|
|
} else {
|
|
basGenExpr(c, objNode);
|
|
}
|
|
|
|
basGenPushCStr(c, BAS_METHOD_PRINT);
|
|
|
|
if (value != NULL) {
|
|
basGenExpr(c, value);
|
|
} else {
|
|
basGenPushInt16(c, 0);
|
|
}
|
|
|
|
basGenPushInt16(c, (int16_t)mode);
|
|
basEmit8(&c->cg, OP_CALL_METHOD);
|
|
basEmit8(&c->cg, BAS_OBJ_PRINT_ARGS);
|
|
basEmit8(&c->cg, OP_POP);
|
|
}
|
|
|
|
|
|
// ON expr GOTO / GOSUB label, ...: the selector is kept in a temporary
|
|
// cleared first, so an error computing it leaves no branch to take after
|
|
// RESUME NEXT.
|
|
static void genOnGoto(BasCompilerT *c, const BasStmtT *s) {
|
|
int32_t selector = basGenTemp(c);
|
|
int32_t *endJumps = NULL;
|
|
int16_t idx = 1;
|
|
|
|
basGenPushInt16(c, 0);
|
|
basGenStoreTemp(c, selector);
|
|
basGenExpr(c, s->a);
|
|
basGenStoreTemp(c, selector);
|
|
|
|
for (const BasNodeT *l = s->b; l != NULL && !c->hasError; l = l->next, idx++) {
|
|
BasSymT *label = ((const BasNameT *)l)->sym;
|
|
|
|
basGenLoadTemp(c, selector);
|
|
basGenPushInt16(c, idx);
|
|
basEmit8(&c->cg, OP_CMP_EQ);
|
|
|
|
int32_t skip = basGenJump(c, OP_JMP_FALSE);
|
|
|
|
if (s->ival) {
|
|
genJumpToLabel(c, OP_GOSUB, label, 0);
|
|
arrput(endJumps, basGenJump(c, OP_JMP));
|
|
} else {
|
|
genGoto(c, label);
|
|
}
|
|
|
|
basGenPatchHere(c, skip);
|
|
}
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(endJumps); i++) {
|
|
basGenPatchHere(c, endJumps[i]);
|
|
}
|
|
|
|
arrfree(endJumps);
|
|
}
|
|
|
|
|
|
// Drops count SELECT test values.
|
|
static void genPops(BasCompilerT *c, int32_t count) {
|
|
for (int32_t i = 0; i < count; i++) {
|
|
basEmit8(&c->cg, OP_POP);
|
|
}
|
|
}
|
|
|
|
|
|
// PRINT / LPRINT items, PRINT USING, PRINT #.
|
|
static void genPrint(BasCompilerT *c, const BasPrintT *pr) {
|
|
// PRINT # sends the statement's output to the file
|
|
if (pr->channel != NULL) {
|
|
basGenExpr(c, pr->channel);
|
|
genBuiltinStatement(c, BAS_FN_FILE_PRINT, 1);
|
|
}
|
|
|
|
if (pr->isLprint) {
|
|
basEmit8(&c->cg, OP_LPRINT);
|
|
basEmit8(&c->cg, BAS_LPRINT_BEGIN);
|
|
}
|
|
|
|
if (pr->mode == BAS_PRINT_USING) {
|
|
genPrintUsing(c, pr);
|
|
} else {
|
|
uint8_t last = BAS_ITEM_EXPR;
|
|
|
|
for (const BasNodeT *it = pr->items; it != NULL && !c->hasError; it = it->next) {
|
|
const BasPrintItemT *item = (const BasPrintItemT *)it;
|
|
|
|
last = item->kind;
|
|
|
|
switch (item->kind) {
|
|
case BAS_ITEM_SEMI:
|
|
break;
|
|
|
|
case BAS_ITEM_COMMA:
|
|
basEmit8(&c->cg, OP_PRINT_TAB);
|
|
break;
|
|
|
|
case BAS_ITEM_SPC:
|
|
basGenExpr(c, item->expr);
|
|
basEmit8(&c->cg, OP_PRINT_SPC_N);
|
|
break;
|
|
|
|
case BAS_ITEM_TAB:
|
|
basGenExpr(c, item->expr);
|
|
basEmit8(&c->cg, OP_PRINT_TAB_N);
|
|
break;
|
|
|
|
default:
|
|
basGenExpr(c, item->expr);
|
|
basEmit8(&c->cg, OP_PRINT);
|
|
break;
|
|
}
|
|
}
|
|
|
|
// A trailing ';' or ',' keeps the line open
|
|
if (last != BAS_ITEM_SEMI && last != BAS_ITEM_COMMA) {
|
|
basEmit8(&c->cg, OP_PRINT_NL);
|
|
}
|
|
}
|
|
|
|
if (pr->isLprint) {
|
|
basEmit8(&c->cg, OP_LPRINT);
|
|
basEmit8(&c->cg, BAS_LPRINT_END);
|
|
}
|
|
|
|
if (pr->channel != NULL) {
|
|
genBuiltinStatement(c, BAS_FN_FILE_PRINT, 0);
|
|
}
|
|
}
|
|
|
|
|
|
// PRINT USING format; values: the first value rewinds the format, the last
|
|
// prints its trailing text; the format left on the stack is dropped.
|
|
static void genPrintUsing(BasCompilerT *c, const BasPrintT *pr) {
|
|
uint8_t flags = BAS_USING_FIRST;
|
|
int32_t flagsPos = -1;
|
|
bool trailingSep = false;
|
|
|
|
basGenExpr(c, pr->format);
|
|
|
|
for (const BasNodeT *it = pr->items; it != NULL && !c->hasError; it = it->next) {
|
|
const BasPrintItemT *item = (const BasPrintItemT *)it;
|
|
|
|
trailingSep = (item->kind != BAS_ITEM_EXPR);
|
|
|
|
if (trailingSep) {
|
|
continue;
|
|
}
|
|
|
|
basGenExpr(c, item->expr);
|
|
basEmit8(&c->cg, OP_PRINT_USING);
|
|
flagsPos = basCodePos(&c->cg);
|
|
basEmit8(&c->cg, flags);
|
|
basEmit8(&c->cg, OP_PRINT);
|
|
flags = 0;
|
|
}
|
|
|
|
if (flagsPos >= 0) {
|
|
c->cg.code[flagsPos] |= BAS_USING_LAST;
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_POP);
|
|
|
|
if (!trailingSep) {
|
|
basEmit8(&c->cg, OP_PRINT_NL);
|
|
}
|
|
}
|
|
|
|
|
|
// An INPUT / LINE INPUT prompt ("" when there is none).
|
|
static void genPrompt(BasCompilerT *c, const BasNodeT *prompt) {
|
|
if (prompt != NULL) {
|
|
basGenExpr(c, prompt);
|
|
} else {
|
|
basGenPushStr(c, "", 0);
|
|
}
|
|
}
|
|
|
|
|
|
// PUT #channel, [record], value: a TYPE variable or element writes the
|
|
// record's packed fields.
|
|
static void genPut(BasCompilerT *c, const BasStmtT *s) {
|
|
basGenExpr(c, s->a);
|
|
|
|
if (s->b != NULL) {
|
|
basGenExpr(c, s->b);
|
|
} else {
|
|
basGenPushInt16(c, 0);
|
|
}
|
|
|
|
basGenExpr(c, s->c);
|
|
|
|
if (s->ival) {
|
|
if (!basGenUdtLayout(c, basExprUdtType(c, s->c))) {
|
|
return;
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_FILE_PUT_UDT);
|
|
return;
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_FILE_PUT);
|
|
}
|
|
|
|
|
|
// RESTORE [label]: the DATA pointer to the first DATA item, or to the
|
|
// first after label (a label not generated yet fills the operand in).
|
|
static void genRestore(BasCompilerT *c, BasSymT *label) {
|
|
basEmit8(&c->cg, OP_RESTORE);
|
|
|
|
if (label == NULL || label->u.label->hasCode) {
|
|
basEmit32(&c->cg, (label != NULL) ? label->u.label->dataIndex : 0);
|
|
return;
|
|
}
|
|
|
|
arrput(label->u.label->dataPatches, basCodePos(&c->cg));
|
|
basEmit32(&c->cg, 0);
|
|
}
|
|
|
|
|
|
// SELECT CASE: the test value stays on the stack for the whole construct.
|
|
// A never-taken jump after it skips the construct when an error computing
|
|
// the value is resumed with RESUME NEXT. Every test fails forward with
|
|
// JMP_FALSE (an error in it then counts as false).
|
|
static void genSelect(BasCompilerT *c, const BasSelectT *sel) {
|
|
int32_t *endJumps = NULL;
|
|
|
|
basGenExpr(c, sel->expr);
|
|
basEmit8(&c->cg, OP_PUSH_FALSE);
|
|
|
|
int32_t skip = basGenJump(c, OP_JMP_TRUE);
|
|
|
|
c->genSelectDepth++;
|
|
|
|
for (const BasNodeT *cn = sel->cases; cn != NULL && !c->hasError; cn = cn->next) {
|
|
const BasCaseT *cs = (const BasCaseT *)cn;
|
|
int32_t *bodyJumps = NULL;
|
|
int32_t *failJumps = NULL;
|
|
|
|
// The tests start a statement whose stack holds the test value
|
|
basEmit8(&c->cg, OP_STMT);
|
|
|
|
for (const BasNodeT *in = cs->items; in != NULL && !c->hasError; in = in->next) {
|
|
const BasCaseItemT *item = (const BasCaseItemT *)in;
|
|
|
|
basEmit8(&c->cg, OP_DUP);
|
|
basGenExpr(c, item->a);
|
|
|
|
if (item->kind == BAS_CASE_RANGE) {
|
|
basEmit8(&c->cg, OP_CMP_GE);
|
|
arrput(failJumps, basGenJump(c, OP_JMP_FALSE));
|
|
basEmit8(&c->cg, OP_DUP);
|
|
basGenExpr(c, item->b);
|
|
basEmit8(&c->cg, OP_CMP_LE);
|
|
} else {
|
|
basEmit8(&c->cg, (item->kind == BAS_CASE_IS) ? item->cmpOp : OP_CMP_EQ);
|
|
}
|
|
|
|
arrput(failJumps, basGenJump(c, OP_JMP_FALSE));
|
|
|
|
if (in->next == NULL) {
|
|
break;
|
|
}
|
|
|
|
// Another item follows: a pass enters the body, a fail tries it
|
|
arrput(bodyJumps, basGenJump(c, OP_JMP));
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(failJumps); i++) {
|
|
basGenPatchHere(c, failJumps[i]);
|
|
}
|
|
|
|
arrsetlen(failJumps, 0);
|
|
}
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(bodyJumps); i++) {
|
|
basGenPatchHere(c, bodyJumps[i]);
|
|
}
|
|
|
|
arrfree(bodyJumps);
|
|
basGenBody(c, cs->body);
|
|
|
|
// The last body (and CASE ELSE) falls into the pop
|
|
if (cn->next != NULL && !cs->isElse) {
|
|
arrput(endJumps, basGenJump(c, OP_JMP));
|
|
}
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(failJumps); i++) {
|
|
basGenPatchHere(c, failJumps[i]);
|
|
}
|
|
|
|
arrfree(failJumps);
|
|
}
|
|
|
|
for (int32_t i = 0; i < (int32_t)arrlen(endJumps); i++) {
|
|
basGenPatchHere(c, endJumps[i]);
|
|
}
|
|
|
|
arrfree(endJumps);
|
|
basEmit8(&c->cg, OP_POP);
|
|
basGenPatchHere(c, skip);
|
|
c->genSelectDepth--;
|
|
}
|
|
|
|
|
|
// SWAP a, b: both subscripts evaluated once.
|
|
static void genSwap(BasCompilerT *c, const BasStmtT *s) {
|
|
LvalueT a;
|
|
LvalueT b;
|
|
|
|
// The first store may change a variable the other's subscripts use
|
|
lvPrepare(c, &a, s->a, false);
|
|
lvLoad(c, &a, a.node);
|
|
lvPrepare(c, &b, s->b, false);
|
|
lvLoad(c, &b, b.node);
|
|
lvStore(c, &a);
|
|
lvStore(c, &b);
|
|
}
|
|
|
|
|
|
// WHILE cond ... WEND (EXIT DO leaves it).
|
|
static void genWhile(BasCompilerT *c, const BasLoopT *loop) {
|
|
genLoopStart(c, false, false);
|
|
|
|
int32_t top = basCodePos(&c->cg);
|
|
|
|
basGenExpr(c, loop->preCond);
|
|
|
|
int32_t done = basGenJump(c, OP_JMP_FALSE);
|
|
|
|
basGenBody(c, loop->body);
|
|
basGenJumpTo(c, OP_JMP, top);
|
|
basGenPatchHere(c, done);
|
|
genLoopEnd(c);
|
|
}
|
|
|
|
|
|
// WITH ... END WITH: an object evaluated once is held in the hidden
|
|
// variable for the block and released at its end.
|
|
static void genWith(BasCompilerT *c, const BasWithT *w) {
|
|
if (w->hidden != NULL) {
|
|
basGenExpr(c, w->expr);
|
|
basGenStore(c, w->hidden);
|
|
}
|
|
|
|
basGenBody(c, w->body);
|
|
|
|
if (w->hidden != NULL) {
|
|
basGenPushSpecial(c, BAS_SPECIAL_EMPTY);
|
|
basGenStoreRaw(c, w->hidden);
|
|
}
|
|
}
|
|
|
|
|
|
// WRITE #channel, values: comma-separated, strings quoted, then a newline.
|
|
static void genWrite(BasCompilerT *c, const BasStmtT *s) {
|
|
basGenExpr(c, s->a);
|
|
|
|
for (const BasNodeT *v = s->b; v != NULL && !c->hasError; v = v->next) {
|
|
if (v != s->b) {
|
|
basEmit8(&c->cg, OP_DUP);
|
|
basEmit8(&c->cg, OP_FILE_WRITE_SEP);
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_DUP);
|
|
basGenExpr(c, v);
|
|
basEmit8(&c->cg, OP_FILE_WRITE);
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_FILE_WRITE_NL);
|
|
}
|
|
|
|
|
|
// Statements gen.c generates (declarations, procedures, form and class
|
|
// markers).
|
|
static bool isDeclaration(uint8_t kind) {
|
|
return kind >= ST_DIM && kind <= ST_IMPLEMENTS && kind != ST_REDIM && kind != ST_ERASE && kind != ST_DATA && kind != ST_RESTORE;
|
|
}
|
|
|
|
|
|
// Pushes the current value of node n of the prepared target lv.
|
|
static void lvLoad(BasCompilerT *c, const LvalueT *lv, const BasNodeT *n) {
|
|
if (n->kind == NK_FIELD) {
|
|
const BasMemberT *m = (const BasMemberT *)n;
|
|
|
|
lvLoad(c, lv, m->base);
|
|
basEmit8(&c->cg, OP_LOAD_FIELD);
|
|
basEmitU16(&c->cg, (uint16_t)m->aux);
|
|
return;
|
|
}
|
|
|
|
if (n->kind == NK_ELEM) {
|
|
lvPushElement(c, lv, (const BasCallT *)n);
|
|
basEmit8(&c->cg, OP_LOAD_ARRAY);
|
|
basEmit8(&c->cg, (uint8_t)((const BasCallT *)n)->argc);
|
|
return;
|
|
}
|
|
|
|
basGenExpr(c, n);
|
|
}
|
|
|
|
|
|
// Evaluates the subscripts of target that could change before the store
|
|
// (varsStable: no variable can change before it).
|
|
static void lvPrepare(BasCompilerT *c, LvalueT *lv, const BasNodeT *target, bool varsStable) {
|
|
const BasNodeT *root = target;
|
|
|
|
while (root->kind == NK_FIELD) {
|
|
root = ((const BasMemberT *)root)->base;
|
|
}
|
|
|
|
lv->node = target;
|
|
lv->elem = (root->kind == NK_ELEM) ? (const BasCallT *)root : NULL;
|
|
|
|
for (int32_t i = 0; i < BAS_ARRAY_MAX_DIMS; i++) {
|
|
lv->temps[i] = -1;
|
|
}
|
|
|
|
if (lv->elem == NULL) {
|
|
return;
|
|
}
|
|
|
|
int32_t i = 0;
|
|
|
|
for (const BasNodeT *a = lv->elem->args; a != NULL; a = a->next, i++) {
|
|
if (!stableExpr(a, varsStable)) {
|
|
lv->temps[i] = basGenTemp(c);
|
|
basGenExpr(c, a);
|
|
basGenStoreTemp(c, lv->temps[i]);
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
// Pushes the array (or what a Variant holds) and the subscripts of lv's
|
|
// element elem.
|
|
static void lvPushElement(BasCompilerT *c, const LvalueT *lv, const BasCallT *elem) {
|
|
int32_t i = 0;
|
|
|
|
basGenExpr(c, elem->callee);
|
|
|
|
for (const BasNodeT *a = elem->args; a != NULL; a = a->next, i++) {
|
|
if (lv->temps[i] >= 0) {
|
|
basGenLoadTemp(c, lv->temps[i]);
|
|
} else {
|
|
basGenExpr(c, a);
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
// Stores the value on the stack into the prepared target lv. An element
|
|
// or field store needs the array or record beneath the value, so the
|
|
// value is parked in a temporary while they are pushed.
|
|
static void lvStore(BasCompilerT *c, const LvalueT *lv) {
|
|
const BasNodeT *n = lv->node;
|
|
|
|
if (n->kind == NK_VAR) {
|
|
basGenStore(c, ((const BasNameT *)n)->sym);
|
|
return;
|
|
}
|
|
|
|
int32_t value = basGenTemp(c);
|
|
|
|
basGenStoreTemp(c, value);
|
|
|
|
if (n->kind == NK_FIELD) {
|
|
const BasMemberT *m = (const BasMemberT *)n;
|
|
const BasFieldT *f = (const BasFieldT *)m->target;
|
|
|
|
lvLoad(c, lv, m->base);
|
|
basGenLoadTemp(c, value);
|
|
|
|
if (f->fixedLen > 0) {
|
|
basEmit8(&c->cg, OP_STR_FIXLEN);
|
|
basEmitU16(&c->cg, (uint16_t)f->fixedLen);
|
|
}
|
|
|
|
basGenStoreConv(c, f->dataType);
|
|
basEmit8(&c->cg, OP_STORE_FIELD);
|
|
basEmitU16(&c->cg, (uint16_t)m->aux);
|
|
return;
|
|
}
|
|
|
|
if (n->kind != NK_ELEM) {
|
|
basErrorNode(c, n, "Internal error: store target kind %d", (int)n->kind);
|
|
return;
|
|
}
|
|
|
|
const BasCallT *elem = (const BasCallT *)n;
|
|
const BasSymT *sym = lvSymbol(lv);
|
|
|
|
lvPushElement(c, lv, elem);
|
|
basGenLoadTemp(c, value);
|
|
|
|
if (sym->flags & SF_TYPED) {
|
|
basGenStoreConv(c, sym->dataType);
|
|
}
|
|
|
|
basEmit8(&c->cg, OP_STORE_ARRAY);
|
|
basEmit8(&c->cg, (uint8_t)elem->argc);
|
|
}
|
|
|
|
|
|
// The variable at the root of lv.
|
|
static const BasSymT *lvSymbol(const LvalueT *lv) {
|
|
const BasNodeT *root = (lv->elem != NULL) ? lv->elem->callee : lv->node;
|
|
|
|
while (root->kind == NK_FIELD) {
|
|
root = ((const BasMemberT *)root)->base;
|
|
}
|
|
|
|
return ((const BasNameT *)root)->sym;
|
|
}
|
|
|
|
|
|
// The declared type of what lv names.
|
|
static uint8_t lvType(const LvalueT *lv) {
|
|
if (lv->node->kind == NK_FIELD) {
|
|
return ((const BasFieldT *)((const BasMemberT *)lv->node)->target)->dataType;
|
|
}
|
|
|
|
return lvSymbol(lv)->dataType;
|
|
}
|
|
|
|
|
|
// True when n's value cannot change between evaluating a target's
|
|
// subscripts and storing into it (a literal, a variable when varsStable,
|
|
// operators on them): it is then evaluated at the store.
|
|
static bool stableExpr(const BasNodeT *n, bool varsStable) {
|
|
switch (n->kind) {
|
|
case NK_INT:
|
|
case NK_DBL:
|
|
case NK_STR:
|
|
case NK_BOOL:
|
|
return true;
|
|
|
|
case NK_VAR:
|
|
return varsStable;
|
|
|
|
case NK_UNARY:
|
|
case NK_BINARY:
|
|
return stableExpr(((const BasOpT *)n)->a, varsStable) && (((const BasOpT *)n)->b == NULL || stableExpr(((const BasOpT *)n)->b, varsStable));
|
|
|
|
default:
|
|
return false;
|
|
}
|
|
}
|