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

Merge branch 'feature/jdk21-support' into develop

Browse source
This commit is contained in:
Joshua Suskalo 2024-07-24 18:29:18 -05:00
commit 74af3c084d
No known key found for this signature in database
GPG key ID: 9B6BA586EFF1B9F0
9 changed files with 256 additions and 169 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
build.clj
View file

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

2
deps.edn
View file

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

53
src/clj/coffi/ffi.clj
View file

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

2
src/clj/coffi/layout.clj
View file

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

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

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

5
src/java/coffi/ffi/Loader.java
View file

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

15
test/c/ffi_test.c
View file

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

23
test/clj/coffi/ffi_test.clj
View file

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

32
test/clj/coffi/mem_test.clj Normal file
View file

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