From: Eric S. Raymond Date: Fri, 4 Nov 1994 05:24:53 +0000 (+0000) Subject: Split out nodetype.h. X-Git-Tag: 1-2~78 X-Git-Url: http://thyrsus.com/gitweb/?a=commitdiff_plain;h=caa9637927b69477c1ae21d0fad6ac5fe0a8527f;p=cupl.git Split out nodetype.h. --- diff --git a/Makefile b/Makefile index 01c1423..29f5a8d 100644 --- a/Makefile +++ b/Makefile @@ -6,7 +6,7 @@ CDEBUG = -g YFLAGS = -vlt CFLAGS = $(CDEBUG) -D_POSIX_SOURCE -DYYDEBUG=1 -DPARSEDEBUG -SOURCES = cupl.[ylh] tokdump.c main.c interpret.c execute.c monitor.c +SOURCES = cupl.[ylh] tokdump.c main.c interpret.c execute.c monitor.c nodetype.h MODULES = main.o grammar.o lexer.o interpret.o tokdump.o execute.o monitor.o cupl: $(MODULES) @@ -26,8 +26,8 @@ grammar.o: grammar.c cupl.h tokdump.o: tokdump.c toktab.h lexer.o: lexer.c tokens.h cupl.h interpret.o: interpret.c tokens.h cupl.h -interpret.o: interpret.c tokens.h cupl.h -execute.o: execute.c tokens.h cupl.h +interpret.o: interpret.c tokens.h nodetype.h cupl.h +execute.o: execute.c tokens.h nodetype.h cupl.h monitor.o: monitor.c tokens.h cupl.h toktab.h: tokens.h diff --git a/READ.ME b/READ.ME index 10221fc..91efc38 100644 --- a/READ.ME +++ b/READ.ME @@ -35,6 +35,7 @@ Makefile -- project makefile cupl.y -- the YACC grammar cupl.l -- the LEX lexical-analyzer description cupl.h -- fundamental types and defines +nodetype.h -- macros encoding semantic knowledge about node types tokdump.c -- token-dumper code (used for debugging) interpret.c -- parse tree interpretation execute.c -- actual execution diff --git a/cupl.y b/cupl.y index 1ff74b6..e5c15a8 100644 --- a/cupl.y +++ b/cupl.y @@ -72,7 +72,6 @@ static int statement_count; %token STATEMENT %token VARLIST %token FORLIST -%token DATALIST %token LABEL %token IFELSE %token DIMENSION @@ -113,7 +112,7 @@ command : simple {$$ = $1;} | perform {$$ = $1;} | BLOCK {$$ = cons(BLOCK, NULLNODE, NULLNODE);} | END {$$ = cons(END, NULLNODE, NULLNODE);} - | DATA datal {$$ = cons(DATA, NULLNODE, $2);} + | DATA datal {$$ = $2;} ; cond : IF guard THEN simple @@ -128,9 +127,9 @@ ditem : NUMBER {$$ = $1;} | IDENTIFIER '=' NUMBER {$$ = cons(LET,$1, $3);} ; -datal : ditem ',' datal {$$ = cons(DATALIST, $1, $3);} - | ditem datal {$$ = cons(DATALIST, $1, $2);} - | ditem {$$ = cons(DATALIST, $1, NULLNODE);} +datal : ditem ',' datal {$$ = cons(DATA, $1, $3);} + | ditem datal {$$ = cons(DATA, $1, $2);} + | ditem {$$ = cons(DATA, $1, NULLNODE);} ; perform : PERFORM IDENTIFIER diff --git a/execute.c b/execute.c index 11054f9..c9c2c23 100644 --- a/execute.c +++ b/execute.c @@ -12,17 +12,35 @@ handed off to execute(). *****************************************************************************/ /*LINTLIBRARY*/ +#include #include "cupl.h" #include "tokens.h" +#include "nodetype.h" #define car u.n.left #define cdr u.n.right static node *pc; /* the statement node to evaluate next */ +static node *data; /* pointer to *DATA item to be grabbed next */ static void cupl_read(node *tp) /* evaluate a READ item */ { + if (tp->type != IDENTIFIER) + die("internal error -- garbled READ list\n"); + else + { + value *v = &(tp->syminf->value); + int n; + + for (n = 0; n < v->width * v->depth; n++) + if (ATOMIC(data->car->type)) + { + v->elements[n] = data->car->u.numval; + data = data->cdr; + } + /* code to handle conses expressing check variables goes here */ + } } static void cupl_write(node *tp) @@ -39,7 +57,7 @@ static value cupl_eval(node *tree) switch(tree->type) { case READ: - for_cdr(np, tree->car) + for_cdr(np, tree) cupl_read(np->car); break; @@ -57,15 +75,35 @@ static value cupl_eval(node *tree) void execute(node *tree) /* execute a CUPL program described by a parse tree */ { -#ifdef FOO - node *next; + node *np, *next; + lvar *lp; + + /* initially, all variables are scalars with zero values */ + for_symbols(lp) + { + lp->value.width = lp->value.depth = 1; + lp->value.elements = (scalar *)malloc(sizeof(scalar)); + lp->value.elements[0] = 0; + } + + /* locate the data pointer */ + data = (node *)NULL; + for_cdr(np, tree) + if (np->car->type == DATA) + { + data = np->car; + break; + } + if (!data) + warn("no data supplied\n"); for (pc = tree; pc; pc = next) { next = pc->cdr; (void) cupl_eval(pc->car); } -#endif /* FOO */ } /* execute.c ends here */ + + diff --git a/interpret.c b/interpret.c index 62cbb67..0b3d222 100644 --- a/interpret.c +++ b/interpret.c @@ -15,31 +15,7 @@ of a CUPL parse tree. Actual execution is handed off to execute(). #include #include "cupl.h" #include "tokens.h" - -#define car u.n.left -#define cdr u.n.right - -/* - * Define token classes for consistency checks here. The theory is - * that by separating this from the tree-traversal machinery below, we - * may be able to parametrize for different source languages someday. - */ -/* does the node represent an atom? */ -#define ATOMIC(n) ((n) == IDENTIFIER || (n) == NUMBER || (n) == STRING) -/* does the node reference a statement label? */ -#define SLABELREF(n) ((n) == GO || (n) == OG) -/* does the node reference a block label? */ -#define BLABELREF(n) ((n) == PERFORM || (n) == TIMES || \ - (n) == WHILE || (n) == FOR) -/* does the node set a variable? */ -#define VARSET(n) ((n) == LET || (n) == READ || (n) == ITERATE) -/* does the (non-VARSET) node refer to its left operand? */ -#define LEFTREF(n) ((n) != FOR && (n) != GO && (n) != OG && (n) != LABEL \ - && (n) != ALLOCATE && (n) != WATCH \ - && (n) != ITERATE && (n) != FROM \ - && (n) != TIMES && (n) != WHILE) -/* does the (non-VARSET) node refer to its right operand? */ -#define RIGHTREF(n) ((n) != PERFORM) +#include "nodetype.h" #ifdef PARSEDEBUG /*