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