BSD 4_1_snap release
[unix-history] / usr / src / cmd / pi / type.c
index ae7ca59..f85dc47 100644 (file)
@@ -1,15 +1,11 @@
 /* Copyright (c) 1979 Regents of the University of California */
 /* Copyright (c) 1979 Regents of the University of California */
-#
-/*
- * pi - Pascal interpreter code translator
- *
- * Charles Haley, Bill Joy UCB
- * Version 1.2 November 1978
- */
 
 
-#include "whoami"
+static char sccsid[] = "@(#)type.c 1.6 3/8/81";
+
+#include "whoami.h"
 #include "0.h"
 #include "tree.h"
 #include "0.h"
 #include "tree.h"
+#include "objfmt.h"
 
 /*
  * Type declaration part
 
 /*
  * Type declaration part
 typebeg()
 {
 
 typebeg()
 {
 
+/*
+ * this allows for multiple
+ * declaration parts unless
+ * standard option has been
+ * specified.
+ * If routine segment is being
+ * compiled, do level one processing.
+ */
+
 #ifndef PI1
 #ifndef PI1
-       if (parts & VPRT)
-               error("Type declarations must precede var declarations");
-       if (parts & TPRT)
-               error("All types must be declared in one type part");
-       parts |= TPRT;
+       if (!progseen)
+               level1();
+       if ( parts[ cbn ] & ( VPRT | RPRT ) ) {
+           if ( opt( 's' ) ) {
+               standard();
+           } else {
+               warning();
+           }
+           error("Type declarations should precede var and routine declarations");
+       }
+       if (parts[ cbn ] & TPRT) {
+           if ( opt( 's' ) ) {
+               standard();
+           } else {
+               warning();
+           }
+           error("All types should be declared in one type part");
+       }
+       parts[ cbn ] |= TPRT;
 #endif
        /*
         * Forechain is the head of a list of types that
 #endif
        /*
         * Forechain is the head of a list of types that
@@ -44,14 +63,19 @@ type(tline, tid, tdecl)
 
        np = gtype(tdecl);
        line = tline;
 
        np = gtype(tdecl);
        line = tline;
-       if (np != NIL && (tdecl[0] == T_ID || tdecl[0] == T_TYID))
-               np = nlcopy(np);
 #ifndef PI0
        enter(defnl(tid, TYPE, np, 0))->nl_flags |= NMOD;
 #else
        enter(defnl(tid, TYPE, np, 0));
        send(REVTYPE, tline, tid, tdecl);
 #endif
 #ifndef PI0
        enter(defnl(tid, TYPE, np, 0))->nl_flags |= NMOD;
 #else
        enter(defnl(tid, TYPE, np, 0));
        send(REVTYPE, tline, tid, tdecl);
 #endif
+
+#ifdef PC
+       if (cbn == 1) {
+           stabgtype( tid , line );
+       }
+#endif PC
+
 #      ifdef PTREE
            {
                pPointer Type = TypeDecl( tid , tdecl );
 #      ifdef PTREE
            {
                pPointer Type = TypeDecl( tid , tdecl );
@@ -85,7 +109,8 @@ gtype(r)
 {
        register struct nl *np;
        register char *cp;
 {
        register struct nl *np;
        register char *cp;
-       int oline;
+       register int oline;
+       long w;
 
        if (r == NIL)
                return (NIL);
 
        if (r == NIL)
                return (NIL);
@@ -175,6 +200,14 @@ gtype(r)
                        break;
        }
        line = oline;
                        break;
        }
        line = oline;
+       w = lwidth(np);
+#ifndef PC
+       if (w >= TOOMUCH) {
+               error("Storage requirement of %s exceeds the implementation limit of %D by %D bytes",
+                       nameof(np), (long)(TOOMUCH-1), (long)(w-TOOMUCH+1));
+               np = NIL;
+       }
+#endif
        return (np);
 }
 
        return (np);
 }
 
@@ -184,7 +217,7 @@ gtype(r)
 tyscal(r)
        int *r;
 {
 tyscal(r)
        int *r;
 {
-       register struct nl *np, *op;
+       register struct nl *np, *op, *zp;
        register *v;
        int i;
 
        register *v;
        int i;
 
@@ -194,12 +227,15 @@ tyscal(r)
        if (v == NIL)
                return (NIL);
        i = -1;
        if (v == NIL)
                return (NIL);
        i = -1;
+       zp = np;
        for (; v != NIL; v = v[2]) {
                op = enter(defnl(v[1], CONST, np, ++i));
 #ifndef PI0
                op->nl_flags |= NMOD;
 #endif
                op->value[1] = i;
        for (; v != NIL; v = v[2]) {
                op = enter(defnl(v[1], CONST, np, ++i));
 #ifndef PI0
                op->nl_flags |= NMOD;
 #endif
                op->value[1] = i;
+               zp->chain = op;
+               zp = op;
        }
        np->range[1] = i;
        return (np);
        }
        np->range[1] = i;
        return (np);
@@ -307,12 +343,14 @@ tyary(r)
                        np = NIL;
                        continue;
                }
                        np = NIL;
                        continue;
                }
+#ifndef PC
                if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
 #ifndef PI1
                        error("Value of dimension specifier too large or small for this implementation");
 #endif
                        continue;
                }
                if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
 #ifndef PI1
                        error("Value of dimension specifier too large or small for this implementation");
 #endif
                        continue;
                }
+#endif
                tp = nlcopy(tp);
                i++;
                ltp->chain = tp;
                tp = nlcopy(tp);
                i++;
                ltp->chain = tp;