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

newer version

Browse source
This commit is contained in:
ceriel 1986-06-26 09:39:36 +00:00
parent 9932033365
commit bcfca75b56
19 changed files with 387 additions and 446 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lang/m2/comp/Makefile
View file

@ -97,26 +97,26 @@ symbol2str.o: Lpars.h
tokenname.o: Lpars.h idf.h tokenname.h
idf.o: idf.h
input.o: f_info.h input.h inputtype.h
type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h scope.h target_sizes.h type.h
type.o: LLlex.h const.h debug.h def.h idf.h maxset.h node.h scope.h target_sizes.h type.h walk.h
def.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
scope.o: LLlex.h debug.h def.h idf.h node.h scope.h type.h
misc.o: LLlex.h f_info.h idf.h misc.h node.h
enter.o: LLlex.h debug.h def.h idf.h main.h node.h scope.h type.h
defmodule.o: LLlex.h debug.h def.h f_info.h idf.h input.h inputtype.h main.h scope.h
typequiv.o: LLlex.h def.h node.h type.h
typequiv.o: LLlex.h debug.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 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 chk_expr.h debug.h def.h desig.h f_info.h idf.h main.h node.h scope.h type.h walk.h
casestat.o: LLlex.h Lpars.h debug.h density.h desig.h node.h type.h
casestat.o: LLlex.h Lpars.h debug.h density.h desig.h node.h type.h walk.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
code.o: LLlex.h Lpars.h debug.h def.h desig.h node.h scope.h standards.h type.h walk.h
tmpvar.o: debug.h def.h main.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
declar.o: LLlex.h Lpars.h chk_expr.h debug.h def.h idf.h main.h misc.h node.h scope.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

4
lang/m2/comp/Parameters
View file

@ -49,9 +49,9 @@
#define DEBUG 1 /* perform various self-tests */
extern char options[];
#ifdef DEBUG
#define DO_DEBUG(n, x) ((n) <= options['D'] && (x))
#define DO_DEBUG(y, x) ((y) && (x))
#else
#define DO_DEBUG(n, x)
#define DO_DEBUG(y, x)
#endif DEBUG
!File: inputtype.h

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

