newer version
authorceriel <none@none>
Thu, 1 May 1986 19:06:53 +0000 (19:06 +0000)
committerceriel <none@none>
Thu, 1 May 1986 19:06:53 +0000 (19:06 +0000)
26 files changed:
lang/m2/comp/LLlex.c
lang/m2/comp/LLlex.h
lang/m2/comp/LLmessage.c
lang/m2/comp/Makefile
lang/m2/comp/Parameters
lang/m2/comp/casestat.C [new file with mode: 0644]
lang/m2/comp/chk_expr.c
lang/m2/comp/cstoper.c
lang/m2/comp/declar.g
lang/m2/comp/def.c
lang/m2/comp/defmodule.c
lang/m2/comp/enter.c
lang/m2/comp/error.c
lang/m2/comp/expression.g
lang/m2/comp/main.c
lang/m2/comp/misc.c
lang/m2/comp/node.H
lang/m2/comp/node.c
lang/m2/comp/options.c
lang/m2/comp/program.g
lang/m2/comp/scope.C
lang/m2/comp/statement.g
lang/m2/comp/tokenname.c
lang/m2/comp/type.c
lang/m2/comp/typequiv.c
lang/m2/comp/walk.c

index 8ebb1d8..9edc42d 100644 (file)
@@ -1,16 +1,19 @@
 /* L E X I C A L   A N A L Y S E R   F O R   M O D U L A - 2 */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
+#include       "idfsize.h"
+#include       "numsize.h"
+#include       "strsize.h"
 
 #include       <alloc.h>
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
 
-#include       "idfsize.h"
-#include       "numsize.h"
-#include       "strsize.h"
-
 #include       "input.h"
 #include       "f_info.h"
 #include       "Lpars.h"
index 0fcddec..bf207ad 100644 (file)
@@ -18,6 +18,7 @@ struct token  {
                char *tk_real;          /* REAL         */
                arith *tk_set;          /* only used in parse tree node */
                struct def *tk_def;     /* only used in parse tree node */
+               label tk_lab;           /* only used in parse tree node */
        } tk_data;
 };
 
index ad6cd5b..0ea6e86 100644 (file)
@@ -1,9 +1,13 @@
 /* S Y N T A X   E R R O R   R E P O R T I N G */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
 
 #include       <alloc.h>
 #include       <em_arith.h>
+#include       <em_label.h>
+
 #include       "idf.h"
 #include       "LLlex.h"
 #include       "Lpars.h"
index 7d89327..f4d00d0 100644 (file)
@@ -18,7 +18,7 @@ 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 node.o \
-       cstoper.o chk_expr.o options.o walk.o
+       cstoper.o chk_expr.o options.o walk.o casestat.o
 OBJ =  $(COBJ) $(LOBJ) Lpars.o
 GENFILES=      tokenfile.c \
        program.c declar.c expression.c statement.c \
@@ -58,6 +58,7 @@ def.h:                def.H make.allocd
 type.h:                type.H make.allocd
 node.h:                node.H make.allocd
 scope.c:       scope.C make.allocd
+casestat.c:    casestat.C make.allocd
 
 char.c: char.tab tab
        ./tab -fchar.tab >char.c
index 7604bdf..82e019a 100644 (file)
@@ -67,4 +67,5 @@ extern char options[];
 #define NDIRS  16              /* maximum number of directories searched */
 
 
