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