1: # 2: /* 3: * pxp - Pascal execution profiler 4: * 5: * Bill Joy UCB 6: * Version 1.2.1 January 1994 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 && noinclude && 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 && noinclude && 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: }