From: Eric S. Raymond Date: Mon, 7 Nov 1994 18:54:27 +0000 (+0000) Subject: One long step towards control-structure interpretation. X-Git-Tag: 1-2~59 X-Git-Url: http://thyrsus.com/gitweb/?a=commitdiff_plain;h=6490b265f6646a566adccb9b71c900665268ad0e;p=cupl.git One long step towards control-structure interpretation. --- diff --git a/cupl.h b/cupl.h index 5b06362..dc9c8d2 100644 --- a/cupl.h +++ b/cupl.h @@ -55,6 +55,8 @@ typedef struct edon /* back-pointer to the symbol list, set if the node is an identifier */ struct lvar_t *syminf; + /* statement node only */ + struct edon *endnode; /* end node address, if block label */ #ifdef PARSEDEBUG int number; /* statement number, if this is a STATEMENT node */ #endif /* PARSEDEBUG */ @@ -79,7 +81,6 @@ typedef struct lvar_t node *node; /* variable's symbol info */ value value; /* variable's value */ node *target; /* target node, if label */ - node *endnode; /* end node address, if block label */ /* information used for consistency checks */ int blabeldef; diff --git a/cupl.y b/cupl.y index c8fb373..9aa551f 100644 --- a/cupl.y +++ b/cupl.y @@ -79,8 +79,9 @@ static int statement_count; %token ITERATE %token FROM -%type prog command cond simple guard perform iter expr rel alloc subscr -%type datal ditem expl readl writel witem allocl varlist minl maxl +%type prog command cond simple guard perform gosub iter expr rel alloc +%type subscr datal ditem expl readl writel witem allocl varlist +%type minl maxl %% /* beginning of rules section */ @@ -132,16 +133,17 @@ datal : ditem ',' datal {$$ = cons(DATA, $1, $3);} | ditem {$$ = cons(DATA, $1, NULLNODE);} ; -perform : PERFORM IDENTIFIER - {$$ = cons(PERFORM, $2, NULLNODE);} - | PERFORM IDENTIFIER expr TIMES - {$$ = cons(TIMES, $2, $3);} - | PERFORM IDENTIFIER WHILE guard - {$$ = cons(WHILE, $2, $4);} - | PERFORM IDENTIFIER FOR IDENTIFIER '=' expl - {$$ = cons(FOR, $2, cons('=', $4, $6));} - | PERFORM IDENTIFIER FOR IDENTIFIER '=' expr iter - {$$ = cons(FOR, $2, cons(ITERATE, $4, cons(FROM, $6, $7)));} +gosub : PERFORM IDENTIFIER {$$ = cons(PERFORM, $2, NULLNODE);} + ; + +perform : gosub {$$ = $1;} + | gosub expr TIMES {$$ = cons(TIMES, $2, $1);} + | gosub WHILE guard {$$ = cons(WHILE, $3, $1);} + + | gosub FOR IDENTIFIER '=' expl + {$$ = cons(FOR, cons('=', $3, $5), $1);} + | gosub FOR IDENTIFIER '=' expr iter + {$$ = cons(FOR, cons(ITERATE, $3, cons(FROM, $5, $6)), $1);} ; iter : TO expr BY expr {$$ = cons(TO, $2, $4);} @@ -161,7 +163,7 @@ expl : expr ',' expl {$$ = cons(FORLIST, $1, $3);} */ guard : rel {$$ = $1;} | rel AND rel {$$ = cons(AND, $1, $3);} - | rel OR rel {$$ = cons(OR, $1, $3);} + | rel OR rel {$$ = cons(OR, $1, $3);} ; rel : expr '=' expr {$$ = cons('=', $1, $3);} diff --git a/execute.c b/execute.c index d338512..f88d64a 100644 --- a/execute.c +++ b/execute.c @@ -23,9 +23,42 @@ support in monitor.c. #define EVAL_WRAP /* empty */ #define RETURN_WRAP(t, l, r, v) display_return(t, l, r, v); -static node *pc; /* the statement node to evaluate next */ +static node *pc; /* pointer to statement being evaluated */ +static node *next; /* the statement node to evaluate next */ static node *data; /* pointer to *DATA item to be grabbed next */ -static jmp_buf jmpbuf; /* termination handling */ +static jmp_buf nextbuf; /* end-of-statement handling */ +static jmp_buf endbuf; /* termination handling */ + +/**************************************************************************** + * + * Stack handling + * + ****************************************************************************/ + +#define STACKSIZE 64 +static node *stack[STACKSIZE], **sp = stack; + +static node *popstack(void) +/* pop the perform stack */ +{ + if (sp <= stack) + die("too many END statements\n"); + return(*sp--); +} + +static void pushstack(node *st) +/* push a return location onto the perform stack */ +{ + if (sp >= stack + STACKSIZE) + die("too many PERFORM calls\n"); + *sp++ = st; +} + +/**************************************************************************** + * + * I/O support + * + ****************************************************************************/ static void cupl_read(node *tp) /* evaluate a READ item */ @@ -81,6 +114,12 @@ static void eval_write(node *tp) cupl_scalar_write(tp->u.string, tp->syminf->value.elements[0]); } +/**************************************************************************** + * + * Interpretation + * + ****************************************************************************/ + static void display_return(node *tree, node *left, node *right, value v) /* display the returned value of a node (for tracing purposes) */ { @@ -275,6 +314,14 @@ static value cupl_eval(node *tree) * Matrix functions */ + case IDN: + /* FIXME: IDN special properties are not implemented */ + die("special properties of IDN are not omplemented\n"); + + case SUBSCRIPT: + /* FIXME: SUBSCRIPT special properties are not implemented */ + die("special properties of subscript are not omplemented\n"); + case DET: rightside = EVAL_WRAP(cupl_eval(tree->cdr)); result = cupl_det(rightside); @@ -413,40 +460,75 @@ static value cupl_eval(node *tree) * Control structures. */ - case WHILE: - do { - (void) cupl_eval(tree->car); + case LABEL: + (void) cupl_eval(tree->cdr); + result.rank = FAIL; + return(result); - cond = cupl_eval(tree->cdr); - } while - (cond.rank); /* conditional values use an odd convention */ + case WHILE: + /* FIXME: implement WHILE */ + die("WHILE is not implemented\n"); result.rank = FAIL; - break; + return(result); case FOR: /* FIXME: implement FOR */ die("FOR is not implemented\n"); + result.rank = FAIL; + return(result); case TIMES: /* FIXME: implement TIMES */ die("TIMES is not implemented\n"); + result.rank = FAIL; + return(result); + + case PERFORM: + next = tree->car; + pushstack(pc->cdr); + longjmp(nextbuf, 1); case BLOCK: - /* FIXME: implement BLOCK */ - die("BLOCK skip is not implemented\n"); + next = pc->endnode->cdr; + longjmp(nextbuf, 1); case GO: - /* FIXME: implement GO TO */ - die("GO TO is not implemented\n"); + next = tree->car; + longjmp(nextbuf, 1); + + case END: + case OG: + next = popstack(); + longjmp(nextbuf, 1); case IF: - /* FIXME: implement IF */ - die("GO TO is not implemented\n"); + leftside = EVAL_WRAP(cupl_eval(tree->car)); + if (leftside.rank) + cupl_eval(tree->cdr); + result.rank == FAIL; + return(result); + + case IFELSE: + leftside = EVAL_WRAP(cupl_eval(tree->car)); + if (leftside.rank) + cupl_eval(tree->cdr->car); + else + cupl_eval(tree->cdr->cdr); + result.rank == FAIL; + return(result); case STOP: - longjmp(jmpbuf, 1); + longjmp(endbuf, 1); /* no fall through */ + /* + * Tracing. + */ + + case WATCH: + /* FIXME: implement WATCH */ + die("WATCH is not implemented\n"); + default: die("unknown node type %d (%s), cannot execute\n", tree->type, @@ -458,7 +540,7 @@ static value cupl_eval(node *tree) void execute(node *tree) /* execute a CUPL program described by a parse tree */ { - node *np, *next, *last; + node *np, *last; lvar *lp; /* initially, all variables are scalars with zero values */ @@ -484,14 +566,15 @@ void execute(node *tree) last->cdr = (node *)NULL; /* first, setjmp so we can use STOP to exit */ - if (setjmp(jmpbuf) != 0) + if (setjmp(endbuf) != 0) return; else /* now execute the program */ for (pc = tree; pc; pc = next) { next = pc->cdr; - (void) cupl_eval(pc->car); + if (setjmp(nextbuf) == 0) + (void) cupl_eval(pc->car); } warn("program terminated without explicit STOP\n"); diff --git a/interpret.c b/interpret.c index cf37fe9..f377be6 100644 --- a/interpret.c +++ b/interpret.c @@ -299,24 +299,31 @@ static void rewrite(node *tree) if (np->car->type == LABEL) np->car->car->syminf->target = np; - /* pull blocks out of the main line */ + /* figure end addresses */ for_cdr(np, tree) { node *sp = np->car; if (sp && sp->type == LABEL && sp->cdr->type == BLOCK) { - node *endnode; + node *ep; bool found = FALSE; - for (endnode = np->cdr; endnode; endnode = endnode->cdr) - if (endnode->car->type == LABEL - && endnode->car->cdr->type == END + for (ep = np->cdr; ep; ep = ep->cdr) + if (ep->car->type == LABEL + && ep->car->cdr->type == END && strcmp(sp->car->u.string, - endnode->car->car->u.string) == 0) + ep->car->car->u.string) == 0) { + /* + * Associate the end node not with the BLOCK node + * itself but with the enclosing statement node. + * that way, we can find the first statement after + * the END by pc->endnode->cdr, where pc is the + * current statement. + */ + np->endnode = ep; found = TRUE; - sp->car->syminf->endnode = endnode; break; } if (!found)