struct string tk_str; /* STRING */
arith tk_int; /* INTEGER */
char *tk_real; /* REAL */
+ arith *tk_set; /* only used in parse tree node */
+ struct def *tk_def; /* only used in parse tree node */
} tk_data;
};
typequiv.o: Lpars.h def.h type.h
node.o: LLlex.h debug.h def.h node.h type.h
cstoper.o: LLlex.h Lpars.h def_sizes.h idf.h node.h type.h
-chk_expr.o: LLlex.h Lpars.h def.h idf.h node.h scope.h type.h
+chk_expr.o: LLlex.h Lpars.h const.h def.h idf.h node.h scope.h standards.h type.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 def.h idf.h misc.h node.h scope.h type.h
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
+#include <alloc.h>
#include "idf.h"
#include "type.h"
#include "def.h"
#include "node.h"
#include "Lpars.h"
#include "scope.h"
+#include "const.h"
+#include "standards.h"
int
chk_expr(expp, const)
chk_set(expp, const)
register struct node *expp;
{
+ /* 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 node *nd;
- extern struct def *findname();
+ arith *set;
assert(expp->nd_symb == SET);
if (expp->nd_left) {
/* A type was given. Check it out
*/
- df = findname(expp->nd_left);
+ (void) findname(expp->nd_left);
+ assert(expp->nd_left->nd_class == Def);
+ df = expp->nd_left->nd_def;
if ((df->df_kind != D_TYPE && df->df_kind != D_ERROR) ||
(df->df_type->tp_fund != SET)) {
node_error(expp, "Illegal set type");
}
else tp = bitset_type;
- /* Now check the elements given
+ /* Now check the elements given, and try to compute a constant set.
*/
+ set = (arith *) Malloc(tp->tp_size * sizeof(arith) / wrd_size);
nd = expp->nd_right;
while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ',');
- if (!chk_el(nd->nd_left, const, tp->next, 0)) return 0;
+ if (!chk_el(nd->nd_left, const, tp->next, &set)) return 0;
nd = nd->nd_right;
}
+ expp->nd_type = tp;
+ assert(!const || set);
+ if (set) {
+ /* Yes, in was a constant set, and we managed to compute it!
+ */
+ expp->nd_class = Set;
+ expp->nd_set = set;
+ FreeNode(expp->nd_left);
+ FreeNode(expp->nd_right);
+ expp->nd_left = expp->nd_right = 0;
+ }
return 1;
}
int
-chk_el(expp, const, tp, level)
- struct node *expp;
+chk_el(expp, const, tp, set)
+ register struct node *expp;
struct type *tp;
+ arith **set;
{
/* Check elements of a set. This routine may call itself
- recursively, but only once.
+ recursively.
+ Also try to compute the set!
*/
if (expp->nd_class == Link && expp->nd_symb == UPTO) {
- /* { ... , expr1 .. expr2, ... } */
- if (level) {
- node_error(expp, "Illegal set element");
- return 0;
- }
- if (!chk_el(expp->nd_left, const, tp, 1) ||
- !chk_el(expp->nd_right, const, tp, 1)) {
+ /* { ... , expr1 .. expr2, ... }
+ First check expr1 and expr2, and try to compute them.
+ */
+ if (!chk_el(expp->nd_left, const, tp, set) ||
+ !chk_el(expp->nd_right, const, tp, set)) {
return 0;
}
if (expp->nd_left->nd_class == Value &&
expp->nd_right->nd_class == Value) {
+ /* We have a constant range. Put all elements in the
+ set
+ */
+ register int i;
+
if (expp->nd_left->nd_INT > expp->nd_right->nd_INT) {
node_error(expp, "Lower bound exceeds upper bound in range");
- return 0;
+ return rem_set(set);
}
+
+ if (*set) for (i = expp->nd_left->nd_INT + 1;
+ i < expp->nd_right->nd_INT; i++) {
+ (*set)[i/wrd_bits] |= (1 << (i % wrd_bits));
+ }
+ }
+ else if (*set) {
+ free(*set);
+ *set = 0;
}
return 1;
}
- if (!chk_expr(expp, const)) return 0;
+
+ /* Here, a single element is checked
+ */
+ if (!chk_expr(expp, const)) {
+ return rem_set(set);
+ }
if (!TstCompat(tp, expp->nd_type)) {
node_error(expp, "Set element has incompatible type");
- return 0;
+ return rem_set(set);
}
if (expp->nd_class == Value) {
if ((tp->tp_fund != ENUMERATION &&
(expp->nd_INT < 0 || expp->nd_INT > tp->enm_ncst))
) {
node_error(expp, "Set element out of range");
-#ifdef DEBUG
- debug("%d (%d, %d)", (int) expp->nd_INT, (int) tp->sub_lb, (int) tp->sub_ub);
-#endif
- return 0;
+ return rem_set(set);
}
+ if (*set) (*set)[expp->nd_INT/wrd_bits] |= (1 << (expp->nd_INT%wrd_bits));
}
return 1;
}
+int
+rem_set(set)
+ arith **set;
+{
+ /* This routine is only used for error exits of chk_el.
+ It frees the set indicated by "set", and returns 0.
+ */
+ if (*set) {
+ free((char *) *set);
+ *set = 0;
+ }
+ return 0;
+}
+
int
chk_call(expp, const)
register struct node *expp;
{
- /* ??? */
- return 1;
+ register struct type *tp;
+ register struct node *left;
+
+ expp->nd_type = error_type;
+ (void) findname(expp->nd_left);
+ left = expp->nd_left;
+ tp = left->nd_type;
+
+ if (tp == error_type) return 0;
+ if (left->nd_class == Def &&
+ (left->nd_def->df_kind & (D_HTYPE|D_TYPE|D_HIDDEN))) {
+ /* A type cast. This is of course not portable.
+ No runtime action. Remove it.
+ */
+ if (!expp->nd_right ||
+ (expp->nd_right->nd_symb == ',')) {
+node_error(expp, "Only one parameter expected in type cast");
+ return 0;
+ }
+ if (! chk_expr(expp->nd_right, const)) return 0;
+ if (expp->nd_right->nd_type->tp_size !=
+ left->nd_type->tp_size) {
+node_error(expp, "Size of type in type cast does not match size of operand");
+ return 0;
+ }
+ expp->nd_right->nd_type = left->nd_type;
+ left = expp->nd_right;
+ FreeNode(expp->nd_left);
+ *expp = *(expp->nd_right);
+ left->nd_left = left->nd_right = 0;
+ FreeNode(left);
+ return 1;
+ }
+
+ if ((left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) ||
+ tp->tp_fund == PROCVAR) {
+ /* A procedure call. it may also be a call to a
+ standard procedure
+ */
+ if (tp == std_type) {
+ assert(left->nd_class == Def);
+ switch(left->nd_def->df_value.df_stdname) {
+ case S_ABS:
+ case S_CAP:
+ case S_CHR:
+ case S_FLOAT:
+ case S_HIGH:
+ case S_MAX:
+ case S_MIN:
+ case S_ODD:
+ case S_ORD:
+ case S_SIZE:
+ case S_TRUNC:
+ case S_VAL:
+ break;
+ case S_DEC:
+ case S_INC:
+ case S_HALT:
+ case S_EXCL:
+ case S_INCL:
+ expp->nd_type = 0;
+ break;
+ default:
+ assert(0);
+ }
+ return 1;
+ }
+ return 1;
+ }
+ node_error(expp->nd_left, "procedure, type, or function expected");
+ return 0;
}
-struct def *
findname(expp)
register struct node *expp;
{
*/
register struct def *df;
struct def *lookfor();
- register struct node *nd;
+ register struct type *tp;
int scope;
int module;
+ expp->nd_type = error_type;
if (expp->nd_class == Name) {
- return lookfor(expp, CurrentScope, 1);
+ expp->nd_def = lookfor(expp, CurrentScope, 1);
+ expp->nd_class = Def;
+ expp->nd_type = expp->nd_def->df_type;
+ return;
}
- assert(expp->nd_class == Link && expp->nd_symb == '.');
- assert(expp->nd_left->nd_class == Name);
- df = lookfor(expp->nd_left, CurrentScope, 1);
- if (df->df_kind == D_ERROR) return df;
- nd = expp;
- while (nd->nd_class == Link) {
- struct node *nd1;
-
- if (!(scope = has_selectors(df))) {
- node_error(nd, "identifier \"%s\" has no selectors",
- df->df_idf->id_text);
- return ill_df;
+ if (expp->nd_class == Link) {
+ assert(expp->nd_symb == '.');
+ assert(expp->nd_right->nd_class == Name);
+ findname(expp->nd_left);
+ tp = expp->nd_left->nd_type;
+ if (tp == error_type) {
+ df = ill_df;
}
- nd = nd->nd_right;
- if (nd->nd_class == Name) nd1 = nd;
- else nd1 = nd->nd_left;
- module = (df->df_kind == D_MODULE);
- df = lookup(nd1->nd_IDF, scope);
+ else if (tp->tp_fund != RECORD) {
+ /* This is also true for modules */
+ node_error(expp,"Illegal selection");
+ df = ill_df;
+ }
+ else df = lookup(expp->nd_right->nd_IDF, tp->rec_scope);
if (!df) {
- id_not_declared(nd1);
- return ill_df;
+ df = ill_df;
+ id_not_declared(expp->nd_right);
}
- if (module && !(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
-node_error(nd1, "identifier \"%s\" not exprted from qualifying module",
+ else if (df != ill_df) {
+ expp->nd_type = df->df_type;
+ if (!(df->df_flags & (D_EXPORTED|D_QEXPORTED))) {
+node_error(expp->nd_right,
+"identifier \"%s\" not exprted from qualifying module",
df->df_idf->id_text);
+ }
}
+ if (expp->nd_left->nd_class == Def) {
+ expp->nd_class = Def;
+ expp->nd_def = df;
+ FreeNode(expp->nd_left);
+ FreeNode(expp->nd_right);
+ expp->nd_left = expp->nd_right = 0;
+ }
+ return;
+ }
+ if (expp->nd_class == Oper) {
+ assert(expp->nd_symb == '[');
+ (void) findname(expp->nd_left);
+ if (chk_expr(expp->nd_right, 0) &&
+ expp->nd_left->nd_type != error_type &&
+ chk_oper(expp)) /* ??? */ ;
+ return 1;
}
- return df;
+ if (expp->nd_class == Uoper && expp->nd_symb == '^') {
+ (void) findname(expp->nd_right);
+ if (expp->nd_right->nd_type != error_type &&
+ chk_uoper(expp)) /* ??? */ ;
+ }
+ return 0;
}
int
register struct def *df;
int retval = 1;
- df = findname(expp);
+ (void) findname(expp);
+ assert(expp->nd_class == Def);
+ df = expp->nd_def;
if (df->df_kind == D_ERROR) {
retval = 0;
}
- expp->nd_type = df->df_type;
- if (df->df_kind == D_ENUM || df->df_kind == D_CONST) {
- if (expp->nd_left) FreeNode(expp->nd_left);
- if (expp->nd_right) FreeNode(expp->nd_right);
+ if (df->df_kind & (D_ENUM | D_CONST)) {
if (df->df_kind == D_ENUM) {
- expp->nd_left = expp->nd_right = 0;
expp->nd_class = Value;
expp->nd_INT = df->enm_val;
expp->nd_symb = INTEGER;
expp->nd_right->nd_type = tpr = tpl;
}
}
+ expp->nd_type = error_type;
if (expp->nd_symb == IN) {
/* Handle this one specially */
- expp->nd_type == bool_type;
+ expp->nd_type = bool_type;
if (tpr->tp_fund != SET) {
node_error(expp, "RHS of IN operator not a SET type");
return 0;
return 1;
}
+ if (expp->nd_symb == '[') {
+ /* Handle ARRAY selection specially too! */
+ if (tpl->tp_fund != ARRAY) {
+node_error(expp, "array index not belonging to an ARRAY");
+ return 0;
+ }
+ if (!TstCompat(tpl->next, tpr)) {
+node_error(expp, "incompatible index type");
+ return 0;
+ }
+ expp->nd_type = tpl->arr_elem;
+ if (const) return 0;
+ return 1;
+ }
+
if (tpl->tp_fund == SUBRANGE) tpl = tpl->next;
expp->nd_type = tpl;
return 1;
}
break;
+ case '^':
+ if (tpr->tp_fund != POINTER) break;
+ expp->nd_type = tpr->next;
+ if (const) return 0;
+ return 1;
default:
assert(0);
}
mach_long_size; /* size of long on this machine == sizeof(long) */
extern arith
max_int, /* maximum integer on target machine */
- max_unsigned; /* maximum unsigned on target machine */
+ max_unsigned, /* maximum unsigned on target machine */
+ wrd_bits; /* Number of bits in a word */
arith max_int; /* maximum integer on target machine */
arith max_unsigned; /* maximum unsigned on target machine */
arith max_longint; /* maximum longint on target machine */
+arith wrd_bits; /* number of bits in a word */
cstunary(expp)
register struct node *expp;
cstset(expp)
register struct node *expp;
{
- switch(expp->nd_symb) {
- case IN:
- case '+':
- case '-':
- case '*':
- case '/':
- case GREATEREQUAL:
- case LESSEQUAL:
- case '=':
- case '#':
- /* ??? */
- break;
- default:
- assert(0);
+ register arith *set1 = 0, *set2;
+ register int setsize, j;
+
+ assert(expp->nd_right->nd_class == Set);
+ assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set);
+ set2 = expp->nd_right->nd_set;
+ setsize = expp->nd_right->nd_type->tp_size / wrd_size;
+
+ if (expp->nd_symb == IN) {
+ arith i;
+
+ assert(expp->nd_left->nd_class == Value);
+ i = expp->nd_left->nd_INT;
+ expp->nd_INT = (i >= 0 &&
+ i < setsize * wrd_bits &&
+ (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
+ free((char *) set2);
+ }
+ else {
+ set1 = expp->nd_left->nd_set;
+ switch(expp->nd_symb) {
+ case '+':
+ for (j = 0; j < setsize; j++) {
+ *set1++ |= *set2++;
+ }
+ break;
+ case '-':
+ for (j = 0; j < setsize; j++) {
+ *set1++ &= ~*set2++;
+ }
+ break;
+ case '*':
+ for (j = 0; j < setsize; j++) {
+ *set1++ &= *set2++;
+ }
+ break;
+ case '/':
+ for (j = 0; j < setsize; j++) {
+ *set1++ ^= *set2++;
+ }
+ break;
+ case GREATEREQUAL:
+ case LESSEQUAL:
+ case '=':
+ case '#':
+ /* Clumsy, but who cares? Nobody writes these things! */
+ for (j = 0; j < setsize; j++) {
+ switch(expp->nd_symb) {
+ case GREATEREQUAL:
+ if ((*set1 | *set2++) != *set1) break;
+ set1++;
+ continue;
+ case LESSEQUAL:
+ if ((*set2 | *set1++) != *set2) break;
+ set2++;
+ continue;
+ case '=':
+ case '#':
+ if (*set1++ != *set2++) break;
+ continue;
+ }
+ expp->nd_INT = expp->nd_symb == '#';
+ break;
+ }
+ if (j == setsize) expp->nd_INT = expp->nd_symb != '#';
+ expp->nd_class = Value;
+ free((char *) expp->nd_left->nd_set);
+ free((char *) expp->nd_right->nd_set);
+ break;
+ default:
+ assert(0);
+ }
+ free((char *) expp->nd_right->nd_set);
+ expp->nd_class = Set;
+ expp->nd_set = expp->nd_left->nd_set;
}
+ FreeNode(expp->nd_left);
+ FreeNode(expp->nd_right);
+ expp->nd_left = expp->nd_right = 0;
}
cut_size(expr)
max_int = full_mask[int_size] & ~(1 << (int_size * 8 - 1));
max_unsigned = full_mask[int_size];
+ wrd_bits = 8 * wrd_size;
}
SubrangeType(struct type **ptp;)
{
struct node *nd1, *nd2;
- extern struct type *subr_type();
}:
/*
This is not exactly the rule in the new report, but see
SetType(struct type **ptp;)
{
struct type *tp;
- struct type *set_type();
} :
SET OF SimpleType(&tp)
{
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
+#include <assert.h>
#include "LLlex.h"
#include "idf.h"
#include "def.h"
register struct def *df;
register struct node **pnd;
struct node *nd;
- struct def *findname();
} :
IDENT { nd = MkNode(Name, NULLNODE, NULLNODE, &dot);
pnd = &nd;
}
[
- /* selector */
- '.' { *pnd = MkNode(Link,*pnd,NULLNODE,&dot);
- pnd = &(*pnd)->nd_right;
- }
- IDENT
- { *pnd = MkNode(Name,NULLNODE,NULLNODE,&dot); }
+ selector(pnd)
]*
{ if (types) {
- *pdf = df = findname(nd);
+ findname(nd);
+ assert(nd->nd_class == Def);
+ *pdf = df = nd->nd_def;
if (df->df_kind != D_ERROR &&
!(types & df->df_kind)) {
error("identifier \"%s\" is not a %s",
}
;
-/* Inline substituted wherever it occurred
-selector:
- '.' IDENT
+selector(struct node **pnd;):
+ '.' { *pnd = MkNode(Link,*pnd,NULLNODE,&dot); }
+ IDENT { (*pnd)->nd_right = MkNode(Name,NULLNODE,NULLNODE,&dot); }
;
-*/
ExpList(struct node **pnd;)
{
designator_tail(struct node **pnd;):
visible_designator_tail(pnd)
[
- /* selector */
- '.' { *pnd = MkNode(Link, *pnd, NULLNODE, &dot); }
- IDENT { (*pnd)->nd_right =
- MkNode(Name, NULLNODE, NULLNODE, &dot);
- }
+ selector(pnd)
|
visible_designator_tail(pnd)
]*
visible_designator_tail(struct node **pnd;):
'[' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
- ExpList(&((*pnd)->nd_right))
+ expression(&((*pnd)->nd_right))
+ [
+ ','
+ { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot);
+ (*pnd)->nd_symb = '[';
+ }
+ expression(&((*pnd)->nd_right))
+ ]*
']'
|
- '^' { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+ '^' { *pnd = MkNode(Oper, NULLNODE, *pnd, &dot); }
;
register struct def *df;
struct def *Enter();
- (void) Enter("ABS", D_STDFUNC, NULLTYPE, S_ABS);
- (void) Enter("CAP", D_STDFUNC, NULLTYPE, S_CAP);
- (void) Enter("CHR", D_STDFUNC, NULLTYPE, S_CHR);
- (void) Enter("FLOAT", D_STDFUNC, NULLTYPE, S_FLOAT);
- (void) Enter("HIGH", D_STDFUNC, NULLTYPE, S_HIGH);
- (void) Enter("HALT", D_STDPROC, NULLTYPE, S_HALT);
- (void) Enter("EXCL", D_STDPROC, NULLTYPE, S_EXCL);
- (void) Enter("DEC", D_STDPROC, NULLTYPE, S_DEC);
- (void) Enter("INC", D_STDPROC, NULLTYPE, S_INC);
- (void) Enter("VAL", D_STDFUNC, NULLTYPE, S_VAL);
- (void) Enter("TRUNC", D_STDFUNC, NULLTYPE, S_TRUNC);
- (void) Enter("SIZE", D_STDFUNC, NULLTYPE, S_SIZE);
- (void) Enter("ORD", D_STDFUNC, NULLTYPE, S_ORD);
- (void) Enter("ODD", D_STDFUNC, NULLTYPE, S_ODD);
- (void) Enter("MAX", D_STDFUNC, NULLTYPE, S_MAX);
- (void) Enter("MIN", D_STDFUNC, NULLTYPE, S_MIN);
- (void) Enter("INCL", D_STDPROC, NULLTYPE, S_INCL);
+ (void) Enter("ABS", D_PROCEDURE, std_type, S_ABS);
+ (void) Enter("CAP", D_PROCEDURE, std_type, S_CAP);
+ (void) Enter("CHR", D_PROCEDURE, std_type, S_CHR);
+ (void) Enter("FLOAT", D_PROCEDURE, std_type, S_FLOAT);
+ (void) Enter("HIGH", D_PROCEDURE, std_type, S_HIGH);
+ (void) Enter("HALT", D_PROCEDURE, std_type, S_HALT);
+ (void) Enter("EXCL", D_PROCEDURE, std_type, S_EXCL);
+ (void) Enter("DEC", D_PROCEDURE, std_type, S_DEC);
+ (void) Enter("INC", D_PROCEDURE, std_type, S_INC);
+ (void) Enter("VAL", D_PROCEDURE, std_type, S_VAL);
+ (void) Enter("TRUNC", D_PROCEDURE, std_type, S_TRUNC);
+ (void) Enter("SIZE", D_PROCEDURE, std_type, S_SIZE);
+ (void) Enter("ORD", D_PROCEDURE, std_type, S_ORD);
+ (void) Enter("ODD", D_PROCEDURE, std_type, S_ODD);
+ (void) Enter("MAX", D_PROCEDURE, std_type, S_MAX);
+ (void) Enter("MIN", D_PROCEDURE, std_type, S_MIN);
+ (void) Enter("INCL", D_PROCEDURE, std_type, S_INCL);
(void) Enter("CHAR", D_TYPE, char_type, 0);
(void) Enter("INTEGER", D_TYPE, int_type, 0);
open_scope(CLOSEDSCOPE, 0);
(void) Enter("WORD", D_TYPE, word_type, 0);
(void) Enter("ADDRESS", D_TYPE, address_type, 0);
- (void) Enter("ADR", D_STDFUNC, NULLTYPE, S_ADR);
- (void) Enter("TSIZE", D_STDFUNC, NULLTYPE, S_TSIZE);
+ (void) Enter("ADR", D_PROCEDURE, std_type, S_ADR);
+ (void) Enter("TSIZE", D_PROCEDURE, std_type, S_TSIZE);
if (!InsertText(SYSTEM, strlen(SYSTEM))) {
fatal("Could not insert text");
}
#define Oper 2 /* binary operator */
#define Uoper 3 /* unary operator */
#define Call 4 /* cast or procedure - or function call */
-#define Name 5 /* a qualident */
+#define Name 5 /* an identifier */
#define Set 6 /* a set constant */
#define Xset 7 /* a set */
#define Def 8 /* an identified name */
+#define Stat 9 /* a statement */
#define Link 11
struct type *nd_type; /* type of this node */
- union {
- struct token ndu_token; /* (Value, Oper, Uoper, Call, Name,
- Link)
- */
- arith *ndu_set; /* pointer to a set constant (Set) */
- struct def *ndu_def; /* pointer to definition structure for
- identified name (Def)
- */
- } nd_val;
-#define nd_token nd_val.ndu_token
-#define nd_set nd_val.ndu_set
-#define nd_def nd_val.ndu_def
+ struct token nd_token;
+#define nd_set nd_token.tk_data.tk_set
+#define nd_def nd_token.tk_data.tk_def
#define nd_symb nd_token.tk_symb
#define nd_lineno nd_token.tk_lineno
#define nd_filename nd_token.tk_filename
df = define(id, CurrentScope, D_MODULE);
open_scope(CLOSEDSCOPE, 0);
df->mod_scope = CurrentScope->sc_scope;
+ df->df_type =
+ standard_type(RECORD, 0, (arith) 0);
+ df->df_type->rec_scope = df->mod_scope;
}
priority? ';'
import(1)*
df = define(id, GlobalScope, D_MODULE);
if (!SYSTEMModule) open_scope(CLOSEDSCOPE, 0);
df->mod_scope = CurrentScope->sc_scope;
+ df->df_type = standard_type(RECORD, 0, (arith) 0);
+ df->df_type->rec_scope = df->mod_scope;
DefinitionModule = 1;
DO_DEBUG(1, debug("Definition module \"%s\"", id->id_text));
}
statement
{
- struct node *nd1, *nd2;
+ struct node *nd1, *nd2 = 0;
} :
[
/*
designator(&nd1)
[
ActualParameters(&nd2)?
+ { nd1 = MkNode(Call, nd1, nd2, &dot);
+ nd1->nd_symb = '(';
+ }
|
- BECOMES expression(&nd2)
+ BECOMES { nd1 = MkNode(Stat, nd1, NULLNODE, &dot); }
+ expression(&(nd1->nd_right))
]
/*
* end of changed part
*intorcard_type,
*string_type,
*bitset_type,
+ *std_type,
*error_type; /* All from type.c */
extern int
struct type
*create_type(),
*construct_type(),
- *standard_type(); /* All from type.c */
+ *standard_type(),
+ *set_type(),
+ *subr_type(); /* All from type.c */
#define NULLTYPE ((struct type *) 0)
*intorcard_type,
*string_type,
*bitset_type,
+ *std_type,
*error_type;
struct paramlist *h_paramlist;
char_type = standard_type(CHAR, 1, (arith) 1);
char_type->enm_ncst = 256;
- bool_type = standard_type(BOOLEAN, 1, (arith) 1);
+ bool_type = standard_type(ENUMERATION, 1, (arith) 1);
+ bool_type->enm_ncst = 2;
int_type = standard_type(INTEGER, int_align, int_size);
longint_type = standard_type(LONGINT, lint_align, lint_size);
card_type = standard_type(CARDINAL, int_align, int_size);
tp = construct_type(SUBRANGE, int_type);
tp->sub_lb = 0;
tp->sub_ub = wrd_size * 8 - 1;
- bitset_type = construct_type(SET, tp);
- bitset_type->tp_size = wrd_size;
+ bitset_type = set_type(tp);
+ std_type = construct_type(PROCEDURE, NULLTYPE);
error_type = standard_type(ERRONEOUS, 1, (arith) 1);
}
public / ack.git / commitdiff