Sneak a Nasal update in before the next release. This version

*appears* to work correctly on all systems to which I have access
(i386 linux/win32, x86_64 linux, powerpc OS X, Sparc Solaris 10), but
not all systems are capable of running fgfs.  Beyond that, multiple
threading bugs were fixed, and the naCall() API changed slightly to
support named function arguments.

NOTE: this introduces a change in the external API, and therefore this
change *must* be compiled against current FlightGear code.

simgear/nasal/code.c

@@ -64,8 +64,16 @@ static naRef stringify(struct Context* ctx, naRef r)
 static int checkVec(struct Context* ctx, naRef vec, naRef idx)
 {
     int i = (int)numify(ctx, idx);
-    if(i < 0 || !vec.ref.ptr.vec->rec || i >= vec.ref.ptr.vec->rec->size)
+    if(i < 0) i += naVec_size(vec);
-        ERR(ctx, "vector index out of bounds");
+    if(i < 0 || i >= naVec_size(vec)) ERR(ctx, "vector index out of bounds");
+    return i;
+}
+
+static int checkStr(struct Context* ctx, naRef str, naRef idx)
+{
+    int i = (int)numify(ctx, idx);
+    if(i < 0) i += naStr_len(str);
+    if(i < 0 || i >= naStr_len(str)) ERR(ctx, "string index out of bounds");
     return i;
 }
 
@@ -78,6 +86,8 @@ static naRef containerGet(struct Context* ctx, naRef box, naRef key)
             ERR(ctx, "undefined value in container");
     } else if(IS_VEC(box)) {
         result = naVec_get(box, checkVec(ctx, box, key));
+    } else if(IS_STR(box)) {
+        result = naNum((unsigned char)naStr_data(box)[checkStr(ctx, box, key)]);
     } else {
         ERR(ctx, "extract from non-container");
     }
@@ -89,7 +99,18 @@ static void containerSet(struct Context* ctx, naRef box, naRef key, naRef val)
     if(!IS_SCALAR(key))   ERR(ctx, "container index not scalar");
     else if(IS_HASH(box)) naHash_set(box, key, val);
     else if(IS_VEC(box))  naVec_set(box, checkVec(ctx, box, key), val);
-    else                  ERR(ctx, "insert into non-container");
+    else if(IS_STR(box)) {
+        if(box.ref.ptr.str->hashcode)
+            ERR(ctx, "cannot change immutable string");
+        naStr_data(box)[checkStr(ctx, box, key)] = (char)numify(ctx, val);
+    } else ERR(ctx, "insert into non-container");
+}
+
+static void initTemps(struct Context* c)
+{
+    c->tempsz = 4;
+    c->temps = naAlloc(c->tempsz * sizeof(struct naObj*));
+    c->ntemps = 0;
 }
 
 static void initContext(struct Context* c)
@@ -98,7 +119,12 @@ static void initContext(struct Context* c)
     c->fTop = c->opTop = c->markTop = 0;
     for(i=0; i<NUM_NASAL_TYPES; i++)
         c->nfree[i] = 0;
-    naVec_setsize(c->temps, 4);
+
+    if(c->tempsz > 32) {
+        naFree(c->temps);
+        initTemps(c);
+    }
+
     c->callParent = 0;
     c->callChild = 0;
     c->dieArg = naNil();
