]> git.mxchange.org Git - simgear.git/commitdiff
Sync with Nasal upstream (Melchior already had a chance to test this,
authorandy <andy>
Fri, 26 Sep 2008 18:22:12 +0000 (18:22 +0000)
committerandy <andy>
Fri, 26 Sep 2008 18:22:12 +0000 (18:22 +0000)
so hopefully not too much breaks).  New syntax features:

1. Call-by-name function arguments.  You can specify a hash literal in
place of ordered function arguments, and it will become the local
variable namespace for the called function, making functions with many
arguments more readable.  Ex:

   view_manager.lookat(heading:180, pitch:20, roll:0, x:X0, y:Y0, z:Z0,
                       time:now, fov:55);

Declared arguments are checked and defaulted as would be expected:
it's an error if you fail to pass a value for an undefaulted argument,
missing default arguments get assigned, and any rest parameter
(e.g. "func(a,b=2,rest...){}") will be assigned with an empty vector.

2. Vector slicing.  Vectors (lists) can now be created from others
using an ordered list of indexes and ranges.  For example:

   var v1 = ["a","b","c","d","e"]

   var v2 = v1[3,2];   # == ["d","c"];
   var v3 = v1[1:3];   # i.e. range from 1 to 3: ["b","c","d"];
   var v4 = v1[1:];    # no value means "to the end": ["b","c","d","e"]
   var i = 2;
   var v5 = v1[i];     # runtime expressions are fine: ["c"]
   var v6 = v1[-2,-1]; # negative indexes are relative to end: ["d","e"]

The range values can be computed at runtime (e.g. i=1; v5=v1[i:]).
Negative indices work the same way the do with the vector functions
(-1 is the last element, -2 is 2nd to last, etc...).

3. Multi-assignment expressions.  You can assign more than one
variable (or lvalue) at a time by putting them in a parenthesized
list:

   (var a, var b) = (1, 2);
   var (a, b) = (1, 2);               # Shorthand for (var a, var b)
   (var a, v[0], obj.field) = (1,2,3) # Any assignable lvalue works

   var color = [1, 1, 0.5];
   var (r, g, b) = color;  # works with runtime vectors too

19 files changed:
simgear/nasal/bitslib.c
simgear/nasal/code.c
simgear/nasal/code.h
simgear/nasal/codegen.c
simgear/nasal/data.h
simgear/nasal/gc.c
simgear/nasal/hash.c
simgear/nasal/iolib.c
simgear/nasal/lex.c
simgear/nasal/lib.c
simgear/nasal/misc.c
simgear/nasal/naref.h
simgear/nasal/nasal.h
simgear/nasal/parse.c
simgear/nasal/parse.h
simgear/nasal/string.c
simgear/nasal/threadlib.c
simgear/nasal/utf8lib.c
simgear/nasal/vector.c

index e7f1f37435a1539e20c26f2b07d85da21fbff920..04071e3afc68a068725a508b366055ae6a6d9f57 100644 (file)
@@ -16,7 +16,7 @@ static unsigned int fld(naContext c, unsigned char* s,
     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;
 }
 
@@ -32,13 +32,13 @@ static void setfld(naContext c, unsigned char* s, int slen,
 
 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);
@@ -56,13 +56,13 @@ static naRef f_fld(naContext c, naRef me, int argc, naRef* args)
 
 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();
 }
 
index 031be628b2205910a2494ed677c6f48b3204853e..44ff2a0e099e68ea0739d51a1500aa18e35abbe8 100644 (file)
@@ -17,7 +17,7 @@
 #endif
 char* opStringDEBUG(int op);
 void printOpDEBUG(int ip, int op);
-void printStackDEBUG(struct Context* ctx);
+void printStackDEBUG(naContext ctx);
 ////////////////////////////////////////////////////////////////////////
 
 #ifdef _MSC_VER
@@ -26,10 +26,10 @@ void printStackDEBUG(struct Context* ctx);
 
 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);
@@ -54,7 +54,7 @@ static naRef endToken()
     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;
@@ -68,7 +68,7 @@ static int boolify(struct Context* ctx, naRef r)
     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;
@@ -79,7 +79,7 @@ static double numify(struct Context* ctx, naRef o)
     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);
@@ -87,7 +87,7 @@ static naRef stringify(struct Context* ctx, naRef r)
     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);
