Skip to content

Commit

Permalink
[FSharp] Move native utilities to separate file
Browse files Browse the repository at this point in the history
  • Loading branch information
@hyazinthh
hyazinthh committed Oct 30, 2023
1 parent e7ed019 commit 6d67952
Show file tree
Hide file tree
Showing 3 changed files with 210 additions and 224 deletions.
1 change: 1 addition & 0 deletions src/Aardvark.Base.FSharp/Aardvark.Base.FSharp.fsproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@
<Compile Include="Utilities\Pickler\AdaptivePicklers.fs" />
<Compile Include="Utilities\Threading.fs" />
<Compile Include="Utilities\IO.fs" />
<Compile Include="Utilities\Native.fs" />
<Compile Include="Utilities\Measures.fs" />
<Compile Include="Utilities\Lens.fs" />
<Compile Include="Utilities\Monoid.fs" />
Expand Down
224 changes: 0 additions & 224 deletions src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
namespace Aardvark.Base

#nowarn "9"
#nowarn "51"

open System
open FSharp.NativeInterop
Expand Down Expand Up @@ -391,229 +390,6 @@ module NiceUtilities =
| (true, v) -> Some v
| _ -> None

[<AutoOpen>]
module NativeUtilities =
open System.Runtime.InteropServices
open Microsoft.FSharp.NativeInterop

let private os = System.Environment.OSVersion
let private notimp() = raise <| NotImplementedException()


/// <summary>
/// MSVCRT wraps memory-functions provided by msvcrt.dll on windows systems.
/// </summary>
module internal MSVCRT =
open System
open System.Runtime.InteropServices

