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