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

##### Functions

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

       1: /*
       2:  * Copyright (c) 1980 Regents of the University of California.
       3:  * All rights reserved.  The Berkeley software License Agreement
       4:  * specifies the terms and conditions for redistribution.
       5:  */
       6:
       7: #ifndef lint
       8: static char sccsid[] = "@(#)type.c	5.1 (Berkeley) 6/5/85";
       9: #endif not lint
      10:
      11: #include "whoami.h"
      12: #include "0.h"
      13: #include "tree.h"
      14: #include "objfmt.h"
      15: #include "tree_ty.h"
      16:
      17: /*
      18:  * Type declaration part
      19:  */
      20: /*ARGSUSED*/
      21: typebeg( lineofytype , r )
      22:     int lineofytype;
      23: {
      24:     static bool type_order = FALSE;
      25:     static bool type_seen = FALSE;
      26:
      27: /*
      28:  * this allows for multiple
      29:  * declaration parts unless
      30:  * standard option has been
      31:  * specified.
      32:  * If routine segment is being
      33:  * compiled, do level one processing.
      34:  */
      35:
      36: #ifndef PI1
      37:     if (!progseen)
      38:         level1();
      39:     line = lineofytype;
      40:     if ( parts[ cbn ] & ( VPRT | RPRT ) ) {
      41:         if ( opt( 's' ) ) {
      42:         standard();
      43:         error("Type declarations should precede var and routine declarations");
      44:         } else {
      45:         if ( !type_order ) {
      46:             type_order = TRUE;
      47:             warning();
      48:             error("Type declarations should precede var and routine declarations");
      49:         }
      50:         }
      51:     }
      52:     if (parts[ cbn ] & TPRT) {
      53:         if ( opt( 's' ) ) {
      54:         standard();
      55:         error("All types should be declared in one type part");
      56:         } else {
      57:         if ( !type_seen ) {
      58:             type_seen = TRUE;
      59:             warning();
      60:             error("All types should be declared in one type part");
      61:         }
      62:         }
      63:     }
      64:     parts[ cbn ] |= TPRT;
      65: #endif
      66:     /*
      67: 	 * Forechain is the head of a list of types that
      68: 	 * might be self referential.  We chain them up and
      69: 	 * process them later.
      70: 	 */
      71:     forechain = NIL;
      72: #ifdef PI0
      73:     send(REVTBEG);
      74: #endif
      75: }
      76:
      77: type(tline, tid, tdecl)
      78:     int tline;
      79:     char *tid;
      80:     register struct tnode *tdecl;
      81: {
      82:     register struct nl *np;
      83:     struct nl *tnp;
      84:
      85:     np = gtype(tdecl);
      86:     line = tline;
      87:     tnp = defnl(tid, TYPE, np, 0);
      88: #ifndef PI0
      89:     enter(tnp)->nl_flags |= (char) NMOD;
      90: #else
      91:     (void) enter(tnp);
      92:     send(REVTYPE, tline, tid, tdecl);
      93: #endif
      94:
      95: #ifdef PC
      96:     if (cbn == 1) {
      97:         stabgtype(tid, np, line);
      98:     } else {
      99:         stabltype(tid, np);
     100:     }
     101: #endif PC
     102:
     103: #	ifdef PTREE
     104:         {
     105:         pPointer Type = TypeDecl( tid , tdecl );
     106:         pPointer *Types;
     107:
     108:         pSeize( PorFHeader[ nesting ] );
     109:         Types = &( pDEF( PorFHeader[ nesting ] ).PorFTypes );
     110:         *Types = ListAppend( *Types , Type );
     111:         pRelease( PorFHeader[ nesting ] );
     112:         }
     113: #	endif
     114: }
     115:
     116: typeend()
     117: {
     118:
     119: #ifdef PI0
     120:     send(REVTEND);
     121: #endif
     122:     foredecl();
     123: }
     124:
     125: /*
     126:  * Return a type pointer (into the namelist)
     127:  * from a parse tree for a type, building
     128:  * namelist entries as needed.
     129:  */
     130: struct nl *
     131: gtype(r)
     132:     register struct tnode *r;
     133: {
     134:     register struct nl *np;
     135:     register int oline;
     136: #ifdef OBJ
     137:     long w;
     138: #endif
     139:
     140:     if (r == TR_NIL)
     141:         return (NLNIL);
     142:     oline = line;
     143:     if (r->tag != T_ID)
     144:         oline = line = r->lined.line_no;
     145:     switch (r->tag) {
     146:         default:
     147:             panic("type");
     148:         case T_TYID:
     149:             r = (struct tnode *) (&(r->tyid_node.line_no));
     150:         case T_ID:
     151:             np = lookup(r->char_const.cptr);
     152:             if (np == NLNIL)
     153:                 break;
     154:             if (np->class != TYPE) {
     155: #ifndef PI1
     156:                 error("%s is a %s, not a type as required", r->char_const.cptr, classes[np->class]);
     157: #endif
     158:                 np = NLNIL;
     159:                 break;
     160:             }
     161:             np = np->type;
     162:             break;
     163:         case T_TYSCAL:
     164:             np = tyscal(r);
     165:             break;
     166:         case T_TYCRANG:
     167:             np = tycrang(r);
     168:             break;
     169:         case T_TYRANG:
     170:             np = tyrang(r);
     171:             break;
     172:         case T_TYPTR:
     173:             np = defnl((char *) 0, PTR, NLNIL, 0 );
     174:             np -> ptr[0] = ((struct nl *) r->ptr_ty.id_node);
     175:             np->nl_next = forechain;
     176:             forechain = np;
     177:             break;
     178:         case T_TYPACK:
     179:             np = gtype(r->comp_ty.type);
     180:             break;
     181:         case T_TYCARY:
     182:         case T_TYARY:
     183:             np = tyary(r);
     184:             break;
     185:         case T_TYREC:
     186:             np = tyrec(r->comp_ty.type, 0);
     187: #			ifdef PTREE
     188:                 /*
     189: 				 * mung T_TYREC[3] to point to the record
     190: 				 * for RecTCopy
     191: 				 */
     192:                 r->comp_ty.nl_entry = np;
     193: #			endif
     194:             break;
     195:         case T_TYFILE:
     196:             np = gtype(r->comp_ty.type);
     197:             if (np == NLNIL)
     198:                 break;
     199: #ifndef PI1
     200:             if (np->nl_flags & NFILES)
     201:                 error("Files cannot be members of files");
     202: #endif
     203:             np = defnl((char *) 0, FILET, np, 0);
     204:             np->nl_flags |= NFILES;
     205:             break;
     206:         case T_TYSET:
     207:             np = gtype(r->comp_ty.type);
     208:             if (np == NLNIL)
     209:                 break;
     210:             if (np->type == nl+TDOUBLE) {
     211: #ifndef PI1
     212:                 error("Set of real is not allowed");
     213: #endif
     214:                 np = NLNIL;
     215:                 break;
     216:             }
     217:             if (np->class != RANGE && np->class != SCAL) {
     218: #ifndef PI1
     219:                 error("Set type must be range or scalar, not %s", nameof(np));
     220: #endif
     221:                 np = NLNIL;
     222:                 break;
     223:             }
     224: #ifndef PI1
     225:             if (width(np) > 2)
     226:                 error("Implementation restriction: sets must be indexed by 16 bit quantities");
     227: #endif
     228:             np = defnl((char *) 0, SET, np, 0);
     229:             break;
     230:     }
     231:     line = oline;
     232: #ifndef PC
     233:     w = lwidth(np);
     234:     if (w >= TOOMUCH) {
     235:         error("Storage requirement of %s exceeds the implementation limit of %D by %D bytes",
     236:             nameof(np), (char *) (long)(TOOMUCH-1), (char *) (long)(w-TOOMUCH+1));
     237:         np = NLNIL;
     238:     }
     239: #endif
     240:     return (np);
     241: }
     242:
     243: /*
     244:  * Scalar (enumerated) types
     245:  */
     246: struct nl *
     247: tyscal(r)
     248:     struct tnode *r;    /* T_TYSCAL */
     249: {
     250:     register struct nl *np, *op, *zp;
     251:     register struct tnode *v;
     252:     int i;
     253:
     254:     np = defnl((char *) 0, SCAL, NLNIL, 0);
     255:     np->type = np;
     256:     v = r->comp_ty.type;
     257:     if (v == TR_NIL)
     258:         return (NLNIL);
     259:     i = -1;
     260:     zp = np;
     261:     for (; v != TR_NIL; v = v->list_node.next) {
     262:         op = enter(defnl((char *) v->list_node.list, CONST, np, ++i));
     263: #ifndef PI0
     264:         op->nl_flags |= NMOD;
     265: #endif
     266:         op->value[1] = i;
     267:         zp->chain = op;
     268:         zp = op;
     269:     }
     270:     np->range[1] = i;
     271:     return (np);
     272: }
     273:
     274: /*
     275:  * Declare a subrange for conformant arrays.
     276:  */
     277: struct nl *
     278: tycrang(r)
     279:     register struct tnode *r;
     280: {
     281:     register struct nl *p, *op, *tp;
     282:
     283:     tp = gtype(r->crang_ty.type);
     284:     if ( tp == NLNIL )
     285:         return (NLNIL);
     286:     /*
     287: 	 * Just make a new type -- the lower and upper bounds must be
     288: 	 * set by params().
     289: 	 */
     290:     p = defnl ( 0, CRANGE, tp, 0 );
     291:     return(p);
     292: }
     293:
     294: /*
     295:  * Declare a subrange.
     296:  */
     297: struct nl *
     298: tyrang(r)
     299:     register struct tnode *r;  /* T_TYRANG */
     300: {
     301:     register struct nl *lp, *hp;
     302:     double high;
     303:     int c, c1;
     304:
     305:     gconst(r->rang_ty.const2);
     306:     hp = con.ctype;
     307:     high = con.crval;
     308:     gconst(r->rang_ty.const1);
     309:     lp = con.ctype;
     310:     if (lp == NLNIL || hp == NLNIL)
     311:         return (NLNIL);
     312:     if (norange(lp) || norange(hp))
     313:         return (NLNIL);
     314:     c = classify(lp);
     315:     c1 = classify(hp);
     316:     if (c != c1) {
     317: #ifndef PI1
     318:         error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
     319: #endif
     320:         return (NLNIL);
     321:     }
     322:     if (c == TSCAL && scalar(lp) != scalar(hp)) {
     323: #ifndef PI1
     324:         error("Scalar types must be identical in subranges");
     325: #endif
     326:         return (NLNIL);
     327:     }
     328:     if (con.crval > high) {
     329: #ifndef PI1
     330:         error("Range lower bound exceeds upper bound");
     331: #endif
     332:         return (NLNIL);
     333:     }
     334:     lp = defnl((char *) 0, RANGE, hp->type, 0);
     335:     lp->range[0] = con.crval;
     336:     lp->range[1] = high;
     337:     return (lp);
     338: }
     339:
     340: norange(p)
     341:     register struct nl *p;
     342: {
     343:     if (isa(p, "d")) {
     344: #ifndef PI1
     345:         error("Subrange of real is not allowed");
     346: #endif
     347:         return (1);
     348:     }
     349:     if (isnta(p, "bcsi")) {
     350: #ifndef PI1
     351:         error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p));
     352: #endif
     353:         return (1);
     354:     }
     355:     return (0);
     356: }
     357:
     358: /*
     359:  * Declare arrays and chain together the dimension specification
     360:  */
     361: struct nl *
     362: tyary(r)
     363:     struct tnode *r;
     364: {
     365:     struct nl *np;
     366:     register struct tnode *tl, *s;
     367:     register struct nl *tp, *ltp;
     368:     int i, n;
     369:
     370:     s = r;
     371:     /* Count the dimensions */
     372:     for (n = 0; s->tag == T_TYARY || s->tag == T_TYCARY;
     373:                     s = s->ary_ty.type, n++)
     374:         /* NULL STATEMENT */;
     375:     tp = gtype(s);
     376:     if (tp == NLNIL)
     377:         return (NLNIL);
     378:     np = defnl((char *) 0, ARRAY, tp, 0);
     379:     np->nl_flags |= (tp->nl_flags) & NFILES;
     380:     ltp = np;
     381:     i = 0;
     382:     for (s = r; s->tag == T_TYARY || s->tag == T_TYCARY;
     383:                     s = s->ary_ty.type) {
     384:         for (tl = s->ary_ty.type_list; tl != TR_NIL; tl=tl->list_node.next){
     385:         tp = gtype(tl->list_node.list);
     386:         if (tp == NLNIL) {
     387:             np = NLNIL;
     388:             continue;
     389:         }
     390:         if ((tp->class == RANGE || tp->class == CRANGE) &&
     391:             tp->type == nl+TDOUBLE) {
     392: #ifndef PI1
     393:             error("Index type for arrays cannot be real");
     394: #endif
     395:             np = NLNIL;
     396:             continue;
     397:         }
     398:         if (tp->class != RANGE && tp->class != SCAL && tp->class !=CRANGE){
     399: #ifndef PI1
     400:             error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
     401: #endif
     402:             np = NLNIL;
     403:             continue;
     404:         }
     405: #ifndef PC
     406:         if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
     407: #ifndef PI1
     408:             error("Value of dimension specifier too large or small for this implementation");
     409: #endif
     410:             continue;
     411:         }
     412: #endif
     413:         if (tp->class != CRANGE)
     414:             tp = nlcopy(tp);
     415:         i++;
     416:         ltp->chain = tp;
     417:         ltp = tp;
     418:         }
     419:     }
     420:     if (np != NLNIL)
     421:         np->value[0] = i;
     422:     return (np);
     423: }
     424:
     425: /*
     426:  * Delayed processing for pointers to
     427:  * allow self-referential and mutually
     428:  * recursive pointer constructs.
     429:  */
     430: foredecl()
     431: {
     432:     register struct nl *p;
     433:
     434:     for (p = forechain; p != NLNIL; p = p->nl_next) {
     435:         if (p->class == PTR && p -> ptr[0] != 0)
     436:         {
     437:             p->type = gtype((struct tnode *) p -> ptr[0]);
     438: #			ifdef PTREE
     439:             {
     440:                 if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
     441:                 pPointer    PtrTo = tCopy( p -> ptr[0] );
     442:
     443:                 pDEF( p -> inTree ).PtrTType = PtrTo;
     444:                 }
     445:             }
     446: #			endif
     447: #			ifdef PC
     448:                 fixfwdtype(p);
     449: #			endif
     450:             p -> ptr[0] = 0;
     451:         }
     452:     }
     453: }

