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