home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Distributions / ucb / spencer_2bsd.tar.gz / 2bsd.tar / src / pi0 / type.c < prev    next >
C/C++ Source or Header  |  1980-02-17  |  6KB  |  325 lines
  1. /* Copyright (c) 1979 Regents of the University of California */
  2. #
  3. /*
  4.  * pi - Pascal interpreter code translator
  5.  *
  6.  * Charles Haley, Bill Joy UCB
  7.  * Version 1.2 January 1979
  8.  */
  9.  
  10. #include "0.h"
  11. #include "tree.h"
  12.  
  13. /*
  14.  * Type declaration part
  15.  */
  16. typebeg()
  17. {
  18.  
  19. #ifndef PI1
  20.     if (parts & VPRT)
  21.         error("Type declarations must precede var declarations");
  22.     if (parts & TPRT)
  23.         error("All types must be declared in one type part");
  24.     parts =| TPRT;
  25. #endif
  26.     /*
  27.      * Forechain is the head of a list of types that
  28.      * might be self referential.  We chain them up and
  29.      * process them later.
  30.      */
  31.     forechain = NIL;
  32. #ifdef PI0
  33.     send(REVTBEG);
  34. #endif
  35. }
  36.  
  37. type(tline, tid, tdecl)
  38.     int tline;
  39.     char *tid;
  40.     register int *tdecl;
  41. {
  42.     register struct nl *np;
  43.  
  44.     np = gtype(tdecl);
  45.     line = tline;
  46.     if (np != NIL && (tdecl[0] == T_ID || tdecl[0] == T_TYID))
  47.         np = nlcopy(np);
  48. #ifndef PI0
  49.     enter(defnl(tid, TYPE, np, 0))->nl_flags =| NMOD;
  50. #else
  51.     enter(defnl(tid, TYPE, np, 0));
  52.     send(REVTYPE, tline, tid, tdecl);
  53. #endif
  54. }
  55.  
  56. typeend()
  57. {
  58.  
  59. #ifdef PI0
  60.     send(REVTEND);
  61. #endif
  62.     foredecl();
  63. }
  64.  
  65. /*
  66.  * Return a type pointer (into the namelist)
  67.  * from a parse tree for a type, building
  68.  * namelist entries as needed.
  69.  */
  70. gtype(r)
  71.     register int *r;
  72. {
  73.     register struct nl *np;
  74.     register char *cp;
  75.     int oline;
  76.  
  77.     if (r == NIL)
  78.         return (NIL);
  79.     oline = line;
  80.     if (r[0] != T_ID)
  81.         oline = line = r[1];
  82.     switch (r[0]) {
  83.         default:
  84.             panic("type");
  85.         case T_TYID:
  86.             r++;
  87.         case T_ID:
  88.             np = lookup(r[1]);
  89.             if (np == NIL)
  90.                 break;
  91.             if (np->class != TYPE) {
  92. #ifndef PI1
  93.                 error("%s is a %s, not a type as required", r[1], classes[np->class]);
  94. #endif
  95.                 np = NIL;
  96.                 break;
  97.             }
  98.             np = np->type;
  99.             break;
  100.         case T_TYSCAL:
  101.             np = tyscal(r);
  102.             break;
  103.         case T_TYRANG:
  104.             np = tyrang(r);
  105.             break;
  106.         case T_TYPTR:
  107.             np = defnl(0, PTR, 0, r[2]);
  108.             np->nl_next = forechain;
  109.             forechain = np;
  110.             break;
  111.         case T_TYPACK:
  112.             np = gtype(r[2]);
  113.             break;
  114.         case T_TYARY:
  115.             np = tyary(r);
  116.             break;
  117.         case T_TYREC:
  118.             np = tyrec(r[2], 0);
  119.             break;
  120.         case T_TYFILE:
  121.             np = gtype(r[2]);
  122.             if (np == NIL)
  123.                 break;
  124. #ifndef PI1
  125.             if (np->nl_flags & NFILES)
  126.                 error("Files cannot be members of files");
  127. #endif
  128.             np = defnl(0, FILE, np, 0);
  129.             np->nl_flags =| NFILES;
  130.             break;
  131.         case T_TYSET:
  132.             np = gtype(r[2]);
  133.             if (np == NIL)
  134.                 break;
  135.             if (np->type == nl+TDOUBLE) {
  136. #ifndef PI1
  137.                 error("Set of real is not allowed");
  138. #endif
  139.                 np = NIL;
  140.                 break;
  141.             }
  142.             if (np->class != RANGE && np->class != SCAL) {
  143. #ifndef PI1
  144.                 error("Set type must be range or scalar, not %s", nameof(np));
  145. #endif
  146.                 np = NIL;
  147.                 break;
  148.             }
  149. #ifndef PI1
  150.             if (width(np) > 2)
  151.                 error("Implementation restriction: sets must be indexed by 16 bit quantities");
  152. #endif
  153.             np = defnl(0, SET, np, 0);
  154.             break;
  155.     }
  156.     line = oline;
  157.     return (np);
  158. }
  159.  
  160. /*
  161.  * Scalar (enumerated) types
  162.  */
  163. tyscal(r)
  164.     int *r;
  165. {
  166.     register struct nl *np, *op;
  167.     register *v;
  168.     int i;
  169.  
  170.     np = defnl(0, SCAL, 0, 0);
  171.     np->type = np;
  172.     v = r[2];
  173.     if (v == NIL)
  174.         return (NIL);
  175.     i = -1;
  176.     for (; v != NIL; v = v[2]) {
  177.         op = enter(defnl(v[1], CONST, np, ++i));
  178. #ifndef PI0
  179.         op->nl_flags =| NMOD;
  180. #endif
  181.         op->value[1] = i;
  182.     }
  183.     np->range[1] = i;
  184.     return (np);
  185. }
  186.  
  187. /*
  188.  * Declare a subrange.
  189.  */
  190. tyrang(r)
  191.     register int *r;
  192. {
  193.     register struct nl *lp, *hp;
  194.     double high;
  195.     int c, c1;
  196.  
  197.     gconst(r[3]);
  198.     hp = con.ctype;
  199.     high = con.crval;
  200.     gconst(r[2]);
  201.     lp = con.ctype;
  202.     if (lp == NIL || hp == NIL)
  203.         return (NIL);
  204.     if (norange(lp) || norange(hp))
  205.         return (NIL);
  206.     c = classify(lp);
  207.     c1 = classify(hp);
  208.     if (c != c1) {
  209. #ifndef PI1
  210.         error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
  211. #endif
  212.         return (NIL);
  213.     }
  214.     if (c == TSCAL && scalar(lp) != scalar(hp)) {
  215. #ifndef PI1
  216.         error("Scalar types must be identical in subranges");
  217. #endif
  218.         return (NIL);
  219.     }
  220.     if (con.crval > high) {
  221. #ifndef PI1
  222.         error("Range lower bound exceeds upper bound");
  223. #endif
  224.         return (NIL);
  225.     }
  226.     lp = defnl(0, RANGE, hp->type, 0);
  227.     lp->range[0] = con.crval;
  228.     lp->range[1] = high;
  229.     return (lp);
  230. }
  231.  
  232. norange(p)
  233.     register struct nl *p;
  234. {
  235.     if (isa(p, "d")) {
  236. #ifndef PI1
  237.         error("Subrange of real is not allowed");
  238. #endif
  239.         return (1);
  240.     }
  241.     if (isnta(p, "bcsi")) {
  242. #ifndef PI1
  243.         error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p));
  244. #endif
  245.         return (1);
  246.     }
  247.     return (0);
  248. }
  249.  
  250. /*
  251.  * Declare arrays and chain together the dimension specification
  252.  */
  253. tyary(r)
  254.     int *r;
  255. {
  256.     struct nl *np;
  257.     register *tl;
  258.     register struct nl *tp, *ltp;
  259.     int i;
  260.  
  261.     tp = gtype(r[3]);
  262.     if (tp == NIL)
  263.         return (NIL);
  264.     np = defnl(0, ARRAY, tp, 0);
  265.     np->nl_flags =| (tp->nl_flags) & NFILES;
  266.     ltp = np;
  267.     i = 0;
  268.     for (tl = r[2]; tl != NIL; tl = tl[2]) {
  269.         tp = gtype(tl[1]);
  270.         if (tp == NIL) {
  271.             np = NIL;
  272.             continue;
  273.         }
  274.         if (tp->class == RANGE && tp->type == nl+TDOUBLE) {
  275. #ifndef PI1
  276.             error("Index type for arrays cannot be real");
  277. #endif
  278.             np = NIL;
  279.             continue;
  280.         }
  281.         if (tp->class != RANGE && tp->class != SCAL) {
  282. #ifndef PI1
  283.             error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
  284. #endif
  285.             np = NIL;
  286.             continue;
  287.         }
  288.         if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
  289. #ifndef PI1
  290.             error("Value of dimension specifier too large or small for this implementation");
  291. #endif
  292.             continue;
  293.         }
  294.         tp = nlcopy(tp);
  295.         i++;
  296.         ltp->chain = tp;
  297.         ltp = tp;
  298.     }
  299.     if (np != NIL)
  300.         np->value[0] = i;
  301.     return (np);
  302. }
  303.  
  304. /*
  305.  * Delayed processing for pointers to
  306.  * allow self-referential and mutually
  307.  * recursive pointer constructs.
  308.  */
  309. foredecl()
  310. {
  311.     register struct nl *p, *q;
  312.  
  313.     for (p = forechain; p != NIL; p = p->nl_next) {
  314.         if (p->class == PTR && p->value[0] != 0)
  315.         {
  316.             p->type = gtype(p->value[0]);
  317. #ifndef PI1
  318.             if (p->type != NIL && (p->type->nl_flags & NFILES))
  319.                 error("Files cannot be members of dynamic structures");
  320. #endif
  321.             p->value[0] = 0;
  322.         }
  323.     }
  324. }
  325.