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