From c66066a91faa8dcdc448ba8dc47725cab0333224 Mon Sep 17 00:00:00 2001 From: ceriel Date: Mon, 13 Jul 1987 10:30:37 +0000 Subject: [PATCH] fixes --- lang/m2/comp/chk_expr.c | 77 ++++++++++++++++++----------------------- lang/m2/comp/code.c | 9 ++--- lang/m2/comp/declar.g | 31 +++++++++-------- lang/m2/comp/desig.c | 6 ++-- lang/m2/comp/options.c | 2 +- lang/m2/comp/type.c | 2 -- lang/m2/comp/walk.c | 45 ++++++++++++++---------- 7 files changed, 86 insertions(+), 86 deletions(-) diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c index 6c8a7c99f..612204fa9 100644 --- a/lang/m2/comp/chk_expr.c +++ b/lang/m2/comp/chk_expr.c @@ -59,15 +59,11 @@ ChkVariable(expp) if (! ChkDesignator(expp)) return 0; - if (expp->nd_class == Def && - !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) { + if ((expp->nd_class == Def || expp->nd_class == LinkDef) && + !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) { Xerror(expp, "variable expected", expp->nd_def); return 0; } - if (expp->nd_class == Value) { - node_error(expp, "variable expected"); - return 0; - } return 1; } @@ -187,8 +183,7 @@ ChkLinkOrName(expp) if (! ChkDesignator(left)) return 0; - if (left->nd_class == Def && - (left->nd_type->tp_fund != T_RECORD || + if ((left->nd_type->tp_fund != T_RECORD || !(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD)) ) ) { @@ -216,8 +211,7 @@ Xerror(expp, "not exported from qualifying module", df); } } - if (left->nd_class == Def && - left->nd_def->df_kind == D_MODULE) { + if (left->nd_def->df_kind == D_MODULE) { expp->nd_class = Def; FreeNode(left); expp->nd_left = 0; @@ -227,6 +221,20 @@ Xerror(expp, "not exported from qualifying module", df); assert(expp->nd_class == Def); + return df->df_kind != D_ERROR; +} + +STATIC int +ChkExLinkOrName(expp) + register struct node *expp; +{ + /* Check either an ID or an ID.ID [.ID]* occurring in an + expression. + */ + register struct def *df; + + if (! ChkLinkOrName(expp)) return 0; + df = expp->nd_def; if (df->df_kind & (D_ENUM | D_CONST)) { @@ -245,21 +253,6 @@ Xerror(expp, "not exported from qualifying module", df); expp->nd_lineno = ln; } } - return df->df_kind != D_ERROR; -} - -STATIC int -ChkExLinkOrName(expp) - register struct node *expp; -{ - /* Check either an ID or an ID.ID [.ID]* occurring in an - expression. - */ - register struct def *df; - - if (! ChkLinkOrName(expp)) return 0; - if (expp->nd_class != Def) return 1; - df = expp->nd_def; if (!(df->df_kind & D_VALUE)) { Xerror(expp, "value expected", df); @@ -380,13 +373,13 @@ ChkSet(expp) /* A type was given. Check it out */ if (! ChkDesignator(nd)) return 0; - assert(nd->nd_class == Def); + assert(nd->nd_class == Def || nd->nd_class == LinkDef); df = nd->nd_def; if (!is_type(df) || (df->df_type->tp_fund != T_SET)) { if (df->df_kind != D_ERROR) { - Xerror(nd, "not a set type", df); + Xerror(nd, "not a SET type", df); } return 0; } @@ -454,7 +447,7 @@ getarg(argp, bases, designator, edf) return 0; } - if (designator && left->nd_class == Def) { + if (designator && (left->nd_class==Def || left->nd_class==LinkDef)) { left->nd_def->df_flags |= D_NOREG; } @@ -917,9 +910,9 @@ ChkStandard(expp, left) register struct def *edf; int std; - assert(left->nd_class == Def); - std = left->nd_def->df_value.df_stdname; + assert(left->nd_class == Def || left->nd_class == LinkDef); edf = left->nd_def; + std = edf->df_value.df_stdname; switch(std) { case S_ABS: @@ -1053,30 +1046,26 @@ ChkStandard(expp, left) Xerror(left, "pointer variable expected", edf); return 0; } - if (left->nd_class == Def) { - left->nd_def->df_flags |= D_NOREG; - } /* Now, make it look like a call to ALLOCATE or DEALLOCATE */ { struct token dt; - register struct token *tk = &dt; struct node *nd; - tk->TOK_INT = PointedtoType(left->nd_type)->tp_size; - tk->tk_symb = INTEGER; - tk->tk_lineno = left->nd_lineno; - nd = MkLeaf(Value, tk); + dt.TOK_INT = PointedtoType(left->nd_type)->tp_size; + dt.tk_symb = INTEGER; + dt.tk_lineno = left->nd_lineno; + nd = MkLeaf(Value, &dt); nd->nd_type = card_type; - tk->tk_symb = ','; - arg->nd_right = MkNode(Link, nd, NULLNODE, tk); + dt.tk_symb = ','; + arg->nd_right = MkNode(Link, nd, NULLNODE, &dt); /* Ignore other arguments to NEW and/or DISPOSE ??? */ FreeNode(expp->nd_left); - tk->tk_symb = IDENT; - tk->tk_lineno = expp->nd_left->nd_lineno; - tk->TOK_IDF = str2idf(std == S_NEW ? + dt.tk_symb = IDENT; + dt.tk_lineno = expp->nd_left->nd_lineno; + dt.TOK_IDF = str2idf(std == S_NEW ? "ALLOCATE" : "DEALLOCATE", 0); - expp->nd_left = MkLeaf(Name, tk); + expp->nd_left = MkLeaf(Name, &dt); } return ChkCall(expp); diff --git a/lang/m2/comp/code.c b/lang/m2/comp/code.c index 3318db043..59d2012bd 100644 --- a/lang/m2/comp/code.c +++ b/lang/m2/comp/code.c @@ -329,11 +329,12 @@ CodeCall(nd) } C_asp(left->nd_type->prc_nbpar); if (result_tp = ResultType(left->nd_type)) { + arith sz = WA(result_tp->tp_size); if (IsConstructed(result_tp)) { C_lfr(pointer_size); - C_loi(result_tp->tp_size); + C_loi(sz); } - else C_lfr(WA(result_tp->tp_size)); + else C_lfr(sz); } } @@ -395,8 +396,8 @@ CodeParameters(param, arg) if (left->nd_symb == STRING) { CodeString(left); } - else if (left->nd_class == Call) { - /* ouch! forgot about this one! */ + else if (left->nd_class == Call || left->nd_class == Value) { + /* ouch! forgot about these ones! */ arith tmp, TmpSpace(); CodePExpr(left); diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g index 0f235d7ce..ef3e75fc6 100644 --- a/lang/m2/comp/declar.g +++ b/lang/m2/comp/declar.g @@ -430,31 +430,34 @@ qualtype(struct type **ptp;) { *ptp = qualified_type(nd); } ; -ProcedureType(register struct type **ptp;) -{ - struct paramlist *pr = 0; - arith parmaddr = 0; -} -: - { *ptp = 0; } +ProcedureType(struct type **ptp;) : PROCEDURE [ - FormalTypeList(&pr, &parmaddr, ptp) - ]? - { *ptp = proc_type(*ptp, pr, parmaddr); } + FormalTypeList(ptp) + | + { *ptp = proc_type((struct type *) 0, + (struct paramlist *) 0, + (arith) 0); + } + ] ; -FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;): +FormalTypeList(struct type **ptp;) +{ + struct paramlist *pr = 0; + arith parmaddr = 0; +} : '(' [ - VarFormalType(ppr, parmaddr) + VarFormalType(&pr, &parmaddr) [ - ',' VarFormalType(ppr, parmaddr) + ',' VarFormalType(&pr, &parmaddr) ]* ]? ')' [ ':' qualtype(ptp) ]? + { *ptp = proc_type(*ptp, pr, parmaddr); } ; VarFormalType(struct paramlist **ppr; arith *parmaddr;) @@ -501,7 +504,7 @@ VariableDeclaration { EnterVarList(VarList, tp, proclevel > 0); } ; -IdentAddr(struct node **pnd;) : +IdentAddr(register struct node **pnd;) : IDENT { *pnd = MkLeaf(Name, &dot); } [ '[' ConstExpression(&((*pnd)->nd_left)) diff --git a/lang/m2/comp/desig.c b/lang/m2/comp/desig.c index 800b231da..42fb05949 100644 --- a/lang/m2/comp/desig.c +++ b/lang/m2/comp/desig.c @@ -254,7 +254,7 @@ CodeMove(rhs, left, rtp) if (lhs->dsg_kind == DSG_FIXED && lhs->dsg_offset % word_size == rhs->dsg_offset % word_size) { - register arith sz; + register int sz; arith size = tp->tp_size; while (size && (sz = (lhs->dsg_offset % word_size))) { @@ -262,8 +262,8 @@ CodeMove(rhs, left, rtp) boundaries */ if (sz < 0) sz = -sz; /* bloody '%' */ - while (word_size % sz) sz--; - CodeCopy(lhs, rhs, sz, &size); + while ((int) word_size % sz) sz--; + CodeCopy(lhs, rhs, (arith) sz, &size); } if (size > 3*dword_size) { /* Do a block move diff --git a/lang/m2/comp/options.c b/lang/m2/comp/options.c index 22b3104cb..725d2ba73 100644 --- a/lang/m2/comp/options.c +++ b/lang/m2/comp/options.c @@ -142,7 +142,7 @@ DoOption(text) case 'V' : /* set object sizes and alignment requirements */ { - register arith size; + register int size; register int align; char c; char *t; diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c index 4ecaf2714..0c90555dc 100644 --- a/lang/m2/comp/type.c +++ b/lang/m2/comp/type.c @@ -127,8 +127,6 @@ standard_type(fund, align, size) { register struct type *tp = new_type(); - if (align == 0) align = 1; - tp->tp_fund = fund; tp->tp_align = align; tp->tp_size = size; diff --git a/lang/m2/comp/walk.c b/lang/m2/comp/walk.c index ac94d47ed..de08abab2 100644 --- a/lang/m2/comp/walk.c +++ b/lang/m2/comp/walk.c @@ -19,6 +19,7 @@ #include #include #include +#include #include #include "def.h" @@ -184,20 +185,23 @@ WalkProcedure(procedure) func_type = tp = RemoveEqual(ResultType(procedure->df_type)); - if (tp && IsConstructed(tp)) { - /* The result type of this procedure is constructed. - The actual procedure will return a pointer to a global - data area in which the function result is stored. - Notice that this does make the code non-reentrant. - Here, we create the data area for the function result. - */ - func_res_label = ++data_label; - C_df_dlb(func_res_label); - C_bss_cst(tp->tp_size, (arith) 0, 0); + if (tp) { + func_res_size = WA(tp->tp_size); + if (IsConstructed(tp)) { + /* The result type of this procedure is constructed. + The actual procedure will return a pointer to a + global data area in which the function result is + stored. + Notice that this does make the code non-reentrant. + Here, we create the data area for the function + result. + */ + func_res_label = ++data_label; + C_df_dlb(func_res_label); + C_bss_cst(func_res_size, (arith) 0, 0); + } } - if (tp) func_res_size = WA(tp->tp_size); - /* Generate calls to initialization routines of modules defined within this procedure */ @@ -211,13 +215,14 @@ WalkProcedure(procedure) param; param = param->next) { if (! IsVarParam(param)) { - tp = TypeOfParam(param); + register struct type *TpParam = TypeOfParam(param); - if (! IsConformantArray(tp)) { - if (tp->tp_size < word_size) { + if (! IsConformantArray(TpParam)) { + if (TpParam->tp_size < word_size && + (int) word_size % (int) TpParam->tp_size == 0) { C_lol(param->par_def->var_off); C_lal(param->par_def->var_off); - C_sti(tp->tp_size); + C_sti(TpParam->tp_size); } } else { @@ -266,14 +271,18 @@ WalkProcedure(procedure) WalkNode(procedure->prc_body, NO_EXIT_LABEL); DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0)); + if (func_res_size) { + C_loc((arith) M2_NORESULT); + C_trp(); + C_asp(-func_res_size); + } C_df_ilb(RETURN_LABEL); /* label at end */ - tp = func_type; if (func_res_label) { /* Fill the data area reserved for the function result with the result */ C_lae_dlb(func_res_label, (arith) 0); - C_sti(tp->tp_size); + C_sti(func_res_size); if (StackAdjustment) { /* Remove copies of conformant arrays */ -- 2.34.1