From 28e5a6e88f6fec3f7f0673467404dfbd712cd11a Mon Sep 17 00:00:00 2001 From: Martin Date: Wed, 4 Sep 2024 12:04:15 +0200 Subject: [PATCH] [FSharp] Move pin utilities to modules; add pinArri, temp --- .../Utilities/Interop/FSLibExtensions.fs | 15 +++++++++++++ src/Aardvark.Base.FSharp/Utilities/Native.fs | 22 ++++++++++--------- 2 files changed, 27 insertions(+), 10 deletions(-) diff --git a/src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs b/src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs index cd4fc62c..917ed3a1 100644 --- a/src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs +++ b/src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs @@ -266,6 +266,21 @@ module Prelude = let l = int64 <| sizeof<'a> * count new System.IO.UnmanagedMemoryStream(cast ptr, l,l, FileAccess.ReadWrite) :> _ + /// Pins the given value and invokes the action with the native pointer. + let inline pin<'T, 'U when 'T : unmanaged> ([] action: nativeptr<'T> -> 'U) (value: 'T) = + use ptr = fixed &value + action ptr + + /// Pins the given array and invokes the action with the native pointer. + let inline pinArr<'T, 'U when 'T : unmanaged> ([] action: nativeptr<'T> -> 'U) (array: 'T[]) = + use ptr = fixed array + action ptr + + /// Pins the given array at the given index and invokes the action with the native pointer. + let inline pinArri<'T, 'U when 'T : unmanaged> ([] action: nativeptr<'T> -> 'U) (index: int) (array: 'T[]) = + use ptr = fixed &array.[index] + action ptr + module Operators = let ( &+ ) (ptr : nativeptr<'a>) (count : int) = diff --git a/src/Aardvark.Base.FSharp/Utilities/Native.fs b/src/Aardvark.Base.FSharp/Utilities/Native.fs index 2e09818b..1655542a 100644 --- a/src/Aardvark.Base.FSharp/Utilities/Native.fs +++ b/src/Aardvark.Base.FSharp/Utilities/Native.fs @@ -127,6 +127,12 @@ module NativeUtilities = let inline set<'a when 'a : unmanaged> (ptr : nativeint) (index : int) (value : 'a)= NativePtr.set (NativePtr.ofNativeInt<'a> ptr) index value + /// Pins the given object and invokes the action with its address. + let inline pin ([] action: nativeint -> 'T) (value: obj) = + let gc = GCHandle.Alloc(value, GCHandleType.Pinned) + try action <| gc.AddrOfPinnedObject() + finally gc.Free() + type Marshal with static member Copy(source : nativeint, destination : nativeint, length : unativeint) = match os with @@ -174,21 +180,17 @@ module NativeUtilities = static member inline Compare(source : nativeint, destination : nativeint, length : 'a) = Marshal.Compare(source, destination, unativeint length) - + [] let pinned (a : obj) f = - let gc = GCHandle.Alloc(a, GCHandleType.Pinned) - try - f ( gc.AddrOfPinnedObject() ) - finally - gc.Free() + NativeInt.pin f a + [] let inline pin ([] f: nativeptr<'T> -> 'U) (value: 'T) = - use ptr = fixed &value - f ptr + NativePtr.pin f value + [] let inline pinArr ([] f: nativeptr<'T> -> 'U) (array: 'T[]) = - use ptr = fixed array - f ptr + NativePtr.pinArr f array [] module MarshalDelegateExtensions =