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: }
Defined functions
precset
defined in line 46; used 5 times
- in /usr/src/ucb/pascal/src/0.h line 728
- in /usr/src/ucb/pascal/src/rval.c line 358, 375, 905, 917
Defined variables
Defined macros
BITSPERBYTE
defined in line 32; never used
|
Last modified: 1985-06-05
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1601 |
|