| 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 | } |