BSD 2 development
[unix-history] / src / pi1 / var.c
CommitLineData
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 */
21varbeg()
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
38var(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
72varend()
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 */
86even(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 */
97width(np)
98 struct nl *np;
99{
100
101 return (lwidth(np));
102}
103
104long 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);
113loop:
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 */
157long 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 */
198setran(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 */
219bytes(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}