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