![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to exec.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1|
Return to exec.c CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1 |
1.1 ! root 1: /* %W% (Berkeley) %G% */ ! 2: #include "defs.h" ! 3: #include "optim.h" ! 4: ! 5: ! 6: /* Logical IF codes ! 7: */ ! 8: ! 9: ! 10: exif(p) ! 11: expptr p; ! 12: { ! 13: register int k; ! 14: pushctl(CTLIF); ! 15: ctlstack->elselabel = newlabel(); ! 16: ! 17: if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL) ! 18: { ! 19: if(k != TYERROR) ! 20: err("non-logical expression in IF statement"); ! 21: frexpr(p); ! 22: } ! 23: else if (optimflag) ! 24: optbuff (SKIFN, p, ctlstack->elselabel, 0); ! 25: else ! 26: putif (p, ctlstack->elselabel); ! 27: } ! 28: ! 29: ! 30: ! 31: exelif(p) ! 32: expptr p; ! 33: { ! 34: int k,oldelse; ! 35: ! 36: if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL) ! 37: { ! 38: if(k != TYERROR) ! 39: err("non-logical expression in IF statement"); ! 40: frexpr(p); ! 41: } ! 42: else { ! 43: if(ctlstack->ctltype == CTLIF) ! 44: { ! 45: if(ctlstack->endlabel == 0) ctlstack->endlabel = newlabel(); ! 46: oldelse=ctlstack->elselabel; ! 47: ctlstack->elselabel = newlabel(); ! 48: if (optimflag) ! 49: { ! 50: optbuff (SKGOTO, 0, ctlstack->endlabel, 0); ! 51: optbuff (SKLABEL, 0, oldelse, 0); ! 52: optbuff (SKIFN, p, ctlstack->elselabel, 0); ! 53: } ! 54: else ! 55: { ! 56: putgoto (ctlstack->endlabel); ! 57: putlabel (oldelse); ! 58: putif (p, ctlstack->elselabel); ! 59: } ! 60: } ! 61: else execerr("elseif out of place", CNULL); ! 62: } ! 63: } ! 64: ! 65: ! 66: ! 67: ! 68: ! 69: exelse() ! 70: { ! 71: if(ctlstack->ctltype==CTLIF) ! 72: { ! 73: if(ctlstack->endlabel == 0) ! 74: ctlstack->endlabel = newlabel(); ! 75: ctlstack->ctltype = CTLELSE; ! 76: if (optimflag) ! 77: { ! 78: optbuff (SKGOTO, 0, ctlstack->endlabel, 0); ! 79: optbuff (SKLABEL, 0, ctlstack->elselabel, 0); ! 80: } ! 81: else ! 82: { ! 83: putgoto (ctlstack->endlabel); ! 84: putlabel (ctlstack->elselabel); ! 85: } ! 86: } ! 87: ! 88: else execerr("else out of place", CNULL); ! 89: } ! 90: ! 91: ! 92: exendif() ! 93: { ! 94: if (ctlstack->ctltype == CTLIF) ! 95: { ! 96: if (optimflag) ! 97: { ! 98: optbuff (SKLABEL, 0, ctlstack->elselabel, 0); ! 99: if (ctlstack->endlabel) ! 100: optbuff (SKLABEL, 0, ctlstack->endlabel, 0); ! 101: } ! 102: else ! 103: { ! 104: putlabel (ctlstack->elselabel); ! 105: if (ctlstack->endlabel) ! 106: putlabel (ctlstack->endlabel); ! 107: } ! 108: popctl (); ! 109: } ! 110: else if (ctlstack->ctltype == CTLELSE) ! 111: { ! 112: if (optimflag) ! 113: optbuff (SKLABEL, 0, ctlstack->endlabel, 0); ! 114: else ! 115: putlabel (ctlstack->endlabel); ! 116: popctl (); ! 117: } ! 118: else ! 119: execerr("endif out of place", CNULL); ! 120: } ! 121: ! 122: ! 123: ! 124: LOCAL pushctl(code) ! 125: int code; ! 126: { ! 127: register int i; ! 128: ! 129: /* fprintf(diagfile,"old blklevel %d \n",blklevel); dmpframe(ctlstack); */ ! 130: if(++ctlstack >= lastctl) ! 131: many("loops or if-then-elses", 'c'); ! 132: ctlstack->ctltype = code; ! 133: for(i = 0 ; i < 4 ; ++i) ! 134: ctlstack->ctlabels[i] = 0; ! 135: ++blklevel; ! 136: } ! 137: ! 138: ! 139: LOCAL popctl() ! 140: { ! 141: if( ctlstack-- < ctls ) ! 142: fatal("control stack empty"); ! 143: --blklevel; ! 144: } ! 145: ! 146: ! 147: ! 148: LOCAL poplab() ! 149: { ! 150: register struct Labelblock *lp; ! 151: ! 152: for(lp = labeltab ; lp < highlabtab ; ++lp) ! 153: if(lp->labdefined) ! 154: { ! 155: /* mark all labels in inner blocks unreachable */ ! 156: if(lp->blklevel > blklevel) ! 157: lp->labinacc = YES; ! 158: } ! 159: else if(lp->blklevel > blklevel) ! 160: { ! 161: /* move all labels referred to in inner blocks out a level */ ! 162: lp->blklevel = blklevel; ! 163: } ! 164: } ! 165: ! 166: ! 167: ! 168: /* BRANCHING CODE ! 169: */ ! 170: ! 171: exgoto(lab) ! 172: struct Labelblock *lab; ! 173: { ! 174: if (optimflag) ! 175: optbuff (SKGOTO, 0, lab->labelno, 0); ! 176: else ! 177: putgoto (lab->labelno); ! 178: } ! 179: ! 180: ! 181: ! 182: ! 183: ! 184: ! 185: ! 186: exequals(lp, rp) ! 187: register struct Primblock *lp; ! 188: register expptr rp; ! 189: { ! 190: register Namep np; ! 191: ! 192: if(lp->tag != TPRIM) ! 193: { ! 194: err("assignment to a non-variable"); ! 195: frexpr(lp); ! 196: frexpr(rp); ! 197: } ! 198: else if(lp->namep->vclass!=CLVAR && lp->argsp) ! 199: { ! 200: if(parstate >= INEXEC) ! 201: err("assignment to an undimemsioned array"); ! 202: else ! 203: mkstfunct(lp, rp); ! 204: } ! 205: else ! 206: { ! 207: np = (Namep) lp->namep; ! 208: if (np->vclass == CLPROC && np->vprocclass == PTHISPROC ! 209: && proctype == TYSUBR) ! 210: { ! 211: err("assignment to a subroutine name"); ! 212: return; ! 213: } ! 214: if(parstate < INDATA) ! 215: enddcl(); ! 216: if (optimflag) ! 217: optbuff (SKEQ, mkexpr(OPASSIGN, mklhs(lp), fixtype(rp)), 0, 0); ! 218: else ! 219: puteq (mklhs(lp), fixtype(rp)); ! 220: } ! 221: } ! 222: ! 223: ! 224: ! 225: mkstfunct(lp, rp) ! 226: struct Primblock *lp; ! 227: expptr rp; ! 228: { ! 229: register struct Primblock *p; ! 230: register Namep np; ! 231: chainp args; ! 232: ! 233: if(parstate < INDATA) ! 234: { ! 235: enddcl(); ! 236: parstate = INDATA; ! 237: } ! 238: ! 239: np = lp->namep; ! 240: if(np->vclass == CLUNKNOWN) ! 241: np->vclass = CLPROC; ! 242: else ! 243: { ! 244: dclerr("redeclaration of statement function", np); ! 245: return; ! 246: } ! 247: np->vprocclass = PSTFUNCT; ! 248: np->vstg = STGSTFUNCT; ! 249: impldcl(np); ! 250: args = (lp->argsp ? lp->argsp->listp : CHNULL); ! 251: np->varxptr.vstfdesc = mkchain(args , rp ); ! 252: ! 253: for( ; args ; args = args->nextp) ! 254: if( args->datap->tag!=TPRIM || ! 255: (p = (struct Primblock *) (args->datap) )->argsp || ! 256: p->fcharp || p->lcharp ) ! 257: err("non-variable argument in statement function definition"); ! 258: else ! 259: { ! 260: args->datap = (tagptr) (p->namep); ! 261: vardcl(p->namep); ! 262: free(p); ! 263: } ! 264: } ! 265: ! 266: ! 267: ! 268: excall(name, args, nstars, labels) ! 269: Namep name; ! 270: struct Listblock *args; ! 271: int nstars; ! 272: struct Labelblock *labels[ ]; ! 273: { ! 274: register expptr p; ! 275: ! 276: settype(name, TYSUBR, ENULL); ! 277: p = mkfunct( mkprim(name, args, CHNULL) ); ! 278: p->exprblock.vtype = p->exprblock.leftp->headblock.vtype = TYINT; ! 279: if (nstars > 0) ! 280: if (optimflag) ! 281: optbuff (SKCMGOTO, p, nstars, labels); ! 282: else ! 283: putcmgo (p, nstars, labels); ! 284: else ! 285: if (optimflag) ! 286: optbuff (SKCALL, p, 0, 0); ! 287: else ! 288: putexpr (p); ! 289: } ! 290: ! 291: ! 292: ! 293: exstop(stop, p) ! 294: int stop; ! 295: register expptr p; ! 296: { ! 297: char *q; ! 298: int n; ! 299: expptr mkstrcon(); ! 300: ! 301: if(p) ! 302: { ! 303: if( ! ISCONST(p) ) ! 304: { ! 305: execerr("pause/stop argument must be constant", CNULL); ! 306: frexpr(p); ! 307: p = mkstrcon(0, CNULL); ! 308: } ! 309: else if( ISINT(p->constblock.vtype) ) ! 310: { ! 311: q = convic(p->constblock.const.ci); ! 312: n = strlen(q); ! 313: if(n > 0) ! 314: { ! 315: p->constblock.const.ccp = copyn(n, q); ! 316: p->constblock.vtype = TYCHAR; ! 317: p->constblock.vleng = (expptr) ICON(n); ! 318: } ! 319: else ! 320: p = (expptr) mkstrcon(0, CNULL); ! 321: } ! 322: else if(p->constblock.vtype != TYCHAR) ! 323: { ! 324: execerr("pause/stop argument must be integer or string", CNULL); ! 325: p = (expptr) mkstrcon(0, CNULL); ! 326: } ! 327: } ! 328: else p = (expptr) mkstrcon(0, CNULL); ! 329: ! 330: if (optimflag) ! 331: optbuff ((stop ? SKSTOP : SKPAUSE), p, 0, 0); ! 332: else ! 333: putexpr (call1(TYSUBR, (stop ? "s_stop" : "s_paus"), p)); ! 334: } ! 335: ! 336: ! 337: /* UCB DO LOOP CODE */ ! 338: ! 339: #define DOINIT par[0] ! 340: #define DOLIMIT par[1] ! 341: #define DOINCR par[2] ! 342: ! 343: #define CONSTINIT const[0] ! 344: #define CONSTLIMIT const[1] ! 345: #define CONSTINCR const[2] ! 346: ! 347: #define VARSTEP 0 ! 348: #define POSSTEP 1 ! 349: #define NEGSTEP 2 ! 350: ! 351: ! 352: exdo(range, spec) ! 353: int range; ! 354: chainp spec; ! 355: ! 356: { ! 357: register expptr p, q; ! 358: expptr q1; ! 359: register Namep np; ! 360: chainp cp; ! 361: register int i; ! 362: int dotype, incsign; ! 363: Addrp dovarp, dostgp; ! 364: expptr par[3]; ! 365: expptr const[3]; ! 366: Slotp doslot; ! 367: ! 368: pushctl(CTLDO); ! 369: dorange = ctlstack->dolabel = range; ! 370: np = (Namep) (spec->datap); ! 371: ctlstack->donamep = NULL; ! 372: if(np->vdovar) ! 373: { ! 374: errstr("nested loops with variable %s", varstr(VL,np->varname)); ! 375: return; ! 376: } ! 377: ! 378: dovarp = mkplace(np); ! 379: if( ! ONEOF(dovarp->vtype, MSKINT|MSKREAL) ) ! 380: { ! 381: err("bad type on DO variable"); ! 382: return; ! 383: } ! 384: ! 385: ctlstack->donamep = np; ! 386: ! 387: np->vdovar = YES; ! 388: if( !optimflag && enregister(np) ) ! 389: { ! 390: /* stgp points to a storage version, varp to a register version */ ! 391: dostgp = dovarp; ! 392: dovarp = mkplace(np); ! 393: } ! 394: else ! 395: dostgp = NULL; ! 396: dotype = dovarp->vtype; ! 397: ! 398: ! 399: for(i=0 , cp = spec->nextp ; cp!=NULL && i<3 ; cp = cp->nextp) ! 400: { ! 401: p = fixtype((expptr) cpexpr((tagptr) q = cp->datap)); ! 402: if(!ONEOF(p->headblock.vtype, MSKINT|MSKREAL) ) ! 403: { ! 404: err("bad type on DO parameter"); ! 405: return; ! 406: } ! 407: ! 408: ! 409: if (ISCONST(q)) ! 410: const[i] = mkconv(dotype, q); ! 411: else ! 412: { ! 413: frexpr(q); ! 414: const[i] = NULL; ! 415: } ! 416: ! 417: par[i++] = mkconv(dotype, p); ! 418: } ! 419: ! 420: frchain(&spec); ! 421: switch(i) ! 422: { ! 423: case 0: ! 424: case 1: ! 425: err("too few DO parameters"); ! 426: return; ! 427: ! 428: case 2: ! 429: DOINCR = (expptr) ICON(1); ! 430: CONSTINCR = ICON(1); ! 431: ! 432: case 3: ! 433: break; ! 434: ! 435: default: ! 436: err("too many DO parameters"); ! 437: return; ! 438: } ! 439: ! 440: ! 441: for (i = 0; i < 4; i++) ! 442: ctlstack->ctlabels[i] = newlabel(); ! 443: ! 444: if( CONSTLIMIT ) ! 445: ctlstack->domax = DOLIMIT; ! 446: else ! 447: ctlstack->domax = (expptr) mktemp(dotype, PNULL); ! 448: ! 449: if( CONSTINCR ) ! 450: { ! 451: ctlstack->dostep = DOINCR; ! 452: if( (incsign = conssgn(CONSTINCR)) == 0) ! 453: err("zero DO increment"); ! 454: ctlstack->dostepsign = (incsign > 0 ? POSSTEP : NEGSTEP); ! 455: } ! 456: else ! 457: { ! 458: ctlstack->dostep = (expptr) mktemp(dotype, PNULL); ! 459: ctlstack->dostepsign = VARSTEP; ! 460: } ! 461: ! 462: if (optimflag) ! 463: doslot = optbuff (SKDOHEAD,0,0,ctlstack); ! 464: ! 465: if( CONSTLIMIT && CONSTINIT && ctlstack->dostepsign!=VARSTEP) ! 466: { ! 467: if (optimflag) ! 468: optbuff (SKEQ,mkexpr(OPASSIGN,cpexpr(dovarp),cpexpr(DOINIT)), ! 469: 0,0); ! 470: else ! 471: puteq (cpexpr(dovarp), cpexpr(DOINIT)); ! 472: if( ! onetripflag ) ! 473: { ! 474: q = mkexpr(OPMINUS, cpexpr(CONSTLIMIT), cpexpr(CONSTINIT)); ! 475: if((incsign * conssgn(q)) == -1) ! 476: { ! 477: warn("DO range never executed"); ! 478: if (optimflag) ! 479: optbuff (SKGOTO,0,ctlstack->endlabel,0); ! 480: else ! 481: putgoto (ctlstack->endlabel); ! 482: } ! 483: frexpr(q); ! 484: } ! 485: } ! 486: ! 487: ! 488: else if (ctlstack->dostepsign != VARSTEP && !onetripflag) ! 489: { ! 490: if (CONSTLIMIT) ! 491: q = (expptr) cpexpr(ctlstack->domax); ! 492: else ! 493: q = mkexpr(OPASSIGN, cpexpr(ctlstack->domax), DOLIMIT); ! 494: q1 = mkexpr(OPASSIGN, cpexpr(dovarp), DOINIT); ! 495: q = mkexpr( (ctlstack->dostepsign == POSSTEP ? OPLE : OPGE), ! 496: q1, q); ! 497: if (optimflag) ! 498: optbuff (SKIFN,q, ctlstack->endlabel,0); ! 499: else ! 500: putif (q, ctlstack->endlabel); ! 501: } ! 502: else ! 503: { ! 504: if (!CONSTLIMIT) ! 505: if (optimflag) ! 506: optbuff (SKEQ, ! 507: mkexpr(OPASSIGN,cpexpr(ctlstack->domax),DOLIMIT),0,0); ! 508: else ! 509: puteq (cpexpr(ctlstack->domax), DOLIMIT); ! 510: q = DOINIT; ! 511: if (!onetripflag) ! 512: q = mkexpr(OPMINUS, q, ! 513: mkexpr(OPASSIGN, cpexpr(ctlstack->dostep), ! 514: DOINCR) ); ! 515: if (optimflag) ! 516: optbuff (SKEQ,mkexpr(OPASSIGN,cpexpr(dovarp), q),0,0); ! 517: else ! 518: puteq (cpexpr(dovarp), q); ! 519: if (onetripflag && ctlstack->dostepsign == VARSTEP) ! 520: if (optimflag) ! 521: optbuff (SKEQ, ! 522: mkexpr(OPASSIGN,cpexpr(ctlstack->dostep),DOINCR),0,0); ! 523: else ! 524: puteq (cpexpr(ctlstack->dostep), DOINCR); ! 525: } ! 526: ! 527: if (ctlstack->dostepsign == VARSTEP) ! 528: { ! 529: expptr incr,test; ! 530: if (onetripflag) ! 531: if (optimflag) ! 532: optbuff (SKGOTO,0,ctlstack->dobodylabel,0); ! 533: else ! 534: putgoto (ctlstack->dobodylabel); ! 535: else ! 536: if (optimflag) ! 537: optbuff (SKIFN,mkexpr(OPGE, cpexpr(ctlstack->dostep), ICON(0)), ! 538: ctlstack->doneglabel,0); ! 539: else ! 540: putif (mkexpr(OPGE, cpexpr(ctlstack->dostep), ICON(0)), ! 541: ctlstack->doneglabel); ! 542: if (optimflag) ! 543: optbuff (SKLABEL,0,ctlstack->doposlabel,0); ! 544: else ! 545: putlabel (ctlstack->doposlabel); ! 546: incr = mkexpr(OPPLUSEQ, cpexpr(dovarp), cpexpr(ctlstack->dostep)); ! 547: test = mkexpr(OPLE, incr, cpexpr(ctlstack->domax)); ! 548: if (optimflag) ! 549: optbuff (SKIFN,test, ctlstack->endlabel,0); ! 550: else ! 551: putif (test, ctlstack->endlabel); ! 552: } ! 553: ! 554: if (optimflag) ! 555: optbuff (SKLABEL,0,ctlstack->dobodylabel,0); ! 556: else ! 557: putlabel (ctlstack->dobodylabel); ! 558: if (dostgp) ! 559: { ! 560: if (optimflag) ! 561: optbuff (SKEQ,mkexpr(OPASSIGN,dostgp, dovarp),0,0); ! 562: else ! 563: puteq (dostgp, dovarp); ! 564: } ! 565: else ! 566: frexpr(dovarp); ! 567: if (optimflag) ! 568: doslot->nullslot = optbuff (SKNULL,0,0,0); ! 569: ! 570: frexpr(CONSTINIT); ! 571: frexpr(CONSTLIMIT); ! 572: frexpr(CONSTINCR); ! 573: } ! 574: ! 575: ! 576: enddo(here) ! 577: int here; ! 578: ! 579: { ! 580: register struct Ctlframe *q; ! 581: Namep np; ! 582: Addrp ap, rv; ! 583: expptr t; ! 584: register int i; ! 585: Slotp doslot; ! 586: ! 587: while (here == dorange) ! 588: { ! 589: if (np = ctlstack->donamep) ! 590: { ! 591: rv = mkplace (np); ! 592: ! 593: t = mkexpr(OPPLUSEQ, cpexpr(rv), cpexpr(ctlstack->dostep) ); ! 594: ! 595: if (optimflag) ! 596: doslot = optbuff (SKENDDO,0,0,ctlstack); ! 597: ! 598: if (ctlstack->dostepsign == VARSTEP) ! 599: if (optimflag) ! 600: { ! 601: optbuff (SKIFN, ! 602: mkexpr(OPLE, cpexpr(ctlstack->dostep), ICON(0)), ! 603: ctlstack->doposlabel,0); ! 604: optbuff (SKLABEL,0,ctlstack->doneglabel,0); ! 605: optbuff (SKIFN,mkexpr(OPLT, t, ctlstack->domax), ! 606: ctlstack->dobodylabel,0); ! 607: } ! 608: else ! 609: { ! 610: putif (mkexpr(OPLE, cpexpr(ctlstack->dostep), ICON(0)), ! 611: ctlstack->doposlabel); ! 612: putlabel (ctlstack->doneglabel); ! 613: putif (mkexpr(OPLT, t, ctlstack->domax), ! 614: ctlstack->dobodylabel); ! 615: } ! 616: else ! 617: { ! 618: int op; ! 619: op = (ctlstack->dostepsign == POSSTEP ? OPGT : OPLT); ! 620: if (optimflag) ! 621: optbuff (SKIFN, mkexpr(op,t,ctlstack->domax), ! 622: ctlstack->dobodylabel,0); ! 623: else ! 624: putif (mkexpr(op, t, ctlstack->domax), ! 625: ctlstack->dobodylabel); ! 626: } ! 627: if (optimflag) ! 628: optbuff (SKLABEL,0,ctlstack->endlabel,0); ! 629: else ! 630: putlabel (ctlstack->endlabel); ! 631: ! 632: if (ap = memversion(np)) ! 633: { ! 634: if (optimflag) ! 635: optbuff (SKEQ,mkexpr(OPASSIGN,ap, rv),0,0); ! 636: else ! 637: puteq (ap, rv); ! 638: } ! 639: else ! 640: frexpr(rv); ! 641: for (i = 0; i < 4; i++) ! 642: ctlstack->ctlabels[i] = 0; ! 643: if (!optimflag) ! 644: deregister(ctlstack->donamep); ! 645: ctlstack->donamep->vdovar = NO; ! 646: if (optimflag) ! 647: doslot->nullslot = optbuff (SKNULL,0,0,0); ! 648: } ! 649: ! 650: popctl(); ! 651: poplab(); ! 652: ! 653: dorange = 0; ! 654: for (q = ctlstack; q >= ctls; --q) ! 655: if (q->ctltype == CTLDO) ! 656: { ! 657: dorange = q->dolabel; ! 658: break; ! 659: } ! 660: } ! 661: } ! 662: ! 663: ! 664: exassign(vname, labelval) ! 665: Namep vname; ! 666: struct Labelblock *labelval; ! 667: { ! 668: Addrp p; ! 669: expptr mkaddcon(); ! 670: ! 671: p = mkplace(vname); ! 672: if( ! ONEOF(p->vtype, MSKINT|MSKADDR) ) ! 673: err("noninteger assign variable"); ! 674: else if (optimflag) ! 675: optbuff (SKASSIGN, p, labelval->labelno, 0); ! 676: else ! 677: puteq (p, mkaddcon(labelval->labelno) ); ! 678: } ! 679: ! 680: ! 681: ! 682: exarif(expr, neglab, zerlab, poslab) ! 683: expptr expr; ! 684: struct Labelblock *neglab, *zerlab, *poslab; ! 685: { ! 686: register int lm, lz, lp; ! 687: struct Labelblock *labels[3]; ! 688: ! 689: lm = neglab->labelno; ! 690: lz = zerlab->labelno; ! 691: lp = poslab->labelno; ! 692: expr = fixtype(expr); ! 693: ! 694: if( ! ONEOF(expr->headblock.vtype, MSKINT|MSKREAL) ) ! 695: { ! 696: err("invalid type of arithmetic if expression"); ! 697: frexpr(expr); ! 698: } ! 699: else ! 700: { ! 701: if(lm == lz) ! 702: exar2(OPLE, expr, lm, lp); ! 703: else if(lm == lp) ! 704: exar2(OPNE, expr, lm, lz); ! 705: else if(lz == lp) ! 706: exar2(OPGE, expr, lz, lm); ! 707: else ! 708: if (optimflag) ! 709: { ! 710: labels[0] = neglab; ! 711: labels[1] = zerlab; ! 712: labels[2] = poslab; ! 713: optbuff (SKARIF, expr, 0, labels); ! 714: } ! 715: else ! 716: prarif(expr, lm, lz, lp); ! 717: } ! 718: } ! 719: ! 720: ! 721: ! 722: LOCAL exar2 (op, e, l1, l2) ! 723: int op; ! 724: expptr e; ! 725: int l1,l2; ! 726: { ! 727: if (optimflag) ! 728: { ! 729: optbuff (SKIFN, mkexpr(op, e, ICON(0)), l2, 0); ! 730: optbuff (SKGOTO, 0, l1, 0); ! 731: } ! 732: else ! 733: { ! 734: putif (mkexpr(op, e, ICON(0)), l2); ! 735: putgoto (l1); ! 736: } ! 737: } ! 738: ! 739: ! 740: exreturn(p) ! 741: register expptr p; ! 742: { ! 743: if(procclass != CLPROC) ! 744: warn("RETURN statement in main or block data"); ! 745: if(p && (proctype!=TYSUBR || procclass!=CLPROC) ) ! 746: { ! 747: err("alternate return in nonsubroutine"); ! 748: p = 0; ! 749: } ! 750: ! 751: if(p) ! 752: if (optimflag) ! 753: optbuff (SKRETURN, p, retlabel, 0); ! 754: else ! 755: { ! 756: putforce (TYINT, p); ! 757: putgoto (retlabel); ! 758: } ! 759: else ! 760: if (optimflag) ! 761: optbuff (SKRETURN, p, ! 762: (proctype==TYSUBR ? ret0label : retlabel), 0); ! 763: else ! 764: putgoto (proctype==TYSUBR ? ret0label : retlabel); ! 765: } ! 766: ! 767: ! 768: ! 769: exasgoto(labvar) ! 770: struct Hashentry *labvar; ! 771: { ! 772: register Addrp p; ! 773: ! 774: p = mkplace(labvar); ! 775: if( ! ISINT(p->vtype) ) ! 776: err("assigned goto variable must be integer"); ! 777: else ! 778: if (optimflag) ! 779: optbuff (SKASGOTO, p, 0, 0); ! 780: else ! 781: putbranch (p); ! 782: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.