(def native-loc "ffitest/so.so") (def native-source-loc "ffitest/so.c") (os/execute ["cc" native-source-loc "-shared" "-o" native-loc] :px) (def module (raw-native native-loc)) (def int-fn-sig (native-signature :default :int :int :int)) (def int-fn-pointer (native-lookup module "int_fn")) (defn int-fn [x y] (native-call int-fn-pointer int-fn-sig x y)) (def double-fn-sig (native-signature :default :double :double :double :double)) (def double-fn-pointer (native-lookup module "double_fn")) (defn double-fn [x y z] (native-call double-fn-pointer double-fn-sig x y z)) (def double-many-sig (native-signature :default :double :double :double :double :double :double :double)) (def double-many-pointer (native-lookup module "double_many")) (defn double-many [x y z w a b] (native-call double-many-pointer double-many-sig x y z w a b)) (def double-lots-sig (native-signature :default :double :double :double :double :double :double :double :double :double :double :double)) (def double-lots-pointer (native-lookup module "double_lots")) (defn double-lots [a b c d e f g h i j] (native-call double-lots-pointer double-lots-sig a b c d e f g h i j)) (def float-fn-sig (native-signature :default :double :float :float :float)) (def float-fn-pointer (native-lookup module "float_fn")) (defn float-fn [x y z] (native-call float-fn-pointer float-fn-sig x y z)) (def intint-fn-sig (native-signature :default :int :double [:int :int])) (def intint-fn-pointer (native-lookup module "intint_fn")) (defn intint-fn [x ii] (native-call intint-fn-pointer intint-fn-sig x ii)) (def return-struct-sig (native-signature :default [:int :int] :int)) (def return-struct-pointer (native-lookup module "return_struct")) (defn return-struct-fn [i] (native-call return-struct-pointer return-struct-sig i)) (def intintint (native-struct :int :int :int)) (def intintint-fn-sig (native-signature :default :int :double intintint)) (def intintint-fn-pointer (native-lookup module "intintint_fn")) (defn intintint-fn [x iii] (native-call intintint-fn-pointer intintint-fn-sig x iii)) (def big (native-struct :s64 :s64 :s64)) (def struct-big-fn-sig (native-signature :default big :int :double)) (def struct-big-fn-pointer (native-lookup module "struct_big")) (defn struct-big-fn [i d] (native-call struct-big-fn-pointer struct-big-fn-sig i d)) (def void-fn-pointer (native-lookup module "void_fn")) (def void-fn-sig (native-signature :default :void)) (defn void-fn [] (native-call void-fn-pointer void-fn-sig)) # # 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 (struct-big-fn 11 99.5)) (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 (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10))) (assert (= 204 (float-fn 8 4 17))) # # Struct reading and writing # (defn check-round-trip [t value] (def buf (native-write t value)) (def same-value (native-read t buf)) (assert (deep= value same-value) (string/format "round trip %j (got %j)" value same-value))) (check-round-trip :bool true) (check-round-trip :bool false) (check-round-trip :void nil) (check-round-trip :void nil) (check-round-trip :s8 10) (check-round-trip :s8 0) (check-round-trip :s8 -10) (check-round-trip :u8 10) (check-round-trip :u8 0) (check-round-trip :s16 10) (check-round-trip :s16 0) (check-round-trip :s16 -12312) (check-round-trip :u16 10) (check-round-trip :u16 0) (check-round-trip :u32 0) (check-round-trip :u32 10) (check-round-trip :u32 0xFFFF7777) (check-round-trip :s32 0x7FFF7777) (check-round-trip :s32 0) (check-round-trip :s32 -1234567) (def s (native-struct :s8 :s8 :s8 :float)) (check-round-trip s [1 3 5 123.5]) (check-round-trip s [-1 -3 -5 -123.5]) (print "Done.")