From f56f8f56f3321d7d8dce7a1e0cbabad552d24935 Mon Sep 17 00:00:00 2001 From: ceriel Date: Fri, 23 May 1986 19:25:21 +0000 Subject: [PATCH] newer version --- lang/m2/comp/LLlex.c | 1 - lang/m2/comp/LLlex.h | 5 ++- lang/m2/comp/chk_expr.c | 5 +-- lang/m2/comp/code.c | 67 ++++++++++++++++++++++++++++++++++++----- lang/m2/comp/def.H | 1 - lang/m2/comp/desig.c | 2 ++ lang/m2/comp/error.c | 11 +++---- lang/m2/comp/f_info.h | 2 +- lang/m2/comp/main.c | 2 +- lang/m2/comp/node.H | 1 - lang/m2/comp/node.c | 4 +-- lang/m2/comp/type.H | 3 -- lang/m2/comp/type.c | 10 +++--- lang/m2/comp/typequiv.c | 12 ++++++-- lang/m2/comp/walk.c | 51 +++++++++++++++++-------------- 15 files changed, 114 insertions(+), 63 deletions(-) diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index 9edc42d63..c7738c649 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -121,7 +121,6 @@ LLlex() return tk->tk_symb; } tk->tk_lineno = LineNumber; - tk->tk_filename = FileName; again: LoadChar(ch); diff --git a/lang/m2/comp/LLlex.h b/lang/m2/comp/LLlex.h index bf207ad98..dae0151a0 100644 --- a/lang/m2/comp/LLlex.h +++ b/lang/m2/comp/LLlex.h @@ -8,9 +8,8 @@ struct string { }; struct token { - int tk_symb; /* token itself */ - char *tk_filename; /* filename in which it occurred */ - int tk_lineno; /* linenumber on which it occurred */ + short tk_symb; /* token itself */ + unsigned short tk_lineno; /* linenumber on which it occurred */ union { struct idf *tk_idf; /* IDENT */ struct string *tk_str; /* STRING */ diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 31e505ded..daf2befb5 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -503,15 +503,12 @@ df->df_idf->id_text); expp->nd_symb = INTEGER; } else { - char *fn; - int ln; + unsigned int ln; assert(df->df_kind == D_CONST); ln = expp->nd_lineno; - fn = expp->nd_filename; *expp = *(df->con_const); expp->nd_lineno = ln; - expp->nd_filename = fn; } } diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 668d527b1..cd2101fa2 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -51,7 +51,6 @@ CodeConst(cst, size) CodeString(nd) struct node *nd; { - label lab; if (nd->nd_type == charc_type) { @@ -75,8 +74,8 @@ CodeReal(nd) } CodeExpr(nd, ds, true_label, false_label) - struct node *nd; - struct desig *ds; + register struct node *nd; + register struct desig *ds; label true_label, false_label; { @@ -135,9 +134,22 @@ CodeExpr(nd, ds, true_label, false_label) ds->dsg_kind = DSG_LOADED; break; + case Set: { + arith *st; + int i; + + st = nd->nd_set; + for (i = nd->nd_type->tp_size / word_size, st = nd->nd_set + i; + i > 0; + i--) { + C_loc(*--st); + } + ds->dsg_kind = DSG_LOADED; + } + break; + case Xset: - case Set: - /* ??? */ + CodeSet(nd); ds->dsg_kind = DSG_LOADED; break; @@ -160,7 +172,7 @@ CodeCoercion(t1, t2) } CodeCall(nd) - struct node *nd; + register struct node *nd; { /* Generate code for a procedure call. Checking of parameters and result is already done. @@ -250,7 +262,7 @@ CodeAssign(nd, dst, dss) } Operands(leftop, rightop) - struct node *leftop, *rightop; + register struct node *leftop, *rightop; { struct desig Des; @@ -514,7 +526,7 @@ CodeOper(expr, true_label, false_label) /* compare() serves as an auxiliary function of CodeOper */ compare(relop, lbl) int relop; - label lbl; + register label lbl; { switch (relop) { case '<': @@ -596,3 +608,42 @@ CodeUoper(nd) crash("Bad unary operator"); } } + +CodeSet(nd) + register struct node *nd; +{ + struct type *tp = nd->nd_type; + + nd = nd->nd_right; + while (nd) { + assert(nd->nd_class == Link && nd->nd_symb == ','); + + CodeEl(nd->nd_left, tp); + nd = nd->nd_right; + if (nd) { + C_ior(tp->tp_size); + } + } +} + +CodeEl(nd, tp) + register struct node *nd; + struct type *tp; +{ + + if (nd->nd_class == Link && nd->nd_symb == UPTO) { + C_zer(tp->tp_size); /* empty set */ + C_lor((arith) 1); /* SP: address of set */ + Operands(nd->nd_left, nd->nd_right); + C_cal("_LtoUset"); /* library routine to fill set */ + C_asp(2 * word_size + pointer_size); + } + else { + struct desig Des; + + Des = InitDesig; + CodeExpr(nd, &Des, NO_LABEL, NO_LABEL); + CodeValue(nd, word_size); + C_set(tp->tp_size); + } +} diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H index 95037b6fa..176452c30 100644 --- a/lang/m2/comp/def.H +++ b/lang/m2/comp/def.H @@ -61,7 +61,6 @@ struct dforward { char *fo_name; #define for_node df_value.df_forward.fo_node #define for_vis df_value.df_forward.fo_vis -#define for_scopes df_value.df_forward.fo_scopes #define for_name df_value.df_forward.fo_name }; diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index 79d0f600a..fd7949bb8 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -329,6 +329,7 @@ CodeDesig(nd, ds) case Oper: assert(nd->nd_symb == '['); + CodeDesig(nd->nd_left, ds); CodeAddress(ds); *ds = InitDesig; @@ -348,6 +349,7 @@ CodeDesig(nd, ds) case Uoper: assert(nd->nd_symb == '^'); + CodeDesig(nd->nd_right, ds); switch(ds->dsg_kind) { case DSG_LOADED: diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c index a430f70b5..3c612e163 100644 --- a/lang/m2/comp/error.c +++ b/lang/m2/comp/error.c @@ -137,9 +137,8 @@ _error(class, node, fmt, argv) static unsigned int last_ln = 0; unsigned int ln = 0; static char * last_fn = 0; - char *fn = 0; static int e_seen = 0; - char *remark = 0; + register char *remark = 0; /* Since name and number are gathered from different places depending on the class, we first collect the relevant @@ -185,7 +184,6 @@ _error(class, node, fmt, argv) switch (class) { case WARNING: case ERROR: - fn = node ? node->nd_filename : dot.tk_filename; ln = node ? node->nd_lineno : dot.tk_lineno; break; case LEXWARNING: @@ -196,14 +194,13 @@ _error(class, node, fmt, argv) case VDEBUG: #endif DEBUG ln = LineNumber; - fn = FileName; break; } #ifdef DEBUG if (class != VDEBUG) { #endif - if (fn == last_fn && ln == last_ln) { + if (FileName == last_fn && ln == last_ln) { /* we've seen this place before */ e_seen++; if (e_seen == MAXERR_LINE) fmt = "etc ..."; @@ -215,14 +212,14 @@ _error(class, node, fmt, argv) else { /* brand new place */ last_ln = ln; - last_fn = fn; + last_fn = FileName; e_seen = 0; } #ifdef DEBUG } #endif DEBUG - if (fn) fprint(ERROUT, "\"%s\", line %u: ", fn, ln); + if (FileName) fprint(ERROUT, "\"%s\", line %u: ", FileName, ln); if (remark) fprint(ERROUT, "%s ", remark); diff --git a/lang/m2/comp/f_info.h b/lang/m2/comp/f_info.h index 92b1710a4..edee620d0 100644 --- a/lang/m2/comp/f_info.h +++ b/lang/m2/comp/f_info.h @@ -3,7 +3,7 @@ /* $Header$ */ struct f_info { - unsigned int f_lineno; + unsigned short f_lineno; char *f_filename; char *f_workingdir; }; diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 62b780def..d4e112d5e 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -140,7 +140,7 @@ AddStandards() { register struct def *df; struct def *Enter(); - static struct node nilnode = { 0, 0, Value, 0, { INTEGER, 0, 0}}; + static struct node nilnode = { 0, 0, Value, 0, { INTEGER, 0}}; (void) Enter("ABS", D_PROCEDURE, std_type, S_ABS); (void) Enter("CAP", D_PROCEDURE, std_type, S_CAP); diff --git a/lang/m2/comp/node.H b/lang/m2/comp/node.H index c8c29216e..859e4bbc5 100644 --- a/lang/m2/comp/node.H +++ b/lang/m2/comp/node.H @@ -24,7 +24,6 @@ struct node { #define nd_lab nd_token.tk_data.tk_lab #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 diff --git a/lang/m2/comp/node.c b/lang/m2/comp/node.c index d0c982c3a..352347c4a 100644 --- a/lang/m2/comp/node.c +++ b/lang/m2/comp/node.c @@ -43,8 +43,8 @@ FreeNode(nd) list */ if (!nd) return; - if (nd->nd_left) FreeNode(nd->nd_left); - if (nd->nd_right) FreeNode(nd->nd_right); + FreeNode(nd->nd_left); + FreeNode(nd->nd_right); free_node(nd); } diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index b9c0eaf0a..b0cbd5643 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -29,11 +29,8 @@ struct subrange { struct array { struct type *ar_elem; /* Type of elements */ - arith ar_lb, ar_ub; /* Lower bound and upper bound */ label ar_descr; /* Label of array descriptor */ #define arr_elem tp_value.tp_arr.ar_elem -#define arr_lb tp_value.tp_arr.ar_lb -#define arr_ub tp_value.tp_arr.ar_ub #define arr_descr tp_value.tp_arr.ar_descr }; diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 5898569b1..cdea3b4ee 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -387,15 +387,11 @@ ArraySizes(tp) */ switch(index_type->tp_fund) { case T_SUBRANGE: - tp->arr_lb = index_type->sub_lb; - tp->arr_ub = index_type->sub_ub; tp->tp_size = elem_size * (index_type->sub_ub - index_type->sub_lb + 1); break; case T_CHAR: case T_ENUMERATION: - tp->arr_lb = 0; - tp->arr_ub = index_type->enm_ncst - 1; tp->tp_size = elem_size * index_type->enm_ncst; break; default: @@ -453,6 +449,8 @@ lcm(m, n) DumpType(tp) register struct type *tp; { + if (!tp) return; + print(" a:%d; s:%ld;", tp->tp_align, (long) tp->tp_size); if (tp->next && tp->tp_fund != T_POINTER) { /* Avoid printing recursive types! @@ -501,9 +499,11 @@ DumpType(tp) break; } case T_ARRAY: - print("ARRAY %ld-%ld", (long) tp->arr_lb, (long) tp->arr_ub); + print("ARRAY"); print("; el:"); DumpType(tp->arr_elem); + print("; index:"); + DumpType(tp->next); break; case T_STRING: print("STRING"); break; diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c index 2ddd5cf92..266a06a51 100644 --- a/lang/m2/comp/typequiv.c +++ b/lang/m2/comp/typequiv.c @@ -128,11 +128,12 @@ TstCompat(tp1, tp2) int TstAssCompat(tp1, tp2) - struct type *tp1, *tp2; + register struct type *tp1, *tp2; { /* Test if two types are assignment compatible. See Def 9.1. */ + register struct type *tp; if (TstCompat(tp1, tp2)) return 1; @@ -145,11 +146,16 @@ TstAssCompat(tp1, tp2) if (tp1 == char_type && tp2 == charc_type) return 1; if (tp1->tp_fund == T_ARRAY) { + /* check for string + */ arith size; - if (! tp1->next) return 0; + if (!(tp = tp1->next)) return 0; - size = tp1->arr_ub - tp1->arr_lb + 1; + if (tp->tp_fund == T_SUBRANGE) { + size = tp->sub_ub - tp->sub_lb + 1; + } + else size = tp->enm_ncst; tp1 = tp1->arr_elem; if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next; return diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index f71cd5ed0..111ea1808 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -69,10 +69,12 @@ WalkModule(module) Also generate code for its body. */ register struct def *df = module->mod_vis->sc_scope->sc_def; + register struct scope *sc; struct scopelist *vis; vis = CurrVis; CurrVis = module->mod_vis; + sc = CurrentScope; if (!proclevel && module != Defined) { /* This module is a local module, but not within a @@ -80,12 +82,12 @@ WalkModule(module) variables. This is done by generating a "bss", with label "_". */ - arith size = align(CurrentScope->sc_off, word_align); + arith size = align(sc->sc_off, word_align); if (size == 0) size = word_size; /* WHY ??? because we generated an INA for it ??? */ - C_df_dnam(&(CurrentScope->sc_name[1])); + C_df_dnam(&(sc->sc_name[1])); C_bss_cst(size, (arith) 0, 0); } else if (CurrVis == Defined->mod_vis) { @@ -104,22 +106,22 @@ WalkModule(module) /* Now, walk through it's local definitions */ - WalkDef(CurrentScope->sc_def); + WalkDef(sc->sc_def); /* Now, generate initialization code for this module. First call initialization routines for modules defined within this module. */ - CurrentScope->sc_off = 0; + sc->sc_off = 0; instructionlabel = 2; func_type = 0; - C_pro_narg(CurrentScope->sc_name); + C_pro_narg(sc->sc_name); DoProfil(); - MkCalls(CurrentScope->sc_def); + MkCalls(sc->sc_def); WalkNode(module->mod_body, (label) 0); C_df_ilb((label) 1); C_ret(0); - C_end(-CurrentScope->sc_off); + C_end(-sc->sc_off); TmpClose(); CurrVis = vis; @@ -132,20 +134,22 @@ WalkProcedure(procedure) local definitions */ struct scopelist *vis = CurrVis; + register struct scope *sc; proclevel++; CurrVis = procedure->prc_vis; + sc = CurrentScope; - WalkDef(CurrentScope->sc_def); + WalkDef(sc->sc_def); /* Generate code for this procedure */ - C_pro_narg(CurrentScope->sc_name); + C_pro_narg(sc->sc_name); DoProfil(); /* generate calls to initialization routines of modules defined within this procedure */ - MkCalls(CurrentScope->sc_def); + MkCalls(sc->sc_def); return_expr_occurred = 0; instructionlabel = 2; func_type = procedure->df_type->next; @@ -158,7 +162,7 @@ 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(-CurrentScope->sc_off); + C_end(-sc->sc_off); TmpClose(); CurrVis = vis; proclevel--; @@ -215,7 +219,7 @@ WalkNode(nd, lab) } WalkStat(nd, lab) - register struct node *nd; + struct node *nd; label lab; { /* Walk through a statement, generating code for it. @@ -224,8 +228,7 @@ WalkStat(nd, lab) */ register struct node *left = nd->nd_left; register struct node *right = nd->nd_right; - - if (options['p']) C_lin((arith) nd->nd_lineno); + register struct desig *pds = &Desig; if (!nd) { /* Empty statement @@ -233,6 +236,8 @@ WalkStat(nd, lab) return; } + if (options['p']) C_lin((arith) nd->nd_lineno); + if (nd->nd_class == Call) { if (chk_call(nd)) CodeCall(nd); return; @@ -253,7 +258,7 @@ WalkStat(nd, lab) break; } - CodeAssign(nd, &ds, &Desig); + CodeAssign(nd, &ds, pds); } break; @@ -341,16 +346,16 @@ WalkStat(nd, lab) wds.w_next = WithDesigs; WithDesigs = &wds; wds.w_scope = left->nd_type->rec_scope; - if (Desig.dsg_kind != DSG_PFIXED) { + if (pds->dsg_kind != DSG_PFIXED) { /* In this case, we use a temporary variable */ - CodeAddress(&Desig); - Desig.dsg_kind = DSG_FIXED; + CodeAddress(pds); + pds->dsg_kind = DSG_FIXED; /* Only for the store ... */ - Desig.dsg_offset = tmp = NewPtr(); - Desig.dsg_name = 0; - CodeStore(&Desig, pointer_size); - Desig.dsg_kind = DSG_PFIXED; + pds->dsg_offset = tmp = NewPtr(); + pds->dsg_name = 0; + CodeStore(pds, pointer_size); + pds->dsg_kind = DSG_PFIXED; /* the record is indirectly available */ } wds.w_desig = Desig; @@ -390,7 +395,7 @@ node_error(right, "type incompatibility in RETURN statement"); } ExpectBool(nd, true_label, false_label) - struct node *nd; + register struct node *nd; label true_label, false_label; { /* "nd" must indicate a boolean expression. Check this and -- 2.34.1