simgear/nasal/code.c

   1 #include "nasal.h"
   2 #include "code.h"
   3
   4 ////////////////////////////////////////////////////////////////////////
   5 // Debugging stuff. ////////////////////////////////////////////////////
   6 ////////////////////////////////////////////////////////////////////////
   7 //#define DEBUG_NASAL
   8 #if !defined(DEBUG_NASAL)
   9 # define DBG(expr) /* noop */
  10 #else
  11 # define DBG(expr) expr
  12 # include <stdio.h>
  13 # include <stdlib.h>
  14 #endif
  15 char* opStringDEBUG(int op);
  16 void printOpDEBUG(int ip, int op);
  17 void printStackDEBUG(struct Context* ctx);
  18 ////////////////////////////////////////////////////////////////////////
  19
  20 struct Globals* globals = 0;
  21
  22 static naRef bindFunction(struct Context* ctx, struct Frame* f, naRef code);
  23
  24 #define ERR(c, msg) naRuntimeError((c),(msg))
  25 void naRuntimeError(struct Context* c, char* msg)
  26 {
  27     c->error = msg;
  28     longjmp(c->jumpHandle, 1);
  29 }
  30
  31 static int boolify(struct Context* ctx, naRef r)
  32 {
  33     if(IS_NUM(r)) return r.num != 0;
  34     if(IS_NIL(r)) return 0;
  35     if(IS_STR(r)) {
  36         double d;
  37         if(naStr_len(r) == 0) return 0;
  38         if(naStr_tonum(r, &d)) return d != 0;
  39         else return 1;
  40     }
  41     ERR(ctx, "non-scalar used in boolean context");
  42     return 0;
  43 }
  44
  45 static double numify(struct Context* ctx, naRef o)
  46 {
  47     double n;
  48     if(IS_NUM(o)) return o.num;
  49     else if(IS_NIL(o)) ERR(ctx, "nil used in numeric context");
  50     else if(!IS_STR(o)) ERR(ctx, "non-scalar in numeric context");
  51     else if(naStr_tonum(o, &n)) return n;
  52     else ERR(ctx, "non-numeric string in numeric context");
  53     return 0;
  54 }
  55
  56 static naRef stringify(struct Context* ctx, naRef r)
  57 {
  58     if(IS_STR(r)) return r;
  59     if(IS_NUM(r)) return naStr_fromnum(naNewString(ctx), r.num);
  60     ERR(ctx, "non-scalar in string context");
  61     return naNil();
  62 }
  63
  64 static int checkVec(struct Context* ctx, naRef vec, naRef idx)
  65 {
  66     int i = (int)numify(ctx, idx);
  67     if(i < 0 || i >= vec.ref.ptr.vec->rec->size)
  68         ERR(ctx, "vector index out of bounds");
  69     return i;
  70 }
  71
  72 static naRef containerGet(struct Context* ctx, naRef box, naRef key)
  73 {
  74     naRef result = naNil();
  75     if(!IS_SCALAR(key)) ERR(ctx, "container index not scalar");
  76     if(IS_HASH(box)) {
  77         if(!naHash_get(box, key, &result))
  78             ERR(ctx, "undefined value in container");
  79     } else if(IS_VEC(box)) {
  80         result = naVec_get(box, checkVec(ctx, box, key));
  81     } else {
  82         ERR(ctx, "extract from non-container");
  83     }
  84     return result;
  85 }
  86
  87 static void containerSet(struct Context* ctx, naRef box, naRef key, naRef val)
  88 {
  89     if(!IS_SCALAR(key))   ERR(ctx, "container index not scalar");
  90     else if(IS_HASH(box)) naHash_set(box, key, val);
  91     else if(IS_VEC(box))  naVec_set(box, checkVec(ctx, box, key), val);
  92     else                  ERR(ctx, "insert into non-container");
  93 }
  94
  95 static void initContext(struct Context* c)
  96 {
  97     int i;
  98     c->fTop = c->opTop = c->markTop = 0;
  99     for(i=0; i<NUM_NASAL_TYPES; i++)
 100         c->nfree[i] = 0;
 101     naVec_setsize(c->temps, 4);
 102     c->callParent = 0;
 103     c->callChild = 0;
 104     c->dieArg = naNil();
 105     c->error = 0;
 106 }
 107
 108 static void initGlobals()
 109 {
 110     globals = (struct Globals*)naAlloc(sizeof(struct Globals));
 111     naBZero(globals, sizeof(struct Globals));
 112
 113     globals->sem = naNewSem();
 114     globals->lock = naNewLock();
 115
 116     int i;
 117     globals->allocCount = 256; // reasonable starting value
 118     for(i=0; i<NUM_NASAL_TYPES; i++)
 119         naGC_init(&(globals->pools[i]), i);
 120     globals->deadsz = 256;
 121     globals->ndead = 0;
 122     globals->deadBlocks = naAlloc(sizeof(void*) * globals->deadsz);
 123
 124     // Initialize a single context
 125     globals->freeContexts = 0;
 126     globals->allContexts = 0;
 127     struct Context* c = naNewContext();
 128
 129     globals->symbols = naNewHash(c);
 130     globals->save = naNewVector(c);
 131
 132     // Cache pre-calculated "me", "arg" and "parents" scalars
 133     globals->meRef = naInternSymbol(naStr_fromdata(naNewString(c), "me", 2));
 134     globals->argRef = naInternSymbol(naStr_fromdata(naNewString(c), "arg", 3));
 135     globals->parentsRef = naInternSymbol(naStr_fromdata(naNewString(c), "parents", 7));
 136
 137     naFreeContext(c);
 138 }
 139
 140 struct Context* naNewContext()
 141 {
 142     int dummy;
 143     if(globals == 0)
 144         initGlobals();
 145
 146     LOCK();
 147     struct Context* c = globals->freeContexts;
 148     if(c) {
 149         globals->freeContexts = c->nextFree;
 150         c->nextFree = 0;
 151         UNLOCK();
 152         initContext(c);
 153     } else {
 154         UNLOCK();
 155         c = (struct Context*)naAlloc(sizeof(struct Context));
 156         // Chicken and egg, can't use naNew because it requires temps to exist
 157         c->temps = naObj(T_VEC, (naGC_get(&globals->pools[T_VEC], 1, &dummy))[0]);
 158         initContext(c);
 159         LOCK();
 160         c->nextAll = globals->allContexts;
 161         c->nextFree = 0;
 162         globals->allContexts = c;
 163         UNLOCK();
 164     }
 165     return c;
 166 }
 167
 168 void naFreeContext(struct Context* c)
 169 {
 170     naVec_setsize(c->temps, 0);
 171     LOCK();
 172     c->nextFree = globals->freeContexts;
 173     globals->freeContexts = c;
 174     UNLOCK();
 175 }
 176
 177 #define PUSH(r) do { \
 178     if(ctx->opTop >= MAX_STACK_DEPTH) ERR(ctx, "stack overflow"); \
 179     ctx->opStack[ctx->opTop++] = r; \
 180     } while(0)
 181
 182 struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
 183 {
 184     int i;
 185     naRef *frame;
 186     struct Frame* f;
 187     struct naCode* c;
 188
 189     DBG(printf("setupFuncall(nargs:%d, mcall:%d)\n", nargs, mcall);)
 190
 191     frame = &ctx->opStack[ctx->opTop - nargs - 1];
 192     if(!IS_FUNC(frame[0]))
 193         ERR(ctx, "function/method call invoked on uncallable object");
 194
 195     // Just do native calls right here, and don't touch the stack
 196     // frames; return the current one (unless it's a tail call!).
 197     if(frame[0].ref.ptr.func->code.ref.ptr.obj->type == T_CCODE) {
 198         naRef obj = mcall ? frame[-1] : naNil();
 199         naCFunction fp = frame[0].ref.ptr.func->code.ref.ptr.ccode->fptr;
 200         naRef result = (*fp)(ctx, obj, nargs, frame + 1);
 201         ctx->opTop -= nargs + 1 + mcall;
 202         PUSH(result);
 203         return &(ctx->fStack[ctx->fTop-1]);
 204     }
 205
 206     if(tail) ctx->fTop--;
 207     else if(ctx->fTop >= MAX_RECURSION) ERR(ctx, "call stack overflow");
 208
 209     // Note: assign nil first, otherwise the naNew() can cause a GC,
 210     // which will now (after fTop++) see the *old* reference as a
 211     // markable value!
 212     f = &(ctx->fStack[ctx->fTop++]);
 213     f->locals = f->func = naNil();
 214     f->locals = naNewHash(ctx);
 215     f->func = frame[0];
 216     f->ip = 0;
 217     f->bp = ctx->opTop - (nargs + 1 + mcall);
 218
 219     if(mcall)
 220         naHash_set(f->locals, globals->meRef, frame[-1]);
 221
 222     // Set the argument symbols, and put any remaining args in a vector
 223     c = (*frame++).ref.ptr.func->code.ref.ptr.code;
 224     if(nargs < c->nArgs) ERR(ctx, "not enough arguments to function call");
 225     for(i=0; i<c->nArgs; i++)
 226         naHash_newsym(f->locals.ref.ptr.hash,
 227                       &c->constants[c->argSyms[i]], &frame[i]);
 228     frame += c->nArgs;
 229     nargs -= c->nArgs;
 230     for(i=0; i<c->nOptArgs; i++, nargs--) {
 231         naRef val = nargs > 0 ? frame[i] : c->constants[c->optArgVals[i]];
 232         if(IS_CODE(val))
 233             val = bindFunction(ctx, &ctx->fStack[ctx->fTop-2], val);
 234         naHash_newsym(f->locals.ref.ptr.hash, &c->constants[c->optArgSyms[i]],
 235                       &val);
 236     }
 237     if(c->needArgVector || nargs > 0)
 238     {
 239         naRef args = naNewVector(ctx);
 240         naVec_setsize(args, nargs > 0 ? nargs : 0);
 241         for(i=0; i<nargs; i++)
 242             args.ref.ptr.vec->rec->array[i] = *frame++;
 243         naHash_newsym(f->locals.ref.ptr.hash, &c->restArgSym, &args);
 244     }
 245
 246     ctx->opTop = f->bp; // Pop the stack last, to avoid GC lossage
 247     DBG(printf("Entering frame %d with %d args\n", ctx->fTop-1, nargs);)
 248     return f;
 249 }
 250
 251 static naRef evalAndOr(struct Context* ctx, int op, naRef ra, naRef rb)
 252 {
 253     int a = boolify(ctx, ra);
 254     int b = boolify(ctx, rb);
 255     int result;
 256     if(op == OP_AND) result = a && b ? 1 : 0;
 257     else             result = a || b ? 1 : 0;
 258     return naNum(result);
 259 }
 260
 261 static naRef evalEquality(int op, naRef ra, naRef rb)
 262 {
 263     int result = naEqual(ra, rb);
 264     return naNum((op==OP_EQ) ? result : !result);
 265 }
 266
 267 // When a code object comes out of the constant pool and shows up on
 268 // the stack, it needs to be bound with the lexical context.
 269 static naRef bindFunction(struct Context* ctx, struct Frame* f, naRef code)
 270 {
 271     naRef result = naNewFunc(ctx, code);
 272     result.ref.ptr.func->namespace = f->locals;
 273     result.ref.ptr.func->next = f->func;
 274     return result;
 275 }
 276
 277 static int getClosure(struct naFunc* c, naRef sym, naRef* result)
 278 {
 279     while(c) {
 280         if(naHash_get(c->namespace, sym, result)) return 1;
 281         c = c->next.ref.ptr.func;
 282     }
 283     return 0;
 284 }
 285
 286 static naRef getLocal2(struct Context* ctx, struct Frame* f, naRef sym)
 287 {
 288     naRef result;
 289     if(!naHash_get(f->locals, sym, &result))
 290         if(!getClosure(f->func.ref.ptr.func, sym, &result))
 291             ERR(ctx, "undefined symbol");
 292     return result;
 293 }
 294
 295 static void getLocal(struct Context* ctx, struct Frame* f,
 296                      naRef* sym, naRef* out)
 297 {
 298     struct naFunc* func;
 299     struct naStr* str = sym->ref.ptr.str;
 300     if(naHash_sym(f->locals.ref.ptr.hash, str, out))
 301         return;
 302     func = f->func.ref.ptr.func;
 303     while(func && func->namespace.ref.ptr.hash) {
 304         if(naHash_sym(func->namespace.ref.ptr.hash, str, out))
 305             return;
 306         func = func->next.ref.ptr.func;
 307     }
 308     // Now do it again using the more general naHash_get().  This will
 309     // only be necessary if something has created the value in the
 310     // namespace using the more generic hash syntax
 311     // (e.g. namespace["symbol"] and not namespace.symbol).
 312     *out = getLocal2(ctx, f, *sym);
 313 }
 314
 315 static int setClosure(naRef func, naRef sym, naRef val)
 316 {
 317     struct naFunc* c = func.ref.ptr.func;
 318     if(c == 0) { return 0; }
 319     else if(naHash_tryset(c->namespace, sym, val)) { return 1; }
 320     else { return setClosure(c->next, sym, val); }
 321 }
 322
 323 static naRef setSymbol(struct Frame* f, naRef sym, naRef val)
 324 {
 325     // Try the locals first, if not already there try the closures in
 326     // order.  Finally put it in the locals if nothing matched.
 327     if(!naHash_tryset(f->locals, sym, val))
 328         if(!setClosure(f->func, sym, val))
 329             naHash_set(f->locals, sym, val);
 330     return val;
 331 }
 332
 333 // Recursively descend into the parents lists
 334 static int getMember(struct Context* ctx, naRef obj, naRef fld,
 335                      naRef* result, int count)
 336 {
 337     naRef p;
 338     if(--count < 0) ERR(ctx, "too many parents");
 339     if(!IS_HASH(obj)) ERR(ctx, "non-objects have no members");
 340     if(naHash_get(obj, fld, result)) {
 341         return 1;
 342     } else if(naHash_get(obj, globals->parentsRef, &p)) {
 343         if(IS_VEC(p)) {
 344             int i;
 345             struct VecRec* v = p.ref.ptr.vec->rec;
 346             for(i=0; i<v->size; i++)
 347                 if(getMember(ctx, v->array[i], fld, result, count))
 348                     return 1;
 349         } else
 350             ERR(ctx, "parents field not vector");
 351     }
 352     return 0;
 353 }
 354
 355 // OP_EACH works like a vector get, except that it leaves the vector
 356 // and index on the stack, increments the index after use, and pops
 357 // the arguments and pushes a nil if the index is beyond the end.
 358 static void evalEach(struct Context* ctx)
 359 {
 360     int idx = (int)(ctx->opStack[ctx->opTop-1].num);
 361     naRef vec = ctx->opStack[ctx->opTop-2];
 362     if(!IS_VEC(vec)) naRuntimeError(ctx, "foreach enumeration of non-vector");
 363     if(!vec.ref.ptr.vec->rec || idx >= vec.ref.ptr.vec->rec->size) {
 364         ctx->opTop -= 2; // pop two values
 365         PUSH(naNil());
 366         return;
 367     }
 368     ctx->opStack[ctx->opTop-1].num = idx+1; // modify in place
 369     PUSH(naVec_get(vec, idx));
 370 }
 371
 372 #define ARG() cd->byteCode[f->ip++]
 373 #define CONSTARG() cd->constants[ARG()]
 374 #define POP() ctx->opStack[--ctx->opTop]
 375 #define STK(n) (ctx->opStack[ctx->opTop-(n)])
 376 #define FIXFRAME() f = &(ctx->fStack[ctx->fTop-1]); \
 377                    cd = f->func.ref.ptr.func->code.ref.ptr.code;
 378 static naRef run(struct Context* ctx)
 379 {
 380     struct Frame* f;
 381     struct naCode* cd;
 382     int op, arg;
 383     naRef a, b, c;
 384
 385     FIXFRAME();
 386
 387     while(1) {
 388         op = cd->byteCode[f->ip++];
 389         DBG(printf("Stack Depth: %d\n", ctx->opTop));
 390         DBG(printOpDEBUG(f->ip-1, op));
 391         switch(op) {
 392         case OP_POP:
 393             ctx->opTop--;
 394             break;
 395         case OP_DUP:
 396             PUSH(ctx->opStack[ctx->opTop-1]);
 397             break;
 398         case OP_XCHG:
 399             a = STK(1); STK(1) = STK(2); STK(2) = a;
 400             break;
 401
 402 #define BINOP(expr) do { \
 403     double l = IS_NUM(STK(2)) ? STK(2).num : numify(ctx, STK(2)); \
 404     double r = IS_NUM(STK(1)) ? STK(1).num : numify(ctx, STK(1)); \
 405     STK(2).ref.reftag = ~NASAL_REFTAG; \
 406     STK(2).num = expr; \
 407     ctx->opTop--; } while(0)
 408
 409         case OP_PLUS:  BINOP(l + r);         break;
 410         case OP_MINUS: BINOP(l - r);         break;
 411         case OP_MUL:   BINOP(l * r);         break;
 412         case OP_DIV:   BINOP(l / r);         break;
 413         case OP_LT:    BINOP(l <  r ? 1 : 0); break;
 414         case OP_LTE:   BINOP(l <= r ? 1 : 0); break;
 415         case OP_GT:    BINOP(l >  r ? 1 : 0); break;
 416         case OP_GTE:   BINOP(l >= r ? 1 : 0); break;
 417
 418 #undef BINOP
 419
 420         case OP_EQ: case OP_NEQ:
 421             STK(2) = evalEquality(op, STK(2), STK(1));
 422             ctx->opTop--;
 423             break;
 424         case OP_AND: case OP_OR:
 425             STK(2) = evalAndOr(ctx, op, STK(2), STK(1));
 426             ctx->opTop--;
 427             break;
 428         case OP_CAT:
 429             // stringify can call the GC, so don't take stuff of the stack!
 430             a = stringify(ctx, ctx->opStack[ctx->opTop-1]);
 431             b = stringify(ctx, ctx->opStack[ctx->opTop-2]);
 432             c = naStr_concat(naNewString(ctx), b, a);
 433             ctx->opTop -= 2;
 434             PUSH(c);
 435             break;
 436         case OP_NEG:
 437             STK(1) = naNum(-numify(ctx, STK(1)));
 438             break;
 439         case OP_NOT:
 440             STK(1) = naNum(boolify(ctx, STK(1)) ? 0 : 1);
 441             break;
 442         case OP_PUSHCONST:
 443             a = CONSTARG();
 444             if(IS_CODE(a)) a = bindFunction(ctx, f, a);
 445             PUSH(a);
 446             break;
 447         case OP_PUSHONE:
 448             PUSH(naNum(1));
 449             break;
 450         case OP_PUSHZERO:
 451             PUSH(naNum(0));
 452             break;
 453         case OP_PUSHNIL:
 454             PUSH(naNil());
 455             break;
 456         case OP_NEWVEC:
 457             PUSH(naNewVector(ctx));
 458             break;
 459         case OP_VAPPEND:
 460             naVec_append(STK(2), STK(1));
 461             ctx->opTop--;
 462             break;
 463         case OP_NEWHASH:
 464             PUSH(naNewHash(ctx));
 465             break;
 466         case OP_HAPPEND:
 467             naHash_set(STK(3), STK(2), STK(1));
 468             ctx->opTop -= 2;
 469             break;
 470         case OP_LOCAL:
 471             a = CONSTARG();
 472             getLocal(ctx, f, &a, &b);
 473             PUSH(b);
 474             break;
 475         case OP_SETSYM:
 476             STK(2) = setSymbol(f, STK(2), STK(1));
 477             ctx->opTop--;
 478             break;
 479         case OP_SETLOCAL:
 480             naHash_set(f->locals, STK(2), STK(1));
 481             STK(2) = STK(1); // FIXME: reverse order of arguments instead!
 482             ctx->opTop--;
 483             break;
 484         case OP_MEMBER:
 485             if(!getMember(ctx, STK(1), CONSTARG(), &STK(1), 64))
 486                 ERR(ctx, "no such member");
 487             break;
 488         case OP_SETMEMBER:
 489             if(!IS_HASH(STK(3))) ERR(ctx, "non-objects have no members");
 490             naHash_set(STK(3), STK(2), STK(1));
 491             STK(3) = STK(1); // FIXME: fix arg order instead
 492             ctx->opTop -= 2;
 493             break;
 494         case OP_INSERT:
 495             containerSet(ctx, STK(3), STK(2), STK(1));
 496             STK(3) = STK(1); // FIXME: codegen order again...
 497             ctx->opTop -= 2;
 498             break;
 499         case OP_EXTRACT:
 500             STK(2) = containerGet(ctx, STK(2), STK(1));
 501             ctx->opTop--;
 502             break;
 503         case OP_JMPLOOP:
 504             // Identical to JMP, except for locking
 505             naCheckBottleneck();
 506             f->ip = cd->byteCode[f->ip];
 507             DBG(printf("   [Jump to: %d]\n", f->ip);)
 508             break;
 509         case OP_JMP:
 510             f->ip = cd->byteCode[f->ip];
 511             DBG(printf("   [Jump to: %d]\n", f->ip);)
 512             break;
 513         case OP_JIFNIL:
 514             arg = ARG();
 515             if(IS_NIL(STK(1))) {
 516                 ctx->opTop--; // Pops **ONLY** if it's nil!
 517                 f->ip = arg;
 518                 DBG(printf("   [Jump to: %d]\n", f->ip);)
 519             }
 520             break;
 521         case OP_JIFNOT:
 522             arg = ARG();
 523             if(!boolify(ctx, POP())) {
 524                 f->ip = arg;
 525                 DBG(printf("   [Jump to: %d]\n", f->ip);)
 526             }
 527             break;
 528         case OP_FCALL:
 529             f = setupFuncall(ctx, ARG(), 0, 0);
 530             cd = f->func.ref.ptr.func->code.ref.ptr.code;
 531             break;
 532         case OP_FTAIL:
 533             f = setupFuncall(ctx, ARG(), 0, 1);
 534             cd = f->func.ref.ptr.func->code.ref.ptr.code;
 535             break;
 536         case OP_MCALL:
 537             f = setupFuncall(ctx, ARG(), 1, 0);
 538             cd = f->func.ref.ptr.func->code.ref.ptr.code;
 539             break;
 540         case OP_MTAIL:
 541             f = setupFuncall(ctx, ARG(), 1, 1);
 542             cd = f->func.ref.ptr.func->code.ref.ptr.code;
 543             break;
 544         case OP_RETURN:
 545             a = STK(1);
 546             if(--ctx->fTop <= 0) return a;
 547             ctx->opTop = f->bp + 1; // restore the correct opstack frame!
 548             STK(1) = a;
 549             FIXFRAME();
 550             break;
 551         case OP_EACH:
 552             evalEach(ctx);
 553             break;
 554         case OP_MARK: // save stack state (e.g. "setjmp")
 555             if(ctx->markTop >= MAX_MARK_DEPTH)
 556                 naRuntimeError(ctx, "mark stack overflow");
 557             ctx->markStack[ctx->markTop++] = ctx->opTop;
 558             break;
 559         case OP_UNMARK: // pop stack state set by mark
 560             ctx->markTop--;
 561             break;
 562         case OP_BREAK: // restore stack state (FOLLOW WITH JMP!)
 563             ctx->opTop = ctx->markStack[--ctx->markTop];
 564             break;
 565         default:
 566             ERR(ctx, "BUG: bad opcode");
 567         }
 568         ctx->temps.ref.ptr.vec->rec->size = 0; // reset GC temp vector
 569         DBG(printStackDEBUG(ctx);)
 570     }
 571     return naNil(); // unreachable
 572 }
 573 #undef POP
 574 #undef CONSTARG
 575 #undef STK
 576 #undef FIXFRAME
 577
 578 void naSave(struct Context* ctx, naRef obj)
 579 {
 580     naVec_append(globals->save, obj);
 581 }
 582
 583 // FIXME: handle ctx->callParent
 584 int naStackDepth(struct Context* ctx)
 585 {
 586     return ctx->fTop;
 587 }
 588
 589 // FIXME: handle ctx->callParent
 590 int naGetLine(struct Context* ctx, int frame)
 591 {
 592     struct Frame* f = &ctx->fStack[ctx->fTop-1-frame];
 593     naRef func = f->func;
 594     int ip = f->ip;
 595     if(IS_FUNC(func) && IS_CODE(func.ref.ptr.func->code)) {
 596         struct naCode* c = func.ref.ptr.func->code.ref.ptr.code;
 597         unsigned short* p = c->lineIps + c->nLines - 2;
 598         while(p >= c->lineIps && p[0] > ip)
 599             p -= 2;
 600         return p[1];
 601     }
 602     return -1;
 603 }
 604
 605 // FIXME: handle ctx->callParent
 606 naRef naGetSourceFile(struct Context* ctx, int frame)
 607 {
 608     naRef f = ctx->fStack[ctx->fTop-1-frame].func;
 609     f = f.ref.ptr.func->code;
 610     return f.ref.ptr.code->srcFile;
 611 }
 612
 613 char* naGetError(struct Context* ctx)
 614 {
 615     if(IS_STR(ctx->dieArg))
 616         return ctx->dieArg.ref.ptr.str->data;
 617     return ctx->error;
 618 }
 619
 620 naRef naBindFunction(naContext ctx, naRef code, naRef closure)
 621 {
 622     naRef func = naNewFunc(ctx, code);
 623     func.ref.ptr.func->namespace = closure;
 624     func.ref.ptr.func->next = naNil();
 625     return func;
 626 }
 627
 628 naRef naBindToContext(naContext ctx, naRef code)
 629 {
 630     naRef func = naNewFunc(ctx, code);
 631     struct Frame* f = &ctx->fStack[ctx->fTop-1];
 632     func.ref.ptr.func->namespace = f->locals;
 633     func.ref.ptr.func->next = f->func;
 634     return func;
 635 }
 636
 637 naRef naCall(naContext ctx, naRef func, naRef args, naRef obj, naRef locals)
 638 {
 639     naRef result;
 640     if(!ctx->callParent) naModLock(ctx);
 641
 642     // We might have to allocate objects, which can call the GC.  But
 643     // the call isn't on the Nasal stack yet, so the GC won't find our
 644     // C-space arguments.
 645     naVec_append(ctx->temps, func);
 646     naVec_append(ctx->temps, args);
 647     naVec_append(ctx->temps, obj);
 648     naVec_append(ctx->temps, locals);
 649
 650     if(IS_NIL(locals))
 651         locals = naNewHash(ctx);
 652     if(!IS_FUNC(func))
 653         func = naNewFunc(ctx, func); // bind bare code objects
 654
 655     if(!IS_NIL(args))
 656         naHash_set(locals, globals->argRef, args);
 657     if(!IS_NIL(obj))
 658         naHash_set(locals, globals->meRef, obj);
 659
 660     ctx->dieArg = naNil();
 661
 662     ctx->opTop = ctx->markTop = 0;
 663     ctx->fTop = 1;
 664     ctx->fStack[0].func = func;
 665     ctx->fStack[0].locals = locals;
 666     ctx->fStack[0].ip = 0;
 667     ctx->fStack[0].bp = ctx->opTop;
 668
 669     // Return early if an error occurred.  It will be visible to the
 670     // caller via naGetError().
 671     ctx->error = 0;
 672     if(setjmp(ctx->jumpHandle))
 673         return naNil();
 674
 675     if(IS_CCODE(func.ref.ptr.func->code)) {
 676         naCFunction fp = func.ref.ptr.func->code.ref.ptr.ccode->fptr;
 677         struct naVec* av = args.ref.ptr.vec;
 678         result = (*fp)(ctx, obj, av->rec->size, av->rec->array);
 679     } else
 680         result = run(ctx);
 681     if(!ctx->callParent) naModUnlock(ctx);
 682     return result;
 683 }
 684