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

   1: /*
   2:  * Copyright (c) 1980 Regents of the University of California.
   3:  * All rights reserved.  The Berkeley software License Agreement
   4:  * specifies the terms and conditions for redistribution.
   5:  */
   6: 
   7: #ifndef lint
   8: static char sccsid[] = "@(#)fdec.c	5.1 (Berkeley) 6/5/85";
   9: #endif not lint
  10: 
  11: /*
  12:  * pxp - Pascal execution profiler
  13:  *
  14:  * Bill Joy UCB
  15:  * Version 1.2 January 1979
  16:  */
  17: 
  18: #include "0.h"
  19: #include "tree.h"
  20: 
  21: /*
  22:  * Program, procedure or function "header", i.e.:
  23:  *
  24:  *	function sin: real;
  25:  */
  26: funchdr(r)
  27:     int *r;
  28: {
  29:     register **rl, *il;
  30: 
  31:     if (inpflist(r[2])) {
  32:         optstk['z'-'a'] =<< 1;
  33:         optstk['z'-'a'] =| opts['z'-'a'];
  34:         opts['z'-'a'] = 1;
  35:     }
  36:     cbn++;
  37:     lastbn = cbn;
  38:     getcnt();
  39:     if (nojunk && !inpflist(r[2]))
  40:         setprint();
  41:     else
  42:         printon();
  43:     if (r[0] == T_PROG && noinclude && bracket)
  44:         printoff();
  45:     if (cbn > 1 && !justify)
  46:         ppgoin(PRFN);
  47:     puthedr();
  48:     if (noblank(setline(r[1])))
  49:         ppnl();
  50:     cnttab(r[2], pfcnt++);
  51:     ppnl();
  52:     indent();
  53:     switch (r[0]) {
  54:         case T_PROG:
  55:             ppkw("program");
  56:             break;
  57:         case T_PDEC:
  58:             ppkw("procedure");
  59:             break;
  60:         case T_FDEC:
  61:             ppkw("function");
  62:             break;
  63:         default:
  64:             panic("funchdr");
  65:     }
  66:     ppspac();
  67:     ppid(r[2]);
  68:     if (r[0] != T_PROG) {
  69:         rl = r[3];
  70:         if (rl != NIL) {
  71:             ppbra("(");
  72:             for (;;) {
  73:                 if (rl[1] == NIL) {
  74:                     rl = rl[2];
  75:                     continue;
  76:                 }
  77:                 switch (rl[1][0]) {
  78:                     case T_PVAR:
  79:                         ppkw("var");
  80:                         ppspac();
  81:                         break;
  82:                     case T_PPROC:
  83:                         ppkw("procedure");
  84:                         ppspac();
  85:                         break;
  86:                     case T_PFUNC:
  87:                         ppkw("function");
  88:                         ppspac();
  89:                         break;
  90:                 }
  91:                 il = rl[1][1];
  92:                 if (il != NIL)
  93:                     for (;;) {
  94:                         ppid(il[1]);
  95:                         il = il[2];
  96:                         if (il == NIL)
  97:                             break;
  98:                         ppsep(", ");
  99:                     }
 100:                 else
 101:                     ppid("{identifier list}");
 102:                 if (rl[1][0] != T_PPROC) {
 103:                     ppsep(":");
 104:                     gtype(rl[1][2]);
 105:                 }
 106:                 rl = rl[2];
 107:                 if (rl == NIL)
 108:                     break;
 109:                 ppsep(";");
 110:                 ppspac();
 111:             }
 112:             ppket(")");
 113:         }
 114:         if (r[0] == T_FDEC && r[4] != NIL) {
 115:             ppsep(":");
 116:             gtype(r[4]);
 117:         }
 118:         ppsep(";");
 119:     } else {
 120:         rl = r[3];
 121:         if (rl != NIL) {
 122:             ppbra("(");
 123:             for (;;) {
 124:                 ppid(rl[1]);
 125:                 rl = rl[2];
 126:                 if (rl == NIL)
 127:                     break;
 128:                 ppsep(", ");
 129:             }
 130:             ppket(")");
 131:         }
 132:         ppsep(";");
 133:     }
 134: fhout:
 135:     setline(r[1]);
 136:     putcml();
 137:     savecnt(&pfcnts[cbn]);
 138:     setprint();
 139:     --cbn;
 140:     if (cbn && !justify)
 141:         ppgoout(PRFN);
 142:     return (r[2]);
 143: }
 144: 
 145: /*
 146:  * Forward declaration i.e. the second line of
 147:  *
 148:  *	procedure fum(var i: integer);
 149:  *	    forward;
 150:  */
 151: funcfwd(fp)
 152:     char *fp;
 153: {
 154: 
 155:     baroff();
 156:     ppgoin(DECL);
 157:     ppnl();
 158:     indent();
 159:     ppkw("forward");
 160:     ppsep(";");
 161:     ppgoout(DECL);
 162:     baron();
 163:     return (fp);
 164: }
 165: 
 166: /*
 167:  * The "body" of a procedure, function, or program declaration,
 168:  * i.e. a non-forward definition encounter.
 169:  */
 170: funcbody(fp)
 171:     char *fp;
 172: {
 173: 
 174:     if (cbn && !justify)
 175:         ppgoin(PRFN);
 176:     cbn++;
 177:     lastbn = cbn;
 178:     return (fp);
 179: }
 180: 
 181: /*
 182:  * The guts of the procedure, function or program, i.e.
 183:  * the part between the begin and the end.
 184:  */
 185: funcend(fp, bundle, binfo)
 186:     char *fp;
 187:     int *bundle, *binfo;
 188: {
 189:     int *blk;
 190:     extern int cntstat;
 191: 
 192:     cntstat = 0;
 193:     blk = bundle[2];
 194:     rescnt(&pfcnts[cbn]);
 195:     setprint();
 196:     if (cbn == 1 && noinclude && bracket)
 197:         printoff();
 198:     if (lastbn > cbn)
 199:         unprint();
 200:     if (cbn == 1)
 201:         puthedr();
 202:     if (noblank(setline(bundle[1])) && lastbn > cbn)
 203:         ppnl();
 204:     ppnl();
 205:     indent();
 206:     ppkw("begin");
 207:     setline(bundle[1]);
 208:     if (putcml() == 0 && lastbn > cbn)
 209:         ppsname(fp);
 210:     ppgoin(DECL);
 211:     statlist(blk);
 212:     setinfo(bundle[1]);
 213:     putcmp();
 214:     ppgoout(DECL);
 215:     ppnl();
 216:     indent();
 217:     ppkw("end");
 218:     ppsep(cbn == 1 ? "." : ";");
 219:     setinfo(binfo);
 220:     if (putcml() == 0)
 221:         ppsname(fp);
 222:     cbn--;
 223:     if (cbn && !justify)
 224:         ppgoout(PRFN);
 225:     if (inpflist(fp)) {
 226:         opts['z'-'a'] = optstk['z'-'a'] & 1;
 227:         optstk['z'-'a'] =>> 1;
 228:     }
 229:     if (cbn == 0) {
 230:         flushcm();
 231:         printon();
 232:         ppnl();
 233:     }
 234: }
 235: 
 236: ppsname(fp)
 237:     char *fp;
 238: {
 239:     if (fp == NIL)
 240:         return;
 241:     ppsep(" { ");
 242:     ppid(fp);
 243:     ppsep(" }");
 244: }
 245: 
 246: /*
 247:  * Segend is called at the end of a routine segment (a separately
 248:  * compiled segment that is not the main program). Since pxp only works
 249:  * with a single pascal file, this routine should never be called.
 250:  */
 251: segend()
 252: {
 253: 
 254:     if ( profile ) {
 255:         error("Missing program statement and program body");
 256:     }
 257: }
 258: 
 259: /*
 260:  * External declaration i.e. the second line of
 261:  *
 262:  *	procedure fum(var i: integer);
 263:  *	    external;
 264:  */
 265: struct nl *
 266: funcext(fp)
 267:     struct nl *fp;
 268: {
 269: 
 270:     baroff();
 271:     ppgoin(DECL);
 272:     ppnl();
 273:     indent();
 274:     ppkw("external");
 275:     ppsep(";");
 276:     ppgoout(DECL);
 277:     baron();
 278:     return (fp);
 279: }

Defined functions

Defined variables