nuttx-apps/interpreters/bas/bas.c
Xiang Xiao 857158451b Unify the void cast usage
1.Remove void cast for function because many place ignore the returned value witout cast
2.Replace void cast for variable with UNUSED macro

Change-Id: Ie644129a563244a6397036789c4c3ea83c4e9b09
Signed-off-by: Xiang Xiao <xiaoxiang@xiaomi.com>
2020-01-02 23:21:01 +08:00

2490 lines
63 KiB
C

/****************************************************************************
* 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 <Alan Carvalho de Assis>
* Gregory Nutt <gnutt@nuttx.org>
*
* 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 <nuttx/config.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <sys/wait.h>
#include <stdbool.h>
#include <stdlib.h>
#include <stdio.h>
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <fcntl.h>
#include <limits.h>
#include <math.h>
#include <strings.h>
#include <time.h>
#include <unistd.h>
#include "bas_auto.h"
#include "bas.h"
#include "bas_error.h"
#include "bas_fs.h"
#include "bas_global.h"
#include "bas_program.h"
#include "bas_value.h"
#include "bas_var.h"
/****************************************************************************
* Pre-processor Definitions
****************************************************************************/
#define DIRECTMODE (g_pc.line== -1)
#define _(String) String
/****************************************************************************
* Private Types
****************************************************************************/
enum labeltype_e
{
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_s
{
enum labeltype_e type;
struct Pc patch;
};
/****************************************************************************
* Private Data
****************************************************************************/
static unsigned int g_labelstack_index;
static unsigned int g_labelstack_capacity;
static struct labelstack_s *g_labelstack;
static struct Pc *g_lastdata;
static struct Pc g_curdata;
static struct Pc g_nextdata;
static enum
{
DECLARE,
COMPILE,
INTERPRET
} g_pass;
static int g_stopped;
static int g_optionbase;
static struct Pc g_pc;
static struct Auto g_stack;
static struct Program g_program;
static struct Global g_globals;
static int g_run_restricted;
/****************************************************************************
* Public Data
****************************************************************************/
int g_bas_argc;
char *g_bas_argv0;
char **g_bas_argv;
bool g_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 errcode;
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)
{
errcode = errno;
close(fd);
errno = errcode;
return -1;
}
off += w;
}
}
if (l == -1)
{
errcode = errno;
close(fd);
errno = errcode;
return -1;
}
close(fd);
return 0;
}
static struct Value *lvalue(struct Value *value)
{
struct Symbol *sym;
struct Pc lvpc = g_pc;
sym = g_pc.token->u.identifier->sym;
assert(g_pass == DECLARE || sym->type == GLOBALVAR || sym->type == GLOBALARRAY
|| sym->type == LOCALVAR);
if ((g_pc.token + 1)->type == T_OP)
{
struct Pc idxpc;
unsigned int dim, capacity;
int *idx;
g_pc.token += 2;
dim = 0;
capacity = 0;
idx = (int *)0;
while (1)
{
if (dim == capacity && g_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 = g_pc;
if (eval(value, _("index"))->type == V_ERROR ||
VALUE_RETYPE(value, V_INTEGER)->type == V_ERROR)
{
if (capacity)
{
free(idx);
}
g_pc = idxpc;
return value;
}
if (g_pass == INTERPRET)
{
idx[dim] = value->u.integer;
++dim;
}
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
if (g_pc.token->type != T_CP)
{
assert(g_pass != INTERPRET);
return Value_new_ERROR(value, MISSINGCP);
}
else
{
++g_pc.token;
}
switch (g_pass)
{
case INTERPRET:
{
if ((value =
Var_value(&(sym->u.var), dim, idx, value))->type == V_ERROR)
{
g_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(&g_stack, sym));
}
default:
assert(0);
}
return (struct Value *)0;
}
else
{
++g_pc.token;
switch (g_pass)
{
case INTERPRET:
return VAR_SCALAR_VALUE(sym->type ==
GLOBALVAR ? &(sym->u.var) : Auto_local(&g_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(&g_stack, sym));
default:
assert(0);
}
return (struct Value *)0;
}
}
static struct Value *func(struct Value *value)
{
struct Identifier *ident;
struct Pc funcpc = g_pc;
int firstslot = -99;
int args = 0;
struct Symbol *sym;
assert(g_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 && !g_program.runnable && g_pass != DECLARE)
{
if (compileProgram(value, 0)->type == V_ERROR)
{
return value;
}
Value_destroy(value);
}
ident = g_pc.token->u.identifier;
assert(g_pass == DECLARE || ident->sym->type == BUILTINFUNCTION ||
ident->sym->type == USERFUNCTION);
++g_pc.token;
if (g_pass != DECLARE)
{
firstslot = g_stack.stackPointer;
if (ident->sym->type == USERFUNCTION &&
ident->sym->u.sub.retType != V_VOID)
{
struct Var *v = Auto_pushArg(&g_stack);
Var_new(v, ident->sym->u.sub.retType, 0, (const unsigned int *)0, 0);
}
}
if (g_pc.token->type == T_OP) /* push arguments to stack */
{
++g_pc.token;
if (g_pc.token->type != T_CP)
{
while (1)
{
if (g_pass == DECLARE)
{
if (eval(value, _("actual parameter"))->type == V_ERROR)
{
return value;
}
Value_destroy(value);
}
else
{
struct Var *v = Auto_pushArg(&g_stack);
Var_new_scalar(v);
if (eval(v->value, (const char *)0)->type == V_ERROR)
{
Value_clone(value, v->value);
while (g_stack.stackPointer > firstslot)
{
Var_destroy(&g_stack.slot[--g_stack.stackPointer].var);
}
return value;
}
v->type = v->value->type;
}
++args;
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
if (g_pc.token->type != T_CP)
{
if (g_pass != DECLARE)
{
while (g_stack.stackPointer > firstslot)
{
Var_destroy(&g_stack.slot[--g_stack.stackPointer].var);
}
}
return Value_new_ERROR(value, MISSINGCP);
}
++g_pc.token;
}
}
if (g_pass == DECLARE)
{
Value_new_null(value, ident->defaultType);
}
else
{
int i;
int nomore;
int argerr;
int overloaded;
if (g_pass == INTERPRET && ident->sym->type == USERFUNCTION)
{
for (i = 0; i < ident->sym->u.sub.u.def.localLength; ++i)
{
struct Var *v = Auto_pushArg(&g_stack);
Var_new(v, ident->sym->u.sub.u.def.localTypes[i], 0,
(const unsigned int *)0, 0);
}
}
Auto_pushFuncRet(&g_stack, firstslot, &g_pc);
sym = ident->sym;
overloaded = (g_pass == COMPILE && sym->type == BUILTINFUNCTION &&
sym->u.sub.u.bltin.next);
do
{
nomore = (g_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(&g_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(&g_stack, (struct Pc *)0);
g_pc = funcpc;
return value;
}
else
{
sym = sym->u.sub.u.bltin.next;
}
}
}
while (argerr);
ident->sym = sym;
if (sym->type == BUILTINFUNCTION)
{
if (g_pass == INTERPRET)
{
if (sym->u.sub.u.bltin.call(value, &g_stack)->type == V_ERROR)
{
g_pc = funcpc;
}
}
else
{
Value_new_null(value, sym->u.sub.retType);
}
}
else if (sym->type == USERFUNCTION)
{
if (g_pass == INTERPRET)
{
int r = 1;
g_pc = sym->u.sub.u.def.scope.start;
if (g_pc.token->type == T_COLON)
{
++g_pc.token;
}
else
{
Program_skipEOL(&g_program, &g_pc, STDCHANNEL, 1);
}
do
{
if (statements(value)->type == V_ERROR)
{
if (strchr(value->u.error.msg, '\n') == (char *)0)
{
Auto_setError(&g_stack,
Program_lineNumber(&g_program, &g_pc), &g_pc,
value);
Program_PCtoError(&g_program, &g_pc, value);
}
if (g_stack.onerror.line != -1)
{
g_stack.resumeable = 1;
g_pc = g_stack.onerror;
}
else
{
Auto_frameToError(&g_stack, &g_program, value);
break;
}
}
else if (value->type != V_NIL)
{
break;
}
Value_destroy(value);
}
while ((r = Program_skipEOL(&g_program, &g_pc, STDCHANNEL, 1)));
if (!r)
{
Value_new_VOID(value);
}
}
else
{
Value_new_null(value, sym->u.sub.retType);
}
}
Auto_funcReturn(&g_stack, g_pass == INTERPRET &&
value->type != V_ERROR ? &g_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 = g_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 (g_pass == COMPILE)
{
if (((g_pc.token + 1)->type == T_OP ||
Auto_find(&g_stack, g_pc.token->u.identifier) == 0) &&
Global_find(&g_globals, g_pc.token->u.identifier,
(g_pc.token + 1)->type == T_OP) == 0)
{
Value_new_ERROR(value, UNDECLARED);
goto error;
}
}
if (g_pass != DECLARE &&
(g_pc.token->u.identifier->sym->type == GLOBALVAR ||
g_pc.token->u.identifier->sym->type == GLOBALARRAY ||
g_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 = g_pc;
func(&sp->u.value);
if (sp->u.value.type == V_VOID)
{
g_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, g_pc.token->u.integer);
++g_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, g_pc.token->u.real);
++g_pc.token;
}
else if (TOKEN_ISUNARYOPERATOR(ip))
{
/* printf("state %d: shift 2\n",sp->state); */
++sp;
sp->state = 2;
sp->u.token = ip;
++g_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, g_pc.token->u.hexinteger);
++g_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, g_pc.token->u.octinteger);
++g_pc.token;
}
else if (ip == T_OP)
{
/* printf("state %d: shift 3\n",sp->state); */
++sp;
sp->state = 3;
sp->u.token = T_OP;
++g_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, g_pc.token->u.string);
++g_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;
++g_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;
++g_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, g_pass == INTERPRET);
break;
case T_NOT:
Value_unot(&sp->u.value, g_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;
++g_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;
++g_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;
++g_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,
g_pass == INTERPRET);
break;
case T_LE:
Value_le(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_EQ:
Value_eq(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_GE:
Value_ge(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_GT:
Value_gt(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_NE:
Value_ne(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_PLUS:
Value_add(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_MINUS:
Value_sub(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_MULT:
Value_mult(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_DIV:
Value_div(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_IDIV:
Value_idiv(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_MOD:
Value_mod(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_POW:
Value_pow(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_AND:
Value_and(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_OR:
Value_or(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_XOR:
Value_xor(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_EQV:
Value_eqv(&(sp - 2)->u.value, &sp->u.value,
g_pass == INTERPRET);
break;
case T_IMP:
Value_imp(&(sp - 2)->u.value, &sp->u.value,
g_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 = g_pc.token->type;
if (!TOKEN_ISBINARYOPERATOR(op) || TOKEN_BINARYPRIORITY(op) != prio)
{
return value;
}
oppc = g_pc;
++g_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, g_pass == INTERPRET);
break;
case T_LE:
Value_le(value, &x, g_pass == INTERPRET);
break;
case T_EQ:
Value_eq(value, &x, g_pass == INTERPRET);
break;
case T_GE:
Value_ge(value, &x, g_pass == INTERPRET);
break;
case T_GT:
Value_gt(value, &x, g_pass == INTERPRET);
break;
case T_NE:
Value_ne(value, &x, g_pass == INTERPRET);
break;
case T_PLUS:
Value_add(value, &x, g_pass == INTERPRET);
break;
case T_MINUS:
Value_sub(value, &x, g_pass == INTERPRET);
break;
case T_MULT:
Value_mult(value, &x, g_pass == INTERPRET);
break;
case T_DIV:
Value_div(value, &x, g_pass == INTERPRET);
break;
case T_IDIV:
Value_idiv(value, &x, g_pass == INTERPRET);
break;
case T_MOD:
Value_mod(value, &x, g_pass == INTERPRET);
break;
case T_POW:
Value_pow(value, &x, g_pass == INTERPRET);
break;
case T_AND:
Value_and(value, &x, g_pass == INTERPRET);
break;
case T_OR:
Value_or(value, &x, g_pass == INTERPRET);
break;
case T_XOR:
Value_xor(value, &x, g_pass == INTERPRET);
break;
case T_EQV:
Value_eqv(value, &x, g_pass == INTERPRET);
break;
case T_IMP:
Value_imp(value, &x, g_pass == INTERPRET);
break;
default:
assert(0);
}
}
Value_destroy(&x);
}
while (value->type != V_ERROR);
if (value->type == V_ERROR)
{
g_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 = g_pc.token->type;
if (!TOKEN_ISUNARYOPERATOR(op) || TOKEN_UNARYPRIORITY(op) != prio)
{
return level(value);
}
oppc = g_pc;
++g_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, g_pass == INTERPRET);
break;
case T_MINUS:
Value_uneg(value, g_pass == INTERPRET);
break;
case T_NOT:
Value_unot(value, g_pass == INTERPRET);
break;
default:
assert(0);
}
if (value->type == V_ERROR)
{
g_pc = oppc;
}
return value;
}
static struct Value *eval8(struct Value *value)
{
switch (g_pc.token->type)
{
case T_IDENTIFIER:
{
struct Pc var;
struct Value *l;
var = g_pc;
if (g_pass == COMPILE)
{
if (((g_pc.token + 1)->type == T_OP ||
Auto_find(&g_stack, g_pc.token->u.identifier) == 0) &&
Global_find(&g_globals, g_pc.token->u.identifier,
(g_pc.token + 1)->type == T_OP) == 0)
return Value_new_ERROR(value, UNDECLARED);
}
assert(g_pass == DECLARE || g_pc.token->u.identifier->sym);
if (g_pass != DECLARE &&
(g_pc.token->u.identifier->sym->type == GLOBALVAR ||
g_pc.token->u.identifier->sym->type == GLOBALARRAY ||
g_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);
g_pc = var;
return Value_new_ERROR(value, VOIDVALUE);
}
}
break;
}
case T_INTEGER:
{
VALUE_NEW_INTEGER(value, g_pc.token->u.integer);
++g_pc.token;
break;
}
case T_REAL:
{
VALUE_NEW_REAL(value, g_pc.token->u.real);
++g_pc.token;
break;
}
case T_STRING:
{
Value_new_STRING(value);
String_destroy(&value->u.string);
String_clone(&value->u.string, g_pc.token->u.string);
++g_pc.token;
break;
}
case T_HEXINTEGER:
{
VALUE_NEW_INTEGER(value, g_pc.token->u.hexinteger);
++g_pc.token;
break;
}
case T_OCTINTEGER:
{
VALUE_NEW_INTEGER(value, g_pc.token->u.octinteger);
++g_pc.token;
break;
}
case T_OP:
{
++g_pc.token;
if (eval(value, _("parenthetic"))->type == V_ERROR)
{
return value;
}
if (g_pc.token->type != T_CP)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGCP);
}
++g_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 (g_pc.token->type)
{
case T_STRING:
case T_REAL:
case T_INTEGER:
case T_HEXINTEGER:
case T_OCTINTEGER:
case T_IDENTIFIER:
if (!TOKEN_ISBINARYOPERATOR((g_pc.token + 1)->type) &&
(g_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(&g_globals);
Global_new(&g_globals);
Auto_destroy(&g_stack);
Auto_new(&g_stack);
Program_destroy(&g_program);
Program_new(&g_program);
FS_closefiles();
g_optionbase = 0;
}
static void pushLabel(enum labeltype_e type, struct Pc *patch)
{
if (g_labelstack_index == g_labelstack_capacity)
{
struct labelstack_s *more;
more =
realloc(g_labelstack,
sizeof(struct labelstack_s) *
(g_labelstack_capacity ? (g_labelstack_capacity *= 2) : (32)));
g_labelstack = more;
}
g_labelstack[g_labelstack_index].type = type;
g_labelstack[g_labelstack_index].patch = *patch;
++g_labelstack_index;
}
static struct Pc *popLabel(enum labeltype_e type)
{
if (g_labelstack_index == 0 || g_labelstack[g_labelstack_index - 1].type != type)
{
return (struct Pc *)0;
}
else
{
return &g_labelstack[--g_labelstack_index].patch;
}
}
static struct Pc *findLabel(enum labeltype_e type)
{
int i;
for (i = g_labelstack_index - 1; i >= 0; --i)
{
if (g_labelstack[i].type == type)
{
return &g_labelstack[i].patch;
}
}
return (struct Pc *)0;
}
static void labelStackError(struct Value *v)
{
assert(g_labelstack_index);
g_pc = g_labelstack[g_labelstack_index - 1].patch;
switch (g_labelstack[g_labelstack_index - 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);
g_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 (g_labelstack_index == 0)
{
return _("program");
}
switch (g_labelstack[g_labelstack_index - 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(g_pc.token->u.identifier->name, "mid$") == 0)
{
long int n, m;
struct Value *l;
++g_pc.token;
if (g_pc.token->type != T_OP)
{
return Value_new_ERROR(value, MISSINGOP);
}
++g_pc.token;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGSTRIDENT);
}
if (g_pass == DECLARE)
{
if (((g_pc.token + 1)->type == T_OP ||
Auto_find(&g_stack, g_pc.token->u.identifier) == 0) &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType,
(g_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 (g_pass == COMPILE && l->type != V_STRING)
{
return Value_new_ERROR(value, TYPEMISMATCH4);
}
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
++g_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 (g_pass == INTERPRET && n < 1)
{
return Value_new_ERROR(value, OUTOFRANGE, "position");
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (eval(value, _("length"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
m = value->u.integer;
if (g_pass == INTERPRET && m < 0)
{
return Value_new_ERROR(value, OUTOFRANGE, _("length"));
}
Value_destroy(value);
}
else
{
m = -1;
}
if (g_pc.token->type != T_CP)
{
return Value_new_ERROR(value, MISSINGCP);
}
++g_pc.token;
if (g_pc.token->type != T_EQ)
{
return Value_new_ERROR(value, MISSINGEQ);
}
++g_pc.token;
if (eval(value, _("rhs"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
return value;
}
if (g_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 (g_pass == DECLARE)
{
if (((g_pc.token + 1)->type == T_OP ||
Auto_find(&g_stack, g_pc.token->u.identifier) == 0) &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType,
(g_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 (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
if (g_pc.token->type != T_EQ)
{
return Value_new_ERROR(value, MISSINGEQ);
}
++g_pc.token;
expr = g_pc;
if (eval(value, _("rhs"))->type == V_ERROR)
{
return value;
}
for (i = 0; i < used; ++i)
{
Value_clone(&retyped_value, value);
if (g_pass != DECLARE &&
VALUE_RETYPE(&retyped_value, (l[i])->type)->type == V_ERROR)
{
g_pc = expr;
free(l);
Value_destroy(value);
*value = retyped_value;
return value;
}
if (g_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;
g_stack.resumeable = 0;
if (clearGlobals)
{
Global_destroy(&g_globals);
Global_new(&g_globals);
}
else
{
Global_clearFunctions(&g_globals);
}
if (Program_beginning(&g_program, &begin))
{
struct Pc savepc;
int savepass;
savepc = g_pc;
savepass = g_pass;
Program_norun(&g_program);
for (g_pass = DECLARE; g_pass != INTERPRET; ++g_pass)
{
if (g_pass == DECLARE)
{
g_stack.begindata.line = -1;
g_lastdata = &g_stack.begindata;
}
g_optionbase = 0;
g_stopped = 0;
g_program.runnable = 1;
g_pc = begin;
while (1)
{
statements(v);
if (v->type == V_ERROR)
{
break;
}
Value_destroy(v);
if (!Program_skipEOL(&g_program, &g_pc, 0, 0))
{
Value_new_NIL(v);
break;
}
}
if (v->type != V_ERROR && g_labelstack_index > 0)
{
Value_destroy(v);
labelStackError(v);
}
if (v->type == V_ERROR)
{
g_labelstack_index = 0;
Program_norun(&g_program);
if (g_stack.cur)
{
Auto_funcEnd(&g_stack); /* Always correct? */
}
g_pass = savepass;
return v;
}
}
g_pc = begin;
if (Program_analyse(&g_program, &g_pc, v))
{
g_labelstack_index = 0;
Program_norun(&g_program);
if (g_stack.cur)
{
Auto_funcEnd(&g_stack); /* Always correct? */
}
g_pass = savepass;
return v;
}
g_curdata = g_stack.begindata;
g_pc = savepc;
g_pass = savepass;
}
return Value_new_NIL(v);
}
static void runline(struct Token *line)
{
struct Value value;
FS_flush(STDCHANNEL);
for (g_pass = DECLARE; g_pass != INTERPRET; ++g_pass)
{
g_curdata.line = -1;
g_pc.line = -1;
g_pc.token = line;
g_optionbase = 0;
g_stopped = 0;
statements(&value);
if (value.type != V_ERROR && g_pc.token->type != T_EOL)
{
Value_destroy(&value);
Value_new_ERROR(&value, SYNTAX);
}
if (value.type != V_ERROR && g_labelstack_index > 0)
{
Value_destroy(&value);
labelStackError(&value);
}
if (value.type == V_ERROR)
{
struct String s;
Auto_setError(&g_stack, Program_lineNumber(&g_program, &g_pc), &g_pc, &value);
Program_PCtoError(&g_program, &g_pc, &value);
g_labelstack_index = 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 (!g_program.runnable && g_pass == COMPILE)
{
Value_destroy(&value);
compileProgram(&value, 0);
}
}
g_pc.line = -1;
g_pc.token = line;
g_optionbase = 0;
g_curdata = g_stack.begindata;
g_nextdata.line = -1;
Value_destroy(&value);
g_pass = INTERPRET;
do
{
assert(g_pass == INTERPRET);
statements(&value);
assert(g_pass == INTERPRET);
if (value.type == V_ERROR)
{
if (strchr(value.u.error.msg, '\n') == (char *)0)
{
Auto_setError(&g_stack, Program_lineNumber(&g_program, &g_pc), &g_pc,
&value);
Program_PCtoError(&g_program, &g_pc, &value);
}
if (g_stack.onerror.line != -1)
{
g_stack.resumeable = 1;
g_pc = g_stack.onerror;
}
else
{
struct String s;
String_new(&s);
if (!g_stopped)
{
g_stopped = 0;
FS_putChars(STDCHANNEL, _("Error: "));
}
Auto_frameToError(&g_stack, &g_program, &value);
Value_toString(&value, &s, ' ', -1, 0, 0, 0, 0, -1, 0, 0);
while (Auto_gosubReturn(&g_stack, (struct Pc *)0));
FS_putString(STDCHANNEL, &s);
String_destroy(&s);
Value_destroy(&value);
break;
}
}
Value_destroy(&value);
}
while (g_pc.token->type != T_EOL ||
Program_skipEOL(&g_program, &g_pc, STDCHANNEL, 1));
}
static struct Value *evalGeometry(struct Value *value, unsigned int *dim,
unsigned int geometry[])
{
struct Pc exprpc = g_pc;
if (eval(value, _("dimension"))->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR))
{
return value;
}
if (g_pass == INTERPRET && value->u.integer < g_optionbase)
{
Value_destroy(value);
g_pc = exprpc;
return Value_new_ERROR(value, OUTOFRANGE, _("dimension"));
}
geometry[0] = value->u.integer - g_optionbase + 1;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
exprpc = g_pc;
if (eval(value, _("dimension"))->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR))
{
return value;
}
if (g_pass == INTERPRET && value->u.integer < g_optionbase)
{
Value_destroy(value);
g_pc = exprpc;
return Value_new_ERROR(value, OUTOFRANGE, _("dimension"));
}
geometry[1] = value->u.integer - g_optionbase + 1;
Value_destroy(value);
*dim = 2;
}
else
{
*dim = 1;
}
if (g_pc.token->type == T_CP)
{
++g_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 (g_curdata.line == -1)
{
return Value_new_ERROR(value, ENDOFDATA);
}
if (g_curdata.token->type == T_DATA)
{
g_nextdata = g_curdata.token->u.nextdata;
++g_curdata.token;
}
if (convert(value, l, g_curdata.token))
{
return value;
}
++g_curdata.token;
if (g_curdata.token->type == T_COMMA)
{
++g_curdata.token;
}
else
{
g_curdata = g_nextdata;
}
return (struct Value *)0;
}
static struct Value more_statements;
#include "bas_statement.c"
static struct Value *statements(struct Value *value)
{
more:
if (g_pc.token->statement)
{
struct Value *v;
if ((v = g_pc.token->statement(value)))
{
if (v == &more_statements)
{
goto more;
}
else
{
return value;
}
}
}
else
{
return Value_new_ERROR(value, MISSINGSTATEMENT);
}
if (g_pc.token->type == T_COLON && (g_pc.token + 1)->type == T_ELSE)
{
++g_pc.token;
}
else if ((g_pc.token->type == T_COLON && (g_pc.token + 1)->type != T_ELSE) ||
g_pc.token->type == T_QUOTE)
{
++g_pc.token;
goto more;
}
else if ((g_pass == DECLARE || g_pass == COMPILE) && g_pc.token->type != T_EOL &&
g_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)
{
g_stack.begindata.line = -1;
Token_init(backslash_colon, uppercase);
Global_new(&g_globals);
Auto_new(&g_stack);
Program_new(&g_program);
FS_opendev(STDCHANNEL, 0, 1);
FS_opendev(LPCHANNEL, -1, lpfd);
g_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(&g_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(&g_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;
g_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 (g_program.numbered)
{
if ((line + 1)->type == T_EOL)
{
struct Pc where;
if (Program_goLine(&g_program, line->u.integer, &where) ==
(struct Pc *)0)
{
FS_putChars(STDCHANNEL, (NOSUCHLINE));
}
else
{
Program_delete(&g_program, &where, &where);
}
Token_destroy(line);
}
else
{
Program_store(&g_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) && g_bas_end)
{
FS_putChars(STDCHANNEL, _("END program\n"));
g_bas_end = false;
}
}
else
{
FS_putChars(STDCHANNEL, _("Invalid line\n"));
Token_destroy(line);
}
}
else
{
Token_destroy(line);
}
}
}
void bas_exit(void)
{
/* Release resources */
Auto_destroy(&g_stack);
Global_destroy(&g_globals);
Program_destroy(&g_program);
if (g_labelstack)
{
free(g_labelstack);
g_labelstack = (struct labelstack_s *)0;
}
/* Close files and devices. NOTE that STDCHANNEL is also close here and
* can no longer be use
*/
FS_closefiles();
FS_close(LPCHANNEL);
FS_close(STDCHANNEL);
}