![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to simple.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / efl|
Return to simple.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / efl |
1.1 ! root 1: #include <ctype.h> ! 2: #include "defs" ! 3: ! 4: ! 5: /* basic simplifying procedure */ ! 6: ! 7: ptr simple(t,e) ! 8: int t; /* take on the values LVAL, RVAL, and SUBVAL */ ! 9: register ptr e; /* points to an expression */ ! 10: { ! 11: int tag, subtype; ! 12: ptr lp, rp; ! 13: int ltag; ! 14: int lsubt; ! 15: ptr p, e1; ! 16: ptr exio(), exioop(), dblop(), setfield(), gentemp(); ! 17: int a,b,c; ! 18: ! 19: top: ! 20: ! 21: if(e == 0) return(0); ! 22: ! 23: tag = e->tag; ! 24: subtype = e->subtype; ! 25: if(lp = e->leftp) ! 26: { ! 27: ltag = lp->tag; ! 28: lsubt = lp->subtype; ! 29: } ! 30: rp = e->rightp; ! 31: ! 32: TEST fprintf(diagfile, "simple(%d; tag %d,%d)\n", t,tag,subtype); ! 33: ! 34: switch(tag){ ! 35: ! 36: case TNOTOP: ! 37: switch(ltag) { ! 38: ! 39: case TNOTOP: /* not not = yes */ ! 40: frexpblock(e); ! 41: e = lp->leftp; ! 42: frexpblock(lp); ! 43: goto top; ! 44: ! 45: case TLOGOP: /* de Morgan's Law */ ! 46: lp->subtype = (OPOR+OPAND) - lp->subtype; ! 47: lp->leftp = mknode(TNOTOP,OPNOT,lp->leftp, PNULL); ! 48: lp->rightp=mknode(TNOTOP,OPNOT,lp->rightp, PNULL); ! 49: frexpblock(e); ! 50: e = lp; ! 51: goto top; ! 52: ! 53: case TRELOP: /* reverse the condition */ ! 54: lp->subtype = (OPEQ+OPNE) - lp->subtype; ! 55: frexpblock(e); ! 56: e = lp; ! 57: goto top; ! 58: ! 59: case TCALL: ! 60: case TASGNOP: ! 61: e->leftp = simple(RVAL,lp); ! 62: ! 63: case TNAME: ! 64: case TFTNBLOCK: ! 65: lp = simple(RVAL,lp); ! 66: ! 67: case TTEMP: ! 68: if(t == LVAL) ! 69: e = simple(LVAL, ! 70: mknode(TASGNOP,0, gentemp(e->leftp), e)); ! 71: break; ! 72: ! 73: case TCONST: ! 74: if(equals(lp->leftp, ".false.")) ! 75: e->leftp = copys(".true."); ! 76: else if(equals(lp->leftp, ".true.")) ! 77: e->leftp = copys(".false."); ! 78: else goto typerr; ! 79: ! 80: e->tag = TCONST; ! 81: e->subtype = 0; ! 82: cfree(lp->leftp); ! 83: frexpblock(lp); ! 84: break; ! 85: ! 86: default: goto typerr; ! 87: } ! 88: break; ! 89: ! 90: ! 91: ! 92: ! 93: case TLOGOP: switch(subtype) { ! 94: case OPOR: ! 95: case OPAND: ! 96: goto binop; ! 97: ! 98: case OP2OR: ! 99: case OP2AND: ! 100: lp = e->leftp = simple(RVAL, lp); ! 101: if(lp->tag != TTEMP) ! 102: lp = simple(RVAL, ! 103: mknode(TASGNOP,0, gent(TYLOG,0),lp)); ! 104: return( simple(LVAL, mknode(TASGNOP,subtype,lp,rp)) ); ! 105: default: ! 106: fatal("impossible logical operator"); ! 107: } ! 108: ! 109: case TNEGOP: ! 110: lp = e->leftp = simple(RVAL,lp); ! 111: ltag = lp->tag; ! 112: lsubt = lp->subtype; ! 113: ! 114: if(ltag==TNEGOP) ! 115: { ! 116: frexpblock(e); ! 117: e = lp->leftp; ! 118: frexpblock(lp); ! 119: goto top; ! 120: } ! 121: else goto lvcheck; ! 122: ! 123: case TAROP: ! 124: case TRELOP: ! 125: ! 126: binop: ! 127: ! 128: e->leftp = simple(RVAL,lp); ! 129: lp = e->leftp; ! 130: ltag = lp->tag; ! 131: lsubt = lp->subtype; ! 132: ! 133: e->rightp= simple(RVAL,rp); ! 134: rp = e->rightp; ! 135: ! 136: if(tag==TAROP && isicon(rp,&b) ) ! 137: { /* simplify a*1, a/1 , a+0, a-0 */ ! 138: if( ((subtype==OPSTAR||subtype==OPSLASH) && b==1) || ! 139: ((subtype==OPPLUS||subtype==OPMINUS) && b==0) ) ! 140: { ! 141: frexpr(rp); ! 142: mvexpr(lp,e); ! 143: goto top; ! 144: } ! 145: ! 146: if(isicon(lp, &a)) /* try folding const op const */ ! 147: { ! 148: e1 = fold(e); ! 149: if(e1!=e || e1->tag!=TAROP) ! 150: { ! 151: e = e1; ! 152: goto top; ! 153: } ! 154: } ! 155: if(ltag==TAROP && lp->needpar==0 && isicon(lp->rightp,&a) ) ! 156: { /* look for cases of (e op const ) op' const */ ! 157: ! 158: if( (subtype==OPPLUS||subtype==OPMINUS) && ! 159: (lsubt==OPPLUS||lsubt==OPMINUS) ) ! 160: { /* (e +- const) +- const */ ! 161: c = (subtype==OPPLUS ? 1 : -1) * b + ! 162: (lsubt==OPPLUS? 1 : -1) * a; ! 163: if(c > 0) ! 164: subtype = OPPLUS; ! 165: else { ! 166: subtype = OPMINUS; ! 167: c = -c; ! 168: } ! 169: fixexpr: ! 170: frexpr(rp); ! 171: frexpr(lp->rightp); ! 172: frexpblock(e); ! 173: e = lp; ! 174: e->subtype = subtype; ! 175: e->rightp = mkint(c); ! 176: goto top; ! 177: } ! 178: ! 179: else if(lsubt==OPSTAR && ! 180: ( (subtype==OPSTAR) || ! 181: (subtype==OPSLASH && a%b==0)) ) ! 182: { /* (e * const ) (* or /) const */ ! 183: c = (subtype==OPSTAR ? a*b : a/b ); ! 184: subtype = OPSTAR; ! 185: goto fixexpr; ! 186: } ! 187: } ! 188: if(ltag==TAROP && (lsubt==OPPLUS || lsubt==OPMINUS) && ! 189: subtype==OPSLASH && divides(lp,conval(rp)) ) ! 190: { ! 191: e->leftp = mknode(TAROP,OPSLASH,lp->leftp, cpexpr(rp)); ! 192: e->rightp = mknode(TAROP,OPSLASH,lp->rightp, rp); ! 193: e->subtype = lsubt; ! 194: goto top; ! 195: } ! 196: } ! 197: ! 198: else if( tag==TRELOP && isicon(lp,&a) && isicon(rp,&b) ) ! 199: { ! 200: e1 = fold(e); ! 201: if(e1!=e || e1->tag!=TRELOP) ! 202: { ! 203: e = e1; ! 204: goto top; ! 205: } ! 206: } ! 207: ! 208: lvcheck: ! 209: if(t == LVAL) ! 210: e = simple(LVAL, mknode(TASGNOP,0, gentemp(e),e)); ! 211: else if(t == SUBVAL) ! 212: { /* test for legal Fortran c*v +-c form */ ! 213: if(tag==TAROP && (subtype==OPPLUS || subtype==OPMINUS)) ! 214: if(rp->tag==TCONST && rp->vtype==TYINT) ! 215: { ! 216: if(!cvform(lp)) ! 217: e->leftp = simple(SUBVAL, lp); ! 218: } ! 219: else goto makesub; ! 220: else if( !cvform(e) ) goto makesub; ! 221: } ! 222: break; ! 223: ! 224: case TCALL: ! 225: if( lp->tag!=TFTNBLOCK && ioop(lp->sthead->namep) ) ! 226: { ! 227: e = exioop(e, YES); ! 228: exlab(0); ! 229: break; ! 230: } ! 231: e->rightp = simple(RVAL, rp); ! 232: if(t == SUBVAL) ! 233: goto makesub; ! 234: if(t == LVAL) ! 235: e = simple(RVAL, mknode(TASGNOP,0, gentemp(e),e)); ! 236: break; ! 237: ! 238: ! 239: case TNAME: ! 240: if(e->voffset) ! 241: fixsubs(e); ! 242: if(e->vsubs) ! 243: e->vsubs = simple(SUBVAL, e->vsubs); ! 244: if(t==SUBVAL && !vform(e)) ! 245: goto makesub; ! 246: ! 247: case TTEMP: ! 248: case TFTNBLOCK: ! 249: case TCONST: ! 250: if(t==SUBVAL && e->vtype!=TYINT) ! 251: goto makesub; ! 252: break; ! 253: ! 254: case TASGNOP: ! 255: lp = e->leftp = simple(LVAL,lp); ! 256: if(subtype==OP2OR || subtype==OP2AND) ! 257: e = dblop(e); ! 258: ! 259: else { ! 260: rp = e->rightp = simple(RVAL,rp); ! 261: if(e->vtype == TYCHAR) ! 262: excall(mkcall(mkftnblock(TYSUBR,"ef1asc"), arg4(cpexpr(lp),rp))); ! 263: else if(e->vtype == TYSTRUCT) ! 264: { ! 265: if(lp->vtypep->strsize != rp->vtypep->strsize) ! 266: fatal("simple: attempt to assign incompatible structures"); ! 267: e1 = mkchain(cpexpr(lp),mkchain(rp, ! 268: mkchain(mkint(lp->vtypep->strsize),CHNULL))); ! 269: excall(mkcall(mkftnblock(TYSUBR,"ef1ass"), ! 270: mknode(TLIST, 0, e1, PNULL) )); ! 271: } ! 272: else if(lp->vtype == TYFIELD) ! 273: lp = setfield(e); ! 274: else { ! 275: if(subtype != OPASGN) /* but is one of += etc */ ! 276: { ! 277: rp = e->rightp = simple(RVAL, mknode( ! 278: (subtype<=OPPOWER?TAROP:TLOGOP),subtype, ! 279: cpexpr(e->leftp),e->rightp)); ! 280: e->subtype = OPASGN; ! 281: } ! 282: exlab(0); ! 283: prexpr(e); ! 284: frexpr(rp); ! 285: } ! 286: frexpblock(e); ! 287: e = lp; ! 288: if(t == SUBVAL) goto top; ! 289: } ! 290: ! 291: break; ! 292: ! 293: case TLIST: ! 294: for(p=lp ; p ; p = p->nextp) ! 295: p->datap = simple(t, p->datap); ! 296: break; ! 297: ! 298: case TIOSTAT: ! 299: e = exio(e, 1); ! 300: break; ! 301: ! 302: default: ! 303: break; ! 304: } ! 305: ! 306: return(e); ! 307: ! 308: ! 309: typerr: ! 310: exprerr("type match error", CNULL); ! 311: return(e); ! 312: ! 313: makesub: ! 314: if(t==SUBVAL && e->vtype!=TYINT) ! 315: warn1("Line %d. Non-integer subscript", yylineno); ! 316: return( simple(RVAL, mknode(TASGNOP,0,gent(TYINT,PNULL),e)) ); ! 317: } ! 318: ! 319: ptr fold(e) ! 320: register ptr e; ! 321: { ! 322: int a, b, c; ! 323: register ptr lp, rp; ! 324: ! 325: lp = e->leftp; ! 326: rp = e->rightp; ! 327: ! 328: if(lp->tag!=TCONST && lp->tag!=TNEGOP) ! 329: return(e); ! 330: ! 331: if(rp->tag!=TCONST && rp->tag!=TNEGOP) ! 332: return(e); ! 333: ! 334: ! 335: switch(e->tag) ! 336: { ! 337: case TAROP: ! 338: if( !isicon(lp,&a) || !isicon(rp,&b) ) ! 339: return(e); ! 340: ! 341: switch(e->subtype) ! 342: { ! 343: case OPPLUS: ! 344: c = a + b;break; ! 345: case OPMINUS: ! 346: c = a - b; break; ! 347: case OPSTAR: ! 348: c = a * b; break; ! 349: case OPSLASH: ! 350: if(a%b!=0 && (a<0 || b<0) ) ! 351: return(e); ! 352: c = a / b; break; ! 353: case OPPOWER: ! 354: return(e); ! 355: default: ! 356: fatal("fold: illegal binary operator"); ! 357: } ! 358: frexpr(e); ! 359: ! 360: if(c >= 0) ! 361: return( mkint(c) ); ! 362: else return(mknode(TNEGOP,OPMINUS, mkint(-c), PNULL) ); ! 363: ! 364: case TRELOP: ! 365: if( !isicon(lp,&a) || !isicon(rp,&b) ) ! 366: return(e); ! 367: frexpr(e); ! 368: ! 369: switch(e->subtype) ! 370: { ! 371: case OPEQ: ! 372: c = a == b; break; ! 373: case OPLT: ! 374: c = a < b ; break; ! 375: case OPGT: ! 376: c = a > b; break; ! 377: case OPLE: ! 378: c = a <= b; break; ! 379: case OPGE: ! 380: c = a >= b; break; ! 381: case OPNE: ! 382: c = a != b; break; ! 383: default: ! 384: fatal("fold: invalid relational operator"); ! 385: } ! 386: return( mkconst(TYLOG, (c ? ".true." : ".false.")) ); ! 387: ! 388: ! 389: case TLOGOP: ! 390: if(lp->vtype!=TYLOG || rp->vtype!=TYLOG) ! 391: return(e); ! 392: a = equals(lp->leftp, ".true."); ! 393: b = equals(rp->leftp, ".true."); ! 394: frexpr(e); ! 395: ! 396: switch(e->subtype) ! 397: { ! 398: case OPAND: ! 399: case OP2AND: ! 400: c = a & b; break; ! 401: case OPOR: ! 402: case OP2OR: ! 403: c = a | b; break; ! 404: default: ! 405: fatal("fold: invalid logical operator"); ! 406: } ! 407: return( mkconst(TYLOG, (c? ".true." : ".false")) ); ! 408: ! 409: default: ! 410: return(e); ! 411: } ! 412: } ! 413: ! 414: #define TO + 100* ! 415: ! 416: ! 417: ptr coerce(t,e) /* coerce expression e to type t */ ! 418: int t; ! 419: register ptr e; ! 420: { ! 421: register int et; ! 422: int econst; ! 423: char buff[100]; ! 424: char *s, *s1; ! 425: ptr conrep(), xfixf(); ! 426: ! 427: if(e->tag == TNEGOP) ! 428: { ! 429: e->leftp = coerce(t, e->leftp); ! 430: goto settype; ! 431: } ! 432: ! 433: et = e->vtype; ! 434: econst = (e->tag == TCONST); ! 435: TEST fprintf(diagfile, "coerce type %d to type %d\n", et, t); ! 436: if(t == et) ! 437: return(e); ! 438: ! 439: switch( et TO t ) ! 440: { ! 441: case TYCOMPLEX TO TYINT: ! 442: case TYLREAL TO TYINT: ! 443: e = coerce(TYREAL,e); ! 444: case TYREAL TO TYINT: ! 445: if(econst) ! 446: e = xfixf(e); ! 447: if(e->vtype != TYINT) ! 448: e = mkcall(builtin(TYINT,"ifix"), arg1(e)); ! 449: break; ! 450: ! 451: case TYINT TO TYREAL: ! 452: if(econst) ! 453: { ! 454: e->leftp = conrep(e->leftp, "."); ! 455: goto settype; ! 456: } ! 457: e = mkcall(builtin(TYREAL,"float"), arg1(e)); ! 458: break; ! 459: ! 460: case TYLREAL TO TYREAL: ! 461: if(econst) ! 462: { ! 463: for(s=e->leftp ; *s && *s!='d';++s) ! 464: ; ! 465: *s = 'e'; ! 466: goto settype; ! 467: } ! 468: e = mkcall(builtin(TYREAL,"sngl"), arg1(e)); ! 469: break; ! 470: ! 471: case TYCOMPLEX TO TYREAL: ! 472: if(econst) ! 473: { ! 474: s1 = (char *)(e->leftp) + 1; ! 475: s = buff; ! 476: while(*s1!=',' && *s1!='\0') ! 477: *s1++ = *s++; ! 478: *s = '\0'; ! 479: cfree(e->leftp); ! 480: e->leftp = copys(buff); ! 481: goto settype; ! 482: } ! 483: else ! 484: e = mkcall(mkftnblock(TYREAL,"real"), arg1(e)); ! 485: break; ! 486: ! 487: case TYINT TO TYLREAL: ! 488: if(econst) ! 489: { ! 490: e->leftp = conrep(e->leftp,"d0"); ! 491: goto settype; ! 492: } ! 493: case TYCOMPLEX TO TYLREAL: ! 494: e = coerce(TYREAL,e); ! 495: case TYREAL TO TYLREAL: ! 496: if(econst) ! 497: { ! 498: for(s=e->leftp ; *s && *s!='e'; ++s) ! 499: ; ! 500: if(*s == 'e') ! 501: *s = 'd'; ! 502: else e->leftp = conrep(e->leftp,"d0"); ! 503: goto settype; ! 504: } ! 505: e = mkcall(builtin(TYLREAL,"dble"), arg1(e)); ! 506: break; ! 507: ! 508: case TYINT TO TYCOMPLEX: ! 509: case TYLREAL TO TYCOMPLEX: ! 510: e = coerce(TYREAL, e); ! 511: case TYREAL TO TYCOMPLEX: ! 512: if(e->tag == TCONST) ! 513: { ! 514: sprintf(buff, "(%s,0.)", e->leftp); ! 515: cfree(e->leftp); ! 516: e->leftp = copys(buff); ! 517: goto settype; ! 518: } ! 519: else ! 520: e = mkcall(builtin(TYCOMPLEX,"cmplx"), ! 521: arg2(e, mkconst(TYREAL,"0."))); ! 522: break; ! 523: ! 524: ! 525: default: ! 526: goto mismatch; ! 527: } ! 528: ! 529: return(e); ! 530: ! 531: ! 532: mismatch: ! 533: exprerr("impossible conversion", ""); ! 534: frexpr(e); ! 535: return( errnode() ); ! 536: ! 537: ! 538: settype: ! 539: e->vtype = t; ! 540: return(e); ! 541: } ! 542: ! 543: ! 544: ! 545: /* check whether expression is in form c, v, or v*c */ ! 546: cvform(p) ! 547: register ptr p; ! 548: { ! 549: switch(p->tag) ! 550: { ! 551: case TCONST: ! 552: return(p->vtype == TYINT); ! 553: ! 554: case TNAME: ! 555: return(vform(p)); ! 556: ! 557: case TAROP: ! 558: if(p->subtype==OPSTAR && p->rightp->tag==TCONST ! 559: && p->rightp->vtype==TYINT && vform(p->leftp)) ! 560: return(1); ! 561: ! 562: default: ! 563: return(0); ! 564: } ! 565: } ! 566: ! 567: ! 568: ! 569: ! 570: /* is p a simple integer variable */ ! 571: vform(p) ! 572: register ptr p; ! 573: { ! 574: return( p->tag==TNAME && p->vtype==TYINT && p->vdim==0 ! 575: && p->voffset==0 && p->vsubs==0) ; ! 576: } ! 577: ! 578: ! 579: ! 580: ptr dblop(p) ! 581: ptr p; ! 582: { ! 583: ptr q; ! 584: ! 585: bgnexec(); ! 586: if(p->subtype == OP2OR) ! 587: q = mknode(TNOTOP,OPNOT, cpexpr(p->leftp), PNULL); ! 588: else q = cpexpr(p->leftp); ! 589: ! 590: pushctl(STIF, q); ! 591: bgnexec(); ! 592: exasgn(cpexpr(p->leftp), OPASGN, p->rightp); ! 593: ifthen(); ! 594: popctl(); ! 595: addexec(); ! 596: return(p->leftp); ! 597: } ! 598: ! 599: ! 600: ! 601: ! 602: divides(a,b) ! 603: ptr a; ! 604: int b; ! 605: { ! 606: if(a->vtype!=TYINT) ! 607: return(0); ! 608: ! 609: switch(a->tag) ! 610: { ! 611: case TNEGOP: ! 612: return( divides(a->leftp,b) ); ! 613: ! 614: case TCONST: ! 615: return( conval(a) % b == 0); ! 616: ! 617: case TAROP: ! 618: switch(a->subtype) ! 619: { ! 620: case OPPLUS: ! 621: case OPMINUS: ! 622: return(divides(a->leftp,b)&& ! 623: divides(a->rightp,b) ); ! 624: ! 625: case OPSTAR: ! 626: return(divides(a->rightp,b)); ! 627: ! 628: default: ! 629: return(0); ! 630: } ! 631: default: ! 632: return(0); ! 633: } ! 634: /* NOTREACHED */ ! 635: } ! 636: ! 637: /* truncate floating point constant to integer */ ! 638: ! 639: #define MAXD 100 ! 640: ! 641: ptr xfixf(e) ! 642: struct exprblock *e; ! 643: { ! 644: char digit[MAXD+1]; /* buffer into which digits are placed */ ! 645: char *first; /* points to first nonzero digit */ ! 646: register char *end; /* points at position past last digit */ ! 647: register char *dot; /* decimal point is immediately to left of this digit */ ! 648: register char *s; ! 649: int expon; ! 650: ! 651: dot = NULL; ! 652: end = digit; ! 653: expon = 0; ! 654: ! 655: for(s = e->leftp ; *s; ++s) ! 656: if( isdigit(*s) ) ! 657: { ! 658: if(end-digit > MAXD) ! 659: return(e); ! 660: *end++ = *s; ! 661: } ! 662: else if(*s == '.') ! 663: dot = end; ! 664: else if(*s=='d' || *s=='e') ! 665: { ! 666: expon = convci(s+1); ! 667: break; ! 668: } ! 669: else fatal1("impossible character %d in floating constant", *s); ! 670: ! 671: if(dot == NULL) ! 672: dot = end; ! 673: dot += expon; ! 674: if(dot-digit > MAXD) ! 675: return(e); ! 676: for(first = digit; first<end && *first=='0' ; ++first) ! 677: ; ! 678: if(dot<=first) ! 679: { ! 680: dot = first+1; ! 681: *first = '0'; ! 682: } ! 683: else while(end < dot) ! 684: *end++ = '0'; ! 685: *dot = '\0'; ! 686: cfree(e->leftp); ! 687: e->leftp = copys(first); ! 688: e->vtype = TYINT; ! 689: return(e); ! 690: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.