lib_LIBRARIES = libsgnasal.a
-include_HEADERS = nasal.h
+include_HEADERS = nasal.h naref.h
-libsgnasal_a_SOURCES = \
- code.c code.h \
- codegen.c \
- data.h \
- gc.c \
- hash.c \
- lex.c \
- lib.c \
- mathlib.c \
- iolib.c \
- iolib.h \
- bitslib.c \
- misc.c \
- nasal.h \
- parse.c parse.h \
- string.c \
- vector.c \
- thread-posix.c \
- thread-win32.c
+libsgnasal_a_SOURCES = bitslib.c code.c code.h codegen.c data.h gc.c \
+ hash.c iolib.c iolib.h lex.c lib.c mathlib.c \
+ misc.c naref.h nasal.h parse.c parse.h string.c \
+ thread-posix.c thread-win32.c threadlib.c \
+ utf8lib.c vector.c
INCLUDES = -I$(top_srcdir)
// bits (i.e. an unsigned int). Using a 64 bit integer would stretch
// that beyond what is representable in the double result, but
// requires portability work.
-
-#define BIT(s,l,n) s[l-1-((n)>>3)] & (1<<((n)&7))
-#define CLRB(s,l,n) s[l-1-((n)>>3)] &= ~(1<<((n)&7))
-#define SETB(s,l,n) s[l-1-((n)>>3)] |= 1<<((n)&7)
+#define MSK(n) (1 << (7 - ((n) & 7)))
+#define BIT(s,l,n) s[(n)>>3] & MSK(n)
+#define CLRB(s,l,n) s[(n)>>3] &= ~MSK(n)
+#define SETB(s,l,n) s[(n)>>3] |= MSK(n)
static unsigned int fld(naContext c, unsigned char* s,
int slen, int bit, int flen)
static naRef dofld(naContext c, int argc, naRef* args, int sign)
{
- struct naStr* s = argc > 0 ? args[0].ref.ptr.str : 0;
+ struct naStr* s = argc > 0 ? PTR(args[0]).str : 0;
int bit = argc > 1 ? (int)naNumValue(args[1]).num : -1;
int len = argc > 2 ? (int)naNumValue(args[2]).num : -1;
unsigned int f;
static naRef f_setfld(naContext c, naRef me, int argc, naRef* args)
{
- struct naStr* s = argc > 0 ? args[0].ref.ptr.str : 0;
+ struct naStr* s = argc > 0 ? PTR(args[0]).str : 0;
int bit = argc > 1 ? (int)naNumValue(args[1]).num : -1;
int len = argc > 2 ? (int)naNumValue(args[2]).num : -1;
naRef val = argc > 3 ? naNumValue(args[3]) : naNil();
return naStr_buf(naNewString(c), (int)len.num);
}
-static struct func { char* name; naCFunction func; } funcs[] = {
+static naCFuncItem funcs[] = {
{ "sfld", f_sfld },
{ "fld", f_fld },
{ "setfld", f_setfld },
{ "buf", f_buf },
+ { 0 }
};
-naRef naBitsLib(naContext c)
+naRef naInit_bits(naContext c)
{
- naRef namespace = naNewHash(c);
- int i, n = sizeof(funcs)/sizeof(struct func);
- for(i=0; i<n; i++) {
- naRef code = naNewCCode(c, funcs[i].func);
- naRef name = naStr_fromdata(naNewString(c),
- funcs[i].name, strlen(funcs[i].name));
- naHash_set(namespace, name, naNewFunc(c, code));
- }
- return namespace;
+ return naGenLib(c, funcs);
}
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
#include "nasal.h"
#include "code.h"
////////////////////////////////////////////////////////////////////////
// Debugging stuff. ////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
-//#define DEBUG_NASAL
-#if !defined(DEBUG_NASAL)
+//#define INTERPRETER_DUMP
+#if !defined(INTERPRETER_DUMP)
# define DBG(expr) /* noop */
#else
# define DBG(expr) expr
void printStackDEBUG(struct Context* ctx);
////////////////////////////////////////////////////////////////////////
+#ifdef _MSC_VER
+#define vsnprintf _vsnprintf
+#endif
+
struct Globals* globals = 0;
static naRef bindFunction(struct Context* ctx, struct Frame* f, naRef code);
#define ERR(c, msg) naRuntimeError((c),(msg))
-void naRuntimeError(struct Context* c, char* msg)
-{
- c->error = msg;
+void naRuntimeError(struct Context* c, const char* fmt, ...)
+{
+ va_list ap;
+ va_start(ap, fmt);
+ vsnprintf(c->error, sizeof(c->error), fmt, ap);
+ va_end(ap);
longjmp(c->jumpHandle, 1);
}
+void naRethrowError(naContext subc)
+{
+ strncpy(subc->callParent->error, subc->error, sizeof(subc->error));
+ subc->callParent->dieArg = subc->dieArg;
+ longjmp(subc->callParent->jumpHandle, 1);
+}
+
+#define END_PTR ((void*)1)
+#define IS_END(r) (IS_REF((r)) && PTR((r)).obj == END_PTR)
+static naRef endToken()
+{
+ naRef r;
+ SETPTR(r, END_PTR);
+ return r;
+}
+
static int boolify(struct Context* ctx, naRef r)
{
if(IS_NUM(r)) return r.num != 0;
- if(IS_NIL(r)) return 0;
+ if(IS_NIL(r) || IS_END(r)) return 0;
if(IS_STR(r)) {
double d;
if(naStr_len(r) == 0) return 0;
{
int i = (int)numify(ctx, idx);
if(i < 0) i += naVec_size(vec);
- if(i < 0 || i >= naVec_size(vec)) ERR(ctx, "vector index out of bounds");
+ if(i < 0 || i >= naVec_size(vec))
+ naRuntimeError(ctx, "vector index %d out of bounds (size: %d)",
+ i, naVec_size(vec));
return i;
}
{
int i = (int)numify(ctx, idx);
if(i < 0) i += naStr_len(str);
- if(i < 0 || i >= naStr_len(str)) ERR(ctx, "string index out of bounds");
+ if(i < 0 || i >= naStr_len(str))
+ naRuntimeError(ctx, "string index %d out of bounds (size: %d)",
+ i, naStr_len(str));
return i;
}
naRef result = naNil();
if(!IS_SCALAR(key)) ERR(ctx, "container index not scalar");
if(IS_HASH(box)) {
- if(!naHash_get(box, key, &result))
- ERR(ctx, "undefined value in container");
+ naHash_get(box, key, &result);
} else if(IS_VEC(box)) {
result = naVec_get(box, checkVec(ctx, box, key));
} else if(IS_STR(box)) {
else if(IS_HASH(box)) naHash_set(box, key, val);
else if(IS_VEC(box)) naVec_set(box, checkVec(ctx, box, key), val);
else if(IS_STR(box)) {
- if(box.ref.ptr.str->hashcode)
+ if(PTR(box).str->hashcode)
ERR(ctx, "cannot change immutable string");
naStr_data(box)[checkStr(ctx, box, key)] = (char)numify(ctx, val);
} else ERR(ctx, "insert into non-container");
c->callParent = 0;
c->callChild = 0;
c->dieArg = naNil();
- c->error = 0;
+ c->error[0] = 0;
+ c->userData = 0;
}
static void initGlobals()
return c;
}
+struct Context* naSubContext(struct Context* super)
+{
+ struct Context* ctx = naNewContext();
+ if(super->callChild) naFreeContext(super->callChild);
+ ctx->callParent = super;
+ super->callChild = ctx;
+ return ctx;
+}
+
void naFreeContext(struct Context* c)
{
c->ntemps = 0;
+ if(c->callChild) naFreeContext(c->callChild);
+ if(c->callParent) c->callParent->callChild = 0;
LOCK();
c->nextFree = globals->freeContexts;
globals->freeContexts = c;
static void setupArgs(naContext ctx, struct Frame* f, naRef* args, int nargs)
{
int i;
- struct naCode* c = f->func.ref.ptr.func->code.ref.ptr.code;
+ struct naCode* c = PTR(PTR(f->func).func->code).code;
// Set the argument symbols, and put any remaining args in a vector
- if(nargs < c->nArgs) ERR(ctx, "not enough arguments to function call");
+ if(nargs < c->nArgs)
+ naRuntimeError(ctx, "too few function args (have %d need %d)",
+ nargs, c->nArgs);
for(i=0; i<c->nArgs; i++)
- naHash_newsym(f->locals.ref.ptr.hash,
+ naHash_newsym(PTR(f->locals).hash,
&c->constants[c->argSyms[i]], &args[i]);
args += c->nArgs;
nargs -= c->nArgs;
naRef val = nargs > 0 ? args[i] : c->constants[c->optArgVals[i]];
if(IS_CODE(val))
val = bindFunction(ctx, &ctx->fStack[ctx->fTop-2], val);
- naHash_newsym(f->locals.ref.ptr.hash, &c->constants[c->optArgSyms[i]],
+ naHash_newsym(PTR(f->locals).hash, &c->constants[c->optArgSyms[i]],
&val);
}
args += c->nOptArgs;
naRef argsv = naNewVector(ctx);
naVec_setsize(argsv, nargs > 0 ? nargs : 0);
for(i=0; i<nargs; i++)
- argsv.ref.ptr.vec->rec->array[i] = *args++;
- naHash_newsym(f->locals.ref.ptr.hash, &c->restArgSym, &argsv);
+ PTR(argsv).vec->rec->array[i] = *args++;
+ naHash_newsym(PTR(f->locals).hash, &c->restArgSym, &argsv);
}
}
-struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
+static struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall)
{
naRef *frame;
struct Frame* f;
if(!IS_FUNC(frame[0]))
ERR(ctx, "function/method call invoked on uncallable object");
- // Just do native calls right here, and don't touch the stack
- // frames; return the current one (unless it's a tail call!).
- if(frame[0].ref.ptr.func->code.ref.ptr.obj->type == T_CCODE) {
+ ctx->opFrame = ctx->opTop - (nargs + 1 + mcall);
+
+ // Just do native calls right here
+ if(PTR(PTR(frame[0]).func->code).obj->type == T_CCODE) {
naRef obj = mcall ? frame[-1] : naNil();
- naCFunction fp = frame[0].ref.ptr.func->code.ref.ptr.ccode->fptr;
+ naCFunction fp = PTR(PTR(frame[0]).func->code).ccode->fptr;
naRef result = (*fp)(ctx, obj, nargs, frame + 1);
- ctx->opTop -= nargs + 1 + mcall;
+ ctx->opTop = ctx->opFrame;
PUSH(result);
return &(ctx->fStack[ctx->fTop-1]);
}
- if(tail) ctx->fTop--;
- else if(ctx->fTop >= MAX_RECURSION) ERR(ctx, "call stack overflow");
-
+ if(ctx->fTop >= MAX_RECURSION) ERR(ctx, "call stack overflow");
+
// Note: assign nil first, otherwise the naNew() can cause a GC,
// which will now (after fTop++) see the *old* reference as a
// markable value!
f->locals = naNewHash(ctx);
f->func = frame[0];
f->ip = 0;
- f->bp = ctx->opTop - (nargs + 1 + mcall);
+ f->bp = ctx->opFrame;
if(mcall)
naHash_set(f->locals, globals->meRef, frame[-1]);
return f;
}
-static naRef evalAndOr(struct Context* ctx, int op, naRef ra, naRef rb)
-{
- int a = boolify(ctx, ra);
- int b = boolify(ctx, rb);
- int result;
- if(op == OP_AND) result = a && b ? 1 : 0;
- else result = a || b ? 1 : 0;
- return naNum(result);
-}
-
static naRef evalEquality(int op, naRef ra, naRef rb)
{
int result = naEqual(ra, rb);
return naNum((op==OP_EQ) ? result : !result);
}
+static naRef evalCat(naContext ctx, naRef l, naRef r)
+{
+ if(IS_VEC(l) && IS_VEC(r)) {
+ int i, ls = naVec_size(l), rs = naVec_size(r);
+ naRef v = naNewVector(ctx);
+ naVec_setsize(v, ls + rs);
+ for(i=0; i<ls; i+=1) naVec_set(v, i, naVec_get(l, i));
+ for(i=0; i<rs; i+=1) naVec_set(v, i+ls, naVec_get(r, i));
+ return v;
+ } else {
+ naRef a = stringify(ctx, l);
+ naRef b = stringify(ctx, r);
+ return naStr_concat(naNewString(ctx), a, b);
+ }
+}
+
// When a code object comes out of the constant pool and shows up on
// the stack, it needs to be bound with the lexical context.
static naRef bindFunction(struct Context* ctx, struct Frame* f, naRef code)
{
naRef result = naNewFunc(ctx, code);
- result.ref.ptr.func->namespace = f->locals;
- result.ref.ptr.func->next = f->func;
+ PTR(result).func->namespace = f->locals;
+ PTR(result).func->next = f->func;
return result;
}
{
while(c) {
if(naHash_get(c->namespace, sym, result)) return 1;
- c = c->next.ref.ptr.func;
+ c = PTR(c->next).func;
}
return 0;
}
{
naRef result;
if(!naHash_get(f->locals, sym, &result))
- if(!getClosure(f->func.ref.ptr.func, sym, &result))
- ERR(ctx, "undefined symbol");
+ if(!getClosure(PTR(f->func).func, sym, &result))
+ naRuntimeError(ctx, "undefined symbol: %s", naStr_data(sym));
return result;
}
naRef* sym, naRef* out)
{
struct naFunc* func;
- struct naStr* str = sym->ref.ptr.str;
- if(naHash_sym(f->locals.ref.ptr.hash, str, out))
+ struct naStr* str = PTR(*sym).str;
+ if(naHash_sym(PTR(f->locals).hash, str, out))
return;
- func = f->func.ref.ptr.func;
- while(func && func->namespace.ref.ptr.hash) {
- if(naHash_sym(func->namespace.ref.ptr.hash, str, out))
+ func = PTR(f->func).func;
+ while(func && PTR(func->namespace).hash) {
+ if(naHash_sym(PTR(func->namespace).hash, str, out))
return;
- func = func->next.ref.ptr.func;
+ func = PTR(func->next).func;
}
// Now do it again using the more general naHash_get(). This will
// only be necessary if something has created the value in the
static int setClosure(naRef func, naRef sym, naRef val)
{
- struct naFunc* c = func.ref.ptr.func;
+ struct naFunc* c = PTR(func).func;
if(c == 0) { return 0; }
else if(naHash_tryset(c->namespace, sym, val)) { return 1; }
else { return setClosure(c->next, sym, val); }
return val;
}
-// Recursively descend into the parents lists
-static int getMember(struct Context* ctx, naRef obj, naRef fld,
- naRef* result, int count)
+// Funky API: returns null to indicate no member, an empty string to
+// indicate success, or a non-empty error message. Works this way so
+// we can generate smart error messages without throwing them with a
+// longjmp -- this gets called under naMember_get() from C code.
+static const char* getMember_r(naRef obj, naRef field, naRef* out, int count)
{
+ int i;
naRef p;
- if(--count < 0) ERR(ctx, "too many parents");
- if(!IS_HASH(obj)) ERR(ctx, "non-objects have no members");
- if(naHash_get(obj, fld, result)) {
- return 1;
- } else if(naHash_get(obj, globals->parentsRef, &p)) {
- if(IS_VEC(p)) {
- int i;
- struct VecRec* v = p.ref.ptr.vec->rec;
- for(i=0; i<v->size; i++)
- if(getMember(ctx, v->array[i], fld, result, count))
- return 1;
- } else
- ERR(ctx, "parents field not vector");
+ struct VecRec* pv;
+ if(--count < 0) return "too many parents";
+ if(!IS_HASH(obj)) return 0;
+ if(naHash_get(obj, field, out)) return "";
+ if(!naHash_get(obj, globals->parentsRef, &p)) return 0;
+ if(!IS_VEC(p)) return "object \"parents\" field not vector";
+ pv = PTR(p).vec->rec;
+ for(i=0; i<pv->size; i++) {
+ const char* err = getMember_r(pv->array[i], field, out, count);
+ if(err) return err; /* either an error or success */
}
return 0;
}
+static void getMember(struct Context* ctx, naRef obj, naRef fld,
+ naRef* result, int count)
+{
+ const char* err = getMember_r(obj, fld, result, count);
+ if(!err) naRuntimeError(ctx, "No such member: %s", naStr_data(fld));
+ if(err[0]) naRuntimeError(ctx, err);
+}
+
+int naMember_get(naRef obj, naRef field, naRef* out)
+{
+ const char* err = getMember_r(obj, field, out, 64);
+ return err && !err[0];
+}
+
// OP_EACH works like a vector get, except that it leaves the vector
// and index on the stack, increments the index after use, and
// pushes a nil if the index is beyond the end.
{
int idx = (int)(ctx->opStack[ctx->opTop-1].num);
naRef vec = ctx->opStack[ctx->opTop-2];
- if(!IS_VEC(vec)) naRuntimeError(ctx, "foreach enumeration of non-vector");
- if(!vec.ref.ptr.vec->rec || idx >= vec.ref.ptr.vec->rec->size) {
- PUSH(naNil());
+ if(!IS_VEC(vec)) ERR(ctx, "foreach enumeration of non-vector");
+ if(!PTR(vec).vec->rec || idx >= PTR(vec).vec->rec->size) {
+ PUSH(endToken());
return;
}
ctx->opStack[ctx->opTop-1].num = idx+1; // modify in place
#define POP() ctx->opStack[--ctx->opTop]
#define STK(n) (ctx->opStack[ctx->opTop-(n)])
#define FIXFRAME() f = &(ctx->fStack[ctx->fTop-1]); \
- cd = f->func.ref.ptr.func->code.ref.ptr.code;
+ cd = PTR(PTR(f->func).func->code).code;
static naRef run(struct Context* ctx)
{
struct Frame* f;
struct naCode* cd;
int op, arg;
- naRef a, b, c;
+ naRef a, b;
+
+ ctx->dieArg = naNil();
+ ctx->error[0] = 0;
FIXFRAME();
#define BINOP(expr) do { \
double l = IS_NUM(STK(2)) ? STK(2).num : numify(ctx, STK(2)); \
double r = IS_NUM(STK(1)) ? STK(1).num : numify(ctx, STK(1)); \
- STK(2).ref.reftag = ~NASAL_REFTAG; \
- STK(2).num = expr; \
+ SETNUM(STK(2), expr); \
ctx->opTop--; } while(0)
case OP_PLUS: BINOP(l + r); break;
case OP_LTE: BINOP(l <= r ? 1 : 0); break;
case OP_GT: BINOP(l > r ? 1 : 0); break;
case OP_GTE: BINOP(l >= r ? 1 : 0); break;
-
#undef BINOP
case OP_EQ: case OP_NEQ:
STK(2) = evalEquality(op, STK(2), STK(1));
ctx->opTop--;
break;
- case OP_AND: case OP_OR:
- STK(2) = evalAndOr(ctx, op, STK(2), STK(1));
- ctx->opTop--;
- break;
case OP_CAT:
- // stringify can call the GC, so don't take stuff of the stack!
- a = stringify(ctx, ctx->opStack[ctx->opTop-1]);
- b = stringify(ctx, ctx->opStack[ctx->opTop-2]);
- c = naStr_concat(naNewString(ctx), b, a);
- ctx->opTop -= 2;
- PUSH(c);
+ STK(2) = evalCat(ctx, STK(2), STK(1));
+ ctx->opTop -= 1;
break;
case OP_NEG:
STK(1) = naNum(-numify(ctx, STK(1)));
case OP_PUSHNIL:
PUSH(naNil());
break;
+ case OP_PUSHEND:
+ PUSH(endToken());
+ break;
case OP_NEWVEC:
PUSH(naNewVector(ctx));
break;
ctx->opTop--;
break;
case OP_MEMBER:
- if(!getMember(ctx, STK(1), CONSTARG(), &STK(1), 64))
- ERR(ctx, "no such member");
+ getMember(ctx, STK(1), CONSTARG(), &STK(1), 64);
break;
case OP_SETMEMBER:
if(!IS_HASH(STK(3))) ERR(ctx, "non-objects have no members");
f->ip = cd->byteCode[f->ip];
DBG(printf(" [Jump to: %d]\n", f->ip);)
break;
- case OP_JIFNIL:
+ case OP_JIFEND:
arg = ARG();
- if(IS_NIL(STK(1))) {
+ if(IS_END(STK(1))) {
ctx->opTop--; // Pops **ONLY** if it's nil!
f->ip = arg;
DBG(printf(" [Jump to: %d]\n", f->ip);)
}
break;
+ case OP_JIFTRUE:
+ arg = ARG();
+ if(boolify(ctx, STK(1))) {
+ f->ip = arg;
+ DBG(printf(" [Jump to: %d]\n", f->ip);)
+ }
+ break;
case OP_JIFNOT:
+ arg = ARG();
+ if(!boolify(ctx, STK(1))) {
+ f->ip = arg;
+ DBG(printf(" [Jump to: %d]\n", f->ip);)
+ }
+ break;
+ case OP_JIFNOTPOP:
arg = ARG();
if(!boolify(ctx, POP())) {
f->ip = arg;
}
break;
case OP_FCALL:
- f = setupFuncall(ctx, ARG(), 0, 0);
- cd = f->func.ref.ptr.func->code.ref.ptr.code;
- break;
- case OP_FTAIL:
- f = setupFuncall(ctx, ARG(), 0, 1);
- cd = f->func.ref.ptr.func->code.ref.ptr.code;
+ f = setupFuncall(ctx, ARG(), 0);
+ cd = PTR(PTR(f->func).func->code).code;
break;
case OP_MCALL:
- f = setupFuncall(ctx, ARG(), 1, 0);
- cd = f->func.ref.ptr.func->code.ref.ptr.code;
- break;
- case OP_MTAIL:
- f = setupFuncall(ctx, ARG(), 1, 1);
- cd = f->func.ref.ptr.func->code.ref.ptr.code;
+ f = setupFuncall(ctx, ARG(), 1);
+ cd = PTR(PTR(f->func).func->code).code;
break;
case OP_RETURN:
a = STK(1);
+ ctx->dieArg = naNil();
+ if(ctx->callChild) naFreeContext(ctx->callChild);
if(--ctx->fTop <= 0) return a;
ctx->opTop = f->bp + 1; // restore the correct opstack frame!
STK(1) = a;
break;
case OP_MARK: // save stack state (e.g. "setjmp")
if(ctx->markTop >= MAX_MARK_DEPTH)
- naRuntimeError(ctx, "mark stack overflow");
+ ERR(ctx, "mark stack overflow");
ctx->markStack[ctx->markTop++] = ctx->opTop;
break;
case OP_UNMARK: // pop stack state set by mark
naVec_append(globals->save, obj);
}
-// FIXME: handle ctx->callParent
int naStackDepth(struct Context* ctx)
{
- return ctx->fTop;
+ return ctx ? ctx->fTop + naStackDepth(ctx->callChild): 0;
+}
+
+static int findFrame(naContext ctx, naContext* out, int fn)
+{
+ int sd = naStackDepth(ctx->callChild);
+ if(fn < sd) return findFrame(ctx->callChild, out, fn);
+ *out = ctx;
+ return ctx->fTop - 1 - (fn - sd);
}
-// FIXME: handle ctx->callParent
int naGetLine(struct Context* ctx, int frame)
{
- struct Frame* f = &ctx->fStack[ctx->fTop-1-frame];
- naRef func = f->func;
- int ip = f->ip;
- if(IS_FUNC(func) && IS_CODE(func.ref.ptr.func->code)) {
- struct naCode* c = func.ref.ptr.func->code.ref.ptr.code;
+ struct Frame* f;
+ frame = findFrame(ctx, &ctx, frame);
+ f = &ctx->fStack[frame];
+ if(IS_FUNC(f->func) && IS_CODE(PTR(f->func).func->code)) {
+ struct naCode* c = PTR(PTR(f->func).func->code).code;
unsigned short* p = c->lineIps + c->nLines - 2;
- while(p >= c->lineIps && p[0] > ip)
+ while(p >= c->lineIps && p[0] > f->ip)
p -= 2;
return p[1];
}
return -1;
}
-// FIXME: handle ctx->callParent
naRef naGetSourceFile(struct Context* ctx, int frame)
{
- naRef f = ctx->fStack[ctx->fTop-1-frame].func;
- f = f.ref.ptr.func->code;
- return f.ref.ptr.code->srcFile;
+ naRef f;
+ frame = findFrame(ctx, &ctx, frame);
+ f = ctx->fStack[frame].func;
+ f = PTR(f).func->code;
+ return PTR(f).code->srcFile;
}
char* naGetError(struct Context* ctx)
{
if(IS_STR(ctx->dieArg))
- return (char*)ctx->dieArg.ref.ptr.str->data;
- return ctx->error;
+ return (char*)PTR(ctx->dieArg).str->data;
+ return ctx->error[0] ? ctx->error : 0;
}
naRef naBindFunction(naContext ctx, naRef code, naRef closure)
{
naRef func = naNewFunc(ctx, code);
- func.ref.ptr.func->namespace = closure;
- func.ref.ptr.func->next = naNil();
+ PTR(func).func->namespace = closure;
+ PTR(func).func->next = naNil();
return func;
}
{
naRef func = naNewFunc(ctx, code);
struct Frame* f = &ctx->fStack[ctx->fTop-1];
- func.ref.ptr.func->namespace = f->locals;
- func.ref.ptr.func->next = f->func;
+ PTR(func).func->namespace = f->locals;
+ PTR(func).func->next = f->func;
return func;
}
{
int i;
naRef result;
- if(!ctx->callParent) naModLock(ctx);
+ if(!ctx->callParent) naModLock();
// We might have to allocate objects, which can call the GC. But
// the call isn't on the Nasal stack yet, so the GC won't find our
naTempSave(ctx, obj);
naTempSave(ctx, locals);
- if(IS_CCODE(func.ref.ptr.func->code)) {
- naCFunction fp = func.ref.ptr.func->code.ref.ptr.ccode->fptr;
- result = (*fp)(ctx, obj, argc, args);
+ // naRuntimeError() calls end up here:
+ if(setjmp(ctx->jumpHandle)) {
if(!ctx->callParent) naModUnlock(ctx);
+ return naNil();
+ }
+
+ if(IS_CCODE(PTR(func).func->code)) {
+ naCFunction fp = PTR(PTR(func).func->code).ccode->fptr;
+ result = (*fp)(ctx, obj, argc, args);
+ if(!ctx->callParent) naModUnlock();
return result;
}
if(IS_NIL(locals))
locals = naNewHash(ctx);
- if(!IS_FUNC(func))
- func = naNewFunc(ctx, func); // bind bare code objects
+ if(!IS_FUNC(func)) {
+ func = naNewFunc(ctx, func);
+ PTR(func).func->namespace = locals;
+ }
if(!IS_NIL(obj))
naHash_set(locals, globals->meRef, obj);
- ctx->dieArg = naNil();
-
ctx->opTop = ctx->markTop = 0;
ctx->fTop = 1;
ctx->fStack[0].func = func;
ctx->fStack[0].ip = 0;
ctx->fStack[0].bp = ctx->opTop;
- setupArgs(ctx, ctx->fStack, args, argc);
+ if(args) setupArgs(ctx, ctx->fStack, args, argc);
+
+ result = run(ctx);
+ if(!ctx->callParent) naModUnlock(ctx);
+ return result;
+}
- // Return early if an error occurred. It will be visible to the
- // caller via naGetError().
- ctx->error = 0;
+naRef naContinue(naContext ctx)
+{
+ naRef result;
+ if(!ctx->callParent) naModLock();
if(setjmp(ctx->jumpHandle)) {
if(!ctx->callParent) naModUnlock(ctx);
return naNil();
}
-
+ ctx->opTop = ctx->opFrame;
+ PUSH(naNil());
result = run(ctx);
- if(!ctx->callParent) naModUnlock(ctx);
+ if(!ctx->callParent) naModUnlock();
return result;
}
-
#define OBJ_CACHE_SZ 128
enum {
- OP_AND, OP_OR, OP_NOT, OP_MUL, OP_PLUS, OP_MINUS, OP_DIV, OP_NEG,
+ OP_NOT, OP_MUL, OP_PLUS, OP_MINUS, OP_DIV, OP_NEG,
OP_CAT, OP_LT, OP_LTE, OP_GT, OP_GTE, OP_EQ, OP_NEQ, OP_EACH,
- OP_JMP, OP_JMPLOOP, OP_JIFNOT, OP_JIFNIL, OP_FCALL, OP_MCALL, OP_RETURN,
- OP_PUSHCONST, OP_PUSHONE, OP_PUSHZERO, OP_PUSHNIL, OP_POP,
+ OP_JMP, OP_JMPLOOP, OP_JIFNOTPOP, OP_JIFEND, OP_FCALL, OP_MCALL,
+ OP_RETURN, OP_PUSHCONST, OP_PUSHONE, OP_PUSHZERO, OP_PUSHNIL, OP_POP,
OP_DUP, OP_XCHG, OP_INSERT, OP_EXTRACT, OP_MEMBER, OP_SETMEMBER,
OP_LOCAL, OP_SETLOCAL, OP_NEWVEC, OP_VAPPEND, OP_NEWHASH, OP_HAPPEND,
- OP_MARK, OP_UNMARK, OP_BREAK, OP_FTAIL, OP_MTAIL, OP_SETSYM, OP_DUP2,
- OP_INDEX, OP_BREAK2
+ OP_MARK, OP_UNMARK, OP_BREAK, OP_SETSYM, OP_DUP2, OP_INDEX, OP_BREAK2,
+ OP_PUSHEND, OP_JIFTRUE, OP_JIFNOT
};
struct Frame {
struct Frame fStack[MAX_RECURSION];
int fTop;
naRef opStack[MAX_STACK_DEPTH];
+ int opFrame; // like Frame::bp, but for C functions
int opTop;
int markStack[MAX_MARK_DEPTH];
int markTop;
// Error handling
jmp_buf jumpHandle;
- char* error;
+ char error[128];
naRef dieArg;
// Sub-call lists
// Linked list pointers in globals
struct Context* nextFree;
struct Context* nextAll;
+
+ void* userData;
};
#define globals nasal_globals
// Threading low-level functions
void* naNewLock();
+void naFreeLock(void* lock);
void naLock(void* lock);
void naUnlock(void* lock);
void* naNewSem();
+void naFreeSem(void* sem);
void naSemDown(void* sem);
-void naSemUpAll(void* sem, int count);
+void naSemUp(void* sem, int count);
void naCheckBottleneck();
return internConstant(p, c);
}
-static int lastExprInBlock(struct Token* t)
-{
- if(!t->parent) return 1;
- if(t->parent->type == TOK_TOP || t->parent->type == TOK_LCURL) return 1;
- if(t->parent->type == TOK_SEMI)
- if(!t->next || t->next->type == TOK_EMPTY)
- return 1;
- return 0;
-}
-
-// Returns true if the node is in "tail context" -- either a child of
-// a return, the last child of a func block, or else the
-// last child of an if/elsif/if that is itself in tail context.
-static int tailContext(struct Token* t)
-{
- if(t->parent && t->parent->type == TOK_RETURN)
- return 1;
- else if(!lastExprInBlock(t))
- return 0;
-
- // Walk up the tree. It is ok to see semicolons, else's, elsifs
- // and curlies. If we reach the top or a func, then we are in
- // tail context. If we hit an if, then we are in tail context
- // only if the "if" node is.
- while((t = t->parent) != 0)
- switch(t->type) {
- case TOK_SEMI: case TOK_LCURL: break;
- case TOK_ELSE: case TOK_ELSIF: break;
- case TOK_TOP: case TOK_FUNC: return 1;
- case TOK_IF: return tailContext(t);
- default: return 0;
- }
- return 0;
-}
-
static int genScalarConstant(struct Parser* p, struct Token* t)
{
// These opcodes are for special-case use in other constructs, but
static int genLValue(struct Parser* p, struct Token* t, int* cidx)
{
- if(t->type == TOK_LPAR) {
+ if(t->type == TOK_LPAR && t->rule != PREC_SUFFIX) {
return genLValue(p, LEFT(t), cidx); // Handle stuff like "(a) = 1"
} else if(t->type == TOK_SYMBOL) {
*cidx = genScalarConstant(p, t);
genExpr(p, LEFT(t));
}
if(RIGHT(t)) nargs = genList(p, RIGHT(t), 0);
- if(tailContext(t))
- op = op == OP_FCALL ? OP_FTAIL : OP_MTAIL;
emitImmediate(p, op, nargs);
}
static void genShortCircuit(struct Parser* p, struct Token* t)
{
- int jumpNext, jumpEnd, isAnd = (t->type == TOK_AND);
+ int end;
genExpr(p, LEFT(t));
- if(isAnd) emit(p, OP_NOT);
- jumpNext = emitJump(p, OP_JIFNOT);
- emit(p, isAnd ? OP_PUSHNIL : OP_PUSHONE);
- jumpEnd = emitJump(p, OP_JMP);
- fixJumpTarget(p, jumpNext);
+ end = emitJump(p, t->type == TOK_AND ? OP_JIFNOT : OP_JIFTRUE);
+ emit(p, OP_POP);
genExpr(p, RIGHT(t));
- fixJumpTarget(p, jumpEnd);
+ fixJumpTarget(p, end);
}
{
int jumpNext, jumpEnd;
genExpr(p, tif->children); // the test
- jumpNext = emitJump(p, OP_JIFNOT);
+ jumpNext = emitJump(p, OP_JIFNOTPOP);
genExprList(p, tif->children->next->children); // the body
jumpEnd = emitJump(p, OP_JMP);
fixJumpTarget(p, jumpNext);
if(!RIGHT(t) || RIGHT(t)->type != TOK_COLON)
naParseError(p, "invalid ?: expression", t->line);
genExpr(p, LEFT(t)); // the test
- jumpNext = emitJump(p, OP_JIFNOT);
+ jumpNext = emitJump(p, OP_JIFNOTPOP);
genExpr(p, LEFT(RIGHT(t))); // the "if true" expr
jumpEnd = emitJump(p, OP_JMP);
fixJumpTarget(p, jumpNext);
pushLoop(p, label);
loopTop = p->cg->codesz;
genExpr(p, test);
- jumpEnd = emitJump(p, OP_JIFNOT);
+ jumpEnd = emitJump(p, OP_JIFNOTPOP);
genLoop(p, body, update, label, loopTop, jumpEnd);
}
pushLoop(p, label);
loopTop = p->cg->codesz;
emit(p, t->type == TOK_FOREACH ? OP_EACH : OP_INDEX);
- jumpEnd = emitJump(p, OP_JIFNIL);
+ jumpEnd = emitJump(p, OP_JIFEND);
assignOp = genLValue(p, elem, &dummy);
emit(p, OP_XCHG);
emit(p, assignOp);
for(i=0; i<levels; i++)
emit(p, (i<levels-1) ? OP_BREAK2 : OP_BREAK);
if(t->type == TOK_BREAK)
- emit(p, OP_PUSHNIL); // breakIP is always a JIFNOT/JIFNIL!
+ emit(p, OP_PUSHEND); // breakIP is always a JIFNOTPOP/JIFEND!
emitImmediate(p, OP_JMP, t->type == TOK_BREAK ? bp : cp);
}
static void genExpr(struct Parser* p, struct Token* t)
{
int i, dummy;
+ if(!t) naParseError(p, "parse error", -1); // throw line -1...
+ p->errLine = t->line; // ...to use this one instead
if(t->line != p->cg->lastLine)
newLineEntry(p, t->line);
p->cg->lastLine = t->line;
case TOK_MINUS:
if(BINARY(t)) {
genBinOp(OP_MINUS, p, t); // binary subtraction
- } else if(RIGHT(t)->type == TOK_LITERAL && !RIGHT(t)->str) {
+ } else if(RIGHT(t) && RIGHT(t)->type == TOK_LITERAL && !RIGHT(t)->str) {
RIGHT(t)->num *= -1; // Pre-negate constants
genScalarConstant(p, RIGHT(t));
} else {
break;
case TOK_DOT:
genExpr(p, LEFT(t));
- if(RIGHT(t)->type != TOK_SYMBOL)
+ if(!RIGHT(t) || RIGHT(t)->type != TOK_SYMBOL)
naParseError(p, "object field not symbol", RIGHT(t)->line);
emitImmediate(p, OP_MEMBER, findConstantIndex(p, RIGHT(t)));
break;
static void genExprList(struct Parser* p, struct Token* t)
{
- if(t->type == TOK_SEMI) {
+ if(t && t->type == TOK_SEMI) {
genExpr(p, LEFT(t));
if(RIGHT(t) && RIGHT(t)->type != TOK_EMPTY) {
emit(p, OP_POP);
// Now make a code object
codeObj = naNewCode(p->context);
- code = codeObj.ref.ptr.code;
+ code = PTR(codeObj).code;
// Parse the argument list, if any
code->restArgSym = globals->argRef;
#include "nasal.h"
+#if defined(NASAL_NAN64)
+
+// On 64 bit systems, Nasal non-numeric references are stored with a
+// bitmask that sets the top 16 bits. As a double, this is a
+// signalling NaN that cannot itself be produced by normal numerics
+// code. The pointer value can be reconstructed if (and only if) we
+// are guaranteed that all memory that can be poitned to by a naRef
+// (i.e. all memory returned by naAlloc) lives in the bottom 48 bits
+// of memory. Linux on x86_64, Win64, Solaris and Irix all have such
+// policies with address spaces:
+//
+// http://msdn.microsoft.com/library/en-us/win64/win64/virtual_address_space.asp
+// http://docs.sun.com/app/docs/doc/816-5138/6mba6ua5p?a=view
+// http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi/
+// ... 0650/bks/SGI_Developer/books/T_IRIX_Prog/sgi_html/ch01.html
+//
+// In the above, MS guarantees 44 bits of process address space, SGI
+// 40, and Sun 43 (Solaris *does* place the stack in the "negative"
+// address space at 0xffff..., but we don't care as naRefs will never
+// point there). Linux doesn't document this rigorously, but testing
+// shows that it allows 47 bits of address space (and current x86_64
+// implementations are limited to 48 bits of virtual space anyway). So
+// we choose 48 as the conservative compromise.
+
+#define REFMAGIC ((1UL<<48) - 1)
+
+#define _ULP(r) ((unsigned long long)((r).ptr))
+#define REFPTR(r) (_ULP(r) & REFMAGIC)
+#define IS_REF(r) ((_ULP(r) & ~REFMAGIC) == ~REFMAGIC)
+
+// Portability note: this cast from a pointer type to naPtr (a union)
+// is not defined in ISO C, it's a GCC extention that doesn't work on
+// (at least) either the SUNWspro or MSVC compilers. Unfortunately,
+// fixing this would require abandoning the naPtr union for a set of
+// PTR_<type>() macros, which is a ton of work and a lot of extra
+// code. And as all enabled 64 bit platforms are gcc anyway, and the
+// 32 bit fallback code works in any case, this is acceptable for now.
+#define PTR(r) ((naPtr)((struct naObj*)(_ULP(r) & REFMAGIC)))
+
+#define SETPTR(r, p) ((r).ptr = (void*)((unsigned long long)p | ~REFMAGIC))
+#define SETNUM(r, n) ((r).num = n)
+
+#else
+
+// On 32 bit systems where the pointer is half the width of the
+// double, we store a special magic number in the structure to make
+// the double a NaN. This must appear in the top bits of the double,
+// which is why the structure layout is endianness-dependent.
+
+#define NASAL_REFTAG 0x7ff56789 // == 2,146,789,257 decimal
+#define IS_REF(r) ((r).ref.reftag == NASAL_REFTAG)
+#define PTR(r) ((r).ref.ptr)
+
+#define SETPTR(r, p) ((r).ref.ptr.obj = (void*)p, (r).ref.reftag = NASAL_REFTAG)
+#define SETNUM(r, n) ((r).ref.reftag = ~NASAL_REFTAG, (r).num = n)
+
+#endif /* platform stuff */
+
enum { T_STR, T_VEC, T_HASH, T_CODE, T_FUNC, T_CCODE, T_GHOST,
NUM_NASAL_TYPES }; // V. important that this come last!
-#define IS_REF(r) ((r).ref.reftag == NASAL_REFTAG)
-#define IS_NUM(r) ((r).ref.reftag != NASAL_REFTAG)
-#define IS_OBJ(r) (IS_REF((r)) && (r).ref.ptr.obj != 0)
-//#define IS_OBJ(r) (IS_REF((r)) && (r).ref.ptr.obj != 0 && (((r).ref.ptr.obj->type == 123) ? *(int*)0 : 1))
-#define IS_NIL(r) (IS_REF((r)) && (r).ref.ptr.obj == 0)
-#define IS_STR(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_STR)
-#define IS_VEC(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_VEC)
-#define IS_HASH(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_HASH)
-#define IS_CODE(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_CODE)
-#define IS_FUNC(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_FUNC)
-#define IS_CCODE(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_CCODE)
-#define IS_GHOST(r) (IS_OBJ((r)) && (r).ref.ptr.obj->type == T_GHOST)
+#define IS_NUM(r) (!IS_REF(r))
+#define IS_OBJ(r) (IS_REF(r) && PTR(r).obj != 0)
+#define IS_NIL(r) (IS_REF(r) && PTR(r).obj == 0)
+#define IS_STR(r) (IS_OBJ(r) && PTR(r).obj->type == T_STR)
+#define IS_VEC(r) (IS_OBJ(r) && PTR(r).obj->type == T_VEC)
+#define IS_HASH(r) (IS_OBJ(r) && PTR(r).obj->type == T_HASH)
+#define IS_CODE(r) (IS_OBJ(r) && PTR(r).obj->type == T_CODE)
+#define IS_FUNC(r) (IS_OBJ(r) && PTR(r).obj->type == T_FUNC)
+#define IS_CCODE(r) (IS_OBJ(r) && PTR(r).obj->type == T_CCODE)
+#define IS_GHOST(r) (IS_OBJ(r) && PTR(r).obj->type == T_GHOST)
#define IS_CONTAINER(r) (IS_VEC(r)||IS_HASH(r))
-#define IS_SCALAR(r) (IS_NUM((r)) || IS_STR((r)))
+#define IS_SCALAR(r) (IS_NUM(r) || IS_STR(r))
#define IDENTICAL(a, b) (IS_REF(a) && IS_REF(b) \
- && a.ref.ptr.obj == b.ref.ptr.obj)
+ && PTR(a).obj == PTR(b).obj)
-#define MUTABLE(r) (IS_STR(r) && (r).ref.ptr.str->hashcode == 0)
+#define MUTABLE(r) (IS_STR(r) && PTR(r).str->hashcode == 0)
// This is a macro instead of a separate struct to allow compilers to
// avoid padding. GCC on x86, at least, will always padd the size of
#include "data.h"
#include "code.h"
-#define MIN_BLOCK_SIZE 256
+#define MIN_BLOCK_SIZE 32
static void reap(struct naPool* p);
static void mark(naRef r);
int i;
naRef r = naNil();
for(i=0; i<c->ntemps; i++) {
- r.ref.ptr.obj = c->temps[i];
+ SETPTR(r, c->temps[i]);
mark(r);
}
}
if(g->waitCount >= g->nThreads - 1) {
freeDead();
if(g->needGC) garbageCollect();
- if(g->waitCount) naSemUpAll(g->sem, g->waitCount);
+ if(g->waitCount) naSemUp(g->sem, g->waitCount);
g->bottleneck = 0;
}
}
static void naGhost_gcclean(struct naGhost* g)
{
- if(g->ptr) g->gtype->destroy(g->ptr);
+ if(g->ptr && g->gtype->destroy) g->gtype->destroy(g->ptr);
g->ptr = 0;
}
static void markvec(naRef r)
{
int i;
- struct VecRec* vr = r.ref.ptr.vec->rec;
+ struct VecRec* vr = PTR(r).vec->rec;
if(!vr) return;
for(i=0; i<vr->size; i++)
mark(vr->array[i]);
static void markhash(naRef r)
{
int i;
- struct HashRec* hr = r.ref.ptr.hash->rec;
+ struct HashRec* hr = PTR(r).hash->rec;
if(!hr) return;
for(i=0; i < (1<<hr->lgalloced); i++) {
struct HashNode* hn = hr->table[i];
if(IS_NUM(r) || IS_NIL(r))
return;
- if(r.ref.ptr.obj->mark == 1)
+ if(PTR(r).obj->mark == 1)
return;
- r.ref.ptr.obj->mark = 1;
- switch(r.ref.ptr.obj->type) {
+ PTR(r).obj->mark = 1;
+ switch(PTR(r).obj->type) {
case T_VEC: markvec(r); break;
case T_HASH: markhash(r); break;
case T_CODE:
- mark(r.ref.ptr.code->srcFile);
- for(i=0; i<r.ref.ptr.code->nConstants; i++)
- mark(r.ref.ptr.code->constants[i]);
+ mark(PTR(r).code->srcFile);
+ for(i=0; i<PTR(r).code->nConstants; i++)
+ mark(PTR(r).code->constants[i]);
break;
case T_FUNC:
- mark(r.ref.ptr.func->code);
- mark(r.ref.ptr.func->namespace);
- mark(r.ref.ptr.func->next);
+ mark(PTR(r).func->code);
+ mark(PTR(r).func->namespace);
+ mark(PTR(r).func->next);
break;
}
}
{
struct Block* b;
int elem, freesz, total = poolsize(p);
- p->nfree = 0;
freesz = total < MIN_BLOCK_SIZE ? MIN_BLOCK_SIZE : total;
freesz = (3 * freesz / 2) + (globals->nThreads * OBJ_CACHE_SZ);
if(p->freesz < freesz) {
p->free = p->free0 = naAlloc(sizeof(void*) * p->freesz);
}
+ p->nfree = 0;
+ p->free = p->free0;
+
for(b = p->blocks; b; b = b->next)
for(elem=0; elem < b->size; elem++) {
struct naObj* o = (struct naObj*)(b->block + elem * p->elemsz);
o->mark = 0;
}
+ p->freetop = p->nfree;
+
// allocs of this type until the next collection
globals->allocCount += total/2;
if(need > 0)
newBlock(p, need);
}
- p->freetop = p->nfree;
}
// Does the swap, returning the old value
#define MIN_HASH_SIZE 4
-#define EQUAL(a, b) (((a).ref.reftag == (b).ref.reftag \
- && (a).ref.ptr.obj == (b).ref.ptr.obj) \
- || naEqual(a, b))
+#define EQUAL(a, b) (IDENTICAL(a, b) || naEqual(a, b))
#define HASH_MAGIC 2654435769u
// 2*sizeof(int).
unsigned int* p = (unsigned int*)&(r.num);
return p[0] ^ p[1];
- } else if(r.ref.ptr.str->hashcode) {
- return r.ref.ptr.str->hashcode;
+ } else if(PTR(r).str->hashcode) {
+ return PTR(r).str->hashcode;
} else {
// This is Daniel Bernstein's djb2 hash function that I found
// on the web somewhere. It appears to work pretty well.
unsigned int i, hash = 5831;
- for(i=0; i<r.ref.ptr.str->len; i++)
- hash = (hash * 33) ^ r.ref.ptr.str->data[i];
- r.ref.ptr.str->hashcode = hash;
+ for(i=0; i<PTR(r).str->len; i++)
+ hash = (hash * 33) ^ PTR(r).str->data[i];
+ PTR(r).str->hashcode = hash;
return hash;
}
}
int col = (HASH_MAGIC * sym->hashcode) >> (32 - h->lgalloced);
struct HashNode* hn = h->table[col];
while(hn) {
- if(hn->key.ref.ptr.str == sym) {
+ if(PTR(hn->key).str == sym) {
*out = hn->val;
return 1;
}
static struct HashNode* find(struct naHash* hash, naRef key)
{
struct HashRec* h = hash->rec;
- if(h) {
- struct HashNode* hn = h->table[hashcolumn(h, key)];
- while(hn) {
- if(EQUAL(key, hn->key))
- return hn;
- hn = hn->next;
- }
- }
+ struct HashNode* hn;
+ if(!h) return 0;
+ for(hn = h->table[hashcolumn(h, key)]; hn; hn = hn->next)
+ if(EQUAL(key, hn->key))
+ return hn;
return 0;
}
// Make a temporary string on the stack
-static void tmpStr(naRef* out, struct naStr* str, char* key)
+static void tmpStr(naRef* out, struct naStr* str, const char* key)
{
str->len = 0;
+ str->type = T_STR;
str->data = (unsigned char*)key;
str->hashcode = 0;
while(key[str->len]) str->len++;
*out = naNil();
- out->ref.ptr.str = str;
+ SETPTR(*out, str);
+}
+
+int naMember_cget(naRef obj, const char* field, naRef* out)
+{
+ naRef key;
+ struct naStr str;
+ tmpStr(&key, &str, field);
+ return naMember_get(obj, key, out);
}
naRef naHash_cget(naRef hash, char* key)
int naHash_get(naRef hash, naRef key, naRef* out)
{
if(IS_HASH(hash)) {
- struct HashNode* n = find(hash.ref.ptr.hash, key);
+ struct HashNode* n = find(PTR(hash).hash, key);
if(n) { *out = n->val; return 1; }
}
return 0;
int naHash_tryset(naRef hash, naRef key, naRef val)
{
if(IS_HASH(hash)) {
- struct HashNode* n = find(hash.ref.ptr.hash, key);
+ struct HashNode* n = find(PTR(hash).hash, key);
if(n) n->val = val;
return n != 0;
}
struct HashRec* h = hash->rec;
while(!h || h->size >= 1<<h->lgalloced)
h = resize(hash);
- col = (HASH_MAGIC * sym->ref.ptr.str->hashcode) >> (32 - h->lgalloced);
+ col = (HASH_MAGIC * PTR(*sym).str->hashcode) >> (32 - h->lgalloced);
INSERT(h, *sym, *val, col);
}
struct HashRec* h;
struct HashNode* n;
if(!IS_HASH(hash)) return;
- if((n = find(hash.ref.ptr.hash, key))) { n->val = val; return; }
- h = hash.ref.ptr.hash->rec;
+ if((n = find(PTR(hash).hash, key))) { n->val = val; return; }
+ h = PTR(hash).hash->rec;
while(!h || h->size >= 1<<h->lgalloced)
- h = resize(hash.ref.ptr.hash);
+ h = resize(PTR(hash).hash);
col = hashcolumn(h, key);
INSERT(h, key, val, hashcolumn(h, key));
chkcycle(h->table[col], h->size - h->dels);
void naHash_delete(naRef hash, naRef key)
{
- struct HashRec* h = hash.ref.ptr.hash->rec;
+ struct HashRec* h = PTR(hash).hash->rec;
int col;
struct HashNode *last=0, *hn;
if(!IS_HASH(hash) || !h) return;
void naHash_keys(naRef dst, naRef hash)
{
int i;
- struct HashRec* h = hash.ref.ptr.hash->rec;
+ struct HashRec* h = PTR(hash).hash->rec;
if(!IS_HASH(hash) || !h) return;
for(i=0; i<(1<<h->lgalloced); i++) {
struct HashNode* hn = h->table[i];
int naHash_size(naRef hash)
{
- struct HashRec* h = hash.ref.ptr.hash->rec;
+ struct HashRec* h = PTR(hash).hash->rec;
if(!IS_HASH(hash) || !h) return 0;
return h->size - h->dels;
}
static struct naIOGhost* ioghost(naRef r)
{
- if(naGhost_type(r) == &naIOGhostType)
+ if(naGhost_type(r) == &naIOGhostType && IOGHOST(r)->handle)
return naGhost_ptr(r);
return 0;
}
naRef len = argc > 2 ? naNumValue(args[2]) : naNil();
if(!g || !MUTABLE(str) || !IS_NUM(len))
naRuntimeError(c, "bad argument to read()");
- if(str.ref.ptr.str->len < (int)len.num)
+ if(PTR(str).str->len < (int)len.num)
naRuntimeError(c, "string not big enough for read");
- return naNum(g->type->read(c, g->handle, (char*)str.ref.ptr.str->data,
+ return naNum(g->type->read(c, g->handle, (char*)PTR(str).str->data,
(int)len.num));
}
naRef str = argc > 1 ? args[1] : naNil();
if(!g || !IS_STR(str))
naRuntimeError(c, "bad argument to write()");
- return naNum(g->type->write(c, g->handle, (char*)str.ref.ptr.str->data,
- str.ref.ptr.str->len));
+ return naNum(g->type->write(c, g->handle, (char*)PTR(str).str->data,
+ PTR(str).str->len));
}
static naRef f_seek(naContext c, naRef me, int argc, naRef* args)
static void iodestroy(void* f)
{
- ioclose(0, f);
+ if(f != stdin && f != stdout && f != stderr)
+ ioclose(0, f);
}
struct naIOType naStdIOType = { ioclose, ioread, iowrite, ioseek,
naRef file = argc > 0 ? naStringValue(c, args[0]) : naNil();
naRef mode = argc > 1 ? naStringValue(c, args[1]) : naNil();
if(!IS_STR(file)) naRuntimeError(c, "bad argument to open()");
- f = fopen((char*)file.ref.ptr.str->data,
- IS_STR(mode) ? (const char*)mode.ref.ptr.str->data : "r");
+ f = fopen((char*)PTR(file).str->data,
+ IS_STR(mode) ? (const char*)PTR(mode).str->data : "rb");
if(!f) naRuntimeError(c, strerror(errno));
return naIOGhost(c, f);
}
if(c == '\r') {
char c2 = getcguard(ctx, g->handle, buf);
if(c2 != EOF && c2 != '\n')
- ungetc(c2, g->handle);
+ if(EOF == ungetc(c2, g->handle))
+ break;
break;
}
buf[i++] = c;
struct stat s;
naRef result, path = argc > 0 ? naStringValue(ctx, args[0]) : naNil();
if(!IS_STR(path)) naRuntimeError(ctx, "bad argument to stat()");
- if(stat((char*)path.ref.ptr.str->data, &s) < 0) {
+ if(stat((char*)PTR(path).str->data, &s) < 0) {
if(errno == ENOENT) return naNil();
naRuntimeError(ctx, strerror(errno));
}
return result;
}
-static struct func { char* name; naCFunction func; } funcs[] = {
+static naCFuncItem funcs[] = {
{ "close", f_close },
{ "read", f_read },
{ "write", f_write },
{ "open", f_open },
{ "readln", f_readln },
{ "stat", f_stat },
+ { 0 }
};
-static void setsym(naContext c, naRef hash, char* sym, naRef val)
+naRef naInit_io(naContext c)
{
- naRef name = naStr_fromdata(naNewString(c), sym, strlen(sym));
- naHash_set(hash, naInternSymbol(name), val);
-}
-
-naRef naIOLib(naContext c)
-{
- naRef ns = naNewHash(c);
- int i, n = sizeof(funcs)/sizeof(struct func);
- for(i=0; i<n; i++)
- setsym(c, ns, funcs[i].name,
- naNewFunc(c, naNewCCode(c, funcs[i].func)));
- setsym(c, ns, "SEEK_SET", naNum(SEEK_SET));
- setsym(c, ns, "SEEK_CUR", naNum(SEEK_CUR));
- setsym(c, ns, "SEEK_END", naNum(SEEK_END));
- setsym(c, ns, "stdin", naIOGhost(c, stdin));
- setsym(c, ns, "stdout", naIOGhost(c, stdout));
- setsym(c, ns, "stderr", naIOGhost(c, stderr));
+ naRef ns = naGenLib(c, funcs);
+ naAddSym(c, ns, "SEEK_SET", naNum(SEEK_SET));
+ naAddSym(c, ns, "SEEK_CUR", naNum(SEEK_CUR));
+ naAddSym(c, ns, "SEEK_END", naNum(SEEK_END));
+ naAddSym(c, ns, "stdin", naIOGhost(c, stdin));
+ naAddSym(c, ns, "stdout", naIOGhost(c, stdout));
+ naAddSym(c, ns, "stderr", naIOGhost(c, stderr));
return ns;
}
static void newToken(struct Parser* p, int pos, int type,
char* str, int slen, double num)
{
- struct Token* tok;
+ struct Token *tok, *last = p->tree.lastChild;
+
+ /* Adjacent string literals get concatenated */
+ if(type == TOK_LITERAL && str) {
+ if(last && last->type == TOK_LITERAL) {
+ int i, len1 = last->strlen;
+ char* str2 = naParseAlloc(p, len1 + slen);
+ for(i=0; i<len1; i++) str2[i] = last->str[i];
+ for(i=0; i<slen; i++) str2[i+len1] = str[i];
+ last->str = str2;
+ last->strlen += slen;
+ return;
+ }
+ }
tok = naParseAlloc(p, sizeof(struct Token));
tok->type = type;
tok->num = num;
tok->parent = &p->tree;
tok->next = 0;
- tok->prev = p->tree.lastChild;
+ tok->prev = last;
tok->children = 0;
tok->lastChild = 0;
// Context sensitivity hack: a "-" following a binary operator of
- // higher precedence (MUL and DIV, basically) must be a unary
- // negation. Needed to get precedence right in the parser for
- // expressiong like "a * -2"
- if(type == TOK_MINUS && tok->prev)
- if(tok->prev->type == TOK_MUL || tok->prev->type == TOK_DIV)
+ // equal or higher precedence must be a unary negation. Needed to
+ // get precedence right in the parser for expressiong like "a * -2"
+ if(type == TOK_MINUS && tok->prev) {
+ int pt = tok->prev->type;
+ if(pt==TOK_PLUS||pt==TOK_MINUS||pt==TOK_CAT||pt==TOK_MUL||pt==TOK_DIV)
tok->type = type = TOK_NEG;
+ }
if(!p->tree.children) p->tree.children = tok;
if(p->tree.lastChild) p->tree.lastChild->next = tok;
case 'n': *cOut = '\n'; break;
case 't': *cOut = '\t'; break;
case '\\': *cOut = '\\'; break;
+ case '`': *cOut = '`'; break;
case 'x':
if(len < 4) error(p, "unterminated string", index);
*cOut = (char)((hexc(buf[2], p, index)<<4) | hexc(buf[3], p, index));
}
}
-// FIXME: should handle UTF8 too
static void charLiteral(struct Parser* p, int index, char* s, int len)
{
- if(len != 1) error(p, "character constant not single character", index);
- newToken(p, index, TOK_LITERAL, 0, 0, *s);
+ int n, c;
+ c = naLexUtf8C(s, len, &n);
+ if(c < 0 || n != len) error(p, "invalid utf8 character constant", index);
+ newToken(p, index, TOK_LITERAL, 0, 0, c);
}
// Read in a string literal
return best;
}
+#define ISNUM(c) ((c) >= '0' && (c) <= '9')
void naLex(struct Parser* p)
{
int i = 0;
i = lexStringLiteral(p, i, c);
break;
default:
- if(c >= '0' && c <= '9') i = lexNumLiteral(p, i);
+ if(ISNUM(c) || (c == '.' && (i+1)<p->len && ISNUM(p->buf[i+1])))
+ i = lexNumLiteral(p, i);
else handled = 0;
}
#include <string.h>
#ifdef _MSC_VER // sigh...
+#define snprintf _snprintf
#define vsnprintf _vsnprintf
#endif
#define NEWSTR(c, s, l) naStr_fromdata(naNewString(c), s, l)
#define NEWCSTR(c, s) NEWSTR(c, s, strlen(s))
-static naRef size(naContext c, naRef me, int argc, naRef* args)
+// Generic argument error, assumes that the symbol "c" is a naContext,
+// and that the __func__ string is of the form "f_NASALSYMBOL".
+#define ARGERR() \
+ naRuntimeError(c, "bad/missing argument to %s()", (__func__ + 2))
+
+static naRef f_size(naContext c, naRef me, int argc, naRef* args)
{
- if(argc == 0) return naNil();
+ if(argc == 0) ARGERR();
if(naIsString(args[0])) return naNum(naStr_len(args[0]));
if(naIsVector(args[0])) return naNum(naVec_size(args[0]));
if(naIsHash(args[0])) return naNum(naHash_size(args[0]));
return naNil();
}
-static naRef keys(naContext c, naRef me, int argc, naRef* args)
+static naRef f_keys(naContext c, naRef me, int argc, naRef* args)
{
- naRef v, h = args[0];
- if(!naIsHash(h)) return naNil();
+ naRef v, h = argc > 0 ? args[0] : naNil();
+ if(!naIsHash(h)) ARGERR();
v = naNewVector(c);
naHash_keys(v, h);
return v;
}
-static naRef append(naContext c, naRef me, int argc, naRef* args)
+static naRef f_append(naContext c, naRef me, int argc, naRef* args)
{
int i;
- if(argc < 2) return naNil();
- if(!naIsVector(args[0])) return naNil();
+ if(argc < 2 || !naIsVector(args[0])) ARGERR();
for(i=1; i<argc; i++) naVec_append(args[0], args[i]);
return args[0];
}
-static naRef pop(naContext c, naRef me, int argc, naRef* args)
+static naRef f_pop(naContext c, naRef me, int argc, naRef* args)
{
- if(argc < 1 || !naIsVector(args[0])) return naNil();
+ if(argc < 1 || !naIsVector(args[0])) ARGERR();
return naVec_removelast(args[0]);
}
-static naRef setsize(naContext c, naRef me, int argc, naRef* args)
+static naRef f_setsize(naContext c, naRef me, int argc, naRef* args)
{
- int sz;
- if(argc < 2) return naNil();
- sz = (int)naNumValue(args[1]).num;
- if(!naIsVector(args[0])) return naNil();
- naVec_setsize(args[0], sz);
+ if(argc < 2 || !naIsVector(args[0])) ARGERR();
+ naVec_setsize(args[0], (int)naNumValue(args[1]).num);
return args[0];
}
-static naRef subvec(naContext c, naRef me, int argc, naRef* args)
+static naRef f_subvec(naContext c, naRef me, int argc, naRef* args)
{
int i;
naRef nlen, result, v = args[0];
if(!naIsNil(nlen))
len = (int)nlen.num;
if(!naIsVector(v) || start < 0 || start > naVec_size(v) || len < 0)
- return naNil();
+ ARGERR();
if(naIsNil(nlen) || len > naVec_size(v) - start)
len = naVec_size(v) - start;
result = naNewVector(c);
return result;
}
-static naRef delete(naContext c, naRef me, int argc, naRef* args)
+static naRef f_delete(naContext c, naRef me, int argc, naRef* args)
{
- if(argc > 1 && naIsHash(args[0])) naHash_delete(args[0], args[1]);
- return naNil();
+ if(argc < 2 || !naIsHash(args[0])) ARGERR();
+ naHash_delete(args[0], args[1]);
+ return args[0];
}
-static naRef intf(naContext c, naRef me, int argc, naRef* args)
+static naRef f_int(naContext c, naRef me, int argc, naRef* args)
{
if(argc > 0) {
naRef n = naNumValue(args[0]);
if(n.num < 0) n.num = -floor(-n.num);
else n.num = floor(n.num);
return n;
- } else return naNil();
+ } else ARGERR();
+ return naNil();
}
-static naRef num(naContext c, naRef me, int argc, naRef* args)
+static naRef f_num(naContext c, naRef me, int argc, naRef* args)
{
return argc > 0 ? naNumValue(args[0]) : naNil();
}
-static naRef streq(naContext c, naRef me, int argc, naRef* args)
+static naRef f_streq(naContext c, naRef me, int argc, naRef* args)
{
return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
}
char *a, *b;
int i, alen, blen;
if(argc < 2 || !naIsString(args[0]) || !naIsString(args[1]))
- naRuntimeError(c, "bad argument to cmp");
+ ARGERR();
a = naStr_data(args[0]);
alen = naStr_len(args[0]);
b = naStr_data(args[1]);
return naNum(alen == blen ? 0 : (alen < blen ? -1 : 1));
}
-static naRef substr(naContext c, naRef me, int argc, naRef* args)
+static naRef f_substr(naContext c, naRef me, int argc, naRef* args)
{
naRef src = argc > 1 ? args[0] : naNil();
naRef startR = argc > 1 ? naNumValue(args[1]) : naNil();
naRef lenR = argc > 2 ? naNumValue(args[2]) : naNil();
int start, len;
- if(!naIsString(src)) return naNil();
- if(naIsNil(startR)) return naNil();
+ if(!naIsString(src) || naIsNil(startR)) ARGERR();
start = (int)startR.num;
- if(naIsNil(lenR)) {
- len = naStr_len(src) - start;
- if(len < 0) return naNil();
- } else {
- lenR = naNumValue(lenR);
- if(naIsNil(lenR)) return naNil();
- len = (int)lenR.num;
- }
+ len = naIsNil(lenR) ? (naStr_len(src) - start) : (int)lenR.num;
+ if(len < 0) ARGERR();
return naStr_substr(naNewString(c), src, start, len);
}
static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
{
char chr[1];
- naRef cr = argc ? naNumValue(args[0]) : naNil();
- if(IS_NIL(cr)) naRuntimeError(c, "chr argument not string");
+ naRef cr = argc > 0 ? naNumValue(args[0]) : naNil();
+ if(IS_NIL(cr)) ARGERR();
chr[0] = (char)cr.num;
return NEWSTR(c, chr, 1);
}
-static naRef contains(naContext c, naRef me, int argc, naRef* args)
+static naRef f_contains(naContext c, naRef me, int argc, naRef* args)
{
naRef hash = argc > 0 ? args[0] : naNil();
naRef key = argc > 1 ? args[1] : naNil();
- if(naIsNil(hash) || naIsNil(key)) return naNil();
+ if(naIsNil(hash) || naIsNil(key)) ARGERR();
if(!naIsHash(hash)) return naNil();
return naHash_get(hash, key, &key) ? naNum(1) : naNum(0);
}
-static naRef typeOf(naContext c, naRef me, int argc, naRef* args)
+static naRef f_typeof(naContext c, naRef me, int argc, naRef* args)
{
naRef r = argc > 0 ? args[0] : naNil();
char* t = "unknown";
else if(naIsHash(r)) t = "hash";
else if(naIsFunc(r)) t = "func";
else if(naIsGhost(r)) t = "ghost";
- r = NEWCSTR(c, t);
- return r;
+ return NEWCSTR(c, t);
+}
+
+static naRef f_ghosttype(naContext c, naRef me, int argc, naRef* args)
+{
+ naRef g = argc > 0 ? args[0] : naNil();
+ if(!naIsGhost(g)) return naNil();
+ if(naGhost_type(g)->name) {
+ return NEWCSTR(c, (char*)naGhost_type(g)->name);
+ } else {
+ char buf[32];
+ sprintf(buf, "%p", naGhost_type(g));
+ return NEWCSTR(c, buf);
+ }
}
static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
if(!naIsString(script) || !naIsString(fname)) return naNil();
code = naParseCode(c, fname, 1,
naStr_data(script), naStr_len(script), &errLine);
- if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
+ if(naIsNil(code)) {
+ char buf[256];
+ snprintf(buf, sizeof(buf), "Parse error: %s at line %d",
+ naGetError(c), errLine);
+ c->dieArg = NEWCSTR(c, buf);
+ naRuntimeError(c, "__die__");
+ }
return naBindToContext(c, code);
}
+// FIXME: need a place to save the current IP when we get an error so
+// that it can be reset if we get a die()/naRethrowError() situation
+// later. Right now, the IP on the stack trace is the line of the
+// die() call, when it should be this one...
static naRef f_call(naContext c, naRef me, int argc, naRef* args)
{
naContext subc;
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;
+ ARGERR();
+
+ // Note that we don't free the subcontext, in case the user
+ // re-throws the same error. That happens at the next OP_RETURN
+ // or naSubContext().
+ subc = naSubContext(c);
+ vr = IS_NIL(callargs) ? 0 : PTR(callargs).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])) {
- naRef v = args[argc-1];
- if(!IS_NIL(subc->dieArg)) naVec_append(v, subc->dieArg);
- else if(naGetError(subc))
- naVec_append(v, NEWCSTR(subc, naGetError(subc)));
- if(naVec_size(v)) {
- int i, sd = naStackDepth(subc);
+ if(naGetError(subc)) {
+ if(argc <= 2 || !IS_VEC(args[argc-1])) {
+ naRethrowError(subc);
+ } else {
+ int i, sd;
+ naRef errv = args[argc-1];
+ if(!IS_NIL(subc->dieArg)) naVec_append(errv, subc->dieArg);
+ else naVec_append(errv, NEWCSTR(subc, naGetError(subc)));
+ sd = naStackDepth(subc);
for(i=0; i<sd; i++) {
- naVec_append(v, naGetSourceFile(subc, i));
- naVec_append(v, naNum(naGetLine(subc, i)));
+ naVec_append(errv, naGetSourceFile(subc, i));
+ naVec_append(errv, naNum(naGetLine(subc, i)));
}
}
}
- naFreeContext(subc);
return result;
}
static naRef f_die(naContext c, naRef me, int argc, naRef* args)
{
- c->dieArg = argc > 0 ? args[0] : naNil();
+ naRef darg = argc > 0 ? args[0] : naNil();
+ if(!naIsNil(darg) && c->callChild && IDENTICAL(c->callChild->dieArg, darg))
+ naRethrowError(c->callChild);
+ c->dieArg = darg;
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, ...)
+static char* dosprintf(char* f, ...)
{
char* buf;
va_list va;
// 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)
+static char* nextFormat(naContext c, char* f, char** out, int* len, char* type)
{
// Skip to the start of the format string
while(*f && *f != '%') f++;
for(p1 = *out + 1; p1 < f; p1++)
for(p2 = p1+1; p2 < f; p2++)
if(*p1 == *p2)
- naRuntimeError(ctx, "duplicate flag in format string"); }
+ naRuntimeError(c, "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");
+ if(!*f) naRuntimeError(c, "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)
+#define ERR(m) naRuntimeError(c, m)
+#define APPEND(r) result = naStr_concat(naNewString(c), result, r)
+static naRef f_sprintf(naContext c, naRef me, int argc, naRef* args)
{
char t, nultmp, *fstr, *next, *fout=0, *s;
int flen, argn=1;
- naRef format, arg, result = naNewString(ctx);
+ naRef format, arg, result = naNewString(c);
- 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");
+ if(argc < 1) ERR("not enough arguments to sprintf()");
+ format = naStringValue(c, 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
+ while((next = nextFormat(c, s, &fstr, &flen, &t))) {
+ APPEND(NEWSTR(c, s, fstr-s)); // stuff before the format string
if(flen == 2 && fstr[1] == '%') {
- APPEND(NEWSTR(ctx, "%", 1));
+ APPEND(NEWSTR(c, "%", 1));
s = next;
continue;
}
- if(argn >= argc) ERR("not enough arguments to sprintf");
+ 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);
+ arg = naStringValue(c, arg);
if(naIsNil(arg)) fout = dosprintf(fstr, "nil");
else fout = dosprintf(fstr, naStr_data(arg));
} else {
ERR("invalid sprintf format type");
}
fstr[flen] = nultmp;
- APPEND(NEWSTR(ctx, fout, strlen(fout)));
+ APPEND(NEWSTR(c, fout, strlen(fout)));
naFree(fout);
s = next;
}
- APPEND(NEWSTR(ctx, s, strlen(s)));
+ APPEND(NEWSTR(c, s, strlen(s)));
return result;
}
-// FIXME: handle ctx->callParent frames too!
-static naRef f_caller(naContext ctx, naRef me, int argc, naRef* args)
+// FIXME: needs to honor subcontext list
+static naRef f_caller(naContext c, 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()");
+ if(IS_NIL(fr)) ARGERR();
fidx = (int)fr.num;
- if(fidx > ctx->fTop - 1) return naNil();
- frame = &ctx->fStack[ctx->fTop - 1 - fidx];
- result = naNewVector(ctx);
+ if(fidx > c->fTop - 1) return naNil();
+ frame = &c->fStack[c->fTop - 1 - fidx];
+ result = naNewVector(c);
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)));
+ naVec_append(result, PTR(PTR(frame->func).func->code).code->srcFile);
+ naVec_append(result, naNum(naGetLine(c, fidx)));
return result;
}
-static naRef f_closure(naContext ctx, naRef me, int argc, naRef* args)
+static naRef f_closure(naContext c, naRef me, int argc, naRef* args)
{
int i;
struct naFunc* f;
naRef func = argc > 0 ? args[0] : naNil();
naRef idx = argc > 1 ? naNumValue(args[1]) : naNum(0);
- if(!IS_FUNC(func) || IS_NIL(idx))
- naRuntimeError(ctx, "bad arguments to closure()");
+ if(!IS_FUNC(func) || IS_NIL(idx)) ARGERR();
i = (int)idx.num;
- f = func.ref.ptr.func;
- while(i > 0 && f) { i--; f = f->next.ref.ptr.func; }
+ f = PTR(func).func;
+ while(i > 0 && f) { i--; f = PTR(f->next).func; }
if(!f) return naNil();
return f->namespace;
}
return -1;
}
-static naRef f_find(naContext ctx, naRef me, int argc, naRef* args)
+static naRef f_find(naContext c, 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 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
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,
+ return naNum(find(PTR(args[0]).str->data, PTR(args[0]).str->len,
+ PTR(args[1]).str->data, PTR(args[1]).str->len,
start));
}
-static naRef f_split(naContext ctx, naRef me, int argc, naRef* args)
+static naRef f_split(naContext c, 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");
+ if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
d = naStr_data(args[0]); dl = naStr_len(args[0]);
s = naStr_data(args[1]); sl = naStr_len(args[1]);
- result = naNewVector(ctx);
+ result = naNewVector(c);
if(dl == 0) { // special case zero-length delimiter
- for(i=0; i<sl; i++) naVec_append(result, NEWSTR(ctx, s+i, 1));
+ for(i=0; i<sl; i++) naVec_append(result, NEWSTR(c, 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));
+ naVec_append(result, NEWSTR(c, s0, s+i-s0));
s0 = s + i + dl;
i += dl - 1;
}
}
- if(s0 - s <= sl) naVec_append(result, NEWSTR(ctx, s0, s+sl-s0));
+ if(s0 - s <= sl) naVec_append(result, NEWSTR(c, s0, s+sl-s0));
return result;
}
// 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)
+static naRef f_rand(naContext c, naRef me, int argc, naRef* args)
{
int i;
double r = 0;
if(argc) {
- if(!IS_NUM(args[0])) naRuntimeError(ctx, "rand() seed not number");
+ if(!IS_NUM(args[0])) naRuntimeError(c, "rand() seed not number");
srand((unsigned int)args[0].num);
return naNil();
}
return naNum(r);
}
-static naRef f_bind(naContext ctx, naRef me, int argc, naRef* args)
+static naRef f_bind(naContext c, naRef me, int argc, naRef* args)
{
naRef func = argc > 0 ? args[0] : naNil();
- naRef hash = argc > 1 ? args[1] : naNewHash(ctx);
+ naRef hash = argc > 1 ? args[1] : naNewHash(c);
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;
+ ARGERR();
+ func = naNewFunc(c, PTR(func).func->code);
+ PTR(func).func->namespace = hash;
+ PTR(func).func->next = next;
return func;
}
-struct func { char* name; naCFunction func; };
-static struct func funcs[] = {
- { "size", size },
- { "keys", keys },
- { "append", append },
- { "pop", pop },
- { "setsize", setsize },
- { "subvec", subvec },
- { "delete", delete },
- { "int", intf },
- { "num", num },
- { "streq", streq },
+static naCFuncItem funcs[] = {
+ { "size", f_size },
+ { "keys", f_keys },
+ { "append", f_append },
+ { "pop", f_pop },
+ { "setsize", f_setsize },
+ { "subvec", f_subvec },
+ { "delete", f_delete },
+ { "int", f_int },
+ { "num", f_num },
+ { "streq", f_streq },
{ "cmp", f_cmp },
- { "substr", substr },
+ { "substr", f_substr },
{ "chr", f_chr },
- { "contains", contains },
- { "typeof", typeOf },
+ { "contains", f_contains },
+ { "typeof", f_typeof },
+ { "ghosttype", f_ghosttype },
{ "compile", f_compile },
{ "call", f_call },
{ "die", f_die },
{ "split", f_split },
{ "rand", f_rand },
{ "bind", f_bind },
+ { 0 }
};
-naRef naStdLib(naContext c)
+naRef naInit_std(naContext c)
{
- naRef namespace = naNewHash(c);
- int i, n = sizeof(funcs)/sizeof(struct func);
- for(i=0; i<n; i++) {
- naRef code = naNewCCode(c, funcs[i].func);
- naRef name = NEWSTR(c, funcs[i].name, strlen(funcs[i].name));
- name = naInternSymbol(name);
- naHash_set(namespace, name, naNewFunc(c, code));
- }
- return namespace;
+ return naGenLib(c, funcs);
}
return a;
}
-static struct func { char* name; naCFunction func; } funcs[] = {
+static naCFuncItem funcs[] = {
{ "sin", f_sin },
{ "cos", f_cos },
{ "exp", f_exp },
{ "ln", f_ln },
{ "sqrt", f_sqrt },
{ "atan2", f_atan2 },
+ { 0 }
};
-naRef naMathLib(naContext c)
+naRef naInit_math(naContext c)
{
- naRef name, namespace = naNewHash(c);
- int i, n = sizeof(funcs)/sizeof(struct func);
- for(i=0; i<n; i++) {
- naRef code = naNewCCode(c, funcs[i].func);
- naRef name = naStr_fromdata(naNewString(c),
- funcs[i].name, strlen(funcs[i].name));
- naHash_set(namespace, name, naNewFunc(c, code));
- }
-
- // Set up constants for math.pi and math.e. Can't use M_PI or
- // M_E, becuase those aren't technically part of the C standard. Sigh.
- name = naStr_fromdata(naNewString(c), "pi", 2);
- naHash_set(namespace, name, naNum(3.14159265358979323846));
-
- name = naStr_fromdata(naNewString(c), "e", 1);
- name = naInternSymbol(name);
- naHash_set(namespace, name, naNum(2.7182818284590452354));
-
- return namespace;
+ naRef ns = naGenLib(c, funcs);
+ naAddSym(c, ns, "pi", naNum(3.14159265358979323846));
+ naAddSym(c, ns, "e", naNum(2.7182818284590452354));
+ return ns;
}
#include "nasal.h"
#include "code.h"
+static void* chkptr(void* p)
+{
+ naRef foo;
+ SETPTR(foo, p);
+ if(PTR(foo).obj != p) *(int*)0=0;
+ return p;
+}
+
void naFree(void* m) { free(m); }
-void* naAlloc(int n) { return malloc(n); }
-void* naRealloc(void* b, int n) { return realloc(b, n); }
+void* naAlloc(int n) { return chkptr(malloc(n)); }
+void* naRealloc(void* b, int n) { return chkptr(realloc(b, n)); }
void naBZero(void* m, int n) { memset(m, 0, n); }
void naTempSave(naContext c, naRef r)
naFree(c->temps);
c->temps = newtemps;
}
- c->temps[c->ntemps++] = r.ref.ptr.obj;
+ c->temps[c->ntemps++] = PTR(r).obj;
}
naRef naObj(int type, struct naObj* o)
{
naRef r;
- r.ref.reftag = NASAL_REFTAG;
- r.ref.ptr.obj = o;
+ SETPTR(r, o);
o->type = type;
return r;
}
naRef naNewString(struct Context* c)
{
naRef s = naNew(c, T_STR);
- s.ref.ptr.str->len = 0;
- s.ref.ptr.str->data = 0;
- s.ref.ptr.str->hashcode = 0;
+ PTR(s).str->len = 0;
+ PTR(s).str->data = 0;
+ PTR(s).str->hashcode = 0;
return s;
}
naRef naNewVector(struct Context* c)
{
naRef r = naNew(c, T_VEC);
- r.ref.ptr.vec->rec = 0;
+ PTR(r).vec->rec = 0;
return r;
}
naRef naNewHash(struct Context* c)
{
naRef r = naNew(c, T_HASH);
- r.ref.ptr.hash->rec = 0;
+ PTR(r).hash->rec = 0;
return r;
}
naRef naNewCCode(struct Context* c, naCFunction fptr)
{
naRef r = naNew(c, T_CCODE);
- r.ref.ptr.ccode->fptr = fptr;
+ PTR(r).ccode->fptr = fptr;
return r;
}
naRef naNewFunc(struct Context* c, naRef code)
{
naRef func = naNew(c, T_FUNC);
- func.ref.ptr.func->code = code;
- func.ref.ptr.func->namespace = naNil();
- func.ref.ptr.func->next = naNil();
+ PTR(func).func->code = code;
+ PTR(func).func->namespace = naNil();
+ PTR(func).func->next = naNil();
return func;
}
naRef naNewGhost(naContext c, naGhostType* type, void* ptr)
{
naRef ghost = naNew(c, T_GHOST);
- ghost.ref.ptr.ghost->gtype = type;
- ghost.ref.ptr.ghost->ptr = ptr;
+ PTR(ghost).ghost->gtype = type;
+ PTR(ghost).ghost->ptr = ptr;
return ghost;
}
naGhostType* naGhost_type(naRef ghost)
{
if(!IS_GHOST(ghost)) return 0;
- return ghost.ref.ptr.ghost->gtype;
+ return PTR(ghost).ghost->gtype;
}
void* naGhost_ptr(naRef ghost)
{
if(!IS_GHOST(ghost)) return 0;
- return ghost.ref.ptr.ghost->ptr;
+ return PTR(ghost).ghost->ptr;
}
naRef naNil()
{
- naRef r;
- r.ref.reftag = NASAL_REFTAG;
- r.ref.ptr.obj = 0;
+ naRef r;
+ SETPTR(r, 0);
return r;
}
naRef naNum(double num)
{
naRef r;
- r.ref.reftag = ~NASAL_REFTAG;
- r.num = num;
+ SETNUM(r, num);
return r;
}
int naEqual(naRef a, naRef b)
{
double na=0, nb=0;
- if(IS_REF(a) && IS_REF(b) && a.ref.ptr.obj == b.ref.ptr.obj)
+ if(IS_REF(a) && IS_REF(b) && PTR(a).obj == PTR(b).obj)
return 1; // Object identity (and nil == nil)
if(IS_NIL(a) || IS_NIL(b))
return 0;
int i;
if(!(IS_STR(a) && IS_STR(b)))
return 0;
- if(a.ref.ptr.str->len != b.ref.ptr.str->len)
+ if(PTR(a).str->len != PTR(b).str->len)
return 0;
- for(i=0; i<a.ref.ptr.str->len; i++)
- if(a.ref.ptr.str->data[i] != b.ref.ptr.str->data[i])
+ for(i=0; i<PTR(a).str->len; i++)
+ if(PTR(a).str->data[i] != PTR(b).str->data[i])
return 0;
return 1;
}
int naIsCode(naRef r) { return IS_CODE(r); }
int naIsCCode(naRef r) { return IS_CCODE(r); }
int naIsGhost(naRef r) { return IS_GHOST(r); }
+
+void naSetUserData(naContext c, void* p) { c->userData = p; }
+void* naGetUserData(naContext c)
+{
+ if(c->userData) return c->userData;
+ return c->callParent ? naGetUserData(c->callParent) : 0;
+}
+
+void naAddSym(naContext c, naRef ns, char *sym, naRef val)
+{
+ naRef name = naStr_fromdata(naNewString(c), sym, strlen(sym));
+ naHash_set(ns, naInternSymbol(name), val);
+}
+
+naRef naGenLib(naContext c, naCFuncItem *fns)
+{
+ naRef ns = naNewHash(c);
+ for(/**/; fns->name; fns++)
+ naAddSym(c, ns, fns->name, naNewFunc(c, naNewCCode(c, fns->func)));
+ return ns;
+}
--- /dev/null
+#ifndef _NAREF_H
+#define _NAREF_H
+
+/* Rather than play elaborate and complicated games with
+ * platform-dependent endianness headers, just detect the platforms we
+ * support. This list is simpler and smaller, yet still quite
+ * complete. */
+#if (defined(__x86_64) && defined(__linux__)) || defined(__sparcv9)
+/* Win64 and Irix should work with this too, but have not been
+ * tested */
+# define NASAL_NAN64
+#elif defined(_M_X86) || defined(i386) || defined(__x86_64) || \
+ defined(__ia64__) || defined(_M_IA64) || defined(__ARMEL__)
+# define NASAL_LE
+#elif defined(__sparc) || defined(__ppc__) || defined(__mips) || \
+ defined(__ARMEB__)
+# define NASAL_BE
+#else
+# error Unrecognized CPU architecture
+#endif
+
+typedef union {
+ struct naObj* obj;
+ struct naStr* str;
+ struct naVec* vec;
+ struct naHash* hash;
+ struct naCode* code;
+ struct naFunc* func;
+ struct naCCode* ccode;
+ struct naGhost* ghost;
+} naPtr;
+
+#if defined(NASAL_NAN64)
+
+/* On suppoted 64 bit platforms (those where all memory returned from
+ * naAlloc() is guaranteed to lie between 0 and 2^48-1) we union the
+ * double with the pointer, and use fancy tricks (see data.h) to make
+ * sure all pointers are stored as NaNs. */
+typedef union { double num; void* ptr; } naRef;
+
+#elif defined(NASAL_LE) || defined(NASAL_BE)
+
+/* 32 bit layouts (and 64 bit platforms where we haven't tested the
+ trick above) need endianness-dependent ordering to make sure that
+ the reftag lies in the top bits of the double */
+#ifdef NASAL_LE
+typedef struct { naPtr ptr; int reftag; } naRefPart;
+#else /* NASAL_BE */
+typedef struct { int reftag; naPtr ptr; } naRefPart;
+#endif
+
+typedef union {
+ double num;
+ naRefPart ref;
+} naRef;
+
+#endif
+
+#endif // _NAREF_H
extern "C" {
#endif
-#ifndef BYTE_ORDER
-
-# if (BSD >= 199103)
-# include <machine/endian.h>
-# elif defined(__CYGWIN__) || defined(__MINGW32__)
-# include <sys/param.h>
-# elif defined(linux)
-# include <endian.h>
-# else
-# ifndef LITTLE_ENDIAN
-# define LITTLE_ENDIAN 1234 /* LSB first: i386, vax */
-# endif
-# ifndef BIG_ENDIAN
-# define BIG_ENDIAN 4321 /* MSB first: 68000, ibm, net */
-# endif
-
-# if defined(ultrix) || defined(__alpha__) || defined(__alpha) || \
- defined(__i386__) || defined(__i486__) || defined(_X86_) || \
- defined(sun386)
-# define BYTE_ORDER LITTLE_ENDIAN
-# else
-# define BYTE_ORDER BIG_ENDIAN
-# endif
-# endif /* BSD */
-#endif /* BYTE_ORDER */
-
-#if BYTE_ORDER == BIG_ENDIAN
-# include <limits.h>
-# if (LONG_MAX == 2147483647)
-# define NASAL_BIG_ENDIAN_32_BIT 1
-# endif
-#endif
-
-// This is a nasal "reference". They are always copied by value, and
-// contain either a pointer to a garbage-collectable nasal object
-// (string, vector, hash) or a floating point number. Keeping the
-// number here is an optimization to prevent the generation of
-// zillions of tiny "number" object that have to be collected. Note
-// sneaky hack: on little endian systems, placing reftag after ptr and
-// putting 1's in the top 13 (except the sign bit) bits makes the
-// double value a NaN, and thus unmistakable (no actual number can
-// appear as a reference, and vice versa). Swap the structure order
-// on 32 bit big-endian systems. On 64 bit sytems of either
-// endianness, reftag and the double won't be coincident anyway.
-#define NASAL_REFTAG 0x7ff56789 // == 2,146,789,257 decimal
-typedef union {
- double num;
- struct {
-#ifdef NASAL_BIG_ENDIAN_32_BIT
- int reftag; // Big-endian systems need this here!
-#endif
- union {
- struct naObj* obj;
- struct naStr* str;
- struct naVec* vec;
- struct naHash* hash;
- struct naCode* code;
- struct naFunc* func;
- struct naCCode* ccode;
- struct naGhost* ghost;
- } ptr;
-#ifndef NASAL_BIG_ENDIAN_32_BIT
- int reftag; // Little-endian and 64 bit systems need this here!
-#endif
- } ref;
-} naRef;
+#include "naref.h"
typedef struct Context* naContext;
naContext naNewContext();
void naFreeContext(naContext c);
-// Save this object in the context, preventing it (and objects
+// Use this when making a call to a new context "underneath" a
+// preexisting context on the same stack. It allows stack walking to
+// see through the boundary, and eliminates the need to release the
+// mod lock (i.e. must be called with the mod lock held!)
+naContext naSubContext(naContext super);
+
+// The naContext supports a user data pointer that can be used to
+// store data specific to an naCall invocation without exposing it to
+// Nasal as a ghost. FIXME: this API is semi-dangerous, there is no
+// provision for sharing it, nor for validating the source or type of
+// the pointer returned.
+void naSetUserData(naContext c, void* p);
+void* naGetUserData(naContext c);
+
+// "Save" this object in the context, preventing it (and objects
// referenced by it) from being garbage collected.
void naSave(naContext ctx, naRef obj);
// temporaries to protect them before passing back into a naCall.
void naTempSave(naContext c, naRef r);
-// Parse a buffer in memory into a code object.
+// Parse a buffer in memory into a code object. The srcFile parameter
+// is a Nasal string representing the "file" from which the code is
+// read. The "first line" is typically 1, but is settable for
+// situations where the Nasal code is embedded in another context with
+// its own numbering convetions. If an error occurs, returns nil and
+// sets the errLine pointer to point to the line at fault. The string
+// representation of the error can be retrieved with naGetError() on
+// the context.
naRef naParseCode(naContext c, naRef srcFile, int firstLine,
char* buf, int len, int* errLine);
// Binds a bare code object (as returned from naParseCode) with a
// closure object (a hash) to act as the outer scope / namespace.
-// FIXME: this API is weak. It should expose the recursive nature of
-// closures, and allow for extracting the closure and namespace
-// information from function objects.
naRef naBindFunction(naContext ctx, naRef code, naRef closure);
// Similar, but it binds to the current context's closure (i.e. the
// namespace at the top of the current call stack).
naRef naBindToContext(naContext ctx, naRef code);
-// Call a code or function object with the specifed arguments "on" the
-// specified object and using the specified hash for the local
-// variables. Any of args, obj or locals may be nil.
-naRef naCall(naContext ctx, naRef func, int argc, naRef* args, naRef obj, naRef locals);
+// Call a code or function object with the specified arguments "on"
+// the specified object and using the specified hash for the local
+// variables. Passing a null args array skips the parameter variables
+// (e.g. "arg") assignments; to get a zero-length arg instead, pass in
+// argc==0 and a non-null args vector. The obj or locals parameters
+// may be nil. Will attempt to acquire the mod lock, so call
+// naModUnlock() first if the lock is already held.
+naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
+ naRef obj, naRef locals);
+
+// As naCall(), but continues execution at the operation after a
+// previous die() call or runtime error. Useful to do "yield"
+// semantics, leaving the context in a condition where it can be
+// restarted from C code. Cannot be used currently to restart a
+// failed operation. Will attempt to acquire the mod lock, so call
+// naModUnlock() first if the lock is already held.
+naRef naContinue(naContext ctx);
// Throw an error from the current call stack. This function makes a
// longjmp call to a handler in naCall() and DOES NOT RETURN. It is
// intended for use in library code that cannot otherwise report an
// error via the return value, and MUST be used carefully. If in
-// doubt, return naNil() as your error condition.
-void naRuntimeError(naContext ctx, char* msg);
+// doubt, return naNil() as your error condition. Works like
+// printf().
+void naRuntimeError(naContext c, const char* fmt, ...);
-// Call a method on an object (NOTE: func is a function binding, *not*
-// a code object as returned from naParseCode).
-naRef naMethod(naContext ctx, naRef func, naRef object);
+// "Re-throws" a runtime error caught from the subcontext. Acts as a
+// naRuntimeError() called on the parent context. Does not return.
+void naRethrowError(naContext subc);
+
+// Retrieve the specified member from the object, respecting the
+// "parents" array as for "object.field". Returns zero for missing
+// fields.
+int naMember_get(naRef obj, naRef field, naRef* out);
+int naMember_cget(naRef obj, const char* field, naRef* out);
// Returns a hash containing functions from the Nasal standard library
// Useful for passing as a namespace to an initial function call
-naRef naStdLib(naContext c);
+naRef naInit_std(naContext c);
// Ditto, for other core libraries
-naRef naMathLib(naContext c);
-naRef naBitsLib(naContext c);
-naRef naIOLib(naContext c);
-naRef naRegexLib(naContext c);
-naRef naUnixLib(naContext c);
-
-// Current line number & error message
+naRef naInit_math(naContext c);
+naRef naInit_bits(naContext c);
+naRef naInit_io(naContext c);
+naRef naInit_regex(naContext c);
+naRef naInit_unix(naContext c);
+naRef naInit_thread(naContext c);
+naRef naInit_utf8(naContext c);
+naRef naInit_sqlite(naContext c);
+naRef naInit_readline(naContext c);
+naRef naInit_gtk(naContext ctx);
+naRef naInit_cairo(naContext ctx);
+
+// Context stack inspection, frame zero is the "top"
int naStackDepth(naContext ctx);
int naGetLine(naContext ctx, int frame);
naRef naGetSourceFile(naContext ctx, int frame);
// Ghost utilities:
typedef struct naGhostType {
void (*destroy)(void* ghost);
+ const char* name;
} naGhostType;
naRef naNewGhost(naContext c, naGhostType* t, void* ghost);
naGhostType* naGhost_type(naRef ghost);
// Acquires a "modification lock" on a context, allowing the C code to
// modify Nasal data without fear that such data may be "lost" by the
-// garbage collector (the C stack is not examined in GC!). This
-// disallows garbage collection until the current thread can be
-// blocked. The lock should be acquired whenever modifications to
-// Nasal objects are made. It need not be acquired when only read
-// access is needed. It MUST NOT be acquired by naCFunction's, as
-// those are called with the lock already held; acquiring two locks
-// for the same thread will cause a deadlock when the GC is invoked.
-// It should be UNLOCKED by naCFunction's when they are about to do
-// any long term non-nasal processing and/or blocking I/O.
+// garbage collector (nasal data the C stack is not examined in GC!).
+// This disallows garbage collection until the current thread can be
+// blocked. The lock should be acquired whenever nasal objects are
+// being modified. It need not be acquired when only read access is
+// needed, PRESUMING that the Nasal data being read is findable by the
+// collector (via naSave, for example) and that another Nasal thread
+// cannot or will not delete the reference to the data. It MUST NOT
+// be acquired by naCFunction's, as those are called with the lock
+// already held; acquiring two locks for the same thread will cause a
+// deadlock when the GC is invoked. It should be UNLOCKED by
+// naCFunction's when they are about to do any long term non-nasal
+// processing and/or blocking I/O. Note that naModLock() may need to
+// block to allow garbage collection to occur, and that garbage
+// collection by other threads may be blocked until naModUnlock() is
+// called. It must also be UNLOCKED by threads that hold a lock
+// already before making a naCall() or naContinue() call -- these
+// functions will attempt to acquire the lock again.
void naModLock();
void naModUnlock();
+// Library utilities. Generate namespaces and add symbols.
+typedef struct { char* name; naCFunction func; } naCFuncItem;
+naRef naGenLib(naContext c, naCFuncItem *funcs);
+void naAddSym(naContext c, naRef ns, char *sym, naRef val);
+
#ifdef __cplusplus
} // extern "C"
#endif
#include <setjmp.h>
+#include <string.h>
#include "parse.h"
// Static precedence table, from low (loose binding, do first) to high
// (tight binding, do last).
-enum { PREC_BINARY, PREC_REVERSE, PREC_PREFIX, PREC_SUFFIX };
-
#define MAX_PREC_TOKS 6
struct precedence {
int toks[MAX_PREC_TOKS];
void naParseError(struct Parser* p, char* msg, int line)
{
+ // Some errors (e.g. code generation of a null pointer) lack a
+ // line number, so we throw -1 and set the line earlier.
+ if(line > 0) p->errLine = line;
p->err = msg;
- p->errLine = line;
longjmp(p->jumpHandle, 1);
}
return t;
}
+// Synthesize a curly brace token to wrap token t foward to the end of
+// "statement". FIXME: unify this with the addNewChild(), which does
+// very similar stuff.
+static void embrace(struct Parser* p, struct Token* t)
+{
+ struct Token *b, *end = t;
+ if(!t) return;
+ while(end->next) {
+ if(end->next->type == TOK_SEMI) {
+ // Slurp up the semi, iff it is followed by an else/elsif,
+ // otherwise leave it in place.
+ if(end->next->next) {
+ if(end->next->next->type == TOK_ELSE) end = end->next;
+ if(end->next->next->type == TOK_ELSIF) end = end->next;
+ }
+ break;
+ }
+ if(end->next->type == TOK_COMMA) break;
+ if(end->next->type == TOK_ELSE) break;
+ if(end->next->type == TOK_ELSIF) break;
+ end = end->next;
+ }
+ b = emptyToken(p);
+ b->type = TOK_LCURL;
+ b->line = t->line;
+ b->parent = t->parent;
+ b->prev = t->prev;
+ b->next = end->next;
+ b->children = t;
+ b->lastChild = end;
+ if(t->prev) t->prev->next = b;
+ else b->parent->children = b;
+ if(end->next) end->next->prev = b;
+ else b->parent->lastChild = b;
+ t->prev = 0;
+ end->next = 0;
+ for(; t; t = t->next)
+ t->parent = b;
+}
+
+#define NEXT(t) (t ? t->next : 0)
+#define TYPE(t) (t ? t->type : -1)
+
+static void fixBracelessBlocks(struct Parser* p, struct Token* t)
+{
+ // Find the end, and march *backward*
+ while(t && t->next) t = t->next;
+ for(/**/; t; t=t->prev) {
+ switch(t->type) {
+ case TOK_FOR: case TOK_FOREACH: case TOK_FORINDEX: case TOK_WHILE:
+ case TOK_IF: case TOK_ELSIF:
+ if(TYPE(NEXT(t)) == TOK_LPAR && TYPE(NEXT(NEXT(t))) != TOK_LCURL)
+ embrace(p, t->next->next);
+ break;
+ case TOK_ELSE:
+ if(TYPE(NEXT(t)) != TOK_LCURL)
+ embrace(p, t->next);
+ break;
+ case TOK_FUNC:
+ if(TYPE(NEXT(t)) == TOK_LPAR) {
+ if(TYPE(NEXT(NEXT(t))) != TOK_LCURL)
+ embrace(p, NEXT(NEXT(t)));
+ } else if(TYPE(NEXT(t)) != TOK_LCURL)
+ embrace(p, t->next);
+ break;
+ default:
+ break;
+ }
+ }
+}
+
// Fixes up parenting for obvious parsing situations, like code blocks
// being the child of a func keyword, etc...
static void fixBlockStructure(struct Parser* p, struct Token* start)
{
struct Token *t, *c;
+ fixBracelessBlocks(p, start);
t = start;
while(t) {
switch(t->type) {
addSemi = 1;
break;
}
- if(t->next && t->next->type == TOK_SEMI)
- addSemi = 0; // don't bother if it's already there!
+ if(!t->next || t->next->type == TOK_SEMI || t->next->type == TOK_COMMA)
+ addSemi = 0; // don't bother, no need
if(addSemi) {
struct Token* semi = emptyToken(p);
semi->type = TOK_SEMI;
semi->prev = t;
semi->parent = t->parent;
if(semi->next) semi->next->prev = semi;
+ else semi->parent->lastChild = semi;
t->next = semi;
t = semi; // don't bother checking the new one
}
if(!top)
return parsePrecedence(p, start, end, level+1);
+ top->rule = rule;
+
if(left) {
left->next = right;
left->prev = 0;
// Catch parser errors here.
*errLine = 0;
if(setjmp(p.jumpHandle)) {
- c->error = p.err;
+ strncpy(c->error, p.err, sizeof(c->error));
*errLine = p.errLine;
return naNil();
}
return codeObj;
}
-
-
TOK_FORINDEX
};
+// Precedence rules
+enum { PREC_BINARY=1, PREC_REVERSE, PREC_PREFIX, PREC_SUFFIX };
+
struct Token {
int type;
int line;
char* str;
int strlen;
+ int rule;
double num;
struct Token* parent;
struct Token* next;
void* naParseAlloc(struct Parser* p, int bytes);
void naParseDestroy(struct Parser* p);
void naLex(struct Parser* p);
+int naLexUtf8C(char* s, int len, int* used); /* in utf8lib.c */
naRef naCodeGen(struct Parser* p, struct Token* block, struct Token* arglist);
void naParse(struct Parser* p);
int naStr_len(naRef s)
{
if(!IS_STR(s)) return 0;
- return s.ref.ptr.str->len;
+ return PTR(s).str->len;
}
char* naStr_data(naRef s)
{
if(!IS_STR(s)) return 0;
- return (char*)s.ref.ptr.str->data;
+ return (char*)PTR(s).str->data;
}
static void setlen(struct naStr* s, int sz)
naRef naStr_buf(naRef dst, int len)
{
- setlen(dst.ref.ptr.str, len);
- naBZero(dst.ref.ptr.str->data, len);
+ setlen(PTR(dst).str, len);
+ naBZero(PTR(dst).str->data, len);
return dst;
}
naRef naStr_fromdata(naRef dst, char* data, int len)
{
if(!IS_STR(dst)) return naNil();
- setlen(dst.ref.ptr.str, len);
- memcpy(dst.ref.ptr.str->data, data, len);
+ setlen(PTR(dst).str, len);
+ memcpy(PTR(dst).str->data, data, len);
return dst;
}
naRef naStr_concat(naRef dest, naRef s1, naRef s2)
{
- struct naStr* dst = dest.ref.ptr.str;
- struct naStr* a = s1.ref.ptr.str;
- struct naStr* b = s2.ref.ptr.str;
+ struct naStr* dst = PTR(dest).str;
+ struct naStr* a = PTR(s1).str;
+ struct naStr* b = PTR(s2).str;
if(!(IS_STR(s1)&&IS_STR(s2)&&IS_STR(dest))) return naNil();
setlen(dst, a->len + b->len);
memcpy(dst->data, a->data, a->len);
naRef naStr_substr(naRef dest, naRef str, int start, int len)
{
- struct naStr* dst = dest.ref.ptr.str;
- struct naStr* s = str.ref.ptr.str;
+ struct naStr* dst = PTR(dest).str;
+ struct naStr* s = PTR(str).str;
if(!(IS_STR(dest)&&IS_STR(str))) return naNil();
if(start + len > s->len) { dst->len = 0; dst->data = 0; return naNil(); }
setlen(dst, len);
int naStr_equal(naRef s1, naRef s2)
{
- struct naStr* a = s1.ref.ptr.str;
- struct naStr* b = s2.ref.ptr.str;
+ struct naStr* a = PTR(s1).str;
+ struct naStr* b = PTR(s2).str;
if(a->data == b->data) return 1;
if(a->len != b->len) return 0;
if(memcmp(a->data, b->data, a->len) == 0) return 1;
naRef naStr_fromnum(naRef dest, double num)
{
- struct naStr* dst = dest.ref.ptr.str;
+ struct naStr* dst = PTR(dest).str;
unsigned char buf[DIGITS+8];
setlen(dst, fromnum(num, buf));
memcpy(dst->data, buf, dst->len);
int naStr_tonum(naRef str, double* out)
{
- return tonum(str.ref.ptr.str->data, str.ref.ptr.str->len, out);
+ return tonum(PTR(str).str->data, PTR(str).str->len, out);
}
int naStr_numeric(naRef str)
{
double dummy;
- return tonum(str.ref.ptr.str->data, str.ref.ptr.str->len, &dummy);
+ return tonum(PTR(str).str->data, PTR(str).str->len, &dummy);
}
void naStr_gcclean(struct naStr* str)
return lock;
}
+void naFreeLock(void* lock)
+{
+ pthread_mutex_destroy(lock);
+ naFree(lock);
+}
+
void naLock(void* lock)
{
pthread_mutex_lock((pthread_mutex_t*)lock);
return sem;
}
+void naFreeSem(void* p)
+{
+ struct naSem* sem = p;
+ pthread_mutex_destroy(&sem->lock);
+ pthread_cond_destroy(&sem->cvar);
+ naFree(sem);
+}
+
void naSemDown(void* sh)
{
struct naSem* sem = (struct naSem*)sh;
pthread_mutex_unlock(&sem->lock);
}
-void naSemUpAll(void* sh, int count)
+void naSemUp(void* sh, int count)
{
struct naSem* sem = (struct naSem*)sh;
pthread_mutex_lock(&sem->lock);
- sem->count = count;
+ sem->count += count;
pthread_cond_broadcast(&sem->cvar);
pthread_mutex_unlock(&sem->lock);
}
void naUnlock(void* lock) { LeaveCriticalSection((LPCRITICAL_SECTION)lock); }
void* naNewSem() { return CreateSemaphore(0, 0, MAX_SEM_COUNT, 0); }
void naSemDown(void* sem) { WaitForSingleObject((HANDLE)sem, INFINITE); }
-void naSemUpAll(void* sem, int count) { ReleaseSemaphore(sem, count, 0); }
+void naSemUp(void* sem, int count) { ReleaseSemaphore(sem, count, 0); }
#endif
--- /dev/null
+#ifdef _WIN32
+#include <windows.h>
+#else
+#include <pthread.h>
+#endif
+
+#include "data.h"
+#include "code.h"
+
+static void lockDestroy(void* lock) { naFreeLock(lock); }
+static naGhostType LockType = { lockDestroy };
+
+static void semDestroy(void* sem) { naFreeSem(sem); }
+static naGhostType SemType = { semDestroy };
+
+typedef struct {
+ naContext ctx;
+ naRef func;
+} ThreadData;
+
+#ifdef _WIN32
+static DWORD WINAPI threadtop(LPVOID param)
+#else
+static void* threadtop(void* param)
+#endif
+{
+ ThreadData* td = param;
+ naCall(td->ctx, td->func, 0, 0, naNil(), naNil());
+ naFreeContext(td->ctx);
+ naFree(td);
+ return 0;
+}
+
+static naRef f_newthread(naContext c, naRef me, int argc, naRef* args)
+{
+ ThreadData *td;
+ if(argc < 1 || !naIsFunc(args[0]))
+ naRuntimeError(c, "bad/missing argument to newthread");
+ td = naAlloc(sizeof(*td));
+ td->ctx = naNewContext();
+ td->func = args[0];
+ naTempSave(td->ctx, td->func);
+#ifdef _WIN32
+ CreateThread(0, 0, threadtop, td, 0, 0);
+#else
+ { pthread_t t; pthread_create(&t, 0, threadtop, td); }
+#endif
+ return naNil();
+}
+
+static naRef f_newlock(naContext c, naRef me, int argc, naRef* args)
+{
+ return naNewGhost(c, &LockType, naNewLock());
+}
+
+static naRef f_lock(naContext c, naRef me, int argc, naRef* args)
+{
+ if(argc > 0 && naGhost_type(args[0]) == &LockType)
+ naLock(naGhost_ptr(args[0]));
+ return naNil();
+}
+
+static naRef f_unlock(naContext c, naRef me, int argc, naRef* args)
+{
+ if(argc > 0 && naGhost_type(args[0]) == &LockType)
+ naUnlock(naGhost_ptr(args[0]));
+ return naNil();
+}
+
+static naRef f_newsem(naContext c, naRef me, int argc, naRef* args)
+{
+ return naNewGhost(c, &SemType, naNewSem());
+}
+
+static naRef f_semdown(naContext c, naRef me, int argc, naRef* args)
+{
+ if(argc > 0 && naGhost_type(args[0]) == &SemType)
+ naSemDown(naGhost_ptr(args[0]));
+ return naNil();
+}
+
+static naRef f_semup(naContext c, naRef me, int argc, naRef* args)
+{
+ if(argc > 0 && naGhost_type(args[0]) == &SemType)
+ naSemUp(naGhost_ptr(args[0]), 1);
+ return naNil();
+}
+
+static naCFuncItem funcs[] = {
+ { "newthread", f_newthread },
+ { "newlock", f_newlock },
+ { "lock", f_lock },
+ { "unlock", f_unlock },
+ { "newsem", f_newsem },
+ { "semdown", f_semdown },
+ { "semup", f_semup },
+ { 0 }
+};
+
+naRef naInit_thread(naContext c)
+{
+ return naGenLib(c, funcs);
+}
--- /dev/null
+#include <string.h>
+#include "nasal.h"
+#include "parse.h"
+
+// bytes required to store a given character
+static int cbytes(unsigned int c)
+{
+ static const int NB[] = { 0x7f, 0x07ff, 0xffff, 0x001fffff, 0x03ffffff };
+ int i;
+ for(i=0; i<(sizeof(NB)/sizeof(NB[0])) && c>NB[i]; i++) {}
+ return i+1;
+}
+
+// Returns a byte with the N high order bits set
+#define TOPBITS(n) ((unsigned char)(((signed char)0x80)>>((n)-1)))
+
+// write a utf8 character, return bytes written or zero on error
+static int writec(unsigned int c, unsigned char* s, int len)
+{
+ int i, n = cbytes(c);
+ if(len < n) return 0;
+ for(i=n-1; i>0; i--) {
+ s[i] = 0x80 | (c & 0x3f);
+ c >>= 6;
+ }
+ s[0] = (n > 1 ? TOPBITS(n) : 0) | c;
+ return n;
+}
+
+// read a utf8 character, or -1 on error.
+static int readc(unsigned char* s, int len, int* used)
+{
+ int n, i, c;
+ if(len > 0 && s[0] < 0x80) { *used = 1; return s[0]; }
+ for(n=2; n<7; n++)
+ if((s[0] & TOPBITS(n+1)) == TOPBITS(n))
+ break;
+ if(len < n || n > 6) return -1;
+ c = s[0] & (~TOPBITS(n+1));
+ for(i=1; i<n; i++) {
+ if((s[i] >> 6) != 2) return -1;
+ c = (c << 6) | (s[i] & 0x3f);
+ }
+ if(n != cbytes(c)) return -1;
+ *used = n;
+ return c;
+}
+
+/* Public symbol used by the parser */
+int naLexUtf8C(char* s, int len, int* used)
+{ return readc((void*)s, len, used); }
+
+static unsigned char* nthchar(unsigned char* s, int n, int* len)
+{
+ int i, bytes;
+ for(i=0; *len && i<n; i++) {
+ if(readc(s, *len, &bytes) < 0) return 0;
+ s += bytes; *len -= bytes;
+ }
+ return s;
+}
+
+static naRef f_chstr(naContext ctx, naRef me, int argc, naRef* args)
+{
+ int n;
+ naRef ch;
+ unsigned char buf[6];
+ if(argc < 1 || naIsNil(ch=naNumValue(args[0])))
+ naRuntimeError(ctx, "bad/missing argument to utf8.chstr");
+ n = writec((int)ch.num, buf, sizeof(buf));
+ return naStr_fromdata(naNewString(ctx), (void*)buf, n);
+}
+
+static naRef f_size(naContext c, naRef me, int argc, naRef* args)
+{
+ unsigned char* s;
+ int sz=0, n, len;
+ if(argc < 1 || !naIsString(args[0]))
+ naRuntimeError(c, "bad/missing argument to utf8.strc");
+ s = (void*)naStr_data(args[0]);
+ len = naStr_len(args[0]);
+ while(len > 0) {
+ if(readc(s, len, &n) < 0)
+ naRuntimeError(c, "utf8 encoding error in utf8.size");
+ sz++; len -= n; s += n;
+ }
+ return naNum(sz);
+}
+
+static naRef f_strc(naContext ctx, naRef me, int argc, naRef* args)
+{
+ naRef idx;
+ unsigned char* s;
+ int len, c=0, bytes;
+ if(argc < 2 || !naIsString(args[0]) || naIsNil(idx=naNumValue(args[1])))
+ naRuntimeError(ctx, "bad/missing argument to utf8.strc");
+ len = naStr_len(args[0]);
+ s = nthchar((void*)naStr_data(args[0]), (int)idx.num, &len);
+ if(!s || (c = readc(s, len, &bytes)) < 0)
+ naRuntimeError(ctx, "utf8 encoding error in utf8.strc");
+ return naNum(c);
+}
+
+static naRef f_substr(naContext c, naRef me, int argc, naRef* args)
+{
+ naRef start, end;
+ int len;
+ unsigned char *s, *s2;
+ end = argc > 2 ? naNumValue(args[2]) : naNil();
+ if((argc < 2 || !naIsString(args[0]) || naIsNil(start=naNumValue(args[1])))
+ || (argc > 2 && naIsNil(end)))
+ naRuntimeError(c, "bad/missing argument to utf8.substr");
+ len = naStr_len(args[0]);
+ if(!(s = nthchar((void*)naStr_data(args[0]), (int)start.num, &len)))
+ naRuntimeError(c, "start index overrun in utf8.substr");
+ if(!naIsNil(end)) {
+ if(!(s2 = nthchar(s, (int)end.num, &len)))
+ naRuntimeError(c, "end index overrun in utf8.substr");
+ len = (int)(s2-s);
+ }
+ return naStr_fromdata(naNewString(c), (void*)s, len);
+}
+
+static naRef f_validate(naContext c, naRef me, int argc, naRef* args)
+{
+ naRef result, unkc=naNil();
+ int len, len2, lenout=0, n;
+ unsigned char *s, *s2, *buf;
+ if(argc < 1 || !naIsString(args[0]) ||
+ (argc > 1 && naIsNil(unkc=naNumValue(args[1]))))
+ naRuntimeError(c, "bad/missing argument to utf8.strc");
+ if(naIsNil(unkc)) unkc = naNum('?');
+ len = naStr_len(args[0]);
+ s = (void*)naStr_data(args[0]);
+ len2 = 6*len; // max for ridiculous unkc values
+ s2 = buf = naAlloc(len2);
+ while(len > 0) {
+ int c = readc(s, len, &n);
+ if(c < 0) { c = (int)unkc.num; n = 1; }
+ s += n; len -= n;
+ n = writec(c, s2, len2);
+ s2 += n; len2 -= n; lenout += n;
+ }
+ result = naStr_fromdata(naNewString(c), (char*)buf, lenout);
+ naFree(buf);
+ return result;
+}
+
+static naCFuncItem funcs[] = {
+ { "chstr", f_chstr },
+ { "strc", f_strc },
+ { "substr", f_substr },
+ { "size", f_size },
+ { "validate", f_validate },
+ { 0 }
+};
+
+naRef naInit_utf8(naContext c)
+{
+ return naGenLib(c, funcs);
+}
naRef naVec_get(naRef v, int i)
{
if(IS_VEC(v)) {
- struct VecRec* r = v.ref.ptr.vec->rec;
+ struct VecRec* r = PTR(v).vec->rec;
if(r) {
if(i < 0) i += r->size;
if(i >= 0 && i < r->size) return r->array[i];
void naVec_set(naRef vec, int i, naRef o)
{
if(IS_VEC(vec)) {
- struct VecRec* r = vec.ref.ptr.vec->rec;
+ struct VecRec* r = PTR(vec).vec->rec;
if(r && i >= r->size) return;
r->array[i] = o;
}
int naVec_size(naRef v)
{
if(IS_VEC(v)) {
- struct VecRec* r = v.ref.ptr.vec->rec;
+ struct VecRec* r = PTR(v).vec->rec;
return r ? r->size : 0;
}
return 0;
int naVec_append(naRef vec, naRef o)
{
if(IS_VEC(vec)) {
- struct VecRec* r = vec.ref.ptr.vec->rec;
+ struct VecRec* r = PTR(vec).vec->rec;
while(!r || r->size >= r->alloced) {
- resize(vec.ref.ptr.vec);
- r = vec.ref.ptr.vec->rec;
+ resize(PTR(vec).vec);
+ r = PTR(vec).vec->rec;
}
r->array[r->size] = o;
return r->size++;
void naVec_setsize(naRef vec, int sz)
{
int i;
- struct VecRec* v = vec.ref.ptr.vec->rec;
+ struct VecRec* v = PTR(vec).vec->rec;
struct VecRec* nv = naAlloc(sizeof(struct VecRec) + sizeof(naRef) * sz);
nv->size = sz;
nv->alloced = sz;
for(i=0; i<sz; i++)
nv->array[i] = (v && i < v->size) ? v->array[i] : naNil();
- naFree(v);
- vec.ref.ptr.vec->rec = nv;
+ naGC_swapfree((void**)&(PTR(vec).vec->rec), nv);
}
naRef naVec_removelast(naRef vec)
{
naRef o;
if(IS_VEC(vec)) {
- struct VecRec* v = vec.ref.ptr.vec->rec;
+ struct VecRec* v = PTR(vec).vec->rec;
if(!v || v->size == 0) return naNil();
o = v->array[v->size - 1];
v->size--;
if(v->size < (v->alloced >> 1))
- resize(vec.ref.ptr.vec);
+ resize(PTR(vec).vec);
return o;
}
return naNil();
projects / simgear.git / commitdiff