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