luciano/coffi
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add suppoort for native array write functions

Browse source
This commit is contained in:
Kristin Rutenkolk 2024-12-19 16:11:00 +01:00
parent e648c26a25
commit f3f156c53a
1 changed files with 33 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
src/clj/coffi/mem.clj
View file

@ -689,13 +689,13 @@
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
value# ~value] value# ~value]
(MemorySegment/copy value# 0 segment# ^ValueLayout$OfShort short-layout ^long offset ^int (alength value#)))) (MemorySegment/copy value# 0 segment# ^ValueLayout$OfShort short-layout ^long offset# ^int (alength value#))))
([segment offset byte-order value] ([segment offset byte-order value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
byte-order# ~byte-order byte-order# ~byte-order
value# ~value] value# ~value]
(MemorySegment/copy value# 0 segment# (.withOrder ^ValueLayout$OfShort short-layout ^ByteOrder byte-order#) ^long offset ^int (alength value#)))))} (MemorySegment/copy value# 0 segment# (.withOrder ^ValueLayout$OfShort short-layout ^ByteOrder byte-order#) ^long offset# ^int (alength value#)))))}
([^MemorySegment segment ^shorts value] ([^MemorySegment segment ^shorts value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfShort short-layout 0 (alength value))) (MemorySegment/copy value 0 segment ^ValueLayout$OfShort short-layout 0 (alength value)))
([^MemorySegment segment ^long offset ^shorts value] ([^MemorySegment segment ^long offset ^shorts value]
@ -712,20 +712,20 @@
([segment value] ([segment value]
`(let [segment# ~segment `(let [segment# ~segment
value# ~value] value# ~value]
(MemorySegment/copy value# 0 segment# ^ValueLayout$OfInt int-layout 0 ^int (alength value#)) (MemorySegment/copy value# 0 segment# ^ValueLayout$OfInt int-layout 0 ^{:tag 'int} (alength value#))
)) ))
([segment offset value] ([segment offset value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
value# ~value] value# ~value]
(MemorySegment/copy value# 0 segment# ^ValueLayout$OfInt int-layout ^long offset ^int (alength value#)) (MemorySegment/copy value# 0 segment# ^ValueLayout$OfInt int-layout ^long offset# ^{:tag 'int} (alength value#))
)) ))
([segment offset byte-order value] ([segment offset byte-order value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
byte-order# ~byte-order byte-order# ~byte-order
value# ~value] value# ~value]
(MemorySegment/copy value# 0 segment# (.withOrder ^ValueLayout$OfInt int-layout ^ByteOrder byte-order#) ^long offset ^int (alength value#)))))} (MemorySegment/copy value# 0 segment# (.withOrder ^ValueLayout$OfInt int-layout ^ByteOrder byte-order#) ^long offset# ^{:tag 'int} (alength value#)))))}
([^MemorySegment segment ^ints value] ([^MemorySegment segment ^ints value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfInt int-layout 0 (alength value))) (MemorySegment/copy value 0 segment ^ValueLayout$OfInt int-layout 0 (alength value)))
([^MemorySegment segment ^long offset ^ints value] ([^MemorySegment segment ^long offset ^ints value]
@ -742,20 +742,20 @@
([segment value] ([segment value]
`(let [segment# ~segment `(let [segment# ~segment
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfLong long-layout 0 ^int (alength value#)) (MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfLong long-layout 0 ^{:tag 'int} (alength value#))
)) ))
([segment offset value] ([segment offset value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfLong long-layout ^long offset ^int (alength value#)) (MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfLong long-layout ^long offset# ^{:tag 'int} (alength value#))
)) ))
([segment offset byte-order value] ([segment offset byte-order value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
byte-order# ~byte-order byte-order# ~byte-order
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# (.withOrder ^ValueLayout$OfLong long-layout ^ByteOrder byte-order#) ^long offset ^int (alength value#)))))} (MemorySegment/copy value# 0 ^MemorySegment segment# (.withOrder ^ValueLayout$OfLong long-layout ^ByteOrder byte-order#) ^long offset# ^{:tag 'int} (alength value#)))))}
([^MemorySegment segment ^longs value] ([^MemorySegment segment ^longs value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfLong long-layout 0 ^int (alength value))) (MemorySegment/copy value 0 segment ^ValueLayout$OfLong long-layout 0 ^int (alength value)))
([^MemorySegment segment ^long offset ^longs value] ([^MemorySegment segment ^long offset ^longs value]
@ -773,18 +773,18 @@
([segment value] ([segment value]
`(let [segment# ~segment `(let [segment# ~segment
value# ~value] value# ~value]
(MemorySegment/copy (bytes (byte-array (map unchecked-int value#))) 0 segment# ^ValueLayout$OfChar char-layout 0 ^int (alength value#)))) (MemorySegment/copy (bytes (byte-array (map unchecked-int value#))) 0 segment# ^ValueLayout$OfChar char-layout 0 ^{:tag 'int} (alength value#))))
([segment offset value] ([segment offset value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
value# ~value] value# ~value]
(MemorySegment/copy (bytes (byte-array (map unchecked-int value#))) 0 segment# ^ValueLayout$OfChar char-layout ^long offset ^int (alength value#)))) (MemorySegment/copy (bytes (byte-array (map unchecked-int value#))) 0 segment# ^ValueLayout$OfChar char-layout ^long offset# ^{:tag 'int} (alength value#))))
([segment offset byte-order value] ([segment offset byte-order value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
byte-order# ~byte-order byte-order# ~byte-order
value# ~value] value# ~value]
(MemorySegment/copy (bytes (byte-array (map unchecked-int value#))) 0 segment# (.withOrder ^ValueLayout$OfChar char-layout ^ByteOrder byte-order#) ^long offset ^int (alength value#)))))} (MemorySegment/copy (bytes (byte-array (map unchecked-int value#))) 0 segment# (.withOrder ^ValueLayout$OfChar char-layout ^ByteOrder byte-order#) ^long offset# ^{:tag 'int} (alength value#)))))}
([^MemorySegment segment ^chars value] ([^MemorySegment segment ^chars value]
(MemorySegment/copy (bytes (byte-array (map unchecked-int value))) 0 segment ^ValueLayout$OfChar char-layout 0 (alength value))) (MemorySegment/copy (bytes (byte-array (map unchecked-int value))) 0 segment ^ValueLayout$OfChar char-layout 0 (alength value)))
([^MemorySegment segment ^long offset ^chars value] ([^MemorySegment segment ^long offset ^chars value]
@ -801,20 +801,20 @@
([segment value] ([segment value]
`(let [segment# ~segment `(let [segment# ~segment
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfFloat float-layout 0 ^int (alength value#)) (MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfFloat float-layout 0 ^{:tag 'int} (alength value#))
)) ))
([segment offset value] ([segment offset value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfFloat float-layout ^long offset ^int (alength value#)) (MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfFloat float-layout ^long offset# ^{:tag 'int} (alength value#))
)) ))
([segment offset byte-order value] ([segment offset byte-order value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
byte-order# ~byte-order byte-order# ~byte-order
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# (.withOrder ^ValueLayout$OfFloat float-layout ^ByteOrder byte-order#) ^long offset ^int (alength value#)))))} (MemorySegment/copy value# 0 ^MemorySegment segment# (.withOrder ^ValueLayout$OfFloat float-layout ^ByteOrder byte-order#) ^long offset# ^{:tag 'int} (alength value#)))))}
([^MemorySegment segment ^floats value] ([^MemorySegment segment ^floats value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfFloat float-layout 0 ^int (alength value))) (MemorySegment/copy value 0 segment ^ValueLayout$OfFloat float-layout 0 ^int (alength value)))
([^MemorySegment segment ^long offset ^floats value] ([^MemorySegment segment ^long offset ^floats value]
@ -831,20 +831,20 @@
([segment value] ([segment value]
`(let [segment# ~segment `(let [segment# ~segment
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfDouble double-layout 0 ^int (alength value#)) (MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfDouble double-layout 0 ^{:tag 'int} (alength value#))
)) ))
([segment offset value] ([segment offset value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfDouble double-layout ^long offset ^int (alength value#)) (MemorySegment/copy value# 0 ^MemorySegment segment# ^ValueLayout$OfDouble double-layout ^long offset# ^{:tag 'int} (alength value#))
)) ))
([segment offset byte-order value] ([segment offset byte-order value]
`(let [segment# ~segment `(let [segment# ~segment
offset# ~offset offset# ~offset
byte-order# ~byte-order byte-order# ~byte-order
value# ~value] value# ~value]
(MemorySegment/copy value# 0 ^MemorySegment segment# (.withOrder ^ValueLayout$OfDouble double-layout ^ByteOrder byte-order#) ^long offset ^int (alength value#)))))} (MemorySegment/copy value# 0 ^MemorySegment segment# (.withOrder ^ValueLayout$OfDouble double-layout ^ByteOrder byte-order#) ^long offset# ^{:tag 'int} (alength value#)))))}
([^MemorySegment segment ^doubles value] ([^MemorySegment segment ^doubles value]
(MemorySegment/copy value 0 segment ^ValueLayout$OfDouble double-layout 0 ^int (alength value))) (MemorySegment/copy value 0 segment ^ValueLayout$OfDouble double-layout 0 ^int (alength value)))
([^MemorySegment segment ^long offset ^doubles value] ([^MemorySegment segment ^long offset ^doubles value]
@ -1607,6 +1607,15 @@
_type _type
`object-array)) `object-array))
(defn- coffitype->array-write-fn [_type]
({:coffi.mem/byte `write-bytes
:coffi.mem/short `write-shorts
:coffi.mem/int `write-ints
:coffi.mem/long `write-longs
:coffi.mem/char `write-chars
:coffi.mem/float `write-floats
:coffi.mem/double `write-doubles} _type))
(defmulti generate-deserialize (fn [& xs] (if (vector? (first xs)) (first (first xs)) (first xs)))) (defmulti generate-deserialize (fn [& xs] (if (vector? (first xs)) (first (first xs)) (first xs))))
(defmethod generate-deserialize :coffi.mem/byte [_type offset segment-source-form] `(read-byte ~segment-source-form ~offset)) (defmethod generate-deserialize :coffi.mem/byte [_type offset segment-source-form] `(read-byte ~segment-source-form ~offset))
@ -1655,12 +1664,13 @@
(defmethod generate-serialize :coffi.mem/c-string [_type source-form offset segment-source-form] `(write-address ~segment-source-form ~offset (.allocateFrom (Arena/ofAuto) ~source-form))) (defmethod generate-serialize :coffi.mem/c-string [_type source-form offset segment-source-form] `(write-address ~segment-source-form ~offset (.allocateFrom (Arena/ofAuto) ~source-form)))
(defmethod generate-serialize :coffi.mem/array [[_arr member-type length & {:keys [raw?]}] source-form offset segment-source-form] (defmethod generate-serialize :coffi.mem/array [[_arr member-type length & {:keys [raw?]}] source-form offset segment-source-form]
(let [obj (gensym 'src-array)] (if (and raw? (coffitype->array-write-fn member-type))
(concat (list (coffitype->array-write-fn member-type) segment-source-form offset source-form)
(list `let [obj source-form]) (let [obj (gensym 'src-array)]
(map (concat
#(generate-serialize member-type (list (if raw? `aget `nth) obj %) (+ offset (* (size-of member-type) %)) segment-source-form) (list `let [obj source-form])
(range length))))) (map #(generate-serialize member-type (list (if raw? `aget `nth) obj %) (+ offset (* (size-of member-type) %)) segment-source-form)
(range length))))))
(defn register-new-struct-serialization [typename [_struct fields]] (defn register-new-struct-serialization [typename [_struct fields]]
(let [typelist (typelist typename fields) (let [typelist (typelist typename fields)