projects / unix-history / blobdiff
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
BSD 4_3 release
[unix-history] / usr / src / ucb / pascal / src / type.c
diff --git a/usr/src/ucb/pascal/src/type.c b/usr/src/ucb/pascal/src/type.c
index 3532c7d..415cc70 100644 (file)
--- a/usr/src/ucb/pascal/src/type.c
+++ b/usr/src/ucb/pascal/src/type.c
@@ -1,15 +1,23 @@
-/* Copyright (c) 1979 Regents of the University of California */
+/*
+ * Copyright (c) 1980 Regents of the University of California.
+ * All rights reserved.  The Berkeley software License Agreement
+ * specifies the terms and conditions for redistribution.
+ */
 
 
-static char sccsid[] = "@(#)type.c 1.8 8/29/82";
+#ifndef lint
+static char sccsid[] = "@(#)type.c     5.1 (Berkeley) 6/5/85";
+#endif not lint
 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"
 #include "objfmt.h"
 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"
 #include "objfmt.h"
+#include "tree_ty.h"
 
 /*
  * Type declaration part
  */
 
 /*
  * Type declaration part
  */
+/*ARGSUSED*/
 typebeg( lineofytype , r )
     int        lineofytype;
 {
 typebeg( lineofytype , r )
     int        lineofytype;
 {
@@ -69,22 +77,26 @@ typebeg( lineofytype , r )
 type(tline, tid, tdecl)
        int tline;
        char *tid;
 type(tline, tid, tdecl)
        int tline;
        char *tid;
-       register int *tdecl;
+       register struct tnode *tdecl;
 {
        register struct nl *np;
 {
        register struct nl *np;
+       struct nl *tnp;
 
        np = gtype(tdecl);
        line = tline;
 
        np = gtype(tdecl);
        line = tline;
+       tnp = defnl(tid, TYPE, np, 0);
 #ifndef PI0
 #ifndef PI0
-       enter(defnl(tid, TYPE, np, 0))->nl_flags |= NMOD;
+       enter(tnp)->nl_flags |= (char) NMOD;
 #else
 #else
-       enter(defnl(tid, TYPE, np, 0));
+       (void) enter(tnp);
        send(REVTYPE, tline, tid, tdecl);
 #endif
 
 #ifdef PC
        if (cbn == 1) {
        send(REVTYPE, tline, tid, tdecl);
 #endif
 
 #ifdef PC
        if (cbn == 1) {
-           stabgtype( tid , line );
+           stabgtype(tid, np, line);
+       } else {
+           stabltype(tid, np);
        }
 #endif PC
 
        }
 #endif PC
 
@@ -117,32 +129,33 @@ typeend()
  */
 struct nl *
 gtype(r)
  */
 struct nl *
 gtype(r)
-       register int *r;
+       register struct tnode *r;
 {
        register struct nl *np;
 {
        register struct nl *np;
-       register char *cp;
        register int oline;
        register int oline;
+#ifdef OBJ
        long w;
        long w;
+#endif
 
 
-       if (r == NIL)
-               return (NIL);
+       if (r == TR_NIL)
+               return (NLNIL);
        oline = line;
        oline = line;
-       if (r[0] != T_ID)
-               oline = line = r[1];
-       switch (r[0]) {
+       if (r->tag != T_ID)
+               oline = line = r->lined.line_no;
+       switch (r->tag) {
                default:
                        panic("type");
                case T_TYID:
                default:
                        panic("type");
                case T_TYID:
-                       r++;
+                       r = (struct tnode *) (&(r->tyid_node.line_no));
                case T_ID:
                case T_ID:
-                       np = lookup(r[1]);
-                       if (np == NIL)
+                       np = lookup(r->char_const.cptr);
+                       if (np == NLNIL)
                                break;
                        if (np->class != TYPE) {
 #ifndef PI1
                                break;
                        if (np->class != TYPE) {
 #ifndef PI1
-                               error("%s is a %s, not a type as required", r[1], classes[np->class]);
+                               error("%s is a %s, not a type as required", r->char_const.cptr, classes[np->class]);
 #endif
 #endif
-                               np = NIL;
+                               np = NLNIL;
                                break;
                        }
                        np = np->type;
                                break;
                        }
                        np = np->type;
@@ -150,74 +163,78 @@ gtype(r)
                case T_TYSCAL:
                        np = tyscal(r);
                        break;
                case T_TYSCAL:
                        np = tyscal(r);
                        break;
+               case T_TYCRANG:
+                       np = tycrang(r);
+                       break;
                case T_TYRANG:
                        np = tyrang(r);
                        break;
                case T_TYPTR:
                case T_TYRANG:
                        np = tyrang(r);
                        break;
                case T_TYPTR:
-                       np = defnl(0, PTR, 0, 0 );
-                       np -> ptr[0] = r[2];
+                       np = defnl((char *) 0, PTR, NLNIL, 0 );
+                       np -> ptr[0] = ((struct nl *) r->ptr_ty.id_node);
                        np->nl_next = forechain;
                        forechain = np;
                        break;
                case T_TYPACK:
                        np->nl_next = forechain;
                        forechain = np;
                        break;
                case T_TYPACK:
-                       np = gtype(r[2]);
+                       np = gtype(r->comp_ty.type);
                        break;
                        break;
+               case T_TYCARY:
                case T_TYARY:
                        np = tyary(r);
                        break;
                case T_TYREC:
                case T_TYARY:
                        np = tyary(r);
                        break;
                case T_TYREC:
-                       np = tyrec(r[2], 0);
+                       np = tyrec(r->comp_ty.type, 0);
 #                      ifdef PTREE
                                /*
                                 * mung T_TYREC[3] to point to the record
                                 * for RecTCopy
                                 */
 #                      ifdef PTREE
                                /*
                                 * mung T_TYREC[3] to point to the record
                                 * for RecTCopy
                                 */
-                           r[3] = np;
+                           r->comp_ty.nl_entry = np;
 #                      endif
                        break;
                case T_TYFILE:
 #                      endif
                        break;
                case T_TYFILE:
-                       np = gtype(r[2]);
-                       if (np == NIL)
+                       np = gtype(r->comp_ty.type);
+                       if (np == NLNIL)
                                break;
 #ifndef PI1
                        if (np->nl_flags & NFILES)
                                error("Files cannot be members of files");
 #endif
                                break;
 #ifndef PI1
                        if (np->nl_flags & NFILES)
                                error("Files cannot be members of files");
 #endif
-                       np = defnl(0, FILET, np, 0);
+                       np = defnl((char *) 0, FILET, np, 0);
                        np->nl_flags |= NFILES;
                        break;
                case T_TYSET:
                        np->nl_flags |= NFILES;
                        break;
                case T_TYSET:
-                       np = gtype(r[2]);
-                       if (np == NIL)
+                       np = gtype(r->comp_ty.type);
+                       if (np == NLNIL)
                                break;
                        if (np->type == nl+TDOUBLE) {
 #ifndef PI1
                                error("Set of real is not allowed");
 #endif
                                break;
                        if (np->type == nl+TDOUBLE) {
 #ifndef PI1
                                error("Set of real is not allowed");
 #endif
-                               np = NIL;
+                               np = NLNIL;
                                break;
                        }
                        if (np->class != RANGE && np->class != SCAL) {
 #ifndef PI1
                                error("Set type must be range or scalar, not %s", nameof(np));
 #endif
                                break;
                        }
                        if (np->class != RANGE && np->class != SCAL) {
 #ifndef PI1
                                error("Set type must be range or scalar, not %s", nameof(np));
 #endif
-                               np = NIL;
+                               np = NLNIL;
                                break;
                        }
 #ifndef PI1
                        if (width(np) > 2)
                                error("Implementation restriction: sets must be indexed by 16 bit quantities");
 #endif
                                break;
                        }
 #ifndef PI1
                        if (width(np) > 2)
                                error("Implementation restriction: sets must be indexed by 16 bit quantities");
 #endif
-                       np = defnl(0, SET, np, 0);
+                       np = defnl((char *) 0, SET, np, 0);
                        break;
        }
        line = oline;
                        break;
        }
        line = oline;
-       w = lwidth(np);
 #ifndef PC
 #ifndef PC
+       w = lwidth(np);
        if (w >= TOOMUCH) {
                error("Storage requirement of %s exceeds the implementation limit of %D by %D bytes",
        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;
+                       nameof(np), (char *) (long)(TOOMUCH-1), (char *) (long)(w-TOOMUCH+1));
+               np = NLNIL;
        }
 #endif
        return (np);
        }
 #endif
        return (np);
@@ -226,22 +243,23 @@ gtype(r)
 /*
  * Scalar (enumerated) types
  */
 /*
  * Scalar (enumerated) types
  */
+struct nl *
 tyscal(r)
 tyscal(r)
-       int *r;
+       struct tnode *r;        /* T_TYSCAL */
 {
        register struct nl *np, *op, *zp;
 {
        register struct nl *np, *op, *zp;
-       register *v;
+       register struct tnode *v;
        int i;
 
        int i;
 
-       np = defnl(0, SCAL, 0, 0);
+       np = defnl((char *) 0, SCAL, NLNIL, 0);
        np->type = np;
        np->type = np;
-       v = r[2];
-       if (v == NIL)
-               return (NIL);
+       v = r->comp_ty.type;
+       if (v == TR_NIL)
+               return (NLNIL);
        i = -1;
        zp = np;
        i = -1;
        zp = np;
-       for (; v != NIL; v = v[2]) {
-               op = enter(defnl(v[1], CONST, np, ++i));
+       for (; v != TR_NIL; v = v->list_node.next) {
+               op = enter(defnl((char *) v->list_node.list, CONST, np, ++i));
 #ifndef PI0
                op->nl_flags |= NMOD;
 #endif
 #ifndef PI0
                op->nl_flags |= NMOD;
 #endif
@@ -253,46 +271,67 @@ tyscal(r)
        return (np);
 }
 
        return (np);
 }
 
+/*
+ * Declare a subrange for conformant arrays.
+ */
+struct nl *
+tycrang(r)
+       register struct tnode *r;
+{
+       register struct nl *p, *op, *tp;
+
+       tp = gtype(r->crang_ty.type);
+       if ( tp == NLNIL )
+               return (NLNIL);
+       /*
+        * Just make a new type -- the lower and upper bounds must be
+        * set by params().
+        */
+       p = defnl ( 0, CRANGE, tp, 0 );
+       return(p);
+}
+
 /*
  * Declare a subrange.
  */
 /*
  * Declare a subrange.
  */
+struct nl *
 tyrang(r)
 tyrang(r)
-       register int *r;
+       register struct tnode *r;  /* T_TYRANG */
 {
        register struct nl *lp, *hp;
        double high;
        int c, c1;
 
 {
        register struct nl *lp, *hp;
        double high;
        int c, c1;
 
-       gconst(r[3]);
+       gconst(r->rang_ty.const2);
        hp = con.ctype;
        high = con.crval;
        hp = con.ctype;
        high = con.crval;
-       gconst(r[2]);
+       gconst(r->rang_ty.const1);
        lp = con.ctype;
        lp = con.ctype;
-       if (lp == NIL || hp == NIL)
-               return (NIL);
+       if (lp == NLNIL || hp == NLNIL)
+               return (NLNIL);
        if (norange(lp) || norange(hp))
        if (norange(lp) || norange(hp))
-               return (NIL);
+               return (NLNIL);
        c = classify(lp);
        c1 = classify(hp);
        if (c != c1) {
 #ifndef PI1
                error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
 #endif
        c = classify(lp);
        c1 = classify(hp);
        if (c != c1) {
 #ifndef PI1
                error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
 #endif
-               return (NIL);
+               return (NLNIL);
        }
        if (c == TSCAL && scalar(lp) != scalar(hp)) {
 #ifndef PI1
                error("Scalar types must be identical in subranges");
 #endif
        }
        if (c == TSCAL && scalar(lp) != scalar(hp)) {
 #ifndef PI1
                error("Scalar types must be identical in subranges");
 #endif
-               return (NIL);
+               return (NLNIL);
        }
        if (con.crval > high) {
 #ifndef PI1
                error("Range lower bound exceeds upper bound");
 #endif
        }
        if (con.crval > high) {
 #ifndef PI1
                error("Range lower bound exceeds upper bound");
 #endif
-               return (NIL);
+               return (NLNIL);
        }
        }
-       lp = defnl(0, RANGE, hp->type, 0);
+       lp = defnl((char *) 0, RANGE, hp->type, 0);
        lp->range[0] = con.crval;
        lp->range[1] = high;
        return (lp);
        lp->range[0] = con.crval;
        lp->range[1] = high;
        return (lp);
@@ -321,38 +360,46 @@ norange(p)
  */
 struct nl *
 tyary(r)
  */
 struct nl *
 tyary(r)
-       int *r;
+       struct tnode *r;
 {
        struct nl *np;
 {
        struct nl *np;
-       register *tl;
+       register struct tnode *tl, *s;
        register struct nl *tp, *ltp;
        register struct nl *tp, *ltp;
-       int i;
+       int i, n;
 
 
-       tp = gtype(r[3]);
-       if (tp == NIL)
-               return (NIL);
-       np = defnl(0, ARRAY, tp, 0);
+       s = r;
+       /* Count the dimensions */
+       for (n = 0; s->tag == T_TYARY || s->tag == T_TYCARY;
+                                       s = s->ary_ty.type, n++)
+               /* NULL STATEMENT */;
+       tp = gtype(s);
+       if (tp == NLNIL)
+               return (NLNIL);
+       np = defnl((char *) 0, ARRAY, tp, 0);
        np->nl_flags |= (tp->nl_flags) & NFILES;
        ltp = np;
        i = 0;
        np->nl_flags |= (tp->nl_flags) & NFILES;
        ltp = np;
        i = 0;
-       for (tl = r[2]; tl != NIL; tl = tl[2]) {
-               tp = gtype(tl[1]);
-               if (tp == NIL) {
-                       np = NIL;
+       for (s = r; s->tag == T_TYARY || s->tag == T_TYCARY;
+                                       s = s->ary_ty.type) {
+           for (tl = s->ary_ty.type_list; tl != TR_NIL; tl=tl->list_node.next){
+               tp = gtype(tl->list_node.list);
+               if (tp == NLNIL) {
+                       np = NLNIL;
                        continue;
                }
                        continue;
                }
-               if (tp->class == RANGE && tp->type == nl+TDOUBLE) {
+               if ((tp->class == RANGE || tp->class == CRANGE) &&
+                   tp->type == nl+TDOUBLE) {
 #ifndef PI1
                        error("Index type for arrays cannot be real");
 #endif
 #ifndef PI1
                        error("Index type for arrays cannot be real");
 #endif
-                       np = NIL;
+                       np = NLNIL;
                        continue;
                }
                        continue;
                }
-               if (tp->class != RANGE && tp->class != SCAL) {
+               if (tp->class != RANGE && tp->class != SCAL && tp->class !=CRANGE){
 #ifndef PI1
                        error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
 #endif
 #ifndef PI1
                        error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
 #endif
-                       np = NIL;
+                       np = NLNIL;
                        continue;
                }
 #ifndef PC
                        continue;
                }
 #ifndef PC
@@ -363,12 +410,14 @@ tyary(r)
                        continue;
                }
 #endif
                        continue;
                }
 #endif
-               tp = nlcopy(tp);
+               if (tp->class != CRANGE)
+                       tp = nlcopy(tp);
                i++;
                ltp->chain = tp;
                ltp = tp;
                i++;
                ltp->chain = tp;
                ltp = tp;
+           }
        }
        }
-       if (np != NIL)
+       if (np != NLNIL)
                np->value[0] = i;
        return (np);
 }
                np->value[0] = i;
        return (np);
 }
@@ -380,12 +429,12 @@ tyary(r)
  */
 foredecl()
 {
  */
 foredecl()
 {
-       register struct nl *p, *q;
+       register struct nl *p;
 
 
-       for (p = forechain; p != NIL; p = p->nl_next) {
+       for (p = forechain; p != NLNIL; p = p->nl_next) {
                if (p->class == PTR && p -> ptr[0] != 0)
                {
                if (p->class == PTR && p -> ptr[0] != 0)
                {
-                       p->type = gtype(p -> ptr[0]);
+                       p->type = gtype((struct tnode *) p -> ptr[0]);
 #                      ifdef PTREE
                        {
                            if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
 #                      ifdef PTREE
                        {
                            if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
@@ -394,6 +443,9 @@ foredecl()
                                pDEF( p -> inTree ).PtrTType = PtrTo;
                            }
                        }
                                pDEF( p -> inTree ).PtrTType = PtrTo;
                            }
                        }
+#                      endif
+#                      ifdef PC
+                           fixfwdtype(p);
 #                      endif
                        p -> ptr[0] = 0;
                }
 #                      endif
                        p -> ptr[0] = 0;
                }
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.