From 965e75761d9709fd3de437a64385b81951e1e417 Mon Sep 17 00:00:00 2001 From: ceriel Date: Tue, 8 Jul 1986 14:59:02 +0000 Subject: [PATCH] newer version --- lang/m2/comp/Makefile | 21 ++-- lang/m2/comp/casestat.C | 1 + lang/m2/comp/code.c | 1 + lang/m2/comp/cstoper.c | 107 +++++++++++------ lang/m2/comp/declar.g | 236 ++++++++++++++++---------------------- lang/m2/comp/def.H | 1 + lang/m2/comp/def.c | 10 -- lang/m2/comp/desig.c | 1 + lang/m2/comp/enter.c | 1 + lang/m2/comp/expression.g | 21 ++-- lang/m2/comp/main.c | 12 +- lang/m2/comp/program.g | 62 +++++----- lang/m2/comp/statement.g | 5 +- lang/m2/comp/tmpvar.C | 9 +- lang/m2/comp/type.c | 1 + lang/m2/comp/walk.c | 35 +++--- 16 files changed, 259 insertions(+), 265 deletions(-) diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index f4caf84bf..dda87c51e 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -1,16 +1,16 @@ # make modula-2 "compiler" # $Header$ +EMDIR = /usr/em +MHDIR = $(EMDIR)/modules/h +PKGDIR = $(EMDIR)/modules/pkg +LIBDIR = $(EMDIR)/modules/lib +LLGEN = $(EMDIR)/util/LLgen/src/LLgen -HDIR = ../../em/h -PKGDIR = ../../em/pkg -LIBDIR = ../../em/lib - -INCLUDES = -I$(HDIR) -I/usr/em/h -I$(PKGDIR) -I/user1/erikb/em/h +INCLUDES = -I$(MHDIR) -I$(EMDIR)/h -I$(PKGDIR) LSRC = tokenfile.g program.g declar.g expression.g statement.g CC = cc -GEN = /usr/em/util/LLgen/src/LLgen -GENOPTIONS = -d +LLGENOPTIONS = -d PROFILE = CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC= LINTFLAGS = -DSTATIC= -DNORCSID @@ -30,7 +30,8 @@ GENCFILES= tokenfile.c \ GENGFILES= tokenfile.g GENHFILES= errout.h\ idfsize.h numsize.h strsize.h target_sizes.h debug.h\ - inputtype.h maxset.h ndir.h density.h + inputtype.h maxset.h ndir.h density.h\ + def.h type.h Lpars.h node.h # GENFILES = $(GENGFILES) $(GENCFILES) $(GENHFILES) all: @@ -39,7 +40,7 @@ all: make main LLfiles: $(LSRC) - $(GEN) $(GENOPTIONS) $(LSRC) + $(LLGEN) $(LLGENOPTIONS) $(LSRC) @touch LLfiles hfiles: Parameters make.hfiles @@ -47,7 +48,7 @@ hfiles: Parameters make.hfiles touch hfiles main: $(OBJ) Makefile - $(CC) $(LFLAGS) $(OBJ) /user1/erikb/em/lib/libem_mes.a /user1/erikb/em/lib/libeme.a $(LIBDIR)/libcomp.a $(LIBDIR)/malloc.o /user1/erikb/em/lib/libprint.a /user1/erikb/em/lib/libstr.a /user1/erikb/em/lib/libsystem.a -o main + $(CC) $(LFLAGS) $(OBJ) $(LIBDIR)/libem_mes.a $(LIBDIR)/libeme.a $(LIBDIR)/input.a $(LIBDIR)/assert.a $(LIBDIR)/alloc.a $(LIBDIR)/malloc.o $(LIBDIR)/libprint.a $(LIBDIR)/libstr.a $(LIBDIR)/libsystem.a -o main size main clean: diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C index 7c4294447..eeb9162a5 100644 --- a/lang/m2/comp/casestat.C +++ b/lang/m2/comp/casestat.C @@ -8,6 +8,7 @@ static char *RcsId = "$Header$"; #include #include +#include #include #include diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 60b6c6a4b..2e625273a 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -11,6 +11,7 @@ static char *RcsId = "$Header$"; #include #include +#include #include #include "type.h" diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index 30ac8c7ab..65c9924e3 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -32,24 +32,28 @@ cstunary(expp) /* The unary operation in "expp" is performed on the constant expression below it, and the result restored in expp. */ - arith o1 = expp->nd_right->nd_INT; + register arith o1 = expp->nd_right->nd_INT; switch(expp->nd_symb) { case '+': break; + case '-': o1 = -o1; if (expp->nd_type->tp_fund == T_INTORCARD) { expp->nd_type = int_type; } break; + case NOT: case '~': o1 = !o1; break; + default: crash("(cstunary)"); } + expp->nd_class = Value; expp->nd_token = expp->nd_right->nd_token; expp->nd_INT = o1; @@ -65,8 +69,8 @@ cstbin(expp) expressions below it, and the result restored in expp. */ - arith o1 = expp->nd_left->nd_INT; - arith o2 = expp->nd_right->nd_INT; + register arith o1 = expp->nd_left->nd_INT; + register arith o2 = expp->nd_right->nd_INT; int uns = expp->nd_type != int_type; assert(expp->nd_class == Oper); @@ -158,15 +162,12 @@ cstbin(expp) break; case '<': - if (uns) { - o1 = (o1 & mach_long_sign ? - (o2 & mach_long_sign ? o1 < o2 : 0) : - (o2 & mach_long_sign ? 1 : o1 < o2) - ); + { arith tmp = o1; + + o1 = o2; + o2 = tmp; } - else - o1 = (o1 < o2); - break; + /* Fall through */ case '>': if (uns) { @@ -178,16 +179,15 @@ cstbin(expp) else o1 = (o1 > o2); break; + case LESSEQUAL: - if (uns) { - o1 = (o1 & mach_long_sign ? - (o2 & mach_long_sign ? o1 <= o2 : 0) : - (o2 & mach_long_sign ? 1 : o1 <= o2) - ); + { arith tmp = o1; + + o1 = o2; + o2 = tmp; } - else - o1 = (o1 <= o2); - break; + /* Fall through */ + case GREATEREQUAL: if (uns) { o1 = (o1 & mach_long_sign ? @@ -198,22 +198,28 @@ cstbin(expp) else o1 = (o1 >= o2); break; + case '=': o1 = (o1 == o2); break; + case '#': o1 = (o1 != o2); break; + case AND: case '&': o1 = (o1 && o2); break; + case OR: o1 = (o1 || o2); break; + default: crash("(cstbin)"); } + expp->nd_class = Value; expp->nd_token = expp->nd_right->nd_token; if (expp->nd_type == bool_type) expp->nd_symb = INTEGER; @@ -227,7 +233,7 @@ cstbin(expp) cstset(expp) register struct node *expp; { - register arith *set1 = 0, *set2; + register arith *set1, *set2; arith *resultset = 0; register int setsize, j; @@ -253,6 +259,8 @@ cstset(expp) expp->nd_left->nd_set = 0; switch(expp->nd_symb) { case '+': + /* Set union + */ if (!set1) { resultset = set2; expp->nd_right->nd_set = 0; @@ -262,11 +270,15 @@ cstset(expp) *set1++ |= *set2++; } break; + case '-': + /* Set difference + */ if (!set1 || !set2) { /* The set from which something is substracted is already empty, or the set that is - substracted is empty + substracted is empty. In either case, the + result set is set1. */ break; } @@ -274,34 +286,50 @@ cstset(expp) *set1++ &= ~*set2++; } break; + case '*': - if (!set1) break; + /* Set intersection + */ + if (!set1) { + /* set1 is empty, and so is the result set + */ + break; + } if (!set2) { + /* set 2 is empty, so the result set must be + empty too. + */ resultset = set2; expp->nd_right->nd_set = 0; break; } - for (j = 0; j < setsize; j++) { *set1++ &= *set2++; } break; + case '/': + /* Symmetric set difference + */ if (!set1) { resultset = set2; expp->nd_right->nd_set = 0; break; } - if (set2) for (j = 0; j < setsize; j++) { - *set1++ ^= *set2++; + if (set2) { + for (j = 0; j < setsize; j++) { + *set1++ ^= *set2++; + } } break; + case GREATEREQUAL: case LESSEQUAL: case '=': case '#': - /* Clumsy, but who cares? Nobody writes these things! */ - expp->nd_left->nd_set = set1; + /* Constant set comparisons + */ + expp->nd_left->nd_set = set1; /* may be disposed of */ for (j = 0; j < setsize; j++) { switch(expp->nd_symb) { case GREATEREQUAL: @@ -371,11 +399,13 @@ cstcall(expp, call) register struct node *expr = 0; assert(expp->nd_class == Call); + if (expp->nd_right) { expr = expp->nd_right->nd_left; expp->nd_right->nd_left = 0; FreeNode(expp->nd_right); } + expp->nd_class = Value; expp->nd_symb = INTEGER; switch(call) { @@ -384,6 +414,7 @@ cstcall(expp, call) else expp->nd_INT = expr->nd_INT; CutSize(expp); break; + case S_CAP: if (expr->nd_INT >= 'a' && expr->nd_INT <= 'z') { expp->nd_INT = expr->nd_INT + ('A' - 'a'); @@ -391,10 +422,12 @@ cstcall(expp, call) else expp->nd_INT = expr->nd_INT; CutSize(expp); break; + case S_CHR: expp->nd_INT = expr->nd_INT; CutSize(expp); break; + case S_MAX: if (expp->nd_type == int_type) { expp->nd_INT = max_int; @@ -410,6 +443,7 @@ cstcall(expp, call) } else expp->nd_INT = expp->nd_type->enm_ncst - 1; break; + case S_MIN: if (expp->nd_type == int_type) { expp->nd_INT = (-max_int) - 1; @@ -422,16 +456,20 @@ cstcall(expp, call) } else expp->nd_INT = 0; break; + case S_ODD: expp->nd_INT = (expr->nd_INT & 1); break; + case S_ORD: expp->nd_INT = expr->nd_INT; CutSize(expp); break; + case S_SIZE: expp->nd_INT = WA(expr->nd_type->tp_size) / word_size; break; + case S_VAL: expp->nd_INT = expr->nd_INT; if ( /* Check overflow of subranges or enumerations */ @@ -451,6 +489,7 @@ cstcall(expp, call) ) node_warning(expp,"overflow in constant expression"); else CutSize(expp); break; + default: crash("(cstcall)"); } @@ -465,8 +504,8 @@ CutSize(expr) /* The constant value of the expression expr is made to conform to the size of the type of the expression. */ - arith o1 = expr->nd_INT; - struct type *tp = BaseType(expr->nd_type); + register arith o1 = expr->nd_INT; + register struct type *tp = BaseType(expr->nd_type); int uns; int size = tp->tp_size; @@ -476,8 +515,8 @@ CutSize(expr) if (o1 & ~full_mask[size]) { node_warning(expr, "overflow in constant expression"); + o1 &= full_mask[size]; } - o1 &= full_mask[size]; } else { int nbits = (int) (mach_long_size - size) * 8; @@ -485,17 +524,17 @@ CutSize(expr) if (remainder != 0 && remainder != ~full_mask[size]) { node_warning(expr, "overflow in constant expression"); + o1 <<= nbits; + o1 >>= nbits; } - o1 <<= nbits; - o1 >>= nbits; } expr->nd_INT = o1; } InitCst() { - int i = 0; - arith bt = (arith)0; + register int i = 0; + register arith bt = (arith)0; while (!(bt < 0)) { bt = (bt << 8) + 0377, i++; diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 3b1bc590c..53fb46656 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -33,21 +33,20 @@ ProcedureDeclaration register struct def *df; struct def *df1; } : - { proclevel++; } - ProcedureHeading(&df1, D_PROCEDURE) - { - CurrentScope->sc_definedby = df = df1; - df->prc_vis = CurrVis; + { ++proclevel; return_occurred = 0; } + ProcedureHeading(&df1, D_PROCEDURE) + { CurrentScope->sc_definedby = df = df1; + df->prc_vis = CurrVis; + } ';' block(&(df->prc_body)) IDENT - { - match_id(dot.TOK_IDF, df->df_idf); + { match_id(dot.TOK_IDF, df->df_idf); close_scope(SC_CHKFORW|SC_REVERSE); if (! return_occurred && ResultType(df->df_type)) { -error("function procedure does not return a value", df->df_idf->id_text); +error("function procedure %s does not return a value", df->df_idf->id_text); } - proclevel--; + --proclevel; } ; @@ -56,22 +55,17 @@ ProcedureHeading(struct def **pdf; int type;) struct paramlist *params = 0; struct type *tp = 0; register struct def *df; - struct def *DeclProc(); arith NBytesParams; } : PROCEDURE IDENT - { - df = DeclProc(type); - if (proclevel > 1) { - /* Room for static link - */ + { df = DeclProc(type); + if (proclevel > 1) { /* need room for static link */ NBytesParams = pointer_size; } else NBytesParams = 0; } FormalParameters(¶ms, &tp, &NBytesParams)? - { - tp = construct_type(T_PROCEDURE, tp); + { tp = construct_type(T_PROCEDURE, tp); tp->prc_params = params; tp->prc_nbpar = NBytesParams; if (df->df_type) { @@ -85,9 +79,6 @@ error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text); } df->df_type = tp; *pdf = df; - - if (type == D_PROCHEAD) close_scope(0); - } ; @@ -115,7 +106,7 @@ declaration: ; FormalParameters(struct paramlist **pr; - struct type **tp; + struct type **ptp; arith *parmaddr;) { struct def *df; @@ -128,9 +119,7 @@ FormalParameters(struct paramlist **pr; ]* ]? ')' - [ ':' qualident(D_ISTYPE, &df, "type", (struct node **) 0) - { *tp = df->df_type; - } + [ ':' qualtype(ptp) ]? ; @@ -138,13 +127,10 @@ FPSection(struct paramlist **ppr; arith *parmaddr;) { struct node *FPList; struct type *tp; - int VARp = D_VALPAR; + int VARp; struct paramlist *p = 0; } : - [ - VAR { VARp = D_VARPAR; } - ]? - IdentList(&FPList) ':' FormalType(&p, 0) + var(&VARp) IdentList(&FPList) ':' FormalType(&p, 0) { EnterParamList(ppr, FPList, p->par_def->df_type, VARp, parmaddr); free_def(p->par_def); @@ -154,25 +140,24 @@ FPSection(struct paramlist **ppr; arith *parmaddr;) FormalType(struct paramlist **ppr; int VARp;) { - struct def *df1; register struct def *df; int ARRAYflag; register struct type *tp; + struct type *tp1; register struct paramlist *p = new_paramlist(); extern arith ArrayElSize(); } : [ ARRAY OF { ARRAYflag = 1; } | { ARRAYflag = 0; } ] - qualident(D_ISTYPE, &df1, "type", (struct node **) 0) - { df = df1; - if (ARRAYflag) { + qualtype(&tp1) + { if (ARRAYflag) { tp = construct_type(T_ARRAY, NULLTYPE); - tp->arr_elem = df->df_type; - tp->arr_elsize = ArrayElSize(df->df_type); + tp->arr_elem = tp1; + tp->arr_elsize = ArrayElSize(tp1); tp->tp_align = lcm(word_align, pointer_align); } - else tp = df->df_type; + else tp = tp1; p->next = *ppr; *ppr = p; p->par_def = df = new_def(); @@ -186,23 +171,19 @@ TypeDeclaration register struct def *df; struct type *tp; }: - IDENT { df = lookup(dot.TOK_IDF, CurrentScope); - if (!df) df = define(dot.TOK_IDF,CurrentScope,D_TYPE); - } + IDENT { df = define(dot.TOK_IDF,CurrentScope,D_TYPE); } '=' type(&tp) - { - if (df->df_kind == D_HIDDEN) { + { if (df->df_type && df->df_type->tp_fund == T_HIDDEN) { if (tp->tp_fund != T_POINTER) { error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text); } - df->df_kind = D_TYPE; + /* Careful now ... we might have declarations + referring to the hidden type. + */ *(df->df_type) = *tp; free_type(tp); } - else { - df->df_type = tp; - df->df_kind = D_TYPE; - } + else df->df_type = tp; } ; @@ -222,20 +203,17 @@ type(struct type **ptp;): SimpleType(struct type **ptp;) { - struct def *df; + struct type *tp; } : - qualident(D_ISTYPE, &df, "type", (struct node **) 0) + qualtype(ptp) [ /* nothing */ - { *ptp = df->df_type; } | - SubrangeType(ptp) + SubrangeType(&tp) /* The subrange type is given a base type by the qualident (this is new modula-2). */ - { - chk_basesubrange(*ptp, df->df_type); - } + { chk_basesubrange(tp, *ptp); } ] | enumeration(ptp) @@ -249,8 +227,7 @@ enumeration(struct type **ptp;) register struct type *tp; } : '(' IdentList(&EnumList) ')' - { - *ptp = tp = standard_type(T_ENUMERATION, 1, (arith) 1); + { *ptp = tp = standard_type(T_ENUMERATION, 1, (arith) 1); EnterEnumList(EnumList, tp); if (tp->enm_ncst > 256) { /* ??? is this reasonable ??? */ error("Too many enumeration literals"); @@ -262,9 +239,7 @@ IdentList(struct node **p;) { register struct node *q; } : - IDENT { q = MkLeaf(Value, &dot); - *p = q; - } + IDENT { *p = q = MkLeaf(Value, &dot); } [ ',' IDENT { q->next = MkLeaf(Value, &dot); @@ -285,8 +260,7 @@ SubrangeType(struct type **ptp;) '[' ConstExpression(&nd1) UPTO ConstExpression(&nd2) ']' - { *ptp = subr_type(nd1, nd2); - } + { *ptp = subr_type(nd1, nd2); } ; ArrayType(struct type **ptp;) @@ -295,9 +269,7 @@ ArrayType(struct type **ptp;) register struct type *tp2; } : ARRAY SimpleType(&tp) - { - *ptp = tp2 = construct_type(T_ARRAY, tp); - } + { *ptp = tp2 = construct_type(T_ARRAY, tp); } [ ',' SimpleType(&tp) { tp2->arr_elem = construct_type(T_ARRAY, tp); @@ -311,20 +283,19 @@ ArrayType(struct type **ptp;) RecordType(struct type **ptp;) { - struct scope *scope; + register struct scope *scope; arith count; int xalign = struct_align; } : RECORD - { open_scope(OPENSCOPE); - scope = CurrentScope; - close_scope(0); - count = 0; - } + { open_scope(OPENSCOPE); + scope = CurrentScope; + close_scope(0); + count = 0; + } FieldListSequence(scope, &count, &xalign) - { - *ptp = standard_type(T_RECORD, xalign, WA(count)); + { *ptp = standard_type(T_RECORD, xalign, WA(count)); (*ptp)->rec_scope = scope; } END @@ -340,8 +311,8 @@ FieldListSequence(struct scope *scope; arith *cnt; int *palign;): FieldList(struct scope *scope; arith *cnt; int *palign;) { struct node *FldList; - struct idf *id; - struct def *df; + register struct idf *id = gen_anon_idf(); + register struct def *df; struct type *tp; struct node *nd; arith tcnt, max; @@ -355,41 +326,37 @@ FieldList(struct scope *scope; arith *cnt; int *palign;) CASE /* Also accept old fashioned Modula-2 syntax, but give a warning */ - [ qualident(0, &df, (char *) 0, &nd) - [ /* This is good, in both kinds of Modula-2, if + [ qualident(0, (struct def **) 0, (char *) 0, &nd) + [ ':' qualtype(&tp) + /* This is correct, in both kinds of Modula-2, if the first qualident is a single identifier. */ - { if (nd->nd_class != Name) { - error("illegal variant tag"); - id = gen_anon_idf(); - } - else id = nd->nd_IDF; - } - ':' qualident(D_ISTYPE, &df, "type", (struct node **) 0) + { if (nd->nd_class != Name) { + error("illegal variant tag"); + } + else id = nd->nd_IDF; + } | /* Old fashioned! the first qualident now represents the type */ { warning("Old fashioned Modula-2 syntax!"); - id = gen_anon_idf(); - df = ill_df; if (chk_designator(nd) && (nd->nd_class != Def || - !(nd->nd_def->df_kind & - (D_ERROR|D_ISTYPE)))) { + !(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) || + !nd->nd_def->df_type)) { node_error(nd, "type expected"); + tp = error_type; } - else df = nd->nd_def; + else tp = nd->nd_def->df_type; FreeNode(nd); } ] | - /* Aha, third edition? */ - ':' qualident(D_ISTYPE, &df, "type", (struct node **) 0) - { id = gen_anon_idf(); } + /* Aha, third edition. Well done! */ + ':' qualtype(&tp) ] - { tp = df->df_type; - if (!(tp->tp_fund & T_DISCRETE)) { + { if (!(tp->tp_fund & T_DISCRETE)) { error("Illegal type in variant"); } df = define(id, scope, D_FIELD); @@ -464,12 +431,9 @@ node_error(nd1,"type incompatibility in case label"); SetType(struct type **ptp;) { - struct type *tp; } : - SET OF SimpleType(&tp) - { - *ptp = set_type(tp); - } + SET OF SimpleType(ptp) + { *ptp = set_type(*ptp); } ; /* In a pointer type definition, the type pointed at does not @@ -478,46 +442,48 @@ SetType(struct type **ptp;) */ PointerType(struct type **ptp;) { - struct type *tp; - struct def *df; - struct node *nd; + register struct def *df; + register struct node *nd; } : POINTER TO - [ %if ( (df = lookup(dot.TOK_IDF, CurrentScope))) + { *ptp = construct_type(T_POINTER, NULLTYPE); } + [ %if ( lookup(dot.TOK_IDF, CurrentScope)) /* Either a Module or a Type, but in both cases defined in this scope, so this is the correct identification */ - qualident(D_ISTYPE, &df, "type", (struct node **) 0) - { - if (!df->df_type) { - error("type \"%s\" not declared", - df->df_idf->id_text); - tp = error_type; - } - else tp = df->df_type; - } + qualtype(&((*ptp)->next)) | %if ( nd = new_node(), nd->nd_token = dot, df = lookfor(nd, CurrVis, 0), free_node(nd), df->df_kind == D_MODULE) - type(&tp) + type(&((*ptp)->next)) | - IDENT - { tp = NULLTYPE; } + IDENT { Forward(&dot, &((*ptp)->next)); } ] - { - *ptp = construct_type(T_POINTER, tp); - if (!tp) Forward(&dot, &((*ptp)->next)); - } ; +qualtype(struct type **ptp;) +{ + struct def *df; +} : + qualident(D_ISTYPE, &df, "type", (struct node **) 0) + { if (!df->df_type) { + error("type \"%s\" not declared", df->df_idf->id_text); + *ptp = error_type; + } + else *ptp = df->df_type; + } +; + + ProcedureType(struct type **ptp;) { struct paramlist *pr = 0; - struct type *tp = 0; + register struct type *tp; } : - PROCEDURE FormalTypeList(&pr, &tp)? - { *ptp = construct_type(T_PROCEDURE, tp); - (*ptp)->prc_params = pr; + { *ptp = 0; } + PROCEDURE FormalTypeList(&pr, ptp)? + { *ptp = tp = construct_type(T_PROCEDURE, *ptp); + tp->prc_params = pr; } ; @@ -528,34 +494,30 @@ FormalTypeList(struct paramlist **ppr; struct type **ptp;) } : '(' { *ppr = 0; } [ - [ VAR { VARp = D_VARPAR; } - | { VARp = D_VALPAR; } - ] - FormalType(ppr, VARp) + var(&VARp) FormalType(ppr, VARp) [ - ',' - [ VAR {VARp = D_VARPAR; } - | {VARp = D_VALPAR; } - ] - FormalType(ppr, VARp) + ',' var(&VARp) FormalType(ppr, VARp) ]* ]? ')' - [ ':' qualident(D_TYPE, &df, "type", (struct node **) 0) - { *ptp = df->df_type; } + [ ':' qualtype(ptp) ]? ; +var(int *VARp;): + VAR { *VARp = D_VARPAR; } +| + /* empty */ { *VARp = D_VALPAR; } +; + ConstantDeclaration { - struct def *df; struct idf *id; struct node *nd; }: - IDENT { id = dot.TOK_IDF; } - '=' ConstExpression(&nd){ df = define(id, CurrentScope, D_CONST); - df->con_const = nd; - } + IDENT { id = dot.TOK_IDF; } + '=' ConstExpression(&nd) + { define(id,CurrentScope,D_CONST)->con_const = nd; } ; VariableDeclaration diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H index e87d3ac01..774fd798a 100644 --- a/lang/m2/comp/def.H +++ b/lang/m2/comp/def.H @@ -119,6 +119,7 @@ extern struct def *define(), *DefineLocalModule(), *MkDef(), + *DeclProc(), *ill_df; extern struct def diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index 91f4402a1..037e9bfe0 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -232,16 +232,6 @@ DeclProc(type) return df; } -InitProc(nd, df) - struct node *nd; - struct def *df; -{ - /* Create an initialization procedure for a module. - */ - df->mod_body = nd; - /* Keep it this way, or really create a procedure out of it??? */ -} - AddModule(id) struct idf *id; { diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index 68bebc399..f33a589d4 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -15,6 +15,7 @@ static char *RcsId = "$Header$"; #include #include +#include #include #include "type.h" diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 04d4dda75..0d3bf3676 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -9,6 +9,7 @@ static char *RcsId = "$Header$"; #include #include #include +#include #include #include "idf.h" diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index 53673a472..ca3961f48 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -78,17 +78,16 @@ selector(struct node **pnd;): ExpList(struct node **pnd;) { - struct node **nd; + register struct node *nd; } : - expression(pnd) { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); + expression(pnd) { *pnd = nd = MkNode(Link,*pnd,NULLNODE,&dot); (*pnd)->nd_symb = ','; - nd = &((*pnd)->nd_right); } [ - ',' { *nd = MkLeaf(Link, &dot); + ',' { nd->nd_right = MkLeaf(Link, &dot); + nd = nd->nd_right; } - expression(&(*nd)->nd_left) - { nd = &((*nd)->nd_right); } + expression(&(nd->nd_left)) ]* ; @@ -169,7 +168,7 @@ MulOperator: ; */ -factor(struct node **p;) +factor(register struct node **p;) { struct def *df; struct node *nd; @@ -190,8 +189,7 @@ factor(struct node **p;) | %default number(p) | - STRING { - *p = MkLeaf(Value, &dot); + STRING { *p = MkLeaf(Value, &dot); (*p)->nd_type = toktype; } | @@ -205,8 +203,7 @@ bare_set(struct node **pnd;) { register struct node *nd; } : - '{' { - dot.tk_symb = SET; + '{' { dot.tk_symb = SET; *pnd = nd = MkLeaf(Xset, &dot); nd->nd_type = bitset_type; } @@ -255,7 +252,7 @@ designator_tail(struct node **pnd;): ]* ; -visible_designator_tail(struct node **pnd;): +visible_designator_tail(register struct node **pnd;): '[' { *pnd = MkNode(Arrsel, *pnd, NULLNODE, &dot); } expression(&((*pnd)->nd_right)) [ diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 405737189..18d1ad6d3 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -26,7 +26,7 @@ static char *RcsId = "$Header$"; int state; /* either IMPLEMENTATION or PROGRAM */ char options[128]; int DefinitionModule; -int SYSTEMModule = 0; +int SYSTEMModule; char *ProgName; char *DEFPATH[NDIRS+1]; struct def *Defined; @@ -34,7 +34,7 @@ extern int err_occurred; extern int fp_used; /* set if floating point used */ main(argc, argv) - char *argv[]; + register char **argv; { register int Nargc = 1; register char **Nargv = &argv[0]; @@ -84,9 +84,7 @@ Compile(src, dst) open_scope(CLOSEDSCOPE); GlobalScope = CurrentScope; C_init(word_size, pointer_size); - if (! C_open(dst)) { - fatal("Could not open output file"); - } + if (! C_open(dst)) fatal("Could not open output file"); C_magic(); C_ms_emx(word_size, pointer_size); CompUnit(); @@ -95,9 +93,7 @@ Compile(src, dst) if (!err_occurred) { C_exp(Defined->mod_vis->sc_scope->sc_name); WalkModule(Defined); - if (fp_used) { - C_ms_flt(); - } + if (fp_used) C_ms_flt(); } C_close(); #ifdef DEBUG diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 60ffc705d..36c2bf358 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -41,9 +41,8 @@ static char *RcsId = "$Header$"; ModuleDeclaration { - struct idf *id; - struct def *df; - struct node *nd; + struct idf *id; /* save module identifier */ + register struct def *df; struct node *exportlist = 0; int qualified; } : @@ -54,9 +53,8 @@ ModuleDeclaration ';' import(1)* export(&qualified, &exportlist)? - block(&nd) - IDENT { InitProc(nd, df); - if (exportlist) { + block(&(df->mod_body)) + IDENT { if (exportlist) { EnterExportList(exportlist, qualified); } close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE); @@ -93,11 +91,13 @@ export(int *QUALflag; struct node **ExportList;) import(int local;) { struct node *ImportList; - struct node *id = 0; + register struct node *id; } : [ FROM IDENT { id = MkLeaf(Value, &dot); } - ]? + | + { id = 0; } + ] IMPORT IdentList(&ImportList) ';' /* When parsing a global module, this is the place where we must @@ -113,8 +113,8 @@ import(int local;) DefinitionModule { register struct def *df; - struct idf *id; - struct node *exportlist = 0; + struct idf *id; /* save module identifier */ + struct node *exportlist; int dummy; } : DEFINITION @@ -130,19 +130,20 @@ DefinitionModule } ';' import(0)* - export(&dummy, &exportlist)? - /* New Modula-2 does not have export lists in definition modules. - For the time being, we ignore export lists here, and a - warning is issued. - */ - { if (exportlist) { + [ + export(&dummy, &exportlist) + /* New Modula-2 does not have export lists in definition + modules. Issue a warning. + */ + { node_warning(exportlist, "export list in definition module ignored"); FreeNode(exportlist); - } } + | + /* empty */ + ] definition* END IDENT - { - df = CurrentScope->sc_def; + { df = CurrentScope->sc_def; while (df) { /* Make all definitions "QUALIFIED EXPORT" */ df->df_flags |= D_QEXPORTED; @@ -157,7 +158,8 @@ node_warning(exportlist, "export list in definition module ignored"); definition { - struct def *df; + register struct def *df; + struct def *dummy; } : CONST [ ConstantDeclaration Semicolon ]* | @@ -179,13 +181,17 @@ definition | VAR [ VariableDeclaration Semicolon ]* | - ProcedureHeading(&df, D_PROCHEAD) Semicolon + ProcedureHeading(&dummy, D_PROCHEAD) + { close_scope(0); } + Semicolon ; +/* The next nonterminal is used to relax the grammar a little. +*/ Semicolon: ';' | - { warning("; expected"); } + /* empty */ { warning("; expected"); } ; ProgramModule @@ -193,30 +199,26 @@ ProgramModule struct idf *id; struct def *GetDefinitionModule(); register struct def *df; - struct node *nd; } : MODULE IDENT { id = dot.TOK_IDF; if (state == IMPLEMENTATION) { df = GetDefinitionModule(id); CurrVis = df->mod_vis; - CurrentScope = CurrVis->sc_scope; RemoveImports(&(CurrentScope->sc_def)); } else { - df = define(id, CurrentScope, D_MODULE); + Defined = df = define(id, CurrentScope, D_MODULE); open_scope(CLOSEDSCOPE); df->mod_vis = CurrVis; CurrentScope->sc_name = "_M2M"; } - Defined = df; CurrentScope->sc_definedby = df; } priority(&(df->mod_priority))? ';' import(0)* - block(&nd) IDENT - { InitProc(nd, df); - close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE); + block(&(df->mod_body)) IDENT + { close_scope(SC_CHKFORW|SC_CHKPROC|SC_REVERSE); match_id(id, dot.TOK_IDF); } '.' @@ -228,7 +230,7 @@ Module: [ IMPLEMENTATION { state = IMPLEMENTATION; } | - { state = PROGRAM; } + /* empty */ { state = PROGRAM; } ] ProgramModule ; diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g index 7728d2dee..6c45f898a 100644 --- a/lang/m2/comp/statement.g +++ b/lang/m2/comp/statement.g @@ -23,7 +23,6 @@ statement(register struct node **pnd;) { register struct node *nd; } : -[ /* * This part is not in the reference grammar. The reference grammar * states : assignment | ProcedureCall | ... @@ -67,7 +66,6 @@ statement(register struct node **pnd;) ReturnStatement(pnd) | /* empty */ { *pnd = 0; } -] ; /* @@ -194,8 +192,7 @@ ForStatement(struct node **pnd;) [ BY ConstExpression(&dummy) - { - if (!(dummy->nd_type->tp_fund & T_INTORCARD)) { + { if (!(dummy->nd_type->tp_fund & T_INTORCARD)) { error("illegal type in BY clause"); } nd->nd_INT = dummy->nd_INT; diff --git a/lang/m2/comp/tmpvar.C b/lang/m2/comp/tmpvar.C index 10338d112..0c5ade1ca 100644 --- a/lang/m2/comp/tmpvar.C +++ b/lang/m2/comp/tmpvar.C @@ -33,10 +33,17 @@ struct tmpvar { static struct tmpvar *TmpInts, /* for integer temporaries */ *TmpPtrs; /* for pointer temporaries */ -extern struct scope *ProcScope; /* scope of procedure in which the +static struct scope *ProcScope; /* scope of procedure in which the temporaries are allocated */ +TmpOpen(sc) struct scope *sc; +{ + /* Initialize for temporaries in scope "sc". + */ + ProcScope = sc; +} + arith NewInt() { diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 13584d02a..434c0c235 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -12,6 +12,7 @@ static char *RcsId = "$Header$"; #include #include #include +#include #include "def.h" #include "type.h" diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index 7a5b9bc20..68e60c220 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -13,6 +13,7 @@ static char *RcsId = "$Header$"; #include #include #include +#include #include #include "def.h" @@ -36,7 +37,6 @@ label data_label; static struct type *func_type; struct withdesig *WithDesigs; struct node *Modules; -struct scope *ProcScope; STATIC DoProfil() @@ -74,9 +74,9 @@ WalkModule(module) First call initialization routines for modules defined within this module. */ - sc->sc_off = 0; + sc->sc_off = 0; /* no locals (yet) */ text_label = 1; - ProcScope = sc; + TmpOpen(sc); /* Initialize for temporaries */ C_pro_narg(sc->sc_name); DoProfil(); if (module == Defined) { @@ -130,7 +130,7 @@ WalkProcedure(procedure) proclevel++; CurrVis = procedure->prc_vis; - ProcScope = sc = CurrentScope; + sc = CurrentScope; /* Generate code for all local modules and procedures */ @@ -140,6 +140,7 @@ WalkProcedure(procedure) */ C_pro_narg(sc->sc_name); DoProfil(); + TmpOpen(sc); /* Generate calls to initialization routines of modules defined within this procedure @@ -397,20 +398,16 @@ WalkStat(nd, lab) wds.w_next = WithDesigs; WithDesigs = &wds; wds.w_scope = left->nd_type->rec_scope; - if (ds.dsg_kind != DSG_PFIXED) { - /* In this case, we use a temporary variable - */ - CodeAddress(&ds); - ds.dsg_kind = DSG_FIXED; - /* Create a designator structure for the - temporary. - */ - ds.dsg_offset = tmp = NewPtr(); - ds.dsg_name = 0; - CodeStore(&ds, pointer_size); - ds.dsg_kind = DSG_PFIXED; - /* the record is indirectly available */ - } + CodeAddress(&ds); + ds.dsg_kind = DSG_FIXED; + /* Create a designator structure for the + temporary. + */ + ds.dsg_offset = tmp = NewPtr(); + ds.dsg_name = 0; + CodeStore(&ds, pointer_size); + ds.dsg_kind = DSG_PFIXED; + /* the record is indirectly available */ wds.w_desig = ds; link.sc_scope = wds.w_scope; link.next = CurrVis; @@ -418,7 +415,7 @@ WalkStat(nd, lab) WalkNode(right, lab); CurrVis = link.next; WithDesigs = wds.w_next; - if (tmp) FreePtr(tmp); + FreePtr(tmp); break; }