BSD 4_3_Net_2 release
[unix-history] / usr / src / usr.bin / pascal / pdx / sym / predicates.c
index 9fa08f7..4ebddd0 100644 (file)
@@ -1,6 +1,39 @@
-/* Copyright (c) 1982 Regents of the University of California */
+/*-
+ * Copyright (c) 1980 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *     This product includes software developed by the University of
+ *     California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
 
 
-static char sccsid[] = "@(#)predicates.c 1.1 %G%";
+#ifndef lint
+static char sccsid[] = "@(#)predicates.c       5.2 (Berkeley) 4/16/91";
+#endif /* not lint */
 
 /*
  * The basic tests on a symbol.
 
 /*
  * The basic tests on a symbol.
@@ -9,6 +42,7 @@ static char sccsid[] = "@(#)predicates.c 1.1 %G%";
 #include "defs.h"
 #include "sym.h"
 #include "symtab.h"
 #include "defs.h"
 #include "sym.h"
 #include "symtab.h"
+#include "btypes.h"
 #include "classes.h"
 #include "sym.rep"
 
 #include "classes.h"
 #include "sym.rep"
 
@@ -20,14 +54,14 @@ static char sccsid[] = "@(#)predicates.c 1.1 %G%";
 BOOLEAN isparam(s)
 SYM *s;
 {
 BOOLEAN isparam(s)
 SYM *s;
 {
-       register SYM *t;
+    register SYM *t;
 
 
-       for (t = s->func; t != NIL; t = t->chain) {
-               if (t == s) {
-                       return(TRUE);
-               }
+    for (t = s->func; t != NIL; t = t->chain) {
+       if (t == s) {
+           return(TRUE);
        }
        }
-       return(FALSE);
+    }
+    return(FALSE);
 }
 
 /*
 }
 
 /*
@@ -37,7 +71,18 @@ SYM *s;
 BOOLEAN isvarparam(s)
 SYM *s;
 {
 BOOLEAN isvarparam(s)
 SYM *s;
 {
-       return (BOOLEAN) s->class == REF;
+    return (BOOLEAN) s->class == REF;
+}
+
+/*
+ * Test if a symbol is a variable (actually any addressible quantity
+ * with do).
+ */
+
+BOOLEAN isvariable(s)
+SYM *s;
+{
+    return s->class == VAR || s->class == FVAR || s->class == REF;
 }
 
 /*
 }
 
 /*
@@ -48,7 +93,7 @@ SYM *s;
 BOOLEAN isblock(s)
 register SYM *s;
 {
 BOOLEAN isblock(s)
 register SYM *s;
 {
-       return(s->class == FUNC || s->class == PROC || s->class == PROG);
+    return(s->class == FUNC || s->class == PROC || s->class == PROG);
 }
 
 /*
 }
 
 /*
@@ -59,7 +104,7 @@ register SYM *s;
 BOOLEAN isbuiltin(s)
 SYM *s;
 {
 BOOLEAN isbuiltin(s)
 SYM *s;
 {
-       return(s->blkno == 0 && s->class != PROG && s->class != VAR);
+    return(s->blkno == 0 && s->class != PROG && s->class != VAR);
 }
 
 /*
 }
 
 /*
@@ -72,31 +117,43 @@ SYM *s;
 BOOLEAN compatible(t1, t2)
 register SYM *t1, *t2;
 {
 BOOLEAN compatible(t1, t2)
 register SYM *t1, *t2;
 {
-       if (t1 == t2) {
-               return(TRUE);
-       }
+    register BOOLEAN b;
+
+    if (isvariable(t1)) {
+       t1 = t1->type;
+    }
+    if (isvariable(t2)) {
+       t2 = t2->type;
+    }
+    if (t1 == t2) {
+       b = TRUE;
+    } else {
        t1 = rtype(t1);
        t2 = rtype(t2);
        if (t1->type == t2->type) {
        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;
+           if (t1->class == RANGE && t2->class == RANGE) {
+               b = TRUE;
+           } else if ((t1->class == SCAL || t1->class == CONST) &&
+             (t2->class == SCAL || t2->class == CONST)) {
+               b = TRUE;
+           } else if (t1->type == t_char &&
+             t1->class == ARRAY && t2->class == ARRAY) {
+               b = TRUE;
+           } else {
+               b = FALSE;
+           }
+    /*
+     * A kludge here for "nil".  Should be handled better.
+     * Opens a pandora's box for integer/pointer compatibility.
+     */
+       } else if ((t1->class == RANGE && t2->class == PTR) ||
+         (t2->class == RANGE && t1->class == PTR)) {
+           b = TRUE;
+       } else {
+           b = FALSE;
        }
        }
-       return(FALSE);
+    }
+    return b;
 }
 
 /*
 }
 
 /*
@@ -109,20 +166,20 @@ BOOLEAN should_print(s, f)
 SYM *s;
 SYM *f;
 {
 SYM *s;
 SYM *f;
 {
-       SYM *t;
+    SYM *t;
 
 
-       if (s->func != f || (s->class != VAR && s->class != FVAR)) {
-               return(FALSE);
-       } else if (s->chain != NIL) {
-               return(FALSE);
+    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 || t->class == SET) {
+           return(FALSE);
        } else {
        } else {
-               t = rtype(s->type);
-               if (t == NIL || t->class == FILET) {
-                       return(FALSE);
-               } else {
-                       return(TRUE);
-               }
+           return(TRUE);
        }
        }
+    }
 }
 
 /*
 }
 
 /*
@@ -132,14 +189,14 @@ SYM *f;
 BOOLEAN isambiguous(s)
 SYM *s;
 {
 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;
+    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;
 }
 }