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