![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to type.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / pi|
Return to type.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)type.c 1.4 9/4/80";
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, w;
113:
114: if (r == NIL)
115: return (NIL);
116: oline = line;
117: if (r[0] != T_ID)
118: oline = line = r[1];
119: switch (r[0]) {
120: default:
121: panic("type");
122: case T_TYID:
123: r++;
124: case T_ID:
125: np = lookup(r[1]);
126: if (np == NIL)
127: break;
128: if (np->class != TYPE) {
129: #ifndef PI1
130: error("%s is a %s, not a type as required", r[1], classes[np->class]);
131: #endif
132: np = NIL;
133: break;
134: }
135: np = np->type;
136: break;
137: case T_TYSCAL:
138: np = tyscal(r);
139: break;
140: case T_TYRANG:
141: np = tyrang(r);
142: break;
143: case T_TYPTR:
144: np = defnl(0, PTR, 0, 0 );
145: np -> ptr[0] = r[2];
146: np->nl_next = forechain;
147: forechain = np;
148: break;
149: case T_TYPACK:
150: np = gtype(r[2]);
151: break;
152: case T_TYARY:
153: np = tyary(r);
154: break;
155: case T_TYREC:
156: np = tyrec(r[2], 0);
157: # ifdef PTREE
158: /*
159: * mung T_TYREC[3] to point to the record
160: * for RecTCopy
161: */
162: r[3] = np;
163: # endif
164: break;
165: case T_TYFILE:
166: np = gtype(r[2]);
167: if (np == NIL)
168: break;
169: #ifndef PI1
170: if (np->nl_flags & NFILES)
171: error("Files cannot be members of files");
172: #endif
173: np = defnl(0, FILET, np, 0);
174: np->nl_flags |= NFILES;
175: break;
176: case T_TYSET:
177: np = gtype(r[2]);
178: if (np == NIL)
179: break;
180: if (np->type == nl+TDOUBLE) {
181: #ifndef PI1
182: error("Set of real is not allowed");
183: #endif
184: np = NIL;
185: break;
186: }
187: if (np->class != RANGE && np->class != SCAL) {
188: #ifndef PI1
189: error("Set type must be range or scalar, not %s", nameof(np));
190: #endif
191: np = NIL;
192: break;
193: }
194: #ifndef PI1
195: if (width(np) > 2)
196: error("Implementation restriction: sets must be indexed by 16 bit quantities");
197: #endif
198: np = defnl(0, SET, np, 0);
199: break;
200: }
201: line = oline;
202: w = lwidth(np);
203: if (w >= TOOMUCH) {
204: error("Storage requirement of %s exceeds the implementation limit of %d by %d bytes",
205: nameof(np), TOOMUCH-1, w-TOOMUCH+1);
206: np = NIL;
207: }
208: return (np);
209: }
210:
211: /*
212: * Scalar (enumerated) types
213: */
214: tyscal(r)
215: int *r;
216: {
217: register struct nl *np, *op, *zp;
218: register *v;
219: int i;
220:
221: np = defnl(0, SCAL, 0, 0);
222: np->type = np;
223: v = r[2];
224: if (v == NIL)
225: return (NIL);
226: i = -1;
227: zp = np;
228: for (; v != NIL; v = v[2]) {
229: op = enter(defnl(v[1], CONST, np, ++i));
230: #ifndef PI0
231: op->nl_flags |= NMOD;
232: #endif
233: op->value[1] = i;
234: zp->chain = op;
235: zp = op;
236: }
237: np->range[1] = i;
238: return (np);
239: }
240:
241: /*
242: * Declare a subrange.
243: */
244: tyrang(r)
245: register int *r;
246: {
247: register struct nl *lp, *hp;
248: double high;
249: int c, c1;
250:
251: gconst(r[3]);
252: hp = con.ctype;
253: high = con.crval;
254: gconst(r[2]);
255: lp = con.ctype;
256: if (lp == NIL || hp == NIL)
257: return (NIL);
258: if (norange(lp) || norange(hp))
259: return (NIL);
260: c = classify(lp);
261: c1 = classify(hp);
262: if (c != c1) {
263: #ifndef PI1
264: error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
265: #endif
266: return (NIL);
267: }
268: if (c == TSCAL && scalar(lp) != scalar(hp)) {
269: #ifndef PI1
270: error("Scalar types must be identical in subranges");
271: #endif
272: return (NIL);
273: }
274: if (con.crval > high) {
275: #ifndef PI1
276: error("Range lower bound exceeds upper bound");
277: #endif
278: return (NIL);
279: }
280: lp = defnl(0, RANGE, hp->type, 0);
281: lp->range[0] = con.crval;
282: lp->range[1] = high;
283: return (lp);
284: }
285:
286: norange(p)
287: register struct nl *p;
288: {
289: if (isa(p, "d")) {
290: #ifndef PI1
291: error("Subrange of real is not allowed");
292: #endif
293: return (1);
294: }
295: if (isnta(p, "bcsi")) {
296: #ifndef PI1
297: error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p));
298: #endif
299: return (1);
300: }
301: return (0);
302: }
303:
304: /*
305: * Declare arrays and chain together the dimension specification
306: */
307: struct nl *
308: tyary(r)
309: int *r;
310: {
311: struct nl *np;
312: register *tl;
313: register struct nl *tp, *ltp;
314: int i;
315:
316: tp = gtype(r[3]);
317: if (tp == NIL)
318: return (NIL);
319: np = defnl(0, ARRAY, tp, 0);
320: np->nl_flags |= (tp->nl_flags) & NFILES;
321: ltp = np;
322: i = 0;
323: for (tl = r[2]; tl != NIL; tl = tl[2]) {
324: tp = gtype(tl[1]);
325: if (tp == NIL) {
326: np = NIL;
327: continue;
328: }
329: if (tp->class == RANGE && tp->type == nl+TDOUBLE) {
330: #ifndef PI1
331: error("Index type for arrays cannot be real");
332: #endif
333: np = NIL;
334: continue;
335: }
336: if (tp->class != RANGE && tp->class != SCAL) {
337: #ifndef PI1
338: error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
339: #endif
340: np = NIL;
341: continue;
342: }
343: if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
344: #ifndef PI1
345: error("Value of dimension specifier too large or small for this implementation");
346: #endif
347: continue;
348: }
349: tp = nlcopy(tp);
350: i++;
351: ltp->chain = tp;
352: ltp = tp;
353: }
354: if (np != NIL)
355: np->value[0] = i;
356: return (np);
357: }
358:
359: /*
360: * Delayed processing for pointers to
361: * allow self-referential and mutually
362: * recursive pointer constructs.
363: */
364: foredecl()
365: {
366: register struct nl *p, *q;
367:
368: for (p = forechain; p != NIL; p = p->nl_next) {
369: if (p->class == PTR && p -> ptr[0] != 0)
370: {
371: p->type = gtype(p -> ptr[0]);
372: #ifndef PI1
373: if (p->type != NIL && ( ( p->type )->nl_flags & NFILES))
374: error("Files cannot be members of dynamic structures");
375: #endif
376: # ifdef PTREE
377: {
378: if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
379: pPointer PtrTo = tCopy( p -> ptr[0] );
380:
381: pDEF( p -> inTree ).PtrTType = PtrTo;
382: }
383: }
384: # endif
385: p -> ptr[0] = 0;
386: }
387: }
388: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.