Been hacking at Nasal recently:

Fix bug with break/continue inside of a foreach or forindex: Don't pop
the vector/index inside OP_EACH, do it at the end of the loop.

In the process, discovered and fixed a scary corruption issue with
continue; it never really worked right, although simple usage was
likely to get away without crashing.  Both the continue's OP_BREAK and
the cleanup code at the end of a loop would pop the "mark" stack,
leading to an underflow.  Introduced an OP_CONTINUE which adjusts
stack but doesn't change markTop

Re-inline the PUSH macro.  This thing is called all over the place
from the inner loop.  If the problem is intra-expression side effects,
then just use another expression in the macro.

Return an empty vector when requesting zero-length subvec, not nil

Have call() return the call stack in the error vector; see docs on
plausible.org/nasal or ask Andy about this feature.

Default closure()'s level argument to zero, not nil

Add an optional "file name" argument to compile()

simgear/nasal/code.c

@@ -200,29 +200,15 @@ void naFreeContext(struct Context* c)
     UNLOCK();
 }
 
-#if 0
+// Note that opTop is incremented separately, to avoid situations
-/*
+// where the "r" expression also references opTop.  The SGI compiler
- * This is the original code which might not work properly on all
+// is known to have issues with such code.
- * platforms since it allows one to work on the same variable in one
+#define PUSH(r) do { \
- * statement without the prior knowledge how this will behave.
- * 
- * e.g. ctx->opStack[ctx->opTop++] = ctx->opStack[ctx->opTop-1];
- *                        ^^^^^                        ^^^^^
- */
-# define PUSH(r) do { \
     if(ctx->opTop >= MAX_STACK_DEPTH) ERR(ctx, "stack overflow"); \
-    ctx->opStack[ctx->opTop++] = r; \
+    ctx->opStack[ctx->opTop] = r; \
+    ctx->opTop++;                 \
     } while(0)
 