@@ -140,7 +166,6 @@ static void initGlobals()
 
 struct Context* naNewContext()
 {
-    int dummy;
     struct Context* c;
     if(globals == 0)
         initGlobals();
@@ -155,8 +180,7 @@ struct Context* naNewContext()
     } else {
         UNLOCK();
         c = (struct Context*)naAlloc(sizeof(struct Context));
-        // Chicken and egg, can't use naNew because it requires temps to exist
+        initTemps(c);
-        c->temps = naObj(T_VEC, (naGC_get(&globals->pools[T_VEC], 1, &dummy))[0]);
         initContext(c);
         LOCK();
         c->nextAll = globals->allContexts;
@@ -169,7 +193,7 @@ struct Context* naNewContext()
 
 void naFreeContext(struct Context* c)
 {
-    naVec_setsize(c->temps, 0);
+    c->ntemps = 0;
     LOCK();
     c->nextFree = globals->freeContexts;
     globals->freeContexts = c;
@@ -181,12 +205,39 @@ void naFreeContext(struct Context* c)
     ctx->opStack[ctx->opTop++] = r; \
     } while(0)
 
-struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
+static void setupArgs(naContext ctx, struct Frame* f, naRef* args, int nargs)
 {
     int i;
+    struct naCode* c = f->func.ref.ptr.func->code.ref.ptr.code;
+
+    // Set the argument symbols, and put any remaining args in a vector
+    if(nargs < c->nArgs) ERR(ctx, "not enough arguments to function call");
+    for(i=0; i<c->nArgs; i++)
+        naHash_newsym(f->locals.ref.ptr.hash,
+                      &c->constants[c->argSyms[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]];
+        if(IS_CODE(val))
+            val = bindFunction(ctx, &ctx->fStack[ctx->fTop-2], val);
+        naHash_newsym(f->locals.ref.ptr.hash, &c->constants[c->optArgSyms[i]], 
+                      &val);
+    }
+    args += c->nOptArgs;
+    if(c->needArgVector || nargs > 0) {
+        naRef argsv = naNewVector(ctx);
+        naVec_setsize(argsv, nargs > 0 ? nargs : 0);
+        for(i=0; i<nargs; i++)
+            argsv.ref.ptr.vec->rec->array[i] = *args++;
+        naHash_newsym(f->locals.ref.ptr.hash, &c->restArgSym, &argsv);
+    }
+}
+
+struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
+{
     naRef *frame;
     struct Frame* f;
-    struct naCode* c;
     
     DBG(printf("setupFuncall(nargs:%d, mcall:%d)\n", nargs, mcall);)
 
@@ -221,29 +272,7 @@ struct Frame* setupFuncall(struct Context* ctx, int nargs, int mcall, int tail)
     if(mcall)
         naHash_set(f->locals, globals->meRef, frame[-1]);
 
-    // Set the argument symbols, and put any remaining args in a vector
+    setupArgs(ctx, f, frame+1, nargs);
-    c = (*frame++).ref.ptr.func->code.ref.ptr.code;
-    if(nargs < c->nArgs) ERR(ctx, "not enough arguments to function call");
-    for(i=0; i<c->nArgs; i++)
-        naHash_newsym(f->locals.ref.ptr.hash,
-                      &c->constants[c->argSyms[i]], &frame[i]);
-    frame += c->nArgs;
-    nargs -= c->nArgs;
-    for(i=0; i<c->nOptArgs; i++, nargs--) {
-        naRef val = nargs > 0 ? frame[i] : c->constants[c->optArgVals[i]];
-        if(IS_CODE(val))
-            val = bindFunction(ctx, &ctx->fStack[ctx->fTop-2], val);
-        naHash_newsym(f->locals.ref.ptr.hash, &c->constants[c->optArgSyms[i]], 
-                      &val);
-    }
-    if(c->needArgVector || nargs > 0)
-    {
-        naRef args = naNewVector(ctx);
-        naVec_setsize(args, nargs > 0 ? nargs : 0);
-        for(i=0; i<nargs; i++)
-            args.ref.ptr.vec->rec->array[i] = *frame++;
-        naHash_newsym(f->locals.ref.ptr.hash, &c->restArgSym, &args);
-    }
 
     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);)
@@ -574,7 +603,7 @@ static naRef run(struct Context* ctx)
         default:
             ERR(ctx, "BUG: bad opcode");
         }
-        ctx->temps.ref.ptr.vec->rec->size = 0; // reset GC temp vector
+        ctx->ntemps = 0; // reset GC temp vector
         DBG(printStackDEBUG(ctx);)
     }
     return naNil(); // unreachable
@@ -622,7 +651,7 @@ naRef naGetSourceFile(struct Context* ctx, int frame)
 char* naGetError(struct Context* ctx)
 {
     if(IS_STR(ctx->dieArg))
-        return ctx->dieArg.ref.ptr.str->data;
+        return (char*)ctx->dieArg.ref.ptr.str->data;
     return ctx->error;
 }
 
@@ -643,26 +672,33 @@ naRef naBindToContext(naContext ctx, naRef code)
     return func;
 }
 
-naRef naCall(naContext ctx, naRef func, naRef args, naRef obj, naRef locals)
+naRef naCall(naContext ctx, naRef func, int argc, naRef* args,
+             naRef obj, naRef locals)
 {
+    int i;
     naRef result;
     if(!ctx->callParent) naModLock(ctx);
 
     // We might have to allocate objects, which can call the GC.  But
     // the call isn't on the Nasal stack yet, so the GC won't find our
     // C-space arguments.
-    naVec_append(ctx->temps, func);
+    naTempSave(ctx, func);
-    naVec_append(ctx->temps, args);
+    for(i=0; i<argc; i++)
-    naVec_append(ctx->temps, obj);
+        naTempSave(ctx, args[i]);
-    naVec_append(ctx->temps, locals);
+    naTempSave(ctx, obj);
+    naTempSave(ctx, locals);
+
+    if(IS_CCODE(func.ref.ptr.func->code)) {
+        naCFunction fp = func.ref.ptr.func->code.ref.ptr.ccode->fptr;
+        result = (*fp)(ctx, obj, argc, args);
+        if(!ctx->callParent) naModUnlock(ctx);
+        return result;
+    }
 
     if(IS_NIL(locals))
         locals = naNewHash(ctx);
     if(!IS_FUNC(func))
         func = naNewFunc(ctx, func); // bind bare code objects
-
-    if(!IS_NIL(args))
-        naHash_set(locals, globals->argRef, args);
     if(!IS_NIL(obj))
         naHash_set(locals, globals->meRef, obj);
 
@@ -675,6 +711,8 @@ naRef naCall(naContext ctx, naRef func, naRef args, naRef obj, naRef locals)
     ctx->fStack[0].ip = 0;
     ctx->fStack[0].bp = ctx->opTop;
 
+    setupArgs(ctx, ctx->fStack, args, argc);
+
     // Return early if an error occurred.  It will be visible to the
     // caller via naGetError().
     ctx->error = 0;
@@ -683,12 +721,7 @@ naRef naCall(naContext ctx, naRef func, naRef args, naRef obj, naRef locals)
         return naNil();
     }
 
