From 927a5636bdbfd985596fa5f8f0175dc50303d5a8 Mon Sep 17 00:00:00 2001 From: ceriel Date: Mon, 11 May 1987 14:38:37 +0000 Subject: [PATCH] removed the limitation on number of include directories, some bug fixes, sets now have a constant and a variable part --- lang/m2/comp/Makefile | 5 +-- lang/m2/comp/Parameters | 4 -- lang/m2/comp/chk_expr.c | 92 +++++++++++++++++++++-------------------- lang/m2/comp/code.c | 10 ++--- lang/m2/comp/em_m2.6 | 3 ++ lang/m2/comp/main.c | 11 +++-- lang/m2/comp/main.h | 3 +- lang/m2/comp/options.c | 32 ++++++++++++-- lang/m2/comp/scope.C | 5 +-- lang/m2/comp/type.c | 9 +++- 10 files changed, 102 insertions(+), 72 deletions(-) diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index 2e170d384..781fe6246 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -41,7 +41,7 @@ GENCFILES= tokenfile.c \ GENGFILES= tokenfile.g GENHFILES= errout.h\ idfsize.h numsize.h strsize.h target_sizes.h \ - inputtype.h maxset.h ndir.h density.h\ + inputtype.h maxset.h density.h\ def.h debugcst.h type.h Lpars.h node.h HFILES= LLlex.h\ chk_expr.h class.h const.h debug.h desig.h f_info.h idf.h\ @@ -164,6 +164,7 @@ error.o: node.h error.o: warning.h main.o: LLlex.h main.o: Lpars.h +main.o: SYSTEM.h main.o: debug.h main.o: debugcst.h main.o: def.h @@ -171,7 +172,6 @@ main.o: f_info.h main.o: idf.h main.o: input.h main.o: inputtype.h -main.o: ndir.h main.o: node.h main.o: scope.h main.o: standards.h @@ -288,7 +288,6 @@ chk_expr.o: type.h chk_expr.o: warning.h options.o: idfsize.h options.o: main.h -options.o: ndir.h options.o: type.h options.o: warning.h walk.o: LLlex.h diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters index fecdc8a73..1e16606e2 100644 --- a/lang/m2/comp/Parameters +++ b/lang/m2/comp/Parameters @@ -57,9 +57,5 @@ but what is a reasonable choice ??? */ -!File: ndir.h -#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/chk_expr.c b/lang/m2/comp/chk_expr.c index 95392b720..9693d1e26 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -63,6 +63,10 @@ ChkVariable(expp) Xerror(expp, "variable expected", expp->nd_def); return 0; } + if (expp->nd_class == Value) { + node_error(expp, "variable expected"); + return 0; + } return 1; } @@ -182,14 +186,18 @@ ChkLinkOrName(expp) if (! ChkDesignator(left)) return 0; - if (left->nd_type->tp_fund != T_RECORD || - (left->nd_class == Def && - !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD)) + if (left->nd_class == Def && + (left->nd_type->tp_fund != T_RECORD || + !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD)) ) ) { Xerror(left, "illegal selection", left->nd_def); return 0; } + if (left->nd_type->tp_fund != T_RECORD) { + node_error(left, "illegal selection"); + return 0; + } if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope, 1))) { id_not_declared(expp); @@ -273,8 +281,8 @@ node_error(expp, "standard or local procedures may not be assigned"); } STATIC int -ChkElement(expp, tp, set) - register struct node *expp; +ChkElement(expp, tp, set, level) + struct node **expp; register struct type *tp; arith **set; { @@ -282,15 +290,17 @@ ChkElement(expp, tp, set) recursively. Also try to compute the set! */ - register struct node *left = expp->nd_left; - register struct node *right = expp->nd_right; + register struct node *expr = *expp; + register struct node *left = expr->nd_left; + register struct node *right = expr->nd_right; register int i; - if (expp->nd_class == Link && expp->nd_symb == UPTO) { + if (expr->nd_class == Link && expr->nd_symb == UPTO) { /* { ... , expr1 .. expr2, ... } First check expr1 and expr2, and try to compute them. */ - if (!ChkElement(left, tp, set) || !ChkElement(right, tp, set)) { + if (!ChkElement(&(expr->nd_left), tp, set, 1) || + !ChkElement(&(expr->nd_right), tp, set, 1)) { return 0; } @@ -304,15 +314,11 @@ node_error(expp, "lower bound exceeds upper bound in range"); return 0; } - if (*set) { - for (i=left->nd_INT+1; ind_INT; i++) { - (*set)[i/wrd_bits] |= (1<<(i%wrd_bits)); - } + for (i=left->nd_INT; i<=right->nd_INT; i++) { + (*set)[i/wrd_bits] |= (1<<(i%wrd_bits)); } - } - else if (*set) { - free((char *) *set); - *set = 0; + FreeNode(expr); + *expp = 0; } return 1; @@ -320,27 +326,31 @@ node_error(expp, "lower bound exceeds upper bound in range"); /* Here, a single element is checked */ - if (!ChkExpression(expp)) return 0; + if (!ChkExpression(expr)) return 0; - if (!TstCompat(tp, expp->nd_type)) { - node_error(expp, "set element has incompatible type"); + if (!TstCompat(tp, expr->nd_type)) { + node_error(expr, "set element has incompatible type"); return 0; } - if (expp->nd_class == Value) { + if (expr->nd_class == Value) { /* a constant element */ arith low, high; - i = expp->nd_INT; + i = expr->nd_INT; getbounds(tp, &low, &high); if (i < low || i > high) { - node_error(expp, "set element out of range"); + node_error(expr, "set element out of range"); return 0; } - if (*set) (*set)[i/wrd_bits] |= (1 << (i%wrd_bits)); + if (! level) { + (*set)[i/wrd_bits] |= (1 << (i%wrd_bits)); + FreeNode(expr); + *expp = 0; + } } return 1; @@ -356,11 +366,13 @@ ChkSet(expp) register struct type *tp; register struct node *nd; register struct def *df; - arith *set; unsigned size; + int retval = 1; assert(expp->nd_symb == SET); + expp->nd_class = Set; + /* First determine the type of the set */ if (nd = expp->nd_left) { @@ -392,37 +404,31 @@ ChkSet(expp) if (! nd) { /* The resulting set IS empty, so we just return */ - expp->nd_class = Set; expp->nd_set = 0; return 1; } size = tp->tp_size * (sizeof(arith) / word_size); - set = (arith *) Malloc(size); - clear((char *) set, size); + expp->nd_set = (arith *) Malloc(size); + clear((char *) (expp->nd_set) , size); /* Now check the elements, one by one */ while (nd) { assert(nd->nd_class == Link && nd->nd_symb == ','); - if (!ChkElement(nd->nd_left, ElementType(tp), &set)) return 0; + if (!ChkElement(&(nd->nd_left), ElementType(tp), + &(expp->nd_set), 0)) { + retval = 0; + } + if (nd->nd_left) expp->nd_class = Xset; nd = nd->nd_right; } - if (set) { - /* Yes, it was a constant set, and we managed to compute it! - Notice that at the moment there is no such thing as - partial evaluation. Either we evaluate the set, or we - don't (at all). Improvement not neccesary (???) - ??? sets have a contant part and a variable part ??? - */ - expp->nd_class = Set; - expp->nd_set = set; + if (expp->nd_class == Set) { FreeNode(expp->nd_right); expp->nd_right = 0; } - - return 1; + return retval; } STATIC struct node * @@ -814,10 +820,8 @@ ChkUnOper(expp) switch(expp->nd_symb) { case '+': if (tpr->tp_fund & T_NUMERIC) { - expp->nd_token = right->nd_token; - expp->nd_class = right->nd_class; - FreeNode(right); - expp->nd_right = 0; + *expp = *right; + free_node(right); return 1; } break; diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 46dc12b49..f7afbae21 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -140,6 +140,7 @@ CodeExpr(nd, ds, true_label, false_label) ds->dsg_kind = DSG_LOADED; break; + case Xset: case Set: { register arith *st = nd->nd_set; register int i; @@ -153,14 +154,10 @@ CodeExpr(nd, ds, true_label, false_label) for (i = tp->tp_size / word_size, st += i; i > 0; i--) { C_loc(*--st); } + CodeSet(nd); } break; - case Xset: - CodeSet(nd); - ds->dsg_kind = DSG_LOADED; - break; - default: crash("(CodeExpr) bad node type"); } @@ -930,12 +927,11 @@ CodeSet(nd) { register struct type *tp = nd->nd_type; - C_zer(tp->tp_size); /* empty set */ nd = nd->nd_right; while (nd) { assert(nd->nd_class == Link && nd->nd_symb == ','); - CodeEl(nd->nd_left, tp); + if (nd->nd_left) CodeEl(nd->nd_left, tp); nd = nd->nd_right; } } diff --git a/lang/m2/comp/em_m2.6 b/lang/m2/comp/em_m2.6 index e1f704f56..6851f7784 100644 --- a/lang/m2/comp/em_m2.6 +++ b/lang/m2/comp/em_m2.6 @@ -62,6 +62,9 @@ By default, warnings in class \fBO\fR and \fBW\fR are given. allow for warning messages whose class is a member of \fIclasses\fR. .IP \fB\-x\fR make all procedure names global, so that \fIadb\fR(1) understands them. +.IP \fB\-i\fR\fInum\fR +maximum number of bits in a set. When not used, a default value is +retained. .LP .SH FILES .IR ~em/lib/em_m2 : diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 7e398ba9e..427fb241d 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -10,7 +10,6 @@ /* $Header$ */ #include "debug.h" -#include "ndir.h" #include #include @@ -34,7 +33,8 @@ int state; /* either IMPLEMENTATION or PROGRAM */ char options[128]; int DefinitionModule; char *ProgName; -char *DEFPATH[NDIRS+1]; +char **DEFPATH; +int nDEF, mDEF; struct def *Defined; extern int err_occurred; extern int fp_used; /* set if floating point used */ @@ -50,6 +50,9 @@ main(argc, argv) ProgName = *argv++; warning_classes = W_INITIAL; + DEFPATH = (char **) Malloc(10 * sizeof(char *)); + mDEF = 10; + nDEF = 1; while (--argc > 0) { if (**argv == '-') @@ -60,10 +63,10 @@ main(argc, argv) Nargv[Nargc] = 0; /* terminate the arg vector */ if (Nargc < 2) { fprint(STDERR, "%s: Use a file argument\n", ProgName); - return 1; + exit(1); } if (options['x']) c_inp = C_exp; - return !Compile(Nargv[1], Nargv[2]); + exit(!Compile(Nargv[1], Nargv[2])); } Compile(src, dst) diff --git a/lang/m2/comp/main.h b/lang/m2/comp/main.h index d79a91266..a98b86776 100644 --- a/lang/m2/comp/main.h +++ b/lang/m2/comp/main.h @@ -20,5 +20,6 @@ extern struct def *Defined; /* definition structure of module defined in this compilation */ -extern char *DEFPATH[]; /* search path for DEFINITION MODULE's */ +extern char **DEFPATH; /* search path for DEFINITION MODULE's */ +extern int mDEF, nDEF; extern int state; /* either IMPLEMENTATION or PROGRAM */ diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c index da084b7cf..6bcf3d164 100644 --- a/lang/m2/comp/options.c +++ b/lang/m2/comp/options.c @@ -10,7 +10,6 @@ /* $Header$ */ #include "idfsize.h" -#include "ndir.h" #include #include @@ -46,6 +45,19 @@ DoOption(text) options[text[-1]]++; break; + case 'i': /* # of bits in set */ + { + char *t = text; + int val; + extern int maxset; + + val = txt2int(&t); + if (val <= 0 || *t) { + error("bad -i flag; use -i"); + } + else maxset = val; + break; + } case 'w': if (*text) { while (*text) { @@ -100,13 +112,25 @@ DoOption(text) case 'I' : if (*text) { - register int i = ndirs++; + register int i; register char *new = text; + + if (++nDEF > mDEF) { + char **n = (char **) + Malloc((10+mDEF)*sizeof(char *)); + + for (i = 0; i < mDEF; i++) { + n[i] = DEFPATH[i]; + } + free((char *) DEFPATH); + DEFPATH = n; + mDEF += 10; + } + + i = ndirs++; while (new) { register char *tmp = DEFPATH[i]; - if (i >= NDIRS) - fatal("too many -I options"); DEFPATH[i++] = new; new = tmp; } diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index 6fbde4afb..337feefa8 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -207,7 +207,7 @@ close_scope(flag) assert(sc != 0); if (flag) { - DO_DEBUG(options['S'], PrScopeDef(sc->sc_def)); + DO_DEBUG(options['S'],(print("List of definitions in currently ended scope:\n"), DumpScope(sc->sc_def))); if (flag & SC_CHKPROC) chk_proc(sc->sc_def); if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def)); if (flag & SC_REVERSE) Reverse(&(sc->sc_def)); @@ -216,10 +216,9 @@ close_scope(flag) } #ifdef DEBUG -PrScopeDef(df) +DumpScope(df) register struct def *df; { - print("List of definitions in currently ended scope:\n"); while (df) { PrDef(df); df = df->df_nextinscope; diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 784e921b5..b9eb03ced 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -39,6 +39,9 @@ int pointer_align = AL_POINTER, struct_align = AL_STRUCT; +int + maxset = MAXSET; + arith word_size = SZ_WORD, dword_size = 2 * SZ_WORD, @@ -436,7 +439,7 @@ set_type(tp) getbounds(tp, &lb, &ub); - if (lb < 0 || ub > MAXSET-1) { + if (lb < 0 || ub > maxset-1) { error("set type limits exceeded"); return error_type; } @@ -648,7 +651,9 @@ DumpType(tp) print(" fund:"); switch(tp->tp_fund) { case T_RECORD: - print("RECORD"); break; + print("RECORD\n"); + DumpScope(tp->rec_scope); + break; case T_ENUMERATION: print("ENUMERATION; ncst:%d", tp->enm_ncst); break; case T_INTEGER: -- 2.34.1