-#else
-
-# define PUSH(r)  _PUSH((ctx), (r))
-void _PUSH(struct Context* ctx, naRef r) {
-   if(ctx->opTop >= MAX_STACK_DEPTH) ERR(ctx, "stack overflow");
-    ctx->opStack[ctx->opTop++] = r;
-}
-#endif
-
 static void setupArgs(naContext ctx, struct Frame* f, naRef* args, int nargs)
 {
     int i;
@@ -402,15 +388,14 @@ static int getMember(struct Context* ctx, naRef obj, naRef fld,
 }
 
 // OP_EACH works like a vector get, except that it leaves the vector
-// and index on the stack, increments the index after use, and pops
+// and index on the stack, increments the index after use, and
-// the arguments and pushes a nil if the index is beyond the end.
+// pushes a nil if the index is beyond the end.
 static void evalEach(struct Context* ctx, int useIndex)
 {
     int idx = (int)(ctx->opStack[ctx->opTop-1].num);
     naRef vec = ctx->opStack[ctx->opTop-2];
     if(!IS_VEC(vec)) naRuntimeError(ctx, "foreach enumeration of non-vector");
     if(!vec.ref.ptr.vec->rec || idx >= vec.ref.ptr.vec->rec->size) {
-        ctx->opTop -= 2; // pop two values
         PUSH(naNil());
         return;
     }
@@ -618,6 +603,9 @@ static naRef run(struct Context* ctx)
         case OP_BREAK: // restore stack state (FOLLOW WITH JMP!)
             ctx->opTop = ctx->markStack[--ctx->markTop];
             break;
+        case OP_CONTINUE: // same, but don't modify markTop
+            ctx->opTop = ctx->markStack[ctx->markTop-1];
+            break;
         default:
             ERR(ctx, "BUG: bad opcode");
         }

simgear/nasal/code.h

@@ -22,7 +22,7 @@ enum {
     OP_DUP, OP_XCHG, OP_INSERT, OP_EXTRACT, OP_MEMBER, OP_SETMEMBER,
     OP_LOCAL, OP_SETLOCAL, OP_NEWVEC, OP_VAPPEND, OP_NEWHASH, OP_HAPPEND,
     OP_MARK, OP_UNMARK, OP_BREAK, OP_FTAIL, OP_MTAIL, OP_SETSYM, OP_DUP2,
-    OP_INDEX
+    OP_INDEX, OP_CONTINUE
 };
 
 struct Frame {

simgear/nasal/codegen.c

@@ -480,9 +480,9 @@ static void genForEach(struct Parser* p, struct Token* t)
     vec = RIGHT(h);
     body = RIGHT(t)->children;
 
-    pushLoop(p, label);
     genExpr(p, vec);
     emit(p, OP_PUSHZERO);
+    pushLoop(p, label);
     loopTop = p->cg->codesz;
     emit(p, t->type == TOK_FOREACH ? OP_EACH : OP_INDEX);
     jumpEnd = emitJump(p, OP_JIFNIL);
@@ -491,6 +491,8 @@ static void genForEach(struct Parser* p, struct Token* t)
     emit(p, assignOp);
     emit(p, OP_POP);
     genLoop(p, body, 0, label, loopTop, jumpEnd);
+    emit(p, OP_POP); // Pull off the vector and index
+    emit(p, OP_POP);
 }
 
 static int tokMatch(struct Token* a, struct Token* b)
@@ -518,7 +520,7 @@ static void genBreakContinue(struct Parser* p, struct Token* t)
     bp = p->cg->loops[p->cg->loopTop - levels].breakIP;
     cp = p->cg->loops[p->cg->loopTop - levels].contIP;
     for(i=0; i<levels; i++)
-        emit(p, OP_BREAK);
+        emit(p, (t->type == TOK_BREAK || i>0) ? OP_BREAK : OP_CONTINUE);
     if(t->type == TOK_BREAK)
         emit(p, OP_PUSHNIL); // breakIP is always a JIFNOT/JIFNIL!
     emitImmediate(p, OP_JMP, t->type == TOK_BREAK ? bp : cp);

simgear/nasal/gc.c

@@ -136,28 +136,15 @@ static void naGhost_gcclean(struct naGhost* g)
 
 static void freeelem(struct naPool* p, struct naObj* o)
 {
-    // Free any intrinsic (i.e. non-garbage collected) storage the
+    // Clean up any intrinsic storage the object might have...
-    // object might have
     switch(p->type) {
-    case T_STR:
+    case T_STR:   naStr_gcclean  ((struct naStr*)  o); break;
-        naStr_gcclean((struct naStr*)o);
+    case T_VEC:   naVec_gcclean  ((struct naVec*)  o); break;
-        break;
+    case T_HASH:  naHash_gcclean ((struct naHash*) o); break;
-    case T_VEC:
+    case T_CODE:  naCode_gcclean ((struct naCode*) o); break;
-        naVec_gcclean((struct naVec*)o);
+    case T_GHOST: naGhost_gcclean((struct naGhost*)o); break;
-        break;
-    case T_HASH:
-        naHash_gcclean((struct naHash*)o);
-        break;
-    case T_CODE:
-        naCode_gcclean((struct naCode*)o);
-        break;
-    case T_GHOST:
-        naGhost_gcclean((struct naGhost*)o);
-        break;
     }
-
+    p->free[p->nfree++] = o;  // ...and add it to the free list
-    // And add it to the free list
-    p->free[p->nfree++] = o;
 }
 
 static void newBlock(struct naPool* p, int need)

simgear/nasal/lib.c

@@ -67,7 +67,7 @@ static naRef subvec(naContext c, naRef me, int argc, naRef* args)
     nlen = argc > 2 ? naNumValue(args[2]) : naNil();
     if(!naIsNil(nlen))
         len = (int)nlen.num;
-    if(!naIsVector(v) || start < 0 || start >= naVec_size(v) || len < 0)
+    if(!naIsVector(v) || start < 0 || start > naVec_size(v) || len < 0)
         return naNil();
     if(naIsNil(nlen) || len > naVec_size(v) - start)
         len = naVec_size(v) - start;
@@ -180,8 +180,8 @@ static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
     int errLine;
     naRef script, code, fname;
     script = argc > 0 ? args[0] : naNil();
-    if(!naIsString(script)) return naNil();
+    fname = argc > 1 ? args[1] : NEWCSTR(c, "<compile>");
-    fname = NEWCSTR(c, "<compile>");
+    if(!naIsString(script) || !naIsString(fname)) return naNil();
     code = naParseCode(c, fname, 1,
                        naStr_data(script), naStr_len(script), &errLine);
     if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
@@ -208,9 +208,17 @@ static naRef f_call(naContext c, naRef me, int argc, naRef* args)
                     callme, callns);
     c->callChild = 0;
     if(argc > 2 && IS_VEC(args[argc-1])) {
-        if(!IS_NIL(subc->dieArg)) naVec_append(args[argc-1], subc->dieArg);
+        naRef v = args[argc-1];
+        if(!IS_NIL(subc->dieArg)) naVec_append(v, subc->dieArg);
         else if(naGetError(subc))
-            naVec_append(args[argc-1], NEWCSTR(subc, naGetError(subc)));
+            naVec_append(v, NEWCSTR(subc, naGetError(subc)));
+        if(naVec_size(v)) {
+            int i, sd = naStackDepth(subc);
+            for(i=0; i<sd; i++) {
+                naVec_append(v, naGetSourceFile(subc, i));
+                naVec_append(v, naNum(naGetLine(subc, i)));
+            }
+        }
     }
     naFreeContext(subc);
     return result;
@@ -349,10 +357,9 @@ static naRef f_caller(naContext ctx, naRef me, int argc, naRef* args)
 static naRef f_closure(naContext ctx, naRef me, int argc, naRef* args)
 {
     int i;
-    naRef func, idx;
     struct naFunc* f;
-    func = argc > 0 ? args[0] : naNil();
+    naRef func = argc > 0 ? args[0] : naNil();
-    idx = argc > 1 ? naNumValue(args[1]) : naNil();
+    naRef idx = argc > 1 ? naNumValue(args[1]) : naNum(0);
     if(!IS_FUNC(func) || IS_NIL(idx))
         naRuntimeError(ctx, "bad arguments to closure()");
     i = (int)idx.num;

simgear/nasal/vector.c

@@ -13,7 +13,7 @@ static struct VecRec* newvecrec(struct VecRec* old)
     return vr;
 }
 
-static void vecrealloc(struct naVec* v)
+static void resize(struct naVec* v)
 {
     struct VecRec* vr = newvecrec(v->rec);
     naGC_swapfree((void**)&(v->rec), vr);
@@ -60,7 +60,7 @@ int naVec_append(naRef vec, naRef o)
     if(IS_VEC(vec)) {
         struct VecRec* r = vec.ref.ptr.vec->rec;
         while(!r || r->size >= r->alloced) {
-            vecrealloc(vec.ref.ptr.vec);
+            resize(vec.ref.ptr.vec);
             r = vec.ref.ptr.vec->rec;
         }
         r->array[r->size] = o;
@@ -91,7 +91,7 @@ naRef naVec_removelast(naRef vec)
         o = v->array[v->size - 1];
         v->size--;
         if(v->size < (v->alloced >> 1))
-            vecrealloc(vec.ref.ptr.vec);
+            resize(vec.ref.ptr.vec);
         return o;
     }
     return naNil();