From 376c47c98f6f8a2298b38c5bb30ad276cd53724f Mon Sep 17 00:00:00 2001 From: ceriel Date: Sun, 6 Apr 1986 17:42:56 +0000 Subject: [PATCH] newer version, partial parse trees --- lang/m2/comp/Makefile | 18 ++-- lang/m2/comp/declar.g | 67 ++++++++------- lang/m2/comp/def.c | 54 ++++++------ lang/m2/comp/enter.c | 7 +- lang/m2/comp/error.c | 55 +++++++----- lang/m2/comp/expression.g | 173 +++++++++++++++++++++++++++++--------- lang/m2/comp/misc.H | 7 -- lang/m2/comp/misc.c | 16 ---- lang/m2/comp/node.H | 31 +++++++ lang/m2/comp/node.c | 41 +++++++++ lang/m2/comp/program.g | 22 +++-- lang/m2/comp/statement.g | 68 ++++++++++----- lang/m2/comp/type.c | 5 +- 13 files changed, 381 insertions(+), 183 deletions(-) create mode 100644 lang/m2/comp/node.H create mode 100644 lang/m2/comp/node.c diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index 2bff6e5ed..bbd5a93d3 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -17,7 +17,7 @@ LFLAGS = $(PROFILE) LOBJ = tokenfile.o program.o declar.o expression.o statement.o COBJ = LLlex.o LLmessage.o char.o error.o main.o \ symbol2str.o tokenname.o idf.o input.o type.o def.o \ - scope.o misc.o enter.o defmodule.o typequiv.o + scope.o misc.o enter.o defmodule.o typequiv.o node.o OBJ = $(COBJ) $(LOBJ) Lpars.o GENFILES= tokenfile.c \ program.c declar.c expression.c statement.c \ @@ -47,6 +47,7 @@ symbol2str.c: tokenname.c make.tokcase misc.h: misc.H make.allocd def.h: def.H make.allocd type.h: type.H make.allocd +node.h: node.H make.allocd scope.c: scope.C make.allocd char.c: char.tab tab @@ -71,22 +72,23 @@ depend: LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h LLmessage.o: LLlex.h Lpars.h idf.h char.o: class.h -error.o: LLlex.h f_info.h input.h main.h +error.o: LLlex.h f_info.h input.h main.h node.h main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h main.h scope.h standards.h type.h symbol2str.o: Lpars.h tokenname.o: Lpars.h idf.h tokenname.h idf.o: idf.h input.o: f_info.h input.h -type.o: Lpars.h def.h def_sizes.h idf.h misc.h type.h -def.o: Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h +type.o: LLlex.h Lpars.h def.h def_sizes.h idf.h node.h type.h +def.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h scope.o: LLlex.h debug.h def.h idf.h scope.h type.h misc.o: LLlex.h f_info.h idf.h misc.h -enter.o: def.h idf.h misc.h scope.h type.h +enter.o: LLlex.h def.h idf.h node.h scope.h type.h defmodule.o: LLlex.h def.h f_info.h idf.h input.h scope.h typequiv.o: Lpars.h def.h type.h +node.o: LLlex.h def.h node.h type.h tokenfile.o: Lpars.h -program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h -declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h -expression.o: LLlex.h Lpars.h def.h idf.h scope.h +program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h +declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h +expression.o: LLlex.h Lpars.h def.h idf.h node.h scope.h statement.o: Lpars.h Lpars.o: Lpars.h diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 1db02dbc9..09e77d3f6 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -7,11 +7,12 @@ static char *RcsId = "$Header$"; #include #include #include "idf.h" -#include "misc.h" #include "LLlex.h" #include "def.h" #include "type.h" #include "scope.h" +#include "node.h" +#include "misc.h" } ProcedureDeclaration @@ -95,7 +96,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;) ]? ')' { *tp = 0; } - [ ':' qualident(D_TYPE | D_HTYPE, &df, "type") + [ ':' qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0) { *tp = df->df_type; } ]? ; @@ -108,7 +109,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;) */ FPSection(int doparams; struct paramlist **ppr;) { - struct id_list *FPList; + struct node *FPList; struct paramlist *ParamList(); struct type *tp; int VARp = 0; @@ -122,7 +123,7 @@ FPSection(int doparams; struct paramlist **ppr;) EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope); } *ppr = ParamList(FPList, tp); - FreeIdList(FPList); + FreeNode(FPList); } ; @@ -133,7 +134,7 @@ FormalType(struct type **tp;) } : [ ARRAY OF { ARRAYflag = 1; } ]? - qualident(D_TYPE | D_HTYPE, &df, "type") + qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0) { if (ARRAYflag) { *tp = construct_type(ARRAY, NULLTYPE); (*tp)->arr_elem = df->df_type; @@ -182,7 +183,7 @@ SimpleType(struct type **ptp;) struct def *df; struct type *tp; } : - qualident(D_TYPE | D_HTYPE, &df, "type") + qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0) [ /* nothing */ | @@ -202,41 +203,44 @@ SimpleType(struct type **ptp;) enumeration(struct type **ptp;) { - struct id_list *EnumList; + struct node *EnumList; } : '(' IdentList(&EnumList) ')' { *ptp = standard_type(ENUMERATION,int_align,int_size); EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope); - FreeIdList(EnumList); + FreeNode(EnumList); } ; -IdentList(struct id_list **p;) +IdentList(struct node **p;) { - register struct id_list *q = new_id_list(); + register struct node *q; } : - IDENT { q->id_ptr = dot.TOK_IDF; *p = q;} + IDENT { q = MkNode(Value, NULLNODE, NULLNODE, &dot); + *p = q; + } [ - ',' IDENT { q->next = new_id_list(); - q = q->next; - q->id_ptr = dot.TOK_IDF; - } + ',' IDENT + { q->next = MkNode(Value,NULLNODE,NULLNODE,&dot); + q = q->next; + } ]* - { q->next = 0; } + { q->next = 0; } ; SubrangeType(struct type **ptp;) { struct type *tp; + struct node *nd1 = 0, *nd2 = 0; }: /* This is not exactly the rule in the new report, but see the rule for "SimpleType". */ - '[' ConstExpression - UPTO ConstExpression + '[' ConstExpression(&nd1) + UPTO ConstExpression(&nd2) ']' /* Evaluate the expressions. Check that they are indeed constant. @@ -295,7 +299,7 @@ FieldListSequence(struct scope *scope;): FieldList(struct scope *scope;) { - struct id_list *FldList; + struct node *FldList; struct idf *id; struct def *df, *df1; struct type *tp; @@ -303,7 +307,7 @@ FieldList(struct scope *scope;) [ IdentList(&FldList) ':' type(&tp) { EnterIdList(FldList, D_FIELD, 0, tp, scope); - FreeIdList(FldList); + FreeNode(FldList); } | CASE @@ -312,7 +316,7 @@ FieldList(struct scope *scope;) | { id = gen_anon_idf(); } ] /* Changed rule in new modula-2 */ - ':' qualident(D_TYPE|D_HTYPE, &df, "type") + ':' qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0) { df1 = define(id, scope, D_FIELD); df1->df_type = df->df_type; } @@ -335,8 +339,11 @@ CaseLabelList: CaseLabels [ ',' CaseLabels ]* ; -CaseLabels: - ConstExpression [ UPTO ConstExpression ]? +CaseLabels +{ + struct node *nd1, *nd2 = 0; +}: + ConstExpression(&nd1) [ UPTO ConstExpression(&nd2) ]? ; SetType(struct type **ptp;) @@ -364,7 +371,7 @@ PointerType(struct type **ptp;) /* Either a Module or a Type, but in both cases defined in this scope, so this is the correct identification */ - qualident(D_TYPE|D_HTYPE, &df, "type") + qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0) { if (!df->df_type) { error("type \"%s\" not declared", @@ -429,7 +436,7 @@ FormalTypeList(struct paramlist **ppr; struct type **ptp;) { p->next = 0; } ]? ')' - [ ':' qualident(D_TYPE|D_HTYPE, &df, "type") + [ ':' qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0) { *ptp = df->df_type; } ]? ; @@ -438,24 +445,26 @@ ConstantDeclaration { struct def *df; struct idf *id; + struct node *nd; }: IDENT { id = dot.TOK_IDF; } - '=' ConstExpression { df = define(id, CurrentScope, D_CONST); + '=' ConstExpression(&nd){ df = define(id, CurrentScope, D_CONST); /* ???? */ } ; VariableDeclaration { - struct id_list *VarList; + struct node *VarList; struct type *tp; + struct node *nd = 0; } : IdentList(&VarList) [ - ConstExpression + ConstExpression(&nd) ]? ':' type(&tp) { EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope); - FreeIdList(VarList); + FreeNode(VarList); } ; diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index 231364b10..8a5e2999a 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -10,9 +10,10 @@ static char *RcsId = "$Header$"; #include "def.h" #include "type.h" #include "idf.h" -#include "misc.h" #include "main.h" #include "scope.h" +#include "LLlex.h" +#include "node.h" #include "debug.h" struct def *h_def; /* Pointer to free list of def structures */ @@ -63,7 +64,7 @@ define(id, scope, kind) return df; } if (kind != D_ERROR) { - error("identifier \"%s\" already declared", id->id_text); +error("identifier \"%s\" already declared", id->id_text); } return df; } @@ -115,7 +116,7 @@ lookup(id, scope) } Export(ids, qualified) - register struct id_list *ids; + register struct node *ids; { /* From the current scope, the list of identifiers "ids" is exported. Note this fact. If the export is not qualified, make @@ -125,36 +126,38 @@ Export(ids, qualified) register struct def *df; while (ids) { - df = define(ids->id_ptr, CurrentScope, D_ISEXPORTED); + df = define(ids->nd_IDF, CurrentScope, D_ISEXPORTED); if (qualified) { df->df_flags |= D_QEXPORTED; } else { df->df_flags |= D_EXPORTED; - df = define(ids->id_ptr, enclosing(CurrentScope), + df = define(ids->nd_IDF, enclosing(CurrentScope), D_IMPORT); } ids = ids->next; } } -Import(ids, id, local) - register struct id_list *ids; - struct idf *id; +Import(ids, idn, local) + register struct node *ids; + struct node *idn; { /* "ids" is a list of imported identifiers. - If "id" is a null-pointer, the identifiers are imported from the - enclosing scope. Otherwise they are imported from the module - indicated by "id", which must be visible in the enclosing scope. - An exception must be made for imports of the Compilation Unit. + If "idn" is a null-pointer, the identifiers are imported from + the enclosing scope. Otherwise they are imported from the module + indicated by "idn", which must be visible in the enclosing + scope. An exception must be made for imports of the + Compilation Unit. This case is indicated by the value 0 of the flag "local". - In this case, if "id" is a null pointer, the "ids" identifiers + In this case, if "idn" is a null pointer, the "ids" identifiers are all module identifiers. Their Definition Modules must be - read. Otherwise "id" is a module identifier whose Definition + read. Otherwise "idn" is a module identifier whose Definition Module must be read. "ids" then represents a list of identifiers defined in this module. */ register struct def *df; + register struct idf *id = 0; int scope; int kind; int imp_kind; @@ -162,6 +165,7 @@ Import(ids, id, local) #define FROM_ENCLOSING 1 struct def *lookfor(), *GetDefinitionModule(); + if (idn) id = idn->nd_IDF; kind = D_IMPORT; scope = enclosing(CurrentScope)->sc_scope; if (!id) imp_kind = FROM_ENCLOSING; @@ -173,35 +177,35 @@ Import(ids, id, local) /* enter all "ids" with type D_ERROR */ kind = D_ERROR; if (df->df_kind != D_ERROR) { -error("identifier \"%s\" does not represent a module", id->id_text); +node_error(idn, "identifier \"%s\" does not represent a module", id->id_text); } } else scope = df->mod_scope; } while (ids) { if (imp_kind == FROM_MODULE) { - if (!(df = lookup(ids->id_ptr, scope))) { -error("identifier \"%s\" not declared in qualifying module", -ids->id_ptr->id_text); + if (!(df = lookup(ids->nd_IDF, scope))) { +node_error(ids, "identifier \"%s\" not declared in qualifying module", +ids->nd_IDF->id_text); df = ill_df; } else if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) { -error("identifier \"%s\" not exported from qualifying module", -ids->id_ptr->id_text); +node_error(ids,"identifier \"%s\" not exported from qualifying module", +ids->nd_IDF->id_text); } } else { if (local) { - df = lookfor(ids->id_ptr, + df = lookfor(ids->nd_IDF, enclosing(CurrentScope), 0); - } else df = GetDefinitionModule(ids->id_ptr); + } else df = GetDefinitionModule(ids->nd_IDF); if (df->df_kind == D_ERROR) { -error("identifier \"%s\" not visible in enclosing scope", -ids->id_ptr->id_text); +node_error(ids, "identifier \"%s\" not visible in enclosing scope", +ids->nd_IDF->id_text); } } - define(ids->id_ptr, CurrentScope, kind)->imp_def = df; + define(ids->nd_IDF, CurrentScope, kind)->imp_def = df; if (df->df_kind == D_TYPE && df->df_type->tp_fund == ENUMERATION) { /* Also import all enumeration literals */ diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 245e33eaa..85df442ff 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -9,7 +9,8 @@ static char *RcsId = "$Header$"; #include "def.h" #include "type.h" #include "scope.h" -#include "misc.h" +#include "LLlex.h" +#include "node.h" struct def * Enter(name, kind, type, pnam) @@ -30,7 +31,7 @@ Enter(name, kind, type, pnam) } EnterIdList(idlist, kind, flags, type, scope) - register struct id_list *idlist; + register struct node *idlist; struct type *type; struct scope *scope; { @@ -39,7 +40,7 @@ EnterIdList(idlist, kind, flags, type, scope) int assval = 0; while (idlist) { - df = define(idlist->id_ptr, scope, kind); + df = define(idlist->nd_IDF, scope, kind); df->df_type = type; df->df_flags = flags; if (kind == D_ENUM) { diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c index d3b23f402..8998e166b 100644 --- a/lang/m2/comp/error.c +++ b/lang/m2/comp/error.c @@ -13,6 +13,7 @@ static char *RcsId = "$Header$"; #include "f_info.h" #include "LLlex.h" #include "main.h" +#include "node.h" #define MAXERR_LINE 5 /* Number of error messages on one line ... */ #define ERROUT STDERR @@ -28,8 +29,6 @@ static char *RcsId = "$Header$"; #define VDEBUG 7 #endif -#define NILEXPR ((struct expr *) 0) - int err_occurred; extern char *symbol2str(); @@ -37,12 +36,12 @@ extern char *symbol2str(); /* There are three general error-message functions: lexerror() lexical and pre-processor error messages error() syntactic and semantic error messages - expr_error() errors in expressions + node_error() errors in nodes The difference lies in the place where the file name and line number come from. Lexical errors report from the global variables LineNumber and - FileName, expression errors get their information from the - expression, whereas other errors use the information in the token. + FileName, node errors get their information from the + node, whereas other errors use the information in the token. */ #ifdef DEBUG @@ -50,7 +49,7 @@ extern char *symbol2str(); debug(level, fmt, args) char *fmt; { - if (level <= options['D']) _error(VDEBUG, NILEXPR, fmt, &args); + if (level <= options['D']) _error(VDEBUG, NULLNODE, fmt, &args); } #endif DEBUG @@ -58,44 +57,44 @@ debug(level, fmt, args) error(fmt, args) char *fmt; { - _error(ERROR, NILEXPR, fmt, &args); + _error(ERROR, NULLNODE, fmt, &args); } /*VARARGS2*/ -expr_error(expr, fmt, args) - struct expr *expr; +node_error(node, fmt, args) + struct node *node; char *fmt; { - _error(ERROR, expr, fmt, &args); + _error(ERROR, node, fmt, &args); } /*VARARGS1*/ warning(fmt, args) char *fmt; { - _error(WARNING, NILEXPR, fmt, &args); + _error(WARNING, NULLNODE, fmt, &args); } /*VARARGS2*/ -expr_warning(expr, fmt, args) - struct expr *expr; +node_warning(node, fmt, args) + struct node *node; char *fmt; { - _error(WARNING, expr, fmt, &args); + _error(WARNING, node, fmt, &args); } /*VARARGS1*/ lexerror(fmt, args) char *fmt; { - _error(LEXERROR, NILEXPR, fmt, &args); + _error(LEXERROR, NULLNODE, fmt, &args); } /*VARARGS1*/ lexwarning(fmt, args) char *fmt; { - _error(LEXWARNING, NILEXPR, fmt, &args); + _error(LEXWARNING, NULLNODE, fmt, &args); } /*VARARGS1*/ @@ -104,13 +103,13 @@ fatal(fmt, args) int args; { - _error(FATAL, NILEXPR, fmt, &args); + _error(FATAL, NULLNODE, fmt, &args); sys_stop(S_EXIT); } -_error(class, expr, fmt, argv) +_error(class, node, fmt, argv) int class; - struct expr *expr; + struct node *node; char *fmt; int argv[]; { @@ -118,8 +117,10 @@ _error(class, expr, fmt, argv) for a given line to MAXERR_LINE. */ static unsigned int last_ln = 0; - static int e_seen = 0; unsigned int ln = 0; + static char * last_fn = 0; + char *fn = 0; + static int e_seen = 0; char *remark = 0; /* Since name and number are gathered from different places @@ -158,13 +159,19 @@ _error(class, expr, fmt, argv) case FATAL: remark = "fatal error --"; break; +#ifdef DEBUG + case VDEBUG: + remark = "(debug)"; + break; +#endif DEBUG } /* the place */ switch (class) { case WARNING: case ERROR: - ln = /* ???? expr ? expr->ex_line : */ dot.tk_lineno; + fn = node ? node->nd_filename : dot.tk_filename; + ln = node ? node->nd_lineno : dot.tk_lineno; break; case LEXWARNING: case LEXERROR: @@ -174,13 +181,14 @@ _error(class, expr, fmt, argv) case VDEBUG: #endif DEBUG ln = LineNumber; + fn = FileName; break; } #ifdef DEBUG if (class != VDEBUG) { #endif - if (ln == last_ln) { + if (fn == last_fn && ln == last_ln) { /* we've seen this place before */ e_seen++; if (e_seen == MAXERR_LINE) fmt = "etc ..."; @@ -192,13 +200,14 @@ _error(class, expr, fmt, argv) else { /* brand new place */ last_ln = ln; + last_fn = fn; e_seen = 0; } #ifdef DEBUG } #endif DEBUG - if (FileName) fprint(ERROUT, "\"%s\", line %u: ", FileName, ln); + if (fn) fprint(ERROUT, "\"%s\", line %u: ", fn, ln); if (remark) fprint(ERROUT, "%s ", remark); diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index d325eac5c..e35b7e330 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -10,15 +10,18 @@ static char *RcsId = "$Header$"; #include "idf.h" #include "def.h" #include "scope.h" +#include "node.h" } -number: +number(struct node **p;): +[ INTEGER | REAL +] { *p = MkNode(Value, NULLNODE, NULLNODE, dot); } ; -qualident(int types; struct def **pdf; char *str;) +qualident(int types; struct def **pdf; char *str; struct node **p;) { int scope; int module; @@ -30,6 +33,9 @@ qualident(int types; struct def **pdf; char *str;) *pdf = df; if (df->df_kind == D_ERROR) types = 0; } + if (p) { + *p = MkNode(Value, NULLNODE, NULLNODE,&dot); + } } [ { if (types &&!(scope = has_selectors(df))) { @@ -38,8 +44,13 @@ qualident(int types; struct def **pdf; char *str;) } } /* selector */ - '.' IDENT - { if (types) { + '.' { if (p) *p = MkNode(Link, *p, NULLNODE, &dot); } + IDENT + { if (p) { + p = &((*p)->nd_right); + *p = MkNode(Value, NULLNODE, NULLNODE,&dot); + } + if (types) { module = (df->df_kind == D_MODULE); df = lookup(dot.TOK_IDF, scope); if (!df) { @@ -62,99 +73,179 @@ qualident(int types; struct def **pdf; char *str;) } ; +/* Inline substituted wherever it occurred selector: - '.' /* field */ IDENT + '.' IDENT ; +*/ -ExpList: - expression [ ',' expression ]* +ExpList(struct node **pnd;) +{ + struct node **nd; +} : + expression(pnd) { nd = pnd; } + [ + ',' { *nd = MkNode(Link, *nd, NULLNODE, &dot); + nd = &(*nd)->nd_right; + } + expression(nd) + ]* ; -ConstExpression: - expression +ConstExpression(struct node **pnd;): + expression(pnd) /* * Changed rule in new Modula-2. * Check that the expression is a constant expression and evaluate! */ ; -expression: - SimpleExpression [ relation SimpleExpression ]? +expression(struct node **pnd;) +{ + struct node *nd; +} : + SimpleExpression(&nd) + [ + /* relation */ + [ '=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' | + GREATEREQUAL | IN + ] + { nd = MkNode(Oper, nd, NULLNODE, &dot); } + SimpleExpression(&(nd->nd_right)) + ]? + { *pnd = nd; } ; +/* Inline in expression relation: '=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ; +*/ -SimpleExpression: - [ '+' | '-' ]? term [ AddOperator term ]* +SimpleExpression(struct node **pnd;) +{ + register struct node *nd; +} : + [ '+' | '-' ]? + term(pnd) { nd = *pnd; } + [ + /* AddOperator */ + [ '+' | '-' | OR ] + { *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); } + term(&(nd->nd_right)) + ]* ; +/* Inline in "SimpleExpression" AddOperator: '+' | '-' | OR ; +*/ -term: - factor [ MulOperator factor ]* +term(struct node **pnd;) +{ + register struct node *nd; +}: + factor(pnd) { nd = *pnd; } + [ + /* MulOperator */ + [ '*' | '/' | DIV | MOD | AND | '&' ] + { *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); } + factor(&(nd->nd_right)) + ]* ; +/* inline in "term" MulOperator: '*' | '/' | DIV | MOD | AND | '&' ; +*/ -factor +factor(struct node **p;) { struct def *df; } : - qualident(0, &df, (char *) 0) + qualident(0, &df, (char *) 0, p) [ - designator_tail? ActualParameters? - | - bare_set + designator_tail(p)? + [ + { *p = MkNode(Call, p, NULLNODE, &dot); } + ActualParameters(&((*p)->nd_right)) + ]? + | { *p = MkNode(Call, p, NULLNODE, &dot); } + bare_set(&((*p)->nd_right)) ] | - bare_set + bare_set(p) | %default - number + number(p) | - STRING + STRING { *p = MkNode(Value, NULLNODE, NULLNODE, &dot); } | - '(' expression ')' + '(' expression(p) ')' | - NOT factor + NOT { *p = MkNode(Uoper, NULLNODE, NULLNODE, &dot); } + factor(&((*p)->nd_left)) ; -bare_set: - '{' [ element [ ',' element ]* ]? '}' +bare_set(struct node **pnd;) +{ + struct node **nd; +} : + '{' { + dot.tk_symb = SET; + *pnd = MkNode(Link, NULLNODE, NULLNODE, &dot); + nd = &((*pnd)->nd_left); + } + [ + element(nd) + [ + ',' { *nd = MkNode(Link, *nd, NULLNODE, &dot); + nd = &((*nd)->nd_right); + } + element(nd) + ]* + ]? + '}' ; -ActualParameters: - '(' ExpList? ')' +ActualParameters(struct node **pnd;): + '(' ExpList(pnd)? ')' ; -element: - expression [ UPTO expression ]? +element(struct node **pnd;): + expression(pnd) + [ + UPTO { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);} + expression(&((*pnd)->nd_right)) + ]? ; -designator +designator(struct node **pnd;) { struct def *df; } : - qualident(0, &df, (char *) 0) - designator_tail? + qualident(0, &df, (char *) 0, pnd) + designator_tail(pnd)? ; -designator_tail: - visible_designator_tail +designator_tail(struct node **pnd;): + visible_designator_tail(pnd) [ - selector + /* selector */ + '.' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); } + IDENT { (*pnd)->nd_right = + MkNode(Value, NULLNODE, NULLNODE, &dot); + } | - visible_designator_tail + visible_designator_tail(pnd) ]* ; -visible_designator_tail: - '[' ExpList ']' +visible_designator_tail(struct node **pnd;): + '[' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); } + ExpList(&((*pnd)->nd_right)) + ']' | - '^' + '^' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); } ; diff --git a/lang/m2/comp/misc.H b/lang/m2/comp/misc.H index ef9a78153..4f2ae65e3 100644 --- a/lang/m2/comp/misc.H +++ b/lang/m2/comp/misc.H @@ -2,13 +2,6 @@ /* $Header$ */ -/* Structure to link idf structures together -*/ -struct id_list { - struct id_list *next; - struct idf *id_ptr; -}; - /* ALLOCDEF "id_list" */ #define is_anon_idf(x) ((x)->id_text[0] == '#') diff --git a/lang/m2/comp/misc.c b/lang/m2/comp/misc.c index 7a5439785..e0063bb68 100644 --- a/lang/m2/comp/misc.c +++ b/lang/m2/comp/misc.c @@ -24,22 +24,6 @@ match_id(id1, id2) } } -struct id_list *h_id_list; /* Header of free list of id_list structures */ - -/* FreeIdList: take a list of id_list structures and put them - on the free list of id_list structures -*/ -FreeIdList(p) - struct id_list *p; -{ - register struct id_list *q; - - while (q = p) { - p = p->next; - free_id_list(q); - } -} - struct idf * gen_anon_idf() { diff --git a/lang/m2/comp/node.H b/lang/m2/comp/node.H new file mode 100644 index 000000000..2dd99b4e6 --- /dev/null +++ b/lang/m2/comp/node.H @@ -0,0 +1,31 @@ +/* N O D E O F A N A B S T R A C T P A R S E T R E E */ + +/* $Header$ */ + +struct node { + struct node *next; +#define nd_left next + struct node *nd_right; + int nd_class; /* kind of node */ +#define Value 1 /* idf or constant */ +#define Oper 2 /* binary operator */ +#define Uoper 3 /* unary operator */ +#define Call 4 /* cast or procedure - or function call */ +#define Link 5 + struct type *nd_type; /* type of this node */ + struct token nd_token; +#define nd_symb nd_token.tk_symb +#define nd_lineno nd_token.tk_lineno +#define nd_filename nd_token.tk_filename +#define nd_IDF nd_token.TOK_IDF +#define nd_STR nd_token.TOK_STR +#define nd_SLE nd_token.TOK_SLE +#define nd_INT nd_token.TOK_INT +#define nd_REL nd_token.TOK_REL +}; + +/* ALLOCDEF "node" */ + +extern struct node *MkNode(); + +#define NULLNODE ((struct node *) 0) diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c new file mode 100644 index 000000000..dcd5a9eed --- /dev/null +++ b/lang/m2/comp/node.c @@ -0,0 +1,41 @@ +/* N O D E O F A N A B S T R A C T P A R S E T R E E */ + +static char *RcsId = "$Header$"; + +#include +#include +#include +#include "def.h" +#include "type.h" +#include "LLlex.h" +#include "node.h" + +struct node *h_node; /* header of free list */ + +struct node * +MkNode(class, left, right, token) + struct node *left, *right; + struct token *token; +{ + /* Create a node and initialize it with the given parameters + */ + register struct node *nd = new_node(); + + nd->nd_left = left; + nd->nd_right = right; + nd->nd_token = *token; + nd->nd_class = class; + nd->nd_type = NULLTYPE; + return nd; +} + +FreeNode(nd) + register struct node *nd; +{ + /* Put nodes that are no longer needed back onto the free + list + */ + if (nd->nd_left) FreeNode(nd->nd_left); + if (nd->nd_right) FreeNode(nd->nd_right); + free_node(nd); +} diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 994f6c407..5c17fd6f1 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -7,12 +7,12 @@ static char *RcsId = "$Header$"; #include #include #include "idf.h" -#include "misc.h" #include "main.h" #include "LLlex.h" #include "scope.h" #include "def.h" #include "type.h" +#include "node.h" #include "debug.h" static struct idf *impl_name = 0; @@ -57,13 +57,16 @@ ModuleDeclaration } ; -priority: - '[' ConstExpression ']' +priority +{ + struct node *nd; +}: + '[' ConstExpression(&nd) ']' ; export(int def;) { - struct id_list *ExportList; + struct node *ExportList; int QUALflag = 0; } : EXPORT @@ -74,17 +77,17 @@ export(int def;) { if (!def) Export(ExportList, QUALflag); else warning("export list in definition module ignored"); - FreeIdList(ExportList); + FreeNode(ExportList); } ; import(int local;) { - struct id_list *ImportList; - struct idf *id = 0; + struct node *ImportList; + struct node *id = 0; } : [ FROM - IDENT { id = dot.TOK_IDF; } + IDENT { id = MkNode(Value, NULLNODE, NULLNODE, &dot); } ]? IMPORT IdentList(&ImportList) ';' /* @@ -95,7 +98,8 @@ import(int local;) */ { Import(ImportList, id, local); - FreeIdList(ImportList); + FreeNode(ImportList); + if (id) FreeNode(id); } ; diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g index 70e7b8095..6f675a269 100644 --- a/lang/m2/comp/statement.g +++ b/lang/m2/comp/statement.g @@ -2,20 +2,27 @@ { static char *RcsId = "$Header$"; + +#include +#include "LLlex.h" +#include "node.h" } -statement: +statement +{ + struct node *nd1, *nd2; +} : [ /* * This part is not in the reference grammar. The reference grammar * states : assignment | ProcedureCall | ... * but this gives LL(1) conflicts */ - designator + designator(&nd1) [ - ActualParameters? + ActualParameters(&nd2)? | - BECOMES expression + BECOMES expression(&nd2) ] /* * end of changed part @@ -37,7 +44,10 @@ statement: | EXIT | - RETURN expression? + RETURN + [ + expression(&nd1) + ]? ]? ; @@ -57,15 +67,21 @@ StatementSequence: statement [ ';' statement ]* ; -IfStatement: - IF expression THEN StatementSequence - [ ELSIF expression THEN StatementSequence ]* +IfStatement +{ + struct node *nd1; +} : + IF expression(&nd1) THEN StatementSequence + [ ELSIF expression(&nd1) THEN StatementSequence ]* [ ELSE StatementSequence ]? END ; -CaseStatement: - CASE expression OF case [ '|' case ]* +CaseStatement +{ + struct node *nd; +} : + CASE expression(&nd) OF case [ '|' case ]* [ ELSE StatementSequence ]? END ; @@ -75,19 +91,28 @@ case: /* This rule is changed in new modula-2 */ ; -WhileStatement: - WHILE expression DO StatementSequence END +WhileStatement +{ + struct node *nd; +}: + WHILE expression(&nd) DO StatementSequence END ; -RepeatStatement: - REPEAT StatementSequence UNTIL expression +RepeatStatement +{ + struct node *nd; +}: + REPEAT StatementSequence UNTIL expression(&nd) ; -ForStatement: +ForStatement +{ + struct node *nd1, *nd2, *nd3; +}: FOR IDENT - BECOMES expression - TO expression - [ BY ConstExpression ]? + BECOMES expression(&nd1) + TO expression(&nd2) + [ BY ConstExpression(&nd3) ]? DO StatementSequence END ; @@ -95,6 +120,9 @@ LoopStatement: LOOP StatementSequence END ; -WithStatement: - WITH designator DO StatementSequence END +WithStatement +{ + struct node *nd; +}: + WITH designator(&nd) DO StatementSequence END ; diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 520b2b68b..30097075b 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -11,7 +11,8 @@ static char *RcsId = "$Header$"; #include "def.h" #include "type.h" #include "idf.h" -#include "misc.h" +#include "LLlex.h" +#include "node.h" /* To be created dynamically in main() from defaults or from command line parameters. @@ -164,7 +165,7 @@ has_selectors(df) */ struct paramlist * ParamList(ids, tp, VARp) - register struct id_list *ids; + register struct node *ids; struct type *tp; { register struct paramlist *pr; -- 2.34.1