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

Changes to make node structure smaller, and cleaned up a bit

Browse source
This commit is contained in:
ceriel 1991-03-12 16:52:00 +00:00
parent 20b17c3eb2
commit 0a517b9256
25 changed files with 950 additions and 817 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lang/m2/comp/.distr
View file

@ -13,7 +13,6 @@ chk_expr.c
chk_expr.h chk_expr.h
class.h class.h
code.c code.c
const.h
cstoper.c cstoper.c
debug.h debug.h
declar.g declar.g

1
lang/m2/comp/LLlex.c
View file

@ -27,7 +27,6 @@
#include "idf.h" #include "idf.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "const.h"
#include "warning.h" #include "warning.h"
extern long str2long(); extern long str2long();

32
lang/m2/comp/LLlex.h
View file

@ -18,19 +18,35 @@ struct string {
char *s_str; /* the string itself */ char *s_str; /* the string itself */
}; };
union tk_attr {
struct string *tk_str;
arith tk_int;
struct real *tk_real;
struct {
union {
arith *tky_set;
struct idf *tky_idf;
struct def *tky_def;
} tk_yy;
struct node *tky_next;
} tk_y;
struct {
struct node *tkx_left, *tkx_right;
} tk_x;
};
#define tk_left tk_x.tkx_left
#define tk_right tk_x.tkx_right
#define tk_next tk_y.tky_next
#define tk_idf tk_y.tk_yy.tky_idf
#define tk_def tk_y.tk_yy.tky_def
#define tk_set tk_y.tk_yy.tky_set
/* Token structure. Keep it small, as it is part of a parse-tree node /* Token structure. Keep it small, as it is part of a parse-tree node
*/ */
struct token { struct token {
short tk_symb; /* token itself */ short tk_symb; /* token itself */
unsigned short tk_lineno; /* linenumber on which it occurred */ unsigned short tk_lineno; /* linenumber on which it occurred */
union { union tk_attr tk_data;
struct idf *tk_idf; /* IDENT */
struct string *tk_str; /* STRING */
arith tk_int; /* INTEGER */
struct real *tk_real; /* REAL */
arith *tk_set; /* only used in parse tree node */
struct def *tk_def; /* only used in parse tree node */
} tk_data;
}; };
typedef struct token t_token; typedef struct token t_token;

8
lang/m2/comp/Makefile
View file

@ -79,7 +79,7 @@ GENH = errout.h \
def.h debugcst.h type.h Lpars.h node.h desig.h strict3rd.h real.h \ def.h debugcst.h type.h Lpars.h node.h desig.h strict3rd.h real.h \
use_insert.h dbsymtab.h use_insert.h dbsymtab.h
HFILES =LLlex.h \ HFILES =LLlex.h \
chk_expr.h class.h const.h debug.h f_info.h idf.h \ chk_expr.h class.h debug.h f_info.h idf.h \
input.h main.h misc.h scope.h standards.h tokenname.h \ input.h main.h misc.h scope.h standards.h tokenname.h \
walk.h warning.h SYSTEM.h $(GENH) walk.h warning.h SYSTEM.h $(GENH)
# #
@ -212,7 +212,6 @@ LLlex.o: LLlex.h
LLlex.o: Lpars.h LLlex.o: Lpars.h
LLlex.o: bigparam.h LLlex.o: bigparam.h
LLlex.o: class.h LLlex.o: class.h
LLlex.o: const.h
LLlex.o: dbsymtab.h LLlex.o: dbsymtab.h
LLlex.o: debug.h LLlex.o: debug.h
LLlex.o: debugcst.h LLlex.o: debugcst.h
@ -278,7 +277,6 @@ input.o: inputtype.h
type.o: LLlex.h type.o: LLlex.h
type.o: bigparam.h type.o: bigparam.h
type.o: chk_expr.h type.o: chk_expr.h
type.o: const.h
type.o: dbsymtab.h type.o: dbsymtab.h
type.o: debug.h type.o: debug.h
type.o: debugcst.h type.o: debugcst.h
@ -381,7 +379,6 @@ node.o: type.h
cstoper.o: LLlex.h cstoper.o: LLlex.h
cstoper.o: Lpars.h cstoper.o: Lpars.h
cstoper.o: bigparam.h cstoper.o: bigparam.h
cstoper.o: const.h
cstoper.o: dbsymtab.h cstoper.o: dbsymtab.h
cstoper.o: debug.h cstoper.o: debug.h
cstoper.o: debugcst.h cstoper.o: debugcst.h
@ -397,7 +394,6 @@ chk_expr.o: LLlex.h
chk_expr.o: Lpars.h chk_expr.o: Lpars.h
chk_expr.o: bigparam.h chk_expr.o: bigparam.h
chk_expr.o: chk_expr.h chk_expr.o: chk_expr.h
chk_expr.o: const.h
chk_expr.o: dbsymtab.h chk_expr.o: dbsymtab.h
chk_expr.o: debug.h chk_expr.o: debug.h
chk_expr.o: debugcst.h chk_expr.o: debugcst.h
@ -502,7 +498,6 @@ lookup.o: target_sizes.h
lookup.o: type.h lookup.o: type.h
stab.o: LLlex.h stab.o: LLlex.h
stab.o: bigparam.h stab.o: bigparam.h
stab.o: const.h
stab.o: dbsymtab.h stab.o: dbsymtab.h
stab.o: def.h stab.o: def.h
stab.o: idf.h stab.o: idf.h
@ -556,7 +551,6 @@ expression.o: LLlex.h
expression.o: Lpars.h expression.o: Lpars.h
expression.o: bigparam.h expression.o: bigparam.h
expression.o: chk_expr.h expression.o: chk_expr.h
expression.o: const.h
expression.o: dbsymtab.h expression.o: dbsymtab.h
expression.o: debug.h expression.o: debug.h
expression.o: debugcst.h expression.o: debugcst.h

36
lang/m2/comp/casestat.C
View file

