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