@@ -97,7 +97,7 @@ static int checkVec(struct Context* ctx, naRef vec, naRef idx)
     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);
@@ -107,23 +107,22 @@ static int checkStr(struct Context* ctx, naRef str, naRef idx)
     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);
@@ -135,14 +134,14 @@ static void containerSet(struct Context* ctx, naRef box, naRef key, naRef 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;
@@ -164,7 +163,7 @@ static void initContext(struct Context* c)
 static void initGlobals()
 {
     int i;
-    struct Context* c;
+    naContext c;
     globals = (struct Globals*)naAlloc(sizeof(struct Globals));
     naBZero(globals, sizeof(struct Globals));
 
@@ -194,9 +193,9 @@ static void initGlobals()
     naFreeContext(c);
 }
 
-struct Context* naNewContext()
+naContext naNewContext()
 {
-    struct Context* c;
+    naContext c;
     if(globals == 0)
         initGlobals();
 
@@ -209,7 +208,7 @@ struct Context* naNewContext()
         initContext(c);
     } else {
         UNLOCK();
-        c = (struct Context*)naAlloc(sizeof(struct Context));
+        c = (naContext)naAlloc(sizeof(struct Context));
         initTemps(c);
         initContext(c);
         LOCK();
@@ -221,16 +220,16 @@ struct Context* naNewContext()
     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);
@@ -260,45 +259,66 @@ static void setupArgs(naContext ctx, struct Frame* f, naRef* args, int nargs)
         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]);
@@ -306,23 +326,19 @@ static struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall)
     
     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;
 }
 
@@ -350,7 +366,7 @@ static naRef evalCat(naContext ctx, naRef l, naRef r)
 
 // 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;
@@ -367,7 +383,7 @@ static int getClosure(struct naFunc* c, naRef sym, naRef* result)
     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))
@@ -376,16 +392,15 @@ static naRef getLocal2(struct Context* ctx, struct Frame* f, naRef sym)
     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;
     }
@@ -399,19 +414,18 @@ static void getLocal(struct Context* ctx, struct Frame* f,
 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
@@ -424,19 +438,19 @@ static const char* getMember_r(naRef obj, naRef field, naRef* out, int count)
     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);
@@ -453,7 +467,7 @@ int naMember_get(naRef obj, naRef field, naRef* out)
 // 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];
@@ -466,13 +480,48 @@ static void evalEach(struct Context* ctx, int useIndex)
     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;
@@ -485,23 +534,15 @@ static naRef run(struct Context* ctx)
     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)); \
@@ -525,7 +566,7 @@ static naRef run(struct Context* ctx)
             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)));
@@ -570,79 +611,80 @@ static naRef run(struct Context* ctx)
             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();
@@ -672,11 +714,14 @@ static naRef run(struct Context* ctx)
         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
 }
@@ -685,12 +730,12 @@ static naRef run(struct Context* ctx)
 #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;
 }
@@ -703,22 +748,22 @@ static int findFrame(naContext ctx, naContext* out, int fn)
     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);
@@ -727,10 +772,10 @@ naRef naGetSourceFile(struct Context* ctx, int 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;
 }
 
@@ -745,9 +790,11 @@ naRef naBindFunction(naContext ctx, naRef code, naRef closure)
 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;
 }
 
@@ -769,7 +816,7 @@ naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
 
     // naRuntimeError() calls end up here:
     if(setjmp(ctx->jumpHandle)) {
-        if(!ctx->callParent) naModUnlock(ctx);
+        if(!ctx->callParent) naModUnlock();
         return naNil();
     }
 
@@ -792,14 +839,15 @@ naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
     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;
 }
 
@@ -812,7 +860,7 @@ naRef naContinue(naContext ctx)
     ctx->error[0] = 0;
 
     if(setjmp(ctx->jumpHandle)) {
-        if(!ctx->callParent) naModUnlock(ctx);
+        if(!ctx->callParent) naModUnlock();
         else naRethrowError(ctx);
         return naNil();
     }
index af90e2d2c4bd18dde9372ea9c94701d7d4b0b0cb..3db610773d95e84bd19ab2a2fc6c57017ed0ae20 100644 (file)
 #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 {
index 15276e8c96ec4f59c68278c49eb1a45749371e76..492b0f207283480119f41c83138cc23d85a6386c 100644 (file)
@@ -1,3 +1,4 @@
+#include <string.h>
 #include "parse.h"
 #include "code.h"
 
