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