1 564ca709 2004-04-19 devnull #include <u.h>
  2 564ca709 2004-04-19 devnull #include <libc.h>
  3 564ca709 2004-04-19 devnull #include <bio.h>
  4 564ca709 2004-04-19 devnull #include <ctype.h>
  5 564ca709 2004-04-19 devnull #include <mach.h>
  6 564ca709 2004-04-19 devnull #define Extern extern
  7 564ca709 2004-04-19 devnull #include "acid.h"
  8 564ca709 2004-04-19 devnull 
  9 564ca709 2004-04-19 devnull void
 10 564ca709 2004-04-19 devnull error(char *fmt, ...)
 11 564ca709 2004-04-19 devnull {
 12 564ca709 2004-04-19 devnull 	int i;
 13 564ca709 2004-04-19 devnull 	char buf[2048];
 14 564ca709 2004-04-19 devnull 	va_list arg;
 15 564ca709 2004-04-19 devnull 
 16 564ca709 2004-04-19 devnull 	/* Unstack io channels */
 17 564ca709 2004-04-19 devnull 	if(iop != 0) {
 18 564ca709 2004-04-19 devnull 		for(i = 1; i < iop; i++)
 19 564ca709 2004-04-19 devnull 			Bterm(io[i]);
 20 564ca709 2004-04-19 devnull 		bout = io[0];
 21 564ca709 2004-04-19 devnull 		iop = 0;
 22 564ca709 2004-04-19 devnull 	}
 23 564ca709 2004-04-19 devnull 
 24 564ca709 2004-04-19 devnull 	ret = 0;
 25 564ca709 2004-04-19 devnull 	gotint = 0;
 26 564ca709 2004-04-19 devnull 	Bflush(bout);
 27 564ca709 2004-04-19 devnull 	if(silent)
 28 564ca709 2004-04-19 devnull 		silent = 0;
 29 564ca709 2004-04-19 devnull 	else {
 30 564ca709 2004-04-19 devnull 		va_start(arg, fmt);
 31 564ca709 2004-04-19 devnull 		vseprint(buf, buf+sizeof(buf), fmt, arg);
 32 564ca709 2004-04-19 devnull 		va_end(arg);
 33 564ca709 2004-04-19 devnull 		fprint(2, "%Z: (error) %s\n", buf);
 34 564ca709 2004-04-19 devnull 	}
 35 564ca709 2004-04-19 devnull 	while(popio())
 36 564ca709 2004-04-19 devnull 		;
 37 564ca709 2004-04-19 devnull 	interactive = 1;
 38 564ca709 2004-04-19 devnull 	longjmp(err, 1);
 39 564ca709 2004-04-19 devnull }
 40 564ca709 2004-04-19 devnull 
 41 564ca709 2004-04-19 devnull void
 42 564ca709 2004-04-19 devnull unwind(void)
 43 564ca709 2004-04-19 devnull {
 44 564ca709 2004-04-19 devnull 	int i;
 45 564ca709 2004-04-19 devnull 	Lsym *s;
 46 564ca709 2004-04-19 devnull 	Value *v;
 47 564ca709 2004-04-19 devnull 
 48 564ca709 2004-04-19 devnull 	for(i = 0; i < Hashsize; i++) {
 49 564ca709 2004-04-19 devnull 		for(s = hash[i]; s; s = s->hash) {
 50 564ca709 2004-04-19 devnull 			while(s->v->pop) {
 51 564ca709 2004-04-19 devnull 				v = s->v->pop;
 52 564ca709 2004-04-19 devnull 				free(s->v);
 53 564ca709 2004-04-19 devnull 				s->v = v;
 54 564ca709 2004-04-19 devnull 			}
 55 564ca709 2004-04-19 devnull 		}
 56 564ca709 2004-04-19 devnull 	}
 57 564ca709 2004-04-19 devnull }
 58 564ca709 2004-04-19 devnull 
 59 564ca709 2004-04-19 devnull void
 60 564ca709 2004-04-19 devnull execute(Node *n)
 61 564ca709 2004-04-19 devnull {
 62 564ca709 2004-04-19 devnull 	Value *v;
 63 564ca709 2004-04-19 devnull 	Lsym *sl;
 64 564ca709 2004-04-19 devnull 	Node *l, *r;
 65 564ca709 2004-04-19 devnull 	int i, s, e;
 66 564ca709 2004-04-19 devnull 	Node res, xx;
 67 564ca709 2004-04-19 devnull 	static int stmnt;
 68 564ca709 2004-04-19 devnull 
 69 564ca709 2004-04-19 devnull 	gc();
 70 564ca709 2004-04-19 devnull 	if(gotint)
 71 564ca709 2004-04-19 devnull 		error("interrupted");
 72 564ca709 2004-04-19 devnull 
 73 564ca709 2004-04-19 devnull 	if(n == 0)
 74 564ca709 2004-04-19 devnull 		return;
 75 564ca709 2004-04-19 devnull 
 76 564ca709 2004-04-19 devnull 	if(stmnt++ > 5000) {
 77 564ca709 2004-04-19 devnull 		Bflush(bout);
 78 564ca709 2004-04-19 devnull 		stmnt = 0;
 79 564ca709 2004-04-19 devnull 	}
 80 564ca709 2004-04-19 devnull 
 81 564ca709 2004-04-19 devnull 	l = n->left;
 82 564ca709 2004-04-19 devnull 	r = n->right;
 83 564ca709 2004-04-19 devnull 
 84 564ca709 2004-04-19 devnull 	switch(n->op) {
 85 564ca709 2004-04-19 devnull 	default:
 86 564ca709 2004-04-19 devnull 		expr(n, &res);
 87 564ca709 2004-04-19 devnull 		if(ret || (res.type == TLIST && res.store.u.l == 0))
 88 564ca709 2004-04-19 devnull 			break;
 89 564ca709 2004-04-19 devnull 		prnt->right = &res;
 90 564ca709 2004-04-19 devnull 		expr(prnt, &xx);
 91 564ca709 2004-04-19 devnull 		break;
 92 564ca709 2004-04-19 devnull 	case OASGN:
 93 564ca709 2004-04-19 devnull 	case OCALL:
 94 564ca709 2004-04-19 devnull 		expr(n, &res);
 95 564ca709 2004-04-19 devnull 		break;
 96 564ca709 2004-04-19 devnull 	case OCOMPLEX:
 97 564ca709 2004-04-19 devnull 		decl(n);
 98 564ca709 2004-04-19 devnull 		break;
 99 564ca709 2004-04-19 devnull 	case OLOCAL:
100 564ca709 2004-04-19 devnull 		for(n = n->left; n; n = n->left) {
101 564ca709 2004-04-19 devnull 			if(ret == 0)
102 564ca709 2004-04-19 devnull 				error("local not in function");
103 564ca709 2004-04-19 devnull 			sl = n->sym;
104 564ca709 2004-04-19 devnull 			if(sl->v->ret == ret)
105 564ca709 2004-04-19 devnull 				error("%s declared twice", sl->name);
106 564ca709 2004-04-19 devnull 			v = gmalloc(sizeof(Value));
107 564ca709 2004-04-19 devnull 			v->ret = ret;
108 564ca709 2004-04-19 devnull 			v->pop = sl->v;
109 564ca709 2004-04-19 devnull 			sl->v = v;
110 564ca709 2004-04-19 devnull 			v->scope = 0;
111 564ca709 2004-04-19 devnull 			*(ret->tail) = sl;
112 564ca709 2004-04-19 devnull 			ret->tail = &v->scope;
113 564ca709 2004-04-19 devnull 			v->set = 0;
114 564ca709 2004-04-19 devnull 		}
115 564ca709 2004-04-19 devnull 		break;
116 564ca709 2004-04-19 devnull 	case ORET:
117 564ca709 2004-04-19 devnull 		if(ret == 0)
118 564ca709 2004-04-19 devnull 			error("return not in function");
119 564ca709 2004-04-19 devnull 		expr(n->left, ret->val);
120 564ca709 2004-04-19 devnull 		longjmp(ret->rlab, 1);
121 564ca709 2004-04-19 devnull 	case OLIST:
122 564ca709 2004-04-19 devnull 		execute(n->left);
123 564ca709 2004-04-19 devnull 		execute(n->right);
124 564ca709 2004-04-19 devnull 		break;
125 564ca709 2004-04-19 devnull 	case OIF:
126 564ca709 2004-04-19 devnull 		expr(l, &res);
127 564ca709 2004-04-19 devnull 		if(r && r->op == OELSE) {
128 564ca709 2004-04-19 devnull 			if(bool(&res))
129 564ca709 2004-04-19 devnull 				execute(r->left);
130 564ca709 2004-04-19 devnull 			else
131 564ca709 2004-04-19 devnull 				execute(r->right);
132 564ca709 2004-04-19 devnull 		}
133 564ca709 2004-04-19 devnull 		else if(bool(&res))
134 564ca709 2004-04-19 devnull 			execute(r);
135 564ca709 2004-04-19 devnull 		break;
136 564ca709 2004-04-19 devnull 	case OWHILE:
137 564ca709 2004-04-19 devnull 		for(;;) {
138 564ca709 2004-04-19 devnull 			expr(l, &res);
139 564ca709 2004-04-19 devnull 			if(!bool(&res))
140 564ca709 2004-04-19 devnull 				break;
141 564ca709 2004-04-19 devnull 			execute(r);
142 564ca709 2004-04-19 devnull 		}
143 564ca709 2004-04-19 devnull 		break;
144 564ca709 2004-04-19 devnull 	case ODO:
145 564ca709 2004-04-19 devnull 		expr(l->left, &res);
146 564ca709 2004-04-19 devnull 		if(res.type != TINT)
147 564ca709 2004-04-19 devnull 			error("loop must have integer start");
148 564ca709 2004-04-19 devnull 		s = res.store.u.ival;
149 564ca709 2004-04-19 devnull 		expr(l->right, &res);
150 564ca709 2004-04-19 devnull 		if(res.type != TINT)
151 564ca709 2004-04-19 devnull 			error("loop must have integer end");
152 564ca709 2004-04-19 devnull 		e = res.store.u.ival;
153 564ca709 2004-04-19 devnull 		for(i = s; i <= e; i++)
154 564ca709 2004-04-19 devnull 			execute(r);
155 564ca709 2004-04-19 devnull 		break;
156 564ca709 2004-04-19 devnull 	}
157 564ca709 2004-04-19 devnull }
158 564ca709 2004-04-19 devnull 
159 564ca709 2004-04-19 devnull int
160 564ca709 2004-04-19 devnull bool(Node *n)
161 564ca709 2004-04-19 devnull {
162 564ca709 2004-04-19 devnull 	int true = 0;
163 564ca709 2004-04-19 devnull 
164 564ca709 2004-04-19 devnull 	if(n->op != OCONST)
165 564ca709 2004-04-19 devnull 		fatal("bool: not const");
166 564ca709 2004-04-19 devnull 
167 564ca709 2004-04-19 devnull 	switch(n->type) {
168 564ca709 2004-04-19 devnull 	case TINT:
169 564ca709 2004-04-19 devnull 		if(n->store.u.ival != 0)
170 564ca709 2004-04-19 devnull 			true = 1;
171 564ca709 2004-04-19 devnull 		break;
172 564ca709 2004-04-19 devnull 	case TFLOAT:
173 564ca709 2004-04-19 devnull 		if(n->store.u.fval != 0.0)
174 564ca709 2004-04-19 devnull 			true = 1;
175 564ca709 2004-04-19 devnull 		break;
176 564ca709 2004-04-19 devnull 	case TSTRING:
177 564ca709 2004-04-19 devnull 		if(n->store.u.string->len)
178 564ca709 2004-04-19 devnull 			true = 1;
179 564ca709 2004-04-19 devnull 		break;
180 564ca709 2004-04-19 devnull 	case TLIST:
181 564ca709 2004-04-19 devnull 		if(n->store.u.l)
182 564ca709 2004-04-19 devnull 			true = 1;
183 564ca709 2004-04-19 devnull 		break;
184 564ca709 2004-04-19 devnull 	}
185 564ca709 2004-04-19 devnull 	return true;
186 564ca709 2004-04-19 devnull }
187 564ca709 2004-04-19 devnull 
188 564ca709 2004-04-19 devnull void
189 564ca709 2004-04-19 devnull convflt(Node *r, char *flt)
190 564ca709 2004-04-19 devnull {
191 564ca709 2004-04-19 devnull 	char c;
192 564ca709 2004-04-19 devnull 
193 564ca709 2004-04-19 devnull 	c = flt[0];
194 564ca709 2004-04-19 devnull 	if(('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')) {
195 564ca709 2004-04-19 devnull 		r->type = TSTRING;
196 564ca709 2004-04-19 devnull 		r->store.fmt = 's';
197 564ca709 2004-04-19 devnull 		r->store.u.string = strnode(flt);
198 564ca709 2004-04-19 devnull 	}
199 564ca709 2004-04-19 devnull 	else {
200 564ca709 2004-04-19 devnull 		r->type = TFLOAT;
201 564ca709 2004-04-19 devnull 		r->store.u.fval = atof(flt);
202 564ca709 2004-04-19 devnull 	}
203 564ca709 2004-04-19 devnull }
204 564ca709 2004-04-19 devnull 
205 564ca709 2004-04-19 devnull static char*
206 564ca709 2004-04-19 devnull regbyoff(ulong addr)
207 564ca709 2004-04-19 devnull {
208 564ca709 2004-04-19 devnull 	Regdesc *r;
209 564ca709 2004-04-19 devnull 
210 564ca709 2004-04-19 devnull 	if(mach == nil)
211 564ca709 2004-04-19 devnull 		error("no mach, no registers");
212 564ca709 2004-04-19 devnull 	for(r=mach->reglist; r->name; r++)
213 564ca709 2004-04-19 devnull 		if(r->offset == addr)
214 564ca709 2004-04-19 devnull 			return r->name;
215 564ca709 2004-04-19 devnull 	error("no register at %#lux", addr);
216 564ca709 2004-04-19 devnull 	return nil;
217 564ca709 2004-04-19 devnull }
218 564ca709 2004-04-19 devnull 
219 564ca709 2004-04-19 devnull int
220 564ca709 2004-04-19 devnull xget1(Map *m, ulong addr, u8int *a, int n)
221 564ca709 2004-04-19 devnull {
222 564ca709 2004-04-19 devnull 	if(addr < 0x100)
223 564ca709 2004-04-19 devnull 		return lget1(m, correg, locreg(regbyoff(addr)), a, n);
224 564ca709 2004-04-19 devnull 	else
225 564ca709 2004-04-19 devnull 		return get1(m, addr, a, n);
226 564ca709 2004-04-19 devnull }
227 564ca709 2004-04-19 devnull 
228 564ca709 2004-04-19 devnull int
229 564ca709 2004-04-19 devnull xget2(Map *m, ulong addr, u16int *a)
230 564ca709 2004-04-19 devnull {
231 564ca709 2004-04-19 devnull 	if(addr < 0x100)
232 564ca709 2004-04-19 devnull 		return lget2(m, correg, locreg(regbyoff(addr)), a);
233 564ca709 2004-04-19 devnull 	else
234 564ca709 2004-04-19 devnull 		return get2(m, addr, a);
235 564ca709 2004-04-19 devnull }
236 564ca709 2004-04-19 devnull 
237 564ca709 2004-04-19 devnull int
238 564ca709 2004-04-19 devnull xget4(Map *m, ulong addr, u32int *a)
239 564ca709 2004-04-19 devnull {
240 564ca709 2004-04-19 devnull 	if(addr < 0x100)
241 564ca709 2004-04-19 devnull 		return lget4(m, correg, locreg(regbyoff(addr)), a);
242 564ca709 2004-04-19 devnull 	else
243 564ca709 2004-04-19 devnull 		return get4(m, addr, a);
244 564ca709 2004-04-19 devnull }
245 564ca709 2004-04-19 devnull 
246 564ca709 2004-04-19 devnull int
247 564ca709 2004-04-19 devnull xget8(Map *m, ulong addr, u64int *a)
248 564ca709 2004-04-19 devnull {
249 564ca709 2004-04-19 devnull 	if(addr < 0x100)
250 564ca709 2004-04-19 devnull 		return lget8(m, correg, locreg(regbyoff(addr)), a);
251 564ca709 2004-04-19 devnull 	else
252 564ca709 2004-04-19 devnull 		return get8(m, addr, a);
253 564ca709 2004-04-19 devnull }
254 564ca709 2004-04-19 devnull 
255 564ca709 2004-04-19 devnull void
256 564ca709 2004-04-19 devnull indir(Map *m, ulong addr, char fmt, Node *r)
257 564ca709 2004-04-19 devnull {
258 564ca709 2004-04-19 devnull 	int i;
259 564ca709 2004-04-19 devnull 	u32int ival;
260 564ca709 2004-04-19 devnull 	u64int vval;
261 564ca709 2004-04-19 devnull 	int ret;
262 564ca709 2004-04-19 devnull 	u8int cval;
263 564ca709 2004-04-19 devnull 	u16int sval;
264 564ca709 2004-04-19 devnull 	char buf[512], reg[12];
265 564ca709 2004-04-19 devnull 
266 564ca709 2004-04-19 devnull 	r->op = OCONST;
267 564ca709 2004-04-19 devnull 	r->store.fmt = fmt;
268 564ca709 2004-04-19 devnull 	switch(fmt) {
269 564ca709 2004-04-19 devnull 	default:
270 564ca709 2004-04-19 devnull 		error("bad pointer format '%c' for *", fmt);
271 564ca709 2004-04-19 devnull 	case 'c':
272 564ca709 2004-04-19 devnull 	case 'C':
273 564ca709 2004-04-19 devnull 	case 'b':
274 564ca709 2004-04-19 devnull 		r->type = TINT;
275 564ca709 2004-04-19 devnull 		ret = xget1(m, addr, &cval, 1);
276 564ca709 2004-04-19 devnull 		if (ret < 0)
277 564ca709 2004-04-19 devnull 			error("indir: %r");
278 564ca709 2004-04-19 devnull 		r->store.u.ival = cval;
279 564ca709 2004-04-19 devnull 		break;
280 564ca709 2004-04-19 devnull 	case 'x':
281 564ca709 2004-04-19 devnull 	case 'd':
282 564ca709 2004-04-19 devnull 	case 'u':
283 564ca709 2004-04-19 devnull 	case 'o':
284 564ca709 2004-04-19 devnull 	case 'q':
285 564ca709 2004-04-19 devnull 	case 'r':
286 564ca709 2004-04-19 devnull 		r->type = TINT;
287 564ca709 2004-04-19 devnull 		ret = xget2(m, addr, &sval);
288 564ca709 2004-04-19 devnull 		if (ret < 0)
289 564ca709 2004-04-19 devnull 			error("indir: %r");
290 564ca709 2004-04-19 devnull 		r->store.u.ival = sval;
291 564ca709 2004-04-19 devnull 		break;
292 564ca709 2004-04-19 devnull 	case 'a':
293 564ca709 2004-04-19 devnull 	case 'A':
294 564ca709 2004-04-19 devnull 	case 'B':
295 564ca709 2004-04-19 devnull 	case 'X':
296 564ca709 2004-04-19 devnull 	case 'D':
297 564ca709 2004-04-19 devnull 	case 'U':
298 564ca709 2004-04-19 devnull 	case 'O':
299 564ca709 2004-04-19 devnull 	case 'Q':
300 564ca709 2004-04-19 devnull 		r->type = TINT;
301 564ca709 2004-04-19 devnull 		ret = xget4(m, addr, &ival);
302 564ca709 2004-04-19 devnull 		if (ret < 0)
303 564ca709 2004-04-19 devnull 			error("indir: %r");
304 564ca709 2004-04-19 devnull 		r->store.u.ival = ival;
305 564ca709 2004-04-19 devnull 		break;
306 564ca709 2004-04-19 devnull 	case 'V':
307 564ca709 2004-04-19 devnull 	case 'W':
308 564ca709 2004-04-19 devnull 	case 'Y':
309 564ca709 2004-04-19 devnull 	case 'Z':
310 564ca709 2004-04-19 devnull 		r->type = TINT;
311 564ca709 2004-04-19 devnull 		ret = xget8(m, addr, &vval);
312 564ca709 2004-04-19 devnull 		if (ret < 0)
313 564ca709 2004-04-19 devnull 			error("indir: %r");
314 564ca709 2004-04-19 devnull 		r->store.u.ival = vval;
315 564ca709 2004-04-19 devnull 		break;
316 564ca709 2004-04-19 devnull 	case 's':
317 564ca709 2004-04-19 devnull 		r->type = TSTRING;
318 564ca709 2004-04-19 devnull 		for(i = 0; i < sizeof(buf)-1; i++) {
319 564ca709 2004-04-19 devnull 			ret = xget1(m, addr, (uchar*)&buf[i], 1);
320 564ca709 2004-04-19 devnull 			if (ret < 0)
321 564ca709 2004-04-19 devnull 				error("indir: %r");
322 564ca709 2004-04-19 devnull 			addr++;
323 564ca709 2004-04-19 devnull 			if(buf[i] == '\0')
324 564ca709 2004-04-19 devnull 				break;
325 564ca709 2004-04-19 devnull 		}
326 564ca709 2004-04-19 devnull 		buf[i] = 0;
327 564ca709 2004-04-19 devnull 		if(i == 0)
328 564ca709 2004-04-19 devnull 			strcpy(buf, "(null)");
329 564ca709 2004-04-19 devnull 		r->store.u.string = strnode(buf);
330 564ca709 2004-04-19 devnull 		break;
331 564ca709 2004-04-19 devnull 	case 'R':
332 564ca709 2004-04-19 devnull 		r->type = TSTRING;
333 564ca709 2004-04-19 devnull 		for(i = 0; i < sizeof(buf)-2; i += 2) {
334 564ca709 2004-04-19 devnull 			ret = xget1(m, addr, (uchar*)&buf[i], 2);
335 564ca709 2004-04-19 devnull 			if (ret < 0)
336 564ca709 2004-04-19 devnull 				error("indir: %r");
337 564ca709 2004-04-19 devnull 			addr += 2;
338 564ca709 2004-04-19 devnull 			if(buf[i] == 0 && buf[i+1] == 0)
339 564ca709 2004-04-19 devnull 				break;
340 564ca709 2004-04-19 devnull 		}
341 564ca709 2004-04-19 devnull 		buf[i++] = 0;
342 564ca709 2004-04-19 devnull 		buf[i] = 0;
343 564ca709 2004-04-19 devnull 		r->store.u.string = runenode((Rune*)buf);
344 564ca709 2004-04-19 devnull 		break;
345 564ca709 2004-04-19 devnull 	case 'i':
346 564ca709 2004-04-19 devnull 	case 'I':
347 564ca709 2004-04-19 devnull 		if ((*mach->das)(m, addr, fmt, buf, sizeof(buf)) < 0)
348 564ca709 2004-04-19 devnull 			error("indir: %r");
349 564ca709 2004-04-19 devnull 		r->type = TSTRING;
350 564ca709 2004-04-19 devnull 		r->store.fmt = 's';
351 564ca709 2004-04-19 devnull 		r->store.u.string = strnode(buf);
352 564ca709 2004-04-19 devnull 		break;
353 564ca709 2004-04-19 devnull 	case 'f':
354 564ca709 2004-04-19 devnull 		ret = xget1(m, addr, (uchar*)buf, mach->szfloat);
355 564ca709 2004-04-19 devnull 		if (ret < 0)
356 564ca709 2004-04-19 devnull 			error("indir: %r");
357 564ca709 2004-04-19 devnull 		mach->ftoa32(buf, sizeof(buf), (void*) buf);
358 564ca709 2004-04-19 devnull 		convflt(r, buf);
359 564ca709 2004-04-19 devnull 		break;
360 564ca709 2004-04-19 devnull 	case 'g':
361 564ca709 2004-04-19 devnull 		ret = xget1(m, addr, (uchar*)buf, mach->szfloat);
362 564ca709 2004-04-19 devnull 		if (ret < 0)
363 564ca709 2004-04-19 devnull 			error("indir: %r");
364 564ca709 2004-04-19 devnull 		mach->ftoa32(buf, sizeof(buf), (void*) buf);
365 564ca709 2004-04-19 devnull 		r->type = TSTRING;
366 564ca709 2004-04-19 devnull 		r->store.u.string = strnode(buf);
367 564ca709 2004-04-19 devnull 		break;
368 564ca709 2004-04-19 devnull 	case 'F':
369 564ca709 2004-04-19 devnull 		ret = xget1(m, addr, (uchar*)buf, mach->szdouble);
370 564ca709 2004-04-19 devnull 		if (ret < 0)
371 564ca709 2004-04-19 devnull 			error("indir: %r");
372 564ca709 2004-04-19 devnull 		mach->ftoa64(buf, sizeof(buf), (void*) buf);
373 564ca709 2004-04-19 devnull 		convflt(r, buf);
374 564ca709 2004-04-19 devnull 		break;
375 564ca709 2004-04-19 devnull 	case '3':	/* little endian ieee 80 with hole in bytes 8&9 */
376 564ca709 2004-04-19 devnull 		ret = xget1(m, addr, (uchar*)reg, 10);
377 564ca709 2004-04-19 devnull 		if (ret < 0)
378 564ca709 2004-04-19 devnull 			error("indir: %r");
379 564ca709 2004-04-19 devnull 		memmove(reg+10, reg+8, 2);	/* open hole */
380 564ca709 2004-04-19 devnull 		memset(reg+8, 0, 2);		/* fill it */
381 564ca709 2004-04-19 devnull 		leieeeftoa80(buf, sizeof(buf), reg);
382 564ca709 2004-04-19 devnull 		convflt(r, buf);
383 564ca709 2004-04-19 devnull 		break;
384 564ca709 2004-04-19 devnull 	case '8':	/* big-endian ieee 80 */
385 564ca709 2004-04-19 devnull 		ret = xget1(m, addr, (uchar*)reg, 10);
386 564ca709 2004-04-19 devnull 		if (ret < 0)
387 564ca709 2004-04-19 devnull 			error("indir: %r");
388 564ca709 2004-04-19 devnull 		beieeeftoa80(buf, sizeof(buf), reg);
389 564ca709 2004-04-19 devnull 		convflt(r, buf);
390 564ca709 2004-04-19 devnull 		break;
391 564ca709 2004-04-19 devnull 	case 'G':
392 564ca709 2004-04-19 devnull 		ret = xget1(m, addr, (uchar*)buf, mach->szdouble);
393 564ca709 2004-04-19 devnull 		if (ret < 0)
394 564ca709 2004-04-19 devnull 			error("indir: %r");
395 564ca709 2004-04-19 devnull 		mach->ftoa64(buf, sizeof(buf), (void*) buf);
396 564ca709 2004-04-19 devnull 		r->type = TSTRING;
397 564ca709 2004-04-19 devnull 		r->store.u.string = strnode(buf);
398 564ca709 2004-04-19 devnull 		break;
399 564ca709 2004-04-19 devnull 	}
400 564ca709 2004-04-19 devnull }
401 564ca709 2004-04-19 devnull 
402 564ca709 2004-04-19 devnull void
403 564ca709 2004-04-19 devnull windir(Map *m, Node *addr, Node *rval, Node *r)
404 564ca709 2004-04-19 devnull {
405 564ca709 2004-04-19 devnull 	uchar cval;
406 564ca709 2004-04-19 devnull 	ushort sval;
407 564ca709 2004-04-19 devnull 	Node res, aes;
408 564ca709 2004-04-19 devnull 	int ret;
409 564ca709 2004-04-19 devnull 
410 564ca709 2004-04-19 devnull 	if(m == 0)
411 564ca709 2004-04-19 devnull 		error("no map for */@=");
412 564ca709 2004-04-19 devnull 
413 564ca709 2004-04-19 devnull 	expr(rval, &res);
414 564ca709 2004-04-19 devnull 	expr(addr, &aes);
415 564ca709 2004-04-19 devnull 
416 564ca709 2004-04-19 devnull 	if(aes.type != TINT)
417 564ca709 2004-04-19 devnull 		error("bad type lhs of @/*");
418 564ca709 2004-04-19 devnull 
419 564ca709 2004-04-19 devnull 	if(m != cormap && wtflag == 0)
420 564ca709 2004-04-19 devnull 		error("not in write mode");
421 564ca709 2004-04-19 devnull 
422 564ca709 2004-04-19 devnull 	r->type = res.type;
423 564ca709 2004-04-19 devnull 	r->store.fmt = res.store.fmt;
424 564ca709 2004-04-19 devnull 	r->store = res.store;
425 564ca709 2004-04-19 devnull 
426 564ca709 2004-04-19 devnull 	switch(res.store.fmt) {
427 564ca709 2004-04-19 devnull 	default:
428 564ca709 2004-04-19 devnull 		error("bad pointer format '%c' for */@=", res.store.fmt);
429 564ca709 2004-04-19 devnull 	case 'c':
430 564ca709 2004-04-19 devnull 	case 'C':
431 564ca709 2004-04-19 devnull 	case 'b':
432 564ca709 2004-04-19 devnull 		cval = res.store.u.ival;
433 564ca709 2004-04-19 devnull 		ret = put1(m, aes.store.u.ival, &cval, 1);
434 564ca709 2004-04-19 devnull 		break;
435 564ca709 2004-04-19 devnull 	case 'r':
436 564ca709 2004-04-19 devnull 	case 'x':
437 564ca709 2004-04-19 devnull 	case 'd':
438 564ca709 2004-04-19 devnull 	case 'u':
439 564ca709 2004-04-19 devnull 	case 'o':
440 564ca709 2004-04-19 devnull 		sval = res.store.u.ival;
441 564ca709 2004-04-19 devnull 		ret = put2(m, aes.store.u.ival, sval);
442 564ca709 2004-04-19 devnull 		r->store.u.ival = sval;
443 564ca709 2004-04-19 devnull 		break;
444 564ca709 2004-04-19 devnull 	case 'a':
445 564ca709 2004-04-19 devnull 	case 'A':
446 564ca709 2004-04-19 devnull 	case 'B':
447 564ca709 2004-04-19 devnull 	case 'X':
448 564ca709 2004-04-19 devnull 	case 'D':
449 564ca709 2004-04-19 devnull 	case 'U':
450 564ca709 2004-04-19 devnull 	case 'O':
451 564ca709 2004-04-19 devnull 		ret = put4(m, aes.store.u.ival, res.store.u.ival);
452 564ca709 2004-04-19 devnull 		break;
453 564ca709 2004-04-19 devnull 	case 'V':
454 564ca709 2004-04-19 devnull 	case 'W':
455 564ca709 2004-04-19 devnull 	case 'Y':
456 564ca709 2004-04-19 devnull 	case 'Z':
457 564ca709 2004-04-19 devnull 		ret = put8(m, aes.store.u.ival, res.store.u.ival);
458 564ca709 2004-04-19 devnull 		break;
459 564ca709 2004-04-19 devnull 	case 's':
460 564ca709 2004-04-19 devnull 	case 'R':
461 564ca709 2004-04-19 devnull 		ret = put1(m, aes.store.u.ival, (uchar*)res.store.u.string->string, res.store.u.string->len);
462 564ca709 2004-04-19 devnull 		break;
463 564ca709 2004-04-19 devnull 	}
464 564ca709 2004-04-19 devnull 	if (ret < 0)
465 564ca709 2004-04-19 devnull 		error("windir: %r");
466 564ca709 2004-04-19 devnull }
467 564ca709 2004-04-19 devnull 
468 564ca709 2004-04-19 devnull void
469 564ca709 2004-04-19 devnull call(char *fn, Node *parameters, Node *local, Node *body, Node *retexp)
470 564ca709 2004-04-19 devnull {
471 564ca709 2004-04-19 devnull 	int np, i;
472 564ca709 2004-04-19 devnull 	Rplace rlab;
473 564ca709 2004-04-19 devnull 	Node *n, res;
474 564ca709 2004-04-19 devnull 	Value *v, *f;
475 564ca709 2004-04-19 devnull 	Lsym *s, *next;
476 564ca709 2004-04-19 devnull 	Node *avp[Maxarg], *ava[Maxarg];
477 564ca709 2004-04-19 devnull 
478 564ca709 2004-04-19 devnull 	rlab.local = 0;
479 564ca709 2004-04-19 devnull 
480 564ca709 2004-04-19 devnull 	na = 0;
481 564ca709 2004-04-19 devnull 	flatten(avp, parameters);
482 564ca709 2004-04-19 devnull 	np = na;
483 564ca709 2004-04-19 devnull 	na = 0;
484 564ca709 2004-04-19 devnull 	flatten(ava, local);
485 564ca709 2004-04-19 devnull 	if(np != na) {
486 564ca709 2004-04-19 devnull 		if(np < na)
487 564ca709 2004-04-19 devnull 			error("%s: too few arguments", fn);
488 564ca709 2004-04-19 devnull 		error("%s: too many arguments", fn);
489 564ca709 2004-04-19 devnull 	}
490 564ca709 2004-04-19 devnull 
491 564ca709 2004-04-19 devnull 	rlab.tail = &rlab.local;
492 564ca709 2004-04-19 devnull 
493 564ca709 2004-04-19 devnull 	ret = &rlab;
494 564ca709 2004-04-19 devnull 	for(i = 0; i < np; i++) {
495 564ca709 2004-04-19 devnull 		n = ava[i];
496 564ca709 2004-04-19 devnull 		switch(n->op) {
497 564ca709 2004-04-19 devnull 		default:
498 564ca709 2004-04-19 devnull 			error("%s: %d formal not a name", fn, i);
499 564ca709 2004-04-19 devnull 		case ONAME:
500 564ca709 2004-04-19 devnull 			expr(avp[i], &res);
501 564ca709 2004-04-19 devnull 			s = n->sym;
502 564ca709 2004-04-19 devnull 			break;
503 564ca709 2004-04-19 devnull 		case OINDM:
504 564ca709 2004-04-19 devnull 			res.store.u.cc = avp[i];
505 564ca709 2004-04-19 devnull 			res.type = TCODE;
506 564ca709 2004-04-19 devnull 			res.store.comt = 0;
507 564ca709 2004-04-19 devnull 			if(n->left->op != ONAME)
508 564ca709 2004-04-19 devnull 				error("%s: %d formal not a name", fn, i);
509 564ca709 2004-04-19 devnull 			s = n->left->sym;
510 564ca709 2004-04-19 devnull 			break;
511 564ca709 2004-04-19 devnull 		}
512 564ca709 2004-04-19 devnull 		if(s->v->ret == ret)
513 564ca709 2004-04-19 devnull 			error("%s already declared at this scope", s->name);
514 564ca709 2004-04-19 devnull 
515 564ca709 2004-04-19 devnull 		v = gmalloc(sizeof(Value));
516 564ca709 2004-04-19 devnull 		v->ret = ret;
517 564ca709 2004-04-19 devnull 		v->pop = s->v;
518 564ca709 2004-04-19 devnull 		s->v = v;
519 564ca709 2004-04-19 devnull 		v->scope = 0;
520 564ca709 2004-04-19 devnull 		*(rlab.tail) = s;
521 564ca709 2004-04-19 devnull 		rlab.tail = &v->scope;
522 564ca709 2004-04-19 devnull 
523 564ca709 2004-04-19 devnull 		v->store = res.store;
524 564ca709 2004-04-19 devnull 		v->type = res.type;
525 564ca709 2004-04-19 devnull 		v->set = 1;
526 564ca709 2004-04-19 devnull 	}
527 564ca709 2004-04-19 devnull 
528 564ca709 2004-04-19 devnull 	ret->val = retexp;
529 564ca709 2004-04-19 devnull 	if(setjmp(rlab.rlab) == 0)
530 564ca709 2004-04-19 devnull 		execute(body);
531 564ca709 2004-04-19 devnull 
532 564ca709 2004-04-19 devnull 	for(s = rlab.local; s; s = next) {
533 564ca709 2004-04-19 devnull 		f = s->v;
534 564ca709 2004-04-19 devnull 		next = f->scope;
535 564ca709 2004-04-19 devnull 		s->v = f->pop;
536 564ca709 2004-04-19 devnull 		free(f);
537 564ca709 2004-04-19 devnull 	}
538 564ca709 2004-04-19 devnull }