Merge branch 'feature/jdk18-support' into develop

This commit is contained in:
Joshua Suskalo 2022-07-07 09:26:19 -05:00
commit b8c9417d3f
No known key found for this signature in database
GPG key ID: 9B6BA586EFF1B9F0
6 changed files with 278 additions and 229 deletions

View file

@ -2,6 +2,13 @@
All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
## [Unreleased]
### Removed
- `:coffi.mem/long-long` primitive type
- `coffi.mem/slice-into`; the function no longer has an equivalent in panama, but see 2-arity of `coffi.mem/as-segment` for an alternative
### Changed
- `coffi.mem/as-segment` no longer has a close action arity
- JDK version from 17 to 18
## [0.4.341] - 2022-01-23
### Added

View file

@ -110,7 +110,6 @@ Coffi defines a basic set of primitive types:
- short
- int
- long
- long-long
- char
- float
- double

View file

@ -52,8 +52,8 @@
(b/process {:command-args ["javac" "--add-modules=jdk.incubator.foreign"
"src/java/coffi/ffi/Loader.java"
"-d" class-dir
"-target" "17"
"-source" "17"]})
"-target" "18"
"-source" "18"]})
opts)
(defn- write-pom

View file

@ -17,7 +17,9 @@
Addressable
CLinker
FunctionDescriptor
MemoryAddress
MemoryLayout
NativeSymbol
SegmentAllocator)))
;;; FFI Code loading and function access
@ -33,18 +35,9 @@
(Loader/loadLibrary (.getAbsolutePath (io/file path))))
(defn find-symbol
"Gets the [[MemoryAddress]] of a symbol from the loaded libraries."
"Gets the [[NativeSymbol]] of a symbol from the loaded libraries."
[sym]
(let [sym (name sym)]
(Loader/findSymbol sym)))
(defn- method-type
"Gets the [[MethodType]] for a set of `args` and `ret` types."
([args] (method-type args ::mem/void))
([args ret]
(MethodType/methodType
^Class (mem/java-layout ret)
^"[Ljava.lang.Class;" (into-array Class (map mem/java-layout args)))))
(Loader/findSymbol (name sym)))
(defn- function-descriptor
"Gets the [[FunctionDescriptor]] for a set of `args` and `ret` types."
@ -60,8 +53,8 @@
(defn- downcall-handle
"Gets the [[MethodHandle]] for the function at the `address`."
[address method-type function-descriptor]
(.downcallHandle (CLinker/getInstance) address method-type function-descriptor))
[sym function-descriptor]
(.downcallHandle (CLinker/systemCLinker) sym function-descriptor))
(def ^:private load-instructions
"Mapping from primitive types to the instruction used to load them onto the stack."
@ -138,6 +131,15 @@
[: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."
@ -174,7 +176,7 @@
args)
[:invokevirtual MethodHandle "invokeExact"
(cond->>
(conj (mapv insn-layout args)
(conj (mapv (comp coerce-addressable insn-layout) args)
(insn-layout ret))
(not (mem/primitive-type ret)) (cons SegmentAllocator))]
(to-object-asm ret)
@ -185,12 +187,12 @@
[handle args ret]
(insn/new-instance (downcall-class args ret) ^MethodHandle handle))
(defn- ensure-address
(defn- ensure-symbol
"Gets the address if the argument is [[Addressable]], otherwise
calls [[find-symbol]] on it."
[symbol-or-addr]
(if (instance? Addressable symbol-or-addr)
(mem/address-of symbol-or-addr)
^NativeSymbol [symbol-or-addr]
(if (instance? NativeSymbol symbol-or-addr)
symbol-or-addr
(find-symbol symbol-or-addr)))
(defn make-downcall
@ -205,10 +207,8 @@
first argument of a [[SegmentAllocator]]."
[symbol-or-addr args ret]
(-> symbol-or-addr
ensure-address
(downcall-handle
(method-type args ret)
(function-descriptor args ret))
ensure-symbol
(downcall-handle (function-descriptor args ret))
(downcall-fn args ret)))
(defn make-varargs-factory
@ -440,7 +440,7 @@
arguments."
[symbol required-args ret]
(-> symbol
ensure-address
ensure-symbol
(make-varargs-factory required-args ret)
(make-serde-varargs-wrapper required-args ret)))
@ -452,7 +452,6 @@
::mem/short :sreturn
::mem/int :ireturn
::mem/long :lreturn
::mem/long-long :lreturn
::mem/char :creturn
::mem/float :freturn
::mem/double :dreturn
@ -460,7 +459,7 @@
(def ^:private double-sized?
"Set of primitive types which require 2 indices in the constant pool."
#{::mem/double ::mem/long ::mem/long-long})
#{::mem/double ::mem/long})
(defn- upcall-class
"Constructs a class definition for a class with a single method, `upcall`, which
@ -482,7 +481,7 @@
{:name :upcall
:flags #{:public}
:desc (conj (mapv insn-layout arg-types)
(insn-layout ret-type))
(coerce-addressable (insn-layout ret-type)))
:emit [[:aload 0]
[:getfield :this "upcall_ifn" IFn]
(loop [types arg-types
@ -498,7 +497,7 @@
inc)))
acc))
[:invokeinterface IFn "invoke" (repeat (inc (count arg-types)) Object)]
(to-prim-asm ret-type)
(to-prim-asm (coerce-addressable ret-type))
[(return-for-type ret-type :areturn)]]}]})
(defn- upcall
@ -506,6 +505,17 @@
[f arg-types ret-type]
(insn/new-instance (upcall-class arg-types ret-type) ^IFn f))
(defn- method-type
"Gets the [[MethodType]] for a set of `args` and `ret` types."
([args] (method-type args ::mem/void))
([args ret]
(MethodType/methodType
^Class (let [r (mem/java-layout ret)]
(if (= r MemoryAddress)
Addressable
r))
^"[Ljava.lang.Class;" (into-array Class (map mem/java-layout args)))))
(defn- upcall-handle
"Constructs a method handle for invoking `f`, a function of `arg-count` args."
[f arg-types ret-type]
@ -532,7 +542,7 @@
(defmethod mem/serialize* ::fn
[f [_fn arg-types ret-type & {:keys [raw-fn?]}] scope]
(.upcallStub
(CLinker/getInstance)
(CLinker/systemCLinker)
(cond-> f
(not raw-fn?) (upcall-serde-wrapper arg-types ret-type)
:always (upcall-handle arg-types ret-type))
@ -544,9 +554,8 @@
(when-not (mem/null? addr)
(vary-meta
(-> addr
(downcall-handle
(method-type arg-types ret-type)
(function-descriptor arg-types ret-type))
(as-> addr (NativeSymbol/ofAddress "coffi_upcall_symbol" addr (mem/connected-scope)))
(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)))
assoc ::address addr)))
@ -556,19 +565,16 @@
(defn const
"Gets the value of a constant stored in `symbol-or-addr`."
[symbol-or-addr type]
(mem/deserialize (ensure-address symbol-or-addr) [::mem/pointer type]))
(mem/deserialize (.address (ensure-symbol symbol-or-addr)) [::mem/pointer type]))
(deftype StaticVariable [addr type meta]
Addressable
(address [_]
addr)
(deftype StaticVariable [seg type meta]
IDeref
(deref [_]
(mem/deserialize addr [::mem/pointer type]))
(mem/deserialize seg type))
IObj
(withMeta [_ meta-map]
(StaticVariable. addr type (atom meta-map)))
(StaticVariable. seg type (atom meta-map)))
IMeta
(meta [_]
@meta)
@ -583,7 +589,7 @@
[^StaticVariable static-var newval]
(mem/serialize-into
newval (.-type static-var)
(mem/slice-global (.-addr static-var) (mem/size-of (.-type static-var)))
(.-seg static-var)
(mem/global-scope))
newval)
@ -603,7 +609,10 @@
See [[freset!]], [[fswap!]]."
[symbol-or-addr type]
(StaticVariable. (ensure-address symbol-or-addr) type (atom nil)))
(StaticVariable. (mem/as-segment (.address (ensure-symbol symbol-or-addr))
(mem/size-of type)
(mem/global-scope))
type (atom nil)))
(s/def :coffi.ffi.symbolspec/symbol string?)
(s/def :coffi.ffi.symbolspec/type keyword?)

