date and time created 82/01/18 19:21:16 by linton

SCCS-vsn: usr.bin/pascal/pdx/sym/predicates.c 1.1

diff --git a/usr/src/usr.bin/pascal/pdx/sym/predicates.c b/usr/src/usr.bin/pascal/pdx/sym/predicates.c
new file mode 100644 (file)
index 0000000..9fa08f7
--- /dev/null
+++ b/usr/src/usr.bin/pascal/pdx/sym/predicates.c
@@ -0,0 +1,145 @@
+/* Copyright (c) 1982 Regents of the University of California */
+
+static char sccsid[] = "@(#)predicates.c 1.1 %G%";
+
+/*
+ * The basic tests on a symbol.
+ */
+
+#include "defs.h"
+#include "sym.h"
+#include "symtab.h"
+#include "classes.h"
+#include "sym.rep"
+
+/*
+ * Test if a symbol is a parameter.  This is true if there
+ * is a cycle from s->func to s via chain pointers.
+ */
+
+BOOLEAN isparam(s)
+SYM *s;
+{
+       register SYM *t;
+
+       for (t = s->func; t != NIL; t = t->chain) {
+               if (t == s) {
+                       return(TRUE);
+               }
+       }
+       return(FALSE);
+}
+
+/*
+ * Test if a symbol is a var parameter, i.e. has class REF.
+ */
+
+BOOLEAN isvarparam(s)
+SYM *s;
+{
+       return (BOOLEAN) s->class == REF;
+}
+
+/*
+ * Test if a symbol is a block, e.g. function, procedure, or the
+ * main program.
+ */
+
+BOOLEAN isblock(s)
+register SYM *s;
+{
+       return(s->class == FUNC || s->class == PROC || s->class == PROG);
+}
+
+/*
+ * Test if a symbol is builtin, that is, a predefined type or
+ * reserved word.
+ */
+
+BOOLEAN isbuiltin(s)
+SYM *s;
+{
+       return(s->blkno == 0 && s->class != PROG && s->class != VAR);
+}
+
+/*
+ * Compatible tests if two types are compatible.  The issue
+ * is complicated a bit by ranges.
+ *
+ * Integers and reals are not compatible since they cannot always be mixed.
+ */
+
+BOOLEAN compatible(t1, t2)
+register SYM *t1, *t2;
+{
+       if (t1 == t2) {
+               return(TRUE);
+       }
+       t1 = rtype(t1);
+       t2 = rtype(t2);
+       if (t1->type == t2->type) {
+               if (t1->class == RANGE && t2->class == RANGE) {
+                       return TRUE;
+               }
+               if ((t1->class == SCAL || t1->class == CONST) &&
+                 (t2->class == SCAL || t2->class == CONST)) {
+                       return TRUE;
+               }
+       }
+/*
+ * A kludge here for "nil".  Should be handled better.
+ * Opens a pandora's box for integer/pointer compatibility.
+ */
+       if (t1->class == RANGE && t2->class == PTR) {
+               return TRUE;
+       }
+       if (t2->class == RANGE && t1->class == PTR) {
+               return TRUE;
+       }
+       return(FALSE);
+}
+
+/*
+ * Predicate to test if a symbol should be printed.  We don't print
+ * files, for example, simply because there's no good way to do it.
+ * The symbol must be within the given function.
+ */
+
+BOOLEAN should_print(s, f)
+SYM *s;
+SYM *f;
+{
+       SYM *t;
+
+       if (s->func != f || (s->class != VAR && s->class != FVAR)) {
+               return(FALSE);
+       } else if (s->chain != NIL) {
+               return(FALSE);
+       } else {
+               t = rtype(s->type);
+               if (t == NIL || t->class == FILET) {
+                       return(FALSE);
+               } else {
+                       return(TRUE);
+               }
+       }
+}
+
+/*
+ * Test if the name of a symbol is uniquely defined or not.
+ */
+
+BOOLEAN isambiguous(s)
+SYM *s;
+{
+       SYM *t;
+
+       t = st_lookup(symtab, s->symbol);
+       if (t == NIL) {
+               panic("symbol name vanished");
+       }
+       while (t != NIL && (s == t || !streq(t->symbol, s->symbol))) {
+               t = t->next_sym;
+       }
+       return t != NIL;
+}