#include <em_label.h>
#include <assert.h>
#include <alloc.h>
+#include "Lpars.h"
#include "idf.h"
#include "type.h"
#include "def.h"
#include "LLlex.h"
#include "node.h"
-#include "Lpars.h"
#include "scope.h"
#include "const.h"
#include "standards.h"
int
-chk_expr(expp, const)
+chk_expr(expp)
register struct node *expp;
{
/* Check the expression indicated by expp for semantic errors,
switch(expp->nd_class) {
case Oper:
- return chk_expr(expp->nd_left, const) &&
- chk_expr(expp->nd_right, const) &&
- chk_oper(expp, const);
+ return chk_expr(expp->nd_left) &&
+ chk_expr(expp->nd_right) &&
+ chk_oper(expp);
case Uoper:
- return chk_expr(expp->nd_right, const) &&
- chk_uoper(expp, const);
+ return chk_expr(expp->nd_right) &&
+ chk_uoper(expp);
case Value:
switch(expp->nd_symb) {
case REAL:
}
break;
case Xset:
- return chk_set(expp, const);
+ return chk_set(expp);
case Name:
- return chk_name(expp, const);
+ return chk_name(expp);
case Call:
- return chk_call(expp, const);
+ return chk_call(expp);
case Link:
- return chk_name(expp, const);
+ return chk_name(expp);
default:
assert(0);
}
}
int
-chk_set(expp, const)
+chk_set(expp)
register struct node *expp;
{
/* Check the legality of a SET aggregate, and try to evaluate it
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)) {
+ (df->df_type->tp_fund != T_SET)) {
node_error(expp, "Illegal set type");
return 0;
}
nd = expp->nd_right;
while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ',');
- if (!chk_el(nd->nd_left, const, tp->next, &set)) return 0;
+ if (!chk_el(nd->nd_left, 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!
*/
}
int
-chk_el(expp, const, tp, set)
+chk_el(expp, tp, set)
register struct node *expp;
struct type *tp;
arith **set;
/* { ... , 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)) {
+ if (!chk_el(expp->nd_left, tp, set) ||
+ !chk_el(expp->nd_right, tp, set)) {
return 0;
}
if (expp->nd_left->nd_class == Value &&
/* Here, a single element is checked
*/
- if (!chk_expr(expp, const)) {
+ if (!chk_expr(expp)) {
return rem_set(set);
}
if (!TstCompat(tp, expp->nd_type)) {
return rem_set(set);
}
if (expp->nd_class == Value) {
- if ((tp->tp_fund != ENUMERATION &&
+ if ((tp->tp_fund != T_ENUMERATION &&
(expp->nd_INT < tp->sub_lb || expp->nd_INT > tp->sub_ub))
||
- (tp->tp_fund == ENUMERATION &&
+ (tp->tp_fund == T_ENUMERATION &&
(expp->nd_INT < 0 || expp->nd_INT > tp->enm_ncst))
) {
node_error(expp, "Set element out of range");
return 0;
}
+struct node *
+getarg(argp, bases)
+ struct node *argp;
+{
+ struct type *tp;
+
+ if (!argp->nd_right) {
+ node_error(argp, "Too few arguments supplied");
+ return 0;
+ }
+ argp = argp->nd_right;
+ if (!chk_expr(argp->nd_left)) return 0;
+ tp = argp->nd_left->nd_type;
+ if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+ if (!(tp->tp_fund & bases)) {
+ node_error(argp, "Unexpected type");
+ return 0;
+ }
+ return argp;
+}
+
+struct node *
+getname(argp, kinds)
+ struct node *argp;
+{
+ if (!argp->nd_right) {
+ node_error(argp, "Too few arguments supplied");
+ return 0;
+ }
+ argp = argp->nd_right;
+ if (!findname(argp->nd_left)) return 0;
+ assert(argp->nd_left->nd_class == Def);
+ if (!(argp->nd_left->nd_def->df_kind & kinds)) {
+ node_error(argp, "Unexpected type");
+ return 0;
+ }
+ return argp;
+}
+
int
-chk_call(expp, const)
+chk_call(expp)
register struct node *expp;
{
register struct type *tp;
register struct node *left;
+ register struct node *arg;
expp->nd_type = error_type;
(void) findname(expp->nd_left);
/* A type cast. This is of course not portable.
No runtime action. Remove it.
*/
- if (!expp->nd_right ||
- (expp->nd_right->nd_symb == ',')) {
+ arg = expp->nd_right;
+ if (!arg || arg->nd_right) {
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 !=
+ if (! chk_expr(arg->nd_left)) return 0;
+ if (arg->nd_left->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;
+ arg->nd_left->nd_type = left->nd_type;
FreeNode(expp->nd_left);
- *expp = *(expp->nd_right);
- left->nd_left = left->nd_right = 0;
- FreeNode(left);
+ *expp = *(arg->nd_left);
+ arg->nd_left->nd_left = 0;
+ arg->nd_left->nd_right = 0;
+ FreeNode(arg);
return 1;
}
if ((left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) ||
- tp->tp_fund == PROCVAR) {
+ tp->tp_fund == T_PROCEDURE) {
/* A procedure call. it may also be a call to a
standard procedure
*/
+ arg = expp;
if (tp == std_type) {
assert(left->nd_class == Def);
switch(left->nd_def->df_value.df_stdname) {
case S_ABS:
+ arg = getarg(arg, T_INTEGER|T_CARDINAL|T_REAL);
+ if (! arg) return 0;
+ expp->nd_type = arg->nd_left->nd_type;
+ break;
case S_CAP:
+ arg = getarg(arg, T_CHAR);
+ expp->nd_type = char_type;
+ if (!arg) return 0;
+ break;
case S_CHR:
+ arg = getarg(arg, T_INTEGER|T_CARDINAL);
+ expp->nd_type = char_type;
+ if (!arg) return 0;
+ break;
case S_FLOAT:
+ arg = getarg(arg, T_CARDINAL|T_INTEGER);
+ expp->nd_type = real_type;
+ if (!arg) return 0;
+ break;
case S_HIGH:
+ arg = getarg(arg, T_ARRAY);
+ if (!arg) return 0;
+ expp->nd_type = arg->nd_left->nd_type->next;
+ if (!expp->nd_type) expp->nd_type = int_type;
+ break;
case S_MAX:
case S_MIN:
+ arg = getarg(arg, T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL);
+ if (!arg) return 0;
+ expp->nd_type = arg->nd_left->nd_type;
+ break;
case S_ODD:
+ arg = getarg(arg, T_INTEGER|T_CARDINAL);
+ if (!arg) return 0;
+ expp->nd_type = bool_type;
+ break;
case S_ORD:
+ arg = getarg(arg, T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL);
+ if (!arg) return 0;
+ expp->nd_type = card_type;
+ break;
+ case S_TSIZE: /* ??? */
case S_SIZE:
+ arg = getname(arg, D_FIELD|D_VARIABLE|D_TYPE|D_HIDDEN|D_HTYPE);
+ expp->nd_type = intorcard_type;
+ if (!arg) return 0;
+ break;
case S_TRUNC:
+ arg = getarg(arg, T_REAL);
+ if (!arg) return 0;
+ expp->nd_type = card_type;
+ break;
case S_VAL:
+ arg = getname(arg, D_HIDDEN|D_HTYPE|D_TYPE);
+ if (!arg) return 0;
+ tp = arg->nd_left->nd_def->df_type;
+ if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
+ if (!(tp->tp_fund & (T_ENUMERATION|T_CHAR|T_INTEGER|T_CARDINAL))) {
+ node_error(arg, "unexpected type");
+ return 0;
+ }
+ expp->nd_type = arg->nd_left->nd_def->df_type;
+ FreeNode(arg->nd_left);
+ arg->nd_left = 0;
+ arg = getarg(arg, T_INTEGER|T_CARDINAL);
+ if (!arg) return 0;
+ break;
+ case S_ADR:
+ arg = getname(arg, D_VARIABLE|D_FIELD|D_PROCEDURE);
+ expp->nd_type = address_type;
+ if (!arg) return 0;
break;
case S_DEC:
case S_INC:
+ expp->nd_type = 0;
+ arg = getname(arg, D_VARIABLE|D_FIELD);
+ if (!arg) return 0;
+ if (arg->nd_right) {
+ arg = getarg(arg, T_INTEGER|T_CARDINAL);
+ if (!arg) return 0;
+ }
+ break;
case S_HALT:
+ expp->nd_type = 0;
+ break;
case S_EXCL:
case S_INCL:
expp->nd_type = 0;
+ arg = getname(arg, D_VARIABLE|D_FIELD);
+ if (!arg) return 0;
+ tp = arg->nd_left->nd_type;
+ if (tp->tp_fund != T_SET) {
+node_error(arg, "EXCL and INCL expect a SET parameter");
+ return 0;
+ }
+ arg = getarg(arg, T_INTEGER|T_CARDINAL|T_CHAR|T_ENUMERATION);
+ if (!arg) return 0;
+ if (!TstCompat(tp->next, arg->nd_left->nd_type)) {
+ node_error(arg, "Unexpected type");
+ return 0;
+ }
break;
default:
assert(0);
}
+ if (arg->nd_right) {
+ node_error(arg->nd_right,
+ "Too many parameters supplied");
+ return 0;
+ }
+ FreeNode(expp->nd_left);
+ expp->nd_left = 0;
return 1;
}
return 1;
if (tp == error_type) {
df = ill_df;
}
- else if (tp->tp_fund != RECORD) {
+ else if (tp->tp_fund != T_RECORD) {
/* This is also true for modules */
node_error(expp,"Illegal selection");
df = ill_df;
}
int
-chk_name(expp, const)
+chk_name(expp)
register struct node *expp;
{
register struct def *df;
- int retval = 1;
(void) findname(expp);
assert(expp->nd_class == Def);
df = expp->nd_def;
- if (df->df_kind == D_ERROR) {
- retval = 0;
- }
+ if (df->df_kind == D_ERROR) return 0;
if (df->df_kind & (D_ENUM | D_CONST)) {
if (df->df_kind == D_ENUM) {
expp->nd_class = Value;
*expp = *(df->con_const);
}
}
- else if (const) {
- node_error(expp, "constant expected");
- retval = 0;
- }
- return retval;
+ return 1;
}
int
-chk_oper(expp, const)
+chk_oper(expp)
register struct node *expp;
{
- /* Check a binary operation. If "const" is set, also check
- that it is constant.
- The code is ugly !
+ /* Check a binary operation.
*/
register struct type *tpl = expp->nd_left->nd_type;
register struct type *tpr = expp->nd_right->nd_type;
if (expp->nd_symb == IN) {
/* Handle this one specially */
expp->nd_type = bool_type;
- if (tpr->tp_fund != SET) {
+ if (tpr->tp_fund != T_SET) {
node_error(expp, "RHS of IN operator not a SET type");
return 0;
}
if (expp->nd_symb == '[') {
/* Handle ARRAY selection specially too! */
- if (tpl->tp_fund != ARRAY) {
+ if (tpl->tp_fund != T_ARRAY) {
node_error(expp, "array index not belonging to an ARRAY");
return 0;
}
return 0;
}
expp->nd_type = tpl->arr_elem;
- if (const) return 0;
return 1;
}
- if (tpl->tp_fund == SUBRANGE) tpl = tpl->next;
+ if (tpl->tp_fund == T_SUBRANGE) tpl = tpl->next;
expp->nd_type = tpl;
if (!TstCompat(tpl, tpr)) {
case '-':
case '*':
switch(tpl->tp_fund) {
- case INTEGER:
- case INTORCARD:
- case CARDINAL:
- case LONGINT:
- case SET:
+ case T_INTEGER:
+ case T_CARDINAL:
+ case T_SET:
if (expp->nd_left->nd_class == Value &&
expp->nd_right->nd_class == Value) {
cstbin(expp);
}
return 1;
- case REAL:
- case LONGREAL:
- if (const) {
- errval = 2;
- break;
- }
+ case T_REAL:
return 1;
}
break;
case '/':
switch(tpl->tp_fund) {
- case SET:
+ case T_SET:
if (expp->nd_left->nd_class == Value &&
expp->nd_right->nd_class == Value) {
cstbin(expp);
}
return 1;
- case REAL:
- case LONGREAL:
- if (const) {
- errval = 2;
- break;
- }
+ case T_REAL:
return 1;
}
break;
case DIV:
case MOD:
switch(tpl->tp_fund) {
- case INTEGER:
- case INTORCARD:
- case CARDINAL:
- case LONGINT:
+ case T_INTEGER:
+ case T_CARDINAL:
if (expp->nd_left->nd_class == Value &&
expp->nd_right->nd_class == Value) {
cstbin(expp);
case '<':
case '>':
switch(tpl->tp_fund) {
- case SET:
+ case T_SET:
if (expp->nd_symb == '<' || expp->nd_symb == '>') {
break;
}
- case INTEGER:
- case INTORCARD:
- case LONGINT:
- case CARDINAL:
- case ENUMERATION: /* includes boolean */
- case CHAR:
+ if (expp->nd_left->nd_class == Set &&
+ expp->nd_right->nd_class == Set) {
+ cstbin(expp);
+ }
+ return 1;
+ case T_INTEGER:
+ case T_CARDINAL:
+ case T_ENUMERATION: /* includes boolean */
+ case T_CHAR:
if (expp->nd_left->nd_class == Value &&
expp->nd_right->nd_class == Value) {
cstbin(expp);
}
return 1;
- case POINTER:
+ case T_POINTER:
if (!(expp->nd_symb == '=' || expp->nd_symb == '#')) {
break;
}
/* Fall through */
- case REAL:
- case LONGREAL:
- if (const) {
- errval = 2;
- break;
- }
+ case T_REAL:
return 1;
}
default:
case 1:
node_error(expp,"Operator \"%s\": illegal operand type(s)", symbol2str(expp->nd_symb));
break;
- case 2:
- node_error(expp, "Expression not constant");
- break;
case 3:
node_error(expp, "BOOLEAN type(s) expected");
break;
+ default:
+ assert(0);
}
return 0;
}
int
-chk_uoper(expp, const)
+chk_uoper(expp)
register struct node *expp;
{
- /* Check an unary operation. If "const" is set, also check that
- it can be evaluated compile-time.
+ /* Check an unary operation.
*/
register struct type *tpr = expp->nd_right->nd_type;
- if (tpr->tp_fund == SUBRANGE) tpr = tpr->next;
+ if (tpr->tp_fund == T_SUBRANGE) tpr = tpr->next;
expp->nd_type = tpr;
switch(expp->nd_symb) {
case '+':
switch(tpr->tp_fund) {
- case INTEGER:
- case LONGINT:
- case REAL:
- case LONGREAL:
- case CARDINAL:
- case INTORCARD:
+ case T_INTEGER:
+ case T_REAL:
+ case T_CARDINAL:
expp->nd_token = expp->nd_right->nd_token;
FreeNode(expp->nd_right);
expp->nd_right = 0;
break;
case '-':
switch(tpr->tp_fund) {
- case INTEGER:
- case LONGINT:
- case INTORCARD:
+ case T_INTEGER:
if (expp->nd_right->nd_class == Value) {
cstunary(expp);
}
return 1;
- case REAL:
- case LONGREAL:
+ case T_REAL:
if (expp->nd_right->nd_class == Value) {
expp->nd_token = expp->nd_right->nd_token;
if (*(expp->nd_REL) == '-') {
}
break;
case '^':
- if (tpr->tp_fund != POINTER) break;
+ if (tpr->tp_fund != T_POINTER) break;
expp->nd_type = tpr->next;
- if (const) return 0;
return 1;
default:
assert(0);
int uns = expp->nd_type != int_type;
assert(expp->nd_class == Oper);
- if (expp->nd_right->nd_type->tp_fund == SET) {
+ if (expp->nd_right->nd_type->tp_fund == T_SET) {
cstset(expp);
return;
}
}
FormalParameters(type == D_PROCEDURE, ¶ms, &tp)?
{
- df->df_type = tp = construct_type(PROCEDURE, tp);
+ df->df_type = tp = construct_type(T_PROCEDURE, tp);
tp->prc_params = params;
if (tp1 && !TstTypeEquiv(tp, tp1)) {
error("inconsistent procedure declaration for \"%s\"", df->df_idf->id_text);
]?
qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
{ if (ARRAYflag) {
- *tp = construct_type(ARRAY, NULLTYPE);
+ *tp = construct_type(T_ARRAY, NULLTYPE);
(*tp)->arr_elem = df->df_type;
}
else *tp = df->df_type;
'=' type(&tp)
{ df->df_type = tp;
if ((df->df_flags&D_EXPORTED) &&
- tp->tp_fund == ENUMERATION) {
+ tp->tp_fund == T_ENUMERATION) {
exprt_literals(tp->enm_enums,
enclosing(CurrentScope));
}
if (df->df_kind == D_HTYPE &&
- tp->tp_fund != POINTER) {
+ tp->tp_fund != T_POINTER) {
error("Opaque type \"%s\" is not a pointer type", df->df_idf->id_text);
}
struct node *EnumList;
} :
'(' IdentList(&EnumList) ')'
- {
- *ptp = standard_type(ENUMERATION,int_align,int_size);
- EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
- FreeNode(EnumList);
- }
+ {
+ *ptp = standard_type(T_ENUMERATION,int_align,int_size);
+ EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
+ FreeNode(EnumList);
+ }
;
} :
ARRAY SimpleType(&tp)
{
- *ptp = tp2 = construct_type(ARRAY, tp);
+ *ptp = tp2 = construct_type(T_ARRAY, tp);
}
[
',' SimpleType(&tp)
{ tp2 = tp2->arr_elem =
- construct_type(ARRAY, tp);
+ construct_type(T_ARRAY, tp);
}
]* OF type(&tp)
{ tp2->arr_elem = tp; }
scope.next = CurrentScope;
}
FieldListSequence(&scope)
- {
- *ptp = standard_type(RECORD, record_align, (arith) 0 /* ???? */);
- (*ptp)->rec_scope = scope.sc_scope;
- }
+ {
+ *ptp = standard_type(T_RECORD, record_align, (arith) 0 /* ???? */);
+ (*ptp)->rec_scope = scope.sc_scope;
+ }
END
;
{ tp = NULLTYPE; }
]
{
- *ptp = construct_type(POINTER, tp);
+ *ptp = construct_type(T_POINTER, tp);
if (!tp) Forward(&dot, &((*ptp)->next));
}
;
struct type *tp = 0;
} :
PROCEDURE FormalTypeList(&pr, &tp)?
- { *ptp = construct_type(PROCVAR, tp);
+ { *ptp = construct_type(T_PROCEDURE, tp);
(*ptp)->prc_params = pr;
}
;
DO_DEBUG(2, debug("importing \"%s\", kind %d", ids->nd_IDF->id_text, df->df_kind));
define(ids->nd_IDF, CurrentScope, kind)->imp_def = df;
if (df->df_kind == D_TYPE &&
- df->df_type->tp_fund == ENUMERATION) {
+ df->df_type->tp_fund == T_ENUMERATION) {
/* Also import all enumeration literals */
exprt_literals(df->df_type->enm_enums,
CurrentScope);
{
struct node **nd;
} :
- expression(pnd) { nd = pnd; }
+ expression(pnd) { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);
+ (*pnd)->nd_symb = ',';
+ nd = &((*pnd)->nd_right);
+ }
[
- ',' { *nd = MkNode(Link, *nd, NULLNODE, &dot);
- nd = &(*nd)->nd_right;
+ ',' { *nd = MkNode(Link, NULLNODE, NULLNODE, &dot);
}
- expression(nd)
+ expression(&(*nd)->nd_left)
+ { nd = &((*pnd)->nd_right); }
]*
;
{ DO_DEBUG(3,
( debug("Constant expression:"),
PrNode(*pnd)));
- (void) chk_expr(*pnd, 1);
+ if (chk_expr(*pnd) &&
+ ((*pnd)->nd_class != Set && (*pnd)->nd_class != Value)) {
+ error("Constant expression expected");
+ }
DO_DEBUG(3, PrNode(*pnd));
}
;
(void) Enter("NIL", D_CONST, address_type, 0);
(void) Enter("PROC",
D_TYPE,
- construct_type(PROCEDURE, NULLTYPE),
+ construct_type(T_PROCEDURE, NULLTYPE),
0);
df = Enter("BITSET", D_TYPE, bitset_type, 0);
df = Enter("FALSE", D_ENUM, bool_type, 0);
open_scope(CLOSEDSCOPE, 0);
df->mod_scope = CurrentScope->sc_scope;
df->df_type =
- standard_type(RECORD, 0, (arith) 0);
+ standard_type(T_RECORD, 0, (arith) 0);
df->df_type->rec_scope = df->mod_scope;
}
priority? ';'
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 = standard_type(T_RECORD, 0, (arith) 0);
df->df_type->rec_scope = df->mod_scope;
DefinitionModule = 1;
DO_DEBUG(1, debug("Definition module \"%s\"", id->id_text));
struct tokenname tkinternal[] = { /* internal keywords */
{PROGRAM, ""},
- {SUBRANGE, ""},
- {ENUMERATION, ""},
- {ERRONEOUS, ""},
- {PROCVAR, ""},
- {INTORCARD, ""},
{0, "0"}
};
struct tokenname tkstandard[] = { /* standard identifiers */
- {CHAR, ""},
- {BOOLEAN, ""},
- {LONGINT, ""},
- {CARDINAL, ""},
- {LONGREAL, ""},
- {WORD, ""},
- {ADDRESS, ""},
{0, ""}
};
SUBRANGE
*/
int tp_fund; /* fundamental type or constructor */
+#define T_RECORD 0x0001
+#define T_ENUMERATION 0x0002
+#define T_INTEGER 0x0004
+#define T_CARDINAL 0x0008
+/* #define T_LONGINT 0x0010 */
+#define T_REAL 0x0020
+/* #define T_LONGREAL 0x0040 */
+#define T_POINTER 0x0080
+#define T_CHAR 0x0100
+#define T_WORD 0x0200
+#define T_SET 0x0400
+#define T_SUBRANGE 0x0800
+#define T_PROCEDURE 0x1000
+#define T_ARRAY 0x2000
+#define T_STRING 0x4000
int tp_align; /* alignment requirement of this type */
arith tp_size; /* size of this type */
-/* struct idf *tp_idf; /* name of this type */
union {
struct enume tp_enum;
struct subrange tp_subrange;
struct type *dtp = create_type(fund);
switch (fund) {
- case PROCEDURE:
- case POINTER:
+ case T_PROCEDURE:
+ case T_POINTER:
dtp->tp_align = ptr_align;
dtp->tp_size = ptr_size;
dtp->next = tp;
break;
- case SET:
+ case T_SET:
dtp->tp_align = wrd_align;
dtp->next = tp;
break;
- case ARRAY:
+ case T_ARRAY:
dtp->tp_align = tp->tp_align;
dtp->next = tp;
break;
- case SUBRANGE:
+ case T_SUBRANGE:
dtp->tp_align = tp->tp_align;
dtp->tp_size = tp->tp_size;
dtp->next = tp;
{
register struct type *tp;
- char_type = standard_type(CHAR, 1, (arith) 1);
+ char_type = standard_type(T_CHAR, 1, (arith) 1);
char_type->enm_ncst = 256;
- bool_type = standard_type(ENUMERATION, 1, (arith) 1);
+ bool_type = standard_type(T_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);
- real_type = standard_type(REAL, real_align, real_size);
- longreal_type = standard_type(LONGREAL, lreal_align, lreal_size);
- word_type = standard_type(WORD, wrd_align, wrd_size);
- intorcard_type = standard_type(INTORCARD, int_align, int_size);
- string_type = standard_type(STRING, 1, (arith) -1);
- address_type = construct_type(POINTER, word_type);
- tp = construct_type(SUBRANGE, int_type);
+ int_type = standard_type(T_INTEGER, int_align, int_size);
+ longint_type = standard_type(T_INTEGER, lint_align, lint_size);
+ card_type = standard_type(T_CARDINAL, int_align, int_size);
+ real_type = standard_type(T_REAL, real_align, real_size);
+ longreal_type = standard_type(T_REAL, lreal_align, lreal_size);
+ word_type = standard_type(T_WORD, wrd_align, wrd_size);
+ intorcard_type = standard_type(T_INTEGER, int_align, int_size);
+ string_type = standard_type(T_STRING, 1, (arith) -1);
+ address_type = construct_type(T_POINTER, word_type);
+ tp = construct_type(T_SUBRANGE, int_type);
tp->sub_lb = 0;
tp->sub_ub = wrd_size * 8 - 1;
bitset_type = set_type(tp);
- std_type = construct_type(PROCEDURE, NULLTYPE);
- error_type = standard_type(ERRONEOUS, 1, (arith) 1);
+ std_type = construct_type(T_PROCEDURE, NULLTYPE);
+ error_type = standard_type(T_CHAR, 1, (arith) 1);
}
int
switch(df->df_kind) {
case D_MODULE:
return df->df_value.df_module.mo_scope;
- case D_VARIABLE: {
- register struct type *tp = df->df_type;
-
- if (tp->tp_fund == RECORD) {
- return tp->rec_scope;
+ case D_VARIABLE:
+ if (df->df_type->tp_fund == T_RECORD) {
+ return df->df_type->rec_scope;
}
break;
- }
}
error("no selectors for \"%s\"", df->df_idf->id_text);
return 0;
chk_basesubrange(tp, base)
register struct type *tp, *base;
{
- if (base->tp_fund == SUBRANGE) {
+ if (base->tp_fund == T_SUBRANGE) {
/* Check that the bounds of "tp" fall within the range
of "base"
*/
}
base = base->next;
}
- if (base->tp_fund == ENUMERATION || base->tp_fund == CHAR) {
+ if (base->tp_fund == T_ENUMERATION || base->tp_fund == T_CHAR) {
if (tp->next != base) {
error("Specified base does not conform");
}
return error_type;
}
- if (tp->tp_fund == SUBRANGE) tp = tp->next;
+ if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
if (tp == intorcard_type) tp = card_type; /* lower bound > 0 */
/* Check base type
*/
if (tp != int_type && tp != card_type && tp != char_type &&
- tp->tp_fund != ENUMERATION) {
+ tp->tp_fund != T_ENUMERATION) {
/* BOOLEAN is also an ENUMERATION type
*/
node_error(ub, "Illegal base type for subrange");
/* Now construct resulting type
*/
- tp = construct_type(SUBRANGE, tp);
+ tp = construct_type(T_SUBRANGE, tp);
tp->sub_lb = lb->nd_INT;
tp->sub_ub = ub->nd_INT;
DO_DEBUG(2,debug("Creating subrange type %ld-%ld", (long)lb->nd_INT,(long)ub->nd_INT));
*/
int lb, ub;
- if (tp->tp_fund == SUBRANGE) {
+ if (tp->tp_fund == T_SUBRANGE) {
if ((lb = tp->sub_lb) < 0 || (ub = tp->sub_ub) > MAX_SET - 1) {
error("Set type limits exceeded");
return error_type;
}
}
- else if (tp->tp_fund == ENUMERATION || tp == char_type) {
+ else if (tp->tp_fund == T_ENUMERATION || tp == char_type) {
lb = 0;
if ((ub = tp->enm_ncst - 1) > MAX_SET - 1) {
error("Set type limits exceeded");
error("illegal base type for set");
return error_type;
}
- tp = construct_type(SET, tp);
+ tp = construct_type(T_SET, tp);
tp->tp_size = align(((ub - lb) + 7)/8, wrd_align);
return tp;
}
tp2 == error_type
||
(
- tp1 && tp1->tp_fund == PROCEDURE
+ tp1 && tp1->tp_fund == T_PROCEDURE
&&
- tp2 && tp2->tp_fund == PROCEDURE
+ tp2 && tp2->tp_fund == T_PROCEDURE
&&
TstProcEquiv(tp1, tp2)
);
Modula-2 Report for a definition of "compatible".
*/
if (TstTypeEquiv(tp1, tp2)) return 1;
- if (tp1->tp_fund == SUBRANGE) tp1 = tp1->next;
- if (tp2->tp_fund == SUBRANGE) tp2 = tp2->next;
+ if (tp1->tp_fund == T_SUBRANGE) tp1 = tp1->next;
+ if (tp2->tp_fund == T_SUBRANGE) tp2 = tp2->next;
return tp1 == tp2
||
( tp1 == intorcard_type
&&
( tp2 == card_type
|| tp2 == intorcard_type
- || tp2->tp_fund == POINTER
+ || tp2->tp_fund == T_POINTER
)
)
||
&&
( tp1 == card_type
|| tp1 == intorcard_type
- || tp1->tp_fund == POINTER
+ || tp1->tp_fund == T_POINTER
)
)
;
public / ack.git / commitdiff