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