#### Defined functions

foredecl defined in line 430; used 2 times

- in line 122
- in /usr/src/ucb/PORT/pascal/src/var.c line 180

gtype defined in line 130; used 15 times

- in line 85, 179, 196, 207, 283, 375, 385, 437
- in /usr/src/ucb/PORT/pascal/src/0.h line 758
- in /usr/src/ucb/PORT/pascal/src/fhdr.c line 144, 356
- in /usr/src/ucb/PORT/pascal/src/rec.c line 135, 175
- in /usr/src/ucb/PORT/pascal/src/var.c line 92, 113

norange defined in line 340; used 2 times

- in line 312(2)

tyary defined in line 361; used 2 times

- in line 183
- in /usr/src/ucb/PORT/pascal/src/0.h line 740

tycrang defined in line 277; used 2 times

- in line 167
- in /usr/src/ucb/PORT/pascal/src/0.h line 764

type defined in line 77; used 25 times

- in line 161, 179, 186, 196, 207-210(2), 255-256(2), 283, 334, 373, 383, 391, 437
- in /usr/src/ucb/PORT/pascal/src/pas.y line 243-246(3), 264-267(2), 326-329(2), 343, 421-425(2), 468

typebeg defined in line 21; used 2 times

- in /usr/src/ucb/PORT/pascal/src/pas.y line 243, 250

typeend defined in line 116; used 2 times

- in /usr/src/ucb/PORT/pascal/src/pas.y line 173, 188

tyrang defined in line 297; used 2 times

- in line 170
- in /usr/src/ucb/PORT/pascal/src/0.h line 741

tyscal defined in line 246; used 2 times

- in line 164
- in /usr/src/ucb/PORT/pascal/src/0.h line 742

#### Defined variables

sccsid defined in line 8; never used

Last modified: 1985-06-06 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1415 |