diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index d1ae5f18a..fc5e571de 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -82,10 +82,10 @@ SkipComment() options[ch] = !on_on_minus; break; } + ch = c; } /* fall through */ default: - PushBack(); break; } } @@ -152,7 +152,8 @@ GetString(upto) } } str->s_length = p - str->s_str; - while (p - str->s_str < len) *p++ = '\0'; + *p = '\0'; + str->s_str = Realloc(str->s_str, (unsigned)(str->s_length) + 1); if (str->s_length == 0) str->s_length = 1; /* ??? string length at least 1 ??? */ return str; @@ -236,6 +237,13 @@ CheckForLineDirective() LineNumber = i; } +static +UnloadChar(ch) +{ + if (ch == EOI) eofseen = 1; + else PushBack(); +} + int LLlex() { @@ -297,8 +305,7 @@ again: SkipComment(); goto again; } - else if (nch == EOI) eofseen = 1; - else PushBack(); + UnloadChar(nch); } if (ch == '&') return tk->tk_symb = AND; if (ch == '~') return tk->tk_symb = NOT; @@ -338,8 +345,7 @@ again: default : crash("(LLlex, STCOMP)"); } - if (nch == EOI) eofseen = 1; - else PushBack(); + UnloadChar(nch); return tk->tk_symb = ch; case STIDF: @@ -355,8 +361,7 @@ again: LoadChar(ch); } while(in_idf(ch)); - if (ch == EOI) eofseen = 1; - else PushBack(); + UnloadChar(ch); *tag = '\0'; if (*(tag - 1) == '_') { lexerror("last character of an identifier may not be an underscore"); @@ -377,10 +382,10 @@ again: } else { tk->tk_data.tk_str = str; - if (! fit(str->s_length, (int) word_size)) { + if (! fit((arith)(str->s_length), (int) word_size)) { lexerror("string too long"); } - toktype = standard_type(T_STRING, 1, str->s_length); + toktype = standard_type(T_STRING, 1, (arith)(str->s_length)); } return tk->tk_symb = STRING; } @@ -429,8 +434,7 @@ again: else { state = End; if (ch == 'H') base = 16; - else if (ch == EOI) eofseen = 1; - else PushBack(); + UnloadChar(ch); } break; @@ -456,8 +460,7 @@ again: state = End; if (ch != 'H') { lexerror("H expected after hex number"); - if (ch == EOI) eofseen = 1; - else PushBack(); + UnloadChar(ch); } break; @@ -473,8 +476,7 @@ again: state = Hex; break; } - if (ch == EOI) eofseen = 1; - else PushBack(); + UnloadChar(ch); ch = *--np; *np++ = '\0'; base = 8; @@ -593,8 +595,7 @@ lexwarning(W_ORDINARY, "overflow in constant"); noscale: *np++ = '\0'; - if (ch == EOI) eofseen = 1; - else PushBack(); + UnloadChar(ch); if (np >= &buf[NUMSIZE]) { tk->TOK_REL = Salloc("0.0", 5); diff --git a/lang/m2/comp/LLlex.h b/lang/m2/comp/LLlex.h index ecfa892e9..3d7f44ab0 100644 --- a/lang/m2/comp/LLlex.h +++ b/lang/m2/comp/LLlex.h @@ -12,7 +12,7 @@ /* Structure to store a string constant */ struct string { - arith s_length; /* length of a string */ + unsigned s_length; /* length of a string */ char *s_str; /* the string itself */ }; diff --git a/lang/m2/comp/Version.c b/lang/m2/comp/Version.c index 1e7bcbc5b..bd0c5ed4c 100644 --- a/lang/m2/comp/Version.c +++ b/lang/m2/comp/Version.c @@ -1 +1 @@ -static char Version[] = "ACK Modula-2 compiler Version 0.38"; +static char Version[] = "ACK Modula-2 compiler Version 0.39"; diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 47928a678..c0f6464d7 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -84,19 +84,12 @@ MkCoercion(pnd, tp) if (nd->nd_class == Value && nd_tp->tp_fund != T_REAL && tp->tp_fund != T_REAL) { - /* Constant expression mot involving REALs */ + /* Constant expression not involving REALs */ switch(tp->tp_fund) { case T_SUBRANGE: - if (! chk_bounds(tp->sub_lb, nd->nd_INT, - BaseType(tp)->tp_fund) || - ! chk_bounds(nd->nd_INT, tp->sub_ub, - BaseType(tp)->tp_fund)) { - wmess = "range bound"; - } - break; case T_ENUMERATION: case T_CHAR: - if (nd->nd_INT < 0 || nd->nd_INT >= tp->enm_ncst) { + if (! in_range(nd->nd_INT, tp)) { wmess = "range bound"; } break; @@ -109,12 +102,10 @@ MkCoercion(pnd, tp) } break; case T_INTEGER: { - long i = ~max_int[(int)(tp->tp_size)]; + long i = min_int[(int)(tp->tp_size)]; long j = nd->nd_INT & i; - if ((nd_tp->tp_fund == T_INTEGER && - j != i && j != 0) || - (nd_tp->tp_fund != T_INTEGER && j)) { + if (j != 0 && (nd_tp->tp_fund != T_INTEGER || j != i)) { wmess = "conversion"; } } @@ -377,7 +368,7 @@ ChkElement(expp, tp, set) register t_node *expr = *expp; t_type *el_type = ElementType(tp); register unsigned int i; - arith lo, hi, low, high; + arith low, high; if (expr->nd_class == Link && expr->nd_symb == UPTO) { /* { ... , expr1 .. expr2, ... } @@ -407,13 +398,12 @@ ChkElement(expp, tp, set) } low = high = expr->nd_INT; } - if (low > high) { + if (! chk_bounds(low, high, BaseType(el_type)->tp_fund)) { node_error(expr, "lower bound exceeds upper bound in range"); return 0; } - getbounds(el_type, &lo, &hi); - if (low < lo || high > hi) { + if (! in_range(low, el_type) || ! in_range(high, el_type)) { node_error(expr, "set element out of range"); return 0; } @@ -665,17 +655,12 @@ ChkFunCall(expp) /* Check a call that must have a result */ - if (! ChkCall(expp)) { - expp->nd_type = error_type; - return 0; - } - - if (expp->nd_type == 0) { + if (ChkCall(expp)) { + if (expp->nd_type != 0) return 1; node_error(expp, "function call expected"); - expp->nd_type = error_type; - return 0; } - return 1; + expp->nd_type = error_type; + return 0; } int diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index d31fe4b80..e77af3913 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -83,7 +83,7 @@ CodeString(nd) return; } C_df_dlb(++data_label); - C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1)); + C_rom_scon(nd->nd_STR, WA((arith)(nd->nd_SLE + 1))); c_lae_dlb(data_label); } @@ -395,7 +395,7 @@ CodeParameters(param, arg) } } else if (left->nd_symb == STRING) { - C_loc(left->nd_SLE - 1); + C_loc((arith)(left->nd_SLE - 1)); } else if (elem == word_type) { C_loc((left_type->tp_size+word_size-1) / word_size - 1); @@ -612,28 +612,25 @@ RangeCheck(tpl, tpr) /* Generate a range check if neccessary */ - arith llo, lhi, rlo, rhi; + arith rlo, rhi; if (options['R']) return; if (bounded(tpl)) { - /* in this case we might need a range check */ - if (!bounded(tpr)) { - /* yes, we need one */ - genrck(tpl); - return; - } - /* both types are restricted. check the bounds + /* In this case we might need a range check. + If both types are restricted. check the bounds to see wether we need a range check. We don't need one if the range of values of the right hand side is a subset of the range of values of the left hand side. */ - getbounds(tpl, &llo, &lhi); - getbounds(tpr, &rlo, &rhi); - if (llo > rlo || lhi < rhi) { - genrck(tpl); + if (bounded(tpr)) { + getbounds(tpr, &rlo, &rhi); + if (in_range(rlo, tpl) && in_range(rhi, tpl)) { + return; + } } + genrck(tpl); return; } if (tpl->tp_size <= tpr->tp_size && diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c index abfe9eb38..8c25020be 100644 --- a/lang/m2/comp/defmodule.c +++ b/lang/m2/comp/defmodule.c @@ -41,10 +41,9 @@ getwdir(fn) register char *p; char *strrindex(); - p = strrindex(fn, '/'); - while (p && *(p + 1) == '\0') { /* remove trailing /'s */ + while ((p = strrindex(fn,'/')) && *(p + 1) == '\0') { + /* remove trailing /'s */ *p = '\0'; - p = strrindex(fn, '/'); } if (p) { @@ -53,7 +52,7 @@ getwdir(fn) *p = '/'; return fn; } - else return "."; + return "."; } STATIC @@ -101,23 +100,23 @@ GetDefinitionModule(id, incr) if (!df) { /* Read definition module. Make an exception for SYSTEM. */ + extern int ForeignFlag; + + ForeignFlag = 0; DefId = id; + open_scope(CLOSEDSCOPE); if (!strcmp(id->id_text, "SYSTEM")) { do_SYSTEM(); df = lookup(id, GlobalScope, D_IMPORTED, 0); } else { - extern int ForeignFlag; - - ForeignFlag = 0; - open_scope(CLOSEDSCOPE); newsc = CurrentScope; if (!is_anon_idf(id) && GetFile(id->id_text)) { DefModule(); df = lookup(id, GlobalScope, D_IMPORTED, 0); if (level == 1 && - (!df || !(df->df_flags & D_FOREIGN))) { + (df && !(df->df_flags & D_FOREIGN))) { /* The module is directly imported by the currently defined module, and is not foreign, so we have to @@ -129,7 +128,7 @@ GetDefinitionModule(id, incr) extern t_node *Modules; n = dot2leaf(Def); - n->nd_def = CurrentScope->sc_definedby; + n->nd_def = newsc->sc_definedby; if (nd_end) nd_end->nd_left = n; else Modules = n; nd_end = n; @@ -140,8 +139,8 @@ GetDefinitionModule(id, incr) newsc->sc_name = id->id_text; } vis = CurrVis; - close_scope(SC_CHKFORW); } + close_scope(SC_CHKFORW); if (! df) { df = MkDef(id, GlobalScope, D_ERROR); df->mod_vis = vis; diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index d09901f63..2a4014cde 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -236,7 +236,6 @@ do_SYSTEM() */ static char systemtext[] = SYSTEMTEXT; - open_scope(CLOSEDSCOPE); EnterType("WORD", word_type); EnterType("BYTE", byte_type); EnterType("ADDRESS",address_type); @@ -245,7 +244,6 @@ do_SYSTEM() fatal("could not insert text"); } DefModule(); - close_scope(SC_CHKFORW); } #ifdef DEBUG diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index fc626a7bd..b6ee4a0ac 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -206,12 +206,15 @@ extern t_type (tpx)->tp_next) #define PointedtoType(tpx) (assert((tpx)->tp_fund == T_POINTER),\ (tpx)->tp_next) +#define SubBaseType(tpx) (assert((tpx)->tp_fund == T_SUBRANGE), \ + (tpx)->tp_next) #else DEBUG #define ResultType(tpx) ((tpx)->tp_next) #define ParamList(tpx) ((tpx)->prc_params) #define IndexType(tpx) ((tpx)->tp_next) #define ElementType(tpx) ((tpx)->tp_next) #define PointedtoType(tpx) ((tpx)->tp_next) +#define SubBaseType(tpx) ((tpx)->tp_next) #endif DEBUG #define BaseType(tpx) ((tpx)->tp_fund == T_SUBRANGE ? (tpx)->tp_next : \ (tpx)) diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 2b79ea9bb..39d447789 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -291,31 +291,25 @@ chk_basesubrange(tp, base) /* Check that the bounds of "tp" fall within the range of "base". */ - int fund = base->tp_next->tp_fund; - - if (! chk_bounds(base->sub_lb, tp->sub_lb, fund) || - ! chk_bounds(tp->sub_ub, base->sub_ub, fund)) { + if (! in_range(tp->sub_lb, base) || + ! in_range(tp->sub_ub, base)) { error("base type has insufficient range"); } base = base->tp_next; } - if (base->tp_fund & (T_ENUMERATION|T_CHAR)) { + if ((base->tp_fund & (T_ENUMERATION|T_CHAR)) || base == card_type) { if (tp->tp_next != base) { error("specified base does not conform"); } } - else if (base != card_type && base != int_type) { - error("illegal base for a subrange"); + else if (base == int_type) { + if (tp->tp_next == card_type && + ! chk_bounds(tp->sub_ub,max_int[(int)int_size],T_CARDINAL)){ + error("upperbound to large for type INTEGER"); + } } - else if (base == int_type && tp->tp_next == card_type && - (tp->sub_ub > max_int[(int) word_size] || tp->sub_ub < 0)) { - error("upperbound to large for type INTEGER"); - } - else if (base != tp->tp_next && base != int_type) { - error("specified base does not conform"); - } - + else error("illegal base for a subrange"); tp->tp_next = base; } @@ -334,6 +328,28 @@ chk_bounds(l1, l2, fund) ); } +int +in_range(i, tp) + arith i; + register t_type *tp; +{ + /* Check that the value i fits in the subrange or enumeration + type tp. Return 1 if so, 0 otherwise + */ + + switch(tp->tp_fund) { + case T_ENUMERATION: + case T_CHAR: + return i >= 0 && i < tp->enm_ncst; + + case T_SUBRANGE: + return chk_bounds(i, tp->sub_ub, SubBaseType(tp)->tp_fund) && + chk_bounds(tp->sub_lb, i, SubBaseType(tp)->tp_fund); + } + assert(0); + /*NOTREACHED*/ +} + t_type * subr_type(lb, ub) register t_node *lb; @@ -536,7 +552,7 @@ ArraySizes(tp) /* Assign sizes to an array type, and check index type */ register t_type *index_type = IndexType(tp); - arith lo, hi, diff; + arith diff; ArrayElSize(tp); @@ -548,10 +564,8 @@ ArraySizes(tp) return; } - getbounds(index_type, &lo, &hi); - tp->arr_low = lo; - tp->arr_high = hi; - diff = hi - lo; + getbounds(index_type, &(tp->arr_low), &(tp->arr_high)); + diff = tp->arr_high - tp->arr_low; if (! fit(diff, (int) int_size)) { error("too many elements in array");