Fix some vararg behavior in tail calls.

core/asm.c

@@ -149,6 +149,7 @@ static const DstInstructionDef dst_ops[] = {
     {"multiply-real", DIT_SSS, DOP_MULTIPLY_REAL},
     {"noop", DIT_0, DOP_NOOP},
     {"push", DIT_S, DOP_PUSH},
+    {"push-array", DIT_S, DOP_PUSH_ARRAY},
     {"push2", DIT_SS, DOP_PUSH_2},
     {"push3", DIT_SSS, DOP_PUSH_3},
     {"put", DIT_SSS, DOP_PUT},

core/fiber.c

@@ -102,19 +102,7 @@ void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n) {
 }
 
 /* Help set up function */
-static void funcframe_helper(DstFiber *fiber, DstFunction *func) {
+static void funcframe_env(DstFiber *fiber, DstFunction *func) {
-    /* Check varargs */
-    if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) {
-        int32_t tuplehead = fiber->frame + func->def->arity;
-        if (tuplehead >= fiber->stacktop) {
-            fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(NULL, 0));
-        } else {
-            fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(
-                fiber->data + tuplehead,
-                fiber->stacktop - tuplehead));
-        }
-    }
-
     /* Check closure env */
     if (func->def->flags & DST_FUNCDEF_FLAG_NEEDSENV) {
         /* Delayed capture of current stack frame */
@@ -131,6 +119,7 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
     DstStackFrame *newframe;
 
     int32_t i;
+    int32_t oldtop = fiber->stacktop;
     int32_t oldframe = fiber->frame;
     int32_t nextframe = fiber->stackstart;
     int32_t nextstacktop = nextframe + func->def->slotcount + DST_FRAME_SIZE;
@@ -153,8 +142,19 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
     newframe->func = func;
 
     /* Check varargs */
-    funcframe_helper(fiber, func);
+    if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) {
+        int32_t tuplehead = fiber->frame + func->def->arity;
+        if (tuplehead >= oldtop) {
+            fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(NULL, 0));
+        } else {
+            fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(
+                fiber->data + tuplehead,
+                oldtop - tuplehead));
+        }
+    }
 
+    /* Check env */
+    funcframe_env(fiber, func) ;
 }
 
 /* If a frame has a closure environment, detach it from
@@ -179,7 +179,7 @@ void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
     int32_t i;
     int32_t nextframetop = fiber->frame + func->def->slotcount;
     int32_t nextstacktop = nextframetop + DST_FRAME_SIZE;
-    int32_t stacksize = fiber->stacktop - fiber->stackstart;
+    int32_t stacksize;
 
     if (fiber->capacity < nextstacktop) {
         dst_fiber_setcapacity(fiber, 2 * nextstacktop);
@@ -192,18 +192,34 @@ void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
     if (NULL != dst_fiber_frame(fiber)->func)
         dst_function_detach(dst_fiber_frame(fiber)->func);
 
-    memmove(stack, args, stacksize * sizeof(Dst));
+    /* Check varargs */
+    if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) {
+        int32_t tuplehead = fiber->stackstart + func->def->arity;
+        if (tuplehead >= fiber->stacktop) {
+            if (tuplehead >= fiber->capacity) dst_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
+            for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = dst_wrap_nil();
+            fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(NULL, 0));
+        } else {
+            fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(
+                fiber->data + tuplehead,
+                fiber->stacktop - tuplehead));
+        }
+        stacksize = tuplehead - fiber->stackstart + 1;
+    } else {
+        stacksize = fiber->stacktop - fiber->stackstart;
+    }
+
+    if (stacksize) memmove(stack, args, stacksize * sizeof(Dst));
+
+    /* Nil unset locals (Needed for functional correctness) */
+    for (i = fiber->frame + stacksize; i < nextframetop; ++i)
+        fiber->data[i] = dst_wrap_nil();
 
     /* Set stack stuff */
     fiber->stacktop = fiber->stackstart = nextstacktop;
 
