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