-
+!File: density.h
+#define DENSITY        3               /* see casestat.C for an explanation */
diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C
new file mode 100644 (file)
index 0000000..babfd8b
--- /dev/null
@@ -0,0 +1,279 @@
+/* C A S E   S T A T E M E N T   C O D E   G E N E R A T I O N */
+
+#ifndef NORCSID
+static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
+
+#include       <em_label.h>
+#include       <em_arith.h>
+#include       <alloc.h>
+#include       <assert.h>
+
+#include       "Lpars.h"
+#include       "type.h"
+#include       "LLlex.h"
+#include       "node.h"
+
+#include       "density.h"
+
+/* STATICALLOCDEF "caselist" */
+
+struct switch_hdr      {
+       struct switch_hdr *next;
+       label sh_break;
+       label sh_default;
+       int sh_nrofentries;
+       struct type *sh_type;
+       arith sh_lowerbd;
+       arith sh_upperbd;
+       struct case_entry *sh_entries;
+};
+
+/* STATICALLOCDEF "switch_hdr" */
+
+struct case_entry      {
+       struct case_entry *next;
+       label ce_label;
+       arith ce_value;
+};
+
+/* STATICALLOCDEF "case_entry" */
+
+/* The constant DENSITY determines when CSA and when CSB instructions
+   are generated. Reasonable values are: 2, 3, 4.
+   On machines that have lots of address space and memory, higher values
+   are also reasonable. On these machines the density of jump tables
+   may be lower.
+*/
+#define        compact(nr, low, up)    (nr != 0 && (up - low) / nr <= DENSITY)
+
+extern label text_label(), data_label();
+
+CaseCode(nd, exitlabel)
+       struct node *nd;
+       label exitlabel;
+{
+       /*      Check the expression, stack a new case header and
+               fill in the necessary fields.
+       */
+       register struct switch_hdr *sh = new_switch_hdr();
+       register struct node *pnode = nd;
+       register struct case_entry *ce;
+       register arith val;
+       label tablabel;
+
+       assert(nd->nd_class == Stat && nd->nd_symb == CASE);
+
+       WalkExpr(nd->nd_left);
+       sh->sh_type = nd->nd_left->nd_type;
+       sh->sh_break = text_label();
+       sh->sh_default = 0;
+       sh->sh_nrofentries = 0;
+       sh->sh_lowerbd = sh->sh_upperbd = (arith)0;     /* immaterial ??? */
+       sh->sh_entries = (struct case_entry *) 0; /* case-entry list    */
+
+       /* Now, create case label list
+       */
+       while (pnode && pnode->nd_right) {
+               pnode = pnode->nd_right;
+               if (pnode->nd_class == Link && pnode->nd_symb == '|') {
+                       if (pnode->nd_left) {
+                               pnode->nd_lab = text_label();
+                               if (! AddCases(sh,
+                                              pnode->nd_left->nd_left,
+                                              pnode->nd_lab)) {
+                                       FreeSh(sh);
+                                       return;
+                               }
+                       }
+               }
+               else {
+                       /* Else part
+                       */
+                       pnode = 0;
+                       sh->sh_default = text_label();
+               }
+       }
+
+       /* Now generate code for the switch itself
+       */
+       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);
+       if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
+               /* CSA */
+
+               C_rom_cst(sh->sh_lowerbd);
+               C_rom_cst(sh->sh_upperbd - sh->sh_lowerbd);
+               ce = sh->sh_entries;
+               for (val = sh->sh_lowerbd; val <= sh->sh_upperbd; val++) {
+                       assert(ce);
+                       if (val == ce->ce_value)        {
+                               C_rom_ilb(ce->ce_label);
+                               ce = ce->next;
+                       }
+                       else if (sh->sh_default) C_rom_ilb(sh->sh_default);
+                       else C_rom_ucon("0", pointer_size);
+               }
+               C_lae_dlb(tablabel, (arith)0); /* perform the switch    */
+               C_csa(word_size);
+       }
+       else    { /* CSB */
+               C_rom_cst((arith)sh->sh_nrofentries);
+               for (ce = sh->sh_entries; ce; ce = ce->next)    {
+                       /* generate the entries: value + prog.label     */
+                       C_rom_cst(ce->ce_value);
+                       C_rom_ilb(ce->ce_label);
+               }
+               C_lae_dlb(tablabel, (arith)0); /* perform the switch    */
+               C_csb(word_size);
+       }
+
+       /* Now generate code for the cases
+       */
+       pnode = nd;
+       while (pnode && pnode->nd_right) {
+               pnode = pnode->nd_right;
+               if (pnode->nd_class == Link && pnode->nd_symb == '|') {
+                       if (pnode->nd_left) {
+                               C_df_ilb(pnode->nd_lab);
+                               WalkNode(pnode->nd_left->nd_right, exitlabel);
+                               C_bra(sh->sh_break);
+                       }
+               }
+               else {
+                       /* Else part
+                       */
+                       assert(sh->sh_default != 0);
+
+                       C_df_ilb(sh->sh_default);
+                       WalkNode(pnode, exitlabel);
+                       pnode = 0;
+               }
+       }
+
+       C_df_ilb(sh->sh_break);
+       FreeSh(sh);
+}
+
+FreeSh(sh)
+       struct switch_hdr *sh;
+{
+       /*       free the allocated switch structure    
+       */
+       register struct case_entry *ce;
+
+       ce = sh->sh_entries;
+       while (ce)      {
+               struct case_entry *tmp = ce->next;
+
+               free_case_entry(ce);
+               ce = tmp;
+       }
+
+       free_switch_hdr(sh);
+}
+
+AddCases(sh, node, lbl)
+       struct switch_hdr *sh;
+       struct node *node;
+       label lbl;
+{
+       /*      Add case labels to the case label list
+       */
+       register arith v1, v2;
+
+       if (node->nd_class == Link) {
+               if (node->nd_symb == UPTO) {
+                       assert(node->nd_left->nd_class == Value);
+                       assert(node->nd_right->nd_class == Value);
+                       v2 = node->nd_right->nd_INT;
+                       node->nd_type = node->nd_left->nd_type;
+                       for (v1 = node->nd_left->nd_INT; v1 <= v2; v1++) {
+                               node->nd_INT = v1;
+                               if (! AddOneCase(sh, node, lbl)) return 0;
+                       }
+                       return 1;
+               }
+
+               assert(node->nd_symb == ',');
+               return  AddCases(sh, node->nd_left, lbl) &&
+                       AddCases(sh, node->nd_right, lbl);
+       }
+
+       assert(node->nd_class == Value);
+       return AddOneCase(sh, node, lbl);
+}
+
+AddOneCase(sh, node, lbl)
+       register struct switch_hdr *sh;
+       struct node *node;
+       label lbl;
+{
+       register struct case_entry *ce = new_case_entry();
+       register struct case_entry *c1 = sh->sh_entries, *c2 = 0;
+
+       ce->ce_label = lbl;
+       ce->ce_value = node->nd_INT;
+       if (! TstCompat(sh->sh_type, node->nd_type)) {
+               node_error(node, "Type incompatibility in case");
+               free_case_entry(ce);
+               return 0;
+       }
+       if (sh->sh_entries == 0)        {
+               /* first case entry     */
+               ce->next = (struct case_entry *) 0;
+               sh->sh_entries = ce;
+               sh->sh_lowerbd = sh->sh_upperbd = ce->ce_value;
+               sh->sh_nrofentries = 1;
+       }
+       else    {
+               /* second etc. case entry               */
+               /* find the proper place to put ce into the list        */
+               
+               if (ce->ce_value < sh->sh_lowerbd) sh->sh_lowerbd = ce->ce_value;
+               else
+               if (ce->ce_value > sh->sh_upperbd) sh->sh_upperbd = ce->ce_value;
+               while (c1 && c1->ce_value < ce->ce_value)       {
+                       c2 = c1;
+                       c1 = c1->next;
+               }
+               /*      At this point three cases are possible:
+                       1: c1 != 0 && c2 != 0:
+                               insert ce somewhere in the middle
+                       2: c1 != 0 && c2 == 0:
+                               insert ce right after the head
+                       3: c1 == 0 && c2 != 0:
+                               append ce to last element
+                       The case c1 == 0 && c2 == 0 cannot occur, since
+                       the list is guaranteed not to be empty.
+               */
+               if (c1) {
+                       if (c1->ce_value == ce->ce_value)       {
+                               node_error("multiple case entry for value %ld",
+                                       ce->ce_value);
+                               free_case_entry(ce);
+                               return 0;
+                       }
+                       if (c2) {
+                               ce->next = c2->next;
+                               c2->next = ce;
+                       }
+                       else    {
+                               ce->next = sh->sh_entries;
+                               sh->sh_entries = ce;
+                       }
+               }
+               else    {
+                       assert(c2);
+
+                       ce->next = (struct case_entry *) 0;
+                       c2->next = ce;
+               }
+               (sh->sh_nrofentries)++;
+       }
+       return 1;
+}
index 95f3338..ad59c7f 100644 (file)
@@ -1,9 +1,14 @@
 /* E X P R E S S I O N   C H E C K I N G */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
 
 /*     Check expressions, and try to evaluate them as far as possible.
 */