@ -97,25 +97,25 @@ CaseCode(nd, exitlabel, end_reached)
assert(pnode->nd_class == Stat && pnode->nd_symb == CASE); assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
if (ChkExpression(pnode->nd_left)) { if (ChkExpression(&(pnode->nd_LEFT))) {
MkCoercion(&(pnode->nd_left),BaseType(pnode->nd_left->nd_type)); MkCoercion(&(pnode->nd_LEFT),BaseType(pnode->nd_LEFT->nd_type));
CodePExpr(pnode->nd_left); CodePExpr(pnode->nd_LEFT);
} }
sh->sh_type = pnode->nd_left->nd_type; sh->sh_type = pnode->nd_LEFT->nd_type;
sh->sh_break = ++text_label; sh->sh_break = ++text_label;
/* Now, create case label list /* Now, create case label list
*/ */
while (pnode = pnode->nd_right) { while (pnode = pnode->nd_RIGHT) {
if (pnode->nd_class == Link && pnode->nd_symb == '|') { if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_left) { if (pnode->nd_LEFT) {
/* non-empty case /* non-empty case
*/ */
pnode->nd_left->nd_lab = ++text_label; pnode->nd_LEFT->nd_lab = ++text_label;
AddCases(sh, /* to descriptor */ AddCases(sh, /* to descriptor */
pnode->nd_left->nd_left, pnode->nd_LEFT->nd_LEFT,
/* of case labels */ /* of case labels */
(label) pnode->nd_left->nd_lab (label) pnode->nd_LEFT->nd_lab
/* and code label */ /* and code label */
); );
} }
@ -192,11 +192,11 @@ CaseCode(nd, exitlabel, end_reached)
*/ */
pnode = nd; pnode = nd;
rval = 0; rval = 0;
while (pnode = pnode->nd_right) { while (pnode = pnode->nd_RIGHT) {
if (pnode->nd_class == Link && pnode->nd_symb == '|') { if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_left) { if (pnode->nd_LEFT) {
rval |= LblWalkNode((label) pnode->nd_left->nd_lab, rval |= LblWalkNode((label) pnode->nd_LEFT->nd_lab,
pnode->nd_left->nd_right, pnode->nd_LEFT->nd_RIGHT,
exitlabel, end_reached); exitlabel, end_reached);
C_bra(sh->sh_break); C_bra(sh->sh_break);
} }
@ -245,16 +245,16 @@ AddCases(sh, node, lbl)
if (node->nd_class == Link) { if (node->nd_class == Link) {
if (node->nd_symb == UPTO) { if (node->nd_symb == UPTO) {
assert(node->nd_left->nd_class == Value); assert(node->nd_LEFT->nd_class == Value);
assert(node->nd_right->nd_class == Value); assert(node->nd_RIGHT->nd_class == Value);
AddOneCase(sh, node->nd_left, node->nd_right, lbl); AddOneCase(sh, node->nd_LEFT, node->nd_RIGHT, lbl);
return; return;
} }
assert(node->nd_symb == ','); assert(node->nd_symb == ',');
AddCases(sh, node->nd_left, lbl); AddCases(sh, node->nd_LEFT, lbl);
AddCases(sh, node->nd_right, lbl); AddCases(sh, node->nd_RIGHT, lbl);
return; return;
} }

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

File diff suppressed because it is too large Load diff

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

@ -16,9 +16,8 @@ extern int (*DesigChkTable[])(); /* table of designator checking
functions, indexed by node class functions, indexed by node class
*/ */
#define ChkExpression(expp) ((*ExprChkTable[(expp)->nd_class])(expp,D_USED)) #define ChkExpression(expp) ((*ExprChkTable[(*expp)->nd_class])(expp,D_USED))
#define ChkDesignator(expp) ((*DesigChkTable[(expp)->nd_class])(expp,0)) #define ChkDesig(expp, flags) ((*DesigChkTable[(*expp)->nd_class])(expp,flags))
#define ChkDesig(expp, flags) ((*DesigChkTable[(expp)->nd_class])(expp,flags))
/* handle reference counts for sets */ /* handle reference counts for sets */
#define inc_refcount(s) (*((int *)(s) - 1) += 1) #define inc_refcount(s) (*((int *)(s) - 1) += 1)

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

@ -38,19 +38,6 @@ extern int proclevel;
extern char options[]; extern char options[];
int fp_used; int fp_used;
STATIC char *
NameOfProc(df)
register t_def *df;
{
assert(df->df_kind & (D_PROCHEAD|D_PROCEDURE));
if (df->df_kind == D_PROCEDURE) {
return df->prc_vis->sc_scope->sc_name;
}
return df->for_name;
}
CodeConst(cst, size) CodeConst(cst, size)
arith cst; arith cst;
int size; int size;
@ -100,7 +87,7 @@ CodeExpr(nd, ds, true_label, false_label)
switch(nd->nd_class) { switch(nd->nd_class) {
case Def: case Def:
if (nd->nd_def->df_kind & (D_PROCEDURE|D_PROCHEAD)) { if (nd->nd_def->df_kind & (D_PROCEDURE|D_PROCHEAD)) {
C_lpi(NameOfProc(nd->nd_def)); C_lpi(nd->nd_def->prc_name);
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
break; break;
} }
@ -317,7 +304,7 @@ CodeCall(nd)
/* Generate code for a procedure call. Checking of parameters /* Generate code for a procedure call. Checking of parameters
and result is already done. and result is already done.
*/ */
register t_node *left = nd->nd_left; register t_node *left = nd->nd_LEFT;
t_type *result_tp; t_type *result_tp;
int needs_fn; int needs_fn;
@ -335,8 +322,8 @@ CodeCall(nd)
} }
#endif #endif
if (nd->nd_right) { if (nd->nd_RIGHT) {
CodeParameters(ParamList(left->nd_type), nd->nd_right); CodeParameters(ParamList(left->nd_type), nd->nd_RIGHT);
} }
switch(left->nd_class) { switch(left->nd_class) {
@ -353,7 +340,7 @@ CodeCall(nd)
C_lxl((arith) (proclevel - level)); C_lxl((arith) (proclevel - level));
} }
needs_fn = df->df_scope->sc_defmodule; needs_fn = df->df_scope->sc_defmodule;
C_cal(NameOfProc(df)); C_cal(df->prc_name);
break; break;
}} }}
/* Fall through */ /* Fall through */
@ -379,32 +366,31 @@ CodeCall(nd)
CodeParameters(param, arg) CodeParameters(param, arg)
t_param *param; t_param *param;
t_node *arg; register t_node *arg;
{ {
register t_type *tp; register t_type *tp;
register t_node *left; register t_type *arg_type;
register t_type *left_type;
assert(param != 0 && arg != 0); assert(param != 0 && arg != 0);
if (param->par_next) { if (param->par_next) {
CodeParameters(param->par_next, arg->nd_right); CodeParameters(param->par_next, arg->nd_RIGHT);
} }
tp = TypeOfParam(param); tp = TypeOfParam(param);
left = arg->nd_left; arg = arg->nd_LEFT;
left_type = left->nd_type; arg_type = arg->nd_type;
if (IsConformantArray(tp)) { if (IsConformantArray(tp)) {
register t_type *elem = tp->arr_elem; register t_type *elem = tp->arr_elem;
C_loc(tp->arr_elsize); C_loc(tp->arr_elsize);
if (IsConformantArray(left_type)) { if (IsConformantArray(arg_type)) {
DoHIGH(left->nd_def); DoHIGH(arg->nd_def);
if (elem->tp_size != left_type->arr_elem->tp_size) { if (elem->tp_size != arg_type->arr_elem->tp_size) {
/* This can only happen if the formal type is /* This can only happen if the formal type is
ARRAY OF (WORD|BYTE) ARRAY OF (WORD|BYTE)
*/ */
C_loc(left_type->arr_elem->tp_size); C_loc(arg_type->arr_elem->tp_size);
C_mli(word_size); C_mli(word_size);
if (elem == word_type) { if (elem == word_type) {
c_loc((int) word_size - 1); c_loc((int) word_size - 1);
@ -417,47 +403,47 @@ CodeParameters(param, arg)
} }
} }
} }
else if (left->nd_symb == STRING) { else if (arg->nd_symb == STRING) {
C_loc((arith)(left->nd_SLE - 1)); C_loc((arith)(arg->nd_SLE - 1));
} }
else if (elem == word_type) { else if (elem == word_type) {
C_loc((left_type->tp_size+word_size-1) / word_size - 1); C_loc((arg_type->tp_size+word_size-1) / word_size - 1);
} }
else if (elem == byte_type) { else if (elem == byte_type) {
C_loc(left_type->tp_size - 1); C_loc(arg_type->tp_size - 1);
} }
else { else {
C_loc(left_type->arr_high - left_type->arr_low); C_loc(arg_type->arr_high - arg_type->arr_low);
} }
c_loc(0); c_loc(0);
} }
if (IsConformantArray(tp) || IsVarParam(param) || IsBigParamTp(tp)) { if (IsConformantArray(tp) || IsVarParam(param) || IsBigParamTp(tp)) {
if (left->nd_symb == STRING) { if (arg->nd_symb == STRING) {
CodeString(left); CodeString(arg);
} }
else switch(left->nd_class) { else switch(arg->nd_class) {
case Arrsel: case Arrsel:
case Arrow: case Arrow:
case Def: case Def:
CodeDAddress(left, IsVarParam(param)); CodeDAddress(arg, IsVarParam(param));
break; break;
default:{ default:{
arith tmp, TmpSpace(); arith tmp, TmpSpace();
CodePExpr(left); CodePExpr(arg);
tmp = TmpSpace(left->nd_type->tp_size, left->nd_type->tp_align); tmp = TmpSpace(arg->nd_type->tp_size, arg->nd_type->tp_align);
STL(tmp, WA(left->nd_type->tp_size)); STL(tmp, WA(arg->nd_type->tp_size));
C_lal(tmp); C_lal(tmp);
} }
break; break;
} }
return; return;
} }
if (left_type->tp_fund == T_STRING) { if (arg_type->tp_fund == T_STRING) {
CodePString(left, tp); CodePString(arg, tp);
return; return;
} }
CodePExpr(left); CodePExpr(arg);
} }
CodePString(nd, tp) CodePString(nd, tp)
@ -499,15 +485,15 @@ addu(sz)
CodeStd(nd) CodeStd(nd)
t_node *nd; t_node *nd;
{ {
register t_node *arg = nd->nd_right; register t_node *arg = nd->nd_RIGHT;
register t_node *left = 0; register t_node *left = 0;
register t_type *tp = 0; register t_type *tp = 0;
int std = nd->nd_left->nd_def->df_value.df_stdname; int std = nd->nd_LEFT->nd_def->df_value.df_stdname;
if (arg) { if (arg) {
left = arg->nd_left; left = arg->nd_LEFT;
tp = BaseType(left->nd_type); tp = BaseType(left->nd_type);
arg = arg->nd_right; arg = arg->nd_RIGHT;
} }
switch(std) { switch(std) {
@ -573,8 +559,8 @@ CodeStd(nd)
CodePExpr(left); CodePExpr(left);
CodeCoercion(left->nd_type, tp); CodeCoercion(left->nd_type, tp);
if (arg) { if (arg) {
CodePExpr(arg->nd_left); CodePExpr(arg->nd_LEFT);
CodeCoercion(arg->nd_left->nd_type, tp); CodeCoercion(arg->nd_LEFT->nd_type, tp);
} }
else { else {
c_loc(1); c_loc(1);
@ -603,7 +589,7 @@ CodeStd(nd)
case S_INCL: case S_INCL:
case S_EXCL: case S_EXCL:
CodePExpr(left); CodePExpr(left);
CodePExpr(arg->nd_left); CodePExpr(arg->nd_LEFT);
C_loc(tp->set_low); C_loc(tp->set_low);
C_sbi(word_size); C_sbi(word_size);
C_set(tp->tp_size); C_set(tp->tp_size);
@ -668,8 +654,8 @@ Operands(nd)
register t_node *nd; register t_node *nd;
{ {
CodePExpr(nd->nd_left); CodePExpr(nd->nd_LEFT);
CodePExpr(nd->nd_right); CodePExpr(nd->nd_RIGHT);
DoLineno(nd); DoLineno(nd);
} }
@ -678,8 +664,8 @@ CodeOper(expr, true_label, false_label)
label true_label; label true_label;
label false_label; /* labels to jump to in logical expr's */ label false_label; /* labels to jump to in logical expr's */
{ {
register t_node *leftop = expr->nd_left; register t_node *leftop = expr->nd_LEFT;
register t_node *rightop = expr->nd_right; register t_node *rightop = expr->nd_RIGHT;
register t_type *tp = expr->nd_type; register t_type *tp = expr->nd_type;
switch (expr->nd_symb) { switch (expr->nd_symb) {
@ -991,7 +977,7 @@ CodeUoper(nd)
{ {
register t_type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
CodePExpr(nd->nd_right); CodePExpr(nd->nd_RIGHT);
switch(nd->nd_symb) { switch(nd->nd_symb) {
case NOT: case NOT:
C_teq(); C_teq();
@ -1010,8 +996,8 @@ CodeUoper(nd)
} }
break; break;
case COERCION: case COERCION:
CodeCoercion(nd->nd_right->nd_type, tp); CodeCoercion(nd->nd_RIGHT->nd_type, tp);
RangeCheck(tp, nd->nd_right->nd_type); RangeCheck(tp, nd->nd_RIGHT->nd_type);
break; break;
case CAST: case CAST:
break; break;
@ -1025,12 +1011,12 @@ CodeSet(nd)
{ {
register t_type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
nd = nd->nd_right; nd = nd->nd_NEXT;
while (nd) { while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ','); assert(nd->nd_class == Link && nd->nd_symb == ',');
if (nd->nd_left) CodeEl(nd->nd_left, tp); if (nd->nd_LEFT) CodeEl(nd->nd_LEFT, tp);
nd = nd->nd_right; nd = nd->nd_RIGHT;
} }
} }

275
lang/m2/comp/cstoper.c
View file

@ -24,16 +24,19 @@
#include "Lpars.h" #include "Lpars.h"
#include "standards.h" #include "standards.h"
#include "warning.h" #include "warning.h"
#include "const.h"
extern char *symbol2str(); extern char *symbol2str();
#define arith_sign ((arith) (1L << (sizeof(arith) * 8 - 1)))
arith full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */ arith full_mask[MAXSIZE];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
arith max_int[MAXSIZE]; /* max_int[1] == 0x7F, max_int[2] == 0x7FFF, .. */ arith max_int[MAXSIZE]; /* max_int[1] == 0x7F, max_int[2] == 0x7FFF, .. */
arith min_int[MAXSIZE]; /* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000, arith min_int[MAXSIZE]; /* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000,
... ...
*/ */
#ifndef NOCROSS
unsigned int wrd_bits; /* number of bits in a word */ unsigned int wrd_bits; /* number of bits in a word */
#endif
extern char options[]; extern char options[];
@ -55,24 +58,28 @@ underflow(expp)
STATIC STATIC
commonbin(expp) commonbin(expp)
register t_node *expp; register t_node **expp;
{ {
expp->nd_class = Value; register t_type *tp = (*expp)->nd_type;
expp->nd_token = expp->nd_right->nd_token; register t_node *right = (*expp)->nd_RIGHT;
CutSize(expp);
FreeLR(expp); (*expp)->nd_RIGHT = 0;
FreeNode(*expp);
*expp = right;
right->nd_type = tp;
} }
cstunary(expp) cstunary(expp)
register t_node *expp; t_node **expp;
{ {
/* The unary operation in "expp" is performed on the constant /* The unary operation in "expp" is performed on the constant
expression below it, and the result restored in expp. expression below it, and the result restored in expp.
*/ */
register t_node *right = expp->nd_right; register t_node *exp = *expp;
register t_node *right = exp->nd_RIGHT;
register arith o1 = right->nd_INT; register arith o1 = right->nd_INT;
switch(expp->nd_symb) { switch(exp->nd_symb) {
/* Should not get here /* Should not get here
case '+': case '+':
break; break;
@ -80,7 +87,7 @@ cstunary(expp)
case '-': case '-':
if (o1 == min_int[(int)(right->nd_type->tp_size)]) { if (o1 == min_int[(int)(right->nd_type->tp_size)]) {
overflow(expp); overflow(exp);
} }
o1 = -o1; o1 = -o1;
break; break;
@ -95,7 +102,8 @@ cstunary(expp)
} }
commonbin(expp); commonbin(expp);
expp->nd_INT = o1; (*expp)->nd_INT = o1;
CutSize(*expp);
} }
STATIC STATIC
@ -149,41 +157,42 @@ divide(pdiv, prem)
} }
cstibin(expp) cstibin(expp)
register t_node *expp; t_node **expp;
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expp. expressions below it, and the result restored in expp.
This version is for INTEGER expressions. This version is for INTEGER expressions.
*/ */
register arith o1 = expp->nd_left->nd_INT; register t_node *exp = *expp;
register arith o2 = expp->nd_right->nd_INT; register arith o1 = exp->nd_LEFT->nd_INT;
register int sz = expp->nd_type->tp_size; register arith o2 = exp->nd_RIGHT->nd_INT;
register int sz = exp->nd_type->tp_size;
assert(expp->nd_class == Oper); assert(exp->nd_class == Oper);
assert(expp->nd_left->nd_class == Value); assert(exp->nd_LEFT->nd_class == Value);
assert(expp->nd_right->nd_class == Value); assert(exp->nd_RIGHT->nd_class == Value);
switch (expp->nd_symb) { switch (exp->nd_symb) {
case '*': case '*':
if (o1 > 0 && o2 > 0) { if (o1 > 0 && o2 > 0) {
if (max_int[sz] / o1 < o2) overflow(expp); if (max_int[sz] / o1 < o2) overflow(exp);
} }
else if (o1 < 0 && o2 < 0) { else if (o1 < 0 && o2 < 0) {
if (o1 == min_int[sz] || o2 == min_int[sz] || if (o1 == min_int[sz] || o2 == min_int[sz] ||
max_int[sz] / (-o1) < (-o2)) overflow(expp); max_int[sz] / (-o1) < (-o2)) overflow(exp);
} }
else if (o1 > 0) { else if (o1 > 0) {
if (min_int[sz] / o1 > o2) overflow(expp); if (min_int[sz] / o1 > o2) overflow(exp);
} }
else if (o2 > 0) { else if (o2 > 0) {
if (min_int[sz] / o2 > o1) overflow(expp); if (min_int[sz] / o2 > o1) overflow(exp);
} }
o1 *= o2; o1 *= o2;
break; break;
case DIV: case DIV:
if (o2 == 0) { if (o2 == 0) {
node_error(expp, "division by 0"); node_error(exp, "division by 0");
return; return;
} }
if ((o1 < 0) != (o2 < 0)) { if ((o1 < 0) != (o2 < 0)) {
@ -197,7 +206,7 @@ cstibin(expp)
break; break;
case MOD: case MOD:
if (o2 == 0) { if (o2 == 0) {
node_error(expp, "modulo by 0"); node_error(exp, "modulo by 0");
return; return;
} }
if ((o1 < 0) != (o2 < 0)) { if ((o1 < 0) != (o2 < 0)) {
@ -212,20 +221,20 @@ cstibin(expp)
case '+': case '+':
if (o1 > 0 && o2 > 0) { if (o1 > 0 && o2 > 0) {
if (max_int[sz] - o1 < o2) overflow(expp); if (max_int[sz] - o1 < o2) overflow(exp);
} }
else if (o1 < 0 && o2 < 0) { else if (o1 < 0 && o2 < 0) {
if (min_int[sz] - o1 > o2) overflow(expp); if (min_int[sz] - o1 > o2) overflow(exp);
} }
o1 += o2; o1 += o2;
break; break;
case '-': case '-':
if (o1 >= 0 && o2 < 0) { if (o1 >= 0 && o2 < 0) {
if (max_int[sz] + o2 < o1) overflow(expp); if (max_int[sz] + o2 < o1) overflow(exp);
} }
else if (o1 < 0 && o2 >= 0) { else if (o1 < 0 && o2 >= 0) {
if (min_int[sz] + o2 > o1) overflow(expp); if (min_int[sz] + o2 > o1) overflow(exp);
} }
o1 -= o2; o1 -= o2;
break; break;
@ -259,27 +268,29 @@ cstibin(expp)
} }
commonbin(expp); commonbin(expp);
expp->nd_INT = o1; (*expp)->nd_INT = o1;
CutSize(*expp);
} }
cstfbin(expp) cstfbin(expp)
register t_node *expp; t_node **expp;
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expp. expressions below it, and the result restored in expp.
This version is for REAL expressions. This version is for REAL expressions.
*/ */
register struct real *p = expp->nd_left->nd_REAL; register t_node *exp = *expp;
register struct real *p = exp->nd_LEFT->nd_REAL;
register flt_arith *o1 = &p->r_val; register flt_arith *o1 = &p->r_val;
register flt_arith *o2 = &expp->nd_right->nd_RVAL; register flt_arith *o2 = &exp->nd_RIGHT->nd_RVAL;
int compar = 0; int compar = 0;
int cmpval = 0; int cmpval = 0;
assert(expp->nd_class == Oper); assert(exp->nd_class == Oper);
assert(expp->nd_left->nd_class == Value); assert(exp->nd_LEFT->nd_class == Value);
assert(expp->nd_right->nd_class == Value); assert(exp->nd_RIGHT->nd_class == Value);
switch (expp->nd_symb) { switch (exp->nd_symb) {
case '*': case '*':
flt_mul(o1, o2, o1); flt_mul(o1, o2, o1);
break; break;
@ -304,7 +315,7 @@ cstfbin(expp)
case '#': case '#':
compar++; compar++;
cmpval = flt_cmp(o1, o2); cmpval = flt_cmp(o1, o2);
switch(expp->nd_symb) { switch(exp->nd_symb) {
case '<': cmpval = (cmpval < 0); break; case '<': cmpval = (cmpval < 0); break;
case '>': cmpval = (cmpval > 0); break; case '>': cmpval = (cmpval > 0); break;
case LESSEQUAL: cmpval = (cmpval <= 0); break; case LESSEQUAL: cmpval = (cmpval <= 0); break;
@ -312,8 +323,8 @@ cstfbin(expp)
case '=': cmpval = (cmpval == 0); break; case '=': cmpval = (cmpval == 0); break;
case '#': cmpval = (cmpval != 0); break; case '#': cmpval = (cmpval != 0); break;
} }
if (expp->nd_right->nd_RSTR) free(expp->nd_right->nd_RSTR); if (exp->nd_RIGHT->nd_RSTR) free(exp->nd_RIGHT->nd_RSTR);
free_real(expp->nd_right->nd_REAL); free_real(exp->nd_RIGHT->nd_REAL);
break; break;
default: default:
@ -322,11 +333,11 @@ cstfbin(expp)
switch(flt_status) { switch(flt_status) {
case FLT_OVFL: case FLT_OVFL:
node_warning(expp, "floating point overflow on %s", node_warning(exp, "floating point overflow on %s",
symbol2str(expp->nd_symb)); symbol2str(exp->nd_symb));
break; break;
case FLT_DIV0: case FLT_DIV0:
node_error(expp, "division by 0.0"); node_error(exp, "division by 0.0");
break; break;
} }
@ -338,32 +349,35 @@ cstfbin(expp)
free_real(p); free_real(p);
} }
commonbin(expp); commonbin(expp);
exp = *expp;
if (compar) { if (compar) {
expp->nd_symb = INTEGER; exp->nd_symb = INTEGER;
expp->nd_INT = cmpval; exp->nd_INT = cmpval;
} }
else { else {
expp->nd_REAL = p; exp->nd_REAL = p;
} }
CutSize(exp);
} }
cstubin(expp) cstubin(expp)
register t_node *expp; t_node **expp;
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expressions below it, and the result restored in
expp. expp.
*/ */
arith o1 = expp->nd_left->nd_INT; register t_node *exp = *expp;
arith o2 = expp->nd_right->nd_INT; arith o1 = exp->nd_LEFT->nd_INT;
register int sz = expp->nd_type->tp_size; arith o2 = exp->nd_RIGHT->nd_INT;
register int sz = exp->nd_type->tp_size;
arith tmp1, tmp2; arith tmp1, tmp2;
assert(expp->nd_class == Oper); assert(exp->nd_class == Oper);
assert(expp->nd_left->nd_class == Value); assert(exp->nd_LEFT->nd_class == Value);
assert(expp->nd_right->nd_class == Value); assert(exp->nd_RIGHT->nd_class == Value);
switch (expp->nd_symb) { switch (exp->nd_symb) {
case '*': case '*':
if (o1 == 0 || o2 == 0) { if (o1 == 0 || o2 == 0) {
o1 = 0; o1 = 0;
@ -372,13 +386,13 @@ cstubin(expp)
tmp1 = full_mask[sz]; tmp1 = full_mask[sz];
tmp2 = o2; tmp2 = o2;
divide(&tmp1, &tmp2); divide(&tmp1, &tmp2);
if (! chk_bounds(o1, tmp1, T_CARDINAL)) overflow(expp); if (! chk_bounds(o1, tmp1, T_CARDINAL)) overflow(exp);
o1 *= o2; o1 *= o2;
break; break;
case DIV: case DIV:
if (o2 == 0) { if (o2 == 0) {
node_error(expp, "division by 0"); node_error(exp, "division by 0");
return; return;
} }
divide(&o1, &o2); divide(&o1, &o2);
@ -386,7 +400,7 @@ cstubin(expp)
case MOD: case MOD:
if (o2 == 0) { if (o2 == 0) {
node_error(expp, "modulo by 0"); node_error(exp, "modulo by 0");
return; return;
} }
divide(&o1, &o2); divide(&o1, &o2);
@ -395,20 +409,20 @@ cstubin(expp)
case '+': case '+':
if (! chk_bounds(o2, full_mask[sz] - o1, T_CARDINAL)) { if (! chk_bounds(o2, full_mask[sz] - o1, T_CARDINAL)) {
overflow(expp); overflow(exp);
} }
o1 += o2; o1 += o2;
break; break;
case '-': case '-':
if (! chk_bounds(o2, o1, T_CARDINAL)) { if (! chk_bounds(o2, o1, T_CARDINAL)) {
if (expp->nd_type->tp_fund == T_INTORCARD) { if (exp->nd_type->tp_fund == T_INTORCARD) {
expp->nd_type = int_type; exp->nd_type = int_type;
if (! chk_bounds(min_int[sz], o1 - o2, T_CARDINAL)) { if (! chk_bounds(min_int[sz], o1 - o2, T_CARDINAL)) {
underflow(expp); underflow(exp);
} }
} }
else underflow(expp); else underflow(exp);
} }
o1 -= o2; o1 -= o2;
break; break;
@ -451,75 +465,81 @@ cstubin(expp)
} }
commonbin(expp); commonbin(expp);
expp->nd_INT = o1; exp = *expp;
if (expp->nd_type == bool_type) expp->nd_symb = INTEGER; exp->nd_INT = o1;
if (exp->nd_type == bool_type) exp->nd_symb = INTEGER;
CutSize(exp);
} }
cstset(expp) cstset(expp)
register t_node *expp; t_node **expp;
{ {
extern arith *MkSet(); extern arith *MkSet();
register arith *set1, *set2; register t_node *exp = *expp;
register arith *resultset; register arith *set1, *set2, *set3;
register unsigned int setsize; register unsigned int setsize;
register int j; register int j;
assert(expp->nd_right->nd_class == Set); assert(exp->nd_RIGHT->nd_class == Set);
assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set); assert(exp->nd_symb == IN || exp->nd_LEFT->nd_class == Set);
set2 = expp->nd_right->nd_set; set2 = exp->nd_RIGHT->nd_set;
setsize = (unsigned) (expp->nd_right->nd_type->tp_size) / (unsigned) word_size; setsize = (unsigned) (exp->nd_RIGHT->nd_type->tp_size) / (unsigned) word_size;
if (expp->nd_symb == IN) { if (exp->nd_symb == IN) {
/* The setsize must fit in an unsigned, as it is /* The setsize must fit in an unsigned, as it is
allocated with Malloc, so we can do the arithmetic allocated with Malloc, so we can do the arithmetic
in an unsigned too. in an unsigned too.
*/ */
unsigned i; unsigned i;
assert(expp->nd_left->nd_class == Value); assert(exp->nd_LEFT->nd_class == Value);
expp->nd_left->nd_INT -= expp->nd_right->nd_type->set_low; exp->nd_LEFT->nd_INT -= exp->nd_RIGHT->nd_type->set_low;
i = expp->nd_left->nd_INT; i = exp->nd_LEFT->nd_INT;
expp->nd_class = Value; /* Careful here; use exp->nd_LEFT->nd_INT to see if
/* Careful here; use expp->nd_left->nd_INT to see if
it falls in the range of the set. Do not use i it falls in the range of the set. Do not use i
for this, as i may be truncated. for this, as i may be truncated.
*/ */
expp->nd_INT = (expp->nd_left->nd_INT >= 0 && i = (exp->nd_LEFT->nd_INT >= 0 &&
expp->nd_left->nd_INT < setsize * wrd_bits && exp->nd_LEFT->nd_INT < setsize * wrd_bits &&
(set2[i / wrd_bits] & (1 << (i % wrd_bits)))); (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
FreeSet(set2); FreeSet(set2);
expp->nd_symb = INTEGER; exp = getnode(Value);
FreeLR(expp); exp->nd_symb = INTEGER;
exp->nd_lineno = (*expp)->nd_lineno;
exp->nd_INT = i;
exp->nd_type = bool_type;
FreeNode(*expp);
*expp = exp;
return; return;
} }
set1 = expp->nd_left->nd_set; set1 = exp->nd_LEFT->nd_set;
switch(expp->nd_symb) { *expp = MkLeaf(Set, &(exp->nd_RIGHT->nd_token));
(*expp)->nd_type = exp->nd_type;
switch(exp->nd_symb) {
case '+': /* Set union */ case '+': /* Set union */
case '-': /* Set difference */ case '-': /* Set difference */
case '*': /* Set intersection */ case '*': /* Set intersection */
case '/': /* Symmetric set difference */ case '/': /* Symmetric set difference */
expp->nd_set = resultset = MkSet(expp->nd_type->set_sz); (*expp)->nd_set = set3 = MkSet(exp->nd_type->set_sz);
for (j = 0; j < setsize; j++) { for (j = 0; j < setsize; j++) {
switch(expp->nd_symb) { switch(exp->nd_symb) {
case '+': case '+':
*resultset = *set1++ | *set2++; *set3++ = *set1++ | *set2++;
break; break;
case '-': case '-':
*resultset = *set1++ & ~*set2++; *set3++ = *set1++ & ~*set2++;
break; break;
case '*': case '*':
*resultset = *set1++ & *set2++; *set3++ = *set1++ & *set2++;
break; break;
case '/': case '/':
*resultset = *set1++ ^ *set2++; *set3++ = *set1++ ^ *set2++;
break; break;
} }
resultset++;
} }
expp->nd_class = Set;
break; break;
case GREATEREQUAL: case GREATEREQUAL:
@ -529,7 +549,7 @@ cstset(expp)
/* Constant set comparisons /* Constant set comparisons
*/ */
for (j = 0; j < setsize; j++) { for (j = 0; j < setsize; j++) {
switch(expp->nd_symb) { switch(exp->nd_symb) {
case GREATEREQUAL: case GREATEREQUAL:
if ((*set1 | *set2++) != *set1) break; if ((*set1 | *set2++) != *set1) break;
set1++; set1++;
@ -546,24 +566,27 @@ cstset(expp)
break; break;
} }
if (j < setsize) { if (j < setsize) {
expp->nd_INT = expp->nd_symb == '#'; j = exp->nd_symb == '#';
} }
else { else {
expp->nd_INT = expp->nd_symb != '#'; j = exp->nd_symb != '#';
} }
expp->nd_class = Value; *expp = getnode(Value);
expp->nd_symb = INTEGER; (*expp)->nd_symb = INTEGER;
(*expp)->nd_INT = j;
(*expp)->nd_type = bool_type;
(*expp)->nd_lineno = (*expp)->nd_lineno;
break; break;
default: default:
crash("(cstset)"); crash("(cstset)");
} }
FreeSet(expp->nd_left->nd_set); FreeSet(exp->nd_LEFT->nd_set);
FreeSet(expp->nd_right->nd_set); FreeSet(exp->nd_RIGHT->nd_set);
FreeLR(expp); FreeNode(exp);
} }
cstcall(expp, call) cstcall(expp, call)
register t_node *expp; t_node **expp;
{ {
/* a standard procedure call is found that can be evaluated /* a standard procedure call is found that can be evaluated
compile time, so do so. compile time, so do so.
@ -571,69 +594,69 @@ cstcall(expp, call)
register t_node *expr; register t_node *expr;
register t_type *tp; register t_type *tp;
assert(expp->nd_class == Call); assert((*expp)->nd_class == Call);
expr = (*expp)->nd_RIGHT->nd_LEFT;
expr = expp->nd_right->nd_left;
tp = expr->nd_type; tp = expr->nd_type;
expr->nd_type = (*expp)->nd_type;
expp->nd_class = Value; (*expp)->nd_RIGHT->nd_LEFT = 0;
expp->nd_symb = INTEGER; FreeNode(*expp);
expp->nd_INT = expr->nd_INT; *expp = expr;
expr->nd_symb = INTEGER;
expr->nd_class = Value;
switch(call) { switch(call) {
case S_ABS: case S_ABS:
if (expp->nd_INT < 0) { if (expr->nd_INT < 0) {
if (expp->nd_INT <= min_int[(int)(tp->tp_size)]) { if (expr->nd_INT <= min_int[(int)(tp->tp_size)]) {
overflow(expr); overflow(expr);
} }
expp->nd_INT = - expp->nd_INT; expr->nd_INT = - expr->nd_INT;
} }
CutSize(expp); CutSize(expr);
break; break;
case S_CAP: case S_CAP:
if (expp->nd_INT >= 'a' && expp->nd_INT <= 'z') { if (expr->nd_INT >= 'a' && expr->nd_INT <= 'z') {
expp->nd_INT += ('A' - 'a'); expr->nd_INT += ('A' - 'a');
} }
break; break;
case S_HIGH:
case S_MAX: case S_MAX:
if (tp->tp_fund == T_INTEGER) { if (tp->tp_fund == T_INTEGER) {
expp->nd_INT = max_int[(int)(tp->tp_size)]; expr->nd_INT = max_int[(int)(tp->tp_size)];
} }
else if (tp == card_type) { else if (tp == card_type) {
expp->nd_INT = full_mask[(int)(int_size)]; expr->nd_INT = full_mask[(int)(int_size)];
} }
else if (tp->tp_fund == T_SUBRANGE) { else if (tp->tp_fund == T_SUBRANGE) {
expp->nd_INT = tp->sub_ub; expr->nd_INT = tp->sub_ub;
} }
else expp->nd_INT = tp->enm_ncst - 1; else expr->nd_INT = tp->enm_ncst - 1;
break; break;
case S_MIN: case S_MIN:
if (tp->tp_fund == T_INTEGER) { if (tp->tp_fund == T_INTEGER) {
expp->nd_INT = min_int[(int)(tp->tp_size)]; expr->nd_INT = min_int[(int)(tp->tp_size)];
} }
else if (tp->tp_fund == T_SUBRANGE) { else if (tp->tp_fund == T_SUBRANGE) {
expp->nd_INT = tp->sub_lb; expr->nd_INT = tp->sub_lb;
} }
else expp->nd_INT = 0; else expr->nd_INT = 0;
break; break;
case S_ODD: case S_ODD:
expp->nd_INT &= 1; expr->nd_INT &= 1;
break; break;
case S_TSIZE:
case S_SIZE: case S_SIZE:
expp->nd_INT = tp->tp_size; expr->nd_INT = tp->tp_size;
break; break;
default: default:
crash("(cstcall)"); crash("(cstcall)");
} }
expp->nd_right = 0; /* don't deallocate, for further
argument checking
*/
FreeLR(expp);
} }
CutSize(expr) CutSize(expr)
@ -675,5 +698,7 @@ InitCst()
fatal("sizeof (arith) insufficient on this machine"); fatal("sizeof (arith) insufficient on this machine");
} }
#ifndef NOCROSS
wrd_bits = 8 * (int) word_size; wrd_bits = 8 * (int) word_size;
#endif
} }

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

@ -236,14 +236,13 @@ IdentList(t_node **p;)
{ {
register t_node *q; register t_node *q;
} : } :
IDENT { *p = q = dot2leaf(Value); } IDENT { *p = q = dot2leaf(Select); }
[ %persistent [ %persistent
',' IDENT ',' IDENT
{ q->nd_left = dot2leaf(Value); { q->nd_NEXT = dot2leaf(Select);
q = q->nd_left; q = q->nd_NEXT;
} }
]* ]*
{ q->nd_left = 0; }
; ;
SubrangeType(t_type **ptp;) SubrangeType(t_type **ptp;)
@ -360,7 +359,7 @@ FieldList(t_scope *scope; arith *cnt; int *palign;)
else else
#endif #endif
error("':' missing"); error("':' missing");
tp = qualified_type(nd); tp = qualified_type(&nd);
} }
] ]
| ':' qualtype(&tp) | ':' qualtype(&tp)
@ -405,8 +404,8 @@ CaseLabelList(t_type **ptp; t_node **pnd;):
CaseLabels(ptp, pnd) CaseLabels(ptp, pnd)
[ [
{ *pnd = dot2node(Link, *pnd, NULLNODE); } { *pnd = dot2node(Link, *pnd, NULLNODE); }
',' CaseLabels(ptp, &((*pnd)->nd_right)) ',' CaseLabels(ptp, &((*pnd)->nd_RIGHT))
{ pnd = &((*pnd)->nd_right); } { pnd = &((*pnd)->nd_RIGHT); }
]* ]*
; ;
@ -431,15 +430,15 @@ CaseLabels(t_type **ptp; register t_node **pnd;)
} }
[ [
UPTO { *pnd = nd = dot2node(Link,nd,NULLNODE); UPTO { *pnd = nd = dot2node(Link,nd,NULLNODE);
nd->nd_type = nd->nd_left->nd_type; nd->nd_type = nd->nd_LEFT->nd_type;
} }
ConstExpression(&(*pnd)->nd_right) ConstExpression(&(*pnd)->nd_RIGHT)
{ if (!ChkCompat(&((*pnd)->nd_right), nd->nd_type, { if (!ChkCompat(&((*pnd)->nd_RIGHT), nd->nd_type,
"case label")) { "case label")) {
nd->nd_type = error_type; nd->nd_type = error_type;
} }
else if (! chk_bounds(nd->nd_left->nd_INT, else if (! chk_bounds(nd->nd_LEFT->nd_INT,
nd->nd_right->nd_INT, nd->nd_RIGHT->nd_INT,
nd->nd_type->tp_fund)) { nd->nd_type->tp_fund)) {
node_error(nd, node_error(nd,
"lower bound exceeds upper bound in case label range"); "lower bound exceeds upper bound in case label range");
@ -482,7 +481,7 @@ qualtype(t_type **ptp;)
t_node *nd; t_node *nd;
} : } :
qualident(&nd) qualident(&nd)
{ *ptp = qualified_type(nd); } { *ptp = qualified_type(&nd); }
; ;
ProcedureType(t_type **ptp;) ProcedureType(t_type **ptp;)
@ -559,8 +558,8 @@ VariableDeclaration
IdentAddr(&VarList) IdentAddr(&VarList)
{ nd = VarList; } { nd = VarList; }
[ %persistent [ %persistent
',' IdentAddr(&(nd->nd_right)) ',' IdentAddr(&(nd->nd_RIGHT))
{ nd = nd->nd_right; } { nd = nd->nd_RIGHT; }
]* ]*
':' type(&tp) ':' type(&tp)
{ EnterVarList(VarList, tp, proclevel > 0); } { EnterVarList(VarList, tp, proclevel > 0); }
@ -570,11 +569,12 @@ IdentAddr(t_node **pnd;)
{ {
register t_node *nd; register t_node *nd;
} : } :
IDENT { nd = dot2leaf(Name); } IDENT { nd = dot2leaf(Name);
*pnd = dot2node(Link, nd, NULLNODE);
}
[ '[' [ '['
ConstExpression(&(nd->nd_left)) ConstExpression(&(nd->nd_NEXT))
']' ']'
| |
] ]
{ *pnd = nd; }
; ;

14
lang/m2/comp/def.H
View file

@ -48,13 +48,6 @@ struct field {
#define fld_variant df_value.df_field.fd_variant #define fld_variant df_value.df_field.fd_variant
}; };
struct dfproc {
struct scopelist *pr_vis; /* scope of procedure */
struct node *pr_body; /* body of this procedure */
#define prc_vis df_value.df_proc.pr_vis
#define prc_body df_value.df_proc.pr_body
};
struct import { struct import {
struct def *im_def; /* imported definition */ struct def *im_def; /* imported definition */
#define imp_def df_value.df_import.im_def #define imp_def df_value.df_import.im_def
@ -66,7 +59,9 @@ struct dforward {
char *fo_name; char *fo_name;
#define for_node df_value.df_forward.fo_node #define for_node df_value.df_forward.fo_node
#define for_vis df_value.df_forward.fo_vis #define for_vis df_value.df_forward.fo_vis
#define for_name df_value.df_forward.fo_name #define prc_vis df_value.df_forward.fo_vis
#define prc_body df_value.df_forward.fo_node
#define prc_name df_value.df_forward.fo_name
}; };
struct forwtype { struct forwtype {
@ -128,8 +123,7 @@ struct def { /* list of definitions for a name */
struct enumval df_enum; struct enumval df_enum;
struct field df_field; struct field df_field;
struct import df_import; struct import df_import;
struct dfproc df_proc; struct dforward df_forward; /* also used for proc */
struct dforward df_forward;
struct forwtype df_fortype; struct forwtype df_fortype;
int df_stdname; /* define for standard name */ int df_stdname; /* define for standard name */
} df_value; } df_value;

13
lang/m2/comp/def.c
View file

@ -259,40 +259,37 @@ DeclProc(type, id)
df->for_node = dot2leaf(Name); df->for_node = dot2leaf(Name);
df->df_flags |= D_USED | D_DEFINED; df->df_flags |= D_USED | D_DEFINED;
if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) { if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) {
df->for_name = id->id_text; df->prc_name = id->id_text;
} }
else { else {
sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text); sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1)); df->prc_name = Salloc(buf, (unsigned) (strlen(buf)+1));
} }
if (CurrVis == Defined->mod_vis) { if (CurrVis == Defined->mod_vis) {
/* The current module will define this routine. /* The current module will define this routine.
make sure the name is exported. make sure the name is exported.
*/ */
C_exp(df->for_name); C_exp(df->prc_name);
} }
} }
else { else {
char *name;
df = lookup(id, CurrentScope, D_IMPORTED, 0); df = lookup(id, CurrentScope, D_IMPORTED, 0);
if (df && df->df_kind == D_PROCHEAD) { if (df && df->df_kind == D_PROCHEAD) {
/* C_exp already generated when we saw the definition /* C_exp already generated when we saw the definition
in the definition module in the definition module
*/ */
name = df->for_name;
DefInFront(df); DefInFront(df);
} }
else { else {
df = define(id, CurrentScope, type); df = define(id, CurrentScope, type);
sprint(buf,"_%d_%s",++nmcount,id->id_text); sprint(buf,"_%d_%s",++nmcount,id->id_text);
name = Salloc(buf, (unsigned)(strlen(buf)+1)); df->prc_name = Salloc(buf, (unsigned)(strlen(buf)+1));
internal(buf); internal(buf);
df->df_flags |= D_DEFINED; df->df_flags |= D_DEFINED;
} }
open_scope(OPENSCOPE); open_scope(OPENSCOPE);
scope = CurrentScope; scope = CurrentScope;
scope->sc_name = name; scope->sc_name = df->prc_name;
scope->sc_definedby = df; scope->sc_definedby = df;
} }
df->prc_vis = CurrVis; df->prc_vis = CurrVis;

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

@ -131,7 +131,7 @@ GetDefinitionModule(id, incr)
n = dot2leaf(Def); n = dot2leaf(Def);
n->nd_def = newsc->sc_definedby; n->nd_def = newsc->sc_definedby;
if (nd_end) nd_end->nd_left = n; if (nd_end) nd_end->nd_NEXT = n;
else Modules = n; else Modules = n;
nd_end = n; nd_end = n;
} }

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

@ -629,7 +629,7 @@ CodeDesig(nd, ds)
switch(nd->nd_class) { /* Divide */ switch(nd->nd_class) { /* Divide */
case Def: case Def:
df = nd->nd_def; df = nd->nd_def;
if (nd->nd_left) CodeDesig(nd->nd_left, ds); if (nd->nd_NEXT) CodeDesig(nd->nd_NEXT, ds);
switch(df->df_kind) { switch(df->df_kind) {
case D_FIELD: case D_FIELD:
@ -648,10 +648,10 @@ CodeDesig(nd, ds)
case Arrsel: case Arrsel:
assert(nd->nd_symb == '[' || nd->nd_symb == ','); assert(nd->nd_symb == '[' || nd->nd_symb == ',');
CodeDesig(nd->nd_left, ds); CodeDesig(nd->nd_LEFT, ds);
CodeAddress(ds); CodeAddress(ds);
CodePExpr(nd->nd_right); CodePExpr(nd->nd_RIGHT);
nd = nd->nd_left; nd = nd->nd_LEFT;
/* Now load address of descriptor /* Now load address of descriptor
*/ */
@ -681,7 +681,7 @@ CodeDesig(nd, ds)
case Arrow: case Arrow:
assert(nd->nd_symb == '^'); assert(nd->nd_symb == '^');
nd = nd->nd_right; nd = nd->nd_RIGHT;
CodeDesig(nd, ds); CodeDesig(nd, ds);
switch(ds->dsg_kind) { switch(ds->dsg_kind) {
case DSG_LOADED: case DSG_LOADED:

24
lang/m2/comp/enter.c
View file

@ -75,7 +75,7 @@ EnterEnumList(Idlist, type)
register t_node *idlist = Idlist; register t_node *idlist = Idlist;
type->enm_ncst = 0; type->enm_ncst = 0;
for (; idlist; idlist = idlist->nd_left) { for (; idlist; idlist = idlist->nd_NEXT) {
df = define(idlist->nd_IDF, CurrentScope, D_ENUM); df = define(idlist->nd_IDF, CurrentScope, D_ENUM);
df->df_type = type; df->df_type = type;
df->enm_val = (type->enm_ncst)++; df->enm_val = (type->enm_ncst)++;
@ -102,7 +102,7 @@ EnterFieldList(Idlist, type, scope, addr)
register t_def *df; register t_def *df;
register t_node *idlist = Idlist; register t_node *idlist = Idlist;
for (; idlist; idlist = idlist->nd_left) { for (; idlist; idlist = idlist->nd_NEXT) {
df = define(idlist->nd_IDF, scope, D_FIELD); df = define(idlist->nd_IDF, scope, D_FIELD);
df->df_type = type; df->df_type = type;
df->df_flags |= D_QEXPORTED; df->df_flags |= D_QEXPORTED;
@ -134,20 +134,20 @@ EnterVarList(Idlist, type, local)
while (sc->sc_scope->sc_scopeclosed) sc = enclosing(sc); while (sc->sc_scope->sc_scopeclosed) sc = enclosing(sc);
} }
for (; idlist; idlist = idlist->nd_right) { for (; idlist; idlist = idlist->nd_RIGHT) {
df = define(idlist->nd_IDF, CurrentScope, D_VARIABLE); df = define(idlist->nd_LEFT->nd_IDF, CurrentScope, D_VARIABLE);
df->df_type = type; df->df_type = type;
if (idlist->nd_left) { if (idlist->nd_LEFT->nd_NEXT) {
/* An address was supplied /* An address was supplied
*/ */
register t_type *tp = idlist->nd_left->nd_type; register t_type *tp = idlist->nd_LEFT->nd_NEXT->nd_type;
df->df_flags |= D_ADDRGIVEN | D_NOREG; df->df_flags |= D_ADDRGIVEN | D_NOREG;
if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){ if (tp != error_type && !(tp->tp_fund & T_CARDINAL)){
node_error(idlist->nd_left, node_error(idlist->nd_LEFT->nd_NEXT,
"illegal type for address"); "illegal type for address");
} }
df->var_off = idlist->nd_left->nd_INT; df->var_off = idlist->nd_LEFT->nd_NEXT->nd_INT;
} }
else if (local) { else if (local) {
/* subtract aligned size of variable to the offset, /* subtract aligned size of variable to the offset,
@ -211,7 +211,7 @@ EnterParamList(ppr, Idlist, type, VARp, off)
/* Can only happen when a procedure type is defined */ /* Can only happen when a procedure type is defined */
dummy = Idlist = idlist = dot2leaf(Name); dummy = Idlist = idlist = dot2leaf(Name);
} }
for ( ; idlist; idlist = idlist->nd_left) { for ( ; idlist; idlist = idlist->nd_NEXT) {
pr = new_paramlist(); pr = new_paramlist();
pr->par_next = 0; pr->par_next = 0;
if (!*ppr) *ppr = pr; if (!*ppr) *ppr = pr;
@ -378,7 +378,7 @@ EnterExportList(Idlist, qualified)
register t_node *idlist = Idlist; register t_node *idlist = Idlist;
register t_def *df, *df1; register t_def *df, *df1;
for (;idlist; idlist = idlist->nd_left) { for (;idlist; idlist = idlist->nd_NEXT) {
df = lookup(idlist->nd_IDF, CurrentScope, 0, 0); df = lookup(idlist->nd_IDF, CurrentScope, 0, 0);
if (!df) { if (!df) {
@ -508,7 +508,7 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
return; return;
} }
for (; idlist; idlist = idlist->nd_left) { for (; idlist; idlist = idlist->nd_NEXT) {
if (! (df = lookup(idlist->nd_IDF, sc, 0, 0))) { if (! (df = lookup(idlist->nd_IDF, sc, 0, 0))) {
if (! is_anon_idf(idlist->nd_IDF)) { if (! is_anon_idf(idlist->nd_IDF)) {
node_error(idlist, node_error(idlist,
@ -544,7 +544,7 @@ EnterImportList(idlist, local, sc)
f = file_info; f = file_info;
for (; idlist; idlist = idlist->nd_left) { for (; idlist; idlist = idlist->nd_NEXT) {
if (! DoImport(local ? if (! DoImport(local ?
ForwDef(idlist, sc) : ForwDef(idlist, sc) :
GetDefinitionModule(idlist->nd_IDF, 1), GetDefinitionModule(idlist->nd_IDF, 1),

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

@ -21,7 +21,6 @@
#include "idf.h" #include "idf.h"
#include "def.h" #include "def.h"
#include "node.h" #include "node.h"
#include "const.h"
#include "type.h" #include "type.h"
#include "chk_expr.h" #include "chk_expr.h"
#include "warning.h" #include "warning.h"
@ -51,8 +50,10 @@ qualident(t_node **p;)
]* ]*
; ;
selector(register t_node **pnd;): selector(register t_node **pnd;)
'.' { *pnd = dot2node(Link,*pnd,NULLNODE); } { t_node *nd;
} :
'.' { nd = dot2leaf(Select); nd->nd_NEXT = *pnd; *pnd = nd; }
IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; } IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; }
; ;
@ -64,35 +65,34 @@ ExpList(t_node **pnd;)
nd->nd_symb = ','; nd->nd_symb = ',';
} }
[ [
',' { nd->nd_right = dot2leaf(Link); ',' { nd->nd_RIGHT = dot2leaf(Link);
nd = nd->nd_right; nd = nd->nd_RIGHT;
} }
expression(&(nd->nd_left)) expression(&(nd->nd_LEFT))
]* ]*
; ;
ConstExpression(t_node **pnd;) ConstExpression(register t_node **pnd;)
{ {
register t_node *nd;
}: }:
expression(pnd) expression(pnd)
/* /*
* Changed rule in new Modula-2. * Changed rule in new Modula-2.
* Check that the expression is a constant expression and evaluate! * Check that the expression is a constant expression and evaluate!
*/ */
{ nd = *pnd; {
DO_DEBUG(options['C'], print("CONSTANT EXPRESSION\n")); DO_DEBUG(options['C'], print("CONSTANT EXPRESSION\n"));
DO_DEBUG(options['C'], PrNode(nd, 0)); DO_DEBUG(options['C'], PrNode(*pnd, 0));
if (ChkExpression(nd) && if (ChkExpression(pnd) &&
nd->nd_class != Set && (*pnd)->nd_class != Set &&
nd->nd_class != Value && (*pnd)->nd_class != Value &&
! (options['l'] && nd->nd_class == Def && IsProc(nd))) { ! (options['l'] && (*pnd)->nd_class == Def && IsProc((*pnd)))) {
error("constant expression expected"); error("constant expression expected");
} }
DO_DEBUG(options['C'], print("RESULTS IN\n")); DO_DEBUG(options['C'], print("RESULTS IN\n"));
DO_DEBUG(options['C'], PrNode(nd, 0)); DO_DEBUG(options['C'], PrNode(*pnd, 0));
} }
; ;
@ -104,7 +104,7 @@ expression(register t_node **pnd;)
/* relation */ /* relation */
[ '=' | '#' | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ] [ '=' | '#' | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN ]
{ *pnd = dot2node(Oper, *pnd, NULLNODE); } { *pnd = dot2node(Oper, *pnd, NULLNODE); }
SimpleExpression(&((*pnd)->nd_right)) SimpleExpression(&((*pnd)->nd_RIGHT))
| |
] ]
; ;
@ -128,7 +128,7 @@ SimpleExpression(register t_node **pnd;)
] ]
term(pnd) term(pnd)
{ if (nd) { { if (nd) {
nd->nd_right = *pnd; nd->nd_RIGHT = *pnd;
*pnd = nd; *pnd = nd;
} }
nd = *pnd; nd = *pnd;
@ -137,7 +137,7 @@ SimpleExpression(register t_node **pnd;)
/* AddOperator */ /* AddOperator */
[ '+' | '-' | OR ] [ '+' | '-' | OR ]
{ nd = dot2node(Oper, nd, NULLNODE); } { nd = dot2node(Oper, nd, NULLNODE); }
term(&(nd->nd_right)) term(&(nd->nd_RIGHT))
]* ]*
{ *pnd = nd; } { *pnd = nd; }
; ;
@ -157,7 +157,7 @@ term(t_node **pnd;)
/* MulOperator */ /* MulOperator */
[ '*' | '/' | DIV | MOD | AND ] [ '*' | '/' | DIV | MOD | AND ]
{ nd = dot2node(Oper, nd, NULLNODE); } { nd = dot2node(Oper, nd, NULLNODE); }
factor(&(nd->nd_right)) factor(&(nd->nd_RIGHT))
]* ]*
{ *pnd = nd; } { *pnd = nd; }
; ;
@ -178,12 +178,12 @@ factor(register t_node **p;)
designator_tail(p) designator_tail(p)
[ [
{ *p = dot2node(Call, *p, NULLNODE); } { *p = dot2node(Call, *p, NULLNODE); }
ActualParameters(&((*p)->nd_right)) ActualParameters(&((*p)->nd_RIGHT))
| |
] ]
| |
bare_set(&nd1) bare_set(&nd1)
{ nd = nd1; nd->nd_left = *p; *p = nd; } { nd = nd1; nd->nd_LEFT = *p; *p = nd; }
] ]
| |
bare_set(p) bare_set(p)
@ -210,8 +210,8 @@ factor(register t_node **p;)
if (class == Arrsel || if (class == Arrsel ||
class == Arrow || class == Arrow ||
class == Name || class == Name ||
class == Link) { class == Select) {
nd->nd_right = *p; nd->nd_RIGHT = *p;
*p = nd; *p = nd;
} }
else FreeNode(nd); else FreeNode(nd);
@ -219,20 +219,20 @@ factor(register t_node **p;)
')' ')'
| |
NOT { *p = dot2leaf(Uoper); } NOT { *p = dot2leaf(Uoper); }
factor(&((*p)->nd_right)) factor(&((*p)->nd_RIGHT))
; ;
bare_set(t_node **pnd;) bare_set(t_node **pnd;)
{ {
register t_node *nd; register t_node *nd;
} : } :
'{' { dot.tk_symb = SET; '{' { DOT = SET;
*pnd = nd = dot2leaf(Xset); *pnd = nd = dot2leaf(Xset);
nd->nd_type = bitset_type; nd->nd_type = bitset_type;
} }
[ [
element(nd) element(nd)
[ { nd = nd->nd_right; } [ { nd = nd->nd_RIGHT; }
',' element(nd) ',' element(nd)
]* ]*
| |
@ -245,15 +245,15 @@ ActualParameters(t_node **pnd;):
; ;
element(register t_node *nd;) : element(register t_node *nd;) :
expression(&(nd->nd_right)) expression(&(nd->nd_RIGHT))
[ [
UPTO UPTO
{ nd->nd_right = dot2node(Link, nd->nd_right, NULLNODE);} { nd->nd_RIGHT = dot2node(Link, nd->nd_RIGHT, NULLNODE);}
expression(&(nd->nd_right->nd_right)) expression(&(nd->nd_RIGHT->nd_RIGHT))
| |
] ]
{ nd->nd_right = dot2node(Link, nd->nd_right, NULLNODE); { nd->nd_RIGHT = dot2node(Link, nd->nd_RIGHT, NULLNODE);
nd->nd_right->nd_symb = ','; nd->nd_RIGHT->nd_symb = ',';
} }
; ;
@ -279,12 +279,12 @@ visible_designator_tail(t_node **pnd;)
register t_node *nd = *pnd; register t_node *nd = *pnd;
}: }:
'[' { nd = dot2node(Arrsel, nd, NULLNODE); } '[' { nd = dot2node(Arrsel, nd, NULLNODE); }
expression(&(nd->nd_right)) expression(&(nd->nd_RIGHT))
[ [
',' ','
{ nd = dot2node(Arrsel, nd, NULLNODE); { nd = dot2node(Arrsel, nd, NULLNODE);
} }
expression(&(nd->nd_right)) expression(&(nd->nd_RIGHT))
]* ]*
']' ']'
{ *pnd = nd; } { *pnd = nd; }

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

@ -45,7 +45,7 @@ int pass_1 = 1;
t_def *Defined; t_def *Defined;
extern int err_occurred; extern int err_occurred;
extern int fp_used; /* set if floating point used */ extern int fp_used; /* set if floating point used */
static t_node _emptystat = { NULLNODE, NULLNODE, Stat, 0, NULLTYPE, { ';' }}; static t_node _emptystat = { Stat, 0, NULLTYPE, { ';' }};
t_node *EmptyStatement = &_emptystat; t_node *EmptyStatement = &_emptystat;
main(argc, argv) main(argc, argv)
@ -66,9 +66,9 @@ main(argc, argv)
Nargv[Nargc] = 0; /* terminate the arg vector */ Nargv[Nargc] = 0; /* terminate the arg vector */
if (Nargc < 2) { if (Nargc < 2) {
fprint(STDERR, "%s: Use a file argument\n", ProgName); fprint(STDERR, "%s: Use a file argument\n", ProgName);
exit(1); sys_stop(S_EXIT);
} }
exit(!Compile(Nargv[1], Nargv[2])); sys_stop(Compile(Nargv[1], Nargv[2]) ? S_END : S_EXIT);
/*NOTREACHED*/ /*NOTREACHED*/
} }

10
lang/m2/comp/node.H
View file

@ -10,8 +10,6 @@
/* $Header$ */ /* $Header$ */
struct node { struct node {
struct node *nd_left;
struct node *nd_right;
char nd_class; /* kind of node */ char nd_class; /* kind of node */
#define Value 0 /* constant */ #define Value 0 /* constant */
#define Arrsel 1 /* array selection */ #define Arrsel 1 /* array selection */
@ -24,7 +22,8 @@ struct node {
#define Xset 8 /* a set */ #define Xset 8 /* a set */
#define Def 9 /* an identified name */ #define Def 9 /* an identified name */
#define Stat 10 /* a statement */ #define Stat 10 /* a statement */
#define Link 11 #define Select 11 /* a '.' selection */
#define Link 12
/* do NOT change the order or the numbers!!! */ /* do NOT change the order or the numbers!!! */
char nd_flags; /* options */ char nd_flags; /* options */
#define ROPTION 1 #define ROPTION 1
@ -33,6 +32,9 @@ struct node {
struct token nd_token; struct token nd_token;
#define nd_set nd_token.tk_data.tk_set #define nd_set nd_token.tk_data.tk_set
#define nd_def nd_token.tk_data.tk_def #define nd_def nd_token.tk_data.tk_def
#define nd_LEFT nd_token.tk_data.tk_left
#define nd_RIGHT nd_token.tk_data.tk_right
#define nd_NEXT nd_token.tk_data.tk_next
#define nd_symb nd_token.tk_symb #define nd_symb nd_token.tk_symb
#define nd_lineno nd_token.tk_lineno #define nd_lineno nd_token.tk_lineno
#define nd_IDF nd_token.TOK_IDF #define nd_IDF nd_token.TOK_IDF
@ -49,7 +51,7 @@ typedef struct node t_node;
/* ALLOCDEF "node" 50 */ /* ALLOCDEF "node" 50 */
extern t_node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf(); extern t_node *MkNode(), *MkLeaf(), *dot2node(), *dot2leaf(), *getnode();
#define NULLNODE ((t_node *) 0) #define NULLNODE ((t_node *) 0)

82
lang/m2/comp/node.c
View file

@ -22,6 +22,33 @@
#include "node.h" #include "node.h"
#include "main.h" #include "main.h"
static int nsubnodes[] = {
0,
2,
2,
2,
2,
2,
1,
1,
2,
1,
2,
1,
2
};
t_node *
getnode(class)
{
register t_node *nd = new_node();
if (options['R']) nd->nd_flags |= ROPTION;
if (options['A']) nd->nd_flags |= AOPTION;
nd->nd_class = class;
return nd;
}
t_node * t_node *
MkNode(class, left, right, token) MkNode(class, left, right, token)
t_node *left, *right; t_node *left, *right;
@ -29,14 +56,11 @@ MkNode(class, left, right, token)
{ {
/* Create a node and initialize it with the given parameters /* Create a node and initialize it with the given parameters
*/ */
register t_node *nd = new_node(); register t_node *nd = getnode(class);
nd->nd_left = left;
nd->nd_right = right;
nd->nd_token = *token; nd->nd_token = *token;
nd->nd_class = class; nd->nd_LEFT = left;
if (options['R']) nd->nd_flags |= ROPTION; nd->nd_RIGHT = right;
if (options['A']) nd->nd_flags |= AOPTION;
return nd; return nd;
} }
@ -51,21 +75,40 @@ t_node *
MkLeaf(class, token) MkLeaf(class, token)
t_token *token; t_token *token;
{ {
return MkNode(class, NULLNODE, NULLNODE, token); register t_node *nd = getnode(class);
nd->nd_token = *token;
switch(nsubnodes[class]) {
case 1:
nd->nd_NEXT = 0;
break;
case 2:
nd->nd_LEFT = 0;
nd->nd_RIGHT = 0;
break;
}
return nd;
} }
t_node * t_node *
dot2leaf(class) dot2leaf(class)
{ {
return MkNode(class, NULLNODE, NULLNODE, &dot); return MkLeaf(class, &dot);
} }
FreeLR(nd) FreeLR(nd)
register t_node *nd; register t_node *nd;
{ {
FreeNode(nd->nd_left); switch(nsubnodes[nd->nd_class]) {
FreeNode(nd->nd_right); case 2:
nd->nd_left = nd->nd_right = 0; FreeNode(nd->nd_LEFT);
FreeNode(nd->nd_RIGHT);
nd->nd_LEFT = nd->nd_RIGHT = 0;
break;
case 1:
FreeNode(nd->nd_NEXT);
nd->nd_NEXT = 0;
break;
}
} }
FreeNode(nd) FreeNode(nd)
@ -85,6 +128,12 @@ NodeCrash(expp)
crash("Illegal node %d", expp->nd_class); crash("Illegal node %d", expp->nd_class);
} }
PNodeCrash(expp)
t_node **expp;
{
crash("Illegal node %d", (*expp)->nd_class);
}
#ifdef DEBUG #ifdef DEBUG
extern char *symbol2str(); extern char *symbol2str();
@ -117,7 +166,14 @@ PrNode(nd, lvl)
return; return;
} }
printnode(nd, lvl); printnode(nd, lvl);
PrNode(nd->nd_left, lvl + 1); switch(nsubnodes[nd->nd_class]) {
PrNode(nd->nd_right, lvl + 1); case 1:
PrNode(nd->nd_LEFT, lvl + 1);
PrNode(nd->nd_RIGHT, lvl + 1);
break;
case 2:
PrNode(nd->nd_NEXT, lvl + 1);
break;
}
} }
#endif DEBUG #endif DEBUG

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

@ -191,7 +191,7 @@ node_warning(exportlist, W_OLDFASHIONED, "export list in definition module ignor
definition* END IDENT definition* END IDENT
{ end_definition_list(&(currscope->sc_def)); { end_definition_list(&(currscope->sc_def));
DefinitionModule--; DefinitionModule--;
match_id(df->df_idf, dot.TOK_IDF); match_id(dot.TOK_IDF, df->df_idf);
df->df_flags &= ~D_BUSY; df->df_flags &= ~D_BUSY;
} }
'.' '.'

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

@ -24,13 +24,13 @@
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "idf.h" #include "idf.h"
#include "const.h"
#include "scope.h" #include "scope.h"
#include "main.h" #include "main.h"
#define INCR_SIZE 64 #define INCR_SIZE 64
extern int proclevel; extern int proclevel;
extern char *sprint();
static struct db_str { static struct db_str {
unsigned sz; unsigned sz;
@ -276,11 +276,11 @@ stb_string(df, kind)
break; break;
case D_END: case D_END:
adds_db_str(sprint(buf, "E%d;", df->mod_vis->sc_count)); adds_db_str(sprint(buf, "E%d;", df->mod_vis->sc_count));
C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, 0); C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, (arith) 0);
break; break;
case D_PEND: case D_PEND:
adds_db_str(sprint(buf, "E%d;", df->prc_vis->sc_count)); adds_db_str(sprint(buf, "E%d;", df->prc_vis->sc_count));
C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, 0); C_ms_stb_cst(db_str.base, N_SCOPE, proclevel, (arith) 0);
break; break;
case D_VARIABLE: case D_VARIABLE:
if (DefinitionModule && CurrVis != Defined->mod_vis) break; if (DefinitionModule && CurrVis != Defined->mod_vis) break;

95
lang/m2/comp/statement.g
View file

@ -40,7 +40,7 @@ statement(register t_node **pnd;)
nd->nd_symb = '('; nd->nd_symb = '(';
nd->nd_lineno = (*pnd)->nd_lineno; nd->nd_lineno = (*pnd)->nd_lineno;
} }
ActualParameters(&(nd->nd_right))? ActualParameters(&(nd->nd_RIGHT))?
| |
[ BECOMES [ BECOMES
| '=' { error("':=' expected instead of '='"); | '=' { error("':=' expected instead of '='");
@ -48,7 +48,7 @@ statement(register t_node **pnd;)
} }
] ]
{ nd = dot2node(Stat, *pnd, NULLNODE); } { nd = dot2node(Stat, *pnd, NULLNODE); }
expression(&(nd->nd_right)) expression(&(nd->nd_RIGHT))
] ]
{ *pnd = nd; } { *pnd = nd; }
/* /*
@ -60,19 +60,19 @@ statement(register t_node **pnd;)
CaseStatement(pnd) CaseStatement(pnd)
| |
WHILE { *pnd = nd = dot2leaf(Stat); } WHILE { *pnd = nd = dot2leaf(Stat); }
expression(&(nd->nd_left)) expression(&(nd->nd_LEFT))
DO DO
StatementSequence(&(nd->nd_right)) StatementSequence(&(nd->nd_RIGHT))
END END
| |
REPEAT { *pnd = nd = dot2leaf(Stat); } REPEAT { *pnd = nd = dot2leaf(Stat); }
StatementSequence(&(nd->nd_left)) StatementSequence(&(nd->nd_LEFT))
UNTIL UNTIL
expression(&(nd->nd_right)) expression(&(nd->nd_RIGHT))
| |
{ loopcount++; } { loopcount++; }
LOOP { *pnd = nd = dot2leaf(Stat); } LOOP { *pnd = nd = dot2leaf(Stat); }
StatementSequence(&((*pnd)->nd_right)) StatementSequence(&((*pnd)->nd_RIGHT))
END END
{ loopcount--; } { loopcount--; }
| |
@ -116,7 +116,7 @@ StatementSequence(register t_node **pnd;)
nd1 = dot2node(Link, *pnd, nd); nd1 = dot2node(Link, *pnd, nd);
*pnd = nd1; *pnd = nd1;
nd1->nd_symb = ';'; nd1->nd_symb = ';';
pnd = &(nd1->nd_right); pnd = &(nd1->nd_RIGHT);
} }
} }
]* ]*
@ -129,25 +129,25 @@ IfStatement(t_node **pnd;)
IF { nd = dot2leaf(Stat); IF { nd = dot2leaf(Stat);
*pnd = nd; *pnd = nd;
} }
expression(&(nd->nd_left)) expression(&(nd->nd_LEFT))
THEN { nd->nd_right = dot2leaf(Link); THEN { nd->nd_RIGHT = dot2leaf(Link);
nd = nd->nd_right; nd = nd->nd_RIGHT;
} }
StatementSequence(&(nd->nd_left)) StatementSequence(&(nd->nd_LEFT))
[ [
ELSIF { nd->nd_right = dot2leaf(Stat); ELSIF { nd->nd_RIGHT = dot2leaf(Stat);
nd = nd->nd_right; nd = nd->nd_RIGHT;
nd->nd_symb = IF; nd->nd_symb = IF;
} }
expression(&(nd->nd_left)) expression(&(nd->nd_LEFT))
THEN { nd->nd_right = dot2leaf(Link); THEN { nd->nd_RIGHT = dot2leaf(Link);
nd = nd->nd_right; nd = nd->nd_RIGHT;
} }
StatementSequence(&(nd->nd_left)) StatementSequence(&(nd->nd_LEFT))
]* ]*
[ [
ELSE ELSE
StatementSequence(&(nd->nd_right)) StatementSequence(&(nd->nd_RIGHT))
| |
] ]
END END
@ -159,16 +159,16 @@ CaseStatement(t_node **pnd;)
t_type *tp = 0; t_type *tp = 0;
} : } :
CASE { *pnd = nd = dot2leaf(Stat); } CASE { *pnd = nd = dot2leaf(Stat); }
expression(&(nd->nd_left)) expression(&(nd->nd_LEFT))
OF OF
case(&(nd->nd_right), &tp) case(&(nd->nd_RIGHT), &tp)
{ nd = nd->nd_right; } { nd = nd->nd_RIGHT; }
[ [
'|' '|'
case(&(nd->nd_right), &tp) case(&(nd->nd_RIGHT), &tp)
{ nd = nd->nd_right; } { nd = nd->nd_RIGHT; }
]* ]*
[ ELSE StatementSequence(&(nd->nd_right)) [ ELSE StatementSequence(&(nd->nd_RIGHT))
| |
] ]
END END
@ -177,7 +177,7 @@ CaseStatement(t_node **pnd;)
case(t_node **pnd; t_type **ptp;) : case(t_node **pnd; t_type **ptp;) :
[ CaseLabelList(ptp, pnd) [ CaseLabelList(ptp, pnd)
':' { *pnd = dot2node(Link, *pnd, NULLNODE); } ':' { *pnd = dot2node(Link, *pnd, NULLNODE); }
StatementSequence(&((*pnd)->nd_right)) StatementSequence(&((*pnd)->nd_RIGHT))
| |
] ]
{ *pnd = dot2node(Link, *pnd, NULLNODE); { *pnd = dot2node(Link, *pnd, NULLNODE);
@ -191,9 +191,9 @@ WhileStatement(t_node **pnd;)
register t_node *nd; register t_node *nd;
}: }:
WHILE { *pnd = nd = dot2leaf(Stat); } WHILE { *pnd = nd = dot2leaf(Stat); }
expression(&(nd->nd_left)) expression(&(nd->nd_LEFT))
DO DO
StatementSequence(&(nd->nd_right)) StatementSequence(&(nd->nd_RIGHT))
END END
; ;
@ -202,44 +202,49 @@ RepeatStatement(t_node **pnd;)
register t_node *nd; register t_node *nd;
}: }:
REPEAT { *pnd = nd = dot2leaf(Stat); } REPEAT { *pnd = nd = dot2leaf(Stat); }
StatementSequence(&(nd->nd_left)) StatementSequence(&(nd->nd_LEFT))
UNTIL UNTIL
expression(&(nd->nd_right)) expression(&(nd->nd_RIGHT))
; ;
*/ */
ForStatement(t_node **pnd;) ForStatement(t_node **pnd;)
{ {
register t_node *nd, *nd1; register t_node *nd, *nd1;
t_node *dummy;
}: }:
FOR { *pnd = nd = dot2leaf(Stat); } FOR { *pnd = nd = dot2leaf(Stat); }
IDENT { nd->nd_IDF = dot.TOK_IDF; } IDENT { nd1 = dot2leaf(Name); }
BECOMES { nd->nd_left = nd1 = dot2leaf(Stat); } BECOMES { nd->nd_LEFT = dot2node(Stat, nd1, dot2leaf(Link));
expression(&(nd1->nd_left)) nd1 = nd->nd_LEFT->nd_RIGHT;
nd1->nd_symb = TO;
}
expression(&(nd1->nd_LEFT))
TO TO
expression(&(nd1->nd_right)) expression(&(nd1->nd_RIGHT))
{ nd->nd_RIGHT = nd1 = dot2leaf(Link);
nd1->nd_symb = BY;
}
[ [
BY BY
ConstExpression(&dummy) ConstExpression(&(nd1->nd_LEFT))
{ if (!(dummy->nd_type->tp_fund & T_INTORCARD)) { { if (!(nd1->nd_LEFT->nd_type->tp_fund & T_INTORCARD)) {
error("illegal type in BY clause"); error("illegal type in BY clause");
} }
nd1->nd_INT = dummy->nd_INT;
FreeNode(dummy);
} }
| |
{ nd1->nd_INT = 1; } { nd1->nd_LEFT = dot2leaf(Value);
nd1->nd_LEFT->nd_INT = 1;
}
] ]
DO DO
StatementSequence(&(nd->nd_right)) StatementSequence(&(nd1->nd_RIGHT))
END END
; ;
/* inline in Statement; lack of space /* inline in Statement; lack of space
LoopStatement(t_node **pnd;): LoopStatement(t_node **pnd;):
LOOP { *pnd = dot2leaf(Stat); } LOOP { *pnd = dot2leaf(Stat); }
StatementSequence(&((*pnd)->nd_right)) StatementSequence(&((*pnd)->nd_RIGHT))
END END
; ;
*/ */
@ -249,9 +254,9 @@ WithStatement(t_node **pnd;)
register t_node *nd; register t_node *nd;
}: }:
WITH { *pnd = nd = dot2leaf(Stat); } WITH { *pnd = nd = dot2leaf(Stat); }
designator(&(nd->nd_left)) designator(&(nd->nd_LEFT))
DO DO
StatementSequence(&(nd->nd_right)) StatementSequence(&(nd->nd_RIGHT))
END END
; ;
@ -264,7 +269,7 @@ ReturnStatement(t_node **pnd;)
RETURN { *pnd = nd = dot2leaf(Stat); } RETURN { *pnd = nd = dot2leaf(Stat); }
[ [
expression(&(nd->nd_right)) expression(&(nd->nd_RIGHT))
{ if (scopeclosed(CurrentScope)) { { if (scopeclosed(CurrentScope)) {
error("a module body cannot return a value"); error("a module body cannot return a value");
} }

5
lang/m2/comp/type.H
View file

@ -161,6 +161,8 @@ extern t_type
#define float_size (SZ_FLOAT) #define float_size (SZ_FLOAT)
#define double_size (SZ_DOUBLE) #define double_size (SZ_DOUBLE)
#define pointer_size (SZ_POINTER) #define pointer_size (SZ_POINTER)
#define wrd_bits (8*(int)word_size)
#else NOCROSS #else NOCROSS
extern int extern int
@ -182,6 +184,9 @@ extern arith
float_size, float_size,
double_size, double_size,
pointer_size; /* All from type.c */ pointer_size; /* All from type.c */
extern unsigned int
wrd_bits; /* from cstoper.c */
#endif NOCROSS #endif NOCROSS
extern arith extern arith

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

@ -23,7 +23,6 @@
#include "type.h" #include "type.h"
#include "idf.h" #include "idf.h"
#include "node.h" #include "node.h"
#include "const.h"
#include "scope.h" #include "scope.h"
#include "walk.h" #include "walk.h"
#include "chk_expr.h" #include "chk_expr.h"
@ -52,6 +51,8 @@ arith
pointer_size = SZ_POINTER; pointer_size = SZ_POINTER;
#endif #endif
#define arith_sign ((arith) (1L << (sizeof(arith) * 8 - 1)))
arith ret_area_size; arith ret_area_size;
t_type t_type
@ -255,12 +256,13 @@ enum_type(EnumList)
} }
t_type * t_type *
qualified_type(nd) qualified_type(pnd)
register t_node *nd; t_node **pnd;
{ {
register t_def *df; register t_def *df;
if (ChkDesig(nd, D_USED)) { if (ChkDesig(pnd, D_USED)) {
register t_node *nd = *pnd;
if (nd->nd_class != Def) { if (nd->nd_class != Def) {
node_error(nd, "type expected"); node_error(nd, "type expected");
FreeNode(nd); FreeNode(nd);
@ -284,9 +286,9 @@ node_error(nd,"type \"%s\" not (yet) declared", df->df_idf->id_text);
} }
return df->df_type; return df->df_type;
} }
node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text); node_error(nd, "identifier \"%s\" is not a type", df->df_idf->id_text);
} }
FreeNode(nd); FreeNode(*pnd);
return error_type; return error_type;
} }
@ -681,7 +683,7 @@ SolveForwardTypeRefs(df)
df->df_kind = D_TYPE; df->df_kind = D_TYPE;
while (nd) { while (nd) {
nd->nd_type->tp_next = df->df_type; nd->nd_type->tp_next = df->df_type;
nd = nd->nd_right; nd = nd->nd_RIGHT;
} }
FreeNode(df->df_forw_node); FreeNode(df->df_forw_node);
} }
@ -750,7 +752,7 @@ type_or_forward(tp)
df1->df_forw_node = 0; df1->df_forw_node = 0;
/* Fall through */ /* Fall through */
case D_FORWTYPE: case D_FORWTYPE:
nd = dot2node(0, NULLNODE, df1->df_forw_node); nd = dot2node(Link, NULLNODE, df1->df_forw_node);
df1->df_forw_node = nd; df1->df_forw_node = nd;
nd->nd_type = tp; nd->nd_type = tp;
return 0; return 0;
@ -758,7 +760,7 @@ type_or_forward(tp)
return 1; return 1;
} }
} }
nd = dot2leaf(0); nd = dot2leaf(Name);
if ((df1 = lookfor(nd, CurrVis, 0, D_USED))->df_kind == D_MODULE) { if ((df1 = lookfor(nd, CurrVis, 0, D_USED))->df_kind == D_MODULE) {
/* A Modulename in one of the enclosing scopes. /* A Modulename in one of the enclosing scopes.
It is not clear from the language definition that It is not clear from the language definition that

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

@ -72,7 +72,7 @@ static int UseWarnings();
int int
LblWalkNode(lbl, nd, exit, reach) LblWalkNode(lbl, nd, exit, reach)
label lbl, exit; label lbl, exit;
register t_node *nd; t_node *nd;
{ {
/* Generate code for node "nd", after generating instruction /* Generate code for node "nd", after generating instruction
label "lbl". "exit" is the exit label for the closest label "lbl". "exit" is the exit label for the closest
@ -134,8 +134,8 @@ DoLineno(nd)
static int ms_lineno; static int ms_lineno;
if (ms_lineno != nd->nd_lineno) { if (ms_lineno != nd->nd_lineno) {
C_ms_std((char *) 0, N_SLINE, nd->nd_lineno);
ms_lineno = nd->nd_lineno; ms_lineno = nd->nd_lineno;
C_ms_std((char *) 0, N_SLINE, ms_lineno);
} }
} }
#endif /* DBSYMTAB */ #endif /* DBSYMTAB */
@ -218,7 +218,7 @@ WalkModule(module)
C_cal("killbss"); C_cal("killbss");
} }
for (; nd; nd = nd->nd_left) { for (; nd; nd = nd->nd_NEXT) {
C_cal(nd->nd_def->mod_vis->sc_scope->sc_name); C_cal(nd->nd_def->mod_vis->sc_scope->sc_name);
} }
DoFilename(1); DoFilename(1);
@ -578,8 +578,8 @@ WalkLink(nd, exit_label, end_reached)
*/ */
while (nd && nd->nd_class == Link) { /* statement list */ while (nd && nd->nd_class == Link) { /* statement list */
end_reached = WalkNode(nd->nd_left, exit_label, end_reached); end_reached = WalkNode(nd->nd_LEFT, exit_label, end_reached);
nd = nd->nd_right; nd = nd->nd_RIGHT;
} }
return WalkNode(nd, exit_label, end_reached); return WalkNode(nd, exit_label, end_reached);
@ -602,8 +602,8 @@ WalkStat(nd, exit_label, end_reached)
{ {
/* Walk through a statement, generating code for it. /* Walk through a statement, generating code for it.
*/ */
register t_node *left = nd->nd_left; register t_node *left = nd->nd_LEFT;
register t_node *right = nd->nd_right; register t_node *right = nd->nd_RIGHT;
assert(nd->nd_class == Stat); assert(nd->nd_class == Stat);
@ -620,33 +620,36 @@ WalkStat(nd, exit_label, end_reached)
options['R'] = (nd->nd_flags & ROPTION); options['R'] = (nd->nd_flags & ROPTION);
options['A'] = (nd->nd_flags & AOPTION); options['A'] = (nd->nd_flags & AOPTION);
switch(nd->nd_symb) { switch(nd->nd_symb) {
case '(': case '(': {
if (ChkCall(nd)) { t_node *nd1 = nd;
if (ChkCall(&nd1)) {
assert(nd == nd1);
if (nd->nd_type != 0) { if (nd->nd_type != 0) {
node_error(nd, "procedure call expected instead of function call"); node_error(nd, "procedure call expected instead of function call");
break; break;
} }
CodeCall(nd); CodeCall(nd);
} }
}
break; break;
case BECOMES: case BECOMES:
DoAssign(left, right); DoAssign(nd);
break; break;
case IF: case IF:
{ label l1 = ++text_label, l3 = ++text_label; { label l1 = ++text_label, l3 = ++text_label;
int end_r; int end_r;
ExpectBool(left, l3, l1); ExpectBool(&(nd->nd_LEFT), l3, l1);
assert(right->nd_symb == THEN); assert(right->nd_symb == THEN);
end_r = LblWalkNode(l3, right->nd_left, exit_label, end_reached); end_r = LblWalkNode(l3, right->nd_LEFT, exit_label, end_reached);
if (right->nd_right) { /* ELSE part */ if (right->nd_RIGHT) { /* ELSE part */
label l2 = ++text_label; label l2 = ++text_label;
C_bra(l2); C_bra(l2);
end_reached = end_r | LblWalkNode(l1, right->nd_right, exit_label, end_reached); end_reached = end_r | LblWalkNode(l1, right->nd_RIGHT, exit_label, end_reached);
l1 = l2; l1 = l2;
} }
else end_reached |= end_r; else end_reached |= end_r;
@ -666,7 +669,7 @@ WalkStat(nd, exit_label, end_reached)
C_bra(dummy); C_bra(dummy);
end_reached |= LblWalkNode(loop, right, exit_label, end_reached); end_reached |= LblWalkNode(loop, right, exit_label, end_reached);
def_ilb(dummy); def_ilb(dummy);
ExpectBool(left, loop, exit); ExpectBool(&(nd->nd_LEFT), loop, exit);
def_ilb(exit); def_ilb(exit);
break; break;
} }
@ -675,7 +678,7 @@ WalkStat(nd, exit_label, end_reached)
{ label loop = ++text_label, exit = ++text_label; { label loop = ++text_label, exit = ++text_label;
end_reached = LblWalkNode(loop, left, exit_label, end_reached); end_reached = LblWalkNode(loop, left, exit_label, end_reached);
ExpectBool(right, exit, loop); ExpectBool(&(nd->nd_RIGHT), exit, loop);
def_ilb(exit); def_ilb(exit);
break; break;
} }
@ -696,44 +699,45 @@ WalkStat(nd, exit_label, end_reached)
{ {
arith tmp = NewInt(); arith tmp = NewInt();
arith tmp2 = NewInt(); arith tmp2 = NewInt();
register t_node *fnd;
int good_forvar; int good_forvar;
label l1 = ++text_label; label l1 = ++text_label;
label l2 = ++text_label; label l2 = ++text_label;
int uns = 0; int uns = 0;
arith stepsize; arith stepsize;
t_type *bstp; t_type *bstp;
t_node *loopid;
good_forvar = DoForInit(nd); good_forvar = DoForInit(left);
if ((stepsize = left->nd_INT) == 0) { loopid = left->nd_LEFT;
node_warning(left, if ((stepsize = right->nd_LEFT->nd_INT) == 0) {
node_warning(right->nd_LEFT,
W_ORDINARY, W_ORDINARY,
"zero stepsize in FOR loop"); "zero stepsize in FOR loop");
} }
fnd = left->nd_right;
if (good_forvar) { if (good_forvar) {
bstp = BaseType(nd->nd_type); bstp = BaseType(loopid->nd_type);
uns = bstp->tp_fund != T_INTEGER; uns = bstp->tp_fund != T_INTEGER;
CodePExpr(fnd); CodePExpr(left->nd_RIGHT->nd_RIGHT);
C_stl(tmp); C_stl(tmp);
CodePExpr(left->nd_left); CodePExpr(left->nd_RIGHT->nd_LEFT);
C_dup(int_size); C_dup(int_size);
C_stl(tmp2); C_stl(tmp2);
C_lol(tmp); C_lol(tmp);
if (uns) C_cmu(int_size); if (uns) C_cmu(int_size);
else C_cmi(int_size); else C_cmi(int_size);
if (left->nd_INT >= 0) C_zgt(l2); if (stepsize >= 0) C_zgt(l2);
else C_zlt(l2); else C_zlt(l2);
C_lol(tmp2); C_lol(tmp2);
RangeCheck(nd->nd_type, left->nd_left->nd_type); RangeCheck(loopid->nd_type,
CodeDStore(nd); left->nd_RIGHT->nd_LEFT->nd_type);
if (left->nd_INT >= 0) { CodeDStore(loopid);
if (stepsize >= 0) {
C_lol(tmp); C_lol(tmp);
ForLoopVarExpr(nd); ForLoopVarExpr(loopid);
} }
else { else {
stepsize = -stepsize; stepsize = -stepsize;
ForLoopVarExpr(nd); ForLoopVarExpr(loopid);
C_lol(tmp); C_lol(tmp);
} }
C_sbu(int_size); C_sbu(int_size);
@ -742,23 +746,23 @@ WalkStat(nd, exit_label, end_reached)
C_dvu(int_size); C_dvu(int_size);
} }
C_stl(tmp); C_stl(tmp);
nd->nd_def->df_flags |= D_FORLOOP; loopid->nd_def->df_flags |= D_FORLOOP;
def_ilb(l1); def_ilb(l1);
if (! options['R']) { if (! options['R']) {
label x = ++text_label; label x = ++text_label;
ForLoopVarExpr(nd); ForLoopVarExpr(loopid);
C_stl(tmp2); C_stl(tmp2);
end_reached |= WalkNode(right, exit_label, end_reached); end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
C_lol(tmp2); C_lol(tmp2);
ForLoopVarExpr(nd); ForLoopVarExpr(loopid);
C_beq(x); C_beq(x);
c_loc(M2_FORCH); c_loc(M2_FORCH);
C_trp(); C_trp();
def_ilb(x); def_ilb(x);
} }
else end_reached |= WalkNode(right, exit_label, end_reached); else end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
nd->nd_def->df_flags &= ~D_FORLOOP; loopid->nd_def->df_flags &= ~D_FORLOOP;
FreeInt(tmp2); FreeInt(tmp2);
if (stepsize) { if (stepsize) {
C_lol(tmp); C_lol(tmp);
@ -767,24 +771,20 @@ WalkStat(nd, exit_label, end_reached)
c_loc(1); c_loc(1);
C_sbu(int_size); C_sbu(int_size);
C_stl(tmp); C_stl(tmp);
C_loc(left->nd_INT); C_loc(right->nd_LEFT->nd_INT);
ForLoopVarExpr(nd); ForLoopVarExpr(loopid);
C_adu(int_size); C_adu(int_size);
RangeCheck(nd->nd_type, bstp); RangeCheck(loopid->nd_type, bstp);
CodeDStore(nd); CodeDStore(loopid);
} }
} }
else { else {
end_reached |= WalkNode(right, exit_label, end_reached); end_reached |= WalkNode(right->nd_RIGHT, exit_label, end_reached);
nd->nd_def->df_flags &= ~D_FORLOOP; loopid->nd_def->df_flags &= ~D_FORLOOP;
} }
C_bra(l1); C_bra(l1);
def_ilb(l2); def_ilb(l2);
FreeInt(tmp); FreeInt(tmp);
#ifdef DEBUG
nd->nd_left = left;
nd->nd_right = right;
#endif
} }
break; break;
@ -794,7 +794,8 @@ WalkStat(nd, exit_label, end_reached)
struct withdesig wds; struct withdesig wds;
t_desig ds; t_desig ds;
if (! WalkDesignator(left, &ds, D_USED)) break; if (! WalkDesignator(&(nd->nd_LEFT), &ds, D_USED)) break;
left = nd->nd_LEFT;
if (left->nd_type->tp_fund != T_RECORD) { if (left->nd_type->tp_fund != T_RECORD) {
node_error(left, "record variable expected"); node_error(left, "record variable expected");
break; break;
@ -821,7 +822,7 @@ WalkStat(nd, exit_label, end_reached)
CurrVis = link.sc_next; CurrVis = link.sc_next;
WithDesigs = wds.w_next; WithDesigs = wds.w_next;
FreePtr(ds.dsg_offset); FreePtr(ds.dsg_offset);
ChkDesig(left, wds.w_flags & (D_USED|D_DEFINED)); ChkDesig(&(nd->nd_LEFT), wds.w_flags & (D_USED|D_DEFINED));
break; break;
} }
@ -835,15 +836,15 @@ WalkStat(nd, exit_label, end_reached)
case RETURN: case RETURN:
end_reached &= ~REACH_FLAG; end_reached &= ~REACH_FLAG;
if (right) { if (right) {
if (! ChkExpression(right)) break; if (! ChkExpression(&(nd->nd_RIGHT))) break;
/* The type of the return-expression must be /* The type of the return-expression must be
assignment compatible with the result type of the assignment compatible with the result type of the
function procedure (See Rep. 9.11). function procedure (See Rep. 9.11).
*/ */
if (!ChkAssCompat(&(nd->nd_right), func_type, "RETURN")) { if (!ChkAssCompat(&(nd->nd_RIGHT), func_type, "RETURN")) {
break; break;
} }
right = nd->nd_right; right = nd->nd_RIGHT;
if (right->nd_type->tp_fund == T_STRING) { if (right->nd_type->tp_fund == T_STRING) {
CodePString(right, func_type); CodePString(right, func_type);
} }
@ -872,60 +873,58 @@ int (*WalkTable[])() = {
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
WalkStat, WalkStat,
NodeCrash,
WalkLink, WalkLink,
}; };
ExpectBool(nd, true_label, false_label) ExpectBool(pnd, true_label, false_label)
register t_node *nd; register t_node **pnd;
label true_label, false_label; label true_label, false_label;
{ {
/* "nd" must indicate a boolean expression. Check this and /* "pnd" must indicate a boolean expression. Check this and
generate code to evaluate the expression. generate code to evaluate the expression.
*/ */
register t_desig *ds = new_desig(); register t_desig *ds = new_desig();
if (ChkExpression(nd)) { if (ChkExpression(pnd)) {
if (nd->nd_type != bool_type && nd->nd_type != error_type) { if ((*pnd)->nd_type != bool_type &&
node_error(nd, "boolean expression expected"); (*pnd)->nd_type != error_type) {
node_error(*pnd, "boolean expression expected");
} }
CodeExpr(nd, ds, true_label, false_label); CodeExpr(*pnd, ds, true_label, false_label);
} }
free_desig(ds); free_desig(ds);
} }
int int
WalkDesignator(nd, ds, flags) WalkDesignator(pnd, ds, flags)
t_node *nd; t_node **pnd;
t_desig *ds; t_desig *ds;
{ {
/* Check designator and generate code for it /* Check designator and generate code for it
*/ */
if (! ChkVariable(nd, flags)) return 0; if (! ChkVariable(pnd, flags)) return 0;
clear((char *) ds, sizeof(t_desig)); clear((char *) ds, sizeof(t_desig));
CodeDesig(nd, ds); CodeDesig(*pnd, ds);
return 1; return 1;
} }
DoForInit(nd) DoForInit(nd)
register t_node *nd; t_node *nd;
{ {
register t_node *left = nd->nd_left; register t_node *right = nd->nd_RIGHT;
register t_def *df; register t_def *df;
register t_type *base_tp; t_type *base_tp;
t_type *tpl, *tpr; t_type *tpl, *tpr;
nd->nd_left = nd->nd_right = 0; if (!( ChkVariable(&(nd->nd_LEFT), D_USED|D_DEFINED) &
nd->nd_class = Name; ChkExpression(&(right->nd_LEFT)) &
nd->nd_symb = IDENT; ChkExpression(&(right->nd_RIGHT)))) return 0;
if (!( ChkVariable(nd, D_USED|D_DEFINED) & df = nd->nd_LEFT->nd_def;
ChkExpression(left->nd_left) &
ChkExpression(left->nd_right))) return 0;
df = nd->nd_def;
if (df->df_kind == D_FIELD) { if (df->df_kind == D_FIELD) {
node_error(nd, node_error(nd,
"FOR-loop variable may not be a field of a record"); "FOR-loop variable may not be a field of a record");
@ -958,12 +957,12 @@ DoForInit(nd)
} }
base_tp = BaseType(df->df_type); base_tp = BaseType(df->df_type);
tpl = left->nd_left->nd_type; tpl = right->nd_LEFT->nd_type;
tpr = left->nd_right->nd_type; tpr = right->nd_RIGHT->nd_type;
#ifndef STRICT_3RD_ED #ifndef STRICT_3RD_ED
if (! options['3']) { if (! options['3']) {
if (!ChkAssCompat(&(left->nd_left), base_tp, "FOR statement") || if (!ChkAssCompat(&(right->nd_LEFT), base_tp, "FOR statement") ||
!ChkAssCompat(&(left->nd_right), base_tp, "FOR statement")) { !ChkAssCompat(&(right->nd_RIGHT), base_tp, "FOR statement")) {
return 1; return 1;
} }
if (!TstCompat(df->df_type, tpl) || if (!TstCompat(df->df_type, tpl) ||
@ -972,17 +971,16 @@ node_warning(nd, W_OLDFASHIONED, "compatibility required in FOR statement");
} }
} else } else
#endif #endif
if (!ChkCompat(&(left->nd_left), base_tp, "FOR statement") || if (!ChkCompat(&(right->nd_LEFT), base_tp, "FOR statement") ||
!ChkCompat(&(left->nd_right), base_tp, "FOR statement")) { !ChkCompat(&(right->nd_RIGHT), base_tp, "FOR statement")) {
return 1; return 1;
} }
return 1; return 1;
} }
DoAssign(left, right) DoAssign(nd)
register t_node *left; register t_node *nd;
t_node *right;
{ {
/* May we do it in this order (expression first) ??? /* May we do it in this order (expression first) ???
The reference manual sais nothing about it, but the book does: The reference manual sais nothing about it, but the book does:
@ -992,27 +990,28 @@ DoAssign(left, right)
register t_desig *dsr; register t_desig *dsr;
register t_type *tp; register t_type *tp;
if (! (ChkExpression(right) & ChkVariable(left, D_DEFINED))) return; if (! (ChkExpression(&(nd->nd_RIGHT)) &
tp = left->nd_type; ChkVariable(&(nd->nd_LEFT), D_DEFINED))) return;
tp = nd->nd_LEFT->nd_type;
if (right->nd_symb == STRING) TryToString(right, tp); if (nd->nd_RIGHT->nd_symb == STRING) TryToString(nd->nd_RIGHT, tp);
if (! ChkAssCompat(&right, tp, "assignment")) { if (! ChkAssCompat(&(nd->nd_RIGHT), tp, "assignment")) {
return; return;
} }
dsr = new_desig(); dsr = new_desig();
#define StackNeededFor(ds) ((ds)->dsg_kind == DSG_PLOADED \ #define StackNeededFor(ds) ((ds)->dsg_kind == DSG_PLOADED \
|| (ds)->dsg_kind == DSG_INDEXED) || (ds)->dsg_kind == DSG_INDEXED)
CodeExpr(right, dsr, NO_LABEL, NO_LABEL); CodeExpr(nd->nd_RIGHT, dsr, NO_LABEL, NO_LABEL);
tp = right->nd_type; tp = nd->nd_RIGHT->nd_type;
if (complex(tp)) { if (complex(tp)) {
if (StackNeededFor(dsr)) CodeAddress(dsr); if (StackNeededFor(dsr)) CodeAddress(dsr);
} }
else { else {
CodeValue(dsr, tp); CodeValue(dsr, tp);
} }
CodeMove(dsr, left, tp); CodeMove(dsr, nd->nd_LEFT, tp);
free_desig(dsr); free_desig(dsr);
} }