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) 06/05/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 } 454