[<DllImport("msvcrt.dll", EntryPoint = "memcpy", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern nativeint private memcpy_internal(nativeint dest, nativeint src, UIntPtr size);

[<DllImport("msvcrt.dll", EntryPoint = "memcmp", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern int private memcmp_internal(nativeint ptr1, nativeint ptr2, UIntPtr size);

[<DllImport("msvcrt.dll", EntryPoint = "memset", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern nativeint private memset_internal(nativeint ptr, int value, UIntPtr size);

[<DllImport("msvcrt.dll", EntryPoint = "memmove", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern nativeint private memmove_internal(nativeint dest, nativeint src, UIntPtr size);


let memcpy(target : nativeint, source : nativeint, size : unativeint) =
memcpy_internal(target, source, size) |> ignore

let memcmp(ptr1 : nativeint, ptr2 : nativeint, size : unativeint) =
memcmp_internal(ptr1, ptr2, size)

let memset(ptr : nativeint, value : int, size : unativeint) =
memset_internal(ptr, value, size) |> ignore

let memmove(target : nativeint, source : nativeint, size : unativeint) =
memmove_internal(target, source, size) |> ignore

/// <summary>
/// LibC wraps memory-functions provided by libc on linux systems.
/// </summary>
module internal LibC =
open System
open System.Runtime.InteropServices


[<DllImport("libc", EntryPoint = "memcpy", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern nativeint private memcpy_internal(nativeint dest, nativeint src, UIntPtr size);

[<DllImport("libc", EntryPoint = "memcmp", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern int private memcmp_internal(nativeint ptr1, nativeint ptr2, UIntPtr size);

[<DllImport("libc", EntryPoint = "memset", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern nativeint private memset_internal(nativeint ptr, int value, UIntPtr size);

[<DllImport("libc", EntryPoint = "memmove", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern nativeint private memmove_internal(nativeint dest, nativeint src, UIntPtr size);

[<DllImport("libc", EntryPoint = "uname", CallingConvention = CallingConvention.Cdecl, SetLastError = false)>]
extern int private uname_intern(nativeint buf);


let mutable osname = null
let uname() =
if isNull osname then
let ptr : nativeptr<byte> = NativePtr.stackalloc 8192
if uname_intern(NativePtr.toNativeInt ptr) = 0 then
osname <- Marshal.PtrToStringAnsi(NativePtr.toNativeInt ptr)
else
failwith "could not get os-name"
osname



let memcpy(target : nativeint, source : nativeint, size : unativeint) =
memcpy_internal(target, source, size) |> ignore

let memcmp(ptr1 : nativeint, ptr2 : nativeint, size : unativeint) =
memcmp_internal(ptr1, ptr2, size)

let memset(ptr : nativeint, value : int, size : unativeint) =
memset_internal(ptr, value, size) |> ignore

let memmove(target : nativeint, source : nativeint, size : unativeint) =
memmove_internal(target, source, size) |> ignore

[<AutoOpen>]
module PlatformStuff =


let (|Windows|Linux|Mac|) (p : System.OperatingSystem) =
match p.Platform with
| System.PlatformID.Unix ->
if LibC.uname() = "Darwin" then Mac
else Linux
| System.PlatformID.MacOSX -> Mac
| _ -> Windows

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module NativeInt =
let memcpy (src : nativeint) (dst : nativeint) (size : int) =
match os with
| Windows -> MSVCRT.memcpy(dst, src, unativeint size)
| _ -> LibC.memcpy(dst, src, unativeint size)

let memmove (src : nativeint) (dst : nativeint) (size : int) =
match os with
| Windows -> MSVCRT.memmove(dst, src, unativeint size)
| _ -> LibC.memmove(dst, src, unativeint size)

let memset (dst : nativeint) (value : int) (size : int) =
match os with
| Windows -> MSVCRT.memset(dst, value, unativeint size)
| _ -> LibC.memset(dst, value, unativeint size)

let memcmp (src : nativeint) (dst : nativeint) (size : int) =
match os with
| Windows -> MSVCRT.memcmp(dst, src, unativeint size)
| _ -> LibC.memcmp(dst, src, unativeint size)

let inline read<'a when 'a : unmanaged> (ptr : nativeint) =
NativePtr.read (NativePtr.ofNativeInt<'a> ptr)

let inline write<'a when 'a : unmanaged> (ptr : nativeint) (value : 'a) =
NativePtr.write (NativePtr.ofNativeInt<'a> ptr) value

let inline get<'a when 'a : unmanaged> (ptr : nativeint) (index : int) =
NativePtr.get (NativePtr.ofNativeInt<'a> ptr) index

let inline set<'a when 'a : unmanaged> (ptr : nativeint) (index : int) (value : 'a)=
NativePtr.set (NativePtr.ofNativeInt<'a> ptr) index value

type Marshal with
static member Copy(source : nativeint, destination : nativeint, length : unativeint) =
match os with
| Windows -> MSVCRT.memcpy(destination, source, length)
| _ -> LibC.memcpy(destination, source, length)

static member Move(source : nativeint, destination : nativeint, length : unativeint) =
match os with
| Windows -> MSVCRT.memmove(destination, source, length)
| _ -> LibC.memmove(destination, source, length)

static member Set(memory : nativeint, value : int, length : unativeint) =
match os with
| Windows -> MSVCRT.memset(memory, value, length)
| _ -> LibC.memset(memory, value, length)

static member Compare(source : nativeint, destination : nativeint, length : unativeint) =
match os with
| Windows -> MSVCRT.memcmp(destination, source, length)
| _ -> LibC.memcmp(destination, source, length)



static member Copy(source : nativeint, destination : nativeint, length : int) =
Marshal.Copy(source, destination, unativeint length)

static member Move(source : nativeint, destination : nativeint, length : int) =
Marshal.Move(source, destination, unativeint length)

static member Set(memory : nativeint, value : int, length : int) =
Marshal.Set(memory, value, unativeint length)

static member Compare(source : nativeint, destination : nativeint, length : int) =
Marshal.Compare(source, destination, unativeint length)




static member inline Copy(source : nativeint, destination : nativeint, length : 'a) =
Marshal.Copy(source, destination, unativeint length)

static member inline Move(source : nativeint, destination : nativeint, length : 'a) =
Marshal.Move(source, destination, unativeint length)

static member inline Set(memory : nativeint, value : int, length : 'a) =
Marshal.Set(memory, value, unativeint length)

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()

[<AutoOpen>]
module MarshalDelegateExtensions =
open System.Runtime.InteropServices
open System.Collections.Concurrent

let private pinnedDelegates = ConcurrentDictionary<Delegate, nativeint>()
type PinnedDelegate internal(d : Delegate, ptr : nativeint) =
member x.Pointer = ptr
member x.Dispose() = pinnedDelegates.TryRemove d |> ignore

interface IDisposable with
member x.Dispose() = x.Dispose()

type Marshal with
static member PinDelegate(d : Delegate) =
let ptr = pinnedDelegates.GetOrAdd(d, fun _ -> Marshal.GetFunctionPointerForDelegate d)
new PinnedDelegate(d, ptr)

static member PinFunction(f : 'a -> 'b) =
Marshal.PinDelegate(Func<'a, 'b>(f))

static member PinFunction(f : 'a -> 'b -> 'c) =
Marshal.PinDelegate(Func<'a, 'b, 'c>(f))

static member PinFunction(f : 'a -> 'b -> 'c -> 'd) =
Marshal.PinDelegate(Func<'a, 'b, 'c, 'd>(f))

module ConversionHelpers =

[<Obsolete("Use LookupTable.lookupTable' instead.")>]
Expand Down
Loading

0 comments on commit 6d67952

Please sign in to comment.