Commit | Line | Data |
---|---|---|
16494185 BJ |
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 | * Declare variables of a var part. DPOFF1 is | |
16 | * the local variable storage for all prog/proc/func | |
17 | * modules aside from the block mark. The total size | |
18 | * of all the local variables is entered into the | |
19 | * size array. | |
20 | */ | |
21 | varbeg() | |
22 | { | |
23 | ||
24 | #ifndef PI1 | |
25 | if (parts & VPRT) | |
26 | error("All variables must be declared in one var part"); | |
27 | parts =| VPRT; | |
28 | #endif | |
29 | #ifndef PI0 | |
30 | sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; | |
31 | #endif | |
32 | forechain = NIL; | |
33 | #ifdef PI0 | |
34 | send(REVVBEG); | |
35 | #endif | |
36 | } | |
37 | ||
38 | var(vline, vidl, vtype) | |
39 | #ifdef PI0 | |
40 | int vline, *vidl, *vtype; | |
41 | { | |
42 | register struct nl *np; | |
43 | register int *vl; | |
44 | ||
45 | np = gtype(vtype); | |
46 | line = vline; | |
47 | for (vl = vidl; vl != NIL; vl = vl[2]) | |
48 | enter(defnl(vl[1], VAR, np, 0)); | |
49 | send(REVVAR, vline, vidl, vtype); | |
50 | #else | |
51 | int vline; | |
52 | register int *vidl; | |
53 | int *vtype; | |
54 | { | |
55 | register struct nl *np; | |
56 | register struct om *op; | |
57 | long w; | |
58 | int o2; | |
59 | ||
60 | np = gtype(vtype); | |
61 | line = vline; | |
62 | w = (lwidth(np) + 1) &~ 1; | |
63 | op = &sizes[cbn]; | |
64 | for (; vidl != NIL; vidl = vidl[2]) { | |
65 | op->om_off =- w; | |
66 | o2 = op->om_off; | |
67 | enter(defnl(vidl[1], VAR, np, o2)); | |
68 | } | |
69 | #endif | |
70 | } | |
71 | ||
72 | varend() | |
73 | { | |
74 | ||
75 | foredecl(); | |
76 | #ifndef PI0 | |
77 | sizes[cbn].om_max = sizes[cbn].om_off; | |
78 | #else | |
79 | send(REVVEND); | |
80 | #endif | |
81 | } | |
82 | ||
83 | /* | |
84 | * Evening | |
85 | */ | |
86 | even(w) | |
87 | register int w; | |
88 | { | |
89 | if (w < 0) | |
90 | return (w & ~1); | |
91 | return ((w+1) & ~1); | |
92 | } | |
93 | ||
94 | /* | |
95 | * Find the width of a type in bytes. | |
96 | */ | |
97 | width(np) | |
98 | struct nl *np; | |
99 | { | |
100 | ||
101 | return (lwidth(np)); | |
102 | } | |
103 | ||
104 | long lwidth(np) | |
105 | struct nl *np; | |
106 | { | |
107 | register struct nl *p; | |
108 | long w; | |
109 | ||
110 | p = np; | |
111 | if (p == NIL) | |
112 | return (0); | |
113 | loop: | |
114 | switch (p->class) { | |
115 | case TYPE: | |
116 | switch (nloff(p)) { | |
117 | case TNIL: | |
118 | return (2); | |
119 | case TSTR: | |
120 | case TSET: | |
121 | panic("width"); | |
122 | default: | |
123 | p = p->type; | |
124 | goto loop; | |
125 | } | |
126 | case ARRAY: | |
127 | return (aryconst(p, 0)); | |
128 | case PTR: | |
129 | case FILE: | |
130 | return (2); | |
131 | case RANGE: | |
132 | if (p->type == nl+TDOUBLE) | |
133 | #ifdef DEBUG | |
134 | return (hp21mx ? 4 : 8); | |
135 | #else | |
136 | return (8); | |
137 | #endif | |
138 | case SCAL: | |
139 | return (bytes(p->range[0], p->range[1])); | |
140 | case SET: | |
141 | setran(p->type); | |
142 | return ( (set.uprbp>>3) + 1); | |
143 | case STR: | |
144 | case RECORD: | |
145 | w = 0; | |
146 | w.pint2 = p->value[NL_OFFS]; | |
147 | return (w); | |
148 | default: | |
149 | panic("wclass"); | |
150 | } | |
151 | } | |
152 | ||
153 | /* | |
154 | * Return the width of an element | |
155 | * of a n time subscripted np. | |
156 | */ | |
157 | long aryconst(np, n) | |
158 | struct nl *np; | |
159 | int n; | |
160 | { | |
161 | register struct nl *p; | |
162 | long s, d; | |
163 | ||
164 | if ((p = np) == NIL) | |
165 | return (NIL); | |
166 | if (p->class != ARRAY) | |
167 | panic("ary"); | |
168 | s = width(p->type); | |
169 | /* | |
170 | * Arrays of anything but characters are word aligned. | |
171 | */ | |
172 | if (s & 1) | |
173 | if (s != 1) | |
174 | s++; | |
175 | /* | |
176 | * Skip the first n subscripts | |
177 | */ | |
178 | while (n >= 0) { | |
179 | p = p->chain; | |
180 | n--; | |
181 | } | |
182 | /* | |
183 | * Sum across remaining subscripts. | |
184 | */ | |
185 | while (p != NIL) { | |
186 | if (p->class != RANGE && p->class != SCAL) | |
187 | panic("aryran"); | |
188 | d = p->range[1] - p->range[0] + 1; | |
189 | s =* d; | |
190 | p = p->chain; | |
191 | } | |
192 | return (s); | |
193 | } | |
194 | ||
195 | /* | |
196 | * Find the lower bound of a set, and also its size in bits. | |
197 | */ | |
198 | setran(q) | |
199 | struct nl *q; | |
200 | { | |
201 | register lb, ub; | |
202 | register struct nl *p; | |
203 | ||
204 | p = q; | |
205 | if (p == NIL) | |
206 | return (NIL); | |
207 | lb = p->range[0]; | |
208 | ub = p->range[1]; | |
209 | if (p->class != RANGE && p->class != SCAL) | |
210 | panic("setran"); | |
211 | set.lwrb = lb; | |
212 | /* set.(upperbound prime) = number of bits - 1; */ | |
213 | set.uprbp = ub-lb; | |
214 | } | |
215 | ||
216 | /* | |
217 | * Return the number of bytes required to hold an arithmetic quantity | |
218 | */ | |
219 | bytes(lb, ub) | |
220 | long lb, ub; | |
221 | { | |
222 | ||
223 | #ifndef DEBUG | |
224 | if (lb < -32768 || ub > 32767) | |
225 | return (4); | |
226 | else if (lb < -128 || ub > 127) | |
227 | return (2); | |
228 | #else | |
229 | if (!hp21mx && (lb < -32768 || ub > 32767)) | |
230 | return (4); | |
231 | if (lb < -128 || ub > 127) | |
232 | return (2); | |
233 | #endif | |
234 | else | |
235 | return (1); | |
236 | } |