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

better compatibility between CARDINAL and ADDRESS

Browse source
This commit is contained in:
ceriel 1986-07-10 16:27:26 +00:00
parent 965e75761d
commit 832bdeb3be
6 changed files with 84 additions and 78 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -28,11 +28,11 @@ static char *RcsId = "$Header$";
extern char *symbol2str(); extern char *symbol2str();
int int
chk_variable(expp) ChkVariable(expp)
register struct node *expp; register struct node *expp;
{ {
if (! chk_designator(expp)) return 0; if (! ChkDesignator(expp)) return 0;
if (expp->nd_class == Def && if (expp->nd_class == Def &&
!(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) { !(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) {
@ -44,7 +44,7 @@ chk_variable(expp)
} }
STATIC int STATIC int
chk_arrow(expp) ChkArrow(expp)
register struct node *expp; register struct node *expp;
{ {
register struct type *tp; register struct type *tp;
@ -54,7 +54,7 @@ chk_arrow(expp)
expp->nd_type = error_type; expp->nd_type = error_type;
if (! chk_variable(expp->nd_right)) return 0; if (! ChkVariable(expp->nd_right)) return 0;
tp = expp->nd_right->nd_type; tp = expp->nd_right->nd_type;
@ -69,7 +69,7 @@ chk_arrow(expp)
} }
STATIC int STATIC int
chk_arr(expp) ChkArr(expp)
register struct node *expp; register struct node *expp;
{ {
register struct type *tpl, *tpr; register struct type *tpl, *tpr;
@ -80,9 +80,9 @@ chk_arr(expp)
expp->nd_type = error_type; expp->nd_type = error_type;
if ( if (
!chk_variable(expp->nd_left) !ChkVariable(expp->nd_left)
|| ||
!chk_expr(expp->nd_right) !ChkExpression(expp->nd_right)
|| ||
expp->nd_left->nd_type == error_type expp->nd_left->nd_type == error_type
) return 0; ) return 0;
@ -111,7 +111,7 @@ chk_arr(expp)
} }
STATIC int STATIC int
chk_value(expp) ChkValue(expp)
struct node *expp; struct node *expp;
{ {
switch(expp->nd_symb) { switch(expp->nd_symb) {
@ -121,13 +121,13 @@ chk_value(expp)
return 1; return 1;
default: default:
crash("(chk_value)"); crash("(ChkValue)");
} }
/*NOTREACHED*/ /*NOTREACHED*/
} }
STATIC int STATIC int
chk_linkorname(expp) ChkLinkOrName(expp)
register struct node *expp; register struct node *expp;
{ {
register struct def *df; register struct def *df;
@ -142,7 +142,7 @@ chk_linkorname(expp)
assert(expp->nd_symb == '.'); assert(expp->nd_symb == '.');
if (! chk_designator(left)) return 0; if (! ChkDesignator(left)) return 0;
if (left->nd_type->tp_fund != T_RECORD || if (left->nd_type->tp_fund != T_RECORD ||
(left->nd_class == Def && (left->nd_class == Def &&
@ -204,12 +204,12 @@ df->df_idf->id_text);
} }
STATIC int STATIC int
chk_ex_linkorname(expp) ChkExLinkOrName(expp)
register struct node *expp; register struct node *expp;
{ {
register struct def *df; register struct def *df;
if (! chk_linkorname(expp)) return 0; if (! ChkLinkOrName(expp)) return 0;
if (expp->nd_class != Def) return 1; if (expp->nd_class != Def) return 1;
df = expp->nd_def; df = expp->nd_def;
@ -237,7 +237,7 @@ STATIC int
RemoveSet(set) RemoveSet(set)
arith **set; arith **set;
{ {
/* This routine is only used for error exits of chk_el. /* This routine is only used for error exits of ChkElement.
It frees the set indicated by "set", and returns 0. It frees the set indicated by "set", and returns 0.
*/ */
if (*set) { if (*set) {
@ -248,7 +248,7 @@ RemoveSet(set)
} }
STATIC int STATIC int
chk_el(expp, tp, set) ChkElement(expp, tp, set)
register struct node *expp; register struct node *expp;
register struct type *tp; register struct type *tp;
arith **set; arith **set;
@ -265,7 +265,7 @@ chk_el(expp, tp, set)
/* { ... , expr1 .. expr2, ... } /* { ... , expr1 .. expr2, ... }
First check expr1 and expr2, and try to compute them. First check expr1 and expr2, and try to compute them.
*/ */
if (!chk_el(left, tp, set) || !chk_el(right, tp, set)) { if (!ChkElement(left, tp, set) || !ChkElement(right, tp, set)) {
return 0; return 0;
} }
@ -295,7 +295,7 @@ node_error(expp, "lower bound exceeds upper bound in range");
/* Here, a single element is checked /* Here, a single element is checked
*/ */
if (!chk_expr(expp)) { if (!ChkExpression(expp)) {
return RemoveSet(set); return RemoveSet(set);
} }
@ -326,7 +326,7 @@ node_error(expp, "lower bound exceeds upper bound in range");
} }
STATIC int STATIC int
chk_set(expp) ChkSet(expp)
register struct node *expp; register struct node *expp;
{ {
/* Check the legality of a SET aggregate, and try to evaluate it /* Check the legality of a SET aggregate, and try to evaluate it
@ -345,7 +345,7 @@ chk_set(expp)
if (nd = expp->nd_left) { if (nd = expp->nd_left) {
/* A type was given. Check it out /* A type was given. Check it out
*/ */
if (! chk_designator(nd)) return 0; if (! ChkDesignator(nd)) return 0;
assert(nd->nd_class == Def); assert(nd->nd_class == Def);
df = nd->nd_def; df = nd->nd_def;
@ -383,7 +383,7 @@ node_error(expp, "specifier does not represent a set type");
while (nd) { while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ','); assert(nd->nd_class == Link && nd->nd_symb == ',');
if (!chk_el(nd->nd_left, ElementType(tp), &set)) return 0; if (!ChkElement(nd->nd_left, ElementType(tp), &set)) return 0;
nd = nd->nd_right; nd = nd->nd_right;
} }
@ -426,8 +426,8 @@ getarg(argp, bases, designator)
arg = arg->nd_right; arg = arg->nd_right;
left = arg->nd_left; left = arg->nd_left;
if ((!designator && !chk_expr(left)) || if ((!designator && !ChkExpression(left)) ||
(designator && !chk_variable(left))) { (designator && !ChkVariable(left))) {
return 0; return 0;
} }
@ -454,7 +454,7 @@ getname(argp, kinds)
} }
arg = arg->nd_right; arg = arg->nd_right;
if (! chk_designator(arg->nd_left)) return 0; if (! ChkDesignator(arg->nd_left)) return 0;
if (arg->nd_left->nd_class != Def && arg->nd_left->nd_class != LinkDef) { if (arg->nd_left->nd_class != Def && arg->nd_left->nd_class != LinkDef) {
node_error(arg, "identifier expected"); node_error(arg, "identifier expected");
@ -471,7 +471,7 @@ getname(argp, kinds)
} }
STATIC int STATIC int
chk_proccall(expp) ChkProcCall(expp)
register struct node *expp; register struct node *expp;
{ {
/* Check a procedure call /* Check a procedure call
@ -507,7 +507,7 @@ node_error(left, "type incompatibility in parameter");
} }
int int
chk_call(expp) ChkCall(expp)
register struct node *expp; register struct node *expp;
{ {
/* Check something that looks like a procedure or function call. /* Check something that looks like a procedure or function call.
@ -515,19 +515,19 @@ chk_call(expp)
it may also be a cast or a standard procedure call. it may also be a cast or a standard procedure call.
*/ */
register struct node *left; register struct node *left;
STATIC int chk_std(); STATIC int ChkStandard();
STATIC int chk_cast(); STATIC int ChkCast();
/* First, get the name of the function or procedure /* First, get the name of the function or procedure
*/ */
expp->nd_type = error_type; expp->nd_type = error_type;
left = expp->nd_left; left = expp->nd_left;
if (! chk_designator(left)) return 0; if (! ChkDesignator(left)) return 0;
if (IsCast(left)) { if (IsCast(left)) {
/* It was a type cast. This is of course not portable. /* It was a type cast. This is of course not portable.
*/ */
return chk_cast(expp, left); return ChkCast(expp, left);
} }
if (IsProcCall(left)) { if (IsProcCall(left)) {
@ -537,12 +537,12 @@ chk_call(expp)
if (left->nd_type == std_type) { if (left->nd_type == std_type) {
/* A standard procedure /* A standard procedure
*/ */
return chk_std(expp, left); return ChkStandard(expp, left);
} }
/* Here, we have found a real procedure call. The left hand /* Here, we have found a real procedure call. The left hand
side may also represent a procedure variable. side may also represent a procedure variable.
*/ */
return chk_proccall(expp); return ChkProcCall(expp);
} }
node_error(left, "procedure, type, or function expected"); node_error(left, "procedure, type, or function expected");
@ -606,7 +606,7 @@ AllowedTypes(operator)
} }
STATIC int STATIC int
chk_address(tpl, tpr) ChkAddress(tpl, tpr)
register struct type *tpl, *tpr; register struct type *tpl, *tpr;
{ {
@ -622,7 +622,7 @@ chk_address(tpl, tpr)
} }
STATIC int STATIC int
chk_oper(expp) ChkBinOper(expp)
register struct node *expp; register struct node *expp;
{ {
/* Check a binary operation. /* Check a binary operation.
@ -634,7 +634,7 @@ chk_oper(expp)
left = expp->nd_left; left = expp->nd_left;
right = expp->nd_right; right = expp->nd_right;
if (!chk_expr(left) || !chk_expr(right)) return 0; if (!ChkExpression(left) || !ChkExpression(right)) return 0;
tpl = BaseType(left->nd_type); tpl = BaseType(left->nd_type);
tpr = BaseType(right->nd_type); tpr = BaseType(right->nd_type);
@ -686,10 +686,11 @@ node_error(expp, "IN operator: type of LHS not compatible with element type of R
(tpl != bool_type && Boolean(expp->nd_symb))) { (tpl != bool_type && Boolean(expp->nd_symb))) {
if (!(tpl->tp_fund == T_POINTER && if (!(tpl->tp_fund == T_POINTER &&
(T_CARDINAL & allowed) && (T_CARDINAL & allowed) &&
chk_address(tpl, tpr))) { ChkAddress(tpl, tpr))) {
node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb)); node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
return 0; return 0;
} }
expp->nd_type = card_type;
} }
if (tpl->tp_fund == T_SET) { if (tpl->tp_fund == T_SET) {
@ -706,7 +707,7 @@ node_error(expp,"operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_
} }
STATIC int STATIC int
chk_uoper(expp) ChkUnOper(expp)
register struct node *expp; register struct node *expp;
{ {
/* Check an unary operation. /* Check an unary operation.
@ -714,9 +715,10 @@ chk_uoper(expp)
register struct node *right = expp->nd_right; register struct node *right = expp->nd_right;
register struct type *tpr; register struct type *tpr;
if (! chk_expr(right)) return 0; if (! ChkExpression(right)) return 0;
tpr = BaseType(right->nd_type); tpr = BaseType(right->nd_type);
if (tpr == address_type) tpr = card_type;
expp->nd_type = tpr; expp->nd_type = tpr;
switch(expp->nd_symb) { switch(expp->nd_symb) {
@ -766,7 +768,7 @@ chk_uoper(expp)
break; break;
default: default:
crash("chk_uoper"); crash("ChkUnOper");
} }
node_error(expp, "illegal operand for unary operator \"%s\"", node_error(expp, "illegal operand for unary operator \"%s\"",
symbol2str(expp->nd_symb)); symbol2str(expp->nd_symb));
@ -785,14 +787,14 @@ getvariable(argp)
return 0; return 0;
} }
if (! chk_variable(arg->nd_left)) return 0; if (! ChkVariable(arg->nd_left)) return 0;
*argp = arg; *argp = arg;
return arg->nd_left; return arg->nd_left;
} }
STATIC int STATIC int
chk_std(expp, left) ChkStandard(expp, left)
register struct node *expp, *left; register struct node *expp, *left;
{ {
/* Check a call of a standard procedure or function /* Check a call of a standard procedure or function
@ -909,7 +911,7 @@ chk_std(expp, left)
"ALLOCATE" : "DEALLOCATE", 0); "ALLOCATE" : "DEALLOCATE", 0);
expp->nd_left = MkLeaf(Name, &dt); expp->nd_left = MkLeaf(Name, &dt);
} }
return chk_call(expp); return ChkCall(expp);
case S_TSIZE: /* ??? */ case S_TSIZE: /* ??? */
case S_SIZE: case S_SIZE:
@ -989,7 +991,7 @@ node_error(arg, "EXCL and INCL expect a SET parameter");
} }
default: default:
crash("(chk_std)"); crash("(ChkStandard)");
} }
if (arg->nd_right) { if (arg->nd_right) {
@ -1001,7 +1003,7 @@ node_error(arg, "EXCL and INCL expect a SET parameter");
} }
STATIC int STATIC int
chk_cast(expp, left) ChkCast(expp, left)
register struct node *expp, *left; register struct node *expp, *left;
{ {
/* Check a cast and perform it if the argument is constant. /* Check a cast and perform it if the argument is constant.
@ -1019,7 +1021,7 @@ node_error(expp, "only one parameter expected in type cast");
} }
arg = arg->nd_left; arg = arg->nd_left;
if (! chk_expr(arg)) return 0; if (! ChkExpression(arg)) return 0;
if (arg->nd_type->tp_size != left->nd_type->tp_size && if (arg->nd_type->tp_size != left->nd_type->tp_size &&
(arg->nd_type->tp_size > word_size || (arg->nd_type->tp_size > word_size ||
@ -1078,33 +1080,33 @@ done_before(expp)
extern int NodeCrash(); extern int NodeCrash();
int (*ExprChkTable[])() = { int (*ExprChkTable[])() = {
chk_value, ChkValue,
chk_arr, ChkArr,
chk_oper, ChkBinOper,
chk_uoper, ChkUnOper,
chk_arrow, ChkArrow,
chk_call, ChkCall,
chk_ex_linkorname, ChkExLinkOrName,
NodeCrash, NodeCrash,
chk_set, ChkSet,
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
chk_ex_linkorname, ChkExLinkOrName,
NodeCrash NodeCrash
}; };
int (*DesigChkTable[])() = { int (*DesigChkTable[])() = {
chk_value, ChkValue,
chk_arr, ChkArr,
no_desig, no_desig,
no_desig, no_desig,
chk_arrow, ChkArrow,
no_desig, no_desig,
chk_linkorname, ChkLinkOrName,
NodeCrash, NodeCrash,
no_desig, no_desig,
done_before, done_before,
NodeCrash, NodeCrash,
chk_linkorname, ChkLinkOrName,
done_before done_before
}; };

4
lang/m2/comp/chk_expr.h
View file

@ -9,5 +9,5 @@ extern int (*DesigChkTable[])(); /* table of designator checking
functions, indexed by node class functions, indexed by node class
*/ */
#define chk_expr(expp) ((*ExprChkTable[(expp)->nd_class])(expp)) #define ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp))
#define chk_designator(expp) ((*DesigChkTable[(expp)->nd_class])(expp)) #define ChkDesignator(expp) ((*DesigChkTable[(expp)->nd_class])(expp))

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

@ -341,7 +341,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
the type the type
*/ */
{ warning("Old fashioned Modula-2 syntax!"); { warning("Old fashioned Modula-2 syntax!");
if (chk_designator(nd) && if (ChkDesignator(nd) &&
(nd->nd_class != Def || (nd->nd_class != Def ||
!(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) || !(nd->nd_def->df_kind&(D_ERROR|D_ISTYPE)) ||
!nd->nd_def->df_type)) { !nd->nd_def->df_type)) {

4
lang/m2/comp/expression.g
View file

@ -48,7 +48,7 @@ qualident(int types;
{ if (types) { { if (types) {
df = ill_df; df = ill_df;
if (chk_designator(nd)) { if (ChkDesignator(nd)) {
if (nd->nd_class != Def) { if (nd->nd_class != Def) {
node_error(nd, "%s expected", str); node_error(nd, "%s expected", str);
} }
@ -99,7 +99,7 @@ ConstExpression(struct node **pnd;):
*/ */
{ DO_DEBUG(options['X'], print("CONSTANT EXPRESSION\n")); { DO_DEBUG(options['X'], print("CONSTANT EXPRESSION\n"));
DO_DEBUG(options['X'], PrNode(*pnd, 0)); DO_DEBUG(options['X'], PrNode(*pnd, 0));
if (chk_expr(*pnd) && if (ChkExpression(*pnd) &&
((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) { ((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
error("Constant expression expected"); error("Constant expression expected");
} }

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

@ -154,6 +154,10 @@ InitTypes()
fatal("integer size not equal to word size"); fatal("integer size not equal to word size");
} }
if (int_size != pointer_size) {
fatal("cardinal size not equal to pointer size");
}
if (long_size < int_size || long_size % word_size != 0) { if (long_size < int_size || long_size % word_size != 0) {
fatal("illegal long integer size"); fatal("illegal long integer size");
} }

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

@ -256,7 +256,7 @@ WalkCall(nd)
assert(nd->nd_class == Call); assert(nd->nd_class == Call);
if (! options['L']) C_lin((arith) nd->nd_lineno); if (! options['L']) C_lin((arith) nd->nd_lineno);
if (chk_call(nd)) { if (ChkCall(nd)) {
if (nd->nd_type != 0) { if (nd->nd_type != 0) {
node_error(nd, "procedure call expected"); node_error(nd, "procedure call expected");
return; return;
@ -472,7 +472,7 @@ ExpectBool(nd, true_label, false_label)
*/ */
struct desig ds; struct desig ds;
if (!chk_expr(nd)) return; if (!ChkExpression(nd)) return;
if (nd->nd_type != bool_type && nd->nd_type != error_type) { if (nd->nd_type != bool_type && nd->nd_type != error_type) {
node_error(nd, "boolean expression expected"); node_error(nd, "boolean expression expected");
@ -488,7 +488,7 @@ WalkExpr(nd)
/* Check an expression and generate code for it /* Check an expression and generate code for it
*/ */
if (! chk_expr(nd)) return; if (! ChkExpression(nd)) return;
CodePExpr(nd); CodePExpr(nd);
} }
@ -500,7 +500,7 @@ WalkDesignator(nd, ds)
/* Check designator and generate code for it /* Check designator and generate code for it
*/ */
if (! chk_variable(nd)) return; if (! ChkVariable(nd)) return;
*ds = InitDesig; *ds = InitDesig;
CodeDesig(nd, ds); CodeDesig(nd, ds);
@ -515,9 +515,9 @@ DoForInit(nd, left)
nd->nd_class = Name; nd->nd_class = Name;
nd->nd_symb = IDENT; nd->nd_symb = IDENT;
if (! chk_variable(nd) || if (! ChkVariable(nd) ||
! chk_expr(left->nd_left) || ! ChkExpression(left->nd_left) ||
! chk_expr(left->nd_right)) return 0; ! ChkExpression(left->nd_right)) return 0;
df = nd->nd_def; df = nd->nd_def;
if (df->df_kind == D_FIELD) { if (df->df_kind == D_FIELD) {
@ -543,16 +543,16 @@ DoForInit(nd, left)
} }
} }
if (nd->nd_type->tp_size > word_size || if (df->df_type->tp_size > word_size ||
!(nd->nd_type->tp_fund & T_DISCRETE)) { !(df->df_type->tp_fund & T_DISCRETE)) {
node_error(nd, "illegal type of FOR loop variable"); node_error(nd, "illegal type of FOR loop variable");
return 0; return 0;
} }
if (!TstCompat(nd->nd_type, left->nd_left->nd_type) || if (!TstCompat(df->df_type, left->nd_left->nd_type) ||
!TstCompat(nd->nd_type, left->nd_right->nd_type)) { !TstCompat(df->df_type, left->nd_right->nd_type)) {
if (!TstAssCompat(nd->nd_type, left->nd_left->nd_type) || if (!TstAssCompat(df->df_type, left->nd_left->nd_type) ||
!TstAssCompat(nd->nd_type, left->nd_right->nd_type)) { !TstAssCompat(df->df_type, left->nd_right->nd_type)) {
node_error(nd, "type incompatibility in FOR statement"); node_error(nd, "type incompatibility in FOR statement");
return 0; return 0;
} }
@ -571,8 +571,8 @@ DoAssign(nd, left, right)
/* May we do it in this order (expression first) ??? */ /* May we do it in this order (expression first) ??? */
struct desig dsl, dsr; struct desig dsl, dsr;
if (!chk_expr(right)) return; if (!ChkExpression(right)) return;
if (! chk_variable(left)) return; if (! ChkVariable(left)) return;
TryToString(right, left->nd_type); TryToString(right, left->nd_type);
dsr = InitDesig; dsr = InitDesig;
CodeExpr(right, &dsr, NO_LABEL, NO_LABEL); CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);