# 2.11BSD#431 - /usr/src/ucb/pascal/pi/type.c

##### Functions

    foredecl          X
    gtype             X
    norange           X
    tyary             X
    type              X
    typebeg           X
    typeend           X
    tyrang            X
    tyscal            X

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

#### Defined functions

foredecl defined in line 312; used 2 times

- in line 62
- in /usr/src/ucb/pascal/pi/var.c line 77

gtype defined in line 70; used 14 times

- in line 46, 114, 123, 134, 264, 272, 319
- in /usr/src/ucb/pascal/pi/0.h line 633
- in /usr/src/ucb/pascal/pi/fdec.c line 88, 152
- in /usr/src/ucb/pascal/pi/rec.c line 101, 122
- in /usr/src/ucb/pascal/pi/var.c line 47, 62

norange defined in line 234; used 2 times

- in line 206(2)

tyary defined in line 255; used 2 times

- in line 117
- in /usr/src/ucb/pascal/pi/0.h line 625

type defined in line 39; used 20 times

- in line 99, 137, 173, 228, 277, 319-321(3)
- in /usr/src/ucb/pascal/pi/pas.y line 235-238(3), 256-259(2), 318-324(3), 331, 407-410(2), 452

typebeg defined in line 18; used 2 times

- in /usr/src/ucb/pascal/pi/pas.y line 235, 242

typeend defined in line 56; used 2 times

- in /usr/src/ucb/pascal/pi/pas.y line 170, 185

tyrang defined in line 192; used 1 times

- in line 105

tyscal defined in line 165; used 1 times

- in line 102

Last modified: 1981-07-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1036 |