2490 lines
63 KiB
C
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 <string.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 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 = 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);
|
|
(void)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);
|
|
}
|