4.3BSD - /usr/src/usr.bin/efl/exec.c

   1: #include "defs"
   2: 
   3: exlab(n)
   4: register int n;
   5: {
   6: if(n==0 && thisexec->labelno && !(thisexec->labused))
   7:     {
   8:     thisexec->labused = 1;
   9:     n = thisexec->labelno;
  10:     }
  11: 
  12: if(!prevbg || n!=0)  /* avoid empty statement */
  13:     {
  14:     if(comments && !afterif) putcomment();
  15:     putic(ICBEGIN, n);
  16:     putic(ICINDENT, ctllevel);
  17:     if(n != 0)
  18:         if(stnos[n] != 0)
  19:             fatal("statement number changed");
  20:         else    stnos[n] = ( nxtstno += tailor.deltastno) ;
  21:     TEST fprintf(diagfile, "LABEL %d\n", n);
  22:     thisexec->nftnst++;
  23:     afterif = 0;
  24:     }
  25: }
  26: 
  27: 
  28: exgoto(n)
  29: int n;
  30: {
  31: exlab(0);
  32: exgo1(n);
  33: }
  34: 
  35: exgoind(n)
  36: int n;
  37: {
  38: exlab(0);
  39: putic(ICKEYWORD,FGOTO);
  40: putic(ICINDPTR,n);
  41: TEST fprintf(diagfile, "goto indirect %o\n", n);
  42: }
  43: 
  44: 
  45: 
  46: exgo1(n)
  47: int n;
  48: {
  49: putic(ICKEYWORD,FGOTO);
  50: putic(ICLABEL,n);
  51: TEST fprintf(diagfile, "goto %d\n", n);
  52: }
  53: 
  54: 
  55: excompgoto(labs,index)
  56: ptr labs;
  57: register ptr index;
  58: {
  59: register int first;
  60: register ptr p;
  61: 
  62: index = simple(LVAL,index);
  63: if(tailor.ftn77)
  64:     exlab(0);
  65: else
  66:     {
  67:     int ncases = 0;
  68:     for(p = labs ; p ; p = p->nextp)
  69:         ++ncases;
  70:     exif1( mknode(TLOGOP, OPAND,
  71:         mknode(TRELOP,OPGT, cpexpr(index), mkint(0)),
  72:         mknode(TRELOP,OPLE, cpexpr(index), mkint(ncases)) ));
  73:     }
  74: 
  75: putic(ICKEYWORD, FGOTO);
  76: putic(ICOP,OPLPAR);
  77: 
  78: first = 1;
  79: for(p = labs ; p ; p = p->nextp)
  80:     {
  81:     if(first)   first = 0;
  82:     else   putic(ICOP,OPCOMMA);
  83:     putic(ICLABEL,p->datap);
  84:     }
  85: putic(ICOP,OPRPAR);
  86: frchain(&labs);
  87: 
  88: putic(ICOP,OPCOMMA);
  89: prexpr(index);
  90: frexpr(index);
  91: TEST fprintf(diagfile, "computed goto\n");
  92: }
  93: 
  94: 
  95: 
  96: 
  97: excall(p)
  98: register ptr p;
  99: {
 100: register ptr q1, q2, q3;
 101: ptr mkholl(), exioop();
 102: 
 103: if(p->tag==TNAME || p->tag==TFTNBLOCK)
 104:     p = mkcall(p, PNULL);
 105: 
 106: if(p->tag == TERROR)
 107:     {
 108:     frexpr(p);
 109:     return;
 110:     }
 111: if(p->tag != TCALL)
 112:     badtag("excall", p->tag);
 113: 
 114: q1 = p->leftp;
 115: q2 = (q1->tag==TFTNBLOCK ? q1 : q1->sthead->varp);
 116: if(q2->vtype!=TYUNDEFINED && q2->vtype!=TYSUBR)
 117:     {
 118:     dclerr("attempt to use a variable as a subroutine", p->sthead->namep);
 119:     frexpr(p);
 120:     return;
 121:     }
 122: q1->vtype = q2->vtype = TYSUBR;
 123: if(q1->vdcldone==0)
 124:     dclit(q1);
 125: 
 126: if(q1->tag == TNAME)
 127:     {
 128:     if( equals(q2->sthead->namep, "stop") )
 129:         {
 130:         exlab(0);
 131:         putic(ICKEYWORD, FSTOP);
 132:         TEST fprintf(diagfile,"stop ");
 133:         if( (q1 = p->rightp) && (q1 = q1->leftp) )
 134:             prexpr( simple(RVAL, q1->datap) );
 135:         goto done;
 136:         }
 137:     if( ioop(q2->sthead->namep) )
 138:         {
 139:         exioop(p,NO);
 140:         goto done;
 141:         }
 142:     }
 143: 
 144: p = simple(RVAL,p);
 145: exlab(0);
 146: putic(ICKEYWORD,FCALL);
 147: TEST fprintf(diagfile, "call ");
 148: /* replace character constant arguments with holleriths */
 149: if( (q1=p->rightp) && tailor.hollincall)
 150:     for(q1 = q1->leftp ; q1 ; q1 = q1->nextp)
 151:         if( (q2 = q1->datap)->tag==TCONST
 152:             && q2->vtype==TYCHAR)
 153:             {
 154:             q2->vtype = TYHOLLERITH;
 155:             frexpr(q2->vtypep);
 156:             q2->vtypep = 0;
 157:             q2->leftp = mkholl(q3 = q2->leftp);
 158:             cfree(q3);
 159:             }
 160: prexpr( p );
 161: 
 162: done:   frexpr(p);
 163: }
 164: 
 165: 
 166: 
 167: 
 168: ptr mkholl(p)
 169: register char *p;
 170: {
 171: register char *q, *t, *s;
 172: int n;
 173: 
 174: n = strlen(p);
 175: q = convic(n);
 176: s = t = calloc(n + 2 + strlen(q) , 1);
 177: while(*q)
 178:     *t++ = *q++;
 179: *t++ = 'h';
 180: while(*t++ = *p++ )
 181:     ;
 182: return(s);
 183: }
 184: 
 185: 
 186: ptr ifthen()
 187: {
 188: ptr p;
 189: ptr addexec();
 190: 
 191: p = addexec();
 192: thisexec->brnchend = 0;
 193: if(thisexec->nftnst == 0)
 194:     {
 195:     exlab(0);
 196:     putic(ICKEYWORD,FCONTINUE);
 197:     thisexec->nftnst = 1;
 198:     }
 199: if(thisexec->nftnst>1 || thisexec->labeled || thisexec->uniffable )
 200:     {
 201:     if(thisctl->breaklab == 0)
 202:         thisctl->breaklab = nextlab();
 203:     indifs[thisctl->indifn] = thisctl->breaklab;
 204:     }
 205: else    thisctl->breaklab = 0;
 206: return(p);
 207: }
 208: 
 209: 
 210: 
 211: exasgn(l,o,r)
 212: ptr l;
 213: int o;
 214: ptr r;
 215: {
 216: exlab(0);
 217: if(l->vdcldone == 0)
 218:     dclit(l);
 219: frexpr( simple(LVAL , mknode(TASGNOP,o,l,r)) );
 220: }
 221: 
 222: exretn(p)
 223: ptr p;
 224: {
 225: if(p)
 226:     {
 227:     if(procname && procname->vtype && procname->vtype!=TYCHAR &&
 228:       (procname->vtype!=TYLCOMPLEX || tailor.lngcxtype!=NULL) )
 229:         {
 230:         if(p->tag!=TNAME || p->sthead!=procname->sthead)
 231:             exasgn( cpexpr(procname) , OPASGN, p);
 232:         }
 233:     else execerr("can only return values in a function", PNULL);
 234:     }
 235: else if(procname && procname->vtype)
 236:      warn("function return without data value");
 237: exlab(0);
 238: putic(ICKEYWORD, FRETURN);
 239: 
 240: TEST {fprintf(diagfile, "exec: return( " );  prexpr(p);  fprintf(diagfile, ")\n" );  }
 241: }
 242: 
 243: 
 244: exnull()
 245: {
 246: if(thisexec->labelno && !(thisexec->labused) )
 247:     {
 248:     exlab(0);
 249:     putic(ICKEYWORD,FCONTINUE);
 250:     }
 251: }
 252: 
 253: 
 254: 
 255: 
 256: exbrk(opnext,levskip,btype)
 257: int opnext;
 258: ptr levskip;
 259: int btype;
 260: {
 261: 
 262: if(opnext && (btype==STSWITCH || btype==STPROC))
 263:     execerr("illegal next", PNULL);
 264: else if(!opnext && btype==STPROC)
 265:     exretn(PNULL);
 266: else  brknxtlab(opnext,levskip,btype);
 267: TEST fprintf(diagfile, "exec: %s\n", (opnext ? "next" : "exit"));
 268: 
 269: }
 270: 
 271: 
 272: 
 273: exif(e)
 274: register ptr e;
 275: {
 276: int tag;
 277: 
 278: if( (tag = e->tag)==TERROR || e->vtype!=TYLOG)
 279:     {
 280:     frexpr(e);
 281:     e = mkconst(TYLOG, ".true.");
 282:     if(tag != TERROR)
 283:         execerr("non-logical conditional expression in if", PNULL);
 284:     }
 285: TEST fprintf(diagfile, "exif called\n");
 286: e = simple(RVAL,e);
 287: exlab(0);
 288: putic(ICKEYWORD,FIF2);
 289: indifs[thisctl->indifn = nextindif()] = 0;
 290: putic(ICINDPTR, thisctl->indifn);
 291: putic(ICOP,OPLPAR);
 292: prexpr(e);
 293: putic(ICOP,OPRPAR);
 294: putic(ICMARK,0);
 295: putic(ICOP,OPLPAR);
 296: prexpr(e = simple(RVAL, mknode(TNOTOP,OPNOT,e,PNULL)));
 297: putic(ICOP,OPRPAR);
 298: putic(ICMARK,0);
 299: afterif = 1;
 300: frexpr(e);
 301: }
 302: 
 303: 
 304: exifgo(e,l)
 305: ptr e;
 306: int l;
 307: {
 308: exlab(0);
 309: exif1(e);
 310: exgo1(l);
 311: }
 312: 
 313: 
 314: exif1(e)
 315: register ptr e;
 316: {
 317: e = simple(RVAL,e);
 318: exlab(0);
 319: putic(ICKEYWORD,FIF1);
 320: putic(ICOP,OPLPAR);
 321: TEST fprintf(diagfile, "if1 ");
 322: prexpr( e );
 323: frexpr(e);
 324: putic(ICOP,OPRPAR);
 325: putic(ICBLANK, 1);
 326: }
 327: 
 328: 
 329: 
 330: 
 331: 
 332: 
 333: 
 334: brkcase()
 335: {
 336: ptr bgnexec();
 337: 
 338: if(ncases==0 /* && thisexec->prevexec->brnchend==0 */ )
 339:     {
 340:     exbrk(0, PNULL, 0);
 341:     addexec();
 342:     bgnexec();
 343:     }
 344: ncases = 1;
 345: }
 346: 
 347: 
 348: brknxtlab(opnext, levp, btype)
 349: int opnext;
 350: ptr levp;
 351: int btype;
 352: {
 353: register ptr p;
 354: int levskip;
 355: 
 356: levskip = ( levp ? convci(levp->leftp) : 1);
 357: if(levskip <= 0)
 358:     {
 359:     execerr("illegal break count %d", levskip);
 360:     return;
 361:     }
 362: 
 363: for(p = thisctl ; p!=0 ; p = p->prevctl)
 364:     if( (btype==0 || p->subtype==btype) &&
 365:         p->subtype!=STIF && p->subtype!=STPROC &&
 366:         (!opnext || p->subtype!=STSWITCH) )
 367:         if(--levskip == 0) break;
 368: 
 369: if(p == 0)
 370:     {
 371:     execerr("invalid break/next", PNULL);
 372:     return;
 373:     }
 374: 
 375: if(p->subtype==STREPEAT && opnext)
 376:     exgoind(p->indifn);
 377: else if(opnext)
 378:     exgoto(p->nextlab);
 379: else    {
 380:     if(p->breaklab == 0)
 381:         p->breaklab = nextlab();
 382:     exgoto(p->breaklab);
 383:     }
 384: }
 385: 
 386: 
 387: 
 388: ptr doloop(p1,p2,p3)
 389: ptr p1;
 390: ptr p2;
 391: ptr p3;
 392: {
 393: register ptr p, q;
 394: register int i;
 395: int val[3];
 396: 
 397: p = ALLOC(doblock);
 398: p->tag = TDOBLOCK;
 399: 
 400: if(p1->tag!=TASGNOP || p1->subtype!=OPASGN || p1->leftp->tag!=TNAME)
 401:     {
 402:     p->dovar = gent(TYINT, PNULL);
 403:     p->dopar[0] = p1;
 404:     }
 405: else    {
 406:     p->dovar = p1->leftp;
 407:     p->dopar[0] = p1->rightp;
 408:     frexpblock(p1);
 409:     }
 410: if(p2 == 0)
 411:     {
 412:     p->dopar[1] = p->dopar[0];
 413:     p->dopar[0] = mkint(1);
 414:     }
 415: else    p->dopar[1] = p2;
 416: p->dopar[2] = p3;
 417: 
 418: for(i = 0; i<3 ; ++i)
 419:     {
 420:     if(q = p->dopar[i])
 421:         {
 422:         if( (q->tag==TNAME || q->tag==TTEMP) &&
 423:            (q->vsubs || q->voffset) )
 424:             p->dopar[i] = simple(RVAL,mknode(TASGNOP,0,
 425:                 gent(TYINT,PNULL), q));
 426:         else
 427:             p->dopar[i] = simple(LVAL, coerce(TYINT, q) );
 428: 
 429:         if(isicon(p->dopar[i], &val[i]))
 430:             {
 431:             if(val[i] <= 0)
 432:                 execerr("do parameter out of range", PNULL);
 433:             }
 434:         else    val[i] = -1;
 435:         }
 436:     }
 437: 
 438: if(val[0]>0 && val[1]>0 && val[0]>val[1])
 439:     execerr("do parameters out of order", PNULL);
 440: return(p);
 441: }

Defined functions