View file

@ -24,15 +24,13 @@
(java.nio ByteOrder)
(jdk.incubator.foreign
Addressable
CLinker
MemoryAccess
MemoryAddress
MemoryLayout
MemorySegment
ResourceScope
ResourceScope$Handle
SegmentAllocator
ValueLayout)))
ValueLayout
ValueLayout$OfAddress)))
(defn stack-scope
"Constructs a new scope for use only in this thread.
@ -78,7 +76,7 @@
downcall function returns a non-primitive type, it must be provided with an
allocator."
^SegmentAllocator [^ResourceScope scope]
(SegmentAllocator/ofScope scope))
(SegmentAllocator/nativeAllocator scope))
(defn segment-scope
"Gets the scope used to construct the `segment`."
@ -107,15 +105,10 @@
with it wrapped in this."
{:style/indent 1}
[scopes & body]
`(let [scopes# (vec ~scopes)
handles# (mapv #(.acquire ^ResourceScope %) scopes#)]
(try ~@body
(finally
(doseq [idx# (range (count scopes#))
:let [scope# (nth scopes# idx#)
handle# (nth handles# idx#)]]
(.release ^ResourceScope scope#
^ResourceScope$Handle handle#))))))
`(with-open [scope# (stack-scope)]
(doseq [target-scope# (vec ~scopes)]
(.keepAlive scope# target-scope#))
~@body))
(s/fdef with-acquired
:args (s/cat :scopes any?
:body (s/* any?)))
@ -139,16 +132,6 @@
[addr]
(or (nil? addr) (instance? MemoryAddress addr)))
(defn slice-global
"Gets a slice of the global address space.
Because this fetches from the global segment, it has no associated scope, and
therefore the reference created here cannot prevent the value from being
freed. Be careful to ensure that you are not retaining an object incorrectly."
^MemorySegment [address size]
(.asSlice (MemorySegment/globalNativeSegment)
^MemoryAddress address (long size)))
(defn slice
"Get a slice over the `segment` with the given `offset`."
(^MemorySegment [segment offset]
@ -168,25 +151,19 @@
^MemoryAddress [address offset]
(.addOffset ^MemoryAddress address (long offset)))
(defn as-segment
"Dereferences an `address` into a memory segment associated with the `scope`.
If `cleanup` is provided, it is a 0-arity function run when the scope is
closed. This can be used to register a free method for the memory, or do other
cleanup in a way that doesn't require modifying the code at the point of
freeing, and allows shared or garbage collected resources to be freed
correctly."
(^MemorySegment [^MemoryAddress address size scope]
(.asSegment address (long size) scope))
(^MemorySegment [^MemoryAddress address size ^ResourceScope scope cleanup]
(.asSegment address (long size) cleanup scope)))
(defn add-close-action!
"Adds a 0-arity function to be run when the `scope` closes."
[^ResourceScope scope ^Runnable action]
(.addCloseAction scope action)
nil)
(defn as-segment
"Dereferences an `address` into a memory segment associated with the `scope`."
(^MemorySegment [^MemoryAddress address size]
(MemorySegment/ofAddress address (long size) (connected-scope)))
(^MemorySegment [^MemoryAddress address size scope]
(MemorySegment/ofAddress address (long size) scope)))
(defn copy-segment
"Copies the content to `dest` from `src`.
@ -230,39 +207,35 @@
(def ^ValueLayout byte-layout
"The [[MemoryLayout]] for a byte in [[native-endian]] [[ByteOrder]]."
CLinker/C_CHAR)
(MemoryLayout/valueLayout Byte/TYPE native-endian))
(def ^ValueLayout short-layout
"The [[MemoryLayout]] for a c-sized short in [[native-endian]] [[ByteOrder]]."
CLinker/C_SHORT)
(MemoryLayout/valueLayout Short/TYPE native-endian))
(def ^ValueLayout int-layout
"The [[MemoryLayout]] for a c-sized int in [[native-endian]] [[ByteOrder]]."
CLinker/C_INT)
(MemoryLayout/valueLayout Integer/TYPE native-endian))
(def ^ValueLayout long-layout
"The [[MemoryLayout]] for a c-sized long in [[native-endian]] [[ByteOrder]]."
CLinker/C_LONG)
(def ^ValueLayout long-long-layout
"The [[MemoryLayout]] for a c-sized long-long in [[native-endian]] [[ByteOrder]]."
CLinker/C_LONG_LONG)
(MemoryLayout/valueLayout Long/TYPE native-endian))
(def ^ValueLayout char-layout
"The [[MemoryLayout]] for a c-sized char in [[native-endian]] [[ByteOrder]]."
CLinker/C_CHAR)
(MemoryLayout/valueLayout Byte/TYPE native-endian))
(def ^ValueLayout float-layout
"The [[MemoryLayout]] for a c-sized float in [[native-endian]] [[ByteOrder]]."
CLinker/C_FLOAT)
(MemoryLayout/valueLayout Float/TYPE native-endian))
(def ^ValueLayout double-layout
"The [[MemoryLayout]] for a c-sized double in [[native-endian]] [[ByteOrder]]."
CLinker/C_DOUBLE)
(MemoryLayout/valueLayout Double/TYPE native-endian))
(def ^ValueLayout pointer-layout
(def ^ValueLayout$OfAddress pointer-layout
"The [[MemoryLayout]] for a native pointer in [[native-endian]] [[ByteOrder]]."
CLinker/C_POINTER)
ValueLayout/ADDRESS)
(def ^long short-size
"The size in bytes of a c-sized short."
@ -276,10 +249,6 @@
"The size in bytes of a c-sized long."
(.byteSize long-layout))
(def ^long long-long-size
"The size in bytes of a c-sized long long."
(.byteSize long-long-layout))
(def ^long float-size
"The size in bytes of a c-sized float."
(.byteSize float-layout))
@ -304,10 +273,6 @@
"The alignment in bytes of a c-sized long."
(.byteAlignment long-layout))
(def ^long long-long-alignment
"The alignment in bytes of a c-sized long long."
(.byteAlignment long-long-layout))
(def ^long float-alignment
"The alignment in bytes of a c-sized float."
(.byteAlignment float-layout))
@ -325,13 +290,16 @@
{:inline
(fn read-byte-inline
([segment]
`(MemoryAccess/getByte ~segment))
`(let [segment# ~segment]
(.get ^MemorySegment segment# ^ValueLayout byte-layout 0)))
([segment offset]
`(MemoryAccess/getByteAtOffset ~segment ~offset)))}
`(let [segment# ~segment
offset# ~offset]
(.get ^MemorySegment segment# ^ValueLayout byte-layout offset#))))}
([^MemorySegment segment]
(MemoryAccess/getByte segment))
(.get segment ^ValueLayout byte-layout 0))
([^MemorySegment segment ^long offset]
(MemoryAccess/getByteAtOffset segment offset)))
(.get segment ^ValueLayout byte-layout offset)))
(defn read-short
"Reads a [[short]] from the `segment`, at an optional `offset`.
@ -340,17 +308,23 @@
{:inline
(fn read-short-inline
([segment]
`(MemoryAccess/getShort ~segment))
`(let [segment# ~segment]
(.get ^MemorySegment segment# ^ValueLayout short-layout 0)))
([segment offset]
`(MemoryAccess/getShortAtOffset ~segment ~offset))
`(let [segment# ~segment
offset# ~offset]
(.get ^MemorySegment segment# ^ValueLayout short-layout offset#)))
([segment offset byte-order]
`(MemoryAccess/getShortAtOffset ~segment ~offset ~byte-order)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order]
(.get ^MemorySegment segment# (.withOrder ^ValueLayout short-layout ^ByteOrder byte-order#) offset#))))}
([^MemorySegment segment]
(MemoryAccess/getShort segment))
(.get segment ^ValueLayout short-layout 0))
([^MemorySegment segment ^long offset]
(MemoryAccess/getShortAtOffset segment offset))
(.get segment ^ValueLayout short-layout offset))
([^MemorySegment segment ^long offset ^ByteOrder byte-order]
(MemoryAccess/getShortAtOffset segment offset byte-order)))
(.get segment (.withOrder ^ValueLayout short-layout byte-order) offset)))
(defn read-int
"Reads a [[int]] from the `segment`, at an optional `offset`.
@ -359,17 +333,23 @@
{:inline
(fn read-int-inline
([segment]
`(MemoryAccess/getInt ~segment))
`(let [segment# ~segment]
(.get ^MemorySegment segment# ^ValueLayout int-layout 0)))
([segment offset]
`(MemoryAccess/getIntAtOffset ~segment ~offset))
`(let [segment# ~segment
offset# ~offset]
(.get ^MemorySegment segment# ^ValueLayout int-layout offset#)))
([segment offset byte-order]
`(MemoryAccess/getIntAtOffset ~segment ~offset ~byte-order)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order]
(.get ^MemorySegment segment# (.withOrder ^ValueLayout int-layout ^ByteOrder byte-order#) offset#))))}
([^MemorySegment segment]
(MemoryAccess/getInt segment))
(.get segment ^ValueLayout int-layout 0))
([^MemorySegment segment ^long offset]
(MemoryAccess/getIntAtOffset segment offset))
(.get segment ^ValueLayout int-layout offset))
([^MemorySegment segment ^long offset ^ByteOrder byte-order]
(MemoryAccess/getIntAtOffset segment offset byte-order)))
(.get segment (.withOrder ^ValueLayout int-layout byte-order) offset)))
(defn read-long
"Reads a [[long]] from the `segment`, at an optional `offset`.
@ -378,30 +358,39 @@
{:inline
(fn read-long-inline
([segment]
`(MemoryAccess/getLong ~segment))
`(let [segment# ~segment]
(.get ^MemorySegment segment# ^ValueLayout long-layout 0)))
([segment offset]
`(MemoryAccess/getLongAtOffset ~segment ~offset))
`(let [segment# ~segment
offset# ~offset]
(.get ^MemorySegment segment# ^ValueLayout long-layout offset#)))
([segment offset byte-order]
`(MemoryAccess/getLongAtOffset ~segment ~offset ~byte-order)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order]
(.get ^MemorySegment segment# (.withOrder ^ValueLayout long-layout ^ByteOrder byte-order#) offset#))))}
(^long [^MemorySegment segment]
(MemoryAccess/getLong segment))
(.get segment ^ValueLayout long-layout 0))
(^long [^MemorySegment segment ^long offset]
(MemoryAccess/getLongAtOffset segment offset))
(.get segment ^ValueLayout long-layout offset))
(^long [^MemorySegment segment ^long offset ^ByteOrder byte-order]
(MemoryAccess/getLongAtOffset segment offset byte-order)))
(.get segment (.withOrder ^ValueLayout long-layout byte-order) offset)))
(defn read-char
"Reads a [[char]] from the `segment`, at an optional `offset`."
{:inline
(fn read-char-inline
([segment]
`(char (Byte/toUnsignedInt (MemoryAccess/getByte ~segment))))
`(let [segment# ~segment]
(char (Byte/toUnsignedInt (.get ^MemorySegment segment# ^ValueLayout byte-layout 0)))))
([segment offset]
`(char (Byte/toUnsignedInt (MemoryAccess/getByteAtOffset ~segment ~offset)))))}
`(let [segment# ~segment
offset# ~offset]
(char (Byte/toUnsignedInt (.get ^MemorySegment segment# ^ValueLayout byte-layout offset#))))))}
([^MemorySegment segment]
(char (Byte/toUnsignedInt (MemoryAccess/getByte segment))))
(char (Byte/toUnsignedInt (.get segment ^ValueLayout byte-layout 0))))
([^MemorySegment segment ^long offset]
(char (Byte/toUnsignedInt (MemoryAccess/getByteAtOffset segment offset)))))
(char (Byte/toUnsignedInt (.get segment ^ValueLayout byte-layout offset)))))
(defn read-float
"Reads a [[float]] from the `segment`, at an optional `offset`.
@ -410,17 +399,23 @@
{:inline
(fn read-float-inline
([segment]
`(MemoryAccess/getFloat ~segment))
`(let [segment# ~segment]
(.get ^MemorySegment segment# ^ValueLayout float-layout 0)))
([segment offset]
`(MemoryAccess/getFloatAtOffset ~segment ~offset))
`(let [segment# ~segment
offset# ~offset]
(.get ^MemorySegment segment# ^ValueLayout float-layout offset#)))
([segment offset byte-order]
`(MemoryAccess/getFloatAtOffset ~segment ~offset ~byte-order)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order]
(.get ^MemorySegment segment# (.withOrder ^ValueLayout float-layout ^ByteOrder byte-order#) offset#))))}
([^MemorySegment segment]
(MemoryAccess/getFloat segment))
(.get segment ^ValueLayout float-layout 0))
([^MemorySegment segment ^long offset]
(MemoryAccess/getFloatAtOffset segment offset))
(.get segment ^ValueLayout float-layout offset))
([^MemorySegment segment ^long offset ^ByteOrder byte-order]
(MemoryAccess/getFloatAtOffset segment offset byte-order)))
(.get segment (.withOrder ^ValueLayout float-layout byte-order) offset)))
(defn read-double
"Reads a [[double]] from the `segment`, at an optional `offset`.
@ -429,43 +424,57 @@
{:inline
(fn read-double-inline
([segment]
`(MemoryAccess/getDouble ~segment))
`(let [segment# ~segment]
(.get ^MemorySegment segment# ^ValueLayout double-layout 0)))
([segment offset]
`(MemoryAccess/getDoubleAtOffset ~segment ~offset))
`(let [segment# ~segment
offset# ~offset]
(.get ^MemorySegment segment# ^ValueLayout double-layout offset#)))
([segment offset byte-order]
`(MemoryAccess/getDoubleAtOffset ~segment ~offset ~byte-order)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order]
(.get ^MemorySegment segment# (.withOrder ^ValueLayout double-layout ^ByteOrder byte-order#) offset#))))}
(^double [^MemorySegment segment]
(MemoryAccess/getDouble segment))
(.get segment ^ValueLayout double-layout 0))
(^double [^MemorySegment segment ^long offset]
(MemoryAccess/getDoubleAtOffset segment offset))
(.get segment ^ValueLayout double-layout offset))
(^double [^MemorySegment segment ^long offset ^ByteOrder byte-order]
(MemoryAccess/getDoubleAtOffset segment offset byte-order)))
(.get segment (.withOrder ^ValueLayout double-layout byte-order) offset)))
(defn read-address
"Reads a [[MemoryAddress]] from the `segment`, at an optional `offset`."
{:inline
(fn read-address-inline
([segment]
`(MemoryAccess/getAddress ~segment))
`(let [segment# ~segment]
(.get ^MemorySegment segment# ^ValueLayout$OfAddress pointer-layout 0)))
([segment offset]
`(MemoryAccess/getAddressAtOffset ~segment ~offset)))}
`(let [segment# ~segment
offset# ~offset]
(.get ^MemorySegment segment# ^ValueLayout$OfAddress pointer-layout offset#))))}
(^MemoryAddress [^MemorySegment segment]
(MemoryAccess/getAddress segment))
(.get segment ^ValueLayout$OfAddress pointer-layout 0))
(^MemoryAddress [^MemorySegment segment ^long offset]
(MemoryAccess/getAddressAtOffset segment offset)))
(.get segment ^ValueLayout$OfAddress pointer-layout offset)))
(defn write-byte
"Writes a [[byte]] to the `segment`, at an optional `offset`."
{:inline
(fn write-byte-inline
([segment value]
`(MemoryAccess/setByte ~segment ~value))
`(let [segment# ~segment
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout byte-layout 0 value#)))
([segment offset value]
`(MemoryAccess/setByteAtOffset ~segment ~offset ~value)))}
`(let [segment# ~segment
offset# ~offset
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout byte-layout offset# value#))))}
([^MemorySegment segment value]
(MemoryAccess/setByte segment ^byte value))
(.set segment ^ValueLayout byte-layout 0 ^byte value))
([^MemorySegment segment ^long offset value]
(MemoryAccess/setByteAtOffset segment offset ^byte value)))
(.set segment ^ValueLayout byte-layout offset ^byte value)))
(defn write-short
"Writes a [[short]] to the `segment`, at an optional `offset`.
@ -474,17 +483,26 @@
{:inline
(fn write-short-inline
([segment value]
`(MemoryAccess/setShort ~segment ~value))
`(let [segment# ~segment
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout short-layout 0 value#)))
([segment offset value]
`(MemoryAccess/setShortAtOffset ~segment ~offset ~value))
`(let [segment# ~segment
offset# ~offset
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout short-layout offset# value#)))
([segment offset byte-order value]
`(MemoryAccess/setShortAtOffset ~segment ~offset ~byte-order ~value)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order
value# ~value]
(.set ^MemorySegment segment# (.withOrder ^ValueLayout short-layout ^ByteOrder byte-order#) offset# value#))))}
([^MemorySegment segment value]
(MemoryAccess/setShort segment ^short value))
(.set segment ^ValueLayout short-layout 0 ^short value))
([^MemorySegment segment ^long offset value]
(MemoryAccess/setShortAtOffset segment offset ^short value))
(.set segment ^ValueLayout short-layout offset ^short value))
([^MemorySegment segment ^long offset ^ByteOrder byte-order value]
(MemoryAccess/setShortAtOffset segment offset byte-order ^short value)))
(.set segment (.withOrder ^ValueLayout short-layout byte-order) offset ^short value)))
(defn write-int
"Writes a [[int]] to the `segment`, at an optional `offset`.
@ -493,17 +511,26 @@
{:inline
(fn write-int-inline
([segment value]
`(MemoryAccess/setInt ~segment ~value))
`(let [segment# ~segment
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout int-layout 0 value#)))
([segment offset value]
`(MemoryAccess/setIntAtOffset ~segment ~offset ~value))
`(let [segment# ~segment
offset# ~offset
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout int-layout offset# value#)))
([segment offset byte-order value]
`(MemoryAccess/setIntAtOffset ~segment ~offset ~byte-order ~value)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order
value# ~value]
(.set ^MemorySegment segment# (.withOrder ^ValueLayout int-layout ^ByteOrder byte-order#) offset# value#))))}
([^MemorySegment segment value]
(MemoryAccess/setInt segment ^int value))
(.set segment ^ValueLayout int-layout 0 ^int value))
([^MemorySegment segment ^long offset value]
(MemoryAccess/setIntAtOffset segment offset ^int value))
(.set segment ^ValueLayout int-layout offset ^int value))
([^MemorySegment segment ^long offset ^ByteOrder byte-order value]
(MemoryAccess/setIntAtOffset segment offset byte-order ^int value)))
(.set segment (.withOrder ^ValueLayout int-layout byte-order) offset ^int value)))
(defn write-long
"Writes a [[long]] to the `segment`, at an optional `offset`.
@ -512,35 +539,50 @@
{:inline
(fn write-long-inline
([segment value]
`(MemoryAccess/setLong ~segment ~value))
`(let [segment# ~segment
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout long-layout 0 value#)))
([segment offset value]
`(MemoryAccess/setLongAtOffset ~segment ~offset ~value))
`(let [segment# ~segment
offset# ~offset
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout long-layout offset# value#)))
([segment offset byte-order value]
`(MemoryAccess/setLongAtOffset ~segment ~offset ~byte-order ~value)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order
value# ~value]
(.set ^MemorySegment segment# (.withOrder ^ValueLayout long-layout ^ByteOrder byte-order#) offset# value#))))}
(^long [^MemorySegment segment ^long value]
(MemoryAccess/setLong segment value))
(.set segment ^ValueLayout long-layout 0 value))
(^long [^MemorySegment segment ^long offset ^long value]
(MemoryAccess/setLongAtOffset segment offset value))
(.set segment ^ValueLayout long-layout offset value))
(^long [^MemorySegment segment ^long offset ^ByteOrder byte-order ^long value]
(MemoryAccess/setLongAtOffset segment offset byte-order value)))
(.set segment (.withOrder ^ValueLayout long-layout byte-order) offset value)))
(defn write-char
"Writes a [[char]] to the `segment`, at an optional `offset`."
{:inline
(fn write-char-inline
([segment value]
`(MemoryAccess/setByte ~segment (unchecked-byte (unchecked-int ~value))))
`(let [segment# ~segment
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout byte-layout 0 (unchecked-byte (unchecked-int value#)))))
([segment offset value]
`(MemoryAccess/setByteAtOffset ~segment ~offset (unchecked-byte (unchecked-int ~value)))))}
`(let [segment# ~segment
offset# ~offset
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout byte-layout offset# (unchecked-byte (unchecked-int value#))))))}
([^MemorySegment segment value]
(MemoryAccess/setByte
(.set
segment
;; HACK(Joshua): The Clojure runtime doesn't have an unchecked-byte cast for
;; characters, so this double cast is necessary unless I emit
;; my own bytecode with insn.
^ValueLayout byte-layout 0
(unchecked-byte (unchecked-int ^char value))))
([^MemorySegment segment ^long offset value]
(MemoryAccess/setByteAtOffset segment offset (unchecked-byte (unchecked-int ^char value)))))
(.set segment ^ValueLayout byte-layout offset (unchecked-byte (unchecked-int ^char value)))))
(defn write-float
"Writes a [[float]] to the `segment`, at an optional `offset`.
@ -549,17 +591,26 @@
{:inline
(fn write-float-inline
([segment value]
`(MemoryAccess/setFloat ~segment ~value))
`(let [segment# ~segment
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout float-layout 0 value#)))
([segment offset value]
`(MemoryAccess/setFloatAtOffset ~segment ~offset ~value))
`(let [segment# ~segment
offset# ~offset
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout float-layout offset# value#)))
([segment offset byte-order value]
`(MemoryAccess/setFloatAtOffset ~segment ~offset ~byte-order ~value)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order
value# ~value]
(.set ^MemorySegment segment# (.withOrder ^ValueLayout float-layout ^ByteOrder byte-order#) offset# value#))))}
([^MemorySegment segment value]
(MemoryAccess/setFloat segment ^float value))
(.set segment ^ValueLayout float-layout 0 ^float value))
([^MemorySegment segment ^long offset value]
(MemoryAccess/setFloatAtOffset segment offset ^float value))
(.set segment ^ValueLayout float-layout offset ^float value))
([^MemorySegment segment ^long offset ^ByteOrder byte-order value]
(MemoryAccess/setFloatAtOffset segment offset byte-order ^float value)))
(.set segment (.withOrder ^ValueLayout float-layout byte-order) offset ^float value)))
(defn write-double
"Writes a [[double]] to the `segment`, at an optional `offset`.
@ -568,30 +619,44 @@
{:inline
(fn write-double-inline
([segment value]
`(MemoryAccess/setDouble ~segment ~value))
`(let [segment# ~segment
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout double-layout 0 value#)))
([segment offset value]
`(MemoryAccess/setDoubleAtOffset ~segment ~offset ~value))
`(let [segment# ~segment
offset# ~offset
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout double-layout offset# value#)))
([segment offset byte-order value]
`(MemoryAccess/setDoubleAtOffset ~segment ~offset ~byte-order ~value)))}
`(let [segment# ~segment
offset# ~offset
byte-order# ~byte-order
value# ~value]
(.set ^MemorySegment segment# (.withOrder ^ValueLayout double-layout ^ByteOrder byte-order#) offset# value#))))}
(^double [^MemorySegment segment ^double value]
(MemoryAccess/setDouble segment value))
(.set segment ^ValueLayout double-layout 0 value))
(^double [^MemorySegment segment ^long offset ^double value]
(MemoryAccess/setDoubleAtOffset segment offset value))
(.set segment ^ValueLayout double-layout offset value))
(^double [^MemorySegment segment ^long offset ^ByteOrder byte-order ^double value]
(MemoryAccess/setDoubleAtOffset segment offset byte-order value)))
(.set segment (.withOrder ^ValueLayout double-layout byte-order) offset value)))
(defn write-address
"Writes a [[MemoryAddress]] to the `segment`, at an optional `offset`."
{:inline
(fn write-address-inline
([segment value]
`(MemoryAccess/setAddress ~segment ~value))
`(let [segment# ~segment
value# ~value]
(.set ^MemorySegment segment# ^ValueLayout$OfAddress pointer-layout 0 ^Addressable value#)))
([segment offset value]
`(MemoryAccess/setAddressAtOffset ~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]
(MemoryAccess/setAddress segment value))
(.set segment ^ValueLayout$OfAddress pointer-layout 0 value))
(^MemoryAddress [^MemorySegment segment ^long offset ^MemoryAddress value]
(MemoryAccess/setAddressAtOffset segment offset value)))
(.set segment ^ValueLayout$OfAddress pointer-layout offset value)))
(defn- type-dispatch
"Gets a type dispatch value from a (potentially composite) type."
@ -603,7 +668,7 @@
(def primitive-types
"A set of all primitive types."
#{::byte ::short ::int ::long ::long-long
#{::byte ::short ::int ::long
::char ::float ::double ::pointer})
(defn primitive?
@ -644,10 +709,6 @@
[_type]
::long)
(defmethod primitive-type ::long-long
[_type]
::long-long)
(defmethod primitive-type ::char
[_type]
::char)
@ -688,27 +749,21 @@
(defmethod c-layout ::short
[type]
(if (sequential? type)
(.withOrder short-layout (second type))
(.withOrder short-layout ^ByteOrder (second type))
short-layout))
(defmethod c-layout ::int
[type]
(if (sequential? type)
(.withOrder int-layout (second type))
(.withOrder int-layout ^ByteOrder (second type))
int-layout))
(defmethod c-layout ::long
[type]
(if (sequential? type)
(.withOrder long-layout (second type))
(.withOrder long-layout ^ByteOrder (second type))
long-layout))
(defmethod c-layout ::long-long
[type]
(if (sequential? type)
(.withOrder long-long-layout (second type))
long-long-layout))
(defmethod c-layout ::char
[_type]
char-layout)
@ -716,13 +771,13 @@
(defmethod c-layout ::float
[type]
(if (sequential? type)
(.withOrder float-layout (second type))
(.withOrder float-layout ^ByteOrder (second type))
float-layout))
(defmethod c-layout ::double
[type]
(if (sequential? type)
(.withOrder double-layout (second type))
(.withOrder double-layout ^ByteOrder (second type))
double-layout))
(defmethod c-layout ::pointer
@ -735,7 +790,6 @@
::short Short/TYPE
::int Integer/TYPE
::long Long/TYPE
::long-long Long/TYPE
::char Byte/TYPE
::float Float/TYPE
::double Double/TYPE
@ -805,10 +859,6 @@
[obj _type _scope]
(long obj))
(defmethod serialize* ::long-long
[obj _type _scope]
(long obj))
(defmethod serialize* ::char
[obj _type _scope]
(char obj))
@ -886,12 +936,6 @@
(write-long segment 0 (second type) (long obj))
(write-long segment (long obj))))
(defmethod serialize-into ::long-long
[obj type segment _scope]
(if (sequential? type)
(write-long segment 0 (second type) (long obj))
(write-long segment (long obj))))
(defmethod serialize-into ::char
[obj _type segment _scope]
(write-char segment (char obj)))
@ -911,7 +955,7 @@
(defmethod serialize-into ::pointer
[obj type segment scope]
(with-acquired [(segment-scope segment) scope]
(MemoryAccess/setAddress
(write-address
segment
(cond-> obj
(sequential? type) (serialize* type scope)))))
@ -977,12 +1021,6 @@
(read-long segment 0 (second type))
(read-long segment)))
(defmethod deserialize-from ::long-long
[segment type]
(if (sequential? type)
(read-long segment 0 (second type))
(read-long segment)))
(defmethod deserialize-from ::char
[segment _type]
(read-char segment))
@ -1002,7 +1040,7 @@
(defmethod deserialize-from ::pointer
[segment type]
(with-acquired [(segment-scope segment)]
(cond-> (MemoryAccess/getAddress segment)
(cond-> (read-address segment)
(sequential? type) (deserialize* type))))
(defmulti deserialize*
@ -1037,10 +1075,6 @@
[obj _type]
obj)
(defmethod deserialize* ::long-long
[obj _type]
obj)
(defmethod deserialize* ::char
[obj _type]
obj)
@ -1057,7 +1091,7 @@
[addr type]
(when-not (null? addr)
(if (sequential? type)
(deserialize-from (slice-global addr (size-of (second type)))
(deserialize-from (as-segment addr (size-of (second type)))
(second type))
addr)))
@ -1092,13 +1126,13 @@
(defmethod serialize* ::c-string
[obj _type scope]
(if obj
(address-of (CLinker/toCString ^String obj ^ResourceScope scope))
(address-of (.allocateUtf8String (scope-allocator scope) ^String obj))
(MemoryAddress/NULL)))
(defmethod deserialize* ::c-string
[addr _type]
(when-not (null? addr)
(CLinker/toJavaString ^MemoryAddress addr)))
(.getUtf8String ^MemoryAddress addr 0)))
;;; Union types

View file

@ -36,8 +36,8 @@ public class Loader {
*
* @param symbol The name of the symbol to load from a library.
*/
public static MemoryAddress findSymbol(String symbol) {
return CLinker.systemLookup().lookup(symbol)
public static NativeSymbol findSymbol(String symbol) {
return CLinker.systemCLinker().lookup(symbol)
.orElseGet(() -> SymbolLookup.loaderLookup().lookup(symbol).orElse(null));
}
}