diff --git a/src/tech/v3/datatype.clj b/src/tech/v3/datatype.clj index dd0a6351..09f1238e 100644 --- a/src/tech/v3/datatype.clj +++ b/src/tech/v3/datatype.clj @@ -503,7 +503,7 @@ user> (dtype/make-reader :float32 5 (* idx 2)) Options: - * `:resource-type` - defaults to `:gc` - maps to `:track-type` in `tech.v3.resource` + * `:resource-type` - defaults to `:gc` - maps to `:track-type` in `tech.v3.resource/track` but can also be set to nil in which case the data is not tracked this library will not clean it up. * `:uninitialized?` - do not initialize to zero. Use for perf in very very rare cases. diff --git a/src/tech/v3/datatype/ffi/jna.clj b/src/tech/v3/datatype/ffi/jna.clj index db449d0c..2b9c120f 100644 --- a/src/tech/v3/datatype/ffi/jna.clj +++ b/src/tech/v3/datatype/ffi/jna.clj @@ -205,113 +205,145 @@ :track-type :auto})) +(defn define-by-value-struct! + [classname ^Map defined-structs dtype] + (when-not (.containsKey defined-structs dtype) + (let [sname (str classname "$" (munge (name dtype))) + full-sname sname + sdef (dt-struct/get-struct-def dtype) + layout (->> (sdef :data-layout) + (mapv #(update % :datatype + (fn [dt] + (if (dt-struct/struct-datatype? dt) + (define-by-value-struct! classname defined-structs dt) + (argtype->insn classname :ptr-as-int + (dt-struct/datatype->host-type dt))))))) + by-value-symbol #(symbol (str classname "$" (munge (name %))))] + (.put defined-structs dtype + {:name sname + :flags #{:public :static} + :super Structure + :interfaces [Structure$ByValue] + :fields (mapv (fn [{:keys [name datatype offset n-elems]}] + (when-not (== 1 (long n-elems)) + (throw (RuntimeException. "Array properties not supported"))) + {:name (munge (clojure.core/name name)) + :type (if (dt-struct/struct-datatype? datatype) + (by-value-symbol datatype) + datatype) + :flags #{:public}}) + layout) + :methods [{:name "getFieldOrder" + :flags [:protected] + :desc [java.util.List] + :emit (concat + [[:ldc (count layout)] + [:anewarray String] + [:astore 1]] + (->> layout + (map-indexed (fn [idx {:keys [name]}] + (let [name (munge (clojure.core/name name))] + [[:aload 1] + [:ldc (int idx)] + [:ldc name] + [:aastore]]))) + (apply concat)) + [[:aload 1] + [:invokestatic java.util.Arrays 'asList [(type (object-array [])) java.util.List]] + [:areturn]])} + {:name :fromMap + :flags #{:public :static} + :desc [java.util.Map sname] + :emit (hamf/concatv + [[:new full-sname] + [:dup] + [:invokespecial full-sname :init [:void]] + [:astore 1]] + (mapcat (fn [{:keys [name datatype offset n-elems]}] + (let [oname (clojure.core/name name) + name (munge oname)] + (concat + [[:aload 1] + [:aload 0] + [:ldc oname] + [:invokestatic Keyword 'intern [String Keyword]] + [:invokeinterface java.util.Map 'get [Object Object]]] + ;;TODO nil check here - cannot pass byvalue a nil inner struct + (if (dt-struct/struct-datatype? datatype) + (let [bv-sym (by-value-symbol datatype)] + [[:checkcast java.util.Map] + [:invokestatic bv-sym 'fromMap [java.util.Map bv-sym]] + [:putfield full-sname name bv-sym]]) + (concat + (ffi-base/emit-obj->primitive-cast datatype) + [[:putfield full-sname name datatype]]))))) + layout) + [[:aload 1] + [:areturn]])} + {:name :toMap + :flags #{:public} + :desc [java.util.Map java.util.Map] + :emit (hamf/concatv + (mapcat (fn [{:keys [name datatype offset n-elems]}] + (let [oname (clojure.core/name name) + name (munge oname)] + (if (dt-struct/struct-datatype? datatype) + (let [bv-sym (by-value-symbol datatype)] + ;;In this case the passed in map should already have an entry for + ;;the struct definition so we have to call 'toMap on our field + ;;with the existing map in the outer map. + [[:aload 0] + [:getfield :this name bv-sym] + [:aload 1] + [:ldc oname] + [:invokestatic Keyword 'intern [String Keyword]] + [:invokeinterface java.util.Map 'get [Object Object]] + [:checkcast java.util.Map] + [:invokevirtual bv-sym 'toMap [java.util.Map java.util.Map]] + [:pop]]) + [[:aload 1] + [:ldc oname] + [:invokestatic Keyword 'intern [String Keyword]] + [:aload 0] + [:getfield :this name datatype] + [:invokestatic RT "box" [datatype Number]] + [:invokeinterface java.util.Map 'put [Object Object Object]]]))) + layout) + [[:aload 1] + [:areturn]])} + {:name :toStruct + :flags #{:public} + :desc [Object] + :emit [[:aload 0] + [:ldc (clojure.core/name dtype)] + [:invokestatic Keyword 'intern [String Keyword]] + [:invokestatic 'tech.v3.datatype.ffi.jna$new_struct 'invokeStatic + [Object Object]] + [:checkcast 'java.util.Map] + [:invokevirtual :this 'toMap [java.util.Map java.util.Map]] + [:areturn]]}]}))) + dtype) + + (defn emit-by-value-structs [classname fn-defs] - (let [defined-structs (hamf/java-hashmap)] - (->> (vals fn-defs) - (mapcat - (fn [{:keys [rettype argtypes]}] - (->> (concat [rettype] argtypes) - ;;by-value is indicated by a sequential container with two elements - (filter #(and (sequential? %) - (not (.get defined-structs (second %))))) - (mapv (fn [argtype] - (when-not (== 2 (count argtype)) - (throw (RuntimeException. (str "Unrecognized argument type: " argtype)))) - (when-not (= (first argtype) 'by-value) - (throw (RuntimeException. (str "Only 'by-value argument modifier allowed: " argtype)))) - (let [dtype (second argtype) - sname (str classname "$" (munge (name dtype))) - full-sname sname - sdef (dt-struct/get-struct-def dtype) - layout (->> (sdef :data-layout) - (mapv #(update % :datatype (fn [dt] - (argtype->insn classname :ptr-as-int - (dt-struct/datatype->host-type dt)))))) - retval - {:name sname - :flags #{:public :static} - :super Structure - :interfaces [Structure$ByValue] - :fields (mapv (fn [{:keys [name datatype offset n-elems]}] - (when-not (== 1 (long n-elems)) - (throw (RuntimeException. "Array properties not supported"))) - {:name (munge (clojure.core/name name)) - :type datatype - :flags #{:public}}) - layout) - :methods [{:name "getFieldOrder" - :flags [:protected] - :desc [java.util.List] - :emit (concat - [[:ldc (count layout)] - [:anewarray String] - [:astore 1]] - (->> layout - (map-indexed (fn [idx {:keys [name]}] - (let [name (munge (clojure.core/name name))] - [[:aload 1] - [:ldc (int idx)] - [:ldc name] - [:aastore]]))) - (apply concat)) - [[:aload 1] - [:invokestatic java.util.Arrays 'asList [(type (object-array [])) java.util.List]] - [:areturn]])} - {:name :fromMap - :flags #{:public :static} - :desc [java.util.Map sname] - :emit (concat - [[:new full-sname] - [:dup] - [:invokespecial full-sname :init [:void]] - [:astore 1]] - (mapcat (fn [{:keys [name datatype offset n-elems]}] - (let [oname (clojure.core/name name) - name (munge oname)] - (concat - [[:aload 1] - [:aload 0] - [:ldc oname] - [:invokestatic Keyword 'intern [String Keyword]] - [:invokeinterface java.util.Map 'get [Object Object]]] - (ffi-base/emit-obj->primitive-cast datatype) - [[:putfield full-sname name datatype]]))) - layout) - [[:aload 1] - [:areturn]])} - {:name :toMap - :flags #{:public} - :desc [java.util.Map java.util.Map] - :emit (concat - (mapcat (fn [{:keys [name datatype offset n-elems]}] - (let [oname (clojure.core/name name) - name (munge oname)] - [[:aload 1] - [:ldc oname] - [:invokestatic Keyword 'intern [String Keyword]] - [:aload 0] - [:getfield :this name datatype] - [:invokestatic RT "box" [datatype Number]] - [:invokeinterface java.util.Map 'put [Object Object Object]]])) - layout) - [[:aload 1] - [:areturn]])} - {:name :toStruct - :flags #{:public} - :desc [Object] - :emit [[:aload 0] - [:ldc (clojure.core/name dtype)] - [:invokestatic Keyword 'intern [String Keyword]] - [:invokestatic 'tech.v3.datatype.ffi.jna$new_struct 'invokeStatic - [Object Object]] - [:checkcast 'java.util.Map] - [:invokevirtual :this 'toMap [java.util.Map java.util.Map]] - [:areturn]]}]}] - (.put defined-structs dtype retval) - retval)))))) - ;;force errors right here - (vec)))) + (let [defined-structs (hamf/java-linked-hashmap)] + (reduce + (fn [acc {:keys [rettype argtypes]}] + (reduce (fn [acc argtype] + (when (sequential? argtype) + (when-not (== 2 (count argtype)) + (throw (RuntimeException. (str "Unrecognized argument type: " argtype)))) + (when-not (= (first argtype) 'by-value) + (throw (RuntimeException. (str "Only 'by-value argument modifier allowed: " argtype)))) + (define-by-value-struct! classname defined-structs (second argtype)))) + nil + (concat [rettype] argtypes))) + nil + (vals fn-defs)) + #_(println "by-value structs:\n" (with-out-str + (clojure.pprint/pprint (vec (.values defined-structs))))) + (.values defined-structs))) (defn define-jna-library diff --git a/test/cpp/.gitignore b/test/cpp/.gitignore new file mode 100644 index 00000000..7951377b --- /dev/null +++ b/test/cpp/.gitignore @@ -0,0 +1,2 @@ +byvalue +libffi_test* \ No newline at end of file diff --git a/test/cpp/build.sh b/test/cpp/build.sh new file mode 100755 index 00000000..d5dbace4 --- /dev/null +++ b/test/cpp/build.sh @@ -0,0 +1,4 @@ +#!/bin/bash + +gcc -shared -fPIC -rdynamic -o libffi_test.so ffi_test_lib.c +g++ test_byvalue.cpp -L./ -lffi_test -o byvalue diff --git a/test/cpp/byvalue_nested.h b/test/cpp/byvalue_nested.h new file mode 100644 index 00000000..d687952b --- /dev/null +++ b/test/cpp/byvalue_nested.h @@ -0,0 +1,13 @@ +typedef struct { + int abcd; + struct { + int a; + double b; + } first_struct; + struct { + double c; + int d; + } second_struct; +} ByValue; + +extern const char* byvalue_nested(ByValue bv); diff --git a/test/cpp/ffi_test_lib.c b/test/cpp/ffi_test_lib.c new file mode 100644 index 00000000..c20e3ffe --- /dev/null +++ b/test/cpp/ffi_test_lib.c @@ -0,0 +1,13 @@ +#include +#include "byvalue_nested.h" + + +char json_buffer[1024] = { 0 }; + + +const char* byvalue_nested(ByValue bv) { + snprintf(json_buffer,1024,"{\"abcd\":%d \"a\":%d \"b\":%lf \"c\":%lf \"d\":%d}", bv.abcd, + bv.first_struct.a, bv.first_struct.b, + bv.second_struct.c, bv.second_struct.d); + return json_buffer; +} diff --git a/test/cpp/test_byvalue.cpp b/test/cpp/test_byvalue.cpp new file mode 100644 index 00000000..f647f207 --- /dev/null +++ b/test/cpp/test_byvalue.cpp @@ -0,0 +1,13 @@ +#include +extern "C" { +#include "byvalue_nested.h" +} + +using namespace std; + + +int main (int c, char** v) { + ByValue bc = { 10, { 5, 4.0 }, {3.0, 9}}; + printf("%s\n", byvalue_nested(bc)); + return 0; +} diff --git a/test/tech/v3/datatype/ffi_test.clj b/test/tech/v3/datatype/ffi_test.clj index 501d5d82..1c92e30d 100644 --- a/test/tech/v3/datatype/ffi_test.clj +++ b/test/tech/v3/datatype/ffi_test.clj @@ -7,7 +7,8 @@ [tech.v3.datatype.native-buffer :as native-buffer] [tech.v3.datatype.nio-buffer] [clojure.test :refer [deftest is]] - [clojure.tools.logging :as log]) + [clojure.tools.logging :as log] + [clojure.data.json :as json]) (:import [tech.v3.datatype.ffi Pointer])) @@ -68,12 +69,51 @@ (dt-ffi/set-ffi-impl! :jna) (generic-define-library)) +(defn nested-byvalue + [] + (let [anon1 (dt-struct/define-datatype! :anon1 [{:name :a :datatype :int32} + {:name :b :datatype :float64}]) + anon2 (dt-struct/define-datatype! :anon2 [{:name :c :datatype :float64} + {:name :d :datatype :int32}]) + bv-type (dt-struct/define-datatype! :by-value [{:name :abcd :datatype :int32} + {:name :first-struct :datatype :anon1} + {:name :second-struct :datatype :anon2}]) + bv (dt-struct/new-struct :by-value {:container-type :native-heap}) + ^java.util.Map a1 (get bv :first-struct) + ^java.util.Map a2 (get bv :second-struct) + _ (do + (.put bv :abcd 10) + (.put a1 :a 5) + (.put a1 :b 4.0) + (.put a2 :c 3.0) + (.put a2 :d 9)) + bv-lib-def (dt-ffi/define-library + ;;function definitions + {:byvalue_nested {:rettype :pointer + :argtypes [[bv '(by-value :by-value)]]}} + nil nil) + lib (dt-ffi/instantiate-library bv-lib-def (str (System/getProperty "user.dir") + "/test/cpp/libffi_test.so")) + lib-fns @lib + test-fn (get lib-fns :byvalue_nested) + answer (test-fn bv)] + (is (= {"abcd" 10, "a" 5, "b" 4.0, "c" 3.0, "d" 9} + (json/read-str answer))))) + +(comment + (nested-byvalue) + ) + +(deftest jna-byvalue-test + (dt-ffi/set-ffi-impl! :jna) + (nested-byvalue)) + (if (dt-ffi/jdk-ffi?) (deftest mmodel-ffi-test (dt-ffi/set-ffi-impl! :jdk-21) (generic-define-library)) - (log/warn "JDK-16 FFI pathway not tested.")) + (log/warn "JDK-21 FFI pathway not tested.")) (deftest library-instance-test