return chk_call(expp, const);
case Link:
return chk_name(expp, const);
+ default:
+ assert(0);
}
/*NOTREACHED*/
}
chk_set(expp, const)
register struct node *expp;
{
- /* ??? */
+ struct type *tp;
+ struct def *df;
+ register struct node *nd;
+ extern struct def *findname();
+
+ assert(expp->nd_symb == SET);
+
+ /* First determine the type of the set
+ */
+ if (expp->nd_left) {
+ /* A type was given. Check it out
+ */
+ df = findname(expp->nd_left);
+ if ((df->df_kind != D_TYPE && df->df_kind != D_ERROR) ||
+ (df->df_type->tp_fund != SET)) {
+ node_error(expp, "Illegal set type");
+ return 0;
+ }
+ tp = df->df_type;
+ }
+ else tp = bitset_type;
+
+ /* Now check the elements given
+ */
+ 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;
+ nd = nd->nd_right;
+ }
+ return 1;
+}
+
+int
+chk_el(expp, const, tp, level)
+ struct node *expp;
+ struct type *tp;
+{
+ /* Check elements of a set. This routine may call itself
+ recursively, but only once.
+ */
+ 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)) {
+ return 0;
+ }
+ if (expp->nd_left->nd_class == Value &&
+ expp->nd_right->nd_class == Value) {
+ if (expp->nd_left->nd_INT > expp->nd_right->nd_INT) {
+node_error(expp, "Lower bound exceeds upper bound in range");
+ return 0;
+ }
+ }
+ return 1;
+ }
+ if (!chk_expr(expp, const)) return 0;
+ if (!TstCompat(tp, expp->nd_type)) {
+ node_error(expp, "Set element has incompatible type");
+ return 0;
+ }
+ if (expp->nd_class == Value) {
+ if ((tp->tp_fund != ENUMERATION &&
+ (expp->nd_INT < tp->sub_lb || expp->nd_INT > tp->sub_ub))
+ ||
+ (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 1;
}
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_longint; /* maximum longint on target machine */
+ max_unsigned; /* maximum unsigned on target machine */
}
mach_long_size = i;
mach_long_sign = 1 << (mach_long_size * 8 - 1);
- if (sizeof(long) < mach_long_size)
+ if (int_size > mach_long_size) {
fatal("sizeof (long) insufficient on this machine");
+ }
max_int = full_mask[int_size] & ~(1 << (int_size * 8 - 1));
- max_longint = full_mask[lint_size] & ~(1 << (lint_size * 8 - 1));
max_unsigned = full_mask[int_size];
}
SubrangeType(struct type **ptp;)
{
- struct type *tp;
- struct node *nd1 = 0, *nd2 = 0;
+ struct node *nd1, *nd2;
+ extern struct type *subr_type();
}:
/*
This is not exactly the rule in the new report, but see
'[' ConstExpression(&nd1)
UPTO ConstExpression(&nd2)
']'
- /*
- Evaluate the expressions. Check that they are indeed constant.
- ???
- Leave the basetype of the subrange in tp;
- */
- {
- /* For the time being: */
- tp = int_type;
- tp = construct_type(SUBRANGE, tp);
- *ptp = tp;
- }
+ { *ptp = subr_type(nd1, nd2); }
;
ArrayType(struct type **ptp;)
SetType(struct type **ptp;)
{
struct type *tp;
+ struct type *set_type();
} :
SET OF SimpleType(&tp)
- {
- *ptp = construct_type(SET, tp);
+ {
+ *ptp = set_type(tp);
}
;
*/
extern char *DEFPATH[];
char buf[256];
+ char *strcpy(), *strcat();
(void) strcpy(buf, name);
if (strlen(buf) > 10) {
( debug("Constant expression:"),
PrNode(*pnd)));
(void) chk_expr(*pnd, 1);
+ DO_DEBUG(3, PrNode(*pnd));
}
;
#include "idf.h"
#include "LLlex.h"
#include "node.h"
+#include "const.h"
+#include "debug.h"
/* To be created dynamically in main() from defaults or from command
line parameters.
register struct type *tp;
char_type = standard_type(CHAR, 1, (arith) 1);
+ char_type->enm_ncst = 256;
bool_type = standard_type(BOOLEAN, 1, (arith) 1);
int_type = standard_type(INTEGER, int_align, int_size);
longint_type = standard_type(LONGINT, lint_align, lint_size);
else if (base != card_type && base != int_type) {
error("Illegal base for a subrange");
}
+ else if (base == int_type && tp->next == card_type &&
+ (tp->sub_ub > max_int || tp->sub_ub)) {
+ error("Upperbound to large for type INTEGER");
+ }
else if (base != tp->next && base != int_type) {
error("Specified base does not conform");
}
tp->next = base;
}
+
+struct type *
+subr_type(lb, ub)
+ struct node *lb, *ub;
+{
+ /* Construct a subrange type from the constant expressions
+ indicated by "lb" and "ub", but first perform some
+ checks
+ */
+ register struct type *tp = lb->nd_type;
+
+ if (!TstCompat(lb->nd_type, ub->nd_type)) {
+ node_error(ub, "Types of subrange bounds not compatible");
+ return error_type;
+ }
+
+ if (tp->tp_fund == 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) {
+ /* BOOLEAN is also an ENUMERATION type
+ */
+ node_error(ub, "Illegal base type for subrange");
+ return error_type;
+ }
+
+ /* Check bounds
+ */
+ if (lb->nd_INT > ub->nd_INT) {
+ node_error(ub, "Lower bound exceeds upper bound");
+ }
+
+ /* Now construct resulting type
+ */
+ tp = construct_type(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));
+ return tp;
+}
+#define MAX_SET 1024 /* ??? Maximum number of elements in a set */
+
+struct type *
+set_type(tp)
+ struct type *tp;
+{
+ /* Construct a set type with base type "tp", but first
+ perform some checks
+ */
+ int lb, ub;
+
+ if (tp->tp_fund == 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) {
+ lb = 0;
+ if ((ub = tp->enm_ncst - 1) > MAX_SET - 1) {
+ error("Set type limits exceeded");
+ return error_type;
+ }
+ }
+ else {
+ error("illegal base type for set");
+ return error_type;
+ }
+ tp = construct_type(SET, tp);
+ tp->tp_size = align(((ub - lb) + 7)/8, wrd_align);
+ return tp;
+}
*/
return tp1 == tp2
+ ||
+ tp1 == error_type
+ ||
+ tp2 == error_type
||
(
tp1 && tp1->tp_fund == PROCEDURE
Modula-2 Report for a definition of "compatible".
*/
if (TstTypeEquiv(tp1, tp2)) return 1;
- if (tp2->tp_fund == SUBRANGE) tp1 = tp1->next;
- if (tp2->tp_fund == SUBRANGE) tp1 = tp1->next;
+ if (tp1->tp_fund == SUBRANGE) tp1 = tp1->next;
+ if (tp2->tp_fund == SUBRANGE) tp2 = tp2->next;
return tp1 == tp2
+ ||
+ ( tp1 == intorcard_type
+ &&
+ (tp2 == int_type || tp2 == card_type)
+ )
+ ||
+ ( tp2 == intorcard_type
+ &&
+ (tp1 == int_type || tp1 == card_type)
+ )
||
( tp1 == address_type
&&
public / ack.git / commitdiff