home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
pascal2c
/
basic.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-08-03
|
56KB
|
2,798 lines
/* Output from p2c, the Pascal-to-C translator */
/* From input file "dist/examples/basic.p" */
/*$ debug$*/
#include <p2c/p2c.h>
#define checking true
#define varnamelen 20
#define maxdims 4
typedef Char varnamestring[varnamelen + 1];
typedef Char string255[256];
#define tokvar 0
#define toknum 1
#define tokstr 2
#define toksnerr 3
#define tokplus 4
#define tokminus 5
#define toktimes 6
#define tokdiv 7
#define tokup 8
#define toklp 9
#define tokrp 10
#define tokcomma 11
#define toksemi 12
#define tokcolon 13
#define tokeq 14
#define toklt 15
#define tokgt 16
#define tokle 17
#define tokge 18
#define tokne 19
#define tokand 20
#define tokor 21
#define tokxor 22
#define tokmod 23
#define toknot 24
#define toksqr 25
#define toksqrt 26
#define toksin 27
#define tokcos 28
#define toktan 29
#define tokarctan 30
#define toklog 31
#define tokexp 32
#define tokabs 33
#define toksgn 34
#define tokstr_ 35
#define tokval 36
#define tokchr_ 37
#define tokasc 38
#define toklen 39
#define tokmid_ 40
#define tokpeek 41
#define tokrem 42
#define toklet 43
#define tokprint 44
#define tokinput 45
#define tokgoto 46
#define tokif 47
#define tokend 48
#define tokstop 49
#define tokfor 50
#define toknext 51
#define tokwhile 52
#define tokwend 53
#define tokgosub 54
#define tokreturn 55
#define tokread 56
#define tokdata 57
#define tokrestore 58
#define tokgotoxy 59
#define tokon 60
#define tokdim 61
#define tokpoke 62
#define toklist 63
#define tokrun 64
#define toknew 65
#define tokload 66
#define tokmerge 67
#define toksave 68
#define tokbye 69
#define tokdel 70
#define tokrenum 71
#define tokthen 72
#define tokelse 73
#define tokto 74
#define tokstep 75
typedef double numarray[];
typedef Char *strarray[];
#define forloop 0
#define whileloop 1
#define gosubloop 2
typedef struct tokenrec {
struct tokenrec *next;
short kind;
union {
struct varrec *vp;
double num;
Char *sp;
Char snch;
} UU;
} tokenrec;
typedef struct linerec {
long num, num2;
tokenrec *txt;
struct linerec *next;
} linerec;
typedef struct varrec {
varnamestring name;
struct varrec *next;
long dims[maxdims];
char numdims;
boolean stringvar;
union {
struct {
double *arr;
double *val, rv;
} U0;
struct {
Char **sarr;
Char **sval, *sv;
} U1;
} UU;
} varrec;
typedef struct valrec {
boolean stringval;
union {
double val;
Char *sval;
} UU;
} valrec;
typedef struct looprec {
struct looprec *next;
linerec *homeline;
tokenrec *hometok;
short kind;
union {
struct {
varrec *vp;
double max, step;
} U0;
} UU;
} looprec;
Static Char *inbuf;
Static linerec *linebase;
Static varrec *varbase;
Static looprec *loopbase;
Static long curline;
Static linerec *stmtline, *dataline;
Static tokenrec *stmttok, *datatok, *buf;
Static boolean exitflag;
extern long EXCP_LINE;
/*$if not checking$
$range off$
$end$*/
Static Void restoredata()
{
dataline = NULL;
datatok = NULL;
}
Static Void clearloops()
{
looprec *l;
while (loopbase != NULL) {
l = loopbase->next;
Free(loopbase);
loopbase = l;
}
}
Static long arraysize(v)
varrec *v;
{
long i, j, FORLIM;
if (v->stringvar)
j = 4;
else
j = 8;
FORLIM = v->numdims;
for (i = 0; i < FORLIM; i++)
j *= v->dims[i];
return j;
}
Static Void clearvar(v)
varrec *v;
{
if (v->numdims != 0)
Free(v->UU.U0.arr);
else if (v->stringvar && v->UU.U1.sv != NULL)
Free(v->UU.U1.sv);
v->numdims = 0;
if (v->stringvar) {
v->UU.U1.sv = NULL;
v->UU.U1.sval = &v->UU.U1.sv;
} else {
v->UU.U0.rv = 0.0;
v->UU.U0.val = &v->UU.U0.rv;
}
}
Static Void clearvars()
{
varrec *v;
v = varbase;
while (v != NULL) {
clearvar(v);
v = v->next;
}
}
Static Char *numtostr(Result, n)
Char *Result;
double n;
{
string255 s;
long i;
s[255] = '\0';
if (n != 0 && fabs(n) < 1e-2 || fabs(n) >= 1e12) {
sprintf(s, "% .5E", n);
i = strlen(s) + 1;
s[i - 1] = '\0';
/* p2c: dist/examples/basic.p, line 237:
* Note: Modification of string length may translate incorrectly [146] */
return strcpy(Result, s);
} else {
sprintf(s, "%30.10f", n);
i = strlen(s) + 1;
do {
i--;
} while (s[i - 1] == '0');
if (s[i - 1] == '.')
i--;
s[i] = '\0';
/* p2c: dist/examples/basic.p, line 248:
* Note: Modification of string length may translate incorrectly [146] */
return strcpy(Result, strltrim(s));
}
}
#define toklength 20
typedef long chset[9];
Static Void parse(inbuf, buf)
Char *inbuf;
tokenrec **buf;
{
long i, j, k;
Char token[toklength + 1];
tokenrec *t, *tptr;
varrec *v;
Char ch;
double n, d, d1;
tptr = NULL;
*buf = NULL;
i = 1;
do {
ch = ' ';
while (i <= strlen(inbuf) && ch == ' ') {
ch = inbuf[i - 1];
i++;
}
if (ch != ' ') {
t = (tokenrec *)Malloc(sizeof(tokenrec));
if (tptr == NULL)
*buf = t;
else
tptr->next = t;
tptr = t;
t->next = NULL;
switch (ch) {
case '"':
case '\'':
t->kind = tokstr;
t->UU.sp = (Char *)Malloc(256);
t->UU.sp[255] = '\0';
j = 0;
while (i <= strlen(inbuf) && inbuf[i - 1] != ch) {
j++;
t->UU.sp[j - 1] = inbuf[i - 1];
i++;
}
t->UU.sp[j] = '\0';
/* p2c: dist/examples/basic.p, line 415:
* Note: Modification of string length may translate incorrectly [146] */
i++;
break;
case '+':
t->kind = tokplus;
break;
case '-':
t->kind = tokminus;
break;
case '*':
t->kind = toktimes;
break;
case '/':
t->kind = tokdiv;
break;
case '^':
t->kind = tokup;
break;
case '(':
case '[':
t->kind = toklp;
break;
case ')':
case ']':
t->kind = tokrp;
break;
case ',':
t->kind = tokcomma;
break;
case ';':
t->kind = toksemi;
break;
case ':':
t->kind = tokcolon;
break;
case '?':
t->kind = tokprint;
break;
case '=':
t->kind = tokeq;
break;
case '<':
if (i <= strlen(inbuf) && inbuf[i - 1] == '=') {
t->kind = tokle;
i++;
} else if (i <= strlen(inbuf) && inbuf[i - 1] == '>') {
t->kind = tokne;
i++;
} else
t->kind = toklt;
break;
case '>':
if (i <= strlen(inbuf) && inbuf[i - 1] == '=') {
t->kind = tokge;
i++;
} else
t->kind = tokgt;
break;
default:
if (isalpha(ch)) {
i--;
j = 0;
token[toklength] = '\0';
while (i <= strlen(inbuf) &&
(inbuf[i - 1] == '$' || inbuf[i - 1] == '_' ||
isalnum(inbuf[i - 1]))) {
if (j < toklength) {
j++;
token[j - 1] = inbuf[i - 1];
}
i++;
}
token[j] = '\0';
/* p2c: dist/examples/basic.p, line 309:
* Note: Modification of string length may translate incorrectly [146] */
if (!strcmp(token, "and") || !strcmp(token, "AND"))
t->kind = tokand;
else if (!strcmp(token, "or") || !strcmp(token, "OR"))
t->kind = tokor;
else if (!strcmp(token, "xor") || !strcmp(token, "XOR"))
t->kind = tokxor;
else if (!strcmp(token, "not") || !strcmp(token, "NOT"))
t->kind = toknot;
else if (!strcmp(token, "mod") || !strcmp(token, "MOD"))
t->kind = tokmod;
else if (!strcmp(token, "sqr") || !strcmp(token, "SQR"))
t->kind = toksqr;
else if (!strcmp(token, "sqrt") || !strcmp(token, "SQRT"))
t->kind = toksqrt;
else if (!strcmp(token, "sin") || !strcmp(token, "SIN"))
t->kind = toksin;
else if (!strcmp(token, "cos") || !strcmp(token, "COS"))
t->kind = tokcos;
else if (!strcmp(token, "tan") || !strcmp(token, "TAN"))
t->kind = toktan;
else if (!strcmp(token, "arctan") || !strcmp(token, "ARCTAN"))
t->kind = tokarctan;
else if (!strcmp(token, "log") || !strcmp(token, "LOG"))
t->kind = toklog;
else if (!strcmp(token, "exp") || !strcmp(token, "EXP"))
t->kind = tokexp;
else if (!strcmp(token, "abs") || !strcmp(token, "ABS"))
t->kind = tokabs;
else if (!strcmp(token, "sgn") || !strcmp(token, "SGN"))
t->kind = toksgn;
else if (!strcmp(token, "str$") || !strcmp(token, "STR$"))
t->kind = tokstr_;
else if (!strcmp(token, "val") || !strcmp(token, "VAL"))
t->kind = tokval;
else if (!strcmp(token, "chr$") || !strcmp(token, "CHR$"))
t->kind = tokchr_;
else if (!strcmp(token, "asc") || !strcmp(token, "ASC"))
t->kind = tokasc;
else if (!strcmp(token, "len") || !strcmp(token, "LEN"))
t->kind = toklen;
else if (!strcmp(token, "mid$") || !strcmp(token, "MID$"))
t->kind = tokmid_;
else if (!strcmp(token, "peek") || !strcmp(token, "PEEK"))
t->kind = tokpeek;
else if (!strcmp(token, "let") || !strcmp(token, "LET"))
t->kind = toklet;
else if (!strcmp(token, "print") || !strcmp(token, "PRINT"))
t->kind = tokprint;
else if (!strcmp(token, "input") || !strcmp(token, "INPUT"))
t->kind = tokinput;
else if (!strcmp(token, "goto") || !strcmp(token, "GOTO"))
t->kind = tokgoto;
else if (!strcmp(token, "go to") || !strcmp(token, "GO TO"))
t->kind = tokgoto;
else if (!strcmp(token, "if") || !strcmp(token, "IF"))
t->kind = tokif;
else if (!strcmp(token, "end") || !strcmp(token, "END"))
t->kind = tokend;
else if (!strcmp(token, "stop") || !strcmp(token, "STOP"))
t->kind = tokstop;
else if (!strcmp(token, "for") || !strcmp(token, "FOR"))
t->kind = tokfor;
else if (!strcmp(token, "next") || !strcmp(token, "NEXT"))
t->kind = toknext;
else if (!strcmp(token, "while") || !strcmp(token, "WHILE"))
t->kind = tokwhile;
else if (!strcmp(token, "wend") || !strcmp(token, "WEND"))
t->kind = tokwend;
else if (!strcmp(token, "gosub") || !strcmp(token, "GOSUB"))
t->kind = tokgosub;
else if (!strcmp(token, "return") || !strcmp(token, "RETURN"))
t->kind = tokreturn;
else if (!strcmp(token, "read") || !strcmp(token, "READ"))
t->kind = tokread;
else if (!strcmp(token, "data") || !strcmp(token, "DATA"))
t->kind = tokdata;
else if (!strcmp(token, "restore") || !strcmp(token, "RESTORE"))
t->kind = tokrestore;
else if (!strcmp(token, "gotoxy") || !strcmp(token, "GOTOXY"))
t->kind = tokgotoxy;
else if (!strcmp(token, "on") || !strcmp(token, "ON"))
t->kind = tokon;
else if (!strcmp(token, "dim") || !strcmp(token, "DIM"))
t->kind = tokdim;
else if (!strcmp(token, "poke") || !strcmp(token, "POKE"))
t->kind = tokpoke;
else if (!strcmp(token, "list") || !strcmp(token, "LIST"))
t->kind = toklist;
else if (!strcmp(token, "run") || !strcmp(token, "RUN"))
t->kind = tokrun;
else if (!strcmp(token, "new") || !strcmp(token, "NEW"))
t->kind = toknew;
else if (!strcmp(token, "load") || !strcmp(token, "LOAD"))
t->kind = tokload;
else if (!strcmp(token, "merge") || !strcmp(token, "MERGE"))
t->kind = tokmerge;
else if (!strcmp(token, "save") || !strcmp(token, "SAVE"))
t->kind = toksave;
else if (!strcmp(token, "bye") || !strcmp(token, "BYE"))
t->kind = tokbye;
else if (!strcmp(token, "quit") || !strcmp(token, "QUIT"))
t->kind = tokbye;
else if (!strcmp(token, "del") || !strcmp(token, "DEL"))
t->kind = tokdel;
else if (!strcmp(token, "renum") || !strcmp(token, "RENUM"))
t->kind = tokrenum;
else if (!strcmp(token, "then") || !strcmp(token, "THEN"))
t->kind = tokthen;
else if (!strcmp(token, "else") || !strcmp(token, "ELSE"))
t->kind = tokelse;
else if (!strcmp(token, "to") || !strcmp(token, "TO"))
t->kind = tokto;
else if (!strcmp(token, "step") || !strcmp(token, "STEP"))
t->kind = tokstep;
else if (!strcmp(token, "rem") || !strcmp(token, "REM")) {
t->kind = tokrem;
t->UU.sp = (Char *)Malloc(256);
sprintf(t->UU.sp, "%.*s",
(int)(strlen(inbuf) - i + 1), inbuf + i - 1);
i = strlen(inbuf) + 1;
} else {
t->kind = tokvar;
v = varbase;
while (v != NULL && strcmp(v->name, token))
v = v->next;
if (v == NULL) {
v = (varrec *)Malloc(sizeof(varrec));
v->next = varbase;
varbase = v;
strcpy(v->name, token);
v->numdims = 0;
if (token[strlen(token) - 1] == '$') {
v->stringvar = true;
v->UU.U1.sv = NULL;
v->UU.U1.sval = &v->UU.U1.sv;
} else {
v->stringvar = false;
v->UU.U0.rv = 0.0;
v->UU.U0.val = &v->UU.U0.rv;
}
}
t->UU.vp = v;
}
} else if (isdigit(ch) || ch == '.') {
t->kind = toknum;
n = 0.0;
d = 1.0;
d1 = 1.0;
i--;
while (i <= strlen(inbuf) &&
(isdigit(inbuf[i - 1]) || inbuf[i - 1] == '.' && d1 == 1)) {
if (inbuf[i - 1] == '.')
d1 = 10.0;
else {
n = n * 10 + inbuf[i - 1] - 48;
d *= d1;
}
i++;
}
n /= d;
if (i <= strlen(inbuf) &&
(inbuf[i - 1] == 'E' || inbuf[i - 1] == 'e')) {
i++;
d1 = 10.0;
if (i <= strlen(inbuf) &&
(inbuf[i - 1] == '-' || inbuf[i - 1] == '+')) {
if (inbuf[i - 1] == '-')
d1 = 0.1;
i++;
}
j = 0;
while (i <= strlen(inbuf) && isdigit(inbuf[i - 1])) {
j = j * 10 + inbuf[i - 1] - 48;
i++;
}
for (k = 1; k <= j; k++)
n *= d1;
}
t->UU.num = n;
} else {
t->kind = toksnerr;
t->UU.snch = ch;
}
break;
}
}
} while (i <= strlen(inbuf));
}
#undef toklength
Static Void listtokens(f, buf)
FILE *f;
tokenrec *buf;
{
boolean ltr;
Char STR1[256];
ltr = false;
while (buf != NULL) {
if ((long)buf->kind >= toknot && (long)buf->kind <= tokrenum ||
buf->kind == toknum || buf->kind == tokvar) {
if (ltr)
putc(' ', f);
ltr = (buf->kind != toknot);
} else
ltr = false;
switch (buf->kind) {
case tokvar:
fputs(buf->UU.vp->name, f);
break;
case toknum:
fputs(numtostr(STR1, buf->UU.num), f);
break;
case tokstr:
fprintf(f, "\"%s\"", buf->UU.sp);
break;
case toksnerr:
fprintf(f, "{%c}", buf->UU.snch);
break;
case tokplus:
putc('+', f);
break;
case tokminus:
putc('-', f);
break;
case toktimes:
putc('*', f);
break;
case tokdiv:
putc('/', f);
break;
case tokup:
putc('^', f);
break;
case toklp:
putc('(', f);
break;
case tokrp:
putc(')', f);
break;
case tokcomma:
putc(',', f);
break;
case toksemi:
putc(';', f);
break;
case tokcolon:
fprintf(f, " : ");
break;
case tokeq:
fprintf(f, " = ");
break;
case toklt:
fprintf(f, " < ");
break;
case tokgt:
fprintf(f, " > ");
break;
case tokle:
fprintf(f, " <= ");
break;
case tokge:
fprintf(f, " >= ");
break;
case tokne:
fprintf(f, " <> ");
break;
case tokand:
fprintf(f, " AND ");
break;
case tokor:
fprintf(f, " OR ");
break;
case tokxor:
fprintf(f, " XOR ");
break;
case tokmod:
fprintf(f, " MOD ");
break;
case toknot:
fprintf(f, "NOT ");
break;
case toksqr:
fprintf(f, "SQR");
break;
case toksqrt:
fprintf(f, "SQRT");
break;
case toksin:
fprintf(f, "SIN");
break;
case tokcos:
fprintf(f, "COS");
break;
case toktan:
fprintf(f, "TAN");
break;
case tokarctan:
fprintf(f, "ARCTAN");
break;
case toklog:
fprintf(f, "LOG");
break;
case tokexp:
fprintf(f, "EXP");
break;
case tokabs:
fprintf(f, "ABS");
break;
case toksgn:
fprintf(f, "SGN");
break;
case tokstr_:
fprintf(f, "STR$");
break;
case tokval:
fprintf(f, "VAL");
break;
case tokchr_:
fprintf(f, "CHR$");
break;
case tokasc:
fprintf(f, "ASC");
break;
case toklen:
fprintf(f, "LEN");
break;
case tokmid_:
fprintf(f, "MID$");
break;
case tokpeek:
fprintf(f, "PEEK");
break;
case toklet:
fprintf(f, "LET");
break;
case tokprint:
fprintf(f, "PRINT");
break;
case tokinput:
fprintf(f, "INPUT");
break;
case tokgoto:
fprintf(f, "GOTO");
break;
case tokif:
fprintf(f, "IF");
break;
case tokend:
fprintf(f, "END");
break;
case tokstop:
fprintf(f, "STOP");
break;
case tokfor:
fprintf(f, "FOR");
break;
case toknext:
fprintf(f, "NEXT");
break;
case tokwhile:
fprintf(f, "WHILE");
break;
case tokwend:
fprintf(f, "WEND");
break;
case tokgosub:
fprintf(f, "GOSUB");
break;
case tokreturn:
fprintf(f, "RETURN");
break;
case tokread:
fprintf(f, "READ");
break;
case tokdata:
fprintf(f, "DATA");
break;
case tokrestore:
fprintf(f, "RESTORE");
break;
case tokgotoxy:
fprintf(f, "GOTOXY");
break;
case tokon:
fprintf(f, "ON");
break;
case tokdim:
fprintf(f, "DIM");
break;
case tokpoke:
fprintf(f, "POKE");
break;
case toklist:
fprintf(f, "LIST");
break;
case tokrun:
fprintf(f, "RUN");
break;
case toknew:
fprintf(f, "NEW");
break;
case tokload:
fprintf(f, "LOAD");
break;
case tokmerge:
fprintf(f, "MERGE");
break;
case toksave:
fprintf(f, "SAVE");
break;
case tokdel:
fprintf(f, "DEL");
break;
case tokbye:
fprintf(f, "BYE");
break;
case tokrenum:
fprintf(f, "RENUM");
break;
case tokthen:
fprintf(f, " THEN ");
break;
case tokelse:
fprintf(f, " ELSE ");
break;
case tokto:
fprintf(f, " TO ");
break;
case tokstep:
fprintf(f, " STEP ");
break;
case tokrem:
fprintf(f, "REM%s", buf->UU.sp);
break;
}
buf = buf->next;
}
}
Static Void disposetokens(tok)
tokenrec **tok;
{
tokenrec *tok1;
while (*tok != NULL) {
tok1 = (*tok)->next;
if ((*tok)->kind == tokrem || (*tok)->kind == tokstr)
Free((*tok)->UU.sp);
Free(*tok);
*tok = tok1;
}
}
Static Void parseinput(buf)
tokenrec **buf;
{
linerec *l, *l0, *l1;
Char STR1[256];
strcpy(STR1, strltrim(inbuf));
strcpy(inbuf, STR1);
curline = 0;
while (*inbuf != '\0' && isdigit(inbuf[0])) {
curline = curline * 10 + inbuf[0] - 48;
strcpy(inbuf, inbuf + 1);
}
parse(inbuf, buf);
if (curline == 0)
return;
l = linebase;
l0 = NULL;
while (l != NULL && l->num < curline) {
l0 = l;
l = l->next;
}
if (l != NULL && l->num == curline) {
l1 = l;
l = l->next;
if (l0 == NULL)
linebase = l;
else
l0->next = l;
disposetokens(&l1->txt);
Free(l1);
}
if (*buf != NULL) {
l1 = (linerec *)Malloc(sizeof(linerec));
l1->next = l;
if (l0 == NULL)
linebase = l1;
else
l0->next = l1;
l1->num = curline;
l1->txt = *buf;
}
clearloops();
restoredata();
}
Static Void errormsg(s)
Char *s;
{
printf("\007%s", s);
_Escape(42);
}
Static Void snerr()
{
errormsg("Syntax error");
}
Static Void tmerr()
{
errormsg("Type mismatch error");
}
Static Void badsubscr()
{
errormsg("Bad subscript");
}
/* Local variables for exec: */
struct LOC_exec {
boolean gotoflag, elseflag;
tokenrec *t;
} ;
Local valrec factor PP((struct LOC_exec *LINK));
Local valrec expr PP((struct LOC_exec *LINK));
Local double realfactor(LINK)
struct LOC_exec *LINK;
{
valrec n;
n = factor(LINK);
if (n.stringval)
tmerr();
return (n.UU.val);
}
Local Char *strfactor(LINK)
struct LOC_exec *LINK;
{
valrec n;
n = factor(LINK);
if (!n.stringval)
tmerr();
return (n.UU.sval);
}
Local Char *stringfactor(Result, LINK)
Char *Result;
struct LOC_exec *LINK;
{
valrec n;
n = factor(LINK);
if (!n.stringval)
tmerr();
strcpy(Result, n.UU.sval);
Free(n.UU.sval);
return Result;
}
Local long intfactor(LINK)
struct LOC_exec *LINK;
{
return ((long)floor(realfactor(LINK) + 0.5));
}
Local double realexpr(LINK)
struct LOC_exec *LINK;
{
valrec n;
n = expr(LINK);
if (n.stringval)
tmerr();
return (n.UU.val);
}
Local Char *strexpr(LINK)
struct LOC_exec *LINK;
{
valrec n;
n = expr(LINK);
if (!n.stringval)
tmerr();
return (n.UU.sval);
}
Local Char *stringexpr(Result, LINK)
Char *Result;
struct LOC_exec *LINK;
{
valrec n;
n = expr(LINK);
if (!n.stringval)
tmerr();
strcpy(Result, n.UU.sval);
Free(n.UU.sval);
return Result;
}
Local long intexpr(LINK)
struct LOC_exec *LINK;
{
return ((long)floor(realexpr(LINK) + 0.5));
}
Local Void require(k, LINK)
short k;
struct LOC_exec *LINK;
{
if (LINK->t == NULL || LINK->t->kind != k)
snerr();
LINK->t = LINK->t->next;
}
Local Void skipparen(LINK)
struct LOC_exec *LINK;
{
do {
if (LINK->t == NULL)
snerr();
if (LINK->t->kind == tokrp || LINK->t->kind == tokcomma)
goto _L1;
if (LINK->t->kind == toklp) {
LINK->t = LINK->t->next;
skipparen(LINK);
}
LINK->t = LINK->t->next;
} while (true);
_L1: ;
}
Local varrec *findvar(LINK)
struct LOC_exec *LINK;
{
varrec *v;
long i, j, k;
tokenrec *tok;
long FORLIM;
if (LINK->t == NULL || LINK->t->kind != tokvar)
snerr();
v = LINK->t->UU.vp;
LINK->t = LINK->t->next;
if (LINK->t == NULL || LINK->t->kind != toklp) {
if (v->numdims != 0)
badsubscr();
return v;
}
if (v->numdims == 0) {
tok = LINK->t;
i = 0;
j = 1;
do {
if (i >= maxdims)
badsubscr();
LINK->t = LINK->t->next;
skipparen(LINK);
j *= 11;
i++;
v->dims[i - 1] = 11;
} while (LINK->t->kind != tokrp);
v->numdims = i;
if (v->stringvar) {
v->UU.U1.sarr = (Char **)Malloc(j * 4);
for (k = 0; k < j; k++)
v->UU.U1.sarr[k] = NULL;
} else {
v->UU.U0.arr = (double *)Malloc(j * 8);
for (k = 0; k < j; k++)
v->UU.U0.arr[k] = 0.0;
}
LINK->t = tok;
}
k = 0;
LINK->t = LINK->t->next;
FORLIM = v->numdims;
for (i = 1; i <= FORLIM; i++) {
j = intexpr(LINK);
if ((unsigned long)j >= v->dims[i - 1])
badsubscr();
k = k * v->dims[i - 1] + j;
if (i < v->numdims)
require(tokcomma, LINK);
}
require(tokrp, LINK);
if (v->stringvar)
v->UU.U1.sval = &v->UU.U1.sarr[k];
else
v->UU.U0.val = &v->UU.U0.arr[k];
return v;
}
Local long inot(i, LINK)
long i;
struct LOC_exec *LINK;
{
return (-i - 1);
}
Local long ixor(a, b, LINK)
long a, b;
struct LOC_exec *LINK;
{
return ((a & (~b)) | ((~a) & b));
}
Local valrec factor(LINK)
struct LOC_exec *LINK;
{
varrec *v;
tokenrec *facttok;
valrec n;
long i, j;
tokenrec *tok, *tok1;
Char *s;
union {
long i;
Char *c;
} trick;
double TEMP;
Char STR1[256];
if (LINK->t == NULL)
snerr();
facttok = LINK->t;
LINK->t = LINK->t->next;
n.stringval = false;
switch (facttok->kind) {
case toknum:
n.UU.val = facttok->UU.num;
break;
case tokstr:
n.stringval = true;
n.UU.sval = (Char *)Malloc(256);
strcpy(n.UU.sval, facttok->UU.sp);
break;
case tokvar:
LINK->t = facttok;
v = findvar(LINK);
n.stringval = v->stringvar;
if (n.stringval) {
n.UU.sval = (Char *)Malloc(256);
strcpy(n.UU.sval, *v->UU.U1.sval);
} else
n.UU.val = *v->UU.U0.val;
break;
case toklp:
n = expr(LINK);
require(tokrp, LINK);
break;
case tokminus:
n.UU.val = -realfactor(LINK);
break;
case tokplus:
n.UU.val = realfactor(LINK);
break;
case toknot:
n.UU.val = ~intfactor(LINK);
break;
case toksqr:
TEMP = realfactor(LINK);
n.UU.val = TEMP * TEMP;
break;
case toksqrt:
n.UU.val = sqrt(realfactor(LINK));
break;
case toksin:
n.UU.val = sin(realfactor(LINK));
break;
case tokcos:
n.UU.val = cos(realfactor(LINK));
break;
case toktan:
n.UU.val = realfactor(LINK);
n.UU.val = sin(n.UU.val) / cos(n.UU.val);
break;
case tokarctan:
n.UU.val = atan(realfactor(LINK));
break;
case toklog:
n.UU.val = log(realfactor(LINK));
break;
case tokexp:
n.UU.val = exp(realfactor(LINK));
break;
case tokabs:
n.UU.val = fabs(realfactor(LINK));
break;
case toksgn:
n.UU.val = realfactor(LINK);
n.UU.val = (n.UU.val > 0) - (n.UU.val < 0);
break;
case tokstr_:
n.stringval = true;
n.UU.sval = (Char *)Malloc(256);
numtostr(n.UU.sval, realfactor(LINK));
break;
case tokval:
s = strfactor(LINK);
tok1 = LINK->t;
parse(s, &LINK->t);
tok = LINK->t;
if (tok == NULL)
n.UU.val = 0.0;
else
n = expr(LINK);
disposetokens(&tok);
LINK->t = tok1;
Free(s);
break;
case tokchr_:
n.stringval = true;
n.UU.sval = (Char *)Malloc(256);
strcpy(n.UU.sval, " ");
n.UU.sval[0] = (Char)intfactor(LINK);
break;
case tokasc:
s = strfactor(LINK);
if (*s == '\0')
n.UU.val = 0.0;
else
n.UU.val = s[0];
Free(s);
break;
case tokmid_:
n.stringval = true;
require(toklp, LINK);
n.UU.sval = strexpr(LINK);
require(tokcomma, LINK);
i = intexpr(LINK);
if (i < 1)
i = 1;
j = 255;
if (LINK->t != NULL && LINK->t->kind == tokcomma) {
LINK->t = LINK->t->next;
j = intexpr(LINK);
}
if (j > strlen(n.UU.sval) - i + 1)
j = strlen(n.UU.sval) - i + 1;
if (i > strlen(n.UU.sval))
*n.UU.sval = '\0';
else {
sprintf(STR1, "%.*s", (int)j, n.UU.sval + i - 1);
strcpy(n.UU.sval, STR1);
}
require(tokrp, LINK);
break;
case toklen:
s = strfactor(LINK);
n.UU.val = strlen(s);
Free(s);
break;
case tokpeek:
/* p2c: dist/examples/basic.p, line 1029:
* Note: Range checking is OFF [216] */
trick.i = intfactor(LINK);
n.UU.val = *trick.c;
/* p2c: dist/examples/basic.p, line 1032:
* Note: Range checking is ON [216] */
break;
default:
snerr();
break;
}
return n;
}
Local valrec upexpr(LINK)
struct LOC_exec *LINK;
{
valrec n, n2;
n = factor(LINK);
while (LINK->t != NULL && LINK->t->kind == tokup) {
if (n.stringval)
tmerr();
LINK->t = LINK->t->next;
n2 = upexpr(LINK);
if (n2.stringval)
tmerr();
if (n.UU.val >= 0) {
n.UU.val = exp(n2.UU.val * log(n.UU.val));
continue;
}
if (n2.UU.val != (long)n2.UU.val)
n.UU.val = log(n.UU.val);
n.UU.val = exp(n2.UU.val * log(-n.UU.val));
if (((long)n2.UU.val) & 1)
n.UU.val = -n.UU.val;
}
return n;
}
Local valrec term(LINK)
struct LOC_exec *LINK;
{
valrec n, n2;
short k;
n = upexpr(LINK);
while (LINK->t != NULL && (unsigned long)LINK->t->kind < 32 &&
((1L << ((long)LINK->t->kind)) & ((1L << ((long)toktimes)) |
(1L << ((long)tokdiv)) | (1L << ((long)tokmod)))) != 0) {
k = LINK->t->kind;
LINK->t = LINK->t->next;
n2 = upexpr(LINK);
if (n.stringval || n2.stringval)
tmerr();
if (k == tokmod) {
n.UU.val = (long)floor(n.UU.val + 0.5) % (long)floor(n2.UU.val + 0.5);
/* p2c: dist/examples/basic.p, line 1078:
* Note: Using % for possibly-negative arguments [317] */
} else if (k == toktimes)
n.UU.val *= n2.UU.val;
else
n.UU.val /= n2.UU.val;
}
return n;
}
Local valrec sexpr(LINK)
struct LOC_exec *LINK;
{
valrec n, n2;
short k;
n = term(LINK);
while (LINK->t != NULL && (unsigned long)LINK->t->kind < 32 &&
((1L << ((long)LINK->t->kind)) &
((1L << ((long)tokplus)) | (1L << ((long)tokminus)))) != 0) {
k = LINK->t->kind;
LINK->t = LINK->t->next;
n2 = term(LINK);
if (n.stringval != n2.stringval)
tmerr();
if (k == tokplus) {
if (n.stringval) {
strcat(n.UU.sval, n2.UU.sval);
Free(n2.UU.sval);
} else
n.UU.val += n2.UU.val;
} else {
if (n.stringval)
tmerr();
else
n.UU.val -= n2.UU.val;
}
}
return n;
}
Local valrec relexpr(LINK)
struct LOC_exec *LINK;
{
valrec n, n2;
boolean f;
short k;
n = sexpr(LINK);
while (LINK->t != NULL && (unsigned long)LINK->t->kind < 32 &&
((1L << ((long)LINK->t->kind)) &
((1L << ((long)tokne + 1)) - (1L << ((long)tokeq)))) != 0) {
k = LINK->t->kind;
LINK->t = LINK->t->next;
n2 = sexpr(LINK);
if (n.stringval != n2.stringval)
tmerr();
if (n.stringval) {
f = ((!strcmp(n.UU.sval, n2.UU.sval) && (unsigned long)k < 32 &&
((1L << ((long)k)) & ((1L << ((long)tokeq)) |
(1L << ((long)tokge)) | (1L << ((long)tokle)))) != 0) ||
(strcmp(n.UU.sval, n2.UU.sval) < 0 && (unsigned long)k < 32 &&
((1L << ((long)k)) & ((1L << ((long)toklt)) |
(1L << ((long)tokle)) | (1L << ((long)tokne)))) != 0) ||
(strcmp(n.UU.sval, n2.UU.sval) > 0 && (unsigned long)k < 32 &&
((1L << ((long)k)) & ((1L << ((long)tokgt)) |
(1L << ((long)tokge)) | (1L << ((long)tokne)))) != 0));
/* p2c: dist/examples/basic.p, line 2175: Note:
* Line breaker spent 0.0+8.00 seconds, 5000 tries on line 1554 [251] */
Free(n.UU.sval);
Free(n2.UU.sval);
} else
f = ((n.UU.val == n2.UU.val && (unsigned long)k < 32 && ((1L <<
((long)k)) & ((1L << ((long)tokeq)) |
(1L << ((long)tokge)) | (1L << ((long)tokle)))) != 0) ||
(n.UU.val < n2.UU.val && (unsigned long)k < 32 &&
((1L << ((long)k)) & ((1L << ((long)toklt)) |
(1L << ((long)tokle)) | (1L << ((long)tokne)))) != 0) ||
(n.UU.val > n2.UU.val && (unsigned long)k < 32 &&
((1L << ((long)k)) & ((1L << ((long)tokgt)) |
(1L << ((long)tokge)) | (1L << ((long)tokne)))) != 0));
/* p2c: dist/examples/basic.p, line 2175: Note:
* Line breaker spent 0.0+9.00 seconds, 5000 tries on line 1568 [251] */
n.stringval = false;
n.UU.val = f;
}
return n;
}
Local valrec andexpr(LINK)
struct LOC_exec *LINK;
{
valrec n, n2;
n = relexpr(LINK);
while (LINK->t != NULL && LINK->t->kind == tokand) {
LINK->t = LINK->t->next;
n2 = relexpr(LINK);
if (n.stringval || n2.stringval)
tmerr();
n.UU.val = ((long)n.UU.val) & ((long)n2.UU.val);
}
return n;
}
Local valrec expr(LINK)
struct LOC_exec *LINK;
{
valrec n, n2;
short k;
n = andexpr(LINK);
while (LINK->t != NULL && (unsigned long)LINK->t->kind < 32 &&
((1L << ((long)LINK->t->kind)) &
((1L << ((long)tokor)) | (1L << ((long)tokxor)))) != 0) {
k = LINK->t->kind;
LINK->t = LINK->t->next;
n2 = andexpr(LINK);
if (n.stringval || n2.stringval)
tmerr();
if (k == tokor)
n.UU.val = ((long)n.UU.val) | ((long)n2.UU.val);
else
n.UU.val = ((long)n.UU.val) ^ ((long)n2.UU.val);
}
return n;
}
Local Void checkextra(LINK)
struct LOC_exec *LINK;
{
if (LINK->t != NULL)
errormsg("Extra information on line");
}
Local boolean iseos(LINK)
struct LOC_exec *LINK;
{
return (LINK->t == NULL || LINK->t->kind == tokelse ||
LINK->t->kind == tokcolon);
}
Local Void skiptoeos(LINK)
struct LOC_exec *LINK;
{
while (!iseos(LINK))
LINK->t = LINK->t->next;
}
Local linerec *findline(n, LINK)
long n;
struct LOC_exec *LINK;
{
linerec *l;
l = linebase;
while (l != NULL && l->num != n)
l = l->next;
return l;
}
Local linerec *mustfindline(n, LINK)
long n;
struct LOC_exec *LINK;
{
linerec *l;
l = findline(n, LINK);
if (l == NULL)
errormsg("Undefined line");
return l;
}
Local Void cmdend(LINK)
struct LOC_exec *LINK;
{
stmtline = NULL;
LINK->t = NULL;
}
Local Void cmdnew(LINK)
struct LOC_exec *LINK;
{
Anyptr p;
cmdend(LINK);
clearloops();
restoredata();
while (linebase != NULL) {
p = (Anyptr)linebase->next;
disposetokens(&linebase->txt);
Free(linebase);
linebase = (linerec *)p;
}
while (varbase != NULL) {
p = (Anyptr)varbase->next;
if (varbase->stringvar) {
if (*varbase->UU.U1.sval != NULL)
Free(*varbase->UU.U1.sval);
}
Free(varbase);
varbase = (varrec *)p;
}
}
Local Void cmdlist(LINK)
struct LOC_exec *LINK;
{
linerec *l;
long n1, n2;
do {
n1 = 0;
n2 = LONG_MAX;
if (LINK->t != NULL && LINK->t->kind == toknum) {
n1 = (long)LINK->t->UU.num;
LINK->t = LINK->t->next;
if (LINK->t == NULL || LINK->t->kind != tokminus)
n2 = n1;
}
if (LINK->t != NULL && LINK->t->kind == tokminus) {
LINK->t = LINK->t->next;
if (LINK->t != NULL && LINK->t->kind == toknum) {
n2 = (long)LINK->t->UU.num;
LINK->t = LINK->t->next;
} else
n2 = LONG_MAX;
}
l = linebase;
while (l != NULL && l->num <= n2) {
if (l->num >= n1) {
printf("%ld ", l->num);
listtokens(stdout, l->txt);
putchar('\n');
}
l = l->next;
}
if (!iseos(LINK))
require(tokcomma, LINK);
} while (!iseos(LINK));
}
Local Void cmdload(merging, name, LINK)
boolean merging;
Char *name;
struct LOC_exec *LINK;
{
FILE *f;
tokenrec *buf;
Char STR1[256];
Char *TEMP;
f = NULL;
if (!merging)
cmdnew(LINK);
if (f != NULL) {
sprintf(STR1, "%s.TEXT", name);
f = freopen(STR1, "r", f);
} else {
sprintf(STR1, "%s.TEXT", name);
f = fopen(STR1, "r");
}
if (f == NULL)
_EscIO(FileNotFound);
while (fgets(inbuf, 256, f) != NULL) {
TEMP = strchr(inbuf, '\n');
if (TEMP != NULL)
*TEMP = 0;
parseinput(&buf);
if (curline == 0) {
printf("Bad line in file\n");
disposetokens(&buf);
}
}
if (f != NULL)
fclose(f);
f = NULL;
if (f != NULL)
fclose(f);
}
Local Void cmdrun(LINK)
struct LOC_exec *LINK;
{
linerec *l;
long i;
string255 s;
l = linebase;
if (!iseos(LINK)) {
if (LINK->t->kind == toknum)
l = mustfindline(intexpr(LINK), LINK);
else {
stringexpr(s, LINK);
i = 0;
if (!iseos(LINK)) {
require(tokcomma, LINK);
i = intexpr(LINK);
}
checkextra(LINK);
cmdload(false, s, LINK);
if (i == 0)
l = linebase;
else
l = mustfindline(i, LINK);
}
}
stmtline = l;
LINK->gotoflag = true;
clearvars();
clearloops();
restoredata();
}
Local Void cmdsave(LINK)
struct LOC_exec *LINK;
{
FILE *f;
linerec *l;
Char STR1[256], STR2[256];
f = NULL;
if (f != NULL) {
sprintf(STR2, "%s.TEXT", stringexpr(STR1, LINK));
f = freopen(STR2, "w", f);
} else {
sprintf(STR2, "%s.TEXT", stringexpr(STR1, LINK));
f = fopen(STR2, "w");
}
if (f == NULL)
_EscIO(FileNotFound);
l = linebase;
while (l != NULL) {
fprintf(f, "%ld ", l->num);
listtokens(f, l->txt);
putc('\n', f);
l = l->next;
}
if (f != NULL)
fclose(f);
f = NULL;
if (f != NULL)
fclose(f);
}
Local Void cmdbye(LINK)
struct LOC_exec *LINK;
{
exitflag = true;
}
Local Void cmddel(LINK)
struct LOC_exec *LINK;
{
linerec *l, *l0, *l1;
long n1, n2;
do {
if (iseos(LINK))
snerr();
n1 = 0;
n2 = LONG_MAX;
if (LINK->t != NULL && LINK->t->kind == toknum) {
n1 = (long)LINK->t->UU.num;
LINK->t = LINK->t->next;
if (LINK->t == NULL || LINK->t->kind != tokminus)
n2 = n1;
}
if (LINK->t != NULL && LINK->t->kind == tokminus) {
LINK->t = LINK->t->next;
if (LINK->t != NULL && LINK->t->kind == toknum) {
n2 = (long)LINK->t->UU.num;
LINK->t = LINK->t->next;
} else
n2 = LONG_MAX;
}
l = linebase;
l0 = NULL;
while (l != NULL && l->num <= n2) {
l1 = l->next;
if (l->num >= n1) {
if (l == stmtline) {
cmdend(LINK);
clearloops();
restoredata();
}
if (l0 == NULL)
linebase = l->next;
else
l0->next = l->next;
disposetokens(&l->txt);
Free(l);
} else
l0 = l;
l = l1;
}
if (!iseos(LINK))
require(tokcomma, LINK);
} while (!iseos(LINK));
}
Local Void cmdrenum(LINK)
struct LOC_exec *LINK;
{
linerec *l, *l1;
tokenrec *tok;
long lnum, step;
lnum = 10;
step = 10;
if (!iseos(LINK)) {
lnum = intexpr(LINK);
if (!iseos(LINK)) {
require(tokcomma, LINK);
step = intexpr(LINK);
}
}
l = linebase;
if (l == NULL)
return;
while (l != NULL) {
l->num2 = lnum;
lnum += step;
l = l->next;
}
l = linebase;
do {
tok = l->txt;
do {
if (tok->kind == tokdel || tok->kind == tokrestore ||
tok->kind == toklist || tok->kind == tokrun ||
tok->kind == tokelse || tok->kind == tokthen ||
tok->kind == tokgosub || tok->kind == tokgoto) {
while (tok->next != NULL && tok->next->kind == toknum) {
tok = tok->next;
lnum = (long)floor(tok->UU.num + 0.5);
l1 = linebase;
while (l1 != NULL && l1->num != lnum)
l1 = l1->next;
if (l1 == NULL)
printf("Undefined line %ld in line %ld\n", lnum, l->num2);
else
tok->UU.num = l1->num2;
if (tok->next != NULL && tok->next->kind == tokcomma)
tok = tok->next;
}
}
tok = tok->next;
} while (tok != NULL);
l = l->next;
} while (l != NULL);
l = linebase;
while (l != NULL) {
l->num = l->num2;
l = l->next;
}
}
Local Void cmdprint(LINK)
struct LOC_exec *LINK;
{
boolean semiflag;
valrec n;
Char STR1[256];
semiflag = false;
while (!iseos(LINK)) {
semiflag = false;
if ((unsigned long)LINK->t->kind < 32 &&
((1L << ((long)LINK->t->kind)) &
((1L << ((long)toksemi)) | (1L << ((long)tokcomma)))) != 0) {
semiflag = true;
LINK->t = LINK->t->next;
continue;
}
n = expr(LINK);
if (n.stringval) {
fputs(n.UU.sval, stdout);
Free(n.UU.sval);
} else
printf("%s ", numtostr(STR1, n.UU.val));
}
if (!semiflag)
putchar('\n');
}
Local Void cmdinput(LINK)
struct LOC_exec *LINK;
{
varrec *v;
string255 s;
tokenrec *tok, *tok0, *tok1;
boolean strflag;
if (LINK->t != NULL && LINK->t->kind == tokstr) {
fputs(LINK->t->UU.sp, stdout);
LINK->t = LINK->t->next;
require(toksemi, LINK);
} else
printf("? ");
tok = LINK->t;
if (LINK->t == NULL || LINK->t->kind != tokvar)
snerr();
strflag = LINK->t->UU.vp->stringvar;
do {
if (LINK->t != NULL && LINK->t->kind == tokvar) {
if (LINK->t->UU.vp->stringvar != strflag)
snerr();
}
LINK->t = LINK->t->next;
} while (!iseos(LINK));
LINK->t = tok;
if (strflag) {
do {
gets(s);
v = findvar(LINK);
if (*v->UU.U1.sval != NULL)
Free(*v->UU.U1.sval);
*v->UU.U1.sval = (Char *)Malloc(256);
strcpy(*v->UU.U1.sval, s);
if (!iseos(LINK)) {
require(tokcomma, LINK);
printf("?? ");
}
} while (!iseos(LINK));
return;
}
gets(s);
parse(s, &tok);
tok0 = tok;
do {
v = findvar(LINK);
while (tok == NULL) {
printf("?? ");
gets(s);
disposetokens(&tok0);
parse(s, &tok);
tok0 = tok;
}
tok1 = LINK->t;
LINK->t = tok;
*v->UU.U0.val = realexpr(LINK);
if (LINK->t != NULL) {
if (LINK->t->kind == tokcomma)
LINK->t = LINK->t->next;
else
snerr();
}
tok = LINK->t;
LINK->t = tok1;
if (!iseos(LINK))
require(tokcomma, LINK);
} while (!iseos(LINK));
disposetokens(&tok0);
}
Local Void cmdlet(implied, LINK)
boolean implied;
struct LOC_exec *LINK;
{
varrec *v;
Char *old;
if (implied)
LINK->t = stmttok;
v = findvar(LINK);
require(tokeq, LINK);
if (!v->stringvar) {
*v->UU.U0.val = realexpr(LINK);
return;
}
old = *v->UU.U1.sval;
*v->UU.U1.sval = strexpr(LINK);
if (old != NULL)
Free(old);
}
Local Void cmdgoto(LINK)
struct LOC_exec *LINK;
{
stmtline = mustfindline(intexpr(LINK), LINK);
LINK->t = NULL;
LINK->gotoflag = true;
}
Local Void cmdif(LINK)
struct LOC_exec *LINK;
{
double n;
long i;
n = realexpr(LINK);
require(tokthen, LINK);
if (n == 0) {
i = 0;
do {
if (LINK->t != NULL) {
if (LINK->t->kind == tokif)
i++;
if (LINK->t->kind == tokelse)
i--;
LINK->t = LINK->t->next;
}
} while (LINK->t != NULL && i >= 0);
}
if (LINK->t != NULL && LINK->t->kind == toknum)
cmdgoto(LINK);
else
LINK->elseflag = true;
}
Local Void cmdelse(LINK)
struct LOC_exec *LINK;
{
LINK->t = NULL;
}
Local boolean skiploop(up, dn, LINK)
short up, dn;
struct LOC_exec *LINK;
{
boolean Result;
long i;
linerec *saveline;
saveline = stmtline;
i = 0;
do {
while (LINK->t == NULL) {
if (stmtline == NULL || stmtline->next == NULL) {
Result = false;
stmtline = saveline;
goto _L1;
}
stmtline = stmtline->next;
LINK->t = stmtline->txt;
}
if (LINK->t->kind == up)
i++;
if (LINK->t->kind == dn)
i--;
LINK->t = LINK->t->next;
} while (i >= 0);
Result = true;
_L1:
return Result;
}
Local Void cmdfor(LINK)
struct LOC_exec *LINK;
{
looprec *l, lr;
linerec *saveline;
long i, j;
lr.UU.U0.vp = findvar(LINK);
if (lr.UU.U0.vp->stringvar)
snerr();
require(tokeq, LINK);
*lr.UU.U0.vp->UU.U0.val = realexpr(LINK);
require(tokto, LINK);
lr.UU.U0.max = realexpr(LINK);
if (LINK->t != NULL && LINK->t->kind == tokstep) {
LINK->t = LINK->t->next;
lr.UU.U0.step = realexpr(LINK);
} else
lr.UU.U0.step = 1.0;
lr.homeline = stmtline;
lr.hometok = LINK->t;
lr.kind = forloop;
lr.next = loopbase;
if (lr.UU.U0.step >= 0 && *lr.UU.U0.vp->UU.U0.val > lr.UU.U0.max ||
lr.UU.U0.step <= 0 && *lr.UU.U0.vp->UU.U0.val < lr.UU.U0.max) {
saveline = stmtline;
i = 0;
j = 0;
do {
while (LINK->t == NULL) {
if (stmtline == NULL || stmtline->next == NULL) {
stmtline = saveline;
errormsg("FOR without NEXT");
}
stmtline = stmtline->next;
LINK->t = stmtline->txt;
}
if (LINK->t->kind == tokfor) {
if (LINK->t->next != NULL && LINK->t->next->kind == tokvar &&
LINK->t->next->UU.vp == lr.UU.U0.vp)
j++;
else
i++;
}
if (LINK->t->kind == toknext) {
if (LINK->t->next != NULL && LINK->t->next->kind == tokvar &&
LINK->t->next->UU.vp == lr.UU.U0.vp)
j--;
else
i--;
}
LINK->t = LINK->t->next;
} while (i >= 0 && j >= 0);
skiptoeos(LINK);
return;
}
l = (looprec *)Malloc(sizeof(looprec));
*l = lr;
loopbase = l;
}
Local Void cmdnext(LINK)
struct LOC_exec *LINK;
{
varrec *v;
boolean found;
looprec *l, *WITH;
if (!iseos(LINK))
v = findvar(LINK);
else
v = NULL;
do {
if (loopbase == NULL || loopbase->kind == gosubloop)
errormsg("NEXT without FOR");
found = (loopbase->kind == forloop &&
(v == NULL || loopbase->UU.U0.vp == v));
if (!found) {
l = loopbase->next;
Free(loopbase);
loopbase = l;
}
} while (!found);
WITH = loopbase;
*WITH->UU.U0.vp->UU.U0.val += WITH->UU.U0.step;
if ((WITH->UU.U0.step < 0 || *WITH->UU.U0.vp->UU.U0.val <= WITH->UU.U0.max) &&
(WITH->UU.U0.step > 0 || *WITH->UU.U0.vp->UU.U0.val >= WITH->UU.U0.max)) {
stmtline = WITH->homeline;
LINK->t = WITH->hometok;
return;
}
l = loopbase->next;
Free(loopbase);
loopbase = l;
}
Local Void cmdwhile(LINK)
struct LOC_exec *LINK;
{
looprec *l;
l = (looprec *)Malloc(sizeof(looprec));
l->next = loopbase;
loopbase = l;
l->kind = whileloop;
l->homeline = stmtline;
l->hometok = LINK->t;
if (iseos(LINK))
return;
if (realexpr(LINK) != 0)
return;
if (!skiploop(tokwhile, tokwend, LINK))
errormsg("WHILE without WEND");
l = loopbase->next;
Free(loopbase);
loopbase = l;
skiptoeos(LINK);
}
Local Void cmdwend(LINK)
struct LOC_exec *LINK;
{
tokenrec *tok;
linerec *tokline;
looprec *l;
boolean found;
do {
if (loopbase == NULL || loopbase->kind == gosubloop)
errormsg("WEND without WHILE");
found = (loopbase->kind == whileloop);
if (!found) {
l = loopbase->next;
Free(loopbase);
loopbase = l;
}
} while (!found);
if (!iseos(LINK)) {
if (realexpr(LINK) != 0)
found = false;
}
tok = LINK->t;
tokline = stmtline;
if (found) {
stmtline = loopbase->homeline;
LINK->t = loopbase->hometok;
if (!iseos(LINK)) {
if (realexpr(LINK) == 0)
found = false;
}
}
if (found)
return;
LINK->t = tok;
stmtline = tokline;
l = loopbase->next;
Free(loopbase);
loopbase = l;
}
Local Void cmdgosub(LINK)
struct LOC_exec *LINK;
{
looprec *l;
l = (looprec *)Malloc(sizeof(looprec));
l->next = loopbase;
loopbase = l;
l->kind = gosubloop;
l->homeline = stmtline;
l->hometok = LINK->t;
cmdgoto(LINK);
}
Local Void cmdreturn(LINK)
struct LOC_exec *LINK;
{
looprec *l;
boolean found;
do {
if (loopbase == NULL)
errormsg("RETURN without GOSUB");
found = (loopbase->kind == gosubloop);
if (!found) {
l = loopbase->next;
Free(loopbase);
loopbase = l;
}
} while (!found);
stmtline = loopbase->homeline;
LINK->t = loopbase->hometok;
l = loopbase->next;
Free(loopbase);
loopbase = l;
skiptoeos(LINK);
}
Local Void cmdread(LINK)
struct LOC_exec *LINK;
{
varrec *v;
tokenrec *tok;
boolean found;
do {
v = findvar(LINK);
tok = LINK->t;
LINK->t = datatok;
if (dataline == NULL) {
dataline = linebase;
LINK->t = dataline->txt;
}
if (LINK->t == NULL || LINK->t->kind != tokcomma) {
do {
while (LINK->t == NULL) {
if (dataline == NULL || dataline->next == NULL)
errormsg("Out of Data");
dataline = dataline->next;
LINK->t = dataline->txt;
}
found = (LINK->t->kind == tokdata);
LINK->t = LINK->t->next;
} while (!found || iseos(LINK));
} else
LINK->t = LINK->t->next;
if (v->stringvar) {
if (*v->UU.U1.sval != NULL)
Free(*v->UU.U1.sval);
*v->UU.U1.sval = strexpr(LINK);
} else
*v->UU.U0.val = realexpr(LINK);
datatok = LINK->t;
LINK->t = tok;
if (!iseos(LINK))
require(tokcomma, LINK);
} while (!iseos(LINK));
}
Local Void cmddata(LINK)
struct LOC_exec *LINK;
{
skiptoeos(LINK);
}
Local Void cmdrestore(LINK)
struct LOC_exec *LINK;
{
if (iseos(LINK))
restoredata();
else {
dataline = mustfindline(intexpr(LINK), LINK);
datatok = dataline->txt;
}
}
Local Void cmdgotoxy(LINK)
struct LOC_exec *LINK;
{
long i;
i = intexpr(LINK);
require(tokcomma, LINK);
}
Local Void cmdon(LINK)
struct LOC_exec *LINK;
{
long i;
looprec *l;
i = intexpr(LINK);
if (LINK->t != NULL && LINK->t->kind == tokgosub) {
l = (looprec *)Malloc(sizeof(looprec));
l->next = loopbase;
loopbase = l;
l->kind = gosubloop;
l->homeline = stmtline;
l->hometok = LINK->t;
LINK->t = LINK->t->next;
} else
require(tokgoto, LINK);
if (i < 1) {
skiptoeos(LINK);
return;
}
while (i > 1 && !iseos(LINK)) {
require(toknum, LINK);
if (!iseos(LINK))
require(tokcomma, LINK);
i--;
}
if (!iseos(LINK))
cmdgoto(LINK);
}
Local Void cmddim(LINK)
struct LOC_exec *LINK;
{
long i, j, k;
varrec *v;
boolean done;
do {
if (LINK->t == NULL || LINK->t->kind != tokvar)
snerr();
v = LINK->t->UU.vp;
LINK->t = LINK->t->next;
if (v->numdims != 0)
errormsg("Array already dimensioned");
j = 1;
i = 0;
require(toklp, LINK);
do {
k = intexpr(LINK) + 1;
if (k < 1)
badsubscr();
if (i >= maxdims)
badsubscr();
i++;
v->dims[i - 1] = k;
j *= k;
done = (LINK->t != NULL && LINK->t->kind == tokrp);
if (!done)
require(tokcomma, LINK);
} while (!done);
LINK->t = LINK->t->next;
v->numdims = i;
if (v->stringvar) {
v->UU.U1.sarr = (Char **)Malloc(j * 4);
for (i = 0; i < j; i++)
v->UU.U1.sarr[i] = NULL;
} else {
v->UU.U0.arr = (double *)Malloc(j * 8);
for (i = 0; i < j; i++)
v->UU.U0.arr[i] = 0.0;
}
if (!iseos(LINK))
require(tokcomma, LINK);
} while (!iseos(LINK));
}
Local Void cmdpoke(LINK)
struct LOC_exec *LINK;
{
union {
long i;
Char *c;
} trick;
/* p2c: dist/examples/basic.p, line 2073:
* Note: Range checking is OFF [216] */
trick.i = intexpr(LINK);
require(tokcomma, LINK);
*trick.c = (Char)intexpr(LINK);
/* p2c: dist/examples/basic.p, line 2077:
* Note: Range checking is ON [216] */
}
Static Void exec()
{
struct LOC_exec V;
Char *ioerrmsg;
Char STR1[256];
TRY(try1);
do {
do {
V.gotoflag = false;
V.elseflag = false;
while (stmttok != NULL && stmttok->kind == tokcolon)
stmttok = stmttok->next;
V.t = stmttok;
if (V.t != NULL) {
V.t = V.t->next;
switch (stmttok->kind) {
case tokrem:
/* blank case */
break;
case toklist:
cmdlist(&V);
break;
case tokrun:
cmdrun(&V);
break;
case toknew:
cmdnew(&V);
break;
case tokload:
cmdload(false, stringexpr(STR1, &V), &V);
break;
case tokmerge:
cmdload(true, stringexpr(STR1, &V), &V);
break;
case toksave:
cmdsave(&V);
break;
case tokbye:
cmdbye(&V);
break;
case tokdel:
cmddel(&V);
break;
case tokrenum:
cmdrenum(&V);
break;
case toklet:
cmdlet(false, &V);
break;
case tokvar:
cmdlet(true, &V);
break;
case tokprint:
cmdprint(&V);
break;
case tokinput:
cmdinput(&V);
break;
case tokgoto:
cmdgoto(&V);
break;
case tokif:
cmdif(&V);
break;
case tokelse:
cmdelse(&V);
break;
case tokend:
cmdend(&V);
break;
case tokstop:
P_escapecode = -20;
goto _Ltry1;
break;
case tokfor:
cmdfor(&V);
break;
case toknext:
cmdnext(&V);
break;
case tokwhile:
cmdwhile(&V);
break;
case tokwend:
cmdwend(&V);
break;
case tokgosub:
cmdgosub(&V);
break;
case tokreturn:
cmdreturn(&V);
break;
case tokread:
cmdread(&V);
break;
case tokdata:
cmddata(&V);
break;
case tokrestore:
cmdrestore(&V);
break;
case tokgotoxy:
cmdgotoxy(&V);
break;
case tokon:
cmdon(&V);
break;
case tokdim:
cmddim(&V);
break;
case tokpoke:
cmdpoke(&V);
break;
default:
errormsg("Illegal command");
break;
}
}
if (!V.elseflag && !iseos(&V))
checkextra(&V);
stmttok = V.t;
} while (V.t != NULL);
if (stmtline != NULL) {
if (!V.gotoflag)
stmtline = stmtline->next;
if (stmtline != NULL)
stmttok = stmtline->txt;
}
} while (stmtline != NULL);
RECOVER2(try1,_Ltry1);
if (P_escapecode == -20)
printf("Break");
else if (P_escapecode != 42) {
switch (P_escapecode) {
case -4:
printf("\007Integer overflow");
break;
case -5:
printf("\007Divide by zero");
break;
case -6:
printf("\007Real math overflow");
break;
case -7:
printf("\007Real math underflow");
break;
case -8:
case -19:
case -18:
case -17:
case -16:
case -15:
printf("\007Value range error");
break;
case -10:
ioerrmsg = (Char *)Malloc(256);
sprintf(ioerrmsg, "I/O Error %d", (int)P_ioresult);
printf("\007%s", ioerrmsg);
Free(ioerrmsg);
break;
default:
if (EXCP_LINE != -1)
printf("%12ld\n", EXCP_LINE);
_Escape(P_escapecode);
break;
}
}
if (stmtline != NULL)
printf(" in %ld", stmtline->num);
putchar('\n');
ENDTRY(try1);
} /*exec*/
main(argc, argv)
int argc;
Char *argv[];
{ /*main*/
PASCAL_MAIN(argc, argv);
inbuf = (Char *)Malloc(256);
linebase = NULL;
varbase = NULL;
loopbase = NULL;
printf("Chipmunk BASIC 1.0\n\n");
exitflag = false;
do {
TRY(try2);
do {
putchar('>');
gets(inbuf);
parseinput(&buf);
if (curline == 0) {
stmtline = NULL;
stmttok = buf;
if (stmttok != NULL)
exec();
disposetokens(&buf);
}
} while (!(exitflag || P_eof(stdin)));
RECOVER(try2);
if (P_escapecode != -20)
printf("Error %d/%d!\n", (int)P_escapecode, (int)P_ioresult);
else
putchar('\n');
ENDTRY(try2);
} while (!(exitflag || P_eof(stdin)));
exit(EXIT_SUCCESS);
}
/* End. */