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 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 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 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(bool(&res)) 133 execute(r->left); 134 else 135 execute(r->right); 136 } 137 else if(bool(&res)) 138 execute(r); 139 break; 140 case OWHILE: 141 for(;;) { 142 expr(l, &res); 143 if(!bool(&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 164 bool(Node *n) 165 { 166 int true = 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 true = 1; 175 break; 176 case TFLOAT: 177 if(n->nstore.u0.sfval != 0.0) 178 true = 1; 179 break; 180 case TSTRING: 181 if(n->nstore.u0.sstring->len) 182 true = 1; 183 break; 184 case TLIST: 185 if(n->nstore.u0.sl) 186 true = 1; 187 break; 188 } 189 return true; 190 } 191 192 void 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 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 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 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