long str2long();
struct token dot, aside;
-struct type *numtype;
+struct type *toktype;
struct string string;
int idfsize = IDFSIZE;
+extern label data_label();
static
SkipComment()
The putting aside of tokens is taken into account.
*/
register struct token *tk = ˙
- char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 1];
+ char buf[(IDFSIZE > NUMSIZE ? IDFSIZE : NUMSIZE) + 2];
register int ch, nch;
- numtype = error_type;
+ toktype = error_type;
if (ASIDE) { /* a token is put aside */
*tk = aside;
ASIDE = 0;
case STSTR:
GetString(ch);
- tk->tk_data.tk_str = (struct string *)
+ if (string.s_length == 1) {
+ tk->TOK_INT = *(string.s_str) & 0377;
+ toktype = char_type;
+ }
+ else {
+ tk->tk_data.tk_str = (struct string *)
Malloc(sizeof (struct string));
- *(tk->tk_data.tk_str) = string;
+ *(tk->tk_data.tk_str) = string;
+ toktype = standard_type(T_STRING, 1, string.s_length);
+ }
return tk->tk_symb = STRING;
case STNUM:
Shex: *np++ = '\0';
tk->TOK_INT = str2long(&buf[1], 16);
if (tk->TOK_INT >= 0 && tk->TOK_INT <= max_int) {
- numtype = intorcard_type;
+ toktype = intorcard_type;
}
- else numtype = card_type;
+ else toktype = card_type;
return tk->tk_symb = INTEGER;
case '8':
*np++ = '\0';
tk->TOK_INT = str2long(&buf[1], 8);
if (ch == 'C') {
- numtype = char_type;
+ toktype = char_type;
if (tk->TOK_INT < 0 || tk->TOK_INT > 255) {
lexwarning("Character constant out of range");
}
}
else if (tk->TOK_INT >= 0 && tk->TOK_INT <= max_int) {
- numtype = intorcard_type;
+ toktype = intorcard_type;
}
- else numtype = card_type;
+ else toktype = card_type;
return tk->tk_symb = INTEGER;
case 'A':
PushBack(ch);
if (np == &buf[NUMSIZE + 1]) {
- lexerror("floating constant too long");
tk->TOK_REL = Salloc("0.0", 5);
+ lexerror("floating constant too long");
}
- else {
- tk->TOK_REL = Salloc(buf, np - buf) + 1;
- }
+ else tk->TOK_REL = Salloc(buf, np - buf) + 1;
return tk->tk_symb = REAL;
default:
*np++ = '\0';
tk->TOK_INT = str2long(&buf[1], 10);
if (tk->TOK_INT < 0 || tk->TOK_INT > max_int) {
- numtype = card_type;
+ toktype = card_type;
}
- else numtype = intorcard_type;
+ else toktype = intorcard_type;
return tk->tk_symb = INTEGER;
}
/*NOTREACHED*/
#define TOK_STR tk_data.tk_str->s_str
#define TOK_SLE tk_data.tk_str->s_length
#define TOK_INT tk_data.tk_int
-#define TOK_REL tk_data.tk_real
+#define TOK_REL tk_data.tk_real
extern struct token dot, aside;
-extern struct type *numtype;
+extern struct type *toktype;
#define DOT dot.tk_symb
#define ASIDE aside.tk_symb
return 1;
default:
- assert(0);
+ crash("(chk_expr(Value))");
}
break;
return chk_designator(expp, DESIGNATOR|VALUE, D_USED|D_NOREG);
default:
- assert(0);
+ crash("(chk_expr)");
}
/*NOTREACHED*/
}
/* Check the legality of a SET aggregate, and try to evaluate it
compile time. Unfortunately this is all rather complicated.
*/
- struct type *tp;
- struct def *df;
+ register struct type *tp;
register struct node *nd;
+ register struct def *df;
arith *set;
unsigned size;
if (!(df->df_kind & (D_TYPE|D_ERROR)) ||
(df->df_type->tp_fund != T_SET)) {
- node_error(expp, "specifier does not represent a set type");
+node_error(expp, "specifier does not represent a set type");
return 0;
}
tp = df->df_type;
int
chk_el(expp, tp, set)
register struct node *expp;
- struct type *tp;
+ register struct type *tp;
arith **set;
{
/* Check elements of a set. This routine may call itself
recursively.
Also try to compute the set!
*/
- register int i;
register struct node *left = expp->nd_left;
register struct node *right = expp->nd_right;
+ register int i;
if (expp->nd_class == Link && expp->nd_symb == UPTO) {
/* { ... , expr1 .. expr2, ... }
while (param) {
if (!(left = getarg(&arg, 0, IsVarParam(param)))) return 0;
-
+ if (left->nd_symb == STRING) {
+ TryToString(left, TypeOfParam(param));
+ }
if (! TstParCompat(TypeOfParam(param),
left->nd_type,
IsVarParam(param),
}
return 1;
+ case T_HIDDEN:
case T_POINTER:
if (chk_address(tpl, tpr) ||
expp->nd_symb == '=' ||
return 1;
}
else if (tpr->tp_fund == T_REAL) {
+ expp->nd_type = tpr;
if (right->nd_class == Value) {
- expp->nd_token = right->nd_token;
+ if (*(right->nd_REL) == '-') (right->nd_REL)++;
+ else (right->nd_REL)--;
expp->nd_class = Value;
- if (*(expp->nd_REL) == '-') {
- expp->nd_REL++;
- }
- else {
- expp->nd_REL--;
- *(expp->nd_REL) = '-';
- }
+ expp->nd_symb = REAL;
+ expp->nd_REL = right->nd_REL;
FreeNode(right);
expp->nd_right = 0;
}
case S_ABS:
if (!(left = getarg(&arg, T_NUMERIC, 0))) return 0;
expp->nd_type = left->nd_type;
- if (left->nd_class == Value) cstcall(expp, S_ABS);
+ if (left->nd_class == Value &&
+ expp->nd_type->tp_fund != T_REAL) {
+ cstcall(expp, S_ABS);
+ }
break;
case S_CAP:
return 1;
}
+
+TryToString(nd, tp)
+ struct node *nd;
+ struct type *tp;
+{
+ /* Try a coercion from character constant to string */
+ if (tp->tp_fund == T_ARRAY && nd->nd_type == char_type) {
+ int ch = nd->nd_INT;
+
+ nd->nd_type = standard_type(T_STRING, 1, (arith) 2);
+ nd->nd_token.tk_data.tk_str =
+ (struct string *) Malloc(sizeof(struct string));
+ nd->nd_STR = Salloc("X", 2);
+ *(nd->nd_STR) = ch;
+ nd->nd_SLE = 1;
+ }
+}
}
CodeString(nd)
- struct node *nd;
+ register struct node *nd;
{
label lab;
- if (nd->nd_type == charc_type) {
+ if (nd->nd_type == char_type) {
C_loc(nd->nd_INT);
- return;
}
- C_df_dlb(lab = data_label());
- C_rom_scon(nd->nd_STR, nd->nd_SLE);
- C_lae_dlb(lab, (arith) 0);
+ else {
+ C_df_dlb(lab = data_label());
+ C_rom_scon(nd->nd_STR, align(nd->nd_SLE + 1, word_size));
+ C_lae_dlb(lab, (arith) 0);
+ }
+}
+
+CodePadString(nd, sz)
+ register struct node *nd;
+ arith sz;
+{
+ /* Generate code to push the string indicated by "nd".
+ Make it null-padded to "sz" bytes
+ */
+ register arith sizearg = align(nd->nd_type->tp_size, word_align);
+
+ assert(nd->nd_type->tp_fund == T_STRING);
+
+ if (sizearg != sz) {
+ /* null padding required */
+ assert(sizearg < sz);
+ C_zer(sz - sizearg);
+ }
+ C_asp(-sizearg); /* room for string */
+ CodeString(nd); /* push address of string */
+ C_lor((arith) 1); /* load stack pointer */
+ C_adp(pointer_size); /* and compute target address from it */
+ C_blm(sizearg); /* and copy */
}
CodeReal(nd)
- struct node *nd;
+ register struct node *nd;
{
- label lab;
-
- C_df_dlb(lab = data_label());
+ label lab = data_label();
+
+ C_df_dlb(lab);
C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
C_lae_dlb(lab, (arith) 0);
C_loi(nd->nd_type->tp_size);
switch(nd->nd_class) {
case Def:
if (nd->nd_def->df_kind == D_PROCEDURE) {
- C_lpi(nd->nd_def->prc_vis->sc_scope->sc_name);
+ C_lpi(NameOfProc(nd->nd_def));
ds->dsg_kind = DSG_LOADED;
break;
}
+ /* Fall through */
+
+ case Link:
CodeDesig(nd, ds);
break;
}
CodeOper(nd, true_label, false_label);
if (true_label == 0) ds->dsg_kind = DSG_LOADED;
- else {
- *ds = InitDesig;
- true_label = 0;
- }
+ else ds->dsg_kind = DSG_INIT;
+ true_label = 0;
break;
case Uoper:
ds->dsg_kind = DSG_LOADED;
break;
- case Link:
- CodeDesig(nd, ds);
- break;
-
case Call:
CodeCall(nd);
ds->dsg_kind = DSG_LOADED;
CodeCoercion(t1, t2)
register struct type *t1, *t2;
{
- int fund1, fund2;
+ register int fund1, fund2;
if (t1 == t2) return;
if (t1->tp_fund == T_SUBRANGE) t1 = t1->next;
CodeStd(nd);
return;
}
- tp = left->nd_type;
if (IsCast(left)) {
/* it was just a cast. Simply ignore it
assert(IsProcCall(left));
for (param = left->nd_type->prc_params; param; param = param->next) {
+ tp = TypeOfParam(param);
arg = arg->nd_right;
assert(arg != 0);
- if (IsVarParam(param)) {
+ if (IsConformantArray(tp)) {
+ C_loc(tp->arr_elsize);
+ if (IsConformantArray(arg->nd_left->nd_type)) {
+ DoHIGH(arg->nd_left);
+ }
+ else if (arg->nd_left->nd_symb == STRING) {
+ C_loc(arg->nd_left->nd_SLE);
+ }
+ else if (tp->arr_elem == word_type) {
+ C_loc(arg->nd_left->nd_type->tp_size / word_size - 1);
+ }
+ else C_loc(arg->nd_left->nd_type->tp_size /
+ tp->arr_elsize - 1);
+ C_loc(0);
+ if (arg->nd_left->nd_symb == STRING) {
+ CodeString(arg->nd_left);
+ }
+ else CodeDAddress(arg->nd_left);
+ pushed += pointer_size + 3 * word_size;
+ }
+ else if (IsVarParam(param)) {
CodeDAddress(arg->nd_left);
pushed += pointer_size;
}
else {
- CodePExpr(arg->nd_left);
- CheckAssign(arg->nd_left->nd_type, TypeOfParam(param));
- pushed += align(arg->nd_left->nd_type->tp_size, word_align);
+ if (arg->nd_left->nd_type->tp_fund == T_STRING) {
+ CodePadString(arg->nd_left,
+ align(tp->tp_size, word_align));
+ }
+ else CodePExpr(arg->nd_left);
+ CheckAssign(arg->nd_left->nd_type, tp);
+ pushed += align(tp->tp_size, word_align);
}
- /* ??? Conformant arrays */
}
if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
C_lxl((arith) proclevel - left->nd_def->df_scope->sc_level);
pushed += pointer_size;
}
- C_cal(left->nd_def->prc_vis->sc_scope->sc_name);
+ C_cal(NameOfProc(left->nd_def));
}
else if (left->nd_class == Def && left->nd_def->df_kind == D_PROCHEAD) {
C_cal(left->nd_def->for_name);
CodePExpr(left);
C_cai();
}
- C_asp(pushed);
- if (tp->next) {
- C_lfr(align(tp->next->tp_size, word_align));
+ if (pushed) C_asp(pushed);
+ if (left->nd_type->next) {
+ C_lfr(align(left->nd_type->next->tp_size, word_align));
}
}
case S_HIGH:
assert(IsConformantArray(tp));
- /* ??? */
+ DoHIGH(left);
break;
case S_ODD:
/* Generate code for an assignment. Testing of type
compatibility and the like is already done.
*/
+ register struct type *tp = nd->nd_right->nd_type;
+ extern arith align();
if (dss->dsg_kind == DSG_LOADED) {
+ if (tp->tp_fund == T_STRING) {
+ CodeAddress(dst);
+ C_loc(tp->tp_size);
+ C_loc(nd->nd_left->nd_type->tp_size);
+ C_cal("_StringAssign");
+ C_asp((int_size << 1) + (pointer_size << 1));
+ return;
+ }
CodeStore(dst, nd->nd_left->nd_type->tp_size);
+ return;
}
- else {
- CodeAddress(dss);
- CodeAddress(dst);
- C_blm(nd->nd_left->nd_type->tp_size);
- }
+ CodeAddress(dss);
+ CodeAddress(dst);
+ C_blm(nd->nd_left->nd_type->tp_size);
}
CheckAssign(tpl, tpr)
case T_INTEGER:
C_cmi(tp->tp_size);
break;
+ case T_HIDDEN:
case T_POINTER:
C_cmp();
break;
CodeEl(nd, tp)
register struct node *nd;
- struct type *tp;
+ register struct type *tp;
{
if (nd->nd_class == Link && nd->nd_symb == UPTO) {
C_zer(tp->tp_size); /* empty set */
C_lor((arith) 1); /* SP: address of set */
+ if (tp->next->tp_fund == T_SUBRANGE) {
+ C_loc(tp->next->sub_ub);
+ }
+ else C_loc(tp->next->enm_ncst - 1);
Operands(nd->nd_left, nd->nd_right);
C_cal("_LtoUset"); /* library routine to fill set */
C_asp(2 * word_size + pointer_size);
CodeDesig(nd, &designator);
CodeStore(&designator, nd->nd_type->tp_size);
}
+
+DoHIGH(nd)
+ struct node *nd;
+{
+ register struct def *df;
+ arith highoff;
+
+ assert(nd->nd_class == Def);
+
+ df = nd->nd_def;
+
+ assert(df->df_kind == D_VARIABLE);
+
+ highoff = df->var_off + pointer_size + word_size;
+ if (df->df_scope->sc_level < proclevel) {
+ C_lxa(proclevel - df->df_scope->sc_level);
+ C_lof(highoff);
+ }
+ else C_lol(highoff);
+}
expp->nd_symb = INTEGER;
switch(call) {
case S_ABS:
- if (expr->nd_type->tp_fund == T_REAL) {
- expp->nd_symb = REAL;
- expp->nd_REL = expr->nd_REL;
- if (*(expr->nd_REL) == '-') (expp->nd_REL)++;
- break;
- }
if (expr->nd_INT < 0) expp->nd_INT = - expr->nd_INT;
else expp->nd_INT = expr->nd_INT;
CutSize(expp);
{
df = DeclProc(type);
tp = construct_type(T_PROCEDURE, tp);
- if (proclevel) {
+ if (proclevel > 1) {
/* Room for static link
*/
tp->prc_nbpar = pointer_size;
{
struct node *FPList;
struct type *tp;
- int VARp = 0;
+ int VARp = D_VALPAR;
} :
[
- VAR { VARp = 1; }
+ VAR { VARp = D_VARPAR; }
]?
IdentList(&FPList) ':' FormalType(&tp)
{
}
;
-FormalType(struct type **tp;)
+FormalType(struct type **ptp;)
{
struct def *df;
int ARRAYflag = 0;
+ register struct type *tp;
+ extern arith ArrayElSize();
} :
[ ARRAY OF { ARRAYflag = 1; }
]?
qualident(D_ISTYPE, &df, "type", (struct node **) 0)
{ if (ARRAYflag) {
- *tp = construct_type(T_ARRAY, NULLTYPE);
- (*tp)->arr_elem = df->df_type;
- (*tp)->tp_align = lcm(word_align, pointer_align);
- (*tp)->tp_size = align(pointer_size + word_size,
- (*tp)->tp_align);
+ *ptp = 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 *tp = df->df_type;
+ else *ptp = df->df_type;
}
;
TypeDeclaration
{
- struct def *df;
+ register struct def *df;
struct type *tp;
}:
IDENT { df = lookup(dot.TOK_IDF, CurrentScope);
- if (!df) df = define( dot.TOK_IDF,
- CurrentScope,
- D_TYPE);
+ if (!df) df = define(dot.TOK_IDF,CurrentScope,D_TYPE);
}
'=' type(&tp)
- { if (df->df_type) free_type(df->df_type); /* ??? */
- df->df_type = tp;
- if (df->df_kind == D_HIDDEN &&
- tp->tp_fund != T_POINTER) {
+ {
+ if (df->df_kind == D_HIDDEN) {
+ if (tp->tp_fund != T_POINTER) {
error("opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
+ }
+ df->df_kind = D_TYPE;
+ *(df->df_type) = *tp;
+ free_type(tp);
+ }
+ else {
+ df->df_type = tp;
+ df->df_kind = D_TYPE;
}
- df->df_kind = D_TYPE;
}
;
CurrentScope, (arith *) 0);
FreeNode(EnumList);
if (tp->enm_ncst > 256) {
+ /* ??? is this reasonable ??? */
error("Too many enumeration literals");
}
}
{
register struct node *q;
} :
- IDENT { q = MkNode(Value, NULLNODE, NULLNODE, &dot);
+ IDENT { q = MkLeaf(Value, &dot);
*p = q;
}
[
',' IDENT
- { q->next = MkNode(Value,NULLNODE,NULLNODE,&dot);
+ { q->next = MkLeaf(Value, &dot);
q = q->next;
}
]*
IdentAddrList(struct node **pnd;)
{
} :
- IDENT { *pnd = MkNode(Name, NULLNODE, NULLNODE, &dot); }
+ IDENT { *pnd = MkLeaf(Name, &dot); }
ConstExpression(&(*pnd)->nd_left)?
[ { pnd = &((*pnd)->nd_right); }
',' IDENT
- { *pnd = MkNode(Name, NULLNODE, NULLNODE, &dot); }
+ { *pnd = MkLeaf(Name, &dot); }
ConstExpression(&(*pnd)->nd_left)?
]*
;
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
+#define NameOfProc(xdf) ((xdf)->prc_vis->sc_scope->sc_name)
};
struct import {
struct def *
MkDef(id, scope, kind)
struct idf *id;
- struct scope *scope;
+ register struct scope *scope;
{
/* Create a new definition structure in scope "scope", with
id "id" and kind "kind".
InitDef()
{
/* Initialize this module. Easy, the only thing to be initialized
- is "illegal_def".
+ is "ill_df".
*/
struct idf *gen_anon_idf();
) {
switch(df->df_kind) {
case D_HIDDEN:
+ /* An opaque type. We may now have found the
+ definition of this type.
+ */
if (kind == D_TYPE && !DefinitionModule) {
df->df_kind = D_TYPE;
return df;
break;
case D_FORWMODULE:
+ /* A forward reference to a module. We may have found
+ another one, or we may have found the definition
+ for this module.
+ */
if (kind == D_FORWMODULE) {
return df;
}
break;
case D_FORWARD:
+ /* A forward reference, for which we may now have
+ found a definition.
+ */
if (kind != D_FORWARD) {
FreeNode(df->for_node);
}
- df->df_kind = kind;
- return df;
+ /* Fall through */
case D_ERROR:
+ /* A definition generated by the compiler, because
+ it found an error. Maybe, the user gives a
+ definition after all.
+ */
df->df_kind = kind;
return df;
}
if (kind != D_ERROR) {
+ /* Avoid spurious error messages
+ */
error("identifier \"%s\" already declared", id->id_text);
}
assert(retval != 0);
}
if (df1) {
+ /* Put the definition now found in front
+ */
df1->next = df->next;
df->next = id->id_def;
id->id_def = df;
}
DoImport(df, scope)
- struct def *df;
+ register struct def *df;
struct scope *scope;
{
- register struct def *df1;
+ /* Definition "df" is imported to scope "scope".
+ Handle the case that it is an enumeration type or a module.
+ */
+
+ define(df->df_idf, scope, D_IMPORT)->imp_def = df;
if (df->df_kind == D_TYPE && df->df_type->tp_fund == T_ENUMERATION) {
/* Also import all enumeration literals
*/
- df1 = df->df_type->enm_enums;
- while (df1) {
- define(df1->df_idf, scope, D_IMPORT)->imp_def = df1;
- df1 = df1->enm_next;
+ df = df->df_type->enm_enums;
+ while (df) {
+ define(df->df_idf, scope, D_IMPORT)->imp_def = df;
+ df = df->enm_next;
}
}
else if (df->df_kind == D_MODULE) {
/* Also import all definitions that are exported from this
module
*/
- df1 = df->mod_vis->sc_scope->sc_def;
- while (df1) {
- if (df1->df_flags & D_EXPORTED) {
- define(df1->df_idf, scope, D_IMPORT)->imp_def = df1;
+ df = df->mod_vis->sc_scope->sc_def;
+ while (df) {
+ if (df->df_flags & D_EXPORTED) {
+ define(df->df_idf,scope,D_IMPORT)->imp_def = df;
}
- df1 = df1->df_nextinscope;
+ df = df->df_nextinscope;
}
}
}
}
if (df->df_flags & (D_EXPORTED|D_QEXPORTED)) {
-node_error(ids, "Identifier \"%s\" occurs more than once in export list",
+node_error(ids, "identifier \"%s\" occurs more than once in export list",
df->df_idf->id_text);
}
Find all imports of the module in which this export
occurs, and export the current definition to it
*/
+ df->df_flags |= D_EXPORTED;
+
impmod = moddef->df_idf->id_def;
while (impmod) {
if (impmod->df_kind == D_IMPORT &&
impmod = impmod->next;
}
- df->df_flags |= D_EXPORTED;
df1 = lookup(ids->nd_IDF, enclosing(CurrVis)->sc_scope);
if (df1 && df1->df_kind == D_PROCHEAD) {
if (df->df_kind == D_PROCEDURE) {
}
}
- df1 = define(ids->nd_IDF,
- enclosing(CurrVis)->sc_scope,
- D_IMPORT);
- df1->imp_def = df;
DoImport(df, enclosing(CurrVis)->sc_scope);
}
}
closing this one
*/
df->for_vis = vis;
- df->for_node = MkNode(Name, NULLNODE, NULLNODE, &(idn->nd_token));
+ df->for_node = MkLeaf(Name, &(idn->nd_token));
close_scope(0);
vis->sc_encl = enclosing(CurrVis);
/* Here ! */
if (!(df = lookup(ids->nd_IDF, scope))) {
df = define(ids->nd_IDF, scope, D_FORWARD);
- df->for_node = MkNode(Name,NULLNODE,NULLNODE,&(ids->nd_token));
+ df->for_node = MkLeaf(Name, &(ids->nd_token));
}
return df;
}
else df = GetDefinitionModule(ids->nd_IDF);
}
- define(ids->nd_IDF,CurrentScope,D_IMPORT)->imp_def = df;
DoImport(df, CurrentScope);
ids = ids->next;
FreeNode(idn);
}
-RemImports(pdf)
+RemoveImports(pdf)
struct def **pdf;
{
/* Remove all imports from a definition module. This is
while (df) {
if (df->df_kind == D_IMPORT) {
- RemFromId(df);
+ RemoveFromIdList(df);
*pdf = df->df_nextinscope;
free_def(df);
}
}
}
-RemFromId(df)
+RemoveFromIdList(df)
struct def *df;
{
/* Remove definition "df" from the definition list
DeclProc(type)
{
/* A procedure is declared, either in a definition or a program
- module. Create a def structure for it (if neccessary)
+ module. Create a def structure for it (if neccessary).
+ Also create a name for it.
*/
register struct def *df;
static int nmcount = 0;
- extern char *Malloc();
extern char *strcpy();
extern char *sprint();
char buf[256];
/* In a definition module
*/
df = define(dot.TOK_IDF, CurrentScope, type);
- df->for_node = MkNode(Name, NULLNODE, NULLNODE, &dot);
+ df->for_node = MkLeaf(Name, &dot);
sprint(buf,"%s_%s",CurrentScope->sc_name,df->df_idf->id_text);
df->for_name = Malloc((unsigned) (strlen(buf)+1));
strcpy(df->for_name, buf);
register struct node *n;
extern struct node *Modules;
- n = MkNode(Name, NULLNODE, NULLNODE, &dot);
+ n = MkLeaf(Name, &dot);
n->nd_IDF = id;
n->nd_symb = IDENT;
if (nd_end) nd_end->next = n;
+ else Modules = n;
nd_end = n;
- if (!Modules) Modules = n;
}
DefInFront(df)
This is neccessary because in some cases the order in this
list is important.
*/
- register struct def *df1;
+ register struct def *df1 = df->df_scope->sc_def;
- if (df->df_scope->sc_def != df) {
- df1 = df->df_scope->sc_def;
+ if (df1 != df) {
+ /* Definition "df" is not in front of the list
+ */
while (df1 && df1->df_nextinscope != df) {
+ /* Find definition "df"
+ */
df1 = df1->df_nextinscope;
}
- if (df1) df1->df_nextinscope = df->df_nextinscope;
+ if (df1) {
+ /* It already was in the list. Remove it
+ */
+ df1->df_nextinscope = df->df_nextinscope;
+ }
+
+ /* Now put it in front
+ */
df->df_nextinscope = df->df_scope->sc_def;
df->df_scope->sc_def = df;
}
/* value or var parameter
*/
C_lxa((arith) (proclevel - sc->sc_level));
- if (df->df_flags & D_VARPAR) {
+ if ((df->df_flags & D_VARPAR) ||
+ IsConformantArray(df->df_type)) {
/* var parameter
*/
C_adp(df->var_off);
/* Now, finally, we have a local variable or a local parameter
*/
- if (df->df_flags & D_VARPAR) {
+ if ((df->df_flags & D_VARPAR) || IsConformantArray(df->df_type)) {
/* a var parameter; address directly accessible.
*/
ds->dsg_kind = DSG_PFIXED;
/* Generate code for a designator. Use divide and conquer
principle
*/
+ register struct def *df;
switch(nd->nd_class) { /* Divide */
- case Def: {
- register struct def *df = nd->nd_def;
+ case Def:
+ df = nd->nd_def;
df->df_flags |= D_USED;
switch(df->df_kind) {
default:
crash("(CodeDesig) Def");
}
- }
break;
case Link:
CodeDesig(nd->nd_left, ds);
CodeAddress(ds);
- *ds = InitDesig;
- CodeExpr(nd->nd_right, ds, NO_LABEL, NO_LABEL);
- CodeValue(ds, nd->nd_right->nd_type->tp_size);
+ CodePExpr(nd->nd_right);
if (nd->nd_right->nd_type->tp_size > word_size) {
CodeCoercion(nd->nd_right->nd_type, int_type);
}
+
+ /* Now load address of descriptor
+ */
if (IsConformantArray(nd->nd_left->nd_type)) {
- /* ??? */
+ assert(nd->nd_left->nd_class == Def);
+
+ df = nd->nd_left->nd_def;
+ if (proclevel > df->df_scope->sc_level) {
+ C_lxa(proclevel - df->df_scope->sc_level);
+ C_adp(df->var_off + pointer_size);
+ }
+ else C_lal(df->var_off + pointer_size);
}
else {
- /* load address of descriptor
- */
C_lae_dlb(nd->nd_left->nd_type->arr_descr, (arith) 0);
}
ds->dsg_kind = DSG_INDEXED;
} :
[
%default
- INTEGER { tp = numtype; }
+ INTEGER { tp = toktype; }
|
REAL { tp = real_type; }
-] { *p = MkNode(Value, NULLNODE, NULLNODE, &dot);
+] { *p = MkLeaf(Value, &dot);
(*p)->nd_type = tp;
}
;
-qualident(int types; struct def **pdf; char *str; struct node **p;)
+qualident(int types;
+ struct def **pdf;
+ char *str;
+ struct node **p;
+ )
{
register struct def *df;
struct node *nd;
} :
- IDENT { nd = MkNode(Name, NULLNODE, NULLNODE, &dot);
- }
+ IDENT { nd = MkLeaf(Name, &dot); }
[
selector(&nd)
]*
- { if (types) {
- df = ill_df;
+ { if (types) {
+ df = ill_df;
- if (chk_designator(nd, 0, D_REFERRED)) {
- if (nd->nd_class != Def) {
- node_error(nd, "%s expected", str);
+ if (chk_designator(nd, 0, D_REFERRED)) {
+ if (nd->nd_class != Def) {
+ node_error(nd, "%s expected", str);
+ }
+ else {
+ df = nd->nd_def;
+ if ( !((types|D_ERROR) & df->df_kind)) {
+ if (df->df_kind == D_FORWARD) {
+node_error(nd,"%s \"%s\" not declared", str, df->df_idf->id_text);
}
else {
- df = nd->nd_def;
- if ( !((types|D_ERROR) & df->df_kind)) {
- if (df->df_kind == D_FORWARD) {
-node_error(nd,"%s \"%s\" not declared", str, df->df_idf->id_text);
- }
- else {
node_error(nd,"identifier \"%s\" is not a %s", df->df_idf->id_text, str);
- }
- }
}
}
- *pdf = df;
- }
- if (!p) FreeNode(nd);
- else *p = nd;
+ }
}
+ *pdf = df;
+ }
+ if (!p) FreeNode(nd);
+ else *p = nd;
+ }
;
selector(struct node **pnd;):
nd = &((*pnd)->nd_right);
}
[
- ',' { *nd = MkNode(Link, NULLNODE, NULLNODE, &dot);
+ ',' { *nd = MkLeaf(Link, &dot);
}
expression(&(*nd)->nd_left)
{ nd = &((*nd)->nd_right); }
} :
[
[ '+' | '-' ]
- { *pnd = MkNode(Uoper, NULLNODE, NULLNODE, &dot);
+ { *pnd = MkLeaf(Uoper, &dot);
pnd = &((*pnd)->nd_right);
}
]?
number(p)
|
STRING {
- *p = MkNode(Value, NULLNODE, NULLNODE, &dot);
- if (dot.TOK_SLE == 1) {
- int i;
-
- tp = charc_type;
- i = *(dot.TOK_STR) & 0377;
- free(dot.TOK_STR);
- free((char *) dot.tk_data.tk_str);
- (*p)->nd_INT = i;
- }
- else tp = standard_type(T_STRING, 1, dot.TOK_SLE);
- (*p)->nd_type = tp;
+ *p = MkLeaf(Value, &dot);
+ (*p)->nd_type = toktype;
}
|
'(' expression(p) ')'
|
- NOT { *p = MkNode(Uoper, NULLNODE, NULLNODE, &dot); }
+ NOT { *p = MkLeaf(Uoper, &dot); }
factor(&((*p)->nd_right))
;
} :
'{' {
dot.tk_symb = SET;
- *pnd = nd = MkNode(Xset, NULLNODE, NULLNODE, &dot);
+ *pnd = nd = MkLeaf(Xset, &dot);
nd->nd_type = bitset_type;
}
[
#ifdef DEBUG
LexScan()
{
- register int symb;
- char *symbol2str();
+ register struct token *tkp = ˙
+ extern char *symbol2str();
- while ((symb = LLlex()) > 0) {
- print(">>> %s ", symbol2str(symb));
- switch(symb) {
+ while (LLlex() > 0) {
+ print(">>> %s ", symbol2str(tkp->tk_symb));
+ switch(tkp->tk_symb) {
case IDENT:
- print("%s\n", dot.TOK_IDF->id_text);
+ print("%s\n", tkp->TOK_IDF->id_text);
break;
case INTEGER:
- print("%ld\n", dot.TOK_INT);
+ print("%ld\n", tkp->TOK_INT);
break;
case REAL:
- print("%s\n", dot.TOK_REL);
+ print("%s\n", tkp->TOK_REL);
break;
-
+
case STRING:
- print("\"%s\"\n", dot.TOK_STR);
+ print("\"%s\"\n", tkp->TOK_STR);
break;
default:
/* ALLOCDEF "node" */
-extern struct node *MkNode();
+extern struct node *MkNode(), *MkLeaf();
#define NULLNODE ((struct node *) 0)
return nd;
}
+struct node *
+MkLeaf(class, token)
+ struct token *token;
+{
+ register struct node *nd = new_node();
+
+ nd->nd_left = nd->nd_right = 0;
+ nd->nd_token = *token;
+ nd->nd_type = error_type;
+ nd->nd_class = class;
+ return nd;
+}
+
FreeNode(nd)
register struct node *nd;
{
#include "type.h"
#include "node.h"
-static int DEFofIMPL = 0; /* Flag indicating that we are currently
- parsing the definition module of the
- implementation module currently being
- compiled
- */
}
/*
The grammar as given by Wirth is already almost LL(1); the
struct node *id = 0;
} :
[ FROM
- IDENT { id = MkNode(Value, NULLNODE, NULLNODE, &dot); }
+ IDENT { id = MkLeaf(Value, &dot); }
]?
IMPORT IdentList(&ImportList) ';'
/*
*/
definition* END IDENT
{
- if (DEFofIMPL) {
- /* Just read the definition module of the
- implementation module being compiled
- */
- RemImports(&(CurrentScope->sc_def));
- }
df = CurrentScope->sc_def;
while (df) {
/* Make all definitions "QUALIFIED EXPORT" */
It is restricted to pointer types.
*/
{ df->df_kind = D_HIDDEN;
- df->df_type = construct_type(T_POINTER, NULLTYPE);
+ df->df_type = construct_type(T_HIDDEN, NULLTYPE);
}
]
Semicolon
IDENT {
id = dot.TOK_IDF;
if (state == IMPLEMENTATION) {
- DEFofIMPL = 1;
df = GetDefinitionModule(id);
CurrVis = df->mod_vis;
CurrentScope = CurrVis->sc_scope;
- DEFofIMPL = 0;
+ RemoveImports(&(CurrentScope->sc_def));
}
else {
df = define(id, CurrentScope, D_MODULE);
static int loopcount = 0; /* Count nested loops */
}
-statement(struct node **pnd;)
+statement(register struct node **pnd;)
{
register struct node *nd;
} :
- { *pnd = 0; }
[
/*
* This part is not in the reference grammar. The reference grammar
|
EXIT
{ if (!loopcount) error("EXIT not in a LOOP");
- *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
+ *pnd = MkLeaf(Stat, &dot);
}
|
ReturnStatement(pnd)
-]?
+|
+ /* empty */ { *pnd = 0; }
+]
;
/*
;
*/
-StatementSequence(struct node **pnd;):
+StatementSequence(register struct node **pnd;)
+{
+} :
statement(pnd)
[
';' { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);
{
register struct node *nd;
} :
- IF { nd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
+ IF { nd = MkLeaf(Stat, &dot);
*pnd = nd;
}
expression(&(nd->nd_left))
- THEN { nd = MkNode(Link, NULLNODE, NULLNODE, &dot);
- (*pnd)->nd_right = nd;
+ THEN { nd->nd_right = MkLeaf(Link, &dot);
+ nd = nd->nd_right;
}
StatementSequence(&(nd->nd_left))
[
- ELSIF { nd->nd_right = MkNode(Stat,NULLNODE,NULLNODE,&dot);
+ ELSIF { nd->nd_right = MkLeaf(Stat, &dot);
nd = nd->nd_right;
nd->nd_symb = IF;
}
expression(&(nd->nd_left))
- THEN { nd->nd_right = MkNode(Link,NULLNODE,NULLNODE,&dot);
+ THEN { nd->nd_right = MkLeaf(Link, &dot);
nd = nd->nd_right;
}
StatementSequence(&(nd->nd_left))
register struct node *nd;
struct type *tp = 0;
} :
- CASE { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+ CASE { *pnd = nd = MkLeaf(Stat, &dot); }
expression(&(nd->nd_left))
OF
case(&(nd->nd_right), &tp)
;
case(struct node **pnd; struct type **ptp;) :
- { *pnd = 0; }
[ CaseLabelList(ptp, pnd)
':' { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
StatementSequence(&((*pnd)->nd_right))
]?
- /* This rule is changed in new modula-2 */
{ *pnd = MkNode(Link, *pnd, NULLNODE, &dot);
(*pnd)->nd_symb = '|';
}
{
register struct node *nd;
}:
- WHILE { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+ WHILE { *pnd = nd = MkLeaf(Stat, &dot); }
expression(&(nd->nd_left))
DO
StatementSequence(&(nd->nd_right))
{
register struct node *nd;
}:
- REPEAT { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+ REPEAT { *pnd = nd = MkLeaf(Stat, &dot); }
StatementSequence(&(nd->nd_left))
UNTIL
expression(&(nd->nd_right))
register struct node *nd;
struct node *dummy;
}:
- FOR { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
- IDENT { (*pnd)->nd_IDF = dot.TOK_IDF; }
- BECOMES { nd = MkNode(Stat, NULLNODE, NULLNODE, &dot);
- (*pnd)->nd_left = nd;
+ FOR { *pnd = nd = MkLeaf(Stat, &dot); }
+ IDENT { nd->nd_IDF = dot.TOK_IDF; }
+ BECOMES { nd->nd_left = MkLeaf(Stat, &dot);
+ nd = nd->nd_left;
}
expression(&(nd->nd_left))
TO
;
LoopStatement(struct node **pnd;):
- LOOP { *pnd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+ LOOP { *pnd = MkLeaf(Stat, &dot); }
StatementSequence(&((*pnd)->nd_right))
END
;
{
register struct node *nd;
}:
- WITH { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+ WITH { *pnd = nd = MkLeaf(Stat, &dot); }
designator(&(nd->nd_left))
DO
StatementSequence(&(nd->nd_right))
register struct node *nd;
} :
- RETURN { *pnd = nd = MkNode(Stat, NULLNODE, NULLNODE, &dot); }
+ RETURN { *pnd = nd = MkLeaf(Stat, &dot); }
[
expression(&(nd->nd_right))
{ if (scopeclosed(CurrentScope)) {
};
struct subrange {
- arith su_lb, su_ub; /* Lower bound and upper bound */
- label su_rck; /* Label of range check descriptor */
+ arith su_lb, su_ub; /* lower bound and upper bound */
+ label su_rck; /* label of range check descriptor */
#define sub_lb tp_value.tp_subrange.su_lb
#define sub_ub tp_value.tp_subrange.su_ub
#define sub_rck tp_value.tp_subrange.su_rck
};
struct array {
- struct type *ar_elem; /* Type of elements */
- label ar_descr; /* Label of array descriptor */
+ struct type *ar_elem; /* type of elements */
+ label ar_descr; /* label of array descriptor */
+ arith ar_elsize; /* size of elements */
#define arr_elem tp_value.tp_arr.ar_elem
#define arr_descr tp_value.tp_arr.ar_descr
+#define arr_elsize tp_value.tp_arr.ar_elsize
};
struct record {
#define T_CARDINAL 0x0008
/* #define T_LONGINT 0x0010 */
#define T_REAL 0x0020
-/* #define T_LONGREAL 0x0040 */
+#define T_HIDDEN 0x0040
#define T_POINTER 0x0080
#define T_CHAR 0x0100
#define T_WORD 0x0200
extern struct type
*bool_type,
*char_type,
- *charc_type,
*int_type,
*card_type,
*longint_type,
#define NULLTYPE ((struct type *) 0)
-#define IsConformantArray(tpx) ((tpx)->tp_fund == T_ARRAY && (tpx)->next == 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 returntype(tpx) (((tpx)->tp_fund & T_PRCRESULT) ||\
struct type
*bool_type,
*char_type,
- *charc_type,
*int_type,
*card_type,
*longint_type,
struct type *
create_type(fund)
- register int fund;
+ int fund;
{
/* A brand new struct type is created, and its tp_fund set
to fund.
clear((char *)ntp, sizeof(struct type));
ntp->tp_fund = fund;
- ntp->tp_size = (arith)-1;
return ntp;
}
struct type *
construct_type(fund, tp)
- struct type *tp;
+ int fund;
+ register struct type *tp;
{
/* fund must be a type constructor.
The pointer to the constructed type is returned.
*/
- struct type *dtp = create_type(fund);
+ register struct type *dtp = create_type(fund);
switch (fund) {
case T_PROCEDURE:
case T_POINTER:
+ case T_HIDDEN:
dtp->tp_align = pointer_align;
dtp->tp_size = pointer_size;
dtp->next = tp;
if (fund == T_PROCEDURE && tp) {
- if (tp != bitset_type &&
- !(tp->tp_fund&(T_NUMERIC|T_INDEX|T_WORD|T_POINTER))) {
+ if (! returntype(tp)) {
error("illegal procedure result type");
}
}
struct type *
standard_type(fund, align, size)
- int align; arith size;
+ int fund;
+ int align;
+ arith size;
{
register struct type *tp = create_type(fund);
/* first, do some checking
*/
if (int_size != word_size) {
- fatal("Integer size not equal to word size");
+ fatal("integer size not equal to word size");
}
- if (long_size < int_size) {
- fatal("Long integer size smaller than integer size");
+ if (long_size < int_size || long_size % word_size != 0) {
+ fatal("illegal long integer size");
}
if (double_size < float_size) {
- fatal("Long real size smaller than real size");
+ fatal("long real size smaller than real size");
+ }
+
+ if (!pointer_size || pointer_size % word_size != 0) {
+ fatal("illegal pointer size");
}
/* character type
char_type = standard_type(T_CHAR, 1, (arith) 1);
char_type->enm_ncst = 256;
- /* character constant type, different from character type because
- of compatibility with character array's
- */
- charc_type = standard_type(T_CHAR, 1, (arith) 1);
- charc_type->enm_ncst = 256;
-
/* boolean type
*/
bool_type = standard_type(T_ENUMERATION, 1, (arith) 1);
register struct node *ids;
struct paramlist **ppr;
struct type *tp;
+ int VARp;
arith *off;
{
/* Create (part of) a parameterlist of a procedure.
"ids" indicates the list of identifiers, "tp" their type, and
- "VARp" is set when the parameters are VAR-parameters.
-*/
+ "VARp" indicates D_VARPAR or D_VALPAR.
+ */
register struct paramlist *pr;
register struct def *df;
- struct paramlist *pstart;
- while (ids) {
+ for ( ; ids; ids = ids->next) {
pr = new_paramlist();
pr->next = *ppr;
*ppr = pr;
df = define(ids->nd_IDF, CurrentScope, D_VARIABLE);
pr->par_def = df;
df->df_type = tp;
- if (VARp) df->df_flags = D_VARPAR;
- else df->df_flags = D_VALPAR;
df->var_off = align(*off, word_align);
- *off = df->var_off + tp->tp_size;
- ids = ids->next;
+ df->df_flags = VARp;
+ if (IsConformantArray(tp)) {
+ /* we need room for the base address and a descriptor
+ */
+ *off = df->var_off + pointer_size + 3 * word_size;
+ }
+ else if (VARp == D_VARPAR) {
+ *off = df->var_off + pointer_size;
+ }
+ else {
+ *off = df->var_off + tp->tp_size;
+ }
}
}
base = base->next;
}
- if (base->tp_fund == T_ENUMERATION || base->tp_fund == T_CHAR) {
+ if (base->tp_fund & (T_ENUMERATION|T_CHAR)) {
if (tp->next != base) {
error("Specified base does not conform");
}
}
struct type *
set_type(tp)
- struct type *tp;
+ register struct type *tp;
{
/* Construct a set type with base type "tp", but first
perform some checks
return tp;
}
+arith
+ArrayElSize(tp)
+ register struct type *tp;
+{
+ /* Align element size to alignment requirement of element type.
+ Also make sure that its size is either a dividor of the word_size,
+ or a multiple of it.
+ */
+ arith algn;
+
+ if (tp->tp_fund == T_ARRAY) ArraySizes(tp);
+ algn = align(tp->tp_size, tp->tp_align);
+ if (!(algn % word_size == 0 || word_size % algn == 0)) {
+ algn = align(algn, word_size);
+ }
+ return algn;
+}
+
ArraySizes(tp)
register struct type *tp;
{
/* Assign sizes to an array type, and check index type
*/
- arith elem_size;
register struct type *index_type = tp->next;
register struct type *elem_type = tp->arr_elem;
- if (elem_type->tp_fund == T_ARRAY) {
- ArraySizes(elem_type);
- }
-
- /* align element size to alignment requirement of element type
- */
- elem_size = align(elem_type->tp_size, elem_type->tp_align);
+ tp->arr_elsize = ArrayElSize(elem_type);
tp->tp_align = elem_type->tp_align;
/* check index type
switch(index_type->tp_fund) {
case T_SUBRANGE:
- tp->tp_size = elem_size *
+ tp->tp_size = tp->arr_elsize *
(index_type->sub_ub - index_type->sub_lb + 1);
C_rom_cst(index_type->sub_lb);
C_rom_cst(index_type->sub_ub - index_type->sub_lb);
case T_CHAR:
case T_ENUMERATION:
- tp->tp_size = elem_size * index_type->enm_ncst;
+ tp->tp_size = tp->arr_elsize * index_type->enm_ncst;
C_rom_cst((arith) 0);
C_rom_cst((arith) (index_type->enm_ncst - 1));
break;
crash("Funny index type");
}
- C_rom_cst(elem_size);
+ C_rom_cst(tp->arr_elsize);
/* ??? overflow checking ???
*/
FreeType(tp)
struct type *tp;
{
- /* Release type structures indicated by "tp"
+ /* Release type structures indicated by "tp".
+ This procedure is only called for types, constructed with
+ T_PROCEDURE.
*/
register struct paramlist *pr, *pr1;
&&
(tp1 == int_type || tp1 == card_type)
)
- ||
- (tp1 == char_type && tp2 == charc_type)
- ||
- (tp2 == char_type && tp1 == charc_type)
||
( tp1 == address_type
&&
if ((tp1->tp_fund & T_INTORCARD) &&
(tp2->tp_fund & T_INTORCARD)) return 1;
- if (tp1 == char_type && tp2 == charc_type) return 1;
-
if (tp1->tp_fund == T_ARRAY) {
/* check for string
*/
if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
return
tp1 == char_type
- &&
- (
- tp2 == charc_type
- ||
- (tp2->tp_fund == T_STRING && size >= tp2->tp_size)
- );
+ && (tp2->tp_fund == T_STRING && size >= tp2->tp_size)
+ ;
}
return 0;
#include "f_info.h"
#include "idf.h"
-extern arith align();
extern arith NewPtr();
extern arith NewInt();
extern int proclevel;
if (!filename_label) {
filename_label = data_label();
C_df_dlb(filename_label);
- C_rom_scon(FileName, (arith) strlen(FileName));
+ C_rom_scon(FileName, (arith) (strlen(FileName) + 1));
}
C_fil_dlb(filename_label, (arith) 0);
Call initialization routines of imported modules.
Also prevent recursive calls of this one.
*/
- label l1 = data_label(), l2 = text_label();
struct node *nd;
- /* we don't actually prevent recursive calls, but do nothing
- if called recursively
- */
- C_df_dlb(l1);
- C_bss_cst(word_size, (arith) 0, 1);
- C_loe_dlb(l1, (arith) 0);
- C_zeq(l2);
- C_ret((arith) 0);
- C_df_ilb(l2);
- C_loc((arith) 1);
- C_ste_dlb(l1, (arith) 0);
+ if (state == IMPLEMENTATION) {
+ label l1 = data_label(), l2 = text_label();
+ /* we don't actually prevent recursive calls,
+ but do nothing if called recursively
+ */
+ C_df_dlb(l1);
+ C_bss_cst(word_size, (arith) 0, 1);
+ C_loe_dlb(l1, (arith) 0);
+ C_zeq(l2);
+ C_ret((arith) 0);
+ C_df_ilb(l2);
+ C_loc((arith) 1);
+ C_ste_dlb(l1, (arith) 0);
+ }
nd = Modules;
while (nd) {
return;
}
- if (options['L']) C_lin((arith) nd->nd_lineno);
+ if (! options['L']) C_lin((arith) nd->nd_lineno);
if (nd->nd_class == Call) {
if (chk_call(nd)) {
/* May we do it in this order (expression first) ??? */
struct desig ds;
- WalkExpr(right, NO_LABEL, NO_LABEL);
+ if (!chk_expr(right)) return;
if (! chk_designator(left, DESIGNATOR|VARIABLE, D_DEFINED)) return;
+ TryToString(right, left->nd_type);
+ Desig = InitDesig;
+ CodeExpr(right, &Desig, NO_LABEL, NO_LABEL);
if (! TstAssCompat(left->nd_type, right->nd_type)) {
node_error(nd, "type incompatibility in assignment");
public / ack.git / commitdiff