1: #include "defs" 2: 3: 4: hide(p) 5: ptr p; 6: { 7: warn1("Name %s hidden by a new declaration", p->namep); 8: hidlist = mkchain(p->varp, hidlist); 9: p->varp = 0; 10: ++nhid[blklevel]; 11: } 12: 13: 14: 15: /* remove all symbol table entries in terminated block, 16: revive old hidden names 17: */ 18: unhide() 19: { 20: chainp p; 21: register ptr q; 22: register ptr v; 23: register struct stentry *s; 24: struct stentry **hp; 25: 26: for(hp = hashtab ; hp<hashend ; ++hp) 27: if(s = *hp) 28: { 29: if( (v = s->varp) && v->blklevel == blklevel) 30: { 31: if(v->tag==TLABEL) 32: if(blklevel <= 1) 33: { 34: if(v->labdefined==0) 35: laberr("%s never defined", 36: v->sthead->namep); 37: s->varp = 0; 38: } 39: else { /* move label out a level */ 40: if(v->labdefined) 41: v->labinacc = 1; 42: v->blklevel--; 43: ++ndecl[blklevel-1]; 44: } 45: else { 46: if(v->tag == TNAME) 47: { 48: TEST fprintf(diagfile,"gone(%s) level %d\n", 49: s->namep, blklevel); 50: gonelist = mkchain(s->varp, gonelist); 51: } 52: 53: else if(v->tag!=TSTRUCT) 54: { 55: ++ndecl[blklevel]; 56: if(v->tag==TDEFINE) 57: frdef(v); 58: } 59: s->varp = 0; 60: } 61: --ndecl[blklevel]; 62: } 63: } 64: 65: for( p=hidlist ; p && ((v = (q=p->datap)->sthead)->varp==NULL) ; p=hidlist ) 66: { 67: v->varp = q; 68: v->tag = q->tag; 69: v->subtype = q->subtype; 70: if(v->blklevel > q->blklevel) 71: v->blklevel = q->blklevel; 72: hidlist = p->nextp; 73: p->nextp = CHNULL; 74: frchain(&p); 75: --nhid[blklevel]; 76: TEST fprintf(diagfile, "unhide(%s), blklevel %d\n", v->namep, v->blklevel); 77: } 78: if(ndecl[blklevel] != 0) 79: { 80: sprintf(msg, "%d declarations leftover at block level %d", 81: ndecl[blklevel], blklevel); 82: fatal(msg); 83: } 84: if(nhid[blklevel] != 0) 85: fatal("leftover hidden variables"); 86: } 87: 88: 89: 90: 91: ptr bgnexec() 92: { 93: register ptr p; 94: 95: p = allexcblock(); 96: p->tag = TEXEC; 97: p->prevexec = thisexec; 98: if(thisexec && thisexec->copylab) 99: { 100: p->labelno = thisexec->labelno; 101: p->labused = thisexec->labused; 102: thisexec->labelno = 0; 103: } 104: thisexec = p; 105: return(p); 106: } 107: 108: 109: ptr addexec() 110: { 111: register ptr p; 112: register ptr q; 113: 114: q = thisexec; 115: p = q->prevexec; 116: 117: if(q->temps) 118: tempvarlist = hookup(q->temps, tempvarlist); 119: 120: p->brnchend = q->brnchend; 121: p->nftnst += q->nftnst; 122: p->labeled |= q->labeled; 123: p->uniffable |= q->uniffable; 124: 125: if(q->labelno && !(q->labused)) 126: { 127: if(q->nxtlabno) 128: exnull(); 129: else q->nxtlabno = q->labelno; 130: } 131: 132: thisexec = p; 133: 134: if(q->nxtlabno) 135: { 136: if(p->labelno && !(p->labused)) 137: exnull(); 138: p->labelno = q->nxtlabno; 139: p->labused = 0; 140: } 141: 142: frexcblock(q); 143: return(p); 144: } 145: 146: 147: 148: pushctl(t,vp) 149: int t; 150: register ptr vp; 151: { 152: register ptr q; 153: ptr p; 154: int junk; 155: 156: q = allexcblock(); 157: q->tag = TCONTROL; 158: q->subtype = t; 159: q->loopvar = vp; 160: q->prevctl = thisctl; 161: thisctl = q; 162: 163: switch(t) 164: { 165: case STSWITCH: 166: q->xlab = nextlab(); 167: q->nextlab = 0; 168: exgoto(q->xlab); 169: ncases = -1; 170: break; 171: 172: case STFOR: 173: exlab(0); 174: q->nextlab = nextlab(); 175: q->xlab = nextlab(); 176: break; 177: 178: case STWHILE: 179: q->nextlab = thislab(); 180: if(vp) 181: exifgo( mknode(TNOTOP,OPNOT,vp,PNULL), 182: q->breaklab = nextlab() ); 183: else thisexec->copylab = 1; 184: break; 185: 186: case STREPEAT: 187: exnull(); 188: q->xlab = thislab(); 189: thisexec->copylab = 1; 190: junk = nextindif(); 191: indifs[junk] = 0; 192: q->indifn = junk; 193: indifs[q->indifn] = q->xlab; 194: break; 195: 196: case STDO: 197: q->nextlab = nextlab(); 198: exlab(0); 199: putic(ICKEYWORD,FDO); 200: putic(ICLABEL, q->nextlab); 201: putic(ICBLANK, 1); 202: p = mknode(TASGNOP,OPASGN,vp->dovar,vp->dopar[0]); 203: prexpr(p); 204: frexpr(p); 205: putic(ICOP, OPCOMMA); 206: prexpr(vp->dopar[1]); 207: frexpr(vp->dopar[1]); 208: if(vp->dopar[2]) 209: { 210: putic(ICOP, OPCOMMA); 211: prexpr(vp->dopar[2]); 212: frexpr(vp->dopar[2]); 213: } 214: cfree(vp); 215: break; 216: 217: case STIF: 218: exif(vp); 219: thisexec->nftnst = 0; 220: break; 221: 222: default: 223: fatal1("pushctl: invalid control block type %d", t); 224: } 225: 226: ++ctllevel; 227: } 228: 229: 230: 231: popctl() 232: { 233: register ptr p; 234: ptr newp; 235: chainp q; 236: int first, deflabno, blab, cmin, cmax, range, caseval, optcase; 237: int labp[MAXSWITCH]; 238: 239: if(thisctl == 0) 240: fatal("empty control stack popped"); 241: 242: switch(thisctl->subtype) 243: { 244: case STSWITCH: 245: /* if(thisexec->brnchend == 0) */ 246: { 247: if(thisctl->breaklab == 0) 248: thisctl->breaklab = nextlab(); 249: exgoto(thisctl->breaklab); 250: } 251: exlab(thisctl->xlab); 252: deflabno = 0; 253: first = YES; 254: optcase = (thisctl->loopvar->vtype == TYINT); 255: 256: for(p=thisctl->loopctl ; p!=0 ; p = p->nextcase) 257: if(p->labdefined == 0) 258: { 259: laberr("undefined case label", CNULL); 260: optcase = NO; 261: } 262: else if(p->casexpr == 0) 263: deflabno = p->labelno; 264: else if( isicon(p->casexpr, &caseval)) 265: { 266: if(first) 267: { 268: first = NO; 269: cmin = cmax = caseval; 270: } 271: else { 272: if(caseval < cmin) 273: cmin = caseval; 274: if(caseval > cmax) 275: cmax = caseval; 276: } 277: ++ncases; 278: } 279: else optcase = NO; 280: 281: range = cmax - cmin + 1; 282: if(optcase && ncases>2 && range<2*ncases && range<MAXSWITCH) 283: { 284: register int i; 285: for(i=0; i<range ; ++i) 286: labp[i] = 0; 287: for(p=thisctl->loopctl ; p!=0 ; p = p->nextcase) 288: if(p->labdefined && p->casexpr) 289: { 290: isicon(p->casexpr, &caseval); 291: frexpr(p->casexpr); 292: labp[caseval-cmin] = p->labelno; 293: } 294: 295: q = CHNULL; 296: blab = (deflabno ? deflabno : thisctl->breaklab); 297: for(i=range-1 ; i>=0 ; --i) 298: q = mkchain(labp[i] ? labp[i] : blab, q); 299: excompgoto(q, mknode(TAROP,OPPLUS, mkint(1-cmin), 300: cpexpr(thisctl->loopvar) )); 301: } 302: else { 303: for(p=thisctl->loopctl ; p!=0 ; p = p->nextcase) 304: if(p->labdefined && p->casexpr) 305: exifgo( mknode(TRELOP,OPEQ, 306: cpexpr(thisctl->loopvar),p->casexpr), 307: p->labelno); 308: } 309: if(deflabno) 310: exgoto(deflabno); 311: 312: for(p = thisctl->loopctl ; p; p = newp) 313: { 314: newp = p->nextcase; 315: cfree(p); 316: } 317: thisctl->loopctl = NULL; 318: break; 319: 320: case STFOR: 321: exgoto(thisctl->nextlab); 322: break; 323: 324: case STWHILE: 325: exgoto(thisctl->nextlab); 326: break; 327: 328: case STREPEAT: 329: break; 330: 331: case STDO: 332: exnull(); 333: exlab(thisctl->nextlab); 334: putic(ICKEYWORD,FCONTINUE); 335: break; 336: 337: case STIF: 338: break; 339: 340: case STPROC: 341: break; 342: 343: default: 344: fatal1("popctl: invalid control block type %d", 345: thisctl->subtype); 346: } 347: 348: if(thisctl->breaklab != 0) 349: thisexec->nxtlabno = thisctl->breaklab; 350: p = thisctl->prevctl; 351: frexcblock(thisctl); 352: thisctl = p; 353: --ctllevel; 354: }