@@ -6,7 +7,7 @@
 // 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);
@@ -46,12 +47,7 @@ static int newConstant(struct Parser* p, naRef c)
     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
@@ -68,6 +64,10 @@ static int internConstant(struct Parser* p, naRef c)
     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;
@@ -93,19 +93,11 @@ static int findConstantIndex(struct Parser* p, struct Token* t)
 
 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)
@@ -135,7 +127,7 @@ 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);
@@ -143,10 +135,13 @@ static void genEqOp(int op, struct Parser* p, struct Token* t)
     } 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);
 }
 
@@ -169,27 +164,29 @@ static void genArgList(struct Parser* p, struct naCode* c, struct Token* t)
 {
     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
@@ -219,12 +216,12 @@ static void genLambda(struct Parser* p, struct Token* t)
 
 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);
@@ -234,7 +231,7 @@ static int genList(struct Parser* p, struct Token* t, int doAppend)
 
 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);
@@ -247,31 +244,45 @@ static void genHashElem(struct Parser* p, struct Token* t)
 
 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;
@@ -279,13 +290,7 @@ static void pushLoop(struct Parser* p, struct Token* label)
     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
@@ -352,10 +357,11 @@ static void genQuestion(struct Parser* p, struct Token* t)
     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,
@@ -377,7 +383,8 @@ 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
 }
 
@@ -387,8 +394,7 @@ static void genForWhile(struct Parser* p, struct Token* init,
 {
     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);
@@ -397,14 +403,13 @@ static void genForWhile(struct Parser* p, struct Token* init,
 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);
@@ -414,17 +419,14 @@ static void genFor(struct Parser* p, struct Token* t)
 {
     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));
@@ -437,13 +439,13 @@ static void genForEach(struct Parser* p, struct Token* t)
     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);
@@ -452,12 +454,10 @@ static void genForEach(struct Parser* p, struct Token* t)
 
     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);
@@ -511,47 +511,111 @@ static void newLineEntry(struct Parser* p, int line)
     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);
@@ -561,11 +625,6 @@ static void genExpr(struct Parser* p, struct Token* t)
         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);
@@ -579,9 +638,6 @@ static void genExpr(struct Parser* p, struct Token* t)
     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
@@ -604,7 +660,8 @@ static void genExpr(struct Parser* p, struct Token* t)
         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;
@@ -661,51 +718,42 @@ naRef naCodeGen(struct Parser* p, struct Token* block, struct Token* arglist)
 
     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;
 }
index 7c851be590c28b884552f25f26a4130e6ab41a39..8f1715a332a9ce020103ba48aaf483fabcb67d55 100644 (file)
@@ -76,8 +76,7 @@ enum { T_STR, T_VEC, T_HASH, T_CODE, T_FUNC, T_CCODE, T_GHOST,
 #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)
 
@@ -93,11 +92,18 @@ struct naObj {
     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 {
@@ -117,14 +123,6 @@ struct HashNode {
     struct HashNode* next;
 };
 
-struct HashRec {
-    int size;
-    int dels;
-    int lgalloced;
-    struct HashNode* nodes;
-    struct HashNode* table[];
-};
-
 struct naHash {
     GC_HEADER;
     struct HashRec* rec;
@@ -132,22 +130,26 @@ struct naHash {
 
 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;
@@ -194,17 +196,19 @@ int naStr_parsenum(char* str, int len, double* result);
 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
index f3853c96efbe219cb0c8c355802b7a100c869971..e9d9b7b8ba60587f9618eca6e25fab55a3a8a5f5 100644 (file)
@@ -88,6 +88,11 @@ void naModUnlock()
 {
     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();
 }
 
@@ -120,12 +125,7 @@ void naCheckBottleneck()
 
 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)
@@ -140,7 +140,7 @@ static void freeelem(struct naPool* p, struct naObj* o)
     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;
     }
@@ -220,21 +220,6 @@ static void markvec(naRef r)
         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)
@@ -250,7 +235,7 @@ 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++)
@@ -264,6 +249,11 @@ static void mark(naRef r)
     }
 }
 
+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)
index 6ceb7ae66c99dabbf76f7b8629f0b90bcbf3a1cf..b7571c42058dc82e79a27e8ac7548170a7eeac4e 100644 (file)
+#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);
 }