@ -27,11 +27,87 @@ static char *RcsId = "$Header$";
extern char *symbol2str();
int
chk_variable(expp)
register struct node *expp;
{
if (! chk_designator(expp)) return 0;
if (expp->nd_class == Def &&
!(expp->nd_def->df_kind & (D_FIELD|D_VARIABLE))) {
node_error(expp, "variable expected");
return 0;
}
return 1;
}
STATIC int
chk_arrow(expp)
register struct node *expp;
{
register struct type *tp;
assert(expp->nd_class == Arrow);
assert(expp->nd_symb == '^');
expp->nd_type = error_type;
if (! chk_variable(expp->nd_right)) return 0;
tp = expp->nd_right->nd_type;
if (tp->tp_fund != T_POINTER) {
node_error(expp, "illegal operand for unary operator \"%s\"",
symbol2str(expp->nd_symb));
return 0;
}
expp->nd_type = PointedtoType(tp);
return 1;
}
STATIC int
chk_arr(expp)
struct node *expp;
register struct node *expp;
{
return chk_designator(expp, VARIABLE, D_USED);
register struct type *tpl, *tpr;
assert(expp->nd_class == Arrsel);
assert(expp->nd_symb == '[');
expp->nd_type = error_type;
if (
!chk_variable(expp->nd_left)
||
!chk_expr(expp->nd_right)
||
expp->nd_left->nd_type == error_type
) return 0;
tpl = expp->nd_left->nd_type;
tpr = expp->nd_right->nd_type;
if (tpl->tp_fund != T_ARRAY) {
node_error(expp, "array index not belonging to an ARRAY");
return 0;
}
/* Type of the index must be assignment compatible with
the index type of the array (Def 8.1).
However, the index type of a conformant array is not specified.
Either INTEGER or CARDINAL seems reasonable.
*/
if (IsConformantArray(tpl) ? !TstAssCompat(card_type, tpr)
: !TstAssCompat(IndexType(tpl), tpr)) {
node_error(expp, "incompatible index type");
return 0;
}
expp->nd_type = tpl->arr_elem;
return 1;
}
STATIC int
@ -54,24 +130,107 @@ STATIC int
chk_linkorname(expp)
register struct node *expp;
{
if (chk_designator(expp, VALUE, 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.
register struct def *df;
if (expp->nd_class == Name) {
expp->nd_def = lookfor(expp, CurrVis, 1);
expp->nd_class = Def;
expp->nd_type = expp->nd_def->df_type;
}
else if (expp->nd_class == Link) {
register struct node *left = expp->nd_left;
assert(expp->nd_symb == '.');
if (! chk_designator(left)) return 0;
if (left->nd_type->tp_fund != T_RECORD ||
(left->nd_class == Def &&
!(left->nd_def->df_kind & (D_MODULE|D_VARIABLE|D_FIELD))
)
) {
node_error(left, "illegal selection");
return 0;
}
if (!(df = lookup(expp->nd_IDF, left->nd_type->rec_scope))) {
id_not_declared(expp);
return 0;
}
else {
expp->nd_def = df;
expp->nd_type = df->df_type;
expp->nd_class = LinkDef;
if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
/* Fields of a record are always D_QEXPORTED,
so ...
*/
node_error(expp, "it is illegal to take the address of a standard or local procedure");
node_error(expp, "identifier \"%s\" not exported from qualifying module",
df->df_idf->id_text);
return 0;
}
}
return 1;
if (left->nd_class == Def &&
left->nd_def->df_kind == D_MODULE) {
expp->nd_class = Def;
FreeNode(left);
expp->nd_left = 0;
}
else return 1;
}
return 0;
assert(expp->nd_class == Def);
df = expp->nd_def;
if (df->df_kind & (D_ENUM | D_CONST)) {
if (df->df_kind == D_ENUM) {
expp->nd_class = Value;
expp->nd_INT = df->enm_val;
expp->nd_symb = INTEGER;
}
else {
unsigned int ln;
assert(df->df_kind == D_CONST);
ln = expp->nd_lineno;
*expp = *(df->con_const);
expp->nd_lineno = ln;
}
}
return 1;
}
STATIC int
chk_ex_linkorname(expp)
register struct node *expp;
{
register struct def *df;
if (! chk_linkorname(expp)) return 0;
if (expp->nd_class != Def) return 1;
df = expp->nd_def;
if (!(df->df_kind & (D_ENUM|D_CONST|D_PROCEDURE|D_FIELD|D_VARIABLE|D_PROCHEAD))) {
node_error(expp, "value expected");
}
if (df->df_kind == D_PROCEDURE) {
/* Check that this procedure is one that we
may take the address from.
*/
if (df->df_type == std_type || df->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;
}
}
return 1;
}
STATIC int
@ -186,7 +345,7 @@ chk_set(expp)
if (nd = expp->nd_left) {
/* A type was given. Check it out
*/
if (! chk_designator(nd, 0, D_USED)) return 0;
if (! chk_designator(nd)) return 0;
assert(nd->nd_class == Def);
df = nd->nd_def;
@ -224,7 +383,7 @@ node_error(expp, "specifier does not represent a set type");
while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ',');
if (!chk_el(nd->nd_left, tp->next, &set)) return 0;
if (!chk_el(nd->nd_left, ElementType(tp), &set)) return 0;
nd = nd->nd_right;
}
@ -268,13 +427,11 @@ getarg(argp, bases, designator)
left = arg->nd_left;
if ((!designator && !chk_expr(left)) ||
(designator &&
!chk_designator(left, VARIABLE, D_USED|D_NOREG))) {
(designator && !chk_variable(left))) {
return 0;
}
tp = left->nd_type;
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
tp = BaseType(left->nd_type);
if (bases && !(tp->tp_fund & bases)) {
node_error(arg, "unexpected type");
@ -297,7 +454,7 @@ getname(argp, kinds)
}
arg = arg->nd_right;
if (! chk_designator(arg->nd_left, 0, D_REFERRED)) return 0;
if (! chk_designator(arg->nd_left)) return 0;
if (arg->nd_left->nd_class != Def && arg->nd_left->nd_class != LinkDef) {
node_error(arg, "identifier expected");
@ -325,7 +482,7 @@ chk_proccall(expp)
left = expp->nd_left;
arg = expp;
expp->nd_type = left->nd_type->next;
expp->nd_type = ResultType(left->nd_type);
for (param = ParamList(left->nd_type); param; param = param->next) {
if (!(left = getarg(&arg, 0, IsVarParam(param)))) return 0;
@ -358,12 +515,14 @@ chk_call(expp)
it may also be a cast or a standard procedure call.
*/
register struct node *left;
STATIC int chk_std();
STATIC int chk_cast();
/* First, get the name of the function or procedure
*/
expp->nd_type = error_type;
left = expp->nd_left;
if (! chk_designator(left, 0, D_USED)) return 0;
if (! chk_designator(left)) return 0;
if (IsCast(left)) {
/* It was a type cast. This is of course not portable.
@ -390,192 +549,6 @@ chk_call(expp)
return 0;
}
STATIC int
FlagCheck(expp, df, flag)
struct node *expp;
struct def *df;
{
/* See the routine "chk_designator" for an explanation of
"flag". Here, a definition "df" is checked against it.
*/
if (df->df_kind == D_ERROR) return 0;
if ((flag & VARIABLE) &&
!(df->df_kind & (D_FIELD|D_VARIABLE))) {
node_error(expp, "variable expected");
return 0;
}
if ((flag & HASSELECTORS) &&
( !(df->df_kind & (D_VARIABLE|D_FIELD|D_MODULE)) ||
df->df_type->tp_fund != T_RECORD)) {
node_error(expp, "illegal selection");
return 0;
}
if ((flag & VALUE) &&
( !(df->df_kind & (D_VARIABLE|D_FIELD|D_CONST|D_ENUM|D_PROCEDURE)))) {
node_error(expp, "value expected");
return 0;
}
return 1;
}
int
chk_designator(expp, flag, dflags)
register struct node *expp;
{
/* Find the name indicated by "expp", starting from the current
scope. "flag" indicates the kind of designator we expect:
It contains the flags VARIABLE, indicating that the result must
be something that can be assigned to.
It may also contain the flag VALUE, indicating that a
value is expected. In this case, VARIABLE may not be set.
Also contained may be the flag HASSELECTORS, indicating that
the result must have selectors.
"dflags" contains some flags that must be set at the definition
found.
*/
register struct def *df;
register struct type *tp;
if (expp->nd_class == Def || expp->nd_class == LinkDef) {
expp->nd_def->df_flags |= dflags;
return 1;
}
expp->nd_type = error_type;
if (expp->nd_class == Name) {
expp->nd_def = lookfor(expp, CurrVis, 1);
expp->nd_class = Def;
expp->nd_type = expp->nd_def->df_type;
}
else if (expp->nd_class == Link) {
register struct node *left = expp->nd_left;
assert(expp->nd_symb == '.');
if (! chk_designator(left,
HASSELECTORS,
dflags)) return 0;
tp = left->nd_type;
assert(tp->tp_fund == T_RECORD);
if (!(df = lookup(expp->nd_IDF, tp->rec_scope))) {
id_not_declared(expp);
return 0;
}
else {
expp->nd_def = df;
expp->nd_type = df->df_type;
expp->nd_class = LinkDef;
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 (left->nd_class == Def &&
left->nd_def->df_kind == D_MODULE) {
expp->nd_class = Def;
FreeNode(left);
expp->nd_left = 0;
}
else {
return FlagCheck(expp, df, flag);
}
}
if (expp->nd_class == Def) {
df = expp->nd_def;
if (! FlagCheck(expp, df, flag)) return 0;
if (df->df_kind & (D_ENUM | D_CONST)) {
if (df->df_kind == D_ENUM) {
expp->nd_class = Value;
expp->nd_INT = df->enm_val;
expp->nd_symb = INTEGER;
}
else {
unsigned int ln;
assert(df->df_kind == D_CONST);
ln = expp->nd_lineno;
*expp = *(df->con_const);
expp->nd_lineno = ln;
}
}
df->df_flags |= dflags;
return 1;
}
if (expp->nd_class == Arrsel) {
struct type *tpl, *tpr;
assert(expp->nd_symb == '[');
if (
!chk_designator(expp->nd_left, VARIABLE, dflags)
||
!chk_expr(expp->nd_right)
||
expp->nd_left->nd_type == error_type
) return 0;
tpr = expp->nd_right->nd_type;
tpl = expp->nd_left->nd_type;
if (tpl->tp_fund != T_ARRAY) {
node_error(expp,
"array index not belonging to an ARRAY");
return 0;
}
/* Type of the index must be assignment compatible with
the index type of the array (Def 8.1)
*/
if ((tpl->next && !TstAssCompat(tpl->next, tpr)) ||
(!tpl->next && !TstAssCompat(intorcard_type, tpr))) {
node_error(expp, "incompatible index type");
return 0;
}
expp->nd_type = tpl->arr_elem;
return 1;
}
if (expp->nd_class == Arrow) {
assert(expp->nd_symb == '^');
if (! chk_designator(expp->nd_right, VARIABLE, dflags)) {
return 0;
}
if (expp->nd_right->nd_type->tp_fund != T_POINTER) {
node_error(expp, "illegal operand for unary operator \"%s\"",
symbol2str(expp->nd_symb));
return 0;
}
expp->nd_type = expp->nd_right->nd_type->next;
return 1;
}
node_error(expp, "designator expected");
return 0;
}
STATIC struct type *
ResultOfOperation(operator, tp)
struct type *tp;
@ -663,11 +636,8 @@ chk_oper(expp)
if (!chk_expr(left) || !chk_expr(right)) return 0;
tpl = left->nd_type;
tpr = right->nd_type;
if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
tpl = BaseType(left->nd_type);
tpr = BaseType(right->nd_type);
if (tpl == intorcard_type) {
if (tpr == int_type || tpr == card_type) {
@ -688,7 +658,7 @@ chk_oper(expp)
node_error(expp, "RHS of IN operator not a SET type");
return 0;
}
if (!TstAssCompat(tpl, tpr->next)) {
if (!TstAssCompat(tpl, ElementType(tpr))) {
/* Assignment compatible ???
I don't know! Should we be allowed to check
if a CARDINAL is a member of a BITSET???
@ -746,8 +716,7 @@ chk_uoper(expp)
if (! chk_expr(right)) return 0;
tpr = right->nd_type;
if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
tpr = BaseType(right->nd_type);
expp->nd_type = tpr;
switch(expp->nd_symb) {
@ -809,8 +778,6 @@ getvariable(argp)
struct node **argp;
{
register struct node *arg = *argp;
register struct def *df;
register struct node *left;
arg = arg->nd_right;
if (!arg) {
@ -818,29 +785,13 @@ getvariable(argp)
return 0;
}
left = arg->nd_left;
if (! chk_designator(left, 0, D_REFERRED)) return 0;
if (left->nd_class == Arrsel || left->nd_class == Arrow) {
*argp = arg;
return left;
}
df = 0;
if (left->nd_class == LinkDef || left->nd_class == Def) {
df = left->nd_def;
}
if (!df || !(df->df_kind & (D_VARIABLE|D_FIELD))) {
node_error(arg, "variable expected");
return 0;
}
if (! chk_variable(arg->nd_left)) return 0;
*argp = arg;
return left;
return arg->nd_left;
}
int
STATIC int
chk_std(expp, left)
register struct node *expp, *left;
{
@ -852,8 +803,6 @@ chk_std(expp, left)
assert(left->nd_class == Def);
std = left->nd_def->df_value.df_stdname;
DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
switch(std) {
case S_ABS:
if (!(left = getarg(&arg, T_NUMERIC, 0))) return 0;
@ -883,13 +832,15 @@ DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
case S_HIGH:
if (!(left = getarg(&arg, T_ARRAY, 0))) return 0;
expp->nd_type = left->nd_type->next;
if (!expp->nd_type) {
/* A dynamic array has no explicit index type
if (IsConformantArray(left->nd_type)) {
/* A conformant array has no explicit index type
*/
expp->nd_type = intorcard_type;
expp->nd_type = card_type;
}
else {
expp->nd_type = IndexType(left->nd_type);
cstcall(expp, S_MAX);
}
else cstcall(expp, S_MAX);
break;
case S_MAX:
@ -942,7 +893,7 @@ DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
struct token dt;
struct node *nd;
dt.TOK_INT = left->nd_type->next->tp_size;
dt.TOK_INT = PointedtoType(left->nd_type)->tp_size;
dt.tk_symb = INTEGER;
dt.tk_lineno = left->nd_lineno;
nd = MkLeaf(Value, &dt);
@ -978,7 +929,6 @@ DO_DEBUG(3,debug("standard name \"%s\", %d",left->nd_def->df_idf->id_text,std));
if (!(left = getname(&arg, D_ISTYPE))) return 0;
tp = left->nd_def->df_type;
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
if (!(tp->tp_fund & T_DISCRETE)) {
node_error(arg, "unexpected type");
return 0;
@ -1028,7 +978,7 @@ node_error(arg, "EXCL and INCL expect a SET parameter");
return 0;
}
if (!(left = getarg(&arg, T_DISCRETE, 0))) return 0;
if (!TstAssCompat(tp->next, left->nd_type)) {
if (!TstAssCompat(ElementType(tp), left->nd_type)) {
/* What type of compatibility do we want here?
apparently assignment compatibility! ??? ???
*/
@ -1050,6 +1000,7 @@ node_error(arg, "EXCL and INCL expect a SET parameter");
return 1;
}
STATIC int
chk_cast(expp, left)
register struct node *expp, *left;
{
@ -1109,20 +1060,51 @@ TryToString(nd, tp)
}
}
STATIC int
no_desig(expp)
struct node *expp;
{
node_error(expp, "designator expected");
return 0;
}
STATIC int
done_before(expp)
struct node *expp;
{
return 1;
}
extern int NodeCrash();
int (*ChkTable[])() = {
int (*ExprChkTable[])() = {
chk_value,
chk_arr,
chk_oper,
chk_uoper,
chk_arr,
chk_arrow,
chk_call,
chk_linkorname,
chk_ex_linkorname,
NodeCrash,
chk_set,
NodeCrash,
NodeCrash,
chk_linkorname,
chk_ex_linkorname,
NodeCrash
};
int (*DesigChkTable[])() = {
chk_value,
chk_arr,
no_desig,
no_desig,
chk_arrow,
no_desig,
chk_linkorname,
NodeCrash,
no_desig,
done_before,
NodeCrash,
chk_linkorname,
done_before
};

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

@ -2,8 +2,12 @@
/* $Header$ */
extern int (*ChkTable[])(); /* table of expression checking
extern int (*ExprChkTable[])(); /* table of expression checking
functions, indexed by node class
*/
extern int (*DesigChkTable[])(); /* table of designator checking
functions, indexed by node class
*/
#define chk_expr(expp) ((*ChkTable[(expp)->nd_class])(expp))
#define chk_expr(expp) ((*ExprChkTable[(expp)->nd_class])(expp))
#define chk_designator(expp) ((*DesigChkTable[(expp)->nd_class])(expp))

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

@ -193,8 +193,8 @@ CodeCoercion(t1, t2)
{
register int fund1, fund2;
if (t1->tp_fund == T_SUBRANGE) t1 = t1->next;
if (t2->tp_fund == T_SUBRANGE) t2 = t2->next;
t1 = BaseType(t1);
t2 = BaseType(t2);
if (t1 == t2) return;
if ((fund1 = t1->tp_fund) == T_WORD) fund1 = T_INTEGER;
if ((fund2 = t2->tp_fund) == T_WORD) fund2 = T_INTEGER;
@ -368,7 +368,7 @@ CodeParameters(param, arg)
C_loc(left->nd_type->tp_size / word_size - 1);
}
else {
tp = left->nd_type->next;
tp = IndexType(left->nd_type);
if (tp->tp_fund == T_SUBRANGE) {
C_loc(tp->sub_ub - tp->sub_lb);
}
@ -402,8 +402,7 @@ CodeStd(nd)
if (arg) {
left = arg->nd_left;
tp = left->nd_type;
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
tp = BaseType(left->nd_type);
arg = arg->nd_right;
}
@ -736,8 +735,7 @@ CodeOper(expr, true_label, false_label)
case '#':
Operands(leftop, rightop);
CodeCoercion(rightop->nd_type, leftop->nd_type);
tp = leftop->nd_type; /* Not the result type! */
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
tp = BaseType(leftop->nd_type); /* Not the result type! */
switch (tp->tp_fund) {
case T_INTEGER:
C_cmi(tp->tp_size);
@ -970,13 +968,14 @@ CodeEl(nd, tp)
register struct node *nd;
register struct type *tp;
{
register struct type *eltype = ElementType(tp);
if (nd->nd_class == Link && nd->nd_symb == UPTO) {
C_loc(tp->tp_size); /* push size */
if (tp->next->tp_fund == T_SUBRANGE) {
C_loc(tp->next->sub_ub);
if (eltype->tp_fund == T_SUBRANGE) {
C_loc(eltype->sub_ub);
}
else C_loc((arith) (tp->next->enm_ncst - 1));
else C_loc((arith) (eltype->enm_ncst - 1));
Operands(nd->nd_left, nd->nd_right);
C_cal("_LtoUset"); /* library routine to fill set */
C_asp(4 * word_size);

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

@ -466,12 +466,11 @@ CutSize(expr)
conform to the size of the type of the expression.
*/
arith o1 = expr->nd_INT;
struct type *tp = expr->nd_type;
struct type *tp = BaseType(expr->nd_type);
int uns;
int size = tp->tp_size;
assert(expr->nd_class == Value);
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
uns = (tp->tp_fund & (T_CARDINAL|T_CHAR));
if (uns) {
if (o1 & ~full_mask[size]) {

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

@ -20,6 +20,7 @@ static char *RcsId = "$Header$";
#include "node.h"
#include "misc.h"
#include "main.h"
#include "chk_expr.h"
int proclevel = 0; /* nesting level of procedures */
int return_occurred; /* set if a return occurred in a
@ -52,25 +53,27 @@ error("function procedure does not return a value", df->df_idf->id_text);
ProcedureHeading(struct def **pdf; int type;)
{
struct type *tp = 0;
struct paramlist *params = 0;
struct type *tp = 0;
register struct def *df;
struct def *DeclProc();
arith NBytesParams;
} :
PROCEDURE IDENT
{
df = DeclProc(type);
tp = construct_type(T_PROCEDURE, tp);
if (proclevel > 1) {
/* Room for static link
*/
tp->prc_nbpar = pointer_size;
NBytesParams = pointer_size;
}
else tp->prc_nbpar = 0;
else NBytesParams = 0;
}
FormalParameters(&params, &(tp->next), &(tp->prc_nbpar))?
FormalParameters(&params, &tp, &NBytesParams)?
{
tp = construct_type(T_PROCEDURE, tp);
tp->prc_params = params;
tp->prc_nbpar = NBytesParams;
if (df->df_type) {
/* We already saw a definition of this type
in the definition module.
@ -85,15 +88,10 @@ error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text);
if (type == D_PROCHEAD) close_scope(0);
DO_DEBUG(1, type == D_PROCEDURE &&
(print("proc %s:", df->df_idf->id_text),
DumpType(tp), print("\n")));
}
;
block(struct node **pnd;)
{
}:
block(struct node **pnd;) :
declaration*
[
BEGIN
@ -130,7 +128,6 @@ FormalParameters(struct paramlist **pr;
]*
]?
')'
{ *tp = 0; }
[ ':' qualident(D_ISTYPE, &df, "type", (struct node **) 0)
{ *tp = df->df_type;
}
@ -142,31 +139,45 @@ FPSection(struct paramlist **ppr; arith *parmaddr;)
struct node *FPList;
struct type *tp;
int VARp = D_VALPAR;
struct paramlist *p = 0;
} :
[
VAR { VARp = D_VARPAR; }
]?
IdentList(&FPList) ':' FormalType(&tp)
{ EnterParamList(ppr, FPList, tp, VARp, parmaddr); }
IdentList(&FPList) ':' FormalType(&p, 0)
{ EnterParamList(ppr, FPList, p->par_def->df_type,
VARp, parmaddr);
free_def(p->par_def);
free_paramlist(p);
}
;
FormalType(struct type **ptp;)
FormalType(struct paramlist **ppr; int VARp;)
{
struct def *df;
int ARRAYflag = 0;
struct def *df1;
register struct def *df;
int ARRAYflag;
register struct type *tp;
register struct paramlist *p = new_paramlist();
extern arith ArrayElSize();
} :
[ ARRAY OF { ARRAYflag = 1; }
]?
qualident(D_ISTYPE, &df, "type", (struct node **) 0)
{ if (ARRAYflag) {
*ptp = tp = construct_type(T_ARRAY, NULLTYPE);
| { ARRAYflag = 0; }
]
qualident(D_ISTYPE, &df1, "type", (struct node **) 0)
{ df = df1;
if (ARRAYflag) {
tp = construct_type(T_ARRAY, NULLTYPE);
tp->arr_elem = df->df_type;
tp->arr_elsize = ArrayElSize(df->df_type);
tp->tp_align = lcm(word_align, pointer_align);
}
else *ptp = df->df_type;
else tp = df->df_type;
p->next = *ppr;
*ppr = p;
p->par_def = df = new_def();
df->df_type = tp;
df->df_flags = VARp;
}
;
@ -362,7 +373,7 @@ FieldList(struct scope *scope; arith *cnt; int *palign;)
{ warning("Old fashioned Modula-2 syntax!");
id = gen_anon_idf();
df = ill_df;
if (chk_designator(nd, 0, D_REFERRED) &&
if (chk_designator(nd) &&
(nd->nd_class != Def ||
!(nd->nd_def->df_kind &
(D_ERROR|D_ISTYPE)))) {
@ -513,8 +524,6 @@ ProcedureType(struct type **ptp;)
FormalTypeList(struct paramlist **ppr; struct type **ptp;)
{
struct def *df;
struct type *tp;
struct paramlist *p;
int VARp;
} :
'(' { *ppr = 0; }
@ -522,25 +531,13 @@ FormalTypeList(struct paramlist **ppr; struct type **ptp;)
[ VAR { VARp = D_VARPAR; }
| { VARp = D_VALPAR; }
]
FormalType(&tp)
{ *ppr = p = new_paramlist();
p->next = 0;
p->par_def = df = new_def();
df->df_type = tp;
df->df_flags = VARp;
}
FormalType(ppr, VARp)
[
','
[ VAR {VARp = D_VARPAR; }
| {VARp = D_VALPAR; }
]
FormalType(&tp)
{ p = new_paramlist();
p->next = *ppr; *ppr = p;
p->par_def = df = new_def();
df->df_type = tp;
df->df_flags = VARp;
}
FormalType(ppr, VARp)
]*
]?
')'

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

@ -38,7 +38,7 @@ GetFile(name)
fatal("Could'nt find a DEFINITION MODULE for \"%s\"", name);
}
LineNumber = 1;
DO_DEBUG(1, debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
DO_DEBUG(options['F'], debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
}
struct def *

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

@ -48,7 +48,7 @@ qualident(int types;
{ if (types) {
df = ill_df;
if (chk_designator(nd, 0, D_REFERRED)) {
if (chk_designator(nd)) {
if (nd->nd_class != Def) {
node_error(nd, "%s expected", str);
}
@ -98,14 +98,14 @@ ConstExpression(struct node **pnd;):
* Changed rule in new Modula-2.
* Check that the expression is a constant expression and evaluate!
*/
{ DO_DEBUG(3,
( debug("Constant expression:"),
PrNode(*pnd)));
{ DO_DEBUG(options['X'], print("CONSTANT EXPRESSION\n"));
DO_DEBUG(options['X'], PrNode(*pnd, 0));
if (chk_expr(*pnd) &&
((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
error("Constant expression expected");
}
DO_DEBUG(3, PrNode(*pnd));
DO_DEBUG(options['X'], print("RESULTS IN\n"));
DO_DEBUG(options['X'], PrNode(*pnd, 0));
}
;

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

@ -52,9 +52,6 @@ main(argc, argv)
fprint(STDERR, "%s: Use a file argument\n", ProgName);
return 1;
}
#ifdef DEBUG
DO_DEBUG(1, debug("Debugging level: %d", options['D']));
#endif DEBUG
return !Compile(Nargv[1], Nargv[2]);
}
@ -63,8 +60,6 @@ Compile(src, dst)
{
extern struct tokenname tkidf[];
DO_DEBUG(1, debug("Filename : %s", src));
DO_DEBUG(1, (!dst || debug("Targetfile: %s", dst)));
if (! InsertFile(src, (char **) 0, &src)) {
fprint(STDERR,"%s: cannot open %s\n", ProgName, src);
return 0;
@ -98,6 +93,7 @@ Compile(src, dst)
C_ms_src((arith) (LineNumber - 1), FileName);
close_scope(SC_REVERSE);
if (!err_occurred) {
C_exp(Defined->mod_vis->sc_scope->sc_name);
WalkModule(Defined);
if (fp_used) {
C_ms_flt();

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

@ -35,7 +35,6 @@ MkNode(class, left, right, token)
nd->nd_token = *token;
nd->nd_class = class;
nd->nd_type = error_type;
DO_DEBUG(4,(debug("Create node:"), PrNode(nd)));
return nd;
}
@ -74,23 +73,29 @@ NodeCrash(expp)
extern char *symbol2str();
STATIC
printnode(nd)
register struct node *nd;
indnt(lvl)
{
fprint(STDERR, "(");
if (nd) {
printnode(nd->nd_left);
fprint(STDERR, " %s ", symbol2str(nd->nd_symb));
printnode(nd->nd_right);
while (lvl--) {
print(" ");
}
fprint(STDERR, ")");
}
PrNode(nd)
struct node *nd;
printnode(nd, lvl)
register struct node *nd;
{
printnode(nd);
fprint(STDERR, "\n");
indnt(lvl);
print("C: %d; T: %s\n", nd->nd_class, symbol2str(nd->nd_symb));
}
PrNode(nd, lvl)
register struct node *nd;
{
if (! nd) {
indnt(lvl); print("<nilnode>\n");
return;
}
PrNode(nd->nd_left, lvl + 1);
printnode(nd, lvl);
PrNode(nd->nd_right, lvl + 1);
}
#endif DEBUG

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

@ -127,8 +127,6 @@ DefinitionModule
df->df_type = standard_type(T_RECORD, 0, (arith) 0);
df->df_type->rec_scope = df->mod_vis->sc_scope;
DefinitionModule++;
DO_DEBUG(1, debug("Definition module \"%s\" %d",
id->id_text, DefinitionModule));
}
';'
import(0)*
@ -209,7 +207,7 @@ ProgramModule
df = define(id, CurrentScope, D_MODULE);
open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis;
CurrentScope->sc_name = id->id_text;
CurrentScope->sc_name = "_M2M";
}
Defined = df;
CurrentScope->sc_definedby = df;

2
lang/m2/comp/scope.C
View file

@ -218,7 +218,7 @@ close_scope(flag)
if (flag) {
if (sc->sc_forw) rem_forwards(sc->sc_forw);
DO_DEBUG(2, PrScopeDef(sc->sc_def));
DO_DEBUG(options['S'], PrScopeDef(sc->sc_def));
if (flag & SC_CHKPROC) chk_proc(sc->sc_def);
if (flag & SC_CHKFORW) chk_forw(&(sc->sc_def));
if (flag & SC_REVERSE) Reverse(&(sc->sc_def));

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

@ -5,6 +5,7 @@
static char *RcsId = "$Header$";
#endif
#include <assert.h>
#include <em_arith.h>
#include <em_label.h>
@ -240,12 +241,12 @@ ReturnStatement(struct node **pnd;)
{ if (scopeclosed(CurrentScope)) {
error("a module body has no result value");
}
else if (! df->df_type->next) {
else if (! ResultType(df->df_type)) {
error("procedure \"%s\" has no result value", df->df_idf->id_text);
}
}
|
{ if (df->df_type->next) {
{ if (ResultType(df->df_type)) {
error("procedure \"%s\" must return a value", df->df_idf->id_text);
}
}

5
lang/m2/comp/tmpvar.C
View file

@ -22,6 +22,7 @@ static char *RcsId = "$Header$";
#include "def.h"
#include "type.h"
#include "scope.h"
#include "main.h"
struct tmpvar {
struct tmpvar *next;
@ -45,7 +46,7 @@ NewInt()
if (!TmpInts) {
offset = - WA(align(int_size - ProcScope->sc_off, int_align));
ProcScope->sc_off = offset;
C_ms_reg(offset, int_size, reg_any, 0);
if (! options['n']) C_ms_reg(offset, int_size, reg_any, 0);
}
else {
tmp = TmpInts;
@ -65,7 +66,7 @@ NewPtr()
if (!TmpPtrs) {
offset = - WA(align(pointer_size - ProcScope->sc_off, pointer_align));
ProcScope->sc_off = offset;
C_ms_reg(offset, pointer_size, reg_pointer, 0);
if (! options['n']) C_ms_reg(offset, pointer_size, reg_pointer, 0);
}
else {
tmp = TmpPtrs;

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

@ -134,10 +134,19 @@ struct type
#define NULLTYPE ((struct type *) 0)
#define IsConformantArray(tpx) ((tpx)->tp_fund==T_ARRAY && (tpx)->next==0)
#define bounded(tpx) ((tpx)->tp_fund & T_INDEX)
#define complex(tpx) ((tpx)->tp_fund & (T_RECORD|T_ARRAY))
#define WA(sz) (align(sz, (int) word_size))
#define ResultType(tpx) (assert((tpx)->tp_fund == T_PROCEDURE), (tpx)->next)
#define ParamList(tpx) (assert((tpx)->tp_fund == T_PROCEDURE),\
#define bounded(tpx) ((tpx)->tp_fund & T_INDEX)
#define complex(tpx) ((tpx)->tp_fund & (T_RECORD|T_ARRAY))
#define WA(sz) (align(sz, (int) word_size))
#define ResultType(tpx) (assert((tpx)->tp_fund == T_PROCEDURE),\
(tpx)->next)
#define ParamList(tpx) (assert((tpx)->tp_fund == T_PROCEDURE),\
(tpx)->prc_params)
#define IndexType(tpx) (assert((tpx)->tp_fund == T_ARRAY),\
(tpx)->next)
#define ElementType(tpx) (assert((tpx)->tp_fund == T_SET),\
(tpx)->next)
#define PointedtoType(tpx) (assert((tpx)->tp_fund == T_POINTER),\
(tpx)->next)
#define BaseType(tpx) ((tpx)->tp_fund == T_SUBRANGE ? (tpx)->next\
: (tpx))
#define IsConstructed(tpx) ((tpx)->tp_fund & T_CONSTRUCTED)

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

@ -225,22 +225,22 @@ chk_basesubrange(tp, base)
if (base->sub_lb > tp->sub_lb || base->sub_ub < tp->sub_ub) {
error("Base type has insufficient range");
}
base = base->next;
base = BaseType(base);
}
if (base->tp_fund & (T_ENUMERATION|T_CHAR)) {
if (tp->next != base) {
if (BaseType(tp) != base) {
error("Specified base does not conform");
}
}
else if (base != card_type && base != int_type) {
error("Illegal base for a subrange");
}
else if (base == int_type && tp->next == card_type &&
else if (base == int_type && BaseType(tp) == card_type &&
(tp->sub_ub > max_int || tp->sub_ub < 0)) {
error("Upperbound to large for type INTEGER");
}
else if (base != tp->next && base != int_type) {
else if (base != BaseType(tp) && base != int_type) {
error("Specified base does not conform");
}
@ -257,15 +257,13 @@ subr_type(lb, ub)
indicated by "lb" and "ub", but first perform some
checks
*/
register struct type *tp = lb->nd_type, *res;
register struct type *tp = BaseType(lb->nd_type), *res;
if (!TstCompat(lb->nd_type, ub->nd_type)) {
node_error(ub, "Types of subrange bounds not equal");
return error_type;
}
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
if (tp == intorcard_type) {
/* Lower bound >= 0; in this case, the base type is CARDINAL,
according to the language definition, par. 6.3
@ -397,7 +395,7 @@ ArraySizes(tp)
{
/* Assign sizes to an array type, and check index type
*/
register struct type *index_type = tp->next;
register struct type *index_type = IndexType(tp);
register struct type *elem_type = tp->arr_elem;
arith lo, hi;

16
lang/m2/comp/typequiv.c
View file

@ -67,7 +67,7 @@ TstProcEquiv(tp1, tp2)
/* First check if the result types are equivalent
*/
if (! TstTypeEquiv(tp1->next, tp2->next)) return 0;
if (! TstTypeEquiv(ResultType(tp1), ResultType(tp2))) return 0;
p1 = ParamList(tp1);
p2 = ParamList(tp2);
@ -94,8 +94,8 @@ TstCompat(tp1, tp2)
if (TstTypeEquiv(tp1, tp2)) return 1;
if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
if (tp2->tp_fund == T_SUBRANGE) tp2 = tp2->next;
tp1 = BaseType(tp1);
tp2 = BaseType(tp2);
return tp1 == tp2
||
@ -138,8 +138,8 @@ TstAssCompat(tp1, tp2)
if (TstCompat(tp1, tp2)) return 1;
if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
if (tp2->tp_fund == T_SUBRANGE) tp2 = tp2->next;
tp1 = BaseType(tp1);
tp2 = BaseType(tp2);
if ((tp1->tp_fund & T_INTORCARD) &&
(tp2->tp_fund & T_INTORCARD)) return 1;
@ -149,14 +149,14 @@ TstAssCompat(tp1, tp2)
*/
arith size;
if (!(tp = tp1->next)) return 0;
if (IsConformantArray(tp1)) return 0;
tp = IndexType(tp1);
if (tp->tp_fund == T_SUBRANGE) {
size = tp->sub_ub - tp->sub_lb + 1;
}
else size = tp->enm_ncst;
tp1 = tp1->arr_elem;
if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
tp1 = BaseType(tp1->arr_elem);
return
tp1 == char_type
&& (tp2->tp_fund == T_STRING && size >= tp2->tp_size)

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

@ -61,21 +61,12 @@ WalkModule(module)
Also generate code for its body.
*/
register struct scope *sc;
struct scopelist *vis;
struct scopelist *savevis = CurrVis;
vis = CurrVis;
CurrVis = module->mod_vis;
sc = CurrentScope;
if (!proclevel && module == Defined) {
/* This module is a global module. Export the name of its
initialization routine
*/
if (state == PROGRAM) C_exp("main");
else C_exp(sc->sc_name);
}
/* Now, walk through it's local definitions
/* Walk through it's local definitions
*/
WalkDef(sc->sc_def);
@ -85,15 +76,15 @@ WalkModule(module)
*/
sc->sc_off = 0;
text_label = 1;
ProcScope = CurrentScope;
C_pro_narg(state==PROGRAM && module==Defined ? "main" : sc->sc_name);
ProcScope = sc;
C_pro_narg(sc->sc_name);
DoProfil();
if (module == Defined) {
/* Body of implementation or program module.
Call initialization routines of imported modules.
Also prevent recursive calls of this one.
*/
struct node *nd;
register struct node *nd;
if (state == IMPLEMENTATION) {
label l1 = ++data_label;
@ -108,14 +99,13 @@ WalkModule(module)
C_ste_dlb(l1, (arith) 0);
}
nd = Modules;
while (nd) {
for (nd = Modules; nd; nd = nd->next) {
C_cal(nd->nd_IDF->id_text);
nd = nd->next;
}
}
MkCalls(sc->sc_def);
proclevel++;
DO_DEBUG(options['X'], PrNode(module->mod_body, 0));
WalkNode(module->mod_body, (label) 0);
C_df_ilb((label) 1);
C_ret((arith) 0);
@ -123,14 +113,14 @@ WalkModule(module)
proclevel--;
TmpClose();
CurrVis = vis;
CurrVis = savevis;
}
WalkProcedure(procedure)
register struct def *procedure;
{
/* Walk through the definition of a procedure and all its
local definitions
local definitions, checking and generating code.
*/
struct scopelist *savevis = CurrVis;
register struct scope *sc;
@ -141,7 +131,7 @@ WalkProcedure(procedure)
proclevel++;
CurrVis = procedure->prc_vis;
ProcScope = sc = CurrentScope;
/* Generate code for all local modules and procedures
*/
WalkDef(sc->sc_def);
@ -182,6 +172,7 @@ WalkProcedure(procedure)
C_bss_cst(tp->tp_size, (arith) 0, 0);
}
DO_DEBUG(options['X'], PrNode(procedure->prc_body, 0));
WalkNode(procedure->prc_body, (label) 0);
C_ret((arith) 0);
if (tp) {
@ -195,7 +186,7 @@ WalkProcedure(procedure)
else C_ret(WA(tp->tp_size));
}
RegisterMessages(sc->sc_def);
if (! options['n']) RegisterMessages(sc->sc_def);
C_end(-sc->sc_off);
TmpClose();
CurrVis = savevis;
@ -372,18 +363,20 @@ WalkStat(nd, lab)
}
C_bra(l1);
C_df_ilb(l2);
WalkNode(right, lab);
C_loc(left->nd_INT);
CodePExpr(nd);
C_adi(int_size);
CheckAssign(nd->nd_type, int_type);
CodeDStore(nd);
C_df_ilb(l1);
WalkNode(right, lab);
CodePExpr(nd);
C_loc(left->nd_INT);
C_adi(int_size);
C_df_ilb(l1);
C_dup(int_size);
if (tmp) C_lol(tmp); else C_loc(fnd->nd_INT);
if (left->nd_INT > 0) {
C_ble(l2);
}
else C_bge(l2);
C_asp(int_size);
if (tmp) FreeInt(tmp);
}
break;
@ -498,8 +491,6 @@ WalkExpr(nd)
/* Check an expression and generate code for it
*/
DO_DEBUG(1, (DumpTree(nd), print("\n")));
if (! chk_expr(nd)) return;
CodePExpr(nd);
@ -512,9 +503,7 @@ WalkDesignator(nd, ds)
/* Check designator and generate code for it
*/
DO_DEBUG(1, (DumpTree(nd), print("\n")));
if (! chk_designator(nd, VARIABLE, D_DEFINED)) return;
if (! chk_variable(nd)) return;
*ds = InitDesig;
CodeDesig(nd, ds);
@ -529,7 +518,7 @@ DoForInit(nd, left)
nd->nd_class = Name;
nd->nd_symb = IDENT;
if (! chk_designator(nd, VARIABLE, D_DEFINED) ||
if (! chk_variable(nd) ||
! chk_expr(left->nd_left) ||
! chk_expr(left->nd_right)) return 0;
@ -574,7 +563,6 @@ node_warning(nd, "old-fashioned! compatibility required in FOR statement");
}
CodePExpr(left->nd_left);
CodeDStore(nd);
return 1;
}
@ -587,7 +575,7 @@ DoAssign(nd, left, right)
struct desig dsl, dsr;
if (!chk_expr(right)) return;
if (! chk_designator(left, VARIABLE, D_DEFINED)) return;
if (! chk_variable(left)) return;
TryToString(right, left->nd_type);
dsr = InitDesig;
CodeExpr(right, &dsr, NO_LABEL, NO_LABEL);
@ -613,15 +601,19 @@ DoAssign(nd, left, right)
RegisterMessages(df)
register struct def *df;
{
struct type *tp;
register struct type *tp;
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 = BaseType(df->df_type);
if ((df->df_flags & D_VARPAR) ||
tp->tp_fund == T_POINTER) {
C_ms_reg(df->var_off, pointer_size,
reg_pointer, 0);
}
else if ((tp->tp_fund & T_NUMERIC) &&
tp->tp_size <= dword_size) {
C_ms_reg(df->var_off,
tp->tp_size,
@ -629,46 +621,6 @@ RegisterMessages(df)
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
DumpTree(nd)
struct node *nd;
{
char *s;
extern char *symbol2str();
if (!nd) {
print("()");
return;
}
print("(");
DumpTree(nd->nd_left);
switch(nd->nd_class) {
case Def: s = "Def"; break;
case Oper: s = "Oper"; break;
case Arrsel: s = "Arrsel"; break;
case Arrow: s = "Arrow"; break;
case Uoper: s = "Uoper"; break;
case Name: s = "Name"; break;
case Set: s = "Set"; break;
case Value: s = "Value"; break;
case Call: s = "Call"; break;
case Xset: s = "Xset"; break;
case Stat: s = "Stat"; break;
case Link: s = "Link"; break;
default: s = "ERROR"; break;
}
print("%s %s", s, symbol2str(nd->nd_symb));
DumpTree(nd->nd_right);
print(")");
}
#endif