simgear/nasal/code.c

   1 #include <stdio.h>
   2 #include <stdarg.h>
   3 #include <string.h>
   4 #include "nasal.h"
   5 #include "code.h"
   6
   7 ////////////////////////////////////////////////////////////////////////
   8 // Debugging stuff. ////////////////////////////////////////////////////
   9 ////////////////////////////////////////////////////////////////////////
  10 //#define INTERPRETER_DUMP
  11 #if !defined(INTERPRETER_DUMP)
  12 # define DBG(expr) /* noop */
  13 #else
  14 # define DBG(expr) expr
  15 # include <stdio.h>
  16 # include <stdlib.h>
  17 #endif
  18 char* opStringDEBUG(int op);
  19 void printOpDEBUG(int ip, int op);
  20 void printStackDEBUG(naContext ctx);
  21 ////////////////////////////////////////////////////////////////////////
  22
  23 struct Globals* globals = 0;
  24
  25 static naRef bindFunction(naContext ctx, struct Frame* f, naRef code);
  26
  27 #define ERR(c, msg) naRuntimeError((c),(msg))
  28 void naRuntimeError(naContext c, const char* fmt, ...)
  29 {
  30     va_list ap;
  31     va_start(ap, fmt);
  32     vsnprintf(c->error, sizeof(c->error), fmt, ap);
  33     va_end(ap);
  34     longjmp(c->jumpHandle, 1);
  35 }
  36
  37 void naRethrowError(naContext subc)
  38 {
  39     strncpy(subc->callParent->error, subc->error, sizeof(subc->error));
  40     subc->callParent->dieArg = subc->dieArg;
  41     longjmp(subc->callParent->jumpHandle, 1);
  42 }
  43
  44 #define END_PTR ((void*)1)
  45 #define IS_END(r) (IS_REF((r)) && PTR((r)).obj == END_PTR)
  46 static naRef endToken()
  47 {
  48     naRef r;
  49     SETPTR(r, END_PTR);
  50     return r;
  51 }
  52
  53 static int boolify(naContext ctx, naRef r)
  54 {
  55     if(IS_NUM(r)) return r.num != 0;
  56     if(IS_NIL(r) || IS_END(r)) return 0;
  57     if(IS_STR(r)) {
  58         double d;
  59         if(naStr_len(r) == 0) return 0;
  60         if(naStr_tonum(r, &d)) return d != 0;
  61         else return 1;
  62     }
  63     ERR(ctx, "non-scalar used in boolean context");
  64     return 0;
  65 }
  66
  67 static double numify(naContext ctx, naRef o)
  68 {
  69     double n;
  70     if(IS_NUM(o)) return o.num;
  71     else if(IS_NIL(o)) ERR(ctx, "nil used in numeric context");
  72     else if(!IS_STR(o)) ERR(ctx, "non-scalar in numeric context");
  73     else if(naStr_tonum(o, &n)) return n;
  74     else naRuntimeError( ctx,
  75                          "non-numeric string in numeric context: '%s'",
  76                          naStr_data(o) );
  77     return 0;
  78 }
  79
  80 static naRef stringify(naContext ctx, naRef r)
  81 {
  82     if(IS_STR(r)) return r;
  83     if(IS_NUM(r)) return naStr_fromnum(naNewString(ctx), r.num);
  84     ERR(ctx, "non-scalar in string context");
  85     return naNil();
  86 }
  87
  88 static int checkVec(naContext ctx, naRef vec, naRef idx)
  89 {
  90     int i = (int)numify(ctx, idx);
  91     if(i < 0) i += naVec_size(vec);
  92     if(i < 0 || i >= naVec_size(vec))
  93         naRuntimeError(ctx, "vector index %d out of bounds (size: %d)",
  94                        i, naVec_size(vec));
  95     return i;
  96 }
  97
  98 static int checkStr(naContext ctx, naRef str, naRef idx)
  99 {
 100     int i = (int)numify(ctx, idx);
 101     if(i < 0) i += naStr_len(str);
 102     if(i < 0 || i >= naStr_len(str))
 103         naRuntimeError(ctx, "string index %d out of bounds (size: %d)",
 104                        i, naStr_len(str));
 105     return i;
 106 }
 107
 108 static naRef containerGet(naContext ctx, naRef box, naRef key)
 109 {
 110     naRef result = naNil();
 111     if(!IS_SCALAR(key)) ERR(ctx, "container index not scalar");
 112     if(IS_HASH(box))
 113         naHash_get(box, key, &result);
 114     else if(IS_VEC(box))
 115         result = naVec_get(box, checkVec(ctx, box, key));
 116     else if(IS_STR(box))
 117         result = naNum((unsigned char)naStr_data(box)[checkStr(ctx, box, key)]);
 118     else
 119         ERR(ctx, "extract from non-container");
 120     return result;
 121 }
 122
 123 static void containerSet(naContext ctx, naRef box, naRef key, naRef val)
 124 {
 125     if(!IS_SCALAR(key))   ERR(ctx, "container index not scalar");
 126     else if(IS_HASH(box)) naHash_set(box, key, val);
 127     else if(IS_VEC(box))  naVec_set(box, checkVec(ctx, box, key), val);
 128     else if(IS_STR(box)) {
 129         if(PTR(box).str->hashcode)
 130             ERR(ctx, "cannot change immutable string");
 131         naStr_data(box)[checkStr(ctx, box, key)] = (char)numify(ctx, val);
 132     } else ERR(ctx, "insert into non-container");
 133 }
 134
 135 static void initTemps(naContext c)
 136 {
 137     c->tempsz = 4;
 138     c->temps = naAlloc(c->tempsz * sizeof(struct naObj*));
 139     c->ntemps = 0;
 140 }
 141
 142 static void initContext(naContext c)
 143 {
 144     int i;
 145     c->fTop = c->opTop = c->markTop = 0;
 146     for(i=0; i<NUM_NASAL_TYPES; i++)
 147         c->nfree[i] = 0;
 148
 149     if(c->tempsz > 32) {
 150         naFree(c->temps);
 151         initTemps(c);
 152     }
 153
 154     c->callParent = 0;
 155     c->callChild = 0;
 156     c->dieArg = naNil();
 157     c->error[0] = 0;
 158     c->userData = 0;
 159 }
 160
 161 static void initGlobals()
 162 {
 163     int i;
 164     naContext c;
 165     globals = (struct Globals*)naAlloc(sizeof(struct Globals));
 166     naBZero(globals, sizeof(struct Globals));
 167
 168     globals->sem = naNewSem();
 169     globals->lock = naNewLock();
 170
 171     globals->allocCount = 256; // reasonable starting value
 172     for(i=0; i<NUM_NASAL_TYPES; i++)
 173         naGC_init(&(globals->pools[i]), i);
 174     globals->deadsz = 256;
 175     globals->ndead = 0;
 176     globals->deadBlocks = naAlloc(sizeof(void*) * globals->deadsz);
 177
 178     // Initialize a single context
 179     globals->freeContexts = 0;
 180     globals->allContexts = 0;
 181     c = naNewContext();
 182
 183     globals->symbols = naNewHash(c);
 184     globals->save = naNewVector(c);
 185     globals->save_hash = naNewHash(c);
 186     globals->next_gc_key = 0;
 187
 188     // Cache pre-calculated "me", "arg" and "parents" scalars
 189     globals->meRef = naInternSymbol(naStr_fromdata(naNewString(c), "me", 2));
 190     globals->argRef = naInternSymbol(naStr_fromdata(naNewString(c), "arg", 3));
 191     globals->parentsRef = naInternSymbol(naStr_fromdata(naNewString(c), "parents", 7));
 192
 193     naFreeContext(c);
 194 }
 195
 196 naContext naNewContext()
 197 {
 198     naContext c;
 199     if(globals == 0)
 200         initGlobals();
 201
 202     LOCK();
 203     c = globals->freeContexts;
 204     if(c) {
 205         globals->freeContexts = c->nextFree;
 206         c->nextFree = 0;
 207         UNLOCK();
 208         initContext(c);
 209     } else {
 210         UNLOCK();
 211         c = (naContext)naAlloc(sizeof(struct Context));
 212         initTemps(c);
 213         initContext(c);
 214         LOCK();
 215         c->nextAll = globals->allContexts;
 216         c->nextFree = 0;
 217         globals->allContexts = c;
 218         UNLOCK();
 219     }
 220     return c;
 221 }
 222
 223 naContext naSubContext(naContext super)
 224 {
 225     naContext ctx = naNewContext();
 226     if(super->callChild) naFreeContext(super->callChild);
 227     ctx->callParent = super;
 228     super->callChild = ctx;
 229     return ctx;
 230 }
 231
 232 void naFreeContext(naContext c)
 233 {
 234     c->ntemps = 0;
 235     if(c->callChild) naFreeContext(c->callChild);
 236     if(c->callParent) c->callParent->callChild = 0;
 237     LOCK();
 238     c->nextFree = globals->freeContexts;
 239     globals->freeContexts = c;
 240     UNLOCK();
 241 }
 242
 243 // Note that opTop is incremented separately, to avoid situations
 244 // where the "r" expression also references opTop.  The SGI compiler
 245 // is known to have issues with such code.
 246 #define PUSH(r) do { \
 247     if(ctx->opTop >= MAX_STACK_DEPTH) ERR(ctx, "stack overflow"); \
 248     ctx->opStack[ctx->opTop] = r; \
 249     ctx->opTop++;                 \
 250     } while(0)
 251
 252 static void setupArgs(naContext ctx, struct Frame* f, naRef* args, int nargs)
 253 {
 254     int i;
 255     struct naCode* c = PTR(PTR(f->func).func->code).code;
 256
 257     // Set the argument symbols, and put any remaining args in a vector
 258     if(nargs < c->nArgs)
 259         naRuntimeError(ctx, "too few function args (have %d need %d)",
 260             nargs, c->nArgs);
 261     for(i=0; i<c->nArgs; i++)
 262         naiHash_newsym(PTR(f->locals).hash,
 263                       &c->constants[ARGSYMS(c)[i]], &args[i]);
 264     args += c->nArgs;
 265     nargs -= c->nArgs;
 266     for(i=0; i<c->nOptArgs; i++, nargs--) {
 267         naRef val = nargs > 0 ? args[i] : c->constants[OPTARGVALS(c)[i]];
 268         if(IS_CODE(val))
 269             val = bindFunction(ctx, &ctx->fStack[ctx->fTop-2], val);
 270         naiHash_newsym(PTR(f->locals).hash, &c->constants[OPTARGSYMS(c)[i]],
 271                       &val);
 272     }
 273     args += c->nOptArgs;
 274     if(c->needArgVector || nargs > 0) {
 275         naRef argv = naNewVector(ctx);
 276         naVec_setsize(ctx, argv, nargs > 0 ? nargs : 0);
 277         for(i=0; i<nargs; i++)
 278             PTR(argv).vec->rec->array[i] = *args++;
 279         naiHash_newsym(PTR(f->locals).hash, &c->constants[c->restArgSym], &argv);
 280     }
 281 }
 282
 283 static void checkNamedArgs(naContext ctx, struct naCode* c, struct naHash* h)
 284 {
 285     int i;
 286     naRef sym, rest, dummy;
 287     for(i=0; i<c->nArgs; i++) {
 288         sym = c->constants[ARGSYMS(c)[i]];
 289         if(!naiHash_sym(h, PTR(sym).str, &dummy))
 290             naRuntimeError(ctx, "Missing arg: %s", naStr_data(sym));
 291     }
 292     for(i=0; i<c->nOptArgs; i++) {
 293         sym = c->constants[OPTARGSYMS(c)[i]];
 294         if(!naiHash_sym(h, PTR(sym).str, &dummy))
 295             naiHash_newsym(h, &sym, &c->constants[OPTARGVALS(c)[i]]);
 296     }
 297     if(c->needArgVector) {
 298         sym = c->constants[c->restArgSym];
 299         if(!naiHash_sym(h, PTR(sym).str, &dummy)) {
 300             rest = naNewVector(ctx);
 301             naiHash_newsym(h, &sym, &rest);
 302         }
 303     }
 304 }
 305
 306 static struct Frame* setupFuncall(naContext ctx, int nargs, int mcall, int named)
 307 {
 308     naRef *args, func, code, obj = naNil();
 309     struct Frame* f;
 310     int opf = ctx->opTop - nargs;
 311
 312     args = &ctx->opStack[opf];
 313     func = ctx->opStack[--opf];
 314     if(!IS_FUNC(func)) ERR(ctx, "function/method call on uncallable object");
 315     code = PTR(func).func->code;
 316     if(mcall) obj = ctx->opStack[--opf];
 317     ctx->opFrame = opf;
 318
 319     if(IS_CCODE(code)) {
 320         struct naCCode *ccode = PTR(code).ccode;
 321         naRef result = ccode->fptru
 322                      ? (*ccode->fptru)(ctx, obj, nargs, args, ccode->user_data)
 323                      : (*ccode->fptr)(ctx, obj, nargs, args);
 324         if(named) ERR(ctx, "native functions have no named arguments");
 325         ctx->opTop = ctx->opFrame;
 326         PUSH(result);
 327         return &(ctx->fStack[ctx->fTop-1]);
 328     }
 329
 330     if(ctx->fTop >= MAX_RECURSION) ERR(ctx, "call stack overflow");
 331
 332     f = &(ctx->fStack[ctx->fTop]);
 333     f->locals = named ? args[0] : naNewHash(ctx);
 334     f->func = func;
 335     f->ip = 0;
 336     f->bp = ctx->opFrame;
 337
 338     if(mcall) naHash_set(f->locals, globals->meRef, obj);
 339
 340     if(named) checkNamedArgs(ctx, PTR(code).code, PTR(f->locals).hash);
 341     else      setupArgs(ctx, f, args, nargs);
 342
 343     ctx->fTop++;
 344     ctx->opTop = f->bp; /* Pop the stack last, to avoid GC lossage */
 345     return f;
 346 }
 347
 348 static naRef evalEquality(int op, naRef ra, naRef rb)
 349 {
 350     int result = naEqual(ra, rb);
 351     return naNum((op==OP_EQ) ? result : !result);
 352 }
 353
 354 static naRef evalCat(naContext ctx, naRef l, naRef r)
 355 {
 356     if(IS_VEC(l) && IS_VEC(r)) {
 357         int i, ls = naVec_size(l), rs = naVec_size(r);
 358         naRef v = naNewVector(ctx);
 359         naVec_setsize(ctx, v, ls + rs);
 360         for(i=0; i<ls; i+=1) naVec_set(v, i, naVec_get(l, i));
 361         for(i=0; i<rs; i+=1) naVec_set(v, i+ls, naVec_get(r, i));
 362         return v;
 363     } else {
 364         naRef a = stringify(ctx, l);
 365         naRef b = stringify(ctx, r);
 366         return naStr_concat(naNewString(ctx), a, b);
 367     }
 368 }
 369
 370 // When a code object comes out of the constant pool and shows up on
 371 // the stack, it needs to be bound with the lexical context.
 372 static naRef bindFunction(naContext ctx, struct Frame* f, naRef code)
 373 {
 374     naRef result = naNewFunc(ctx, code);
 375     PTR(result).func->namespace = f->locals;
 376     PTR(result).func->next = f->func;
 377     return result;
 378 }
 379
 380 static int getClosure(struct naFunc* c, naRef sym, naRef* result)
 381 {
 382     while(c) {
 383         if(naHash_get(c->namespace, sym, result)) return 1;
 384         c = PTR(c->next).func;
 385     }
 386     return 0;
 387 }
 388
 389 static naRef getLocal2(naContext ctx, struct Frame* f, naRef sym)
 390 {
 391     naRef result;
 392     if(!naHash_get(f->locals, sym, &result))
 393         if(!getClosure(PTR(f->func).func, sym, &result))
 394             naRuntimeError(ctx, "undefined symbol: %s", naStr_data(sym));
 395     return result;
 396 }
 397
 398 static void getLocal(naContext ctx, struct Frame* f, naRef* sym, naRef* out)
 399 {
 400     struct naFunc* func;
 401     struct naStr* str = PTR(*sym).str;
 402     if(naiHash_sym(PTR(f->locals).hash, str, out))
 403         return;
 404     func = PTR(f->func).func;
 405     while(func && PTR(func->namespace).hash) {
 406         if(naiHash_sym(PTR(func->namespace).hash, str, out))
 407             return;
 408         func = PTR(func->next).func;
 409     }
 410     // Now do it again using the more general naHash_get().  This will
 411     // only be necessary if something has created the value in the
 412     // namespace using the more generic hash syntax
 413     // (e.g. namespace["symbol"] and not namespace.symbol).
 414     *out = getLocal2(ctx, f, *sym);
 415 }
 416
 417 static int setClosure(naRef func, naRef sym, naRef val)
 418 {
 419     struct naFunc* c = PTR(func).func;
 420     if(c == 0) return 0;
 421     if(naiHash_tryset(c->namespace, sym, val)) return 1;
 422     return setClosure(c->next, sym, val);
 423 }
 424
 425 static void setSymbol(struct Frame* f, naRef sym, naRef val)
 426 {
 427     // Try the locals first, if not already there try the closures in
 428     // order.  Finally put it in the locals if nothing matched.
 429     if(!naiHash_tryset(f->locals, sym, val))
 430         if(!setClosure(f->func, sym, val))
 431             naHash_set(f->locals, sym, val);
 432 }
 433
 434 static const char* ghostGetMember(naContext ctx, naRef obj, naRef field, naRef* out)
 435 {
 436     naGhostType* gtype = PTR(obj).ghost->gtype;
 437     if (!gtype->get_member) return "ghost does not support member access";
 438     return gtype->get_member(ctx, PTR(obj).ghost->ptr, field, out);
 439 }
 440
 441 // Funky API: returns null to indicate no member, an empty string to
 442 // indicate success, or a non-empty error message.  Works this way so
 443 // we can generate smart error messages without throwing them with a
 444 // longjmp -- this gets called under naMember_get() from C code.
 445 static const char* getMember_r(naContext ctx, naRef obj, naRef field, naRef* out, int count)
 446 {
 447     int i;
 448     naRef p;
 449     struct VecRec* pv;
 450     if(--count < 0) return "too many parents";
 451
 452     if (IS_GHOST(obj)) {
 453         if (ghostGetMember(ctx, obj, field, out)) return "";
 454         if(!ghostGetMember(ctx, obj, globals->parentsRef, &p)) return 0;
 455     } else if (IS_HASH(obj)) {
 456         if(naHash_get(obj, field, out)) return "";
 457         if(!naHash_get(obj, globals->parentsRef, &p)) return 0;
 458     } else if (IS_STR(obj) ) {
 459         return getMember_r(ctx, getStringMethods(ctx), field, out, count);
 460     } else {
 461         return "non-objects have no members";
 462     }
 463
 464     if(!IS_VEC(p)) return "object \"parents\" field not vector";
 465     pv = PTR(p).vec->rec;
 466     for(i=0; pv && i<pv->size; i++) {
 467         const char* err = getMember_r(ctx, pv->array[i], field, out, count);
 468         if(err) return err; /* either an error or success */
 469     }
 470     return 0;
 471 }
 472
 473 static void getMember(naContext ctx, naRef obj, naRef fld,
 474                       naRef* result, int count)
 475 {
 476     const char* err = getMember_r(ctx, obj, fld, result, count);
 477     if(!err)   naRuntimeError(ctx, "No such member: %s", naStr_data(fld));
 478     if(err[0]) naRuntimeError(ctx, err);
 479 }
 480
 481 static void setMember(naContext ctx, naRef obj, naRef fld, naRef value)
 482 {
 483     if (IS_GHOST(obj)) {
 484         naGhostType* gtype = PTR(obj).ghost->gtype;
 485         if (!gtype->set_member) ERR(ctx, "ghost does not support member access");
 486         gtype->set_member(ctx, PTR(obj).ghost->ptr, fld, value);
 487         ctx->opTop -= 2;
 488         return;
 489     }
 490
 491     if(!IS_HASH(obj)) ERR(ctx, "non-objects have no members");
 492     naHash_set(obj, fld, value);
 493     ctx->opTop -= 2;
 494 }
 495
 496 int naMember_get(naContext ctx, naRef obj, naRef field, naRef* out)
 497 {
 498     const char* err = getMember_r(ctx, obj, field, out, 64);
 499     return err && !err[0];
 500 }
 501
 502 // OP_EACH works like a vector get, except that it leaves the vector
 503 // and index on the stack, increments the index after use, and
 504 // pushes a nil if the index is beyond the end.
 505 static void evalEach(naContext ctx, int useIndex)
 506 {
 507     int idx = (int)(ctx->opStack[ctx->opTop-1].num);
 508     naRef vec = ctx->opStack[ctx->opTop-2];
 509     if(!IS_VEC(vec)) ERR(ctx, "foreach enumeration of non-vector");
 510     if(!PTR(vec).vec->rec || idx >= PTR(vec).vec->rec->size) {
 511         PUSH(endToken());
 512         return;
 513     }
 514     ctx->opStack[ctx->opTop-1].num = idx+1; // modify in place
 515     PUSH(useIndex ? naNum(idx) : naVec_get(vec, idx));
 516 }
 517
 518 static void evalUnpack(naContext ctx, int count)
 519 {
 520     naRef vec = ctx->opStack[--ctx->opTop];
 521     if(!IS_VEC(vec) || naVec_size(vec) < count)
 522         ERR(ctx, "short or invalid multi-assignment vector");
 523     while(count--) PUSH(naVec_get(vec, count));
 524 }
 525
 526 // FIXME: unify with almost identical checkVec() above
 527 static int vbound(naContext ctx, naRef v, naRef ir, int end)
 528 {
 529     int sz=naVec_size(v), i = IS_NIL(ir) ? (end ? -1 : 0) : numify(ctx, ir);
 530     if(IS_NIL(ir) && !sz) return i;
 531     if(i < 0) i += sz;
 532     if(i < 0 || i >= sz)
 533         naRuntimeError(ctx, "slice index %d out of bounds (size: %d)",
 534                        i, sz);
 535     return i;
 536 }
 537
 538 static void evalSlice(naContext ctx, naRef src, naRef dst, naRef idx)
 539 {
 540     if(!IS_VEC(src)) ERR(ctx, "cannot slice non-vector");
 541     naVec_append(dst, naVec_get(src, checkVec(ctx, src, idx)));
 542 }
 543
 544 static void evalSlice2(naContext ctx, naRef src, naRef dst,
 545                        naRef start, naRef endr)
 546 {
 547     int i, end;
 548     if(!IS_VEC(src)) ERR(ctx, "cannot slice non-vector");
 549     end = vbound(ctx, src, endr, 1);
 550     for(i = vbound(ctx, src, start, 0); i<=end; i++)
 551         naVec_append(dst, naVec_get(src, i));
 552 }
 553
 554 #define ARG() BYTECODE(cd)[f->ip++]
 555 #define CONSTARG() cd->constants[ARG()]
 556 #define POP() ctx->opStack[--ctx->opTop]
 557 #define STK(n) (ctx->opStack[ctx->opTop-(n)])
 558 #define SETFRAME(F) f = (F); cd = PTR(PTR(f->func).func->code).code;
 559 #define FIXFRAME() SETFRAME(&(ctx->fStack[ctx->fTop-1]))
 560 static naRef run(naContext ctx)
 561 {
 562     struct Frame* f;
 563     struct naCode* cd;
 564     int op, arg;
 565     naRef a, b;
 566
 567     ctx->dieArg = naNil();
 568     ctx->error[0] = 0;
 569
 570     FIXFRAME();
 571
 572     while(1) {
 573         op = BYTECODE(cd)[f->ip++];
 574         DBG(printf("Stack Depth: %d\n", ctx->opTop));
 575         DBG(printOpDEBUG(f->ip-1, op));
 576         switch(op) {
 577         case OP_POP:  ctx->opTop--; break;
 578         case OP_DUP:  PUSH(STK(1)); break;
 579         case OP_DUP2: PUSH(STK(2)); PUSH(STK(2)); break;
 580         case OP_XCHG:  a=STK(1); STK(1)=STK(2); STK(2)=a; break;
 581         case OP_XCHG2: a=STK(1); STK(1)=STK(2); STK(2)=STK(3); STK(3)=a; break;
 582
 583 #define BINOP(expr) do { \
 584     double l = IS_NUM(STK(2)) ? STK(2).num : numify(ctx, STK(2)); \
 585     double r = IS_NUM(STK(1)) ? STK(1).num : numify(ctx, STK(1)); \
 586     SETNUM(STK(2), expr);                                         \
 587     ctx->opTop--; } while(0)
 588
 589         case OP_PLUS:  BINOP(l + r);         break;
 590         case OP_MINUS: BINOP(l - r);         break;
 591         case OP_MUL:   BINOP(l * r);         break;
 592         case OP_DIV:   BINOP(l / r);         break;
 593         case OP_LT:    BINOP(l <  r ? 1 : 0); break;
 594         case OP_LTE:   BINOP(l <= r ? 1 : 0); break;
 595         case OP_GT:    BINOP(l >  r ? 1 : 0); break;
 596         case OP_GTE:   BINOP(l >= r ? 1 : 0); break;
 597         case OP_BIT_AND: BINOP((int)l & (int)r); break;
 598         case OP_BIT_OR:  BINOP((int)l | (int)r); break;
 599         case OP_BIT_XOR: BINOP((int)l ^ (int)r); break;
 600 #undef BINOP
 601
 602         case OP_EQ: case OP_NEQ:
 603             STK(2) = evalEquality(op, STK(2), STK(1));
 604             ctx->opTop--;
 605             break;
 606         case OP_CAT:
 607             STK(2) = evalCat(ctx, STK(2), STK(1));
 608             ctx->opTop--;
 609             break;
 610         case OP_NEG:
 611             STK(1) = naNum(-numify(ctx, STK(1)));
 612             break;
 613         case OP_BIT_NEG:
 614             STK(1) = naNum(~(int)numify(ctx, STK(1)));
 615             break;
 616         case OP_NOT:
 617             STK(1) = naNum(boolify(ctx, STK(1)) ? 0 : 1);
 618             break;
 619         case OP_PUSHCONST:
 620             a = CONSTARG();
 621             if(IS_CODE(a)) a = bindFunction(ctx, f, a);
 622             PUSH(a);
 623             break;
 624         case OP_PUSHONE:
 625             PUSH(naNum(1));
 626             break;
 627         case OP_PUSHZERO:
 628             PUSH(naNum(0));
 629             break;
 630         case OP_PUSHNIL:
 631             PUSH(naNil());
 632             break;
 633         case OP_PUSHEND:
 634             PUSH(endToken());
 635             break;
 636         case OP_NEWVEC:
 637             PUSH(naNewVector(ctx));
 638             break;
 639         case OP_VAPPEND:
 640             naVec_append(STK(2), STK(1));
 641             ctx->opTop--;
 642             break;
 643         case OP_NEWHASH:
 644             PUSH(naNewHash(ctx));
 645             break;
 646         case OP_HAPPEND:
 647             naHash_set(STK(3), STK(2), STK(1));
 648             ctx->opTop -= 2;
 649             break;
 650         case OP_LOCAL:
 651             a = CONSTARG();
 652             getLocal(ctx, f, &a, &b);
 653             PUSH(b);
 654             break;
 655         case OP_SETSYM:
 656             setSymbol(f, STK(1), STK(2));
 657             ctx->opTop--;
 658             break;
 659         case OP_SETLOCAL:
 660             naHash_set(f->locals, STK(1), STK(2));
 661             ctx->opTop--;
 662             break;
 663         case OP_MEMBER:
 664             getMember(ctx, STK(1), CONSTARG(), &STK(1), 64);
 665             break;
 666         case OP_SETMEMBER:
 667             setMember(ctx, STK(2), STK(1), STK(3));
 668             break;
 669         case OP_INSERT:
 670             containerSet(ctx, STK(2), STK(1), STK(3));
 671             ctx->opTop -= 2;
 672             break;
 673         case OP_EXTRACT:
 674             STK(2) = containerGet(ctx, STK(2), STK(1));
 675             ctx->opTop--;
 676             break;
 677         case OP_SLICE:
 678             evalSlice(ctx, STK(3), STK(2), STK(1));
 679             ctx->opTop--;
 680             break;
 681         case OP_SLICE2:
 682             evalSlice2(ctx, STK(4), STK(3), STK(2), STK(1));
 683             ctx->opTop -= 2;
 684             break;
 685         case OP_JMPLOOP:
 686             // Identical to JMP, except for locking
 687             naCheckBottleneck();
 688             f->ip = BYTECODE(cd)[f->ip];
 689             DBG(printf("   [Jump to: %d]\n", f->ip));
 690             break;
 691         case OP_JMP:
 692             f->ip = BYTECODE(cd)[f->ip];
 693             DBG(printf("   [Jump to: %d]\n", f->ip));
 694             break;
 695         case OP_JIFEND:
 696             arg = ARG();
 697             if(IS_END(STK(1))) {
 698                 ctx->opTop--; // Pops **ONLY** if it's nil!
 699                 f->ip = arg;
 700                 DBG(printf("   [Jump to: %d]\n", f->ip));
 701             }
 702             break;
 703         case OP_JIFTRUE:
 704             arg = ARG();
 705             if(boolify(ctx, STK(1))) {
 706                 f->ip = arg;
 707                 DBG(printf("   [Jump to: %d]\n", f->ip));
 708             }
 709             break;
 710         case OP_JIFNOT:
 711             arg = ARG();
 712             if(!boolify(ctx, STK(1))) {
 713                 f->ip = arg;
 714                 DBG(printf("   [Jump to: %d]\n", f->ip));
 715             }
 716             break;
 717         case OP_JIFNOTPOP:
 718             arg = ARG();
 719             if(!boolify(ctx, POP())) {
 720                 f->ip = arg;
 721                 DBG(printf("   [Jump to: %d]\n", f->ip));
 722             }
 723             break;
 724         case OP_FCALL:  SETFRAME(setupFuncall(ctx, ARG(), 0, 0)); break;
 725         case OP_MCALL:  SETFRAME(setupFuncall(ctx, ARG(), 1, 0)); break;
 726         case OP_FCALLH: SETFRAME(setupFuncall(ctx,     1, 0, 1)); break;
 727         case OP_MCALLH: SETFRAME(setupFuncall(ctx,     1, 1, 1)); break;
 728         case OP_RETURN:
 729             a = STK(1);
 730             ctx->dieArg = naNil();
 731             if(ctx->callChild) naFreeContext(ctx->callChild);
 732             if(--ctx->fTop <= 0) return a;
 733             ctx->opTop = f->bp + 1; // restore the correct opstack frame!
 734             STK(1) = a;
 735             FIXFRAME();
 736             break;
 737         case OP_EACH:
 738             evalEach(ctx, 0);
 739             break;
 740         case OP_INDEX:
 741             evalEach(ctx, 1);
 742             break;
 743         case OP_MARK: // save stack state (e.g. "setjmp")
 744             if(ctx->markTop >= MAX_MARK_DEPTH)
 745                 ERR(ctx, "mark stack overflow");
 746             ctx->markStack[ctx->markTop++] = ctx->opTop;
 747             break;
 748         case OP_UNMARK: // pop stack state set by mark
 749             ctx->markTop--;
 750             break;
 751         case OP_BREAK: // restore stack state (FOLLOW WITH JMP!)
 752             ctx->opTop = ctx->markStack[ctx->markTop-1];
 753             break;
 754         case OP_BREAK2: // same, but also pop the mark stack
 755             ctx->opTop = ctx->markStack[--ctx->markTop];
 756             break;
 757         case OP_UNPACK:
 758             evalUnpack(ctx, ARG());
 759             break;
 760         default:
 761             ERR(ctx, "BUG: bad opcode");
 762         }
 763         ctx->ntemps = 0; // reset GC temp vector
 764         DBG(printStackDEBUG(ctx));
 765     }
 766     return naNil(); // unreachable
 767 }
 768 #undef POP
 769 #undef CONSTARG
 770 #undef STK
 771 #undef FIXFRAME
 772
 773 void naSave(naContext ctx, naRef obj)
 774 {
 775     naVec_append(globals->save, obj);
 776 }
 777
 778 int naGCSave(naRef obj)
 779 {
 780   int key = globals->next_gc_key++;
 781   naHash_set(globals->save_hash, naNum(key), obj);
 782   return key;
 783 }
 784
 785 void naGCRelease(int key)
 786 {
 787   naHash_delete(globals->save_hash, naNum(key));
 788 }
 789
 790 void naClearSaved()
 791 {
 792     naContext c;
 793     c = naNewContext();
 794     globals->save = naNewVector(c);
 795     globals->save_hash = naNewHash(c);
 796     naFreeContext(c);
 797 }
 798
 799 int naStackDepth(naContext ctx)
 800 {
 801     return ctx ? ctx->fTop + naStackDepth(ctx->callChild): 0;
 802 }
 803
 804 static int findFrame(naContext ctx, naContext* out, int fn)
 805 {
 806     int sd = naStackDepth(ctx->callChild);
 807     if(fn < sd) return findFrame(ctx->callChild, out, fn);
 808     *out = ctx;
 809     return ctx->fTop - 1 - (fn - sd);
 810 }
 811
 812 int naGetLine(naContext ctx, int frame)
 813 {
 814     struct Frame* f;
 815     frame = findFrame(ctx, &ctx, frame);
 816     f = &ctx->fStack[frame];
 817     if(IS_FUNC(f->func) && IS_CODE(PTR(f->func).func->code)) {
 818         struct naCode* c = PTR(PTR(f->func).func->code).code;
 819         unsigned short* p = LINEIPS(c) + c->nLines - 2;
 820         while(p >= LINEIPS(c) && p[0] > f->ip)
 821             p -= 2;
 822         return p[1];
 823     }
 824     return -1;
 825 }
 826
 827 naRef naGetSourceFile(naContext ctx, int frame)
 828 {
 829     naRef f;
 830     frame = findFrame(ctx, &ctx, frame);
 831     f = ctx->fStack[frame].func;
 832     f = PTR(f).func->code;
 833     return PTR(f).code->srcFile;
 834 }
 835
 836 char* naGetError(naContext ctx)
 837 {
 838     if(IS_STR(ctx->dieArg))
 839         return naStr_data(ctx->dieArg);
 840     return ctx->error[0] ? ctx->error : 0;
 841 }
 842
 843 naRef naBindFunction(naContext ctx, naRef code, naRef closure)
 844 {
 845     naRef func = naNewFunc(ctx, code);
 846     PTR(func).func->namespace = closure;
 847     PTR(func).func->next = naNil();
 848     return func;
 849 }
 850
 851 naRef naBindToContext(naContext ctx, naRef code)
 852 {
 853     naRef func = naNewFunc(ctx, code);
 854     if(ctx->fTop) {
 855         struct Frame* f = &ctx->fStack[ctx->fTop-1];
 856         PTR(func).func->namespace = f->locals;
 857         PTR(func).func->next = f->func;
 858     }
 859     return func;
 860 }
 861
 862 naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
 863              naRef obj, naRef locals)
 864 {
 865     int i;
 866     naRef result;
 867     if(!ctx->callParent) naModLock();
 868
 869     // We might have to allocate objects, which can call the GC.  But
 870     // the call isn't on the Nasal stack yet, so the GC won't find our
 871     // C-space arguments.
 872     naTempSave(ctx, func);
 873     for(i=0; i<argc; i++)
 874         naTempSave(ctx, args[i]);
 875     naTempSave(ctx, obj);
 876     naTempSave(ctx, locals);
 877
 878     // naRuntimeError() calls end up here:
 879     if(setjmp(ctx->jumpHandle)) {
 880         if(!ctx->callParent) naModUnlock();
 881         return naNil();
 882     }
 883
 884     if(IS_CCODE(PTR(func).func->code)) {
 885         struct naCCode *ccode = PTR(PTR(func).func->code).ccode;
 886         result = ccode->fptru
 887                ? (*ccode->fptru)(ctx, obj, argc, args, ccode->user_data)
 888                : (*ccode->fptr) (ctx, obj, argc, args);
 889         if(!ctx->callParent) naModUnlock();
 890         return result;
 891     }
 892
 893     if(IS_NIL(locals))
 894         locals = naNewHash(ctx);
 895     if(!IS_FUNC(func)) {
 896         func = naNewFunc(ctx, func);
 897         PTR(func).func->namespace = locals;
 898     }
 899     if(!IS_NIL(obj))
 900         naHash_set(locals, globals->meRef, obj);
 901
 902     ctx->opTop = ctx->markTop = 0;
 903     ctx->fTop = 1;
 904     ctx->fStack[0].func = func;
 905
 906     ctx->fStack[0].locals = locals;
 907     ctx->fStack[0].ip = 0;
 908     ctx->fStack[0].bp = ctx->opTop;
 909
 910     setupArgs(ctx, ctx->fStack, args, argc);
 911
 912     result = run(ctx);
 913     if(!ctx->callParent) naModUnlock();
 914     return result;
 915 }
 916
 917 naRef naContinue(naContext ctx)
 918 {
 919     naRef result;
 920     if(!ctx->callParent) naModLock();
 921
 922     ctx->dieArg = naNil();
 923     ctx->error[0] = 0;
 924
 925     if(setjmp(ctx->jumpHandle)) {
 926         if(!ctx->callParent) naModUnlock();
 927         else naRethrowError(ctx);
 928         return naNil();
 929     }
 930
 931     // Wipe off the old function arguments, and push the expected
 932     // result (either the result of our subcontext, or a synthesized
 933     // nil if the thrown error was from an extension function or
 934     // in-script die() call) before re-running the code from the
 935     // instruction following the error.
 936     ctx->opTop = ctx->opFrame;
 937     PUSH(ctx->callChild ? naContinue(ctx->callChild) : naNil());
 938
 939     // Getting here means the child completed successfully.  But
 940     // because its original C stack was longjmp'd out of existence,
 941     // there is no one left to free the context, so we have to do it.
 942     // This is fragile, but unfortunately required.
 943     if(ctx->callChild) naFreeContext(ctx->callChild);
 944
 945     result = run(ctx);
 946     if(!ctx->callParent) naModUnlock();
 947     return result;
 948 }
 949
 950 static void logError(naContext ctx)
 951 {
 952     int i, stack_depth = naStackDepth(ctx);
 953     printf("Nasal runtime error: %s\n", naGetError(ctx));
 954     if( stack_depth < 1 )
 955         return;
 956     printf("  at %s\n", naStr_data(naGetSourceFile(ctx, 0)));
 957     printf(", line %d\n", naGetLine(ctx, 0));
 958     for(i = 1; i < stack_depth; ++i )
 959         printf( "  called from: %s, line %d",
 960                 naStr_data(naGetSourceFile(ctx, i)),
 961                 naGetLine(ctx, i));
 962 }
 963
 964 static naErrorHandler error_handler = &logError;
 965 naErrorHandler naSetErrorHandler(naErrorHandler cb)
 966 {
 967   naErrorHandler old_handler = error_handler;
 968   error_handler = cb;
 969   return old_handler;
 970 }
 971
 972 static int call_count = 0;
 973 naRef naCallMethodCtx( naContext ctx,
 974                        naRef code,
 975                        naRef self,
 976                        int argc,
 977                        naRef* args,
 978                        naRef locals )
 979 {
 980     naRef result;
 981     if(call_count) naModUnlock();
 982     call_count++;
 983     result = naCall(ctx, code, argc, args, self, locals);
 984     if(naGetError(ctx) && error_handler)
 985         error_handler(ctx);
 986     call_count--;
 987     if(call_count) naModLock();
 988     return result;
 989 }
 990
 991 naRef naCallMethod(naRef code, naRef self, int argc, naRef* args, naRef locals)
 992 {
 993     naContext ctx = naNewContext();
 994     naRef result = naCallMethodCtx(ctx, code, self, argc, args, locals);
 995     naFreeContext(ctx);
 996     return result;
 997 }