From f8174f192c613e05c77166435e331198819e0507 Mon Sep 17 00:00:00 2001 From: bakpakin Date: Fri, 12 Jan 2018 13:54:37 -0500 Subject: [PATCH] Fix some vararg behavior in tail calls. --- core/asm.c | 1 + core/fiber.c | 60 +++++++++++++++++++++++++++++----------------- core/opcodes.h | 1 + core/stl.c | 10 ++++++++ core/vm.c | 14 +++++++++++ dsttest/suite0.dst | 30 +++++++++++++++++------ 6 files changed, 87 insertions(+), 29 deletions(-) diff --git a/core/asm.c b/core/asm.c index d9eadb81..c4ba674b 100644 --- a/core/asm.c +++ b/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}, diff --git a/core/fiber.c b/core/fiber.c index a8b3655d..7abe4932 100644 --- a/core/fiber.c +++ b/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) { - /* 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)); - } - } - +static void funcframe_env(DstFiber *fiber, DstFunction *func) { /* 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; diff --git a/core/opcodes.h b/core/opcodes.h index 50495f1f..f564aef7 100644 --- a/core/opcodes.h +++ b/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, diff --git a/core/stl.c b/core/stl.c index b160b6a0..30c1a710 100644 --- a/core/stl.c +++ b/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}, diff --git a/core/vm.c b/core/vm.c index 0ba3e8ef..3cd67ced 100644 --- a/core/vm.c +++ b/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)]; diff --git a/dsttest/suite0.dst b/dsttest/suite0.dst index 21ef61a0..d0cc0d7e 100644 --- a/dsttest/suite0.dst +++ b/dsttest/suite0.dst @@ -131,12 +131,28 @@ # Var arg tests -(def vargf (fn [x & more] (apply + (if x x 0) 100 more))) -(assert (= 100 (vargf)) "var arg no arguments") -(assert (= 101 (vargf 1)) "var arg no packed arguments") -(assert (= 103 (vargf 1 2)) "var arg tuple size 1") -(assert (= 110 (vargf 1 2 3 4)) "var arg tuple size 3") -(assert (= 210 (vargf 1 2 3 4 10 10 10 10 10 10 10 10 10 10)) "var arg large tuple") +(def apply (asm '{ + arity 2 + bytecode [ + (push-array 1) + (tailcall 0) + ] +})) + +(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")))