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