+
+#include       "debug.h"
+
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
@@ -19,8 +24,6 @@ static char *RcsId = "$Header$";
 #include       "const.h"
 #include       "standards.h"
 
-#include       "debug.h"
-
 extern char *symbol2str();
 
 int
index 8a671aa..aba6940 100644 (file)
@@ -1,13 +1,16 @@
 /* C O N S T A N T   E X P R E S S I O N   H A N D L I N G */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
+#include       "target_sizes.h"
 
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
 
-#include       "target_sizes.h"
-
 #include       "idf.h"
 #include       "type.h"
 #include       "LLlex.h"
@@ -47,7 +50,7 @@ cstunary(expp)
        expp->nd_class = Value;
        expp->nd_token = expp->nd_right->nd_token;
        expp->nd_INT = o1;
-       cut_size(expp);
+       CutSize(expp);
        FreeNode(expp->nd_right);
        expp->nd_right = 0;
 }
@@ -64,11 +67,14 @@ cstbin(expp)
        int uns = expp->nd_type != int_type;
 
        assert(expp->nd_class == Oper);
-       assert(expp->nd_left->nd_class == Value && expp->nd_right->nd_class == Value);
+       assert(expp->nd_left->nd_class == Value);
+       assert(expp->nd_right->nd_class == Value);
+
        switch (expp->nd_symb)  {
        case '*':
                o1 *= o2;
                break;
+
        case DIV:
                if (o2 == 0)    {
                        node_error(expp, "division by 0");
@@ -106,6 +112,7 @@ cstbin(expp)
                else
                        o1 /= o2;
                break;
+
        case MOD:
                if (o2 == 0)    {
                        node_error(expp, "modulo by 0");
@@ -135,12 +142,15 @@ cstbin(expp)
                else
                        o1 %= o2;
                break;
+
        case '+':
                o1 += o2;
                break;
+
        case '-':
                o1 -= o2;
                break;
+
        case '<':
                if (uns)        {
                        o1 = (o1 & mach_long_sign ?
@@ -151,6 +161,7 @@ cstbin(expp)
                else
                        o1 = o1 < o2;
                break;
+
        case '>':
                if (uns)        {
                        o1 = (o1 & mach_long_sign ?
@@ -201,7 +212,7 @@ cstbin(expp)
        expp->nd_class = Value;
        expp->nd_token = expp->nd_right->nd_token;
        expp->nd_INT = o1;
-       cut_size(expp);
+       CutSize(expp);
        FreeNode(expp->nd_left);
        FreeNode(expp->nd_right);
        expp->nd_left = expp->nd_right = 0;
@@ -318,18 +329,18 @@ cstcall(expp, call)
                }
                if (expr->nd_INT < 0) expp->nd_INT = - expr->nd_INT;
                else expp->nd_INT = expr->nd_INT;
-               cut_size(expp);
+               CutSize(expp);
                break;
        case S_CAP:
                if (expr->nd_INT >= 'a' && expr->nd_INT <= 'z') {
                        expp->nd_INT = expr->nd_INT + ('A' - 'a');
                }
                else    expp->nd_INT = expr->nd_INT;
-               cut_size(expp);
+               CutSize(expp);
                break;
        case S_CHR:
                expp->nd_INT = expr->nd_INT;
-               cut_size(expp);
+               CutSize(expp);
                break;
        case S_MAX:
                if (expp->nd_type == int_type) {
@@ -363,7 +374,7 @@ cstcall(expp, call)
                break;
        case S_ORD:
                expp->nd_INT = expr->nd_INT;
-               cut_size(expp);
+               CutSize(expp);
                break;
        case S_SIZE:
                expp->nd_INT = align(expr->nd_type->tp_size, (int) word_size) /
@@ -386,7 +397,7 @@ cstcall(expp, call)
                      )
                    )
                   )    node_warning(expp,"overflow in constant expression");
-               else cut_size(expp);
+               else CutSize(expp);
                break;
        default:
                assert(0);
@@ -396,7 +407,7 @@ cstcall(expp, call)
        expp->nd_right = expp->nd_left = 0;
 }
 
-cut_size(expr)
+CutSize(expr)
        register struct node *expr;
 {
        /*      The constant value of the expression expr is made to
@@ -430,7 +441,7 @@ cut_size(expr)
        expr->nd_INT = o1;
 }
 
-init_cst()
+InitCst()
 {
        int i = 0;
        arith bt = (arith)0;
index 924f63e..909e433 100644 (file)
@@ -1,7 +1,11 @@
 /* D E C L A R A T I O N S */
 
 {
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
 
 #include       <em_arith.h>
 #include       <em_label.h>
@@ -17,8 +21,6 @@ static char *RcsId = "$Header$";
 #include       "misc.h"
 #include       "main.h"
 
-#include       "debug.h"
-
 int            proclevel = 0;  /* nesting level of procedures */
 extern char    *sprint();
 extern struct def *currentdef;
@@ -382,6 +384,9 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
                                { id = gen_anon_idf(); }
        ]
                                { tp = df->df_type;
+                                 if (!(tp->tp_fund & T_DISCRETE)) {
+                                       error("Illegal type in variant");
+                                 }
                                  df = define(id, scope, D_FIELD);
                                  df->df_type = tp;
                                  df->fld_off = align(*cnt, tp->tp_align);
@@ -439,8 +444,8 @@ CaseLabels(struct type **ptp; struct node **pnd;)
                ConstExpression(&nd2)
                                { if (!TstCompat(nd1->nd_type, nd2->nd_type)) {
 node_error(nd2,"type incompatibility in case label");
+                                       nd1->nd_type = error_type;
                                  }
-                                 nd1->nd_type = error_type;
                                  (*pnd)->nd_right = nd2;
                                }
        ]?
index 295e5c4..a5781cb 100644 (file)
@@ -1,6 +1,10 @@
 /* D E F I N I T I O N   M E C H A N I S M */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
 
 #include       <alloc.h>
 #include       <em_arith.h>
@@ -15,14 +19,9 @@ static char *RcsId = "$Header$";
 #include       "LLlex.h"
 #include       "node.h"
 
-#include       "debug.h"
-
 struct def *h_def;             /* Pointer to free list of def structures */
 
-static struct def illegal_def =
-       {0, 0, 0, 0, D_ERROR};
-
-struct def *ill_df = &illegal_def;
+struct def *ill_df;
 
 struct def *
 MkDef(id, scope, kind)
@@ -49,6 +48,16 @@ MkDef(id, scope, kind)
        return df;
 }
 
+InitDef()
+{
+       /*      Initialize this module. Easy, the only thing to be initialized
+               is "illegal_def".
+       */
+       struct idf *gen_anon_idf();
+
+       ill_df = MkDef(gen_anon_idf(), CurrentScope, D_ERROR);
+}
+
 struct def *
 define(id, scope, kind)
        register struct idf *id;
@@ -59,8 +68,6 @@ define(id, scope, kind)
        */
        register struct def *df;
 
-       DO_DEBUG(5, debug("Defining identifier \"%s\", kind = %d",
-                         id->id_text, kind));
        df = lookup(id, scope);
        if (    /* Already in this scope */
                df
@@ -372,10 +379,9 @@ ids->nd_IDF->id_text);
                        else    df = GetDefinitionModule(ids->nd_IDF);
                }
 
-DO_DEBUG(2, debug("importing \"%s\", kind %d", ids->nd_IDF->id_text,
-df->df_kind));
-               define(df->df_idf, CurrentScope, D_IMPORT)->imp_def = df;
+               define(ids->nd_IDF,CurrentScope,D_IMPORT)->imp_def = df;
                DoImport(df, CurrentScope);
+
                ids = ids->next;
        }
 
@@ -463,8 +469,8 @@ DeclProc(type)
                                sprint(buf, "_%d_%s", ++nmcount,
                                        df->df_idf->id_text);
                        }
