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