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