|
|
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: ! 12: tyrec(r, p0) ! 13: int *r, p0; ! 14: { ! 15: ! 16: if (r != NIL) ! 17: setinfo(r[1]); ! 18: if (p0 == NIL) { ! 19: ppgoin(DECL); ! 20: ppnl(); ! 21: indent(); ! 22: ppkw("record"); ! 23: ppspac(); ! 24: } else { ! 25: ppspac(); ! 26: ppbra("("); ! 27: } ! 28: ppgoin(DECL); ! 29: if (r) { ! 30: field(r[2], r[3]); ! 31: variant(r[3]); ! 32: } ! 33: if (r != NIL) ! 34: setinfo(r[1]); ! 35: putcml(); ! 36: ppgoout(DECL); ! 37: if (p0 == NIL) { ! 38: ppnl(); ! 39: indent(); ! 40: ppkw("end"); ! 41: ppgoout(DECL); ! 42: } else { ! 43: ppitem(); ! 44: ppket(")"); ! 45: } ! 46: } ! 47: ! 48: field(r, v) ! 49: int *r, *v; ! 50: { ! 51: register int *fp, *tp, *ip; ! 52: ! 53: fp = r; ! 54: if (fp != NIL) ! 55: for (;;) { ! 56: tp = fp[1]; ! 57: if (tp != NIL) { ! 58: setline(tp[1]); ! 59: ip = tp[2]; ! 60: ppitem(); ! 61: if (ip != NIL) ! 62: for (;;) { ! 63: ppid(ip[1]); ! 64: ip = ip[2]; ! 65: if (ip == NIL) ! 66: break; ! 67: ppsep(", "); ! 68: } ! 69: else ! 70: ppid("{field id list}"); ! 71: ppsep(":"); ! 72: gtype(tp[3]); ! 73: setinfo(tp[1]); ! 74: putcm(); ! 75: } ! 76: fp = fp[2]; ! 77: if (fp == NIL) ! 78: break; ! 79: ppsep(";"); ! 80: } ! 81: if (v != NIL && r != NIL) ! 82: ppsep(";"); ! 83: } ! 84: ! 85: variant(r) ! 86: register int *r; ! 87: { ! 88: register int *v, *vc; ! 89: ! 90: if (r == NIL) ! 91: return; ! 92: setline(r[1]); ! 93: ppitem(); ! 94: ppkw("case"); ! 95: v = r[2]; ! 96: if (v != NIL) { ! 97: ppspac(); ! 98: ppid(v); ! 99: ppsep(":"); ! 100: } ! 101: gtype(r[3]); ! 102: ppspac(); ! 103: ppkw("of"); ! 104: for (vc = r[4]; vc != NIL;) { ! 105: v = vc[1]; ! 106: if (v == NIL) ! 107: continue; ! 108: ppgoin(DECL); ! 109: setline(v[1]); ! 110: ppnl(); ! 111: indent(); ! 112: ppbra(NIL); ! 113: v = v[2]; ! 114: if (v != NIL) { ! 115: for (;;) { ! 116: gconst(v[1]); ! 117: v = v[2]; ! 118: if (v == NIL) ! 119: break; ! 120: ppsep(", "); ! 121: } ! 122: } else ! 123: ppid("{case label list}"); ! 124: ppket(":"); ! 125: v = vc[1]; ! 126: tyrec(v[3], 1); ! 127: setinfo(v[1]); ! 128: putcml(); ! 129: ppgoout(DECL); ! 130: vc = vc[2]; ! 131: if (vc == NIL) ! 132: break; ! 133: ppsep(";"); ! 134: } ! 135: setinfo(r[1]); ! 136: putcm(); ! 137: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.