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 sz=naVec_size(v), i = IS_NIL(ir) ? (end ? -1 : 0) : numify(ctx, ir);
 495     if(IS_NIL(ir) && !sz) return i;
 496     if(i < 0) i += sz;
 497     if(i < 0 || i >= sz)
 498         naRuntimeError(ctx, "slice index %d out of bounds (size: %d)",
 499                        i, sz);
 500     return i;
 501 }
 502
 503 static void evalSlice(naContext ctx, naRef src, naRef dst, naRef idx)
 504 {
 505     if(!IS_VEC(src)) ERR(ctx, "cannot slice non-vector");
 506     naVec_append(dst, naVec_get(src, checkVec(ctx, src, idx)));
 507 }
 508
 509 static void evalSlice2(naContext ctx, naRef src, naRef dst,
 510                        naRef start, naRef endr)
 511 {
 512     int i, end;
 513     if(!IS_VEC(src)) ERR(ctx, "cannot slice non-vector");
 514     end = vbound(ctx, src, endr, 1);
 515     for(i = vbound(ctx, src, start, 0); i<=end; i++)
 516         naVec_append(dst, naVec_get(src, i));
 517 }
 518
 519 #define ARG() BYTECODE(cd)[f->ip++]
 520 #define CONSTARG() cd->constants[ARG()]
 521 #define POP() ctx->opStack[--ctx->opTop]
 522 #define STK(n) (ctx->opStack[ctx->opTop-(n)])
 523 #define SETFRAME(F) f = (F); cd = PTR(PTR(f->func).func->code).code;
 524 #define FIXFRAME() SETFRAME(&(ctx->fStack[ctx->fTop-1]))
 525 static naRef run(naContext ctx)
 526 {
 527     struct Frame* f;
 528     struct naCode* cd;
 529     int op, arg;
 530     naRef a, b;
 531
 532     ctx->dieArg = naNil();
 533     ctx->error[0] = 0;
 534
 535     FIXFRAME();
 536
 537     while(1) {
 538         op = BYTECODE(cd)[f->ip++];
 539         DBG(printf("Stack Depth: %d\n", ctx->opTop));
 540         DBG(printOpDEBUG(f->ip-1, op));
 541         switch(op) {
 542         case OP_POP:  ctx->opTop--; break;
 543         case OP_DUP:  PUSH(STK(1)); break;
 544         case OP_DUP2: PUSH(STK(2)); PUSH(STK(2)); break;
 545         case OP_XCHG:  a=STK(1); STK(1)=STK(2); STK(2)=a; break;
 546         case OP_XCHG2: a=STK(1); STK(1)=STK(2); STK(2)=STK(3); STK(3)=a; break;
 547
 548 #define BINOP(expr) do { \
 549     double l = IS_NUM(STK(2)) ? STK(2).num : numify(ctx, STK(2)); \
 550     double r = IS_NUM(STK(1)) ? STK(1).num : numify(ctx, STK(1)); \
 551     SETNUM(STK(2), expr);                                         \
 552     ctx->opTop--; } while(0)
 553
 554         case OP_PLUS:  BINOP(l + r);         break;
 555         case OP_MINUS: BINOP(l - r);         break;
 556         case OP_MUL:   BINOP(l * r);         break;
 557         case OP_DIV:   BINOP(l / r);         break;
 558         case OP_LT:    BINOP(l <  r ? 1 : 0); break;
 559         case OP_LTE:   BINOP(l <= r ? 1 : 0); break;
 560         case OP_GT:    BINOP(l >  r ? 1 : 0); break;
 561         case OP_GTE:   BINOP(l >= r ? 1 : 0); break;
 562 #undef BINOP
 563
 564         case OP_EQ: case OP_NEQ:
 565             STK(2) = evalEquality(op, STK(2), STK(1));
 566             ctx->opTop--;
 567             break;
 568         case OP_CAT:
 569             STK(2) = evalCat(ctx, STK(2), STK(1));
 570             ctx->opTop--;
 571             break;
 572         case OP_NEG:
 573             STK(1) = naNum(-numify(ctx, STK(1)));
 574             break;
 575         case OP_NOT:
 576             STK(1) = naNum(boolify(ctx, STK(1)) ? 0 : 1);
 577             break;
 578         case OP_PUSHCONST:
 579             a = CONSTARG();
 580             if(IS_CODE(a)) a = bindFunction(ctx, f, a);
 581             PUSH(a);
 582             break;
 583         case OP_PUSHONE:
 584             PUSH(naNum(1));
 585             break;
 586         case OP_PUSHZERO:
 587             PUSH(naNum(0));
 588             break;
 589         case OP_PUSHNIL:
 590             PUSH(naNil());
 591             break;
 592         case OP_PUSHEND:
 593             PUSH(endToken());
 594             break;
 595         case OP_NEWVEC:
 596             PUSH(naNewVector(ctx));
 597             break;
 598         case OP_VAPPEND:
 599             naVec_append(STK(2), STK(1));
 600             ctx->opTop--;
 601             break;
 602         case OP_NEWHASH:
 603             PUSH(naNewHash(ctx));
 604             break;
 605         case OP_HAPPEND:
 606             naHash_set(STK(3), STK(2), STK(1));
 607             ctx->opTop -= 2;
 608             break;
 609         case OP_LOCAL:
 610             a = CONSTARG();
 611             getLocal(ctx, f, &a, &b);
 612             PUSH(b);
 613             break;
 614         case OP_SETSYM:
 615             setSymbol(f, STK(1), STK(2));
 616             ctx->opTop--;
 617             break;
 618         case OP_SETLOCAL:
 619             naHash_set(f->locals, STK(1), STK(2));
 620             ctx->opTop--;
 621             break;
 622         case OP_MEMBER:
 623             getMember(ctx, STK(1), CONSTARG(), &STK(1), 64);
 624             break;
 625         case OP_SETMEMBER:
 626             if(!IS_HASH(STK(2))) ERR(ctx, "non-objects have no members");
 627             naHash_set(STK(2), STK(1), STK(3));
 628             ctx->opTop -= 2;
 629             break;
 630         case OP_INSERT:
 631             containerSet(ctx, STK(2), STK(1), STK(3));
 632             ctx->opTop -= 2;
 633             break;
 634         case OP_EXTRACT:
 635             STK(2) = containerGet(ctx, STK(2), STK(1));
 636             ctx->opTop--;
 637             break;
 638         case OP_SLICE:
 639             evalSlice(ctx, STK(3), STK(2), STK(1));
 640             ctx->opTop--;
 641             break;
 642         case OP_SLICE2:
 643             evalSlice2(ctx, STK(4), STK(3), STK(2), STK(1));
 644             ctx->opTop -= 2;
 645             break;
 646         case OP_JMPLOOP:
 647             // Identical to JMP, except for locking
 648             naCheckBottleneck();
 649             f->ip = BYTECODE(cd)[f->ip];
 650             DBG(printf("   [Jump to: %d]\n", f->ip));
 651             break;
 652         case OP_JMP:
 653             f->ip = BYTECODE(cd)[f->ip];
 654             DBG(printf("   [Jump to: %d]\n", f->ip));
 655             break;
 656         case OP_JIFEND:
 657             arg = ARG();
 658             if(IS_END(STK(1))) {
 659                 ctx->opTop--; // Pops **ONLY** if it's nil!
 660                 f->ip = arg;
 661                 DBG(printf("   [Jump to: %d]\n", f->ip));
 662             }
 663             break;
 664         case OP_JIFTRUE:
 665             arg = ARG();
 666             if(boolify(ctx, STK(1))) {
 667                 f->ip = arg;
 668                 DBG(printf("   [Jump to: %d]\n", f->ip));
 669             }
 670             break;
 671         case OP_JIFNOT:
 672             arg = ARG();
 673             if(!boolify(ctx, STK(1))) {
 674                 f->ip = arg;
 675                 DBG(printf("   [Jump to: %d]\n", f->ip));
 676             }
 677             break;
 678         case OP_JIFNOTPOP:
 679             arg = ARG();
 680             if(!boolify(ctx, POP())) {
 681                 f->ip = arg;
 682                 DBG(printf("   [Jump to: %d]\n", f->ip));
 683             }
 684             break;
 685         case OP_FCALL:  SETFRAME(setupFuncall(ctx, ARG(), 0, 0)); break;
 686         case OP_MCALL:  SETFRAME(setupFuncall(ctx, ARG(), 1, 0)); break;
 687         case OP_FCALLH: SETFRAME(setupFuncall(ctx,     1, 0, 1)); break;
 688         case OP_MCALLH: SETFRAME(setupFuncall(ctx,     1, 1, 1)); break;
 689         case OP_RETURN:
 690             a = STK(1);
 691             ctx->dieArg = naNil();
 692             if(ctx->callChild) naFreeContext(ctx->callChild);
 693             if(--ctx->fTop <= 0) return a;
 694             ctx->opTop = f->bp + 1; // restore the correct opstack frame!
 695             STK(1) = a;
 696             FIXFRAME();
 697             break;
 698         case OP_EACH:
 699             evalEach(ctx, 0);
 700             break;
 701         case OP_INDEX:
 702             evalEach(ctx, 1);
 703             break;
 704         case OP_MARK: // save stack state (e.g. "setjmp")
 705             if(ctx->markTop >= MAX_MARK_DEPTH)
 706                 ERR(ctx, "mark stack overflow");
 707             ctx->markStack[ctx->markTop++] = ctx->opTop;
 708             break;
 709         case OP_UNMARK: // pop stack state set by mark
 710             ctx->markTop--;
 711             break;
 712         case OP_BREAK: // restore stack state (FOLLOW WITH JMP!)
 713             ctx->opTop = ctx->markStack[ctx->markTop-1];
 714             break;
 715         case OP_BREAK2: // same, but also pop the mark stack
 716             ctx->opTop = ctx->markStack[--ctx->markTop];
 717             break;
 718         case OP_UNPACK:
 719             evalUnpack(ctx, ARG());
 720             break;
 721         default:
 722             ERR(ctx, "BUG: bad opcode");
 723         }
 724         ctx->ntemps = 0; // reset GC temp vector
 725         DBG(printStackDEBUG(ctx));
 726     }
 727     return naNil(); // unreachable
 728 }
 729 #undef POP
 730 #undef CONSTARG
 731 #undef STK
 732 #undef FIXFRAME
 733
 734 void naSave(naContext ctx, naRef obj)
 735 {
 736     naVec_append(globals->save, obj);
 737 }
 738
 739 int naStackDepth(naContext ctx)
 740 {
 741     return ctx ? ctx->fTop + naStackDepth(ctx->callChild): 0;
 742 }
 743
 744 static int findFrame(naContext ctx, naContext* out, int fn)
 745 {
 746     int sd = naStackDepth(ctx->callChild);
 747     if(fn < sd) return findFrame(ctx->callChild, out, fn);
 748     *out = ctx;
 749     return ctx->fTop - 1 - (fn - sd);
 750 }
 751
 752 int naGetLine(naContext ctx, int frame)
 753 {
 754     struct Frame* f;
 755     frame = findFrame(ctx, &ctx, frame);
 756     f = &ctx->fStack[frame];
 757     if(IS_FUNC(f->func) && IS_CODE(PTR(f->func).func->code)) {
 758         struct naCode* c = PTR(PTR(f->func).func->code).code;
 759         unsigned short* p = LINEIPS(c) + c->nLines - 2;
 760         while(p >= LINEIPS(c) && p[0] > f->ip)
 761             p -= 2;
 762         return p[1];
 763     }
 764     return -1;
 765 }
 766
 767 naRef naGetSourceFile(naContext ctx, int frame)
 768 {
 769     naRef f;
 770     frame = findFrame(ctx, &ctx, frame);
 771     f = ctx->fStack[frame].func;
 772     f = PTR(f).func->code;
 773     return PTR(f).code->srcFile;
 774 }
 775
 776 char* naGetError(naContext ctx)
 777 {
 778     if(IS_STR(ctx->dieArg))
 779         return naStr_data(ctx->dieArg);
 780     return ctx->error[0] ? ctx->error : 0;
 781 }
 782
 783 naRef naBindFunction(naContext ctx, naRef code, naRef closure)
 784 {
 785     naRef func = naNewFunc(ctx, code);
 786     PTR(func).func->namespace = closure;
 787     PTR(func).func->next = naNil();
 788     return func;
 789 }
 790
 791 naRef naBindToContext(naContext ctx, naRef code)
 792 {
 793     naRef func = naNewFunc(ctx, code);
 794     if(ctx->fTop) {
 795         struct Frame* f = &ctx->fStack[ctx->fTop-1];
 796         PTR(func).func->namespace = f->locals;
 797         PTR(func).func->next = f->func;
 798     }
 799     return func;
 800 }
 801
 802 naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
 803              naRef obj, naRef locals)
 804 {
 805     int i;
 806     naRef result;
 807     if(!ctx->callParent) naModLock();
 808
 809     // We might have to allocate objects, which can call the GC.  But
 810     // the call isn't on the Nasal stack yet, so the GC won't find our
 811     // C-space arguments.
 812     naTempSave(ctx, func);
 813     for(i=0; i<argc; i++)
 814         naTempSave(ctx, args[i]);
 815     naTempSave(ctx, obj);
 816     naTempSave(ctx, locals);
 817
 818     // naRuntimeError() calls end up here:
 819     if(setjmp(ctx->jumpHandle)) {
 820         if(!ctx->callParent) naModUnlock();
 821         return naNil();
 822     }
 823
 824     if(IS_CCODE(PTR(func).func->code)) {
 825         naCFunction fp = PTR(PTR(func).func->code).ccode->fptr;
 826         result = (*fp)(ctx, obj, argc, args);
 827         if(!ctx->callParent) naModUnlock();
 828         return result;
 829     }
 830
 831     if(IS_NIL(locals))
 832         locals = naNewHash(ctx);
 833     if(!IS_FUNC(func)) {
 834         func = naNewFunc(ctx, func);
 835         PTR(func).func->namespace = locals;
 836     }
 837     if(!IS_NIL(obj))
 838         naHash_set(locals, globals->meRef, obj);
 839
 840     ctx->opTop = ctx->markTop = 0;
 841     ctx->fTop = 1;
 842     ctx->fStack[0].func = func;
 843
 844     ctx->fStack[0].locals = locals;
 845     ctx->fStack[0].ip = 0;
 846     ctx->fStack[0].bp = ctx->opTop;
 847
 848     setupArgs(ctx, ctx->fStack, args, argc);
 849
 850     result = run(ctx);
 851     if(!ctx->callParent) naModUnlock();
 852     return result;
 853 }
 854
 855 naRef naContinue(naContext ctx)
 856 {
 857     naRef result;
 858     if(!ctx->callParent) naModLock();
 859
 860     ctx->dieArg = naNil();
 861     ctx->error[0] = 0;
 862
 863     if(setjmp(ctx->jumpHandle)) {
 864         if(!ctx->callParent) naModUnlock();
 865         else naRethrowError(ctx);
 866         return naNil();
 867     }
 868
 869     // Wipe off the old function arguments, and push the expected
 870     // result (either the result of our subcontext, or a synthesized
 871     // nil if the thrown error was from an extension function or
 872     // in-script die() call) before re-running the code from the
 873     // instruction following the error.
 874     ctx->opTop = ctx->opFrame;
 875     PUSH(ctx->callChild ? naContinue(ctx->callChild) : naNil());
 876
 877     // Getting here means the child completed successfully.  But
 878     // because its original C stack was longjmp'd out of existence,
 879     // there is no one left to free the context, so we have to do it.
 880     // This is fragile, but unfortunately required.
 881     if(ctx->callChild) naFreeContext(ctx->callChild);
 882
 883     result = run(ctx);
 884     if(!ctx->callParent) naModUnlock();
 885     return result;
 886 }