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