-    if(IS_CCODE(func.ref.ptr.func->code)) {
+    result = run(ctx);
-        naCFunction fp = func.ref.ptr.func->code.ref.ptr.ccode->fptr;
-        struct naVec* av = args.ref.ptr.vec;
-        result = (*fp)(ctx, obj, av->rec->size, av->rec->array);
-    } else
-        result = run(ctx);
     if(!ctx->callParent) naModUnlock(ctx);
     return result;
 }

simgear/nasal/code.h

@@ -80,7 +80,9 @@ struct Context {
     // GC-findable reference point for objects that may live on the
     // processor ("real") stack during execution.  naNew() places them
     // here, and clears the array each instruction
-    naRef temps;
+    struct naObj** temps;
+    int ntemps;
+    int tempsz;
 
     // Error handling
     jmp_buf jumpHandle;

simgear/nasal/codegen.c

@@ -79,10 +79,11 @@ naRef naInternSymbol(naRef sym)
 
 static int findConstantIndex(struct Parser* p, struct Token* t)
 {
-    naRef c;
+    naRef c, dummy;
     if(t->type == TOK_NIL) c = naNil();
     else if(t->str) {
         c = naStr_fromdata(naNewString(p->context), t->str, t->strlen);
+        naHash_get(globals->symbols, c, &dummy); // noop, make c immutable
         if(t->type == TOK_SYMBOL) c = naInternSymbol(c);
     } else if(t->type == TOK_FUNC) c = newLambda(p, t);
     else if(t->type == TOK_LITERAL) c = naNum(t->num);

simgear/nasal/data.h

@@ -3,10 +3,6 @@
 
 #include "nasal.h"
 
-// Notes: A CODE object is a compiled set of bytecode instructions.
-// What actually gets executed at runtime is a bound FUNC object,
-// which combines the raw code with a namespace and a pointer to
-// parent function in the lexical closure.
 enum { T_STR, T_VEC, T_HASH, T_CODE, T_FUNC, T_CCODE, T_GHOST,
        NUM_NASAL_TYPES }; // V. important that this come last!
 
@@ -27,6 +23,8 @@ enum { T_STR, T_VEC, T_HASH, T_CODE, T_FUNC, T_CCODE, T_GHOST,
 #define IDENTICAL(a, b) (IS_REF(a) && IS_REF(b) \
                          && a.ref.ptr.obj == b.ref.ptr.obj)
 
+#define MUTABLE(r) (IS_STR(r) && (r).ref.ptr.str->hashcode == 0)
+
 // This is a macro instead of a separate struct to allow compilers to
 // avoid padding.  GCC on x86, at least, will always padd the size of
 // an embedded struct up to 32 bits.  Doing it this way allows the
@@ -125,6 +123,7 @@ struct naPool {
 
 void naFree(void* m);
 void* naAlloc(int n);
+void* naRealloc(void* buf, int sz);
 void naBZero(void* m, int n);
 
 int naTypeSize(int type);
@@ -137,6 +136,7 @@ naRef naStr_fromnum(naRef dest, double num);
 int naStr_numeric(naRef str);
 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);

simgear/nasal/gc.c

@@ -4,9 +4,6 @@
 
 #define MIN_BLOCK_SIZE 256
 
-// "type" for an object freed by the collector
-#define T_GCFREED 123 // DEBUG
-
 static void reap(struct naPool* p);
 static void mark(naRef r);
 
@@ -25,6 +22,15 @@ static void freeDead()
     globals->ndead = 0;
 }
 
+static void marktemps(struct Context* c)
+{
+    int i;
+    naRef r = naNil();
+    for(i=0; i<c->ntemps; i++) {
+        r.ref.ptr.obj = c->temps[i];
+        mark(r);
+    }
+}
 
 // Must be called with the big lock!
 static void garbageCollect()
@@ -43,7 +49,7 @@ static void garbageCollect()
         for(i=0; i < c->opTop; i++)
             mark(c->opStack[i]);
         mark(c->dieArg);
-        mark(c->temps);
+        marktemps(c);
         c = c->nextAll;
     }
 
@@ -72,10 +78,10 @@ static void garbageCollect()
 
 void naModLock()
 {
-    naCheckBottleneck();
     LOCK();
     globals->nThreads++;
     UNLOCK();
+    naCheckBottleneck();
 }
 
 void naModUnlock()
@@ -149,7 +155,6 @@ static void freeelem(struct naPool* p, struct naObj* o)
     }
 
     // And add it to the free list
-    o->type = T_GCFREED; // DEBUG
     p->free[p->nfree++] = o;
 }
 
@@ -173,7 +178,6 @@ static void newBlock(struct naPool* p, int need)
     for(i=0; i < need; i++) {
         struct naObj* o = (struct naObj*)(newb->block + i*p->elemsz);
         o->mark = 0;
-        o->type = T_GCFREED; // DEBUG
         p->free[p->nfree++] = o;
     }
     p->freetop += need;
