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