| 1 | /* Copyright (c) 1979 Regents of the University of California */ |
| 2 | # |
| 3 | /* |
| 4 | * pi - Pascal interpreter code translator |
| 5 | * |
| 6 | * Charles Haley, Bill Joy UCB |
| 7 | * Version 1.2 January 1979 |
| 8 | */ |
| 9 | |
| 10 | #include "0.h" |
| 11 | #include "tree.h" |
| 12 | #include "opcode.h" |
| 13 | |
| 14 | /* |
| 15 | * Build a record namelist entry. |
| 16 | * Some of the processing here is somewhat involved. |
| 17 | * The basic structure we are building is as follows. |
| 18 | * |
| 19 | * Each record has a main RECORD entry, with an attached |
| 20 | * chain of fields as ->chain; these include all the fields in all |
| 21 | * the variants of this record. |
| 22 | * |
| 23 | * Attached to NL_VARNT is a chain of VARNT structures |
| 24 | * describing each of the variants. These are further linked |
| 25 | * through ->chain. Each VARNT has, in ->range[0] the value of |
| 26 | * the associated constant, and each points at a RECORD describing |
| 27 | * the subrecord through NL_VTOREC. These pointers are not unique, |
| 28 | * more than one VARNT may reference the same RECORD. |
| 29 | * |
| 30 | * The involved processing here is in computing the NL_OFFS entry |
| 31 | * by maxing over the variants. This works as follows. |
| 32 | * |
| 33 | * Each RECORD has two size counters. NL_OFFS is the maximum size |
| 34 | * so far of any variant of this record; NL_FLDSZ gives the size |
| 35 | * of just the FIELDs to this point as a base for further variants. |
| 36 | * |
| 37 | * As we process each variant record, we start its size with the |
| 38 | * NL_FLDSZ we have so far. After processing it, if its NL_OFFS |
| 39 | * is the largest so far, we update the NL_OFFS of this subrecord. |
| 40 | * This will eventually propagate back and update the NL_OFFS of the |
| 41 | * entire record. |
| 42 | */ |
| 43 | |
| 44 | /* |
| 45 | * P0 points to the outermost RECORD for name searches. |
| 46 | */ |
| 47 | struct nl *P0; |
| 48 | |
| 49 | tyrec(r, off) |
| 50 | int *r, off; |
| 51 | { |
| 52 | |
| 53 | tyrec1(r, off, 1); |
| 54 | } |
| 55 | |
| 56 | /* |
| 57 | * Define a record namelist entry. |
| 58 | * R is the tree for the record to be built. |
| 59 | * Off is the offset for the first item in this (sub)record. |
| 60 | */ |
| 61 | tyrec1(r, off, first) |
| 62 | register int *r; |
| 63 | int off; |
| 64 | char first; |
| 65 | { |
| 66 | register struct nl *p, *P0was; |
| 67 | |
| 68 | p = defnl(0, RECORD, 0, 0); |
| 69 | P0was = P0; |
| 70 | if (first) |
| 71 | P0 = p; |
| 72 | #ifndef PI0 |
| 73 | p->value[NL_FLDSZ] = p->value[NL_OFFS] = off; |
| 74 | #endif |
| 75 | if (r != NIL) { |
| 76 | fields(p, r[2]); |
| 77 | variants(p, r[3]); |
| 78 | } |
| 79 | P0 = P0was; |
| 80 | return (p); |
| 81 | } |
| 82 | |
| 83 | /* |
| 84 | * Define the fixed part fields for p. |
| 85 | */ |
| 86 | fields(p, r) |
| 87 | struct nl *p; |
| 88 | int *r; |
| 89 | { |
| 90 | register int *fp, *tp, *ip; |
| 91 | struct nl *jp; |
| 92 | |
| 93 | for (fp = r; fp != NIL; fp = fp[2]) { |
| 94 | tp = fp[1]; |
| 95 | if (tp == NIL) |
| 96 | continue; |
| 97 | jp = gtype(tp[3]); |
| 98 | line = tp[1]; |
| 99 | for (ip = tp[2]; ip != NIL; ip = ip[2]) |
| 100 | deffld(p, ip[1], jp); |
| 101 | } |
| 102 | } |
| 103 | |
| 104 | /* |
| 105 | * Define the variants for RECORD p. |
| 106 | */ |
| 107 | variants(p, r) |
| 108 | struct nl *p; |
| 109 | register int *r; |
| 110 | { |
| 111 | register int *vc, *v; |
| 112 | int *vr; |
| 113 | struct nl *ct; |
| 114 | |
| 115 | if (r == NIL) |
| 116 | return; |
| 117 | ct = gtype(r[3]); |
| 118 | line = r[1]; |
| 119 | /* |
| 120 | * Want it even if r[2] is NIL so |
| 121 | * we check its type in "new" and "dispose" |
| 122 | * calls -- link it to NL_TAG. |
| 123 | */ |
| 124 | p->value[NL_TAG] = deffld(p, r[2], ct); |
| 125 | for (vc = r[4]; vc != NIL; vc = vc[2]) { |
| 126 | v = vc[1]; |
| 127 | if (v == NIL) |
| 128 | continue; |
| 129 | vr = tyrec1(v[3], p->value[NL_FLDSZ], 0); |
| 130 | #ifndef PI0 |
| 131 | if (vr->value[NL_OFFS] > p->value[NL_OFFS]) |
| 132 | p->value[NL_OFFS] = vr->value[NL_OFFS]; |
| 133 | #endif |
| 134 | line = v[1]; |
| 135 | for (v = v[2]; v != NIL; v = v[2]) |
| 136 | defvnt(p, v[1], vr, ct); |
| 137 | } |
| 138 | } |
| 139 | |
| 140 | /* |
| 141 | * Define a field in subrecord p of record P0 |
| 142 | * with name s and type t. |
| 143 | */ |
| 144 | deffld(p, s, t) |
| 145 | struct nl *p; |
| 146 | register char *s; |
| 147 | register struct nl *t; |
| 148 | { |
| 149 | register struct nl *fp; |
| 150 | |
| 151 | if (reclook(P0, s) != NIL) { |
| 152 | #ifndef PI1 |
| 153 | error("%s is a duplicate field name in this record", s); |
| 154 | #endif |
| 155 | s = NIL; |
| 156 | } |
| 157 | #ifndef PI0 |
| 158 | fp = enter(defnl(s, FIELD, t, p->value[NL_OFFS])); |
| 159 | #else |
| 160 | fp = enter(defnl(s, FIELD, t, 0)); |
| 161 | #endif |
| 162 | if (s != NIL) { |
| 163 | fp->chain = P0->chain; |
| 164 | P0->chain = fp; |
| 165 | #ifndef PI0 |
| 166 | p->value[NL_FLDSZ] = p->value[NL_OFFS] =+ even(width(t)); |
| 167 | #endif |
| 168 | if (t != NIL) { |
| 169 | P0->nl_flags =| t->nl_flags & NFILES; |
| 170 | p->nl_flags =| t->nl_flags & NFILES; |
| 171 | } |
| 172 | } |
| 173 | return (fp); |
| 174 | } |
| 175 | |
| 176 | /* |
| 177 | * Define a variant from the constant tree of t |
| 178 | * in subrecord p of record P0 where the casetype |
| 179 | * is ct and the variant record to be associated is vr. |
| 180 | */ |
| 181 | defvnt(p, t, vr, ct) |
| 182 | struct nl *p, *vr; |
| 183 | int *t; |
| 184 | register struct nl *ct; |
| 185 | { |
| 186 | register struct nl *av; |
| 187 | |
| 188 | gconst(t); |
| 189 | if (ct != NIL && incompat(con.ctype, ct)) { |
| 190 | #ifndef PI1 |
| 191 | cerror("Variant label type incompatible with selector type"); |
| 192 | #endif |
| 193 | ct = NIL; |
| 194 | } |
| 195 | av = defnl(0, VARNT, ct, 0); |
| 196 | #ifndef PI1 |
| 197 | if (ct != NIL) |
| 198 | uniqv(p); |
| 199 | #endif |
| 200 | av->chain = p->value[NL_VARNT]; |
| 201 | p->value[NL_VARNT] = av; |
| 202 | av->value[NL_VTOREC] = vr; |
| 203 | av->range[0] = con.crval; |
| 204 | return (av); |
| 205 | } |
| 206 | |
| 207 | #ifndef PI1 |
| 208 | /* |
| 209 | * Check that the constant label value |
| 210 | * is unique among the labels in this variant. |
| 211 | */ |
| 212 | uniqv(p) |
| 213 | struct nl *p; |
| 214 | { |
| 215 | register struct nl *vt; |
| 216 | |
| 217 | for (vt = p->value[NL_VARNT]; vt != NIL; vt = vt->chain) |
| 218 | if (vt->range[0] == con.crval) { |
| 219 | error("Duplicate variant case label in record"); |
| 220 | return; |
| 221 | } |
| 222 | } |
| 223 | #endif |
| 224 | |
| 225 | /* |
| 226 | * See if the field name s is defined |
| 227 | * in the record p, returning a pointer |
| 228 | * to it namelist entry if it is. |
| 229 | */ |
| 230 | reclook(p, s) |
| 231 | register struct nl *p; |
| 232 | char *s; |
| 233 | { |
| 234 | |
| 235 | if (p == NIL || s == NIL) |
| 236 | return (NIL); |
| 237 | for (p = p->chain; p != NIL; p = p->chain) |
| 238 | if (p->symbol == s) |
| 239 | return (p); |
| 240 | return (NIL); |
| 241 | } |