-                       else    (sprint(buf, "%s_%s",CurrentScope->sc_name,
-                                               df->df_idf->id_text));
+                       else    sprint(buf, "%s_%s",CurrentScope->sc_name,
+                                               df->df_idf->id_text);
                        open_scope(OPENSCOPE);
                        df->prc_vis = CurrVis;
                        CurrentScope->sc_name = Malloc((unsigned)(strlen(buf)+1));
@@ -491,6 +497,6 @@ InitProc(nd, df)
 PrDef(df)
        register struct def *df;
 {
-       debug("name: %s, kind: %d", df->df_idf->id_text, df->df_kind);
+       print("n: %s, k: %d\n", df->df_idf->id_text, df->df_kind);
 }
 #endif DEBUG
index faf3b62..cad40b3 100644 (file)
@@ -1,6 +1,10 @@
 /* D E F I N I T I O N   M O D U L E S */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
 
 #include       <assert.h>
 #include       <em_arith.h>
@@ -14,8 +18,6 @@ static char *RcsId = "$Header$";
 #include       "f_info.h"
 #include       "main.h"
 
-#include       "debug.h"
-
 #ifdef DEBUG
 long   sys_filesize();
 #endif
index b96d7a1..336a2e0 100644 (file)
@@ -1,11 +1,16 @@
 /* H I G H   L E V E L   S Y M B O L   E N T R Y   A N D   L O O K U P */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
 
 #include       <alloc.h>
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
+
 #include       "idf.h"
 #include       "def.h"
 #include       "type.h"
