1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char *sccsid = "@(#)type.c 1.3 (Berkeley) 02/08/84"; 4 5 /* 6 * pxp - Pascal execution profiler 7 * 8 * Bill Joy UCB 9 * Version 1.2 January 1979 10 */ 11 12 #include "0.h" 13 #include "tree.h" 14 15 STATIC int typecnt = -1; 16 /* 17 * Type declaration part 18 */ 19 typebeg(l, tline) 20 int l, tline; 21 { 22 23 line = l; 24 if (nodecl) 25 printoff(); 26 puthedr(); 27 putcm(); 28 ppnl(); 29 indent(); 30 ppkw("type"); 31 ppgoin(DECL); 32 typecnt = 0; 33 setline(tline); 34 } 35 36 type(tline, tid, tdecl) 37 int tline; 38 char *tid; 39 int *tdecl; 40 { 41 42 if (typecnt) 43 putcm(); 44 setline(tline); 45 ppitem(); 46 ppid(tid); 47 ppsep(" ="); 48 gtype(tdecl); 49 ppsep(";"); 50 setinfo(tline); 51 putcml(); 52 typecnt++; 53 } 54 55 typeend() 56 { 57 58 if (typecnt == -1) 59 return; 60 if (typecnt == 0) 61 ppid("{type decls}"); 62 ppgoout(DECL); 63 typecnt = -1; 64 } 65 66 /* 67 * A single type declaration 68 */ 69 gtype(r) 70 register int *r; 71 { 72 73 if (r == NIL) { 74 ppid("{type}"); 75 return; 76 } 77 if (r[0] != T_ID && r[0] != T_TYPACK) 78 setline(r[1]); 79 switch (r[0]) { 80 default: 81 panic("type"); 82 case T_ID: 83 ppspac(); 84 ppid(r[1]); 85 return; 86 case T_TYID: 87 ppspac(); 88 ppid(r[2]); 89 break; 90 case T_TYSCAL: 91 ppspac(); 92 tyscal(r); 93 break; 94 case T_TYCRANG: 95 ppspac(); 96 tycrang(r); 97 break; 98 case T_TYRANG: 99 ppspac(); 100 tyrang(r); 101 break; 102 case T_TYPTR: 103 ppspac(); 104 ppop("^"); 105 gtype(r[2]); 106 break; 107 case T_TYPACK: 108 ppspac(); 109 ppkw("packed"); 110 gtype(r[2]); 111 break; 112 case T_TYCARY: 113 case T_TYARY: 114 ppspac(); 115 tyary(r); 116 break; 117 case T_TYREC: 118 ppspac(); 119 tyrec(r[2], NIL); 120 break; 121 case T_TYFILE: 122 ppspac(); 123 ppkw("file"); 124 ppspac(); 125 ppkw("of"); 126 gtype(r[2]); 127 break; 128 case T_TYSET: 129 ppspac(); 130 ppkw("set"); 131 ppspac(); 132 ppkw("of"); 133 gtype(r[2]); 134 break; 135 } 136 setline(r[1]); 137 putcml(); 138 } 139 140 /* 141 * Scalar type declaration 142 */ 143 tyscal(r) 144 register int *r; 145 { 146 register int i; 147 148 ppsep("("); 149 r = r[2]; 150 if (r != NIL) { 151 i = 0; 152 ppgoin(DECL); 153 for (;;) { 154 ppid(r[1]); 155 r = r[2]; 156 if (r == NIL) 157 break; 158 ppsep(", "); 159 i++; 160 if (i == 7) { 161 ppitem(); 162 i = 0; 163 } 164 } 165 ppgoout(DECL); 166 } else 167 ppid("{constant list}"); 168 ppsep(")"); 169 } 170 171 /* 172 * Conformant array subrange. 173 */ 174 tycrang(r) 175 register int *r; 176 { 177 178 ppid(r[2]); 179 ppsep(".."); 180 ppid(r[3]); 181 ppsep(":"); 182 gtype(r[4]); 183 } 184 185 /* 186 * Subrange type declaration 187 */ 188 tyrang(r) 189 register int *r; 190 { 191 192 gconst(r[2]); 193 ppsep(".."); 194 gconst(r[3]); 195 } 196 197 /* 198 * Array type declaration 199 */ 200 tyary(r) 201 register int *r; 202 { 203 register int *tl; 204 205 ppkw("array"); 206 ppspac(); 207 ppsep("["); 208 tl = r[2]; 209 if (tl != NIL) { 210 ppunspac(); 211 for (;;) { 212 gtype(tl[1]); 213 tl = tl[2]; 214 if (tl == NIL) 215 break; 216 ppsep(","); 217 } 218 } else 219 ppid("{subscr list}"); 220 ppsep("]"); 221 ppspac(); 222 ppkw("of"); 223 gtype(r[3]); 224 } 225