@@ -218,6 +222,30 @@ struct naObj** naGC_get(struct naPool* p, int n, int* nout)
     return result;
 }
 
+static void markvec(naRef r)
+{
+    int i;
+    struct VecRec* vr = r.ref.ptr.vec->rec;
+    if(!vr) return;
+    for(i=0; i<vr->size; i++)
+        mark(vr->array[i]);
+}
+
+static void markhash(naRef r)
+{
+    int i;
+    struct HashRec* hr = r.ref.ptr.hash->rec;
+    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)
@@ -230,29 +258,10 @@ static void mark(naRef r)
     if(r.ref.ptr.obj->mark == 1)
         return;
 
-    // Verify that the object hasn't been freed incorrectly:
-    if(r.ref.ptr.obj->type == T_GCFREED) *(int*)0=0; // DEBUG
-
     r.ref.ptr.obj->mark = 1;
     switch(r.ref.ptr.obj->type) {
-    case T_VEC:
+    case T_VEC: markvec(r); break;
-        if(r.ref.ptr.vec->rec)
+    case T_HASH: markhash(r); break;
-            for(i=0; i<r.ref.ptr.vec->rec->size; i++)
-                mark(r.ref.ptr.vec->rec->array[i]);
-        break;
-    case T_HASH:
-        if(r.ref.ptr.hash->rec != 0) {
-            struct HashRec* hr = r.ref.ptr.hash->rec;
-            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;
-                }
-            }
-        }
-        break;
     case T_CODE:
         mark(r.ref.ptr.code->srcFile);
         for(i=0; i<r.ref.ptr.code->nConstants; i++)
@@ -304,15 +313,24 @@ static void reap(struct naPool* p)
     p->freetop = p->nfree;
 }
 
+// Does the swap, returning the old value
+static void* doswap(void** target, void* val)
+{
+    void* old = *target;
+    *target = val;
+    return old;
+}
+
 // Atomically replaces target with a new pointer, and adds the old one
 // to the list of blocks to free the next time something holds the
 // giant lock.
 void naGC_swapfree(void** target, void* val)
 {
+    void* old;
     LOCK();
+    old = doswap(target, val);
     while(globals->ndead >= globals->deadsz)
         bottleneck();
-    globals->deadBlocks[globals->ndead++] = *target;
+    globals->deadBlocks[globals->ndead++] = old;
-    *target = val;
     UNLOCK();
 }

simgear/nasal/hash.c