index 7c12107..8158886 100644 (file)
@@ -5,14 +5,17 @@
        number of arguments!
 */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
-
-#include       <system.h>
-#include       <em_arith.h>
+#endif
 
 #include       "errout.h"
 #include       "debug.h"
 
+#include       <system.h>
+#include       <em_arith.h>
+#include       <em_label.h>
+
 #include       "input.h"
 #include       "f_info.h"
 #include       "LLlex.h"
index 1509eb9..6825795 100644 (file)
@@ -1,19 +1,23 @@
 /* E X P R E S S I O N S */
 
 {
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
 
 #include       <alloc.h>
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
+
 #include       "LLlex.h"
 #include       "idf.h"
 #include       "def.h"
 #include       "node.h"
 #include       "const.h"
 #include       "type.h"
-#include       "debug.h"
 }
 
 number(struct node **p;)
index afd2b13..c81078f 100644 (file)
@@ -1,6 +1,11 @@
 /* M A I N   P R O G R A M */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
+#include       "ndir.h"
 
 #include       <system.h>
 #include       <em_arith.h>
@@ -18,9 +23,6 @@ static char *RcsId = "$Header$";
 #include       "tokenname.h"
 #include       "node.h"
 
-#include       "debug.h"
-#include       "ndir.h"
-
 char   options[128];
 int    DefinitionModule; 
 int    SYSTEMModule = 0;
