int i;
unsigned int fld = 0;
if(bit + flen > 8*slen) naRuntimeError(c, "bitfield out of bounds");
- for(i=0; i<flen; i++) if(BIT(s, slen, i+bit)) fld |= (1<<i);
+ for(i=0; i<flen; i++) if(BIT(s, slen, bit+flen-i-1)) fld |= (1<<i);
return fld;
}
static naRef dofld(naContext c, int argc, naRef* args, int sign)
{
- struct naStr* s = argc > 0 ? PTR(args[0]).str : 0;
+ naRef s = argc > 0 ? args[0] : naNil();
int bit = argc > 1 ? (int)naNumValue(args[1]).num : -1;
int len = argc > 2 ? (int)naNumValue(args[2]).num : -1;
unsigned int f;
- if(!s || !MUTABLE(args[0]) || bit < 0 || len < 0)
+ if(!naIsString(s) || !MUTABLE(args[0]) || bit < 0 || len < 0)
naRuntimeError(c, "missing/bad argument to fld/sfld");
- f = fld(c, s->data, s->len, bit, len);
+ f = fld(c, (void*)naStr_data(s), naStr_len(s), bit, len);
if(!sign) return naNum(f);
if(f & (1 << (len-1))) f |= ~((1<<len)-1); // sign extend
return naNum((signed int)f);
static naRef f_setfld(naContext c, naRef me, int argc, naRef* args)
{
- struct naStr* s = argc > 0 ? PTR(args[0]).str : 0;
+ naRef s = argc > 0 ? args[0] : naNil();
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();
if(!argc || !MUTABLE(args[0])|| bit < 0 || len < 0 || IS_NIL(val))
naRuntimeError(c, "missing/bad argument to setfld");
- setfld(c, s->data, s->len, bit, len, (unsigned int)val.num);
+ setfld(c, (void*)naStr_data(s), naStr_len(s), bit, len, (unsigned int)val.num);
return naNil();
}
#endif
char* opStringDEBUG(int op);
void printOpDEBUG(int ip, int op);
-void printStackDEBUG(struct Context* ctx);
+void printStackDEBUG(naContext ctx);
////////////////////////////////////////////////////////////////////////
#ifdef _MSC_VER
struct Globals* globals = 0;
-static naRef bindFunction(struct Context* ctx, struct Frame* f, naRef code);
+static naRef bindFunction(naContext ctx, struct Frame* f, naRef code);
#define ERR(c, msg) naRuntimeError((c),(msg))
-void naRuntimeError(struct Context* c, const char* fmt, ...)
+void naRuntimeError(naContext c, const char* fmt, ...)
{
va_list ap;
va_start(ap, fmt);
return r;
}
-static int boolify(struct Context* ctx, naRef r)
+static int boolify(naContext ctx, naRef r)
{
if(IS_NUM(r)) return r.num != 0;
if(IS_NIL(r) || IS_END(r)) return 0;
return 0;
}
-static double numify(struct Context* ctx, naRef o)
+static double numify(naContext ctx, naRef o)
{
double n;
if(IS_NUM(o)) return o.num;
return 0;
}
-static naRef stringify(struct Context* ctx, naRef r)
+static naRef stringify(naContext ctx, naRef r)
{
if(IS_STR(r)) return r;
if(IS_NUM(r)) return naStr_fromnum(naNewString(ctx), r.num);
return naNil();
}
-static int checkVec(struct Context* ctx, naRef vec, naRef idx)
+static int checkVec(naContext ctx, naRef vec, naRef idx)
{
int i = (int)numify(ctx, idx);
if(i < 0) i += naVec_size(vec);
return i;
}
-static int checkStr(struct Context* ctx, naRef str, naRef idx)
+static int checkStr(naContext ctx, naRef str, naRef idx)
{
int i = (int)numify(ctx, idx);
if(i < 0) i += naStr_len(str);
return i;
}
-static naRef containerGet(struct Context* ctx, naRef box, naRef key)
+static naRef containerGet(naContext ctx, naRef box, naRef key)
{
naRef result = naNil();
if(!IS_SCALAR(key)) ERR(ctx, "container index not scalar");
- if(IS_HASH(box)) {
+ if(IS_HASH(box))
naHash_get(box, key, &result);
- } else if(IS_VEC(box)) {
+ else if(IS_VEC(box))
result = naVec_get(box, checkVec(ctx, box, key));
- } else if(IS_STR(box)) {
+ else if(IS_STR(box))
result = naNum((unsigned char)naStr_data(box)[checkStr(ctx, box, key)]);
- } else {
+ else
ERR(ctx, "extract from non-container");
- }
return result;
}
-static void containerSet(struct Context* ctx, naRef box, naRef key, naRef val)
+static void containerSet(naContext ctx, naRef box, naRef key, naRef val)
{
if(!IS_SCALAR(key)) ERR(ctx, "container index not scalar");
else if(IS_HASH(box)) naHash_set(box, key, val);
} else ERR(ctx, "insert into non-container");
}
-static void initTemps(struct Context* c)
+static void initTemps(naContext c)
{
c->tempsz = 4;
c->temps = naAlloc(c->tempsz * sizeof(struct naObj*));
c->ntemps = 0;
}
-static void initContext(struct Context* c)
+static void initContext(naContext c)
{
int i;
c->fTop = c->opTop = c->markTop = 0;
static void initGlobals()
{
int i;
- struct Context* c;
+ naContext c;
globals = (struct Globals*)naAlloc(sizeof(struct Globals));
naBZero(globals, sizeof(struct Globals));
naFreeContext(c);
}
-struct Context* naNewContext()
+naContext naNewContext()
{
- struct Context* c;
+ naContext c;
if(globals == 0)
initGlobals();
initContext(c);
} else {
UNLOCK();
- c = (struct Context*)naAlloc(sizeof(struct Context));
+ c = (naContext)naAlloc(sizeof(struct Context));
initTemps(c);
initContext(c);
LOCK();
return c;
}
-struct Context* naSubContext(struct Context* super)
+naContext naSubContext(naContext super)
{
- struct Context* ctx = naNewContext();
+ naContext ctx = naNewContext();
if(super->callChild) naFreeContext(super->callChild);
ctx->callParent = super;
super->callChild = ctx;
return ctx;
}
-void naFreeContext(struct Context* c)
+void naFreeContext(naContext c)
{
c->ntemps = 0;
if(c->callChild) naFreeContext(c->callChild);
naRuntimeError(ctx, "too few function args (have %d need %d)",
nargs, c->nArgs);
for(i=0; i<c->nArgs; i++)
- naHash_newsym(PTR(f->locals).hash,
- &c->constants[c->argSyms[i]], &args[i]);
+ naiHash_newsym(PTR(f->locals).hash,
+ &c->constants[ARGSYMS(c)[i]], &args[i]);
args += c->nArgs;
nargs -= c->nArgs;
for(i=0; i<c->nOptArgs; i++, nargs--) {
- naRef val = nargs > 0 ? args[i] : c->constants[c->optArgVals[i]];
+ naRef val = nargs > 0 ? args[i] : c->constants[OPTARGVALS(c)[i]];
if(IS_CODE(val))
val = bindFunction(ctx, &ctx->fStack[ctx->fTop-2], val);
- naHash_newsym(PTR(f->locals).hash, &c->constants[c->optArgSyms[i]],
+ naiHash_newsym(PTR(f->locals).hash, &c->constants[OPTARGSYMS(c)[i]],
&val);
}
args += c->nOptArgs;
if(c->needArgVector || nargs > 0) {
- naRef argsv = naNewVector(ctx);
- naVec_setsize(argsv, nargs > 0 ? nargs : 0);
+ naRef argv = naNewVector(ctx);
+ naVec_setsize(argv, nargs > 0 ? nargs : 0);
for(i=0; i<nargs; i++)
- PTR(argsv).vec->rec->array[i] = *args++;
- naHash_newsym(PTR(f->locals).hash, &c->restArgSym, &argsv);
+ PTR(argv).vec->rec->array[i] = *args++;
+ naiHash_newsym(PTR(f->locals).hash, &c->constants[c->restArgSym], &argv);
}
}
-static struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall)
+static void checkNamedArgs(naContext ctx, struct naCode* c, struct naHash* h)
{
- naRef *frame;
- struct Frame* f;
-
- DBG(printf("setupFuncall(nargs:%d, mcall:%d)\n", nargs, mcall);)
-
- frame = &ctx->opStack[ctx->opTop - nargs - 1];
- if(!IS_FUNC(frame[0]))
- ERR(ctx, "function/method call invoked on uncallable object");
-
- ctx->opFrame = ctx->opTop - (nargs + 1 + mcall);
+ int i;
+ naRef sym, rest, dummy;
+ for(i=0; i<c->nArgs; i++) {
+ sym = c->constants[ARGSYMS(c)[i]];
+ if(!naiHash_sym(h, PTR(sym).str, &dummy))
+ naRuntimeError(ctx, "Missing arg: %s", naStr_data(sym));
+ }
+ for(i=0; i<c->nOptArgs; i++) {
+ sym = c->constants[OPTARGSYMS(c)[i]];
+ if(!naiHash_sym(h, PTR(sym).str, &dummy))
+ naiHash_newsym(h, &sym, &c->constants[OPTARGVALS(c)[i]]);
+ }
+ if(c->needArgVector) {
+ sym = c->constants[c->restArgSym];
+ if(!naiHash_sym(h, PTR(sym).str, &dummy)) {
+ rest = naNewVector(ctx);
+ naiHash_newsym(h, &sym, &rest);
+ }
+ }
+}
- // 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 = PTR(PTR(frame[0]).func->code).ccode->fptr;
- naRef result = (*fp)(ctx, obj, nargs, frame + 1);
+static struct Frame* setupFuncall(naContext ctx, int nargs, int mcall, int named)
+{
+ naRef *args, func, code, obj = naNil();
+ struct Frame* f;
+ int opf = ctx->opTop - nargs;
+
+ args = &ctx->opStack[opf];
+ func = ctx->opStack[--opf];
+ if(!IS_FUNC(func)) ERR(ctx, "function/method call on uncallable object");
+ code = PTR(func).func->code;
+ if(mcall) obj = ctx->opStack[--opf];
+ ctx->opFrame = opf;
+
+ if(IS_CCODE(code)) {
+ naRef result = (*PTR(code).ccode->fptr)(ctx, obj, nargs, args);
+ if(named) ERR(ctx, "native functions have no named arguments");
ctx->opTop = ctx->opFrame;
PUSH(result);
return &(ctx->fStack[ctx->fTop-1]);
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 = &(ctx->fStack[ctx->fTop++]);
- f->locals = f->func = naNil();
- f->locals = naNewHash(ctx);
- f->func = frame[0];
+ f = &(ctx->fStack[ctx->fTop]);
+ f->locals = named ? args[0] : naNewHash(ctx);
+ f->func = func;
f->ip = 0;
f->bp = ctx->opFrame;
- if(mcall)
- naHash_set(f->locals, globals->meRef, frame[-1]);
+ if(mcall) naHash_set(f->locals, globals->meRef, obj);
- setupArgs(ctx, f, frame+1, nargs);
+ if(named) checkNamedArgs(ctx, PTR(code).code, PTR(f->locals).hash);
+ else setupArgs(ctx, f, args, nargs);
- ctx->opTop = f->bp; // Pop the stack last, to avoid GC lossage
- DBG(printf("Entering frame %d with %d args\n", ctx->fTop-1, nargs);)
+ ctx->fTop++;
+ ctx->opTop = f->bp; /* Pop the stack last, to avoid GC lossage */
return f;
}
// 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)
+static naRef bindFunction(naContext ctx, struct Frame* f, naRef code)
{
naRef result = naNewFunc(ctx, code);
PTR(result).func->namespace = f->locals;
return 0;
}
-static naRef getLocal2(struct Context* ctx, struct Frame* f, naRef sym)
+static naRef getLocal2(naContext ctx, struct Frame* f, naRef sym)
{
naRef result;
if(!naHash_get(f->locals, sym, &result))
return result;
}
-static void getLocal(struct Context* ctx, struct Frame* f,
- naRef* sym, naRef* out)
+static void getLocal(naContext ctx, struct Frame* f, naRef* sym, naRef* out)
{
struct naFunc* func;
struct naStr* str = PTR(*sym).str;
- if(naHash_sym(PTR(f->locals).hash, str, out))
+ if(naiHash_sym(PTR(f->locals).hash, str, out))
return;
func = PTR(f->func).func;
while(func && PTR(func->namespace).hash) {
- if(naHash_sym(PTR(func->namespace).hash, str, out))
+ if(naiHash_sym(PTR(func->namespace).hash, str, out))
return;
func = PTR(func->next).func;
}
static int setClosure(naRef func, naRef sym, naRef val)
{
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); }
+ if(c == 0) return 0;
+ if(naiHash_tryset(c->namespace, sym, val)) return 1;
+ return setClosure(c->next, sym, val);
}
-static naRef setSymbol(struct Frame* f, naRef sym, naRef val)
+static void setSymbol(struct Frame* f, naRef sym, naRef val)
{
// Try the locals first, if not already there try the closures in
// order. Finally put it in the locals if nothing matched.
- if(!naHash_tryset(f->locals, sym, val))
+ if(!naiHash_tryset(f->locals, sym, val))
if(!setClosure(f->func, sym, val))
naHash_set(f->locals, sym, val);
- return val;
}
// Funky API: returns null to indicate no member, an empty string to
naRef p;
struct VecRec* pv;
if(--count < 0) return "too many parents";
- if(!IS_HASH(obj)) return 0;
+ if(!IS_HASH(obj)) return "non-objects have no members";
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++) {
+ for(i=0; pv && 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,
+static void getMember(naContext ctx, naRef obj, naRef fld,
naRef* result, int count)
{
const char* err = getMember_r(obj, fld, result, count);
// 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.
-static void evalEach(struct Context* ctx, int useIndex)
+static void evalEach(naContext ctx, int useIndex)
{
int idx = (int)(ctx->opStack[ctx->opTop-1].num);
naRef vec = ctx->opStack[ctx->opTop-2];
PUSH(useIndex ? naNum(idx) : naVec_get(vec, idx));
}
-#define ARG() cd->byteCode[f->ip++]
+static void evalUnpack(naContext ctx, int count)
+{
+ naRef vec = ctx->opStack[--ctx->opTop];
+ if(!IS_VEC(vec) || naVec_size(vec) < count)
+ ERR(ctx, "short or invalid multi-assignment vector");
+ while(count--) PUSH(naVec_get(vec, count));
+}
+
+// FIXME: unify with almost identical checkVec() above
+static int vbound(naContext ctx, naRef v, naRef ir, int end)
+{
+ int i = IS_NIL(ir) ? (end ? -1 : 0) : numify(ctx, ir);
+ if(i < 0) i += naVec_size(v);
+ if(i < 0 || i >= naVec_size(v))
+ naRuntimeError(ctx, "slice index %d out of bounds (size: %d)",
+ i, naVec_size(v));
+ return i;
+}
+
+static void evalSlice(naContext ctx, naRef src, naRef dst, naRef idx)
+{
+ if(!IS_VEC(src)) ERR(ctx, "cannot slice non-vector");
+ naVec_append(dst, naVec_get(src, vbound(ctx, src, idx, 0)));
+}
+
+static void evalSlice2(naContext ctx, naRef src, naRef dst,
+ naRef start, naRef endr)
+{
+ int i, end;
+ if(!IS_VEC(src)) ERR(ctx, "cannot slice non-vector");
+ end = vbound(ctx, src, endr, 1);
+ for(i = vbound(ctx, src, start, 0); i<=end; i++)
+ naVec_append(dst, naVec_get(src, i));
+}
+
+#define ARG() BYTECODE(cd)[f->ip++]
#define CONSTARG() cd->constants[ARG()]
#define POP() ctx->opStack[--ctx->opTop]
#define STK(n) (ctx->opStack[ctx->opTop-(n)])
-#define FIXFRAME() f = &(ctx->fStack[ctx->fTop-1]); \
- cd = PTR(PTR(f->func).func->code).code;
-static naRef run(struct Context* ctx)
+#define SETFRAME(F) f = (F); cd = PTR(PTR(f->func).func->code).code;
+#define FIXFRAME() SETFRAME(&(ctx->fStack[ctx->fTop-1]))
+static naRef run(naContext ctx)
{
struct Frame* f;
struct naCode* cd;
FIXFRAME();
while(1) {
- op = cd->byteCode[f->ip++];
+ op = BYTECODE(cd)[f->ip++];
DBG(printf("Stack Depth: %d\n", ctx->opTop));
DBG(printOpDEBUG(f->ip-1, op));
switch(op) {
- case OP_POP:
- ctx->opTop--;
- break;
- case OP_DUP:
- PUSH(ctx->opStack[ctx->opTop-1]);
- break;
- case OP_DUP2:
- PUSH(ctx->opStack[ctx->opTop-2]);
- PUSH(ctx->opStack[ctx->opTop-2]);
- break;
- case OP_XCHG:
- a = STK(1); STK(1) = STK(2); STK(2) = a;
- break;
+ case OP_POP: ctx->opTop--; break;
+ case OP_DUP: PUSH(STK(1)); break;
+ case OP_DUP2: PUSH(STK(2)); PUSH(STK(2)); break;
+ case OP_XCHG: a=STK(1); STK(1)=STK(2); STK(2)=a; break;
+ case OP_XCHG2: a=STK(1); STK(1)=STK(2); STK(2)=STK(3); STK(3)=a; break;
#define BINOP(expr) do { \
double l = IS_NUM(STK(2)) ? STK(2).num : numify(ctx, STK(2)); \
break;
case OP_CAT:
STK(2) = evalCat(ctx, STK(2), STK(1));
- ctx->opTop -= 1;
+ ctx->opTop--;
break;
case OP_NEG:
STK(1) = naNum(-numify(ctx, STK(1)));
PUSH(b);
break;
case OP_SETSYM:
- STK(2) = setSymbol(f, STK(2), STK(1));
+ setSymbol(f, STK(1), STK(2));
ctx->opTop--;
break;
case OP_SETLOCAL:
- naHash_set(f->locals, STK(2), STK(1));
- STK(2) = STK(1); // FIXME: reverse order of arguments instead!
+ naHash_set(f->locals, STK(1), STK(2));
ctx->opTop--;
break;
case OP_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");
- naHash_set(STK(3), STK(2), STK(1));
- STK(3) = STK(1); // FIXME: fix arg order instead
+ if(!IS_HASH(STK(2))) ERR(ctx, "non-objects have no members");
+ naHash_set(STK(2), STK(1), STK(3));
ctx->opTop -= 2;
break;
case OP_INSERT:
- containerSet(ctx, STK(3), STK(2), STK(1));
- STK(3) = STK(1); // FIXME: codegen order again...
+ containerSet(ctx, STK(2), STK(1), STK(3));
ctx->opTop -= 2;
break;
case OP_EXTRACT:
STK(2) = containerGet(ctx, STK(2), STK(1));
ctx->opTop--;
break;
+ case OP_SLICE:
+ evalSlice(ctx, STK(3), STK(2), STK(1));
+ ctx->opTop--;
+ break;
+ case OP_SLICE2:
+ evalSlice2(ctx, STK(4), STK(3), STK(2), STK(1));
+ ctx->opTop -= 2;
+ break;
case OP_JMPLOOP:
// Identical to JMP, except for locking
naCheckBottleneck();
- f->ip = cd->byteCode[f->ip];
- DBG(printf(" [Jump to: %d]\n", f->ip);)
+ f->ip = BYTECODE(cd)[f->ip];
+ DBG(printf(" [Jump to: %d]\n", f->ip));
break;
case OP_JMP:
- f->ip = cd->byteCode[f->ip];
- DBG(printf(" [Jump to: %d]\n", f->ip);)
+ f->ip = BYTECODE(cd)[f->ip];
+ DBG(printf(" [Jump to: %d]\n", f->ip));
break;
case OP_JIFEND:
arg = ARG();
if(IS_END(STK(1))) {
ctx->opTop--; // Pops **ONLY** if it's nil!
f->ip = arg;
- DBG(printf(" [Jump to: %d]\n", f->ip);)
+ 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);)
+ 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);)
+ DBG(printf(" [Jump to: %d]\n", f->ip));
}
break;
case OP_JIFNOTPOP:
arg = ARG();
if(!boolify(ctx, POP())) {
f->ip = arg;
- DBG(printf(" [Jump to: %d]\n", f->ip);)
+ DBG(printf(" [Jump to: %d]\n", f->ip));
}
break;
- case OP_FCALL:
- f = setupFuncall(ctx, ARG(), 0);
- cd = PTR(PTR(f->func).func->code).code;
- break;
- case OP_MCALL:
- f = setupFuncall(ctx, ARG(), 1);
- cd = PTR(PTR(f->func).func->code).code;
- break;
+ case OP_FCALL: SETFRAME(setupFuncall(ctx, ARG(), 0, 0)); break;
+ case OP_MCALL: SETFRAME(setupFuncall(ctx, ARG(), 1, 0)); break;
+ case OP_FCALLH: SETFRAME(setupFuncall(ctx, 1, 0, 1)); break;
+ case OP_MCALLH: SETFRAME(setupFuncall(ctx, 1, 1, 1)); break;
case OP_RETURN:
a = STK(1);
ctx->dieArg = naNil();
case OP_BREAK2: // same, but also pop the mark stack
ctx->opTop = ctx->markStack[--ctx->markTop];
break;
+ case OP_UNPACK:
+ evalUnpack(ctx, ARG());
+ break;
default:
ERR(ctx, "BUG: bad opcode");
}
ctx->ntemps = 0; // reset GC temp vector
- DBG(printStackDEBUG(ctx);)
+ DBG(printStackDEBUG(ctx));
}
return naNil(); // unreachable
}
#undef STK
#undef FIXFRAME
-void naSave(struct Context* ctx, naRef obj)
+void naSave(naContext ctx, naRef obj)
{
naVec_append(globals->save, obj);
}
-int naStackDepth(struct Context* ctx)
+int naStackDepth(naContext ctx)
{
return ctx ? ctx->fTop + naStackDepth(ctx->callChild): 0;
}
return ctx->fTop - 1 - (fn - sd);
}
-int naGetLine(struct Context* ctx, int frame)
+int naGetLine(naContext ctx, int frame)
{
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] > f->ip)
+ unsigned short* p = LINEIPS(c) + c->nLines - 2;
+ while(p >= LINEIPS(c) && p[0] > f->ip)
p -= 2;
return p[1];
}
return -1;
}
-naRef naGetSourceFile(struct Context* ctx, int frame)
+naRef naGetSourceFile(naContext ctx, int frame)
{
naRef f;
frame = findFrame(ctx, &ctx, frame);
return PTR(f).code->srcFile;
}
-char* naGetError(struct Context* ctx)
+char* naGetError(naContext ctx)
{
if(IS_STR(ctx->dieArg))
- return (char*)PTR(ctx->dieArg).str->data;
+ return naStr_data(ctx->dieArg);
return ctx->error[0] ? ctx->error : 0;
}
naRef naBindToContext(naContext ctx, naRef code)
{
naRef func = naNewFunc(ctx, code);
- struct Frame* f = &ctx->fStack[ctx->fTop-1];
- PTR(func).func->namespace = f->locals;
- PTR(func).func->next = f->func;
+ if(ctx->fTop) {
+ struct Frame* f = &ctx->fStack[ctx->fTop-1];
+ PTR(func).func->namespace = f->locals;
+ PTR(func).func->next = f->func;
+ }
return func;
}
// naRuntimeError() calls end up here:
if(setjmp(ctx->jumpHandle)) {
- if(!ctx->callParent) naModUnlock(ctx);
+ if(!ctx->callParent) naModUnlock();
return naNil();
}
ctx->opTop = ctx->markTop = 0;
ctx->fTop = 1;
ctx->fStack[0].func = func;
+
ctx->fStack[0].locals = locals;
ctx->fStack[0].ip = 0;
ctx->fStack[0].bp = ctx->opTop;
- if(args) setupArgs(ctx, ctx->fStack, args, argc);
+ setupArgs(ctx, ctx->fStack, args, argc);
result = run(ctx);
- if(!ctx->callParent) naModUnlock(ctx);
+ if(!ctx->callParent) naModUnlock();
return result;
}
ctx->error[0] = 0;
if(setjmp(ctx->jumpHandle)) {
- if(!ctx->callParent) naModUnlock(ctx);
+ if(!ctx->callParent) naModUnlock();
else naRethrowError(ctx);
return naNil();
}
#define OBJ_CACHE_SZ 1
enum {
- 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_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_SETSYM, OP_DUP2, OP_INDEX, OP_BREAK2,
- OP_PUSHEND, OP_JIFTRUE, OP_JIFNOT
+ 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_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_SETSYM, OP_DUP2,
+ OP_INDEX, OP_BREAK2, OP_PUSHEND, OP_JIFTRUE, OP_JIFNOT, OP_FCALLH,
+ OP_MCALLH, OP_XCHG2, OP_UNPACK, OP_SLICE, OP_SLICE2
};
struct Frame {
+#include <string.h>
#include "parse.h"
#include "code.h"
// These are more sensical predicate names in most contexts in this file
#define LEFT(tok) ((tok)->children)
#define RIGHT(tok) ((tok)->lastChild)
-#define BINARY(tok) (LEFT(tok) && RIGHT(tok) && LEFT(tok) != RIGHT(tok))
+#define BINARY(tok) (LEFT(tok) && RIGHT(tok) && LEFT(tok)->next == RIGHT(tok))
// Forward references for recursion
static void genExpr(struct Parser* p, struct Token* t);
naVec_append(p->cg->consts, c);
i = naVec_size(p->cg->consts) - 1;
if(i > 0xffff) naParseError(p, "too many constants in code block", 0);
- return i;
-}
-
-static naRef getConstant(struct Parser* p, int idx)
-{
- return naVec_get(p->cg->consts, idx);
+ return i;
}
// Interns a scalar (!) constant and returns its index
return newConstant(p, c);
}
+/* FIXME: this API is fundamentally a resource leak, because symbols
+ * can't be deregistered. The "proper" way to do this would be to
+ * keep a reference count for each symbol, and decrement it when a
+ * code object referencing it is deleted. */
naRef naInternSymbol(naRef sym)
{
naRef result;
static int genScalarConstant(struct Parser* p, struct Token* t)
{
- // These opcodes are for special-case use in other constructs, but
- // we might as well use them here to save a few bytes in the
- // instruction stream.
- if(t->str == 0 && t->num == 1) {
- emit(p, OP_PUSHONE);
- } else if(t->str == 0 && t->num == 0) {
- emit(p, OP_PUSHZERO);
- } else {
- int idx = findConstantIndex(p, t);
- emitImmediate(p, OP_PUSHCONST, idx);
- return idx;
- }
- return 0;
+ int idx;
+ if(t->str == 0 && t->num == 1) { emit(p, OP_PUSHONE); return 0; }
+ if(t->str == 0 && t->num == 0) { emit(p, OP_PUSHZERO); return 0; }
+ emitImmediate(p, OP_PUSHCONST, idx = findConstantIndex(p, t));
+ return idx;
}
static int genLValue(struct Parser* p, struct Token* t, int* cidx)
static void genEqOp(int op, struct Parser* p, struct Token* t)
{
- int cidx, setop = genLValue(p, LEFT(t), &cidx);
+ int cidx, n = 2, setop = genLValue(p, LEFT(t), &cidx);
if(setop == OP_SETMEMBER) {
emit(p, OP_DUP2);
emit(p, OP_POP);
} else if(setop == OP_INSERT) {
emit(p, OP_DUP2);
emit(p, OP_EXTRACT);
- } else // OP_SETSYM, OP_SETLOCAL
+ } else {
emitImmediate(p, OP_LOCAL, cidx);
+ n = 1;
+ }
genExpr(p, RIGHT(t));
emit(p, op);
+ emit(p, n == 1 ? OP_XCHG : OP_XCHG2);
emit(p, setop);
}
{
naRef sym;
if(t->type == TOK_EMPTY) return;
- if(!IDENTICAL(c->restArgSym, globals->argRef))
- naParseError(p, "remainder must be last", t->line);
+ if(!IDENTICAL(p->cg->restArgSym, globals->argRef))
+ naParseError(p, "remainder must be last", t->line);
if(t->type == TOK_ELLIPSIS) {
if(LEFT(t)->type != TOK_SYMBOL)
naParseError(p, "bad function argument expression", t->line);
sym = naStr_fromdata(naNewString(p->context),
LEFT(t)->str, LEFT(t)->strlen);
- c->restArgSym = naInternSymbol(sym);
+ p->cg->restArgSym = naInternSymbol(sym);
c->needArgVector = 1;
} else if(t->type == TOK_ASSIGN) {
if(LEFT(t)->type != TOK_SYMBOL)
naParseError(p, "bad function argument expression", t->line);
- c->optArgSyms[c->nOptArgs] = findConstantIndex(p, LEFT(t));
- c->optArgVals[c->nOptArgs++] = defArg(p, RIGHT(t));
+ p->cg->optArgSyms[c->nOptArgs] = findConstantIndex(p, LEFT(t));
+ p->cg->optArgVals[c->nOptArgs++] = defArg(p, RIGHT(t));
} else if(t->type == TOK_SYMBOL) {
if(c->nOptArgs)
naParseError(p, "optional arguments must be last", t->line);
if(c->nArgs >= MAX_FUNARGS)
naParseError(p, "too many named function arguments", t->line);
- c->argSyms[c->nArgs++] = findConstantIndex(p, t);
+ p->cg->argSyms[c->nArgs++] = findConstantIndex(p, t);
} else if(t->type == TOK_COMMA) {
+ if(!LEFT(t) || !RIGHT(t))
+ naParseError(p, "empty function argument", t->line);
genArgList(p, c, LEFT(t));
genArgList(p, c, RIGHT(t));
} else
static int genList(struct Parser* p, struct Token* t, int doAppend)
{
- if(t->type == TOK_COMMA) {
+ if(!t || t->type == TOK_EMPTY) {
+ return 0;
+ } else if(t->type == TOK_COMMA) {
genExpr(p, LEFT(t));
if(doAppend) emit(p, OP_VAPPEND);
return 1 + genList(p, RIGHT(t), doAppend);
- } else if(t->type == TOK_EMPTY) {
- return 0;
} else {
genExpr(p, t);
if(doAppend) emit(p, OP_VAPPEND);
static void genHashElem(struct Parser* p, struct Token* t)
{
- if(t->type == TOK_EMPTY)
+ if(!t || t->type == TOK_EMPTY)
return;
if(t->type != TOK_COLON)
naParseError(p, "bad hash/object initializer", t->line);
static void genHash(struct Parser* p, struct Token* t)
{
- if(t->type == TOK_COMMA) {
+ if(t && t->type == TOK_COMMA) {
genHashElem(p, LEFT(t));
genHash(p, RIGHT(t));
- } else if(t->type != TOK_EMPTY) {
+ } else if(t && t->type != TOK_EMPTY) {
genHashElem(p, t);
}
}
+static int isHashcall(struct Parser* p, struct Token* t)
+{
+ if(t) {
+ int sep = LEFT(t) && t->type == TOK_COMMA ? t->children->type : t->type;
+ return sep == TOK_COLON;
+ }
+ return 0;
+}
+
static void genFuncall(struct Parser* p, struct Token* t)
{
- int op = OP_FCALL;
- int nargs = 0;
+ int method = 0;
if(LEFT(t)->type == TOK_DOT) {
+ method = 1;
genExpr(p, LEFT(LEFT(t)));
emit(p, OP_DUP);
emitImmediate(p, OP_MEMBER, findConstantIndex(p, RIGHT(LEFT(t))));
- op = OP_MCALL;
} else {
genExpr(p, LEFT(t));
}
- if(RIGHT(t)) nargs = genList(p, RIGHT(t), 0);
- emitImmediate(p, op, nargs);
+ if(isHashcall(p, RIGHT(t))) {
+ emit(p, OP_NEWHASH);
+ genHash(p, RIGHT(t));
+ emit(p, method ? OP_MCALLH : OP_FCALLH);
+ } else {
+ int nargs = genList(p, RIGHT(t), 0);
+ emitImmediate(p, method ? OP_MCALL : OP_FCALL, nargs);
+ }
}
-static void pushLoop(struct Parser* p, struct Token* label)
+static int startLoop(struct Parser* p, struct Token* label)
{
int i = p->cg->loopTop;
p->cg->loops[i].breakIP = 0xffffff;
p->cg->loops[i].label = label;
p->cg->loopTop++;
emit(p, OP_MARK);
-}
-
-static void popLoop(struct Parser* p)
-{
- p->cg->loopTop--;
- if(p->cg->loopTop < 0) naParseError(p, "BUG: loop stack underflow", -1);
- emit(p, OP_UNMARK);
+ return p->cg->codesz;
}
// Emit a jump operation, and return the location of the address in
fixJumpTarget(p, jumpEnd);
}
-static int countSemis(struct Token* t)
+static int countList(struct Token* t, int type)
{
- if(!t || t->type != TOK_SEMI) return 0;
- return 1 + countSemis(RIGHT(t));
+ int n;
+ for(n = 1; t && t->type == type; t = RIGHT(t)) n++;
+ return n;
}
static void genLoop(struct Parser* p, struct Token* body,
if(update) { genExpr(p, update); emit(p, OP_POP); }
emitImmediate(p, OP_JMPLOOP, loopTop);
fixJumpTarget(p, jumpEnd);
- popLoop(p);
+ p->cg->loopTop--;
+ emit(p, OP_UNMARK);
emit(p, OP_PUSHNIL); // Leave something on the stack
}
{
int loopTop, jumpEnd;
if(init) { genExpr(p, init); emit(p, OP_POP); }
- pushLoop(p, label);
- loopTop = p->cg->codesz;
+ loopTop = startLoop(p, label);
genExpr(p, test);
jumpEnd = emitJump(p, OP_JIFNOTPOP);
genLoop(p, body, update, label, loopTop, jumpEnd);
static void genWhile(struct Parser* p, struct Token* t)
{
struct Token *test=LEFT(t)->children, *body, *label=0;
- int semis = countSemis(test);
- if(semis == 1) {
+ int len = countList(test, TOK_SEMI);
+ if(len == 2) {
label = LEFT(test);
if(!label || label->type != TOK_SYMBOL)
naParseError(p, "bad loop label", t->line);
test = RIGHT(test);
- }
- else if(semis != 0)
+ } else if(len != 1)
naParseError(p, "too many semicolons in while test", t->line);
body = LEFT(RIGHT(t));
genForWhile(p, 0, test, 0, body, label);
{
struct Token *init, *test, *body, *update, *label=0;
struct Token *h = LEFT(t)->children;
- int semis = countSemis(h);
- if(semis == 3) {
+ int len = countList(h, TOK_SEMI);
+ if(len == 4) {
if(!LEFT(h) || LEFT(h)->type != TOK_SYMBOL)
naParseError(p, "bad loop label", h->line);
label = LEFT(h);
h=RIGHT(h);
- } else if(semis != 2) {
+ } else if(len != 3)
naParseError(p, "wrong number of terms in for header", t->line);
- }
-
- // Parse tree hell :)
init = LEFT(h);
test = LEFT(RIGHT(h));
update = RIGHT(RIGHT(h));
int loopTop, jumpEnd, assignOp, dummy;
struct Token *elem, *body, *vec, *label=0;
struct Token *h = LEFT(LEFT(t));
- int semis = countSemis(h);
- if(semis == 2) {
+ int len = countList(h, TOK_SEMI);
+ if(len == 3) {
if(!LEFT(h) || LEFT(h)->type != TOK_SYMBOL)
naParseError(p, "bad loop label", h->line);
label = LEFT(h);
h = RIGHT(h);
- } else if (semis != 1) {
+ } else if (len != 2) {
naParseError(p, "wrong number of terms in foreach header", t->line);
}
elem = LEFT(h);
genExpr(p, vec);
emit(p, OP_PUSHZERO);
- pushLoop(p, label);
- loopTop = p->cg->codesz;
+ loopTop = startLoop(p, label);
emit(p, t->type == TOK_FOREACH ? OP_EACH : OP_INDEX);
jumpEnd = emitJump(p, OP_JIFEND);
assignOp = genLValue(p, elem, &dummy);
- emit(p, OP_XCHG);
emit(p, assignOp);
emit(p, OP_POP);
genLoop(p, body, 0, label, loopTop, jumpEnd);
p->cg->lineIps[p->cg->nextLineIp++] = (unsigned short) line;
}
+static int parListLen(struct Token* t)
+{
+ if(t->type != TOK_LPAR || !LEFT(t) || LEFT(t)->type != TOK_COMMA) return 0;
+ return countList(LEFT(t), TOK_COMMA);
+}
+
+static void genCommaList(struct Parser* p, struct Token* t)
+{
+ if(t->type != TOK_COMMA) { genExpr(p, t); return; }
+ genCommaList(p, RIGHT(t));
+ genExpr(p, LEFT(t));
+}
+
+static void genMultiLV(struct Parser* p, struct Token* t, int var)
+{
+ if(!var) { emit(p, genLValue(p, t, &var)); return; }
+ if(t->type != TOK_SYMBOL) naParseError(p, "bad lvalue", t->line);
+ genScalarConstant(p, t);
+ emit(p, OP_SETLOCAL);
+}
+
+static void genAssign(struct Parser* p, struct Token* t)
+{
+ struct Token *lv = LEFT(t), *rv = RIGHT(t);
+ int len, dummy, var=0;
+ if(parListLen(lv) || (lv->type == TOK_VAR && parListLen(RIGHT(lv)))) {
+ if(lv->type == TOK_VAR) { lv = RIGHT(lv); var = 1; }
+ len = parListLen(lv);
+ if(rv->type == TOK_LPAR) {
+ if(len != parListLen(rv))
+ naParseError(p, "bad assignment count", rv->line);
+ genCommaList(p, LEFT(rv));
+ } else {
+ genExpr(p, rv);
+ emitImmediate(p, OP_UNPACK, len);
+ }
+ for(t = LEFT(lv); t && t->type == TOK_COMMA; t = RIGHT(t)) {
+ genMultiLV(p, LEFT(t), var);
+ emit(p, OP_POP);
+ }
+ genMultiLV(p, t, var);
+ } else {
+ genExpr(p, rv);
+ emit(p, genLValue(p, lv, &dummy));
+ }
+}
+
+static void genSlice(struct Parser* p, struct Token* t)
+{
+ if(t->type == TOK_COLON) {
+ genExpr(p, LEFT(t));
+ genExpr(p, RIGHT(t));
+ emit(p, OP_SLICE2);
+ } else {
+ genExpr(p, t);
+ emit(p, OP_SLICE);
+ }
+}
+
+static void genExtract(struct Parser* p, struct Token* t)
+{
+ genExpr(p, LEFT(t));
+ if(countList(RIGHT(t), TOK_COMMA) == 1 && RIGHT(t)->type != TOK_COLON) {
+ genExpr(p, RIGHT(t));
+ emit(p, OP_EXTRACT);
+ } else {
+ emit(p, OP_NEWVEC);
+ for(t = RIGHT(t); t->type == TOK_COMMA; t = RIGHT(t))
+ genSlice(p, LEFT(t));
+ genSlice(p, t);
+ emit(p, OP_XCHG);
+ emit(p, OP_POP);
+ }
+}
+
static void genExpr(struct Parser* p, struct Token* t)
{
- int i, dummy;
+ int i;
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;
switch(t->type) {
- case TOK_IF:
- genIfElse(p, t);
- break;
- case TOK_QUESTION:
- genQuestion(p, t);
- break;
- case TOK_WHILE:
- genWhile(p, t);
- break;
- case TOK_FOR:
- genFor(p, t);
- break;
- case TOK_FOREACH:
- case TOK_FORINDEX:
+ case TOK_TOP: genExprList(p, LEFT(t)); break;
+ case TOK_IF: genIfElse(p, t); break;
+ case TOK_QUESTION: genQuestion(p, t); break;
+ case TOK_WHILE: genWhile(p, t); break;
+ case TOK_FOR: genFor(p, t); break;
+ case TOK_FUNC: genLambda(p, t); break;
+ case TOK_ASSIGN: genAssign(p, t); break;
+ case TOK_LITERAL: genScalarConstant(p, t); break;
+ case TOK_FOREACH: case TOK_FORINDEX:
genForEach(p, t);
break;
case TOK_BREAK: case TOK_CONTINUE:
genBreakContinue(p, t);
break;
- case TOK_TOP:
- genExprList(p, LEFT(t));
- break;
- case TOK_FUNC:
- genLambda(p, t);
- break;
case TOK_LPAR:
- if(BINARY(t) || !RIGHT(t)) genFuncall(p, t); // function invocation
- else genExpr(p, LEFT(t)); // simple parenthesis
+ if(BINARY(t) || !RIGHT(t)) genFuncall(p, t);
+ else genExpr(p, LEFT(t));
break;
case TOK_LBRA:
if(BINARY(t)) {
- genBinOp(OP_EXTRACT, p, t); // a[i]
+ genExtract(p, t);
} else {
emit(p, OP_NEWVEC);
genList(p, LEFT(t), 1);
emit(p, OP_NEWHASH);
genHash(p, LEFT(t));
break;
- case TOK_ASSIGN:
- i = genLValue(p, LEFT(t), &dummy);
- genExpr(p, RIGHT(t));
- emit(p, i); // use the op appropriate to the lvalue
- break;
case TOK_RETURN:
if(RIGHT(t)) genExpr(p, RIGHT(t));
else emit(p, OP_PUSHNIL);
case TOK_SYMBOL:
emitImmediate(p, OP_LOCAL, findConstantIndex(p, t));
break;
- case TOK_LITERAL:
- genScalarConstant(p, t);
- break;
case TOK_MINUS:
if(BINARY(t)) {
genBinOp(OP_MINUS, p, t); // binary subtraction
emitImmediate(p, OP_MEMBER, findConstantIndex(p, RIGHT(t)));
break;
case TOK_EMPTY: case TOK_NIL:
- emit(p, OP_PUSHNIL); break; // *NOT* a noop!
+ emit(p, OP_PUSHNIL);
+ break;
case TOK_AND: case TOK_OR:
genShortCircuit(p, t);
break;
genExprList(p, block);
emit(p, OP_RETURN);
-
+
// Now make a code object
codeObj = naNewCode(p->context);
code = PTR(codeObj).code;
-
+
// Parse the argument list, if any
- code->restArgSym = globals->argRef;
+ p->cg->restArgSym = globals->argRef;
code->nArgs = code->nOptArgs = 0;
- code->argSyms = code->optArgSyms = code->optArgVals = 0;
+ p->cg->argSyms = p->cg->optArgSyms = p->cg->optArgVals = 0;
code->needArgVector = 1;
if(arglist) {
- code->argSyms = naParseAlloc(p, sizeof(int) * MAX_FUNARGS);
- code->optArgSyms = naParseAlloc(p, sizeof(int) * MAX_FUNARGS);
- code->optArgVals = naParseAlloc(p, sizeof(int) * MAX_FUNARGS);
+ p->cg->argSyms = naParseAlloc(p, sizeof(int) * MAX_FUNARGS);
+ p->cg->optArgSyms = naParseAlloc(p, sizeof(int) * MAX_FUNARGS);
+ p->cg->optArgVals = naParseAlloc(p, sizeof(int) * MAX_FUNARGS);
code->needArgVector = 0;
genArgList(p, code, arglist);
- if(code->nArgs) {
- int i, *nsyms;
- nsyms = naAlloc(sizeof(int) * code->nArgs);
- for(i=0; i<code->nArgs; i++) nsyms[i] = code->argSyms[i];
- code->argSyms = nsyms;
- } else code->argSyms = 0;
- if(code->nOptArgs) {
- int i, *nsyms, *nvals;
- nsyms = naAlloc(sizeof(int) * code->nOptArgs);
- nvals = naAlloc(sizeof(int) * code->nOptArgs);
- for(i=0; i<code->nOptArgs; i++) nsyms[i] = code->optArgSyms[i];
- for(i=0; i<code->nOptArgs; i++) nvals[i] = code->optArgVals[i];
- code->optArgSyms = nsyms;
- code->optArgVals = nvals;
- } else code->optArgSyms = code->optArgVals = 0;
}
- code->codesz = cg.codesz;
- code->byteCode = naAlloc(cg.codesz * sizeof(unsigned short));
- for(i=0; i < cg.codesz; i++)
- code->byteCode[i] = cg.byteCode[i];
+ code->restArgSym = internConstant(p, p->cg->restArgSym);
+
+ /* Set the size fields and allocate the combined array buffer.
+ * Note cute trick with null pointer to get the array size. */
code->nConstants = naVec_size(cg.consts);
- code->constants = naAlloc(code->nConstants * sizeof(naRef));
+ code->codesz = cg.codesz;
+ code->nLines = cg.nextLineIp;
code->srcFile = p->srcFile;
+ code->constants = 0;
+ code->constants = naAlloc((int)(size_t)(LINEIPS(code)+code->nLines));
for(i=0; i<code->nConstants; i++)
- code->constants[i] = getConstant(p, i);
- code->nLines = p->cg->nextLineIp;
- code->lineIps = naAlloc(sizeof(unsigned short)*p->cg->nLineIps*2);
- for(i=0; i<p->cg->nLineIps*2; i++)
- code->lineIps[i] = p->cg->lineIps[i];
+ code->constants[i] = naVec_get(p->cg->consts, i);
+
+ for(i=0; i<code->nArgs; i++) ARGSYMS(code)[i] = cg.argSyms[i];
+ for(i=0; i<code->nOptArgs; i++) OPTARGSYMS(code)[i] = cg.optArgSyms[i];
+ for(i=0; i<code->nOptArgs; i++) OPTARGVALS(code)[i] = cg.optArgVals[i];
+ for(i=0; i<code->codesz; i++) BYTECODE(code)[i] = cg.byteCode[i];
+ for(i=0; i<code->nLines; i++) LINEIPS(code)[i] = cg.lineIps[i];
+
return codeObj;
}
#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 IDENTICAL(a, b) (IS_REF(a) && IS_REF(b) \
- && PTR(a).obj == PTR(b).obj)
+#define IDENTICAL(a, b) (IS_REF(a) && IS_REF(b) && PTR(a).obj == PTR(b).obj)
#define MUTABLE(r) (IS_STR(r) && PTR(r).str->hashcode == 0)
GC_HEADER;
};
+#define MAX_STR_EMBLEN 15
struct naStr {
GC_HEADER;
- int len;
- unsigned char* data;
+ char emblen; /* [0-15], or -1 to indicate "not embedded" */
unsigned int hashcode;
+ union {
+ unsigned char buf[16];
+ struct {
+ int len;
+ unsigned char* ptr;
+ } ref;
+ } data;
};
struct VecRec {
struct HashNode* next;
};
-struct HashRec {
- int size;
- int dels;
- int lgalloced;
- struct HashNode* nodes;
- struct HashNode* table[];
-};
-
struct naHash {
GC_HEADER;
struct HashRec* rec;
struct naCode {
GC_HEADER;
- unsigned char nArgs;
- unsigned char nOptArgs;
- unsigned char needArgVector;
+ unsigned int nArgs : 5;
+ unsigned int nOptArgs : 5;
+ unsigned int needArgVector : 1;
unsigned short nConstants;
- unsigned short nLines;
unsigned short codesz;
- unsigned short* byteCode;
- naRef* constants;
- int* argSyms; // indices into constants
- int* optArgSyms;
- int* optArgVals;
- unsigned short* lineIps; // pairs of {ip, line}
+ unsigned short restArgSym; // The "..." vector name, defaults to "arg"
+ unsigned short nLines;
naRef srcFile;
- naRef restArgSym; // The "..." vector name, defaults to "arg"
+ naRef* constants;
};
+/* naCode objects store their variable length arrays in a single block
+ * starting with their constants table. Compute indexes at runtime
+ * for space efficiency: */
+#define BYTECODE(c) ((unsigned short*)((c)->constants+(c)->nConstants))
+#define ARGSYMS(c) (BYTECODE(c)+(c)->codesz)
+#define OPTARGSYMS(c) (ARGSYMS(c)+(c)->nArgs)
+#define OPTARGVALS(c) (OPTARGSYMS(c)+(c)->nOptArgs)
+#define LINEIPS(c) (OPTARGVALS(c)+(c)->nOptArgs)
+
struct naFunc {
GC_HEADER;
naRef code;
int naStr_tonum(naRef str, double* out);
naRef naStr_buf(naRef str, int len);
-int naHash_tryset(naRef hash, naRef key, naRef val); // sets if exists
-int naHash_sym(struct naHash* h, struct naStr* sym, naRef* out);
-void naHash_newsym(struct naHash* h, naRef* sym, naRef* val);
+int naiHash_tryset(naRef hash, naRef key, naRef val); // sets if exists
+int naiHash_sym(struct naHash* h, struct naStr* sym, naRef* out);
+void naiHash_newsym(struct naHash* h, naRef* sym, naRef* val);
void naGC_init(struct naPool* p, int type);
struct naObj** naGC_get(struct naPool* p, int n, int* nout);
void naGC_swapfree(void** target, void* val);
void naGC_freedead();
+void naiGCMark(naRef r);
+void naiGCMarkHash(naRef h);
void naStr_gcclean(struct naStr* s);
void naVec_gcclean(struct naVec* s);
-void naHash_gcclean(struct naHash* s);
+void naiGCHashClean(struct naHash* h);
#endif // _DATA_H
{
LOCK();
globals->nThreads--;
+ // We might be the "last" thread needed for collection. Since
+ // we're releasing our modlock to do something else for a while,
+ // wake someone else up to do it.
+ if(globals->waitCount == globals->nThreads)
+ naSemUp(globals->sem, 1);
UNLOCK();
}
static void naCode_gcclean(struct naCode* o)
{
- naFree(o->byteCode); o->byteCode = 0;
naFree(o->constants); o->constants = 0;
- naFree(o->argSyms); o->argSyms = 0;
- naFree(o->optArgSyms); o->optArgSyms = 0;
- naFree(o->optArgVals); o->optArgVals = 0;
- naFree(o->lineIps); o->lineIps = 0;
}
static void naGhost_gcclean(struct naGhost* g)
switch(p->type) {
case T_STR: naStr_gcclean ((struct naStr*) o); break;
case T_VEC: naVec_gcclean ((struct naVec*) o); break;
- case T_HASH: naHash_gcclean ((struct naHash*) o); break;
+ case T_HASH: naiGCHashClean ((struct naHash*) o); break;
case T_CODE: naCode_gcclean ((struct naCode*) o); break;
case T_GHOST: naGhost_gcclean((struct naGhost*)o); break;
}
mark(vr->array[i]);
}
-static void markhash(naRef r)
-{
- int i;
- struct HashRec* hr = PTR(r).hash->rec;
- if(!hr) return;
- for(i=0; i < (1<<hr->lgalloced); i++) {
- struct HashNode* hn = hr->table[i];
- while(hn) {
- mark(hn->key);
- mark(hn->val);
- hn = hn->next;
- }
- }
-}
-
// Sets the reference bit on the object, and recursively on all
// objects reachable from it. Uses the processor stack for recursion...
static void mark(naRef r)
PTR(r).obj->mark = 1;
switch(PTR(r).obj->type) {
case T_VEC: markvec(r); break;
- case T_HASH: markhash(r); break;
+ case T_HASH: naiGCMarkHash(r); break;
case T_CODE:
mark(PTR(r).code->srcFile);
for(i=0; i<PTR(r).code->nConstants; i++)
}
}
+void naiGCMark(naRef r)
+{
+ mark(r);
+}
+
// Collects all the unreachable objects into a free list, and
// allocates more space if needed.
static void reap(struct naPool* p)
+#include <string.h>
#include "nasal.h"
#include "data.h"
-#define MIN_HASH_SIZE 4
+/* A HashRec lives in a single allocated block. The layout is the
+ * header struct, then a table of 2^lgsz hash entries (key/value
+ * pairs), then an index table of 2*2^lgsz integers storing index
+ * values into the entry table. There are two tokens needed for
+ * "unused" and "used but empty". */
-#define EQUAL(a, b) (IDENTICAL(a, b) || naEqual(a, b))
+#define ENT_EMPTY -1
+#define ENT_DELETED -2
-#define HASH_MAGIC 2654435769u
+typedef struct { naRef key, val; } HashEnt;
-#define INSERT(hh, hkey, hval, hcol) do { \
- unsigned int cc = (hcol), iidx=(hh)->size++; \
- if(iidx < (1<<(hh)->lgalloced)) { \
- struct HashNode* hnn = &(hh)->nodes[iidx]; \
- hnn->key = (hkey); hnn->val = (hval); \
- hnn->next = (hh)->table[cc]; \
- (hh)->table[cc] = hnn; \
- }} while(0)
+typedef struct HashRec {
+ int size; /* number of active entries */
+ int lgsz; /* base-2 logarithm of the allocated (!) size */
+ int next; /* next entry to use */
+} HashRec;
-// Computes a hash code for a given scalar
-static unsigned int hashcode(naRef r)
+#define REC(h) (PTR(h).hash->rec)
+#define POW2(n) (1<<(n))
+#define NCELLS(hr) (2*POW2((hr)->lgsz))
+#define ROUNDUPOFF(n,m) ((((n)+(m-1))/m)*m)-(n)
+#define ALIGN(p,sz) (((char*)p)+ROUNDUPOFF(((size_t)p)%sz,sz))
+#define ENTS(h) ((HashEnt*)ALIGN(&((HashRec*)h)[1],sizeof(naRef)))
+#define TAB(h) ((int*)&(ENTS(h)[1<<(h)->lgsz]))
+#define HBITS(hr,code) ((hr)->lgsz ? ((code)>>(32-(hr)->lgsz)) : 0)
+
+#define LROT(h,n) (((h)<<n)|((h)>>((8*sizeof(h))-n)))
+static unsigned int mix32(unsigned int h)
{
- if(IS_NUM(r))
- {
- // Numbers get the number as a hash. Just use the bits and
- // xor them together. Note assumption that sizeof(double) >=
- // 2*sizeof(int).
- unsigned int* p = (unsigned int*)&(r.num);
- return p[0] ^ p[1];
- } 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<PTR(r).str->len; i++)
- hash = (hash * 33) ^ PTR(r).str->data[i];
- PTR(r).str->hashcode = hash;
- return hash;
+ h ^= 0x2e63823a; h += LROT(h, 15); h -= LROT(h, 9);
+ h += LROT(h, 4); h -= LROT(h, 1); h ^= LROT(h, 2);
+ return h;
+}
+static unsigned int hash32(const unsigned char* in, int len)
+{
+ unsigned int h = len, val = 0;
+ int i, count = 0;
+ for(i=0; i<len; i++) {
+ val = (val<<8) ^ in[i];
+ if(++count == 4) {
+ h = mix32(h ^ val);
+ val = count = 0;
+ }
}
+ return mix32(h ^ val);
}
-// Which column in a given hash does the key correspond to.
-static unsigned int hashcolumn(struct HashRec* h, naRef key)
+static unsigned int refhash(naRef key)
{
- // Multiply by a big number, and take the top N bits. Note
- // assumption that sizeof(unsigned int) == 4.
- return (HASH_MAGIC * hashcode(key)) >> (32 - h->lgalloced);
+ if(IS_STR(key)) {
+ struct naStr* s = PTR(key).str;
+ if(s->hashcode) return s->hashcode;
+ return s->hashcode = hash32((void*)naStr_data(key), naStr_len(key));
+ } else { /* must be a number */
+ union { double d; unsigned int u[2]; } n;
+ n.d = key.num == -0.0 ? 0.0 : key.num; /* remember negative zero! */
+ return mix32(mix32(n.u[0]) ^ n.u[1]);
+ }
}
-static struct HashRec* resize(struct naHash* hash)
+static int equal(naRef a, naRef b)
{
- struct HashRec *h, *h0 = hash->rec;
- int lga, cols, need = h0 ? h0->size - h0->dels : MIN_HASH_SIZE;
+ if(IS_NUM(a)) return a.num == b.num;
+ if(PTR(a).obj == PTR(b).obj) return 1;
+ if(naStr_len(a) != naStr_len(b)) return 0;
+ return memcmp(naStr_data(a), naStr_data(b), naStr_len(a)) == 0;
+}
- if(need < MIN_HASH_SIZE) need = MIN_HASH_SIZE;
- for(lga=0; 1<<lga <= need; lga++);
- cols = 1<<lga;
- h = naAlloc(sizeof(struct HashRec) +
- cols * (sizeof(struct HashNode*) + sizeof(struct HashNode)));
- naBZero(h, sizeof(struct HashRec) + cols * sizeof(struct HashNode*));
+/* Returns the index of a cell that either contains a matching key, or
+ * is the empty slot to receive a new insertion. */
+static int findcell(struct HashRec *hr, naRef key, unsigned int hash)
+{
+ int i, mask = POW2(hr->lgsz+1)-1, step = (2*hash+1) & mask;
+ for(i=HBITS(hr,hash); TAB(hr)[i] != ENT_EMPTY; i=(i+step)&mask)
+ if(TAB(hr)[i] != ENT_DELETED && equal(key, ENTS(hr)[TAB(hr)[i]].key))
+ break;
+ return i;
+}
- h->lgalloced = lga;
- h->nodes = (struct HashNode*)(((char*)h)
- + sizeof(struct HashRec)
- + cols * sizeof(struct HashNode*));
- for(lga=0; h0 != 0 && lga<(1<<h0->lgalloced); lga++) {
- struct HashNode* hn = h0->table[lga];
- while(hn) {
- INSERT(h, hn->key, hn->val, hashcolumn(h, hn->key));
- hn = hn->next;
- }
+static void hashset(HashRec* hr, naRef key, naRef val)
+{
+ int ent, cell = findcell(hr, key, refhash(key));
+ if((ent = TAB(hr)[cell]) == ENT_EMPTY) {
+ ent = hr->next++;
+ if(ent >= NCELLS(hr)) return; /* race protection, don't overrun */
+ TAB(hr)[cell] = ent;
+ hr->size++;
+ ENTS(hr)[ent].key = key;
}
- naGC_swapfree((void**)&hash->rec, h);
- return h;
+ ENTS(hr)[ent].val = val;
}
-// Special, optimized version of naHash_get for the express purpose of
-// looking up symbols in the local variables hash (OP_LOCAL is by far
-// the most common opcode and deserves some special case
-// optimization). Elides all the typing checks that are normally
-// required, presumes that the key is a string and has had its
-// hashcode precomputed, checks only for object identity, and inlines
-// the column computation.
-int naHash_sym(struct naHash* hash, struct naStr* sym, naRef* out)
+static int recsize(int lgsz)
{
- struct HashRec* h = hash->rec;
- if(h) {
- int col = (HASH_MAGIC * sym->hashcode) >> (32 - h->lgalloced);
- struct HashNode* hn = h->table[col];
- while(hn) {
- if(PTR(hn->key).str == sym) {
- *out = hn->val;
- return 1;
- }
- hn = hn->next;
- }
+ HashRec hr;
+ hr.lgsz = lgsz;
+ return (int)((char*)&TAB(&hr)[POW2(lgsz+1)] - (char*)&hr);
+}
+
+static HashRec* resize(struct naHash* hash)
+{
+ HashRec *hr = hash->rec, *hr2;
+ int i, lgsz = 0;
+ if(hr) {
+ int oldsz = hr->size;
+ while(oldsz) { oldsz >>= 1; lgsz++; }
}
- return 0;
+ hr2 = naAlloc(recsize(lgsz));
+ hr2->size = hr2->next = 0;
+ hr2->lgsz = lgsz;
+ for(i=0; i<(2*(1<<lgsz)); i++)
+ TAB(hr2)[i] = ENT_EMPTY;
+ for(i=0; hr && i < POW2(hr->lgsz+1); i++)
+ if(TAB(hr)[i] >= 0)
+ hashset(hr2, ENTS(hr)[TAB(hr)[i]].key, ENTS(hr)[TAB(hr)[i]].val);
+ naGC_swapfree((void*)&hash->rec, hr2);
+ return hr2;
}
-static struct HashNode* find(struct naHash* hash, naRef key)
+int naHash_size(naRef h) { return REC(h) ? REC(h)->size : 0; }
+
+int naHash_get(naRef hash, naRef key, naRef* out)
{
- struct HashRec* h = hash->rec;
- 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;
+ HashRec* hr = REC(hash);
+ if(hr) {
+ int ent, cell = findcell(hr, key, refhash(key));
+ if((ent = TAB(hr)[cell]) < 0) return 0;
+ *out = ENTS(hr)[ent].val;
+ return 1;
+ }
return 0;
}
-// Make a temporary string on the stack
+void naHash_set(naRef hash, naRef key, naRef val)
+{
+ HashRec* hr = REC(hash);
+ if(!hr || hr->next >= POW2(hr->lgsz))
+ hr = resize(PTR(hash).hash);
+ hashset(hr, key, val);
+}
+
+void naHash_delete(naRef hash, naRef key)
+{
+ HashRec* hr = REC(hash);
+ if(hr) {
+ int cell = findcell(hr, key, refhash(key));
+ if(TAB(hr)[cell] >= 0) {
+ TAB(hr)[cell] = ENT_DELETED;
+ if(--hr->size < POW2(hr->lgsz-1))
+ resize(PTR(hash).hash);
+ }
+ }
+}
+
+void naHash_keys(naRef dst, naRef hash)
+{
+ int i;
+ HashRec* hr = REC(hash);
+ for(i=0; hr && i < NCELLS(hr); i++)
+ if(TAB(hr)[i] >= 0)
+ naVec_append(dst, ENTS(hr)[TAB(hr)[i]].key);
+}
+
+void naiGCMarkHash(naRef hash)
+{
+ int i;
+ HashRec* hr = REC(hash);
+ for(i=0; hr && i < NCELLS(hr); i++)
+ if(TAB(hr)[i] >= 0) {
+ naiGCMark(ENTS(hr)[TAB(hr)[i]].key);
+ naiGCMark(ENTS(hr)[TAB(hr)[i]].val);
+ }
+}
+
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();
+ str->hashcode = str->emblen = 0;
+ str->data.ref.ptr = (unsigned char*)key;
+ str->data.ref.len = strlen(key);
SETPTR(*out, str);
}
int naMember_cget(naRef obj, const char* field, naRef* out)
{
- naRef key;
- struct naStr str;
+ naRef key; struct naStr str;
tmpStr(&key, &str, field);
return naMember_get(obj, key, out);
}
struct naStr str;
naRef result, key2;
tmpStr(&key2, &str, key);
- if(naHash_get(hash, key2, &result))
- return result;
- return naNil();
+ return naHash_get(hash, key2, &result) ? result : naNil();
}
void naHash_cset(naRef hash, char* key, naRef val)
{
- struct naStr str;
- naRef key2;
+ naRef key2; struct naStr str;
tmpStr(&key2, &str, key);
- naHash_tryset(hash, key2, val);
+ naiHash_tryset(hash, key2, val);
}
-int naHash_get(naRef hash, naRef key, naRef* out)
+int naiHash_tryset(naRef hash, naRef key, naRef val)
{
- if(IS_HASH(hash)) {
- struct HashNode* n = find(PTR(hash).hash, key);
- if(n) { *out = n->val; return 1; }
+ HashRec* hr = REC(hash);
+ if(hr) {
+ int ent, cell = findcell(hr, key, refhash(key));
+ if((ent = TAB(hr)[cell]) >= 0) { ENTS(hr)[ent].val = val; return 1; }
}
return 0;
}
-// Simpler version. Don't create a new node if the value isn't there
-int naHash_tryset(naRef hash, naRef key, naRef val)
+void naiGCHashClean(struct naHash* h)
{
- if(IS_HASH(hash)) {
- struct HashNode* n = find(PTR(hash).hash, key);
- if(n) n->val = val;
- return n != 0;
- }
- return 0;
-}
-
-// Special purpose optimization for use in function call setups. Sets
-// a value that is known *not* to be present in the hash table. As
-// for naHash_sym, the key must be a string with a precomputed hash
-// code.
-void naHash_newsym(struct naHash* hash, naRef* sym, naRef* val)
-{
- int col;
- struct HashRec* h = hash->rec;
- while(!h || h->size >= 1<<h->lgalloced)
- h = resize(hash);
- col = (HASH_MAGIC * PTR(*sym).str->hashcode) >> (32 - h->lgalloced);
- INSERT(h, *sym, *val, col);
-}
-
-// The cycle check is an integrity requirement for multithreading,
-// where raced inserts can potentially cause cycles. This ensures
-// that the "last" thread to hold a reference to an inserted node
-// breaks any cycles that might have happened (at the expense of
-// potentially dropping items out of the hash). Under normal
-// circumstances, chains will be very short and this will be fast.
-static void chkcycle(struct HashNode* node, int count)
-{
- struct HashNode* hn = node;
- while(hn && (hn = hn->next) != 0)
- if(count-- <= 0) { node->next = 0; return; }
-}
-
-void naHash_set(naRef hash, naRef key, naRef val)
-{
- int col;
- struct HashRec* h;
- struct HashNode* n;
- if(!IS_HASH(hash)) return;
- 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(PTR(hash).hash);
- col = hashcolumn(h, key);
- INSERT(h, key, val, hashcolumn(h, key));
- chkcycle(h->table[col], h->size - h->dels);
+ naFree(h->rec);
+ h->rec = 0;
}
-void naHash_delete(naRef hash, naRef key)
+/* Optimized naHash_get for looking up local variables (OP_LOCAL is by
+ * far the most common opcode and deserves some special case
+ * optimization). Assumes that the key is an interned symbol
+ * (i.e. the hash code is precomputed, and we only need to test for
+ * pointer identity). */
+int naiHash_sym(struct naHash* hash, struct naStr* sym, naRef* out)
{
- struct HashRec* h = PTR(hash).hash->rec;
- int col;
- struct HashNode *last=0, *hn;
- if(!IS_HASH(hash) || !h) return;
- col = hashcolumn(h, key);
- hn = h->table[col];
- while(hn) {
- if(EQUAL(hn->key, key)) {
- if(last == 0) h->table[col] = hn->next;
- else last->next = hn->next;
- h->dels++;
- return;
- }
- last = hn;
- hn = hn->next;
+ HashRec* hr = hash->rec;
+ if(hr) {
+ int* tab = TAB(hr);
+ HashEnt* ents = ENTS(hr);
+ unsigned int hc = sym->hashcode;
+ int cell, mask = POW2(hr->lgsz+1) - 1, step = (2*hc+1) & mask;
+ for(cell=HBITS(hr,hc); tab[cell] != ENT_EMPTY; cell=(cell+step)&mask)
+ if(tab[cell]!=ENT_DELETED && sym==PTR(ents[tab[cell]].key).str) {
+ *out = ents[tab[cell]].val;
+ return 1;
+ }
}
+ return 0;
}
-void naHash_keys(naRef dst, naRef hash)
-{
- int i;
- 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];
- while(hn) {
- naVec_append(dst, hn->key);
- hn = hn->next;
- }
- }
-}
-int naHash_size(naRef hash)
+/* As above, a special naHash_set for setting local variables.
+ * Assumes that the key is interned, and also that it isn't already
+ * present in the hash. */
+void naiHash_newsym(struct naHash* hash, naRef* sym, naRef* val)
{
- struct HashRec* h = PTR(hash).hash->rec;
- if(!IS_HASH(hash) || !h) return 0;
- return h->size - h->dels;
+ HashRec* hr = hash->rec;
+ int mask, step, cell, ent;
+ struct naStr *s = PTR(*sym).str;
+ if(!hr || hr->next >= POW2(hr->lgsz))
+ hr = resize(hash);
+ mask = POW2(hr->lgsz+1) - 1;
+ step = (2*s->hashcode+1) & mask;
+ cell = HBITS(hr, s->hashcode);
+ while(TAB(hr)[cell] != ENT_EMPTY)
+ cell = (cell + step) & mask;
+ ent = hr->next++;
+ if(ent >= NCELLS(hr)) return; /* race protection, don't overrun */
+ TAB(hr)[cell] = ent;
+ hr->size++;
+ ENTS(hr)[TAB(hr)[cell]].key = *sym;
+ ENTS(hr)[TAB(hr)[cell]].val = *val;
}
-void naHash_gcclean(struct naHash* h)
-{
- naFree(h->rec);
- h->rec = 0;
-}
#include "iolib.h"
static void ghostDestroy(void* g);
-naGhostType naIOGhostType = { ghostDestroy };
+naGhostType naIOGhostType = { ghostDestroy, "iofile" };
static struct naIOGhost* ioghost(naRef r)
{
naRef len = argc > 2 ? naNumValue(args[2]) : naNil();
if(!g || !MUTABLE(str) || !IS_NUM(len))
naRuntimeError(c, "bad argument to read()");
- if(PTR(str).str->len < (int)len.num)
+ if(naStr_len(str) < (int)len.num)
naRuntimeError(c, "string not big enough for read");
- return naNum(g->type->read(c, g->handle, (char*)PTR(str).str->data,
+ return naNum(g->type->read(c, g->handle, naStr_data(str),
(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*)PTR(str).str->data,
- PTR(str).str->len));
+ return naNum(g->type->write(c, g->handle, naStr_data(str),
+ naStr_len(str)));
}
static naRef f_seek(naContext c, naRef me, int argc, naRef* args)
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*)PTR(file).str->data,
- IS_STR(mode) ? (const char*)PTR(mode).str->data : "rb");
+ f = fopen(naStr_data(file), IS_STR(mode) ? naStr_data(mode) : "rb");
if(!f) naRuntimeError(c, strerror(errno));
return naIOGhost(c, f);
}
{
naRef result;
struct naIOGhost* g = argc==1 ? ioghost(args[0]) : 0;
- int i=0, sz = 128, c, c2;
+ int i=0, c, sz = 128;
char *buf;
if(!g || g->type != &naStdIOType)
naRuntimeError(ctx, "bad argument to readln()");
c = getcguard(ctx, g->handle, buf);
if(c == EOF || c == '\n') break;
if(c == '\r') {
- c2 = getcguard(ctx, g->handle, buf);
+ int c2 = getcguard(ctx, g->handle, buf);
if(c2 != EOF && c2 != '\n')
if(EOF == ungetc(c2, g->handle))
break;
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*)PTR(path).str->data, &s) < 0) {
+ if(stat(naStr_data(path), &s) < 0) {
if(errno == ENOENT) return naNil();
naRuntimeError(ctx, strerror(errno));
}
#include "parse.h"
// Static table of recognized lexemes in the language
-struct Lexeme {
+static const struct Lexeme {
char* str;
int tok;
} LEXEMES[] = {
tok->str = str;
tok->strlen = slen;
tok->num = num;
- tok->parent = &p->tree;
tok->next = 0;
tok->prev = last;
tok->children = 0;
}
// Ditto, but more complicated for double quotes.
+/* FIXME: need to handle \b (8), \f (12), and \uXXXX for JSON compliance */
static void dqEscape(char* buf, int len, int index, struct Parser* p,
char* cOut, int* eatenOut)
{
// 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...
+//
+// FIXME: don't use naCall at all here, we don't need it. Fix up the
+// context stack to tail call the function directly. There's no need
+// for f_call() to live on the C stack at all.
static naRef f_call(naContext c, naRef me, int argc, naRef* args)
{
naContext subc;
int start = 0;
if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1])) ARGERR();
if(argc > 2) start = (int)(naNumValue(args[2]).num);
- return naNum(find(PTR(args[0]).str->data, PTR(args[0]).str->len,
- PTR(args[1]).str->data, PTR(args[1]).str->len,
+ return naNum(find((void*)naStr_data(args[0]), naStr_len(args[0]),
+ (void*)naStr_data(args[1]), naStr_len(args[1]),
start));
}
return out;
}
+static naRef f_id(naContext c, naRef me, int argc, naRef* args)
+{
+ char *t = "unk", buf[64];
+ if(argc != 1 || !IS_REF(args[0]))
+ naRuntimeError(c, "bad/missing argument to id()");
+ if (IS_STR(args[0])) t = "str";
+ else if(IS_VEC(args[0])) t = "vec";
+ else if(IS_HASH(args[0])) t = "hash";
+ else if(IS_CODE(args[0])) t = "code";
+ else if(IS_FUNC(args[0])) t = "func";
+ else if(IS_CCODE(args[0])) t = "ccode";
+ else if(IS_GHOST(args[0])) {
+ naGhostType *gt = PTR(args[0]).ghost->gtype;
+ t = gt->name ? (char*)gt->name : "ghost";
+ }
+ sprintf(buf, "%s:%p", (char*)t, (void*)PTR(args[0]).obj);
+ return NEWCSTR(c, buf);
+}
+
static naCFuncItem funcs[] = {
{ "size", f_size },
{ "keys", f_keys },
{ "rand", f_rand },
{ "bind", f_bind },
{ "sort", f_sort },
+ { "id", f_id },
{ 0 }
};
naRef naNewString(struct Context* c)
{
naRef s = naNew(c, T_STR);
- PTR(s).str->len = 0;
- PTR(s).str->data = 0;
+ PTR(s).str->emblen = 0;
+ PTR(s).str->data.ref.len = 0;
+ PTR(s).str->data.ref.ptr = 0;
PTR(s).str->hashcode = 0;
return s;
}
int naStrEqual(naRef a, naRef b)
{
int i;
- if(!(IS_STR(a) && IS_STR(b)))
+ char *ap, *bp;
+ if(!IS_STR(a) || !IS_STR(b) || naStr_len(a) != naStr_len(b))
return 0;
- if(PTR(a).str->len != PTR(b).str->len)
- return 0;
- for(i=0; i<PTR(a).str->len; i++)
- if(PTR(a).str->data[i] != PTR(b).str->data[i])
+ ap = naStr_data(a);
+ bp = naStr_data(b);
+ for(i=0; i<naStr_len(a); i++)
+ if(ap[i] != bp[i])
return 0;
return 1;
}
defined(__powerpc64__)
/* Win64 and Irix should work with this too, but have not been
* tested */
-# define NASAL_NAN64
-#elif defined(_M_IX86) || defined(i386) || defined(__x86_64) || \
+# define NASAL_NAN64
+#elif defined(_M_IX86) || defined(i386) || defined(__x86_64) || \
defined(__ia64__) || defined(_M_IA64) || defined(__ARMEL__)
# define NASAL_LE
-#elif defined(__sparc) || defined(__ppc__) ||defined(__PPC) || \
+#elif defined(__sparc) || defined(__ppc__) || defined(__PPC) || \
defined(__mips) || defined(__ARMEB__)
# define NASAL_BE
#else
struct naGhost* ghost;
} naPtr;
-#if defined(NASAL_NAN64)
-
-/* On suppoted 64 bit platforms (those where all memory returned from
+/* On supported 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;
+ * sure all pointers are stored as NaNs. 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 */
-#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
+#if defined(NASAL_LE)
typedef struct { naPtr ptr; int reftag; } naRefPart;
-#else /* NASAL_BE */
+#elif defined(NASAL_BE)
typedef struct { int reftag; naPtr ptr; } naRefPart;
#endif
-typedef union {
- double num;
- naRefPart ref;
-} naRef;
-
+#if defined(NASAL_NAN64)
+typedef union { double num; void* ptr; } naRef;
+#else
+typedef union { double num; naRefPart ref; } naRef;
#endif
#endif // _NAREF_H
naRef naStringValue(naContext c, naRef n);
// String utilities:
-int naStr_len(naRef s);
-char* naStr_data(naRef s);
-naRef naStr_fromdata(naRef dst, char* data, int len);
+int naStr_len(naRef s) GCC_PURE;
+char* naStr_data(naRef s) GCC_PURE;
+naRef naStr_fromdata(naRef dst, const char* data, int len);
naRef naStr_concat(naRef dest, naRef s1, naRef s2);
naRef naStr_substr(naRef dest, naRef str, int start, int len);
naRef naInternSymbol(naRef sym);
// Ghost utilities:
typedef struct naGhostType {
- void (*destroy)(void* ghost);
+ void(*destroy)(void*);
const char* name;
} naGhostType;
naRef naNewGhost(naContext c, naGhostType* t, void* 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 (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
+// garbage collector (nasal data on 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
// Static precedence table, from low (loose binding, do first) to high
// (tight binding, do last).
#define MAX_PREC_TOKS 6
-struct precedence {
+static const struct precedence {
int toks[MAX_PREC_TOKS];
int rule;
} PRECEDENCE[] = {
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;
longjmp(p->jumpHandle, 1);
}
-// A "generic" (too obfuscated to describe) parser error
-static void oops(struct Parser* p, struct Token* t)
-{
- naParseError(p, "parse error", t->line);
-}
+static void oops(struct Parser* p) { naParseError(p, "parse error", -1); }
void naParseInit(struct Parser* p)
{
- p->buf = 0;
- p->len = 0;
- p->lines = 0;
- p->nLines = 0;
- p->chunks = 0;
- p->chunkSizes = 0;
- p->nChunks = 0;
- p->leftInChunk = 0;
- p->cg = 0;
-
+ memset(p, 0, sizeof(*p));
p->tree.type = TOK_TOP;
p->tree.line = 1;
- p->tree.str = 0;
- p->tree.strlen = 0;
- p->tree.num = 0;
- p->tree.next = 0;
- p->tree.prev = 0;
- p->tree.children = 0;
- p->tree.lastChild = 0;
}
void naParseDestroy(struct Parser* p)
void* naParseAlloc(struct Parser* p, int bytes)
{
char* result;
-
- // Round up to 8 byte chunks for alignment
- if(bytes & 0x7) bytes = ((bytes>>3) + 1) << 3;
+ bytes = (bytes+7) & (~7); // Round up to 8 byte chunks for alignment
- // Need a new chunk?
if(p->leftInChunk < bytes) {
void* newChunk;
void** newChunks;
result = (char *)p->chunks[0] + p->chunkSizes[0] - p->leftInChunk;
p->leftInChunk -= bytes;
- return (void*)result;
+ return result;
}
-// Remove the child from the list where it exists, and insert it at
-// the end of the parents child list.
-static void addNewChild(struct Token* p, struct Token* c)
+static void addChild(struct Token *par, struct Token *ch)
{
- if(c->prev) c->prev->next = c->next;
- if(c->next) c->next->prev = c->prev;
- if(c == c->parent->children)
- c->parent->children = c->next;
- if(c == c->parent->lastChild)
- c->parent->lastChild = c->prev;
- c->parent = p;
- c->next = 0;
- c->prev = p->lastChild;
- if(p->lastChild) p->lastChild->next = c;
- if(!p->children) p->children = c;
- p->lastChild = c;
+ if(par->lastChild) {
+ ch->prev = par->lastChild;
+ par->lastChild->next = ch;
+ } else
+ par->children = ch;
+ par->lastChild = ch;
}
-// Follows the token list from start (which must be a left brace of
-// some type), placing all tokens found into start's child list until
-// it reaches the matching close brace.
-static void collectBrace(struct Parser* p, struct Token* start)
+static int endBrace(int tok)
{
- struct Token* t;
- int closer = -1;
- if(start->type == TOK_LPAR) closer = TOK_RPAR;
- if(start->type == TOK_LBRA) closer = TOK_RBRA;
- if(start->type == TOK_LCURL) closer = TOK_RCURL;
+ if(tok == TOK_LBRA) return TOK_RBRA;
+ if(tok == TOK_LPAR) return TOK_RPAR;
+ if(tok == TOK_LCURL) return TOK_RCURL;
+ return -1;
+}
- t = start->next;
- while(t) {
- struct Token* next;
- switch(t->type) {
- case TOK_LPAR: case TOK_LBRA: case TOK_LCURL:
- collectBrace(p, t);
- break;
- case TOK_RPAR: case TOK_RBRA: case TOK_RCURL:
- if(t->type != closer)
- naParseError(p, "mismatched closing brace", t->line);
-
- // Drop this node on the floor, stitch up the list and return
- if(start->parent->lastChild == t)
- start->parent->lastChild = t->prev;
- start->next = t->next;
- if(t->next) t->next->prev = start;
- return;
- }
- // Snip t out of the existing list, and append it to start's
- // children.
- next = t->next;
- addNewChild(start, t);
- t = next;
- }
- naParseError(p, "unterminated brace", start->line);
+static int isOpenBrace(int t)
+{
+ return t==TOK_LPAR || t==TOK_LBRA || t==TOK_LCURL;
}
-// Recursively find the contents of all matching brace pairs in the
-// token list and turn them into children of the left token. The
-// right token disappears.
-static void braceMatch(struct Parser* p, struct Token* start)
+static int isLoopoid(int t)
{
- struct Token* t = start;
- while(t) {
- switch(t->type) {
- case TOK_LPAR: case TOK_LBRA: case TOK_LCURL:
- collectBrace(p, t);
- break;
- case TOK_RPAR: case TOK_RBRA: case TOK_RCURL:
- if(start->type != TOK_LBRA)
- naParseError(p, "stray closing brace", t->line);
- break;
- }
- t = t->next;
- }
+ return t==TOK_FOR || t==TOK_FOREACH || t==TOK_WHILE || t==TOK_FORINDEX;
}
-// Allocate and return an "empty" token as a parsing placeholder.
-static struct Token* emptyToken(struct Parser* p)
+static int isBlockoid(int t)
{
- struct Token* t = naParseAlloc(p, sizeof(struct Token));
- t->type = TOK_EMPTY;
- t->line = -1;
- t->strlen = 0;
- t->num = 0;
- t->str = 0;
- t->next = t->prev = t->children = t->lastChild = 0;
- t->parent = 0;
- return t;
+ return isLoopoid(t)||t==TOK_IF||t==TOK_ELSIF||t==TOK_ELSE||t==TOK_FUNC;
}
-// 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)
+/* Yes, a bare else or elsif ends a block; it means we've reached the
+ * end of the previous if/elsif clause. */
+static int isBlockEnd(int 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;
+ return t==TOK_RPAR||t==TOK_RBRA||t==TOK_RCURL||t==TOK_ELSIF||t==TOK_ELSE;
}
-#define NEXT(t) (t ? t->next : 0)
-#define TYPE(t) (t ? t->type : -1)
+/* To match C's grammar, "blockoid" expressions sometimes need
+ * synthesized terminating semicolons to make them act like
+ * "statements" in C. Always add one after "loopoid"
+ * (for/foreach/while) expressions. Add one after a func if it
+ * immediately follows an assignment, and add one after an
+ * if/elsif/else if it is the first token in an expression list */
+static int needsSemi(struct Token* t, struct Token* next)
+{
+ if(!next || next->type == TOK_SEMI || isBlockEnd(next->type)) return 0;
+ if(t->type == TOK_IF) return !t->prev || t->prev->type == TOK_SEMI;
+ if(t->type == TOK_FUNC) return t->prev && t->prev->type == TOK_ASSIGN;
+ if(isLoopoid(t->type)) return 1;
+ return 0;
+}
-static void fixBracelessBlocks(struct Parser* p, struct Token* t)
+static struct Token* newToken(struct Parser* p, int type)
{
- // 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;
- }
+ struct Token* t = naParseAlloc(p, sizeof(struct Token));
+ memset(t, 0, sizeof(*t));
+ t->type = type;
+ t->line = -1;
+ return t;
+}
+
+static struct Token* parseToken(struct Parser* p, struct Token** list);
+
+static void parseBlock(struct Parser* p, struct Token *top,
+ int end, struct Token** list)
+{
+ struct Token *t;
+ while(*list) {
+ if(isBlockEnd((*list)->type) && (*list)->type != end) break;
+ if(end == TOK_SEMI && (*list)->type == TOK_COMMA) break;
+ t = parseToken(p, list);
+ if(t->type == end) return; /* drop end token on the floor */
+ addChild(top, t);
+ if(needsSemi(t, *list))
+ addChild(top, newToken(p, TOK_SEMI));
}
+ /* Context dependency: end of block is a parse error UNLESS we're
+ * looking for a statement terminator (a braceless block) or a -1
+ * (the top level) */
+ if(end != TOK_SEMI && end != -1) oops(p);
}
-// 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)
+static struct Token* parseToken(struct Parser* p, struct Token** list)
{
- struct Token *t, *c;
- fixBracelessBlocks(p, start);
- t = start;
- while(t) {
- switch(t->type) {
- case TOK_FUNC:
- // Slurp an optional paren block containing an arglist, then
- // fall through to parse the curlies...
- if(t->next && t->next->type == TOK_LPAR) {
- c = t->next;
- addNewChild(t, c);
- fixBlockStructure(p, c);
- }
- case TOK_ELSE: // and TOK_FUNC!
- // These guys precede a single curly block
- if(!t->next || t->next->type != TOK_LCURL) oops(p, t);
- c = t->next;
- addNewChild(t, c);
- fixBlockStructure(p, c);
- break;
- case TOK_FOR: case TOK_FOREACH: case TOK_FORINDEX: case TOK_WHILE:
- case TOK_IF: case TOK_ELSIF:
- // Expect a paren and then a curly
- if(!t->next || t->next->type != TOK_LPAR) oops(p, t);
- c = t->next;
- addNewChild(t, c);
- fixBlockStructure(p, c);
-
- if(!t->next || t->next->type != TOK_LCURL) oops(p, t);
- c = t->next;
- addNewChild(t, c);
- fixBlockStructure(p, c);
- break;
- case TOK_LPAR: case TOK_LBRA: case TOK_LCURL:
- fixBlockStructure(p, t->children);
- break;
+ struct Token *t = *list;
+ *list = t->next;
+ if(t->next) t->next->prev = 0;
+ t->next = t->prev = 0;
+ p->errLine = t->line;
+
+ if(!t) return 0;
+ if(isOpenBrace(t->type)) {
+ parseBlock(p, t, endBrace(t->type), list);
+ } else if(isBlockoid(t->type)) {
+ /* Read an optional paren expression */
+ if(!*list) oops(p);
+ if((*list)->type == TOK_LPAR)
+ addChild(t, parseToken(p, list));
+
+ /* And the code block, which might be implicit/braceless */
+ if(!*list) oops(p);
+ if((*list)->type == TOK_LCURL) {
+ addChild(t, parseToken(p, list));
+ } else {
+ /* Context dependency: if we're reading a braceless block,
+ * and the first (!) token is itself a "blockoid"
+ * expression, it is parsed alone, otherwise, read to the
+ * terminating semicolon. */
+ struct Token *blk = newToken(p, TOK_LCURL);
+ if(isBlockoid((*list)->type)) addChild(blk, parseToken(p, list));
+ else parseBlock(p, blk, TOK_SEMI, list);
+ addChild(t, blk);
}
- t = t->next;
- }
- // Another pass to hook up the elsif/else chains.
- t = start;
- while(t) {
+ /* Read the elsif/else chain */
if(t->type == TOK_IF) {
- while(t->next && t->next->type == TOK_ELSIF)
- addNewChild(t, t->next);
- if(t->next && t->next->type == TOK_ELSE)
- addNewChild(t, t->next);
+ while(*list && ((*list)->type == TOK_ELSIF))
+ addChild(t, parseToken(p, list));
+ if(*list && (*list)->type == TOK_ELSE)
+ addChild(t, parseToken(p, list));
}
- t = t->next;
- }
- // And a final one to add semicolons. Always add one after
- // for/foreach/while expressions. Add one after a function lambda
- // if it immediately follows an assignment, and add one after an
- // if/elsif/else if it is the first token in an expression list
- // (i.e has no previous token, or is preceded by a ';' or '{').
- // This mimicks common usage and avoids a conspicuous difference
- // between this grammar and more common languages. It can be
- // "escaped" with extra parenthesis if necessary, e.g.:
- // a = (func { join(" ", arg) })(1, 2, 3, 4);
- t = start;
- while(t) {
- int addSemi = 0;
- switch(t->type) {
- case TOK_IF:
- if(!t->prev
- || t->prev->type == TOK_SEMI
- || t->prev->type == TOK_LCURL)
- addSemi = 1;
- break;
- case TOK_FOR: case TOK_FOREACH: case TOK_FORINDEX: case TOK_WHILE:
- addSemi = 1;
- break;
- case TOK_FUNC:
- if(t->prev && t->prev->type == TOK_ASSIGN)
- addSemi = 1;
- break;
+ /* Finally, check for proper usage */
+ if(t->type != TOK_FUNC) {
+ if(t->type == TOK_ELSE && t->children->type != TOK_LCURL) oops(p);
+ if(t->type != TOK_ELSE && t->children->type != TOK_LPAR) oops(p);
}
- 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->line = t->line;
- semi->next = t->next;
- 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
- }
- t = t->next;
}
-
+ return t;
}
// True if the token's type exists in the precedence level.
return 0;
}
-static int isBrace(int type)
+static struct Token* parsePrecedence(struct Parser* p, struct Token* start,
+ struct Token* end, int level);
+
+static void precChildren(struct Parser* p, struct Token* t)
{
- return type == TOK_LPAR || type == TOK_LBRA || type == TOK_LCURL;
+ struct Token* top = parsePrecedence(p, t->children, t->lastChild, 0);
+ t->children = top;
+ t->lastChild = top;
}
-static int isBlock(int t)
+// Run a "block structure" node (if/elsif/else/for/while/foreach)
+// through the precedence parser. The funny child structure makes
+// this a little more complicated than it should be.
+static void precBlock(struct Parser* p, struct Token* block)
{
- return t == TOK_IF || t == TOK_ELSIF || t == TOK_ELSE
- || t == TOK_FOR || t == TOK_FOREACH || t == TOK_WHILE
- || t == TOK_FUNC || t == TOK_FORINDEX;
+ struct Token* t = block->children;
+ while(t) {
+ if(isOpenBrace(t->type))
+ precChildren(p, t);
+ else if(isBlockoid(t->type))
+ precBlock(p, t);
+ t = t->next;
+ }
}
-static void precChildren(struct Parser* p, struct Token* t);
-static void precBlock(struct Parser* p, struct Token* t);
+/* Binary tokens that get empties synthesized if one side is missing */
+static int oneSidedBinary(int t)
+{ return t == TOK_SEMI || t == TOK_COMMA || t == TOK_COLON; }
static struct Token* parsePrecedence(struct Parser* p,
struct Token* start, struct Token* end,
// This is an error. No "siblings" are allowed at the bottom level.
if(level >= PRECEDENCE_LEVELS && start != end)
- oops(p, start);
+ naParseError(p, "parse error", start->line);
// Synthesize an empty token if necessary
if(end == 0 && start == 0)
- return emptyToken(p);
+ return newToken(p, TOK_EMPTY);
// Sanify the list. This is OK, since we're recursing into the
// list structure; stuff to the left and right has already been
// Single tokens parse as themselves. Recurse into braces, and
// parse children of block structure.
if(start == end) {
- if(isBrace(start->type)) {
- precChildren(p, start);
- } else if(isBlock(start->type)) {
- precBlock(p, start);
- }
+ if (isOpenBrace(start->type)) precChildren(p, start);
+ else if(isBlockoid(start->type)) precBlock(p, start);
return start;
}
- // A context-sensitivity: we want to parse ';' and ',' as binary
- // operators, but want them to be legal at the beginning and end
- // of a list (unlike, say, '+' where we want a parse error).
- // Generate empties as necessary.
- if(start->type == TOK_SEMI || start->type == TOK_COMMA) {
- t = emptyToken(p);
+ if(oneSidedBinary(start->type)) {
+ t = newToken(p, TOK_EMPTY);
start->prev = t;
t->next = start;
start = t;
}
- if(end->type == TOK_SEMI || end->type == TOK_COMMA) {
- t = emptyToken(p);
+ if(oneSidedBinary(end->type)) {
+ t = newToken(p, TOK_EMPTY);
end->next = t;
t->prev = end;
end = t;
if(left) {
left->next = right;
left->prev = 0;
- left->parent = top;
}
top->children = left;
if(right) {
right->next = 0;
right->prev = left;
- right->parent = top;
}
top->lastChild = right;
return top;
}
-static void precChildren(struct Parser* p, struct Token* t)
-{
- struct Token* top = parsePrecedence(p, t->children, t->lastChild, 0);
- t->children = top;
- t->lastChild = top;
-}
-
-// Run a "block structure" node (if/elsif/else/for/while/foreach)
-// through the precedence parser. The funny child structure makes
-// this a little more complicated than it should be.
-static void precBlock(struct Parser* p, struct Token* block)
-{
- struct Token* t = block->children;
- while(t) {
- if(isBrace(t->type))
- precChildren(p, t);
- else if(isBlock(t->type))
- precBlock(p, t);
- t = t->next;
- }
-}
-
naRef naParseCode(struct Context* c, naRef srcFile, int firstLine,
char* buf, int len, int* errLine)
{
// Protect from garbage collection
naTempSave(c, srcFile);
+ naParseInit(&p);
+
// Catch parser errors here.
- *errLine = 0;
+ p.errLine = *errLine = 1;
if(setjmp(p.jumpHandle)) {
strncpy(c->error, p.err, sizeof(c->error));
*errLine = p.errLine;
+ naParseDestroy(&p);
return naNil();
}
- naParseInit(&p);
p.context = c;
p.srcFile = srcFile;
p.firstLine = firstLine;
// Lexify, match brace structure, fixup if/for/etc...
naLex(&p);
- braceMatch(&p, p.tree.children);
- fixBlockStructure(&p, p.tree.children);
+
+ // Run the block parser, make sure everything was eaten
+ t = p.tree.children;
+ p.tree.children = p.tree.lastChild = 0;
+ parseBlock(&p, &p.tree, -1, &t);
+ if(t) oops(&p);
// Recursively run the precedence parser, and fixup the treetop
t = parsePrecedence(&p, p.tree.children, p.tree.lastChild, 0);
p.tree.children = t;
p.tree.lastChild = t;
- // Generate code!
+ // Generate code
codeObj = naCodeGen(&p, &(p.tree), 0);
// Clean up our mess
#include "data.h"
#include "code.h"
-enum {
+enum tok {
TOK_TOP=1, TOK_AND, TOK_OR, TOK_NOT, TOK_LPAR, TOK_RPAR, TOK_LBRA,
TOK_RBRA, TOK_LCURL, TOK_RCURL, TOK_MUL, TOK_PLUS, TOK_MINUS, TOK_NEG,
TOK_DIV, TOK_CAT, TOK_COLON, TOK_DOT, TOK_COMMA, TOK_SEMI,
enum { PREC_BINARY=1, PREC_REVERSE, PREC_PREFIX, PREC_SUFFIX };
struct Token {
- int type;
+ enum tok type;
int line;
char* str;
int strlen;
int rule;
double num;
- struct Token* parent;
struct Token* next;
struct Token* prev;
struct Token* children;
// Computed line number table for the lexer
int* lines;
int nLines;
-
+
struct CodeGenerator* cg;
};
int nLineIps; // number of pairs
int nextLineIp;
+ int* argSyms;
+ int* optArgSyms;
+ int* optArgVals;
+ naRef restArgSym;
+
// Stack of "loop" frames for break/continue statements
struct {
int breakIP;
static int tonum(unsigned char* s, int len, double* result);
static int fromnum(double val, unsigned char* s);
+#define LEN(s) ((s)->emblen != -1 ? (s)->emblen : (s)->data.ref.len)
+#define DATA(s) ((s)->emblen != -1 ? (s)->data.buf : (s)->data.ref.ptr)
+
int naStr_len(naRef s)
{
- if(!IS_STR(s)) return 0;
- return PTR(s).str->len;
+ return IS_STR(s) ? LEN(PTR(s).str) : 0;
}
char* naStr_data(naRef s)
{
- if(!IS_STR(s)) return 0;
- return (char*)PTR(s).str->data;
+ return IS_STR(s) ? (char*)DATA(PTR(s).str) : 0;
}
static void setlen(struct naStr* s, int sz)
{
- if(s->data) naFree(s->data);
- s->len = sz;
- s->data = naAlloc(sz+1);
- s->data[sz] = 0; // nul terminate
+ if(s->emblen == -1 && DATA(s)) naFree(s->data.ref.ptr);
+ if(sz > MAX_STR_EMBLEN) {
+ s->emblen = -1;
+ s->data.ref.len = sz;
+ s->data.ref.ptr = naAlloc(sz+1);
+ } else {
+ s->emblen = sz;
+ }
+ DATA(s)[sz] = 0; // nul terminate
}
naRef naStr_buf(naRef dst, int len)
{
setlen(PTR(dst).str, len);
- naBZero(PTR(dst).str->data, len);
+ naBZero(DATA(PTR(dst).str), len);
return dst;
}
-naRef naStr_fromdata(naRef dst, char* data, int len)
+naRef naStr_fromdata(naRef dst, const char* data, int len)
{
if(!IS_STR(dst)) return naNil();
setlen(PTR(dst).str, len);
- memcpy(PTR(dst).str->data, data, len);
+ memcpy(DATA(PTR(dst).str), data, len);
return dst;
}
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);
- memcpy(dst->data + a->len, b->data, b->len);
+ setlen(dst, LEN(a) + LEN(b));
+ memcpy(DATA(dst), DATA(a), LEN(a));
+ memcpy(DATA(dst) + LEN(a), DATA(b), LEN(b));
return dest;
}
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(); }
+ if(start + len > LEN(s)) return naNil();
setlen(dst, len);
- memcpy(dst->data, s->data + start, len);
+ memcpy(DATA(dst), DATA(s) + start, len);
return dest;
}
{
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;
+ if(DATA(a) == DATA(b)) return 1;
+ if(LEN(a) != LEN(b)) return 0;
+ if(memcmp(DATA(a), DATA(b), LEN(a)) == 0) return 1;
return 0;
}
struct naStr* dst = PTR(dest).str;
unsigned char buf[DIGITS+8];
setlen(dst, fromnum(num, buf));
- memcpy(dst->data, buf, dst->len);
+ memcpy(DATA(dst), buf, LEN(dst));
return dest;
}
int naStr_tonum(naRef str, double* out)
{
- return tonum(PTR(str).str->data, PTR(str).str->len, out);
+ return tonum(DATA(PTR(str).str), LEN(PTR(str).str), out);
}
int naStr_numeric(naRef str)
{
double dummy;
- return tonum(PTR(str).str->data, PTR(str).str->len, &dummy);
+ return tonum(DATA(PTR(str).str), LEN(PTR(str).str), &dummy);
}
void naStr_gcclean(struct naStr* str)
{
- naFree(str->data);
- str->data = 0;
- str->len = 0;
+ if(str->emblen == -1) naFree(str->data.ref.ptr);
+ str->data.ref.ptr = 0;
+ str->data.ref.len = 0;
+ str->emblen = -1;
}
////////////////////////////////////////////////////////////////////////
+#include <string.h>
#ifdef _WIN32
#include <windows.h>
#else
#ifdef _WIN32
CreateThread(0, 0, threadtop, td, 0, 0);
#else
- { pthread_t t; pthread_create(&t, 0, threadtop, td); }
+ {
+ pthread_t t; int err;
+ if((err = pthread_create(&t, 0, threadtop, td)))
+ naRuntimeError(c, "newthread failed: %s", strerror(err));
+ pthread_detach(t);
+ }
#endif
return naNil();
}
static naRef f_lock(naContext c, naRef me, int argc, naRef* args)
{
- if(argc > 0 && naGhost_type(args[0]) == &LockType)
+ if(argc > 0 && naGhost_type(args[0]) == &LockType) {
+ naModUnlock();
naLock(naGhost_ptr(args[0]));
+ naModLock();
+ }
return naNil();
}
static naRef f_semdown(naContext c, naRef me, int argc, naRef* args)
{
- if(argc > 0 && naGhost_type(args[0]) == &SemType)
+ if(argc > 0 && naGhost_type(args[0]) == &SemType) {
+ naModUnlock();
naSemDown(naGhost_ptr(args[0]));
+ naModLock();
+ }
return naNil();
}
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]; }
+ if(!len) return -1;
+ if(s[0] < 0x80) { *used = 1; return s[0]; }
for(n=2; n<7; n++)
if((s[0] & TOPBITS(n+1)) == TOPBITS(n))
break;
static naRef f_size(naContext c, naRef me, int argc, naRef* args)
{
unsigned char* s;
- int sz=0, n, len;
+ int sz=0, n=0, len;
if(argc < 1 || !naIsString(args[0]))
naRuntimeError(c, "bad/missing argument to utf8.strc");
s = (void*)naStr_data(args[0]);
static void resize(struct naVec* v)
{
struct VecRec* vr = newvecrec(v->rec);
- naGC_swapfree((void**)&(v->rec), vr);
+ naGC_swapfree((void*)&(v->rec), vr);
}
void naVec_gcclean(struct naVec* v)
nv->alloced = sz;
for(i=0; i<sz; i++)
nv->array[i] = (v && i < v->size) ? v->array[i] : naNil();
- naGC_swapfree((void**)&(PTR(vec).vec->rec), nv);
+ naGC_swapfree((void*)&(PTR(vec).vec->rec), nv);
}
naRef naVec_removelast(naRef vec)