From 709e2c1dc94f672ac1b59a30655c95d18b59501b Mon Sep 17 00:00:00 2001 From: Joshua Suskalo Date: Fri, 15 Apr 2022 09:58:10 -0500 Subject: [PATCH 1/5] Update to jdk 18 in changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index f953948..dc60fad 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ 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] +### Changed +- JDK version from 17 to 18 ## [0.4.341] - 2022-01-23 ### Added From 5d24b149928496decd01adb4b2f84cac5c0a583e Mon Sep 17 00:00:00 2001 From: Joshua Suskalo Date: Fri, 15 Apr 2022 09:56:08 -0500 Subject: [PATCH 2/5] Update the build to produce the correct version of jvm bytecode --- build.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/build.clj b/build.clj index c0df6d7..5c7e0b2 100644 --- a/build.clj +++ b/build.clj @@ -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 From 4037040c4b8f52ce35c4d04be1a71fd9a03936c7 Mon Sep 17 00:00:00 2001 From: Joshua Suskalo Date: Fri, 15 Apr 2022 09:56:38 -0500 Subject: [PATCH 3/5] Update mem namespace to jdk18 --- CHANGELOG.md | 4 + src/clj/coffi/mem.clj | 402 +++++++++++++++++++++++------------------- 2 files changed, 222 insertions(+), 184 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index dc60fad..3a0fd9f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,11 @@ 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/slice-into` 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 diff --git a/src/clj/coffi/mem.clj b/src/clj/coffi/mem.clj index 492f786..87fb28a 100644 --- a/src/clj/coffi/mem.clj +++ b/src/clj/coffi/mem.clj @@ -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 From b10c459bf71e2c7243d2f71de3de54543868a61c Mon Sep 17 00:00:00 2001 From: Joshua Suskalo Date: Fri, 15 Apr 2022 13:52:41 -0500 Subject: [PATCH 4/5] Update ffi namespace for jdk 18 --- src/clj/coffi/ffi.clj | 89 +++++++++++++++++++--------------- src/java/coffi/ffi/Loader.java | 4 +- 2 files changed, 51 insertions(+), 42 deletions(-) diff --git a/src/clj/coffi/ffi.clj b/src/clj/coffi/ffi.clj index 061ff3b..6b4016f 100644 --- a/src/clj/coffi/ffi.clj +++ b/src/clj/coffi/ffi.clj @@ -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?) diff --git a/src/java/coffi/ffi/Loader.java b/src/java/coffi/ffi/Loader.java index b06d00f..9ad662f 100644 --- a/src/java/coffi/ffi/Loader.java +++ b/src/java/coffi/ffi/Loader.java @@ -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)); } } From 7d4f0e6567b78e51b85d3ab981bc6ea3077bba8e Mon Sep 17 00:00:00 2001 From: Joshua Suskalo Date: Thu, 7 Jul 2022 09:25:58 -0500 Subject: [PATCH 5/5] Update readme and changelog about removal of long-long --- CHANGELOG.md | 3 ++- README.md | 1 - 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3a0fd9f..4d7b30b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,7 +3,8 @@ All notable changes to this project will be documented in this file. This change ## [Unreleased] ### Removed -- `coffi.mem/slice-into` function no longer has an equivalent in panama, but see 2-arity of `coffi.mem/as-segment` for an alternative +- `: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 diff --git a/README.md b/README.md index ddd50a9..48e4e51 100644 --- a/README.md +++ b/README.md @@ -110,7 +110,6 @@ Coffi defines a basic set of primitive types: - short - int - long -- long-long - char - float - double