![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to pclval.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / pi|
Return to pclval.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)pclval.c 1.1 8/27/80";
4:
5: #include "whoami.h"
6: #include "0.h"
7: #include "tree.h"
8: #include "opcode.h"
9: #include "objfmt.h"
10: #ifdef PC
11: /*
12: * and the rest of the file
13: */
14: # include "pc.h"
15: # include "pcops.h"
16:
17: extern int flagwas;
18: /*
19: * pclvalue computes the address
20: * of a qualified name and
21: * leaves it on the stack.
22: * for pc, it can be asked for either an lvalue or an rvalue.
23: * the semantics are the same, only the code is different.
24: * for putting out calls to check for nil and fnil,
25: * we have to traverse the list of qualifications twice:
26: * once to put out the calls and once to put out the address to be checked.
27: */
28: struct nl *
29: pclvalue( r , modflag , required )
30: int *r;
31: int modflag;
32: int required;
33: {
34: register struct nl *p;
35: register *c, *co;
36: int f, o;
37: int tr[2], trp[3];
38: struct nl *firstp;
39: struct nl *lastp;
40: char *firstsymbol;
41: int firstbn;
42:
43: if ( r == NIL ) {
44: return NIL;
45: }
46: if ( nowexp( r ) ) {
47: return NIL;
48: }
49: if ( r[0] != T_VAR ) {
50: error("Variable required"); /* Pass mesgs down from pt of call ? */
51: return NIL;
52: }
53: firstp = p = lookup( r[2] );
54: if ( p == NIL ) {
55: return NIL;
56: }
57: firstsymbol = p -> symbol;
58: firstbn = bn;
59: c = r[3];
60: if ( ( modflag & NOUSE ) && ! lptr( c ) ) {
61: p -> nl_flags = flagwas;
62: }
63: if ( modflag & MOD ) {
64: p -> nl_flags |= NMOD;
65: }
66: /*
67: * Only possibilities for p -> class here
68: * are the named classes, i.e. CONST, TYPE
69: * VAR, PROC, FUNC, REF, or a WITHPTR.
70: */
71: if ( p -> class == WITHPTR ) {
72: /*
73: * Construct the tree implied by
74: * the with statement
75: */
76: trp[0] = T_LISTPP;
77: trp[1] = tr;
78: trp[2] = r[3];
79: tr[0] = T_FIELD;
80: tr[1] = r[2];
81: c = trp;
82: }
83: /*
84: * this not only puts out the names of functions to call
85: * but also does all the semantic checking of the qualifications.
86: */
87: if ( ! nilfnil( p , c , modflag , firstp , r[2] ) ) {
88: return NIL;
89: }
90: switch (p -> class) {
91: case WITHPTR:
92: case REF:
93: /*
94: * Obtain the indirect word
95: * of the WITHPTR or REF
96: * as the base of our lvalue
97: */
98: putRV( firstsymbol , firstbn , p -> value[ 0 ]
99: , p2type( p ) );
100: firstsymbol = 0;
101: f = 0; /* have an lv on stack */
102: o = 0;
103: break;
104: case VAR:
105: f = 1; /* no lv on stack yet */
106: o = p -> value[0];
107: break;
108: default:
109: error("%s %s found where variable required", classes[p -> class], p -> symbol);
110: return (NIL);
111: }
112: /*
113: * Loop and handle each
114: * qualification on the name
115: */
116: if ( c == NIL && ( modflag & ASGN ) && p -> value[ NL_FORV ] ) {
117: error("Can't modify the for variable %s in the range of the loop", p -> symbol);
118: return (NIL);
119: }
120: for ( ; c != NIL ; c = c[2] ) {
121: co = c[1];
122: if ( co == NIL ) {
123: return NIL;
124: }
125: lastp = p;
126: p = p -> type;
127: if ( p == NIL ) {
128: return NIL;
129: }
130: switch ( co[0] ) {
131: case T_PTR:
132: /*
133: * Pointer qualification.
134: */
135: if ( f ) {
136: putLV( firstsymbol , firstbn , o
137: , p2type( p ) );
138: firstsymbol = 0;
139: } else {
140: if (o) {
141: putleaf( P2ICON , o , 0 , P2INT
142: , 0 );
143: putop( P2PLUS , P2PTR | P2CHAR );
144: }
145: }
146: /*
147: * Pointer cannot be
148: * nil and file cannot
149: * be at end-of-file.
150: * the appropriate function name is
151: * already out there from nilfnil.
152: */
153: if ( p -> class == PTR ) {
154: /*
155: * this is the indirection from
156: * the address of the pointer
157: * to the pointer itself.
158: * kirk sez:
159: * fnil doesn't want this.
160: * and does it itself for files
161: * since only it knows where the
162: * actual window is.
163: * but i have to do this for
164: * regular pointers.
165: */
166: putop( P2UNARY P2MUL , p2type( p ) );
167: if ( opt( 't' ) ) {
168: putop( P2CALL , P2INT );
169: }
170: } else {
171: putop( P2CALL , P2INT );
172: }
173: f = o = 0;
174: continue;
175: case T_ARGL:
176: case T_ARY:
177: if ( f ) {
178: putLV( firstsymbol , firstbn , o
179: , p2type( p ) );
180: firstsymbol = 0;
181: } else {
182: if (o) {
183: putleaf( P2ICON , o , 0 , P2INT
184: , 0 );
185: putop( P2PLUS , P2INT );
186: }
187: }
188: arycod( p , co[1] );
189: f = o = 0;
190: continue;
191: case T_FIELD:
192: /*
193: * Field names are just
194: * an offset with some
195: * semantic checking.
196: */
197: p = reclook(p, co[1]);
198: o += p -> value[0];
199: continue;
200: default:
201: panic("lval2");
202: }
203: }
204: if (f) {
205: putLV( firstsymbol , firstbn , o , p2type( p -> type ) );
206: } else {
207: if (o) {
208: putleaf( P2ICON , o , 0 , P2INT , 0 );
209: putop( P2PLUS , P2INT );
210: }
211: }
212: if ( required == RREQ ) {
213: putop( P2UNARY P2MUL , p2type( p -> type ) );
214: }
215: return ( p -> type );
216: }
217:
218: /*
219: * this recursively follows done a list of qualifications
220: * and puts out the beginnings of calls to fnil for files
221: * or nil for pointers (if checking is on) on the way back.
222: * this returns true or false.
223: */
224: nilfnil( p , c , modflag , firstp , r2 )
225: struct nl *p;
226: int *c;
227: int modflag;
228: struct nl *firstp;
229: char *r2; /* no, not r2-d2 */
230: {
231: int *co;
232: struct nl *lastp;
233: int t;
234:
235: if ( c == NIL ) {
236: return TRUE;
237: }
238: co = (int *) ( c[1] );
239: if ( co == NIL ) {
240: return FALSE;
241: }
242: lastp = p;
243: p = p -> type;
244: if ( p == NIL ) {
245: return FALSE;
246: }
247: switch ( co[0] ) {
248: case T_PTR:
249: /*
250: * Pointer qualification.
251: */
252: lastp -> nl_flags |= NUSED;
253: if ( p -> class != PTR && p -> class != FILET) {
254: error("^ allowed only on files and pointers, not on %ss", nameof(p));
255: goto bad;
256: }
257: break;
258: case T_ARGL:
259: if ( p -> class != ARRAY ) {
260: if ( lastp == firstp ) {
261: error("%s is a %s, not a function", r2, classes[firstp -> class]);
262: } else {
263: error("Illegal function qualificiation");
264: }
265: return FALSE;
266: }
267: recovered();
268: error("Pascal uses [] for subscripting, not ()");
269: /* and fall through */
270: case T_ARY:
271: if ( p -> class != ARRAY ) {
272: error("Subscripting allowed only on arrays, not on %ss", nameof(p));
273: goto bad;
274: }
275: codeoff();
276: t = arycod( p , co[1] );
277: codeon();
278: switch ( t ) {
279: case 0:
280: return FALSE;
281: case -1:
282: goto bad;
283: }
284: break;
285: case T_FIELD:
286: /*
287: * Field names are just
288: * an offset with some
289: * semantic checking.
290: */
291: if ( p -> class != RECORD ) {
292: error(". allowed only on records, not on %ss", nameof(p));
293: goto bad;
294: }
295: if ( co[1] == NIL ) {
296: return FALSE;
297: }
298: p = reclook( p , co[1] );
299: if ( p == NIL ) {
300: error("%s is not a field in this record", co[1]);
301: goto bad;
302: }
303: if ( modflag & MOD ) {
304: p -> nl_flags |= NMOD;
305: }
306: if ( ( modflag & NOUSE ) == 0 || lptr( c[2] ) ) {
307: p -> nl_flags |= NUSED;
308: }
309: break;
310: default:
311: panic("nilfnil");
312: }
313: /*
314: * recursive call, check the rest of the qualifications.
315: */
316: if ( ! nilfnil( p , c[2] , modflag , firstp , r2 ) ) {
317: return FALSE;
318: }
319: /*
320: * the point of all this.
321: */
322: if ( co[0] == T_PTR ) {
323: if ( p -> class == PTR ) {
324: if ( opt( 't' ) ) {
325: putleaf( P2ICON , 0 , 0
326: , ADDTYPE( P2FTN | P2INT , P2PTR )
327: , "_NIL" );
328: }
329: } else {
330: putleaf( P2ICON , 0 , 0
331: , ADDTYPE( P2FTN | P2INT , P2PTR )
332: , "_FNIL" );
333: }
334: }
335: return TRUE;
336: bad:
337: cerror("Error occurred on qualification of %s", r2);
338: return FALSE;
339: }
340: #endif PC
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.