mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-25 01:37:19 +00:00
Code Issues 1 Releases Wiki Activity

Fix FFI for reference return values and stack parameter passing.

Browse Source
This commit is contained in:
bakpakin 2022-08-14 15:20:30 -05:00
parent f8a9efa8e4
commit 9a6d2a7b32
4 changed files with 77 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
examples/ffi/so.c
View File

@ -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;

117
examples/ffi/test.janet
View File

@ -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))
(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))
(ffi/context ffi/loc)
(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"))
(def void-fn-sig (ffi/signature :default :void))
(defn void-fn
[]
(ffi/call void-fn-pointer void-fn-sig))
(ffi/defbind int-fn :int [a :int b :int])
(ffi/defbind double-fn :double [a :double b :double c :double])
(ffi/defbind double-many :double
[x :double y :double z :double w :double a :double b :double])
(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))
(pp (int-fn 10 20))
(pp (double-fn 1.5 2.5 3.5))
(pp (double-many 1 2 3 4 5 6))
(pp (double-lots 1 2 3 4 5 6 7 8 9 10))
(pp (float-fn 8 4 17))
(pp (intint-fn 123.456 [10 20]))
(pp (intintint-fn 123.456 [10 20 30]))
(pp (return-struct-fn 42))
(pp (double-lots 1 2 3 4 5 6 700 800 9 10))
#(pp (struct-big-fn 11 99.5))
(tracev (double-many 1 2 3 4 5 6))
(tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
(tracev (type (double-many 1 2 3 4 5 6)))
(tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
(tracev (void-fn))
(tracev (int-fn 10 20))
(tracev (double-fn 1.5 2.5 3.5))
(tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
(tracev (float-fn 8 4 17))
(tracev (intint-fn 123.456 [10 20]))
(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)))

3
src/boot/boot.janet
View File

@ -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

17
src/core/ffi.c
View File

@ -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);