@@ -118,7 +118,7 @@ static struct HashNode* find(struct naHash* hash, naRef key)
 static void tmpStr(naRef* out, struct naStr* str, char* key)
 {
     str->len = 0;
-    str->data = key;
+    str->data = (unsigned char*)key;
     while(key[str->len]) str->len++;
     *out = naNil();
     out->ref.ptr.str = str;
@@ -170,7 +170,7 @@ void naHash_newsym(struct naHash* hash, naRef* sym, naRef* val)
 {
     int col;
     struct HashRec* h = hash->rec;
-    if(!h || h->size >= 1<<h->lgalloced)
+    while(!h || h->size >= 1<<h->lgalloced)
         h = realloc(hash);
     col = (HASH_MAGIC * sym->ref.ptr.str->hashcode) >> (32 - h->lgalloced);
     INSERT(h, *sym, *val, col);

simgear/nasal/lex.c

@@ -136,14 +136,19 @@ static void newToken(struct Parser* p, int pos, int type,
     p->tree.lastChild = tok;
 }
 
-// Parse a hex nibble
+static int hex(char c)
-static int hexc(char c, struct Parser* p, int index)
 {
     if(c >= '0' && c <= '9') return c - '0';
     if(c >= 'A' && c <= 'F') return c - 'A' + 10;
     if(c >= 'a' && c <= 'f') return c - 'a' + 10;
-    error(p, "bad hex constant", index);
+    return -1;
-    return 0;
+}
+
+static int hexc(char c, struct Parser* p, int index)
+{
+    int n = hex(c);
+    if(n < 0) error(p, "bad hex constant", index);
+    return n;
 }
 
 // Escape and returns a single backslashed expression in a single
@@ -186,13 +191,19 @@ static void dqEscape(char* buf, int len, int index, struct Parser* p,
     }
 }
 
+// FIXME: should handle UTF8 too
+static void charLiteral(struct Parser* p, int index, char* s, int len)
+{
+    if(len != 1) error(p, "character constant not single character", index);
+    newToken(p, index, TOK_LITERAL, 0, 0, *s);
+}
+
 // Read in a string literal
-static int lexStringLiteral(struct Parser* p, int index, int singleQuote)
+static int lexStringLiteral(struct Parser* p, int index, char q)
 {
     int i, j, len, iteration;
     char* out = 0;
     char* buf = p->buf;
-    char endMark = singleQuote ? '\'' : '"';
 
     for(iteration = 0; iteration<2; iteration++) {
         i = index+1;
@@ -200,11 +211,10 @@ static int lexStringLiteral(struct Parser* p, int index, int singleQuote)
         while(i < p->len) {
             char c = buf[i];
             int eaten = 1;
-            if(c == endMark)
+            if(c == q) break;
-                break;
             if(c == '\\') {
-                if(singleQuote) sqEscape(buf+i, p->len-i, i, p, &c, &eaten);
+                if(q == '\'') sqEscape(buf+i, p->len-i, i, p, &c, &eaten);
-                else            dqEscape(buf+i, p->len-i, i, p, &c, &eaten);
+                else          dqEscape(buf+i, p->len-i, i, p, &c, &eaten);
             }
             if(iteration == 1) out[j++] = c;
             i += eaten;
@@ -213,16 +223,31 @@ static int lexStringLiteral(struct Parser* p, int index, int singleQuote)
         // Finished stage one -- allocate the buffer for stage two
         if(iteration == 0) out = naParseAlloc(p, len);
     }
-    newToken(p, index, TOK_LITERAL, out, len, 0);
+    if(q == '`') charLiteral(p, index, out, len);
+    else         newToken(p, index, TOK_LITERAL, out, len, 0);
     return i+1;
 }
 
+static int lexHexLiteral(struct Parser* p, int index)
+{
+    int nib, i = index;
+    double d = 0;
+    while(i < p->len && (nib = hex(p->buf[i])) >= 0) {
+        d = d*16 + nib;
+        i++;
+    }
+    newToken(p, index, TOK_LITERAL, 0, 0, d);
+    return i;
+}
+
 static int lexNumLiteral(struct Parser* p, int index)
 {
     int len = p->len, i = index;
-    unsigned char* buf = p->buf;
+    unsigned char* buf = (unsigned char*)p->buf;
     double d;
 
+    if(i+1<len && buf[i+1] == 'x') return lexHexLiteral(p, index+2);
+
     while(i<len && buf[i] >= '0' && buf[i] <= '9') i++;
     if(i<len && buf[i] == '.') {
         i++;
@@ -309,12 +334,12 @@ void naLex(struct Parser* p)
         case '#':
             i = lineEnd(p, getLine(p, i));
             break;
-        case '\'': case '"':
+        case '\'': case '"': case '`':
-            i = lexStringLiteral(p, i, (c=='"' ? 0 : 1));
+            i = lexStringLiteral(p, i, c);
             break;
         default:
             if(c >= '0' && c <= '9') i = lexNumLiteral(p, i);
-            else                     handled = 0;
+            else handled = 0;
         }
 
         // Lexemes and symbols are a little more complicated.  Pick
@@ -324,7 +349,7 @@ void naLex(struct Parser* p)
         // symbol (e.g. "orchid").  If neither match, we have a bad
         // character in the mix.
         if(!handled) {
-            int symlen=0, lexlen=0, lexeme;
+            int symlen=0, lexlen=0, lexeme=-1;
             lexlen = tryLexemes(p, i, &lexeme);
             if((c>='A' && c<='Z') || (c>='a' && c<='z') || (c=='_'))
                 symlen = trySymbol(p, i);

simgear/nasal/lib.c

@@ -12,6 +12,7 @@
 #include "code.h"
 
 #define NEWSTR(c, s, l) naStr_fromdata(naNewString(c), s, l)
+#define NEWCSTR(c, s) NEWSTR(c, s, strlen(s))
 
 static naRef size(naContext c, naRef me, int argc, naRef* args)
 {
@@ -103,14 +104,32 @@ static naRef streq(naContext c, naRef me, int argc, naRef* args)
     return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
 }
 
+static naRef f_cmp(naContext c, naRef me, int argc, naRef* args)
+{
+    char *a, *b;
+    int i, len;
+    if(argc < 2 || !naIsString(args[0]) || !naIsString(args[1]))
+        naRuntimeError(c, "bad argument to cmp");
+    a = naStr_data(args[0]);
+    b = naStr_data(args[1]);
+    len = naStr_len(args[0]);
+    if(naStr_len(args[1]) < len)
+        len = naStr_len(args[1]);
+    for(i=0; i<len; i++) {
+        int diff = a - b;
+        if(diff < 0) return naNum(-1);
+        else if(diff > 0) return naNum(1);
+    }
+    return naNum(0);
+}
+
 static naRef substr(naContext c, naRef me, int argc, naRef* args)
 {
     naRef src = argc > 1 ? args[0] : naNil();
-    naRef startR = argc > 1 ? args[1] : naNil();
+    naRef startR = argc > 1 ? naNumValue(args[1]) : naNil();
-    naRef lenR = argc > 2 ? args[2] : naNil();
+    naRef lenR = argc > 2 ? naNumValue(args[2]) : naNil();
     int start, len;
     if(!naIsString(src)) return naNil();
-    startR = naNumValue(startR);
     if(naIsNil(startR)) return naNil();
     start = (int)startR.num;
     if(naIsNil(lenR)) {
@@ -124,18 +143,6 @@ static naRef substr(naContext c, naRef me, int argc, naRef* args)
     return naStr_substr(naNewString(c), src, start, len);
 }
 
-static naRef f_strc(naContext c, naRef me, int argc, naRef* args)
-{
-    int idx;
-    struct naStr* str = args[0].ref.ptr.str;
-    naRef idr = argc > 1 ? naNumValue(args[1]) : naNum(0);
-    if(argc < 1 || IS_NIL(idr) || !IS_STR(args[0]))
-        naRuntimeError(c, "bad arguments to strc");
-    idx = (int)naNumValue(idr).num;
-    if(idx > str->len) naRuntimeError(c, "strc index out of bounds");
-    return naNum(str->data[idx]);
-}
-
 static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
 {
     char chr[1];
@@ -165,7 +172,7 @@ static naRef typeOf(naContext c, naRef me, int argc, naRef* args)
     else if(naIsHash(r)) t = "hash";
     else if(naIsFunc(r)) t = "func";
     else if(naIsGhost(r)) t = "ghost";
-    r = NEWSTR(c, t, strlen(t));
+    r = NEWCSTR(c, t);
     return r;
 }
 
@@ -175,33 +182,37 @@ static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
     naRef script, code, fname;
     script = argc > 0 ? args[0] : naNil();
     if(!naIsString(script)) return naNil();
-    fname = NEWSTR(c, "<compile>", 9);
+    fname = NEWCSTR(c, "<compile>");
     code = naParseCode(c, fname, 1,
                        naStr_data(script), naStr_len(script), &errLine);
     if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
     return naBindToContext(c, code);
 }
 
-// Funcation metacall API.  Allows user code to generate an arg vector
-// at runtime and/or call function references on arbitrary objects.
 static naRef f_call(naContext c, naRef me, int argc, naRef* args)
 {
     naContext subc;
-    naRef callargs, callme, result;
+    naRef callargs, callme, callns, result;
+    struct VecRec* vr;
     callargs = argc > 1 ? args[1] : naNil();
     callme = argc > 2 ? args[2] : naNil(); // Might be nil, that's OK
-    if(!naIsFunc(args[0])) naRuntimeError(c, "call() on non-function");
+    callns = argc > 3 ? args[3] : naNil(); // ditto
-    if(naIsNil(callargs)) callargs = naNewVector(c);
+    if(!IS_HASH(callme)) callme = naNil();
-    else if(!naIsVector(callargs)) naRuntimeError(c, "call() args not vector");
+    if(!IS_HASH(callns)) callns = naNil();
-    if(!naIsHash(callme)) callme = naNil();
+    if(!IS_FUNC(args[0]) || (!IS_NIL(callargs) && !IS_VEC(callargs)))
+        naRuntimeError(c, "bad argument to call()");
     subc = naNewContext();
     subc->callParent = c;
     c->callChild = subc;
-    result = naCall(subc, args[0], callargs, callme, naNil());
+    vr = IS_NIL(callargs) ? 0 : callargs.ref.ptr.vec->rec;
+    result = naCall(subc, args[0], vr ? vr->size : 0, vr ? vr->array : 0,
+                    callme, callns);
     c->callChild = 0;
-    if(argc > 2 && !IS_NIL(subc->dieArg))
+    if(argc > 2 && IS_VEC(args[argc-1])) {
-        if(naIsVector(args[argc-1]))
+        if(!IS_NIL(subc->dieArg)) naVec_append(args[argc-1], subc->dieArg);
-            naVec_append(args[argc-1], subc->dieArg);
+        else if(naGetError(subc))
+            naVec_append(args[argc-1], NEWCSTR(subc, naGetError(subc)));
+    }
     naFreeContext(subc);
     return result;
 }
@@ -351,14 +362,14 @@ static naRef f_closure(naContext ctx, naRef me, int argc, naRef* args)
     return f->namespace;
 }
 
-static int match(char* a, char* b, int l)
+static int match(unsigned char* a, unsigned char* b, int l)
 {
     int i;
     for(i=0; i<l; i++) if(a[i] != b[i]) return 0;
     return 1;
 }
 
-static int find(char* a, int al, char* s, int sl, int start)
+static int find(unsigned char* a, int al, unsigned char* s, int sl, int start)
 {
     int i;
     if(al == 0) return 0;
@@ -370,7 +381,7 @@ static naRef f_find(naContext ctx, naRef me, int argc, naRef* args)
 {
     int start = 0;
     if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
-        naRuntimeError(ctx, "bad/missing argument to split");
+        naRuntimeError(ctx, "bad/missing argument to find");
     if(argc > 2) start = (int)(naNumValue(args[2]).num);
     return naNum(find(args[0].ref.ptr.str->data, args[0].ref.ptr.str->len,
                       args[1].ref.ptr.str->data, args[1].ref.ptr.str->len,
@@ -393,7 +404,7 @@ static naRef f_split(naContext ctx, naRef me, int argc, naRef* args)
     }
     s0 = s;
     for(i=0; i <= sl-dl; i++) {
-        if(match(s+i, d, dl)) {
+        if(match((unsigned char*)(s+i), (unsigned char*)d, dl)) {
             naVec_append(result, NEWSTR(ctx, s0, s+i-s0));
             s0 = s + i + dl;
             i += dl - 1;
@@ -445,8 +456,8 @@ static struct func funcs[] = {
     { "int", intf },
     { "num", num },
     { "streq", streq },
+    { "cmp", f_cmp },
     { "substr", substr },
-    { "strc", f_strc },
     { "chr", f_chr },
     { "contains", contains },
     { "typeof", typeOf },

simgear/nasal/mathlib.c

@@ -82,13 +82,14 @@ naRef naMathLib(naContext c)
         naHash_set(namespace, name, naNewFunc(c, code));
     }
 
-    // Set up constants for math.pi and math.e
+    // Set up constants for math.pi and math.e.  Can't use M_PI or
+    // M_E, becuase those aren't technically part of the C standard.  Sigh.
     name = naStr_fromdata(naNewString(c), "pi", 2);
-    naHash_set(namespace, name, naNum(M_PI));
+    naHash_set(namespace, name, naNum(3.14159265358979323846));
 
     name = naStr_fromdata(naNewString(c), "e", 1);
     name = naInternSymbol(name);
-    naHash_set(namespace, name, naNum(M_E));
+    naHash_set(namespace, name, naNum(2.7182818284590452354));
 
     return namespace;
 }

simgear/nasal/misc.c

@@ -7,8 +7,24 @@
 
 void naFree(void* m) { free(m); }
 void* naAlloc(int n) { return malloc(n); }
+void* naRealloc(void* b, int n) { return realloc(b, n); }
 void naBZero(void* m, int n) { memset(m, 0, n); }
 
+void naTempSave(naContext c, naRef r)
+{
+    int i;
+    if(!IS_OBJ(r)) return;
+    if(c->ntemps >= c->tempsz) {
+        c->tempsz *= 2;
+        struct naObj** newtemps = naAlloc(c->tempsz * sizeof(struct naObj*));
+        for(i=0; i<c->ntemps; i++)
+            newtemps[i] = c->temps[i];
+        naFree(c->temps);
+        c->temps = newtemps;
+    }
+    c->temps[c->ntemps++] = r.ref.ptr.obj;
+}
+
 naRef naObj(int type, struct naObj* o)
 {
     naRef r;
@@ -54,7 +70,7 @@ naRef naNew(struct Context* c, int type)
         c->free[type] = naGC_get(&globals->pools[type],
                                  OBJ_CACHE_SZ, &c->nfree[type]);
     result = naObj(type, c->free[type][--c->nfree[type]]);
-    naVec_append(c->temps, result);
+    naTempSave(c, result);
     return result;
 }
 
@@ -187,52 +203,13 @@ int naTypeSize(int type)
     return 0x7fffffff; // Make sure the answer is nonsense :)
 }
 
-int naIsNil(naRef r)
+int naIsNil(naRef r)    { return IS_NIL(r); }
-{
+int naIsNum(naRef r)    { return IS_NUM(r); }
-    return IS_NIL(r);
+int naIsString(naRef r) { return IS_STR(r); }
-}
+int naIsScalar(naRef r) { return IS_SCALAR(r); }
-
+int naIsVector(naRef r) { return IS_VEC(r); }
-int naIsNum(naRef r)
+int naIsHash(naRef r)   { return IS_HASH(r); }
-{
+int naIsFunc(naRef r)   { return IS_FUNC(r); }
-    return IS_NUM(r);
+int naIsCode(naRef r)   { return IS_CODE(r); }
-}
+int naIsCCode(naRef r)  { return IS_CCODE(r); }
-
+int naIsGhost(naRef r)  { return IS_GHOST(r); }
-int naIsString(naRef r)
-{
-    return (!IS_NIL(r))&&IS_STR(r);
-}
-
-int naIsScalar(naRef r)
-{
-    return IS_SCALAR(r);
-}
-
-int naIsVector(naRef r)
-{
-    return (!IS_NIL(r))&&IS_VEC(r);
-}
-
-int naIsHash(naRef r)
-{
-    return (!IS_NIL(r))&&IS_HASH(r);
-}
-
-int naIsFunc(naRef r)
-{
-    return (!IS_NIL(r))&&IS_FUNC(r);
-}
-
-int naIsCode(naRef r)
-{
-    return IS_CODE(r);
-}
-
-int naIsCCode(naRef r)
-{
-    return IS_CCODE(r);
-}
-
-int naIsGhost(naRef r)
-{
-    return IS_GHOST(r);
-}

simgear/nasal/nasal.h

@@ -84,6 +84,11 @@ void naFreeContext(naContext c);
 // referenced by it) from being garbage collected.
 void naSave(naContext ctx, naRef obj);
 
+// Similar, but the object is automatically released when the
+// context next runs native bytecode.  Useful for saving off C-space
+// temporaries to protect them before passing back into a naCall.
+void naTempSave(naContext c, naRef r);
+
 // Parse a buffer in memory into a code object.
 naRef naParseCode(naContext c, naRef srcFile, int firstLine,
                   char* buf, int len, int* errLine);
@@ -102,7 +107,7 @@ naRef naBindToContext(naContext ctx, naRef code);
 // Call a code or function object with the specifed arguments "on" the
 // specified object and using the specified hash for the local
 // variables.  Any of args, obj or locals may be nil.
-naRef naCall(naContext ctx, naRef func, naRef args, naRef obj, naRef locals);
+naRef naCall(naContext ctx, naRef func, int argc, naRef* args, naRef obj, naRef locals);
 
 // Throw an error from the current call stack.  This function makes a
 // longjmp call to a handler in naCall() and DOES NOT RETURN.  It is
@@ -119,8 +124,12 @@ naRef naMethod(naContext ctx, naRef func, naRef object);
 // Useful for passing as a namespace to an initial function call
 naRef naStdLib(naContext c);
 
-// Ditto, with math functions
+// Ditto, for other core libraries
 naRef naMathLib(naContext c);
+naRef naBitsLib(naContext c);
+naRef naIOLib(naContext c);
+naRef naRegexLib(naContext c);
+naRef naUnixLib(naContext c);
 
 // Current line number & error message
 int naStackDepth(naContext ctx);

simgear/nasal/parse.c

@@ -503,7 +503,7 @@ naRef naParseCode(struct Context* c, naRef srcFile, int firstLine,
     struct Parser p;
 
     // Protect from garbage collection
-    naVec_append(c->temps, srcFile);
+    naTempSave(c, srcFile);
 
     // Catch parser errors here.
     *errLine = 0;
@@ -536,7 +536,7 @@ naRef naParseCode(struct Context* c, naRef srcFile, int firstLine,
 
     // Clean up our mess
     naParseDestroy(&p);
-    naVec_append(c->temps, codeObj);
+    naTempSave(c, codeObj);
 
     return codeObj;
 }

simgear/nasal/string.c

@@ -20,7 +20,7 @@ int naStr_len(naRef s)
 char* naStr_data(naRef s)
 {
     if(!IS_STR(s)) return 0;
-    return s.ref.ptr.str->data;
+    return (char*)s.ref.ptr.str->data;
 }
 
 static void setlen(struct naStr* s, int sz)
@@ -31,6 +31,13 @@ static void setlen(struct naStr* s, int sz)
     s->data[sz] = 0; // nul terminate
 }
 
+naRef naStr_buf(naRef dst, int len)
+{
+    setlen(dst.ref.ptr.str, len);
+    naBZero(dst.ref.ptr.str->data, len);
+    return dst;
+}
+
 naRef naStr_fromdata(naRef dst, char* data, int len)
 {
     if(!IS_STR(dst)) return naNil();
@@ -83,7 +90,7 @@ naRef naStr_fromnum(naRef dest, double num)
 
 int naStr_parsenum(char* str, int len, double* result)
 {
-    return tonum(str, len, result);
+    return tonum((unsigned char*)str, len, result);
 }
 
 int naStr_tonum(naRef str, double* out)

simgear/nasal/thread-posix.c

@@ -55,3 +55,5 @@ void naSemUpAll(void* sh, int count)
 }
 
 #endif
+
+extern int GccWarningWorkaround_IsoCForbidsAnEmptySourceFile;

simgear/nasal/thread-win32.c

@@ -18,3 +18,5 @@ void  naSemDown(void* sem) { WaitForSingleObject((HANDLE)sem, INFINITE); }
 void  naSemUpAll(void* sem, int count) { ReleaseSemaphore(sem, count, 0); }
 
 #endif
+
+extern int GccWarningWorkaround_IsoCForbidsAnEmptySourceFile;

simgear/nasal/vector.c

@@ -1,9 +1,8 @@
 #include "nasal.h"
 #include "data.h"
 
-static void realloc(struct naVec* v)
+static struct VecRec* newvecrec(struct VecRec* old)
 {
-    struct VecRec* old = v->rec;
     int i, oldsz = old ? old->size : 0, newsz = 1 + ((oldsz*3)>>1);
     struct VecRec* vr = naAlloc(sizeof(struct VecRec) + sizeof(naRef) * newsz);
     if(oldsz > newsz) oldsz = newsz; // race protection
@@ -11,6 +10,12 @@ static void realloc(struct naVec* v)
     vr->size = oldsz;
     for(i=0; i<oldsz; i++)
         vr->array[i] = old->array[i];
+    return vr;
+}
+
+static void realloc(struct naVec* v)
+{
+    struct VecRec* vr = newvecrec(v->rec);
     naGC_swapfree((void**)&(v->rec), vr);
 }
 
@@ -24,7 +29,10 @@ naRef naVec_get(naRef v, int i)
 {
     if(IS_VEC(v)) {
         struct VecRec* r = v.ref.ptr.vec->rec;
-        if(r && i < r->size) return r->array[i];
+        if(r) {
+            if(i < 0) i += r->size;
+            if(i >= 0 && i < r->size) return r->array[i];
+        }
     }
     return naNil();
 }
@@ -51,7 +59,7 @@ int naVec_append(naRef vec, naRef o)
 {
     if(IS_VEC(vec)) {
         struct VecRec* r = vec.ref.ptr.vec->rec;
-        if(!r || r->size >= r->alloced) {
+        while(!r || r->size >= r->alloced) {
             realloc(vec.ref.ptr.vec);
             r = vec.ref.ptr.vec->rec;
         }