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