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

   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", 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 && e->leftp->tag!=TCONST && 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: }

Defined functions

Defined variables