From: ceriel Date: Tue, 15 Apr 1986 17:51:53 +0000 (+0000) Subject: newer version X-Git-Tag: release-5-5~5308 X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=426c273de83a08dcfce88e04703611b3c7d637a9;p=ack.git newer version --- diff --git a/lang/m2/comp/LLlex.c b/lang/m2/comp/LLlex.c index b0eb90e1d..db080a5f2 100644 --- a/lang/m2/comp/LLlex.c +++ b/lang/m2/comp/LLlex.c @@ -4,13 +4,16 @@ static char *RcsId = "$Header$"; #include #include +#include #include #include "input.h" #include "f_info.h" #include "Lpars.h" #include "class.h" #include "idf.h" +#include "type.h" #include "LLlex.h" +#include "const.h" #define IDFSIZE 256 /* Number of significant characters in an identifier */ #define NUMSIZE 256 /* maximum number of characters in a number */ @@ -18,6 +21,7 @@ static char *RcsId = "$Header$"; long str2long(); struct token dot, aside; +struct type *numtype; struct string string; static @@ -102,6 +106,7 @@ LLlex() char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 1]; register int ch, nch; + numtype = error_type; if (ASIDE) { /* a token is put aside */ *tk = aside; ASIDE = 0; @@ -236,7 +241,7 @@ again: switch (ch) { case 'H': Shex: *np++ = '\0'; - /* Type is integer */ + numtype = card_type; tk->TOK_INT = str2long(&buf[1], 16); return tk->tk_symb = INTEGER; @@ -271,10 +276,10 @@ Shex: *np++ = '\0'; PushBack(ch); ch = *--np; *np++ = '\0'; - /* - * If (ch == 'C') type is a CHAR - * else type is an INTEGER - */ + if (ch == 'C') { + numtype = char_type; + } + else numtype = card_type; tk->TOK_INT = str2long(&buf[1], 8); return tk->tk_symb = INTEGER; @@ -369,8 +374,11 @@ Sreal: PushBack(ch); Sdec: *np++ = '\0'; - /* Type is an integer */ tk->TOK_INT = str2long(&buf[1], 10); + if (tk->TOK_INT < 0 || tk->TOK_INT > max_int) { + numtype = card_type; + } + else numtype = intorcard_type; return tk->tk_symb = INTEGER; } /*NOTREACHED*/ diff --git a/lang/m2/comp/LLlex.h b/lang/m2/comp/LLlex.h index db49e6b9d..31ddcd465 100644 --- a/lang/m2/comp/LLlex.h +++ b/lang/m2/comp/LLlex.h @@ -28,6 +28,7 @@ struct token { #define TOK_REL tk_data.tk_real extern struct token dot, aside; +extern struct type *numtype; #define DOT dot.tk_symb #define ASIDE aside.tk_symb diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 67075d10d..fdd55cb49 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -266,7 +266,9 @@ node_error(expp, "Size of type in type cast does not match size of operand"); } arg->nd_type = left->nd_type; FreeNode(expp->nd_left); - *expp = *(arg->nd_left); + expp->nd_right->nd_left = 0; + FreeNode(expp->nd_right); + *expp = *arg; arg->nd_left = 0; arg->nd_right = 0; FreeNode(arg); @@ -451,8 +453,6 @@ findname(expp) register struct def *df; struct def *lookfor(); register struct type *tp; - int scope; - int module; expp->nd_type = error_type; if (expp->nd_class == Name) { @@ -596,7 +596,7 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R if (!TstCompat(tpl, tpr)) { node_error(expp, - "Incompatible types for operator \"%s\"", + "incompatible types for operator \"%s\"", symbol2str(expp->nd_symb)); return 0; } diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 062445836..afedfbbe1 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -14,6 +14,8 @@ static char *RcsId = "$Header$"; #include "scope.h" #include "node.h" #include "misc.h" + +static int proclevel = 0; /* nesting level of procedures */ } ProcedureDeclaration @@ -21,10 +23,13 @@ ProcedureDeclaration struct def *df; } : ProcedureHeading(&df, D_PROCEDURE) + { df->prc_level = proclevel++; + } ';' block IDENT { match_id(dot.TOK_IDF, df->df_idf); - df->prc_scope = CurrentScope->sc_scope; + df->prc_scope = CurrentScope; close_scope(SC_CHKFORW); + proclevel--; } ; @@ -36,38 +41,38 @@ ProcedureHeading(struct def **pdf; int type;) register struct def *df; } : PROCEDURE IDENT - { assert(type & (D_PROCEDURE | D_PROCHEAD)); - if (type == D_PROCHEAD) { - df = define(dot.TOK_IDF, CurrentScope, type); - df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot); - } - else { - df = lookup(dot.TOK_IDF, - CurrentScope->sc_scope); - if (df && df->df_kind == D_PROCHEAD) { - df->df_kind = type; - tp1 = df->df_type; - } - else { - df = define(dot.TOK_IDF, - CurrentScope, type); - } - open_scope(OPENSCOPE, 0); - } + { assert(type & (D_PROCEDURE | D_PROCHEAD)); + if (type == D_PROCHEAD) { + df = define(dot.TOK_IDF, CurrentScope, type); + df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot); + } + else { + df = lookup(dot.TOK_IDF, CurrentScope); + if (df && df->df_kind == D_PROCHEAD) { + df->df_kind = type; + tp1 = df->df_type; } - FormalParameters(type == D_PROCEDURE, ¶ms, &tp)? - { - df->df_type = tp = construct_type(T_PROCEDURE, tp); - tp->prc_params = params; - if (tp1 && !TstTypeEquiv(tp, tp1)) { + else df = define(dot.TOK_IDF, CurrentScope, type); + df->prc_nbpar = 0; + open_scope(OPENSCOPE); + } + } + FormalParameters(type == D_PROCEDURE, ¶ms, &tp, &(df->prc_nbpar))? + { + 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); - } - *pdf = df; - } + } + *pdf = df; + } ; -block: - declaration* [ BEGIN StatementSequence ]? END +block +{ + struct node *nd; +}: + declaration* [ BEGIN StatementSequence(&nd) ]? END ; declaration: @@ -82,18 +87,21 @@ declaration: ModuleDeclaration ';' ; -FormalParameters(int doparams; struct paramlist **pr; struct type **tp;) +FormalParameters(int doparams; + struct paramlist **pr; + struct type **tp; + arith *parmaddr;) { struct def *df; register struct paramlist *pr1; } : '(' [ - FPSection(doparams, pr) + FPSection(doparams, pr, parmaddr) { pr1 = *pr; } [ { for (; pr1->next; pr1 = pr1->next) ; } - ';' FPSection(doparams, &(pr1->next)) + ';' FPSection(doparams, &(pr1->next), &parmaddr) ]* ]? ')' @@ -109,7 +117,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;) because in this case we only read the header. The Implementation might contain different identifiers representing the same paramters. */ -FPSection(int doparams; struct paramlist **ppr;) +FPSection(int doparams; struct paramlist **ppr; arith *addr;) { struct node *FPList; struct paramlist *ParamList(); @@ -122,7 +130,8 @@ FPSection(int doparams; struct paramlist **ppr;) IdentList(&FPList) ':' FormalType(&tp) { if (doparams) { - EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope); + EnterIdList(FPList, D_VARIABLE, VARp, + tp, CurrentScope, addr); } *ppr = ParamList(FPList, tp, VARp); FreeNode(FPList); @@ -140,6 +149,9 @@ FormalType(struct type **tp;) { if (ARRAYflag) { *tp = construct_type(T_ARRAY, NULLTYPE); (*tp)->arr_elem = df->df_type; + (*tp)->tp_align = lcm(wrd_align, ptr_align); + (*tp)->tp_size = align(ptr_size + 3*wrd_size, + (*tp)->tp_align); } else *tp = df->df_type; } @@ -209,11 +221,20 @@ enumeration(struct type **ptp;) } : '(' IdentList(&EnumList) ')' { - *ptp = standard_type(T_ENUMERATION,int_align,int_size); - EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope); + *ptp = standard_type(T_ENUMERATION,1,1); + EnterIdList(EnumList, D_ENUM, 0, *ptp, + CurrentScope, (arith *) 0); FreeNode(EnumList); + if ((*ptp)->enm_ncst > 256) { + if (wrd_size == 1) { + error("Too many enumeration literals"); + } + else { + (*ptp)->tp_size = wrd_size; + (*ptp)->tp_align = wrd_align; + } + } } - ; IdentList(struct node **p;) @@ -261,44 +282,52 @@ ArrayType(struct type **ptp;) construct_type(T_ARRAY, tp); } ]* OF type(&tp) - { tp2->arr_elem = tp; } + { tp2->arr_elem = tp; + ArraySizes(*ptp); + } ; RecordType(struct type **ptp;) { - struct scope scope; + struct scope *scope; + arith count; + int xalign = record_align; } : RECORD - { scope.sc_scope = uniq_scope(); - scope.next = CurrentScope; + { open_scope(OPENSCOPE); + scope = CurrentScope; + close_scope(0); + count = 0; } - FieldListSequence(&scope) + FieldListSequence(scope, &count, &xalign) { - *ptp = standard_type(T_RECORD, record_align, (arith) 0 /* ???? */); - (*ptp)->rec_scope = scope.sc_scope; + *ptp = standard_type(T_RECORD, xalign, count); + (*ptp)->rec_scope = scope; } END ; -FieldListSequence(struct scope *scope;): - FieldList(scope) +FieldListSequence(struct scope *scope; arith *cnt; int *palign;): + FieldList(scope, cnt, palign) [ - ';' FieldList(scope) + ';' FieldList(scope, cnt, palign) ]* ; -FieldList(struct scope *scope;) +FieldList(struct scope *scope; arith *cnt; int *palign;) { struct node *FldList; struct idf *id; - struct def *df, *df1; + struct def *df; struct type *tp; struct node *nd; + arith tcnt, max; } : [ IdentList(&FldList) ':' type(&tp) - { EnterIdList(FldList, D_FIELD, 0, tp, scope); + { *palign = lcm(*palign, tp->tp_align); + EnterIdList(FldList, D_FIELD, 0, tp, scope, cnt); FreeNode(FldList); } | @@ -309,8 +338,7 @@ FieldList(struct scope *scope;) [ /* This is good, in both kinds of Modula-2, if the first qualident is a single identifier. */ - { - if (nd->nd_class != Name) { + { if (nd->nd_class != Name) { error("illegal variant tag"); id = gen_anon_idf(); } @@ -322,8 +350,7 @@ FieldList(struct scope *scope;) /* Old fashioned! the first qualident now represents the type */ - { - warning("Old fashioned Modula-2 syntax!"); + { warning("Old fashioned Modula-2 syntax!"); id = gen_anon_idf(); findname(nd); assert(nd->nd_class == Def); @@ -338,42 +365,62 @@ FieldList(struct scope *scope;) ] | /* Aha, third edition? */ - ':' qualident(D_TYPE|D_HTYPE|D_HIDDEN, - &df, - "type", - (struct node **) 0) - { - id = gen_anon_idf(); - } + ':' qualident(D_TYPE|D_HTYPE|D_HIDDEN, &df, "type", (struct node **) 0) + { id = gen_anon_idf(); } ] - { - df1 = define(id, scope, D_FIELD); - df1->df_type = df->df_type; + { tp = df->df_type; + df = define(id, scope, D_FIELD); + df->df_type = tp; + df->fld_off = align(*cnt, tp->tp_align); + *cnt = tcnt = df->fld_off + tp->tp_size; } - OF variant(scope) + OF variant(scope, &tcnt, tp, palign) + { max = tcnt; tcnt = *cnt; } [ - '|' variant(scope) + '|' variant(scope, &tcnt, tp, palign) + { if (tcnt > max) max = tcnt; } ]* - [ ELSE FieldListSequence(scope) + [ ELSE FieldListSequence(scope, &tcnt, palign) + { if (tcnt > max) max = tcnt; } ]? END + { *cnt = max; } ]? ; -variant(struct scope *scope;): - [ CaseLabelList ':' FieldListSequence(scope) ]? +variant(struct scope *scope; arith *cnt; struct type *tp; int *palign;) +{ + struct type *tp1 = tp; +} : + [ + CaseLabelList(&tp1) ':' FieldListSequence(scope, cnt, palign) + ]? /* Changed rule in new modula-2 */ ; -CaseLabelList: - CaseLabels [ ',' CaseLabels ]* +CaseLabelList(struct type **ptp;): + CaseLabels(ptp) [ ',' CaseLabels(ptp) ]* ; -CaseLabels +CaseLabels(struct type **ptp;) { struct node *nd1, *nd2 = 0; }: - ConstExpression(&nd1) [ UPTO ConstExpression(&nd2) ]? + ConstExpression(&nd1) + [ + UPTO ConstExpression(&nd2) + { if (!TstCompat(nd1->nd_type, nd2->nd_type)) { +node_error(nd2,"type incompatibility in case label"); + } + nd1->nd_type = error_type; + } + ]? + { if (*ptp != 0 && + !TstCompat(*ptp, nd1->nd_type)) { +node_error(nd1,"type incompatibility in case label"); + } + *ptp = nd1->nd_type; + } ; SetType(struct type **ptp;) @@ -398,7 +445,7 @@ PointerType(struct type **ptp;) struct node *nd; } : POINTER TO - [ %if ( (df = lookup(dot.TOK_IDF, CurrentScope->sc_scope))) + [ %if ( (df = lookup(dot.TOK_IDF, CurrentScope))) /* Either a Module or a Type, but in both cases defined in this scope, so this is the correct identification */ @@ -489,14 +536,22 @@ VariableDeclaration { struct node *VarList; struct type *tp; - struct node *nd = 0; } : - IdentList(&VarList) - [ - ConstExpression(&nd) - ]? + IdentAddrList(&VarList) ':' type(&tp) - { EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope); + { EnterVarList(VarList, tp, proclevel > 0); FreeNode(VarList); } ; + +IdentAddrList(struct node **pnd;) +{ +} : + IDENT { *pnd = MkNode(Name, NULLNODE, NULLNODE, &dot); } + ConstExpression(&(*pnd)->nd_left)? + [ { pnd = &((*pnd)->nd_right); } + ',' IDENT + { *pnd = MkNode(Name, NULLNODE, NULLNODE, &dot); } + ConstExpression(&(*pnd)->nd_left)? + ]* +; diff --git a/lang/m2/comp/def.H b/lang/m2/comp/def.H index 35f75794f..6a7629379 100644 --- a/lang/m2/comp/def.H +++ b/lang/m2/comp/def.H @@ -4,14 +4,16 @@ struct module { int mo_priority; /* priority of a module */ - int mo_scope; /* scope of this module */ + struct scope *mo_scope; /* scope of this module */ #define mod_priority df_value.df_module.mo_priority #define mod_scope df_value.df_module.mo_scope }; struct variable { arith va_off; /* address or offset of variable */ + char va_addrgiven; /* an address was given in the program */ #define var_off df_value.df_variable.va_off +#define var_addrgiven df_value.df_variable.va_addrgiven }; struct constant { @@ -38,8 +40,12 @@ struct field { }; struct dfproc { - int pr_scope; /* scope number of procedure */ + struct scope *pr_scope; /* scope of procedure */ + int pr_level; /* depth level of this procedure */ + arith pr_nbpar; /* Number of bytes parameters */ #define prc_scope df_value.df_proc.pr_scope +#define prc_level df_value.df_proc.pr_level +#define prc_nbpar df_value.df_proc.pr_nbpar }; struct import { @@ -48,7 +54,7 @@ struct import { }; struct dforward { - int fo_scope; + struct scope *fo_scope; struct node *fo_node; #define for_node df_value.df_forward.fo_node #define for_scope df_value.df_forward.fo_scope @@ -59,7 +65,7 @@ struct def { /* list of definitions for a name */ struct def *df_nextinscope; /* link all definitions in a scope */ struct idf *df_idf; /* link back to the name */ - int df_scope; /* scope in which this definition resides */ + struct scope *df_scope; /* scope in which this definition resides */ short df_kind; /* the kind of this definition: */ #define D_MODULE 0x0001 /* a module */ #define D_PROCEDURE 0x0002 /* procedure of function */ diff --git a/lang/m2/comp/def.c b/lang/m2/comp/def.c index c47b32189..4ebdef06f 100644 --- a/lang/m2/comp/def.c +++ b/lang/m2/comp/def.c @@ -18,7 +18,7 @@ static char *RcsId = "$Header$"; struct def *h_def; /* Pointer to free list of def structures */ static struct def illegal_def = - {0, 0, 0, -20 /* Illegal scope */, D_ERROR}; + {0, 0, 0, 0, D_ERROR}; struct def *ill_df = &illegal_def; @@ -32,17 +32,17 @@ define(id, scope, kind) */ register struct def *df; - DO_DEBUG(5, debug("Defining identifier \"%s\" in scope %d, kind = %d", - id->id_text, scope->sc_scope, kind)); - df = lookup(id, scope->sc_scope); + DO_DEBUG(5, debug("Defining identifier \"%s\", kind = %d", + id->id_text, kind)); + df = lookup(id, scope); if ( /* Already in this scope */ df || /* A closed scope, and id defined in the pervasive scope */ ( CurrentScope == scope && - scopeclosed(CurrentScope) + scopeclosed(scope) && - (df = lookup(id, 0))) + (df = lookup(id, PervasiveScope))) ) { switch(df->df_kind) { case D_PROCHEAD: @@ -62,7 +62,6 @@ define(id, scope, kind) break; case D_FORWMODULE: if (kind == D_FORWMODULE) { - df->df_kind = kind; return df; } if (kind == D_MODULE) { @@ -89,8 +88,9 @@ error("identifier \"%s\" already declared", id->id_text); df = new_def(); df->df_flags = 0; df->df_idf = id; - df->df_scope = scope->sc_scope; + df->df_scope = scope; df->df_kind = kind; + df->df_type = 0; df->next = id->id_def; id->id_def = df; @@ -103,6 +103,7 @@ error("identifier \"%s\" already declared", id->id_text); struct def * lookup(id, scope) register struct idf *id; + struct scope *scope; { /* Look up a definition of an identifier in scope "scope". Make the "def" list self-organizing. @@ -114,7 +115,6 @@ lookup(id, scope) df1 = 0; df = id->id_def; - DO_DEBUG(5, debug("Looking for identifier \"%s\" in scope %d", id->id_text, scope)); while (df) { if (df->df_scope == scope) { retval = df; @@ -148,7 +148,7 @@ Export(ids, qualified) struct node *nd = ids; while (ids) { - df = lookup(ids->nd_IDF, CurrentScope->sc_scope); + df = lookup(ids->nd_IDF, CurrentScope); if (df && (df->df_flags & (D_EXPORTED|D_QEXPORTED))) { node_error(ids, "Identifier \"%s\" occurs more than once in export list", df->df_idf->id_text); @@ -163,8 +163,7 @@ df->df_idf->id_text); } else { df->df_flags |= D_EXPORTED; - df1 = lookup(ids->nd_IDF, - enclosing(CurrentScope)->sc_scope); + df1 = lookup(ids->nd_IDF, enclosing(CurrentScope)); if (! df1 || !(df1->df_kind & (D_PROCHEAD|D_HIDDEN))) { df1 = define(ids->nd_IDF, enclosing(CurrentScope), @@ -185,6 +184,49 @@ df->df_idf->id_text); FreeNode(nd); } +static struct scope * +ForwModule(df, idn) + register struct def *df; + struct node *idn; +{ + /* An import is done from a not yet defined module "idn". + Create a declaration and a scope for this module. + */ + struct scope *scope; + + df->df_scope = enclosing(CurrentScope); + df->df_kind = D_FORWMODULE; + open_scope(CLOSEDSCOPE); + scope = CurrentScope; /* The new scope, but watch out, it's "next" + field is not set right. It must indicate the + enclosing scope, but this must be done AFTER + closing this one + */ + df->for_scope = scope; + df->for_node = MkNode(Name, NULLNODE, NULLNODE, &(idn->nd_token)); + close_scope(0); + scope->next = df->df_scope; + /* Here ! */ + return scope; +} + +static struct def * +ForwDef(ids, scope) + register struct node *ids; + struct scope *scope; +{ + /* Enter a forward definition of "ids" in scope "scope", + if it is not already defined. + */ + register struct def *df; + + if (!(df = lookup(ids->nd_IDF, scope))) { + df = define(ids->nd_IDF, scope, D_FORWARD); + df->for_node = MkNode(Name,NULLNODE,NULLNODE,&(ids->nd_token)); + } + return df; +} + Import(ids, idn, local) register struct node *ids; struct node *idn; @@ -203,63 +245,51 @@ Import(ids, idn, local) identifiers defined in this module. */ register struct def *df; - struct def *df1 = 0; - int scope; - int kind; - int imp_kind; + struct scope *scope = enclosing(CurrentScope); + int kind = D_IMPORT; + int forwflag = 0; #define FROM_MODULE 0 #define FROM_ENCLOSING 1 + int imp_kind = FROM_ENCLOSING; struct def *lookfor(), *GetDefinitionModule(); - kind = D_IMPORT; - scope = enclosing(CurrentScope)->sc_scope; - - if (! idn) imp_kind = FROM_ENCLOSING; - else { + if (idn) { imp_kind = FROM_MODULE; if (local) { - df = lookfor(idn, enclosing(CurrentScope), 0); - if (df->df_kind == D_ERROR) { + df = lookfor(idn, scope, 0); + switch(df->df_kind) { + case D_ERROR: /* The module from which the import was done is not yet declared. I'm not sure if I must accept this, but for the time being I will. ??? */ - df->df_scope = scope; - df->df_kind = D_FORWMODULE; - open_scope(CLOSEDSCOPE, 0); - df->for_scope = CurrentScope->sc_scope; - df->for_node = MkNode(Name, NULLNODE, - NULLNODE, &(idn->nd_token)); - close_scope(); - df1 = df; - } - } - else df = GetDefinitionModule(idn->nd_IDF); - - if (!(df->df_kind & (D_MODULE|D_FORWMODULE))) { - /* enter all "ids" with type D_ERROR */ - kind = D_ERROR; - if (df->df_kind != D_ERROR) { + scope = ForwModule(df, idn); + forwflag = 1; + break; + case D_FORWMODULE: + scope = df->for_scope; + break; + case D_MODULE: + scope = df->mod_scope; + break; + default: + kind = D_ERROR; node_error(idn, "identifier \"%s\" does not represent a module", idn->nd_IDF->id_text); + break; } } - else scope = df->mod_scope; + else scope = GetDefinitionModule(idn->nd_IDF)->mod_scope; + FreeNode(idn); } idn = ids; while (ids) { if (imp_kind == FROM_MODULE) { - if (df1 != 0) { - open_scope(CLOSEDSCOPE, df1->mod_scope); - df = define(ids->nd_IDF, - CurrentScope, - D_FORWARD); - df->for_node = MkNode(Name, NULLNODE, - NULLNODE, &(ids->nd_token)); - close_scope(0); + if (forwflag) { + df = ForwDef(ids, scope); } else if (!(df = lookup(ids->nd_IDF, scope))) { node_error(ids, "identifier \"%s\" not declared in qualifying module", @@ -272,29 +302,22 @@ ids->nd_IDF->id_text); } } else { - if (local) { - df = lookfor(ids, enclosing(CurrentScope), 0); - } else df = GetDefinitionModule(ids->nd_IDF); - if (df->df_kind == D_ERROR) { - /* It was not yet defined in the enclosing - scope. - */ - df->df_kind = D_FORWARD; - df->for_node = MkNode(Name, NULLNODE, NULLNODE, - &(ids->nd_token)); - } + if (local) df = ForwDef(ids, scope); + else df = GetDefinitionModule(ids->nd_IDF); } + 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 == T_ENUMERATION) { - /* Also import all enumeration literals */ - exprt_literals(df->df_type->enm_enums, - CurrentScope); + /* Also import all enumeration literals + */ + exprt_literals(df->df_type->enm_enums, CurrentScope); } ids = ids->next; } + FreeNode(idn); } @@ -305,9 +328,9 @@ exprt_literals(df, toscope) /* A list of enumeration literals is exported. This is implemented as an import from the scope "toscope". */ - DO_DEBUG(2, debug("enumeration import:")); + DO_DEBUG(3, debug("enumeration import:")); while (df) { - DO_DEBUG(2, debug(df->df_idf->id_text)); + DO_DEBUG(3, debug(df->df_idf->id_text)); define(df->df_idf, toscope, D_IMPORT)->imp_def = df; df = df->enm_next; } @@ -353,3 +376,11 @@ RemFromId(df) df1->next = df->next; } } + +#ifdef DEBUG +PrDef(df) + register struct def *df; +{ + debug("name: %s, kind: %d", df->df_idf->id_text, df->df_kind); +} +#endif DEBUG diff --git a/lang/m2/comp/defmodule.c b/lang/m2/comp/defmodule.c index 8dd739a0f..7a2611135 100644 --- a/lang/m2/comp/defmodule.c +++ b/lang/m2/comp/defmodule.c @@ -49,7 +49,7 @@ GetDefinitionModule(id) */ struct def *df; - df = lookup(id, GlobalScope->sc_scope); + df = lookup(id, GlobalScope); if (!df) { /* Read definition module. Make an exception for SYSTEM. */ @@ -60,7 +60,7 @@ GetDefinitionModule(id) GetFile(id->id_text); DefModule(); } - df = lookup(id, GlobalScope->sc_scope); + df = lookup(id, GlobalScope); } assert(df != 0 && df->df_kind == D_MODULE); return df; diff --git a/lang/m2/comp/enter.c b/lang/m2/comp/enter.c index 52380bc3a..4c9e14b7d 100644 --- a/lang/m2/comp/enter.c +++ b/lang/m2/comp/enter.c @@ -35,10 +35,11 @@ Enter(name, kind, type, pnam) return df; } -EnterIdList(idlist, kind, flags, type, scope) +EnterIdList(idlist, kind, flags, type, scope, addr) register struct node *idlist; struct type *type; struct scope *scope; + arith *addr; { /* Put a list of identifiers in the symbol table. They all have kind "kind", and type "type", and are put @@ -50,11 +51,29 @@ EnterIdList(idlist, kind, flags, type, scope) register struct def *df; struct def *first = 0, *last = 0; int assval = 0; + arith off; while (idlist) { df = define(idlist->nd_IDF, scope, kind); df->df_type = type; df->df_flags |= flags; + if (addr) { + if (*addr >= 0) { + off = align(*addr, type->tp_align); + *addr = off + type->tp_size; + } + else { + off = -align(-*addr, type->tp_align); + *addr = off - type->tp_size; + } + if (kind == D_VARIABLE) { + df->var_off = off; + } + else { + assert(kind == D_FIELD); + df->fld_off = off; + } + } if (kind == D_ENUM) { if (!first) first = df; df->enm_val = assval++; @@ -72,6 +91,45 @@ EnterIdList(idlist, kind, flags, type, scope) } } +EnterVarList(IdList, type, local) + register struct node *IdList; + struct type *type; +{ + register struct def *df; + struct scope *scope; + + if (local) { + /* Find the closest enclosing open scope. This + is the procedure that we are dealing with + */ + scope = CurrentScope; + while (scope->sc_scopeclosed) scope = scope->next; + } + + while (IdList) { + df = define(IdList->nd_IDF, CurrentScope, D_VARIABLE); + df->df_type = type; + if (IdList->nd_left) { + df->var_addrgiven = 1; + if (IdList->nd_left->nd_type != card_type) { +node_error(IdList->nd_left,"Illegal type for address"); + } + df->var_off = IdList->nd_left->nd_INT; + } + else if (local) { + arith off; + + /* add aligned size of variable to the offset + */ + off = scope->sc_off - type->tp_size; + off = -align(-off, type->tp_align); + df->var_off = off; + scope->sc_off = off; + } + IdList = IdList->nd_right; + } +} + struct def * lookfor(id, scope, give_error) struct node *id; @@ -86,7 +144,7 @@ lookfor(id, scope, give_error) register struct scope *sc = scope; while (sc) { - df = lookup(id->nd_IDF, sc->sc_scope); + df = lookup(id->nd_IDF, sc); if (df) return df; sc = nextvisible(sc); } diff --git a/lang/m2/comp/expression.g b/lang/m2/comp/expression.g index dfe210ba8..75655c90c 100644 --- a/lang/m2/comp/expression.g +++ b/lang/m2/comp/expression.g @@ -22,9 +22,7 @@ number(struct node **p;) struct type *tp; } : [ - INTEGER { tp = dot.TOK_INT <= max_int ? - intorcard_type : card_type; - } + INTEGER { tp = numtype; } | REAL { tp = real_type; } ] { *p = MkNode(Value, NULLNODE, NULLNODE, &dot); diff --git a/lang/m2/comp/main.c b/lang/m2/comp/main.c index 08632c06b..a66d0aa85 100644 --- a/lang/m2/comp/main.c +++ b/lang/m2/comp/main.c @@ -74,7 +74,7 @@ Compile(src) if (options['L']) LexScan(); else { #endif DEBUG - (void) open_scope(CLOSEDSCOPE, 0); + (void) open_scope(CLOSEDSCOPE); GlobalScope = CurrentScope; CompUnit(); #ifdef DEBUG @@ -192,7 +192,7 @@ PROCEDURE NEWPROCESS(P:PROC; A:ADDRESS; n:CARDINAL; VAR p1:ADDRESS);\n\ PROCEDURE TRANSFER(VAR p1,p2:ADDRESS);\n\ END SYSTEM.\n"; - open_scope(CLOSEDSCOPE, 0); + open_scope(CLOSEDSCOPE); (void) Enter("WORD", D_TYPE, word_type, 0); (void) Enter("ADDRESS", D_TYPE, address_type, 0); (void) Enter("ADR", D_PROCEDURE, std_type, S_ADR); @@ -202,7 +202,7 @@ END SYSTEM.\n"; } SYSTEMModule = 1; DefModule(); - close_scope(); + close_scope(0); SYSTEMModule = 0; } diff --git a/lang/m2/comp/program.g b/lang/m2/comp/program.g index 3ff352b20..e3c6bb787 100644 --- a/lang/m2/comp/program.g +++ b/lang/m2/comp/program.g @@ -20,7 +20,6 @@ static int DEFofIMPL = 0; /* Flag indicating that we are currently implementation module currently being compiled */ -static struct def *impl_df; } /* The grammar as given by Wirth is already almost LL(1); the @@ -50,10 +49,10 @@ ModuleDeclaration id = dot.TOK_IDF; df = define(id, CurrentScope, D_MODULE); if (!df->mod_scope) { - open_scope(CLOSEDSCOPE, 0); - df->mod_scope = CurrentScope->sc_scope; + open_scope(CLOSEDSCOPE); + df->mod_scope = CurrentScope; } - else open_scope(CLOSEDSCOPE, df->mod_scope); + else CurrentScope = df->mod_scope; df->df_type = standard_type(T_RECORD, 0, (arith) 0); df->df_type->rec_scope = df->mod_scope; @@ -123,8 +122,8 @@ DefinitionModule DEFINITION MODULE IDENT { id = dot.TOK_IDF; df = define(id, GlobalScope, D_MODULE); - if (!SYSTEMModule) open_scope(CLOSEDSCOPE, 0); - df->mod_scope = CurrentScope->sc_scope; + if (!SYSTEMModule) open_scope(CLOSEDSCOPE); + df->mod_scope = CurrentScope; df->df_type = standard_type(T_RECORD, 0, (arith) 0); df->df_type->rec_scope = df->mod_scope; DefinitionModule = 1; @@ -144,7 +143,6 @@ DefinitionModule implementation module being compiled */ RemImports(&(CurrentScope->sc_def)); - impl_df = CurrentScope->sc_def; } df = CurrentScope->sc_def; while (df) { @@ -174,7 +172,8 @@ definition The export is said to be opaque. It is restricted to pointer types. */ - { df->df_kind = D_HIDDEN; } + { df->df_kind = D_HIDDEN; + } ] ';' ]* @@ -188,20 +187,19 @@ ProgramModule(int state;) { struct idf *id; struct def *df, *GetDefinitionModule(); - int scope = 0; + struct scope *scope = 0; } : MODULE IDENT { id = dot.TOK_IDF; if (state == IMPLEMENTATION) { - DEFofIMPL = 1; - df = GetDefinitionModule(id); - scope = df->mod_scope; - DEFofIMPL = 0; + DEFofIMPL = 1; + df = GetDefinitionModule(id); + CurrentScope = df->mod_scope; + DEFofIMPL = 0; + DefinitionModule = 0; } - DefinitionModule = 0; - open_scope(CLOSEDSCOPE, scope); - CurrentScope->sc_def = impl_df; + else open_scope(CLOSEDSCOPE); } priority? ';' import(0)* diff --git a/lang/m2/comp/scope.C b/lang/m2/comp/scope.C index e7a0fcf74..ca6086823 100644 --- a/lang/m2/comp/scope.C +++ b/lang/m2/comp/scope.C @@ -14,40 +14,28 @@ static char *RcsId = "$Header$"; #include "node.h" #include "debug.h" -static int maxscope; /* maximum assigned scope number */ - -struct scope *CurrentScope, *GlobalScope; +struct scope *CurrentScope, *PervasiveScope, *GlobalScope; /* STATICALLOCDEF "scope" */ -open_scope(scopetype, scope) +open_scope(scopetype) { /* Open a scope that is either open (automatic imports) or closed. - A closed scope is handled by adding an extra entry to the list - with scope number 0. This has two purposes: it makes scope 0 - visible, and it marks the end of a visibility list. - Scope 0 is the pervasive scope, the one that is always visible. - A disadvantage of this method is that we cannot open scope 0 - explicitly. */ register struct scope *sc = new_scope(); register struct scope *sc1; - sc->sc_scope = scope == 0 ? ++maxscope : scope; + assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE); + sc->sc_scopeclosed = scopetype == CLOSEDSCOPE; sc->sc_forw = 0; sc->sc_def = 0; - assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE); + sc->sc_off = 0; + sc->next = 0; DO_DEBUG(1, debug("Opening a %s scope", scopetype == OPENSCOPE ? "open" : "closed")); - sc1 = CurrentScope; - if (scopetype == CLOSEDSCOPE) { - sc1 = new_scope(); - sc1->sc_scope = 0; /* Pervasive scope nr */ - sc1->sc_forw = 0; - sc1->sc_def = 0; - sc1->next = CurrentScope; + if (CurrentScope != PervasiveScope) { + sc->next = CurrentScope; } - sc->next = sc1; CurrentScope = sc; } @@ -55,18 +43,14 @@ init_scope() { register struct scope *sc = new_scope(); - sc->sc_scope = 0; + sc->sc_scopeclosed = 0; sc->sc_forw = 0; sc->sc_def = 0; + sc->next = 0; + PervasiveScope = sc; CurrentScope = sc; } -int -uniq_scope() -{ - return ++maxscope; -} - struct forwards { struct forwards *next; struct node fo_tok; @@ -92,73 +76,67 @@ Forward(tk, ptp) CurrentScope->sc_forw = f; } -close_scope(flag) +static +chk_proc(df) + register struct def *df; { - /* Close a scope. If "flag" is set, check for forward declarations, - either POINTER declarations, or EXPORTs, or forward references - to MODULES + /* Called at scope closing. Check all definitions, and if one + is a D_PROCHEAD, the procedure was not defined */ - register struct scope *sc = CurrentScope; - register struct def *df, *dfback = 0; - - assert(sc != 0); - DO_DEBUG(1, debug("Closing a scope")); - - if (flag) { - if (sc->sc_forw) rem_forwards(sc->sc_forw); - df = sc->sc_def; - while(df) { - if (flag & SC_CHKPROC) { - if (df->df_kind == D_PROCHEAD) { - /* A not defined procedure - */ + while (df) { + if (df->df_kind == D_PROCHEAD) { + /* A not defined procedure + */ node_error(df->for_node, "procedure \"%s\" not defined", df->df_idf->id_text); - FreeNode(df->for_node); - } + FreeNode(df->for_node); + } + df = df->df_nextinscope; + } +} + +static +chk_forw(pdf) + register struct def **pdf; +{ + /* Called at scope close. Look for all forward definitions and + if the scope was a closed scope, give an error message for + them, and otherwise move them to the enclosing scope. + */ + while (*pdf) { + if ((*pdf)->df_kind & (D_FORWARD|D_FORWMODULE)) { + /* These definitions must be found in + the enclosing closed scope, which of course + may be the scope that is now closed! + */ + struct def *df1 = (*pdf)->df_nextinscope; + + if (scopeclosed(CurrentScope)) { + /* Indeed, the scope was a closed + scope, so give error message + */ +node_error((*pdf)->for_node, "identifier \"%s\" has not been declared", +(*pdf)->df_idf->id_text); + FreeNode((*pdf)->for_node); + pdf = &(*pdf)->df_nextinscope; } - if ((flag & SC_CHKFORW) && - df->df_kind & (D_FORWARD|D_FORWMODULE)) { - /* These definitions must be found in - the enclosing closed scope, which of course - may be the scope that is now closed! + else { /* This scope was an open scope. + Maybe the definitions are in the + enclosing scope? */ - struct def *df1 = df->df_nextinscope; - - if (scopeclosed(CurrentScope)) { - /* Indeed, the scope was a closed - scope, so give error message - */ -node_error(df->for_node, "identifier \"%s\" not declared", df->df_idf->id_text); - FreeNode(df->for_node); - dfback = df; - } - else { - /* This scope was an open scope. - Maybe the definitions are in the - enclosing scope? - */ - struct scope *sc; - - sc = enclosing(CurrentScope); - df->df_nextinscope = sc->sc_def; - sc->sc_def = df; - df->df_scope = sc->sc_scope; - if (dfback) dfback->df_nextinscope = df1; - else sc->sc_def = df1; + struct scope *sc; + + sc = enclosing(CurrentScope); + if ((*pdf)->df_kind == D_FORWMODULE) { + (*pdf)->for_scope->next = sc; } - df = df1; - } - else { - dfback = df; - df = df->df_nextinscope; + (*pdf)->df_nextinscope = sc->sc_def; + sc->sc_def = *pdf; + (*pdf)->df_scope = sc; + *pdf = df1; } } + else pdf = &(*pdf)->df_nextinscope; } - - if (sc->next && (sc->next->sc_scope == 0)) { - sc = sc->next; - } - CurrentScope = sc->next; } static @@ -182,3 +160,35 @@ rem_forwards(fo) free_forwards(f); } } + +close_scope(flag) +{ + /* Close a scope. If "flag" is set, check for forward declarations, + either POINTER declarations, or EXPORTs, or forward references + to MODULES + */ + register struct scope *sc = CurrentScope; + + assert(sc != 0); + DO_DEBUG(1, debug("Closing a scope")); + + if (flag) { + if (sc->sc_forw) rem_forwards(sc->sc_forw); + DO_DEBUG(2, PrScopeDef(sc->sc_def)); + if (flag & SC_CHKPROC) chk_proc(sc->sc_def); + if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def)); + } + CurrentScope = sc->next; +} + +#ifdef DEBUG +PrScopeDef(df) + register struct def *df; +{ + debug("List of definitions in currently ended scope:"); + while (df) { + PrDef(df); + df = df->df_nextinscope; + } +} +#endif diff --git a/lang/m2/comp/scope.h b/lang/m2/comp/scope.h index e009ccf7a..3dc7b4413 100644 --- a/lang/m2/comp/scope.h +++ b/lang/m2/comp/scope.h @@ -16,16 +16,15 @@ struct scope { struct scope *next; struct forwards *sc_forw; struct def *sc_def; /* list of definitions in this scope */ - int sc_scope; /* The scope number. Scope number 0 indicates - both the pervasive scope and the end of a - visibility range - */ + arith sc_off; /* offsets of variables in this scope */ + char sc_scopeclosed; /* flag indicating closed or open scope */ }; extern struct scope *CurrentScope, + *PervasiveScope, *GlobalScope; -#define nextvisible(x) ((x)->sc_scope ? (x)->next : (struct scope *) 0) -#define scopeclosed(x) ((x)->next->sc_scope == 0) -#define enclosing(x) (scopeclosed(x) ? (x)->next->next : (x)->next) +#define enclosing(x) ((x)->next) +#define scopeclosed(x) ((x)->sc_scopeclosed) +#define nextvisible(x) (scopeclosed(x) ? PervasiveScope : enclosing(x)) diff --git a/lang/m2/comp/statement.g b/lang/m2/comp/statement.g index d9eb42cda..36596be0d 100644 --- a/lang/m2/comp/statement.g +++ b/lang/m2/comp/statement.g @@ -6,12 +6,15 @@ static char *RcsId = "$Header$"; #include #include "LLlex.h" #include "node.h" + +static int loopcount = 0; /* Count nested loops */ } -statement +statement(struct node **pnd;) { - struct node *nd1, *nd2 = 0; + struct node *nd1; } : + { *pnd = 0; } [ /* * This part is not in the reference grammar. The reference grammar @@ -19,38 +22,45 @@ statement * but this gives LL(1) conflicts */ designator(&nd1) - [ - ActualParameters(&nd2)? - { nd1 = MkNode(Call, nd1, nd2, &dot); + [ { nd1 = MkNode(Call, nd1, NULLNODE, &dot); nd1->nd_symb = '('; } + ActualParameters(&(nd1->nd_right))? | BECOMES { nd1 = MkNode(Stat, nd1, NULLNODE, &dot); } expression(&(nd1->nd_right)) ] + { *pnd = nd1; } /* * end of changed part */ | - IfStatement + IfStatement(pnd) | - CaseStatement + CaseStatement(pnd) | - WhileStatement + WhileStatement(pnd) | - RepeatStatement + RepeatStatement(pnd) | - LoopStatement + { loopcount++; } + LoopStatement(pnd) + { loopcount--; } | - ForStatement + ForStatement(pnd) | - WithStatement + WithStatement(pnd) | EXIT + { if (!loopcount) { + error("EXIT not in a LOOP"); + } + *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); + } | - RETURN + RETURN { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); } [ - expression(&nd1) + expression(&((*pnd)->nd_right)) ]? ]? ; @@ -67,66 +77,132 @@ ProcedureCall: ; */ -StatementSequence: - statement [ ';' statement ]* +StatementSequence(struct node **pnd;): + statement(pnd) + [ + ';' { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); + pnd = &((*pnd)->nd_right); + } + statement(pnd) + ]* ; -IfStatement +IfStatement(struct node **pnd;) { - struct node *nd1; + register struct node *nd; } : - IF expression(&nd1) THEN StatementSequence - [ ELSIF expression(&nd1) THEN StatementSequence ]* - [ ELSE StatementSequence ]? + IF { nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); + *pnd = nd; + } + expression(&(nd->nd_left)) + THEN { nd = MkNode(Link, NULLNODE, NULLNODE, &dot); + (*pnd)->nd_right = nd; + } + StatementSequence(&(nd->nd_left)) + [ + ELSIF { nd->nd_right = MkNode(Stat,NULLNODE,NULLNODE,&dot); + nd = nd->nd_right; + nd->nd_symb = IF; + } + expression(&(nd->nd_left)) + THEN { nd->nd_right = MkNode(Link,NULLNODE,NULLNODE,&dot); + nd = nd->nd_right; + } + StatementSequence(&(nd->nd_left)) + ]* + [ + ELSE + StatementSequence(&(nd->nd_right)) + ]? END ; -CaseStatement +CaseStatement(struct node **pnd;) { - struct node *nd; + register struct node *nd; + struct type *tp = 0; } : - CASE expression(&nd) OF case [ '|' case ]* - [ ELSE StatementSequence ]? + CASE { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); } + expression(&(nd->nd_left)) + OF + case(&(nd->nd_right), &tp) + { nd = nd->nd_right; } + [ + '|' + case(&(nd->nd_right), &tp) + { nd = nd->nd_right; } + ]* + [ ELSE StatementSequence(&(nd->nd_right)) ]? END ; -case: - [ CaseLabelList ':' StatementSequence ]? +case(struct node **pnd; struct type **ptp;) : + { *pnd = 0; } + [ CaseLabelList(ptp/*,pnd*/) + ':' { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); } + StatementSequence(&((*pnd)->nd_right)) + ]? /* This rule is changed in new modula-2 */ + { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); + (*pnd)->nd_symb = '|'; + } ; -WhileStatement +WhileStatement(struct node **pnd;) { - struct node *nd; + register struct node *nd; }: - WHILE expression(&nd) DO StatementSequence END + WHILE { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); } + expression(&(nd->nd_left)) + DO + StatementSequence(&(nd->nd_right)) + END ; -RepeatStatement +RepeatStatement(struct node **pnd;) { - struct node *nd; + register struct node *nd; }: - REPEAT StatementSequence UNTIL expression(&nd) + REPEAT { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); } + StatementSequence(&(nd->nd_left)) + UNTIL + expression(&(nd->nd_right)) ; -ForStatement +ForStatement(struct node **pnd;) { - struct node *nd1, *nd2, *nd3; + register struct node *nd; }: - FOR IDENT - BECOMES expression(&nd1) - TO expression(&nd2) - [ BY ConstExpression(&nd3) ]? - DO StatementSequence END + FOR { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); } + IDENT { nd = MkNode(Name, NULLNODE, NULLNODE, &dot); } + BECOMES { nd = MkNode(BECOMES, nd, NULLNODE, &dot); } + expression(&(nd->nd_right)) + TO { (*pnd)->nd_left=nd=MkNode(Link,nd,NULLNODE,&dot); } + expression(&(nd->nd_right)) + [ + BY { nd->nd_right=MkNode(Link,NULLNODE,nd->nd_right,&dot); + } + ConstExpression(&(nd->nd_right->nd_left)) + | + ] + DO + StatementSequence(&((*pnd)->nd_right)) + END ; -LoopStatement: - LOOP StatementSequence END +LoopStatement(struct node **pnd;): + LOOP { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); } + StatementSequence(&((*pnd)->nd_right)) + END ; -WithStatement +WithStatement(struct node **pnd;) { - struct node *nd; + register struct node *nd; }: - WITH designator(&nd) DO StatementSequence END + WITH { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); } + designator(&(nd->nd_left)) + DO + StatementSequence(&(nd->nd_right)) + END ; diff --git a/lang/m2/comp/type.H b/lang/m2/comp/type.H index 8abf6981c..38c8a96c9 100644 --- a/lang/m2/comp/type.H +++ b/lang/m2/comp/type.H @@ -38,8 +38,8 @@ struct array { }; struct record { - int rc_scope; /* Scope number of this record */ - /* Members are in the symbol table */ + struct scope *rc_scope; /* scope of this record */ + /* members are in the symbol table */ #define rec_scope tp_value.tp_record.rc_scope }; @@ -71,6 +71,7 @@ struct type { #define T_INTORCARD (T_INTEGER|T_CARDINAL) #define T_DISCRETE (T_ENUMERATION|T_INTORCARD|T_CHAR) #define T_NUMERIC (T_INTORCARD|T_REAL) +#define T_INDEX (T_ENUMERATION|T_CHAR|T_SUBRANGE) int tp_align; /* alignment requirement of this type */ arith tp_size; /* size of this type */ union { diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 7efa40a44..5792379ea 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -151,24 +151,6 @@ init_types() error_type = standard_type(T_CHAR, 1, (arith) 1); } -int -has_selectors(df) - register struct def *df; -{ - - switch(df->df_kind) { - case D_MODULE: - return df->df_value.df_module.mo_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; -} - /* Create a parameterlist of a procedure and return a pointer to it. "ids" indicates the list of identifiers, "tp" their type, and "VARp" is set when the parameters are VAR-parameters. @@ -226,6 +208,8 @@ chk_basesubrange(tp, base) error("Specified base does not conform"); } tp->next = base; + tp->tp_size = base->tp_size; + tp->tp_align = base->tp_align; } struct type * @@ -236,7 +220,7 @@ subr_type(lb, ub) indicated by "lb" and "ub", but first perform some checks */ - register struct type *tp = lb->nd_type; + register struct type *tp = lb->nd_type, *res; if (!TstCompat(lb->nd_type, ub->nd_type)) { node_error(ub, "Types of subrange bounds not compatible"); @@ -264,11 +248,13 @@ subr_type(lb, ub) /* Now construct resulting type */ - tp = construct_type(T_SUBRANGE, tp); - tp->sub_lb = lb->nd_INT; - tp->sub_ub = ub->nd_INT; + res = construct_type(T_SUBRANGE, tp); + res->sub_lb = lb->nd_INT; + res->sub_ub = ub->nd_INT; + res->tp_size = tp->tp_size; + res->tp_align = tp->tp_align; DO_DEBUG(2,debug("Creating subrange type %ld-%ld", (long)lb->nd_INT,(long)ub->nd_INT)); - return tp; + return res; } #define MAX_SET 1024 /* ??? Maximum number of elements in a set */ @@ -302,3 +288,71 @@ set_type(tp) tp->tp_size = align(((ub - lb) + 7)/8, wrd_align); return tp; } + +ArraySizes(tp) + register struct type *tp; +{ + /* Assign sizes to an array type + */ + arith elem_size; + register struct type *itype = tp->next; /* the index type */ + + if (tp->arr_elem->tp_fund == T_ARRAY) { + ArraySizes(tp->arr_elem); + } + + elem_size = align(tp->arr_elem->tp_size, tp->arr_elem->tp_align); + tp->tp_align = tp->arr_elem->tp_align; + + if (! (itype->tp_fund & T_INDEX)) { + error("Illegal index type"); + tp->tp_size = 0; + return; + } + + switch(itype->tp_fund) { + case T_SUBRANGE: + tp->arr_lb = itype->sub_lb; + tp->arr_ub = itype->sub_ub; + tp->tp_size = elem_size * (itype->sub_ub - itype->sub_lb + 1); + break; + case T_CHAR: + case T_ENUMERATION: + tp->arr_lb = 0; + tp->arr_ub = itype->enm_ncst - 1; + tp->tp_size = elem_size * itype->enm_ncst; + break; + default: + assert(0); + } + /* ??? overflow checking ??? */ +} + +int +gcd(m, n) + register int m, n; +{ + /* Greatest Common Divisor + */ + register int r; + + while (n) { + r = m % n; + m = n; + n = r; + } + return m; +} + +int +lcm(m, n) + register int m, n; +{ + /* Least Common Multiple + */ + while (m != n) { + if (m < n) m = m + m; + else n = n + n; + } + return n; /* or m */ +} diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c index 9c97fdd2c..7fef09274 100644 --- a/lang/m2/comp/typequiv.c +++ b/lang/m2/comp/typequiv.c @@ -2,6 +2,9 @@ static char *RcsId = "$Header$"; +/* Routines for testing type equivalence, type compatibility, and + assignment compatibility +*/ #include #include #include "type.h" @@ -15,8 +18,8 @@ TstTypeEquiv(tp1, tp2) from the fact that for some procedures two declarations may be given: one in the specification module and one in the definition module. - A related problem is that two dynamic arrays with the - same base type are also equivalent. + A related problem is that two dynamic arrays with + equivalent base types are also equivalent. */ return tp1 == tp2 @@ -66,8 +69,7 @@ TstProcEquiv(tp1, tp2) p1 = p1->next; p2 = p2->next; } - if (p1 != p2) return 0; - return 1; + return p1 == p2; } int