d0p1/ack
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

fixes

Browse source
This commit is contained in:
ceriel 1987-07-13 10:30:37 +00:00
parent dc8d6ce37b
commit c66066a91f
7 changed files with 87 additions and 87 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

75
lang/m2/comp/chk_expr.c
View file

@ -59,15 +59,11 @@ ChkVariable(expp)
if (! ChkDesignator(expp)) return 0; if (! ChkDesignator(expp)) return 0;
if (expp->nd_class == Def && if ((expp->nd_class == Def || expp->nd_class == LinkDef) &&
!(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) { !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) {
Xerror(expp, "variable expected", expp->nd_def); Xerror(expp, "variable expected", expp->nd_def);
return 0; return 0;
} }
if (expp->nd_class == Value) {
node_error(expp, "variable expected");
return 0;
}
return 1; return 1;
} }
@ -187,8 +183,7 @@ ChkLinkOrName(expp)
if (! ChkDesignator(left)) return 0; if (! ChkDesignator(left)) return 0;
if (left->nd_class == Def && if ((left->nd_type->tp_fund != T_RECORD ||
(left->nd_type->tp_fund != T_RECORD ||
!(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD)) !(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 && if (left->nd_def->df_kind == D_MODULE) {
left->nd_def->df_kind == D_MODULE) {
expp->nd_class = Def; expp->nd_class = Def;
FreeNode(left); FreeNode(left);
expp->nd_left = 0; expp->nd_left = 0;
@ -227,6 +221,20 @@ Xerror(expp, "not exported from qualifying module", df);
assert(expp->nd_class == Def); 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; df = expp->nd_def;
if (df->df_kind & (D_ENUM | D_CONST)) { if (df->df_kind & (D_ENUM | D_CONST)) {
@ -245,21 +253,6 @@ Xerror(expp, "not exported from qualifying module", df);
expp->nd_lineno = ln; 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)) { if (!(df->df_kind & D_VALUE)) {
Xerror(expp, "value expected", df); Xerror(expp, "value expected", df);
@ -380,13 +373,13 @@ ChkSet(expp)
/* A type was given. Check it out /* A type was given. Check it out
*/ */
if (! ChkDesignator(nd)) return 0; if (! ChkDesignator(nd)) return 0;
assert(nd->nd_class == Def); assert(nd->nd_class == Def || nd->nd_class == LinkDef);
df = nd->nd_def; df = nd->nd_def;
if (!is_type(df) || if (!is_type(df) ||
(df->df_type->tp_fund != T_SET)) { (df->df_type->tp_fund != T_SET)) {
if (df->df_kind != D_ERROR) { if (df->df_kind != D_ERROR) {
Xerror(nd, "not a set type", df); Xerror(nd, "not a SET type", df);
} }
return 0; return 0;
} }
@ -454,7 +447,7 @@ getarg(argp, bases, designator, edf)
return 0; 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; left->nd_def->df_flags |= D_NOREG;
} }
@ -917,9 +910,9 @@ ChkStandard(expp, left)
register struct def *edf; register struct def *edf;
int std; int std;
assert(left->nd_class == Def); assert(left->nd_class == Def || left->nd_class == LinkDef);
std = left->nd_def->df_value.df_stdname;
edf = left->nd_def; edf = left->nd_def;
std = edf->df_value.df_stdname;
switch(std) { switch(std) {
case S_ABS: case S_ABS:
@ -1053,30 +1046,26 @@ ChkStandard(expp, left)
Xerror(left, "pointer variable expected", edf); Xerror(left, "pointer variable expected", edf);
return 0; 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 */ /* Now, make it look like a call to ALLOCATE or DEALLOCATE */
{ {
struct token dt; struct token dt;
register struct token *tk = &dt;
struct node *nd; struct node *nd;
tk->TOK_INT = PointedtoType(left->nd_type)->tp_size; dt.TOK_INT = PointedtoType(left->nd_type)->tp_size;
tk->tk_symb = INTEGER; dt.tk_symb = INTEGER;
tk->tk_lineno = left->nd_lineno; dt.tk_lineno = left->nd_lineno;
nd = MkLeaf(Value, tk); nd = MkLeaf(Value, &dt);
nd->nd_type = card_type; nd->nd_type = card_type;
tk->tk_symb = ','; dt.tk_symb = ',';
arg->nd_right = MkNode(Link, nd, NULLNODE, tk); arg->nd_right = MkNode(Link, nd, NULLNODE, &dt);
/* Ignore other arguments to NEW and/or DISPOSE ??? */ /* Ignore other arguments to NEW and/or DISPOSE ??? */
FreeNode(expp->nd_left); FreeNode(expp->nd_left);
tk->tk_symb = IDENT; dt.tk_symb = IDENT;
tk->tk_lineno = expp->nd_left->nd_lineno; dt.tk_lineno = expp->nd_left->nd_lineno;
tk->TOK_IDF = str2idf(std == S_NEW ? dt.TOK_IDF = str2idf(std == S_NEW ?
"ALLOCATE" : "DEALLOCATE", 0); "ALLOCATE" : "DEALLOCATE", 0);
expp->nd_left = MkLeaf(Name, tk); expp->nd_left = MkLeaf(Name, &dt);
} }
return ChkCall(expp); return ChkCall(expp);

9
lang/m2/comp/code.c
View file

@ -329,11 +329,12 @@ CodeCall(nd)
} }
C_asp(left->nd_type->prc_nbpar); C_asp(left->nd_type->prc_nbpar);
if (result_tp = ResultType(left->nd_type)) { if (result_tp = ResultType(left->nd_type)) {
arith sz = WA(result_tp->tp_size);
if (IsConstructed(result_tp)) { if (IsConstructed(result_tp)) {
C_lfr(pointer_size); 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) { if (left->nd_symb == STRING) {
CodeString(left); CodeString(left);
} }
else if (left->nd_class == Call) { else if (left->nd_class == Call || left->nd_class == Value) {
/* ouch! forgot about this one! */ /* ouch! forgot about these ones! */
arith tmp, TmpSpace(); arith tmp, TmpSpace();
CodePExpr(left); CodePExpr(left);

33
lang/m2/comp/declar.g
View file

@ -430,31 +430,34 @@ qualtype(struct type **ptp;)
{ *ptp = qualified_type(nd); } { *ptp = qualified_type(nd); }
; ;
ProcedureType(register struct type **ptp;) ProcedureType(struct type **ptp;) :
PROCEDURE
[
FormalTypeList(ptp)
|
{ *ptp = proc_type((struct type *) 0,
(struct paramlist *) 0,
(arith) 0);
}
]
;
FormalTypeList(struct type **ptp;)
{ {
struct paramlist *pr = 0; struct paramlist *pr = 0;
arith parmaddr = 0; arith parmaddr = 0;
} } :
:
{ *ptp = 0; }
PROCEDURE
[
FormalTypeList(&pr, &parmaddr, ptp)
]?
{ *ptp = proc_type(*ptp, pr, parmaddr); }
;
FormalTypeList(struct paramlist **ppr; arith *parmaddr; struct type **ptp;):
'(' '('
[ [
VarFormalType(ppr, parmaddr) VarFormalType(&pr, &parmaddr)
[ [
',' VarFormalType(ppr, parmaddr) ',' VarFormalType(&pr, &parmaddr)
]* ]*
]? ]?
')' ')'
[ ':' qualtype(ptp) [ ':' qualtype(ptp)
]? ]?
{ *ptp = proc_type(*ptp, pr, parmaddr); }
; ;
VarFormalType(struct paramlist **ppr; arith *parmaddr;) VarFormalType(struct paramlist **ppr; arith *parmaddr;)
@ -501,7 +504,7 @@ VariableDeclaration
{ EnterVarList(VarList, tp, proclevel > 0); } { EnterVarList(VarList, tp, proclevel > 0); }
; ;
IdentAddr(struct node **pnd;) : IdentAddr(register struct node **pnd;) :
IDENT { *pnd = MkLeaf(Name, &dot); } IDENT { *pnd = MkLeaf(Name, &dot); }
[ '[' [ '['
ConstExpression(&((*pnd)->nd_left)) ConstExpression(&((*pnd)->nd_left))

6
lang/m2/comp/desig.c
View file

@ -254,7 +254,7 @@ CodeMove(rhs, left, rtp)
if (lhs->dsg_kind == DSG_FIXED && if (lhs->dsg_kind == DSG_FIXED &&
lhs->dsg_offset % word_size == lhs->dsg_offset % word_size ==
rhs->dsg_offset % word_size) { rhs->dsg_offset % word_size) {
register arith sz; register int sz;
arith size = tp->tp_size; arith size = tp->tp_size;
while (size && (sz = (lhs->dsg_offset % word_size))) { while (size && (sz = (lhs->dsg_offset % word_size))) {
@ -262,8 +262,8 @@ CodeMove(rhs, left, rtp)
boundaries boundaries
*/ */
if (sz < 0) sz = -sz; /* bloody '%' */ if (sz < 0) sz = -sz; /* bloody '%' */
while (word_size % sz) sz--; while ((int) word_size % sz) sz--;
CodeCopy(lhs, rhs, sz, &size); CodeCopy(lhs, rhs, (arith) sz, &size);
} }
if (size > 3*dword_size) { if (size > 3*dword_size) {
/* Do a block move /* Do a block move

2
lang/m2/comp/options.c
View file

@ -142,7 +142,7 @@ DoOption(text)
case 'V' : /* set object sizes and alignment requirements */ case 'V' : /* set object sizes and alignment requirements */
{ {
register arith size; register int size;
register int align; register int align;
char c; char c;
char *t; char *t;

2
lang/m2/comp/type.c
View file

@ -127,8 +127,6 @@ standard_type(fund, align, size)
{ {
register struct type *tp = new_type(); register struct type *tp = new_type();
if (align == 0) align = 1;
tp->tp_fund = fund; tp->tp_fund = fund;
tp->tp_align = align; tp->tp_align = align;
tp->tp_size = size; tp->tp_size = size;

35
lang/m2/comp/walk.c
View file

@ -19,6 +19,7 @@
#include <em_label.h> #include <em_label.h>
#include <em_reg.h> #include <em_reg.h>
#include <em_code.h> #include <em_code.h>
#include <m2_traps.h>
#include <assert.h> #include <assert.h>
#include "def.h" #include "def.h"
@ -184,19 +185,22 @@ WalkProcedure(procedure)
func_type = tp = RemoveEqual(ResultType(procedure->df_type)); func_type = tp = RemoveEqual(ResultType(procedure->df_type));
if (tp && IsConstructed(tp)) { if (tp) {
func_res_size = WA(tp->tp_size);
if (IsConstructed(tp)) {
/* The result type of this procedure is constructed. /* The result type of this procedure is constructed.
The actual procedure will return a pointer to a global The actual procedure will return a pointer to a
data area in which the function result is stored. global data area in which the function result is
stored.
Notice that this does make the code non-reentrant. Notice that this does make the code non-reentrant.
Here, we create the data area for the function result. Here, we create the data area for the function
result.
*/ */
func_res_label = ++data_label; func_res_label = ++data_label;
C_df_dlb(func_res_label); C_df_dlb(func_res_label);
C_bss_cst(tp->tp_size, (arith) 0, 0); 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 /* Generate calls to initialization routines of modules defined within
this procedure this procedure
@ -211,13 +215,14 @@ WalkProcedure(procedure)
param; param;
param = param->next) { param = param->next) {
if (! IsVarParam(param)) { if (! IsVarParam(param)) {
tp = TypeOfParam(param); register struct type *TpParam = TypeOfParam(param);
if (! IsConformantArray(tp)) { if (! IsConformantArray(TpParam)) {
if (tp->tp_size < word_size) { if (TpParam->tp_size < word_size &&
(int) word_size % (int) TpParam->tp_size == 0) {
C_lol(param->par_def->var_off); C_lol(param->par_def->var_off);
C_lal(param->par_def->var_off); C_lal(param->par_def->var_off);
C_sti(tp->tp_size); C_sti(TpParam->tp_size);
} }
} }
else { else {
@ -266,14 +271,18 @@ WalkProcedure(procedure)
WalkNode(procedure->prc_body, NO_EXIT_LABEL); WalkNode(procedure->prc_body, NO_EXIT_LABEL);
DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0)); 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 */ C_df_ilb(RETURN_LABEL); /* label at end */
tp = func_type;
if (func_res_label) { if (func_res_label) {
/* Fill the data area reserved for the function result /* Fill the data area reserved for the function result
with the result with the result
*/ */
C_lae_dlb(func_res_label, (arith) 0); C_lae_dlb(func_res_label, (arith) 0);
C_sti(tp->tp_size); C_sti(func_res_size);
if (StackAdjustment) { if (StackAdjustment) {
/* Remove copies of conformant arrays /* Remove copies of conformant arrays
*/ */