sergiotarxz/nuttx-apps
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
a76f057bc6
nuttx-apps/interpreters/bas/statement.c
Gregory Nutt 799de0c6b5 BAS: More name compatibility changes
2014-11-08 11:47:35 -06:00

6355 lines
148 KiB
C
Raw Blame History

/****************************************************************************
* apps/interpreters/bas/var.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 <stdlib.h>
#include "statement.h"
/****************************************************************************
* Pre-processor Definitions
****************************************************************************/
#define _(String) String
/****************************************************************************
* Private Functions
****************************************************************************/
/****************************************************************************
* Public Functions
****************************************************************************/
struct Value *stmt_CALL(struct Value *value)
{
++g_pc.token;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGPROCIDENT);
}
if (g_pass == DECLARE)
{
if (func(value)->type == V_ERROR)
{
return value;
}
else
{
Value_destroy(value);
}
}
else
{
if (g_pass == COMPILE)
{
if (Global_find
(&g_globals, g_pc.token->u.identifier,
(g_pc.token + 1)->type == T_OP) == 0)
{
return Value_new_ERROR(value, UNDECLARED);
}
}
if (g_pc.token->u.identifier->sym->type != USERFUNCTION &&
g_pc.token->u.identifier->sym->type != BUILTINFUNCTION)
{
return Value_new_ERROR(value, TYPEMISMATCH1, "variable", "function");
}
func(value);
if (Value_retype(value, V_VOID)->type == V_ERROR)
{
return value;
}
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_CASE(struct Value *value)
{
struct Pc statementpc = g_pc;
if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Pc *selectcase, *nextcasevalue;
if ((selectcase = findLabel(L_SELECTCASE)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYCASE);
}
for (nextcasevalue = &selectcase->token->u.selectcase->nextcasevalue;
nextcasevalue->line != -1;
nextcasevalue = &nextcasevalue->token->u.casevalue->nextcasevalue);
*nextcasevalue = g_pc;
if (g_pass == COMPILE)
{
g_pc.token->u.casevalue->endselect =
selectcase->token->u.selectcase->endselect;
}
g_pc.token->u.casevalue->nextcasevalue.line = -1;
++g_pc.token;
switch (statementpc.token->type)
{
case T_CASEELSE:
break;
case T_CASEVALUE:
{
struct Pc exprpc;
do
{
if (g_pc.token->type == T_IS)
{
++g_pc.token;
switch (g_pc.token->type)
{
case T_LT:
case T_LE:
case T_EQ:
case T_GE:
case T_GT:
case T_NE:
break;
default:
return Value_new_ERROR(value, MISSINGRELOP);
}
++g_pc.token;
exprpc = g_pc;
if (eval(value, "`is'")->type == V_ERROR)
{
return value;
}
if (Value_retype
(value,
selectcase->token->u.selectcase->type)->type ==
V_ERROR)
{
g_pc = exprpc;
return value;
}
Value_destroy(value);
}
else /* value or range */
{
exprpc = g_pc;
if (eval(value, "`case'")->type == V_ERROR)
{
return value;
}
if (Value_retype
(value,
selectcase->token->u.selectcase->type)->type ==
V_ERROR)
{
g_pc = exprpc;
return value;
}
Value_destroy(value);
if (g_pc.token->type == T_TO)
{
++g_pc.token;
exprpc = g_pc;
if (eval(value, "`case'")->type == V_ERROR)
{
return value;
}
if (Value_retype
(value,
selectcase->token->u.selectcase->type)->type ==
V_ERROR)
{
g_pc = exprpc;
return value;
}
Value_destroy(value);
}
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
while (1);
break;
}
default:
assert(0);
}
}
else
{
g_pc = g_pc.token->u.casevalue->endselect;
}
return (struct Value *)0;
}
struct Value *stmt_CHDIR_MKDIR(struct Value *value)
{
int res = -1, err = -1;
struct Pc dirpc;
struct Pc statementpc = g_pc;
++g_pc.token;
dirpc = g_pc;
if (eval(value, _("directory"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
switch (statementpc.token->type)
{
case T_CHDIR:
res = chdir(value->u.string.character);
break;
case T_MKDIR:
res = mkdir(value->u.string.character, 0777);
break;
default:
assert(0);
}
err = errno;
}
Value_destroy(value);
if (g_pass == INTERPRET && res == -1)
{
g_pc = dirpc;
return Value_new_ERROR(value, IOERROR, strerror(err));
}
return (struct Value *)0;
}
struct Value *stmt_CLEAR(struct Value *value)
{
if (g_pass == INTERPRET)
{
Global_clear(&g_globals);
FS_closefiles();
}
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_CLOSE(struct Value *value)
{
int hasargs = 0;
struct Pc chnpc;
++g_pc.token;
while (1)
{
chnpc = g_pc;
if (g_pc.token->type == T_CHANNEL)
{
hasargs = 1;
++g_pc.token;
}
if (eval(value, (const char *)0) == (struct Value *)0)
{
if (hasargs)
{
return Value_new_ERROR(value, MISSINGEXPR, _("channel"));
}
else
{
break;
}
}
hasargs = 1;
if (value->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET && FS_close(value->u.integer) == -1)
{
Value_destroy(value);
g_pc = chnpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
if (!hasargs && g_pass == INTERPRET)
{
FS_closefiles();
}
return (struct Value *)0;
}
struct Value *stmt_CLS(struct Value *value)
{
struct Pc statementpc = g_pc;
++g_pc.token;
if (g_pass == INTERPRET && FS_cls(STDCHANNEL) == -1)
{
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
return (struct Value *)0;
}
struct Value *stmt_COLOR(struct Value *value)
{
int foreground = -1, background = -1;
struct Pc statementpc = g_pc;
++g_pc.token;
if (eval(value, (const char *)0))
{
if (value->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR))
{
return value;
}
foreground = value->u.integer;
if (foreground < 0 || foreground > 15)
{
Value_destroy(value);
g_pc = statementpc;
return Value_new_ERROR(value, OUTOFRANGE, _("foreground colour"));
}
}
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (eval(value, (const char *)0))
{
if (value->type == V_ERROR ||
(g_pass != DECLARE &&
Value_retype(value, V_INTEGER)->type == V_ERROR))
{
return value;
}
background = value->u.integer;
if (background < 0 || background > 15)
{
Value_destroy(value);
g_pc = statementpc;
return Value_new_ERROR(value, OUTOFRANGE, _("background colour"));
}
}
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (eval(value, (const char *)0))
{
int bordercolour = -1;
if (value->type == V_ERROR ||
(g_pass != DECLARE &&
Value_retype(value, V_INTEGER)->type == V_ERROR))
{
return value;
}
bordercolour = value->u.integer;
if (bordercolour < 0 || bordercolour > 15)
{
Value_destroy(value);
g_pc = statementpc;
return Value_new_ERROR(value, OUTOFRANGE, _("border colour"));
}
}
Value_destroy(value);
}
}
if (g_pass == INTERPRET)
{
FS_colour(STDCHANNEL, foreground, background);
}
return (struct Value *)0;
}
struct Value *stmt_DATA(struct Value *value)
{
if (DIRECTMODE)
{
return Value_new_ERROR(value, NOTINDIRECTMODE);
}
if (g_pass == DECLARE)
{
*g_lastdata = g_pc;
(g_lastdata = &(g_pc.token->u.nextdata))->line = -1;
}
++g_pc.token;
while (1)
{
if (g_pc.token->type != T_STRING && g_pc.token->type != T_DATAINPUT)
{
return Value_new_ERROR(value, MISSINGDATAINPUT);
}
++g_pc.token;
if (g_pc.token->type != T_COMMA)
{
break;
}
else
{
++g_pc.token;
}
}
return (struct Value *)0;
}
struct Value *stmt_DEFFN_DEFPROC_FUNCTION_SUB(struct Value *value)
{
if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Pc statementpc = g_pc;
struct Identifier *fn;
int proc;
int args = 0;
if (DIRECTMODE)
{
return Value_new_ERROR(value, NOTINDIRECTMODE);
}
proc = (g_pc.token->type == T_DEFPROC || g_pc.token->type == T_SUB);
++g_pc.token;
if (g_pc.token->type != T_IDENTIFIER)
{
if (proc)
{
return Value_new_ERROR(value, MISSINGPROCIDENT);
}
else
{
return Value_new_ERROR(value, MISSINGFUNCIDENT);
}
}
fn = g_pc.token->u.identifier;
if (proc)
{
fn->defaultType = V_VOID;
}
++g_pc.token;
if (findLabel(L_FUNC))
{
g_pc = statementpc;
return Value_new_ERROR(value, NESTEDDEFINITION);
}
Auto_variable(&g_stack, fn);
if (g_pc.token->type == T_OP) /* arguments */
{
++g_pc.token;
while (1)
{
if (g_pc.token->type != T_IDENTIFIER)
{
Auto_funcEnd(&g_stack);
return Value_new_ERROR(value, MISSINGFORMIDENT);
}
if (Auto_variable(&g_stack, g_pc.token->u.identifier) == 0)
{
Auto_funcEnd(&g_stack);
return Value_new_ERROR(value, ALREADYDECLARED);
}
++args;
++g_pc.token;
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
if (g_pc.token->type != T_CP)
{
Auto_funcEnd(&g_stack);
return Value_new_ERROR(value, MISSINGCP);
}
++g_pc.token;
}
if (g_pass == DECLARE)
{
enum ValueType *t =
args ? malloc(args * sizeof(enum ValueType)) : (enum ValueType *)0;
int i;
for (i = 0; i < args; ++i)
{
t[i] = Auto_argType(&g_stack, i);
}
if (Global_function
(&g_globals, fn, fn->defaultType, &g_pc, &statementpc, args, t) == 0)
{
free(t);
Auto_funcEnd(&g_stack);
g_pc = statementpc;
return Value_new_ERROR(value, REDECLARATION);
}
Program_addScope(&g_program, &fn->sym->u.sub.u.def.scope);
}
pushLabel(L_FUNC, &statementpc);
if (g_pc.token->type == T_EQ)
{
return stmt_EQ_FNRETURN_FNEND(value);
}
}
else
{
g_pc = (g_pc.token + 1)->u.identifier->sym->u.sub.u.def.scope.end;
}
return (struct Value *)0;
}
struct Value *stmt_DEC_INC(struct Value *value)
{
int step;
step = (g_pc.token->type == T_DEC ? -1 : 1);
++g_pc.token;
while (1)
{
struct Value *l, stepValue;
struct Pc lvaluepc;
lvaluepc = g_pc;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGDECINCIDENT);
}
if (g_pass == DECLARE &&
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 (l->type == V_INTEGER)
{
VALUE_NEW_INTEGER(&stepValue, step);
}
else if (l->type == V_REAL)
{
VALUE_NEW_REAL(&stepValue, (double)step);
}
else
{
g_pc = lvaluepc;
return Value_new_ERROR(value, TYPEMISMATCH5);
}
if (g_pass == INTERPRET)
{
Value_add(l, &stepValue, 1);
}
Value_destroy(&stepValue);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_DEFINT_DEFDBL_DEFSTR(struct Value *value)
{
enum ValueType dsttype = V_NIL;
switch (g_pc.token->type)
{
case T_DEFINT:
dsttype = V_INTEGER;
break;
case T_DEFDBL:
dsttype = V_REAL;
break;
case T_DEFSTR:
dsttype = V_STRING;
break;
default:
assert(0);
}
++g_pc.token;
while (1)
{
struct Identifier *ident;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGVARIDENT);
}
if (g_pc.token->u.identifier->defaultType != V_REAL)
{
switch (dsttype)
{
case V_INTEGER:
return Value_new_ERROR(value, BADIDENTIFIER, _("integer"));
case V_REAL:
return Value_new_ERROR(value, BADIDENTIFIER, _("real"));
case V_STRING:
return Value_new_ERROR(value, BADIDENTIFIER, _("string"));
default:
assert(0);
}
}
ident = g_pc.token->u.identifier;
++g_pc.token;
if (g_pc.token->type == T_MINUS)
{
struct Identifier i;
if (strlen(ident->name) != 1)
{
return Value_new_ERROR(value, BADRANGE);
}
++g_pc.token;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGVARIDENT);
}
if (strlen(g_pc.token->u.identifier->name) != 1)
{
return Value_new_ERROR(value, BADRANGE);
}
for (i.name[0] = tolower(ident->name[0]), i.name[1] = '\0';
i.name[0] <= tolower(g_pc.token->u.identifier->name[0]);
++i.name[0])
{
Global_variable(&g_globals, &i, dsttype, GLOBALVAR, 1);
}
++g_pc.token;
}
else
{
Global_variable(&g_globals, ident, dsttype, GLOBALVAR, 1);
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_DELETE(struct Value *value)
{
struct Pc from, to;
int f = 0, t = 0;
if (g_pass == INTERPRET && !DIRECTMODE)
{
return Value_new_ERROR(value, NOTINPROGRAMMODE);
}
++g_pc.token;
if (g_pc.token->type == T_INTEGER)
{
if (g_pass == INTERPRET &&
Program_goLine(&g_program, g_pc.token->u.integer,
&from) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
f = 1;
++g_pc.token;
}
if (g_pc.token->type == T_MINUS || g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (g_pc.token->type == T_INTEGER)
{
if (g_pass == INTERPRET &&
Program_goLine(&g_program, g_pc.token->u.integer,
&to) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
t = 1;
++g_pc.token;
}
}
else if (f == 1)
{
to = from;
t = 1;
}
if (!f && !t)
{
return Value_new_ERROR(value, MISSINGLINENUMBER);
}
if (g_pass == INTERPRET)
{
Program_delete(&g_program, f ? &from : (struct Pc *)0,
t ? &to : (struct Pc *)0);
}
return (struct Value *)0;
}
struct Value *stmt_DIM(struct Value *value)
{
++g_pc.token;
while (1)
{
unsigned int capacity = 0, *geometry = (unsigned int *)0;
struct Var *var;
struct Pc dimpc;
unsigned int dim;
enum ValueType vartype;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGARRIDENT);
}
if (g_pass == DECLARE &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType, GLOBALARRAY,
0) == 0)
{
return Value_new_ERROR(value, REDECLARATION);
}
var = &g_pc.token->u.identifier->sym->u.var;
if (g_pass == INTERPRET && var->dim)
{
return Value_new_ERROR(value, REDIM);
}
vartype = var->type;
++g_pc.token;
if (g_pc.token->type != T_OP)
{
return Value_new_ERROR(value, MISSINGOP);
}
++g_pc.token;
dim = 0;
while (1)
{
dimpc = g_pc;
if (eval(value, _("dimension"))->type == V_ERROR ||
(g_pass != DECLARE &&
Value_retype(value, V_INTEGER)->type == V_ERROR))
{
if (capacity)
{
free(geometry);
}
return value;
}
if (g_pass == INTERPRET && value->u.integer < g_optionbase) /* error */
{
Value_destroy(value);
Value_new_ERROR(value, OUTOFRANGE, _("dimension"));
}
if (value->type == V_ERROR) /* abort */
{
if (capacity)
{
free(geometry);
}
g_pc = dimpc;
return value;
}
if (g_pass == INTERPRET)
{
if (dim == capacity) /* enlarge geometry */
{
unsigned int *more;
more =
realloc(geometry,
sizeof(unsigned int) *
(capacity ? (capacity *= 2) : (capacity = 3)));
geometry = more;
}
geometry[dim] = value->u.integer - g_optionbase + 1;
++dim;
}
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
if (g_pc.token->type != T_CP) /* abort */
{
if (capacity)
{
free(geometry);
}
return Value_new_ERROR(value, MISSINGCP);
}
++g_pc.token;
if (g_pass == INTERPRET)
{
struct Var newarray;
assert(capacity);
if (Var_new(&newarray, vartype, dim, geometry, g_optionbase) ==
(struct Var *)0)
{
free(geometry);
return Value_new_ERROR(value, OUTOFMEMORY);
}
Var_destroy(var);
*var = newarray;
free(geometry);
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token; /* advance to next var */
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_DISPLAY(struct Value *value)
{
struct Pc statementpc = g_pc;
++g_pc.token;
if (eval(value, _("file name"))->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR))
{
return value;
}
if (g_pass == INTERPRET && cat(value->u.string.character) == -1)
{
const char *msg = strerror(errno);
Value_destroy(value);
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR, msg);
}
else
{
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_DO(struct Value *value)
{
if (g_pass == DECLARE || g_pass == COMPILE)
{
pushLabel(L_DO, &g_pc);
}
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_DOcondition(struct Value *value)
{
struct Pc dowhilepc = g_pc;
int negate = (g_pc.token->type == T_DOUNTIL);
if (g_pass == DECLARE || g_pass == COMPILE)
{
pushLabel(L_DOcondition, &g_pc);
}
++g_pc.token;
if (eval(value, "condition")->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
int condition;
condition = Value_isNull(value);
if (negate)
{
condition = !condition;
}
if (condition)
{
g_pc = dowhilepc.token->u.exitdo;
}
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_EDIT(struct Value *value)
{
#ifdef CONFIG_ARCH_HAVE_VFORK
long int line;
struct Pc statementpc = g_pc;
int status;
++g_pc.token;
if (g_pc.token->type == T_INTEGER)
{
struct Pc where;
if (g_program.numbered)
{
if (Program_goLine(&g_program, g_pc.token->u.integer, &where) ==
(struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
line = where.line + 1;
}
else
{
if (!Program_end(&g_program, &where))
{
return Value_new_ERROR(value, NOPROGRAM);
}
line = g_pc.token->u.integer;
if (line < 1 || line > (where.line + 1))
{
return Value_new_ERROR(value, NOSUCHLINE);
}
}
++g_pc.token;
}
else
{
line = 1;
}
if (g_pass == INTERPRET)
{
/* variables */
char *name;
int chn;
struct Program newProgram;
const char *visual, *basename, *shell;
struct String cmd;
static struct
{
const char *editor, *flag;
}
gotoLine[] =
{
{
"Xemacs", "+%ld "},
{
"cemacs", "+%ld "},
{
"emacs", "+%ld "},
{
"emori", "-l%ld "},
{
"fe", "-l%ld "},
{
"jed", "+%ld "},
{
"jmacs", "+%ld "},
{
"joe", "+%ld "},
{
"modeori", "-l%ld "},
{
"origami", "-l%ld "},
{
"vi", "-c%ld "},
{
"vim", "+%ld "},
{
"xemacs", "+%ld "}
};
unsigned int i;
pid_t pid;
if (!DIRECTMODE)
{
g_pc = statementpc;
return Value_new_ERROR(value, NOTINPROGRAMMODE);
}
if ((name = tmpnam(NULL)) == (char *)0)
{
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR,
_("generating temporary file name failed"));
}
if ((chn = FS_openout(name)) == -1)
{
g_pc = statementpc;
return Value_new_ERROR(value, IOERRORCREATE, name, FS_errmsg);
}
FS_width(chn, 0);
if (Program_list(&g_program, chn, 0, (struct Pc *)0, (struct Pc *)0, value))
{
g_pc = statementpc;
return value;
}
if (FS_close(chn) == -1)
{
g_pc = statementpc;
unlink(name);
return Value_new_ERROR(value, IOERRORCLOSE, name, FS_errmsg);
}
if ((visual = getenv("VISUAL")) == (char *)0 &&
(visual = getenv("EDITOR")) == (char *)0)
{
visual = "vi";
}
basename = strrchr(visual, '/');
if (basename == (char *)0)
{
basename = visual;
}
if ((shell = getenv("SHELL")) == (char *)0)
{
shell = "/bin/sh";
}
String_new(&cmd);
String_appendChars(&cmd, visual);
String_appendChar(&cmd, ' ');
for (i = 0; i < sizeof(gotoLine) / sizeof(gotoLine[0]); ++i)
{
if (strcmp(basename, gotoLine[i].editor) == 0)
{
String_appendPrintf(&cmd, gotoLine[i].flag, line);
break;
}
}
String_appendChars(&cmd, name);
FS_shellmode(STDCHANNEL);
switch (pid = vfork())
{
case -1:
{
unlink(name);
FS_fsmode(STDCHANNEL);
return Value_new_ERROR(value, FORKFAILED, strerror(errno));
}
case 0:
{
execl(shell, shell, "-c", cmd.character, (const char *)0);
exit(127);
}
default:
{
/* Wait for the editor to complete */
while (waitpid(pid, &status, 0) < 0 && errno != EINTR);
}
}
FS_fsmode(STDCHANNEL);
String_destroy(&cmd);
if ((chn = FS_openin(name)) == -1)
{
g_pc = statementpc;
return Value_new_ERROR(value, IOERROROPEN, name, FS_errmsg);
}
Program_new(&newProgram);
if (Program_merge(&newProgram, chn, value))
{
FS_close(chn);
unlink(name);
g_pc = statementpc;
return value;
}
FS_close(chn);
Program_setname(&newProgram, g_program.name.character);
Program_destroy(&g_program);
g_program = newProgram;
unlink(name);
}
return (struct Value *)0;
#else
return Value_new_ERROR(value, FORKFAILED, strerror(ENOSYS));
#endif
}
struct Value *stmt_ELSE_ELSEIFELSE(struct Value *value)
{
if (g_pass == INTERPRET)
{
g_pc = g_pc.token->u.endifpc;
}
if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Pc elsepc = g_pc;
struct Pc *ifinstr;
int elseifelse = (g_pc.token->type == T_ELSEIFELSE);
if ((ifinstr = popLabel(L_IF)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYELSE1);
}
if (ifinstr->token->type == T_ELSEIFIF)
{
(ifinstr->token - 1)->u.elsepc = g_pc;
}
++g_pc.token;
ifinstr->token->u.elsepc = g_pc;
assert(ifinstr->token->type == T_ELSEIFIF ||
ifinstr->token->type == T_IF);
if (elseifelse)
{
return &more_statements;
}
else
{
pushLabel(L_ELSE, &elsepc);
}
}
return (struct Value *)0;
}
struct Value *stmt_END(struct Value *value)
{
if (g_pass == INTERPRET)
{
g_pc = g_pc.token->u.endpc;
g_bas_end = true;
}
if (g_pass == DECLARE || g_pass == COMPILE)
{
if (Program_end(&g_program, &g_pc.token->u.endpc))
{
++g_pc.token;
}
else
{
struct Token *eol;
for (eol = g_pc.token; eol->type != T_EOL; ++eol);
g_pc.token->u.endpc = g_pc;
g_pc.token->u.endpc.token = eol;
++g_pc.token;
}
}
return (struct Value *)0;
}
struct Value *stmt_ENDIF(struct Value *value)
{
if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Pc endifpc = g_pc;
struct Pc *ifpc;
struct Pc *elsepc;
if ((ifpc = popLabel(L_IF)))
{
ifpc->token->u.elsepc = endifpc;
if (ifpc->token->type == T_ELSEIFIF)
{
(ifpc->token - 1)->u.elsepc = g_pc;
}
}
else if ((elsepc = popLabel(L_ELSE)))
{
elsepc->token->u.endifpc = endifpc;
}
else
{
return Value_new_ERROR(value, STRAYENDIF);
}
}
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_ENDFN(struct Value *value)
{
struct Pc *curfn = (struct Pc *)0;
struct Pc eqpc = g_pc;
if (g_pass == DECLARE || g_pass == COMPILE)
{
if ((curfn = popLabel(L_FUNC)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYENDFN);
}
if ((eqpc.token->u.type =
(curfn->token + 1)->u.identifier->defaultType) == V_VOID)
{
return Value_new_ERROR(value, STRAYENDFN);
}
}
++g_pc.token;
if (g_pass == INTERPRET)
{
return Value_clone(value,
Var_value(Auto_local(&g_stack, 0), 0, (int *)0,
(struct Value *)0));
}
else
{
if (g_pass == DECLARE)
{
Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier, &g_pc);
}
Auto_funcEnd(&g_stack);
}
return (struct Value *)0;
}
struct Value *stmt_ENDPROC_SUBEND(struct Value *value)
{
struct Pc *curfn = (struct Pc *)0;
if (g_pass == DECLARE || g_pass == COMPILE)
{
if ((curfn = popLabel(L_FUNC)) == (struct Pc *)0 ||
(curfn->token + 1)->u.identifier->defaultType != V_VOID)
{
if (curfn != (struct Pc *)0)
{
pushLabel(L_FUNC, curfn);
}
return Value_new_ERROR(value, STRAYSUBEND, topLabelDescription());
}
}
++g_pc.token;
if (g_pass == INTERPRET)
{
return Value_new_VOID(value);
}
else
{
if (g_pass == DECLARE)
{
Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier, &g_pc);
}
Auto_funcEnd(&g_stack);
}
return (struct Value *)0;
}
struct Value *stmt_ENDSELECT(struct Value *value)
{
struct Pc statementpc = g_pc;
++g_pc.token;
if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Pc *selectcasepc;
if ((selectcasepc = popLabel(L_SELECTCASE)))
{
selectcasepc->token->u.selectcase->endselect = g_pc;
}
else
{
g_pc = statementpc;
return Value_new_ERROR(value, STRAYENDSELECT);
}
}
return (struct Value *)0;
}
struct Value *stmt_ENVIRON(struct Value *value)
{
struct Pc epc = g_pc;
++g_pc.token;
if (eval(value, _("environment variable"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET && value->u.string.character)
{
if (putenv(value->u.string.character) == -1)
{
Value_destroy(value);
g_pc = epc;
return Value_new_ERROR(value, ENVIRONFAILED, strerror(errno));
}
}
Value_destroy(value);
return (struct Value *)0;
}
struct Value *stmt_FNEXIT(struct Value *value)
{
struct Pc *curfn = (struct Pc *)0;
if (g_pass == DECLARE || g_pass == COMPILE)
{
if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0 ||
(curfn->token + 1)->u.identifier->defaultType == V_VOID)
{
return Value_new_ERROR(value, STRAYFNEXIT);
}
}
++g_pc.token;
if (g_pass == INTERPRET)
{
return Value_clone(value,
Var_value(Auto_local(&g_stack, 0), 0, (int *)0,
(struct Value *)0));
}
return (struct Value *)0;
}
struct Value *stmt_COLON_EOL(struct Value *value)
{
return (struct Value *)0;
}
struct Value *stmt_QUOTE_REM(struct Value *value)
{
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_EQ_FNRETURN_FNEND(struct Value *value)
{
struct Pc *curfn = (struct Pc *)0;
struct Pc eqpc = g_pc;
enum TokenType t = g_pc.token->type;
if (g_pass == DECLARE || g_pass == COMPILE)
{
if (t == T_EQ)
{
if ((curfn = popLabel(L_FUNC)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYENDEQ);
}
if ((eqpc.token->u.type =
(curfn->token + 1)->u.identifier->defaultType) == V_VOID)
{
return Value_new_ERROR(value, STRAYENDEQ);
}
}
else if (t == T_FNEND)
{
if ((curfn = popLabel(L_FUNC)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYENDFN);
}
if ((eqpc.token->u.type =
(curfn->token + 1)->u.identifier->defaultType) == V_VOID)
{
return Value_new_ERROR(value, STRAYENDFN);
}
}
else
{
if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYFNRETURN);
}
if ((eqpc.token->u.type =
(curfn->token + 1)->u.identifier->defaultType) == V_VOID)
{
return Value_new_ERROR(value, STRAYFNRETURN);
}
}
}
++g_pc.token;
if (eval(value, _("return"))->type == V_ERROR ||
Value_retype(value, eqpc.token->u.type)->type == V_ERROR)
{
if (g_pass != INTERPRET)
{
Auto_funcEnd(&g_stack);
}
g_pc = eqpc;
return value;
}
if (g_pass == INTERPRET)
{
return value;
}
else
{
Value_destroy(value);
if (t == T_EQ || t == T_FNEND)
{
if (g_pass == DECLARE)
{
Global_endfunction(&g_globals, (curfn->token + 1)->u.identifier,
&g_pc);
}
Auto_funcEnd(&g_stack);
}
}
return (struct Value *)0;
}
struct Value *stmt_ERASE(struct Value *value)
{
++g_pc.token;
while (1)
{
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGARRIDENT);
}
if (g_pass == DECLARE &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType, GLOBALARRAY,
0) == 0)
{
return Value_new_ERROR(value, REDECLARATION);
}
if (g_pass == INTERPRET)
{
Var_destroy(&g_pc.token->u.identifier->sym->u.var);
}
++g_pc.token;
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_EXITDO(struct Value *value)
{
if (g_pass == INTERPRET)
{
g_pc = g_pc.token->u.exitdo;
}
else
{
if (g_pass == COMPILE)
{
struct Pc *exitdo;
if ((exitdo = findLabel(L_DO)) == (struct Pc *)0 &&
(exitdo = findLabel(L_DOcondition)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYEXITDO);
}
g_pc.token->u.exitdo = exitdo->token->u.exitdo;
}
++g_pc.token;
}
return (struct Value *)0;
}
struct Value *stmt_EXITFOR(struct Value *value)
{
if (g_pass == INTERPRET)
{
g_pc = g_pc.token->u.exitfor;
}
else
{
if (g_pass == COMPILE)
{
struct Pc *exitfor;
if ((exitfor = findLabel(L_FOR)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYEXITFOR);
}
g_pc.token->u.exitfor = exitfor->token->u.exitfor;
}
++g_pc.token;
}
return (struct Value *)0;
}
struct Value *stmt_FIELD(struct Value *value)
{
long int chn, offset, recLength = -1;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
}
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && (recLength = FS_recLength(chn)) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
++g_pc.token;
offset = 0;
while (1)
{
struct Pc curpc;
struct Value *l;
long int width;
curpc = g_pc;
if (eval(value, _("field width"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
width = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && offset + width > recLength)
{
g_pc = curpc;
return Value_new_ERROR(value, OUTOFRANGE, _("field width"));
}
if (g_pc.token->type != T_AS)
{
return Value_new_ERROR(value, MISSINGAS);
}
++g_pc.token;
curpc = g_pc;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGVARIDENT);
}
if (g_pass == DECLARE &&
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 != DECLARE && l->type != V_STRING)
{
g_pc = curpc;
return Value_new_ERROR(value, TYPEMISMATCH4);
}
if (g_pass == INTERPRET)
{
FS_field(chn, &l->u.string, offset, width);
}
offset += width;
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_FOR(struct Value *value)
{
struct Pc forpc = g_pc;
struct Pc varpc;
struct Pc limitpc;
struct Value limit, stepValue;
++g_pc.token;
varpc = g_pc;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGLOOPIDENT);
}
if (assign(value)->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
++g_pc.token;
if (eval(&limit, (const char *)0)->type == V_ERROR)
{
*value = limit;
return value;
}
Value_retype(&limit, value->type);
assert(limit.type != V_ERROR);
if (g_pc.token->type == T_STEP) /* STEP x */
{
struct Pc stepPc;
++g_pc.token;
stepPc = g_pc;
if (eval(&stepValue, "`step'")->type == V_ERROR)
{
Value_destroy(value);
*value = stepValue;
g_pc = stepPc;
return value;
}
Value_retype(&stepValue, value->type);
assert(stepValue.type != V_ERROR);
}
else /* implicit numeric STEP */
{
if (value->type == V_INTEGER)
{
VALUE_NEW_INTEGER(&stepValue, 1);
}
else
{
VALUE_NEW_REAL(&stepValue, 1.0);
}
}
if (Value_exitFor(value, &limit, &stepValue))
{
g_pc = forpc.token->u.exitfor;
}
Value_destroy(&limit);
Value_destroy(&stepValue);
Value_destroy(value);
}
else
{
pushLabel(L_FOR, &forpc);
pushLabel(L_FOR_VAR, &varpc);
if (g_pc.token->type != T_TO)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGTO);
}
++g_pc.token;
pushLabel(L_FOR_LIMIT, &g_pc);
limitpc = g_pc;
if (eval(&limit, (const char *)0) == (struct Value *)0)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGEXPR, "`to'");
}
if (limit.type == V_ERROR)
{
Value_destroy(value);
*value = limit;
return value;
}
if (g_pass != DECLARE)
{
struct Symbol *sym = varpc.token->u.identifier->sym;
if (VALUE_RETYPE
(&limit, sym->type == GLOBALVAR ||
sym->type == GLOBALARRAY ? sym->u.var.type : Auto_varType(&g_stack,
sym))->type
== V_ERROR)
{
Value_destroy(value);
*value = limit;
g_pc = limitpc;
return value;
}
}
Value_destroy(&limit);
if (g_pc.token->type == T_STEP) /* STEP x */
{
struct Pc stepPc;
++g_pc.token;
stepPc = g_pc;
if (eval(&stepValue, "`step'")->type == V_ERROR ||
(g_pass != DECLARE &&
Value_retype(&stepValue, value->type)->type == V_ERROR))
{
Value_destroy(value);
*value = stepValue;
g_pc = stepPc;
return value;
}
}
else /* implicit numeric STEP */
{
VALUE_NEW_INTEGER(&stepValue, 1);
if (g_pass != DECLARE &&
VALUE_RETYPE(&stepValue, value->type)->type == V_ERROR)
{
Value_destroy(value);
*value = stepValue;
Value_errorPrefix(value, _("implicit STEP 1:"));
return value;
}
}
pushLabel(L_FOR_BODY, &g_pc);
Value_destroy(&stepValue);
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_GET_PUT(struct Value *value)
{
struct Pc statementpc = g_pc;
int put = g_pc.token->type == T_PUT;
long int chn;
struct Pc errpc;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
}
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
errpc = g_pc;
if (eval(value, (const char *)0)) /* process record number/position */
{
int rec;
if (value->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
rec = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET)
{
if (rec < 1)
{
g_pc = errpc;
return Value_new_ERROR(value, OUTOFRANGE, _("record number"));
}
if (FS_seek((int)chn, rec - 1) == -1)
{
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
}
}
if (g_pc.token->type == T_COMMA) /* BINARY mode get/put */
{
int res = -1;
++g_pc.token;
if (put)
{
if (eval(value, _("`put'/`get' data"))->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
switch (value->type)
{
case V_INTEGER:
res = FS_putbinaryInteger(chn, value->u.integer);
break;
case V_REAL:
res = FS_putbinaryReal(chn, value->u.real);
break;
case V_STRING:
res = FS_putbinaryString(chn, &value->u.string);
break;
default:
assert(0);
}
}
Value_destroy(value);
}
else
{
struct Value *l;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGPROCIDENT);
}
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 == INTERPRET)
{
switch (l->type)
{
case V_INTEGER:
res = FS_getbinaryInteger(chn, &l->u.integer);
break;
case V_REAL:
res = FS_getbinaryReal(chn, &l->u.real);
break;
case V_STRING:
res = FS_getbinaryString(chn, &l->u.string);
break;
default:
assert(0);
}
}
}
if (g_pass == INTERPRET && res == -1)
{
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
else if (g_pass == INTERPRET && ((put ? FS_put : FS_get) (chn)) == -1)
{
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
return (struct Value *)0;
}
struct Value *stmt_GOSUB(struct Value *value)
{
if (g_pass == INTERPRET)
{
if (!g_program.runnable &&
compileProgram(value, !DIRECTMODE)->type == V_ERROR)
{
return value;
}
g_pc.token += 2;
Auto_pushGosubRet(&g_stack, &g_pc);
g_pc = (g_pc.token - 2)->u.gosubpc;
Program_trace(&g_program, &g_pc, 0, 1);
}
if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Token *gosubpc = g_pc.token;
++g_pc.token;
if (g_pc.token->type != T_INTEGER)
{
return Value_new_ERROR(value, MISSINGLINENUMBER);
}
if (Program_goLine(&g_program, g_pc.token->u.integer, &gosubpc->u.gosubpc) ==
(struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
if (g_pass == COMPILE &&
Program_scopeCheck(&g_program, &gosubpc->u.gosubpc, findLabel(L_FUNC)))
{
return Value_new_ERROR(value, OUTOFSCOPE);
}
++g_pc.token;
}
return (struct Value *)0;
}
struct Value *stmt_RESUME_GOTO(struct Value *value)
{
if (g_pass == INTERPRET)
{
if (!g_program.runnable &&
compileProgram(value, !DIRECTMODE)->type == V_ERROR)
{
return value;
}
if (g_pc.token->type == T_RESUME)
{
if (!g_stack.resumeable)
{
return Value_new_ERROR(value, STRAYRESUME);
}
g_stack.resumeable = 0;
}
g_pc = g_pc.token->u.gotopc;
Program_trace(&g_program, &g_pc, 0, 1);
}
else if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Token *gotopc = g_pc.token;
++g_pc.token;
if (g_pc.token->type != T_INTEGER)
{
return Value_new_ERROR(value, MISSINGLINENUMBER);
}
if (Program_goLine(&g_program, g_pc.token->u.integer, &gotopc->u.gotopc) ==
(struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
if (g_pass == COMPILE &&
Program_scopeCheck(&g_program, &gotopc->u.gotopc, findLabel(L_FUNC)))
{
return Value_new_ERROR(value, OUTOFSCOPE);
}
++g_pc.token;
}
return (struct Value *)0;
}
struct Value *stmt_KILL(struct Value *value)
{
struct Pc statementpc = g_pc;
++g_pc.token;
if (eval(value, _("file name"))->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR))
{
return value;
}
if (g_pass == INTERPRET && unlink(value->u.string.character) == -1)
{
const char *msg = strerror(errno);
Value_destroy(value);
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR, msg);
}
else
{
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_LET(struct Value *value)
{
++g_pc.token;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGVARIDENT);
}
if (assign(value)->type == V_ERROR)
{
return value;
}
if (g_pass != INTERPRET)
{
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_LINEINPUT(struct Value *value)
{
int channel = 0;
struct Pc lpc;
struct Value *l;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
channel = value->u.integer;
Value_destroy(value);
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
else
{
++g_pc.token;
}
}
/* prompt */
if (g_pc.token->type == T_STRING)
{
if (g_pass == INTERPRET && channel == 0)
{
FS_putString(channel, g_pc.token->u.string);
}
++g_pc.token;
if (g_pc.token->type != T_SEMICOLON && g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGSEMICOMMA);
}
++g_pc.token;
}
if (g_pass == INTERPRET && channel == 0)
{
FS_flush(channel);
}
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGVARIDENT);
}
if (g_pass == DECLARE &&
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);
}
lpc = g_pc;
if (((l = lvalue(value))->type) == V_ERROR)
{
return value;
}
if (g_pass == COMPILE && l->type != V_STRING)
{
g_pc = lpc;
return Value_new_ERROR(value, TYPEMISMATCH4);
}
if (g_pass == INTERPRET)
{
String_size(&l->u.string, 0);
if (FS_appendToString(channel, &l->u.string, 1) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
if (l->u.string.length == 0)
{
return Value_new_ERROR(value, IOERROR, _("end of file"));
}
if (l->u.string.character[l->u.string.length - 1] == '\n')
{
String_size(&l->u.string, l->u.string.length - 1);
}
}
return (struct Value *)0;
}
struct Value *stmt_LIST_LLIST(struct Value *value)
{
struct Pc from, to;
int f = 0, t = 0, channel;
channel = (g_pc.token->type == T_LLIST ? LPCHANNEL : STDCHANNEL);
++g_pc.token;
if (g_pc.token->type == T_INTEGER)
{
if (g_pass == INTERPRET &&
Program_fromLine(&g_program, g_pc.token->u.integer,
&from) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
f = 1;
++g_pc.token;
}
else if (g_pc.token->type != T_MINUS && g_pc.token->type != T_COMMA)
{
if (eval(value, (const char *)0))
{
if (value->type == V_ERROR ||
(g_pass != DECLARE &&
Value_retype(value, V_INTEGER)->type == V_ERROR))
{
return value;
}
if (g_pass == INTERPRET &&
Program_fromLine(&g_program, value->u.integer,
&from) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
f = 1;
Value_destroy(value);
}
}
if (g_pc.token->type == T_MINUS || g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (eval(value, (const char *)0))
{
if (value->type == V_ERROR ||
(g_pass != DECLARE &&
Value_retype(value, V_INTEGER)->type == V_ERROR))
{
return value;
}
if (g_pass == INTERPRET &&
Program_toLine(&g_program, value->u.integer, &to) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
t = 1;
Value_destroy(value);
}
}
else if (f == 1)
{
to = from;
t = 1;
}
if (g_pass == INTERPRET)
{
/* Some implementations do not require direct mode */
if (Program_list
(&g_program, channel, channel == STDCHANNEL, f ? &from : (struct Pc *)0,
t ? &to : (struct Pc *)0, value))
{
return value;
}
}
return (struct Value *)0;
}
struct Value *stmt_LOAD(struct Value *value)
{
struct Pc loadpc;
if (g_pass == INTERPRET && !DIRECTMODE)
{
return Value_new_ERROR(value, NOTINPROGRAMMODE);
}
++g_pc.token;
loadpc = g_pc;
if (eval(value, _("file name"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
g_pc = loadpc;
return value;
}
if (g_pass == INTERPRET)
{
int dev;
new();
Program_setname(&g_program, value->u.string.character);
if ((dev = FS_openin(value->u.string.character)) == -1)
{
g_pc = loadpc;
Value_destroy(value);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
FS_width(dev, 0);
Value_destroy(value);
if (Program_merge(&g_program, dev, value))
{
g_pc = loadpc;
return value;
}
FS_close(dev);
g_program.unsaved = 0;
}
else
{
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_LOCAL(struct Value *value)
{
struct Pc *curfn = (struct Pc *)0;
if (g_pass == DECLARE || g_pass == COMPILE)
{
if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0)
return Value_new_ERROR(value, STRAYLOCAL);
}
++g_pc.token;
while (1)
{
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGVARIDENT);
}
if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Symbol *fnsym;
if (Auto_variable(&g_stack, g_pc.token->u.identifier) == 0)
return Value_new_ERROR(value, ALREADYLOCAL);
if (g_pass == DECLARE)
{
assert(curfn->token->type == T_DEFFN ||
curfn->token->type == T_DEFPROC ||
curfn->token->type == T_SUB ||
curfn->token->type == T_FUNCTION);
fnsym = (curfn->token + 1)->u.identifier->sym;
assert(fnsym);
fnsym->u.sub.u.def.localTypes =
realloc(fnsym->u.sub.u.def.localTypes,
sizeof(enum ValueType) *
(fnsym->u.sub.u.def.localLength + 1));
fnsym->u.sub.u.def.localTypes[fnsym->u.sub.u.def.localLength] =
g_pc.token->u.identifier->defaultType;
++fnsym->u.sub.u.def.localLength;
}
}
++g_pc.token;
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_LOCATE(struct Value *value)
{
long int line, column;
struct Pc argpc;
struct Pc statementpc = g_pc;
++g_pc.token;
argpc = g_pc;
if (eval(value, _("row"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
line = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && line < 1)
{
g_pc = argpc;
return Value_new_ERROR(value, OUTOFRANGE, _("row"));
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
argpc = g_pc;
if (eval(value, _("column"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
column = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && column < 1)
{
g_pc = argpc;
return Value_new_ERROR(value, OUTOFRANGE, _("column"));
}
if (g_pass == INTERPRET && FS_locate(STDCHANNEL, line, column) == -1)
{
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
return (struct Value *)0;
}
struct Value *stmt_LOCK_UNLOCK(struct Value *value)
{
int lock = g_pc.token->type == T_LOCK;
int channel;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
}
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
channel = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET)
{
if (FS_lock(channel, 0, 0, lock ? FS_LOCK_EXCLUSIVE : FS_LOCK_NONE, 1) ==
-1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
return (struct Value *)0;
}
struct Value *stmt_LOOP(struct Value *value)
{
struct Pc looppc = g_pc;
struct Pc *dopc;
++g_pc.token;
if (g_pass == INTERPRET)
{
g_pc = looppc.token->u.dopc;
}
if (g_pass == DECLARE || g_pass == COMPILE)
{
if ((dopc = popLabel(L_DO)) == (struct Pc *)0 &&
(dopc = popLabel(L_DOcondition)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYLOOP);
}
looppc.token->u.dopc = *dopc;
dopc->token->u.exitdo = g_pc;
}
return (struct Value *)0;
}
struct Value *stmt_LOOPUNTIL(struct Value *value)
{
struct Pc loopuntilpc = g_pc;
struct Pc *dopc;
++g_pc.token;
if (eval(value, _("condition"))->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
if (Value_isNull(value))
g_pc = loopuntilpc.token->u.dopc;
Value_destroy(value);
}
if (g_pass == DECLARE || g_pass == COMPILE)
{
if ((dopc = popLabel(L_DO)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYLOOPUNTIL);
}
loopuntilpc.token->u.until = *dopc;
dopc->token->u.exitdo = g_pc;
}
return (struct Value *)0;
}
struct Value *stmt_LSET_RSET(struct Value *value)
{
struct Value *l;
struct Pc tmppc;
int lset = (g_pc.token->type == T_LSET);
++g_pc.token;
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);
}
}
tmppc = g_pc;
if ((l = lvalue(value))->type == V_ERROR)
{
return value;
}
if (g_pass == COMPILE && l->type != V_STRING)
{
g_pc = tmppc;
return Value_new_ERROR(value, TYPEMISMATCH4);
}
if (g_pc.token->type != T_EQ)
{
return Value_new_ERROR(value, MISSINGEQ);
}
++g_pc.token;
tmppc = g_pc;
if (eval(value, _("rhs"))->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(value, l->type)->type == V_ERROR))
{
g_pc = tmppc;
return value;
}
if (g_pass == INTERPRET)
{
(lset ? String_lset : String_rset) (&l->u.string, &value->u.string);
}
Value_destroy(value);
return (struct Value *)0;
}
struct Value *stmt_IDENTIFIER(struct Value *value)
{
struct Pc here = g_pc;
if (g_pass == DECLARE)
{
if (func(value)->type == V_ERROR)
{
return value;
}
else
{
Value_destroy(value);
}
if (g_pc.token->type == T_EQ || g_pc.token->type == T_COMMA)
{
g_pc = here;
if (assign(value)->type == V_ERROR)
{
return value;
}
Value_destroy(value);
}
}
else
{
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);
}
}
if (strcasecmp(g_pc.token->u.identifier->name, "mid$")
&& (g_pc.token->u.identifier->sym->type == USERFUNCTION ||
g_pc.token->u.identifier->sym->type == BUILTINFUNCTION))
{
func(value);
if (Value_retype(value, V_VOID)->type == V_ERROR)
{
return value;
}
Value_destroy(value);
}
else
{
if (assign(value)->type == V_ERROR)
{
return value;
}
if (g_pass != INTERPRET)
{
Value_destroy(value);
}
}
}
return (struct Value *)0;
}
struct Value *stmt_IF_ELSEIFIF(struct Value *value)
{
struct Pc ifpc = g_pc;
++g_pc.token;
if (eval(value, _("condition"))->type == V_ERROR)
{
return value;
}
if (g_pc.token->type != T_THEN)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGTHEN);
}
++g_pc.token;
if (g_pass == INTERPRET)
{
if (Value_isNull(value))
{
g_pc = ifpc.token->u.elsepc;
}
Value_destroy(value);
}
else
{
Value_destroy(value);
if (g_pc.token->type == T_EOL)
{
pushLabel(L_IF, &ifpc);
}
else /* compile single line IF THEN ELSE recursively */
{
if (statements(value)->type == V_ERROR)
{
return value;
}
Value_destroy(value);
if (g_pc.token->type == T_ELSE)
{
struct Pc elsepc = g_pc;
++g_pc.token;
ifpc.token->u.elsepc = g_pc;
if (ifpc.token->type == T_ELSEIFIF)
{
(ifpc.token - 1)->u.elsepc = g_pc;
}
if (statements(value)->type == V_ERROR)
{
return value;
}
Value_destroy(value);
elsepc.token->u.endifpc = g_pc;
}
else
{
ifpc.token->u.elsepc = g_pc;
if (ifpc.token->type == T_ELSEIFIF)
{
(ifpc.token - 1)->u.elsepc = g_pc;
}
}
}
}
return (struct Value *)0;
}
struct Value *stmt_IMAGE(struct Value *value)
{
++g_pc.token;
if (g_pc.token->type != T_STRING)
{
return Value_new_ERROR(value, MISSINGFMT);
}
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_INPUT(struct Value *value)
{
int channel = STDCHANNEL;
int nl = 1;
int extraprompt = 1;
struct Token *inputdata = (struct Token *)0, *t = (struct Token *)0;
struct Pc lvaluepc;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
channel = value->u.integer;
Value_destroy(value);
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
else
{
++g_pc.token;
}
}
if (g_pc.token->type == T_SEMICOLON)
{
nl = 0;
++g_pc.token;
}
/* prompt */
if (g_pc.token->type == T_STRING)
{
if (g_pass == INTERPRET && channel == STDCHANNEL)
{
FS_putString(STDCHANNEL, g_pc.token->u.string);
}
++g_pc.token;
if (g_pc.token->type == T_COMMA || g_pc.token->type == T_COLON)
{
++g_pc.token;
extraprompt = 0;
}
else if (g_pc.token->type == T_SEMICOLON)
{
++g_pc.token;
}
else
{
extraprompt = 0;
}
}
if (g_pass == INTERPRET && channel == STDCHANNEL && extraprompt)
{
FS_putChars(STDCHANNEL, "? ");
}
retry:
if (g_pass == INTERPRET) /* read input line and tokenise it */
{
struct String s;
if (channel == STDCHANNEL)
{
FS_flush(STDCHANNEL);
}
String_new(&s);
if (FS_appendToString(channel, &s, nl) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
if (s.length == 0)
{
return Value_new_ERROR(value, IOERROR, _("end of file"));
}
inputdata = t = Token_newData(s.character);
String_destroy(&s);
}
while (1)
{
struct Value *l;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGVARIDENT);
}
if (g_pass == DECLARE &&
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);
}
lvaluepc = g_pc;
if (((l = lvalue(value))->type) == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
if (t->type == T_COMMA || t->type == T_EOL)
{
enum ValueType ltype = l->type;
Value_destroy(l);
Value_new_null(l, ltype);
}
else if (convert(value, l, t))
{
g_pc = lvaluepc;
if (channel == STDCHANNEL)
{
struct String s;
String_new(&s);
Value_toString(value, &s, ' ', -1, 0, 0, 0, 0, -1, 0, 0);
String_appendChars(&s, " ?? ");
FS_putString(STDCHANNEL, &s);
String_destroy(&s);
Value_destroy(value);
Token_destroy(inputdata);
goto retry;
}
else
{
Token_destroy(inputdata);
return value;
}
}
else
{
++t;
}
if (g_pc.token->type == T_COMMA)
{
if (t->type == T_COMMA)
{
++t;
}
else
{
Token_destroy(inputdata);
if (channel == STDCHANNEL)
{
FS_putChars(STDCHANNEL, "?? ");
++g_pc.token;
goto retry;
}
else
{
g_pc = lvaluepc;
return Value_new_ERROR(value, MISSINGINPUTDATA);
}
}
}
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
if (g_pass == INTERPRET)
{
if (t->type != T_EOL)
{
FS_putChars(STDCHANNEL, _("Too much input data\n"));
}
Token_destroy(inputdata);
}
return (struct Value *)0;
}
struct Value *stmt_MAT(struct Value *value)
{
struct Var *var1, *var2, *var3 = (struct Var *)0;
struct Pc oppc;
enum TokenType op = T_EOL;
oppc.line = -1;
oppc.token = (struct Token *)0;
++g_pc.token;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGMATIDENT);
}
if (g_pass == DECLARE &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType, GLOBALARRAY, 0) == 0)
{
return Value_new_ERROR(value, REDECLARATION);
}
var1 = &g_pc.token->u.identifier->sym->u.var;
++g_pc.token;
if (g_pc.token->type != T_EQ)
{
return Value_new_ERROR(value, MISSINGEQ);
}
++g_pc.token;
if (g_pc.token->type == T_IDENTIFIER) /* a = b [ +|-|* c ] */
{
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, 1) == 0)
return Value_new_ERROR(value, UNDECLARED);
}
var2 = &g_pc.token->u.identifier->sym->u.var;
if (g_pass == INTERPRET &&
((var2->dim != 1 && var2->dim != 2) || var2->base < 0 ||
var2->base > 1))
{
return Value_new_ERROR(value, NOMATRIX, var2->dim, var2->base);
}
if (g_pass == COMPILE &&
Value_commonType[var1->type][var2->type] == V_ERROR)
{
return Value_new_typeError(value, var2->type, var1->type);
}
++g_pc.token;
if (g_pc.token->type == T_PLUS || g_pc.token->type == T_MINUS ||
g_pc.token->type == T_MULT)
{
oppc = g_pc;
op = g_pc.token->type;
++g_pc.token;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGARRIDENT);
}
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, 1) == 0)
{
return Value_new_ERROR(value, UNDECLARED);
}
}
var3 = &g_pc.token->u.identifier->sym->u.var;
if (g_pass == INTERPRET &&
((var3->dim != 1 && var3->dim != 2) || var3->base < 0 ||
var3->base > 1))
{
return Value_new_ERROR(value, NOMATRIX, var3->dim, var3->base);
}
++g_pc.token;
}
if (g_pass != DECLARE)
{
if (var3 == (struct Var *)0)
{
if (Var_mat_assign(var1, var2, value, g_pass == INTERPRET))
{
assert(oppc.line != -1);
g_pc = oppc;
return value;
}
}
else if (op == T_MULT)
{
if (Var_mat_mult(var1, var2, var3, value, g_pass == INTERPRET))
{
assert(oppc.line != -1);
g_pc = oppc;
return value;
}
}
else if (Var_mat_addsub
(var1, var2, var3, op == T_PLUS, value, g_pass == INTERPRET))
{
assert(oppc.line != -1);
g_pc = oppc;
return value;
}
}
}
else if (g_pc.token->type == T_OP)
{
if (var1->type == V_STRING)
{
return Value_new_ERROR(value, TYPEMISMATCH5);
}
++g_pc.token;
if (eval(value, _("factor"))->type == V_ERROR)
{
return value;
}
if (g_pass == COMPILE &&
Value_commonType[var1->type][value->type] == V_ERROR)
{
return Value_new_typeError(value, var1->type, value->type);
}
if (g_pc.token->type != T_CP)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGCP);
}
++g_pc.token;
if (g_pc.token->type != T_MULT)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGMULT);
}
oppc = g_pc;
++g_pc.token;
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, 1) == 0)
{
Value_destroy(value);
return Value_new_ERROR(value, UNDECLARED);
}
}
var2 = &g_pc.token->u.identifier->sym->u.var;
if (g_pass == INTERPRET &&
((var2->dim != 1 && var2->dim != 2) || var2->base < 0 ||
var2->base > 1))
{
Value_destroy(value);
return Value_new_ERROR(value, NOMATRIX, var2->dim, var2->base);
}
if (g_pass != DECLARE &&
Var_mat_scalarMult(var1, value, var2, g_pass == INTERPRET))
{
assert(oppc.line != -1);
g_pc = oppc;
return value;
}
Value_destroy(value);
++g_pc.token;
}
else if (g_pc.token->type == T_CON || g_pc.token->type == T_ZER ||
g_pc.token->type == T_IDN)
{
op = g_pc.token->type;
if (g_pass == COMPILE && Value_commonType[var1->type][V_INTEGER] == V_ERROR)
{
return Value_new_typeError(value, V_INTEGER, var1->type);
}
++g_pc.token;
if (g_pc.token->type == T_OP)
{
unsigned int dim, geometry[2];
enum ValueType vartype = var1->type;
++g_pc.token;
if (evalGeometry(value, &dim, geometry))
{
return value;
}
if (g_pass == INTERPRET)
{
Var_destroy(var1);
Var_new(var1, vartype, dim, geometry, g_optionbase);
}
}
if (g_pass == INTERPRET)
{
unsigned int i;
int unused = 1 - var1->base;
if ((var1->dim != 1 && var1->dim != 2) || var1->base < 0 ||
var1->base > 1)
{
return Value_new_ERROR(value, NOMATRIX, var1->dim, var1->base);
}
if (var1->dim == 1)
{
for (i = unused; i < var1->geometry[0]; ++i)
{
int c = -1;
Value_destroy(&(var1->value[i]));
switch (op)
{
case T_CON:
c = 1;
break;
case T_ZER:
c = 0;
break;
case T_IDN:
c = (i == unused ? 1 : 0);
break;
default:
assert(0);
}
if (var1->type == V_INTEGER)
{
Value_new_INTEGER(&(var1->value[i]), c);
}
else
{
Value_new_REAL(&(var1->value[i]), (double)c);
}
}
}
else
{
int j;
for (i = unused; i < var1->geometry[0]; ++i)
{
for (j = unused; j < var1->geometry[1]; ++j)
{
int c = -1;
Value_destroy(&(var1->value[i * var1->geometry[1] + j]));
switch (op)
{
case T_CON:
c = 1;
break;
case T_ZER:
c = 0;
break;
case T_IDN:
c = (i == j ? 1 : 0);
break;
default:
assert(0);
}
if (var1->type == V_INTEGER)
{
Value_new_INTEGER(&
(var1->value
[i * var1->geometry[1] + j]), c);
}
else
{
Value_new_REAL(&
(var1->
value[i * var1->geometry[1] + j]),
(double)c);
}
}
}
}
}
}
else if (g_pc.token->type == T_TRN || g_pc.token->type == T_INV)
{
op = g_pc.token->type;
++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, MISSINGMATIDENT);
}
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, 1) == 0)
{
return Value_new_ERROR(value, UNDECLARED);
}
}
var2 = &g_pc.token->u.identifier->sym->u.var;
if (g_pass == COMPILE &&
Value_commonType[var1->type][var2->type] == V_ERROR)
{
return Value_new_typeError(value, var2->type, var1->type);
}
if (g_pass == INTERPRET)
{
if (var2->dim != 2 || var2->base < 0 || var2->base > 1)
{
return Value_new_ERROR(value, NOMATRIX, var2->dim, var2->base);
}
switch (op)
{
case T_TRN:
Var_mat_transpose(var1, var2);
break;
case T_INV:
if (Var_mat_invert(var1, var2, &g_stack.lastdet, value))
{
return value;
}
break;
default:
assert(0);
}
}
++g_pc.token;
if (g_pc.token->type != T_CP)
{
return Value_new_ERROR(value, MISSINGCP);
}
++g_pc.token;
}
else
{
return Value_new_ERROR(value, MISSINGEXPR, _("matrix"));
}
return (struct Value *)0;
}
struct Value *stmt_MATINPUT(struct Value *value)
{
int channel = STDCHANNEL;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
channel = value->u.integer;
Value_destroy(value);
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
else
{
++g_pc.token;
}
}
while (1)
{
struct Pc lvaluepc;
struct Var *var;
lvaluepc = g_pc;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGMATIDENT);
}
if (g_pass == DECLARE &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType, GLOBALARRAY,
0) == 0)
{
return Value_new_ERROR(value, REDECLARATION);
}
var = &g_pc.token->u.identifier->sym->u.var;
++g_pc.token;
if (g_pc.token->type == T_OP)
{
unsigned int dim, geometry[2];
enum ValueType vartype = var->type;
++g_pc.token;
if (evalGeometry(value, &dim, geometry))
{
return value;
}
if (g_pass == INTERPRET)
{
Var_destroy(var);
Var_new(var, vartype, dim, geometry, g_optionbase);
}
}
if (g_pass == INTERPRET)
{
unsigned int i, j;
int unused = 1 - var->base;
int columns;
struct Token *inputdata, *t;
if (var->dim != 1 && var->dim != 2)
{
return Value_new_ERROR(value, NOMATRIX, var->dim);
}
columns = var->dim == 1 ? 0 : var->geometry[1];
inputdata = t = (struct Token *)0;
for (i = unused, j = unused; i < var->geometry[0];)
{
struct String s;
if (!inputdata)
{
if (channel == STDCHANNEL)
{
FS_putChars(STDCHANNEL, "? ");
FS_flush(STDCHANNEL);
}
String_new(&s);
if (FS_appendToString(channel, &s, 1) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
if (s.length == 0)
{
return Value_new_ERROR(value, IOERROR, _("end of file"));
}
inputdata = t = Token_newData(s.character);
String_destroy(&s);
}
if (t->type == T_COMMA)
{
Value_destroy(&(var->value[j * columns + i]));
Value_new_null(&(var->value[j * columns + i]), var->type);
++t;
}
else if (t->type == T_EOL)
{
while (i < var->geometry[0])
{
Value_destroy(&(var->value[j * columns + i]));
Value_new_null(&(var->value[j * columns + i]), var->type);
++i;
}
}
else if (convert(value, &(var->value[j * columns + i]), t))
{
Token_destroy(inputdata);
g_pc = lvaluepc;
return value;
}
else
{
++t;
++i;
if (t->type == T_COMMA)
{
++t;
}
}
if (i == var->geometry[0] && j < (columns - 1))
{
i = unused;
++j;
if (t->type == T_EOL)
{
Token_destroy(inputdata);
inputdata = (struct Token *)0;
}
}
}
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_MATPRINT(struct Value *value)
{
int chn = STDCHANNEL;
int printusing = 0;
struct Value usingval;
struct String *using = (struct String *)0;
size_t usingpos = 0;
int notfirst = 0;
++g_pc.token;
if (chn == STDCHANNEL && g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
}
if (g_pc.token->type == T_USING)
{
struct Pc usingpc;
usingpc = g_pc;
printusing = 1;
++g_pc.token;
if (g_pc.token->type == T_INTEGER)
{
if (g_pass == COMPILE &&
Program_imageLine(&g_program, g_pc.token->u.integer,
&usingpc.token->u.image) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHIMAGELINE);
}
else if (g_pass == INTERPRET)
{
using = usingpc.token->u.image.token->u.string;
}
Value_new_STRING(&usingval);
++g_pc.token;
}
else
{
if (eval(&usingval, _("format string"))->type == V_ERROR ||
Value_retype(&usingval, V_STRING)->type == V_ERROR)
{
*value = usingval;
return value;
}
using = &usingval.u.string;
}
if (g_pc.token->type != T_SEMICOLON)
{
Value_destroy(&usingval);
return Value_new_ERROR(value, MISSINGSEMICOLON);
}
++g_pc.token;
}
else
{
Value_new_STRING(&usingval);
using = &usingval.u.string;
}
while (1)
{
struct Var *var;
int zoned = 1;
if (g_pc.token->type != T_IDENTIFIER)
{
if (notfirst)
{
break;
}
Value_destroy(&usingval);
return Value_new_ERROR(value, MISSINGMATIDENT);
}
if (g_pass == DECLARE &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType, GLOBALARRAY,
0) == 0)
{
Value_destroy(&usingval);
return Value_new_ERROR(value, REDECLARATION);
}
var = &g_pc.token->u.identifier->sym->u.var;
++g_pc.token;
if (g_pc.token->type == T_SEMICOLON)
{
zoned = 0;
}
if (g_pass == INTERPRET)
{
unsigned int i, j;
int unused = 1 - var->base;
int g0, g1;
if ((var->dim != 1 && var->dim != 2) || var->base < 0 ||
var->base > 1)
{
return Value_new_ERROR(value, NOMATRIX, var->dim, var->base);
}
if ((notfirst ? FS_putChar(chn, '\n') : FS_nextline(chn)) == -1)
{
Value_destroy(&usingval);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
g0 = var->geometry[0];
g1 = var->dim == 1 ? unused + 1 : var->geometry[1];
for (i = unused; i < g0; ++i)
{
for (j = unused; j < g1; ++j)
{
struct String s;
String_new(&s);
Value_clone(value,
&(var->value[var->dim == 1 ? i : i * g1 + j]));
if (Value_toStringUsing(value, &s, using, &usingpos)->type ==
V_ERROR)
{
Value_destroy(&usingval);
String_destroy(&s);
return value;
}
Value_destroy(value);
if (FS_putString(chn, &s) == -1)
{
Value_destroy(&usingval);
String_destroy(&s);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
String_destroy(&s);
if (!printusing && zoned)
{
FS_nextcol(chn);
}
}
if (FS_putChar(chn, '\n') == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
}
if (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON)
{
++g_pc.token;
}
else
{
break;
}
notfirst = 1;
}
Value_destroy(&usingval);
if (g_pass == INTERPRET)
{
if (FS_flush(chn) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
return (struct Value *)0;
}
struct Value *stmt_MATREAD(struct Value *value)
{
++g_pc.token;
while (1)
{
struct Pc lvaluepc;
struct Var *var;
lvaluepc = g_pc;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGMATIDENT);
}
if (g_pass == DECLARE &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType, GLOBALARRAY,
0) == 0)
{
return Value_new_ERROR(value, REDECLARATION);
}
var = &g_pc.token->u.identifier->sym->u.var;
++g_pc.token;
if (g_pc.token->type == T_OP)
{
unsigned int dim, geometry[2];
enum ValueType vartype = var->type;
++g_pc.token;
if (evalGeometry(value, &dim, geometry))
{
return value;
}
if (g_pass == INTERPRET)
{
Var_destroy(var);
Var_new(var, vartype, dim, geometry, g_optionbase);
}
}
if (g_pass == INTERPRET)
{
unsigned int i;
int unused = 1 - var->base;
if ((var->dim != 1 && var->dim != 2) || var->base < 0 ||
var->base > 1)
{
return Value_new_ERROR(value, NOMATRIX, var->dim, var->base);
}
if (var->dim == 1)
{
for (i = unused; i < var->geometry[0]; ++i)
{
if (dataread(value, &(var->value[i])))
{
g_pc = lvaluepc;
return value;
}
}
}
else
{
int j;
for (i = unused; i < var->geometry[0]; ++i)
{
for (j = unused; j < var->geometry[1]; ++j)
{
if (dataread
(value, &(var->value[i * var->geometry[1] + j])))
{
g_pc = lvaluepc;
return value;
}
}
}
}
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_MATREDIM(struct Value *value)
{
++g_pc.token;
while (1)
{
struct Var *var;
unsigned int dim, geometry[2];
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGMATIDENT);
}
if (g_pass == DECLARE &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType, GLOBALARRAY,
0) == 0)
{
return Value_new_ERROR(value, REDECLARATION);
}
var = &g_pc.token->u.identifier->sym->u.var;
++g_pc.token;
if (g_pc.token->type != T_OP)
{
return Value_new_ERROR(value, MISSINGOP);
}
++g_pc.token;
if (evalGeometry(value, &dim, geometry))
{
return value;
}
if (g_pass == INTERPRET &&
Var_mat_redim(var, dim, geometry, value) != (struct Value *)0)
{
return value;
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_MATWRITE(struct Value *value)
{
int chn = STDCHANNEL;
int notfirst = 0;
int comma = 0;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
}
while (1)
{
struct Var *var;
if (g_pc.token->type != T_IDENTIFIER)
{
if (notfirst)
{
break;
}
return Value_new_ERROR(value, MISSINGMATIDENT);
}
notfirst = 1;
if (g_pass == DECLARE &&
Global_variable(&g_globals, g_pc.token->u.identifier,
g_pc.token->u.identifier->defaultType, GLOBALARRAY,
0) == 0)
{
return Value_new_ERROR(value, REDECLARATION);
}
var = &g_pc.token->u.identifier->sym->u.var;
++g_pc.token;
if (g_pass == INTERPRET)
{
unsigned int i, j;
int unused = 1 - var->base;
int g0, g1;
if ((var->dim != 1 && var->dim != 2) || var->base < 0 ||
var->base > 1)
{
return Value_new_ERROR(value, NOMATRIX, var->dim, var->base);
}
g0 = var->geometry[0];
g1 = var->dim == 1 ? unused + 1 : var->geometry[1];
for (i = unused; i < g0; ++i)
{
comma = 0;
for (j = unused; j < g1; ++j)
{
struct String s;
String_new(&s);
Value_clone(value,
&(var->value[var->dim == 1 ? i : i * g1 + j]));
if (comma)
{
String_appendChar(&s, ',');
}
if (FS_putString(chn, Value_toWrite(value, &s)) == -1)
{
Value_destroy(value);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
if (FS_flush(chn) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
String_destroy(&s);
comma = 1;
}
FS_putChar(chn, '\n');
}
}
if (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON)
{
++g_pc.token;
}
else
{
break;
}
}
if (g_pass == INTERPRET)
{
if (FS_flush(chn) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
return (struct Value *)0;
}
struct Value *stmt_NAME(struct Value *value)
{
struct Pc namepc = g_pc;
struct Value old;
int res = -1, reserrno = -1;
++g_pc.token;
if (eval(value, _("file name"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
return value;
}
if (g_pc.token->type != T_AS)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGAS);
}
old = *value;
++g_pc.token;
if (eval(value, _("file name"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
Value_destroy(&old);
return value;
}
if (g_pass == INTERPRET)
{
res = rename(old.u.string.character, value->u.string.character);
reserrno = errno;
}
Value_destroy(&old);
Value_destroy(value);
if (g_pass == INTERPRET && res == -1)
{
g_pc = namepc;
return Value_new_ERROR(value, IOERROR, strerror(reserrno));
}
return (struct Value *)0;
}
struct Value *stmt_NEW(struct Value *value)
{
if (g_pass == INTERPRET)
{
if (!DIRECTMODE)
{
return Value_new_ERROR(value, NOTINPROGRAMMODE);
}
new();
}
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_NEXT(struct Value *value)
{
struct Next **next = &g_pc.token->u.next;
int level = 0;
if (g_pass == INTERPRET)
{
struct Value *l, inc;
struct Pc savepc;
++g_pc.token;
while (1)
{
/* get variable lvalue */
savepc = g_pc;
g_pc = (*next)[level].var;
if ((l = lvalue(value))->type == V_ERROR)
{
return value;
}
g_pc = savepc;
/* get limit value and increment */
savepc = g_pc;
g_pc = (*next)[level].limit;
if (eval(value, _("limit"))->type == V_ERROR)
{
return value;
}
Value_retype(value, l->type);
assert(value->type != V_ERROR);
if (g_pc.token->type == T_STEP)
{
++g_pc.token;
if (eval(&inc, _("step"))->type == V_ERROR)
{
Value_destroy(value);
*value = inc;
return value;
}
}
else
{
VALUE_NEW_INTEGER(&inc, 1);
}
VALUE_RETYPE(&inc, l->type);
assert(inc.type != V_ERROR);
g_pc = savepc;
Value_add(l, &inc, 1);
if (Value_exitFor(l, value, &inc))
{
Value_destroy(value);
Value_destroy(&inc);
if (g_pc.token->type == T_IDENTIFIER)
{
if (lvalue(value)->type == V_ERROR)
{
return value;
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
++level;
}
else
{
break;
}
}
else
{
break;
}
}
else
{
g_pc = (*next)[level].body;
Value_destroy(value);
Value_destroy(&inc);
break;
}
}
}
else
{
struct Pc *body;
++g_pc.token;
while (1)
{
if ((body = popLabel(L_FOR_BODY)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYNEXT, topLabelDescription());
}
if (level)
{
struct Next *more;
more = realloc(*next, sizeof(struct Next) * (level + 1));
*next = more;
}
(*next)[level].body = *body;
(*next)[level].limit = *popLabel(L_FOR_LIMIT);
(*next)[level].var = *popLabel(L_FOR_VAR);
(*next)[level].fr = *popLabel(L_FOR);
if (g_pc.token->type == T_IDENTIFIER)
{
if (cistrcmp
(g_pc.token->u.identifier->name,
(*next)[level].var.token->u.identifier->name))
{
return Value_new_ERROR(value, FORMISMATCH);
}
if (g_pass == DECLARE &&
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 (lvalue(value)->type == V_ERROR)
{
return value;
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
++level;
}
else
{
break;
}
}
else
{
break;
}
}
while (level >= 0)
{
(*next)[level--].fr.token->u.exitfor = g_pc;
}
}
return (struct Value *)0;
}
struct Value *stmt_ON(struct Value *value)
{
struct On *on = &g_pc.token->u.on;
++g_pc.token;
if (eval(value, _("selector"))->type == V_ERROR)
{
return value;
}
if (Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
struct Pc newpc;
if (value->u.integer > 0 && value->u.integer < on->pcLength)
{
newpc = on->pc[value->u.integer];
}
else
{
newpc = on->pc[0];
}
if (g_pc.token->type == T_GOTO)
{
g_pc = newpc;
}
else
{
g_pc = on->pc[0];
Auto_pushGosubRet(&g_stack, &g_pc);
g_pc = newpc;
}
Program_trace(&g_program, &g_pc, 0, 1);
}
else if (g_pass == DECLARE || g_pass == COMPILE)
{
Value_destroy(value);
if (g_pc.token->type != T_GOTO && g_pc.token->type != T_GOSUB)
{
return Value_new_ERROR(value, MISSINGGOTOSUB);
}
++g_pc.token;
on->pcLength = 1;
while (1)
{
on->pc = realloc(on->pc, sizeof(struct Pc) * ++on->pcLength);
if (g_pc.token->type != T_INTEGER)
{
return Value_new_ERROR(value, MISSINGLINENUMBER);
}
if (Program_goLine
(&g_program, g_pc.token->u.integer,
&on->pc[on->pcLength - 1]) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
if (g_pass == COMPILE &&
Program_scopeCheck(&g_program, &on->pc[on->pcLength - 1],
findLabel(L_FUNC)))
{
return Value_new_ERROR(value, OUTOFSCOPE);
}
++g_pc.token;
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
on->pc[0] = g_pc;
}
return (struct Value *)0;
}
struct Value *stmt_ONERROR(struct Value *value)
{
if (DIRECTMODE)
{
return Value_new_ERROR(value, NOTINDIRECTMODE);
}
++g_pc.token;
if (g_pass == INTERPRET)
{
g_stack.onerror = g_pc;
Program_nextLine(&g_program, &g_pc);
return (struct Value *)0;
}
else
{
return &more_statements;
}
}
struct Value *stmt_ONERRORGOTO0(struct Value *value)
{
if (DIRECTMODE)
{
return Value_new_ERROR(value, NOTINDIRECTMODE);
}
if (g_pass == INTERPRET)
{
g_stack.onerror.line = -1;
if (g_stack.resumeable)
{
g_pc = g_stack.erpc;
return Value_clone(value, &g_stack.err);
}
}
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_ONERROROFF(struct Value *value)
{
if (DIRECTMODE)
{
return Value_new_ERROR(value, NOTINDIRECTMODE);
}
if (g_pass == INTERPRET)
{
g_stack.onerror.line = -1;
}
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_OPEN(struct Value *value)
{
int inout = -1, append = 0;
int mode = FS_ACCESS_NONE, lock = FS_LOCK_NONE;
long int channel;
long int recLength = -1;
struct Pc errpc;
struct Value recLengthValue;
struct Pc statementpc = g_pc;
++g_pc.token;
errpc = g_pc;
if (eval(value, _("mode or file"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
return value;
}
if (g_pc.token->type == T_COMMA) /* parse MBASIC syntax */
{
if (value->u.string.length >= 1)
{
switch (tolower(value->u.string.character[0]))
{
case 'i':
inout = 0;
mode = FS_ACCESS_READ;
break;
case 'o':
inout = 1;
mode = FS_ACCESS_WRITE;
break;
case 'a':
inout = 1;
mode = FS_ACCESS_WRITE;
append = 1;
break;
case 'r':
inout = 3;
mode = FS_ACCESS_READWRITE;
break;
}
}
Value_destroy(value);
if (g_pass == INTERPRET && inout == -1)
{
g_pc = errpc;
return Value_new_ERROR(value, BADMODE);
}
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
}
errpc = g_pc;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
g_pc = errpc;
return value;
}
channel = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && channel < 0)
{
return Value_new_ERROR(value, OUTOFRANGE, _("channel"));
}
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
++g_pc.token;
if (eval(value, _("file name"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
return value;
}
if (inout == 3)
{
if (g_pc.token->type != T_COMMA)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGCOMMA);
}
++g_pc.token;
errpc = g_pc;
if (eval(&recLengthValue, _("record length"))->type == V_ERROR ||
Value_retype(&recLengthValue, V_INTEGER)->type == V_ERROR)
{
Value_destroy(value);
*value = recLengthValue;
return value;
}
recLength = recLengthValue.u.integer;
Value_destroy(&recLengthValue);
if (g_pass == INTERPRET && recLength <= 0)
{
Value_destroy(value);
g_pc = errpc;
return Value_new_ERROR(value, OUTOFRANGE, _("record length"));
}
}
}
else /* parse ANSI syntax */
{
struct Value channelValue;
int newMode;
switch (g_pc.token->type)
{
case T_FOR_INPUT:
inout = 0;
mode = FS_ACCESS_READ;
++g_pc.token;
break;
case T_FOR_OUTPUT:
inout = 1;
mode = FS_ACCESS_WRITE;
++g_pc.token;
break;
case T_FOR_APPEND:
inout = 1;
mode = FS_ACCESS_WRITE;
append = 1;
++g_pc.token;
break;
case T_FOR_RANDOM:
inout = 3;
mode = FS_ACCESS_READWRITE;
++g_pc.token;
break;
case T_FOR_BINARY:
inout = 4;
mode = FS_ACCESS_READWRITE;
++g_pc.token;
break;
default:
inout = 3;
mode = FS_ACCESS_READWRITE;
break;
}
switch (g_pc.token->type)
{
case T_ACCESS_READ:
newMode = FS_ACCESS_READ;
break;
case T_ACCESS_READ_WRITE:
newMode = FS_ACCESS_READWRITE;
break;
case T_ACCESS_WRITE:
newMode = FS_ACCESS_WRITE;
break;
default:
newMode = FS_ACCESS_NONE;
}
if (newMode != FS_ACCESS_NONE)
{
if ((newMode & mode) == 0)
{
return Value_new_ERROR(value, WRONGMODE);
}
mode = newMode;
++g_pc.token;
}
switch (g_pc.token->type)
{
case T_SHARED:
lock = FS_LOCK_NONE;
++g_pc.token;
break;
case T_LOCK_READ:
lock = FS_LOCK_SHARED;
++g_pc.token;
break;
case T_LOCK_WRITE:
lock = FS_LOCK_EXCLUSIVE;
++g_pc.token;
break;
default:;
}
if (g_pc.token->type != T_AS)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGAS);
}
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
}
errpc = g_pc;
if (eval(&channelValue, _("channel"))->type == V_ERROR ||
Value_retype(&channelValue, V_INTEGER)->type == V_ERROR)
{
g_pc = errpc;
Value_destroy(value);
*value = channelValue;
return value;
}
channel = channelValue.u.integer;
Value_destroy(&channelValue);
if (inout == 3)
{
if (g_pc.token->type == T_IDENTIFIER)
{
if (cistrcmp(g_pc.token->u.identifier->name, "len"))
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGLEN);
}
++g_pc.token;
if (g_pc.token->type != T_EQ)
{
Value_destroy(value);
return Value_new_ERROR(value, MISSINGEQ);
}
++g_pc.token;
errpc = g_pc;
if (eval(&recLengthValue, _("record length"))->type == V_ERROR ||
Value_retype(&recLengthValue, V_INTEGER)->type == V_ERROR)
{
Value_destroy(value);
*value = recLengthValue;
return value;
}
recLength = recLengthValue.u.integer;
Value_destroy(&recLengthValue);
if (g_pass == INTERPRET && recLength <= 0)
{
Value_destroy(value);
g_pc = errpc;
return Value_new_ERROR(value, OUTOFRANGE, _("record length"));
}
}
else
{
recLength = 1;
}
}
}
/* open file with name value */
if (g_pass == INTERPRET)
{
int res = -1;
if (inout == 0)
{
res = FS_openinChn(channel, value->u.string.character, mode);
}
else if (inout == 1)
{
res = FS_openoutChn(channel, value->u.string.character, mode, append);
}
else if (inout == 3)
{
res =
FS_openrandomChn(channel, value->u.string.character, mode,
recLength);
}
else if (inout == 4)
{
res = FS_openbinaryChn(channel, value->u.string.character, mode);
}
if (res == -1)
{
g_pc = statementpc;
Value_destroy(value);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
else
{
if (lock != FS_LOCK_NONE && FS_lock(channel, 0, 0, lock, 0) == -1)
{
g_pc = statementpc;
Value_destroy(value);
Value_new_ERROR(value, IOERROR, FS_errmsg);
FS_close(channel);
return value;
}
}
}
Value_destroy(value);
return (struct Value *)0;
}
struct Value *stmt_OPTIONBASE(struct Value *value)
{
++g_pc.token;
if (eval(value, _("array subscript base"))->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(value, V_INTEGER)->type == V_ERROR))
{
return value;
}
if (g_pass == INTERPRET)
{
g_optionbase = value->u.integer;
}
Value_destroy(value);
return (struct Value *)0;
}
struct Value *stmt_OPTIONRUN(struct Value *value)
{
++g_pc.token;
if (g_pass == INTERPRET)
{
FS_xonxoff(STDCHANNEL, 0);
}
return (struct Value *)0;
}
struct Value *stmt_OPTIONSTOP(struct Value *value)
{
++g_pc.token;
if (g_pass == INTERPRET)
{
FS_xonxoff(STDCHANNEL, 1);
}
return (struct Value *)0;
}
struct Value *stmt_OUT_POKE(struct Value *value)
{
int out, address, val;
struct Pc lpc;
out = (g_pc.token->type == T_OUT);
lpc = g_pc;
++g_pc.token;
if (eval(value, _("address"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
address = value->u.integer;
Value_destroy(value);
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
++g_pc.token;
if (eval(value, _("output value"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
val = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET)
{
if ((out ? FS_portOutput : FS_memOutput) (address, val) == -1)
{
g_pc = lpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
return (struct Value *)0;
}
struct Value *stmt_PRINT_LPRINT(struct Value *value)
{
int nl = 1;
int chn = (g_pc.token->type == T_PRINT ? STDCHANNEL : LPCHANNEL);
int printusing = 0;
struct Value usingval;
struct String *using = (struct String *)0;
size_t usingpos = 0;
++g_pc.token;
if (chn == STDCHANNEL && g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
}
if (g_pc.token->type == T_USING)
{
struct Pc usingpc;
usingpc = g_pc;
printusing = 1;
++g_pc.token;
if (g_pc.token->type == T_INTEGER)
{
if (g_pass == COMPILE &&
Program_imageLine(&g_program, g_pc.token->u.integer,
&usingpc.token->u.image) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHIMAGELINE);
}
else if (g_pass == INTERPRET)
{
using = usingpc.token->u.image.token->u.string;
}
Value_new_STRING(&usingval);
++g_pc.token;
}
else
{
if (eval(&usingval, _("format string"))->type == V_ERROR ||
Value_retype(&usingval, V_STRING)->type == V_ERROR)
{
*value = usingval;
return value;
}
using = &usingval.u.string;
}
if (g_pc.token->type != T_SEMICOLON)
{
Value_destroy(&usingval);
return Value_new_ERROR(value, MISSINGSEMICOLON);
}
++g_pc.token;
}
else
{
Value_new_STRING(&usingval);
using = &usingval.u.string;
}
while (1)
{
struct Pc valuepc;
valuepc = g_pc;
if (eval(value, (const char *)0))
{
if (value->type == V_ERROR)
{
Value_destroy(&usingval);
return value;
}
if (g_pass == INTERPRET)
{
struct String s;
String_new(&s);
if (Value_toStringUsing(value, &s, using, &usingpos)->type ==
V_ERROR)
{
Value_destroy(&usingval);
String_destroy(&s);
g_pc = valuepc;
return value;
}
if (FS_putItem(chn, &s) == -1)
{
Value_destroy(&usingval);
Value_destroy(value);
String_destroy(&s);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
String_destroy(&s);
}
Value_destroy(value);
nl = 1;
}
else if (g_pc.token->type == T_TAB || g_pc.token->type == T_SPC)
{
int tab = g_pc.token->type == T_TAB;
++g_pc.token;
if (g_pc.token->type != T_OP)
{
Value_destroy(&usingval);
return Value_new_ERROR(value, MISSINGOP);
}
++g_pc.token;
if (eval(value, _("count"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
Value_destroy(&usingval);
return value;
}
if (g_pass == INTERPRET)
{
int s = value->u.integer;
int r = 0;
if (tab)
{
r = FS_tab(chn, s);
}
else
{
while (s-- > 0 && (r = FS_putChar(chn, ' ')) != -1);
}
if (r == -1)
{
Value_destroy(&usingval);
Value_destroy(value);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
Value_destroy(value);
if (g_pc.token->type != T_CP)
{
Value_destroy(&usingval);
return Value_new_ERROR(value, MISSINGCP);
}
++g_pc.token;
nl = 1;
}
else if (g_pc.token->type == T_SEMICOLON)
{
++g_pc.token;
nl = 0;
}
else if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (g_pass == INTERPRET && !printusing)
{
FS_nextcol(chn);
}
nl = 0;
}
else
{
break;
}
if (g_pass == INTERPRET && FS_flush(chn) == -1)
{
Value_destroy(&usingval);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
Value_destroy(&usingval);
if (g_pass == INTERPRET)
{
if (nl && FS_putChar(chn, '\n') == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
if (FS_flush(chn) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
return (struct Value *)0;
}
struct Value *stmt_RANDOMIZE(struct Value *value)
{
struct Pc argpc;
++g_pc.token;
argpc = g_pc;
if (eval(value, (const char *)0))
{
Value_retype(value, V_INTEGER);
if (value->type == V_ERROR)
{
g_pc = argpc;
Value_destroy(value);
return Value_new_ERROR(value, MISSINGEXPR,
_("random number generator seed"));
}
if (g_pass == INTERPRET)
{
srand(g_pc.token->u.integer);
}
Value_destroy(value);
}
else
{
srand(getpid() ^ time((time_t *) 0));
}
return (struct Value *)0;
}
struct Value *stmt_READ(struct Value *value)
{
++g_pc.token;
while (1)
{
struct Value *l;
struct Pc lvaluepc;
lvaluepc = g_pc;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGREADIDENT);
}
if (g_pass == DECLARE &&
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 == INTERPRET && dataread(value, l))
{
g_pc = lvaluepc;
return value;
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
return (struct Value *)0;
}
struct Value *stmt_COPY_RENAME(struct Value *value)
{
struct Pc argpc;
struct Value from;
struct Pc statementpc = g_pc;
++g_pc.token;
argpc = g_pc;
if (eval(&from, _("source file"))->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(&from, V_STRING)->type == V_ERROR))
{
g_pc = argpc;
*value = from;
return value;
}
if (g_pc.token->type != T_TO)
{
Value_destroy(&from);
return Value_new_ERROR(value, MISSINGTO);
}
++g_pc.token;
argpc = g_pc;
if (eval(value, _("destination file"))->type == V_ERROR ||
(g_pass != DECLARE && Value_retype(value, V_STRING)->type == V_ERROR))
{
g_pc = argpc;
return value;
}
if (g_pass == INTERPRET)
{
const char *msg;
int res;
if (statementpc.token->type == T_RENAME)
{
res = rename(from.u.string.character, value->u.string.character);
msg = strerror(errno);
}
else
{
res = FS_copy(from.u.string.character, value->u.string.character);
msg = FS_errmsg;
}
if (res == -1)
{
Value_destroy(&from);
Value_destroy(value);
g_pc = statementpc;
return Value_new_ERROR(value, IOERROR, msg);
}
}
Value_destroy(&from);
Value_destroy(value);
return (struct Value *)0;
}
struct Value *stmt_RENUM(struct Value *value)
{
int first = 10, inc = 10;
++g_pc.token;
if (g_pc.token->type == T_INTEGER)
{
first = g_pc.token->u.integer;
++g_pc.token;
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (g_pc.token->type != T_INTEGER)
return Value_new_ERROR(value, MISSINGINCREMENT);
inc = g_pc.token->u.integer;
++g_pc.token;
}
}
if (g_pass == INTERPRET)
{
if (!DIRECTMODE)
{
return Value_new_ERROR(value, NOTINPROGRAMMODE);
}
Program_renum(&g_program, first, inc);
}
return (struct Value *)0;
}
struct Value *stmt_REPEAT(struct Value *value)
{
if (g_pass == DECLARE || g_pass == COMPILE)
{
pushLabel(L_REPEAT, &g_pc);
}
++g_pc.token;
return (struct Value *)0;
}
struct Value *stmt_RESTORE(struct Value *value)
{
struct Token *restorepc = g_pc.token;
if (g_pass == INTERPRET)
{
g_curdata = g_pc.token->u.restore;
}
++g_pc.token;
if (g_pc.token->type == T_INTEGER)
{
if (g_pass == COMPILE &&
Program_dataLine(&g_program, g_pc.token->u.integer,
&restorepc->u.restore) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHDATALINE);
}
++g_pc.token;
}
else if (g_pass == COMPILE)
{
restorepc->u.restore = g_stack.begindata;
}
return (struct Value *)0;
}
struct Value *stmt_RETURN(struct Value *value)
{
if (g_pass == DECLARE || g_pass == COMPILE)
{
++g_pc.token;
}
if (g_pass == INTERPRET)
{
if (Auto_gosubReturn(&g_stack, &g_pc))
{
Program_trace(&g_program, &g_pc, 0, 1);
}
else
{
return Value_new_ERROR(value, STRAYRETURN);
}
}
return (struct Value *)0;
}
struct Value *stmt_RUN(struct Value *value)
{
struct Pc argpc, begin;
g_stack.resumeable = 0;
++g_pc.token;
argpc = g_pc;
if (g_pc.token->type == T_INTEGER)
{
if (Program_goLine(&g_program, g_pc.token->u.integer, &begin) ==
(struct Pc *)0)
{
return Value_new_ERROR(value, NOSUCHLINE);
}
if (g_pass == COMPILE &&
Program_scopeCheck(&g_program, &begin, findLabel(L_FUNC)))
{
return Value_new_ERROR(value, OUTOFSCOPE);
}
++g_pc.token;
}
else if (eval(value, (const char *)0))
{
if (value->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
g_pc = argpc;
return value;
}
else if (g_pass == INTERPRET)
{
int chn;
struct Program newprogram;
if ((chn = FS_openin(value->u.string.character)) == -1)
{
g_pc = argpc;
Value_destroy(value);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
Value_destroy(value);
Program_new(&newprogram);
if (Program_merge(&newprogram, chn, value))
{
g_pc = argpc;
Program_destroy(&newprogram);
return value;
}
FS_close(chn);
new();
Program_destroy(&g_program);
g_program = newprogram;
if (Program_beginning(&g_program, &begin) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOPROGRAM);
}
}
else
{
Value_destroy(value);
}
}
else
{
if (Program_beginning(&g_program, &begin) == (struct Pc *)0)
{
return Value_new_ERROR(value, NOPROGRAM);
}
}
if (g_pass == INTERPRET)
{
if (compileProgram(value, 1)->type == V_ERROR)
{
return value;
}
g_pc = begin;
g_curdata = g_stack.begindata;
Global_clear(&g_globals);
FS_closefiles();
Program_trace(&g_program, &g_pc, 0, 1);
}
return (struct Value *)0;
}
struct Value *stmt_SAVE(struct Value *value)
{
struct Pc loadpc;
int name;
if (g_pass == INTERPRET && !DIRECTMODE)
{
return Value_new_ERROR(value, NOTINPROGRAMMODE);
}
++g_pc.token;
loadpc = g_pc;
if (g_pc.token->type == T_EOL && g_program.name.length)
{
name = 0;
}
else
{
name = 1;
if (eval(value, _("file name"))->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
g_pc = loadpc;
return value;
}
}
if (g_pass == INTERPRET)
{
int chn;
if (name)
{
Program_setname(&g_program, value->u.string.character);
}
if ((chn = FS_openout(g_program.name.character)) == -1)
{
g_pc = loadpc;
if (name)
{
Value_destroy(value);
}
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
FS_width(chn, 0);
if (name)
{
Value_destroy(value);
}
if (Program_list(&g_program, chn, 0, (struct Pc *)0, (struct Pc *)0, value))
{
g_pc = loadpc;
return value;
}
FS_close(chn);
g_program.unsaved = 0;
}
else if (name)
{
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_SELECTCASE(struct Value *value)
{
struct Pc statementpc = g_pc;
if (g_pass == DECLARE || g_pass == COMPILE)
{
pushLabel(L_SELECTCASE, &g_pc);
}
++g_pc.token;
if (eval(value, _("selector"))->type == V_ERROR)
{
return value;
}
if (g_pass == DECLARE || g_pass == COMPILE)
{
statementpc.token->u.selectcase->type = value->type;
statementpc.token->u.selectcase->nextcasevalue.line = -1;
}
else
{
struct Pc casevaluepc;
int match = 0;
g_pc = casevaluepc = statementpc.token->u.selectcase->nextcasevalue;
do
{
++g_pc.token;
switch (casevaluepc.token->type)
{
case T_CASEVALUE:
{
do
{
struct Value casevalue1;
if (g_pc.token->type == T_IS)
{
enum TokenType relop;
++g_pc.token;
relop = g_pc.token->type;
++g_pc.token;
if (eval(&casevalue1, "`is'")->type == V_ERROR)
{
Value_destroy(value);
*value = casevalue1;
return value;
}
Value_retype(&casevalue1,
statementpc.token->u.selectcase->type);
assert(casevalue1.type != V_ERROR);
if (!match)
{
struct Value cmp;
Value_clone(&cmp, value);
switch (relop)
{
case T_LT:
Value_lt(&cmp, &casevalue1, 1);
break;
case T_LE:
Value_le(&cmp, &casevalue1, 1);
break;
case T_EQ:
Value_eq(&cmp, &casevalue1, 1);
break;
case T_GE:
Value_ge(&cmp, &casevalue1, 1);
break;
case T_GT:
Value_gt(&cmp, &casevalue1, 1);
break;
case T_NE:
Value_ne(&cmp, &casevalue1, 1);
break;
default:
assert(0);
}
assert(cmp.type == V_INTEGER);
match = cmp.u.integer;
Value_destroy(&cmp);
}
Value_destroy(&casevalue1);
}
else
{
if (eval(&casevalue1, "`case'")->type == V_ERROR)
{
Value_destroy(value);
*value = casevalue1;
return value;
}
Value_retype(&casevalue1,
statementpc.token->u.selectcase->type);
assert(casevalue1.type != V_ERROR);
if (g_pc.token->type == T_TO) /* match range */
{
struct Value casevalue2;
++g_pc.token;
if (eval(&casevalue2, "`case'")->type == V_ERROR)
{
Value_destroy(&casevalue1);
Value_destroy(value);
*value = casevalue2;
return value;
}
Value_retype(&casevalue2,
statementpc.token->u.selectcase->type);
assert(casevalue2.type != V_ERROR);
if (!match)
{
struct Value cmp1, cmp2;
Value_clone(&cmp1, value);
Value_clone(&cmp2, value);
Value_ge(&cmp1, &casevalue1, 1);
assert(cmp1.type == V_INTEGER);
Value_le(&cmp2, &casevalue2, 1);
assert(cmp2.type == V_INTEGER);
match = cmp1.u.integer && cmp2.u.integer;
Value_destroy(&cmp1);
Value_destroy(&cmp2);
}
Value_destroy(&casevalue2);
}
else /* match value */
{
if (!match)
{
struct Value cmp;
Value_clone(&cmp, value);
Value_eq(&cmp, &casevalue1, 1);
assert(cmp.type == V_INTEGER);
match = cmp.u.integer;
Value_destroy(&cmp);
}
}
Value_destroy(&casevalue1);
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
break;
}
}
while (1);
break;
}
case T_CASEELSE:
{
match = 1;
break;
}
default:
assert(0);
}
if (!match)
{
if (casevaluepc.token->u.casevalue->nextcasevalue.line != -1)
{
g_pc = casevaluepc =
casevaluepc.token->u.casevalue->nextcasevalue;
}
else
{
g_pc = statementpc.token->u.selectcase->endselect;
break;
}
}
}
while (!match);
}
Value_destroy(value);
return (struct Value *)0;
}
struct Value *stmt_SHELL(struct Value *value)
{
#ifdef CONFIG_ARCH_HAVE_VFORK
pid_t pid;
int status;
++g_pc.token;
if (eval(value, (const char *)0))
{
if (value->type == V_ERROR ||
Value_retype(value, V_STRING)->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
if (g_run_restricted)
{
Value_destroy(value);
return Value_new_ERROR(value, RESTRICTED, strerror(errno));
}
FS_shellmode(STDCHANNEL);
switch (pid = vfork())
{
case -1:
{
FS_fsmode(STDCHANNEL);
Value_destroy(value);
return Value_new_ERROR(value, FORKFAILED, strerror(errno));
}
case 0:
{
execl("/bin/sh", "sh", "-c", value->u.string.character,
(const char *)0);
exit(127);
}
default:
{
/* Wait for the shell to complete */
while (waitpid(pid, &status, 0) < 0 && errno != EINTR);
}
}
FS_fsmode(STDCHANNEL);
}
Value_destroy(value);
}
else
{
if (g_pass == INTERPRET)
{
if (g_run_restricted)
{
return Value_new_ERROR(value, RESTRICTED, strerror(errno));
}
FS_shellmode(STDCHANNEL);
switch (pid = vfork())
{
case -1:
{
FS_fsmode(STDCHANNEL);
return Value_new_ERROR(value, FORKFAILED, strerror(errno));
}
case 0:
{
const char *shell;
shell = getenv("SHELL");
if (shell == (const char *)0)
{
shell = "/bin/sh";
}
execl(shell,
(strrchr(shell, '/') ? strrchr(shell, '/') + 1 : shell),
(const char *)0);
exit(127);
}
default:
{
/* Wait for the shell to complete */
while (waitpid(pid, &status, 0) < 0 && errno != EINTR);
}
}
FS_fsmode(STDCHANNEL);
}
}
return (struct Value *)0;
#else
return Value_new_ERROR(value, FORKFAILED, strerror(ENOSYS));
#endif
}
struct Value *stmt_SLEEP(struct Value *value)
{
double s;
++g_pc.token;
if (eval(value, _("pause"))->type == V_ERROR ||
Value_retype(value, V_REAL)->type == V_ERROR)
{
return value;
}
s = value->u.real;
Value_destroy(value);
if (g_pass == INTERPRET)
{
if (s < 0.0)
{
return Value_new_ERROR(value, OUTOFRANGE, _("pause"));
}
FS_sleep(s);
}
return (struct Value *)0;
}
struct Value *stmt_STOP(struct Value *value)
{
if (g_pass != INTERPRET)
{
++g_pc.token;
}
return (struct Value *)0;
}
struct Value *stmt_SUBEXIT(struct Value *value)
{
struct Pc *curfn = (struct Pc *)0;
if (g_pass == DECLARE || g_pass == COMPILE)
{
if ((curfn = findLabel(L_FUNC)) == (struct Pc *)0 ||
(curfn->token + 1)->u.identifier->defaultType != V_VOID)
{
return Value_new_ERROR(value, STRAYSUBEXIT);
}
}
++g_pc.token;
if (g_pass == INTERPRET)
{
return Value_new_VOID(value);
}
return (struct Value *)0;
}
struct Value *stmt_SWAP(struct Value *value)
{
struct Value *l1, *l2;
struct Pc lvaluepc;
++g_pc.token;
lvaluepc = g_pc;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGSWAPIDENT);
}
if (g_pass == DECLARE &&
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 ((l1 = lvalue(value))->type == V_ERROR)
{
return value;
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
else
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
lvaluepc = g_pc;
if (g_pc.token->type != T_IDENTIFIER)
{
return Value_new_ERROR(value, MISSINGSWAPIDENT);
}
if (g_pass == DECLARE &&
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 ((l2 = lvalue(value))->type == V_ERROR)
{
return value;
}
if (l1->type != l2->type)
{
g_pc = lvaluepc;
return Value_new_typeError(value, l2->type, l1->type);
}
if (g_pass == INTERPRET)
{
struct Value foo;
foo = *l1;
*l1 = *l2;
*l2 = foo;
}
return (struct Value *)0;
}
struct Value *stmt_SYSTEM(struct Value *value)
{
++g_pc.token;
if (g_pass == INTERPRET)
{
if (g_program.unsaved)
{
int ch;
FS_putChars(STDCHANNEL, _("Quit without saving? (y/n) "));
FS_flush(STDCHANNEL);
if ((ch = FS_getChar(STDCHANNEL)) != -1)
{
FS_putChar(STDCHANNEL, ch);
FS_flush(STDCHANNEL);
FS_nextline(STDCHANNEL);
if (tolower(ch) == *_("yes"))
{
bas_exit();
exit(0);
}
}
}
else
{
bas_exit();
exit(0);
}
}
return (struct Value *)0;
}
struct Value *stmt_TROFF(struct Value *value)
{
++g_pc.token;
g_program.trace = 0;
return (struct Value *)0;
}
struct Value *stmt_TRON(struct Value *value)
{
++g_pc.token;
g_program.trace = 1;
return (struct Value *)0;
}
struct Value *stmt_TRUNCATE(struct Value *value)
{
struct Pc chnpc;
int chn;
chnpc = g_pc;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
}
if (eval(value, (const char *)0) == (struct Value *)0)
{
return Value_new_ERROR(value, MISSINGEXPR, _("channel"));
}
if (value->type == V_ERROR || Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && FS_truncate(chn) == -1)
{
g_pc = chnpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
return (struct Value *)0;
}
struct Value *stmt_UNNUM(struct Value *value)
{
++g_pc.token;
if (g_pass == INTERPRET)
{
if (!DIRECTMODE)
{
return Value_new_ERROR(value, NOTINPROGRAMMODE);
}
Program_unnum(&g_program);
}
return (struct Value *)0;
}
struct Value *stmt_UNTIL(struct Value *value)
{
struct Pc untilpc = g_pc;
struct Pc *repeatpc;
++g_pc.token;
if (eval(value, _("condition"))->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
if (Value_isNull(value))
{
g_pc = untilpc.token->u.until;
}
Value_destroy(value);
}
if (g_pass == DECLARE || g_pass == COMPILE)
{
if ((repeatpc = popLabel(L_REPEAT)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYUNTIL);
}
untilpc.token->u.until = *repeatpc;
}
return (struct Value *)0;
}
struct Value *stmt_WAIT(struct Value *value)
{
int address, mask, sel = -1, usesel;
struct Pc lpc;
lpc = g_pc;
++g_pc.token;
if (eval(value, _("address"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
address = value->u.integer;
Value_destroy(value);
if (g_pc.token->type != T_COMMA)
{
return Value_new_ERROR(value, MISSINGCOMMA);
}
++g_pc.token;
if (eval(value, _("mask"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
mask = value->u.integer;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (eval(value, _("select"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
sel = value->u.integer;
usesel = 1;
Value_destroy(value);
}
else
{
usesel = 0;
}
if (g_pass == INTERPRET)
{
int v;
do
{
if ((v = FS_portInput(address)) == -1)
{
g_pc = lpc;
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
while ((usesel ? (v ^ sel) & mask : v ^ mask) == 0);
}
return (struct Value *)0;
}
struct Value *stmt_WHILE(struct Value *value)
{
struct Pc whilepc = g_pc;
if (g_pass == DECLARE || g_pass == COMPILE)
{
pushLabel(L_WHILE, &g_pc);
}
++g_pc.token;
if (eval(value, _("condition"))->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
if (Value_isNull(value))
{
g_pc = *whilepc.token->u.afterwend;
}
Value_destroy(value);
}
return (struct Value *)0;
}
struct Value *stmt_WEND(struct Value *value)
{
if (g_pass == DECLARE || g_pass == COMPILE)
{
struct Pc *whilepc;
if ((whilepc = popLabel(L_WHILE)) == (struct Pc *)0)
{
return Value_new_ERROR(value, STRAYWEND, topLabelDescription());
}
*g_pc.token->u.whilepc = *whilepc;
++g_pc.token;
*(whilepc->token->u.afterwend) = g_pc;
}
else
{
g_pc = *g_pc.token->u.whilepc;
}
return (struct Value *)0;
}
struct Value *stmt_WIDTH(struct Value *value)
{
int chn = STDCHANNEL, width;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
}
if (eval(value, (const char *)0))
{
if (value->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
width = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && FS_width(chn, width) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
if (eval(value, _("zone width"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
width = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && FS_zone(chn, width) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
return (struct Value *)0;
}
struct Value *stmt_WRITE(struct Value *value)
{
int chn = STDCHANNEL;
int comma = 0;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
}
while (1)
{
if (eval(value, (const char *)0))
{
if (value->type == V_ERROR)
{
return value;
}
if (g_pass == INTERPRET)
{
struct String s;
String_new(&s);
if (comma)
{
String_appendChar(&s, ',');
}
if (FS_putString(chn, Value_toWrite(value, &s)) == -1)
{
Value_destroy(value);
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
if (FS_flush(chn) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
String_destroy(&s);
}
Value_destroy(value);
comma = 1;
}
else if (g_pc.token->type == T_COMMA || g_pc.token->type == T_SEMICOLON)
{
++g_pc.token;
}
else
{
break;
}
}
if (g_pass == INTERPRET)
{
FS_putChar(chn, '\n');
if (FS_flush(chn) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
}
return (struct Value *)0;
}
struct Value *stmt_XREF(struct Value *value)
{
g_stack.resumeable = 0;
++g_pc.token;
if (g_pass == INTERPRET)
{
if (!g_program.runnable && compileProgram(value, 1)->type == V_ERROR)
{
return value;
}
Program_xref(&g_program, STDCHANNEL);
}
return (struct Value *)0;
}
struct Value *stmt_ZONE(struct Value *value)
{
int chn = STDCHANNEL, width;
++g_pc.token;
if (g_pc.token->type == T_CHANNEL)
{
++g_pc.token;
if (eval(value, _("channel"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
chn = value->u.integer;
Value_destroy(value);
if (g_pc.token->type == T_COMMA)
{
++g_pc.token;
}
}
if (eval(value, _("zone width"))->type == V_ERROR ||
Value_retype(value, V_INTEGER)->type == V_ERROR)
{
return value;
}
width = value->u.integer;
Value_destroy(value);
if (g_pass == INTERPRET && FS_zone(chn, width) == -1)
{
return Value_new_ERROR(value, IOERROR, FS_errmsg);
}
return (struct Value *)0;
}
Reference in New Issue View Git Blame Copy Permalink