diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 3b0cd8ba6..21ba93bb4 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -8,18 +8,18 @@ static char *RcsId = "$Header$"; #include #include #include +#include "Lpars.h" #include "idf.h" #include "type.h" #include "def.h" #include "LLlex.h" #include "node.h" -#include "Lpars.h" #include "scope.h" #include "const.h" #include "standards.h" int -chk_expr(expp, const) +chk_expr(expp) register struct node *expp; { /* Check the expression indicated by expp for semantic errors, @@ -29,12 +29,12 @@ chk_expr(expp, const) switch(expp->nd_class) { case Oper: - return chk_expr(expp->nd_left, const) && - chk_expr(expp->nd_right, const) && - chk_oper(expp, const); + return chk_expr(expp->nd_left) && + chk_expr(expp->nd_right) && + chk_oper(expp); case Uoper: - return chk_expr(expp->nd_right, const) && - chk_uoper(expp, const); + return chk_expr(expp->nd_right) && + chk_uoper(expp); case Value: switch(expp->nd_symb) { case REAL: @@ -46,13 +46,13 @@ chk_expr(expp, const) } break; case Xset: - return chk_set(expp, const); + return chk_set(expp); case Name: - return chk_name(expp, const); + return chk_name(expp); case Call: - return chk_call(expp, const); + return chk_call(expp); case Link: - return chk_name(expp, const); + return chk_name(expp); default: assert(0); } @@ -60,7 +60,7 @@ chk_expr(expp, const) } int -chk_set(expp, const) +chk_set(expp) register struct node *expp; { /* Check the legality of a SET aggregate, and try to evaluate it @@ -82,7 +82,7 @@ chk_set(expp, const) assert(expp->nd_left->nd_class == Def); df = expp->nd_left->nd_def; if ((df->df_kind != D_TYPE && df->df_kind != D_ERROR) || - (df->df_type->tp_fund != SET)) { + (df->df_type->tp_fund != T_SET)) { node_error(expp, "Illegal set type"); return 0; } @@ -96,11 +96,10 @@ chk_set(expp, const) nd = expp->nd_right; while (nd) { assert(nd->nd_class == Link && nd->nd_symb == ','); - if (!chk_el(nd->nd_left, const, tp->next, &set)) return 0; + if (!chk_el(nd->nd_left, tp->next, &set)) return 0; nd = nd->nd_right; } expp->nd_type = tp; - assert(!const || set); if (set) { /* Yes, in was a constant set, and we managed to compute it! */ @@ -114,7 +113,7 @@ chk_set(expp, const) } int -chk_el(expp, const, tp, set) +chk_el(expp, tp, set) register struct node *expp; struct type *tp; arith **set; @@ -127,8 +126,8 @@ chk_el(expp, const, tp, set) /* { ... , expr1 .. expr2, ... } First check expr1 and expr2, and try to compute them. */ - if (!chk_el(expp->nd_left, const, tp, set) || - !chk_el(expp->nd_right, const, tp, set)) { + if (!chk_el(expp->nd_left, tp, set) || + !chk_el(expp->nd_right, tp, set)) { return 0; } if (expp->nd_left->nd_class == Value && @@ -157,7 +156,7 @@ node_error(expp, "Lower bound exceeds upper bound in range"); /* Here, a single element is checked */ - if (!chk_expr(expp, const)) { + if (!chk_expr(expp)) { return rem_set(set); } if (!TstCompat(tp, expp->nd_type)) { @@ -165,10 +164,10 @@ node_error(expp, "Lower bound exceeds upper bound in range"); return rem_set(set); } if (expp->nd_class == Value) { - if ((tp->tp_fund != ENUMERATION && + if ((tp->tp_fund != T_ENUMERATION && (expp->nd_INT < tp->sub_lb || expp->nd_INT > tp->sub_ub)) || - (tp->tp_fund == ENUMERATION && + (tp->tp_fund == T_ENUMERATION && (expp->nd_INT < 0 || expp->nd_INT > tp->enm_ncst)) ) { node_error(expp, "Set element out of range"); @@ -193,12 +192,52 @@ rem_set(set) return 0; } +struct node * +getarg(argp, bases) + struct node *argp; +{ + struct type *tp; + + if (!argp->nd_right) { + node_error(argp, "Too few arguments supplied"); + return 0; + } + argp = argp->nd_right; + if (!chk_expr(argp->nd_left)) return 0; + tp = argp->nd_left->nd_type; + if (tp->tp_fund == T_SUBRANGE) tp = tp->next; + if (!(tp->tp_fund & bases)) { + node_error(argp, "Unexpected type"); + return 0; + } + return argp; +} + +struct node * +getname(argp, kinds) + struct node *argp; +{ + if (!argp->nd_right) { + node_error(argp, "Too few arguments supplied"); + return 0; + } + argp = argp->nd_right; + if (!findname(argp->nd_left)) return 0; + assert(argp->nd_left->nd_class == Def); + if (!(argp->nd_left->nd_def->df_kind & kinds)) { + node_error(argp, "Unexpected type"); + return 0; + } + return argp; +} + int -chk_call(expp, const) +chk_call(expp) register struct node *expp; { register struct type *tp; register struct node *left; + register struct node *arg; expp->nd_type = error_type; (void) findname(expp->nd_left); @@ -211,57 +250,148 @@ chk_call(expp, const) /* A type cast. This is of course not portable. No runtime action. Remove it. */ - if (!expp->nd_right || - (expp->nd_right->nd_symb == ',')) { + arg = expp->nd_right; + if (!arg || arg->nd_right) { node_error(expp, "Only one parameter expected in type cast"); return 0; } - if (! chk_expr(expp->nd_right, const)) return 0; - if (expp->nd_right->nd_type->tp_size != + if (! chk_expr(arg->nd_left)) return 0; + if (arg->nd_left->nd_type->tp_size != left->nd_type->tp_size) { node_error(expp, "Size of type in type cast does not match size of operand"); return 0; } - expp->nd_right->nd_type = left->nd_type; - left = expp->nd_right; + arg->nd_left->nd_type = left->nd_type; FreeNode(expp->nd_left); - *expp = *(expp->nd_right); - left->nd_left = left->nd_right = 0; - FreeNode(left); + *expp = *(arg->nd_left); + arg->nd_left->nd_left = 0; + arg->nd_left->nd_right = 0; + FreeNode(arg); return 1; } if ((left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) || - tp->tp_fund == PROCVAR) { + tp->tp_fund == T_PROCEDURE) { /* A procedure call. it may also be a call to a standard procedure */ + arg = expp; if (tp == std_type) { assert(left->nd_class == Def); switch(left->nd_def->df_value.df_stdname) { case S_ABS: + arg = getarg(arg, T_INTEGER|T_CARDINAL|T_REAL); + if (! arg) return 0; + expp->nd_type = arg->nd_left->nd_type; + break; case S_CAP: + arg = getarg(arg, T_CHAR); + expp->nd_type = char_type; + if (!arg) return 0; + break; case S_CHR: + arg = getarg(arg, T_INTEGER|T_CARDINAL); + expp->nd_type = char_type; + if (!arg) return 0; + break; case S_FLOAT: + arg = getarg(arg, T_CARDINAL|T_INTEGER); + expp->nd_type = real_type; + if (!arg) return 0; + break; case S_HIGH: + arg = getarg(arg, T_ARRAY); + if (!arg) return 0; + expp->nd_type = arg->nd_left->nd_type->next; + if (!expp->nd_type) expp->nd_type = int_type; + break; case S_MAX: case S_MIN: + arg = getarg(arg, T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL); + if (!arg) return 0; + expp->nd_type = arg->nd_left->nd_type; + break; case S_ODD: + arg = getarg(arg, T_INTEGER|T_CARDINAL); + if (!arg) return 0; + expp->nd_type = bool_type; + break; case S_ORD: + arg = getarg(arg, T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL); + if (!arg) return 0; + expp->nd_type = card_type; + break; + case S_TSIZE: /* ??? */ case S_SIZE: + arg = getname(arg, D_FIELD|D_VARIABLE|D_TYPE|D_HIDDEN|D_HTYPE); + expp->nd_type = intorcard_type; + if (!arg) return 0; + break; case S_TRUNC: + arg = getarg(arg, T_REAL); + if (!arg) return 0; + expp->nd_type = card_type; + break; case S_VAL: + arg = getname(arg, D_HIDDEN|D_HTYPE|D_TYPE); + if (!arg) return 0; + tp = arg->nd_left->nd_def->df_type; + if (tp->tp_fund == T_SUBRANGE) tp = tp->next; + if (!(tp->tp_fund & (T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL))) { + node_error(arg, "unexpected type"); + return 0; + } + expp->nd_type = arg->nd_left->nd_def->df_type; + FreeNode(arg->nd_left); + arg->nd_left = 0; + arg = getarg(arg, T_INTEGER|T_CARDINAL); + if (!arg) return 0; + break; + case S_ADR: + arg = getname(arg, D_VARIABLE|D_FIELD|D_PROCEDURE); + expp->nd_type = address_type; + if (!arg) return 0; break; case S_DEC: case S_INC: + expp->nd_type = 0; + arg = getname(arg, D_VARIABLE|D_FIELD); + if (!arg) return 0; + if (arg->nd_right) { + arg = getarg(arg, T_INTEGER|T_CARDINAL); + if (!arg) return 0; + } + break; case S_HALT: + expp->nd_type = 0; + break; case S_EXCL: case S_INCL: expp->nd_type = 0; + arg = getname(arg, D_VARIABLE|D_FIELD); + if (!arg) return 0; + tp = arg->nd_left->nd_type; + if (tp->tp_fund != T_SET) { +node_error(arg, "EXCL and INCL expect a SET parameter"); + return 0; + } + arg = getarg(arg, T_INTEGER|T_CARDINAL|T_CHAR|T_ENUMERATION); + if (!arg) return 0; + if (!TstCompat(tp->next, arg->nd_left->nd_type)) { + node_error(arg, "Unexpected type"); + return 0; + } break; default: assert(0); } + if (arg->nd_right) { + node_error(arg->nd_right, + "Too many parameters supplied"); + return 0; + } + FreeNode(expp->nd_left); + expp->nd_left = 0; return 1; } return 1; @@ -297,7 +427,7 @@ findname(expp) if (tp == error_type) { df = ill_df; } - else if (tp->tp_fund != RECORD) { + else if (tp->tp_fund != T_RECORD) { /* This is also true for modules */ node_error(expp,"Illegal selection"); df = ill_df; @@ -341,18 +471,15 @@ df->df_idf->id_text); } int -chk_name(expp, const) +chk_name(expp) register struct node *expp; { register struct def *df; - int retval = 1; (void) findname(expp); assert(expp->nd_class == Def); df = expp->nd_def; - if (df->df_kind == D_ERROR) { - retval = 0; - } + if (df->df_kind == D_ERROR) return 0; if (df->df_kind & (D_ENUM | D_CONST)) { if (df->df_kind == D_ENUM) { expp->nd_class = Value; @@ -363,20 +490,14 @@ chk_name(expp, const) *expp = *(df->con_const); } } - else if (const) { - node_error(expp, "constant expected"); - retval = 0; - } - return retval; + return 1; } int -chk_oper(expp, const) +chk_oper(expp) register struct node *expp; { - /* Check a binary operation. If "const" is set, also check - that it is constant. - The code is ugly ! + /* Check a binary operation. */ register struct type *tpl = expp->nd_left->nd_type; register struct type *tpr = expp->nd_right->nd_type; @@ -398,7 +519,7 @@ chk_oper(expp, const) if (expp->nd_symb == IN) { /* Handle this one specially */ expp->nd_type = bool_type; - if (tpr->tp_fund != SET) { + if (tpr->tp_fund != T_SET) { node_error(expp, "RHS of IN operator not a SET type"); return 0; } @@ -411,7 +532,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R if (expp->nd_symb == '[') { /* Handle ARRAY selection specially too! */ - if (tpl->tp_fund != ARRAY) { + if (tpl->tp_fund != T_ARRAY) { node_error(expp, "array index not belonging to an ARRAY"); return 0; } @@ -420,11 +541,10 @@ node_error(expp, "incompatible index type"); return 0; } expp->nd_type = tpl->arr_elem; - if (const) return 0; return 1; } - if (tpl->tp_fund == SUBRANGE) tpl = tpl->next; + if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next; expp->nd_type = tpl; if (!TstCompat(tpl, tpr)) { @@ -437,49 +557,35 @@ node_error(expp, "Incompatible types for operator \"%s\"", symbol2str(expp->nd_s case '-': case '*': switch(tpl->tp_fund) { - case INTEGER: - case INTORCARD: - case CARDINAL: - case LONGINT: - case SET: + case T_INTEGER: + case T_CARDINAL: + case T_SET: if (expp->nd_left->nd_class == Value && expp->nd_right->nd_class == Value) { cstbin(expp); } return 1; - case REAL: - case LONGREAL: - if (const) { - errval = 2; - break; - } + case T_REAL: return 1; } break; case '/': switch(tpl->tp_fund) { - case SET: + case T_SET: if (expp->nd_left->nd_class == Value && expp->nd_right->nd_class == Value) { cstbin(expp); } return 1; - case REAL: - case LONGREAL: - if (const) { - errval = 2; - break; - } + case T_REAL: return 1; } break; case DIV: case MOD: switch(tpl->tp_fund) { - case INTEGER: - case INTORCARD: - case CARDINAL: - case LONGINT: + case T_INTEGER: + case T_CARDINAL: if (expp->nd_left->nd_class == Value && expp->nd_right->nd_class == Value) { cstbin(expp); @@ -505,32 +611,30 @@ node_error(expp, "Incompatible types for operator \"%s\"", symbol2str(expp->nd_s case '<': case '>': switch(tpl->tp_fund) { - case SET: + case T_SET: if (expp->nd_symb == '<' || expp->nd_symb == '>') { break; } - case INTEGER: - case INTORCARD: - case LONGINT: - case CARDINAL: - case ENUMERATION: /* includes boolean */ - case CHAR: + if (expp->nd_left->nd_class == Set && + expp->nd_right->nd_class == Set) { + cstbin(expp); + } + return 1; + case T_INTEGER: + case T_CARDINAL: + case T_ENUMERATION: /* includes boolean */ + case T_CHAR: if (expp->nd_left->nd_class == Value && expp->nd_right->nd_class == Value) { cstbin(expp); } return 1; - case POINTER: + case T_POINTER: if (!(expp->nd_symb == '=' || expp->nd_symb == '#')) { break; } /* Fall through */ - case REAL: - case LONGREAL: - if (const) { - errval = 2; - break; - } + case T_REAL: return 1; } default: @@ -540,37 +644,32 @@ node_error(expp, "Incompatible types for operator \"%s\"", symbol2str(expp->nd_s case 1: node_error(expp,"Operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb)); break; - case 2: - node_error(expp, "Expression not constant"); - break; case 3: node_error(expp, "BOOLEAN type(s) expected"); break; + default: + assert(0); } return 0; } int -chk_uoper(expp, const) +chk_uoper(expp) register struct node *expp; { - /* Check an unary operation. If "const" is set, also check that - it can be evaluated compile-time. + /* Check an unary operation. */ register struct type *tpr = expp->nd_right->nd_type; - if (tpr->tp_fund == SUBRANGE) tpr = tpr->next; + if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next; expp->nd_type = tpr; switch(expp->nd_symb) { case '+': switch(tpr->tp_fund) { - case INTEGER: - case LONGINT: - case REAL: - case LONGREAL: - case CARDINAL: - case INTORCARD: + case T_INTEGER: + case T_REAL: + case T_CARDINAL: expp->nd_token = expp->nd_right->nd_token; FreeNode(expp->nd_right); expp->nd_right = 0; @@ -579,15 +678,12 @@ chk_uoper(expp, const) break; case '-': switch(tpr->tp_fund) { - case INTEGER: - case LONGINT: - case INTORCARD: + case T_INTEGER: if (expp->nd_right->nd_class == Value) { cstunary(expp); } return 1; - case REAL: - case LONGREAL: + case T_REAL: if (expp->nd_right->nd_class == Value) { expp->nd_token = expp->nd_right->nd_token; if (*(expp->nd_REL) == '-') { @@ -609,9 +705,8 @@ chk_uoper(expp, const) } break; case '^': - if (tpr->tp_fund != POINTER) break; + if (tpr->tp_fund != T_POINTER) break; expp->nd_type = tpr->next; - if (const) return 0; return 1; default: assert(0); diff --git a/lang/m2/comp/cstoper.c b/lang/m2/comp/cstoper.c index cb9e14319..a6182bd83 100644 --- a/lang/m2/comp/cstoper.c +++ b/lang/m2/comp/cstoper.c @@ -60,7 +60,7 @@ cstbin(expp) int uns = expp->nd_type != int_type; assert(expp->nd_class == Oper); - if (expp->nd_right->nd_type->tp_fund == SET) { + if (expp->nd_right->nd_type->tp_fund == T_SET) { cstset(expp); return; } diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 65dcc05c9..79bc4dc02 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -56,7 +56,7 @@ ProcedureHeading(struct def **pdf; int type;) } FormalParameters(type == D_PROCEDURE, ¶ms, &tp)? { - df->df_type = tp = construct_type(PROCEDURE, tp); + df->df_type = tp = construct_type(T_PROCEDURE, tp); tp->prc_params = params; if (tp1 && !TstTypeEquiv(tp, tp1)) { error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text); @@ -137,7 +137,7 @@ FormalType(struct type **tp;) ]? qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0) { if (ARRAYflag) { - *tp = construct_type(ARRAY, NULLTYPE); + *tp = construct_type(T_ARRAY, NULLTYPE); (*tp)->arr_elem = df->df_type; } else *tp = df->df_type; @@ -153,12 +153,12 @@ TypeDeclaration '=' type(&tp) { df->df_type = tp; if ((df->df_flags&D_EXPORTED) && - tp->tp_fund == ENUMERATION) { + tp->tp_fund == T_ENUMERATION) { exprt_literals(tp->enm_enums, enclosing(CurrentScope)); } if (df->df_kind == D_HTYPE && - tp->tp_fund != POINTER) { + tp->tp_fund != T_POINTER) { error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text); } @@ -207,11 +207,11 @@ enumeration(struct type **ptp;) struct node *EnumList; } : '(' IdentList(&EnumList) ')' - { - *ptp = standard_type(ENUMERATION,int_align,int_size); - EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope); - FreeNode(EnumList); - } + { + *ptp = standard_type(T_ENUMERATION,int_align,int_size); + EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope); + FreeNode(EnumList); + } ; @@ -252,12 +252,12 @@ ArrayType(struct type **ptp;) } : ARRAY SimpleType(&tp) { - *ptp = tp2 = construct_type(ARRAY, tp); + *ptp = tp2 = construct_type(T_ARRAY, tp); } [ ',' SimpleType(&tp) { tp2 = tp2->arr_elem = - construct_type(ARRAY, tp); + construct_type(T_ARRAY, tp); } ]* OF type(&tp) { tp2->arr_elem = tp; } @@ -273,10 +273,10 @@ RecordType(struct type **ptp;) scope.next = CurrentScope; } FieldListSequence(&scope) - { - *ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */); - (*ptp)->rec_scope = scope.sc_scope; - } + { + *ptp = standard_type(T_RECORD, record_align, (arith) 0 /* ???? */); + (*ptp)->rec_scope = scope.sc_scope; + } END ; @@ -380,7 +380,7 @@ PointerType(struct type **ptp;) { tp = NULLTYPE; } ] { - *ptp = construct_type(POINTER, tp); + *ptp = construct_type(T_POINTER, tp); if (!tp) Forward(&dot, &((*ptp)->next)); } ; @@ -391,7 +391,7 @@ ProcedureType(struct type **ptp;) struct type *tp = 0; } : PROCEDURE FormalTypeList(&pr, &tp)? - { *ptp = construct_type(PROCVAR, tp); + { *ptp = construct_type(T_PROCEDURE, tp); (*ptp)->prc_params = pr; } ; diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index 55df98c84..b0f444806 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -204,7 +204,7 @@ ids->nd_IDF->id_text); DO_DEBUG(2, debug("importing \"%s\", kind %d", ids->nd_IDF->id_text, df->df_kind)); define(ids->nd_IDF, CurrentScope, kind)->imp_def = df; if (df->df_kind == D_TYPE && - df->df_type->tp_fund == ENUMERATION) { + df->df_type->tp_fund == T_ENUMERATION) { /* Also import all enumeration literals */ exprt_literals(df->df_type->enm_enums, CurrentScope); diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index 2abfb97fe..6a9e1556f 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -68,12 +68,15 @@ ExpList(struct node **pnd;) { struct node **nd; } : - expression(pnd) { nd = pnd; } - [ - ',' { *nd = MkNode(Link, *nd, NULLNODE, &dot); - nd = &(*nd)->nd_right; + expression(pnd) { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); + (*pnd)->nd_symb = ','; + nd = &((*pnd)->nd_right); } - expression(nd) + [ + ',' { *nd = MkNode(Link, NULLNODE, NULLNODE, &dot); + } + expression(&(*nd)->nd_left) + { nd = &((*pnd)->nd_right); } ]* ; @@ -86,7 +89,10 @@ ConstExpression(struct node **pnd;): { DO_DEBUG(3, ( debug("Constant expression:"), PrNode(*pnd))); - (void) chk_expr(*pnd, 1); + if (chk_expr(*pnd) && + ((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) { + error("Constant expression expected"); + } DO_DEBUG(3, PrNode(*pnd)); } ; diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 5019dce96..08632c06b 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -156,7 +156,7 @@ add_standards() (void) Enter("NIL", D_CONST, address_type, 0); (void) Enter("PROC", D_TYPE, - construct_type(PROCEDURE, NULLTYPE), + construct_type(T_PROCEDURE, NULLTYPE), 0); df = Enter("BITSET", D_TYPE, bitset_type, 0); df = Enter("FALSE", D_ENUM, bool_type, 0); diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index f76742465..0cca0902d 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -48,7 +48,7 @@ ModuleDeclaration open_scope(CLOSEDSCOPE, 0); df->mod_scope = CurrentScope->sc_scope; df->df_type = - standard_type(RECORD, 0, (arith) 0); + standard_type(T_RECORD, 0, (arith) 0); df->df_type->rec_scope = df->mod_scope; } priority? ';' @@ -116,7 +116,7 @@ DefinitionModule df = define(id, GlobalScope, D_MODULE); if (!SYSTEMModule) open_scope(CLOSEDSCOPE, 0); df->mod_scope = CurrentScope->sc_scope; - df->df_type = standard_type(RECORD, 0, (arith) 0); + df->df_type = standard_type(T_RECORD, 0, (arith) 0); df->df_type->rec_scope = df->mod_scope; DefinitionModule = 1; DO_DEBUG(1, debug("Definition module \"%s\"", id->id_text)); diff --git a/lang/m2/comp/tokenname.c b/lang/m2/comp/tokenname.c index 9e0ca1cb5..a9b9920c2 100644 --- a/lang/m2/comp/tokenname.c +++ b/lang/m2/comp/tokenname.c @@ -76,22 +76,10 @@ struct tokenname tkidf[] = { /* names of the identifier tokens */ struct tokenname tkinternal[] = { /* internal keywords */ {PROGRAM, ""}, - {SUBRANGE, ""}, - {ENUMERATION, ""}, - {ERRONEOUS, ""}, - {PROCVAR, ""}, - {INTORCARD, ""}, {0, "0"} }; struct tokenname tkstandard[] = { /* standard identifiers */ - {CHAR, ""}, - {BOOLEAN, ""}, - {LONGINT, ""}, - {CARDINAL, ""}, - {LONGREAL, ""}, - {WORD, ""}, - {ADDRESS, ""}, {0, ""} }; diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index bba1f4afe..d144e4458 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -53,9 +53,23 @@ struct type { SUBRANGE */ int tp_fund; /* fundamental type or constructor */ +#define T_RECORD 0x0001 +#define T_ENUMERATION 0x0002 +#define T_INTEGER 0x0004 +#define T_CARDINAL 0x0008 +/* #define T_LONGINT 0x0010 */ +#define T_REAL 0x0020 +/* #define T_LONGREAL 0x0040 */ +#define T_POINTER 0x0080 +#define T_CHAR 0x0100 +#define T_WORD 0x0200 +#define T_SET 0x0400 +#define T_SUBRANGE 0x0800 +#define T_PROCEDURE 0x1000 +#define T_ARRAY 0x2000 +#define T_STRING 0x4000 int tp_align; /* alignment requirement of this type */ arith tp_size; /* size of this type */ -/* struct idf *tp_idf; /* name of this type */ union { struct enume tp_enum; struct subrange tp_subrange; diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 36083a1d9..f509f0d06 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -82,21 +82,21 @@ construct_type(fund, tp) struct type *dtp = create_type(fund); switch (fund) { - case PROCEDURE: - case POINTER: + case T_PROCEDURE: + case T_POINTER: dtp->tp_align = ptr_align; dtp->tp_size = ptr_size; dtp->next = tp; break; - case SET: + case T_SET: dtp->tp_align = wrd_align; dtp->next = tp; break; - case ARRAY: + case T_ARRAY: dtp->tp_align = tp->tp_align; dtp->next = tp; break; - case SUBRANGE: + case T_SUBRANGE: dtp->tp_align = tp->tp_align; dtp->tp_size = tp->tp_size; dtp->next = tp; @@ -131,25 +131,25 @@ init_types() { register struct type *tp; - char_type = standard_type(CHAR, 1, (arith) 1); + char_type = standard_type(T_CHAR, 1, (arith) 1); char_type->enm_ncst = 256; - bool_type = standard_type(ENUMERATION, 1, (arith) 1); + bool_type = standard_type(T_ENUMERATION, 1, (arith) 1); bool_type->enm_ncst = 2; - int_type = standard_type(INTEGER, int_align, int_size); - longint_type = standard_type(LONGINT, lint_align, lint_size); - card_type = standard_type(CARDINAL, int_align, int_size); - real_type = standard_type(REAL, real_align, real_size); - longreal_type = standard_type(LONGREAL, lreal_align, lreal_size); - word_type = standard_type(WORD, wrd_align, wrd_size); - intorcard_type = standard_type(INTORCARD, int_align, int_size); - string_type = standard_type(STRING, 1, (arith) -1); - address_type = construct_type(POINTER, word_type); - tp = construct_type(SUBRANGE, int_type); + int_type = standard_type(T_INTEGER, int_align, int_size); + longint_type = standard_type(T_INTEGER, lint_align, lint_size); + card_type = standard_type(T_CARDINAL, int_align, int_size); + real_type = standard_type(T_REAL, real_align, real_size); + longreal_type = standard_type(T_REAL, lreal_align, lreal_size); + word_type = standard_type(T_WORD, wrd_align, wrd_size); + intorcard_type = standard_type(T_INTEGER, int_align, int_size); + string_type = standard_type(T_STRING, 1, (arith) -1); + address_type = construct_type(T_POINTER, word_type); + tp = construct_type(T_SUBRANGE, int_type); tp->sub_lb = 0; tp->sub_ub = wrd_size * 8 - 1; bitset_type = set_type(tp); - std_type = construct_type(PROCEDURE, NULLTYPE); - error_type = standard_type(ERRONEOUS, 1, (arith) 1); + std_type = construct_type(T_PROCEDURE, NULLTYPE); + error_type = standard_type(T_CHAR, 1, (arith) 1); } int @@ -160,14 +160,11 @@ has_selectors(df) switch(df->df_kind) { case D_MODULE: return df->df_value.df_module.mo_scope; - case D_VARIABLE: { - register struct type *tp = df->df_type; - - if (tp->tp_fund == RECORD) { - return tp->rec_scope; + case D_VARIABLE: + if (df->df_type->tp_fund == T_RECORD) { + return df->df_type->rec_scope; } break; - } } error("no selectors for \"%s\"", df->df_idf->id_text); return 0; @@ -205,7 +202,7 @@ ParamList(ids, tp, VARp) chk_basesubrange(tp, base) register struct type *tp, *base; { - if (base->tp_fund == SUBRANGE) { + if (base->tp_fund == T_SUBRANGE) { /* Check that the bounds of "tp" fall within the range of "base" */ @@ -214,7 +211,7 @@ chk_basesubrange(tp, base) } base = base->next; } - if (base->tp_fund == ENUMERATION || base->tp_fund == CHAR) { + if (base->tp_fund == T_ENUMERATION || base->tp_fund == T_CHAR) { if (tp->next != base) { error("Specified base does not conform"); } @@ -247,13 +244,13 @@ subr_type(lb, ub) return error_type; } - if (tp->tp_fund == SUBRANGE) tp = tp->next; + if (tp->tp_fund == T_SUBRANGE) tp = tp->next; if (tp == intorcard_type) tp = card_type; /* lower bound > 0 */ /* Check base type */ if (tp != int_type && tp != card_type && tp != char_type && - tp->tp_fund != ENUMERATION) { + tp->tp_fund != T_ENUMERATION) { /* BOOLEAN is also an ENUMERATION type */ node_error(ub, "Illegal base type for subrange"); @@ -268,7 +265,7 @@ subr_type(lb, ub) /* Now construct resulting type */ - tp = construct_type(SUBRANGE, tp); + tp = construct_type(T_SUBRANGE, tp); tp->sub_lb = lb->nd_INT; tp->sub_ub = ub->nd_INT; DO_DEBUG(2,debug("Creating subrange type %ld-%ld", (long)lb->nd_INT,(long)ub->nd_INT)); @@ -285,13 +282,13 @@ set_type(tp) */ int lb, ub; - if (tp->tp_fund == SUBRANGE) { + if (tp->tp_fund == T_SUBRANGE) { if ((lb = tp->sub_lb) < 0 || (ub = tp->sub_ub) > MAX_SET - 1) { error("Set type limits exceeded"); return error_type; } } - else if (tp->tp_fund == ENUMERATION || tp == char_type) { + else if (tp->tp_fund == T_ENUMERATION || tp == char_type) { lb = 0; if ((ub = tp->enm_ncst - 1) > MAX_SET - 1) { error("Set type limits exceeded"); @@ -302,7 +299,7 @@ set_type(tp) error("illegal base type for set"); return error_type; } - tp = construct_type(SET, tp); + tp = construct_type(T_SET, tp); tp->tp_size = align(((ub - lb) + 7)/8, wrd_align); return tp; } diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c index 02f184cd8..9cf8621ff 100644 --- a/lang/m2/comp/typequiv.c +++ b/lang/m2/comp/typequiv.c @@ -25,9 +25,9 @@ TstTypeEquiv(tp1, tp2) tp2 == error_type || ( - tp1 && tp1->tp_fund == PROCEDURE + tp1 && tp1->tp_fund == T_PROCEDURE && - tp2 && tp2->tp_fund == PROCEDURE + tp2 && tp2->tp_fund == T_PROCEDURE && TstProcEquiv(tp1, tp2) ); @@ -65,8 +65,8 @@ TstCompat(tp1, tp2) Modula-2 Report for a definition of "compatible". */ if (TstTypeEquiv(tp1, tp2)) return 1; - if (tp1->tp_fund == SUBRANGE) tp1 = tp1->next; - if (tp2->tp_fund == SUBRANGE) tp2 = tp2->next; + if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next; + if (tp2->tp_fund == T_SUBRANGE) tp2 = tp2->next; return tp1 == tp2 || ( tp1 == intorcard_type @@ -83,7 +83,7 @@ TstCompat(tp1, tp2) && ( tp2 == card_type || tp2 == intorcard_type - || tp2->tp_fund == POINTER + || tp2->tp_fund == T_POINTER ) ) || @@ -91,7 +91,7 @@ TstCompat(tp1, tp2) && ( tp1 == card_type || tp1 == intorcard_type - || tp1->tp_fund == POINTER + || tp1->tp_fund == T_POINTER ) ) ;