/**************************************************************************** * apps/interpreters/bas/bas.c * * Copyright (c) 1999-2014 Michael Haardt * * 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. * * Adapted to NuttX and re-released under a 3-clause BSD license: * * Copyright (C) 2014 Gregory Nutt. All rights reserved. * Authors: Alan Carvalho de Assis * Gregory Nutt * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in * the documentation and/or other materials provided with the * distribution. * 3. Neither the name NuttX nor the names of its contributors may be * used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE * POSSIBILITY OF SUCH DAMAGE. * ****************************************************************************/ /**************************************************************************** * Included Files ****************************************************************************/ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include "auto.h" #include "bas.h" #include "error.h" #include "fs.h" #include "global.h" #include "program.h" #include "value.h" #include "var.h" /**************************************************************************** * Pre-processor Definitions ****************************************************************************/ #define DIRECTMODE (pc.line== -1) #define _(String) String /**************************************************************************** * Private Types ****************************************************************************/ enum LabelType { L_IF = 1, L_ELSE, L_DO, L_DOcondition, L_FOR, L_FOR_VAR, L_FOR_LIMIT, L_FOR_BODY, L_REPEAT, L_SELECTCASE, L_WHILE, L_FUNC }; struct LabelStack { enum LabelType type; struct Pc patch; }; /**************************************************************************** * Private Data ****************************************************************************/ static unsigned int labelStackPointer, labelStackCapacity; static struct LabelStack *labelStack; static struct Pc *lastdata; static struct Pc curdata; static struct Pc nextdata; static enum { DECLARE, COMPILE, INTERPRET } pass; static int stopped; static int optionbase; static struct Pc pc; static struct Auto stack; static struct Program program; static struct Global globals; static int run_restricted; /**************************************************************************** * Public Data ****************************************************************************/ int bas_argc; char *bas_argv0; char **bas_argv; int bas_end; /**************************************************************************** * Private Function Prototypes ****************************************************************************/ static struct Value *statements(struct Value *value); static struct Value *compileProgram(struct Value *v, int clearGlobals); static struct Value *eval(struct Value *value, const char *desc); /**************************************************************************** * Private Functions ****************************************************************************/ static int cat(const char *filename) { int fd; char buf[4096]; ssize_t l; int err; if ((fd = open(filename, O_RDONLY)) == -1) { return -1; } while ((l = read(fd, buf, sizeof(buf))) > 0) { ssize_t off, w; off = 0; while (off < l) { if ((w = write(1, buf + off, l - off)) == -1) { err = errno; close(fd); errno = err; return -1; } off += w; } } if (l == -1) { err = errno; close(fd); errno = err; return -1; } close(fd); return 0; } static struct Value *lvalue(struct Value *value) { struct Symbol *sym; struct Pc lvpc = pc; sym = pc.token->u.identifier->sym; assert(pass == DECLARE || sym->type == GLOBALVAR || sym->type == GLOBALARRAY || sym->type == LOCALVAR); if ((pc.token + 1)->type == T_OP) { struct Pc idxpc; unsigned int dim, capacity; int *idx; pc.token += 2; dim = 0; capacity = 0; idx = (int *)0; while (1) { if (dim == capacity && pass == INTERPRET) /* enlarge idx */ { int *more; more = realloc(idx, sizeof(unsigned int) * (capacity ? (capacity *= 2) : (capacity = 3))); if (!more) { if (capacity) free(idx); return Value_new_ERROR(value, OUTOFMEMORY); } idx = more; } idxpc = pc; if (eval(value, _("index"))->type == V_ERROR || VALUE_RETYPE(value, V_INTEGER)->type == V_ERROR) { if (capacity) { free(idx); } pc = idxpc; return value; } if (pass == INTERPRET) { idx[dim] = value->u.integer; ++dim; } Value_destroy(value); if (pc.token->type == T_COMMA) { ++pc.token; } else { break; } } if (pc.token->type != T_CP) { assert(pass != INTERPRET); return Value_new_ERROR(value, MISSINGCP); } else { ++pc.token; } switch (pass) { case INTERPRET: { if ((value = Var_value(&(sym->u.var), dim, idx, value))->type == V_ERROR) { pc = lvpc; } free(idx); return value; } case DECLARE: { return Value_nullValue(V_INTEGER); } case COMPILE: { return Value_nullValue(sym->type == GLOBALARRAY ? sym->u. var.type : Auto_varType(&stack, sym)); } default: assert(0); } return (struct Value *)0; } else { ++pc.token; switch (pass) { case INTERPRET: return VAR_SCALAR_VALUE(sym->type == GLOBALVAR ? &(sym->u.var) : Auto_local(&stack, sym-> u.local.offset)); case DECLARE: return Value_nullValue(V_INTEGER); case COMPILE: return Value_nullValue(sym->type == GLOBALVAR ? sym->u. var.type : Auto_varType(&stack, sym)); default: assert(0); } return (struct Value *)0; } } static struct Value *func(struct Value *value) { struct Identifier *ident; struct Pc funcpc = pc; int firstslot = -99; int args = 0; struct Symbol *sym; assert(pc.token->type == T_IDENTIFIER); /* Evaluating a function in direct mode may start a program, so it needs to * be compiled. If in direct mode, programs will be compiled after the * direct mode pass DECLARE, but errors are ignored at that point, because * the program may not be needed. If the program is fine, its symbols will * be available during the compile phase already. If not and we need it at * this point, compile it again to get the error and abort. */ if (DIRECTMODE && !program.runnable && pass != DECLARE) { if (compileProgram(value, 0)->type == V_ERROR) { return value; } Value_destroy(value); } ident = pc.token->u.identifier; assert(pass == DECLARE || ident->sym->type == BUILTINFUNCTION || ident->sym->type == USERFUNCTION); ++pc.token; if (pass != DECLARE) { firstslot = stack.stackPointer; if (ident->sym->type == USERFUNCTION && ident->sym->u.sub.retType != V_VOID) { struct Var *v = Auto_pushArg(&stack); Var_new(v, ident->sym->u.sub.retType, 0, (const unsigned int *)0, 0); } } if (pc.token->type == T_OP) /* push arguments to stack */ { ++pc.token; if (pc.token->type != T_CP) { while (1) { if (pass == DECLARE) { if (eval(value, _("actual parameter"))->type == V_ERROR) { return value; } Value_destroy(value); } else { struct Var *v = Auto_pushArg(&stack); Var_new_scalar(v); if (eval(v->value, (const char *)0)->type == V_ERROR) { Value_clone(value, v->value); while (stack.stackPointer > firstslot) { Var_destroy(&stack.slot[--stack.stackPointer].var); } return value; } v->type = v->value->type; } ++args; if (pc.token->type == T_COMMA) { ++pc.token; } else { break; } } if (pc.token->type != T_CP) { if (pass != DECLARE) { while (stack.stackPointer > firstslot) { Var_destroy(&stack.slot[--stack.stackPointer].var); } } return Value_new_ERROR(value, MISSINGCP); } ++pc.token; } } if (pass == DECLARE) { Value_new_null(value, ident->defaultType); } else { int i; int nomore; int argerr; int overloaded; if (pass == INTERPRET && ident->sym->type == USERFUNCTION) { for (i = 0; i < ident->sym->u.sub.u.def.localLength; ++i) { struct Var *v = Auto_pushArg(&stack); Var_new(v, ident->sym->u.sub.u.def.localTypes[i], 0, (const unsigned int *)0, 0); } } Auto_pushFuncRet(&stack, firstslot, &pc); sym = ident->sym; overloaded = (pass == COMPILE && sym->type == BUILTINFUNCTION && sym->u.sub.u.bltin.next); do { nomore = (pass == COMPILE && !(sym->type == BUILTINFUNCTION && sym->u.sub.u.bltin.next)); argerr = 0; if (args < sym->u.sub.argLength) { if (nomore) { Value_new_ERROR(value, TOOFEW); } argerr = 1; } else if (args > sym->u.sub.argLength) { if (nomore) { Value_new_ERROR(value, TOOMANY); } argerr = 1; } else { for (i = 0; i < args; ++i) { struct Value *arg = Var_value(Auto_local(&stack, i), 0, (int *)0, value); assert(arg->type != V_ERROR); if (overloaded) { if (arg->type != sym->u.sub.argTypes[i]) { if (nomore) { Value_new_ERROR(value, TYPEMISMATCH2, i + 1); } argerr = 1; break; } } else if (Value_retype(arg, sym->u.sub.argTypes[i])->type == V_ERROR) { if (nomore) { Value_new_ERROR(value, TYPEMISMATCH3, arg->u.error.msg, i + 1); } argerr = 1; break; } } } if (argerr) { if (nomore) { Auto_funcReturn(&stack, (struct Pc *)0); pc = funcpc; return value; } else { sym = sym->u.sub.u.bltin.next; } } } while (argerr); ident->sym = sym; if (sym->type == BUILTINFUNCTION) { if (pass == INTERPRET) { if (sym->u.sub.u.bltin.call(value, &stack)->type == V_ERROR) { pc = funcpc; } } else { Value_new_null(value, sym->u.sub.retType); } } else if (sym->type == USERFUNCTION) { if (pass == INTERPRET) { int r = 1; pc = sym->u.sub.u.def.scope.start; if (pc.token->type == T_COLON) { ++pc.token; } else { Program_skipEOL(&program, &pc, STDCHANNEL, 1); } do { if (statements(value)->type == V_ERROR) { if (strchr(value->u.error.msg, '\n') == (char *)0) { Auto_setError(&stack, Program_lineNumber(&program, &pc), &pc, value); Program_PCtoError(&program, &pc, value); } if (stack.onerror.line != -1) { stack.resumeable = 1; pc = stack.onerror; } else { Auto_frameToError(&stack, &program, value); break; } } else if (value->type != V_NIL) { break; } Value_destroy(value); } while ((r = Program_skipEOL(&program, &pc, STDCHANNEL, 1))); if (!r) { Value_new_VOID(value); } } else { Value_new_null(value, sym->u.sub.retType); } } Auto_funcReturn(&stack, pass == INTERPRET && value->type != V_ERROR ? &pc : (struct Pc *)0); } return value; } #ifdef CONFIG_INTERPRETER_BAS_USE_LR0 /* Grammar with LR(0) sets */ /* Grammar: * * 1 EV -> E * 2 E -> E op E * 3 E -> op E * 4 E -> ( E ) * 5 E -> value * * i0: * EV -> . E goto(0,E)=5 * E -> . E op E goto(0,E)=5 * E -> . op E +,- shift 2 * E -> . ( E ) ( shift 3 * E -> . value value shift 4 * * i5: * EV -> E . else accept * E -> E . op E op shift 1 * * i2: * E -> op . E goto(2,E)=6 * E -> . E op E goto(2,E)=6 * E -> . op E +,- shift 2 * E -> . ( E ) ( shift 3 * E -> . value value shift 4 * * i3: * E -> ( . E ) goto(3,E)=7 * E -> . E op E goto(3,E)=7 * E -> . op E +,- shift 2 * E -> . ( E ) ( shift 3 * E -> . value value shift 4 * * i4: * E -> value . reduce 5 * * i1: * E -> E op . E goto(1,E)=8 * E -> . E op E goto(1,E)=8 * E -> . op E +,- shift 2 * E -> . ( E ) ( shift 3 * E -> . value value shift 4 * * i6: * E -> op E . reduce 3 * E -> E . op E op* shift 1 *=if stack[-2] contains op of unary lower priority * * i7: * E -> ( E . ) ) shift 9 * E -> E . op E op shift 1 * * i8: * E -> E op E . reduce 2 * E -> E . op E op* shift 1 *=if stack[-2] contains op of lower priority or if * if it is of equal priority and right associative * i9: * E -> ( E ) . reduce 4 */ static struct Value *eval(struct Value *value, const char *desc) { /* Variables */ static const int gotoState[10] = { 5, 8, 6, 7, -1, -1, -1, -1, -1, -1 }; int capacity = 10; struct Pdastack { union { enum TokenType token; struct Value value; } u; char state; }; struct Pdastack *pdastack = malloc(capacity * sizeof(struct Pdastack)); struct Pdastack *sp = pdastack; struct Pdastack *stackEnd = pdastack + capacity - 1; enum TokenType ip; sp->state = 0; while (1) { if (sp == stackEnd) { pdastack = realloc(pdastack, (capacity + 10) * sizeof(struct Pdastack)); sp = pdastack + capacity - 1; capacity += 10; stackEnd = pdastack + capacity - 1; } ip = pc.token->type; switch (sp->state) { case 0: case 1: case 2: case 3: /* including 4 */ { if (ip == T_IDENTIFIER) { /* printf("state %d: shift 4\n",sp->state); */ /* printf("state 4: reduce E -> value\n"); */ ++sp; sp->state = gotoState[(sp - 1)->state]; if (pass == COMPILE) { if (((pc.token + 1)->type == T_OP || Auto_find(&stack, pc.token->u.identifier) == 0) && Global_find(&globals, pc.token->u.identifier, (pc.token + 1)->type == T_OP) == 0) { Value_new_ERROR(value, UNDECLARED); goto error; } } if (pass != DECLARE && (pc.token->u.identifier->sym->type == GLOBALVAR || pc.token->u.identifier->sym->type == GLOBALARRAY || pc.token->u.identifier->sym->type == LOCALVAR)) { struct Value *l; if ((l = lvalue(value))->type == V_ERROR) goto error; Value_clone(&sp->u.value, l); } else { struct Pc var = pc; func(&sp->u.value); if (sp->u.value.type == V_VOID) { pc = var; Value_new_ERROR(value, VOIDVALUE); goto error; } } } else if (ip == T_INTEGER) { /* printf("state %d: shift 4\n",sp->state); */ /* printf("state 4: reduce E -> value\n"); */ ++sp; sp->state = gotoState[(sp - 1)->state]; VALUE_NEW_INTEGER(&sp->u.value, pc.token->u.integer); ++pc.token; } else if (ip == T_REAL) { /* printf("state %d: shift 4\n",sp->state); */ /* printf("state 4: reduce E -> value\n"); */ ++sp; sp->state = gotoState[(sp - 1)->state]; VALUE_NEW_REAL(&sp->u.value, pc.token->u.real); ++pc.token; } else if (TOKEN_ISUNARYOPERATOR(ip)) { /* printf("state %d: shift 2\n",sp->state); */ ++sp; sp->state = 2; sp->u.token = ip; ++pc.token; } else if (ip == T_HEXINTEGER) { /* printf("state %d: shift 4\n",sp->state); */ /* printf("state 4: reduce E -> value\n"); */ ++sp; sp->state = gotoState[(sp - 1)->state]; VALUE_NEW_INTEGER(&sp->u.value, pc.token->u.hexinteger); ++pc.token; } else if (ip == T_OCTINTEGER) { /* printf("state %d: shift 4\n",sp->state); */ /* printf("state 4: reduce E -> value\n"); */ ++sp; sp->state = gotoState[(sp - 1)->state]; VALUE_NEW_INTEGER(&sp->u.value, pc.token->u.octinteger); ++pc.token; } else if (ip == T_OP) { /* printf("state %d: shift 3\n",sp->state); */ ++sp; sp->state = 3; sp->u.token = T_OP; ++pc.token; } else if (ip == T_STRING) { /* printf("state %d: shift 4\n",sp->state); */ /* printf("state 4: reduce E -> value\n"); */ ++sp; sp->state = gotoState[(sp - 1)->state]; Value_new_STRING(&sp->u.value); String_destroy(&sp->u.value.u.string); String_clone(&sp->u.value.u.string, pc.token->u.string); ++pc.token; } else { char state = sp->state; if (state == 0) { if (desc) { Value_new_ERROR(value, MISSINGEXPR, desc); } else { value = (struct Value *)0; } } else { Value_new_ERROR(value, MISSINGEXPR, _("operand")); } goto error; } break; } case 5: { if (TOKEN_ISBINARYOPERATOR(ip)) { /* printf("state %d: shift 1\n",sp->state); */ ++sp; sp->state = 1; sp->u.token = ip; ++pc.token; break; } else { assert(sp == pdastack + 1); *value = sp->u.value; free(pdastack); return value; } break; } case 6: { if (TOKEN_ISBINARYOPERATOR(ip) && TOKEN_UNARYPRIORITY((sp - 1)->u.token) < TOKEN_BINARYPRIORITY(ip)) { assert(TOKEN_ISUNARYOPERATOR((sp - 1)->u.token)); /* printf("state %d: shift 1 (not reducing E -> op E)\n", sp->state); */ ++sp; sp->state = 1; sp->u.token = ip; ++pc.token; } else { enum TokenType op; /* printf("reduce E -> op E\n"); */ --sp; op = sp->u.token; sp->u.value = (sp + 1)->u.value; switch (op) { case T_PLUS: break; case T_MINUS: Value_uneg(&sp->u.value, pass == INTERPRET); break; case T_NOT: Value_unot(&sp->u.value, pass == INTERPRET); break; default: assert(0); } sp->state = gotoState[(sp - 1)->state]; if (sp->u.value.type == V_ERROR) { *value = sp->u.value; --sp; goto error; } } break; } case 7: /* including 9 */ { if (TOKEN_ISBINARYOPERATOR(ip)) { /* printf("state %d: shift 1\n"sp->state); */ ++sp; sp->state = 1; sp->u.token = ip; ++pc.token; } else if (ip == T_CP) { /* printf("state %d: shift 9\n",sp->state); */ /* printf("state 9: reduce E -> ( E )\n"); */ --sp; sp->state = gotoState[(sp - 1)->state]; sp->u.value = (sp + 1)->u.value; ++pc.token; } else { Value_new_ERROR(value, MISSINGCP); goto error; } break; } case 8: { int p1, p2; if (TOKEN_ISBINARYOPERATOR(ip) && (((p1 = TOKEN_BINARYPRIORITY((sp - 1)->u.token)) < (p2 = TOKEN_BINARYPRIORITY (ip))) || (p1 == p2 && TOKEN_ISRIGHTASSOCIATIVE((sp - 1)->u.token)))) { /* printf("state %d: shift 1\n",sp->state); */ ++sp; sp->state = 1; sp->u.token = ip; ++pc.token; } else { /* printf("state %d: reduce E -> E op E\n",sp->state); */ if (Value_commonType[(sp - 2)->u.value.type][sp->u.value.type] == V_ERROR) { Value_destroy(&sp->u.value); sp -= 2; Value_destroy(&sp->u.value); Value_new_ERROR(value, INVALIDOPERAND); --sp; goto error; } else { switch ((sp - 1)->u.token) { case T_LT: Value_lt(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_LE: Value_le(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_EQ: Value_eq(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_GE: Value_ge(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_GT: Value_gt(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_NE: Value_ne(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_PLUS: Value_add(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_MINUS: Value_sub(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_MULT: Value_mult(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_DIV: Value_div(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_IDIV: Value_idiv(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_MOD: Value_mod(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_POW: Value_pow(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_AND: Value_and(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_OR: Value_or(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_XOR: Value_xor(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_EQV: Value_eqv(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; case T_IMP: Value_imp(&(sp - 2)->u.value, &sp->u.value, pass == INTERPRET); break; default: assert(0); } } Value_destroy(&sp->u.value); sp -= 2; sp->state = gotoState[(sp - 1)->state]; if (sp->u.value.type == V_ERROR) { *value = sp->u.value; --sp; goto error; } } break; } } } error: while (sp > pdastack) { switch (sp->state) { case 5: case 6: case 7: case 8: Value_destroy(&sp->u.value); } --sp; } free(pdastack); return value; } #else static inline struct Value *binarydown(struct Value *value, struct Value *(level) (struct Value * value), const int prio) { enum TokenType op; struct Pc oppc; if (level(value) == (struct Value *)0) { return (struct Value *)0; } if (value->type == V_ERROR) { return value; } do { struct Value x; op = pc.token->type; if (!TOKEN_ISBINARYOPERATOR(op) || TOKEN_BINARYPRIORITY(op) != prio) { return value; } oppc = pc; ++pc.token; if (level(&x) == (struct Value *)0) { Value_destroy(value); return Value_new_ERROR(value, MISSINGEXPR, _("binary operand")); } if (x.type == V_ERROR) { Value_destroy(value); *value = x; return value; } if (Value_commonType[value->type][x.type] == V_ERROR) { Value_destroy(value); Value_destroy(&x); return Value_new_ERROR(value, INVALIDOPERAND); } else { switch (op) { case T_LT: Value_lt(value, &x, pass == INTERPRET); break; case T_LE: Value_le(value, &x, pass == INTERPRET); break; case T_EQ: Value_eq(value, &x, pass == INTERPRET); break; case T_GE: Value_ge(value, &x, pass == INTERPRET); break; case T_GT: Value_gt(value, &x, pass == INTERPRET); break; case T_NE: Value_ne(value, &x, pass == INTERPRET); break; case T_PLUS: Value_add(value, &x, pass == INTERPRET); break; case T_MINUS: Value_sub(value, &x, pass == INTERPRET); break; case T_MULT: Value_mult(value, &x, pass == INTERPRET); break; case T_DIV: Value_div(value, &x, pass == INTERPRET); break; case T_IDIV: Value_idiv(value, &x, pass == INTERPRET); break; case T_MOD: Value_mod(value, &x, pass == INTERPRET); break; case T_POW: Value_pow(value, &x, pass == INTERPRET); break; case T_AND: Value_and(value, &x, pass == INTERPRET); break; case T_OR: Value_or(value, &x, pass == INTERPRET); break; case T_XOR: Value_xor(value, &x, pass == INTERPRET); break; case T_EQV: Value_eqv(value, &x, pass == INTERPRET); break; case T_IMP: Value_imp(value, &x, pass == INTERPRET); break; default: assert(0); } } Value_destroy(&x); } while (value->type != V_ERROR); if (value->type == V_ERROR) { pc = oppc; } return value; } static inline struct Value *unarydown(struct Value *value, struct Value *(level) (struct Value * value), const int prio) { enum TokenType op; struct Pc oppc; op = pc.token->type; if (!TOKEN_ISUNARYOPERATOR(op) || TOKEN_UNARYPRIORITY(op) != prio) { return level(value); } oppc = pc; ++pc.token; if (unarydown(value, level, prio) == (struct Value *)0) { return Value_new_ERROR(value, MISSINGEXPR, _("unary operand")); } if (value->type == V_ERROR) { return value; } switch (op) { case T_PLUS: Value_uplus(value, pass == INTERPRET); break; case T_MINUS: Value_uneg(value, pass == INTERPRET); break; case T_NOT: Value_unot(value, pass == INTERPRET); break; default: assert(0); } if (value->type == V_ERROR) { pc = oppc; } return value; } static struct Value *eval8(struct Value *value) { switch (pc.token->type) { case T_IDENTIFIER: { struct Pc var; struct Value *l; var = pc; if (pass == COMPILE) { if (((pc.token + 1)->type == T_OP || Auto_find(&stack, pc.token->u.identifier) == 0) && Global_find(&globals, pc.token->u.identifier, (pc.token + 1)->type == T_OP) == 0) return Value_new_ERROR(value, UNDECLARED); } assert(pass == DECLARE || pc.token->u.identifier->sym); if (pass != DECLARE && (pc.token->u.identifier->sym->type == GLOBALVAR || pc.token->u.identifier->sym->type == GLOBALARRAY || pc.token->u.identifier->sym->type == LOCALVAR)) { if ((l = lvalue(value))->type == V_ERROR) { return value; } Value_clone(value, l); } else { func(value); if (value->type == V_VOID) { Value_destroy(value); pc = var; return Value_new_ERROR(value, VOIDVALUE); } } break; } case T_INTEGER: { VALUE_NEW_INTEGER(value, pc.token->u.integer); ++pc.token; break; } case T_REAL: { VALUE_NEW_REAL(value, pc.token->u.real); ++pc.token; break; } case T_STRING: { Value_new_STRING(value); String_destroy(&value->u.string); String_clone(&value->u.string, pc.token->u.string); ++pc.token; break; } case T_HEXINTEGER: { VALUE_NEW_INTEGER(value, pc.token->u.hexinteger); ++pc.token; break; } case T_OCTINTEGER: { VALUE_NEW_INTEGER(value, pc.token->u.octinteger); ++pc.token; break; } case T_OP: { ++pc.token; if (eval(value, _("parenthetic"))->type == V_ERROR) { return value; } if (pc.token->type != T_CP) { Value_destroy(value); return Value_new_ERROR(value, MISSINGCP); } ++pc.token; break; } default: { return (struct Value *)0; } } return value; } static struct Value *eval7(struct Value *value) { return binarydown(value, eval8, 7); } static struct Value *eval6(struct Value *value) { return unarydown(value, eval7, 6); } static struct Value *eval5(struct Value *value) { return binarydown(value, eval6, 5); } static struct Value *eval4(struct Value *value) { return binarydown(value, eval5, 4); } static struct Value *eval3(struct Value *value) { return binarydown(value, eval4, 3); } static struct Value *eval2(struct Value *value) { return unarydown(value, eval3, 2); } static struct Value *eval1(struct Value *value) { return binarydown(value, eval2, 1); } static struct Value *eval(struct Value *value, const char *desc) { /* Avoid function calls for atomic expression */ switch (pc.token->type) { case T_STRING: case T_REAL: case T_INTEGER: case T_HEXINTEGER: case T_OCTINTEGER: case T_IDENTIFIER: if (!TOKEN_ISBINARYOPERATOR((pc.token + 1)->type) && (pc.token + 1)->type != T_OP) { return eval7(value); } default: break; } if (binarydown(value, eval1, 0) == (struct Value *)0) { if (desc) { return Value_new_ERROR(value, MISSINGEXPR, desc); } else { return (struct Value *)0; } } else { return value; } } #endif static void new(void) { Global_destroy(&globals); Global_new(&globals); Auto_destroy(&stack); Auto_new(&stack); Program_destroy(&program); Program_new(&program); FS_closefiles(); optionbase = 0; } static void pushLabel(enum LabelType type, struct Pc *patch) { if (labelStackPointer == labelStackCapacity) { struct LabelStack *more; more = realloc(labelStack, sizeof(struct LabelStack) * (labelStackCapacity ? (labelStackCapacity *= 2) : (32))); labelStack = more; } labelStack[labelStackPointer].type = type; labelStack[labelStackPointer].patch = *patch; ++labelStackPointer; } static struct Pc *popLabel(enum LabelType type) { if (labelStackPointer == 0 || labelStack[labelStackPointer - 1].type != type) { return (struct Pc *)0; } else { return &labelStack[--labelStackPointer].patch; } } static struct Pc *findLabel(enum LabelType type) { int i; for (i = labelStackPointer - 1; i >= 0; --i) { if (labelStack[i].type == type) { return &labelStack[i].patch; } } return (struct Pc *)0; } static void labelStackError(struct Value *v) { assert(labelStackPointer); pc = labelStack[labelStackPointer - 1].patch; switch (labelStack[labelStackPointer - 1].type) { case L_IF: Value_new_ERROR(v, STRAYIF); break; case L_DO: Value_new_ERROR(v, STRAYDO); break; case L_DOcondition: Value_new_ERROR(v, STRAYDOcondition); break; case L_ELSE: Value_new_ERROR(v, STRAYELSE2); break; case L_FOR_BODY: { Value_new_ERROR(v, STRAYFOR); pc = *findLabel(L_FOR); break; } case L_WHILE: Value_new_ERROR(v, STRAYWHILE); break; case L_REPEAT: Value_new_ERROR(v, STRAYREPEAT); break; case L_SELECTCASE: Value_new_ERROR(v, STRAYSELECTCASE); break; case L_FUNC: Value_new_ERROR(v, STRAYFUNC); break; default: assert(0); } } static const char *topLabelDescription(void) { if (labelStackPointer == 0) { return _("program"); } switch (labelStack[labelStackPointer - 1].type) { case L_IF: return _("`if' branch"); case L_DO: return _("`do' loop"); case L_DOcondition: return _("`do while' or `do until' loop"); case L_ELSE: return _("`else' branch"); case L_FOR_BODY: return _("`for' loop"); case L_WHILE: return _("`while' loop"); case L_REPEAT: return _("`repeat' loop"); case L_SELECTCASE: return _("`select case' control structure"); case L_FUNC: return _("function or procedure"); default: assert(0); } /* NOTREACHED */ return (const char *)0; } static struct Value *assign(struct Value *value) { struct Pc expr; if (strcasecmp(pc.token->u.identifier->name, "mid$") == 0) { long int n, m; struct Value *l; ++pc.token; if (pc.token->type != T_OP) { return Value_new_ERROR(value, MISSINGOP); } ++pc.token; if (pc.token->type != T_IDENTIFIER) { return Value_new_ERROR(value, MISSINGSTRIDENT); } if (pass == DECLARE) { if (((pc.token + 1)->type == T_OP || Auto_find(&stack, pc.token->u.identifier) == 0) && Global_variable(&globals, pc.token->u.identifier, pc.token->u.identifier->defaultType, (pc.token + 1)->type == T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0) { return Value_new_ERROR(value, REDECLARATION); } } if ((l = lvalue(value))->type == V_ERROR) { return value; } if (pass == COMPILE && l->type != V_STRING) { return Value_new_ERROR(value, TYPEMISMATCH4); } if (pc.token->type != T_COMMA) { return Value_new_ERROR(value, MISSINGCOMMA); } ++pc.token; if (eval(value, _("position"))->type == V_ERROR || Value_retype(value, V_INTEGER)->type == V_ERROR) { return value; } n = value->u.integer; Value_destroy(value); if (pass == INTERPRET && n < 1) { return Value_new_ERROR(value, OUTOFRANGE, "position"); } if (pc.token->type == T_COMMA) { ++pc.token; if (eval(value, _("length"))->type == V_ERROR || Value_retype(value, V_INTEGER)->type == V_ERROR) { return value; } m = value->u.integer; if (pass == INTERPRET && m < 0) { return Value_new_ERROR(value, OUTOFRANGE, _("length")); } Value_destroy(value); } else { m = -1; } if (pc.token->type != T_CP) { return Value_new_ERROR(value, MISSINGCP); } ++pc.token; if (pc.token->type != T_EQ) { return Value_new_ERROR(value, MISSINGEQ); } ++pc.token; if (eval(value, _("rhs"))->type == V_ERROR || Value_retype(value, V_STRING)->type == V_ERROR) { return value; } if (pass == INTERPRET) { if (m == -1) { m = value->u.string.length; } String_set(&l->u.string, n - 1, &value->u.string, m); } } else { struct Value **l = (struct Value **)0; int i, used = 0, capacity = 0; struct Value retyped_value; for (;;) { if (used == capacity) { struct Value **more; capacity = capacity ? 2 * capacity : 2; more = realloc(l, capacity * sizeof(*l)); l = more; } if (pass == DECLARE) { if (((pc.token + 1)->type == T_OP || Auto_find(&stack, pc.token->u.identifier) == 0) && Global_variable(&globals, pc.token->u.identifier, pc.token->u.identifier->defaultType, (pc.token + 1)->type == T_OP ? GLOBALARRAY : GLOBALVAR, 0) == 0) { if (capacity) { free(l); } return Value_new_ERROR(value, REDECLARATION); } } if ((l[used] = lvalue(value))->type == V_ERROR) { return value; } ++used; if (pc.token->type == T_COMMA) { ++pc.token; } else { break; } } if (pc.token->type != T_EQ) { return Value_new_ERROR(value, MISSINGEQ); } ++pc.token; expr = pc; if (eval(value, _("rhs"))->type == V_ERROR) { return value; } for (i = 0; i < used; ++i) { Value_clone(&retyped_value, value); if (pass != DECLARE && VALUE_RETYPE(&retyped_value, (l[i])->type)->type == V_ERROR) { pc = expr; free(l); Value_destroy(value); *value = retyped_value; return value; } if (pass == INTERPRET) { Value_destroy(l[i]); *(l[i]) = retyped_value; } } free(l); Value_destroy(value); *value = retyped_value; /* for status only */ } return value; } static struct Value *compileProgram(struct Value *v, int clearGlobals) { struct Pc begin; stack.resumeable = 0; if (clearGlobals) { Global_destroy(&globals); Global_new(&globals); } else { Global_clearFunctions(&globals); } if (Program_beginning(&program, &begin)) { struct Pc savepc; int savepass; savepc = pc; savepass = pass; Program_norun(&program); for (pass = DECLARE; pass != INTERPRET; ++pass) { if (pass == DECLARE) { stack.begindata.line = -1; lastdata = &stack.begindata; } optionbase = 0; stopped = 0; program.runnable = 1; pc = begin; while (1) { statements(v); if (v->type == V_ERROR) { break; } Value_destroy(v); if (!Program_skipEOL(&program, &pc, 0, 0)) { Value_new_NIL(v); break; } } if (v->type != V_ERROR && labelStackPointer > 0) { Value_destroy(v); labelStackError(v); } if (v->type == V_ERROR) { labelStackPointer = 0; Program_norun(&program); if (stack.cur) { Auto_funcEnd(&stack); /* Always correct? */ } pass = savepass; return v; } } pc = begin; if (Program_analyse(&program, &pc, v)) { labelStackPointer = 0; Program_norun(&program); if (stack.cur) { Auto_funcEnd(&stack); /* Always correct? */ } pass = savepass; return v; } curdata = stack.begindata; pc = savepc; pass = savepass; } return Value_new_NIL(v); } static void runline(struct Token *line) { struct Value value; FS_flush(STDCHANNEL); for (pass = DECLARE; pass != INTERPRET; ++pass) { curdata.line = -1; pc.line = -1; pc.token = line; optionbase = 0; stopped = 0; statements(&value); if (value.type != V_ERROR && pc.token->type != T_EOL) { Value_destroy(&value); Value_new_ERROR(&value, SYNTAX); } if (value.type != V_ERROR && labelStackPointer > 0) { Value_destroy(&value); labelStackError(&value); } if (value.type == V_ERROR) { struct String s; Auto_setError(&stack, Program_lineNumber(&program, &pc), &pc, &value); Program_PCtoError(&program, &pc, &value); labelStackPointer = 0; FS_putChars(STDCHANNEL, _("Error: ")); String_new(&s); Value_toString(&value, &s, ' ', -1, 0, 0, 0, 0, -1, 0, 0); Value_destroy(&value); FS_putString(STDCHANNEL, &s); String_destroy(&s); return; } if (!program.runnable && pass == COMPILE) { Value_destroy(&value); (void)compileProgram(&value, 0); } } pc.line = -1; pc.token = line; optionbase = 0; curdata = stack.begindata; nextdata.line = -1; Value_destroy(&value); pass = INTERPRET; do { assert(pass == INTERPRET); statements(&value); assert(pass == INTERPRET); if (value.type == V_ERROR) { if (strchr(value.u.error.msg, '\n') == (char *)0) { Auto_setError(&stack, Program_lineNumber(&program, &pc), &pc, &value); Program_PCtoError(&program, &pc, &value); } if (stack.onerror.line != -1) { stack.resumeable = 1; pc = stack.onerror; } else { struct String s; String_new(&s); if (!stopped) { stopped = 0; FS_putChars(STDCHANNEL, _("Error: ")); } Auto_frameToError(&stack, &program, &value); Value_toString(&value, &s, ' ', -1, 0, 0, 0, 0, -1, 0, 0); while (Auto_gosubReturn(&stack, (struct Pc *)0)); FS_putString(STDCHANNEL, &s); String_destroy(&s); Value_destroy(&value); break; } } Value_destroy(&value); } while (pc.token->type != T_EOL || Program_skipEOL(&program, &pc, STDCHANNEL, 1)); } static struct Value *evalGeometry(struct Value *value, unsigned int *dim, unsigned int geometry[]) { struct Pc exprpc = pc; if (eval(value, _("dimension"))->type == V_ERROR || (pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR)) { return value; } if (pass == INTERPRET && value->u.integer < optionbase) { Value_destroy(value); pc = exprpc; return Value_new_ERROR(value, OUTOFRANGE, _("dimension")); } geometry[0] = value->u.integer - optionbase + 1; Value_destroy(value); if (pc.token->type == T_COMMA) { ++pc.token; exprpc = pc; if (eval(value, _("dimension"))->type == V_ERROR || (pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR)) { return value; } if (pass == INTERPRET && value->u.integer < optionbase) { Value_destroy(value); pc = exprpc; return Value_new_ERROR(value, OUTOFRANGE, _("dimension")); } geometry[1] = value->u.integer - optionbase + 1; Value_destroy(value); *dim = 2; } else { *dim = 1; } if (pc.token->type == T_CP) { ++pc.token; } else { return Value_new_ERROR(value, MISSINGCP); } return (struct Value *)0; } static struct Value *convert(struct Value *value, struct Value *l, struct Token *t) { switch (l->type) { case V_INTEGER: { char *datainput; char *end; long int v; int overflow; if (t->type != T_DATAINPUT) { return Value_new_ERROR(value, BADCONVERSION, _("integer")); } datainput = t->u.datainput; v = Value_vali(datainput, &end, &overflow); if (end == datainput || (*end != '\0' && *end != ' ' && *end != '\t')) { return Value_new_ERROR(value, BADCONVERSION, _("integer")); } if (overflow) { return Value_new_ERROR(value, OUTOFRANGE, _("converted value")); } Value_destroy(l); VALUE_NEW_INTEGER(l, v); break; } case V_REAL: { char *datainput; char *end; double v; int overflow; if (t->type != T_DATAINPUT) { return Value_new_ERROR(value, BADCONVERSION, _("real")); } datainput = t->u.datainput; v = Value_vald(datainput, &end, &overflow); if (end == datainput || (*end != '\0' && *end != ' ' && *end != '\t')) { return Value_new_ERROR(value, BADCONVERSION, _("real")); } if (overflow) { return Value_new_ERROR(value, OUTOFRANGE, _("converted value")); } Value_destroy(l); VALUE_NEW_REAL(l, v); break; } case V_STRING: { Value_destroy(l); Value_new_STRING(l); if (t->type == T_STRING) { String_appendString(&l->u.string, t->u.string); } else { String_appendChars(&l->u.string, t->u.datainput); } break; } default: assert(0); } return (struct Value *)0; } static struct Value *dataread(struct Value *value, struct Value *l) { if (curdata.line == -1) { return Value_new_ERROR(value, ENDOFDATA); } if (curdata.token->type == T_DATA) { nextdata = curdata.token->u.nextdata; ++curdata.token; } if (convert(value, l, curdata.token)) { return value; } ++curdata.token; if (curdata.token->type == T_COMMA) { ++curdata.token; } else { curdata = nextdata; } return (struct Value *)0; } static struct Value more_statements; #include "statement.c" static struct Value *statements(struct Value *value) { more: if (pc.token->statement) { struct Value *v; if ((v = pc.token->statement(value))) { if (v == &more_statements) { goto more; } else { return value; } } } else { return Value_new_ERROR(value, MISSINGSTATEMENT); } if (pc.token->type == T_COLON && (pc.token + 1)->type == T_ELSE) { ++pc.token; } else if ((pc.token->type == T_COLON && (pc.token + 1)->type != T_ELSE) || pc.token->type == T_QUOTE) { ++pc.token; goto more; } else if ((pass == DECLARE || pass == COMPILE) && pc.token->type != T_EOL && pc.token->type != T_ELSE) { return Value_new_ERROR(value, MISSINGCOLON); } return Value_new_NIL(value); } /**************************************************************************** * Public Functions ****************************************************************************/ void bas_init(int backslash_colon, int restricted, int uppercase, int lpfd) { stack.begindata.line = -1; Token_init(backslash_colon, uppercase); Global_new(&globals); Auto_new(&stack); Program_new(&program); FS_opendev(STDCHANNEL, 0, 1); FS_opendev(LPCHANNEL, -1, lpfd); run_restricted = restricted; } void bas_runFile(const char *runFile) { struct Value value; int dev; new(); if ((dev = FS_openin(runFile)) == -1) { const char *errmsg = FS_errmsg; FS_putChars(0, _("bas: Executing `")); FS_putChars(0, runFile); FS_putChars(0, _("' failed (")); FS_putChars(0, errmsg); FS_putChars(0, _(").\n")); } else if (Program_merge(&program, dev, &value)) { struct String s; FS_putChars(0, "bas: "); String_new(&s); Value_toString(&value, &s, ' ', -1, 0, 0, 0, 0, -1, 0, 0); FS_putString(0, &s); String_destroy(&s); FS_putChar(0, '\n'); Value_destroy(&value); } else { struct Token line[2]; Program_setname(&program, runFile); line[0].type = T_RUN; line[0].statement = stmt_RUN; line[1].type = T_EOL; line[1].statement = stmt_COLON_EOL; FS_close(dev); runline(line); } } void bas_runLine(const char *runLine) { struct Token *line; line = Token_newCode(runLine); runline(line + 1); Token_destroy(line); } void bas_interpreter(void) { if (FS_istty(STDCHANNEL)) { FS_putChars(STDCHANNEL, "bas " CONFIG_INTERPRETER_BAS_VERSION "\n"); FS_putChars(STDCHANNEL, "Copyright 1999-2014 Michael Haardt.\n"); FS_putChars(STDCHANNEL, "This is free software with ABSOLUTELY NO WARRANTY.\n"); } new(); while (1) { struct Token *line; struct String s; stopped = 0; FS_nextline(STDCHANNEL); if (FS_istty(STDCHANNEL)) { FS_putChars(STDCHANNEL, "> "); } FS_flush(STDCHANNEL); String_new(&s); if (FS_appendToString(STDCHANNEL, &s, 1) == -1) { FS_putChars(STDCHANNEL, FS_errmsg); FS_flush(STDCHANNEL); String_destroy(&s); break; } if (s.length == 0) { String_destroy(&s); break; } line = Token_newCode(s.character); String_destroy(&s); if (line->type != T_EOL) { if (line->type == T_INTEGER && line->u.integer > 0) { if (program.numbered) { if ((line + 1)->type == T_EOL) { struct Pc where; if (Program_goLine(&program, line->u.integer, &where) == (struct Pc *)0) { FS_putChars(STDCHANNEL, (NOSUCHLINE)); } else { Program_delete(&program, &where, &where); } Token_destroy(line); } else { Program_store(&program, line, line->u.integer); } } else { FS_putChars(STDCHANNEL, _("Use `renum' to number program first")); Token_destroy(line); } } else if (line->type == T_UNNUMBERED) { runline(line + 1); Token_destroy(line); if (FS_istty(STDCHANNEL) && bas_end > 0) { FS_putChars(STDCHANNEL, _("END program\n")); bas_end = 0; } } else { FS_putChars(STDCHANNEL, _("Invalid line\n")); Token_destroy(line); } } else { Token_destroy(line); } } } void bas_exit(void) { Auto_destroy(&stack); Global_destroy(&globals); Program_destroy(&program); if (labelStack) { free(labelStack); } FS_closefiles(); FS_close(LPCHANNEL); FS_close(STDCHANNEL); }