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