![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to print.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / efl|
Return to print.c CVS log | Up to [Research Unix] / researchv10no / cmd / efl |
1.1 ! root 1: #include "defs" ! 2: ! 3: char *ops[ ] = { "", "+", "-", "*", "/", "**", ! 4: ".not. ", " .and. ", ".andand.", ".oror.", " .or. ", ! 5: " .eq. ", " .lt. ", " .gt. ", " .le. ", " .ge. ", " .ne. ", ! 6: "(", ")", " = ", ", " }; ! 7: ! 8: int opprecs[ ] = { 0, 7, 7, 8, 8, 9, 5, 4, 4, 3, 3, ! 9: 6, 6, 6, 6, 6, 6, 10, 10, 1, 0 }; ! 10: ! 11: char *qualops[ ] = { "", "->", ".", " of ", " sub " }; ! 12: ! 13: ! 14: char *classes[ ] = { "", "arg ", "valarg ", "static ", "auto ", ! 15: "common ", "mos ", "external ", "statement function " }; ! 16: ! 17: char *precs[ ] = { "", "long " }; ! 18: ! 19: char *types[ ] = { "", "integer ", "real ", "double precision ", "logical ", ! 20: "complex ", "char ", "type " }; ! 21: ! 22: char *ftntypes[] = { "integer ", "real ", "logical ", "complex ", ! 23: "double precision ", 0, 0 }; ! 24: ! 25: ! 26: char *langs[] = { "pfort", "ratfor", "efl"}; ! 27: ! 28: ! 29: propts() ! 30: { ! 31: fprintf(diagfile, "Options: "); ! 32: fprintf(diagfile, "%s ", langs[langopt]); ! 33: fprintf(diagfile, "%s ", (dbgopt ? "debug" : "ndebug") ); ! 34: fprintf(diagfile, "%s ", (dotsopt? "dotson" : "dotsoff") ); ! 35: fprintf(diagfile, "\n"); ! 36: } ! 37: ! 38: ! 39: ! 40: ! 41: prexpr(e) ! 42: ptr e; ! 43: { ! 44: if(e) prexp1(e, 0,0,0); ! 45: } ! 46: ! 47: ! 48: ! 49: ! 50: ! 51: prexp1(e, prec, subt, leftside) ! 52: register ptr e; ! 53: int prec, subt, leftside; ! 54: { ! 55: ptr p, q; ! 56: int prec1, needpar; ! 57: ! 58: needpar = 0; ! 59: ! 60: switch(e->tag) ! 61: { ! 62: case TERROR: ! 63: break; ! 64: ! 65: case TCONST: ! 66: TEST fprintf(diagfile, "%s", e->leftp); ! 67: if(e->rightp) ! 68: putzcon(e); ! 69: else ! 70: putconst(e->vtype, e->leftp); ! 71: break; ! 72: ! 73: case TFTNBLOCK: ! 74: putname(e); ! 75: break; ! 76: ! 77: case TNAME: ! 78: if(e->sthead == 0) fatal("name without entry"); ! 79: TEST fprintf(diagfile, "%s", ((struct stentry *)e->sthead)->namep); ! 80: putname(e); ! 81: if(e->vsubs) ! 82: prexp1(e->vsubs, 0,0,0); ! 83: break; ! 84: ! 85: case TTEMP: ! 86: TEST fprintf(diagfile, "(fakename %o)", e); ! 87: putname(e); ! 88: break; ! 89: ! 90: case TLIST: ! 91: if(e->leftp == 0) break; ! 92: TEST fprintf(diagfile, "( "); ! 93: putic(ICOP, OPLPAR); ! 94: for(p=e->leftp ; p!=0 ; p = p->nextp) ! 95: { ! 96: prexp1(p->datap, 0,0,0); ! 97: if(p->nextp) ! 98: { ! 99: TEST fprintf(diagfile, " , "); ! 100: putic(ICOP, OPCOMMA); ! 101: } ! 102: } ! 103: TEST fprintf(diagfile, " )"); ! 104: putic(ICOP, OPRPAR); ! 105: break; ! 106: ! 107: case TSTFUNCT: ! 108: fprintf(diagfile, "statement function "); ! 109: prexp1(e->leftp, 0,0,0); ! 110: TEST fprintf(diagfile, " = "); ! 111: putic(ICOP, OPEQUALS); ! 112: prexp1(e->rightp, 0,0,0); ! 113: break; ! 114: ! 115: case TAROP: ! 116: if(e->subtype==OPSTAR && ((struct headbits *)e->leftp)->tag!=TCONST && ((struct headbits *)e->rightp)->tag==TCONST) ! 117: { ! 118: q = e->leftp; ! 119: e->leftp = e->rightp; ! 120: e->rightp = q; ! 121: } ! 122: case TLOGOP: ! 123: prec1 = opprecs[e->subtype]; ! 124: goto print; ! 125: case TNOTOP: ! 126: prec1 = 5; ! 127: if(prec > 1) /* force parens */ ! 128: needpar = 1; ! 129: goto print; ! 130: case TNEGOP: ! 131: if(prec > 1) /* force parens */ ! 132: needpar = 1; ! 133: prec1 = 8; ! 134: goto print; ! 135: case TASGNOP: ! 136: prec1 = 1; ! 137: goto print; ! 138: case TRELOP: ! 139: prec1 = 6; ! 140: goto print; ! 141: case TCALL: ! 142: prec1 = 10; ! 143: goto print; ! 144: case TREPOP: ! 145: prec1 = 2; ! 146: goto print; ! 147: ! 148: print: ! 149: if(prec1 < prec ) ! 150: needpar = 1; ! 151: else if(prec1 == prec) ! 152: if(e->needpar) ! 153: needpar = 1; ! 154: else if(subt == e->subtype) ! 155: needpar |= ! (e->tag==TLOGOP || leftside || subt==0 ! 156: || subt==OPPLUS || subt==OPSTAR); ! 157: else needpar |= ! (leftside || subt==OPPLUS || subt==OPSTAR); ! 158: ! 159: if(needpar) ! 160: { ! 161: putic(ICOP,OPLPAR); ! 162: TEST fprintf(diagfile, "("); ! 163: } ! 164: ! 165: if(e->rightp != 0) ! 166: { ! 167: prexp1(e->leftp, prec1, e->subtype, 1); ! 168: switch(e->tag) { ! 169: case TASGNOP: ! 170: TEST fprintf(diagfile, "="); ! 171: putic(ICOP, OPEQUALS); ! 172: if(e->subtype != 0) ! 173: prexp1(e->leftp, prec1, 0, 1); ! 174: ! 175: case TAROP: ! 176: case TNEGOP: ! 177: case TLOGOP: ! 178: case TNOTOP: ! 179: case TRELOP: ! 180: if(e->subtype) ! 181: { ! 182: TEST fprintf(diagfile, " %s ", ops[e->subtype]); ! 183: putic(ICOP, e->subtype); ! 184: } ! 185: break; ! 186: ! 187: case TCALL: ! 188: TEST fprintf(diagfile, " %s ", qualops[e->subtype]); ! 189: break; ! 190: ! 191: case TREPOP: ! 192: TEST fprintf(diagfile, "$"); ! 193: break; ! 194: } ! 195: ! 196: prexp1(e->rightp, prec1,e->subtype, 0); ! 197: } ! 198: else { /* e->rightp == 0 */ ! 199: TEST fprintf(diagfile, " %s ", ops[e->subtype]); ! 200: putic(ICOP, e->subtype); ! 201: prexp1(e->leftp, prec1,e->subtype, 0); ! 202: } ! 203: if(needpar) ! 204: { ! 205: putic(ICOP, OPRPAR); ! 206: TEST fprintf(diagfile, ")"); ! 207: } ! 208: break; ! 209: ! 210: default: ! 211: badtag("prexp1", e->tag); ! 212: break; ! 213: } ! 214: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.