diff --git a/build.clj b/build.clj index f7f3796..48622c7 100644 --- a/build.clj +++ b/build.clj @@ -53,8 +53,8 @@ (b/process {:command-args ["javac" "--enable-preview" "src/java/coffi/ffi/Loader.java" "-d" class-dir - "-target" "19" - "-source" "19"]})] + "-target" "22" + "-source" "22"]})] (when-not (zero? (:exit compilation-result)) (b/delete {:path class-dir}))) opts) diff --git a/deps.edn b/deps.edn index d0e1469..a6c2599 100644 --- a/deps.edn +++ b/deps.edn @@ -1,6 +1,6 @@ {:paths ["src/clj" "target/classes" "resources"] :deps {org.clojure/clojure {:mvn/version "1.11.1"} - insn/insn {:mvn/version "0.2.1"}} + insn/insn {:mvn/version "0.5.4"}} :deps/prep-lib {:alias :build :fn build/compile-java diff --git a/src/clj/coffi/ffi.clj b/src/clj/coffi/ffi.clj index 371aeef..365fa10 100644 --- a/src/clj/coffi/ffi.clj +++ b/src/clj/coffi/ffi.clj @@ -14,10 +14,9 @@ MethodHandles MethodType) (java.lang.foreign - Addressable Linker + Linker$Option FunctionDescriptor - MemoryAddress MemoryLayout MemorySegment SegmentAllocator))) @@ -56,7 +55,8 @@ (defn- downcall-handle "Gets the [[MethodHandle]] for the function at the `sym`." [sym function-descriptor] - (.downcallHandle (Linker/nativeLinker) sym function-descriptor)) + (.downcallHandle (Linker/nativeLinker) sym function-descriptor + (make-array Linker$Option 0))) (def ^:private load-instructions "Mapping from primitive types to the instruction used to load them onto the stack." @@ -130,20 +130,12 @@ [:invokevirtual (prim-classes prim-type) (unbox-fn-for-type prim-type) [prim]]] [])))) -(defn- coerce-addressable - "If the passed `type` is [[MemoryAddress]], returns [[Addressable]], otherwise returns `type`. - - This is used to declare the return types of upcall stubs." - [type] - (if (= type MemoryAddress) - Addressable - type)) - (defn- downcall-class "Class definition for an implementation of [[IFn]] which calls a closed over method handle without reflection, unboxing primitives when needed." [args ret] {:flags #{:public :final} + :version 8 :super clojure.lang.AFunction :fields [{:name "downcall_handle" :type MethodHandle @@ -175,7 +167,7 @@ args) [:invokevirtual MethodHandle "invokeExact" (cond->> - (conj (mapv (comp coerce-addressable insn-layout) args) + (conj (mapv insn-layout args) (insn-layout ret)) (not (mem/primitive-type ret)) (cons SegmentAllocator))] (to-object-asm ret) @@ -300,7 +292,7 @@ ;; cast null pointers to something understood by panama (#{::mem/pointer} type) - `(or ~sym (MemoryAddress/NULL)) + `(or ~sym (MemorySegment/NULL)) (mem/primitive-type type) `(mem/serialize* ~sym ~type-sym ~session) @@ -343,7 +335,7 @@ ;; taking restargs, and so the downcall must be applied (-> `(~@(when (symbol? args) [`apply]) ~downcall-sym - ~@(when allocator? [`(mem/session-allocator ~session)]) + ~@(when allocator? [`(mem/arena-allocator ~session)]) ~@(if (symbol? args) [args] args)) @@ -410,7 +402,7 @@ (fn native-fn [& args] (with-open [session (mem/stack-session)] (mem/deserialize-from - (apply downcall (mem/session-allocator session) + (apply downcall (mem/arena-allocator session) (map #(mem/serialize %1 %2 session) args arg-types)) ret-type))))) @@ -435,6 +427,7 @@ If your `args` and `ret` are constants, then it is more efficient to call [[make-downcall]] followed by [[make-serde-wrapper]] because the latter has an inline definition which will result in less overhead from serdes." + ;; TODO(Joshua): Add an inline arity for when the args and ret types are constant [symbol args ret] (-> symbol (make-downcall args ret) @@ -474,6 +467,7 @@ boxes any primitives passed to it and calls a closed over [[IFn]]." [arg-types ret-type] {:flags #{:public :final} + :version 8 :fields [{:name "upcall_ifn" :type IFn :flags #{:final}}] @@ -489,7 +483,7 @@ {:name :upcall :flags #{:public} :desc (conj (mapv insn-layout arg-types) - (coerce-addressable (insn-layout ret-type))) + (insn-layout ret-type)) :emit [[:aload 0] [:getfield :this "upcall_ifn" IFn] (loop [types arg-types @@ -505,7 +499,7 @@ inc))) acc)) [:invokeinterface IFn "invoke" (repeat (inc (count arg-types)) Object)] - (to-prim-asm (coerce-addressable ret-type)) + (to-prim-asm ret-type) [(return-for-type ret-type :areturn)]]}]}) (defn- upcall @@ -518,7 +512,7 @@ ([args] (method-type args ::mem/void)) ([args ret] (MethodType/methodType - ^Class (coerce-addressable (mem/java-layout ret)) + ^Class (mem/java-layout ret) ^"[Ljava.lang.Class;" (into-array Class (map mem/java-layout args))))) (defn- upcall-handle @@ -545,21 +539,21 @@ (mem/global-session)))) (defmethod mem/serialize* ::fn - [f [_fn arg-types ret-type & {:keys [raw-fn?]}] session] + [f [_fn arg-types ret-type & {:keys [raw-fn?]}] arena] (.upcallStub (Linker/nativeLinker) - (cond-> f - (not raw-fn?) (upcall-serde-wrapper arg-types ret-type) - :always (upcall-handle arg-types ret-type)) - (function-descriptor arg-types ret-type) - session)) + ^MethodHandle (cond-> f + (not raw-fn?) (upcall-serde-wrapper arg-types ret-type) + :always (upcall-handle arg-types ret-type)) + ^FunctionDescriptor (function-descriptor arg-types ret-type) + ^Arena arena + (make-array Linker$Option 0))) (defmethod mem/deserialize* ::fn [addr [_fn arg-types ret-type & {:keys [raw-fn?]}]] (when-not (mem/null? addr) (vary-meta - (-> addr - (MemorySegment/ofAddress mem/pointer-size (mem/connected-session)) + (-> ^MemorySegment addr (downcall-handle (function-descriptor arg-types ret-type)) (downcall-fn arg-types ret-type) (cond-> (not raw-fn?) (make-serde-wrapper arg-types ret-type))) @@ -640,9 +634,8 @@ See [[freset!]], [[fswap!]]." [symbol-or-addr type] - (StaticVariable. (mem/as-segment (.address (ensure-symbol symbol-or-addr)) - (mem/size-of type) - (mem/global-session)) + (StaticVariable. (.reinterpret ^MemorySegment (ensure-symbol symbol-or-addr) + ^long (mem/size-of type)) type (atom nil))) (defmacro defvar diff --git a/src/clj/coffi/layout.clj b/src/clj/coffi/layout.clj index 15a2db6..810a41f 100644 --- a/src/clj/coffi/layout.clj +++ b/src/clj/coffi/layout.clj @@ -24,7 +24,7 @@ (pos? r) (conj [::padding [::mem/padding (- align r)]]) :always (conj field)) fields)) - (let [strongest-alignment (mem/align-of struct-spec) + (let [strongest-alignment (reduce max (map (comp mem/align-of second) (nth struct-spec 1))) r (rem offset strongest-alignment)] (cond-> aligned-fields (pos? r) (conj [::padding [::mem/padding (- strongest-alignment r)]])))))] diff --git a/src/clj/coffi/mem.clj b/src/clj/coffi/mem.clj index abafd54..23139c1 100644 --- a/src/clj/coffi/mem.clj +++ b/src/clj/coffi/mem.clj @@ -13,21 +13,17 @@ struct, or array, then [[c-layout]] must be overriden to return the native layout of the type, and [[serialize-into]] and [[deserialize-from]] should be overriden to allow marshaling values of the type into and out of memory - segments. - - When writing code that manipulates a segment, it's best practice to - use [[with-acquired]] on the [[segment-session]] in order to ensure it won't be - released during its manipulation." + segments." (:require [clojure.set :as set] [clojure.spec.alpha :as s]) (:import (java.lang.foreign - Addressable - MemoryAddress + AddressLayout + Arena MemoryLayout MemorySegment - MemorySession + MemorySegment$Scope SegmentAllocator ValueLayout ValueLayout$OfByte @@ -36,50 +32,79 @@ ValueLayout$OfLong ValueLayout$OfChar ValueLayout$OfFloat - ValueLayout$OfDouble - ValueLayout$OfAddress) + ValueLayout$OfDouble) (java.lang.ref Cleaner) (java.nio ByteOrder))) (set! *warn-on-reflection* true) -(defn stack-session +(defn confined-arena + "Constructs a new arena for use only in this thread. + + The memory allocated within this arena is cheap to allocate, like a native + stack. + + The memory allocated within this arena will be cleared once it is closed, so + it is usually a good idea to create it in a [[with-open]] clause." + (^Arena [] + (Arena/ofConfined))) + +(defn ^:deprecated stack-session "Constructs a new session for use only in this thread. The memory allocated within this session is cheap to allocate, like a native stack." - (^MemorySession [] - (MemorySession/openConfined)) - (^MemorySession [^Cleaner cleaner] - (MemorySession/openConfined cleaner))) + (^Arena [] + (confined-arena)) + (^Arena [^Cleaner cleaner] + (assert false "Stack sessions with associated cleaners have been removed."))) (defn ^:deprecated stack-scope "Constructs a new scope for use only in this thread. The memory allocated within this scope is cheap to allocate, like a native stack." - ^MemorySession [] - (stack-session)) + ^Arena [] + (confined-arena)) -(defn shared-session +(defn shared-arena + "Constructs a new shared memory arena. + + This arena can be shared across threads and memory allocated in it will only + be cleaned up once any thread accessing the arena closes it." + (^Arena [] + (Arena/ofShared))) + +(defn ^:deprecated shared-session "Constructs a new shared memory session. This session can be shared across threads and memory allocated in it will only be cleaned up once every thread accessing the session closes it." - (^MemorySession [] - (MemorySession/openShared)) - (^MemorySession [^Cleaner cleaner] - (MemorySession/openShared cleaner))) + (^Arena [] + (shared-arena)) + (^Arena [^Cleaner cleaner] + (assert false "Shared sessions with associated cleaners have been removed."))) (defn ^:deprecated shared-scope "Constructs a new shared scope. This scope can be shared across threads and memory allocated in it will only be cleaned up once every thread accessing the scope closes it." - ^MemorySession [] - (shared-session)) + ^Arena [] + (shared-arena)) -(defn connected-session +(defn auto-arena + "Constructs a new memory arena that is managed by the garbage collector. + + The arena may be shared across threads, and all resources created with it will + be cleaned up at the same time, when all references have been collected. + + This type of arena cannot be closed, and therefore should not be created in + a [[with-open]] clause." + ^Arena [] + (Arena/ofAuto)) + +(defn ^:deprecated connected-session "Constructs a new memory session to reclaim all connected resources at once. The session may be shared across threads, and all resources created with it @@ -87,8 +112,8 @@ This type of session cannot be closed, and therefore should not be created in a [[with-open]] clause." - ^MemorySession [] - (MemorySession/openImplicit)) + ^Arena [] + (auto-arena)) (defn ^:deprecated connected-scope "Constructs a new scope to reclaim all connected resources at once. @@ -98,18 +123,28 @@ This type of scope cannot be closed, and therefore should not be created in a [[with-open]] clause." - ^MemorySession [] - (connected-session)) + ^Arena [] + (auto-arena)) -(defn global-session +(defn global-arena + "Constructs the global arena, which will never reclaim its resources. + + This arena may be shared across threads, but is intended mainly in cases where + memory is allocated with [[alloc]] but is either never freed or whose + management is relinquished to a native library, such as when returned from a + callback." + ^Arena [] + (Arena/global)) + +(defn ^:deprecated global-session "Constructs the global session, which will never reclaim its resources. This session may be shared across threads, but is intended mainly in cases where memory is allocated with [[alloc]] but is either never freed or whose management is relinquished to a native library, such as when returned from a callback." - ^MemorySession [] - (MemorySession/global)) + ^Arena [] + (global-arena)) (defn ^:deprecated global-scope "Constructs the global scope, which will never reclaim its resources. @@ -118,17 +153,28 @@ memory is allocated with [[alloc]] but is either never freed or whose management is relinquished to a native library, such as when returned from a callback." - ^MemorySession [] - (global-session)) + ^Arena [] + (global-arena)) -(defn session-allocator +(defn arena-allocator + "Constructs a [[SegmentAllocator]] from the given [[Arena]]. + + This is primarily used when working with unwrapped downcall functions. When a + downcall function returns a non-primitive type, it must be provided with an + allocator." + ^SegmentAllocator [^Arena scope] + (reify SegmentAllocator + (^MemorySegment allocate [_this ^long byte-size ^long byte-alignment] + (.allocate scope ^long byte-size ^long byte-alignment)))) + +(defn ^:deprecated session-allocator "Constructs a segment allocator from the given `session`. This is primarily used when working with unwrapped downcall functions. When a downcall function returns a non-primitive type, it must be provided with an allocator." - ^SegmentAllocator [^MemorySession session] - (SegmentAllocator/newNativeArena session)) + ^SegmentAllocator [^Arena session] + (arena-allocator session)) (defn ^:deprecated scope-allocator "Constructs a segment allocator from the given `scope`. @@ -136,26 +182,26 @@ This is primarily used when working with unwrapped downcall functions. When a downcall function returns a non-primitive type, it must be provided with an allocator." - ^SegmentAllocator [^MemorySession scope] - (session-allocator scope)) + ^SegmentAllocator [^Arena scope] + (arena-allocator scope)) -(defn segment-session +(defn ^:deprecated segment-session "Gets the memory session used to construct the `segment`." - ^MemorySession [segment] - (.session ^MemorySegment segment)) + ^Arena [^MemorySegment segment] + (assert false "Segment sessions no longer provide linkes to the arenas that allocated them.")) -(defn ^:deprecated segment-scope - "Gets the scope used to construct the `segment`." - ^MemorySession [segment] - (segment-session segment)) +(defn segment-scope + "Gets the scope associated with the `segment`." + ^MemorySegment$Scope [segment] + (.scope ^MemorySegment segment)) (defn alloc "Allocates `size` bytes. - If a `session` is provided, the allocation will be reclaimed when it is closed." - (^MemorySegment [size] (alloc size (connected-session))) - (^MemorySegment [size session] (MemorySegment/allocateNative (long size) ^MemorySession session)) - (^MemorySegment [size alignment session] (MemorySegment/allocateNative (long size) (long alignment) ^MemorySession session))) + If an `arena` is provided, the allocation will be reclaimed when it is closed." + (^MemorySegment [size] (alloc size (auto-arena))) + (^MemorySegment [size arena] (.allocate ^Arena arena (long size))) + (^MemorySegment [size alignment arena] (.allocate ^Arena arena (long size) (long alignment)))) (defn alloc-with "Allocates `size` bytes using the `allocator`." @@ -164,7 +210,7 @@ (^MemorySegment [allocator size alignment] (.allocate ^SegmentAllocator allocator (long size) (long alignment)))) -(defmacro with-acquired +(defmacro ^:deprecated with-acquired "Acquires one or more `sessions` until the `body` completes. This is only necessary to do on shared sessions, however if you are operating @@ -172,17 +218,7 @@ interacts with it wrapped in this." {:style/indent 1} [sessions & body] - (if (seq sessions) - `(let [session# ~(first sessions) - res# (volatile! ::invalid-value)] - (.whileAlive - ^MemorySession session# - (^:once fn* [] - (vreset! res# - (with-acquired [~@(rest sessions)] - ~@body)))) - @res#) - `(do ~@body))) + (assert false "Support was removed for keeping a shared arena open.")) (s/fdef with-acquired :args (s/cat :sessions any? :body (s/* any?))) @@ -191,20 +227,20 @@ "Gets the address of a given segment. This value can be used as an argument to functions which take a pointer." - ^MemoryAddress [addressable] - (.address ^Addressable addressable)) + ^long [addressable] + (.address ^MemorySegment addressable)) (defn null? "Checks if a memory address is null." [addr] - (or (.equals (MemoryAddress/NULL) addr) (not addr))) + (or (.equals (MemorySegment/NULL) addr) (not addr))) (defn address? "Checks if an object is a memory address. `nil` is considered an address." [addr] - (or (nil? addr) (instance? MemoryAddress addr))) + (or (nil? addr) (instance? MemorySegment addr))) (defn slice "Get a slice over the `segment` with the given `offset`." @@ -213,18 +249,20 @@ (^MemorySegment [segment offset size] (.asSlice ^MemorySegment segment (long offset) (long size)))) -(defn slice-into +(defn ^:deprecated slice-into "Get a slice into the `segment` starting at the `address`." (^MemorySegment [address segment] - (.asSlice ^MemorySegment segment ^MemoryAddress address)) + (.asSlice ^MemorySegment segment (address-of address))) (^MemorySegment [address segment size] - (.asSlice ^MemorySegment segment ^MemoryAddress address (long size)))) + (.asSlice ^MemorySegment segment (address-of address) (long size)))) -(defn with-offset +(defn ^:deprecated with-offset "Get a new address `offset` from the old `address`." - ^MemoryAddress [address offset] - (.addOffset ^MemoryAddress address (long offset))) + ^MemorySegment [address offset] + (slice address offset)) +;; TODO(Joshua): Figure out if this can be replicated with [[Cleaner]] +#_ (defn add-close-action! "Adds a 0-arity function to be run when the `session` closes." [^MemorySession session ^Runnable action] @@ -233,26 +271,23 @@ (defn as-segment "Dereferences an `address` into a memory segment associated with the `session`." - (^MemorySegment [^MemoryAddress address size] - (MemorySegment/ofAddress address (long size) (connected-session))) - (^MemorySegment [^MemoryAddress address size session] - (MemorySegment/ofAddress address (long size) session))) + (^MemorySegment [^MemorySegment address size] + (.reinterpret (MemorySegment/ofAddress address) (long size) (connected-session) nil)) + (^MemorySegment [^MemorySegment address size session] + (.reinterpret (MemorySegment/ofAddress address) (long size) session nil))) (defn copy-segment "Copies the content to `dest` from `src`. Returns `dest`." ^MemorySegment [^MemorySegment dest ^MemorySegment src] - (with-acquired [(segment-session src) (segment-session dest)] - (.copyFrom dest src) - dest)) + (.copyFrom dest src)) (defn clone-segment "Clones the content of `segment` into a new segment of the same size." (^MemorySegment [segment] (clone-segment segment (connected-session))) (^MemorySegment [^MemorySegment segment session] - (with-acquired [(segment-session segment) session] - (copy-segment ^MemorySegment (alloc (.byteSize segment) session) segment)))) + (copy-segment ^MemorySegment (alloc (.byteSize segment) session) segment))) (defn slice-segments "Constructs a lazy seq of `size`-length memory segments, sliced from `segment`." @@ -307,7 +342,7 @@ "The [[MemoryLayout]] for a c-sized double in [[native-endian]] [[ByteOrder]]." ValueLayout/JAVA_DOUBLE) -(def ^ValueLayout$OfAddress pointer-layout +(def ^AddressLayout pointer-layout "The [[MemoryLayout]] for a native pointer in [[native-endian]] [[ByteOrder]]." ValueLayout/ADDRESS) @@ -517,20 +552,20 @@ (.get segment (.withOrder ^ValueLayout$OfDouble double-layout byte-order) offset))) (defn read-address - "Reads a [[MemoryAddress]] from the `segment`, at an optional `offset`." + "Reads an address from the `segment`, at an optional `offset`, wrapped in a [[MemorySegment]]." {:inline (fn read-address-inline ([segment] `(let [segment# ~segment] - (.get ^MemorySegment segment# ^ValueLayout$OfAddress pointer-layout 0))) + (.get ^MemorySegment segment# ^AddressLayout pointer-layout 0))) ([segment offset] `(let [segment# ~segment offset# ~offset] - (.get ^MemorySegment segment# ^ValueLayout$OfAddress pointer-layout offset#))))} - (^MemoryAddress [^MemorySegment segment] - (.get segment ^ValueLayout$OfAddress pointer-layout 0)) - (^MemoryAddress [^MemorySegment segment ^long offset] - (.get segment ^ValueLayout$OfAddress pointer-layout offset))) + (.get ^MemorySegment segment# ^AddressLayout pointer-layout offset#))))} + (^MemorySegment [^MemorySegment segment] + (.get segment ^AddressLayout pointer-layout 0)) + (^MemorySegment [^MemorySegment segment ^long offset] + (.get segment ^AddressLayout pointer-layout offset))) (defn write-byte "Writes a [[byte]] to the `segment`, at an optional `offset`." @@ -715,22 +750,22 @@ (.set segment (.withOrder ^ValueLayout$OfDouble double-layout byte-order) offset value))) (defn write-address - "Writes a [[MemoryAddress]] to the `segment`, at an optional `offset`." + "Writes the address of the [[MemorySegment]] `value` to the `segment`, at an optional `offset`." {:inline (fn write-address-inline ([segment value] `(let [segment# ~segment value# ~value] - (.set ^MemorySegment segment# ^ValueLayout$OfAddress pointer-layout 0 ^Addressable value#))) + (.set ^MemorySegment segment# ^AddressLayout pointer-layout 0 ^MemorySegment value#))) ([segment offset value] `(let [segment# ~segment offset# ~offset value# ~value] - (.set ^MemorySegment segment# ^ValueLayout$OfAddress pointer-layout offset# ^Addressable value#))))} - (^MemoryAddress [^MemorySegment segment ^MemoryAddress value] - (.set segment ^ValueLayout$OfAddress pointer-layout 0 value)) - (^MemoryAddress [^MemorySegment segment ^long offset ^MemoryAddress value] - (.set segment ^ValueLayout$OfAddress pointer-layout offset value))) + (.set ^MemorySegment segment# ^AddressLayout pointer-layout offset# ^MemorySegment value#))))} + ([^MemorySegment segment ^MemorySegment value] + (.set segment ^AddressLayout pointer-layout 0 value)) + ([^MemorySegment segment ^long offset ^MemorySegment value] + (.set segment ^AddressLayout pointer-layout offset value))) (defn- type-dispatch "Gets a type dispatch value from a (potentially composite) type." @@ -867,7 +902,7 @@ ::char Byte/TYPE ::float Float/TYPE ::double Double/TYPE - ::pointer MemoryAddress + ::pointer MemorySegment ::void Void/TYPE}) (defn java-layout @@ -894,8 +929,8 @@ (defn alloc-instance "Allocates a memory segment for the given `type`." - (^MemorySegment [type] (alloc-instance type (connected-session))) - (^MemorySegment [type session] (MemorySegment/allocateNative ^long (size-of type) ^MemorySession session))) + (^MemorySegment [type] (alloc-instance type (auto-arena))) + (^MemorySegment [type arena] (.allocate ^Arena arena ^long (size-of type) ^long (align-of type)))) (declare serialize serialize-into) @@ -949,12 +984,11 @@ [obj type session] (if-not (null? obj) (if (sequential? type) - (with-acquired [session] - (let [segment (alloc-instance (second type) session)] - (serialize-into obj (second type) segment session) - (address-of segment))) + (let [segment (alloc-instance (second type) session)] + (serialize-into obj (second type) segment session) + (address-of segment)) obj) - (MemoryAddress/NULL))) + (MemorySegment/NULL))) (defmethod serialize* ::void [_obj _type _session] @@ -970,10 +1004,7 @@ override [[c-layout]]. For any other type, this will serialize it as [[serialize*]] before writing - the result value into the `segment`. - - Implementations of this should be inside a [[with-acquired]] block for the - `session` if they perform multiple memory operations." + the result value into the `segment`." (fn #_{:clj-kondo/ignore [:unused-binding]} [obj type segment session] @@ -982,8 +1013,7 @@ (defmethod serialize-into :default [obj type segment session] (if-some [prim-layout (primitive-type type)] - (with-acquired [(segment-session segment) session] - (serialize-into (serialize* obj type session) prim-layout segment session)) + (serialize-into (serialize* obj type session) prim-layout segment session) (throw (ex-info "Attempted to serialize an object to a type that has not been overridden" {:type type :object obj})))) @@ -1028,11 +1058,10 @@ (defmethod serialize-into ::pointer [obj type segment session] - (with-acquired [(segment-session segment) session] - (write-address - segment - (cond-> obj - (sequential? type) (serialize* type session))))) + (write-address + segment + (cond-> obj + (sequential? type) (serialize* type session)))) (defn serialize "Serializes an arbitrary type. @@ -1054,10 +1083,7 @@ "Deserializes the given segment into a Clojure data structure. For types that serialize to primitives, a default implementation will - deserialize the primitive before calling [[deserialize*]]. - - Implementations of this should be inside a [[with-acquired]] block for the the - `segment`'s session if they perform multiple memory operations." + deserialize the primitive before calling [[deserialize*]]." (fn #_{:clj-kondo/ignore [:unused-binding]} [segment type] @@ -1113,9 +1139,8 @@ (defmethod deserialize-from ::pointer [segment type] - (with-acquired [(segment-session segment)] - (cond-> (read-address segment) - (sequential? type) (deserialize* type)))) + (cond-> (read-address segment) + (sequential? type) (deserialize* type))) (defmulti deserialize* "Deserializes a primitive object into a Clojure data structure. @@ -1165,8 +1190,11 @@ [addr type] (when-not (null? addr) (if (sequential? type) - (deserialize-from (as-segment addr (size-of (second type))) - (second type)) + (let [target-type (second type)] + (deserialize-from + (.reinterpret ^MemorySegment (read-address addr) + ^long (size-of target-type)) + target-type)) addr))) (defmethod deserialize* ::void @@ -1188,8 +1216,7 @@ (defn seq-of "Constructs a lazy sequence of `type` elements deserialized from `segment`." [type segment] - (with-acquired [(segment-session segment)] - (map #(deserialize % type) (slice-segments segment (size-of type))))) + (map #(deserialize % type) (slice-segments segment (size-of type)))) ;;; Raw composite types ;; TODO(Joshua): Ensure that all the raw values don't have anything happen on @@ -1218,15 +1245,15 @@ ::pointer) (defmethod serialize* ::c-string - [obj _type session] + [obj _type ^Arena session] (if obj - (address-of (.allocateUtf8String (session-allocator session) ^String obj)) - (MemoryAddress/NULL))) + (.allocateFrom session ^String obj) + (MemorySegment/NULL))) (defmethod deserialize* ::c-string [addr _type] (when-not (null? addr) - (.getUtf8String ^MemoryAddress addr 0))) + (.getString (.reinterpret ^MemorySegment addr Integer/MAX_VALUE) 0))) ;;; Union types @@ -1297,7 +1324,7 @@ (defmethod c-layout ::padding [[_padding size]] - (MemoryLayout/paddingLayout (* 8 size))) + (MemoryLayout/paddingLayout size)) (defmethod serialize-into ::padding [_obj [_padding _size] _segment _session] diff --git a/src/java/coffi/ffi/Loader.java b/src/java/coffi/ffi/Loader.java index 8830118..ef458fc 100644 --- a/src/java/coffi/ffi/Loader.java +++ b/src/java/coffi/ffi/Loader.java @@ -10,6 +10,8 @@ import java.lang.foreign.*; */ public class Loader { + static SymbolLookup lookup = Linker.nativeLinker().defaultLookup().or(SymbolLookup.loaderLookup()); + /** * Loads a library from a given absolute file path. * @@ -37,7 +39,6 @@ public class Loader { * @param symbol The name of the symbol to load from a library. */ public static MemorySegment findSymbol(String symbol) { - return Linker.nativeLinker().defaultLookup().lookup(symbol) - .orElseGet(() -> SymbolLookup.loaderLookup().lookup(symbol).orElse(null)); + return lookup.find(symbol).orElse(null); } } diff --git a/test/c/ffi_test.c b/test/c/ffi_test.c index c689e87..24e6959 100644 --- a/test/c/ffi_test.c +++ b/test/c/ffi_test.c @@ -26,10 +26,18 @@ CString upcall_test(StringFactory fun) { return fun(); } +int upcall_test2(int (*f)(void)) { + return f(); +} + int counter = 0; static char* responses[] = { "Hello, world!", "Goodbye friend.", "co'oi prenu" }; +char* upcall_test_int_fn_string_ret(int (*f)(void)) { + return responses[f()]; +} + CString get_string1(void) { return responses[counter++ % 3]; } @@ -63,3 +71,10 @@ AlignmentTest get_struct() { return ret; } + +void test_call_with_trailing_string_arg(int a, int b, char* text) { + printf("call of `test_call_with_trailing_string_arg` with a=%i b=%i text='%s'",1,2,text); + printf("\r "); + return; +} + diff --git a/test/clj/coffi/ffi_test.clj b/test/clj/coffi/ffi_test.clj index 15cc4b6..d45e3ae 100644 --- a/test/clj/coffi/ffi_test.clj +++ b/test/clj/coffi/ffi_test.clj @@ -29,8 +29,18 @@ (t/deftest can-make-upcall (t/is (= ((ffi/cfn "upcall_test" [[::ffi/fn [] ::mem/c-string]] ::mem/c-string) - (fn [] "hello")) - "hello"))) + (fn [] "hello from clojure from c from clojure")) + "hello from clojure from c from clojure"))) + +(t/deftest can-make-upcall2 + (t/is (= ((ffi/cfn "upcall_test2" [[::ffi/fn [] ::mem/int]] ::mem/int) + (fn [] 5)) + 5))) + +(t/deftest can-make-upcall-int-fn-string-ret + (t/is (= ((ffi/cfn "upcall_test_int_fn_string_ret" [[::ffi/fn [] ::mem/int]] ::mem/c-string) + (fn [] 2)) + "co'oi prenu"))) (mem/defalias ::alignment-test (layout/with-c-layout @@ -49,3 +59,12 @@ (ffi/freset! (ffi/static-variable "counter" ::mem/int) 1) (t/is (= ((ffi/cfn "get_string1" [] ::mem/c-string)) "Goodbye friend."))) + +(t/deftest can-call-with-trailing-string-arg + (t/is + (= + ((ffi/cfn "test_call_with_trailing_string_arg" + [::mem/int ::mem/int ::mem/c-string] + ::mem/void) + 1 2 "third arg")))) + diff --git a/test/clj/coffi/mem_test.clj b/test/clj/coffi/mem_test.clj new file mode 100644 index 0000000..b52c1eb --- /dev/null +++ b/test/clj/coffi/mem_test.clj @@ -0,0 +1,32 @@ +(ns coffi.mem-test + (:require + [clojure.test :as t] + [coffi.ffi :as ffi] + [coffi.layout :as layout] + [coffi.mem :as mem]) + (:import + (java.lang.foreign + AddressLayout + Arena + MemoryLayout + MemorySegment + MemorySegment$Scope + SegmentAllocator + ValueLayout + ValueLayout$OfByte + ValueLayout$OfShort + ValueLayout$OfInt + ValueLayout$OfLong + ValueLayout$OfChar + ValueLayout$OfFloat + ValueLayout$OfDouble) + (java.lang.ref Cleaner) + (java.nio ByteOrder))) + +(ffi/load-library "target/ffi_test.so") + +(t/deftest can-serialize-string + (t/is + (instance? MemorySegment (mem/serialize "this is a string" ::mem/c-string)))) + +