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: }