void
gread_string (gread_state *state)
{
int c = gget ();
switch (c) {
case EOF:
gerror ();
case '"':
{
gstring *string = New gstring (*(state->chars));
delete state->chars;
delete state;
greturn (string);
}
case '\\':
c = gget ();
switch (c) {
case EOF:
gerror ();
case 'n':
state->chars->append ('\n');
ggoto (gread_string, state);
}
// else fall through
default:
state->chars->append (c);
ggoto (gread_string, state);
}
}
void
gread_list (gread_state *state)
{
if (gread_res) {
gpair *newpair = New gpair (gread_res, bottom);
gpair *head = state->list.elms;
gpair *tail = state->list.elmstail;
if (tail) {
tail->cdr = newpair;
tail = newpair;
}
else
head = tail = newpair;
state->list.elms = head;
state->list.elmstail = tail;
}
consume_whitespace ();
int c = gget ();
switch (c) {
case EOF:
gerror ();
case ')':
{
gpair *elms = state->list.elms;
delete state;
if (elms)
greturn (elms);
else
greturn (bottom);
}
default:
gunget (c);
gpush (gread_list, state);
ggoto (gread_gob, NULL);
}
}
void
gread_symbol (gread_state *state)
{
int c = gget ();
if (issymbolchar (c)) {
state->chars->append (tolower (c));
ggoto (gread_symbol, state);
}
else {
gunget (c);
gsymbol *sym = g_symbol (*(state->chars));
delete state->chars;
delete state;
greturn (sym);
}
}
void
gread_integer (gread_state *state)
{
int c = gget ();
if (isdigit (c)) {
state->chars->append (c);
ggoto (gread_integer, state);
}
else {
gunget (c);
// XX: strtoul?
ginteger *num = New ginteger (atol (state->chars->cstr ()));
delete state->chars;
delete state;
greturn (num);
}
}
int run_program(char* p_buf){
int i;
// I REMOVED THIS AND PUT IT IN FRONT OF THE CALL...
//NMS-REMOVAL init_namespace();// Do you need it? May be you want to use the same namespace
prog = p_buf;
scan_labels(); /* find the labels in the program */
ftos = 0; /* initialize the FOR stack index */
gtos = 0; /* initialize the GOSUB stack index */
do {
bas_token_type = get_token();
// printf("ttype=%d bas_tok=%d <%s>\n", bas_token_type, bas_tok, bas_token);
/* check for assignment statement */
if(bas_token_type==VARIABLE) {
putback(); /* return the var to the input stream */
assignment(); /* must be assignment statement */
}
else /* is command */
switch(bas_tok) {
case PRINT:
print();
break;
case GOTO:
exec_goto();
break;
case IF:
exec_if();
break;
case FOR:
exec_for();
break;
case NEXT:
next();
break;
case INPUT:
input();
break;
case GOSUB:
gosub();
break;
case RETURN:
greturn();
break;
case COMMENT:
do{
get_token();
if(bas_tok==EOL || bas_tok==FINISHED) break;
} while (1==1);
break;
case CONTINUE:
do{
get_token();
if(bas_tok==EOL || bas_tok==FINISHED) break;
} while (1==1);
break;
case END:
printf("variables----------------------------%s\n","");
for (i=0;i<varnamelast;i++){
printf("%14s - %19.7f\n", varname[i] , variables[i] );
}
exit(0);
}
} while (bas_tok != FINISHED);
return 0;
}// run_program
void
genstmt(NODE *n)
{
VREG *muuo_ac;
if (n == NULL) return;
switch (n->Nop) {
case N_STATEMENT:
{ NODE *beg, *next;
if (n->Nleft && n->Nleft->Nop == N_DATA) { /* Check for auto inits */
genadata(n->Nleft); /* Yep, do them */
n = n->Nright; /* then move on to real statements */
}
for(beg = n; n != NULL; n = n->Nright) {
if(n->Nop != N_STATEMENT)
int_error("genstmt: bad stmt %N", n);
if(n->Nleft == NULL) continue;
/* Check out following stmt for possible optimizations */
if(n->Nright && (next = n->Nright->Nleft) != NULL && optgen) {
switch(next->Nop) {
/* Hack to encourage tail recursion */
case Q_RETURN: /* If next will be RETURN */
if(next->Nright == NULL) { /* and has no return val */
NODE *v; /* Then try to optimize */
if((v = laststmt(n->Nleft)) != NULL && v->Nop == N_FNCALL)
v->Nflag |= NF_RETEXPR;
}
break;
/* If next stmt is a GOTO, ensure that any jumps
* within current stmt to end of stmt will
* instead go directly to object of the GOTO.
* Avoids jumping to jumps...
* We do a similar hack for BREAK and CONTINUE,
* which are similar to GOTOs except that their
* destination is kept in variables global to the
* code generation routines.
*/
case Q_CASE: /* Not sure about this one yet */
case N_LABEL:
case Q_GOTO:
n->Nleft->Nendlab = next->Nxfsym;
break;
case Q_BREAK:
n->Nleft->Nendlab = brklabel;
break;
case Q_CONTINUE:
n->Nleft->Nendlab = looplabel;
break;
default:
; /* do nothing */
} /* end of Nop switch */
} /* end of next-stmt check */
/* Optimize label usage */
if(n->Nright == NULL /* If this is last stmt in list */
&& optgen)
n->Nleft->Nendlab = beg->Nendlab; /* Copy from 1st */
genstmt(n->Nleft);
}
break;
} /* end of N_STATEMENT case block */
case Q_CASE:
codlabel(n->Nxfsym); /* send forward label */
n->Nleft->Nendlab = n->Nendlab; /* propagate end label */
genstmt (n->Nleft); /* finish rest of body */
break;
case N_LABEL:
if (n->Nxfsym->Sname[0] == '%' && isdigit(n->Nxfsym->Sname[1]))
code_debugcall(n);
else
codgolab(n->Nxfsym); /* send goto label */
n->Nleft->Nendlab = n->Nendlab; /* propagate end label */
genstmt(n->Nleft); /* finish rest of body */
break;
case Q_BREAK: code6(P_JRST, NULL, brklabel); break;
case Q_GOTO: code6(P_JRST, NULL, n->Nxfsym); break;
case Q_CONTINUE: code6(P_JRST, NULL, looplabel); break;
case Q_DO: gdo(n); break;
case Q_FOR: gfor(n); break;
case Q_IF: gif(n); break;
case Q_RETURN: greturn(n); break;
case Q_SWITCH: gswitch(n); break;
case Q_WHILE: gwhile(n); break;
#if SYS_CSI /* Added 1/91 for in-line monitor calls; KAR */
case Q_MUUO:
muuo_ac = gmuuo(n);
vrfree(muuo_ac);
break;
#endif
case N_EXPRLIST: /* Same as expression stmt */
default: /* None of above, assume expression stmt */
genxrelease(n); /* Generate it and flush any result */
break;
}
}