@@ -134,124 +197,75 @@ naRef naHash_cget(naRef hash, char* key)
     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;
-}
index 16d313380f6399d114d3b311f77b293b0b2cdec4..13c2cb53a00dae1eeb375d1d7e30b5887664f414 100644 (file)
@@ -7,7 +7,7 @@
 #include "iolib.h"
 
 static void ghostDestroy(void* g);
-naGhostType naIOGhostType = { ghostDestroy };
+naGhostType naIOGhostType = { ghostDestroy, "iofile" };
 
 static struct naIOGhost* ioghost(naRef r)
 {
@@ -32,9 +32,9 @@ static naRef f_read(naContext c, naRef me, int argc, naRef* args)
     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));
 }
 
@@ -44,8 +44,8 @@ static naRef f_write(naContext c, naRef me, int argc, naRef* args)
     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)
@@ -134,8 +134,7 @@ static naRef f_open(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);
 }
@@ -159,7 +158,7 @@ static naRef f_readln(naContext ctx, naRef me, int argc, naRef* args)
 {
     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()");
@@ -168,7 +167,7 @@ static naRef f_readln(naContext ctx, naRef me, int argc, naRef* args)
         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;
@@ -188,7 +187,7 @@ static naRef f_stat(naContext ctx, naRef me, int argc, naRef* args)
     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));
     }
index 958e0fb4e9ec254022a57a52853f88987e377ebc..432537467290fe64127ea4fb371896f24b83aecd 100644 (file)
@@ -1,7 +1,7 @@
 #include "parse.h"
 
 // Static table of recognized lexemes in the language
-struct Lexeme {
+static const struct Lexeme {
     char* str;
     int   tok;
 } LEXEMES[] = {
@@ -130,7 +130,6 @@ static void newToken(struct Parser* p, int pos, int type,
     tok->str = str;
     tok->strlen = slen;
     tok->num = num;
-    tok->parent = &p->tree;
     tok->next = 0;
     tok->prev = last;
     tok->children = 0;
@@ -182,6 +181,7 @@ static void sqEscape(char* buf, int len, int index, struct Parser* p,
 }
 
 // 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)
 {
index f7ce44e4466e9aaf8ac7b3e48361a0791155549f..11c8e434ac3b0aadae09f6f0b2d5afd81bfb3bdd 100644 (file)
@@ -214,6 +214,10 @@ static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
 // 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;
@@ -422,8 +426,8 @@ 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])) 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));
 }
 
@@ -537,6 +541,25 @@ static naRef f_sort(naContext c, naRef me, int argc, naRef* args)
     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 }, 
@@ -565,6 +588,7 @@ static naCFuncItem funcs[] = {
     { "rand", f_rand },
     { "bind", f_bind },
     { "sort", f_sort },
+    { "id", f_id },
     { 0 }
 };
 
index 85a9f126440462915e16a60bcf3d1fa7238ddc24..8640aea09769c2b90bc5c17f796cb8d7a7a5058f 100644 (file)
@@ -77,8 +77,9 @@ naRef naNew(struct Context* c, int type)
 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;
 }
@@ -177,12 +178,13 @@ int naEqual(naRef a, naRef b)
 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;
 }
index 153de6f1bf75eb4dae67c524f80b8850e29b33bd..f1919a2b542b01ad7752f3443830fa133b75f537 100644 (file)
@@ -9,11 +9,11 @@
     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
@@ -31,30 +31,24 @@ typedef union {
     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
index 1b8184bcbeb7f50d4e95d2227f19e838c6fa9908..a7741b49639657de8885d62ebe612856b90876d7 100644 (file)
@@ -153,9 +153,9 @@ naRef naNumValue(naRef n) GCC_PURE;
 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);
@@ -179,7 +179,7 @@ void naHash_keys(naRef dst, naRef hash);
 
 // Ghost utilities:
 typedef struct naGhostType {
-    void (*destroy)(void* ghost);
+    void(*destroy)(void*);
     const char* name;
 } naGhostType;
 naRef        naNewGhost(naContext c, naGhostType* t, void* ghost);
@@ -189,16 +189,16 @@ int          naIsGhost(naRef r);
 
 // 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
