+static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
+{
+ int errLine;
+ naRef script, code, fname;
+ script = argc > 0 ? args[0] : naNil();
+ if(!naIsString(script)) return naNil();
+ fname = NEWCSTR(c, "<compile>");
+ code = naParseCode(c, fname, 1,
+ naStr_data(script), naStr_len(script), &errLine);
+ if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
+ return naBindToContext(c, code);
+}
+
+static naRef f_call(naContext c, naRef me, int argc, naRef* args)
+{
+ naContext subc;
+ naRef callargs, callme, callns, result;
+ struct VecRec* vr;
+ callargs = argc > 1 ? args[1] : naNil();
+ callme = argc > 2 ? args[2] : naNil(); // Might be nil, that's OK
+ callns = argc > 3 ? args[3] : naNil(); // ditto
+ if(!IS_HASH(callme)) callme = naNil();
+ if(!IS_HASH(callns)) callns = naNil();
+ if(!IS_FUNC(args[0]) || (!IS_NIL(callargs) && !IS_VEC(callargs)))
+ naRuntimeError(c, "bad argument to call()");
+ subc = naNewContext();
+ subc->callParent = c;
+ c->callChild = subc;
+ vr = IS_NIL(callargs) ? 0 : callargs.ref.ptr.vec->rec;
+ result = naCall(subc, args[0], vr ? vr->size : 0, vr ? vr->array : 0,
+ callme, callns);
+ c->callChild = 0;
+ if(argc > 2 && IS_VEC(args[argc-1])) {
+ if(!IS_NIL(subc->dieArg)) naVec_append(args[argc-1], subc->dieArg);
+ else if(naGetError(subc))
+ naVec_append(args[argc-1], NEWCSTR(subc, naGetError(subc)));
+ }
+ naFreeContext(subc);
+ return result;
+}
+
+static naRef f_die(naContext c, naRef me, int argc, naRef* args)
+{
+ c->dieArg = argc > 0 ? args[0] : naNil();
+ naRuntimeError(c, "__die__");
+ return naNil(); // never executes
+}
+
+// Wrapper around vsnprintf, iteratively increasing the buffer size
+// until it fits. Returned buffer should be freed by the caller.
+char* dosprintf(char* f, ...)
+{
+ char* buf;
+ va_list va;
+ int len = 16;
+ while(1) {
+ buf = naAlloc(len);
+ va_start(va, f);
+ if(vsnprintf(buf, len, f, va) < len) {
+ va_end(va);
+ return buf;
+ }
+ va_end(va);
+ naFree(buf);
+ len *= 2;
+ }
+}
+
+// Inspects a printf format string f, and finds the next "%..." format
+// specifier. Stores the start of the specifier in out, the length in
+// len, and the type in type. Returns a pointer to the remainder of
+// the format string, or 0 if no format string was found. Recognizes
+// all of ANSI C's syntax except for the "length modifier" feature.
+// Note: this does not validate the format character returned in
+// "type". That is the caller's job.
+static char* nextFormat(naContext ctx, char* f, char** out, int* len, char* type)
+{
+ // Skip to the start of the format string
+ while(*f && *f != '%') f++;
+ if(!*f) return 0;
+ *out = f++;
+
+ while(*f && (*f=='-' || *f=='+' || *f==' ' || *f=='0' || *f=='#')) f++;
+
+ // Test for duplicate flags. This is pure pedantry and could
+ // be removed on all known platforms, but just to be safe...
+ { char *p1, *p2;
+ for(p1 = *out + 1; p1 < f; p1++)
+ for(p2 = p1+1; p2 < f; p2++)
+ if(*p1 == *p2)
+ naRuntimeError(ctx, "duplicate flag in format string"); }
+
+ while(*f && *f >= '0' && *f <= '9') f++;
+ if(*f && *f == '.') f++;
+ while(*f && *f >= '0' && *f <= '9') f++;
+ if(!*f) naRuntimeError(ctx, "invalid format string");
+
+ *type = *f++;
+ *len = f - *out;
+ return f;
+}
+
+#define ERR(m) naRuntimeError(ctx, m)
+#define APPEND(r) result = naStr_concat(naNewString(ctx), result, r)
+static naRef f_sprintf(naContext ctx, naRef me, int argc, naRef* args)
+{
+ char t, nultmp, *fstr, *next, *fout=0, *s;
+ int flen, argn=1;
+ naRef format, arg, result = naNewString(ctx);
+
+ if(argc < 1) ERR("not enough arguments to sprintf");
+ format = naStringValue(ctx, argc > 0 ? args[0] : naNil());
+ if(naIsNil(format)) ERR("bad format string in sprintf");
+ s = naStr_data(format);
+
+ while((next = nextFormat(ctx, s, &fstr, &flen, &t))) {
+ APPEND(NEWSTR(ctx, s, fstr-s)); // stuff before the format string
+ if(flen == 2 && fstr[1] == '%') {
+ APPEND(NEWSTR(ctx, "%", 1));
+ s = next;
+ continue;
+ }
+ if(argn >= argc) ERR("not enough arguments to sprintf");
+ arg = args[argn++];
+ nultmp = fstr[flen]; // sneaky nul termination...
+ fstr[flen] = 0;
+ if(t == 's') {
+ arg = naStringValue(ctx, arg);
+ if(naIsNil(arg)) fout = dosprintf(fstr, "nil");
+ else fout = dosprintf(fstr, naStr_data(arg));
+ } else {
+ arg = naNumValue(arg);
+ if(naIsNil(arg))
+ fout = dosprintf(fstr, "nil");
+ else if(t=='d' || t=='i' || t=='c')
+ fout = dosprintf(fstr, (int)naNumValue(arg).num);
+ else if(t=='o' || t=='u' || t=='x' || t=='X')
+ fout = dosprintf(fstr, (unsigned int)naNumValue(arg).num);
+ else if(t=='e' || t=='E' || t=='f' || t=='F' || t=='g' || t=='G')
+ fout = dosprintf(fstr, naNumValue(arg).num);
+ else
+ ERR("invalid sprintf format type");
+ }
+ fstr[flen] = nultmp;
+ APPEND(NEWSTR(ctx, fout, strlen(fout)));
+ naFree(fout);
+ s = next;
+ }
+ APPEND(NEWSTR(ctx, s, strlen(s)));
+ return result;
+}
+
+// FIXME: handle ctx->callParent frames too!
+static naRef f_caller(naContext ctx, naRef me, int argc, naRef* args)
+{
+ int fidx;
+ struct Frame* frame;
+ naRef result, fr = argc ? naNumValue(args[0]) : naNum(1);
+ if(IS_NIL(fr)) naRuntimeError(ctx, "non numeric argument to caller()");
+ fidx = (int)fr.num;
+ if(fidx > ctx->fTop - 1) return naNil();
+ frame = &ctx->fStack[ctx->fTop - 1 - fidx];
+ result = naNewVector(ctx);
+ naVec_append(result, frame->locals);
+ naVec_append(result, frame->func);
+ naVec_append(result, frame->func.ref.ptr.func->code.ref.ptr.code->srcFile);
+ naVec_append(result, naNum(naGetLine(ctx, fidx)));
+ return result;
+}
+
+static naRef f_closure(naContext ctx, naRef me, int argc, naRef* args)
+{
+ int i;
+ naRef func, idx;
+ struct naFunc* f;
+ func = argc > 0 ? args[0] : naNil();
+ idx = argc > 1 ? naNumValue(args[1]) : naNil();
+ if(!IS_FUNC(func) || IS_NIL(idx))
+ naRuntimeError(ctx, "bad arguments to closure()");
+ i = (int)idx.num;
+ f = func.ref.ptr.func;
+ while(i > 0 && f) { i--; f = f->next.ref.ptr.func; }
+ if(!f) return naNil();
+ return f->namespace;
+}
+
+static int match(unsigned char* a, unsigned char* b, int l)
+{
+ int i;
+ for(i=0; i<l; i++) if(a[i] != b[i]) return 0;
+ return 1;
+}
+
+static int find(unsigned char* a, int al, unsigned char* s, int sl, int start)
+{
+ int i;
+ if(al == 0) return 0;
+ for(i=start; i<sl-al+1; i++) if(match(a, s+i, al)) return i;
+ return -1;
+}
+
+static naRef f_find(naContext ctx, naRef me, int argc, naRef* args)
+{
+ int start = 0;
+ if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
+ naRuntimeError(ctx, "bad/missing argument to find");
+ if(argc > 2) start = (int)(naNumValue(args[2]).num);
+ return naNum(find(args[0].ref.ptr.str->data, args[0].ref.ptr.str->len,
+ args[1].ref.ptr.str->data, args[1].ref.ptr.str->len,
+ start));
+}
+
+static naRef f_split(naContext ctx, naRef me, int argc, naRef* args)
+{
+ int sl, dl, i;
+ char *s, *d, *s0;
+ naRef result;
+ if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
+ naRuntimeError(ctx, "bad/missing argument to split");
+ d = naStr_data(args[0]); dl = naStr_len(args[0]);
+ s = naStr_data(args[1]); sl = naStr_len(args[1]);
+ result = naNewVector(ctx);
+ if(dl == 0) { // special case zero-length delimiter
+ for(i=0; i<sl; i++) naVec_append(result, NEWSTR(ctx, s+i, 1));
+ return result;
+ }
+ s0 = s;
+ for(i=0; i <= sl-dl; i++) {
+ if(match((unsigned char*)(s+i), (unsigned char*)d, dl)) {
+ naVec_append(result, NEWSTR(ctx, s0, s+i-s0));
+ s0 = s + i + dl;
+ i += dl - 1;
+ }
+ }
+ if(s0 - s <= sl) naVec_append(result, NEWSTR(ctx, s0, s+sl-s0));
+ return result;
+}
+
+// This is a comparatively weak RNG, based on the C library's rand()
+// function, which is usually not threadsafe and often of limited
+// precision. The 5x loop guarantees that we get a full double worth
+// of precision even for 15 bit (Win32...) rand() implementations.
+static naRef f_rand(naContext ctx, naRef me, int argc, naRef* args)
+{
+ int i;
+ double r = 0;
+ if(argc) {
+ if(!IS_NUM(args[0])) naRuntimeError(ctx, "rand() seed not number");
+ srand((unsigned int)args[0].num);
+ return naNil();
+ }
+ for(i=0; i<5; i++) r = (r + rand()) * (1.0/(RAND_MAX+1.0));
+ return naNum(r);
+}
+
+static naRef f_bind(naContext ctx, naRef me, int argc, naRef* args)
+{
+ naRef func = argc > 0 ? args[0] : naNil();
+ naRef hash = argc > 1 ? args[1] : naNewHash(ctx);
+ naRef next = argc > 2 ? args[2] : naNil();
+ if(!IS_FUNC(func) || (!IS_NIL(next) && !IS_FUNC(next)) || !IS_HASH(hash))
+ naRuntimeError(ctx, "bad argument to bind");
+ func = naNewFunc(ctx, func.ref.ptr.func->code);
+ func.ref.ptr.func->namespace = hash;
+ func.ref.ptr.func->next = next;
+ return func;
+}
+