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