Separate memory ops into their own ns
This commit is contained in:
Joshua Suskalo
parent
c90f0e0a18
commit
5f96439432
4 changed files with 807 additions and 768 deletions
120
README.md
120
README.md
|
|
@ -42,11 +42,12 @@ In the simplest cases, the native functions you call will work exclusively with
|
||||||
built-in types, for example the function `strlen` from libc.
|
built-in types, for example the function `strlen` from libc.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(require '[coffi.ffi :as ffi :refer [defcfn defalias]])
|
(require '[coffi.mem :as mem :refer [defalias]])
|
||||||
|
(require '[coffi.ffi :as ffi :refer [defcfn]])
|
||||||
|
|
||||||
(defcfn strlen
|
(defcfn strlen
|
||||||
"Given a string, measures its length in bytes."
|
"Given a string, measures its length in bytes."
|
||||||
strlen [::ffi/c-string] ::ffi/long)
|
strlen [::mem/c-string] ::mem/long)
|
||||||
|
|
||||||
(strlen "hello")
|
(strlen "hello")
|
||||||
;; => 5
|
;; => 5
|
||||||
|
|
@ -61,7 +62,7 @@ If you wish to use a native function as an anonymous function, it can be done
|
||||||
with the `cfn` function.
|
with the `cfn` function.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
((ffi/cfn "strlen" [::ffi/c-string] ::ffi/long) "hello")
|
((ffi/cfn "strlen" [::mem/c-string] ::mem/long) "hello")
|
||||||
;; => 5
|
;; => 5
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
@ -134,7 +135,7 @@ The corresponding coffi definition is like so:
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defcfn zero-point
|
(defcfn zero-point
|
||||||
"zero" [] [::ffi/struct [[:x ::ffi/float] [:y ::ffi/float]]])
|
"zero" [] [::mem/struct [[:x ::mem/float] [:y ::mem/float]]])
|
||||||
|
|
||||||
(zero-point)
|
(zero-point)
|
||||||
;; => {:x 0.0,
|
;; => {:x 0.0,
|
||||||
|
|
@ -146,9 +147,9 @@ macro `defalias` is used to define a struct alias.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defalias ::point
|
(defalias ::point
|
||||||
[::ffi/struct
|
[::mem/struct
|
||||||
[[:x ::ffi/float]
|
[[:x ::mem/float]
|
||||||
[:y ::ffi/float]]])
|
[:y ::mem/float]]])
|
||||||
|
|
||||||
(defcfn zero-point
|
(defcfn zero-point
|
||||||
"zero" [] ::point)
|
"zero" [] ::point)
|
||||||
|
|
@ -159,7 +160,7 @@ native function, but dosn't need to be read back in, the `pointer` primitive
|
||||||
type can take a type argument.
|
type can take a type argument.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
[::ffi/pointer ::ffi/int]
|
[::mem/pointer ::mem/int]
|
||||||
```
|
```
|
||||||
|
|
||||||
Arrays are also supported via a type argument. Keep in mind that they are the
|
Arrays are also supported via a type argument. Keep in mind that they are the
|
||||||
|
|
@ -167,7 +168,7 @@ array itself, and not a pointer to the array like you might see in certain cases
|
||||||
in C.
|
in C.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
[::ffi/array ::ffi/int 3]
|
[::mem/array ::mem/int 3]
|
||||||
```
|
```
|
||||||
|
|
||||||
### Callbacks
|
### Callbacks
|
||||||
|
|
@ -175,7 +176,7 @@ In addition to these composite types, there is also support for Clojure
|
||||||
functions.
|
functions.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
[::ffi/fn [::ffi/c-string] ::ffi/int]
|
[::ffi/fn [::mem/c-string] ::mem/int]
|
||||||
```
|
```
|
||||||
|
|
||||||
Be aware though that if an exception is thrown out of a callback that is called
|
Be aware though that if an exception is thrown out of a callback that is called
|
||||||
|
|
@ -189,14 +190,14 @@ Some native functions can take any number of arguments, and in these cases coffi
|
||||||
provides `vacfn-factory` (for "varargs C function factory").
|
provides `vacfn-factory` (for "varargs C function factory").
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(def printf-factory (ffi/vacfn-factory "printf" [::ffi/c-string] ::ffi/int))
|
(def printf-factory (ffi/vacfn-factory "printf" [::mem/c-string] ::mem/int))
|
||||||
```
|
```
|
||||||
|
|
||||||
This returns a function of the types of the rest of the arguments which itself
|
This returns a function of the types of the rest of the arguments which itself
|
||||||
returns a native function wrapper.
|
returns a native function wrapper.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(def print-int (printf-factory ::ffi/int))
|
(def print-int (printf-factory ::mem/int))
|
||||||
|
|
||||||
(print-int "Some integer: %d\n" 5)
|
(print-int "Some integer: %d\n" 5)
|
||||||
;; Some integer: 5
|
;; Some integer: 5
|
||||||
|
|
@ -213,7 +214,7 @@ Some libraries include global variables or constants accessible through symbols.
|
||||||
To start with, constant values stored in symbols can be fetched with `const`
|
To start with, constant values stored in symbols can be fetched with `const`
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(def some-const (ffi/const "some_const" ::ffi/int))
|
(def some-const (ffi/const "some_const" ::mem/int))
|
||||||
```
|
```
|
||||||
|
|
||||||
This value is fetched once when you call `const` and is turned into a Clojure
|
This value is fetched once when you call `const` and is turned into a Clojure
|
||||||
|
|
@ -221,7 +222,7 @@ value. If you need to refer to a global variable, then `static-variable` can be
|
||||||
used to create a reference to the native value.
|
used to create a reference to the native value.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(def some-var (ffi/static-variable "some_var" ::ffi/int))
|
(def some-var (ffi/static-variable "some_var" ::mem/int))
|
||||||
```
|
```
|
||||||
|
|
||||||
This variable is an `IDeref`. Each time you dereference it, the value will be
|
This variable is an `IDeref`. Each time you dereference it, the value will be
|
||||||
|
|
@ -249,12 +250,12 @@ Clojure code to make this easier.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defcfn takes-array
|
(defcfn takes-array
|
||||||
"takes_array_with_count" [::ffi/pointer ::ffi/long] ::ffi/void
|
"takes_array_with_count" [::mem/pointer ::mem/long] ::mem/void
|
||||||
native-fn
|
native-fn
|
||||||
[ints]
|
[ints]
|
||||||
(let [arr-len (count ints)
|
(let [arr-len (count ints)
|
||||||
int-array (serialize ints [::ffi/array ::ffi/int arr-len]
|
int-array (serialize ints [::mem/array ::mem/int arr-len]
|
||||||
(native-fn (ffi/address-of int-array) arr-len))]))
|
(native-fn (mem/address-of int-array) arr-len))]))
|
||||||
```
|
```
|
||||||
|
|
||||||
The symbol `native-fn` can be any unqualified symbol, and names the native
|
The symbol `native-fn` can be any unqualified symbol, and names the native
|
||||||
|
|
@ -268,17 +269,17 @@ This can be used to implement out variables often seen in native code.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defcfn out-int
|
(defcfn out-int
|
||||||
"out_int" [::ffi/pointer] ::ffi/void
|
"out_int" [::mem/pointer] ::mem/void
|
||||||
native-fn
|
native-fn
|
||||||
[i]
|
[i]
|
||||||
(let [int-ptr (serialize i [::ffi/pointer ::ffi/int])]
|
(let [int-ptr (serialize i [::mem/pointer ::mem/int])]
|
||||||
(native-fn int-ptr)
|
(native-fn int-ptr)
|
||||||
(deserialize int-ptr [::ffi/pointer ::ffi/int])))
|
(deserialize int-ptr [::mem/pointer ::mem/int])))
|
||||||
```
|
```
|
||||||
|
|
||||||
### Scopes
|
### Scopes
|
||||||
In order to serialize any non-primitive type (such as the previous
|
In order to serialize any non-primitive type (such as the previous
|
||||||
`[::ffi/pointer ::ffi/int]`), off-heap memory needs to be allocated. When memory
|
`[::mem/pointer ::mem/int]`), off-heap memory needs to be allocated. When memory
|
||||||
is allocated inside the JVM, the memory is associated with a scope. Because none
|
is allocated inside the JVM, the memory is associated with a scope. Because none
|
||||||
was provided here, the scope is an implicit scope, and the memory will be freed
|
was provided here, the scope is an implicit scope, and the memory will be freed
|
||||||
when the serialized object is garbage collected.
|
when the serialized object is garbage collected.
|
||||||
|
|
@ -294,13 +295,13 @@ stack scope.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defcfn out-int
|
(defcfn out-int
|
||||||
"out_int" [::ffi/pointer] ::ffi/void
|
"out_int" [::mem/pointer] ::mem/void
|
||||||
native-fn
|
native-fn
|
||||||
[i]
|
[i]
|
||||||
(with-open [scope (ffi/stack-scope)]
|
(with-open [scope (mem/stack-scope)]
|
||||||
(let [int-ptr (ffi/serialize i [::ffi/pointer ::ffi/int] scope)]
|
(let [int-ptr (mem/serialize i [::mem/pointer ::mem/int] scope)]
|
||||||
(native-fn int-ptr)
|
(native-fn int-ptr)
|
||||||
(ffi/deserialize int-ptr [::ffi/pointer ::ffi/int]))))
|
(mem/deserialize int-ptr [::mem/pointer ::mem/int]))))
|
||||||
```
|
```
|
||||||
|
|
||||||
This will free the pointer immediately upon leaving the function.
|
This will free the pointer immediately upon leaving the function.
|
||||||
|
|
@ -330,9 +331,9 @@ The multimethod `primitive-type` returns the primitive type that a given type
|
||||||
serializes to. For this example, it should be a pointer.
|
serializes to. For this example, it should be a pointer.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defmethod ffi/primitive-type ::vector
|
(defmethod mem/primitive-type ::vector
|
||||||
[_type]
|
[_type]
|
||||||
::ffi/pointer)
|
::mem/pointer)
|
||||||
```
|
```
|
||||||
|
|
||||||
For any type which doesn't serialize to a primitive, it returns nil, and
|
For any type which doesn't serialize to a primitive, it returns nil, and
|
||||||
|
|
@ -342,14 +343,14 @@ Next is `serialize*` and `deserialize*`, multimethods that work with types that
|
||||||
serialize to primitives.
|
serialize to primitives.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defmethod ffi/serialize* ::vector
|
(defmethod mem/serialize* ::vector
|
||||||
[obj _type scope]
|
[obj _type scope]
|
||||||
(ffi/address-of (ffi/serialize obj [::ffi/array ::ffi/float 3] scope)))
|
(mem/address-of (mem/serialize obj [::mem/array ::mem/float 3] scope)))
|
||||||
|
|
||||||
(defmethod ffi/deserialize* ::vector
|
(defmethod mem/deserialize* ::vector
|
||||||
[addr _type]
|
[addr _type]
|
||||||
(ffi/deserialize (ffi/slice-global addr (ffi/size-of [::ffi/array ::ffi/float 3]))
|
(mem/deserialize (mem/slice-global addr (mem/size-of [::mem/array ::mem/float 3]))
|
||||||
[::ffi/array ::ffi/float 3]))
|
[::mem/array ::mem/float 3]))
|
||||||
```
|
```
|
||||||
|
|
||||||
The `slice-global` function allows you to take an address without an associated
|
The `slice-global` function allows you to take an address without an associated
|
||||||
|
|
@ -361,7 +362,7 @@ function that takes a pointer exists, we could use this:
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defcfn returns-vector
|
(defcfn returns-vector
|
||||||
"returns_vector" [] ::ffi/pointer
|
"returns_vector" [] ::mem/pointer
|
||||||
native-fn
|
native-fn
|
||||||
[scope]
|
[scope]
|
||||||
(let [ret-ptr (native-fn)]
|
(let [ret-ptr (native-fn)]
|
||||||
|
|
@ -387,7 +388,7 @@ To represent this, we can have a `tagged-union` type. For this instance of the
|
||||||
result type, it may look like this:
|
result type, it may look like this:
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
[::tagged-union [:ok :err] {:ok ::ffi/int :err ::ffi/c-string}]
|
[::tagged-union [:ok :err] {:ok ::mem/int :err ::mem/c-string}]
|
||||||
```
|
```
|
||||||
|
|
||||||
The native representation of these objects is a struct of the tag and a union of
|
The native representation of these objects is a struct of the tag and a union of
|
||||||
|
|
@ -396,11 +397,11 @@ we need a representation of the native layout of the data. The `c-layout`
|
||||||
multimethod provides that.
|
multimethod provides that.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defmethod ffi/c-layout ::tagged-union
|
(defmethod mem/c-layout ::tagged-union
|
||||||
[[_tagged-union tags type-map]]
|
[[_tagged-union tags type-map]]
|
||||||
(ffi/c-layout [::ffi/struct
|
(mem/c-layout [::mem/struct
|
||||||
[[:tag ::ffi/long]
|
[[:tag ::mem/long]
|
||||||
[:value [::ffi/union (vals type-map)]]]]))
|
[:value [::mem/union (vals type-map)]]]]))
|
||||||
```
|
```
|
||||||
|
|
||||||
Types with type arguments are represented as vectors of the type name and any
|
Types with type arguments are represented as vectors of the type name and any
|
||||||
|
|
@ -421,13 +422,13 @@ deserialize the value into and out of memory segments. This is accomplished with
|
||||||
(filter (comp #{item} second))
|
(filter (comp #{item} second))
|
||||||
(map first))))
|
(map first))))
|
||||||
|
|
||||||
(defmethod ffi/serialize-into ::tagged-union
|
(defmethod mem/serialize-into ::tagged-union
|
||||||
[obj [_tagged-union tags type-map] segment scope]
|
[obj [_tagged-union tags type-map] segment scope]
|
||||||
(ffi/serialize-into
|
(mem/serialize-into
|
||||||
{:tag (item-index tags (first obj))
|
{:tag (item-index tags (first obj))
|
||||||
:value (second obj)}
|
:value (second obj)}
|
||||||
[::ffi/struct
|
[::mem/struct
|
||||||
[[:tag ::ffi/long]
|
[[:tag ::mem/long]
|
||||||
[:value (get type-map (first obj))]]]
|
[:value (get type-map (first obj))]]]
|
||||||
segment
|
segment
|
||||||
scope))
|
scope))
|
||||||
|
|
@ -438,12 +439,12 @@ a map, and serializes it as a struct, choosing the type of the value based on
|
||||||
the tag.
|
the tag.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(defmethod ffi/deserialize-from ::tagged-union
|
(defmethod mem/deserialize-from ::tagged-union
|
||||||
[segment [_tagged-union tags type-map]]
|
[segment [_tagged-union tags type-map]]
|
||||||
(let [tag (ffi/deserialize-from segment ::ffi/long)]
|
(let [tag (mem/deserialize-from segment ::mem/long)]
|
||||||
[(nth tags tag)
|
[(nth tags tag)
|
||||||
(ffi/deserialize-from
|
(mem/deserialize-from
|
||||||
(ffi/slice segment (ffi/size-of ::ffi/long))
|
(mem/slice segment (mem/size-of ::mem/long))
|
||||||
(get type-map tag))]))
|
(get type-map tag))]))
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
@ -459,11 +460,11 @@ is rather limited. It can be serialized, but not deserialized without external
|
||||||
information.
|
information.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
[::ffi/union
|
[::mem/union
|
||||||
#{::ffi/float ::ffi/double}
|
#{::mem/float ::mem/double}
|
||||||
:dispatch #(cond
|
:dispatch #(cond
|
||||||
(float? %) ::ffi/float
|
(float? %) ::mem/float
|
||||||
(double? %) ::ffi/double)]
|
(double? %) ::mem/double)]
|
||||||
```
|
```
|
||||||
|
|
||||||
This is a minimal union in coffi. If the `:dispatch` keyword argument is not
|
This is a minimal union in coffi. If the `:dispatch` keyword argument is not
|
||||||
|
|
@ -476,11 +477,11 @@ may also be provided. In the case of the value in the tagged union from before,
|
||||||
it could be represented for serialization purposes like so:
|
it could be represented for serialization purposes like so:
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
[::ffi/union
|
[::mem/union
|
||||||
#{::ffi/int ::ffi/c-string}
|
#{::mem/int ::mem/c-string}
|
||||||
:dispatch #(case (first %)
|
:dispatch #(case (first %)
|
||||||
:ok ::ffi/int
|
:ok ::mem/int
|
||||||
:err ::ffi/c-string)
|
:err ::mem/c-string)
|
||||||
:extract second]
|
:extract second]
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
@ -501,8 +502,8 @@ The functions `make-downcall` and `make-varargs-factory` are provided to create
|
||||||
these raw handles.
|
these raw handles.
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
(def raw-strlen (ffi/make-downcall "strlen" [::ffi/c-string] ::ffi/long))
|
(def raw-strlen (ffi/make-downcall "strlen" [::mem/c-string] ::mem/long))
|
||||||
(raw-strlen (ffi/serialize "hello" ::ffi/c-string))
|
(raw-strlen (mem/serialize "hello" ::mem/c-string))
|
||||||
;; => 5
|
;; => 5
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
@ -521,7 +522,7 @@ In addition, function types can be specified as being raw, in the following
|
||||||
manner:
|
manner:
|
||||||
|
|
||||||
```clojure
|
```clojure
|
||||||
[::ffi/fn [::ffi/int] ::ffi/int :raw-fn? true]
|
[::ffi/fn [::mem/int] ::mem/int :raw-fn? true]
|
||||||
```
|
```
|
||||||
|
|
||||||
Clojure functions serialized to this type will have their arguments and return
|
Clojure functions serialized to this type will have their arguments and return
|
||||||
|
|
@ -541,8 +542,8 @@ The data to represent an API is a map with the following form:
|
||||||
(def strlen-libspec
|
(def strlen-libspec
|
||||||
{:strlen {:type :function
|
{:strlen {:type :function
|
||||||
:symbol "strlen"
|
:symbol "strlen"
|
||||||
:function/args [::ffi/c-string]
|
:function/args [::mem/c-string]
|
||||||
:function/ret ::ffi/long}})
|
:function/ret ::mem/long}})
|
||||||
```
|
```
|
||||||
|
|
||||||
Each key in this map represents a single symbol to be loaded. The value is a map
|
Each key in this map represents a single symbol to be loaded. The value is a map
|
||||||
|
|
@ -585,6 +586,7 @@ These features are planned for future releases.
|
||||||
- Support for va_args type
|
- Support for va_args type
|
||||||
- Functions for wrapping structs in padding following various standards
|
- Functions for wrapping structs in padding following various standards
|
||||||
- Header parsing tool for generating a data model?
|
- Header parsing tool for generating a data model?
|
||||||
|
- Generic type aliases
|
||||||
|
|
||||||
## License
|
## License
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -5,6 +5,7 @@
|
||||||
(:require
|
(:require
|
||||||
[clojure.java.io :as io]
|
[clojure.java.io :as io]
|
||||||
[clojure.spec.alpha :as s]
|
[clojure.spec.alpha :as s]
|
||||||
|
[coffi.mem :as mem]
|
||||||
[insn.core :as insn])
|
[insn.core :as insn])
|
||||||
(:import
|
(:import
|
||||||
(clojure.lang
|
(clojure.lang
|
||||||
|
|
@ -18,589 +19,9 @@
|
||||||
Addressable
|
Addressable
|
||||||
CLinker
|
CLinker
|
||||||
FunctionDescriptor
|
FunctionDescriptor
|
||||||
MemoryAccess
|
|
||||||
MemoryAddress
|
|
||||||
MemoryLayout
|
MemoryLayout
|
||||||
MemorySegment
|
|
||||||
ResourceScope
|
|
||||||
SegmentAllocator)))
|
SegmentAllocator)))
|
||||||
|
|
||||||
(defn 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."
|
|
||||||
^ResourceScope []
|
|
||||||
(ResourceScope/newConfinedScope))
|
|
||||||
|
|
||||||
(defn 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."
|
|
||||||
^ResourceScope []
|
|
||||||
(ResourceScope/newSharedScope))
|
|
||||||
|
|
||||||
(defn connected-scope
|
|
||||||
"Constructs a new scope to reclaim all connected resources at once.
|
|
||||||
|
|
||||||
The scope 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 scope cannot be closed, and therefore should not be created in
|
|
||||||
a [[with-open]] clause."
|
|
||||||
^ResourceScope []
|
|
||||||
(ResourceScope/newImplicitScope))
|
|
||||||
|
|
||||||
(defn global-scope
|
|
||||||
"Constructs the global scope, which will never reclaim its resources.
|
|
||||||
|
|
||||||
This scope 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."
|
|
||||||
^ResourceScope []
|
|
||||||
(ResourceScope/globalScope))
|
|
||||||
|
|
||||||
(defn scope-allocator
|
|
||||||
"Constructs a segment allocator from the given `scope`.
|
|
||||||
|
|
||||||
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 [^ResourceScope scope]
|
|
||||||
(SegmentAllocator/ofScope scope))
|
|
||||||
|
|
||||||
(defn alloc
|
|
||||||
"Allocates `size` bytes.
|
|
||||||
|
|
||||||
If a `scope` is provided, the allocation will be reclaimed when it is closed."
|
|
||||||
([size] (alloc size (connected-scope)))
|
|
||||||
([size scope] (MemorySegment/allocateNative (long size) ^ResourceScope scope)))
|
|
||||||
|
|
||||||
(defn alloc-with
|
|
||||||
"Allocates `size` bytes using the `allocator`."
|
|
||||||
([allocator size]
|
|
||||||
(.allocate ^SegmentAllocator allocator (long size)))
|
|
||||||
([allocator size alignment]
|
|
||||||
(.allocate ^SegmentAllocator allocator (long size) (long alignment))))
|
|
||||||
|
|
||||||
(defmacro with-acquired
|
|
||||||
"Acquires a `scope` to ensure it will not be released until the `body` completes.
|
|
||||||
|
|
||||||
This is only necessary to do on shared scopes, however if you are operating on
|
|
||||||
an arbitrary passed scope, it is best practice to wrap code that interacts
|
|
||||||
with it wrapped in this."
|
|
||||||
[scope & body]
|
|
||||||
`(let [scope# ~scope
|
|
||||||
handle# (.acquire ^ResourceScope scope#)]
|
|
||||||
(try ~@body
|
|
||||||
(finally (.release ^ResourceScope scope# handle#)))))
|
|
||||||
|
|
||||||
(defn address-of
|
|
||||||
"Gets the address of a given segment.
|
|
||||||
|
|
||||||
This value can be used as an argument to functions which take a pointer."
|
|
||||||
[addressable]
|
|
||||||
(.address ^Addressable addressable))
|
|
||||||
|
|
||||||
(defn null?
|
|
||||||
"Checks if a memory address is null."
|
|
||||||
[addr]
|
|
||||||
(.equals (MemoryAddress/NULL) 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."
|
|
||||||
[address size]
|
|
||||||
(.asSlice (MemorySegment/globalNativeSegment)
|
|
||||||
^MemoryAddress address (long size)))
|
|
||||||
|
|
||||||
(defn slice
|
|
||||||
"Get a slice over the `segment` with the given `offset`."
|
|
||||||
([segment offset]
|
|
||||||
(.asSlice ^MemorySegment segment (long offset)))
|
|
||||||
([segment offset size]
|
|
||||||
(.asSlice ^MemorySegment segment (long offset) (long size))))
|
|
||||||
|
|
||||||
(defn slice-into
|
|
||||||
"Get a slice into the `segment` starting at the `address`."
|
|
||||||
([address segment]
|
|
||||||
(.asSlice ^MemorySegment segment ^MemoryAddress address))
|
|
||||||
([address segment size]
|
|
||||||
(.asSlice ^MemorySegment segment ^MemoryAddress address (long size))))
|
|
||||||
|
|
||||||
(defn with-offset
|
|
||||||
"Get a new address `offset` from the old `address`."
|
|
||||||
[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."
|
|
||||||
([address size scope]
|
|
||||||
(.asSegment ^MemoryAddress address size scope))
|
|
||||||
([address size scope cleanup]
|
|
||||||
(.asSegment ^MemoryAddress address size cleanup scope)))
|
|
||||||
|
|
||||||
(defn add-close-action!
|
|
||||||
"Adds a 0-arity function to be run when the `scope` closes."
|
|
||||||
[scope action]
|
|
||||||
(.addCloseAction ^ResourceScope scope action))
|
|
||||||
|
|
||||||
(defn copy-segment
|
|
||||||
"Copies the content to `dest` from `src`"
|
|
||||||
[dest src]
|
|
||||||
(.copyFrom ^MemorySegment dest ^MemorySegment src))
|
|
||||||
|
|
||||||
(defn clone-segment
|
|
||||||
"Clones the content of `segment` into a new segment of the same size."
|
|
||||||
([segment] (clone-segment segment (connected-scope)))
|
|
||||||
([segment scope]
|
|
||||||
(doto ^MemorySegment (alloc (.byteSize ^MemorySegment segment) scope)
|
|
||||||
(copy-segment segment))))
|
|
||||||
|
|
||||||
(defn slice-segments
|
|
||||||
"Constructs a lazy seq of `size`-length memory segments, sliced from `segment`."
|
|
||||||
[segment size]
|
|
||||||
(let [num-segments (quot (.byteSize ^MemorySegment segment) size)]
|
|
||||||
(map #(slice segment (* % size) size)
|
|
||||||
(range num-segments))))
|
|
||||||
|
|
||||||
(def primitive-types
|
|
||||||
"A set of keywords representing all the primitive types which may be passed to
|
|
||||||
or returned from native functions."
|
|
||||||
#{::byte ::short ::int ::long ::long-long
|
|
||||||
::char
|
|
||||||
::float ::double
|
|
||||||
::pointer ::void})
|
|
||||||
|
|
||||||
(defn- type-dispatch
|
|
||||||
"Gets a type dispatch value from a (potentially composite) type."
|
|
||||||
[type]
|
|
||||||
(cond
|
|
||||||
(qualified-keyword? type) type
|
|
||||||
(sequential? type) (keyword (first type))))
|
|
||||||
|
|
||||||
(defmulti primitive-type
|
|
||||||
"Gets the primitive type that is used to pass as an argument for the `type`.
|
|
||||||
|
|
||||||
This is for objects which are passed to native functions as primitive types,
|
|
||||||
but which need additional logic to be performed during serialization and
|
|
||||||
deserialization.
|
|
||||||
|
|
||||||
Returns nil for any type which does not have a primitive representation."
|
|
||||||
type-dispatch)
|
|
||||||
|
|
||||||
(defmethod primitive-type :default
|
|
||||||
[type]
|
|
||||||
(primitive-types type))
|
|
||||||
|
|
||||||
(defmethod primitive-type ::pointer
|
|
||||||
[_type]
|
|
||||||
::pointer)
|
|
||||||
|
|
||||||
(def c-prim-layout
|
|
||||||
"Map of primitive type names to the [[CLinker]] types for a method handle."
|
|
||||||
{::byte CLinker/C_CHAR
|
|
||||||
::short CLinker/C_SHORT
|
|
||||||
::int CLinker/C_INT
|
|
||||||
::long CLinker/C_LONG
|
|
||||||
::long-long CLinker/C_LONG_LONG
|
|
||||||
::char CLinker/C_CHAR
|
|
||||||
::float CLinker/C_FLOAT
|
|
||||||
::double CLinker/C_DOUBLE
|
|
||||||
::pointer CLinker/C_POINTER})
|
|
||||||
|
|
||||||
(defmulti c-layout
|
|
||||||
"Gets the layout object for a given `type`.
|
|
||||||
|
|
||||||
If a type is primitive it will return the appropriate primitive
|
|
||||||
layout (see [[c-prim-layout]]).
|
|
||||||
|
|
||||||
Otherwise, it should return a [[GroupLayout]] for the given type."
|
|
||||||
type-dispatch)
|
|
||||||
|
|
||||||
(defmethod c-layout :default
|
|
||||||
[type]
|
|
||||||
(c-prim-layout (or (primitive-type type) type)))
|
|
||||||
|
|
||||||
(def java-prim-layout
|
|
||||||
"Map of primitive type names to the Java types for a method handle."
|
|
||||||
{::byte Byte/TYPE
|
|
||||||
::short Short/TYPE
|
|
||||||
::int Integer/TYPE
|
|
||||||
::long Long/TYPE
|
|
||||||
::long-long Long/TYPE
|
|
||||||
::char Byte/TYPE
|
|
||||||
::float Float/TYPE
|
|
||||||
::double Double/TYPE
|
|
||||||
::pointer MemoryAddress
|
|
||||||
::void Void/TYPE})
|
|
||||||
|
|
||||||
(defn java-layout
|
|
||||||
"Gets the Java class to an argument of this type for a method handle.
|
|
||||||
|
|
||||||
If a type serializes to a primitive it returns return a Java primitive type.
|
|
||||||
Otherwise, it returns [[MemorySegment]]."
|
|
||||||
[type]
|
|
||||||
(java-prim-layout (or (primitive-type type) type) MemorySegment))
|
|
||||||
|
|
||||||
(defn size-of
|
|
||||||
"The size in bytes of the given `type`."
|
|
||||||
[type]
|
|
||||||
(.byteSize ^MemoryLayout (c-layout type)))
|
|
||||||
|
|
||||||
(defn alloc-instance
|
|
||||||
"Allocates a memory segment for the given `type`."
|
|
||||||
([type] (alloc-instance type (connected-scope)))
|
|
||||||
([type scope] (MemorySegment/allocateNative (long (size-of type)) ^ResourceScope scope)))
|
|
||||||
|
|
||||||
(declare serialize serialize-into)
|
|
||||||
|
|
||||||
(defmulti serialize*
|
|
||||||
"Constructs a serialized version of the `obj` and returns it.
|
|
||||||
|
|
||||||
Any new allocations made during the serialization should be tied to the given
|
|
||||||
`scope`, except in extenuating circumstances.
|
|
||||||
|
|
||||||
This method should only be implemented for types that serialize to primitives."
|
|
||||||
(fn
|
|
||||||
#_{:clj-kondo/ignore [:unused-binding]}
|
|
||||||
[obj type scope]
|
|
||||||
(type-dispatch type)))
|
|
||||||
|
|
||||||
(def ^:private primitive-cast
|
|
||||||
"Map from primitive type names to the function to cast it to a primitive."
|
|
||||||
{::byte byte
|
|
||||||
::short short
|
|
||||||
::int int
|
|
||||||
::long long
|
|
||||||
::long-long long
|
|
||||||
::char char
|
|
||||||
::float float
|
|
||||||
::double double})
|
|
||||||
|
|
||||||
(defmethod serialize* :default
|
|
||||||
[obj type _scope]
|
|
||||||
(if-let [prim (primitive-type type)]
|
|
||||||
((primitive-cast prim) obj)
|
|
||||||
(throw (ex-info "Attempted to serialize a non-primitive type with primitive methods"
|
|
||||||
{:type type
|
|
||||||
:object obj}))))
|
|
||||||
|
|
||||||
(defmethod serialize* ::pointer
|
|
||||||
[obj type scope]
|
|
||||||
(when-not (null? obj)
|
|
||||||
(if (sequential? type)
|
|
||||||
(let [segment (alloc-instance (second type) scope)]
|
|
||||||
(serialize-into obj (second type) segment scope)
|
|
||||||
(address-of segment))
|
|
||||||
obj)))
|
|
||||||
|
|
||||||
(defmulti serialize-into
|
|
||||||
"Writes a serialized version of the `obj` to the given `segment`.
|
|
||||||
|
|
||||||
Any new allocations made during the serialization should be tied to the given
|
|
||||||
`scope`, except in extenuating circumstances.
|
|
||||||
|
|
||||||
This method should be implemented for any type which does not
|
|
||||||
override [[c-layout]].
|
|
||||||
|
|
||||||
For any other type, this will serialize it as [[serialize*]] before writing
|
|
||||||
the result value into the `segment`."
|
|
||||||
(fn
|
|
||||||
#_{:clj-kondo/ignore [:unused-binding]}
|
|
||||||
[obj type segment scope]
|
|
||||||
(type-dispatch type)))
|
|
||||||
|
|
||||||
(defmethod serialize-into :default
|
|
||||||
[obj type segment scope]
|
|
||||||
(if-some [prim-layout (primitive-type type)]
|
|
||||||
(serialize-into (serialize* obj type scope) prim-layout segment scope)
|
|
||||||
(throw (ex-info "Attempted to serialize an object to a type that has not been overriden"
|
|
||||||
{:type type
|
|
||||||
:object obj}))))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::byte
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setByte segment (byte obj)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::short
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setShort segment (short obj)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::int
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setInt segment (int obj)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::long
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setLong segment (long obj)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::long-long
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setLong segment (long obj)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::char
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setChar segment (char obj)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::float
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setFloat segment (float obj)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::double
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setDouble segment (double obj)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::pointer
|
|
||||||
[obj _type segment _scope]
|
|
||||||
(MemoryAccess/setAddress segment obj))
|
|
||||||
|
|
||||||
(defn serialize
|
|
||||||
"Serializes an arbitrary type.
|
|
||||||
|
|
||||||
For types which have a primitive representation, this serializes into that
|
|
||||||
representation. For types which do not, it allocates a new segment and
|
|
||||||
serializes into that."
|
|
||||||
([obj type] (serialize obj type (connected-scope)))
|
|
||||||
([obj type scope]
|
|
||||||
(if (primitive-type type)
|
|
||||||
(serialize* obj type scope)
|
|
||||||
(let [segment (alloc-instance type scope)]
|
|
||||||
(serialize-into obj type segment scope)
|
|
||||||
segment))))
|
|
||||||
|
|
||||||
(declare deserialize deserialize*)
|
|
||||||
|
|
||||||
(defmulti deserialize-from
|
|
||||||
"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*]]."
|
|
||||||
(fn
|
|
||||||
#_{:clj-kondo/ignore [:unused-binding]}
|
|
||||||
[segment type]
|
|
||||||
(type-dispatch type)))
|
|
||||||
|
|
||||||
(defmethod deserialize-from :default
|
|
||||||
[segment type]
|
|
||||||
(if-some [prim (primitive-type type)]
|
|
||||||
(-> segment
|
|
||||||
(deserialize-from prim)
|
|
||||||
(deserialize* type))
|
|
||||||
(throw (ex-info "Attempted to deserialize a non-primitive type that has not been overriden"
|
|
||||||
{:type type
|
|
||||||
:segment segment}))))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::byte
|
|
||||||
[segment _type]
|
|
||||||
(MemoryAccess/getByte segment))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::short
|
|
||||||
[segment _type]
|
|
||||||
(MemoryAccess/getShort segment))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::int
|
|
||||||
[segment _type]
|
|
||||||
(MemoryAccess/getInt segment))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::long
|
|
||||||
[segment _type]
|
|
||||||
(MemoryAccess/getLong segment))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::long-long
|
|
||||||
[segment _type]
|
|
||||||
(MemoryAccess/getLong segment))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::char
|
|
||||||
[segment _type]
|
|
||||||
(MemoryAccess/getChar segment))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::float
|
|
||||||
[segment _type]
|
|
||||||
(MemoryAccess/getFloat segment))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::double
|
|
||||||
[segment _type]
|
|
||||||
(MemoryAccess/getDouble segment))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::pointer
|
|
||||||
[segment type]
|
|
||||||
(cond-> (MemoryAccess/getAddress segment)
|
|
||||||
(sequential? type) (deserialize* type)))
|
|
||||||
|
|
||||||
(defmulti deserialize*
|
|
||||||
"Deserializes a primitive object into a Clojure data structure.
|
|
||||||
|
|
||||||
This is intended for use with types that are returned as a primitive but which
|
|
||||||
need additional processing before they can be returned."
|
|
||||||
(fn
|
|
||||||
#_{:clj-kondo/ignore [:unused-binding]}
|
|
||||||
[obj type]
|
|
||||||
(type-dispatch type)))
|
|
||||||
|
|
||||||
(defmethod deserialize* :default
|
|
||||||
[obj type]
|
|
||||||
(if (primitive-type type)
|
|
||||||
obj
|
|
||||||
(throw (ex-info "Attempted to deserialize a non-primitive type with primitive methods"
|
|
||||||
{:type type
|
|
||||||
:segment obj}))))
|
|
||||||
|
|
||||||
(defmethod deserialize* ::pointer
|
|
||||||
[addr type]
|
|
||||||
(when-not (null? addr)
|
|
||||||
(if (sequential? type)
|
|
||||||
(deserialize-from (slice-global addr (size-of (second type)))
|
|
||||||
(second type))
|
|
||||||
addr)))
|
|
||||||
|
|
||||||
(defn deserialize
|
|
||||||
"Deserializes an arbitrary type.
|
|
||||||
|
|
||||||
For types which have a primitive representation, this deserializes the
|
|
||||||
primitive representation. For types which do not, this deserializes out of
|
|
||||||
a segment."
|
|
||||||
[obj type]
|
|
||||||
(when-not (identical? ::void type)
|
|
||||||
((if (primitive-type type)
|
|
||||||
deserialize*
|
|
||||||
deserialize-from)
|
|
||||||
obj type)))
|
|
||||||
|
|
||||||
(defn seq-of
|
|
||||||
"Constructs a lazy sequence of `type` elements deserialized from `segment`."
|
|
||||||
[type segment]
|
|
||||||
(map #(deserialize % type) (slice-segments segment (size-of type))))
|
|
||||||
|
|
||||||
;;; C String type
|
|
||||||
|
|
||||||
(defmethod primitive-type ::c-string
|
|
||||||
[_type]
|
|
||||||
::pointer)
|
|
||||||
|
|
||||||
(defmethod serialize* ::c-string
|
|
||||||
[obj _type scope]
|
|
||||||
(if obj
|
|
||||||
(address-of (CLinker/toCString ^String obj ^ResourceScope scope))
|
|
||||||
(MemoryAddress/NULL)))
|
|
||||||
|
|
||||||
(defmethod deserialize* ::c-string
|
|
||||||
[addr _type]
|
|
||||||
(when-not (null? addr)
|
|
||||||
(CLinker/toJavaString ^MemoryAddress addr)))
|
|
||||||
|
|
||||||
;;; Union types
|
|
||||||
|
|
||||||
(defmethod c-layout ::union
|
|
||||||
[[_union types & {:as _opts} :as _type]]
|
|
||||||
(let [items (map c-layout types)]
|
|
||||||
(MemoryLayout/unionLayout
|
|
||||||
(into-array MemoryLayout items))))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::union
|
|
||||||
[obj [_union _types & {:keys [dispatch extract]} :as type] segment scope]
|
|
||||||
(when-not dispatch
|
|
||||||
(throw (ex-info "Attempted to serialize a union with no dispatch function"
|
|
||||||
{:type type
|
|
||||||
:value obj})))
|
|
||||||
(let [type (dispatch obj)]
|
|
||||||
(serialize-into
|
|
||||||
(if extract
|
|
||||||
(extract type obj)
|
|
||||||
obj)
|
|
||||||
type
|
|
||||||
segment
|
|
||||||
scope)))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::union
|
|
||||||
[segment type]
|
|
||||||
(clone-segment (slice segment 0 (size-of type))))
|
|
||||||
|
|
||||||
;;; Struct types
|
|
||||||
|
|
||||||
(defmethod c-layout ::struct
|
|
||||||
[[_struct fields]]
|
|
||||||
(let [fields (for [[field-name field] fields]
|
|
||||||
(.withName ^MemoryLayout (c-layout field)
|
|
||||||
(name field-name)))]
|
|
||||||
(MemoryLayout/structLayout
|
|
||||||
(into-array MemoryLayout fields))))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::struct
|
|
||||||
[obj [_struct fields] segment scope]
|
|
||||||
(loop [offset 0
|
|
||||||
fields fields]
|
|
||||||
(when (seq fields)
|
|
||||||
(let [[field type] (first fields)
|
|
||||||
size (size-of type)]
|
|
||||||
(serialize-into
|
|
||||||
(get obj field) type
|
|
||||||
(slice segment offset size) scope)
|
|
||||||
(recur (long (+ offset size)) (rest fields))))))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::struct
|
|
||||||
[segment [_struct fields]]
|
|
||||||
(loop [offset 0
|
|
||||||
fields fields
|
|
||||||
obj {}]
|
|
||||||
(if (seq fields)
|
|
||||||
(let [[field type] (first fields)
|
|
||||||
size (size-of type)]
|
|
||||||
(recur
|
|
||||||
(long (+ offset size))
|
|
||||||
(rest fields)
|
|
||||||
(assoc obj field (deserialize-from
|
|
||||||
(slice segment offset size)
|
|
||||||
type))))
|
|
||||||
obj)))
|
|
||||||
|
|
||||||
;;; Padding type
|
|
||||||
|
|
||||||
(defmethod c-layout ::padding
|
|
||||||
[[_padding size]]
|
|
||||||
(MemoryLayout/paddingLayout (* 8 size)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::padding
|
|
||||||
[_obj [_padding _size] _segment _scope]
|
|
||||||
nil)
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::padding
|
|
||||||
[_segment [_padding _size]]
|
|
||||||
nil)
|
|
||||||
|
|
||||||
;;; Array types
|
|
||||||
|
|
||||||
(defmethod c-layout ::array
|
|
||||||
[[_array type count]]
|
|
||||||
(MemoryLayout/sequenceLayout
|
|
||||||
count
|
|
||||||
(c-layout type)))
|
|
||||||
|
|
||||||
(defmethod serialize-into ::array
|
|
||||||
[obj [_array type count] segment scope]
|
|
||||||
(dorun
|
|
||||||
(map #(serialize-into %1 type %2 scope)
|
|
||||||
obj
|
|
||||||
(slice-segments (slice segment 0 (* count (size-of type)))
|
|
||||||
(size-of type)))))
|
|
||||||
|
|
||||||
(defmethod deserialize-from ::array
|
|
||||||
[segment [_array type count]]
|
|
||||||
(map #(deserialize-from % type)
|
|
||||||
(slice-segments (slice segment 0 (* count (size-of type)))
|
|
||||||
(size-of type))))
|
|
||||||
|
|
||||||
;;; FFI Code loading and function access
|
;;; FFI Code loading and function access
|
||||||
|
|
||||||
(defn load-system-library
|
(defn load-system-library
|
||||||
|
|
@ -621,20 +42,20 @@
|
||||||
|
|
||||||
(defn- method-type
|
(defn- method-type
|
||||||
"Gets the [[MethodType]] for a set of `args` and `ret` types."
|
"Gets the [[MethodType]] for a set of `args` and `ret` types."
|
||||||
([args] (method-type args ::void))
|
([args] (method-type args ::mem/void))
|
||||||
([args ret]
|
([args ret]
|
||||||
(MethodType/methodType
|
(MethodType/methodType
|
||||||
^Class (java-layout ret)
|
^Class (mem/java-layout ret)
|
||||||
^"[Ljava.lang.Class;" (into-array Class (map java-layout args)))))
|
^"[Ljava.lang.Class;" (into-array Class (map mem/java-layout args)))))
|
||||||
|
|
||||||
(defn- function-descriptor
|
(defn- function-descriptor
|
||||||
"Gets the [[FunctionDescriptor]] for a set of `args` and `ret` types."
|
"Gets the [[FunctionDescriptor]] for a set of `args` and `ret` types."
|
||||||
([args] (function-descriptor args ::void))
|
([args] (function-descriptor args ::mem/void))
|
||||||
([args ret]
|
([args ret]
|
||||||
(let [args-arr (into-array MemoryLayout (map c-layout args))]
|
(let [args-arr (into-array MemoryLayout (map mem/c-layout args))]
|
||||||
(if-not (identical? ret ::void)
|
(if-not (identical? ret ::mem/void)
|
||||||
(FunctionDescriptor/of
|
(FunctionDescriptor/of
|
||||||
(c-layout ret)
|
(mem/c-layout ret)
|
||||||
args-arr)
|
args-arr)
|
||||||
(FunctionDescriptor/ofVoid
|
(FunctionDescriptor/ofVoid
|
||||||
args-arr)))))
|
args-arr)))))
|
||||||
|
|
@ -646,26 +67,26 @@
|
||||||
|
|
||||||
(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."
|
||||||
{::byte :bload
|
{::mem/byte :bload
|
||||||
::short :sload
|
::mem/short :sload
|
||||||
::int :iload
|
::mem/int :iload
|
||||||
::long :lload
|
::mem/long :lload
|
||||||
::long-long :lload
|
::mem/long-long :lload
|
||||||
::char :cload
|
::mem/char :cload
|
||||||
::float :fload
|
::mem/float :fload
|
||||||
::double :dload
|
::mem/double :dload
|
||||||
::pointer :aload})
|
::mem/pointer :aload})
|
||||||
|
|
||||||
(def ^:private prim-classes
|
(def ^:private prim-classes
|
||||||
"Mapping from primitive types to their box classes."
|
"Mapping from primitive types to their box classes."
|
||||||
{::byte Byte
|
{::mem/byte Byte
|
||||||
::short Short
|
::mem/short Short
|
||||||
::int Integer
|
::mem/int Integer
|
||||||
::long Long
|
::mem/long Long
|
||||||
::long-long Long
|
::mem/long-long Long
|
||||||
::char Character
|
::mem/char Character
|
||||||
::float Float
|
::mem/float Float
|
||||||
::double Double})
|
::mem/double Double})
|
||||||
|
|
||||||
(defn- to-object-asm
|
(defn- to-object-asm
|
||||||
"Constructs a bytecode sequence to box a primitive on the top of the stack.
|
"Constructs a bytecode sequence to box a primitive on the top of the stack.
|
||||||
|
|
@ -674,10 +95,10 @@
|
||||||
null reference will be pushed to the stack."
|
null reference will be pushed to the stack."
|
||||||
[type]
|
[type]
|
||||||
(cond
|
(cond
|
||||||
(identical? ::void type) [:ldc nil]
|
(identical? ::mem/void type) [:ldc nil]
|
||||||
(identical? ::pointer (primitive-type type)) []
|
(identical? ::mem/pointer (mem/primitive-type type)) []
|
||||||
:else
|
:else
|
||||||
(let [prim-type (some-> type primitive-type)]
|
(let [prim-type (some-> type mem/primitive-type)]
|
||||||
(if-some [prim (some-> prim-type name keyword)]
|
(if-some [prim (some-> prim-type name keyword)]
|
||||||
;; Box primitive
|
;; Box primitive
|
||||||
[:invokestatic (prim-classes prim-type) "valueOf" [prim (prim-classes prim-type)]]
|
[:invokestatic (prim-classes prim-type) "valueOf" [prim (prim-classes prim-type)]]
|
||||||
|
|
@ -687,20 +108,20 @@
|
||||||
(defn- insn-layout
|
(defn- insn-layout
|
||||||
"Gets the type keyword or class for referring to the type in bytecode."
|
"Gets the type keyword or class for referring to the type in bytecode."
|
||||||
[type]
|
[type]
|
||||||
(if (some-> (primitive-type type) (not= ::pointer))
|
(if (some-> (mem/primitive-type type) (not= ::mem/pointer))
|
||||||
(keyword (name type))
|
(keyword (name type))
|
||||||
(java-layout type)))
|
(mem/java-layout type)))
|
||||||
|
|
||||||
(def ^:private unbox-fn-for-type
|
(def ^:private unbox-fn-for-type
|
||||||
"Map from type name to the name of its unboxing function."
|
"Map from type name to the name of its unboxing function."
|
||||||
{::byte "byteValue"
|
{::mem/byte "byteValue"
|
||||||
::short "shortValue"
|
::mem/short "shortValue"
|
||||||
::int "intValue"
|
::mem/int "intValue"
|
||||||
::long "longValue"
|
::mem/long "longValue"
|
||||||
::long-long "longValue"
|
::mem/long-long "longValue"
|
||||||
::char "charValue"
|
::mem/char "charValue"
|
||||||
::float "floatValue"
|
::mem/float "floatValue"
|
||||||
::double "doubleValue"})
|
::mem/double "doubleValue"})
|
||||||
|
|
||||||
(defn- to-prim-asm
|
(defn- to-prim-asm
|
||||||
"Constructs a bytecode sequence to unbox a primitive type on top of the stack.
|
"Constructs a bytecode sequence to unbox a primitive type on top of the stack.
|
||||||
|
|
@ -709,10 +130,10 @@
|
||||||
will be popped."
|
will be popped."
|
||||||
[type]
|
[type]
|
||||||
(cond
|
(cond
|
||||||
(identical? ::void type) [:pop]
|
(identical? ::mem/void type) [:pop]
|
||||||
(identical? ::pointer (primitive-type type)) []
|
(identical? ::mem/pointer (mem/primitive-type type)) []
|
||||||
:else
|
:else
|
||||||
(let [prim-type (some-> type primitive-type)]
|
(let [prim-type (some-> type mem/primitive-type)]
|
||||||
(if-some [prim (some-> prim-type name keyword)]
|
(if-some [prim (some-> prim-type name keyword)]
|
||||||
[[:checkcast (prim-classes prim-type)]
|
[[:checkcast (prim-classes prim-type)]
|
||||||
[:invokevirtual (prim-classes prim-type) (unbox-fn-for-type prim-type) [prim]]]
|
[:invokevirtual (prim-classes prim-type) (unbox-fn-for-type prim-type) [prim]]]
|
||||||
|
|
@ -739,24 +160,24 @@
|
||||||
{:name :invoke
|
{:name :invoke
|
||||||
:flags #{:public}
|
:flags #{:public}
|
||||||
:desc (repeat (cond-> (inc (count args))
|
:desc (repeat (cond-> (inc (count args))
|
||||||
(not (primitive-type ret)) inc)
|
(not (mem/primitive-type ret)) inc)
|
||||||
Object)
|
Object)
|
||||||
:emit [[:aload 0]
|
:emit [[:aload 0]
|
||||||
[:getfield :this "downcall_handle" MethodHandle]
|
[:getfield :this "downcall_handle" MethodHandle]
|
||||||
(when-not (primitive-type ret)
|
(when-not (mem/primitive-type ret)
|
||||||
[[:aload 1]
|
[[:aload 1]
|
||||||
[:checkcast SegmentAllocator]])
|
[:checkcast SegmentAllocator]])
|
||||||
(map-indexed
|
(map-indexed
|
||||||
(fn [idx arg]
|
(fn [idx arg]
|
||||||
[[:aload (cond-> (inc idx)
|
[[:aload (cond-> (inc idx)
|
||||||
(not (primitive-type ret)) inc)]
|
(not (mem/primitive-type ret)) inc)]
|
||||||
(to-prim-asm arg)])
|
(to-prim-asm arg)])
|
||||||
args)
|
args)
|
||||||
[:invokevirtual MethodHandle "invokeExact"
|
[:invokevirtual MethodHandle "invokeExact"
|
||||||
(cond->>
|
(cond->>
|
||||||
(conj (mapv insn-layout args)
|
(conj (mapv insn-layout args)
|
||||||
(insn-layout ret))
|
(insn-layout ret))
|
||||||
(not (primitive-type ret)) (cons SegmentAllocator))]
|
(not (mem/primitive-type ret)) (cons SegmentAllocator))]
|
||||||
(to-object-asm ret)
|
(to-object-asm ret)
|
||||||
[:areturn]]}]})
|
[:areturn]]}]})
|
||||||
|
|
||||||
|
|
@ -770,7 +191,7 @@
|
||||||
calls [[find-symbol]] on it."
|
calls [[find-symbol]] on it."
|
||||||
[symbol-or-addr]
|
[symbol-or-addr]
|
||||||
(if (instance? Addressable symbol-or-addr)
|
(if (instance? Addressable symbol-or-addr)
|
||||||
(address-of symbol-or-addr)
|
(mem/address-of symbol-or-addr)
|
||||||
(find-symbol symbol-or-addr)))
|
(find-symbol symbol-or-addr)))
|
||||||
|
|
||||||
(defn make-downcall
|
(defn make-downcall
|
||||||
|
|
@ -812,17 +233,17 @@
|
||||||
"Constructs a wrapper function for the `downcall` which serializes the arguments
|
"Constructs a wrapper function for the `downcall` which serializes the arguments
|
||||||
and deserializes the return value."
|
and deserializes the return value."
|
||||||
[downcall arg-types ret-type]
|
[downcall arg-types ret-type]
|
||||||
(if (primitive-type ret-type)
|
(if (mem/primitive-type ret-type)
|
||||||
(fn native-fn [& args]
|
(fn native-fn [& args]
|
||||||
(with-open [scope (stack-scope)]
|
(with-open [scope (mem/stack-scope)]
|
||||||
(deserialize
|
(mem/deserialize
|
||||||
(apply downcall (map #(serialize %1 %2 scope) args arg-types))
|
(apply downcall (map #(mem/serialize %1 %2 scope) args arg-types))
|
||||||
ret-type)))
|
ret-type)))
|
||||||
(fn native-fn [& args]
|
(fn native-fn [& args]
|
||||||
(with-open [scope (stack-scope)]
|
(with-open [scope (mem/stack-scope)]
|
||||||
(deserialize
|
(mem/deserialize
|
||||||
(apply downcall (scope-allocator scope)
|
(apply downcall (mem/scope-allocator scope)
|
||||||
(map #(serialize %1 %2 scope) args arg-types))
|
(map #(mem/serialize %1 %2 scope) args arg-types))
|
||||||
ret-type)))))
|
ret-type)))))
|
||||||
|
|
||||||
(defn make-serde-varargs-wrapper
|
(defn make-serde-varargs-wrapper
|
||||||
|
|
@ -864,15 +285,15 @@
|
||||||
|
|
||||||
(def ^:private return-for-type
|
(def ^:private return-for-type
|
||||||
"Map from type name to the return instruction for that type."
|
"Map from type name to the return instruction for that type."
|
||||||
{::byte :breturn
|
{::mem/byte :breturn
|
||||||
::short :sreturn
|
::mem/short :sreturn
|
||||||
::int :ireturn
|
::mem/int :ireturn
|
||||||
::long :lreturn
|
::mem/long :lreturn
|
||||||
::long-long :lreturn
|
::mem/long-long :lreturn
|
||||||
::char :creturn
|
::mem/char :creturn
|
||||||
::float :freturn
|
::mem/float :freturn
|
||||||
::double :dreturn
|
::mem/double :dreturn
|
||||||
::void :return})
|
::mem/void :return})
|
||||||
|
|
||||||
(defn- upcall-class
|
(defn- upcall-class
|
||||||
"Constructs a class definition for a class with a single method, `upcall`, which
|
"Constructs a class definition for a class with a single method, `upcall`, which
|
||||||
|
|
@ -893,8 +314,8 @@
|
||||||
[:return]]}
|
[:return]]}
|
||||||
{:name :upcall
|
{:name :upcall
|
||||||
:flags #{:public}
|
:flags #{:public}
|
||||||
:desc (conj (mapv java-layout arg-types)
|
:desc (conj (mapv mem/java-layout arg-types)
|
||||||
(java-layout ret-type))
|
(mem/java-layout ret-type))
|
||||||
:emit [[:aload 0]
|
:emit [[:aload 0]
|
||||||
[:getfield :this "upcall_ifn" IFn]
|
[:getfield :this "upcall_ifn" IFn]
|
||||||
(map-indexed
|
(map-indexed
|
||||||
|
|
@ -920,21 +341,21 @@
|
||||||
"upcall"
|
"upcall"
|
||||||
(method-type arg-types ret-type)))
|
(method-type arg-types ret-type)))
|
||||||
|
|
||||||
(defmethod primitive-type ::fn
|
(defmethod mem/primitive-type ::fn
|
||||||
[_type]
|
[_type]
|
||||||
::pointer)
|
::mem/pointer)
|
||||||
|
|
||||||
(defn- upcall-serde-wrapper
|
(defn- upcall-serde-wrapper
|
||||||
"Creates a function that wraps `f` which deserializes the arguments and
|
"Creates a function that wraps `f` which deserializes the arguments and
|
||||||
serializes the return type in the [[global-scope]]."
|
serializes the return type in the [[global-scope]]."
|
||||||
[f arg-types ret-type]
|
[f arg-types ret-type]
|
||||||
(fn [& args]
|
(fn [& args]
|
||||||
(serialize
|
(mem/serialize
|
||||||
(apply f (map deserialize args arg-types))
|
(apply f (map mem/deserialize args arg-types))
|
||||||
ret-type
|
ret-type
|
||||||
(global-scope))))
|
(mem/global-scope))))
|
||||||
|
|
||||||
(defmethod serialize* ::fn
|
(defmethod mem/serialize* ::fn
|
||||||
[f [_fn arg-types ret-type & {:keys [raw-fn?]}] scope]
|
[f [_fn arg-types ret-type & {:keys [raw-fn?]}] scope]
|
||||||
(.upcallStub
|
(.upcallStub
|
||||||
(CLinker/getInstance)
|
(CLinker/getInstance)
|
||||||
|
|
@ -944,7 +365,7 @@
|
||||||
(function-descriptor arg-types ret-type)
|
(function-descriptor arg-types ret-type)
|
||||||
scope))
|
scope))
|
||||||
|
|
||||||
(defmethod deserialize* ::fn
|
(defmethod mem/deserialize* ::fn
|
||||||
[addr [_fn arg-types ret-type & {:keys [raw-fn?]}]]
|
[addr [_fn arg-types ret-type & {:keys [raw-fn?]}]]
|
||||||
(-> addr
|
(-> addr
|
||||||
(downcall-handle
|
(downcall-handle
|
||||||
|
|
@ -959,7 +380,7 @@
|
||||||
(defn const
|
(defn const
|
||||||
"Gets the value of a constant stored in `symbol-or-addr`."
|
"Gets the value of a constant stored in `symbol-or-addr`."
|
||||||
[symbol-or-addr type]
|
[symbol-or-addr type]
|
||||||
(deserialize (ensure-address symbol-or-addr) [::pointer type]))
|
(mem/deserialize (ensure-address symbol-or-addr) [::mem/pointer type]))
|
||||||
|
|
||||||
(deftype StaticVariable [addr type meta]
|
(deftype StaticVariable [addr type meta]
|
||||||
Addressable
|
Addressable
|
||||||
|
|
@ -967,7 +388,7 @@
|
||||||
addr)
|
addr)
|
||||||
IDeref
|
IDeref
|
||||||
(deref [_]
|
(deref [_]
|
||||||
(deserialize addr [::pointer type]))
|
(mem/deserialize addr [::mem/pointer type]))
|
||||||
|
|
||||||
IObj
|
IObj
|
||||||
(withMeta [_ meta-map]
|
(withMeta [_ meta-map]
|
||||||
|
|
@ -984,10 +405,10 @@
|
||||||
(defn freset!
|
(defn freset!
|
||||||
"Sets the value of `static-var` to `newval`, running it through [[serialize]]."
|
"Sets the value of `static-var` to `newval`, running it through [[serialize]]."
|
||||||
[^StaticVariable static-var newval]
|
[^StaticVariable static-var newval]
|
||||||
(serialize-into
|
(mem/serialize-into
|
||||||
newval (.-type static-var)
|
newval (.-type static-var)
|
||||||
(slice-global (.-addr static-var) (size-of (.-type static-var)))
|
(mem/slice-global (.-addr static-var) (mem/size-of (.-type static-var)))
|
||||||
(global-scope))
|
(mem/global-scope))
|
||||||
newval)
|
newval)
|
||||||
|
|
||||||
(defn fswap!
|
(defn fswap!
|
||||||
|
|
@ -1070,13 +491,6 @@
|
||||||
:args (s/cat :libspec ::libspec)
|
:args (s/cat :libspec ::libspec)
|
||||||
:ret (s/map-of keyword? any?))
|
:ret (s/map-of keyword? any?))
|
||||||
|
|
||||||
(s/def ::type
|
|
||||||
(s/spec
|
|
||||||
(s/nonconforming
|
|
||||||
(s/or :simple-type qualified-keyword?
|
|
||||||
:complex-type (s/cat :base-type qualified-keyword?
|
|
||||||
:type-args (s/* any?))))))
|
|
||||||
|
|
||||||
(s/def ::defcfn-args
|
(s/def ::defcfn-args
|
||||||
(s/and
|
(s/and
|
||||||
(s/cat :name simple-symbol?
|
(s/cat :name simple-symbol?
|
||||||
|
|
@ -1085,7 +499,7 @@
|
||||||
:symbol (s/nonconforming
|
:symbol (s/nonconforming
|
||||||
(s/or :string string?
|
(s/or :string string?
|
||||||
:symbol simple-symbol?))
|
:symbol simple-symbol?))
|
||||||
:native-arglist (s/coll-of ::type :kind vector?)
|
:native-arglist (s/coll-of ::mem/type :kind vector?)
|
||||||
:return-type qualified-keyword?
|
:return-type qualified-keyword?
|
||||||
:wrapper (s/?
|
:wrapper (s/?
|
||||||
(s/cat
|
(s/cat
|
||||||
|
|
@ -1143,10 +557,10 @@
|
||||||
~ret-type ~(:return-type args)
|
~ret-type ~(:return-type args)
|
||||||
~invoke (make-downcall ~(name (:symbol args)) ~args-types ~ret-type)
|
~invoke (make-downcall ~(name (:symbol args)) ~args-types ~ret-type)
|
||||||
~(or (-> args :wrapper :native-fn) native-sym)
|
~(or (-> args :wrapper :native-fn) native-sym)
|
||||||
~(if (and (every? #(= % (primitive-type %))
|
~(if (and (every? #(= % (mem/primitive-type %))
|
||||||
(:native-arglist args))
|
(:native-arglist args))
|
||||||
(= (:return-type args)
|
(= (:return-type args)
|
||||||
(primitive-type (:return-type args))))
|
(mem/primitive-type (:return-type args))))
|
||||||
invoke
|
invoke
|
||||||
`(make-serde-wrapper ~invoke ~args-types ~ret-type))
|
`(make-serde-wrapper ~invoke ~args-types ~ret-type))
|
||||||
fun# ~(if (:wrapper args)
|
fun# ~(if (:wrapper args)
|
||||||
|
|
@ -1169,35 +583,3 @@
|
||||||
fun#))))
|
fun#))))
|
||||||
(s/fdef defcfn
|
(s/fdef defcfn
|
||||||
:args ::defcfn-args)
|
:args ::defcfn-args)
|
||||||
|
|
||||||
(defmacro defalias
|
|
||||||
"Defines a type alias from `new-type` to `aliased-type`.
|
|
||||||
|
|
||||||
This creates needed serialization and deserialization implementations for the
|
|
||||||
aliased type."
|
|
||||||
{:style/indent [:defn]}
|
|
||||||
[new-type aliased-type]
|
|
||||||
(if (primitive-type aliased-type)
|
|
||||||
`(let [aliased# ~aliased-type]
|
|
||||||
(defmethod primitive-type ~new-type
|
|
||||||
[_type#]
|
|
||||||
(primitive-type aliased#))
|
|
||||||
(defmethod serialize* ~new-type
|
|
||||||
[obj# _type# scope#]
|
|
||||||
(serialize* obj# aliased# scope#))
|
|
||||||
(defmethod deserialize* ~new-type
|
|
||||||
[obj# _type#]
|
|
||||||
(deserialize* obj# aliased#)))
|
|
||||||
`(let [aliased# ~aliased-type]
|
|
||||||
(defmethod c-layout ~new-type
|
|
||||||
[_type#]
|
|
||||||
(c-layout aliased#))
|
|
||||||
(defmethod serialize-into ~new-type
|
|
||||||
[obj# _type# segment# scope#]
|
|
||||||
(serialize-into obj# aliased# segment# scope#))
|
|
||||||
(defmethod deserialize-from ~new-type
|
|
||||||
[segment# _type#]
|
|
||||||
(deserialize-from segment# aliased#)))))
|
|
||||||
(s/fdef defalias
|
|
||||||
:args (s/cat :new-type qualified-keyword?
|
|
||||||
:aliased-type ::type))
|
|
||||||
|
|
|
||||||
654
src/clj/coffi/mem.clj
Normal file
654
src/clj/coffi/mem.clj
Normal file
|
|
@ -0,0 +1,654 @@
|
||||||
|
(ns coffi.mem
|
||||||
|
"Functions for managing native allocations, resource scopes, and (de)serialization.
|
||||||
|
|
||||||
|
For any new type to be implemented, three multimethods must be overriden, but
|
||||||
|
which three depends on the native representation of the type.
|
||||||
|
|
||||||
|
If the native representation of the type is a primitive (whether or not other
|
||||||
|
data beyond the primitive is associated with it, as e.g. a pointer),
|
||||||
|
then [[primitive-type]] must be overriden to return which primitive type it is
|
||||||
|
serialized as, then [[serialize*]] and [[deserialize*]] should be overriden.
|
||||||
|
|
||||||
|
If the native representation of the type is a composite type, like a union,
|
||||||
|
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-scope]] in order to ensure it won't be
|
||||||
|
released during its manipulation."
|
||||||
|
(:require
|
||||||
|
[clojure.spec.alpha :as s])
|
||||||
|
(:import
|
||||||
|
(jdk.incubator.foreign
|
||||||
|
Addressable
|
||||||
|
CLinker
|
||||||
|
MemoryAccess
|
||||||
|
MemoryAddress
|
||||||
|
MemoryLayout
|
||||||
|
MemorySegment
|
||||||
|
ResourceScope
|
||||||
|
SegmentAllocator)))
|
||||||
|
|
||||||
|
;; TODO(Joshua): Ensure all the serdes acquire the scopes they use
|
||||||
|
|
||||||
|
(defn 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."
|
||||||
|
^ResourceScope []
|
||||||
|
(ResourceScope/newConfinedScope))
|
||||||
|
|
||||||
|
(defn 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."
|
||||||
|
^ResourceScope []
|
||||||
|
(ResourceScope/newSharedScope))
|
||||||
|
|
||||||
|
(defn connected-scope
|
||||||
|
"Constructs a new scope to reclaim all connected resources at once.
|
||||||
|
|
||||||
|
The scope 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 scope cannot be closed, and therefore should not be created in
|
||||||
|
a [[with-open]] clause."
|
||||||
|
^ResourceScope []
|
||||||
|
(ResourceScope/newImplicitScope))
|
||||||
|
|
||||||
|
(defn global-scope
|
||||||
|
"Constructs the global scope, which will never reclaim its resources.
|
||||||
|
|
||||||
|
This scope 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."
|
||||||
|
^ResourceScope []
|
||||||
|
(ResourceScope/globalScope))
|
||||||
|
|
||||||
|
(defn scope-allocator
|
||||||
|
"Constructs a segment allocator from the given `scope`.
|
||||||
|
|
||||||
|
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 [^ResourceScope scope]
|
||||||
|
(SegmentAllocator/ofScope scope))
|
||||||
|
|
||||||
|
(defn segment-scope
|
||||||
|
"Gets the scope used to construct the `segment`."
|
||||||
|
^ResourceScope [segment]
|
||||||
|
(.scope ^MemorySegment segment))
|
||||||
|
|
||||||
|
(defn alloc
|
||||||
|
"Allocates `size` bytes.
|
||||||
|
|
||||||
|
If a `scope` is provided, the allocation will be reclaimed when it is closed."
|
||||||
|
([size] (alloc size (connected-scope)))
|
||||||
|
([size scope] (MemorySegment/allocateNative (long size) ^ResourceScope scope)))
|
||||||
|
|
||||||
|
(defn alloc-with
|
||||||
|
"Allocates `size` bytes using the `allocator`."
|
||||||
|
([allocator size]
|
||||||
|
(.allocate ^SegmentAllocator allocator (long size)))
|
||||||
|
([allocator size alignment]
|
||||||
|
(.allocate ^SegmentAllocator allocator (long size) (long alignment))))
|
||||||
|
|
||||||
|
(defmacro with-acquired
|
||||||
|
"Acquires a `scope` to ensure it will not be released until the `body` completes.
|
||||||
|
|
||||||
|
This is only necessary to do on shared scopes, however if you are operating on
|
||||||
|
an arbitrary passed scope, it is best practice to wrap code that interacts
|
||||||
|
with it wrapped in this."
|
||||||
|
[scope & body]
|
||||||
|
`(let [scope# ~scope
|
||||||
|
handle# (.acquire ^ResourceScope scope#)]
|
||||||
|
(try ~@body
|
||||||
|
(finally (.release ^ResourceScope scope# handle#)))))
|
||||||
|
|
||||||
|
(defn address-of
|
||||||
|
"Gets the address of a given segment.
|
||||||
|
|
||||||
|
This value can be used as an argument to functions which take a pointer."
|
||||||
|
[addressable]
|
||||||
|
(.address ^Addressable addressable))
|
||||||
|
|
||||||
|
(defn null?
|
||||||
|
"Checks if a memory address is null."
|
||||||
|
[addr]
|
||||||
|
(.equals (MemoryAddress/NULL) 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."
|
||||||
|
[address size]
|
||||||
|
(.asSlice (MemorySegment/globalNativeSegment)
|
||||||
|
^MemoryAddress address (long size)))
|
||||||
|
|
||||||
|
(defn slice
|
||||||
|
"Get a slice over the `segment` with the given `offset`."
|
||||||
|
([segment offset]
|
||||||
|
(.asSlice ^MemorySegment segment (long offset)))
|
||||||
|
([segment offset size]
|
||||||
|
(.asSlice ^MemorySegment segment (long offset) (long size))))
|
||||||
|
|
||||||
|
(defn slice-into
|
||||||
|
"Get a slice into the `segment` starting at the `address`."
|
||||||
|
([address segment]
|
||||||
|
(.asSlice ^MemorySegment segment ^MemoryAddress address))
|
||||||
|
([address segment size]
|
||||||
|
(.asSlice ^MemorySegment segment ^MemoryAddress address (long size))))
|
||||||
|
|
||||||
|
(defn with-offset
|
||||||
|
"Get a new address `offset` from the old `address`."
|
||||||
|
[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."
|
||||||
|
([address size scope]
|
||||||
|
(.asSegment ^MemoryAddress address size scope))
|
||||||
|
([address size scope cleanup]
|
||||||
|
(.asSegment ^MemoryAddress address size cleanup scope)))
|
||||||
|
|
||||||
|
(defn add-close-action!
|
||||||
|
"Adds a 0-arity function to be run when the `scope` closes."
|
||||||
|
[scope action]
|
||||||
|
(.addCloseAction ^ResourceScope scope action))
|
||||||
|
|
||||||
|
(defn copy-segment
|
||||||
|
"Copies the content to `dest` from `src`"
|
||||||
|
[dest src]
|
||||||
|
(.copyFrom ^MemorySegment dest ^MemorySegment src))
|
||||||
|
|
||||||
|
(defn clone-segment
|
||||||
|
"Clones the content of `segment` into a new segment of the same size."
|
||||||
|
([segment] (clone-segment segment (connected-scope)))
|
||||||
|
([segment scope]
|
||||||
|
(doto ^MemorySegment (alloc (.byteSize ^MemorySegment segment) scope)
|
||||||
|
(copy-segment segment))))
|
||||||
|
|
||||||
|
(defn slice-segments
|
||||||
|
"Constructs a lazy seq of `size`-length memory segments, sliced from `segment`."
|
||||||
|
[segment size]
|
||||||
|
(let [num-segments (quot (.byteSize ^MemorySegment segment) size)]
|
||||||
|
(map #(slice segment (* % size) size)
|
||||||
|
(range num-segments))))
|
||||||
|
|
||||||
|
(def primitive-types
|
||||||
|
"A set of keywords representing all the primitive types which may be passed to
|
||||||
|
or returned from native functions."
|
||||||
|
#{::byte ::short ::int ::long ::long-long
|
||||||
|
::char
|
||||||
|
::float ::double
|
||||||
|
::pointer ::void})
|
||||||
|
|
||||||
|
(defn- type-dispatch
|
||||||
|
"Gets a type dispatch value from a (potentially composite) type."
|
||||||
|
[type]
|
||||||
|
(cond
|
||||||
|
(qualified-keyword? type) type
|
||||||
|
(sequential? type) (keyword (first type))))
|
||||||
|
|
||||||
|
(defmulti primitive-type
|
||||||
|
"Gets the primitive type that is used to pass as an argument for the `type`.
|
||||||
|
|
||||||
|
This is for objects which are passed to native functions as primitive types,
|
||||||
|
but which need additional logic to be performed during serialization and
|
||||||
|
deserialization.
|
||||||
|
|
||||||
|
Returns nil for any type which does not have a primitive representation."
|
||||||
|
type-dispatch)
|
||||||
|
|
||||||
|
(defmethod primitive-type :default
|
||||||
|
[type]
|
||||||
|
(primitive-types type))
|
||||||
|
|
||||||
|
(defmethod primitive-type ::pointer
|
||||||
|
[_type]
|
||||||
|
::pointer)
|
||||||
|
|
||||||
|
(def c-prim-layout
|
||||||
|
"Map of primitive type names to the [[CLinker]] types for a method handle."
|
||||||
|
{::byte CLinker/C_CHAR
|
||||||
|
::short CLinker/C_SHORT
|
||||||
|
::int CLinker/C_INT
|
||||||
|
::long CLinker/C_LONG
|
||||||
|
::long-long CLinker/C_LONG_LONG
|
||||||
|
::char CLinker/C_CHAR
|
||||||
|
::float CLinker/C_FLOAT
|
||||||
|
::double CLinker/C_DOUBLE
|
||||||
|
::pointer CLinker/C_POINTER})
|
||||||
|
|
||||||
|
(defmulti c-layout
|
||||||
|
"Gets the layout object for a given `type`.
|
||||||
|
|
||||||
|
If a type is primitive it will return the appropriate primitive
|
||||||
|
layout (see [[c-prim-layout]]).
|
||||||
|
|
||||||
|
Otherwise, it should return a [[GroupLayout]] for the given type."
|
||||||
|
type-dispatch)
|
||||||
|
|
||||||
|
(defmethod c-layout :default
|
||||||
|
[type]
|
||||||
|
(c-prim-layout (or (primitive-type type) type)))
|
||||||
|
|
||||||
|
(def java-prim-layout
|
||||||
|
"Map of primitive type names to the Java types for a method handle."
|
||||||
|
{::byte Byte/TYPE
|
||||||
|
::short Short/TYPE
|
||||||
|
::int Integer/TYPE
|
||||||
|
::long Long/TYPE
|
||||||
|
::long-long Long/TYPE
|
||||||
|
::char Byte/TYPE
|
||||||
|
::float Float/TYPE
|
||||||
|
::double Double/TYPE
|
||||||
|
::pointer MemoryAddress
|
||||||
|
::void Void/TYPE})
|
||||||
|
|
||||||
|
(defn java-layout
|
||||||
|
"Gets the Java class to an argument of this type for a method handle.
|
||||||
|
|
||||||
|
If a type serializes to a primitive it returns return a Java primitive type.
|
||||||
|
Otherwise, it returns [[MemorySegment]]."
|
||||||
|
[type]
|
||||||
|
(java-prim-layout (or (primitive-type type) type) MemorySegment))
|
||||||
|
|
||||||
|
(defn size-of
|
||||||
|
"The size in bytes of the given `type`."
|
||||||
|
[type]
|
||||||
|
(.byteSize ^MemoryLayout (c-layout type)))
|
||||||
|
|
||||||
|
(defn alloc-instance
|
||||||
|
"Allocates a memory segment for the given `type`."
|
||||||
|
([type] (alloc-instance type (connected-scope)))
|
||||||
|
([type scope] (MemorySegment/allocateNative (long (size-of type)) ^ResourceScope scope)))
|
||||||
|
|
||||||
|
(declare serialize serialize-into)
|
||||||
|
|
||||||
|
(defmulti serialize*
|
||||||
|
"Constructs a serialized version of the `obj` and returns it.
|
||||||
|
|
||||||
|
Any new allocations made during the serialization should be tied to the given
|
||||||
|
`scope`, except in extenuating circumstances.
|
||||||
|
|
||||||
|
This method should only be implemented for types that serialize to primitives."
|
||||||
|
(fn
|
||||||
|
#_{:clj-kondo/ignore [:unused-binding]}
|
||||||
|
[obj type scope]
|
||||||
|
(type-dispatch type)))
|
||||||
|
|
||||||
|
(def ^:private primitive-cast
|
||||||
|
"Map from primitive type names to the function to cast it to a primitive."
|
||||||
|
{::byte byte
|
||||||
|
::short short
|
||||||
|
::int int
|
||||||
|
::long long
|
||||||
|
::long-long long
|
||||||
|
::char char
|
||||||
|
::float float
|
||||||
|
::double double})
|
||||||
|
|
||||||
|
(defmethod serialize* :default
|
||||||
|
[obj type _scope]
|
||||||
|
(if-let [prim (primitive-type type)]
|
||||||
|
((primitive-cast prim) obj)
|
||||||
|
(throw (ex-info "Attempted to serialize a non-primitive type with primitive methods"
|
||||||
|
{:type type
|
||||||
|
:object obj}))))
|
||||||
|
|
||||||
|
(defmethod serialize* ::pointer
|
||||||
|
[obj type scope]
|
||||||
|
(when-not (null? obj)
|
||||||
|
(if (sequential? type)
|
||||||
|
(let [segment (alloc-instance (second type) scope)]
|
||||||
|
(serialize-into obj (second type) segment scope)
|
||||||
|
(address-of segment))
|
||||||
|
obj)))
|
||||||
|
|
||||||
|
(defmulti serialize-into
|
||||||
|
"Writes a serialized version of the `obj` to the given `segment`.
|
||||||
|
|
||||||
|
Any new allocations made during the serialization should be tied to the given
|
||||||
|
`scope`, except in extenuating circumstances.
|
||||||
|
|
||||||
|
This method should be implemented for any type which does not
|
||||||
|
override [[c-layout]].
|
||||||
|
|
||||||
|
For any other type, this will serialize it as [[serialize*]] before writing
|
||||||
|
the result value into the `segment`."
|
||||||
|
(fn
|
||||||
|
#_{:clj-kondo/ignore [:unused-binding]}
|
||||||
|
[obj type segment scope]
|
||||||
|
(type-dispatch type)))
|
||||||
|
|
||||||
|
(defmethod serialize-into :default
|
||||||
|
[obj type segment scope]
|
||||||
|
(if-some [prim-layout (primitive-type type)]
|
||||||
|
(serialize-into (serialize* obj type scope) prim-layout segment scope)
|
||||||
|
(throw (ex-info "Attempted to serialize an object to a type that has not been overriden"
|
||||||
|
{:type type
|
||||||
|
:object obj}))))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::byte
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setByte segment (byte obj)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::short
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setShort segment (short obj)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::int
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setInt segment (int obj)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::long
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setLong segment (long obj)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::long-long
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setLong segment (long obj)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::char
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setChar segment (char obj)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::float
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setFloat segment (float obj)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::double
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setDouble segment (double obj)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::pointer
|
||||||
|
[obj _type segment _scope]
|
||||||
|
(MemoryAccess/setAddress segment obj))
|
||||||
|
|
||||||
|
(defn serialize
|
||||||
|
"Serializes an arbitrary type.
|
||||||
|
|
||||||
|
For types which have a primitive representation, this serializes into that
|
||||||
|
representation. For types which do not, it allocates a new segment and
|
||||||
|
serializes into that."
|
||||||
|
([obj type] (serialize obj type (connected-scope)))
|
||||||
|
([obj type scope]
|
||||||
|
(if (primitive-type type)
|
||||||
|
(serialize* obj type scope)
|
||||||
|
(let [segment (alloc-instance type scope)]
|
||||||
|
(serialize-into obj type segment scope)
|
||||||
|
segment))))
|
||||||
|
|
||||||
|
(declare deserialize deserialize*)
|
||||||
|
|
||||||
|
(defmulti deserialize-from
|
||||||
|
"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*]]."
|
||||||
|
(fn
|
||||||
|
#_{:clj-kondo/ignore [:unused-binding]}
|
||||||
|
[segment type]
|
||||||
|
(type-dispatch type)))
|
||||||
|
|
||||||
|
(defmethod deserialize-from :default
|
||||||
|
[segment type]
|
||||||
|
(if-some [prim (primitive-type type)]
|
||||||
|
(-> segment
|
||||||
|
(deserialize-from prim)
|
||||||
|
(deserialize* type))
|
||||||
|
(throw (ex-info "Attempted to deserialize a non-primitive type that has not been overriden"
|
||||||
|
{:type type
|
||||||
|
:segment segment}))))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::byte
|
||||||
|
[segment _type]
|
||||||
|
(MemoryAccess/getByte segment))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::short
|
||||||
|
[segment _type]
|
||||||
|
(MemoryAccess/getShort segment))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::int
|
||||||
|
[segment _type]
|
||||||
|
(MemoryAccess/getInt segment))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::long
|
||||||
|
[segment _type]
|
||||||
|
(MemoryAccess/getLong segment))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::long-long
|
||||||
|
[segment _type]
|
||||||
|
(MemoryAccess/getLong segment))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::char
|
||||||
|
[segment _type]
|
||||||
|
(MemoryAccess/getChar segment))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::float
|
||||||
|
[segment _type]
|
||||||
|
(MemoryAccess/getFloat segment))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::double
|
||||||
|
[segment _type]
|
||||||
|
(MemoryAccess/getDouble segment))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::pointer
|
||||||
|
[segment type]
|
||||||
|
(cond-> (MemoryAccess/getAddress segment)
|
||||||
|
(sequential? type) (deserialize* type)))
|
||||||
|
|
||||||
|
(defmulti deserialize*
|
||||||
|
"Deserializes a primitive object into a Clojure data structure.
|
||||||
|
|
||||||
|
This is intended for use with types that are returned as a primitive but which
|
||||||
|
need additional processing before they can be returned."
|
||||||
|
(fn
|
||||||
|
#_{:clj-kondo/ignore [:unused-binding]}
|
||||||
|
[obj type]
|
||||||
|
(type-dispatch type)))
|
||||||
|
|
||||||
|
(defmethod deserialize* :default
|
||||||
|
[obj type]
|
||||||
|
(if (primitive-type type)
|
||||||
|
obj
|
||||||
|
(throw (ex-info "Attempted to deserialize a non-primitive type with primitive methods"
|
||||||
|
{:type type
|
||||||
|
:segment obj}))))
|
||||||
|
|
||||||
|
(defmethod deserialize* ::pointer
|
||||||
|
[addr type]
|
||||||
|
(when-not (null? addr)
|
||||||
|
(if (sequential? type)
|
||||||
|
(deserialize-from (slice-global addr (size-of (second type)))
|
||||||
|
(second type))
|
||||||
|
addr)))
|
||||||
|
|
||||||
|
(defn deserialize
|
||||||
|
"Deserializes an arbitrary type.
|
||||||
|
|
||||||
|
For types which have a primitive representation, this deserializes the
|
||||||
|
primitive representation. For types which do not, this deserializes out of
|
||||||
|
a segment."
|
||||||
|
[obj type]
|
||||||
|
(when-not (identical? ::void type)
|
||||||
|
((if (primitive-type type)
|
||||||
|
deserialize*
|
||||||
|
deserialize-from)
|
||||||
|
obj type)))
|
||||||
|
|
||||||
|
(defn seq-of
|
||||||
|
"Constructs a lazy sequence of `type` elements deserialized from `segment`."
|
||||||
|
[type segment]
|
||||||
|
(map #(deserialize % type) (slice-segments segment (size-of type))))
|
||||||
|
|
||||||
|
;;; C String type
|
||||||
|
|
||||||
|
(defmethod primitive-type ::c-string
|
||||||
|
[_type]
|
||||||
|
::pointer)
|
||||||
|
|
||||||
|
(defmethod serialize* ::c-string
|
||||||
|
[obj _type scope]
|
||||||
|
(if obj
|
||||||
|
(address-of (CLinker/toCString ^String obj ^ResourceScope scope))
|
||||||
|
(MemoryAddress/NULL)))
|
||||||
|
|
||||||
|
(defmethod deserialize* ::c-string
|
||||||
|
[addr _type]
|
||||||
|
(when-not (null? addr)
|
||||||
|
(CLinker/toJavaString ^MemoryAddress addr)))
|
||||||
|
|
||||||
|
;;; Union types
|
||||||
|
|
||||||
|
(defmethod c-layout ::union
|
||||||
|
[[_union types & {:as _opts} :as _type]]
|
||||||
|
(let [items (map c-layout types)]
|
||||||
|
(MemoryLayout/unionLayout
|
||||||
|
(into-array MemoryLayout items))))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::union
|
||||||
|
[obj [_union _types & {:keys [dispatch extract]} :as type] segment scope]
|
||||||
|
(when-not dispatch
|
||||||
|
(throw (ex-info "Attempted to serialize a union with no dispatch function"
|
||||||
|
{:type type
|
||||||
|
:value obj})))
|
||||||
|
(let [type (dispatch obj)]
|
||||||
|
(serialize-into
|
||||||
|
(if extract
|
||||||
|
(extract type obj)
|
||||||
|
obj)
|
||||||
|
type
|
||||||
|
segment
|
||||||
|
scope)))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::union
|
||||||
|
[segment type]
|
||||||
|
(clone-segment (slice segment 0 (size-of type))))
|
||||||
|
|
||||||
|
;;; Struct types
|
||||||
|
|
||||||
|
(defmethod c-layout ::struct
|
||||||
|
[[_struct fields]]
|
||||||
|
(let [fields (for [[field-name field] fields]
|
||||||
|
(.withName ^MemoryLayout (c-layout field)
|
||||||
|
(name field-name)))]
|
||||||
|
(MemoryLayout/structLayout
|
||||||
|
(into-array MemoryLayout fields))))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::struct
|
||||||
|
[obj [_struct fields] segment scope]
|
||||||
|
(loop [offset 0
|
||||||
|
fields fields]
|
||||||
|
(when (seq fields)
|
||||||
|
(let [[field type] (first fields)
|
||||||
|
size (size-of type)]
|
||||||
|
(serialize-into
|
||||||
|
(get obj field) type
|
||||||
|
(slice segment offset size) scope)
|
||||||
|
(recur (long (+ offset size)) (rest fields))))))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::struct
|
||||||
|
[segment [_struct fields]]
|
||||||
|
(loop [offset 0
|
||||||
|
fields fields
|
||||||
|
obj {}]
|
||||||
|
(if (seq fields)
|
||||||
|
(let [[field type] (first fields)
|
||||||
|
size (size-of type)]
|
||||||
|
(recur
|
||||||
|
(long (+ offset size))
|
||||||
|
(rest fields)
|
||||||
|
(assoc obj field (deserialize-from
|
||||||
|
(slice segment offset size)
|
||||||
|
type))))
|
||||||
|
obj)))
|
||||||
|
|
||||||
|
;;; Padding type
|
||||||
|
|
||||||
|
(defmethod c-layout ::padding
|
||||||
|
[[_padding size]]
|
||||||
|
(MemoryLayout/paddingLayout (* 8 size)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::padding
|
||||||
|
[_obj [_padding _size] _segment _scope]
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::padding
|
||||||
|
[_segment [_padding _size]]
|
||||||
|
nil)
|
||||||
|
|
||||||
|
;;; Array types
|
||||||
|
|
||||||
|
(defmethod c-layout ::array
|
||||||
|
[[_array type count]]
|
||||||
|
(MemoryLayout/sequenceLayout
|
||||||
|
count
|
||||||
|
(c-layout type)))
|
||||||
|
|
||||||
|
(defmethod serialize-into ::array
|
||||||
|
[obj [_array type count] segment scope]
|
||||||
|
(dorun
|
||||||
|
(map #(serialize-into %1 type %2 scope)
|
||||||
|
obj
|
||||||
|
(slice-segments (slice segment 0 (* count (size-of type)))
|
||||||
|
(size-of type)))))
|
||||||
|
|
||||||
|
(defmethod deserialize-from ::array
|
||||||
|
[segment [_array type count]]
|
||||||
|
(map #(deserialize-from % type)
|
||||||
|
(slice-segments (slice segment 0 (* count (size-of type)))
|
||||||
|
(size-of type))))
|
||||||
|
|
||||||
|
(s/def ::type
|
||||||
|
(s/spec
|
||||||
|
(s/nonconforming
|
||||||
|
(s/or :simple-type qualified-keyword?
|
||||||
|
:complex-type (s/cat :base-type qualified-keyword?
|
||||||
|
:type-args (s/* any?))))))
|
||||||
|
|
||||||
|
(defmacro defalias
|
||||||
|
"Defines a type alias from `new-type` to `aliased-type`.
|
||||||
|
|
||||||
|
This creates needed serialization and deserialization implementations for the
|
||||||
|
aliased type."
|
||||||
|
{:style/indent [:defn]}
|
||||||
|
[new-type aliased-type]
|
||||||
|
(if (primitive-type aliased-type)
|
||||||
|
`(let [aliased# ~aliased-type]
|
||||||
|
(defmethod primitive-type ~new-type
|
||||||
|
[_type#]
|
||||||
|
(primitive-type aliased#))
|
||||||
|
(defmethod serialize* ~new-type
|
||||||
|
[obj# _type# scope#]
|
||||||
|
(serialize* obj# aliased# scope#))
|
||||||
|
(defmethod deserialize* ~new-type
|
||||||
|
[obj# _type#]
|
||||||
|
(deserialize* obj# aliased#)))
|
||||||
|
`(let [aliased# ~aliased-type]
|
||||||
|
(defmethod c-layout ~new-type
|
||||||
|
[_type#]
|
||||||
|
(c-layout aliased#))
|
||||||
|
(defmethod serialize-into ~new-type
|
||||||
|
[obj# _type# segment# scope#]
|
||||||
|
(serialize-into obj# aliased# segment# scope#))
|
||||||
|
(defmethod deserialize-from ~new-type
|
||||||
|
[segment# _type#]
|
||||||
|
(deserialize-from segment# aliased#)))))
|
||||||
|
(s/fdef defalias
|
||||||
|
:args (s/cat :new-type qualified-keyword?
|
||||||
|
:aliased-type ::type))
|
||||||
|
|
@ -1,31 +1,32 @@
|
||||||
(ns coffi.ffi-test
|
(ns coffi.ffi-test
|
||||||
(:require
|
(:require
|
||||||
[clojure.test :as t]
|
[clojure.test :as t]
|
||||||
[coffi.ffi :as sut]))
|
[coffi.mem :as mem]
|
||||||
|
[coffi.ffi :as ffi]))
|
||||||
|
|
||||||
(sut/load-library "target/ffi_test.so")
|
(ffi/load-library "target/ffi_test.so")
|
||||||
|
|
||||||
(t/deftest can-load-symbols
|
(t/deftest can-load-symbols
|
||||||
(t/is (not (nil? (sut/find-symbol "add_numbers")))))
|
(t/is (not (nil? (ffi/find-symbol "add_numbers")))))
|
||||||
|
|
||||||
(t/deftest can-call-primitive-fns
|
(t/deftest can-call-primitive-fns
|
||||||
(t/is (= 5 ((sut/cfn "add_numbers" [::sut/int ::sut/int] ::sut/int) 2 3))))
|
(t/is (= 5 ((ffi/cfn "add_numbers" [::mem/int ::mem/int] ::mem/int) 2 3))))
|
||||||
|
|
||||||
(sut/defalias ::point
|
(mem/defalias ::point
|
||||||
[::sut/struct
|
[::mem/struct
|
||||||
[[:x ::sut/float]
|
[[:x ::mem/float]
|
||||||
[:y ::sut/float]]])
|
[:y ::mem/float]]])
|
||||||
|
|
||||||
(t/deftest can-call-with-structs
|
(t/deftest can-call-with-structs
|
||||||
(t/is (= {:x 2.0 :y 2.0}
|
(t/is (= {:x 2.0 :y 2.0}
|
||||||
((sut/cfn "add_points" [::point ::point] ::point) {:x 1 :y 2} {:x 1 :y 0}))))
|
((ffi/cfn "add_points" [::point ::point] ::point) {:x 1 :y 2} {:x 1 :y 0}))))
|
||||||
|
|
||||||
(t/deftest can-call-deserialized-fn-pointers
|
(t/deftest can-call-deserialized-fn-pointers
|
||||||
(t/is (= "Alternate string"
|
(t/is (= "Alternate string"
|
||||||
(((sut/cfn "get_downcall" [::sut/int] [::sut/fn [] ::sut/c-string])
|
(((ffi/cfn "get_downcall" [::mem/int] [::ffi/fn [] ::mem/c-string])
|
||||||
1)))))
|
1)))))
|
||||||
|
|
||||||
(t/deftest can-make-upcall
|
(t/deftest can-make-upcall
|
||||||
(t/is (= ((sut/cfn "upcall_test" [[::sut/fn [] ::sut/c-string]] ::sut/c-string)
|
(t/is (= ((ffi/cfn "upcall_test" [[::ffi/fn [] ::mem/c-string]] ::mem/c-string)
|
||||||
(fn [] "hello"))
|
(fn [] "hello"))
|
||||||
"hello")))
|
"hello")))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue