AI_Slop/DVX_GUI
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
DVX_GUI/src/apps/kpunch/dvxbasic/compiler/parseStmt.c
Scott Duensing e1e48c7619 All new BASIC compiler and VM.
2026-10-05 20:01:04 -05:00

3097 lines
84 KiB
C
Raw Blame History

// The MIT License (MIT)
//
// Copyright (C) 2026 Scott Duensing
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to
// deal in the Software without restriction, including without limitation the
// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
// sell copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
// IN THE SOFTWARE.
// parseStmt.c -- DVX BASIC parser: statements
//
// basParseStatement reads one statement (a block statement with its
// body). Statements that start with a name (assignments, calls, member
// statements) are read as a postfix chain plus either "= value" or the
// call's arguments; what the chain names is decided by the resolver.
#include "front.h"
#include <stdio.h>
#include <string.h>
// Words the parser reads by their text (identifiers, not reserved).
#define BAS_KW_ATTRIBUTE "ATTRIBUTE"
#define BAS_KW_EACH "EACH"
#define BAS_KW_IN "IN"
#define BAS_KW_RAISEEVENT "RAISEEVENT"
#define BAS_KW_RESET "RESET"
#define BAS_KW_USING "USING"
#define BAS_KW_SPC "SPC"
#define BAS_KW_TAB "TAB"
#define BAS_KW_LEN "LEN"
#define BAS_KW_OFF "OFF"
#define BAS_KW_STOP "STOP"
#define BAS_KW_B "B"
#define BAS_KW_BF "BF"
#define BAS_KW_MID "MID$"
#define BAS_KW_LSET "LSET"
#define BAS_KW_RSET "RSET"
// SLEEP with no argument waits this many seconds.
#define BAS_SLEEP_DEFAULT_SECS 1
// Arguments of BEEP, SOUND hz, ticks, PLAY macro$ and FRAMEWAIT hz.
#define BAS_BEEP_ARGS 0
#define BAS_SOUND_ARGS 2
#define BAS_PLAY_ARGS 1
#define BAS_FRAMEWAIT_ARGS 1
// CLS with no argument, and FULLSCREEN with none / ON / OFF.
#define BAS_CLS_OMITTED (-1)
#define BAS_FULLSCREEN_ON 1
#define BAS_FULLSCREEN_OFF 0
// Arguments LOCATE, COLOR, WIDTH and SCREEN take before their given mask
// (SCREEN: after the mode), and the extra ones QBasic accepts that DVX
// ignores (LOCATE's cursor start and stop lines, COLOR's border).
#define BAS_LOCATE_VALUES 3
#define BAS_PAIR_VALUES 2
#define BAS_SCREEN_VALUES 3
#define BAS_LOCATE_IGNORED 2
#define BAS_COLOR_IGNORED 1
// Arguments SETEVENT and INIWRITE take (REMOVECONTROL, FILECOPY, NAME,
// SETATTR and SEEK take BAS_PAIR_ARGS).
#define BAS_SETEVENT_ARGS 3
#define BAS_INIWRITE_ARGS 4
// Console and graphics statements: identifiers, not reserved words; a
// procedure of the same name, or the name followed by '=', '.' or
// "(...) =", is the program's own.
typedef struct {
const char *name;
uint8_t func; // BasBuiltinFnE
int32_t flags; // extra BAS_GFX_* flags (PRESET)
} ScreenStmtT;
static const ScreenStmtT sScreenStmts[] = {
{ "CIRCLE", BAS_FN_CIRCLE, 0 },
{ "CLS", BAS_FN_CLS, 0 },
{ "COLOR", BAS_FN_COLOR, 0 },
{ "DRAW", BAS_FN_DRAW, 0 },
{ "FULLSCREEN", BAS_FN_FULLSCREEN, 0 },
{ "LOCATE", BAS_FN_LOCATE, 0 },
{ "PAINT", BAS_FN_PAINT, 0 },
{ "PALETTE", BAS_FN_PALETTE, 0 },
{ "PCOPY", BAS_FN_PCOPY, 0 },
{ "PEN", BAS_FN_PEN_SET, 0 },
{ "PRESET", BAS_FN_PSET, BAS_GFX_PRESET },
{ "PSET", BAS_FN_PSET, 0 },
{ "SCREEN", BAS_FN_SCREEN, 0 },
{ "VIEW", BAS_FN_VIEW, 0 },
{ "WIDTH", BAS_FN_WIDTH, 0 },
{ "WINDOW", BAS_FN_WINDOW, 0 }
};
// Argument list being built (head / tail / count).
typedef struct {
BasNodeT *head;
BasNodeT *tail;
int32_t count;
} ArgListT;
// Function prototypes (alphabetical)
static void argAdd(ArgListT *l, BasNodeT *n);
static void argZero(BasCompilerT *c, ArgListT *l);
BasNodeT *basParseDeferredArgs(BasCompilerT *c, BasStmtT *call, BasDeferModeE mode, int32_t *outArgc);
BasNodeT *basParseLValue(BasCompilerT *c, bool allowFields);
BasNodeT *basParseStatement(BasCompilerT *c);
static bool classLevelStatement(BasCompilerT *c);
static bool drawingMethod(const char *name);
static const ScreenStmtT *findScreenStmt(BasCompilerT *c);
static char *labelRef(BasCompilerT *c);
static char *lineLabel(BasCompilerT *c, int32_t *outNumber);
static BasStmtT *newStmt(BasCompilerT *c, uint8_t kind);
static bool ownResultKeywordAhead(BasCompilerT *c);
static BasNodeT *parseBlockBody(BasCompilerT *c, BasTokenTypeE endKw, BasTokenTypeE stopTok, bool *outEnded);
static BasNodeT *parseBranch(BasCompilerT *c);
static BasNodeT *parseCallKw(BasCompilerT *c);
static BasNodeT *parseClose(BasCompilerT *c);
static BasNodeT *parseData(BasCompilerT *c);
static BasNodeT *parseDataItem(BasCompilerT *c, bool *outOk);
static BasNodeT *parseDo(BasCompilerT *c);
static BasNodeT *parseDrawingArgs(BasCompilerT *c, const char *method, int32_t *outArgc);
static BasNodeT *parseErrStatement(BasCompilerT *c);
static BasNodeT *parseExit(BasCompilerT *c);
static void parseFlaggedArgs(BasCompilerT *c, ArgListT *l, const int32_t *slots, int32_t count, int32_t *flags);
static BasNodeT *parseFor(BasCompilerT *c);
static BasNodeT *parseForEach(BasCompilerT *c, int32_t line, int32_t col);
static BasNodeT *parseGet(BasCompilerT *c, uint8_t kind);
static void parseGfxCircleArgs(BasCompilerT *c, ArgListT *l);
static void parseGfxLineArgs(BasCompilerT *c, ArgListT *l);
static void parseGfxPoint(BasCompilerT *c, ArgListT *l, int32_t *flags, int32_t stepFlag);
static void parseGfxPsetArgs(BasCompilerT *c, ArgListT *l, int32_t flags);
static int32_t parseGfxRect(BasCompilerT *c, ArgListT *l);
static BasNodeT *parseIdentStatement(BasCompilerT *c, bool isSet);
static BasNodeT *parseIf(BasCompilerT *c);
static void parseIgnoredArgs(BasCompilerT *c, ArgListT *l, int32_t max);
static BasNodeT *parseInput(BasCompilerT *c);
static BasNodeT *parseLabelName(BasCompilerT *c, uint8_t kind);
static BasNodeT *parseLine(BasCompilerT *c);
static BasNodeT *parseLineInput(BasCompilerT *c);
static BasNodeT *parseLset(BasCompilerT *c);
static BasNodeT *parseMemberCall(BasCompilerT *c, BasMemberT *m, bool isSet);
static BasNodeT *parseMeStatement(BasCompilerT *c, bool isSet);
static BasNodeT *parseMidAssign(BasCompilerT *c);
static BasNodeT *parseNumLit(BasCompilerT *c, bool isNeg);
static BasNodeT *parseObjectPrintItems(BasCompilerT *c, int32_t *outCount);
static BasNodeT *parseOn(BasCompilerT *c);
static BasNodeT *parseOpen(BasCompilerT *c);
static int32_t parseOptionalArgs(BasCompilerT *c, ArgListT *l, int32_t count);
static BasNodeT *parsePrint(BasCompilerT *c, bool isLprint);
static void parsePrintItems(BasCompilerT *c, BasPrintT *pr);
static BasNodeT *parseRaiseEvent(BasCompilerT *c);
static BasNodeT *parseRead(BasCompilerT *c);
static BasNodeT *parseScreenStatement(BasCompilerT *c, const ScreenStmtT *stmt);
static BasNodeT *parseSelectCase(BasCompilerT *c);
static BasNodeT *parseSimple(BasCompilerT *c, uint8_t opcode, int32_t argc, bool hashFirst);
static BasNodeT *parseSwap(BasCompilerT *c);
static BasNodeT *parseWhile(BasCompilerT *c);
static BasNodeT *parseWith(BasCompilerT *c);
static BasNodeT *parseWrite(BasCompilerT *c);
static void printItem(BasCompilerT *c, BasNodeT **head, BasNodeT **tail, uint8_t kind, BasNodeT *expr);
static bool procNamed(BasCompilerT *c, const char *name);
static bool resetAhead(BasCompilerT *c);
static BasNodeT *stmtExpr(BasCompilerT *c, BasNodeT *expr);
static void argAdd(ArgListT *l, BasNodeT *n) {
if (n == NULL) {
return;
}
if (l->tail != NULL) {
l->tail->next = n;
} else {
l->head = n;
}
l->tail = n;
l->count++;
}
// An argument the source left out that the statement passes as 0.
static void argZero(BasCompilerT *c, ArgListT *l) {
argAdd(l, basParseIntLit(c, 0));
}
// Reads the arguments of the drawing method statement call (obj.Line ...
// whose object is a plain name) now that the resolver knows how: as a
// class method's comma-separated arguments (BAS_DEFER_ARGS) or in the
// method's QBasic syntax. The source is lexed again from where the
// arguments start; the lexer is put back afterwards.
BasNodeT *basParseDeferredArgs(BasCompilerT *c, BasStmtT *call, BasDeferModeE mode, int32_t *outArgc) {
const BasLitT *at = (const BasLitT *)call->c;
BasLexerT saved = c->lex;
int32_t prevLine = c->prevLine;
BasNodeT *args;
c->prevLine = at->h.line;
basLexerSeek(&c->lex, at->ival, at->h.line, at->h.col);
if (mode == BAS_DEFER_ARGS) {
args = basParseBareArgs(c, outArgc);
} else {
args = parseDrawingArgs(c, ((BasMemberT *)call->a)->name, outArgc);
}
if (!c->hasError && !basParseAtEnd(c)) {
basParseErrorExpected(c, "end of statement");
}
if (!c->hasError) {
c->lex = saved;
c->prevLine = prevLine;
}
return args;
}
// A store target: name, optional subscripts and (allowFields) a .field
// chain. The resolver checks what it names.
BasNodeT *basParseLValue(BasCompilerT *c, bool allowFields) {
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "variable name");
return NULL;
}
BasNameT *n = (BasNameT *)basParseNode(c, (int32_t)sizeof(BasNameT), NK_NAME);
if (n == NULL) {
return NULL;
}
n->name = basParseTokenName(c);
basParseAdvance(c);
BasNodeT *node = &n->h;
if (basParseCheck(c, TOK_LPAREN)) {
BasCallT *call = (BasCallT *)basParseNode(c, (int32_t)sizeof(BasCallT), NK_CALL);
if (call == NULL) {
return NULL;
}
int32_t argc = 0;
call->callee = node;
call->h.line = node->line;
call->h.col = node->col;
call->args = basParseArgList(c, &argc);
call->argc = (int16_t)argc;
node = &call->h;
}
int32_t depth = 0;
while (allowFields && !c->hasError && basParseCheck(c, TOK_DOT)) {
if (++depth > BAS_MAX_FIELD_CHAIN) {
basParseError(c, "TYPE field chain too deep");
return NULL;
}
basParseAdvance(c);
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "field name");
return NULL;
}
BasMemberT *m = (BasMemberT *)basParseNode(c, (int32_t)sizeof(BasMemberT), NK_MEMBER);
if (m == NULL) {
return NULL;
}
node->flags |= NF_MEMBERBASE;
m->base = node;
m->name = basParseTokenName(c);
basParseAdvance(c);
node = &m->h;
}
return node;
}
BasNodeT *basParseStatement(BasCompilerT *c) {
if (c->hasError) {
return NULL;
}
basParseSkipNewlines(c);
if (basParseCheck(c, TOK_EOF)) {
return NULL;
}
// Every nested block recurses through here; bound the depth so a
// pathological input is an error, not a stack overflow.
if (c->blockDepth >= BAS_MAX_BLOCK_DEPTH) {
basParseError(c, "Statements nested too deeply");
return NULL;
}
// A class module holds declarations and procedures only.
if (c->parseInClass && !c->parseInProc && !classLevelStatement(c)) {
basParseError(c, "Only declarations are allowed outside procedures in a class module");
return NULL;
}
c->blockDepth++;
int32_t line = c->lex.token.line;
int32_t col = c->lex.token.col;
bool endOfStatement = true;
BasNodeT *n = NULL;
BasTokenTypeE tt = ownResultKeywordAhead(c) ? TOK_IDENT : c->lex.token.type;
switch (tt) {
case TOK_PRINT:
n = parsePrint(c, false);
break;
case TOK_LPRINT:
n = parsePrint(c, true);
break;
case TOK_DATA:
n = parseData(c);
break;
case TOK_READ:
n = parseRead(c);
break;
case TOK_RESTORE: {
// RESTORE [label]: the DATA from that label on
basParseAdvance(c);
BasStmtT *s = newStmt(c, ST_RESTORE);
if (s != NULL && !basParseAtEnd(c)) {
s->name = labelRef(c);
}
n = &s->h;
break;
}
case TOK_DIM:
case TOK_STATIC:
case TOK_SHARED:
case TOK_DEF:
case TOK_DEFINT:
case TOK_DEFLNG:
case TOK_DEFSNG:
case TOK_DEFDBL:
case TOK_DEFSTR:
case TOK_DEFBYTE:
case TOK_DEFCUR:
case TOK_DECLARE:
case TOK_SUB:
case TOK_FUNCTION:
case TOK_PROPERTY:
case TOK_PUBLIC:
case TOK_PRIVATE:
case TOK_CONST:
case TOK_TYPE:
case TOK_ENUM:
case TOK_REDIM:
case TOK_ERASE:
case TOK_OPTION:
n = basParseDeclStatement(c);
break;
case TOK_IF:
n = parseIf(c);
break;
case TOK_FOR:
n = parseFor(c);
break;
case TOK_DO:
n = parseDo(c);
break;
case TOK_WHILE:
n = parseWhile(c);
break;
case TOK_SELECT:
n = parseSelectCase(c);
break;
case TOK_EXIT:
n = parseExit(c);
break;
case TOK_END:
basParseAdvance(c);
n = (BasNodeT *)newStmt(c, ST_END);
break;
case TOK_ERR:
n = parseErrStatement(c);
break;
case TOK_ERROR_KW:
// ERROR n: raise a runtime error
n = parseSimple(c, OP_RAISE_ERR, 1, false);
break;
case TOK_FILECOPY:
n = parseSimple(c, OP_FS_FILECOPY, BAS_PAIR_ARGS, false);
break;
case TOK_INPUT:
n = parseInput(c);
break;
case TOK_KILL:
n = parseSimple(c, OP_FS_KILL, 1, false);
break;
case TOK_MKDIR:
n = parseSimple(c, OP_FS_MKDIR, 1, false);
break;
case TOK_NAME: {
// NAME old AS new
ArgListT args;
memset(&args, 0, sizeof(args));
basParseAdvance(c);
argAdd(&args, basParseExpr(c));
basParseExpect(c, TOK_AS);
argAdd(&args, basParseExpr(c));
BasStmtT *s = newStmt(c, ST_SIMPLE);
if (s != NULL) {
s->ival = OP_FS_NAME;
s->b = args.head;
s->ival2 = args.count;
}
n = &s->h;
break;
}
case TOK_OPEN:
n = parseOpen(c);
break;
case TOK_CHDIR:
n = parseSimple(c, OP_FS_CHDIR, 1, false);
break;
case TOK_CHDRIVE:
n = parseSimple(c, OP_FS_CHDRIVE, 1, false);
break;
case TOK_CLOSE:
n = parseClose(c);
break;
case TOK_GET:
n = parseGet(c, ST_GET);
break;
case TOK_PUT:
n = parseGet(c, ST_PUT);
break;
case TOK_SEEK:
n = parseSimple(c, OP_FILE_SEEK, BAS_PAIR_ARGS, true);
break;
case TOK_WRITE:
n = parseWrite(c);
break;
case TOK_LINE:
n = parseLine(c);
break;
case TOK_GOTO:
n = parseLabelName(c, ST_GOTO);
break;
case TOK_GOSUB:
n = parseLabelName(c, ST_GOSUB);
break;
case TOK_ON:
n = parseOn(c);
break;
case TOK_SHELL: {
// SHELL [command]: the result is dropped
ArgListT args;
memset(&args, 0, sizeof(args));
basParseAdvance(c);
argAdd(&args, basParseAtEnd(c) ? basParseStrLit(c, "", 0) : basParseExpr(c));
n = stmtExpr(c, basParseIntrinsic(c, OP_SHELL, args.head, args.count, BAS_NO_OPERAND));
break;
}
case TOK_RESUME: {
basParseAdvance(c);
BasStmtT *s = newStmt(c, ST_RESUME);
// RESUME, RESUME 0 (QBasic: the same), RESUME NEXT, RESUME label
if (s != NULL) {
s->ival = basParseMatch(c, TOK_NEXT) ? 1 : 0;
if (s->ival == 0 && basParseCheck(c, TOK_INT_LIT) && c->lex.token.intVal == 0) {
basParseAdvance(c);
} else if (s->ival == 0 && !basParseAtEnd(c)) {
s->name = labelRef(c);
}
}
n = &s->h;
break;
}
case TOK_RMDIR:
n = parseSimple(c, OP_FS_RMDIR, 1, false);
break;
case TOK_SETATTR:
n = parseSimple(c, OP_FS_SETATTR, BAS_PAIR_ARGS, false);
break;
case TOK_RETURN:
basParseAdvance(c);
n = (BasNodeT *)newStmt(c, ST_RETURN);
break;
case TOK_SLEEP: {
// SLEEP [seconds]
ArgListT args;
memset(&args, 0, sizeof(args));
basParseAdvance(c);
argAdd(&args, basParseAtEnd(c) ? basParseIntLit(c, BAS_SLEEP_DEFAULT_SECS) : basParseExpr(c));
BasStmtT *s = newStmt(c, ST_SIMPLE);
if (s != NULL) {
s->ival = OP_SLEEP;
s->b = args.head;
s->ival2 = args.count;
}
n = &s->h;
break;
}
case TOK_BEEP:
n = parseSimple(c, OP_BEEP, BAS_BEEP_ARGS, false);
break;
case TOK_SOUND:
n = parseSimple(c, OP_SOUND, BAS_SOUND_ARGS, false);
break;
case TOK_PLAY:
n = parseSimple(c, OP_PLAY, BAS_PLAY_ARGS, false);
break;
case TOK_FRAMEWAIT:
n = parseSimple(c, OP_FRAME_WAIT, BAS_FRAMEWAIT_ARGS, false);
break;
case TOK_SWAP:
n = parseSwap(c);
break;
case TOK_CALL:
n = parseCallKw(c);
break;
case TOK_RANDOMIZE: {
// RANDOMIZE TIMER | seed
ArgListT args;
memset(&args, 0, sizeof(args));
basParseAdvance(c);
if (basParseMatch(c, TOK_TIMER)) {
argAdd(&args, basParseIntLit(c, BAS_RANDOMIZE_TIMER_SEED));
} else {
argAdd(&args, basParseExpr(c));
}
BasStmtT *s = newStmt(c, ST_SIMPLE);
if (s != NULL) {
s->ival = OP_MATH_RANDOMIZE;
s->b = args.head;
s->ival2 = args.count;
}
n = &s->h;
break;
}
case TOK_DOEVENTS:
n = parseSimple(c, OP_DO_EVENTS, 0, false);
break;
case TOK_CREATEFORM:
case TOK_CREATECONTROL:
// used as a statement: the new object is dropped
n = stmtExpr(c, basParseExpr(c));
break;
case TOK_SETEVENT:
n = parseSimple(c, OP_SET_EVENT, BAS_SETEVENT_ARGS, false);
break;
case TOK_REMOVECONTROL:
n = parseSimple(c, OP_REMOVE_CTRL, BAS_PAIR_ARGS, false);
break;
case TOK_SET:
// SET target = object
basParseAdvance(c);
if (basParseCheck(c, TOK_ME) || (basParseCheck(c, TOK_DOT) && c->parseWith != NULL)) {
n = parseMeStatement(c, true);
} else if (basParseCheck(c, TOK_IDENT) || ownResultKeywordAhead(c)) {
n = parseIdentStatement(c, true);
} else {
basParseErrorExpected(c, "variable name");
}
break;
case TOK_LOAD: {
// Load FormName (an identifier, not a string)
basParseAdvance(c);
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "form name");
break;
}
BasStmtT *s = newStmt(c, ST_LOAD);
if (s != NULL) {
s->name = basParseTokenName(c);
}
basParseAdvance(c);
n = &s->h;
break;
}
case TOK_UNLOAD: {
// Unload Me / Unload FormName
basParseAdvance(c);
BasStmtT *s = newStmt(c, ST_UNLOAD);
if (s == NULL) {
break;
}
if (!basParseMatch(c, TOK_ME)) {
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "form name");
break;
}
s->name = basParseTokenName(c);
basParseAdvance(c);
}
n = &s->h;
break;
}
case TOK_INPUTBOX: {
// InputBox$ prompt [, title [, default]] as a statement
int32_t argc = 0;
basParseAdvance(c);
BasNodeT *args = basParseInputBoxArgs(c, &argc);
n = stmtExpr(c, basParseIntrinsic(c, OP_INPUTBOX, args, argc, BAS_NO_OPERAND));
break;
}
case TOK_MSGBOX: {
// MsgBox message [, flags [, title]] as a statement
int32_t argc = 0;
basParseAdvance(c);
BasNodeT *args = basParseMsgBoxArgs(c, &argc);
n = stmtExpr(c, basParseIntrinsic(c, OP_MSGBOX, args, argc, BAS_NO_OPERAND));
break;
}
case TOK_INIWRITE:
n = parseSimple(c, OP_INI_WRITE, BAS_INIWRITE_ARGS, false);
break;
case TOK_ME:
n = parseMeStatement(c, false);
break;
case TOK_WITH:
n = parseWith(c);
break;
case TOK_DOT:
// .member ... inside WITH
if (c->parseWith == NULL) {
basParseError(c, "Invalid or unqualified reference: '.' outside WITH");
break;
}
n = parseMeStatement(c, false);
break;
case TOK_LET:
basParseAdvance(c);
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "variable name after LET");
break;
}
n = parseIdentStatement(c, false);
break;
case TOK_INT_LIT:
case TOK_LONG_LIT: {
// A QBasic line number: a label named by its number, which ERL
// reports; the rest of the line is its statement
BasStmtT *s = newStmt(c, ST_LABEL);
if (s != NULL) {
s->name = lineLabel(c, &s->ival2);
s->ival = BAS_LABEL_LINE_NUMBER;
}
endOfStatement = false;
n = &s->h;
break;
}
case TOK_IDENT: {
// The project builder's form and class markers, a class
// module's Attribute / Event / Implements lines, RaiseEvent
if (basParseCheckWord(c, BAS_WRAP_BEGINFORM) || basParseCheckWord(c, BAS_WRAP_BEGINCLASS) || basParseCheckWord(c, BAS_WRAP_BEGINMODULE)) {
bool isClass = basParseCheckWord(c, BAS_WRAP_BEGINCLASS);
bool isModule = basParseCheckWord(c, BAS_WRAP_BEGINMODULE);
basParseAdvance(c);
if (!basParseCheck(c, TOK_STRING_LIT)) {
basParseErrorExpected(c, isClass ? "class name string" : (isModule ? "module name string" : "form name string"));
break;
}
BasStmtT *s = newStmt(c, isClass ? ST_BEGINCLASS : (isModule ? ST_BEGINMODULE : ST_BEGINFORM));
if (s != NULL) {
s->name = basParseTokenName(c);
}
basParseAdvance(c);
// A form's controls follow its name
BasNodeT *tail = NULL;
while (s != NULL && !isClass && !isModule && basParseCheck(c, TOK_STRING_LIT)) {
BasNodeT *ctrl = basParseStrLit(c, c->lex.token.text, c->lex.token.textLen);
if (tail != NULL) {
tail->next = ctrl;
} else {
s->a = ctrl;
}
tail = ctrl;
basParseAdvance(c);
}
if (isClass) {
c->parseInClass = true;
c->parseClassName = (s != NULL) ? basArenaStrDup(&c->modArena, s->name, (int32_t)strlen(s->name)) : NULL;
}
n = &s->h;
break;
}
if (basParseCheckWord(c, BAS_WRAP_ENDFORM) || basParseCheckWord(c, BAS_WRAP_ENDCLASS) || basParseCheckWord(c, BAS_WRAP_ENDMODULE)) {
bool isClass = basParseCheckWord(c, BAS_WRAP_ENDCLASS);
bool isModule = basParseCheckWord(c, BAS_WRAP_ENDMODULE);
basParseAdvance(c);
n = (BasNodeT *)newStmt(c, isClass ? ST_ENDCLASS : (isModule ? ST_ENDMODULE : ST_ENDFORM));
if (isClass && !c->parseInProc) {
c->parseInClass = false;
}
break;
}
if (c->parseInClass && basParseCheckWord(c, BAS_KW_ATTRIBUTE)) {
n = basParseAttribute(c);
break;
}
if (basParseFriendAhead(c)) {
n = basParseFriendProc(c);
break;
}
if (c->parseInClass && !c->parseInProc && basParseCheckWord(c, BAS_KW_EVENT)) {
n = basParseEvent(c);
break;
}
if (c->parseInClass && !c->parseInProc && basParseCheckWord(c, BAS_KW_IMPLEMENTS)) {
basParseAdvance(c);
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "the name of a class module after Implements");
break;
}
BasStmtT *s = newStmt(c, ST_IMPLEMENTS);
if (s != NULL) {
s->name = basParseTokenName(c);
}
basParseAdvance(c);
n = &s->h;
break;
}
if (basParseCheckWord(c, BAS_KW_RAISEEVENT) && basParseNameFollows(c, true)) {
n = parseRaiseEvent(c);
break;
}
// RESET: CLOSE every channel (QBasic), unless the program has a
// procedure of that name
if (basParseCheckWord(c, BAS_KW_RESET) && !procNamed(c, BAS_KW_RESET) && resetAhead(c)) {
basParseAdvance(c);
BasStmtT *s = newStmt(c, ST_SCREEN);
if (s != NULL) {
s->ival = BAS_FN_CLOSE;
}
n = &s->h;
break;
}
// CLS, LOCATE, PSET ... (before the label test: CLS: PRINT)
const ScreenStmtT *screenStmt = findScreenStmt(c);
if (screenStmt != NULL) {
n = parseScreenStatement(c, screenStmt);
break;
}
// A label: an identifier followed by a colon
BasLexerT peek = c->lex;
basLexerNext(&peek);
if (peek.token.type == TOK_COLON) {
BasStmtT *s = newStmt(c, ST_LABEL);
if (s != NULL) {
s->name = basParseTokenName(c);
}
basParseAdvance(c);
basParseAdvance(c);
endOfStatement = false;
n = &s->h;
break;
}
n = parseIdentStatement(c, false);
break;
}
default:
basParseError(c, "Unexpected token: %s", basTokenName(tt));
break;
}
c->blockDepth--;
if (n != NULL) {
n->line = line;
n->col = (uint16_t)col;
}
if (endOfStatement && !c->hasError) {
basParseExpectEnd(c);
}
return n;
}
// True for a statement a class module may hold outside its procedures:
// declarations, procedures (Friend ones too), OPTION, DEFxxx, ENDCLASS and
// Attribute, Event and Implements lines.
static bool classLevelStatement(BasCompilerT *c) {
switch (c->lex.token.type) {
case TOK_DIM: case TOK_PUBLIC: case TOK_PRIVATE:
case TOK_CONST: case TOK_SUB: case TOK_FUNCTION:
case TOK_PROPERTY: case TOK_TYPE: case TOK_ENUM:
case TOK_DECLARE: case TOK_OPTION: case TOK_DEFINT:
case TOK_DEFLNG: case TOK_DEFSNG: case TOK_DEFDBL:
case TOK_DEFSTR: case TOK_DEFBYTE: case TOK_DEFCUR:
case TOK_REM:
return true;
case TOK_IDENT:
return basParseCheckWord(c, BAS_WRAP_ENDCLASS) || basParseCheckWord(c, BAS_KW_ATTRIBUTE) || basParseCheckWord(c, BAS_KW_EVENT) || basParseCheckWord(c, BAS_KW_IMPLEMENTS) || basParseFriendAhead(c);
default:
return false;
}
}
// True for a Form / PictureBox method read with QBasic statement syntax.
static bool drawingMethod(const char *name) {
return strcasecmp(name, BAS_METHOD_PRINT) == 0 || strcasecmp(name, BAS_METHOD_LINE) == 0 || strcasecmp(name, BAS_METHOD_CIRCLE) == 0 || strcasecmp(name, BAS_METHOD_PSET) == 0 || strcasecmp(name, BAS_METHOD_SCALE) == 0;
}
// The console / graphics statement at the current identifier, or NULL
// when it is none or the program gives the name its own meaning: a SUB /
// FUNCTION / DECLARE of that name, or the name followed by '=', '.' or
// "(...) =".
static const ScreenStmtT *findScreenStmt(BasCompilerT *c) {
const char *name = c->lex.token.text;
for (int32_t i = 0; i < DVX_ARRAY_LEN(sScreenStmts); i++) {
if (strcasecmp(name, sScreenStmts[i].name) != 0) {
continue;
}
BasLexerT peek = c->lex;
basLexerNext(&peek);
if (peek.token.type == TOK_EQ || peek.token.type == TOK_DOT || procNamed(c, name)) {
return NULL;
}
if (peek.token.type == TOK_LPAREN && basParseAfterParens(&peek) == TOK_EQ) {
return NULL;
}
return &sScreenStmts[i];
}
return NULL;
}
// A label a statement jumps to (GOTO, GOSUB, RESTORE, RESUME, ON ... GOTO):
// a name, or a QBasic line number (named by its number). NULL after the
// error.
static char *labelRef(BasCompilerT *c) {
int32_t number = 0;
if (basParseCheck(c, TOK_INT_LIT) || basParseCheck(c, TOK_LONG_LIT)) {
return lineLabel(c, &number);
}
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "label name or line number");
return NULL;
}
char *name = basParseTokenName(c);
basParseAdvance(c);
return name;
}
// The line number at the current (integer literal) token: its label name
// (the number in decimal, so 010 and 10 are one line), *outNumber its
// value; the token is consumed. NULL after the error (QBasic's line
// numbers are 0 .. 65529).
static char *lineLabel(BasCompilerT *c, int32_t *outNumber) {
int64_t value = basParseCheck(c, TOK_INT_LIT) ? c->lex.token.intVal : c->lex.token.longVal;
char text[BAS_MAX_IDENT];
if (value < 0 || value > BAS_LINE_NUMBER_MAX) {
basParseError(c, "Line number out of range (0 to %d)", (int)BAS_LINE_NUMBER_MAX);
return NULL;
}
snprintf(text, sizeof(text), "%d", (int)value);
*outNumber = (int32_t)value;
basParseAdvance(c);
char *name = basArenaStrDup(&c->unitArena, text, (int32_t)strlen(text));
if (name == NULL) {
basParseError(c, "Out of memory");
}
return name;
}
// A statement node at the current token (the dispatcher sets its
// position to the statement's start).
static BasStmtT *newStmt(BasCompilerT *c, uint8_t kind) {
return (BasStmtT *)basParseNode(c, (int32_t)sizeof(BasStmtT), kind);
}
// True at "Name =" where Name is a keyword naming the FUNCTION / Property
// Get being parsed (a class member may be called Name, Open ...): its
// result is set by its name.
static bool ownResultKeywordAhead(BasCompilerT *c) {
if (!c->parseInProc || !c->parseProcIsFunction || basParseCheck(c, TOK_IDENT) || !basTokenIsWord(&c->lex.token) || c->parseProcName == NULL || strcasecmp(c->lex.token.text, c->parseProcName) != 0) {
return false;
}
BasLexerT peek = c->lex;
basLexerNext(&peek);
return peek.token.type == TOK_EQ;
}
// Statements up to "END endKw" (consumed, *outEnded set) or a stopTok
// token (left; TOK_EOF when none; TOK_ELSEIF stops at ELSE too) or the
// end of the source.
static BasNodeT *parseBlockBody(BasCompilerT *c, BasTokenTypeE endKw, BasTokenTypeE stopTok, bool *outEnded) {
BasNodeT *head = NULL;
BasNodeT *tail = NULL;
*outEnded = false;
basParseSkipNewlines(c);
while (!c->hasError && !basParseCheck(c, TOK_EOF) && !basParseCheck(c, stopTok) && !(stopTok == TOK_ELSEIF && basParseCheck(c, TOK_ELSE))) {
if (endKw != TOK_EOF && basParseMatchEnd(c, endKw)) {
*outEnded = true;
break;
}
BasNodeT *s = basParseStatement(c);
if (s != NULL) {
if (tail != NULL) {
tail->next = s;
} else {
head = s;
}
tail = s;
}
basParseSkipNewlines(c);
}
return head;
}
// A single-line IF's branch: the colon-separated statements up to ELSE
// or the end of the line, or a line number (THEN 100 / ELSE 200: a GOTO
// to it, QBasic).
static BasNodeT *parseBranch(BasCompilerT *c) {
if (basParseCheck(c, TOK_INT_LIT) || basParseCheck(c, TOK_LONG_LIT)) {
BasStmtT *s = newStmt(c, ST_GOTO);
if (s != NULL) {
s->name = labelRef(c);
}
return (BasNodeT *)s;
}
BasNodeT *head = NULL;
BasNodeT *tail = NULL;
while (!c->hasError && !basParseCheck(c, TOK_ELSE) && !basParseCheck(c, TOK_NEWLINE) && !basParseCheck(c, TOK_EOF)) {
BasNodeT *s = basParseStatement(c);
if (s != NULL) {
if (tail != NULL) {
tail->next = s;
} else {
head = s;
}
tail = s;
}
}
return head;
}
// CALL name [(args)]
static BasNodeT *parseCallKw(BasCompilerT *c) {
basParseAdvance(c);
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "subroutine name");
return NULL;
}
BasNameT *name = (BasNameT *)basParseNode(c, (int32_t)sizeof(BasNameT), NK_NAME);
BasStmtT *s = newStmt(c, ST_CALL);
if (name == NULL || s == NULL) {
return NULL;
}
name->name = basParseTokenName(c);
basParseAdvance(c);
s->a = &name->h;
s->ival = BAS_ARGS_CALLKW;
s->name = basTokenName(c->lex.token.type);
if (basParseCheck(c, TOK_LPAREN)) {
int32_t argc = 0;
s->b = basParseArgList(c, &argc);
s->ival2 = argc;
}
return (BasNodeT *)s;
}
// CLOSE [[#]n [, [#]n ...]]: one channel is OP_FILE_CLOSE; none (every
// channel) or several go to BAS_FN_CLOSE.
static BasNodeT *parseClose(BasCompilerT *c) {
ArgListT args;
memset(&args, 0, sizeof(args));
basParseAdvance(c);
bool more = !basParseAtEnd(c);
while (more && !c->hasError) {
basParseMatch(c, TOK_HASH);
argAdd(&args, basParseExpr(c));
more = basParseMatch(c, TOK_COMMA);
}
BasStmtT *s = newStmt(c, (args.count == 1) ? ST_SIMPLE : ST_SCREEN);
if (s != NULL) {
s->ival = (args.count == 1) ? OP_FILE_CLOSE : BAS_FN_CLOSE;
s->b = args.head;
s->ival2 = args.count;
}
return (BasNodeT *)s;
}
// DATA item, item ...: the values go to the data pool (no code).
static BasNodeT *parseData(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_DATA);
BasNodeT *tail = NULL;
bool ok = true;
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
do {
BasNodeT *item = parseDataItem(c, &ok);
if (!ok) {
break;
}
if (tail != NULL) {
tail->next = item;
} else {
s->a = item;
}
tail = item;
} while (basParseMatch(c, TOK_COMMA));
return (BasNodeT *)s;
}
// One DATA item: a quoted string, or a (signed) numeric literal standing
// alone, is stored typed; anything else is the raw text up to the next
// comma, colon, comment or end of line (QB): keywords, several words and
// mixed text all read back as strings.
static BasNodeT *parseDataItem(BasCompilerT *c, bool *outOk) {
BasTokenT itemTok = c->lex.token;
*outOk = true;
if (basParseCheck(c, TOK_STRING_LIT)) {
BasNodeT *n = basParseStrLit(c, c->lex.token.text, c->lex.token.textLen);
basParseAdvance(c);
return n;
}
// A lone numeric literal: the token after it ends the item
bool isNeg = basParseCheck(c, TOK_MINUS);
if (isNeg) {
c->lex.allowNegMagnitude = true;
basParseAdvance(c);
c->lex.allowNegMagnitude = false;
}
if (!c->hasError && (basParseCheck(c, TOK_INT_LIT) || basParseCheck(c, TOK_LONG_LIT) || basParseCheck(c, TOK_FLOAT_LIT) || basParseCheck(c, TOK_CUR_LIT))) {
BasLexerT after = c->lex;
basLexerNext(&after);
BasTokenTypeE next = after.token.type;
if (next == TOK_COMMA || next == TOK_NEWLINE || next == TOK_COLON || next == TOK_EOF) {
BasNodeT *n = parseNumLit(c, isNeg);
basParseAdvance(c);
return n;
}
}
if (c->hasError) {
*outOk = false;
return NULL;
}
// Raw text from the start of the item
const char *src = c->source;
int32_t start = itemTok.pos;
int32_t end = start;
while (end < c->sourceLen && src[end] != ',' && src[end] != ':' && src[end] != '\'' && src[end] != '\n' && src[end] != '\r') {
end++;
}
int32_t textEnd = end;
while (textEnd > start && (src[textEnd - 1] == ' ' || src[textEnd - 1] == '\t')) {
textEnd--;
}
if (textEnd == start || itemTok.type == TOK_NEWLINE || itemTok.type == TOK_EOF) {
basParseError(c, "Expected DATA value");
*outOk = false;
return NULL;
}
BasNodeT *n = basParseStrLit(c, src + start, textEnd - start);
// Lexing resumes at the delimiter
c->prevLine = itemTok.line;
basLexerSeek(&c->lex, end, itemTok.line, itemTok.col + (end - start));
if (c->lex.token.type == TOK_ERROR) {
basErrorAt(c, c->lex.errLine, c->lex.errCol, "%s", c->lex.error);
}
return n;
}
// DO [WHILE | UNTIL cond] ... LOOP [WHILE | UNTIL cond]
static BasNodeT *parseDo(BasCompilerT *c) {
BasLoopT *loop = (BasLoopT *)basParseNode(c, (int32_t)sizeof(BasLoopT), ST_DO);
basParseAdvance(c);
if (loop == NULL) {
return NULL;
}
if (basParseCheck(c, TOK_WHILE) || basParseCheck(c, TOK_UNTIL)) {
loop->preUntil = basParseCheck(c, TOK_UNTIL);
basParseAdvance(c);
loop->preCond = basParseExpr(c);
}
basParseExpectEnd(c);
bool ended = false;
loop->body = parseBlockBody(c, TOK_EOF, TOK_LOOP, &ended);
if (c->hasError) {
return (BasNodeT *)loop;
}
basParseExpect(c, TOK_LOOP);
if (basParseCheck(c, TOK_WHILE) || basParseCheck(c, TOK_UNTIL)) {
loop->postUntil = basParseCheck(c, TOK_UNTIL);
basParseAdvance(c);
loop->postCond = basParseExpr(c);
}
return (BasNodeT *)loop;
}
// A drawing method's arguments in its QBasic statement syntax: Print's
// items (a BasPrintItemT list), the Line / Circle / PSet blocks, Scale's
// optional (x1, y1)-(x2, y2).
static BasNodeT *parseDrawingArgs(BasCompilerT *c, const char *method, int32_t *outArgc) {
ArgListT args;
memset(&args, 0, sizeof(args));
if (strcasecmp(method, BAS_METHOD_PRINT) == 0) {
return parseObjectPrintItems(c, outArgc);
}
if (strcasecmp(method, BAS_METHOD_LINE) == 0) {
parseGfxLineArgs(c, &args);
} else if (strcasecmp(method, BAS_METHOD_CIRCLE) == 0) {
parseGfxCircleArgs(c, &args);
} else if (strcasecmp(method, BAS_METHOD_PSET) == 0) {
parseGfxPsetArgs(c, &args, 0);
} else {
int32_t flags = parseGfxRect(c, &args);
argAdd(&args, basParseIntLit(c, flags));
}
*outArgc = args.count;
return args.head;
}
// Err.Raise number [, source [, description]], Err.Clear and
// Err.Number = n: the Err object's statements.
static BasNodeT *parseErrStatement(BasCompilerT *c) {
ArgListT args;
memset(&args, 0, sizeof(args));
basParseAdvance(c);
basParseExpect(c, TOK_DOT);
const char *member = basParseTokenName(c);
uint8_t fn = BAS_FN_ERR_SET;
basParseAdvance(c);
if (member != NULL && strcasecmp(member, BAS_ERR_MEMBER_RAISE) == 0) {
fn = BAS_FN_ERR_RAISE;
do {
argAdd(&args, basParseExpr(c));
} while (!c->hasError && basParseMatch(c, TOK_COMMA));
} else if (member != NULL && strcasecmp(member, BAS_ERR_MEMBER_NUMBER) == 0) {
basParseExpect(c, TOK_EQ);
argAdd(&args, basParseExpr(c));
} else if (member == NULL || strcasecmp(member, BAS_ERR_MEMBER_CLEAR) != 0) {
basParseError(c, "Err has no statement '%s' (Raise, Clear, or Number = value)", member != NULL ? member : "");
return NULL;
}
BasStmtT *s = newStmt(c, ST_SCREEN);
if (s != NULL) {
s->ival = fn;
s->b = args.head;
s->ival2 = args.count;
}
return (BasNodeT *)s;
}
// EXIT FOR / DO / SUB / FUNCTION / PROPERTY (the resolver checks it is
// inside one).
static BasNodeT *parseExit(BasCompilerT *c) {
basParseAdvance(c);
BasTokenTypeE what = c->lex.token.type;
if (what != TOK_FOR && what != TOK_DO && what != TOK_PROPERTY && what != TOK_SUB && what != TOK_FUNCTION) {
basParseError(c, "Expected FOR, DO, SUB, FUNCTION or PROPERTY after EXIT");
return NULL;
}
BasStmtT *s = newStmt(c, ST_EXIT);
if (s != NULL) {
s->ival = what;
}
basParseAdvance(c);
return (BasNodeT *)s;
}
// Optional arguments, each after a comma and each allowed to be empty: a
// written one adds its slots[i] flag, a missing one is 0.
static void parseFlaggedArgs(BasCompilerT *c, ArgListT *l, const int32_t *slots, int32_t count, int32_t *flags) {
bool more = true;
for (int32_t i = 0; i < count; i++) {
more = more && basParseMatch(c, TOK_COMMA);
if (more && !basParseCheck(c, TOK_COMMA) && !basParseAtEnd(c)) {
argAdd(l, basParseExpr(c));
*flags |= slots[i];
} else {
argZero(c, l);
}
}
}
// FOR var = start TO limit [STEP step] ... NEXT [var], or FOR EACH.
static BasNodeT *parseFor(BasCompilerT *c) {
int32_t line = c->lex.token.line;
int32_t col = c->lex.token.col;
basParseAdvance(c);
// FOR EACH item IN group (a variable named Each is still a counter)
if (basParseCheckWord(c, BAS_KW_EACH)) {
BasLexerT peek = c->lex;
basLexerNext(&peek);
if (peek.token.type == TOK_IDENT) {
return parseForEach(c, line, col);
}
}
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "loop variable");
return NULL;
}
BasLoopT *loop = (BasLoopT *)basParseNode(c, (int32_t)sizeof(BasLoopT), ST_FOR);
BasNameT *var = (BasNameT *)basParseNode(c, (int32_t)sizeof(BasNameT), NK_NAME);
if (loop == NULL || var == NULL) {
return NULL;
}
var->name = basParseTokenName(c);
loop->var = &var->h;
basParseAdvance(c);
basParseExpect(c, TOK_EQ);
loop->from = basParseExpr(c);
basParseExpect(c, TOK_TO);
loop->to = basParseExpr(c);
if (basParseMatch(c, TOK_STEP)) {
loop->step = basParseExpr(c);
}
basParseExpectEnd(c);
bool ended = false;
loop->body = parseBlockBody(c, TOK_EOF, TOK_NEXT, &ended);
if (c->hasError) {
return (BasNodeT *)loop;
}
basParseExpect(c, TOK_NEXT);
if (basParseCheck(c, TOK_IDENT)) {
loop->nextName = basParseTokenName(c);
loop->nextLine = c->lex.token.line;
loop->nextCol = c->lex.token.col;
basParseAdvance(c);
}
return (BasNodeT *)loop;
}
// FOR EACH item IN group ... NEXT [item] (FOR read, EACH current).
static BasNodeT *parseForEach(BasCompilerT *c, int32_t line, int32_t col) {
basParseAdvance(c);
BasLoopT *loop = (BasLoopT *)basParseNode(c, (int32_t)sizeof(BasLoopT), ST_FOREACH);
BasNameT *var = (BasNameT *)basParseNode(c, (int32_t)sizeof(BasNameT), NK_NAME);
if (loop == NULL || var == NULL) {
return NULL;
}
loop->h.line = line;
loop->h.col = (uint16_t)col;
var->name = basParseTokenName(c);
loop->var = &var->h;
basParseAdvance(c);
if (!basParseCheckWord(c, BAS_KW_IN)) {
basParseErrorExpected(c, "IN");
return NULL;
}
basParseAdvance(c);
loop->from = basParseExpr(c);
basParseExpectEnd(c);
bool ended = false;
loop->body = parseBlockBody(c, TOK_EOF, TOK_NEXT, &ended);
if (c->hasError) {
return (BasNodeT *)loop;
}
basParseExpect(c, TOK_NEXT);
if (basParseCheck(c, TOK_IDENT)) {
loop->nextName = basParseTokenName(c);
loop->nextLine = c->lex.token.line;
loop->nextCol = c->lex.token.col;
basParseAdvance(c);
}
return (BasNodeT *)loop;
}
// GET [#]channel, [recno], target / PUT [#]channel, [recno], value
static BasNodeT *parseGet(BasCompilerT *c, uint8_t kind) {
BasStmtT *s = newStmt(c, kind);
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
basParseMatch(c, TOK_HASH);
s->a = basParseExpr(c);
basParseExpect(c, TOK_COMMA);
if (!basParseCheck(c, TOK_COMMA)) {
s->b = basParseExpr(c);
}
basParseExpect(c, TOK_COMMA);
s->c = (kind == ST_GET) ? basParseLValue(c, false) : basParseExpr(c);
return (BasNodeT *)s;
}
// CIRCLE [STEP](x, y), r [, color [, start [, end [, aspect]]]] ->
// (x, y, r, color, start, end, aspect, flags).
static void parseGfxCircleArgs(BasCompilerT *c, ArgListT *l) {
static const int32_t slots[] = { BAS_GFX_COLOR, BAS_GFX_ARC_START, BAS_GFX_ARC_END, BAS_GFX_ASPECT };
int32_t flags = 0;
parseGfxPoint(c, l, &flags, BAS_GFX_STEP);
basParseExpect(c, TOK_COMMA);
argAdd(l, basParseExpr(c));
parseFlaggedArgs(c, l, slots, DVX_ARRAY_LEN(slots), &flags);
argAdd(l, basParseIntLit(c, flags));
}
// LINE [[STEP](x1, y1)]-[STEP](x2, y2) [, [color] [, [B | BF] [, style]]]
// -> (x1, y1, x2, y2, color, style, flags).
static void parseGfxLineArgs(BasCompilerT *c, ArgListT *l) {
int32_t flags = 0;
if (basParseCheck(c, TOK_LPAREN) || basParseCheck(c, TOK_STEP)) {
parseGfxPoint(c, l, &flags, BAS_GFX_STEP);
flags |= BAS_GFX_START;
} else {
argZero(c, l);
argZero(c, l);
}
basParseExpect(c, TOK_MINUS);
parseGfxPoint(c, l, &flags, BAS_GFX_STEP2);
bool colorComma = basParseMatch(c, TOK_COMMA);
if (colorComma && !basParseCheck(c, TOK_COMMA) && !basParseAtEnd(c)) {
argAdd(l, basParseExpr(c));
flags |= BAS_GFX_COLOR;
} else {
argZero(c, l);
}
if (colorComma && basParseMatch(c, TOK_COMMA)) {
if (basParseCheckWord(c, BAS_KW_BF)) {
flags |= BAS_GFX_BOX_FILL;
basParseAdvance(c);
} else if (basParseCheckWord(c, BAS_KW_B)) {
flags |= BAS_GFX_BOX;
basParseAdvance(c);
} else if (!basParseCheck(c, TOK_COMMA) && !basParseAtEnd(c)) {
basParseErrorExpected(c, "B or BF");
return;
}
if (basParseMatch(c, TOK_COMMA)) {
argAdd(l, basParseExpr(c));
flags |= BAS_GFX_STYLE;
} else {
argZero(c, l);
}
} else {
argZero(c, l);
}
argAdd(l, basParseIntLit(c, flags));
}
// [STEP](x, y): adds x and y; STEP adds stepFlag.
static void parseGfxPoint(BasCompilerT *c, ArgListT *l, int32_t *flags, int32_t stepFlag) {
if (basParseMatch(c, TOK_STEP)) {
*flags |= stepFlag;
}
basParseExpect(c, TOK_LPAREN);
argAdd(l, basParseExpr(c));
basParseExpect(c, TOK_COMMA);
argAdd(l, basParseExpr(c));
basParseExpect(c, TOK_RPAREN);
}
// PSET / PRESET [STEP](x, y) [, color] -> (x, y, color, flags).
static void parseGfxPsetArgs(BasCompilerT *c, ArgListT *l, int32_t flags) {
static const int32_t slots[] = { BAS_GFX_COLOR };
parseGfxPoint(c, l, &flags, BAS_GFX_STEP);
parseFlaggedArgs(c, l, slots, DVX_ARRAY_LEN(slots), &flags);
argAdd(l, basParseIntLit(c, flags));
}
// The optional (x1, y1)-(x2, y2) of VIEW, WINDOW and the Scale method:
// the four values (zeros without a rectangle). Returns BAS_VIEW_COORDS
// when the rectangle was written.
static int32_t parseGfxRect(BasCompilerT *c, ArgListT *l) {
int32_t noStep = 0;
if (!basParseCheck(c, TOK_LPAREN)) {
for (int32_t i = 0; i < BAS_PAIR_VALUES * BAS_PAIR_VALUES; i++) {
argZero(c, l);
}
return 0;
}
parseGfxPoint(c, l, &noStep, 0);
basParseExpect(c, TOK_MINUS);
parseGfxPoint(c, l, &noStep, 0);
return BAS_VIEW_COORDS;
}
// A statement that starts with a name: MID$ / LSET / RSET statements,
// "chain = value" (isSet: SET), or a call: name args, name(args),
// obj.Method args, the drawing methods' QBasic syntax.
static BasNodeT *parseIdentStatement(BasCompilerT *c, bool isSet) {
BasLexerT peek = c->lex;
basLexerNext(&peek);
if (basParseCheckWord(c, BAS_KW_MID) && peek.token.type == TOK_LPAREN) {
return parseMidAssign(c);
}
if ((basParseCheckWord(c, BAS_KW_LSET) || basParseCheckWord(c, BAS_KW_RSET)) && peek.token.type == TOK_IDENT && !procNamed(c, c->lex.token.text)) {
return parseLset(c);
}
BasNameT *name = (BasNameT *)basParseNode(c, (int32_t)sizeof(BasNameT), NK_NAME);
if (name == NULL) {
return NULL;
}
name->name = basParseTokenName(c);
basParseAdvance(c);
BasNodeT *chain = basParseChain(c, &name->h, true);
if (chain == NULL) {
return NULL;
}
if (basParseMatch(c, TOK_EQ)) {
BasStmtT *s = newStmt(c, ST_ASSIGN);
if (s == NULL) {
return NULL;
}
s->a = chain;
s->b = basParseExpr(c);
if (isSet) {
s->h.flags |= NF_SET;
basParseObjectOperand(c, s->b);
}
return (BasNodeT *)s;
}
if (chain->kind == NK_MEMBER) {
return parseMemberCall(c, (BasMemberT *)chain, isSet);
}
BasStmtT *s = newStmt(c, ST_CALL);
if (s == NULL) {
return NULL;
}
s->a = chain;
s->name = basTokenName(c->lex.token.type);
if (chain->kind == NK_CALL) {
BasCallT *call = (BasCallT *)chain;
// name (x) without CALL: the parentheses are the argument's own,
// so it is passed as a value (VB, QBasic)
if (call->argc == 1 && call->args != NULL) {
call->args->flags |= NF_PAREN;
}
s->ival = BAS_ARGS_PARENS;
s->ival2 = call->argc;
} else if (!basParseAtEnd(c)) {
s->ival = BAS_ARGS_BARE;
s->b = basParseBareArgs(c, &s->ival2);
} else {
s->ival = BAS_ARGS_NONE;
}
return (BasNodeT *)s;
}
// IF cond THEN stmt [: stmt] [ELSE stmt ...] on one line, or the block
// form with ELSEIF / ELSE / END IF.
static BasNodeT *parseIf(BasCompilerT *c) {
BasIfT *n = (BasIfT *)basParseNode(c, (int32_t)sizeof(BasIfT), ST_IF);
basParseAdvance(c);
if (n == NULL) {
return NULL;
}
n->cond = basParseExpr(c);
// IF cond GOTO label (QBasic): a single-line IF whose THEN is the GOTO
bool viaGoto = basParseCheck(c, TOK_GOTO);
if (!viaGoto) {
basParseExpect(c, TOK_THEN);
}
if (c->hasError) {
return (BasNodeT *)n;
}
// Single-line IF: every colon-separated statement after THEN (and
// after ELSE) belongs to that branch (QuickBASIC); a line number
// there is a GOTO to it.
if (viaGoto || (!basParseCheck(c, TOK_NEWLINE) && !basParseCheck(c, TOK_EOF))) {
n->singleLine = true;
n->thenBody = viaGoto ? parseLabelName(c, ST_GOTO) : parseBranch(c);
if (basParseMatch(c, TOK_ELSE)) {
n->hasElse = true;
n->elseBody = parseBranch(c);
}
return (BasNodeT *)n;
}
basParseExpectEnd(c);
bool ended = false;
BasNodeT *eiTail = NULL;
n->thenBody = parseBlockBody(c, TOK_IF, TOK_ELSEIF, &ended);
while (!ended && !c->hasError && basParseCheck(c, TOK_ELSEIF)) {
BasIfT *ei = (BasIfT *)basParseNode(c, (int32_t)sizeof(BasIfT), ST_ELSEIF);
basParseAdvance(c);
if (ei == NULL) {
return (BasNodeT *)n;
}
ei->cond = basParseExpr(c);
basParseExpect(c, TOK_THEN);
basParseExpectEnd(c);
ei->thenBody = parseBlockBody(c, TOK_IF, TOK_ELSEIF, &ended);
if (eiTail != NULL) {
eiTail->next = &ei->h;
} else {
n->elseIfs = &ei->h;
}
eiTail = &ei->h;
}
if (!ended && !c->hasError && basParseMatch(c, TOK_ELSE)) {
n->hasElse = true;
basParseExpectEnd(c);
n->elseBody = parseBlockBody(c, TOK_IF, TOK_EOF, &ended);
}
if (!ended && !c->hasError) {
basParseError(c, "Expected END IF");
}
return (BasNodeT *)n;
}
// Up to max further arguments QBasic accepts and DVX ignores: evaluated
// for their side effects and dropped (an NK_CONV with OP_POP marks them).
static void parseIgnoredArgs(BasCompilerT *c, ArgListT *l, int32_t max) {
for (int32_t i = 0; i < max && basParseMatch(c, TOK_COMMA); i++) {
if (!basParseCheck(c, TOK_COMMA) && !basParseAtEnd(c)) {
BasOpT *drop = (BasOpT *)basParseNode(c, (int32_t)sizeof(BasOpT), NK_CONV);
if (drop != NULL) {
drop->op = OP_POP;
drop->a = basParseExpr(c);
}
argAdd(l, &drop->h);
l->count--;
}
}
}
// INPUT #channel, target [, target ...] / INPUT ["prompt" {; | ,}] target
static BasNodeT *parseInput(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_INPUT);
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
if (basParseMatch(c, TOK_HASH)) {
BasNodeT *tail = NULL;
s->a = basParseExpr(c);
basParseExpect(c, TOK_COMMA);
do {
BasNodeT *t = basParseLValue(c, true);
if (t == NULL) {
break;
}
if (tail != NULL) {
tail->next = t;
} else {
s->c = t;
}
tail = t;
} while (basParseMatch(c, TOK_COMMA));
return (BasNodeT *)s;
}
if (basParseCheck(c, TOK_STRING_LIT)) {
s->b = basParseStrLit(c, c->lex.token.text, c->lex.token.textLen);
basParseAdvance(c);
if (!basParseMatch(c, TOK_SEMICOLON)) {
basParseMatch(c, TOK_COMMA);
}
}
s->c = basParseLValue(c, true);
return (BasNodeT *)s;
}
// GOTO / GOSUB label (a name or a line number)
static BasNodeT *parseLabelName(BasCompilerT *c, uint8_t kind) {
basParseAdvance(c);
BasStmtT *s = newStmt(c, kind);
if (s != NULL) {
s->name = labelRef(c);
}
return (s != NULL && s->name != NULL) ? (BasNodeT *)s : NULL;
}
// LINE: LINE INPUT, or the graphics LINE statement.
static BasNodeT *parseLine(BasCompilerT *c) {
basParseAdvance(c);
if (basParseMatch(c, TOK_INPUT)) {
return parseLineInput(c);
}
ArgListT args;
BasStmtT *s = newStmt(c, ST_SCREEN);
memset(&args, 0, sizeof(args));
parseGfxLineArgs(c, &args);
if (s != NULL) {
s->ival = BAS_FN_LINE;
s->b = args.head;
s->ival2 = args.count;
}
return (BasNodeT *)s;
}
// LINE INPUT #channel, target / LINE INPUT [;] ["prompt" {; | ,}] target
static BasNodeT *parseLineInput(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_LINEINPUT);
if (s == NULL) {
return NULL;
}
if (basParseMatch(c, TOK_HASH)) {
s->a = basParseExpr(c);
basParseExpect(c, TOK_COMMA);
s->c = basParseLValue(c, true);
return (BasNodeT *)s;
}
basParseMatch(c, TOK_SEMICOLON);
if (basParseCheck(c, TOK_STRING_LIT)) {
s->b = basParseStrLit(c, c->lex.token.text, c->lex.token.textLen);
basParseAdvance(c);
if (!basParseMatch(c, TOK_SEMICOLON)) {
basParseExpect(c, TOK_COMMA);
}
}
s->c = basParseLValue(c, true);
return (BasNodeT *)s;
}
// LSET / RSET target = value (the word is current).
static BasNodeT *parseLset(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_LSET);
if (s == NULL) {
return NULL;
}
s->ival = basParseCheckWord(c, BAS_KW_RSET) ? 1 : 0;
basParseAdvance(c);
s->a = basParseLValue(c, true);
basParseExpect(c, TOK_EQ);
s->c = basParseExpr(c);
return (BasNodeT *)s;
}
// A statement on obj.member not followed by '=': Show / Hide of a form
// (name.Show [modal]), a drawing method (Print, Line, Circle, PSet,
// Scale) in its QBasic syntax, or a method call with comma-separated
// arguments. A drawing method of a plain name may be a class's own
// method instead: its arguments are read once the resolver knows.
static BasNodeT *parseMemberCall(BasCompilerT *c, BasMemberT *m, bool isSet) {
BasStmtT *s = newStmt(c, ST_CALL);
(void)isSet;
if (s == NULL) {
return NULL;
}
s->name = basTokenName(c->lex.token.type);
bool twoPart = m->base->kind == NK_NAME || (m->base->kind == NK_ME && !c->parseInClass);
s->a = &m->h;
s->ival = BAS_ARGS_BARE;
if (twoPart && (strcasecmp(m->name, BAS_METHOD_SHOW) == 0 || strcasecmp(m->name, BAS_METHOD_HIDE) == 0)) {
if (strcasecmp(m->name, BAS_METHOD_SHOW) == 0 && !basParseAtEnd(c)) {
s->b = basParseExpr(c);
s->ival2 = 1;
}
return (BasNodeT *)s;
}
if (!drawingMethod(m->name)) {
s->b = basParseBareArgs(c, &s->ival2);
return (BasNodeT *)s;
}
if (m->base->kind == NK_NAME) {
BasLitT *at = (BasLitT *)basParseNode(c, (int32_t)sizeof(BasLitT), NK_INT);
if (at == NULL) {
return NULL;
}
at->ival = c->lex.token.pos;
s->c = &at->h;
s->h.flags |= NF_DEFERRED;
while (!c->hasError && !basParseAtEnd(c)) {
basParseAdvance(c);
}
return (BasNodeT *)s;
}
s->ival = BAS_ARGS_DRAWING;
s->b = parseDrawingArgs(c, m->name, &s->ival2);
return (BasNodeT *)s;
}
// Me.member ... or (inside WITH) .member ... as a statement (isSet: SET
// Me.member = object).
static BasNodeT *parseMeStatement(BasCompilerT *c, bool isSet) {
BasNodeT *me;
if (basParseCheck(c, TOK_DOT)) {
// .member inside WITH: the WITH's object in place of Me
me = basParseWithRef(c);
} else {
me = basParseNode(c, (int32_t)sizeof(BasNameT), NK_ME);
basParseAdvance(c);
if (!basParseCheck(c, TOK_DOT)) {
basParseErrorExpected(c, "'.' after Me");
return NULL;
}
}
if (me == NULL) {
return NULL;
}
BasNodeT *chain = basParseChain(c, me, true);
if (chain == NULL) {
return NULL;
}
if (basParseMatch(c, TOK_EQ)) {
BasStmtT *s = newStmt(c, ST_ASSIGN);
if (s == NULL) {
return NULL;
}
s->a = chain;
s->b = basParseExpr(c);
if (isSet) {
s->h.flags |= NF_SET;
basParseObjectOperand(c, s->b);
}
return (BasNodeT *)s;
}
if (chain->kind != NK_MEMBER) {
basParseErrorExpected(c, "'=' or method arguments");
return NULL;
}
return parseMemberCall(c, (BasMemberT *)chain, isSet);
}
// MID$(var$, start [, len]) = replacement$
static BasNodeT *parseMidAssign(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_MIDASSIGN);
basParseAdvance(c);
basParseExpect(c, TOK_LPAREN);
if (s == NULL || c->hasError) {
return NULL;
}
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "string variable name");
return NULL;
}
s->name = basParseTokenName(c);
basParseAdvance(c);
basParseExpect(c, TOK_COMMA);
s->a = basParseExpr(c);
if (basParseMatch(c, TOK_COMMA)) {
s->b = basParseExpr(c);
}
basParseExpect(c, TOK_RPAREN);
basParseExpect(c, TOK_EQ);
s->c = basParseExpr(c);
return (BasNodeT *)s;
}
// A numeric literal (the current token), negated when isNeg (the minus
// was consumed with allowNegMagnitude, so -32768% and -2147483648 arrive
// as magnitudes). Integers negate with 32-bit wrap-around.
static BasNodeT *parseNumLit(BasCompilerT *c, bool isNeg) {
if (basParseCheck(c, TOK_FLOAT_LIT)) {
BasLitT *lit = (BasLitT *)basParseNode(c, (int32_t)sizeof(BasLitT), NK_DBL);
if (lit != NULL) {
lit->dval = isNeg ? -c->lex.token.dblVal : c->lex.token.dblVal;
lit->h.type = BAS_TYPE_DOUBLE;
}
return (BasNodeT *)lit;
}
if (basParseCheck(c, TOK_CUR_LIT)) {
return basParseCurLit(c, isNeg ? -c->lex.token.longVal : c->lex.token.longVal);
}
bool isIntLit = basParseCheck(c, TOK_INT_LIT);
int64_t mag = isIntLit ? c->lex.token.intVal : c->lex.token.longVal;
uint32_t bits = (uint32_t)mag;
if (isNeg) {
bits = 0u - bits;
}
BasNodeT *n = basParseIntLit(c, (int32_t)bits);
if (n != NULL && !isIntLit) {
n->type = BAS_TYPE_LONG;
}
return n;
}
// Object Print items (Form / PictureBox Print): ';', ',', SPC(n), TAB(n)
// and values up to the end of the statement.
static BasNodeT *parseObjectPrintItems(BasCompilerT *c, int32_t *outCount) {
BasNodeT *head = NULL;
BasNodeT *tail = NULL;
while (!c->hasError && !basParseAtEnd(c)) {
if (basParseMatch(c, TOK_SEMICOLON)) {
printItem(c, &head, &tail, BAS_ITEM_SEMI, NULL);
continue;
}
if (basParseMatch(c, TOK_COMMA)) {
printItem(c, &head, &tail, BAS_ITEM_COMMA, NULL);
continue;
}
if (basParseCheckWord(c, BAS_KW_SPC) || basParseCheckWord(c, BAS_KW_TAB)) {
uint8_t kind = basParseCheckWord(c, BAS_KW_SPC) ? BAS_ITEM_SPC : BAS_ITEM_TAB;
basParseAdvance(c);
basParseExpect(c, TOK_LPAREN);
BasNodeT *e = basParseExpr(c);
basParseExpect(c, TOK_RPAREN);
printItem(c, &head, &tail, kind, e);
continue;
}
printItem(c, &head, &tail, BAS_ITEM_EXPR, basParseExpr(c));
}
*outCount = basNodeCount(head);
return head;
}
// ON ERROR GOTO label | 0, ON ERROR RESUME NEXT, ON expr GOTO / GOSUB
// label, label ...
static BasNodeT *parseOn(BasCompilerT *c) {
basParseAdvance(c);
if (basParseCheck(c, TOK_ERROR_KW)) {
BasStmtT *s = newStmt(c, ST_ONERROR);
basParseAdvance(c);
// ON ERROR RESUME NEXT (VB)
if (basParseMatch(c, TOK_RESUME)) {
basParseExpect(c, TOK_NEXT);
if (s != NULL) {
s->ival = BAS_ON_ERROR_RESUME_NEXT;
}
return (BasNodeT *)s;
}
if (!basParseCheck(c, TOK_GOTO)) {
basParseError(c, "Expected GOTO or RESUME NEXT after ON ERROR");
return NULL;
}
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
if (basParseCheck(c, TOK_INT_LIT) && c->lex.token.intVal == 0) {
basParseAdvance(c);
return (BasNodeT *)s;
}
s->name = labelRef(c);
return (s->name != NULL) ? (BasNodeT *)s : NULL;
}
BasStmtT *s = newStmt(c, ST_ONGOTO);
if (s == NULL) {
return NULL;
}
s->a = basParseExpr(c);
if (basParseMatch(c, TOK_GOSUB)) {
s->ival = 1;
} else if (!basParseMatch(c, TOK_GOTO)) {
basParseError(c, "Expected GOTO or GOSUB after ON expression");
return NULL;
}
BasNodeT *tail = NULL;
do {
BasNameT *label = (BasNameT *)basParseNode(c, (int32_t)sizeof(BasNameT), NK_NAME);
if (label == NULL) {
return NULL;
}
label->name = labelRef(c);
if (label->name == NULL) {
return NULL;
}
if (tail != NULL) {
tail->next = &label->h;
} else {
s->b = &label->h;
}
tail = &label->h;
s->ival2++;
} while (basParseMatch(c, TOK_COMMA));
return (BasNodeT *)s;
}
// OPEN file FOR mode AS [#]channel [LEN = recordLength]
static BasNodeT *parseOpen(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_OPEN);
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
s->a = basParseExpr(c);
basParseExpect(c, TOK_FOR);
switch (c->lex.token.type) {
case TOK_INPUT:
s->ival = BAS_FILE_MODE_INPUT;
break;
case TOK_OUTPUT:
s->ival = BAS_FILE_MODE_OUTPUT;
break;
case TOK_APPEND:
s->ival = BAS_FILE_MODE_APPEND;
break;
case TOK_RANDOM:
s->ival = BAS_FILE_MODE_RANDOM;
break;
case TOK_BINARY:
s->ival = BAS_FILE_MODE_BINARY;
break;
default:
if (!c->hasError) {
basParseError(c, "Expected INPUT, OUTPUT, APPEND, RANDOM, or BINARY after FOR");
}
return NULL;
}
basParseAdvance(c);
basParseExpect(c, TOK_AS);
basParseMatch(c, TOK_HASH);
s->b = basParseExpr(c);
if (basParseCheckWord(c, BAS_KW_LEN)) {
basParseAdvance(c);
basParseExpect(c, TOK_EQ);
s->c = basParseExpr(c);
}
return (BasNodeT *)s;
}
// count optional positional arguments (LOCATE row, col, cursor ...): each
// may be left empty, a missing one is 0. Returns the BAS_GIVEN_* mask of
// those written.
static int32_t parseOptionalArgs(BasCompilerT *c, ArgListT *l, int32_t count) {
int32_t given = 0;
for (int32_t i = 0; i < count; i++) {
if (i > 0 && !basParseMatch(c, TOK_COMMA)) {
for (int32_t j = i; j < count; j++) {
argZero(c, l);
}
return given;
}
if (basParseCheck(c, TOK_COMMA) || basParseAtEnd(c)) {
argZero(c, l);
continue;
}
argAdd(l, basParseExpr(c));
given |= 1 << i;
}
return given;
}
// PRINT [#channel, items] / PRINT items / PRINT USING (LPRINT: no #).
static BasNodeT *parsePrint(BasCompilerT *c, bool isLprint) {
BasPrintT *pr = (BasPrintT *)basParseNode(c, (int32_t)sizeof(BasPrintT), ST_PRINT);
basParseAdvance(c);
if (pr == NULL) {
return NULL;
}
pr->isLprint = isLprint;
// PRINT #channel, then what PRINT takes (USING, zones, SPC, TAB)
if (!isLprint && basParseMatch(c, TOK_HASH)) {
pr->channel = basParseExpr(c);
basParseExpect(c, TOK_COMMA);
}
parsePrintItems(c, pr);
return (BasNodeT *)pr;
}
// What follows PRINT (or LPRINT) when it is not PRINT #: items with ';',
// ',', SPC(n) and TAB(n), or USING "fmt"; values.
static void parsePrintItems(BasCompilerT *c, BasPrintT *pr) {
BasNodeT *tail = NULL;
if (basParseCheckWord(c, BAS_KW_USING)) {
basParseAdvance(c);
pr->mode = BAS_PRINT_USING;
pr->format = basParseExpr(c);
basParseExpect(c, TOK_SEMICOLON);
while (!c->hasError) {
printItem(c, &pr->items, &tail, BAS_ITEM_EXPR, basParseExpr(c));
if (!basParseCheck(c, TOK_SEMICOLON) && !basParseCheck(c, TOK_COMMA)) {
break;
}
printItem(c, &pr->items, &tail, BAS_ITEM_SEMI, NULL);
basParseAdvance(c);
if (basParseAtEnd(c)) {
break;
}
}
return;
}
pr->mode = BAS_PRINT_CONSOLE;
while (!c->hasError && !basParseAtEnd(c)) {
if (basParseMatch(c, TOK_SEMICOLON)) {
printItem(c, &pr->items, &tail, BAS_ITEM_SEMI, NULL);
continue;
}
if (basParseMatch(c, TOK_COMMA)) {
printItem(c, &pr->items, &tail, BAS_ITEM_COMMA, NULL);
continue;
}
if (basParseCheckWord(c, BAS_KW_SPC) || basParseCheckWord(c, BAS_KW_TAB)) {
uint8_t kind = basParseCheckWord(c, BAS_KW_SPC) ? BAS_ITEM_SPC : BAS_ITEM_TAB;
basParseAdvance(c);
basParseExpect(c, TOK_LPAREN);
BasNodeT *e = basParseExpr(c);
basParseExpect(c, TOK_RPAREN);
printItem(c, &pr->items, &tail, kind, e);
continue;
}
printItem(c, &pr->items, &tail, BAS_ITEM_EXPR, basParseExpr(c));
}
}
// RaiseEvent Name[(args)]
static BasNodeT *parseRaiseEvent(BasCompilerT *c) {
basParseAdvance(c);
BasStmtT *s = newStmt(c, ST_RAISEEVENT);
if (s == NULL) {
return NULL;
}
s->name = basParseTokenName(c);
basParseAdvance(c);
if (basParseCheck(c, TOK_LPAREN)) {
s->b = basParseArgList(c, &s->ival2);
}
return (BasNodeT *)s;
}
// READ target, target, ...
static BasNodeT *parseRead(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_READ);
BasNodeT *tail = NULL;
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
do {
BasNodeT *t = basParseLValue(c, true);
if (t == NULL) {
break;
}
if (tail != NULL) {
tail->next = t;
} else {
s->a = t;
}
tail = t;
} while (basParseMatch(c, TOK_COMMA));
return (BasNodeT *)s;
}
// The console and graphics statements (the word is current): their
// arguments in the layout opcodes.h gives each built-in.
static BasNodeT *parseScreenStatement(BasCompilerT *c, const ScreenStmtT *stmt) {
ArgListT args;
BasStmtT *s = newStmt(c, ST_SCREEN);
int32_t flags = stmt->flags;
int32_t given = 0;
uint8_t func = stmt->func;
memset(&args, 0, sizeof(args));
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
switch (stmt->func) {
case BAS_FN_CLS:
argAdd(&args, basParseAtEnd(c) ? basParseIntLit(c, BAS_CLS_OMITTED) : basParseExpr(c));
break;
case BAS_FN_LOCATE:
given = parseOptionalArgs(c, &args, BAS_LOCATE_VALUES);
parseIgnoredArgs(c, &args, BAS_LOCATE_IGNORED);
argAdd(&args, basParseIntLit(c, given));
break;
case BAS_FN_COLOR:
given = parseOptionalArgs(c, &args, BAS_PAIR_VALUES);
parseIgnoredArgs(c, &args, BAS_COLOR_IGNORED);
argAdd(&args, basParseIntLit(c, given));
break;
case BAS_FN_WIDTH:
// WIDTH #file, width / WIDTH "device", width / WIDTH LPRINT width
if (basParseCheck(c, TOK_HASH) || basParseCheck(c, TOK_STRING_LIT) || basParseCheck(c, TOK_LPRINT)) {
func = BAS_FN_FILE_WIDTH;
if (basParseMatch(c, TOK_LPRINT)) {
argAdd(&args, basParseIntLit(c, BAS_WIDTH_LPRINT));
} else {
basParseMatch(c, TOK_HASH);
argAdd(&args, basParseExpr(c));
basParseExpect(c, TOK_COMMA);
}
argAdd(&args, basParseExpr(c));
break;
}
given = parseOptionalArgs(c, &args, BAS_PAIR_VALUES);
argAdd(&args, basParseIntLit(c, given));
break;
case BAS_FN_SCREEN:
// SCREEN mode [, [colorswitch] [, [apage] [, vpage]]]
argAdd(&args, basParseExpr(c));
if (basParseMatch(c, TOK_COMMA)) {
given = parseOptionalArgs(c, &args, BAS_SCREEN_VALUES);
} else {
for (int32_t i = 0; i < BAS_SCREEN_VALUES; i++) {
argZero(c, &args);
}
}
argAdd(&args, basParseIntLit(c, given));
break;
case BAS_FN_PCOPY:
argAdd(&args, basParseExpr(c));
basParseExpect(c, TOK_COMMA);
argAdd(&args, basParseExpr(c));
break;
case BAS_FN_PSET:
parseGfxPsetArgs(c, &args, flags);
break;
case BAS_FN_CIRCLE:
parseGfxCircleArgs(c, &args);
break;
case BAS_FN_PAINT: {
static const int32_t slots[] = { BAS_GFX_COLOR, BAS_GFX_BORDER, BAS_GFX_BACKGROUND };
parseGfxPoint(c, &args, &flags, BAS_GFX_STEP);
parseFlaggedArgs(c, &args, slots, DVX_ARRAY_LEN(slots), &flags);
argAdd(&args, basParseIntLit(c, flags));
break;
}
case BAS_FN_DRAW:
argAdd(&args, basParseExpr(c));
break;
case BAS_FN_PALETTE:
if (basParseCheckWord(c, BAS_KW_USING)) {
// PALETTE USING array[(first)]
basParseAdvance(c);
if (!basParseCheck(c, TOK_IDENT)) {
basParseErrorExpected(c, "array name");
return NULL;
}
BasNameT *arr = (BasNameT *)basParseNode(c, (int32_t)sizeof(BasNameT), NK_NAME);
if (arr == NULL) {
return NULL;
}
arr->name = basParseTokenName(c);
arr->h.flags = NF_OBJECTARG;
basParseAdvance(c);
argAdd(&args, &arr->h);
if (basParseMatch(c, TOK_LPAREN)) {
argAdd(&args, basParseExpr(c));
basParseExpect(c, TOK_RPAREN);
given = BAS_GIVEN_2;
} else {
argZero(c, &args);
}
argAdd(&args, basParseIntLit(c, given));
func = BAS_FN_PALETTE_USING;
break;
}
if (basParseAtEnd(c)) {
argZero(c, &args);
argZero(c, &args);
} else {
argAdd(&args, basParseExpr(c));
basParseExpect(c, TOK_COMMA);
argAdd(&args, basParseExpr(c));
given = BAS_GIVEN_1;
}
argAdd(&args, basParseIntLit(c, given));
break;
case BAS_FN_VIEW:
case BAS_FN_WINDOW: {
static const int32_t slots[] = { BAS_VIEW_FILL, BAS_VIEW_BORDER };
bool isView = stmt->func == BAS_FN_VIEW;
// VIEW PRINT [top TO bottom]: the text viewport
if (isView && basParseMatch(c, TOK_PRINT)) {
if (basParseAtEnd(c)) {
argZero(c, &args);
argZero(c, &args);
} else {
argAdd(&args, basParseExpr(c));
basParseExpect(c, TOK_TO);
argAdd(&args, basParseExpr(c));
given = BAS_GIVEN_1;
}
argAdd(&args, basParseIntLit(c, given));
func = BAS_FN_VIEW_PRINT;
break;
}
if (basParseCheckWord(c, "SCREEN")) {
basParseAdvance(c);
flags |= BAS_VIEW_SCREEN;
}
flags |= parseGfxRect(c, &args);
if (isView) {
parseFlaggedArgs(c, &args, slots, DVX_ARRAY_LEN(slots), &flags);
}
argAdd(&args, basParseIntLit(c, flags));
break;
}
case BAS_FN_PEN_SET:
// PEN ON | OFF | STOP
if (basParseMatch(c, TOK_ON)) {
argAdd(&args, basParseIntLit(c, BAS_PEN_ON));
} else if (basParseCheckWord(c, BAS_KW_OFF) || basParseCheckWord(c, BAS_KW_STOP)) {
argAdd(&args, basParseIntLit(c, basParseCheckWord(c, BAS_KW_STOP) ? BAS_PEN_STOP : BAS_PEN_OFF));
basParseAdvance(c);
} else {
basParseErrorExpected(c, "ON, OFF or STOP after PEN");
return NULL;
}
break;
case BAS_FN_FULLSCREEN:
if (basParseAtEnd(c) || basParseMatch(c, TOK_ON)) {
argAdd(&args, basParseIntLit(c, BAS_FULLSCREEN_ON));
} else if (basParseCheckWord(c, BAS_KW_OFF)) {
basParseAdvance(c);
argAdd(&args, basParseIntLit(c, BAS_FULLSCREEN_OFF));
} else {
argAdd(&args, basParseExpr(c));
}
break;
default:
basParseError(c, "Unknown screen statement");
return NULL;
}
s->ival = func;
s->b = args.head;
s->ival2 = args.count;
return (BasNodeT *)s;
}
// SELECT CASE expr / CASE items / CASE ELSE / END SELECT
static BasNodeT *parseSelectCase(BasCompilerT *c) {
BasSelectT *sel = (BasSelectT *)basParseNode(c, (int32_t)sizeof(BasSelectT), ST_SELECT);
basParseAdvance(c);
basParseExpect(c, TOK_CASE);
if (sel == NULL) {
return NULL;
}
sel->expr = basParseExpr(c);
basParseExpectEnd(c);
basParseSkipNewlines(c);
BasNodeT *caseTail = NULL;
while (!c->hasError && !basParseCheck(c, TOK_EOF)) {
if (basParseMatchEnd(c, TOK_SELECT)) {
return (BasNodeT *)sel;
}
if (!basParseCheck(c, TOK_CASE)) {
basParseError(c, "Expected CASE or END SELECT");
return NULL;
}
BasCaseT *cs = (BasCaseT *)basParseNode(c, (int32_t)sizeof(BasCaseT), ST_CASE);
basParseAdvance(c);
if (cs == NULL) {
return NULL;
}
if (caseTail != NULL) {
caseTail->next = &cs->h;
} else {
sel->cases = &cs->h;
}
caseTail = &cs->h;
bool ended = false;
// CASE ELSE: its body runs to END SELECT
if (basParseMatch(c, TOK_ELSE)) {
cs->isElse = true;
basParseExpectEnd(c);
cs->body = parseBlockBody(c, TOK_SELECT, TOK_EOF, &ended);
if (ended) {
return (BasNodeT *)sel;
}
continue;
}
// CASE val [, val | val TO val | IS op val] ...
BasNodeT *itemTail = NULL;
do {
BasCaseItemT *item = (BasCaseItemT *)basParseNode(c, (int32_t)sizeof(BasCaseItemT), ST_CASEITEM);
if (item == NULL) {
return NULL;
}
if (basParseMatch(c, TOK_IS)) {
static const BasTokenTypeE ops[] = { TOK_LT, TOK_GT, TOK_LE, TOK_GE, TOK_EQ, TOK_NE };
static const uint8_t opcodes[] = { OP_CMP_LT, OP_CMP_GT, OP_CMP_LE, OP_CMP_GE, OP_CMP_EQ, OP_CMP_NE };
int32_t k = 0;
while (k < DVX_ARRAY_LEN(ops) && !basParseCheck(c, ops[k])) {
k++;
}
if (k == DVX_ARRAY_LEN(ops)) {
basParseError(c, "Expected comparison operator after IS");
return NULL;
}
basParseAdvance(c);
item->kind = BAS_CASE_IS;
item->cmpOp = opcodes[k];
item->a = basParseExpr(c);
} else {
item->a = basParseExpr(c);
if (basParseMatch(c, TOK_TO)) {
item->kind = BAS_CASE_RANGE;
item->b = basParseExpr(c);
} else {
item->kind = BAS_CASE_VALUE;
}
}
if (itemTail != NULL) {
itemTail->next = &item->h;
} else {
cs->items = &item->h;
}
itemTail = &item->h;
} while (!c->hasError && basParseMatch(c, TOK_COMMA));
basParseExpectEnd(c);
cs->body = parseBlockBody(c, TOK_SELECT, TOK_CASE, &ended);
if (ended) {
return (BasNodeT *)sel;
}
}
if (!c->hasError) {
basParseError(c, "Expected END SELECT");
}
return (BasNodeT *)sel;
}
// KEYWORD arg, arg ... with exactly argc comma-separated arguments pushed
// before opcode (hashFirst: an optional '#' before the first).
static BasNodeT *parseSimple(BasCompilerT *c, uint8_t opcode, int32_t argc, bool hashFirst) {
ArgListT args;
BasStmtT *s = newStmt(c, ST_SIMPLE);
memset(&args, 0, sizeof(args));
basParseAdvance(c);
if (hashFirst) {
basParseMatch(c, TOK_HASH);
}
for (int32_t i = 0; i < argc && !c->hasError; i++) {
if (i > 0) {
basParseExpect(c, TOK_COMMA);
}
argAdd(&args, basParseExpr(c));
}
if (s != NULL) {
s->ival = opcode;
s->b = args.head;
s->ival2 = args.count;
}
return (BasNodeT *)s;
}
// SWAP a, b
static BasNodeT *parseSwap(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_SWAP);
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
s->a = basParseLValue(c, false);
basParseExpect(c, TOK_COMMA);
s->b = basParseLValue(c, false);
return (BasNodeT *)s;
}
// WHILE cond ... WEND
static BasNodeT *parseWhile(BasCompilerT *c) {
BasLoopT *loop = (BasLoopT *)basParseNode(c, (int32_t)sizeof(BasLoopT), ST_WHILE);
basParseAdvance(c);
if (loop == NULL) {
return NULL;
}
loop->preCond = basParseExpr(c);
basParseExpectEnd(c);
bool ended = false;
loop->body = parseBlockBody(c, TOK_EOF, TOK_WEND, &ended);
if (!c->hasError) {
basParseExpect(c, TOK_WEND);
}
return (BasNodeT *)loop;
}
// WITH object ... END WITH: inside, ".name" is a member (or field) of
// object.
static BasNodeT *parseWith(BasCompilerT *c) {
BasWithT *w = (BasWithT *)basParseNode(c, (int32_t)sizeof(BasWithT), ST_WITH);
basParseAdvance(c);
if (w == NULL) {
return NULL;
}
w->expr = basParseExpr(c);
basParseExpectEnd(c);
bool ended = false;
w->outer = c->parseWith;
c->parseWith = w;
w->body = parseBlockBody(c, TOK_WITH, TOK_EOF, &ended);
c->parseWith = w->outer;
if (!c->hasError && !ended) {
basParseError(c, "WITH without END WITH");
}
return (BasNodeT *)w;
}
// WRITE #channel, expr [, expr ...]
static BasNodeT *parseWrite(BasCompilerT *c) {
BasStmtT *s = newStmt(c, ST_WRITE);
basParseAdvance(c);
if (s == NULL) {
return NULL;
}
if (!basParseMatch(c, TOK_HASH)) {
basParseError(c, "Expected # after WRITE");
return NULL;
}
s->a = basParseExpr(c);
basParseExpect(c, TOK_COMMA);
BasNodeT *tail = NULL;
do {
BasNodeT *e = basParseExpr(c);
if (e == NULL) {
break;
}
if (tail != NULL) {
tail->next = e;
} else {
s->b = e;
}
tail = e;
s->ival2++;
} while (basParseMatch(c, TOK_COMMA));
return (BasNodeT *)s;
}
static void printItem(BasCompilerT *c, BasNodeT **head, BasNodeT **tail, uint8_t kind, BasNodeT *expr) {
BasPrintItemT *item = (BasPrintItemT *)basParseNode(c, (int32_t)sizeof(BasPrintItemT), NK_PRINTITEM);
if (item == NULL) {
return;
}
item->kind = kind;
item->expr = expr;
if (*tail != NULL) {
(*tail)->next = &item->h;
} else {
*head = &item->h;
}
*tail = &item->h;
}
// True when the program declares a SUB / FUNCTION (or DECLARE) named name
// (the declaration pass registered them all): then a console statement
// word or LSET / RSET is a call of it. In a class module the class's own
// procedures count too.
static bool procNamed(BasCompilerT *c, const char *name) {
const BasSymT *sym = basLookupProc(c, name);
return sym != NULL;
}
// True at RESET when the statement ends after it (RESET = x, RESET.x and
// RESET(i) are the program's own names).
static bool resetAhead(BasCompilerT *c) {
BasLexerT peek = c->lex;
basLexerNext(&peek);
return peek.token.type == TOK_NEWLINE || peek.token.type == TOK_EOF || peek.token.type == TOK_COLON || peek.token.type == TOK_REM;
}
// A statement that evaluates expr and drops its value.
static BasNodeT *stmtExpr(BasCompilerT *c, BasNodeT *expr) {
BasStmtT *s = newStmt(c, ST_EXPR);
if (s != NULL) {
s->a = expr;
}
return (BasNodeT *)s;
}
Reference in a new issue View git blame Copy permalink