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