LOBJ = tokenfile.o program.o declar.o expression.o statement.o
COBJ = LLlex.o LLmessage.o char.o error.o main.o \
symbol2str.o tokenname.o idf.o input.o type.o def.o \
- scope.o misc.o enter.o defmodule.o typequiv.o node.o
+ scope.o misc.o enter.o defmodule.o typequiv.o node.o \
+ cstoper.o
OBJ = $(COBJ) $(LOBJ) Lpars.o
GENFILES= tokenfile.c \
program.c declar.c expression.c statement.c \
input.o: f_info.h input.h
type.o: LLlex.h Lpars.h def.h def_sizes.h idf.h node.h type.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 scope.h type.h
+scope.o: LLlex.h debug.h def.h idf.h main.h scope.h type.h
misc.o: LLlex.h f_info.h idf.h misc.h
enter.o: LLlex.h def.h idf.h node.h scope.h type.h
defmodule.o: LLlex.h def.h f_info.h idf.h input.h scope.h
typequiv.o: Lpars.h def.h type.h
-node.o: LLlex.h def.h node.h type.h
+node.o: LLlex.h debug.h def.h main.h node.h type.h
+cstoper.o: Lpars.h def_sizes.h idf.h node.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
-expression.o: LLlex.h Lpars.h def.h idf.h node.h scope.h
-statement.o: Lpars.h
+expression.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h
+statement.o: LLlex.h Lpars.h node.h
Lpars.o: Lpars.h
--- /dev/null
+/* C O N S T A N T S F O R E X P R E S S I O N H A N D L I N G */
+
+/* $Header$ */
+
+extern long
+ mach_long_sign; /* sign bit of the machine long */
+extern int
+ 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 */
--- /dev/null
+/* C O N S T A N T E X P R E S S I O N H A N D L I N G */
+
+static char *RcsId = "$Header$";
+
+#include <em_arith.h>
+#include <em_label.h>
+#include <assert.h>
+#include "def_sizes.h"
+#include "idf.h"
+#include "type.h"
+#include "LLlex.h"
+#include "node.h"
+#include "Lpars.h"
+
+long mach_long_sign; /* sign bit of the machine long */
+int mach_long_size; /* size of long on this machine == sizeof(long) */
+long full_mask[MAXSIZE];/* full_mask[1] == 0XFF, full_mask[2] == 0XFFFF, .. */
+arith max_int; /* maximum integer on target machine */
+arith max_unsigned; /* maximum unsigned on target machine */
+arith max_longint; /* maximum longint on target machine */
+
+#if 0
+
+cstbin(expp, oper, expr)
+ struct expr **expp, *expr;
+{
+ /* The operation oper is performed on the constant
+ expressions *expp(ld) and expr(ct), and the result restored in
+ *expp.
+ */
+ arith o1 = (*expp)->VL_VALUE;
+ arith o2 = expr->VL_VALUE;
+ int uns = (*expp)->ex_type->tp_unsigned;
+
+ ASSERT(is_ld_cst(*expp) && is_cp_cst(expr));
+ switch (oper) {
+ case '*':
+ o1 *= o2;
+ break;
+ case '/':
+ if (o2 == 0) {
+ expr_error(expr, "division by 0");
+ break;
+ }
+ if (uns) {
+ /* this is more of a problem than you might
+ think on C compilers which do not have
+ unsigned long.
+ */
+ if (o2 & mach_long_sign) {/* o2 > max_long */
+ o1 = ! (o1 >= 0 || o1 < o2);
+ /* this is the unsigned test
+ o1 < o2 for o2 > max_long
+ */
+ }
+ else { /* o2 <= max_long */
+ long half, bit, hdiv, hrem, rem;
+
+ half = (o1 >> 1) & ~mach_long_sign;
+ bit = o1 & 01;
+ /* now o1 == 2 * half + bit
+ and half <= max_long
+ and bit <= max_long
+ */
+ hdiv = half / o2;
+ hrem = half % o2;
+ rem = 2 * hrem + bit;
+ o1 = 2 * hdiv + (rem < 0 || rem >= o2);
+ /* that is the unsigned compare
+ rem >= o2 for o2 <= max_long
+ */
+ }
+ }
+ else
+ o1 /= o2;
+ break;
+ case '%':
+ if (o2 == 0) {
+ expr_error(expr, "modulo by 0");
+ break;
+ }
+ if (uns) {
+ if (o2 & mach_long_sign) {/* o2 > max_long */
+ o1 = (o1 >= 0 || o1 < o2) ? o1 : o1 - o2;
+ /* this is the unsigned test
+ o1 < o2 for o2 > max_long
+ */
+ }
+ else { /* o2 <= max_long */
+ long half, bit, hrem, rem;
+
+ half = (o1 >> 1) & ~mach_long_sign;
+ bit = o1 & 01;
+ /* now o1 == 2 * half + bit
+ and half <= max_long
+ and bit <= max_long
+ */
+ hrem = half % o2;
+ rem = 2 * hrem + bit;
+ o1 = (rem < 0 || rem >= o2) ? rem - o2 : rem;
+ }
+ }
+ else
+ o1 %= o2;
+ break;
+ case '+':
+ o1 += o2;
+ break;
+ case '-':
+ o1 -= o2;
+ break;
+ case LEFT:
+ o1 <<= o2;
+ break;
+ case RIGHT:
+ if (o2 == 0)
+ break;
+ if (uns) {
+ o1 >>= 1;
+ o1 & = ~mach_long_sign;
+ o1 >>= (o2-1);
+ }
+ else
+ o1 >>= o2;
+ break;
+ case '<':
+ if (uns) {
+ o1 = (o1 & mach_long_sign ?
+ (o2 & mach_long_sign ? o1 < o2 : 0) :
+ (o2 & mach_long_sign ? 1 : o1 < o2)
+ );
+ }
+ else
+ o1 = o1 < o2;
+ break;
+ case '>':
+ if (uns) {
+ o1 = (o1 & mach_long_sign ?
+ (o2 & mach_long_sign ? o1 > o2 : 1) :
+ (o2 & mach_long_sign ? 0 : o1 > o2)
+ );
+ }
+ else
+ o1 = o1 > o2;
+ break;
+ case LESSEQ:
+ if (uns) {
+ o1 = (o1 & mach_long_sign ?
+ (o2 & mach_long_sign ? o1 <= o2 : 0) :
+ (o2 & mach_long_sign ? 1 : o1 <= o2)
+ );
+ }
+ else
+ o1 = o1 <= o2;
+ break;
+ case GREATEREQ:
+ if (uns) {
+ o1 = (o1 & mach_long_sign ?
+ (o2 & mach_long_sign ? o1 >= o2 : 1) :
+ (o2 & mach_long_sign ? 0 : o1 >= o2)
+ );
+ }
+ else
+ o1 = o1 >= o2;
+ break;
+ case EQUAL:
+ o1 = o1 == o2;
+ break;
+ case NOTEQUAL:
+ o1 = o1 != o2;
+ break;
+ case '&':
+ o1 &= o2;
+ break;
+ case '|':
+ o1 |= o2;
+ break;
+ case '^':
+ o1 ^= o2;
+ break;
+ }
+ (*expp)->VL_VALUE = o1;
+ cut_size(*expp);
+ (*expp)->ex_flags |= expr->ex_flags;
+ (*expp)->ex_flags &= ~EX_PARENS;
+}
+
+cut_size(expr)
+ struct expr *expr;
+{
+ /* The constant value of the expression expr is made to
+ conform to the size of the type of the expression.
+ */
+ arith o1 = expr->VL_VALUE;
+ int uns = expr->ex_type->tp_unsigned;
+ int size = (int) expr->ex_type->tp_size;
+
+ ASSERT(expr->ex_class == Value);
+ if (uns) {
+ if (o1 & ~full_mask[size])
+ expr_warning(expr,
+ "overflow in unsigned constant expression");
+ o1 &= full_mask[size];
+ }
+ else {
+ int nbits = (int) (mach_long_size - size) * 8;
+ long remainder = o1 & ~full_mask[size];
+
+ if (remainder != 0 && remainder != ~full_mask[size])
+ expr_warning(expr, "overflow in constant expression");
+ o1 <<= nbits; /* ??? */
+ o1 >>= nbits;
+ }
+ expr->VL_VALUE = o1;
+}
+
+# endif
+
+init_cst()
+{
+ int i = 0;
+ arith bt = (arith)0;
+
+ while (!(bt < 0)) {
+ bt = (bt << 8) + 0377, i++;
+ if (i == MAXSIZE)
+ fatal("array full_mask too small for this machine");
+ full_mask[i] = bt;
+ }
+ mach_long_size = i;
+ mach_long_sign = 1 << (mach_long_size * 8 - 1);
+ if (sizeof(long) < 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];
+}
register struct def *df;
register struct scope *sc;
- DO_DEBUG(debug(4,"Defining identifier %s in scope %d", id->id_text, scope->sc_scope));
+ DO_DEBUG(5, debug("Defining identifier \"%s\" in scope %d", id->id_text, scope->sc_scope));
df = lookup(id, scope->sc_scope);
if ( /* Already in this scope */
df
df1 = 0;
df = id->id_def;
- DO_DEBUG(debug(4,"Looking for identifier %s in scope %d", id->id_text, scope));
+ DO_DEBUG(5, debug("Looking for identifier \"%s\" in scope %d", id->id_text, scope));
while (df) {
if (df->df_scope == scope) {
if (df->df_kind == D_IMPORT) {
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
+#include <assert.h>
#include "idf.h"
#include "def.h"
#include "type.h"
char *name;
struct type *type;
{
+ /* Enter a definition for "name" with kind "kind" and type
+ "type" in the Current Scope. If it is a standard name, also
+ put its number in the definition structure.
+ */
struct idf *id;
struct def *df;
struct type *type;
struct scope *scope;
{
+ /* Put a list of identifiers in the symbol table.
+ They all have kind "kind", and type "type", and are put
+ in scope "scope". "flags" initializes the "df_flags" field
+ of the definition structure.
+ Also assign numbers to enumeration literals, and link
+ them together.
+ */
register struct def *df;
struct def *first = 0, *last = 0;
int assval = 0;
df->df_flags = flags;
if (kind == D_ENUM) {
if (!first) first = df;
- df->df_value.df_enum.en_val = assval++;
- if (last) last->df_value.df_enum.en_next = df;
+ df->enm_val = assval++;
+ if (last) last->enm_next = df;
last = df;
}
idlist = idlist->next;
}
if (last) {
- /* Also meaning : enumeration */
- last->df_value.df_enum.en_next = 0;
+ /* Also meaning : kind == D_ENUM */
+ assert(kind == D_ENUM);
+ last->enm_next = 0;
type->enm_enums = first;
type->enm_ncst = assval;
}
#ifdef DEBUG
/*VARARGS2*/
-debug(level, fmt, args)
+debug(fmt, args)
char *fmt;
{
- if (level <= options['D']) _error(VDEBUG, NULLNODE, fmt, &args);
+ _error(VDEBUG, NULLNODE, fmt, &args);
}
#endif DEBUG
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
+#include "main.h"
#include "LLlex.h"
#include "idf.h"
#include "def.h"
#include "scope.h"
#include "node.h"
+#include "const.h"
+#include "type.h"
+#include "debug.h"
}
-number(struct node **p;):
+number(struct node **p;)
+{
+ struct type *tp;
+} :
[
- INTEGER
+ INTEGER { tp = dot.TOK_INT <= max_int ?
+ intorcard_type : card_type;
+ }
|
- REAL
-] { *p = MkNode(Value, NULLNODE, NULLNODE, dot); }
+ REAL { tp = real_type; }
+] { *p = MkNode(Value, NULLNODE, NULLNODE, &dot);
+ (*p)->nd_type = tp;
+ }
;
qualident(int types; struct def **pdf; char *str; struct node **p;)
int module;
register struct def *df;
struct def *lookfor();
+ register struct node **pnd;
+ struct node *nd;
} :
IDENT { if (types) {
df = lookfor(dot.TOK_IDF, CurrentScope, 1);
*pdf = df;
if (df->df_kind == D_ERROR) types = 0;
}
- if (p) {
- *p = MkNode(Value, NULLNODE, NULLNODE,&dot);
- }
+ nd = MkNode(Value, NULLNODE, NULLNODE, &dot);
+ pnd = &nd;
}
[
{ if (types &&!(scope = has_selectors(df))) {
}
}
/* selector */
- '.' { if (p) *p = MkNode(Link, *p, NULLNODE, &dot); }
+ '.' { *pnd = MkNode(Link,*pnd,NULLNODE,&dot);
+ pnd = &(*pnd)->nd_right;
+ }
IDENT
- { if (p) {
- p = &((*p)->nd_right);
- *p = MkNode(Value, NULLNODE, NULLNODE,&dot);
- }
+ { *pnd = MkNode(Value,NULLNODE,NULLNODE,&dot);
if (types) {
module = (df->df_kind == D_MODULE);
df = lookup(dot.TOK_IDF, scope);
error("identifier \"%s\" is not a %s",
df->df_idf->id_text, str);
}
+ if (!p) FreeNode(nd);
+ else *p = nd;
}
;
* Changed rule in new Modula-2.
* Check that the expression is a constant expression and evaluate!
*/
+ { DO_DEBUG(3,
+ ( debug("Constant expression:"),
+ PrNode(*pnd)));
+ }
;
expression(struct node **pnd;)
{
- struct node *nd;
} :
- SimpleExpression(&nd)
+ SimpleExpression(pnd)
[
/* relation */
[ '=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' |
GREATEREQUAL | IN
]
- { nd = MkNode(Oper, nd, NULLNODE, &dot); }
- SimpleExpression(&(nd->nd_right))
+ { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+ SimpleExpression(&((*pnd)->nd_right))
]?
- { *pnd = nd; }
;
/* Inline in expression
SimpleExpression(struct node **pnd;)
{
- register struct node *nd;
} :
- [ '+' | '-' ]?
- term(pnd) { nd = *pnd; }
+ [
+ [ '+' | '-' ]
+ { *pnd = MkNode(Uoper, NULLNODE, NULLNODE, &dot);
+ pnd = &((*pnd)->nd_right);
+ }
+ ]?
+ term(pnd)
[
/* AddOperator */
[ '+' | '-' | OR ]
- { *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); }
- term(&(nd->nd_right))
+ { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+ term(&((*pnd)->nd_right))
]*
;
term(struct node **pnd;)
{
- register struct node *nd;
}:
- factor(pnd) { nd = *pnd; }
+ factor(pnd)
[
/* MulOperator */
[ '*' | '/' | DIV | MOD | AND | '&' ]
- { *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); }
- factor(&(nd->nd_right))
+ { *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+ factor(&((*pnd)->nd_right))
]*
;
factor(struct node **p;)
{
struct def *df;
+ struct node *nd;
} :
qualident(0, &df, (char *) 0, p)
[
designator_tail(p)?
[
- { *p = MkNode(Call, p, NULLNODE, &dot); }
+ { *p = MkNode(Call, *p, NULLNODE, &dot); }
ActualParameters(&((*p)->nd_right))
]?
- | { *p = MkNode(Call, p, NULLNODE, &dot); }
- bare_set(&((*p)->nd_right))
+ |
+ bare_set(&nd)
+ { nd->nd_left = *p;
+ *p = nd;
+ }
]
|
bare_set(p)
| %default
number(p)
|
- STRING { *p = MkNode(Value, NULLNODE, NULLNODE, &dot); }
+ STRING { *p = MkNode(Value, NULLNODE, NULLNODE, &dot);
+ (*p)->nd_type = string_type;
+ }
|
'(' expression(p) ')'
|
bare_set(struct node **pnd;)
{
- struct node **nd;
+ register struct node *nd;
} :
'{' {
dot.tk_symb = SET;
- *pnd = MkNode(Link, NULLNODE, NULLNODE, &dot);
- nd = &((*pnd)->nd_left);
+ *pnd = nd = MkNode(Link, NULLNODE, NULLNODE, &dot);
+ nd->nd_type = bitset_type;
}
[
element(nd)
- [
- ',' { *nd = MkNode(Link, *nd, NULLNODE, &dot);
- nd = &((*nd)->nd_right);
- }
- element(nd)
+ [ { nd = nd->nd_right; }
+ ',' element(nd)
]*
]?
'}'
'(' ExpList(pnd)? ')'
;
-element(struct node **pnd;):
- expression(pnd)
+element(struct node *nd;)
+{
+ struct node *nd1;
+} :
+ expression(&nd1)
[
- UPTO { *pnd = MkNode(Link, *pnd, NULLNODE, &dot);}
- expression(&((*pnd)->nd_right))
+ UPTO
+ { nd1 = MkNode(Link, nd1, NULLNODE, &dot);}
+ expression(&(nd1->nd_right))
]?
+ { nd->nd_right = MkNode(Link, nd1, NULLNODE, &dot);
+ nd->nd_right->nd_symb = ',';
+ }
;
designator(struct node **pnd;)
#ifdef DEBUG
print("Mod2 compiler -- Debug version\n");
#endif DEBUG
- DO_DEBUG(debug(1,"Debugging level: %d", options['D']));
+ DO_DEBUG(1, debug("Debugging level: %d", options['D']));
return !Compile(Nargv[1]);
}
{
extern struct tokenname tkidf[];
- DO_DEBUG(debug(1,"Filename : %s", src));
+ DO_DEBUG(1, debug("Filename : %s", src));
if (! InsertFile(src, (char **) 0, &src)) {
fprint(STDERR,"%s: cannot open %s\n", ProgName, src);
return 0;
FileName = src;
init_DEFPATH();
init_idf();
+ init_cst();
reserve(tkidf);
init_scope();
init_types();
add_standards();
#ifdef DEBUG
- if (options['L'])
- LexScan();
- else if (options['T'])
- TimeScan();
+ if (options['L']) LexScan();
else {
#endif DEBUG
(void) open_scope(CLOSEDSCOPE, 0);
{
register int symb;
- while ((symb = LLlex()) != EOI) {
+ while ((symb = LLlex()) > 0) {
print(">>> %s ", symbol2str(symb));
switch(symb) {
break;
default:
- putchar('\n');
+ print("\n");
}
}
}
-
-TimeScan() {
- while (LLlex() != -1) /* nothing */;
-}
#endif
Option(str)
D_TYPE,
construct_type(PROCEDURE, NULLTYPE),
0);
- tp = construct_type(SUBRANGE, int_type);
- tp->sub_lb = 0;
- tp->sub_ub = wrd_size * 8 - 1;
- df = Enter("BITSET", D_TYPE, construct_type(SET, tp), 0);
- df->df_type->tp_size = wrd_size;
+ df = Enter("BITSET", D_TYPE, bitset_type, 0);
df = Enter("FALSE", D_ENUM, bool_type, 0);
df->df_value.df_enum.en_val = 0;
df->df_value.df_enum.en_next = Enter("TRUE", D_ENUM, bool_type, 0);
#include <em_label.h>
#include <em_arith.h>
#include <alloc.h>
+#include <system.h>
+#include "main.h"
#include "def.h"
#include "type.h"
#include "LLlex.h"
#include "node.h"
+#include "debug.h"
struct node *h_node; /* header of free list */
nd->nd_token = *token;
nd->nd_class = class;
nd->nd_type = NULLTYPE;
+ DO_DEBUG(4,(debug("Create node:"), PrNode(nd)));
return nd;
}
if (nd->nd_right) FreeNode(nd->nd_right);
free_node(nd);
}
+
+#ifdef DEBUG
+
+extern char *symbol2str();
+
+static
+printnode(nd)
+ register struct node *nd;
+{
+ fprint(STDERR, "(");
+ if (nd) {
+ printnode(nd->nd_left);
+ fprint(STDERR, " %s ", symbol2str(nd->nd_symb));
+ printnode(nd->nd_right);
+ }
+ fprint(STDERR, ")");
+}
+
+PrNode(nd)
+ struct node *nd;
+{
+ printnode(nd);
+ fprint(STDERR, "\n");
+}
+#endif DEBUG
if (!SYSTEMModule) open_scope(CLOSEDSCOPE, 0);
df->mod_scope = CurrentScope->sc_scope;
DefinitionModule = 1;
- DO_DEBUG(debug(1, "Definition module \"%s\"", id->id_text));
+ DO_DEBUG(1, debug("Definition module \"%s\"", id->id_text));
}
';'
import(0)*
#include "scope.h"
#include "type.h"
#include "def.h"
+#include "main.h"
#include "debug.h"
static int maxscope; /* maximum assigned scope number */
sc->sc_scope = scope == 0 ? ++maxscope : scope;
sc->sc_forw = 0; sc->sc_def = 0;
assert(scopetype == OPENSCOPE || scopetype == CLOSEDSCOPE);
- DO_DEBUG(debug(1, "Opening a %s scope",
+ DO_DEBUG(1, debug("Opening a %s scope",
scopetype == OPENSCOPE ? "open" : "closed"));
sc1 = CurrentScope;
if (scopetype == CLOSEDSCOPE) {
register struct scope *sc = CurrentScope;
assert(sc != 0);
- DO_DEBUG(debug(1, "Closing a scope"));
+ DO_DEBUG(1, debug("Closing a scope"));
if (sc->sc_forw) rem_forwards(sc->sc_forw);
if (sc->next && (sc->next->sc_scope == 0)) {
struct scope *sc1 = sc;
{ENUMERATION, ""},
{ERRONEOUS, ""},
{PROCVAR, ""},
+ {INTORCARD, ""},
{0, "0"}
};
*longreal_type,
*word_type,
*address_type,
- *error_type;
+ *intorcard_type,
+ *string_type,
+ *bitset_type,
+ *error_type; /* All from type.c */
extern int
wrd_align,
real_align,
lreal_align,
ptr_align,
- record_align;
+ record_align; /* All from type.c */
extern arith
wrd_size,
lint_size,
real_size,
lreal_size,
- ptr_size;
+ ptr_size; /* All from type.c */
extern arith
- align();
+ align(); /* type.c */
struct type
*create_type(),
*construct_type(),
- *standard_type();
+ *standard_type(); /* All from type.c */
#define NULLTYPE ((struct type *) 0)
*longreal_type,
*word_type,
*address_type,
+ *intorcard_type,
+ *string_type,
+ *bitset_type,
*error_type;
struct paramlist *h_paramlist;
init_types()
{
+ register struct type *tp;
+
char_type = standard_type(CHAR, 1, (arith) 1);
bool_type = standard_type(BOOLEAN, 1, (arith) 1);
int_type = standard_type(INTEGER, 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);
+ tp->sub_lb = 0;
+ tp->sub_ub = wrd_size * 8 - 1;
+ bitset_type = construct_type(SET, tp);
+ bitset_type->tp_size = wrd_size;
error_type = standard_type(ERRONEOUS, 1, (arith) 1);
-
}
int
if (p1 != p2) return 0;
return 1;
}
+
+int
+TstCompat(tp1, tp2)
+ register struct type *tp1, *tp2;
+{
+ /* test if two types are compatible. See section 6.3 of the
+ 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;
+ return tp1 == tp2
+ ||
+ ( tp1 == address_type
+ &&
+ ( tp2 == card_type
+ || tp2 == intorcard_type
+ || tp2->tp_fund == POINTER
+ )
+ )
+ ||
+ ( tp2 == address_type
+ &&
+ ( tp1 == card_type
+ || tp1 == intorcard_type
+ || tp1->tp_fund == POINTER
+ )
+ );
+}
public / ack.git / commitdiff