From 503edee161458e82b18c0827229cf21790c5b1eb Mon Sep 17 00:00:00 2001 From: ceriel Date: Mon, 19 Oct 1987 11:28:37 +0000 Subject: [PATCH] New version, with an option for strict Modula-2, and warnings for unused or uninitialized variables --- lang/m2/comp/Makefile | 13 ++- lang/m2/comp/Parameters | 7 ++ lang/m2/comp/SYSTEM.h | 7 ++ lang/m2/comp/Version.c | 2 +- lang/m2/comp/casestat.C | 1 + lang/m2/comp/chk_expr.c | 56 ++++++++----- lang/m2/comp/chk_expr.h | 5 +- lang/m2/comp/const.h | 4 +- lang/m2/comp/cstoper.c | 172 +++++++++++++++++++--------------------- lang/m2/comp/declar.g | 8 +- lang/m2/comp/def.c | 8 +- lang/m2/comp/enter.c | 67 ++++++++++------ lang/m2/comp/error.c | 3 + lang/m2/comp/main.c | 1 + lang/m2/comp/options.c | 8 ++ lang/m2/comp/program.g | 12 ++- lang/m2/comp/scope.C | 4 + lang/m2/comp/scope.h | 1 + lang/m2/comp/type.c | 2 +- lang/m2/comp/typequiv.c | 7 +- lang/m2/comp/walk.c | 149 +++++++++++++++++++++++----------- 21 files changed, 341 insertions(+), 196 deletions(-) diff --git a/lang/m2/comp/Makefile b/lang/m2/comp/Makefile index a04737d75..5b8398508 100644 --- a/lang/m2/comp/Makefile +++ b/lang/m2/comp/Makefile @@ -40,7 +40,7 @@ OBJ = $(COBJ) $(LOBJ) Lpars.o GENH= errout.h\ idfsize.h numsize.h strsize.h target_sizes.h \ inputtype.h maxset.h density.h squeeze.h \ - def.h debugcst.h type.h Lpars.h node.h desig.h + def.h debugcst.h type.h Lpars.h node.h desig.h strict3rd.h HFILES= LLlex.h\ chk_expr.h class.h const.h debug.h f_info.h idf.h\ input.h main.h misc.h scope.h standards.h tokenname.h\ @@ -181,6 +181,7 @@ error.o: input.h error.o: inputtype.h error.o: main.h error.o: node.h +error.o: strict3rd.h error.o: warning.h main.o: LLlex.h main.o: Lpars.h @@ -195,6 +196,7 @@ main.o: inputtype.h main.o: node.h main.o: scope.h main.o: standards.h +main.o: strict3rd.h main.o: tokenname.h main.o: type.h main.o: warning.h @@ -264,7 +266,9 @@ typequiv.o: debug.h typequiv.o: debugcst.h typequiv.o: def.h typequiv.o: idf.h +typequiv.o: main.h typequiv.o: node.h +typequiv.o: strict3rd.h typequiv.o: type.h typequiv.o: warning.h node.o: LLlex.h @@ -291,14 +295,17 @@ chk_expr.o: debug.h chk_expr.o: debugcst.h chk_expr.o: def.h chk_expr.o: idf.h +chk_expr.o: main.h chk_expr.o: misc.h chk_expr.o: node.h chk_expr.o: scope.h chk_expr.o: standards.h +chk_expr.o: strict3rd.h chk_expr.o: type.h chk_expr.o: warning.h options.o: idfsize.h options.o: main.h +options.o: strict3rd.h options.o: type.h options.o: warning.h walk.o: LLlex.h @@ -314,6 +321,7 @@ walk.o: main.h walk.o: node.h walk.o: scope.h walk.o: squeeze.h +walk.o: strict3rd.h walk.o: type.h walk.o: walk.h walk.o: warning.h @@ -360,6 +368,7 @@ program.o: idf.h program.o: main.h program.o: node.h program.o: scope.h +program.o: strict3rd.h program.o: type.h program.o: warning.h declar.o: LLlex.h @@ -373,6 +382,7 @@ declar.o: main.h declar.o: misc.h declar.o: node.h declar.o: scope.h +declar.o: strict3rd.h declar.o: type.h declar.o: warning.h expression.o: LLlex.h @@ -401,6 +411,7 @@ casestat.o: Lpars.h casestat.o: chk_expr.h casestat.o: debug.h casestat.o: debugcst.h +casestat.o: def.h casestat.o: density.h casestat.o: desig.h casestat.o: node.h diff --git a/lang/m2/comp/Parameters b/lang/m2/comp/Parameters index b3ef162b1..1753ad15e 100644 --- a/lang/m2/comp/Parameters +++ b/lang/m2/comp/Parameters @@ -65,3 +65,10 @@ #undef SQUEEZE 1 /* define on "small" machines */ +!File: strict3rd.h +#undef STRICT_3RD_ED 1 /* define on "small" machines, and if you want + a compiler that only implements "3rd edition" + Modula-2 + */ + + diff --git a/lang/m2/comp/SYSTEM.h b/lang/m2/comp/SYSTEM.h index e8f8e3a4e..561a614d6 100644 --- a/lang/m2/comp/SYSTEM.h +++ b/lang/m2/comp/SYSTEM.h @@ -11,8 +11,15 @@ /* Text of SYSTEM module, for as far as it can be expressed in Modula-2 */ +#ifndef STRICT_3RD_ED #define SYSTEMTEXT "DEFINITION MODULE SYSTEM;\n\ TYPE PROCESS = ADDRESS;\n\ PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\ PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\ END SYSTEM.\n" +#else +#define SYSTEMTEXT "DEFINITION MODULE SYSTEM;\n\ +PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\ +PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\ +END SYSTEM.\n" +#endif diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c index 1ce26bef8..9be6dced6 100644 --- a/lang/m2/comp/Version.c +++ b/lang/m2/comp/Version.c @@ -1 +1 @@ -static char Version[] = "ACK Modula-2 compiler Version 0.20"; +static char Version[] = "ACK Modula-2 compiler Version 0.21"; diff --git a/lang/m2/comp/casestat.C b/lang/m2/comp/casestat.C index 022f6c580..3ce53a6ce 100644 --- a/lang/m2/comp/casestat.C +++ b/lang/m2/comp/casestat.C @@ -32,6 +32,7 @@ #include "desig.h" #include "walk.h" #include "chk_expr.h" +#include "def.h" #include "density.h" diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 03621e775..9a8c880c2 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -19,6 +19,7 @@ #include #include +#include "strict3rd.h" #include "Lpars.h" #include "idf.h" #include "type.h" @@ -31,6 +32,7 @@ #include "chk_expr.h" #include "misc.h" #include "warning.h" +#include "main.h" extern char *symbol2str(); extern char *sprint(); @@ -125,14 +127,14 @@ MkCoercion(pnd, tp) } int -ChkVariable(expp) +ChkVariable(expp, flags) register t_node *expp; { /* Check that "expp" indicates an item that can be assigned to. */ - return ChkDesignator(expp) && + return ChkDesig(expp, flags) && ( expp->nd_class != Def || ( expp->nd_def->df_kind & (D_FIELD|D_VARIABLE)) || df_error(expp, "variable expected", expp->nd_def)); @@ -152,7 +154,7 @@ ChkArrow(expp) expp->nd_type = error_type; - if (! ChkVariable(expp->nd_right)) return 0; + if (! ChkVariable(expp->nd_right, D_USED)) return 0; tp = expp->nd_right->nd_type; @@ -166,7 +168,7 @@ ChkArrow(expp) } STATIC int -ChkArr(expp) +ChkArr(expp, flags) register t_node *expp; { /* Check an array selection. @@ -182,7 +184,7 @@ ChkArr(expp) expp->nd_type = error_type; - if (! (ChkVariable(expp->nd_left) & ChkExpression(expp->nd_right))) { + if (! (ChkVariable(expp->nd_left, flags) & ChkExpression(expp->nd_right))) { /* Bitwise and, because we want them both evaluated. */ return 0; @@ -225,7 +227,7 @@ ChkValue(expp) #endif STATIC int -ChkLinkOrName(expp) +ChkLinkOrName(expp, flags) register t_node *expp; { /* Check either an ID or a construction of the form @@ -236,9 +238,10 @@ ChkLinkOrName(expp) expp->nd_type = error_type; if (expp->nd_class == Name) { - expp->nd_def = lookfor(expp, CurrVis, 1); + expp->nd_def = df = lookfor(expp, CurrVis, 1); expp->nd_class = Def; - expp->nd_type = RemoveEqual(expp->nd_def->df_type); + expp->nd_type = RemoveEqual(df->df_type); + df->df_flags |= flags; } else if (expp->nd_class == Link) { /* A selection from a record or a module. @@ -248,7 +251,7 @@ ChkLinkOrName(expp) assert(expp->nd_symb == '.'); - if (! ChkDesignator(left)) return 0; + if (! ChkDesig(left, flags)) return 0; if (left->nd_class==Def && (left->nd_type->tp_fund != T_RECORD || @@ -266,6 +269,7 @@ ChkLinkOrName(expp) id_not_declared(expp); return 0; } + df->df_flags |= flags; expp->nd_def = df; expp->nd_type = RemoveEqual(df->df_type); expp->nd_class = Def; @@ -300,7 +304,7 @@ ChkExLinkOrName(expp) */ register t_def *df; - if (! ChkLinkOrName(expp)) return 0; + if (! ChkLinkOrName(expp, D_USED)) return 0; df = expp->nd_def; @@ -537,7 +541,7 @@ getarg(argp, bases, designator, edf) register t_node *left = nextarg(argp, edf); if (! left || - ! (designator ? ChkVariable(left) : ChkExpression(left))) { + ! (designator ? ChkVariable(left, D_USED|D_DEFINED) : ChkExpression(left))) { return 0; } @@ -616,7 +620,9 @@ ChkProcCall(expp) */ for (param = ParamList(left->nd_type); param; param = param->par_next) { if (!(left = getarg(&expp, 0, IsVarParam(param), edf))) { - return 0; + retval = 0; + cnt++; + continue; } cnt++; if (left->nd_symb == STRING) { @@ -673,7 +679,7 @@ ChkCall(expp) /* First, get the name of the function or procedure */ - if (ChkDesignator(left)) { + if (ChkDesig(left, D_USED)) { if (IsCast(left)) { /* It was a type cast. */ @@ -920,8 +926,8 @@ ChkUnOper(expp) return 1; case '-': - if (tpr->tp_fund & T_INTORCARD) { - if (tpr == intorcard_type || tpr == card_type) { + if (tpr->tp_fund == T_INTORCARD || tpr->tp_fund == T_INTEGER) { + if (tpr == intorcard_type) { expp->nd_type = int_type; } if (right->nd_class == Value) { @@ -957,7 +963,7 @@ ChkUnOper(expp) } STATIC t_node * -getvariable(argp, edf) +getvariable(argp, edf, flags) t_node **argp; t_def *edf; { @@ -966,7 +972,7 @@ getvariable(argp, edf) */ register t_node *left = nextarg(argp, edf); - if (!left || !ChkVariable(left)) return 0; + if (!left || !ChkVariable(left, flags)) return 0; return left; } @@ -1072,6 +1078,7 @@ ChkStandard(expp) if (left->nd_type->tp_fund == T_ARRAY) { expp->nd_type = IndexType(left->nd_type); if (! IsConformantArray(left->nd_type)) { + left->nd_type = expp->nd_type; cstcall(expp, S_MAX); } break; @@ -1120,11 +1127,19 @@ ChkStandard(expp) if (!warning_given) { warning_given = 1; +#ifndef STRICT_3RD_ED + if (! options['3']) node_warning(expp, W_OLDFASHIONED, "NEW and DISPOSE are obsolete"); + else +#endif + node_error(expp, "NEW and DISPOSE are obsolete"); } } +#ifdef STRICT_3RD_ED + return 0; +#else expp->nd_type = 0; - if (! (left = getvariable(&arg, edf))) return 0; + if (! (left = getvariable(&arg, edf,D_DEFINED))) return 0; if (! (left->nd_type->tp_fund == T_POINTER)) { return df_error(left, "pointer variable expected", edf); } @@ -1150,6 +1165,7 @@ ChkStandard(expp) expp->nd_left = MkLeaf(Name, &dt); } return ChkCall(expp); +#endif case S_TSIZE: /* ??? */ case S_SIZE: @@ -1197,7 +1213,7 @@ ChkStandard(expp) case S_DEC: case S_INC: expp->nd_type = 0; - if (! (left = getvariable(&arg, edf))) return 0; + if (! (left = getvariable(&arg, edf, D_USED|D_DEFINED))) return 0; if (! (left->nd_type->tp_fund & T_DISCRETE)) { return df_error(left,"illegal parameter type", edf); } @@ -1217,7 +1233,7 @@ ChkStandard(expp) t_node *dummy; expp->nd_type = 0; - if (!(left = getvariable(&arg, edf))) return 0; + if (!(left = getvariable(&arg, edf, D_USED|D_DEFINED))) return 0; tp = left->nd_type; if (tp->tp_fund != T_SET) { return df_error(arg, "SET parameter expected", edf); diff --git a/lang/m2/comp/chk_expr.h b/lang/m2/comp/chk_expr.h index 4db3ad15b..8de1bbeca 100644 --- a/lang/m2/comp/chk_expr.h +++ b/lang/m2/comp/chk_expr.h @@ -16,8 +16,9 @@ extern int (*DesigChkTable[])(); /* table of designator checking functions, indexed by node class */ -#define ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp)) -#define ChkDesignator(expp) ((*DesigChkTable[(expp)->nd_class])(expp)) +#define ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp,D_USED)) +#define ChkDesignator(expp) ((*DesigChkTable[(expp)->nd_class])(expp,0)) +#define ChkDesig(expp, flags) ((*DesigChkTable[(expp)->nd_class])(expp,flags)) #define inc_refcount(s) (*((s) - 1) += 1) #define dec_refcount(s) (*((s) - 1) -= 1) diff --git a/lang/m2/comp/const.h b/lang/m2/comp/const.h index 8af8e609f..6f6662620 100644 --- a/lang/m2/comp/const.h +++ b/lang/m2/comp/const.h @@ -14,8 +14,6 @@ extern long extern int mach_long_size; /* size of long on this machine == sizeof(long) */ extern arith - max_int, /* maximum integer on target machine */ - max_unsigned, /* maximum unsigned on target machine */ - max_longint; /* maximum longint on target machine */ + max_int; /* maximum integer on target machine */ extern unsigned int wrd_bits; /* Number of bits in a word */ diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index 01bb9299e..f75fdacb7 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -29,8 +29,6 @@ int mach_long_size; /* size of long on this machine == sizeof(long) */ long full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */ long int_mask[MAXSIZE]; /* int_mask[1] == 0x7F, int_mask[2] == 0x7FFF, .. */ arith max_int; /* maximum integer on target machine */ -arith max_unsigned; /* maximum unsigned on target machine */ -arith max_longint; /* maximum longint on target machine */ unsigned int wrd_bits; /* number of bits in a word */ extern char options[]; @@ -52,10 +50,10 @@ cstunary(expp) */ case '-': + if (right->nd_INT < -int_mask[(int)(right->nd_type->tp_size)]) + node_warning(expp, W_ORDINARY, ovflow); + expp->nd_INT = -right->nd_INT; - if (expp->nd_type->tp_fund == T_INTORCARD) { - expp->nd_type = int_type; - } break; case NOT: @@ -74,6 +72,62 @@ cstunary(expp) expp->nd_right = 0; } +STATIC +divide(pdiv, prem, uns) + arith *pdiv, *prem; +{ + /* Divide *pdiv by *prem, and store result in *pdiv, + remainder in *prem + */ + register arith o1 = *pdiv; + register arith o2 = *prem; + + if (uns) { + /* this is more of a problem than you might + think on C compilers which do not have + unsigned long. + */ + if (o2 & mach_long_sign) {/* o2 > max_long */ + if (! (o1 >= 0 || o1 < o2)) { + /* this is the unsigned test + o1 < o2 for o2 > max_long + */ + *prem = o2 - o1; + *pdiv = 1; + } + else { + *pdiv = 0; + } + } + else { /* o2 <= max_long */ + long half, bit, hdiv, hrem, rem; + + half = (o1 >> 1) & ~mach_long_sign; + bit = o1 & 01; + /* now o1 == 2 * half + bit + and half <= max_long + and bit <= max_long + */ + hdiv = half / o2; + hrem = half % o2; + rem = 2 * hrem + bit; + *pdiv = 2*hdiv; + *prem = rem; + if (rem < 0 || rem >= o2) { + /* that is the unsigned compare + rem >= o2 for o2 <= max_long + */ + *pdiv += 1; + *prem -= o2; + } + } + } + else { + *pdiv = o1 / o2; /* ??? */ + *prem = o1 - *pdiv * o2; + } +} + cstbin(expp) register t_node *expp; { @@ -81,8 +135,8 @@ cstbin(expp) expressions below it, and the result restored in expp. */ - register arith o1 = expp->nd_left->nd_INT; - register arith o2 = expp->nd_right->nd_INT; + arith o1 = expp->nd_left->nd_INT; + arith o2 = expp->nd_right->nd_INT; register int uns = expp->nd_left->nd_type != int_type; assert(expp->nd_class == Oper); @@ -99,37 +153,7 @@ cstbin(expp) node_error(expp, "division by 0"); return; } - if (uns) { - /* this is more of a problem than you might - think on C compilers which do not have - unsigned long. - */ - if (o2 & mach_long_sign) {/* o2 > max_long */ - o1 = ! (o1 >= 0 || o1 < o2); - /* this is the unsigned test - o1 < o2 for o2 > max_long - */ - } - else { /* o2 <= max_long */ - long half, bit, hdiv, hrem, rem; - - half = (o1 >> 1) & ~mach_long_sign; - bit = o1 & 01; - /* now o1 == 2 * half + bit - and half <= max_long - and bit <= max_long - */ - hdiv = half / o2; - hrem = half % o2; - rem = 2 * hrem + bit; - o1 = 2 * hdiv + (rem < 0 || rem >= o2); - /* that is the unsigned compare - rem >= o2 for o2 <= max_long - */ - } - } - else - o1 /= o2; + divide(&o1, &o2, uns); break; case MOD: @@ -137,29 +161,8 @@ cstbin(expp) node_error(expp, "modulo by 0"); return; } - if (uns) { - if (o2 & mach_long_sign) {/* o2 > max_long */ - o1 = (o1 >= 0 || o1 < o2) ? o1 : o1 - o2; - /* this is the unsigned test - o1 < o2 for o2 > max_long - */ - } - else { /* o2 <= max_long */ - long half, bit, hrem, rem; - - half = (o1 >> 1) & ~mach_long_sign; - bit = o1 & 01; - /* now o1 == 2 * half + bit - and half <= max_long - and bit <= max_long - */ - hrem = half % o2; - rem = 2 * hrem + bit; - o1 = (rem < 0 || rem >= o2) ? rem - o2 : rem; - } - } - else - o1 %= o2; + divide(&o1, &o2, uns); + o1 = o2; break; case '+': @@ -343,15 +346,15 @@ cstcall(expp, call) /* a standard procedure call is found that can be evaluated compile time, so do so. */ - register t_node *expr = 0; + register t_node *expr; + register t_type *tp; 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); - } + expr = expp->nd_right->nd_left; + expp->nd_right->nd_left = 0; + FreeNode(expp->nd_right); + tp = expr->nd_type; expp->nd_class = Value; expp->nd_symb = INTEGER; @@ -370,32 +373,25 @@ cstcall(expp, call) break; case S_MAX: - if (expp->nd_type == int_type) { - expp->nd_INT = max_int; + if (tp->tp_fund == T_INTEGER) { + expp->nd_INT = int_mask[(int)(tp->tp_size)]; } - else if (expp->nd_type == longint_type) { - expp->nd_INT = max_longint; + else if (tp == card_type) { + expp->nd_INT = full_mask[(int)(int_size)]; } - else if (expp->nd_type == card_type) { - expp->nd_INT = max_unsigned; + else if (tp->tp_fund == T_SUBRANGE) { + expp->nd_INT = tp->sub_ub; } - else if (expp->nd_type->tp_fund == T_SUBRANGE) { - expp->nd_INT = expp->nd_type->sub_ub; - } - else expp->nd_INT = expp->nd_type->enm_ncst - 1; + else expp->nd_INT = tp->enm_ncst - 1; break; case S_MIN: - if (expp->nd_type == int_type) { - expp->nd_INT = -max_int; - if (! options['s']) expp->nd_INT--; - } - else if (expp->nd_type == longint_type) { - expp->nd_INT = - max_longint; + if (tp->tp_fund == T_INTEGER) { + expp->nd_INT = -int_mask[(int)(tp->tp_size)]; if (! options['s']) expp->nd_INT--; } - else if (expp->nd_type->tp_fund == T_SUBRANGE) { - expp->nd_INT = expp->nd_type->sub_lb; + else if (tp->tp_fund == T_SUBRANGE) { + expp->nd_INT = tp->sub_lb; } else expp->nd_INT = 0; break; @@ -405,7 +401,7 @@ cstcall(expp, call) break; case S_SIZE: - expp->nd_INT = expr->nd_type->tp_size; + expp->nd_INT = tp->tp_size; break; default: @@ -466,8 +462,6 @@ InitCst() fatal("sizeof (long) insufficient on this machine"); } - max_int = int_mask[int_size]; - max_unsigned = full_mask[int_size]; - max_longint = int_mask[long_size]; + max_int = int_mask[(int)int_size]; wrd_bits = 8 * (unsigned) word_size; } diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index bc9ac58e0..039b82075 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -17,6 +17,7 @@ #include #include +#include "strict3rd.h" #include "idf.h" #include "LLlex.h" #include "def.h" @@ -336,8 +337,13 @@ FieldList(t_scope *scope; arith *cnt; int *palign;) | /* Old fashioned! the first qualident now represents the type */ - { warning(W_OLDFASHIONED, + { +#ifndef STRICT_3RD_ED + if (! options['3']) warning(W_OLDFASHIONED, "old fashioned Modula-2 syntax; ':' missing"); + else +#endif + error("':' missing"); tp = qualified_type(nd); } ] diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index 6442453dc..bed3ceea9 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -73,6 +73,7 @@ MkDef(id, scope, kind) df->df_scope = scope; df->df_kind = kind; df->df_next = id->id_def; + df->df_flags = D_USED | D_DEFINED; id->id_def = df; if (kind == D_ERROR || kind == D_FORWARD) df->df_type = error_type; @@ -241,6 +242,7 @@ DeclProc(type, id) */ df = define(id, CurrentScope, type); df->for_node = dot2leaf(Name); + df->df_flags |= D_USED | D_DEFINED; if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) { df->for_name = id->id_text; } @@ -275,6 +277,7 @@ DeclProc(type, id) C_exp(buf); } else C_inp(buf); + df->df_flags |= D_DEFINED; } open_scope(OPENSCOPE); scope = CurrentScope; @@ -360,11 +363,12 @@ CheckWithDef(df, tp) possible earlier definition in the definition module. */ - if (df->df_kind == D_PROCHEAD && df->df_type != error_type) { + if (df->df_kind == D_PROCHEAD && + df->df_type && + df->df_type != error_type) { /* We already saw a definition of this type in the definition module. */ - assert(df->df_type != 0); if (!TstProcEquiv(tp, df->df_type)) { error("inconsistent procedure declaration for \"%s\"", diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index b562873aa..5280d6314 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -129,6 +129,7 @@ EnterVarList(Idlist, type, local) for (; idlist; idlist = idlist->nd_right) { df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE); df->df_type = type; + df->df_flags &= ~(D_USED | D_DEFINED); if (idlist->nd_left) { /* An address was supplied */ @@ -166,6 +167,7 @@ EnterVarList(Idlist, type, local) df->df_flags |= D_NOREG; if (DefinitionModule) { + df->df_flags |= D_USED | D_DEFINED; if (sc == Defined->mod_vis) { C_exa_dnam(df->var_name); } @@ -212,7 +214,8 @@ EnterParamList(ppr, Idlist, type, VARp, off) else df = new_def(); pr->par_def = df; df->df_type = type; - df->df_flags = VARp; + df->df_flags |= (VARp | D_DEFINED); + if (df->df_flags & D_VARPAR) df->df_flags |= D_USED; if (IsConformantArray(type)) { /* we need room for the base address and a descriptor @@ -240,6 +243,10 @@ DoImport(df, scope) define(df->df_idf, scope, D_IMPORT)->imp_def = df; + while (df->df_kind == D_IMPORT) { + df = df->imp_def; + } + if (df->df_kind == D_TYPE && df->df_type->tp_fund == T_ENUMERATION) { /* Also import all enumeration literals */ @@ -305,7 +312,7 @@ ForwDef(ids, scope) */ register t_def *df; - if (!(df = lookup(ids->nd_IDF, scope, 1))) { + if (!(df = lookup(ids->nd_IDF, scope, 0))) { df = define(ids->nd_IDF, scope, D_FORWARD); df->for_node = MkLeaf(Name, &(ids->nd_token)); } @@ -341,8 +348,6 @@ EnterExportList(Idlist, qualified) idlist->nd_IDF->id_text); } - if (df->df_kind == D_IMPORT) df = df->imp_def; - df->df_flags |= qualified; if (qualified == D_EXPORTED) { /* Export, but not qualified. @@ -368,15 +373,20 @@ EnterExportList(Idlist, qualified) scope. There are two legal possibilities, which are examined below. */ + t_def *df2 = df; + + while (df2->df_kind == D_IMPORT) { + df2 = df2->imp_def; + } if (df1->df_kind == D_PROCHEAD && - df->df_kind == D_PROCEDURE) { + df2->df_kind == D_PROCEDURE) { df1->df_kind = D_IMPORT; df1->imp_def = df; continue; } if (df1->df_kind == D_HIDDEN && - df->df_kind == D_TYPE) { - DeclareType(idlist, df1, df->df_type); + df2->df_kind == D_TYPE) { + DeclareType(idlist, df1, df2->df_type); df1->df_kind = D_TYPE; continue; } @@ -388,14 +398,13 @@ EnterExportList(Idlist, qualified) FreeNode(Idlist); } -EnterFromImportList(Idlist, FromDef, FromId) - t_node *Idlist; +EnterFromImportList(idlist, FromDef, FromId) + register t_node *idlist; register t_def *FromDef; t_node *FromId; { /* Import the list Idlist from the module indicated by Fromdef. */ - register t_node *idlist = Idlist; register t_scopelist *vis; register t_def *df; char *module_name = FromDef->df_idf->id_text; @@ -430,7 +439,7 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name); for (; idlist; idlist = idlist->nd_left) { if (forwflag) df = ForwDef(idlist, vis->sc_scope); - else if (! (df = lookup(idlist->nd_IDF, vis->sc_scope, 1))) { + else if (! (df = lookup(idlist->nd_IDF, vis->sc_scope, 0))) { if (! is_anon_idf(idlist->nd_IDF)) { node_error(idlist, "identifier \"%s\" not declared in module \"%s\"", @@ -450,30 +459,38 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name); } if (!forwflag) FreeNode(FromId); - FreeNode(Idlist); } -EnterImportList(Idlist, local) - t_node *Idlist; +EnterGlobalImportList(idlist) + register t_node *idlist; { - /* Import "Idlist" from the enclosing scope. - An exception must be made for imports of the compilation unit. - In this case, definition modules must be read for "Idlist". - This case is indicated by the value 0 of the "local" flag. + /* Import "idlist" from the enclosing scope. + Definition modules must be read for "idlist". */ - register t_node *idlist = Idlist; - t_scope *sc = enclosing(CurrVis)->sc_scope; extern t_def *GetDefinitionModule(); struct f_info f; f = file_info; for (; idlist; idlist = idlist->nd_left) { - DoImport(local ? - ForwDef(idlist, sc) : - GetDefinitionModule(idlist->nd_IDF, 1) , - CurrentScope); + DoImport(GetDefinitionModule(idlist->nd_IDF, 1), CurrentScope); file_info = f; } - FreeNode(Idlist); +} + +EnterImportList(idlist) + register t_node *idlist; +{ + /* Import "idlist" from the enclosing scope. + */ + t_scope *sc = enclosing(CurrVis)->sc_scope; + extern t_def *GetDefinitionModule(); + + for (; idlist; idlist = idlist->nd_left) { + t_def *df; + + DoImport(ForwDef(idlist, sc), CurrentScope); + df = lookup(idlist->nd_def, CurrentScope, 0); + df->df_flags |= D_EXPORTED; + } } diff --git a/lang/m2/comp/error.c b/lang/m2/comp/error.c index e7a7a619f..3f97ef4e3 100644 --- a/lang/m2/comp/error.c +++ b/lang/m2/comp/error.c @@ -21,6 +21,7 @@ #include #include +#include "strict3rd.h" #include "input.h" #include "f_info.h" #include "LLlex.h" @@ -170,9 +171,11 @@ _error(class, node, fmt, argv) case WARNING: case LEXWARNING: switch(warn_class) { +#ifndef STRICT_3RD_ED case W_OLDFASHIONED: remark = "(old-fashioned use)"; break; +#endif case W_STRICT: remark = "(strict)"; break; diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index e378e0186..ccfdf58cb 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -16,6 +16,7 @@ #include #include +#include "strict3rd.h" #include "input.h" #include "f_info.h" #include "idf.h" diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c index 4a44db9db..c81405f07 100644 --- a/lang/m2/comp/options.c +++ b/lang/m2/comp/options.c @@ -15,6 +15,7 @@ #include #include +#include "strict3rd.h" #include "type.h" #include "main.h" #include "warning.h" @@ -44,6 +45,9 @@ DoOption(text) case 'n': /* no register messages */ case 'x': /* every name global */ case 's': /* symmetric: MIN(INTEGER) = -MAX(INTEGER) */ +#ifndef STRICT_3RD_ED + case '3': /* strict 3rd edition Modula-2 */ +#endif options[text[-1]]++; break; @@ -64,9 +68,11 @@ DoOption(text) if (*text) { while (*text) { switch(*text++) { +#ifndef STRICT_3RD_ED case 'O': warning_classes &= ~W_OLDFASHIONED; break; +#endif case 'R': warning_classes &= ~W_STRICT; break; @@ -83,9 +89,11 @@ DoOption(text) if (*text) { while (*text) { switch(*text++) { +#ifndef STRICT_3RD_ED case 'O': warning_classes |= W_OLDFASHIONED; break; +#endif case 'R': warning_classes |= W_STRICT; break; diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 6fb2d64de..89ec9b448 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -16,6 +16,7 @@ #include #include +#include "strict3rd.h" #include "main.h" #include "idf.h" #include "LLlex.h" @@ -114,7 +115,9 @@ import(int local;) { if (FromId) { EnterFromImportList(ImportList, df, FromId); } - else EnterImportList(ImportList, local); + else if (local) EnterImportList(ImportList); + else EnterGlobalImportList(ImportList); + FreeNode(ImportList); } ; @@ -150,8 +153,13 @@ DefinitionModule modules. Issue a warning. */ { +#ifndef STRICT_3RD_ED + if (! options['3']) node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignored"); - FreeNode(exportlist); + else +#endif + error("export list not allowed in definition module"); + FreeNode(exportlist); } | /* empty */ diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index 4001f3b70..87bae1a74 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -217,6 +217,10 @@ close_scope(flag) assert(sc != 0); + if (! sc->sc_end) { + sc->sc_end = dot2leaf(Link); + } + if (flag) { 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); diff --git a/lang/m2/comp/scope.h b/lang/m2/comp/scope.h index bad79417e..03725dd28 100644 --- a/lang/m2/comp/scope.h +++ b/lang/m2/comp/scope.h @@ -30,6 +30,7 @@ struct scope { char sc_scopeclosed; /* flag indicating closed or open scope */ int sc_level; /* level of this scope */ struct def *sc_definedby; /* The def structure defining this scope */ + struct node *sc_end; /* node to remember line number of end of scope */ }; struct scopelist { diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 66692660c..213a65621 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -611,7 +611,7 @@ type_or_forward(ptp) in this scope, so this is the correct identification */ if (df1->df_kind == D_FORWTYPE) { - nd = dot2node(NULLNODE, df1->df_forw_node, 0); + nd = dot2node(0, NULLNODE, df1->df_forw_node); df1->df_forw_node = nd; nd->nd_type = *ptp; } diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c index ca77ccb18..3e2d721ab 100644 --- a/lang/m2/comp/typequiv.c +++ b/lang/m2/comp/typequiv.c @@ -18,12 +18,14 @@ #include #include +#include "strict3rd.h" #include "type.h" #include "LLlex.h" #include "idf.h" #include "def.h" #include "node.h" #include "warning.h" +#include "main.h" extern char *sprint(); @@ -239,7 +241,8 @@ TstParCompat(parno, formaltype, VARflag, nd, edf) ) ) return 1; - if (VARflag && TstCompat(formaltype, actualtype)) { +#ifndef STRICT_3RD_ED + if (! options['3'] && VARflag && TstCompat(formaltype, actualtype)) { if (formaltype->tp_size == actualtype->tp_size) { sprint(ebuf1, ebuf, "identical types required"); node_warning(*nd, @@ -251,7 +254,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf) node_error(*nd, ebuf1); return 0; } - +#endif sprint(ebuf1, ebuf, "type incompatibility"); node_error(*nd, ebuf1); return 0; diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index aaf53574d..9e522fa75 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -23,6 +23,7 @@ #include #include +#include "strict3rd.h" #include "squeeze.h" #include "LLlex.h" #include "def.h" @@ -40,14 +41,22 @@ extern arith NewPtr(); extern arith NewInt(); + extern int proclevel; + label text_label; label data_label = 1; -static t_type *func_type; struct withdesig *WithDesigs; -t_node *Modules; +t_node *Modules; + +static t_type *func_type; static arith priority; +static int RegisterMessage(); +static int WalkDef(); +static int MkCalls(); +static int UseWarnings(); + #define NO_EXIT_LABEL ((label) 0) #define RETURN_LABEL ((label) 1) @@ -119,7 +128,7 @@ WalkModule(module) /* Walk through it's local definitions */ - WalkDef(sc->sc_def); + WalkDefList(sc->sc_def, WalkDef); /* Now, generate initialization code for this module. First call initialization routines for modules defined within @@ -156,7 +165,7 @@ WalkModule(module) C_cal(nd->nd_IDF->id_text); } } - MkCalls(sc->sc_def); + WalkDefList(sc->sc_def, MkCalls); proclevel++; WalkNode(module->mod_body, NO_EXIT_LABEL); DO_DEBUG(options['X'], PrNode(module->mod_body, 0)); @@ -168,6 +177,7 @@ WalkModule(module) TmpClose(); CurrVis = savevis; + WalkDefList(sc->sc_def, UseWarnings); } WalkProcedure(procedure) @@ -190,7 +200,7 @@ WalkProcedure(procedure) /* Generate code for all local modules and procedures */ - WalkDef(sc->sc_def); + WalkDefList(sc->sc_def, WalkDef); /* Generate code for this procedure */ @@ -221,7 +231,7 @@ WalkProcedure(procedure) /* Generate calls to initialization routines of modules defined within this procedure */ - MkCalls(sc->sc_def); + WalkDefList(sc->sc_def, MkCalls); /* Make sure that arguments of size < word_size are on a fixed place. @@ -327,54 +337,53 @@ WalkProcedure(procedure) } EndPriority(); C_ret(func_res_size); - if (! options['n']) RegisterMessages(sc->sc_def); + if (! options['n']) WalkDefList(sc->sc_def, RegisterMessage); C_end(-sc->sc_off); TmpClose(); CurrVis = savevis; proclevel--; + WalkDefList(sc->sc_def, UseWarnings); } +static int WalkDef(df) register t_def *df; { /* Walk through a list of definitions */ - for ( ; df; df = df->df_nextinscope) { - switch(df->df_kind) { - case D_MODULE: - WalkModule(df); - break; - case D_PROCEDURE: - WalkProcedure(df); - break; - case D_VARIABLE: - if (!proclevel && !(df->df_flags & D_ADDRGIVEN)) { - C_df_dnam(df->var_name); - C_bss_cst( - WA(df->df_type->tp_size), - (arith) 0, 0); - } - break; - default: - /* nothing */ - ; + switch(df->df_kind) { + case D_MODULE: + WalkModule(df); + break; + case D_PROCEDURE: + WalkProcedure(df); + break; + case D_VARIABLE: + if (!proclevel && !(df->df_flags & D_ADDRGIVEN)) { + C_df_dnam(df->var_name); + C_bss_cst( + WA(df->df_type->tp_size), + (arith) 0, 0); } + break; + default: + /* nothing */ + ; } } +static int MkCalls(df) register t_def *df; { /* Generate calls to initialization routines of modules */ - for ( ; df; df = df->df_nextinscope) { - if (df->df_kind == D_MODULE) { - C_lxl((arith) 0); - C_cal(df->mod_vis->sc_scope->sc_name); - C_asp(pointer_size); - } + if (df->df_kind == D_MODULE) { + C_lxl((arith) 0); + C_cal(df->mod_vis->sc_scope->sc_name); + C_asp(pointer_size); } } @@ -579,7 +588,7 @@ WalkStat(nd, exit_label) struct withdesig wds; t_desig ds; - if (! WalkDesignator(left, &ds)) break; + if (! WalkDesignator(left, &ds, D_USED|D_DEFINED)) break; if (left->nd_type->tp_fund != T_RECORD) { node_error(left, "record variable expected"); break; @@ -686,14 +695,14 @@ ExpectBool(nd, true_label, false_label) } int -WalkDesignator(nd, ds) +WalkDesignator(nd, ds, flags) t_node *nd; t_desig *ds; { /* Check designator and generate code for it */ - if (! ChkVariable(nd)) return 0; + if (! ChkVariable(nd, flags)) return 0; clear((char *) ds, sizeof(t_desig)); CodeDesig(nd, ds); @@ -711,7 +720,7 @@ DoForInit(nd) nd->nd_class = Name; nd->nd_symb = IDENT; - if (!( ChkVariable(nd) & + if (!( ChkVariable(nd, D_USED|D_DEFINED) & ChkExpression(left->nd_left) & ChkExpression(left->nd_right))) return 0; @@ -749,13 +758,22 @@ DoForInit(nd) tpl = left->nd_left->nd_type; tpr = left->nd_right->nd_type; - if (!ChkAssCompat(&(left->nd_left), df->df_type, "FOR statement") || - !ChkAssCompat(&(left->nd_right), BaseType(df->df_type), "FOR statement")) { +#ifndef STRICT_3RD_ED + if (! options['3']) { + if (!ChkAssCompat(&(left->nd_left), df->df_type, "FOR statement") || + !ChkAssCompat(&(left->nd_right), BaseType(df->df_type), "FOR statement")) { return 1; - } - if (!TstCompat(df->df_type, tpl) || - !TstCompat(df->df_type, tpr)) { + } + if (!TstCompat(df->df_type, tpl) || + !TstCompat(df->df_type, tpr)) { node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement"); + node_error(nd, "compatibility required in FOR statement"); + } + } else +#endif + if (!ChkCompat(&(left->nd_left), df->df_type, "FOR statement") || + !ChkCompat(&(left->nd_right), BaseType(df->df_type), "FOR statement")) { + return 1; } CodePExpr(left->nd_left); @@ -774,7 +792,7 @@ DoAssign(left, right) register t_desig *dsr; register t_type *tp; - if (! (ChkExpression(right) & ChkVariable(left))) return; + if (! (ChkExpression(right) & ChkVariable(left, D_DEFINED))) return; tp = left->nd_type; if (right->nd_symb == STRING) TryToString(right, tp); @@ -798,20 +816,22 @@ DoAssign(left, right) free_desig(dsr); } -RegisterMessages(df) +static int +RegisterMessage(df) register t_def *df; { register t_type *tp; arith sz; - int regtype = -1; + int regtype; - for (; df; df = df->df_nextinscope) { - if (df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG)) { + if (df->df_kind == D_VARIABLE) { + if ( !(df->df_flags & D_NOREG)) { /* Examine type and size */ + regtype = -1; tp = BaseType(df->df_type); if ((df->df_flags & D_VARPAR) || - (tp->tp_fund & (T_POINTER|T_HIDDEN|T_EQUAL))) { + (tp->tp_fund&(T_POINTER|T_HIDDEN|T_EQUAL))) { sz = pointer_size; regtype = reg_pointer; } @@ -826,3 +846,38 @@ RegisterMessages(df) } } } + +static int +UseWarnings(df) + register t_def *df; +{ + if (df->df_kind & (D_IMPORT | D_VARIABLE | D_PROCEDURE)) { + struct node *nd; + + if (df->df_flags & (D_EXPORTED | D_QEXPORTED)) return; + if (df->df_kind == D_IMPORT) df = df->imp_def; + if (! (df->df_kind & (D_VARIABLE|D_PROCEDURE))) return; + nd = df->df_scope->sc_end; + if (! (df->df_flags & D_DEFINED)) { + node_warning(nd, + W_ORDINARY, + "identifier \"%s\" never assigned", + df->df_idf->id_text); + } + if (! (df->df_flags & D_USED)) { + node_warning(nd, + W_ORDINARY, + "identifier \"%s\" never used", + df->df_idf->id_text); + } + } +} + +WalkDefList(df, proc) + register t_def *df; + int (*proc)(); +{ + for (; df; df = df->df_nextinscope) { + (*proc)(df); + } +} -- 2.34.1