From d79f557d466a2e9a851447cae268c6f1e9155bb6 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Thu, 19 Dec 2019 23:58:51 +0800
Subject: [PATCH] fix variadic foreign functions with more than 4 params

---
 lib/chibi/disasm.c      |  7 +++++++
 tests/ffi/ffi-tests.scm | 30 ++++++++++++++++++++++++++++++
 vm.c                    |  2 +-
 3 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/lib/chibi/disasm.c b/lib/chibi/disasm.c
index d2cc1f88..788e368b 100644
--- a/lib/chibi/disasm.c
+++ b/lib/chibi/disasm.c
@@ -92,6 +92,12 @@ static sexp disasm (sexp ctx, sexp self, sexp bc, sexp out, int depth) {
       if (off >= 0 && off < (int)sexp_bytecode_length(bc) && labels[off] == 0)
         labels[off] = label++;
     case SEXP_OP_CALL:
+    case SEXP_OP_FCALL0:
+    case SEXP_OP_FCALL1:
+    case SEXP_OP_FCALL2:
+    case SEXP_OP_FCALL3:
+    case SEXP_OP_FCALL4:
+    case SEXP_OP_FCALLN:
     case SEXP_OP_CLOSURE_REF:
     case SEXP_OP_GLOBAL_KNOWN_REF:
     case SEXP_OP_GLOBAL_REF:
@@ -178,6 +184,7 @@ static sexp disasm (sexp ctx, sexp self, sexp bc, sexp out, int depth) {
   case SEXP_OP_FCALL2:
   case SEXP_OP_FCALL3:
   case SEXP_OP_FCALL4:
+  case SEXP_OP_FCALLN:
     sexp_write_pointer(ctx, ((sexp*)ip)[0], out);
     sexp_write_char(ctx, ' ', out);
     sexp_write(ctx, sexp_opcode_name(((sexp*)ip)[0]), out);
diff --git a/tests/ffi/ffi-tests.scm b/tests/ffi/ffi-tests.scm
index f2607a16..b38860de 100644
--- a/tests/ffi/ffi-tests.scm
+++ b/tests/ffi/ffi-tests.scm
@@ -72,6 +72,36 @@ int sub(int x, int y) {
  (test -27 (cube -3))
  (test -3 (sub (zero) 3)))
 
+(test-ffi
+ "params"
+ (begin
+   (c-declare "
+int add4(int a, int b, int c, int d) {
+  return a+b+c+d;
+}
+int add5(int a, int b, int c, int d, int e) {
+  return a+b+c+d+e;
+}
+int add6(int a, int b, int c, int d, int e, int f) {
+  return a+b+c+d+e+f;
+}
+")
+   (define-c int add4 (int int int int))
+   (define-c int add5 (int int int int int))
+   (define-c int add6 (int int int int int int))
+   (define-c int (add3or4 "add4") (int int int (default 0 int)))
+   (define-c int (add4or5 "add5") (int int int int (default 0 int)))
+   (define-c int (add5or6 "add6") (int int int int int (default 0 int))))
+ (test 4321 (add4 1 20 300 4000))
+ (test 54321 (add5 1 20 300 4000 50000))
+ (test 654321 (add6 1 20 300 4000 50000 600000))
+ (test 321 (add3or4 1 20 300))
+ (test 4321 (add3or4 1 20 300 4000))
+ (test 4321 (add4or5 1 20 300 4000))
+ (test 54321 (add4or5 1 20 300 4000 50000))
+ (test 54321 (add5or6 1 20 300 4000 50000))
+ (test 654321 (add5or6 1 20 300 4000 50000 600000)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; More detailed tests on integer conversions and overflow.
 
diff --git a/vm.c b/vm.c
index f97ed0c7..fcc2f808 100644
--- a/vm.c
+++ b/vm.c
@@ -1300,7 +1300,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
     _ALIGN_IP();
     sexp_context_top(ctx) = top;
     sexp_context_last_fp(ctx) = fp;
-    i = sexp_opcode_num_args(_WORD0);
+    i = sexp_opcode_num_args(_WORD0) + sexp_opcode_variadic_p(_WORD0);
     tmp1 = sexp_fcall(ctx, self, i, _WORD0);
     sexp_fcall_return(tmp1, i-1)
     break;