@@ -39,7 +41,7 @@ main(argc, argv)
 
        while (--argc > 0) {
                if (**argv == '-')
-                       do_option((*argv++) + 1);
+                       DoOption((*argv++) + 1);
                else
                        Nargv[Nargc++] = *argv++;
        }
@@ -70,11 +72,12 @@ Compile(src, dst)
        DEFPATH[0] = "";
        DEFPATH[NDIRS] = 0;
        init_idf();
-       init_cst();
+       InitCst();
        reserve(tkidf);
        init_scope();
        init_types();
-       add_standards();
+       InitDef();
+       AddStandards();
 #ifdef DEBUG
        if (options['l']) {
                LexScan();
@@ -133,7 +136,7 @@ LexScan()
 }
 #endif
 
-add_standards()
+AddStandards()
 {
        register struct def *df;
        struct def *Enter();
index 70c4f82..d28f4ef 100644 (file)
@@ -1,9 +1,13 @@
 /* M I S C E L L A N E O U S    R O U T I N E S */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
 
 #include       <alloc.h>
 #include       <em_arith.h>
+#include       <em_label.h>
+
 #include       "f_info.h"
 #include       "misc.h"
 #include       "LLlex.h"
index f4a3095..c8c2921 100644 (file)
@@ -21,6 +21,7 @@ struct node {
        struct token nd_token;
 #define nd_set         nd_token.tk_data.tk_set
 #define nd_def         nd_token.tk_data.tk_def
+#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
index e852541..d0c982c 100644 (file)
@@ -1,16 +1,20 @@
 /* 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 */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
 
 #include       <em_label.h>
 #include       <em_arith.h>
 #include       <alloc.h>
 #include       <system.h>
+
 #include       "def.h"
 #include       "type.h"
 #include       "LLlex.h"
 #include       "node.h"
-#include       "debug.h"
 
 struct node *h_node;           /* header of free list */
 
index f372a62..5206d42 100644 (file)
@@ -1,21 +1,22 @@
 /* U S E R   O P T I O N - H A N D L I N G */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
-
-#include       <em_arith.h>
-#include       <em_label.h>
+#endif
 
 #include       "idfsize.h"
 #include       "ndir.h"
 
+#include       <em_arith.h>
+#include       <em_label.h>
+
 #include       "type.h"
 #include       "main.h"
 
 extern int     idfsize;
-
 static int     ndirs;
 
-do_option(text)
+DoOption(text)
        char *text;
 {
        switch(*text++) {
index 3a54619..81444fc 100644 (file)
@@ -1,7 +1,11 @@
 /* O V E R A L L   S T R U C T U R E */
 
 {
+#ifndef NORCSID
 static  char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
 
 #include       <alloc.h>
 #include       <em_arith.h>
@@ -15,8 +19,6 @@ static  char *RcsId = "$Header$";
 #include       "type.h"
 #include       "node.h"
 
-#include       "debug.h"
-
 static int DEFofIMPL = 0;      /* Flag indicating that we are currently
                                   parsing the definition module of the
                                   implementation module currently being
index fbb6f6c..f416ceb 100644 (file)
@@ -1,6 +1,10 @@
 /* S C O P E   M E C H A N I S M */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "debug.h"
 
 #include       <assert.h>
 #include       <alloc.h>
@@ -14,8 +18,6 @@ static char *RcsId = "$Header$";
 #include       "def.h"
 #include       "node.h"
 
-#include       "debug.h"
-
 struct scope *PervasiveScope, *GlobalScope;
 struct scopelist *CurrVis;
 static int scp_level;
@@ -233,7 +235,7 @@ close_scope(flag)
 PrScopeDef(df)
        register struct def *df;
 {
-       debug("List of definitions in currently ended scope:");
+       print("List of definitions in currently ended scope:\n");
        while (df) {
                PrDef(df);
                df = df->df_nextinscope;
index c601047..434de4d 100644 (file)
@@ -1,7 +1,9 @@
 /* S T A T E M E N T S */
 
 {
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
 
 #include       <em_arith.h>
 #include       <em_label.h>
index a9b9920..bb24813 100644 (file)
@@ -1,6 +1,8 @@
 /* T O K E N   D E F I N I T I O N S */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
 
 #include       "tokenname.h"
 #include       "Lpars.h"
index f542402..e9f19f9 100644 (file)
@@ -1,16 +1,18 @@
 /*     T Y P E   D E F I N I T I O N   M E C H A N I S M        */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
+
+#include       "target_sizes.h"
+#include       "debug.h"
+#include       "maxset.h"
 
 #include       <assert.h>
 #include       <alloc.h>
 #include       <em_arith.h>
 #include       <em_label.h>
 
-#include       "target_sizes.h"
-#include       "debug.h"
-#include       "maxset.h"
-
 #include       "def.h"
 #include       "type.h"
 #include       "idf.h"
index 6ccd9aa..2ddd5cf 100644 (file)
@@ -1,12 +1,15 @@
 /* T Y P E   E Q U I V A L E N C E */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
 
 /*     Routines for testing type equivalence, type compatibility, and
        assignment compatibility
 */
 #include       <em_arith.h>
 #include       <em_label.h>
+
 #include       "type.h"
 #include       "def.h"
 
index dfd8d64..812b48c 100644 (file)
@@ -1,11 +1,15 @@
 /* P A R S E   T R E E   W A L K E R */
 
+#ifndef NORCSID
 static char *RcsId = "$Header$";
+#endif
 
 /*     Routines to walk through parts of the parse tree, and generate
        code for these parts.
 */
 
+#include       "debug.h"
+
 #include       <em_arith.h>
 #include       <em_label.h>
 #include       <assert.h>
@@ -18,16 +22,26 @@ static char *RcsId = "$Header$";
 #include       "node.h"
 #include       "Lpars.h"
 
-#include       "debug.h"
-
 extern arith   align();
 static int     prclev = 0;
-static label   instructionlabel = 0;
-static label   datalabel = 0;
+static label   instructionlabel;
+static label   datalabel = 1;
 static label   return_label;
 static char    return_expr_occurred;
 static struct type *func_type;
 
+label
+text_label()
+{
+       return instructionlabel++;
+}
+
+label
+data_label()
+{
+       return datalabel++;
+}
+
 WalkModule(module)
        register struct def *module;
 {
@@ -182,9 +196,7 @@ WalkStat(nd, lab)
        register struct node *right = nd->nd_right;
 
        if (nd->nd_class == Call) {
-               if (chk_call(nd)) {
-                       /* ??? */
-               }
+               if (chk_call(nd)) CodeCall(nd);
                return;
        }
 
@@ -199,7 +211,9 @@ WalkStat(nd, lab)
                        node_error(nd, "type incompatibility in assignment");
                        break;
                }
-               /* ??? */
+
+               CodeAssign(nd);
+
                break;
 
        case IF:
@@ -223,23 +237,8 @@ WalkStat(nd, lab)
                }
 
        case CASE:
-               {
-                       WalkExpr(left);
-
-                       while (right) {
-                               if (right->nd_class == Link && right->nd_symb == '|') {
-                                       WalkNode(right->nd_left->nd_right, lab);
-                                       right = right->nd_right;
-                               }
-                               else    {
-                                       WalkNode(right, lab);
-                                       right = 0;
-                               }
-                       }
-
-                       /* ??? */
-                       break;
-               }
+               CaseCode(nd, lab);
+               break;
 
        case WHILE:
                {       label l1, l2;
@@ -317,6 +316,7 @@ WalkStat(nd, lab)
                        if (!TstAssCompat(func_type, right->nd_type)) {
 node_error(right, "type incompatibility in RETURN statement");
                        }
+                       return_expr_occurred = 1;
                }
                C_bra(return_label);
                break;
@@ -348,9 +348,9 @@ WalkExpr(nd)
 
        DO_DEBUG(1, (DumpTree(nd), print("\n")));
 
-       if (chk_expr(nd)) {
-               /* ??? */
-       }
+       if (! chk_expr(nd)) return;
+
+       /* ??? */
 }
 
 WalkDesignator(nd)
@@ -361,9 +361,27 @@ WalkDesignator(nd)
 
        DO_DEBUG(1, (DumpTree(nd), print("\n")));
 
-       if (chk_designator(nd, DESIGNATOR|VARIABLE)) {
-               /* ??? */
-       }
+       if (! chk_designator(nd, DESIGNATOR|VARIABLE)) return;
+
+       /* ??? */
+}
+
+CodeCall(nd)
+       struct node *nd;
+{
+       /*      Generate code for a procedure call. Checking of parameters
+               and result is already done.
+       */
+       /* ??? */
+}
+
+CodeAssign(nd)
+       struct node *nd;
+{
+       /*      Generate code for an assignment. Testing of type
+               compatibility and the like is already done.
+       */
+       /* ??? */
 }
 
 #ifdef DEBUG