2.9BSD - /usr/src/ucb/pascal/pxp/fdec.c

   1: #
   2: /*
   3:  * pxp - Pascal execution profiler
   4:  *
   5:  * Bill Joy UCB
   6:  * Version 1.2 January 1979
   7:  */
   8: 
   9: #include "0.h"
  10: #include "tree.h"
  11: 
  12: /*
  13:  * Program, procedure or function "header", i.e.:
  14:  *
  15:  *	function sin: real;
  16:  */
  17: funchdr(r)
  18:     int *r;
  19: {
  20:     register **rl, *il;
  21: 
  22:     if (inpflist(r[2])) {
  23:         optstk['z'-'a'] =<< 1;
  24:         optstk['z'-'a'] =| opts['z'-'a'];
  25:         opts['z'-'a'] = 1;
  26:     }
  27:     cbn++;
  28:     lastbn = cbn;
  29:     getcnt();
  30:     if (nojunk && !inpflist(r[2]))
  31:         setprint();
  32:     else
  33:         printon();
  34:     if (r[0] == T_PROG && noinclud && bracket)
  35:         printoff();
  36:     if (cbn > 1 && !justify)
  37:         ppgoin(PRFN);
  38:     puthedr();
  39:     if (noblank(setline(r[1])))
  40:         ppnl();
  41:     cnttab(r[2], pfcnt++);
  42:     ppnl();
  43:     indent();
  44:     switch (r[0]) {
  45:         case T_PROG:
  46:             ppkw("program");
  47:             break;
  48:         case T_PDEC:
  49:             ppkw("procedure");
  50:             break;
  51:         case T_FDEC:
  52:             ppkw("function");
  53:             break;
  54:         default:
  55:             panic("funchdr");
  56:     }
  57:     ppspac();
  58:     ppid(r[2]);
  59:     if (r[0] != T_PROG) {
  60:         rl = r[3];
  61:         if (rl != NIL) {
  62:             ppbra("(");
  63:             for (;;) {
  64:                 if (rl[1] == NIL) {
  65:                     rl = rl[2];
  66:                     continue;
  67:                 }
  68:                 switch (rl[1][0]) {
  69:                     case T_PVAR:
  70:                         ppkw("var");
  71:                         ppspac();
  72:                         break;
  73:                     case T_PPROC:
  74:                         ppkw("procedure");
  75:                         ppspac();
  76:                         break;
  77:                     case T_PFUNC:
  78:                         ppkw("function");
  79:                         ppspac();
  80:                         break;
  81:                 }
  82:                 il = rl[1][1];
  83:                 if (il != NIL)
  84:                     for (;;) {
  85:                         ppid(il[1]);
  86:                         il = il[2];
  87:                         if (il == NIL)
  88:                             break;
  89:                         ppsep(", ");
  90:                     }
  91:                 else
  92:                     ppid("{identifier list}");
  93:                 if (rl[1][0] != T_PPROC) {
  94:                     ppsep(":");
  95:                     gtype(rl[1][2]);
  96:                 }
  97:                 rl = rl[2];
  98:                 if (rl == NIL)
  99:                     break;
 100:                 ppsep(";");
 101:                 ppspac();
 102:             }
 103:             ppket(")");
 104:         }
 105:         if (r[0] == T_FDEC && r[4] != NIL) {
 106:             ppsep(":");
 107:             gtype(r[4]);
 108:         }
 109:         ppsep(";");
 110:     } else {
 111:         rl = r[3];
 112:         if (rl != NIL) {
 113:             ppbra("(");
 114:             for (;;) {
 115:                 ppid(rl[1]);
 116:                 rl = rl[2];
 117:                 if (rl == NIL)
 118:                     break;
 119:                 ppsep(", ");
 120:             }
 121:             ppket(")");
 122:         }
 123:         ppsep(";");
 124:     }
 125: fhout:
 126:     setline(r[1]);
 127:     putcml();
 128:     savecnt(&pfcnts[cbn]);
 129:     setprint();
 130:     --cbn;
 131:     if (cbn && !justify)
 132:         ppgoout(PRFN);
 133:     return (r[2]);
 134: }
 135: 
 136: /*
 137:  * Forward declaration i.e. the second line of
 138:  *
 139:  *	procedure fum(var i: integer);
 140:  *	    forward;
 141:  */
 142: funcfwd(fp)
 143:     char *fp;
 144: {
 145: 
 146:     baroff();
 147:     ppgoin(DECL);
 148:     ppnl();
 149:     indent();
 150:     ppkw("forward");
 151:     ppsep(";");
 152:     ppgoout(DECL);
 153:     baron();
 154:     return (fp);
 155: }
 156: 
 157: /*
 158:  * The "body" of a procedure, function, or program declaration,
 159:  * i.e. a non-forward definition encounter.
 160:  */
 161: funcbody(fp)
 162:     char *fp;
 163: {
 164: 
 165:     if (cbn && !justify)
 166:         ppgoin(PRFN);
 167:     cbn++;
 168:     lastbn = cbn;
 169:     return (fp);
 170: }
 171: 
 172: /*
 173:  * The guts of the procedure, function or program, i.e.
 174:  * the part between the begin and the end.
 175:  */
 176: funcend(fp, bundle, binfo)
 177:     char *fp;
 178:     int *bundle, *binfo;
 179: {
 180:     int *blk;
 181:     extern int cntstat;
 182: 
 183:     cntstat = 0;
 184:     blk = bundle[2];
 185:     rescnt(&pfcnts[cbn]);
 186:     setprint();
 187:     if (cbn == 1 && noinclud && bracket)
 188:         printoff();
 189:     if (lastbn > cbn)
 190:         unprint();
 191:     if (cbn == 1)
 192:         puthedr();
 193:     if (noblank(setline(bundle[1])) && lastbn > cbn)
 194:         ppnl();
 195:     ppnl();
 196:     indent();
 197:     ppkw("begin");
 198:     setline(bundle[1]);
 199:     if (putcml() == 0 && lastbn > cbn)
 200:         ppsname(fp);
 201:     ppgoin(DECL);
 202:     statlist(blk);
 203:     setinfo(bundle[1]);
 204:     putcmp();
 205:     ppgoout(DECL);
 206:     ppnl();
 207:     indent();
 208:     ppkw("end");
 209:     ppsep(cbn == 1 ? "." : ";");
 210:     setinfo(binfo);
 211:     if (putcml() == 0)
 212:         ppsname(fp);
 213:     cbn--;
 214:     if (cbn && !justify)
 215:         ppgoout(PRFN);
 216:     if (inpflist(fp)) {
 217:         opts['z'-'a'] = optstk['z'-'a'] & 1;
 218:         optstk['z'-'a'] =>> 1;
 219:     }
 220:     if (cbn == 0) {
 221:         flushcm();
 222:         printon();
 223:         ppnl();
 224:     }
 225: }
 226: 
 227: ppsname(fp)
 228:     char *fp;
 229: {
 230:     if (fp == NIL)
 231:         return;
 232:     ppsep(" { ");
 233:     ppid(fp);
 234:     ppsep(" }");
 235: }

Defined functions