![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to cset.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src|
Return to cset.c CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)cset.c 1.7 2/1/83";
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: #include "pc.h"
12: #include "pcops.h"
13: #include "align.h"
14: #endif PC
15:
16: /*
17: * CONSETS causes compile time constant sets to be constructed here.
18: *
19: * COMPSETSZE defines the maximum number of longs to be used in
20: * constant set construction
21: */
22: #define CONSETS
23: #define COMPSETSZE 10
24:
25: #define BITSPERBYTE 8
26: #define BITSPERLONG 32
27: #define LG2BITSBYTE 3
28: #define MSKBITSBYTE 0x07
29: #define LG2BITSLONG 5
30: #define MSKBITSLONG 0x1f
31:
32: /*
33: * rummage through a `constant' set (i.e. anything within [ ]'s) tree
34: * and decide if this is a compile time constant set or a runtime set.
35: * this information is returned in a structure passed from the caller.
36: * while rummaging, this also reorders the tree so that all ranges
37: * preceed all singletons.
38: */
39: bool
40: precset( r , settype , csetp )
41: int *r;
42: struct nl *settype;
43: struct csetstr *csetp;
44: {
45: register int *e;
46: register struct nl *t;
47: register struct nl *exptype;
48: register int *el;
49: register int *pairp;
50: register int *singp;
51: int *ip;
52: int lower;
53: int upper;
54: bool setofint;
55:
56: csetp -> csettype = NIL;
57: csetp -> paircnt = 0;
58: csetp -> singcnt = 0;
59: csetp -> comptime = TRUE;
60: setofint = FALSE;
61: if ( settype != NIL ) {
62: if ( settype -> class == SET ) {
63: /*
64: * the easy case, we are told the type of the set.
65: */
66: exptype = settype -> type;
67: } else {
68: /*
69: * we are told the type, but it's not a set
70: * supposedly possible if someone tries
71: * e.g string context [1,2] = 'abc'
72: */
73: error("Constant set involved in non set context");
74: return csetp -> comptime;
75: }
76: } else {
77: /*
78: * So far we have no indication
79: * of what the set type should be.
80: * We "look ahead" and try to infer
81: * The type of the constant set
82: * by evaluating one of its members.
83: */
84: e = r[2];
85: if (e == NIL) {
86: /*
87: * tentative for [], return type of `intset'
88: */
89: settype = lookup( intset );
90: if ( settype == NIL ) {
91: panic( "empty set" );
92: }
93: settype = settype -> type;
94: if ( settype == NIL ) {
95: return csetp -> comptime;
96: }
97: if ( isnta( settype , "t" ) ) {
98: error("Set default type \"intset\" is not a set");
99: return csetp -> comptime;
100: }
101: csetp -> csettype = settype;
102: setran( settype -> type );
103: if (((set.uprbp + 1) >> LG2BITSLONG) >= COMPSETSZE)
104: csetp -> comptime = FALSE;
105: return csetp -> comptime;
106: }
107: e = e[1];
108: if (e == NIL) {
109: return csetp -> comptime;
110: }
111: if (e[0] == T_RANG) {
112: e = e[1];
113: }
114: codeoff();
115: t = rvalue(e, NIL , RREQ );
116: codeon();
117: if (t == NIL) {
118: return csetp -> comptime;
119: }
120: /*
121: * The type of the set, settype, is
122: * deemed to be a set of the base type
123: * of t, which we call exptype. If,
124: * however, this would involve a
125: * "set of integer", we cop out
126: * and use "intset"'s current scoped
127: * type instead.
128: */
129: if (isa(t, "r")) {
130: error("Sets may not have 'real' elements");
131: return csetp -> comptime;
132: }
133: if (isnta(t, "bcsi")) {
134: error("Set elements must be scalars, not %ss", nameof(t));
135: return csetp -> comptime;
136: }
137: if (isa(t, "i")) {
138: settype = lookup(intset);
139: if (settype == NIL)
140: panic("intset");
141: settype = settype->type;
142: if (settype == NIL)
143: return csetp -> comptime;
144: if (isnta(settype, "t")) {
145: error("Set default type \"intset\" is not a set");
146: return csetp -> comptime;
147: }
148: exptype = settype->type;
149: /*
150: * say we are doing an intset
151: * but, if we get out of range errors for intset
152: * we punt constructing the set at compile time.
153: */
154: setofint = TRUE;
155: } else {
156: exptype = t->type;
157: if (exptype == NIL)
158: return csetp -> comptime;
159: if (exptype->class != RANGE)
160: exptype = exptype->type;
161: settype = defnl(0, SET, exptype, 0);
162: }
163: }
164: csetp -> csettype = settype;
165: # ifndef CONSETS
166: csetp -> comptime = FALSE;
167: # endif CONSETS
168: setran( exptype );
169: if (((set.uprbp + 1) >> LG2BITSLONG) >= COMPSETSZE)
170: csetp -> comptime = FALSE;
171: lower = set.lwrb;
172: upper = set.lwrb + set.uprbp;
173: pairp = NIL;
174: singp = NIL;
175: codeoff();
176: while ( el = r[2] ) {
177: e = el[1];
178: if (e == NIL) {
179: /*
180: * don't hang this one anywhere.
181: */
182: csetp -> csettype = NIL;
183: r[2] = el[2];
184: continue;
185: }
186: if (e[0] == T_RANG) {
187: if ( csetp -> comptime && constval( e[2] ) ) {
188: #ifdef CONSETS
189: t = con.ctype;
190: if ( con.crval < lower || con.crval > upper ) {
191: if ( setofint ) {
192: csetp -> comptime = FALSE;
193: } else {
194: error("Range upper bound of %D out of set bounds" , ((long)con.crval) );
195: csetp -> csettype = NIL;
196: }
197: }
198: #endif CONSETS
199: } else {
200: csetp -> comptime = FALSE;
201: t = rvalue(e[2], NIL , RREQ );
202: if (t == NIL) {
203: rvalue(e[1], NIL , RREQ );
204: goto pairhang;
205: }
206: }
207: if (incompat(t, exptype, e[2])) {
208: cerror("Upper bound of element type clashed with set type in constant set");
209: }
210: if ( csetp -> comptime && constval( e[1] ) ) {
211: #ifdef CONSETS
212: t = con.ctype;
213: if ( con.crval < lower || con.crval > upper ) {
214: if ( setofint ) {
215: csetp -> comptime = FALSE;
216: } else {
217: error("Range lower bound of %D out of set bounds" , ((long)con.crval) );
218: csetp -> csettype = NIL;
219: }
220: }
221: #endif CONSETS
222: } else {
223: csetp -> comptime = FALSE;
224: t = rvalue(e[1], NIL , RREQ );
225: if (t == NIL) {
226: goto pairhang;
227: }
228: }
229: if (incompat(t, exptype, e[1])) {
230: cerror("Lower bound of element type clashed with set type in constant set");
231: }
232: pairhang:
233: /*
234: * remove this range from the tree list and
235: * hang it on the pairs list.
236: */
237: ip = el[2];
238: el[2] = pairp;
239: pairp = r[2];
240: r[2] = ip;
241: csetp -> paircnt++;
242: } else {
243: if ( csetp -> comptime && constval( e ) ) {
244: #ifdef CONSETS
245: t = con.ctype;
246: if ( con.crval < lower || con.crval > upper ) {
247: if ( setofint ) {
248: csetp -> comptime = FALSE;
249: } else {
250: error("Value of %D out of set bounds" , ((long)con.crval) );
251: csetp -> csettype = NIL;
252: }
253: }
254: #endif CONSETS
255: } else {
256: csetp -> comptime = FALSE;
257: t = rvalue((int *) e, NLNIL , RREQ );
258: if (t == NIL) {
259: goto singhang;
260: }
261: }
262: if (incompat(t, exptype, e)) {
263: cerror("Element type clashed with set type in constant set");
264: }
265: singhang:
266: /*
267: * take this expression off the tree list and
268: * hang it on the list of singletons.
269: */
270: ip = el[2];
271: el[2] = singp;
272: singp = r[2];
273: r[2] = ip;
274: csetp -> singcnt++;
275: }
276: }
277: codeon();
278: # ifdef PC
279: if ( pairp != NIL ) {
280: for ( el = pairp ; el[2] != NIL ; el = el[2] ) /* void */;
281: el[2] = singp;
282: r[2] = pairp;
283: } else {
284: r[2] = singp;
285: }
286: # endif PC
287: # ifdef OBJ
288: if ( singp != NIL ) {
289: for ( el = singp ; el[2] != NIL ; el = el[2] ) /* void */;
290: el[2] = pairp;
291: r[2] = singp;
292: } else {
293: r[2] = pairp;
294: }
295: # endif OBJ
296: if ( csetp -> csettype == NIL ) {
297: csetp -> comptime = TRUE;
298: }
299: return csetp -> comptime;
300: }
301:
302: #ifdef CONSETS
303: /*
304: * mask[i] has the low i bits turned off.
305: */
306: long mask[] = {
307: # ifdef DEC11
308: 0xffffffff , 0xfffffffe , 0xfffffffc , 0xfffffff8 ,
309: 0xfffffff0 , 0xffffffe0 , 0xffffffc0 , 0xffffff80 ,
310: 0xffffff00 , 0xfffffe00 , 0xfffffc00 , 0xfffff800 ,
311: 0xfffff000 , 0xffffe000 , 0xffffc000 , 0xffff8000 ,
312: 0xffff0000 , 0xfffe0000 , 0xfffc0000 , 0xfff80000 ,
313: 0xfff00000 , 0xffe00000 , 0xffc00000 , 0xff800000 ,
314: 0xff000000 , 0xfe000000 , 0xfc000000 , 0xf8000000 ,
315: 0xf0000000 , 0xe0000000 , 0xc0000000 , 0x80000000 ,
316: 0x00000000
317: # else
318: 0xffffffff , 0xfeffffff , 0xfcffffff , 0xf8ffffff ,
319: 0xf0ffffff , 0xe0ffffff , 0xc0ffffff , 0x80ffffff ,
320: 0x00ffffff , 0x00feffff , 0x00fcffff , 0x00f8ffff ,
321: 0x00f0ffff , 0x00e0ffff , 0x00c0ffff , 0x0080ffff ,
322: 0x0000ffff , 0x0000feff , 0x0000fcff , 0x0000f8ff ,
323: 0x0000f0ff , 0x0000e0ff , 0x0000c0ff , 0x000080ff ,
324: 0x000000ff , 0x000000fe , 0x000000fc , 0x000000f8 ,
325: 0x000000f0 , 0x000000e0 , 0x000000c0 , 0x00000080 ,
326: 0x00000000
327: # endif DEC11
328: };
329: /*
330: * given a csetstr, either
331: * put out a compile time constant set and an lvalue to it.
332: * or
333: * put out rvalues for the singletons and the pairs
334: * and counts of each.
335: */
336: #endif CONSETS
337: postcset( r , csetp )
338: int *r;
339: struct csetstr *csetp;
340: {
341: register int *el;
342: register int *e;
343: int lower;
344: int upper;
345: int lowerdiv;
346: int lowermod;
347: int upperdiv;
348: int uppermod;
349: int label;
350: long *lp;
351: long *limit;
352: long tempset[ COMPSETSZE ];
353: long temp;
354: char *cp;
355: # ifdef PC
356: char labelname[ BUFSIZ ];
357: # endif PC
358:
359: if ( csetp -> comptime ) {
360: #ifdef CONSETS
361: setran( ( csetp -> csettype ) -> type );
362: limit = &tempset[ ( set.uprbp >> LG2BITSLONG ) + 1 ];
363: for ( lp = &tempset[0] ; lp < limit ; lp++ ) {
364: *lp = 0;
365: }
366: for ( el = r[2] ; el != NIL ; el = el[2] ) {
367: e = el[1];
368: if ( e[0] == T_RANG ) {
369: constval( e[1] );
370: lower = con.crval;
371: constval( e[2] );
372: upper = con.crval;
373: if ( upper < lower ) {
374: continue;
375: }
376: lowerdiv = ( lower - set.lwrb ) >> LG2BITSLONG;
377: lowermod = ( lower - set.lwrb ) & MSKBITSLONG;
378: upperdiv = ( upper - set.lwrb ) >> LG2BITSLONG;
379: uppermod = ( upper - set.lwrb ) & MSKBITSLONG;
380: temp = mask[ lowermod ];
381: if ( lowerdiv == upperdiv ) {
382: temp &= ~mask[ uppermod + 1 ];
383: }
384: tempset[ lowerdiv ] |= temp;
385: limit = &tempset[ upperdiv-1 ];
386: for ( lp = &tempset[ lowerdiv+1 ] ; lp <= limit ; lp++ ) {
387: *lp |= 0xffffffff;
388: }
389: if ( lowerdiv != upperdiv ) {
390: tempset[ upperdiv ] |= ~mask[ uppermod + 1 ];
391: }
392: } else {
393: constval( e );
394: temp = con.crval - set.lwrb;
395: cp = (char *)tempset;
396: cp[temp >> LG2BITSBYTE] |= (1 << (temp & MSKBITSBYTE));
397: }
398: }
399: if ( !CGENNING )
400: return;
401: # ifdef PC
402: label = getlab();
403: putprintf(" .data" , 0 );
404: aligndot(A_SET);
405: putlab( label );
406: lp = &( tempset[0] );
407: limit = &tempset[ ( set.uprbp >> LG2BITSLONG ) + 1 ];
408: while (lp < limit) {
409: putprintf(" .long 0x%x", 1, *lp++);
410: for (temp = 2 ; temp <= 8 && lp < limit ; temp++) {
411: putprintf(",0x%x", 1, *lp++);
412: }
413: putprintf("", 0);
414: }
415: putprintf(" .text", 0);
416: sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label );
417: putleaf( P2ICON , 0 , 0 , P2PTR | P2STRTY , labelname );
418: # endif PC
419: # ifdef OBJ
420: put(2, O_CON, (int)(((set.uprbp >> LG2BITSLONG) + 1) *
421: (BITSPERLONG >> LG2BITSBYTE)));
422: lp = &( tempset[0] );
423: limit = &tempset[ ( set.uprbp >> LG2BITSLONG ) + 1 ];
424: while ( lp < limit ) {
425: put(2, O_CASE4, *lp ++);
426: }
427: # endif OBJ
428: #else
429: panic("const cset");
430: #endif CONSETS
431: } else {
432: # ifdef PC
433: putleaf( P2ICON , csetp -> paircnt , 0 , P2INT , 0 );
434: putop( P2LISTOP , P2INT );
435: putleaf( P2ICON , csetp -> singcnt , 0 , P2INT , 0 );
436: putop( P2LISTOP , P2INT );
437: for ( el = r[2] ; el != NIL ; el = el[2] ) {
438: e = el[1];
439: if ( e[0] == T_RANG ) {
440: rvalue( e[2] , NIL , RREQ );
441: putop( P2LISTOP , P2INT );
442: rvalue( e[1] , NIL , RREQ );
443: putop( P2LISTOP , P2INT );
444: } else {
445: rvalue( e , NIL , RREQ );
446: putop( P2LISTOP , P2INT );
447: }
448: }
449: # endif PC
450: # ifdef OBJ
451: for ( el = r[2] ; el != NIL ; el = el[2] ) {
452: e = el[1];
453: if ( e[0] == T_RANG ) {
454: stkrval( e[1] , NIL , RREQ );
455: stkrval( e[2] , NIL , RREQ );
456: } else {
457: stkrval( e , NIL , RREQ );
458: }
459: }
460: put(2 , O_CON24 , (int)csetp -> singcnt );
461: put(2 , O_CON24 , (int)csetp -> paircnt );
462: # endif OBJ
463: }
464: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.