extern int cntlines;
#endif
-static
+STATIC
SkipComment()
{
/* Skip Modula-2 comments (* ... *).
cntlines++;
#endif
}
- else
- if (ch == '(') {
+ else if (ch == '(') {
LoadChar(ch);
- if (ch == '*') {
- ++NestLevel;
- }
+ if (ch == '*') ++NestLevel;
else continue;
}
- else
- if (ch == '*') {
+ else if (ch == '*') {
LoadChar(ch);
if (ch == ')') {
if (NestLevel-- == 0) return;
}
}
-static
+STATIC
GetString(upto)
{
/* Read a Modula-2 string, delimited by the character "upto".
register int ch, nch;
toktype = error_type;
+
if (ASIDE) { /* a token is put aside */
*tk = aside;
ASIDE = 0;
return tk->tk_symb;
}
+
tk->tk_lineno = LineNumber;
again:
LoadChar(ch);
} while(in_idf(ch));
- if (ch != EOI)
- PushBack(ch);
+ if (ch != EOI) PushBack(ch);
*tg++ = '\0';
tk->TOK_IDF = id = str2idf(buf, 1);
lexerror("floating constant too long");
}
else tk->TOK_REL = Salloc(buf, np - buf) + 1;
+ toktype = real_type;
return tk->tk_symb = REAL;
default:
LSRC = tokenfile.g program.g declar.g expression.g statement.g
CC = cc
-GEN = LLgen
-GENOPTIONS =
-PROFILE =
-CFLAGS = $(PROFILE) $(INCLUDES)
+GEN = /usr/em/util/LLgen/src/LLgen
+GENOPTIONS = -d
+PROFILE = -p
+CFLAGS = $(PROFILE) $(INCLUDES) -DSTATIC=
+LINTFLAGS = -DSTATIC= -DNORCSID
LFLAGS = $(PROFILE)
LOBJ = tokenfile.o program.o declar.o expression.o statement.o
COBJ = LLlex.o LLmessage.o char.o error.o main.o \
rm -f $(OBJ) $(GENFILES) LLfiles
lint: LLfiles hfiles
- lint $(INCLUDES) -DNORCSID `sources $(OBJ)`
+ lint $(INCLUDES) $(LINTFLAGS) `sources $(OBJ)`
tokenfile.g: tokenname.c make.tokfile
make.tokfile <tokenname.c >tokenfile.g
typequiv.o: LLlex.h def.h node.h type.h
node.o: LLlex.h debug.h def.h node.h type.h
cstoper.o: LLlex.h Lpars.h debug.h idf.h node.h standards.h target_sizes.h type.h
-chk_expr.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
+chk_expr.o: LLlex.h Lpars.h chk_expr.h const.h debug.h def.h idf.h node.h scope.h standards.h type.h
options.o: idfsize.h main.h ndir.h type.h
-walk.o: LLlex.h Lpars.h debug.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h
+walk.o: LLlex.h Lpars.h chk_expr.h debug.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h
casestat.o: LLlex.h Lpars.h debug.h density.h desig.h node.h type.h
desig.o: LLlex.h debug.h def.h desig.h node.h scope.h type.h
code.o: LLlex.h Lpars.h debug.h def.h desig.h node.h scope.h standards.h type.h
tmpvar.o: debug.h def.h scope.h type.h
+lookup.o: LLlex.h debug.h def.h idf.h node.h scope.h
tokenfile.o: Lpars.h
program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
declar.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h node.h scope.h type.h
-expression.o: LLlex.h Lpars.h const.h debug.h def.h idf.h node.h type.h
+expression.o: LLlex.h Lpars.h chk_expr.h const.h debug.h def.h idf.h node.h type.h
statement.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h
Lpars.o: Lpars.h
#include "scope.h"
#include "const.h"
#include "standards.h"
+#include "chk_expr.h"
extern char *symbol2str();
-int
-chk_expr(expp)
- register struct node *expp;
+STATIC int
+chk_arr(expp)
+ struct node *expp;
{
- /* Check the expression indicated by expp for semantic errors,
- identify identifiers used in it, replace constants by
- their value, and try to evaluate the expression.
- */
-
- switch(expp->nd_class) {
- case Arrsel:
- return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
-
- case Oper:
- return chk_oper(expp);
-
- case Arrow:
- return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
-
- case Uoper:
- return chk_uoper(expp);
-
- case Value:
- switch(expp->nd_symb) {
- case REAL:
- case STRING:
- case INTEGER:
- return 1;
-
- default:
- crash("(chk_expr(Value))");
- }
- break;
-
- case Xset:
- return chk_set(expp);
-
- case Link:
- case Name:
- if (chk_designator(expp, VALUE|DESIGNATOR, D_USED)) {
- if (expp->nd_class == Def &&
- expp->nd_def->df_kind == D_PROCEDURE) {
- /* Check that this procedure is one that we
- may take the address from.
- */
- if (expp->nd_def->df_type == std_type) {
- /* Standard procedure. Illegal */
-node_error(expp, "address of standard procedure taken");
- return 0;
- }
- if (expp->nd_def->df_scope->sc_level > 0) {
- /* Address of nested procedure taken.
- Illegal.
- */
-node_error(expp, "address of a procedure local to another one taken");
- return 0;
- }
- }
- return 1;
- }
- return 0;
+ return chk_designator(expp, DESIGNATOR|VARIABLE, D_USED);
+}
- case Call:
- return chk_call(expp);
+STATIC int
+chk_value(expp)
+ struct node *expp;
+{
+ switch(expp->nd_symb) {
+ case REAL:
+ case STRING:
+ case INTEGER:
+ return 1;
default:
- crash("(chk_expr)");
+ crash("(chk_value)");
}
/*NOTREACHED*/
}
-int
-chk_set(expp)
+STATIC int
+chk_linkorname(expp)
register struct node *expp;
{
- /* Check the legality of a SET aggregate, and try to evaluate it
- compile time. Unfortunately this is all rather complicated.
- */
- register struct type *tp;
- register struct node *nd;
- register struct def *df;
- arith *set;
- unsigned size;
-
- assert(expp->nd_symb == SET);
-
- /* First determine the type of the set
- */
- if (nd = expp->nd_left) {
- /* A type was given. Check it out
- */
- if (! chk_designator(nd, 0, D_USED)) return 0;
-
- assert(nd->nd_class == Def);
- df = nd->nd_def;
-
- if (!(df->df_kind & (D_TYPE|D_ERROR)) ||
- (df->df_type->tp_fund != T_SET)) {
-node_error(expp, "specifier does not represent a set type");
- return 0;
+ if (chk_designator(expp, VALUE|DESIGNATOR, D_USED)) {
+ if (expp->nd_class == Def &&
+ expp->nd_def->df_kind == D_PROCEDURE) {
+ /* Check that this procedure is one that we
+ may take the address from.
+ */
+ if (expp->nd_def->df_type == std_type ||
+ expp->nd_def->df_scope->sc_level > 0) {
+ /* Address of standard or nested procedure
+ taken.
+ */
+node_error(expp, "it is illegal to take the address of a standard or local procedure");
+ return 0;
+ }
}
- tp = df->df_type;
- FreeNode(expp->nd_left);
- expp->nd_left = 0;
- }
- else tp = bitset_type;
- expp->nd_type = tp;
-
- nd = expp->nd_right;
-
- /* Now check the elements given, and try to compute a constant set.
- First allocate room for the set, but only if it is'nt empty.
- */
- if (! nd) {
- /* The resulting set IS empty, so we just return
- */
- expp->nd_class = Set;
- expp->nd_set = 0;
return 1;
}
- size = tp->tp_size * (sizeof(arith) / word_size);
- set = (arith *) Malloc(size);
- clear((char *) set, size);
+ return 0;
+}
- /* Now check the elements, one by one
+STATIC int
+RemoveSet(set)
+ arith **set;
+{
+ /* This routine is only used for error exits of chk_el.
+ It frees the set indicated by "set", and returns 0.
*/
- while (nd) {
- assert(nd->nd_class == Link && nd->nd_symb == ',');
-
- if (!chk_el(nd->nd_left, tp->next, &set)) return 0;
- nd = nd->nd_right;
- }
-
- if (set) {
- /* Yes, it was a constant set, and we managed to compute it!
- Notice that at the moment there is no such thing as
- partial evaluation. Either we evaluate the set, or we
- don't (at all). Improvement not neccesary. (???)
- */
- expp->nd_class = Set;
- expp->nd_set = set;
- FreeNode(expp->nd_right);
- expp->nd_right = 0;
+ if (*set) {
+ free((char *) *set);
+ *set = 0;
}
-
- return 1;
+ return 0;
}
-int
+STATIC int
chk_el(expp, tp, set)
register struct node *expp;
register struct type *tp;
if (left->nd_INT > right->nd_INT) {
node_error(expp, "lower bound exceeds upper bound in range");
- return rem_set(set);
+ return RemoveSet(set);
}
if (*set) {
/* Here, a single element is checked
*/
if (!chk_expr(expp)) {
- return rem_set(set);
+ return RemoveSet(set);
}
if (!TstCompat(tp, expp->nd_type)) {
node_error(expp, "set element has incompatible type");
- return rem_set(set);
+ return RemoveSet(set);
}
if (expp->nd_class == Value) {
(i < 0 || i > tp->enm_ncst))
) {
node_error(expp, "set element out of range");
- return rem_set(set);
+ return RemoveSet(set);
}
if (*set) (*set)[i/wrd_bits] |= (1 << (i%wrd_bits));
return 1;
}
-int
-rem_set(set)
- arith **set;
+STATIC int
+chk_set(expp)
+ register struct node *expp;
{
- /* This routine is only used for error exits of chk_el.
- It frees the set indicated by "set", and returns 0.
+ /* Check the legality of a SET aggregate, and try to evaluate it
+ compile time. Unfortunately this is all rather complicated.
*/
- if (*set) {
- free((char *) *set);
- *set = 0;
+ register struct type *tp;
+ register struct node *nd;
+ register struct def *df;
+ arith *set;
+ unsigned size;
+
+ assert(expp->nd_symb == SET);
+
+ /* First determine the type of the set
+ */
+ if (nd = expp->nd_left) {
+ /* A type was given. Check it out
+ */
+ if (! chk_designator(nd, 0, D_USED)) return 0;
+
+ assert(nd->nd_class == Def);
+ df = nd->nd_def;
+
+ if (!(df->df_kind & (D_TYPE|D_ERROR)) ||
+ (df->df_type->tp_fund != T_SET)) {
+node_error(expp, "specifier does not represent a set type");
+ return 0;
+ }
+ tp = df->df_type;
+ FreeNode(expp->nd_left);
+ expp->nd_left = 0;
}
- return 0;
+ else tp = bitset_type;
+ expp->nd_type = tp;
+
+ nd = expp->nd_right;
+
+ /* Now check the elements given, and try to compute a constant set.
+ First allocate room for the set, but only if it is'nt empty.
+ */
+ if (! nd) {
+ /* The resulting set IS empty, so we just return
+ */
+ expp->nd_class = Set;
+ expp->nd_set = 0;
+ return 1;
+ }
+ size = tp->tp_size * (sizeof(arith) / word_size);
+ set = (arith *) Malloc(size);
+ clear((char *) set, size);
+
+ /* Now check the elements, one by one
+ */
+ while (nd) {
+ assert(nd->nd_class == Link && nd->nd_symb == ',');
+
+ if (!chk_el(nd->nd_left, tp->next, &set)) return 0;
+ nd = nd->nd_right;
+ }
+
+ if (set) {
+ /* Yes, it was a constant set, and we managed to compute it!
+ Notice that at the moment there is no such thing as
+ partial evaluation. Either we evaluate the set, or we
+ don't (at all). Improvement not neccesary. (???)
+ */
+ expp->nd_class = Set;
+ expp->nd_set = set;
+ FreeNode(expp->nd_right);
+ expp->nd_right = 0;
+ }
+
+ return 1;
}
-struct node *
+STATIC struct node *
getarg(argp, bases, designator)
struct node **argp;
{
+ /* This routine is used to fetch the next argument from an
+ argument list. The argument list is indicated by "argp".
+ The parameter "bases" is a bitset indicating which types
+ are allowed at this point, and "designator" is a flag
+ indicating that the address from this argument is taken, so
+ that it must be a designator and may not be a register
+ variable.
+ */
struct type *tp;
register struct node *arg = *argp;
+ register struct node *left;
- if (!arg->nd_right) {
+ if (! arg->nd_right) {
node_error(arg, "too few arguments supplied");
return 0;
}
+
arg = arg->nd_right;
- if ((!designator && !chk_expr(arg->nd_left)) ||
- (designator && !chk_designator(arg->nd_left, DESIGNATOR, D_REFERRED))) {
+ left = arg->nd_left;
+
+ if ((!designator && !chk_expr(left)) ||
+ (designator &&
+ !chk_designator(left, DESIGNATOR|VARIABLE, D_USED|D_NOREG))) {
return 0;
}
- tp = arg->nd_left->nd_type;
+
+ tp = left->nd_type;
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+
if (bases && !(tp->tp_fund & bases)) {
node_error(arg, "unexpected type");
return 0;
}
*argp = arg;
- return arg->nd_left;
+ return left;
}
-struct node *
+STATIC struct node *
getname(argp, kinds)
struct node **argp;
{
node_error(arg, "too few arguments supplied");
return 0;
}
+
arg = arg->nd_right;
if (! chk_designator(arg->nd_left, 0, D_REFERRED)) return 0;
- assert(arg->nd_left->nd_class == Def);
+ if (arg->nd_left->nd_class != Def);
if (!(arg->nd_left->nd_def->df_kind & kinds)) {
node_error(arg, "unexpected type");
return arg->nd_left;
}
+STATIC int
+chk_proccall(expp)
+ register struct node *expp;
+{
+ /* Check a procedure call
+ */
+ register struct node *left;
+ struct node *arg;
+ register struct paramlist *param;
+
+ left = expp->nd_left;
+ arg = expp;
+ expp->nd_type = left->nd_type->next;
+
+ for (param = left->nd_type->prc_params; param; param = param->next) {
+ if (!(left = getarg(&arg, 0, IsVarParam(param)))) return 0;
+ if (left->nd_symb == STRING) {
+ TryToString(left, TypeOfParam(param));
+ }
+ if (! TstParCompat(TypeOfParam(param),
+ left->nd_type,
+ IsVarParam(param),
+ left)) {
+node_error(left, "type incompatibility in parameter");
+ return 0;
+ }
+ }
+
+ if (arg->nd_right) {
+ node_error(arg->nd_right, "too many parameters supplied");
+ return 0;
+ }
+
+ return 1;
+}
+
int
chk_call(expp)
register struct node *expp;
return 0;
}
-chk_proccall(expp)
- register struct node *expp;
-{
- /* Check a procedure call
- */
- register struct node *left;
- struct node *arg;
- register struct paramlist *param;
-
- left = 0;
- arg = expp->nd_right;
- /* First, reverse the order in the argument list */
- while (arg) {
- expp->nd_right = arg;
- arg = arg->nd_right;
- expp->nd_right->nd_right = left;
- left = expp->nd_right;
- }
-
- left = expp->nd_left;
- arg = expp;
- expp->nd_type = left->nd_type->next;
- param = left->nd_type->prc_params;
-
- while (param) {
- if (!(left = getarg(&arg, 0, IsVarParam(param)))) return 0;
- if (left->nd_symb == STRING) {
- TryToString(left, TypeOfParam(param));
- }
- if (! TstParCompat(TypeOfParam(param),
- left->nd_type,
- IsVarParam(param),
- left)) {
-node_error(left, "type incompatibility in parameter");
- return 0;
- }
- if (IsVarParam(param) && left->nd_class == Def) {
- left->nd_def->df_flags |= D_NOREG;
- }
-
- param = param->next;
- }
-
- if (arg->nd_right) {
- node_error(arg->nd_right, "too many parameters supplied");
- return 0;
- }
-
- return 1;
-}
-
-static int
+STATIC int
FlagCheck(expp, df, flag)
struct node *expp;
struct def *df;
*/
register struct def *df;
register struct type *tp;
- struct def *lookfor();
expp->nd_type = error_type;
expp->nd_def = lookfor(expp, CurrVis, 1);
expp->nd_class = Def;
expp->nd_type = expp->nd_def->df_type;
- if (expp->nd_type == error_type) return 0;
}
+ else if (expp->nd_class == Link) {
+ register struct node *left = expp->nd_left;
- if (expp->nd_class == Link) {
assert(expp->nd_symb == '.');
- if (! chk_designator(expp->nd_left,
- flag|HASSELECTORS,
- dflags|D_NOREG)) return 0;
-
- tp = expp->nd_left->nd_type;
+ if (! chk_designator(left,
+ (flag&DESIGNATOR)|HASSELECTORS,
+ dflags)) return 0;
+ tp = left->nd_type;
assert(tp->tp_fund == T_RECORD);
- df = lookup(expp->nd_IDF, tp->rec_scope);
-
- if (!df) {
+ if (!(df = lookup(expp->nd_IDF, tp->rec_scope))) {
id_not_declared(expp);
return 0;
}
expp->nd_def = df;
expp->nd_type = df->df_type;
if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
+ /* Fields of a record are always D_QEXPORTED,
+ so ...
+ */
node_error(expp, "identifier \"%s\" not exported from qualifying module",
df->df_idf->id_text);
return 0;
}
}
- if (expp->nd_left->nd_class == Def &&
- expp->nd_left->nd_def->df_kind == D_MODULE) {
+ if (left->nd_class == Def &&
+ left->nd_def->df_kind == D_MODULE) {
expp->nd_class = Def;
- expp->nd_def = df;
- FreeNode(expp->nd_left);
+ FreeNode(left);
expp->nd_left = 0;
}
else {
assert(expp->nd_symb == '[');
if (
- !chk_designator(expp->nd_left, DESIGNATOR|VARIABLE, dflags|D_NOREG)
+ !chk_designator(expp->nd_left, DESIGNATOR|VARIABLE, dflags)
||
- !chk_expr(expp->nd_right)
+ !chk_expr(expp->nd_right)
||
- expp->nd_left->nd_type == error_type
- ) return 0;
+ expp->nd_left->nd_type == error_type
+ ) return 0;
tpr = expp->nd_right->nd_type;
tpl = expp->nd_left->nd_type;
return 0;
}
-struct type *
+STATIC struct type *
ResultOfOperation(operator, tp)
struct type *tp;
{
return tp;
}
-int
+STATIC int
Boolean(operator)
{
return operator == OR || operator == AND || operator == '&';
}
-int
+STATIC int
AllowedTypes(operator)
{
switch(operator) {
/*NOTREACHED*/
}
-int
+STATIC int
+chk_address(tpl, tpr)
+ register struct type *tpl, *tpr;
+{
+
+ if (tpl == address_type) {
+ return tpr == address_type || tpr->tp_fund != T_POINTER;
+ }
+
+ if (tpr == address_type) {
+ return tpl->tp_fund != T_POINTER;
+ }
+
+ return 0;
+}
+
+STATIC int
chk_oper(expp)
register struct node *expp;
{
return 1;
}
-int
-chk_address(tpl, tpr)
- register struct type *tpl, *tpr;
-{
-
- if (tpl == address_type) {
- return tpr == address_type || tpr->tp_fund != T_POINTER;
- }
-
- if (tpr == address_type) {
- return tpl->tp_fund != T_POINTER;
- }
-
- return 0;
-}
-
-int
+STATIC int
chk_uoper(expp)
register struct node *expp;
{
return 0;
}
-struct node *
+STATIC struct node *
getvariable(argp)
struct node **argp;
{
case S_MAX:
case S_MIN:
- if (!(left = getarg(&arg, T_DISCRETE, 0))) return 0;
+ if (!(left = getname(&arg, D_ISTYPE))) return 0;
+ if (!(left->nd_type->tp_fund & (T_DISCRETE))) {
+ node_error(left, "illegal type in MIN or MAX");
+ return 0;
+ }
expp->nd_type = left->nd_type;
cstcall(expp,std);
break;
struct node *nd;
struct type *tp;
{
- /* Try a coercion from character constant to string */
+ /* Try a coercion from character constant to string.
+ */
if (tp->tp_fund == T_ARRAY && nd->nd_type == char_type) {
int ch = nd->nd_INT;
nd->nd_SLE = 1;
}
}
+
+extern int NodeCrash();
+
+int (*ChkTable[])() = {
+ chk_value,
+ chk_arr,
+ chk_oper,
+ chk_uoper,
+ chk_arr,
+ chk_call,
+ chk_linkorname,
+ NodeCrash,
+ chk_set,
+ NodeCrash,
+ NodeCrash,
+ chk_linkorname
+};
--- /dev/null
+/* E X P R E S S I O N C H E C K I N G */
+
+/* $Header$ */
+
+extern int (*ChkTable[])(); /* table of expression checking
+ functions, indexed by node class
+ */
+
+#define chk_expr(expp) ((*ChkTable[(expp)->nd_class])(expp))
break;
case Uoper:
- CodePExpr(nd->nd_right);
CodeUoper(nd);
ds->dsg_kind = DSG_LOADED;
break;
{
register int fund1, fund2;
- if (t1 == t2) return;
if (t1->tp_fund == T_SUBRANGE) t1 = t1->next;
if (t2->tp_fund == T_SUBRANGE) t2 = t2->next;
+ if (t1 == t2) return;
if ((fund1 = t1->tp_fund) == T_WORD) fund1 = T_INTEGER;
if ((fund2 = t2->tp_fund) == T_WORD) fund2 = T_INTEGER;
switch(fund1) {
and result is already done.
*/
register struct node *left = nd->nd_left;
- register struct node *arg = nd;
- register struct paramlist *param;
- struct type *tp;
if (left->nd_type == std_type) {
CodeStd(nd);
assert(IsProcCall(left));
- for (param = left->nd_type->prc_params; param; param = param->next) {
- tp = TypeOfParam(param);
- arg = arg->nd_right;
- assert(arg != 0);
- left = arg->nd_left;
- if (IsConformantArray(tp)) {
- C_loc(tp->arr_elsize);
- if (IsConformantArray(left->nd_type)) {
- DoHIGH(left);
- }
- else if (left->nd_symb == STRING) {
- C_loc(left->nd_SLE);
- }
- else if (tp->arr_elem == word_type) {
- C_loc(left->nd_type->tp_size / word_size - 1);
- }
- else {
- tp = left->nd_type->next;
- if (tp->tp_fund == T_SUBRANGE) {
- C_loc(tp->sub_ub - tp->sub_lb);
- }
- else C_loc((arith) (tp->enm_ncst - 1));
- }
- C_loc((arith) 0);
- if (left->nd_symb == STRING) {
- CodeString(left);
- }
- else CodeDAddress(left);
- }
- else if (IsVarParam(param)) {
- CodeDAddress(left);
- }
- else {
- if (left->nd_type->tp_fund == T_STRING) {
- CodePadString(left, tp->tp_size);
- }
- else CodePExpr(left);
- CheckAssign(left->nd_type, tp);
- }
+ if (nd->nd_right) {
+ CodeParameters(left->nd_type->prc_params, nd->nd_right);
}
- left = nd->nd_left;
-
if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
if (left->nd_def->df_scope->sc_level > 0) {
C_lxl((arith) proclevel - left->nd_def->df_scope->sc_level);
}
}
+CodeParameters(param, arg)
+ struct paramlist *param;
+ struct node *arg;
+{
+ register struct type *tp;
+ register struct node *left;
+
+ assert(param != 0 && arg != 0);
+
+ if (param->next) {
+ CodeParameters(param->next, arg->nd_right);
+ }
+
+ tp = TypeOfParam(param);
+ left = arg->nd_left;
+ if (IsConformantArray(tp)) {
+ C_loc(tp->arr_elsize);
+ if (IsConformantArray(left->nd_type)) {
+ DoHIGH(left);
+ if (tp->arr_elem->tp_size != left->nd_type->arr_elem->tp_size) {
+ /* This can only happen if the formal type is
+ ARRAY OF WORD
+ */
+ /* ??? */
+ }
+ }
+ else if (left->nd_symb == STRING) {
+ C_loc(left->nd_SLE);
+ }
+ else if (tp->arr_elem == word_type) {
+ C_loc(left->nd_type->tp_size / word_size - 1);
+ }
+ else {
+ tp = left->nd_type->next;
+ if (tp->tp_fund == T_SUBRANGE) {
+ C_loc(tp->sub_ub - tp->sub_lb);
+ }
+ else C_loc((arith) (tp->enm_ncst - 1));
+ }
+ C_loc((arith) 0);
+ if (left->nd_symb == STRING) {
+ CodeString(left);
+ }
+ else CodeDAddress(left);
+ }
+ else if (IsVarParam(param)) {
+ CodeDAddress(left);
+ }
+ else {
+ if (left->nd_type->tp_fund == T_STRING) {
+ CodePadString(left, tp->tp_size);
+ }
+ else CodePExpr(left);
+ CheckAssign(left->nd_type, tp);
+ }
+}
+
CodeStd(nd)
struct node *nd;
{
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
arg = arg->nd_right;
}
- Desig = InitDesig;
switch(std = nd->nd_left->nd_def->df_value.df_stdname) {
case S_ABS:
*/
arith llo, lhi, rlo, rhi;
- label l = 0;
- extern label getrck();
if (bounded(tpl)) {
/* in this case we might need a range check */
if (!bounded(tpr)) {
/* yes, we need one */
- l = getrck(tpl);
+ genrck(tpl);
}
else {
/* both types are restricted. check the bounds
getbounds(tpl, &llo, &lhi);
getbounds(tpr, &rlo, &rhi);
if (llo > rlo || lhi < rhi) {
- l = getrck(tpl);
+ genrck(tpl);
}
}
-
- if (l) {
- C_lae_dlb(l, (arith) 0);
- C_rck(word_size);
- }
}
}
{
register struct type *tp = nd->nd_type;
+ CodePExpr(nd->nd_right);
switch(nd->nd_symb) {
case '~':
case NOT:
{
struct type *tp;
struct def *df;
- struct def *lookfor();
struct node *nd;
} :
POINTER TO
extern struct def
*define(),
- *lookup(),
+ *DefineLocalModule(),
+ *MkDef(),
*ill_df;
+extern struct def
+ *lookup(),
+ *lookfor();
#define NULLDEF ((struct def *) 0)
df->for_node = MkLeaf(Name, &dot);
sprint(buf,"%s_%s",CurrentScope->sc_name,df->df_idf->id_text);
df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
- C_exp(df->for_name);
+ if (CurrVis == Defined->mod_vis) C_exp(df->for_name);
open_scope(OPENSCOPE);
}
else {
}
}
+struct def *
+DefineLocalModule(id)
+ struct idf *id;
+{
+ /* Create a definition for a local module. Also give it
+ a name to be used for code generation.
+ */
+ register struct def *df = define(id, CurrentScope, D_MODULE);
+ register struct type *tp;
+ register struct scope *sc;
+ static int modulecount = 0;
+ char buf[256];
+ extern char *sprint();
+ extern int proclevel;
+
+ sprint(buf, "_%d%s", ++modulecount, id->id_text);
+
+ if (!df->mod_vis) {
+ /* We never saw the name of this module before. Create a
+ scope for it.
+ */
+ open_scope(CLOSEDSCOPE);
+ df->mod_vis = CurrVis;
+ }
+
+ CurrVis = df->mod_vis;
+
+ sc = CurrentScope;
+ sc->sc_level = proclevel;
+ sc->sc_definedby = df;
+ sc->sc_name = Salloc(buf, (unsigned) (strlen(buf) + 1));
+
+ /* Create a type for it
+ */
+ df->df_type = tp = standard_type(T_RECORD, 0, (arith) 0);
+ tp->rec_scope = sc;
+
+ /* Generate code that indicates that the initialization procedure
+ for this module is local.
+ */
+ C_inp(buf);
+
+ return df;
+}
+
#ifdef DEBUG
PrDef(df)
register struct def *df;
#include "node.h"
extern int proclevel;
-struct desig Desig;
struct desig InitDesig = {DSG_INIT, 0, 0};
CodeValue(ds, size)
*/
assert(ds->dsg_kind == DSG_INIT);
+ df->df_flags |= D_USED;
if (df->var_addrgiven) {
/* the programmer specified an address in the declaration of
the variable. Generate code to push the address.
CodeConst(df->var_off, pointer_size);
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = 0;
- df->df_flags |= D_NOREG;
return;
}
ds->dsg_name = df->var_name;
ds->dsg_offset = 0;
ds->dsg_kind = DSG_FIXED;
- df->df_flags |= D_NOREG;
return;
}
/* the variable is local to a statically enclosing procedure.
*/
assert(proclevel > sc->sc_level);
+
+ df->df_flags |= D_NOREG;
if (df->df_flags & (D_VARPAR|D_VALPAR)) {
/* value or var parameter
*/
else C_lxl((arith) (proclevel - sc->sc_level));
ds->dsg_kind = DSG_PLOADED;
ds->dsg_offset = df->var_off;
- df->df_flags |= D_NOREG;
return;
}
};
extern struct withdesig *WithDesigs;
-extern struct desig Desig, InitDesig;
+extern struct desig InitDesig;
#define NO_LABEL ((label) 0)
/* An address was supplied
*/
df->var_addrgiven = 1;
+ df->df_flags |= D_NOREG;
if (idlist->nd_left->nd_type != card_type) {
node_error(idlist->nd_left,"Illegal type for address");
}
sprint(buf,"%s_%s", sc->sc_scope->sc_name,
df->df_idf->id_text);
df->var_name = Salloc(buf, (unsigned)(strlen(buf)+1));
+ df->df_flags |= D_NOREG;
if (DefinitionModule) {
- C_exa_dnam(df->var_name);
+ if (sc == Defined->mod_vis) {
+ C_exa_dnam(df->var_name);
+ }
}
else {
C_ina_dnam(df->var_name);
register struct paramlist *pr;
register struct def *df;
register struct node *idlist = Idlist;
+ static struct paramlist *last;
for ( ; idlist; idlist = idlist->next) {
pr = new_paramlist();
- pr->next = *ppr;
- *ppr = pr;
+ pr->next = 0;
+ if (!*ppr) {
+ *ppr = pr;
+ }
+ else last->next = pr;
+ last = pr;
df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE);
pr->par_def = df;
df->df_type = type;
FreeNode(Idlist);
}
-static
+STATIC
DoImport(df, scope)
register struct def *df;
struct scope *scope;
}
}
-static struct scopelist *
+STATIC struct scopelist *
ForwModule(df, idn)
register struct def *df;
struct node *idn;
return vis;
}
-static struct def *
+STATIC struct def *
ForwDef(ids, scope)
register struct node *ids;
struct scope *scope;
register struct def *df;
struct scopelist *vis = enclosing(CurrVis);
int forwflag = 0;
- extern struct def *lookfor(), *GetDefinitionModule();
+ extern struct def *GetDefinitionModule();
if (local) {
df = lookfor(Fromid, vis, 0);
register struct node *idlist = Idlist;
register struct def *df;
struct scopelist *vis = enclosing(CurrVis);
- extern struct def *lookfor(), *GetDefinitionModule();
+ extern struct def *GetDefinitionModule();
for (; idlist; idlist = idlist->next) {
if (local) df = ForwDef(idlist, vis->sc_scope);
#include "node.h"
#include "const.h"
#include "type.h"
+#include "chk_expr.h"
}
-number(struct node **p;)
-{
- struct type *tp;
-} :
+number(struct node **p;) :
[
%default
- INTEGER { tp = toktype; }
+ INTEGER
|
- REAL { tp = real_type; }
+ REAL
] { *p = MkLeaf(Value, &dot);
- (*p)->nd_type = tp;
+ (*p)->nd_type = toktype;
}
;
#include "LLlex.h"
#include "node.h"
-extern struct def *MkDef();
-
struct def *
lookup(id, scope)
register struct idf *id;
#include "node.h"
match_id(id1, id2)
- struct idf *id1, *id2;
+ register struct idf *id1, *id2;
{
/* Check that identifiers id1 and id2 are equal. If they
are not, check that we did'nt generate them in the
}
id_not_declared(id)
- struct node *id;
+ register struct node *id;
{
/* The identifier "id" is not declared. If it is not generated,
give an error message
#define Def 9 /* an identified name */
#define Stat 10 /* a statement */
#define Link 11
+ /* do NOT change the order or the numbers!!! */
struct type *nd_type; /* type of this node */
struct token nd_token;
#define nd_set nd_token.tk_data.tk_set
free_node(nd);
}
+NodeCrash(expp)
+ struct node *expp;
+{
+ crash("Illegal node %d", expp->nd_class);
+}
+
#ifdef DEBUG
extern char *symbol2str();
-static
+STATIC
printnode(nd)
register struct node *nd;
{
ModuleDeclaration
{
struct idf *id;
- register struct def *df;
- extern int proclevel;
- static int modulecount = 0;
- char buf[256];
+ struct def *df;
struct node *nd;
struct node *exportlist = 0;
int qualified;
- extern char *sprint();
} :
- MODULE IDENT {
- id = dot.TOK_IDF;
- df = define(id, CurrentScope, D_MODULE);
-
- if (!df->mod_vis) {
- open_scope(CLOSEDSCOPE);
- df->mod_vis = CurrVis;
- }
- else {
- CurrVis = df->mod_vis;
- CurrentScope->sc_level = proclevel;
- }
- CurrentScope->sc_definedby = df;
-
- df->df_type = standard_type(T_RECORD, 0, (arith) 0);
- df->df_type->rec_scope = df->mod_vis->sc_scope;
- sprint(buf, "_%d%s", ++modulecount, id->id_text);
- CurrentScope->sc_name =
- Salloc(buf, (unsigned) (strlen(buf) + 1));
- if (! proclevel) C_ina_dnam(&buf[1]);
- C_inp(buf);
+ MODULE IDENT { id = dot.TOK_IDF;
+ df = DefineLocalModule(id);
}
priority(&(df->mod_priority))?
';'
struct node *nd;
} :
'[' ConstExpression(&nd) ']'
- { if (!(nd->nd_type->tp_fund & T_INTORCARD)) {
+ { if (!(nd->nd_type->tp_fund & T_CARDINAL)) {
node_error(nd, "Illegal priority");
}
*pprio = nd->nd_INT;
int dummy;
} :
DEFINITION
- MODULE IDENT {
- id = dot.TOK_IDF;
+ MODULE IDENT { id = dot.TOK_IDF;
df = define(id, GlobalScope, D_MODULE);
- if (!SYSTEMModule) open_scope(CLOSEDSCOPE);
if (!Defined) Defined = df;
- df->mod_vis = CurrVis;
+ if (!SYSTEMModule) open_scope(CLOSEDSCOPE);
CurrentScope->sc_name = id->id_text;
+ df->mod_vis = CurrVis;
df->df_type = standard_type(T_RECORD, 0, (arith) 0);
df->df_type->rec_scope = df->mod_vis->sc_scope;
DefinitionModule++;
struct node *nd;
} :
MODULE
- IDENT {
- id = dot.TOK_IDF;
+ IDENT { id = dot.TOK_IDF;
if (state == IMPLEMENTATION) {
df = GetDefinitionModule(id);
CurrVis = df->mod_vis;
}
else {
df = define(id, CurrentScope, D_MODULE);
- Defined = df;
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
CurrentScope->sc_name = id->id_text;
}
+ Defined = df;
CurrentScope->sc_definedby = df;
}
priority(&(df->mod_priority))?
CurrentScope->sc_forw = f;
}
-static
+STATIC
chk_proc(df)
register struct def *df;
{
}
}
-static
+STATIC
chk_forw(pdf)
register struct def **pdf;
{
}
}
-static
+STATIC
rem_forwards(fo)
struct forwards *fo;
{
*/
register struct forwards *f;
register struct def *df;
- struct def *lookfor();
while (f = fo) {
df = lookfor(&(f->fo_tok), CurrVis, 1);
/* Reverse the order in the list of definitions in a scope.
This is neccesary because this list is built in reverse.
Also, while we're at it, remove uninteresting definitions
- from this list. The only interesting definitions are:
- D_MODULE, D_PROCEDURE, and D_PROCHEAD.
+ from this list.
*/
register struct def *df, *df1;
-#define INTERESTING D_MODULE|D_PROCEDURE|D_PROCHEAD
+#define INTERESTING D_MODULE|D_PROCEDURE|D_PROCHEAD|D_VARIABLE
df = 0;
df1 = *pdf;
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);
StatementSequence(register struct node **pnd;)
{
+ struct node *nd;
} :
statement(pnd)
[
- ';' { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);
- pnd = &((*pnd)->nd_right);
+ ';' statement(&nd)
+ { if (nd) {
+ *pnd = MkNode(Link, *pnd, nd, &dot);
+ (*pnd)->nd_symb = ';';
+ pnd = &((*pnd)->nd_right);
+ }
}
- statement(pnd)
]*
;
#include "const.h"
#include "scope.h"
-/* To be created dynamically in main() from defaults or from command
- line parameters.
-*/
int
word_align = AL_WORD,
int_align = AL_INT,
switch (fund) {
case T_PROCEDURE:
+ if (tp && !returntype(tp)) {
+ error("illegal procedure result type");
+ }
+ /* Fall through */
case T_POINTER:
case T_HIDDEN:
dtp->tp_align = pointer_align;
dtp->tp_size = pointer_size;
- dtp->next = tp;
- if (fund == T_PROCEDURE && tp) {
- if (! returntype(tp)) {
- error("illegal procedure result type");
- }
- }
break;
case T_SET:
dtp->tp_align = word_align;
- dtp->next = tp;
break;
case T_ARRAY:
dtp->tp_align = tp->tp_align;
- dtp->next = tp;
break;
case T_SUBRANGE:
dtp->tp_align = tp->tp_align;
dtp->tp_size = tp->tp_size;
- dtp->next = tp;
break;
default:
crash("funny type constructor");
}
+ dtp->next = tp;
return dtp;
}
address_type = construct_type(T_POINTER, word_type);
/* create BITSET type
+ TYPE BITSET = SET OF [0..W-1];
+ The subrange is a subrange of type cardinal, because the lower bound
+ is a non-negative integer (See Rep. 6.3)
*/
- tp = construct_type(T_SUBRANGE, int_type);
+ tp = construct_type(T_SUBRANGE, card_type);
tp->sub_lb = 0;
tp->sub_ub = word_size * 8 - 1;
bitset_type = set_type(tp);
if (base->tp_fund == T_SUBRANGE) {
/* Check that the bounds of "tp" fall within the range
- of "base"
+ of "base".
*/
if (base->sub_lb > tp->sub_lb || base->sub_ub < tp->sub_ub) {
error("Base type has insufficient range");
error("Illegal base for a subrange");
}
else if (base == int_type && tp->next == card_type &&
- (tp->sub_ub > max_int || tp->sub_ub)) {
+ (tp->sub_ub > max_int || tp->sub_ub < 0)) {
error("Upperbound to large for type INTEGER");
}
else if (base != tp->next && base != int_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");
+ node_error(ub, "Types of subrange bounds not equal");
return error_type;
}
return res;
}
-label
-getrck(tp)
+genrck(tp)
register struct type *tp;
{
/* generate a range check descriptor for type "tp" when
- neccessary. Return its label
+ neccessary. Return its label.
*/
+ arith lb, ub;
+ label ol, l;
- assert(bounded(tp));
+ getbounds(tp, &lb, &ub);
if (tp->tp_fund == T_SUBRANGE) {
- if (tp->sub_rck == (label) 0) {
- tp->sub_rck = data_label();
- C_df_dlb(tp->sub_rck);
- C_rom_cst(tp->sub_lb);
- C_rom_cst(tp->sub_ub);
+ if (!(ol = tp->sub_rck)) {
+ tp->sub_rck = l = data_label();
}
- return tp->sub_rck;
}
- if (tp->enm_rck == (label) 0) {
- tp->enm_rck = data_label();
- C_df_dlb(tp->enm_rck);
- C_rom_cst((arith) 0);
- C_rom_cst((arith) (tp->enm_ncst - 1));
+ else if (!(ol = tp->enm_rck)) {
+ tp->enm_rck = l = data_label();
+ }
+ if (!ol) {
+ ol = l;
+ C_df_dlb(ol);
+ C_rom_cst(lb);
+ C_rom_cst(ub);
}
- return tp->enm_rck;
+ C_lae_dlb(ol, (arith) 0);
+ C_rck(word_size);
}
getbounds(tp, plo, phi)
*phi = tp->enm_ncst - 1;
}
}
+
struct type *
set_type(tp)
register struct type *tp;
*/
arith lb, ub;
- if (tp->tp_fund == T_SUBRANGE) {
- if ((lb = tp->sub_lb) < 0 || (ub = tp->sub_ub) > MAXSET - 1) {
- error("Set type limits exceeded");
- return error_type;
- }
- }
- else if (tp->tp_fund == T_ENUMERATION || tp == char_type) {
- lb = 0;
- if ((ub = tp->enm_ncst - 1) > MAXSET - 1) {
- error("Set type limits exceeded");
- return error_type;
- }
- }
- else {
+ if (! bounded(tp)) {
error("illegal base type for set");
return error_type;
}
+ getbounds(tp, &lb, &ub);
+
+ if (lb < 0 || ub > MAXSET-1) {
+ error("Set type limits exceeded");
+ return error_type;
+ }
+
tp = construct_type(T_SET, tp);
- tp->tp_size = WA(((ub - lb) + 7)/8);
+ tp->tp_size = WA(((ub - lb) + 8)/8);
return tp;
}
*/
register struct type *index_type = tp->next;
register struct type *elem_type = tp->arr_elem;
+ arith lo, hi;
tp->arr_elsize = ArrayElSize(elem_type);
tp->tp_align = elem_type->tp_align;
/* check index type
*/
- if (! (index_type->tp_fund & T_INDEX)) {
+ if (! bounded(index_type)) {
error("Illegal index type");
tp->tp_size = 0;
return;
}
- /* find out HIGH, LOW and size of ARRAY
+ getbounds(index_type, &lo, &hi);
+
+ tp->tp_size = WA((hi - lo + 1) * tp->arr_elsize);
+
+ /* generate descriptor and remember label.
*/
tp->arr_descr = data_label();
C_df_dlb(tp->arr_descr);
-
- switch(index_type->tp_fund) {
- case T_SUBRANGE:
- tp->tp_size = tp->arr_elsize *
- (index_type->sub_ub - index_type->sub_lb + 1);
- C_rom_cst(index_type->sub_lb);
- C_rom_cst(index_type->sub_ub - index_type->sub_lb);
- break;
-
- case T_CHAR:
- case T_ENUMERATION:
- tp->tp_size = tp->arr_elsize * index_type->enm_ncst;
- C_rom_cst((arith) 0);
- C_rom_cst((arith) (index_type->enm_ncst - 1));
- break;
-
- default:
- crash("Funny index type");
- }
-
+ C_rom_cst(lo);
+ C_rom_cst(hi - lo);
C_rom_cst(tp->arr_elsize);
- tp->tp_size = WA(tp->tp_size);
-
- /* ??? overflow checking ???
- */
}
FreeType(tp)
#include <em_arith.h>
#include <em_label.h>
+#include <em_reg.h>
#include <assert.h>
#include "def.h"
#include "desig.h"
#include "f_info.h"
#include "idf.h"
+#include "chk_expr.h"
extern arith NewPtr();
extern arith NewInt();
return ++datalabel;
}
-static
+STATIC
DoProfil()
{
static label filename_label = 0;
struct node *nd;
if (state == IMPLEMENTATION) {
- label l1 = data_label(), l2 = text_label();
+ label l1 = data_label();
/* we don't actually prevent recursive calls,
but do nothing if called recursively
*/
C_df_dlb(l1);
C_bss_cst(word_size, (arith) 0, 1);
C_loe_dlb(l1, (arith) 0);
- C_zeq(l2);
- C_ret((arith) 0);
- C_df_ilb(l2);
+ C_zne((label) 1);
C_loc((arith) 1);
C_ste_dlb(l1, (arith) 0);
}
*/
struct scopelist *vis = CurrVis;
register struct scope *sc;
- register struct type *res_type;
+ register struct type *tp;
+ register struct paramlist *param;
proclevel++;
CurrVis = procedure->prc_vis;
MkCalls(sc->sc_def);
return_expr_occurred = 0;
instructionlabel = 2;
- func_type = res_type = procedure->df_type->next;
- if (! returntype(res_type)) {
+ func_type = tp = procedure->df_type->next;
+ if (! returntype(tp)) {
node_error(procedure->prc_body, "illegal result type");
}
WalkNode(procedure->prc_body, (label) 0);
C_df_ilb((label) 1);
- if (res_type) {
+ if (tp) {
if (! return_expr_occurred) {
node_error(procedure->prc_body,"function procedure does not return a value");
}
- C_ret(WA(res_type->tp_size));
+ C_ret(WA(tp->tp_size));
}
else C_ret((arith) 0);
+ RegisterMessages(sc->sc_def);
C_end(-sc->sc_off);
TmpClose();
CurrVis = vis;
*/
register struct node *left = nd->nd_left;
register struct node *right = nd->nd_right;
- register struct desig *pds = &Desig;
if (!nd) {
/* Empty statement
{
struct scopelist link;
struct withdesig wds;
+ struct desig ds;
arith tmp = 0;
- WalkDesignator(left);
+ WalkDesignator(left, &ds);
if (left->nd_type->tp_fund != T_RECORD) {
node_error(left, "record variable expected");
break;
wds.w_next = WithDesigs;
WithDesigs = &wds;
wds.w_scope = left->nd_type->rec_scope;
- if (pds->dsg_kind != DSG_PFIXED) {
+ if (ds.dsg_kind != DSG_PFIXED) {
/* In this case, we use a temporary variable
*/
- CodeAddress(pds);
- pds->dsg_kind = DSG_FIXED;
- /* Only for the store ... */
- pds->dsg_offset = tmp = NewPtr();
- pds->dsg_name = 0;
- CodeStore(pds, pointer_size);
- pds->dsg_kind = DSG_PFIXED;
+ CodeAddress(&ds);
+ ds.dsg_kind = DSG_FIXED;
+ /* Create a designator structure for the
+ temporary.
+ */
+ ds.dsg_offset = tmp = NewPtr();
+ ds.dsg_name = 0;
+ CodeStore(&ds, pointer_size);
+ ds.dsg_kind = DSG_PFIXED;
/* the record is indirectly available */
}
- wds.w_desig = *pds;
+ wds.w_desig = ds;
link.sc_scope = wds.w_scope;
link.next = CurrVis;
CurrVis = &link;
break;
default:
- assert(0);
+ crash("(WalkStat)");
}
}
/* "nd" must indicate a boolean expression. Check this and
generate code to evaluate the expression.
*/
+ struct desig ds;
if (!chk_expr(nd)) return;
node_error(nd, "boolean expression expected");
}
- Desig = InitDesig;
- CodeExpr(nd, &Desig, true_label, false_label);
+ ds = InitDesig;
+ CodeExpr(nd, &ds, true_label, false_label);
}
WalkExpr(nd)
CodePExpr(nd);
}
-WalkDesignator(nd)
+WalkDesignator(nd, ds)
struct node *nd;
+ struct desig *ds;
{
/* Check designator and generate code for it
*/
if (! chk_designator(nd, DESIGNATOR|VARIABLE, D_DEFINED)) return;
- Desig = InitDesig;
- CodeDesig(nd, &Desig);
+ *ds = InitDesig;
+ CodeDesig(nd, ds);
}
DoForInit(nd, left)
register struct node *left, *right;
{
/* May we do it in this order (expression first) ??? */
- struct desig ds;
+ struct desig dsl, dsr;
if (!chk_expr(right)) return;
if (! chk_designator(left, DESIGNATOR|VARIABLE, D_DEFINED)) return;
TryToString(right, left->nd_type);
- Desig = InitDesig;
- CodeExpr(right, &Desig, NO_LABEL, NO_LABEL);
+ dsr = InitDesig;
+ CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
if (! TstAssCompat(left->nd_type, right->nd_type)) {
node_error(nd, "type incompatibility in assignment");
}
if (complex(right->nd_type)) {
- CodeAddress(&Desig);
+ CodeAddress(&dsr);
}
else {
- CodeValue(&Desig, right->nd_type->tp_size);
+ CodeValue(&dsr, right->nd_type->tp_size);
CheckAssign(left->nd_type, right->nd_type);
}
- ds = Desig;
- Desig = InitDesig;
- CodeDesig(left, &Desig);
+ dsl = InitDesig;
+ CodeDesig(left, &dsl);
+
+ CodeAssign(nd, &dsr, &dsl);
+}
+
+RegisterMessages(df)
+ register struct def *df;
+{
+ struct type *tp;
- CodeAssign(nd, &ds, &Desig);
+ for (; df; df = df->df_nextinscope) {
+ if (df->df_kind == D_VARIABLE && !(df->df_flags & D_NOREG)) {
+ /* Examine type and size
+ */
+ tp = df->df_type;
+ if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+ if ((tp->tp_fund & T_NUMERIC) &&
+ tp->tp_size <= dword_size) {
+ C_ms_reg(df->var_off,
+ tp->tp_size,
+ tp->tp_fund == T_REAL ?
+ reg_float : reg_any,
+ 0);
+ }
+ else if ((df->df_flags & D_VARPAR) ||
+ tp->tp_fund == T_POINTER) {
+ C_ms_reg(df->var_off, pointer_size,
+ reg_pointer, 0);
+ }
+ }
+ }
}
#ifdef DEBUG
public / ack.git / commitdiff