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