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 #ifdef _MSC_VER
  24 #define vsnprintf _vsnprintf
  25 #endif
  26
  27 struct Globals* globals = 0;
  28
  29 static naRef bindFunction(naContext ctx, struct Frame* f, naRef code);
  30
  31 #define ERR(c, msg) naRuntimeError((c),(msg))
  32 void naRuntimeError(naContext c, const char* fmt, ...)
  33 {
  34     va_list ap;
  35     va_start(ap, fmt);
  36     vsnprintf(c->error, sizeof(c->error), fmt, ap);
  37     va_end(ap);
  38     longjmp(c->jumpHandle, 1);
  39 }
  40
  41 void naRethrowError(naContext subc)
  42 {
  43     strncpy(subc->callParent->error, subc->error, sizeof(subc->error));
  44     subc->callParent->dieArg = subc->dieArg;
  45     longjmp(subc->callParent->jumpHandle, 1);
  46 }
  47
  48 #define END_PTR ((void*)1)
  49 #define IS_END(r) (IS_REF((r)) && PTR((r)).obj == END_PTR)
  50 static naRef endToken()
  51 {
  52     naRef r;
  53     SETPTR(r, END_PTR);
  54     return r;
  55 }
  56
  57 static int boolify(naContext ctx, naRef r)
  58 {
  59     if(IS_NUM(r)) return r.num != 0;
  60     if(IS_NIL(r) || IS_END(r)) return 0;
  61     if(IS_STR(r)) {
  62         double d;
  63         if(naStr_len(r) == 0) return 0;
  64         if(naStr_tonum(r, &d)) return d != 0;
  65         else return 1;
  66     }
  67     ERR(ctx, "non-scalar used in boolean context");
  68     return 0;
  69 }
  70
  71 static double numify(naContext ctx, naRef o)
  72 {
  73     double n;
  74     if(IS_NUM(o)) return o.num;
  75     else if(IS_NIL(o)) ERR(ctx, "nil used in numeric context");
  76     else if(!IS_STR(o)) ERR(ctx, "non-scalar in numeric context");
  77     else if(naStr_tonum(o, &n)) return n;
  78     else ERR(ctx, "non-numeric string in numeric context");
  79     return 0;
  80 }
  81
  82 static naRef stringify(naContext ctx, naRef r)
  83 {
  84     if(IS_STR(r)) return r;
  85     if(IS_NUM(r)) return naStr_fromnum(naNewString(ctx), r.num);
  86     ERR(ctx, "non-scalar in string context");
  87     return naNil();
  88 }
  89
  90 static int checkVec(naContext ctx, naRef vec, naRef idx)
  91 {
  92     int i = (int)numify(ctx, idx);
  93     if(i < 0) i += naVec_size(vec);
  94     if(i < 0 || i >= naVec_size(vec))
  95         naRuntimeError(ctx, "vector index %d out of bounds (size: %d)",
  96                        i, naVec_size(vec));
  97     return i;
  98 }
  99
 100 static int checkStr(naContext ctx, naRef str, naRef idx)
 101 {
 102     int i = (int)numify(ctx, idx);
 103     if(i < 0) i += naStr_len(str);
 104     if(i < 0 || i >= naStr_len(str))
 105         naRuntimeError(ctx, "string index %d out of bounds (size: %d)",
 106                        i, naStr_len(str));
 107     return i;
 108 }
 109
 110 static naRef containerGet(naContext ctx, naRef box, naRef key)
 111 {
 112     naRef result = naNil();
 113     if(!IS_SCALAR(key)) ERR(ctx, "container index not scalar");
 114     if(IS_HASH(box))
 115         naHash_get(box, key, &result);
 116     else if(IS_VEC(box))
 117         result = naVec_get(box, checkVec(ctx, box, key));
 118     else if(IS_STR(box))
 119         result = naNum((unsigned char)naStr_data(box)[checkStr(ctx, box, key)]);
 120     else
 121         ERR(ctx, "extract from non-container");
 122     return result;
 123 }
 124
 125 static void containerSet(naContext ctx, naRef box, naRef key, naRef val)
 126 {
 127     if(!IS_SCALAR(key))   ERR(ctx, "container index not scalar");
 128     else if(IS_HASH(box)) naHash_set(box, key, val);
 129     else if(IS_VEC(box))  naVec_set(box, checkVec(ctx, box, key), val);
 130     else if(IS_STR(box)) {
 131         if(PTR(box).str->hashcode)
 132             ERR(ctx, "cannot change immutable string");
 133         naStr_data(box)[checkStr(ctx, box, key)] = (char)numify(ctx, val);
 134     } else ERR(ctx, "insert into non-container");
 135 }
 136
 137 static void initTemps(naContext c)
 138 {
 139     c->tempsz = 4;
 140     c->temps = naAlloc(c->tempsz * sizeof(struct naObj*));
 141     c->ntemps = 0;
 142 }
 143
 144 static void initContext(naContext c)
 145 {
 146     int i;
 147     c->fTop = c->opTop = c->markTop = 0;
 148     for(i=0; i<NUM_NASAL_TYPES; i++)
 149         c->nfree[i] = 0;
 150
 151     if(c->tempsz > 32) {
 152         naFree(c->temps);
 153         initTemps(c);
 154     }
 155
 156     c->callParent = 0;
 157     c->callChild = 0;
 158     c->dieArg = naNil();
 159     c->error[0] = 0;
 160     c->userData = 0;
 161 }
 162
 163 static void initGlobals()
 164 {
 165     int i;
 166     naContext c;
 167     globals = (struct Globals*)naAlloc(sizeof(struct Globals));
 168     naBZero(globals, sizeof(struct Globals));
 169
 170     globals->sem = naNewSem();
 171     globals->lock = naNewLock();
 172
 173     globals->allocCount = 256; // reasonable starting value
 174     for(i=0; i<NUM_NASAL_TYPES; i++)
 175         naGC_init(&(globals->pools[i]), i);
 176     globals->deadsz = 256;
 177     globals->ndead = 0;
 178     globals->deadBlocks = naAlloc(sizeof(void*) * globals->deadsz);
 179
 180     // Initialize a single context
 181     globals->freeContexts = 0;
 182     globals->allContexts = 0;
 183     c = naNewContext();
 184
 185     globals->symbols = naNewHash(c);
 186     globals->save = naNewVector(c);
 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(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         naRef result = (*PTR(code).ccode->fptr)(ctx, obj, nargs, args);
 321         if(named) ERR(ctx, "native functions have no named arguments");
 322         ctx->opTop = ctx->opFrame;
 323         PUSH(result);
 324         return &(ctx->fStack[ctx->fTop-1]);
 325     }
 326
 327     if(ctx->fTop >= MAX_RECURSION) ERR(ctx, "call stack overflow");
 328
 329     f = &(ctx->fStack[ctx->fTop]);
 330     f->locals = named ? args[0] : naNewHash(ctx);
 331     f->func = func;
 332     f->ip = 0;
 333     f->bp = ctx->opFrame;
 334
 335     if(mcall) naHash_set(f->locals, globals->meRef, obj);
 336
 337     if(named) checkNamedArgs(ctx, PTR(code).code, PTR(f->locals).hash);
 338     else      setupArgs(ctx, f, args, nargs);
 339
 340     ctx->fTop++;
 341     ctx->opTop = f->bp; /* Pop the stack last, to avoid GC lossage */
 342     return f;
 343 }
 344
 345 static naRef evalEquality(int op, naRef ra, naRef rb)
 346 {
 347     int result = naEqual(ra, rb);
 348     return naNum((op==OP_EQ) ? result : !result);
 349 }
 350
 351 static naRef evalCat(naContext ctx, naRef l, naRef r)
 352 {
 353     if(IS_VEC(l) && IS_VEC(r)) {
 354         int i, ls = naVec_size(l), rs = naVec_size(r);
 355         naRef v = naNewVector(ctx);
 356         naVec_setsize(v, ls + rs);
 357         for(i=0; i<ls; i+=1) naVec_set(v, i, naVec_get(l, i));
 358         for(i=0; i<rs; i+=1) naVec_set(v, i+ls, naVec_get(r, i));
 359         return v;
 360     } else {
 361         naRef a = stringify(ctx, l);
 362         naRef b = stringify(ctx, r);
 363         return naStr_concat(naNewString(ctx), a, b);
 364     }
 365 }
 366
 367 // When a code object comes out of the constant pool and shows up on
 368 // the stack, it needs to be bound with the lexical context.
 369 static naRef bindFunction(naContext ctx, struct Frame* f, naRef code)
 370 {
 371     naRef result = naNewFunc(ctx, code);
 372     PTR(result).func->namespace = f->locals;
 373     PTR(result).func->next = f->func;
 374     return result;
 375 }
 376
 377 static int getClosure(struct naFunc* c, naRef sym, naRef* result)
 378 {
 379     while(c) {
 380         if(naHash_get(c->namespace, sym, result)) return 1;
 381         c = PTR(c->next).func;
 382     }
 383     return 0;
 384 }
 385
 386 static naRef getLocal2(naContext ctx, struct Frame* f, naRef sym)
 387 {
 388     naRef result;
 389     if(!naHash_get(f->locals, sym, &result))
 390         if(!getClosure(PTR(f->func).func, sym, &result))
 391             naRuntimeError(ctx, "undefined symbol: %s", naStr_data(sym));
 392     return result;
 393 }
 394
 395 static void getLocal(naContext ctx, struct Frame* f, naRef* sym, naRef* out)
 396 {
 397     struct naFunc* func;
 398     struct naStr* str = PTR(*sym).str;
 399     if(naiHash_sym(PTR(f->locals).hash, str, out))
 400         return;
 401     func = PTR(f->func).func;
 402     while(func && PTR(func->namespace).hash) {
 403         if(naiHash_sym(PTR(func->namespace).hash, str, out))
 404             return;
 405         func = PTR(func->next).func;
 406     }
 407     // Now do it again using the more general naHash_get().  This will
 408     // only be necessary if something has created the value in the
 409     // namespace using the more generic hash syntax
 410     // (e.g. namespace["symbol"] and not namespace.symbol).
 411     *out = getLocal2(ctx, f, *sym);
 412 }
 413
 414 static int setClosure(naRef func, naRef sym, naRef val)
 415 {
 416     struct naFunc* c = PTR(func).func;
 417     if(c == 0) return 0;
 418     if(naiHash_tryset(c->namespace, sym, val)) return 1;
 419     return setClosure(c->next, sym, val);
 420 }
 421
 422 static void setSymbol(struct Frame* f, naRef sym, naRef val)
 423 {
 424     // Try the locals first, if not already there try the closures in
 425     // order.  Finally put it in the locals if nothing matched.
 426     if(!naiHash_tryset(f->locals, sym, val))
 427         if(!setClosure(f->func, sym, val))
 428             naHash_set(f->locals, sym, val);
 429 }
 430
 431 // Funky API: returns null to indicate no member, an empty string to
 432 // indicate success, or a non-empty error message.  Works this way so
 433 // we can generate smart error messages without throwing them with a
 434 // longjmp -- this gets called under naMember_get() from C code.
 435 static const char* getMember_r(naRef obj, naRef field, naRef* out, int count)
 436 {
 437     int i;
 438     naRef p;
 439     struct VecRec* pv;
 440     if(--count < 0) return "too many parents";
 441     if(!IS_HASH(obj)) return "non-objects have no members";
 442     if(naHash_get(obj, field, out)) return "";
 443     if(!naHash_get(obj, globals->parentsRef, &p)) return 0;
 444     if(!IS_VEC(p)) return "object \"parents\" field not vector";
 445     pv = PTR(p).vec->rec;
 446     for(i=0; pv && i<pv->size; i++) {
 447         const char* err = getMember_r(pv->array[i], field, out, count);
 448         if(err) return err; /* either an error or success */
 449     }
 450     return 0;
 451 }
 452
 453 static void getMember(naContext ctx, naRef obj, naRef fld,
 454                       naRef* result, int count)
 455 {
 456     const char* err = getMember_r(obj, fld, result, count);
 457     if(!err)   naRuntimeError(ctx, "No such member: %s", naStr_data(fld));
 458     if(err[0]) naRuntimeError(ctx, err);
 459 }
 460
 461 int naMember_get(naRef obj, naRef field, naRef* out)
 462 {
 463     const char* err = getMember_r(obj, field, out, 64);
 464     return err && !err[0];
 465 }
 466
 467 // OP_EACH works like a vector get, except that it leaves the vector
 468 // and index on the stack, increments the index after use, and
 469 // pushes a nil if the index is beyond the end.
 470 static void evalEach(naContext ctx, int useIndex)
 471 {
 472     int idx = (int)(ctx->opStack[ctx->opTop-1].num);
 473     naRef vec = ctx->opStack[ctx->opTop-2];
 474     if(!IS_VEC(vec)) ERR(ctx, "foreach enumeration of non-vector");
 475     if(!PTR(vec).vec->rec || idx >= PTR(vec).vec->rec->size) {
 476         PUSH(endToken());
 477         return;
 478     }
 479     ctx->opStack[ctx->opTop-1].num = idx+1; // modify in place
 480     PUSH(useIndex ? naNum(idx) : naVec_get(vec, idx));
 481 }
 482
 483 static void evalUnpack(naContext ctx, int count)
 484 {
 485     naRef vec = ctx->opStack[--ctx->opTop];
 486     if(!IS_VEC(vec) || naVec_size(vec) < count)
 487         ERR(ctx, "short or invalid multi-assignment vector");
 488     while(count--) PUSH(naVec_get(vec, count));
 489 }
 490
 491 // FIXME: unify with almost identical checkVec() above
 492 static int vbound(naContext ctx, naRef v, naRef ir, int end)
 493 {
 494     int i = IS_NIL(ir) ? (end ? -1 : 0) : numify(ctx, ir);
 495     if(i < 0) i += naVec_size(v);
 496     if(i < 0 || i >= naVec_size(v))
 497         naRuntimeError(ctx, "slice index %d out of bounds (size: %d)",
 498                        i, naVec_size(v));
 499     return i;
 500 }
 501
 502 static void evalSlice(naContext ctx, naRef src, naRef dst, naRef idx)
 503 {
 504     if(!IS_VEC(src)) ERR(ctx, "cannot slice non-vector");
 505     naVec_append(dst, naVec_get(src, vbound(ctx, src, idx, 0)));
 506 }
 507
 508 static void evalSlice2(naContext ctx, naRef src, naRef dst,
 509                        naRef start, naRef endr)
 510 {
 511     int i, end;
 512     if(!IS_VEC(src)) ERR(ctx, "cannot slice non-vector");
 513     end = vbound(ctx, src, endr, 1);
 514     for(i = vbound(ctx, src, start, 0); i<=end; i++)
 515         naVec_append(dst, naVec_get(src, i));
 516 }
 517
 518 #define ARG() BYTECODE(cd)[f->ip++]
 519 #define CONSTARG() cd->constants[ARG()]
 520 #define POP() ctx->opStack[--ctx->opTop]
 521 #define STK(n) (ctx->opStack[ctx->opTop-(n)])
 522 #define SETFRAME(F) f = (F); cd = PTR(PTR(f->func).func->code).code;
 523 #define FIXFRAME() SETFRAME(&(ctx->fStack[ctx->fTop-1]))
 524 static naRef run(naContext ctx)
 525 {
 526     struct Frame* f;
 527     struct naCode* cd;
 528     int op, arg;
 529     naRef a, b;
 530
 531     ctx->dieArg = naNil();
 532     ctx->error[0] = 0;
 533
 534     FIXFRAME();
 535
 536     while(1) {
 537         op = BYTECODE(cd)[f->ip++];
 538         DBG(printf("Stack Depth: %d\n", ctx->opTop));
 539         DBG(printOpDEBUG(f->ip-1, op));
 540         switch(op) {
 541         case OP_POP:  ctx->opTop--; break;
 542         case OP_DUP:  PUSH(STK(1)); break;
 543         case OP_DUP2: PUSH(STK(2)); PUSH(STK(2)); break;
 544         case OP_XCHG:  a=STK(1); STK(1)=STK(2); STK(2)=a; break;
 545         case OP_XCHG2: a=STK(1); STK(1)=STK(2); STK(2)=STK(3); STK(3)=a; break;
 546
 547 #define BINOP(expr) do { \
 548     double l = IS_NUM(STK(2)) ? STK(2).num : numify(ctx, STK(2)); \
 549     double r = IS_NUM(STK(1)) ? STK(1).num : numify(ctx, STK(1)); \
 550     SETNUM(STK(2), expr);                                         \
 551     ctx->opTop--; } while(0)
 552
 553         case OP_PLUS:  BINOP(l + r);         break;
 554         case OP_MINUS: BINOP(l - r);         break;
 555         case OP_MUL:   BINOP(l * r);         break;
 556         case OP_DIV:   BINOP(l / r);         break;
 557         case OP_LT:    BINOP(l <  r ? 1 : 0); break;
 558         case OP_LTE:   BINOP(l <= r ? 1 : 0); break;
 559         case OP_GT:    BINOP(l >  r ? 1 : 0); break;
 560         case OP_GTE:   BINOP(l >= r ? 1 : 0); break;
 561 #undef BINOP
 562
 563         case OP_EQ: case OP_NEQ:
 564             STK(2) = evalEquality(op, STK(2), STK(1));
 565             ctx->opTop--;
 566             break;
 567         case OP_CAT:
 568             STK(2) = evalCat(ctx, STK(2), STK(1));
 569             ctx->opTop--;
 570             break;
 571         case OP_NEG:
 572             STK(1) = naNum(-numify(ctx, STK(1)));
 573             break;
 574         case OP_NOT:
 575             STK(1) = naNum(boolify(ctx, STK(1)) ? 0 : 1);
 576             break;
 577         case OP_PUSHCONST:
 578             a = CONSTARG();
 579             if(IS_CODE(a)) a = bindFunction(ctx, f, a);
 580             PUSH(a);
 581             break;
 582         case OP_PUSHONE:
 583             PUSH(naNum(1));
 584             break;
 585         case OP_PUSHZERO:
 586             PUSH(naNum(0));
 587             break;
 588         case OP_PUSHNIL:
 589             PUSH(naNil());
 590             break;
 591         case OP_PUSHEND:
 592             PUSH(endToken());
 593             break;
 594         case OP_NEWVEC:
 595             PUSH(naNewVector(ctx));
 596             break;
 597         case OP_VAPPEND:
 598             naVec_append(STK(2), STK(1));
 599             ctx->opTop--;
 600             break;
 601         case OP_NEWHASH:
 602             PUSH(naNewHash(ctx));
 603             break;
 604         case OP_HAPPEND:
 605             naHash_set(STK(3), STK(2), STK(1));
 606             ctx->opTop -= 2;
 607             break;
 608         case OP_LOCAL:
 609             a = CONSTARG();
 610             getLocal(ctx, f, &a, &b);
 611             PUSH(b);
 612             break;
 613         case OP_SETSYM:
 614             setSymbol(f, STK(1), STK(2));
 615             ctx->opTop--;
 616             break;
 617         case OP_SETLOCAL:
 618             naHash_set(f->locals, STK(1), STK(2));
 619             ctx->opTop--;
 620             break;
 621         case OP_MEMBER:
 622             getMember(ctx, STK(1), CONSTARG(), &STK(1), 64);
 623             break;
 624         case OP_SETMEMBER:
 625             if(!IS_HASH(STK(2))) ERR(ctx, "non-objects have no members");
 626             naHash_set(STK(2), STK(1), STK(3));
 627             ctx->opTop -= 2;
 628             break;
 629         case OP_INSERT:
 630             containerSet(ctx, STK(2), STK(1), STK(3));
 631             ctx->opTop -= 2;
 632             break;
 633         case OP_EXTRACT:
 634             STK(2) = containerGet(ctx, STK(2), STK(1));
 635             ctx->opTop--;
 636             break;
 637         case OP_SLICE:
 638             evalSlice(ctx, STK(3), STK(2), STK(1));
 639             ctx->opTop--;
 640             break;
 641         case OP_SLICE2:
 642             evalSlice2(ctx, STK(4), STK(3), STK(2), STK(1));
 643             ctx->opTop -= 2;
 644             break;
 645         case OP_JMPLOOP:
 646             // Identical to JMP, except for locking
 647             naCheckBottleneck();
 648             f->ip = BYTECODE(cd)[f->ip];
 649             DBG(printf("   [Jump to: %d]\n", f->ip));
 650             break;
 651         case OP_JMP:
 652             f->ip = BYTECODE(cd)[f->ip];
 653             DBG(printf("   [Jump to: %d]\n", f->ip));
 654             break;
 655         case OP_JIFEND:
 656             arg = ARG();
 657             if(IS_END(STK(1))) {
 658                 ctx->opTop--; // Pops **ONLY** if it's nil!
 659                 f->ip = arg;
 660                 DBG(printf("   [Jump to: %d]\n", f->ip));
 661             }
 662             break;
 663         case OP_JIFTRUE:
 664             arg = ARG();
 665             if(boolify(ctx, STK(1))) {
 666                 f->ip = arg;
 667                 DBG(printf("   [Jump to: %d]\n", f->ip));
 668             }
 669             break;
 670         case OP_JIFNOT:
 671             arg = ARG();
 672             if(!boolify(ctx, STK(1))) {
 673                 f->ip = arg;
 674                 DBG(printf("   [Jump to: %d]\n", f->ip));
 675             }
 676             break;
 677         case OP_JIFNOTPOP:
 678             arg = ARG();
 679             if(!boolify(ctx, POP())) {
 680                 f->ip = arg;
 681                 DBG(printf("   [Jump to: %d]\n", f->ip));
 682             }
 683             break;
 684         case OP_FCALL:  SETFRAME(setupFuncall(ctx, ARG(), 0, 0)); break;
 685         case OP_MCALL:  SETFRAME(setupFuncall(ctx, ARG(), 1, 0)); break;
 686         case OP_FCALLH: SETFRAME(setupFuncall(ctx,     1, 0, 1)); break;
 687         case OP_MCALLH: SETFRAME(setupFuncall(ctx,     1, 1, 1)); break;
 688         case OP_RETURN:
 689             a = STK(1);
 690             ctx->dieArg = naNil();
 691             if(ctx->callChild) naFreeContext(ctx->callChild);
 692             if(--ctx->fTop <= 0) return a;
 693             ctx->opTop = f->bp + 1; // restore the correct opstack frame!
 694             STK(1) = a;
 695             FIXFRAME();
 696             break;
 697         case OP_EACH:
 698             evalEach(ctx, 0);
 699             break;
 700         case OP_INDEX:
 701             evalEach(ctx, 1);
 702             break;
 703         case OP_MARK: // save stack state (e.g. "setjmp")
 704             if(ctx->markTop >= MAX_MARK_DEPTH)
 705                 ERR(ctx, "mark stack overflow");
 706             ctx->markStack[ctx->markTop++] = ctx->opTop;
 707             break;
 708         case OP_UNMARK: // pop stack state set by mark
 709             ctx->markTop--;
 710             break;
 711         case OP_BREAK: // restore stack state (FOLLOW WITH JMP!)
 712             ctx->opTop = ctx->markStack[ctx->markTop-1];
 713             break;
 714         case OP_BREAK2: // same, but also pop the mark stack
 715             ctx->opTop = ctx->markStack[--ctx->markTop];
 716             break;
 717         case OP_UNPACK:
 718             evalUnpack(ctx, ARG());
 719             break;
 720         default:
 721             ERR(ctx, "BUG: bad opcode");
 722         }
 723         ctx->ntemps = 0; // reset GC temp vector
 724         DBG(printStackDEBUG(ctx));
 725     }
 726     return naNil(); // unreachable
 727 }
 728 #undef POP
 729 #undef CONSTARG
 730 #undef STK
 731 #undef FIXFRAME
 732
 733 void naSave(naContext ctx, naRef obj)
 734 {
 735     naVec_append(globals->save, obj);
 736 }
 737
 738 int naStackDepth(naContext ctx)
 739 {
 740     return ctx ? ctx->fTop + naStackDepth(ctx->callChild): 0;
 741 }
 742
 743 static int findFrame(naContext ctx, naContext* out, int fn)
 744 {
 745     int sd = naStackDepth(ctx->callChild);
 746     if(fn < sd) return findFrame(ctx->callChild, out, fn);
 747     *out = ctx;
 748     return ctx->fTop - 1 - (fn - sd);
 749 }
 750
 751 int naGetLine(naContext ctx, int frame)
 752 {
 753     struct Frame* f;
 754     frame = findFrame(ctx, &ctx, frame);
 755     f = &ctx->fStack[frame];
 756     if(IS_FUNC(f->func) && IS_CODE(PTR(f->func).func->code)) {
 757         struct naCode* c = PTR(PTR(f->func).func->code).code;
 758         unsigned short* p = LINEIPS(c) + c->nLines - 2;
 759         while(p >= LINEIPS(c) && p[0] > f->ip)
 760             p -= 2;
 761         return p[1];
 762     }
 763     return -1;
 764 }
 765
 766 naRef naGetSourceFile(naContext ctx, int frame)
 767 {
 768     naRef f;
 769     frame = findFrame(ctx, &ctx, frame);
 770     f = ctx->fStack[frame].func;
 771     f = PTR(f).func->code;
 772     return PTR(f).code->srcFile;
 773 }
 774
 775 char* naGetError(naContext ctx)
 776 {
 777     if(IS_STR(ctx->dieArg))
 778         return naStr_data(ctx->dieArg);
 779     return ctx->error[0] ? ctx->error : 0;
 780 }
 781
 782 naRef naBindFunction(naContext ctx, naRef code, naRef closure)
 783 {
 784     naRef func = naNewFunc(ctx, code);
 785     PTR(func).func->namespace = closure;
 786     PTR(func).func->next = naNil();
 787     return func;
 788 }
 789
 790 naRef naBindToContext(naContext ctx, naRef code)
 791 {
 792     naRef func = naNewFunc(ctx, code);
 793     if(ctx->fTop) {
 794         struct Frame* f = &ctx->fStack[ctx->fTop-1];
 795         PTR(func).func->namespace = f->locals;
 796         PTR(func).func->next = f->func;
 797     }
 798     return func;
 799 }
 800
 801 naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
 802              naRef obj, naRef locals)
 803 {
 804     int i;
 805     naRef result;
 806     if(!ctx->callParent) naModLock();
 807
 808     // We might have to allocate objects, which can call the GC.  But
 809     // the call isn't on the Nasal stack yet, so the GC won't find our
 810     // C-space arguments.
 811     naTempSave(ctx, func);
 812     for(i=0; i<argc; i++)
 813         naTempSave(ctx, args[i]);
 814     naTempSave(ctx, obj);
 815     naTempSave(ctx, locals);
 816
 817     // naRuntimeError() calls end up here:
 818     if(setjmp(ctx->jumpHandle)) {
 819         if(!ctx->callParent) naModUnlock();
 820         return naNil();
 821     }
 822
 823     if(IS_CCODE(PTR(func).func->code)) {
 824         naCFunction fp = PTR(PTR(func).func->code).ccode->fptr;
 825         result = (*fp)(ctx, obj, argc, args);
 826         if(!ctx->callParent) naModUnlock();
 827         return result;
 828     }
 829
 830     if(IS_NIL(locals))
 831         locals = naNewHash(ctx);
 832     if(!IS_FUNC(func)) {
 833         func = naNewFunc(ctx, func);
 834         PTR(func).func->namespace = locals;
 835     }
 836     if(!IS_NIL(obj))
 837         naHash_set(locals, globals->meRef, obj);
 838
 839     ctx->opTop = ctx->markTop = 0;
 840     ctx->fTop = 1;
 841     ctx->fStack[0].func = func;
 842
 843     ctx->fStack[0].locals = locals;
 844     ctx->fStack[0].ip = 0;
 845     ctx->fStack[0].bp = ctx->opTop;
 846
 847     setupArgs(ctx, ctx->fStack, args, argc);
 848
 849     result = run(ctx);
 850     if(!ctx->callParent) naModUnlock();
 851     return result;
 852 }
 853
 854 naRef naContinue(naContext ctx)
 855 {
 856     naRef result;
 857     if(!ctx->callParent) naModLock();
 858
 859     ctx->dieArg = naNil();
 860     ctx->error[0] = 0;
 861
 862     if(setjmp(ctx->jumpHandle)) {
 863         if(!ctx->callParent) naModUnlock();
 864         else naRethrowError(ctx);
 865         return naNil();
 866     }
 867
 868     // Wipe off the old function arguments, and push the expected
 869     // result (either the result of our subcontext, or a synthesized
 870     // nil if the thrown error was from an extension function or
 871     // in-script die() call) before re-running the code from the
 872     // instruction following the error.
 873     ctx->opTop = ctx->opFrame;
 874     PUSH(ctx->callChild ? naContinue(ctx->callChild) : naNil());
 875
 876     // Getting here means the child completed successfully.  But
 877     // because its original C stack was longjmp'd out of existence,
 878     // there is no one left to free the context, so we have to do it.
 879     // This is fragile, but unfortunately required.
 880     if(ctx->callChild) naFreeContext(ctx->callChild);
 881
 882     result = run(ctx);
 883     if(!ctx->callParent) naModUnlock();
 884     return result;
 885 }