index 6da9a23b21915413d064184785c1aef01e69a34c..2e66d8fe92de81f7b0b59cd8c6462683be685c7b 100644 (file)
@@ -6,7 +6,7 @@
 // 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[] = {
@@ -31,40 +31,18 @@ struct 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)
@@ -79,11 +57,8 @@ 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;
@@ -113,270 +88,141 @@ void* naParseAlloc(struct Parser* p, int bytes)
 
     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.
@@ -389,20 +235,34 @@ static int tokInLevel(struct Token* tok, int 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,
@@ -414,11 +274,11 @@ static struct Token* parsePrecedence(struct Parser* p,
 
     // 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
@@ -432,26 +292,19 @@ static struct Token* parsePrecedence(struct Parser* p,
     // 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;
@@ -534,14 +387,12 @@ static struct Token* parsePrecedence(struct Parser* p,
     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;
 
@@ -549,28 +400,6 @@ static struct Token* parsePrecedence(struct Parser* p,
     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)
 {
@@ -581,15 +410,17 @@ naRef naParseCode(struct Context* c, naRef srcFile, int firstLine,
     // 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;
@@ -598,8 +429,12 @@ naRef naParseCode(struct Context* c, naRef srcFile, int 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);
@@ -607,7 +442,7 @@ naRef naParseCode(struct Context* c, naRef srcFile, int firstLine,
     p.tree.children = t;
     p.tree.lastChild = t;
 
-    // Generate code!
+    // Generate code
     codeObj = naCodeGen(&p, &(p.tree), 0);
 
     // Clean up our mess
index e3db3e7a2bae037fe6d0af9dab5dc47cf3937f0c..1574ea305f3999f869355d4c066d58adf203e572 100644 (file)
@@ -7,7 +7,7 @@
 #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,
@@ -23,13 +23,12 @@ enum {
 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;
@@ -64,7 +63,7 @@ struct Parser {
     // Computed line number table for the lexer
     int* lines;
     int  nLines;
-    
+
     struct CodeGenerator* cg;
 };
 
@@ -81,6 +80,11 @@ struct CodeGenerator {
     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;
index 10641a1500ff486d7749e5b4438c7b8d4af04f71..65a29526c97ce0db31a08c87b0d48a08f6edf64c 100644 (file)
 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;
 }
 
@@ -52,9 +58,9 @@ naRef naStr_concat(naRef dest, naRef s1, naRef s2)
     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;
 }
 
@@ -63,9 +69,9 @@ naRef naStr_substr(naRef dest, naRef str, int start, int len)
     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;
 }
 
@@ -73,9 +79,9 @@ int naStr_equal(naRef s1, naRef s2)
 {
     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;
 }
 
@@ -84,7 +90,7 @@ naRef naStr_fromnum(naRef dest, double num)
     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;
 }
 
@@ -95,20 +101,21 @@ int naStr_parsenum(char* str, int len, double* result)
 
 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;
 }
 
 ////////////////////////////////////////////////////////////////////////
index eda7f234893075788742253f7da2507702f1f086..d5e51ef662a2c7c537596ec05842230a196930aa 100644 (file)
@@ -1,3 +1,4 @@
+#include <string.h>
 #ifdef _WIN32
 #include <windows.h>
 #else
@@ -43,7 +44,12 @@ static naRef f_newthread(naContext c, naRef me, int argc, naRef* args)
 #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();
 }
@@ -55,8 +61,11 @@ static naRef f_newlock(naContext c, naRef me, int argc, naRef* args)
 
 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();
 }
 
@@ -74,8 +83,11 @@ static naRef f_newsem(naContext c, naRef me, int argc, naRef* args)
 
 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();
 }
 
index 55dd7352874dac7bbd3650957d05851772fed05d..7957280cf10913787382c0228d5a743f3a719761 100644 (file)
@@ -31,7 +31,8 @@ static int writec(unsigned int c, unsigned char* s, int len)
 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;
@@ -74,7 +75,7 @@ static naRef f_chstr(naContext ctx, naRef me, int argc, naRef* args)
 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]);
index efd5f4069cd317f3bdf5037d1455643da57e33eb..df20c1385584e3ddbef2f8080f74eeba0740ab12 100644 (file)
@@ -16,7 +16,7 @@ static struct VecRec* newvecrec(struct VecRec* old)
 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)
@@ -78,7 +78,7 @@ void naVec_setsize(naRef vec, int sz)
     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)