Fix FFI for reference return values and stack parameter passing.

examples/ffi/so.c

@@ -43,6 +43,31 @@ double double_lots(
     return i + j;
 }
 
+
+EXPORTER
+double double_lots_2(
+    double a,
+    double b,
+    double c,
+    double d,
+    double e,
+    double f,
+    double g,
+    double h,
+    double i,
+    double j) {
+    return a +
+        10.0 * b +
+        100.0 * c +
+        1000.0 * d +
+        10000.0 * e +
+        100000.0 * f +
+        1000000.0 * g +
+        10000000.0 * h +
+        100000000.0 * i +
+        1000000000.0 * j;
+}
+
 EXPORTER
 double float_fn(float x, float y, float z) {
     return (x + y) * z;

examples/ffi/test.janet

@@ -9,71 +9,40 @@
 (if is-windows
   (os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
   (os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
-(def module (ffi/native ffi/loc))
 
-(def int-fn-sig (ffi/signature :default :int :int :int))
+(ffi/context ffi/loc)
-(def int-fn-pointer (ffi/lookup module "int_fn"))
-(defn int-fn
-  [x y]
-  (ffi/call int-fn-pointer int-fn-sig x y))
-
-(def double-fn-sig (ffi/signature :default :double :double :double :double))
-(def double-fn-pointer (ffi/lookup module "double_fn"))
-(defn double-fn
-  [x y z]
-  (ffi/call double-fn-pointer double-fn-sig x y z))
-
-(def double-many-sig (ffi/signature :default :double :double :double :double :double :double :double))
-(def double-many-pointer (ffi/lookup module "double_many"))
-(defn double-many
-  [x y z w a b]
-  (ffi/call double-many-pointer double-many-sig x y z w a b))
-
-(def double-lots-sig (ffi/signature :default :double
-                                    :double :double :double :double :double
-                                    :double :double :double :double :double))
-(def double-lots-pointer (ffi/lookup module "double_lots"))
-(defn double-lots
-  [a b c d e f g h i j]
-  (ffi/call double-lots-pointer double-lots-sig a b c d e f g h i j))
-
-(def float-fn-sig (ffi/signature :default :double :float :float :float))
-(def float-fn-pointer (ffi/lookup module "float_fn"))
-(defn float-fn
-  [x y z]
-  (ffi/call float-fn-pointer float-fn-sig x y z))
-
-(def intint-fn-sig (ffi/signature :default :int :double [:int :int]))
-(def intint-fn-pointer (ffi/lookup module "intint_fn"))
-(defn intint-fn
-  [x ii]
-  (ffi/call intint-fn-pointer intint-fn-sig x ii))
-
-(def return-struct-sig (ffi/signature :default [:int :int] :int))
-(def return-struct-pointer (ffi/lookup module "return_struct"))
-(defn return-struct-fn
-  [i]
-  (ffi/call return-struct-pointer return-struct-sig i))
 
 (def intintint (ffi/struct :int :int :int))
-(def intintint-fn-sig (ffi/signature :default :int :double intintint))
-(def intintint-fn-pointer (ffi/lookup module "intintint_fn"))
-(defn intintint-fn
-  [x iii]
-  (ffi/call intintint-fn-pointer intintint-fn-sig x iii))
-
 (def big (ffi/struct :s64 :s64 :s64))
-(def struct-big-fn-sig (ffi/signature :default big :int :double))
-(def struct-big-fn-pointer (ffi/lookup module "struct_big"))
-(defn struct-big-fn
-  [i d]
-  (ffi/call struct-big-fn-pointer struct-big-fn-sig i d))
 
-(def void-fn-pointer (ffi/lookup module "void_fn"))
+(ffi/defbind int-fn :int [a :int b :int])
-(def void-fn-sig (ffi/signature :default :void))
+(ffi/defbind double-fn :double [a :double b :double c :double])
-(defn void-fn
+(ffi/defbind double-many :double
-  []
+  [x :double y :double z :double w :double a :double b :double])
-  (ffi/call void-fn-pointer void-fn-sig))
+(ffi/defbind double-lots :double
+  [a :double b :double c :double d :double e :double f :double g :double h :double i :double j :double])
+(ffi/defbind float-fn :double
+  [x :float y :float z :float])
+(ffi/defbind intint-fn :int
+  [x :double ii [:int :int]])
+(ffi/defbind return-struct [:int :int]
+  [i :int])
+(ffi/defbind intintint-fn :int
+  [x :double iii intintint])
+(ffi/defbind struct-big big
+  [i :int d :double])
+(ffi/defbind void-fn :void [])
+(ffi/defbind double-lots-2 :double
+  [a :double
+   b :double
+   c :double
+   d :double
+   e :double
+   f :double
+   g :double
+   h :double
+   i :double
+   j :double])
 
 #
 # Struct reading and writing
@@ -115,21 +84,25 @@
 # Call functions
 #
 
-(pp (void-fn))
+(tracev (double-many 1 2 3 4 5 6))
-(pp (int-fn 10 20))
+(tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
-(pp (double-fn 1.5 2.5 3.5))
+(tracev (type (double-many 1 2 3 4 5 6)))
-(pp (double-many 1 2 3 4 5 6))
+(tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
-(pp (double-lots 1 2 3 4 5 6 7 8 9 10))
+(tracev (void-fn))
-(pp (float-fn 8 4 17))
+(tracev (int-fn 10 20))
-(pp (intint-fn 123.456 [10 20]))
+(tracev (double-fn 1.5 2.5 3.5))
-(pp (intintint-fn 123.456 [10 20 30]))
+(tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
-(pp (return-struct-fn 42))
+(tracev (float-fn 8 4 17))
-(pp (double-lots 1 2 3 4 5 6 700 800 9 10))
+(tracev (intint-fn 123.456 [10 20]))
-#(pp (struct-big-fn 11 99.5))
+(tracev (intintint-fn 123.456 [10 20 30]))
+(tracev (return-struct 42))
+(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
+(tracev (struct-big 11 99.5))
 
+(assert (= 9876543210 (double-lots-2 0 1 2 3 4 5 6 7 8 9)))
 (assert (= 60 (int-fn 10 20)))
 (assert (= 42 (double-fn 1.5 2.5 3.5)))
-#(assert (= 21 (double-many 1 2 3 4 5 6)))
+(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
 (assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
 (assert (= 204 (float-fn 8 4 17)))
 

src/boot/boot.janet

@@ -3671,6 +3671,7 @@
   (defmacro ffi/defbind
     "Generate bindings for native functions in a convenient manner."
     [name ret-type & body]
+    (def real-ret-type (eval ret-type))
     (def meta (slice body 0 -2))
     (def arg-pairs (partition 2 (last body)))
     (def formal-args (map 0 arg-pairs))
@@ -3682,7 +3683,7 @@
           :map-symbols ms} (assert (dyn *ffi-context*) "no ffi context found"))
     (def raw-symbol (ms name))
     (defn make-sig []
-      (ffi/signature :default ret-type ;computed-type-args))
+      (ffi/signature :default real-ret-type ;computed-type-args))
     (defn make-ptr []
       (assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
     (if lazy

src/core/ffi.c

@@ -702,8 +702,6 @@ JANET_CORE_FN(cfun_ffi_signature,
                     mappings[i].offset = next_register;
                     if (is_register_sized) {
                         mappings[i].spec = JANET_WIN64_REGISTER;
-
-                        /* Select variant based on position of floating point arguments */
                         if (mappings[i].type.prim == JANET_FFI_TYPE_FLOAT ||
                                 mappings[i].type.prim == JANET_FFI_TYPE_DOUBLE) {
                             variant += 1 << (3 - next_register);
@@ -729,21 +727,16 @@ JANET_CORE_FN(cfun_ffi_signature,
                 }
             }
 
-            /* Take into account reference arguments and align to 16 bytes just in case */
+            /* Add reference items */
+            size_t old_stack_count = stack_count;
             stack_count += 2 * ref_stack_count;
-            if (stack_count & 1) {
+            if (stack_count & 0x1) {
                 stack_count++;
             }
 
             /* Invert stack
              * Offsets are in units of 8-bytes */
             for (uint32_t i = 0; i < arg_count; i++) {
-                uint32_t old_offset = mappings[i].offset;
-                if (mappings[i].spec == JANET_WIN64_STACK) {
-                    mappings[i].offset = stack_count - 1 - old_offset;
-                } else if (mappings[i].spec == JANET_WIN64_STACK_REF) {
-                    mappings[i].offset = stack_count - 1 - old_offset;
-                }
                 if (mappings[i].spec == JANET_WIN64_STACK_REF || mappings[i].spec == JANET_WIN64_REGISTER_REF) {
                     /* Align size to 16 bytes */
                     size_t size = (type_size(mappings[i].type) + 15) & ~0xFUL;
@@ -962,11 +955,12 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
     } ret_reg;
     JanetFFIWordSpec ret_spec = signature->ret.spec;
     void *ret_mem = &ret_reg.integer;
-    if (ret_spec == JANET_WIN64_STACK) {
+    if (ret_spec == JANET_WIN64_REGISTER_REF) {
         ret_mem = alloca(type_size(signature->ret.type));
         regs[0].integer = (uint64_t) ret_mem;
     }
     uint64_t *stack = alloca(signature->stack_count * 8);
+    stack -= 2; /* hack to get proper stack placement */
     for (uint32_t i = 0; i < signature->arg_count; i++) {
         int32_t n = i + 2;
         JanetFFIMapping arg = signature->args[i];
@@ -985,7 +979,6 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
         }
     }
 
-    /* the seasoned programmer who cut their teeth on assembly is probably quietly shaking their head by now... */
     switch (signature->variant) {
         default:
             janet_panicf("unknown variant %d", signature->variant);