-    /* Nil unset locals (Needed for functional correctness) */
-    for (i = fiber->frame + stacksize; i < nextframetop; ++i) {
-        fiber->data[i] = dst_wrap_nil();
-    }
-
     /* Varargs and func envs */
-    funcframe_helper(fiber, func);
+    funcframe_env(fiber, func);
 
     /* Set frame stuff */
     dst_fiber_frame(fiber)->func = func;

core/opcodes.h

@@ -76,6 +76,7 @@ enum DstOpCode {
     DOP_PUSH,
     DOP_PUSH_2,
     DOP_PUSH_3,
+    DOP_PUSH_ARRAY,
     DOP_CALL,
     DOP_TAILCALL,
     DOP_TRANSFER,

core/stl.c

@@ -184,6 +184,15 @@ int dst_stl_gensym(int32_t argn, Dst *argv, Dst *ret) {
     return 0;
 }
 
+int dst_stl_length(int32_t argn, Dst *argv, Dst *ret) {
+    if (argn != 1) {
+        *ret = dst_cstringv("expected at least 1 argument");
+        return 1;
+    }
+    *ret = dst_wrap_integer(dst_length(argv[0]));
+    return 0;
+}
+
 int dst_stl_get(int32_t argn, Dst *argv, Dst *ret) {
     int32_t i;
     Dst ds;
@@ -281,6 +290,7 @@ static DstReg stl[] = {
     {"disasm", dst_stl_disasm},
     {"get", dst_stl_get},
     {"put", dst_stl_put},
+    {"length", dst_stl_length},
     {"+", dst_add},
     {"-", dst_subtract},
     {"*", dst_multiply},

core/vm.c

@@ -467,6 +467,20 @@ static int dst_continue(Dst *returnreg) {
         stack = dst_vm_fiber->data + dst_vm_fiber->frame;
         vm_checkgc_next();
 
+        case DOP_PUSH_ARRAY:
+        {
+            const Dst *vals;
+            int32_t len;
+            if (dst_seq_view(stack[oparg(1, 0xFFFFFF)], &vals, &len)) {
+                dst_fiber_pushn(dst_vm_fiber, vals, len);        
+            } else {
+                vm_throw("expected array/tuple");
+            }
+        }
+        pc++;
+        stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+        vm_checkgc_next();
+
         case DOP_CALL:
         {
             Dst callee = stack[oparg(2, 0xFFFF)];

dsttest/suite0.dst

@@ -131,12 +131,28 @@
 
 # Var arg tests
 
-(def vargf (fn [x & more] (apply + (if x x 0) 100 more)))
+(def apply (asm '{
-(assert (= 100 (vargf)) "var arg no arguments")
+  arity 2
-(assert (= 101 (vargf 1)) "var arg no packed arguments")
+  bytecode [
-(assert (= 103 (vargf 1 2)) "var arg tuple size 1")
+    (push-array 1)
-(assert (= 110 (vargf 1 2 3 4)) "var arg tuple size 3")
+    (tailcall 0) 
-(assert (= 210 (vargf 1 2 3 4 10 10 10 10 10 10 10 10 10 10)) "var arg large tuple")
+  ] 
+}))
+
+(def error (asm '{
+  arity 1
+  bytecode [
+    (error 0)
+  ]
+}))
+
+(def vargf (fn [more] (apply + more)))
+
+(assert (= 0 (vargf [])) "var arg no arguments")
+(assert (= 1 (vargf [1])) "var arg no packed arguments")
+(assert (= 3 (vargf [1 2])) "var arg tuple size 1")
+(assert (= 10 (vargf [1 2 3 4])) "var arg tuple size 3")
+(assert (= 110 (vargf [1 2 3 4 10 10 10 10 10 10 10 10 10 10])) "var arg large tuple")
 
 # Gensym tests
 
@@ -146,7 +162,7 @@
 	(def syms (table))
 	(var count 0)
 	(while (< count 128)
-		(set! syms (gensym 'beep) true)
+		(put syms (gensym 'beep) true)
 		(varset! count (+ 1 count)))
 	(assert (= (length syms) 128) "many symbols")))