From 15896e422c2bd9aa91be405c5db806bac97a8e1d Mon Sep 17 00:00:00 2001 From: ceriel Date: Wed, 14 May 1986 09:03:51 +0000 Subject: [PATCH] newer version --- lang/m2/comp/Makefile | 17 +++++++++-------- lang/m2/comp/casestat.C | 7 ++----- lang/m2/comp/chk_expr.c | 34 ++++++++++++++++++++++++++++++---- lang/m2/comp/declar.g | 6 ++++++ lang/m2/comp/def.c | 1 - lang/m2/comp/walk.c | 40 +++++++++++++++++++++++++--------------- 6 files changed, 72 insertions(+), 33 deletions(-) diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index f4d00d07f..c0b90a479 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -44,8 +44,8 @@ main: $(OBJ) Makefile clean: rm -f $(OBJ) $(GENFILES) LLfiles -lint: LLfiles lintlist - lint $(INCLUDES) `cat lintlist` +lint: LLfiles hfiles + lint $(INCLUDES) -DNORCSID `sources $(OBJ)` tokenfile.g: tokenname.c make.tokfile make.tokfile tokenfile.g @@ -79,11 +79,11 @@ depend: make.allocd < $< > $@ #AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO -LLlex.o: LLlex.h Lpars.h class.h const.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h +LLlex.o: LLlex.h Lpars.h class.h const.h debug.h f_info.h idf.h idfsize.h input.h inputtype.h numsize.h strsize.h type.h LLmessage.o: LLlex.h Lpars.h idf.h char.o: class.h error.o: LLlex.h debug.h errout.h f_info.h input.h inputtype.h main.h node.h -main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h ndirs.h node.h scope.h standards.h tokenname.h type.h +main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h inputtype.h ndir.h node.h scope.h standards.h tokenname.h type.h symbol2str.o: Lpars.h tokenname.o: Lpars.h idf.h tokenname.h idf.o: idf.h @@ -92,17 +92,18 @@ type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h target_sizes.h type. def.o: LLlex.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 node.h scope.h type.h misc.o: LLlex.h f_info.h idf.h misc.h node.h -enter.o: LLlex.h def.h idf.h main.h node.h scope.h type.h +enter.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h main.h scope.h typequiv.o: def.h type.h node.o: LLlex.h debug.h def.h node.h type.h -cstoper.o: LLlex.h Lpars.h idf.h node.h standards.h target_sizes.h type.h +cstoper.o: LLlex.h Lpars.h debug.h idf.h node.h standards.h target_sizes.h type.h chk_expr.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h options.o: idfsize.h main.h ndir.h type.h walk.o: LLlex.h Lpars.h debug.h def.h main.h node.h scope.h type.h +casestat.o: LLlex.h Lpars.h debug.h density.h node.h type.h tokenfile.o: Lpars.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 main.h misc.h node.h scope.h type.h -expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h type.h +declar.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h node.h scope.h type.h +expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h type.h statement.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h Lpars.o: Lpars.h diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C index babfd8b36..b3ef54b3f 100644 --- a/lang/m2/comp/casestat.C +++ b/lang/m2/comp/casestat.C @@ -18,8 +18,6 @@ static char *RcsId = "$Header$"; #include "density.h" -/* STATICALLOCDEF "caselist" */ - struct switch_hdr { struct switch_hdr *next; label sh_break; @@ -102,7 +100,7 @@ CaseCode(nd, exitlabel) tablabel = data_label(); /* the rom must have a label */ C_df_dlb(tablabel); if (sh->sh_default) C_rom_ilb(sh->sh_default); - else C_rom_ucon((arith) 0, pointer_size); + else C_rom_ucon("0", pointer_size); if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) { /* CSA */ @@ -253,8 +251,7 @@ AddOneCase(sh, node, lbl) */ if (c1) { if (c1->ce_value == ce->ce_value) { - node_error("multiple case entry for value %ld", - ce->ce_value); +node_error(node, "multiple case entry for value %ld", ce->ce_value); free_case_entry(ce); return 0; } diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index ad59c7fef..a0bc2050a 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -448,7 +448,7 @@ chk_designator(expp, flag) assert(expp->nd_right->nd_class == Name); if (! chk_designator(expp->nd_left, - (flag|HASSELECTORS)&DESIGNATOR)) return 0; + (flag|HASSELECTORS))) return 0; tp = expp->nd_left->nd_type; @@ -633,7 +633,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R case '*': switch(tpl->tp_fund) { case T_POINTER: - if (tpl != address_type) break; + if (! chk_address(tpl, tpr)) break; /* Fall through */ case T_INTEGER: case T_CARDINAL: @@ -669,7 +669,13 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R case DIV: case MOD: - if ((tpl->tp_fund & T_INTORCARD) || tpl == address_type) { + switch(tpl->tp_fund) { + case T_POINTER: + if (! chk_address(tpl, tpr)) break; + /* Fall through */ + case T_INTEGER: + case T_CARDINAL: + case T_INTORCARD: if (left->nd_class==Value && right->nd_class==Value) { cstbin(expp); } @@ -718,7 +724,8 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R return 1; case T_POINTER: - if (expp->nd_symb == '=' || + if (chk_address(tpl, tpr) || + expp->nd_symb == '=' || expp->nd_symb == UNEQUAL || expp->nd_symb == '#') return 1; break; @@ -745,6 +752,22 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R return 0; } +int +chk_address(tpl, tpr) + register struct type *tpl, *tpr; +{ + + if (tpl == address_type) { + return tpr == address_type || tpr->tp_fund != T_POINTER; + } + + if (tpr == address_type) { + return tpl->tp_fund != T_POINTER; + } + + return 0; +} + int chk_uoper(expp) register struct node *expp; @@ -769,6 +792,9 @@ chk_uoper(expp) case '-': if (tpr->tp_fund & T_INTORCARD) { + if (tpr == intorcard_type) { + expp->nd_type = int_type; + } if (right->nd_class == Value) { cstunary(expp); } diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 909e43398..1adbccd79 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -56,6 +56,12 @@ ProcedureHeading(struct def **pdf; int type;) PROCEDURE IDENT { df = DeclProc(type); + if (proclevel) { + /* Room for static link + */ + df->prc_nbpar = pointer_size; + } + else df->prc_nbpar = 0; } FormalParameters(type == D_PROCEDURE, ¶ms, &tp, &(df->prc_nbpar))? { diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index a5781cbe2..8006d58ab 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -477,7 +477,6 @@ DeclProc(type) strcpy(CurrentScope->sc_name, buf); C_inp(buf); } - df->prc_nbpar = 0; } return df; diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index 812b48cf5..6e56b658d 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -25,8 +25,6 @@ static char *RcsId = "$Header$"; extern arith align(); static int prclev = 0; static label instructionlabel; -static label datalabel = 1; -static label return_label; static char return_expr_occurred; static struct type *func_type; @@ -39,7 +37,9 @@ text_label() label data_label() { - return datalabel++; + static label datalabel = 0; + + return ++datalabel; } WalkModule(module) @@ -89,14 +89,13 @@ WalkModule(module) this module. */ CurrentScope->sc_off = 0; - instructionlabel = 1; - return_label = instructionlabel++; + instructionlabel = 2; func_type = 0; C_pro_narg(CurrentScope->sc_name); MkCalls(CurrentScope->sc_def); WalkNode(module->mod_body, (label) 0); - C_df_ilb(return_label); - C_ret((label) 0); + C_df_ilb((label) 1); + C_ret(0); C_end(align(-CurrentScope->sc_off, word_align)); CurrVis = vis; @@ -121,15 +120,20 @@ WalkProcedure(procedure) /* generate calls to initialization routines of modules defined within this procedure */ - return_label = 1; + MkCalls(CurrentScope->sc_def); + return_expr_occurred = 0; instructionlabel = 2; func_type = procedure->df_type->next; - MkCalls(CurrentScope->sc_def); WalkNode(procedure->prc_body, (label) 0); - C_df_ilb(return_label); - if (func_type) C_ret((arith) align(func_type->tp_size, word_align)); - else C_ret((arith) 0); - C_end(align(-CurrentScope->sc_off, word_size)); + C_df_ilb((label) 1); + if (func_type) { + if (! return_expr_occurred) { +node_error(procedure->prc_body,"function procedure does not return a value"); + } + C_ret((int) align(func_type->tp_size, word_align)); + } + else C_ret(0); + C_end((int) align(-CurrentScope->sc_off, word_align)); CurrVis = vis; prclev--; } @@ -195,6 +199,12 @@ WalkStat(nd, lab) register struct node *left = nd->nd_left; register struct node *right = nd->nd_right; + if (!nd) { + /* Empty statement + */ + return; + } + if (nd->nd_class == Call) { if (chk_call(nd)) CodeCall(nd); return; @@ -204,8 +214,8 @@ WalkStat(nd, lab) switch(nd->nd_symb) { case BECOMES: - WalkDesignator(left); WalkExpr(right); + WalkDesignator(left); /* May we do it in this order??? */ if (! TstAssCompat(left->nd_type, right->nd_type)) { node_error(nd, "type incompatibility in assignment"); @@ -318,7 +328,7 @@ node_error(right, "type incompatibility in RETURN statement"); } return_expr_occurred = 1; } - C_bra(return_label); + C_bra((label) 1); break; default: