diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md
index e5981a0b5..31a0bedb7 100644
--- a/RELEASE_NOTES.md
+++ b/RELEASE_NOTES.md
@@ -4,16 +4,33 @@
- Added F# tensor utilities and math functions using SRTP
- Deprecated Error type
- Deprecated GenericValues.zero
-- Removed Async.AwaitTask (already in FSharp.Core)
-- Removed Caching.cacheFunction
- Fixed return type of LengthSquared for integer-based vectors. Now returns an integer instead of double.
-- [Color] Removed obsolete conversion functions
- Added missing readonly modifiers for structs
- Renamed CIeLuvf to CieLuvf
-- [PixImage] Removed obsolete loading API
-- Removed IDictionary.GetValueOrDefault
-- Removed broken UnsafeCoerce utilities
-- Removed obsolete CameraExtrinsics and CameraIntrinsics
+- Removed obsolete API:
+ - [Color] obsolete conversion functions
+ - [Color] `Parse()` overload with IFormatProvider parameter
+ - [PixImage] obsolete loading API
+ - `Async.AwaitTask` (already in FSharp.Core)
+ - `Caching.cacheFunction`
+ - `IDictionary.GetValueOrDefault`
+ - broken UnsafeCoerce utilities
+ - `CameraExtrinsics` and `CameraIntrinsics`
+ - float variants of `Constant`
+ - `IPol.SlerpShortest`
+ - `Cell.Parse()` with offset parameter
+ - `M44x.PerspectiveProjectionTransformLH`
+ - `Trafo.PerspectiveProjectionOpenGl`
+ - `Trafo.PerspectiveProjectionLH`
+ - `Trafo.OrthoProjectionOpenGl`
+ - `RangeSet` and `RangeSet64`
+ - `RangeSet1*.insert` and `window`
+ - `Time` and `TimeLink`
+ - `ExecutableMemory`
+ - `Dictionary.TryRemove` and `GetOrAdd`
+ - `Seq.forany` and `Array.forany` (use `exists` instead)
+ - `Strings` module
+ - Assembler related types and functions (use Aardvark.Assembler instead)
### 5.2.31
* fixed Hash Computations for non-primitive types
diff --git a/src/Aardvark.Base.FSharp/Aardvark.Base.FSharp.fsproj b/src/Aardvark.Base.FSharp/Aardvark.Base.FSharp.fsproj
index b609aea7d..205813f29 100644
--- a/src/Aardvark.Base.FSharp/Aardvark.Base.FSharp.fsproj
+++ b/src/Aardvark.Base.FSharp/Aardvark.Base.FSharp.fsproj
@@ -41,7 +41,6 @@
]
-type private HalfRange =
- struct
- val mutable public IsMax : bool
- val mutable public Value : int32
-
- new(m,v) = { IsMax = m; Value = v }
-
- override x.GetHashCode() =
- if x.IsMax then 0
- else x.Value.GetHashCode()
-
- override x.Equals o =
- match o with
- | :? HalfRange as o ->
- x.IsMax = o.IsMax && x.Value = o.Value
- | _ ->
- false
-
- member x.CompareTo (o : HalfRange) =
- let c = x.Value.CompareTo o.Value
- if c = 0 then
- if x.IsMax = o.IsMax then 0
- else (if x.IsMax then 1 else -1)
- else
- c
-
- interface IComparable with
- member x.CompareTo o =
- match o with
- | :? HalfRange as o -> x.CompareTo(o)
- | _ -> failwith "uncomparable"
- end
-
-
-[]
-[]
-type RangeSet = private { root : FingerTreeNode } with
-
- member private x.AsString =
- x |> Seq.map (sprintf "%A")
- |> String.concat "; "
- |> sprintf "set [%s]"
-
- member x.Min =
- match x.root |> FingerTreeNode.firstOpt with
- | Some f -> f.Value
- | _ -> Int32.MaxValue
-
- member x.Max =
- match x.root |> FingerTreeNode.lastOpt with
- | Some f -> f.Value
- | _ -> Int32.MinValue
-
- member x.Range =
- match FingerTreeNode.firstOpt x.root, FingerTreeNode.lastOpt x.root with
- | Some min, Some max -> Range1i(min.Value, max.Value)
- | _ -> Range1i.Invalid
-
- interface IEnumerable with
- member x.GetEnumerator() = new RangeSetEnumerator(FingerTreeImplementation.FingerTreeNode.getEnumeratorFw x.root) :> IEnumerator
-
- interface IEnumerable with
- member x.GetEnumerator() = new RangeSetEnumerator(FingerTreeImplementation.FingerTreeNode.getEnumeratorFw x.root) :> _
-
-
-and private RangeSetEnumerator(i : IEnumerator) =
-
- let mutable last = HalfRange()
- let mutable current = HalfRange()
-
- member x.Current = Range1i(last.Value, current.Value - 1)
-
- interface IEnumerator with
- member x.MoveNext() =
- if i.MoveNext() then
- last <- i.Current
- if i.MoveNext() then
- current <- i.Current
- true
- else
- false
- else
- false
-
- member x.Current = x.Current :> obj
-
- member x.Reset() =
- i.Reset()
-
- interface IEnumerator with
- member x.Current = x.Current
- member x.Dispose() = i.Dispose()
-
-[]
-[]
-module RangeSet =
- let private mm =
- {
- quantify = fun (r : HalfRange) -> r
- mempty = HalfRange(false, Int32.MinValue)
- mappend = fun l r -> if l.CompareTo r > 0 then l else r
- }
-
- let private minRange = HalfRange(false, Int32.MinValue)
-
- let inline private leq v = HalfRange(true, v)
- let inline private geq v = HalfRange(false, v)
-
- let inline private (|Leq|Geq|) (r : HalfRange) =
- if r.IsMax then Leq r.Value
- else Geq r.Value
-
- let empty = { root = Empty }
-
- let insert (range : Range1i) (t : RangeSet) =
- let rangeMax = range.Max + 1
-
- let (l,rest) = t.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo range.Min >= 0) minRange
- let (_,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax > 0) minRange
-
- let max = leq rangeMax
- let min = geq range.Min
-
- match FingerTreeNode.lastOpt l, FingerTreeNode.firstOpt r with
- | None, None ->
- { root = Deep(max, One(min), Empty, One(max)) }
-
- | Some lmax, None ->
- match lmax with
- | Leq _ -> { root = l |> FingerTreeNode.append mm min |> FingerTreeNode.append mm max }
- | Geq _ -> { root = l |> FingerTreeNode.append mm max }
-
- | None, Some rmin ->
- match rmin with
- | Leq _ -> { root = r |> FingerTreeNode.prepend mm min }
- | Geq _ -> { root = r |> FingerTreeNode.prepend mm max |> FingerTreeNode.prepend mm min }
-
- | Some lmax, Some rmin ->
- match lmax, rmin with
- | Leq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min;max] r }
-
- | Geq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [] r }
-
- | Leq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min] r }
-
- | Geq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [max] r }
-
- let remove (range : Range1i) (t : RangeSet) =
- let rangeMax = range.Max + 1
-
- let (l,rest) = t.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo range.Min >= 0) minRange
- let (_,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax > 0) minRange
-
- let max = geq rangeMax
- let min = leq range.Min
-
- match FingerTreeNode.lastOpt l, FingerTreeNode.firstOpt r with
- | None, None ->
- { root = Empty }
-
- | Some lmax, None ->
- match lmax with
- | Leq _ -> { root = l }
- | Geq _ -> { root = l |> FingerTreeNode.append mm min }
-
- | None, Some rmin ->
- match rmin with
- | Leq _ -> { root = r |> FingerTreeNode.prepend mm max }
- | Geq _ -> { root = r }
-
- | Some lmax, Some rmin ->
- match lmax, rmin with
- | Leq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [] r }
-
- | Geq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min; max] r }
-
- | Leq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [max] r }
-
- | Geq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min] r }
-
- let ofSeq (s : seq) =
- let mutable res = empty
- for e in s do res <- insert e res
- res
-
- let inline ofList (l : list) = ofSeq l
- let inline ofArray (l : Range1i[]) = ofSeq l
-
- let toSeq (r : RangeSet) = r :> seq<_>
- let toList (r : RangeSet) = r |> Seq.toList
- let toArray (r : RangeSet) = r |> Seq.toArray
-
- let inline min (t : RangeSet) = t.Min
- let inline max (t : RangeSet) = t.Max
- let inline range (t : RangeSet) = t.Range
-
- let window (window : Range1i) (set : RangeSet) =
- let rangeMax = window.Max + 1
-
- let (l,rest) = set.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo window.Min > 0) minRange
- let (inner,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax >= 0) minRange
-
- let inner =
- match FingerTreeNode.lastOpt l with
- | Some (Geq _) -> FingerTreeNode.prepend mm (geq window.Min) inner
- | _ -> inner
-
- let inner =
- match FingerTreeNode.firstOpt r with
- | Some (Leq _) -> FingerTreeNode.append mm (leq rangeMax) inner
- | _ -> inner
-
- { root = inner }
-
-[]
-type private HalfRange64 =
- struct
- val mutable public IsMax : bool
- val mutable public Value : int64
-
- new(m,v) = { IsMax = m; Value = v }
-
- override x.GetHashCode() =
- if x.IsMax then 0
- else x.Value.GetHashCode()
-
- override x.Equals o =
- match o with
- | :? HalfRange64 as o ->
- x.IsMax = o.IsMax && x.Value = o.Value
- | _ ->
- false
-
- member x.CompareTo (o : HalfRange64) =
- let c = x.Value.CompareTo o.Value
- if c = 0 then
- if x.IsMax = o.IsMax then 0
- else (if x.IsMax then 1 else -1)
- else
- c
-
- interface IComparable with
- member x.CompareTo o =
- match o with
- | :? HalfRange64 as o -> x.CompareTo(o)
- | _ -> failwith "uncomparable"
- end
-
-
-[]
-[]
-type RangeSet64 = private { root : FingerTreeNode } with
-
- member private x.AsString =
- x |> Seq.map (sprintf "%A")
- |> String.concat "; "
- |> sprintf "set [%s]"
-
- member x.Min =
- match x.root |> FingerTreeNode.firstOpt with
- | Some f -> f.Value
- | _ -> Int64.MaxValue
-
- member x.Max =
- match x.root |> FingerTreeNode.lastOpt with
- | Some f -> f.Value
- | _ -> Int64.MinValue
-
- member x.Range =
- match FingerTreeNode.firstOpt x.root, FingerTreeNode.lastOpt x.root with
- | Some min, Some max -> Range1l(min.Value, max.Value)
- | _ -> Range1l.Invalid
-
- interface IEnumerable with
- member x.GetEnumerator() = new RangeSet64Enumerator(FingerTreeImplementation.FingerTreeNode.getEnumeratorFw x.root) :> IEnumerator
-
- interface IEnumerable with
- member x.GetEnumerator() = new RangeSet64Enumerator(FingerTreeImplementation.FingerTreeNode.getEnumeratorFw x.root) :> _
-
-
-and private RangeSet64Enumerator(i : IEnumerator) =
-
- let mutable last = HalfRange64()
- let mutable current = HalfRange64()
-
- member x.Current = Range1l(last.Value, current.Value - 1L)
-
- interface IEnumerator with
- member x.MoveNext() =
- if i.MoveNext() then
- last <- i.Current
- if i.MoveNext() then
- current <- i.Current
- true
- else
- false
- else
- false
-
- member x.Current = x.Current :> obj
-
- member x.Reset() =
- i.Reset()
-
- interface IEnumerator with
- member x.Current = x.Current
- member x.Dispose() = i.Dispose()
-
-[]
-[]
-module RangeSet64 =
- let private mm =
- {
- quantify = fun (r : HalfRange64) -> r
- mempty = HalfRange64(false, Int64.MinValue)
- mappend = fun l r -> if l.CompareTo r > 0 then l else r
- }
-
- let private minRange = HalfRange64(false, Int64.MinValue)
-
- let inline private leq v = HalfRange64(true, v)
- let inline private geq v = HalfRange64(false, v)
-
- let inline private (|Leq|Geq|) (r : HalfRange64) =
- if r.IsMax then Leq r.Value
- else Geq r.Value
-
- let empty = { root = Empty }
-
- let insert (range : Range1l) (t : RangeSet64) =
- let rangeMax = range.Max + 1L
-
- let (l,rest) = t.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo range.Min >= 0) minRange
- let (_,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax > 0) minRange
-
- let max = leq rangeMax
- let min = geq range.Min
-
- match FingerTreeNode.lastOpt l, FingerTreeNode.firstOpt r with
- | None, None ->
- { root = Deep(max, One(min), Empty, One(max)) }
-
- | Some lmax, None ->
- match lmax with
- | Leq _ -> { root = l |> FingerTreeNode.append mm min |> FingerTreeNode.append mm max }
- | Geq _ -> { root = l |> FingerTreeNode.append mm max }
-
- | None, Some rmin ->
- match rmin with
- | Leq _ -> { root = r |> FingerTreeNode.prepend mm min }
- | Geq _ -> { root = r |> FingerTreeNode.prepend mm max |> FingerTreeNode.prepend mm min }
-
- | Some lmax, Some rmin ->
- match lmax, rmin with
- | Leq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min;max] r }
-
- | Geq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [] r }
-
- | Leq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min] r }
-
- | Geq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [max] r }
-
- let remove (range : Range1l) (t : RangeSet64) =
- let rangeMax = range.Max + 1L
-
- let (l,rest) = t.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo range.Min >= 0) minRange
- let (_,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax > 0) minRange
-
- let max = geq rangeMax
- let min = leq range.Min
-
- match FingerTreeNode.lastOpt l, FingerTreeNode.firstOpt r with
- | None, None ->
- { root = Empty }
-
- | Some lmax, None ->
- match lmax with
- | Leq _ -> { root = l }
- | Geq _ -> { root = l |> FingerTreeNode.append mm min }
-
- | None, Some rmin ->
- match rmin with
- | Leq _ -> { root = r |> FingerTreeNode.prepend mm max }
- | Geq _ -> { root = r }
-
- | Some lmax, Some rmin ->
- match lmax, rmin with
- | Leq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [] r }
-
- | Geq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min; max] r }
-
- | Leq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [max] r }
-
- | Geq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min] r }
-
- let ofSeq (s : seq) =
- let mutable res = empty
- for e in s do res <- insert e res
- res
-
- let inline ofList (l : list) = ofSeq l
- let inline ofArray (l : Range1l[]) = ofSeq l
-
- let toSeq (r : RangeSet64) = r :> seq<_>
- let toList (r : RangeSet64) = r |> Seq.toList
- let toArray (r : RangeSet64) = r |> Seq.toArray
-
- let inline min (t : RangeSet64) = t.Min
- let inline max (t : RangeSet64) = t.Max
- let inline range (t : RangeSet64) = t.Range
-
- let window (window : Range1l) (set : RangeSet64) =
- let rangeMax = window.Max + 1L
-
- let (l,rest) = set.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo window.Min > 0) minRange
- let (inner,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax >= 0) minRange
-
- let inner =
- match FingerTreeNode.lastOpt l with
- | Some (Geq _) -> FingerTreeNode.prepend mm (geq window.Min) inner
- | _ -> inner
-
- let inner =
- match FingerTreeNode.firstOpt r with
- | Some (Leq _) -> FingerTreeNode.append mm (leq rangeMax) inner
- | _ -> inner
-
- { root = inner }
-
diff --git a/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSetOld_template.fs b/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSetOld_template.fs
deleted file mode 100644
index 759b6e7f8..000000000
--- a/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSetOld_template.fs
+++ /dev/null
@@ -1,242 +0,0 @@
-namespace Aardvark.Base
-
-open System
-open System.Collections
-open System.Collections.Generic
-open FingerTreeImplementation
-
-#nowarn "44"
-
-//# foreach (var isLong in new[] { false, true }) {
-//# var halfrange = isLong ? "HalfRange64" : "HalfRange";
-//# var rangeset = isLong ? "RangeSet64" : "RangeSet";
-//# var rangesetenumerator = isLong ? "RangeSet64Enumerator" : "RangeSetEnumerator";
-//# var range = isLong ? "Range1l" : "Range1i";
-//# var systype = isLong ? "Int64" : "Int32";
-//# var ft = isLong ? "int64" : "int32";
-//# var one = isLong ? "1L" : "1";
-//# var replacement = isLong ? "RangeSet1l" : "RangeSet1i";
-[]
-type private __halfrange__ =
- struct
- val mutable public IsMax : bool
- val mutable public Value : __ft__
-
- new(m,v) = { IsMax = m; Value = v }
-
- override x.GetHashCode() =
- if x.IsMax then 0
- else x.Value.GetHashCode()
-
- override x.Equals o =
- match o with
- | :? __halfrange__ as o ->
- x.IsMax = o.IsMax && x.Value = o.Value
- | _ ->
- false
-
- member x.CompareTo (o : __halfrange__) =
- let c = x.Value.CompareTo o.Value
- if c = 0 then
- if x.IsMax = o.IsMax then 0
- else (if x.IsMax then 1 else -1)
- else
- c
-
- interface IComparable with
- member x.CompareTo o =
- match o with
- | :? __halfrange__ as o -> x.CompareTo(o)
- | _ -> failwith "uncomparable"
- end
-
-
-[]
-[]
-type __rangeset__ = private { root : FingerTreeNode<__halfrange__, __halfrange__> } with
-
- member private x.AsString =
- x |> Seq.map (sprintf "%A")
- |> String.concat "; "
- |> sprintf "set [%s]"
-
- member x.Min =
- match x.root |> FingerTreeNode.firstOpt with
- | Some f -> f.Value
- | _ -> __systype__.MaxValue
-
- member x.Max =
- match x.root |> FingerTreeNode.lastOpt with
- | Some f -> f.Value
- | _ -> __systype__.MinValue
-
- member x.Range =
- match FingerTreeNode.firstOpt x.root, FingerTreeNode.lastOpt x.root with
- | Some min, Some max -> __range__(min.Value, max.Value)
- | _ -> __range__.Invalid
-
- interface IEnumerable with
- member x.GetEnumerator() = new __rangesetenumerator__(FingerTreeImplementation.FingerTreeNode.getEnumeratorFw x.root) :> IEnumerator
-
- interface IEnumerable<__range__> with
- member x.GetEnumerator() = new __rangesetenumerator__(FingerTreeImplementation.FingerTreeNode.getEnumeratorFw x.root) :> _
-
-
-and private __rangesetenumerator__(i : IEnumerator<__halfrange__>) =
-
- let mutable last = __halfrange__()
- let mutable current = __halfrange__()
-
- member x.Current = __range__(last.Value, current.Value - __one__)
-
- interface IEnumerator with
- member x.MoveNext() =
- if i.MoveNext() then
- last <- i.Current
- if i.MoveNext() then
- current <- i.Current
- true
- else
- false
- else
- false
-
- member x.Current = x.Current :> obj
-
- member x.Reset() =
- i.Reset()
-
- interface IEnumerator<__range__> with
- member x.Current = x.Current
- member x.Dispose() = i.Dispose()
-
-[]
-[]
-module __rangeset__ =
- let private mm =
- {
- quantify = fun (r : __halfrange__) -> r
- mempty = __halfrange__(false, __systype__.MinValue)
- mappend = fun l r -> if l.CompareTo r > 0 then l else r
- }
-
- let private minRange = __halfrange__(false, __systype__.MinValue)
-
- let inline private leq v = __halfrange__(true, v)
- let inline private geq v = __halfrange__(false, v)
-
- let inline private (|Leq|Geq|) (r : __halfrange__) =
- if r.IsMax then Leq r.Value
- else Geq r.Value
-
- let empty = { root = Empty }
-
- let insert (range : __range__) (t : __rangeset__) =
- let rangeMax = range.Max + __one__
-
- let (l,rest) = t.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo range.Min >= 0) minRange
- let (_,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax > 0) minRange
-
- let max = leq rangeMax
- let min = geq range.Min
-
- match FingerTreeNode.lastOpt l, FingerTreeNode.firstOpt r with
- | None, None ->
- { root = Deep(max, One(min), Empty, One(max)) }
-
- | Some lmax, None ->
- match lmax with
- | Leq _ -> { root = l |> FingerTreeNode.append mm min |> FingerTreeNode.append mm max }
- | Geq _ -> { root = l |> FingerTreeNode.append mm max }
-
- | None, Some rmin ->
- match rmin with
- | Leq _ -> { root = r |> FingerTreeNode.prepend mm min }
- | Geq _ -> { root = r |> FingerTreeNode.prepend mm max |> FingerTreeNode.prepend mm min }
-
- | Some lmax, Some rmin ->
- match lmax, rmin with
- | Leq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min;max] r }
-
- | Geq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [] r }
-
- | Leq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min] r }
-
- | Geq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [max] r }
-
- let remove (range : __range__) (t : __rangeset__) =
- let rangeMax = range.Max + __one__
-
- let (l,rest) = t.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo range.Min >= 0) minRange
- let (_,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax > 0) minRange
-
- let max = geq rangeMax
- let min = leq range.Min
-
- match FingerTreeNode.lastOpt l, FingerTreeNode.firstOpt r with
- | None, None ->
- { root = Empty }
-
- | Some lmax, None ->
- match lmax with
- | Leq _ -> { root = l }
- | Geq _ -> { root = l |> FingerTreeNode.append mm min }
-
- | None, Some rmin ->
- match rmin with
- | Leq _ -> { root = r |> FingerTreeNode.prepend mm max }
- | Geq _ -> { root = r }
-
- | Some lmax, Some rmin ->
- match lmax, rmin with
- | Leq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [] r }
-
- | Geq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min; max] r }
-
- | Leq _, Leq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [max] r }
-
- | Geq _, Geq _ ->
- { root = FingerTreeNode.concatWithMiddle mm l [min] r }
-
- let ofSeq (s : seq<__range__>) =
- let mutable res = empty
- for e in s do res <- insert e res
- res
-
- let inline ofList (l : list<__range__>) = ofSeq l
- let inline ofArray (l : __range__[]) = ofSeq l
-
- let toSeq (r : __rangeset__) = r :> seq<_>
- let toList (r : __rangeset__) = r |> Seq.toList
- let toArray (r : __rangeset__) = r |> Seq.toArray
-
- let inline min (t : __rangeset__) = t.Min
- let inline max (t : __rangeset__) = t.Max
- let inline range (t : __rangeset__) = t.Range
-
- let window (window : __range__) (set : __rangeset__) =
- let rangeMax = window.Max + __one__
-
- let (l,rest) = set.root |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo window.Min > 0) minRange
- let (inner,r) = rest |> FingerTreeNode.splitFirstRight mm (fun v -> v.Value.CompareTo rangeMax >= 0) minRange
-
- let inner =
- match FingerTreeNode.lastOpt l with
- | Some (Geq _) -> FingerTreeNode.prepend mm (geq window.Min) inner
- | _ -> inner
-
- let inner =
- match FingerTreeNode.firstOpt r with
- | Some (Leq _) -> FingerTreeNode.append mm (leq rangeMax) inner
- | _ -> inner
-
- { root = inner }
-
-//# }
\ No newline at end of file
diff --git a/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSet_auto.fs b/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSet_auto.fs
index 20320d66b..043c01727 100644
--- a/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSet_auto.fs
+++ b/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSet_auto.fs
@@ -448,9 +448,6 @@ module RangeSet1i =
/// Adds the given range to the set.
let inline add (range : Range1i) (set : RangeSet1i) = set.Add range
- []
- let inline insert (range : Range1i) (set : RangeSet1i) = set.Add range
-
/// Removes the given range from the set.
let inline remove (range : Range1i) (set : RangeSet1i) = set.Remove range
@@ -460,9 +457,6 @@ module RangeSet1i =
/// Returns the intersection of the set with the given range.
let inline intersect (range : Range1i) (set : RangeSet1i) = set.Intersect range
- []
- let inline window (range : Range1i) (set : RangeSet1i) = intersect range set
-
/// Returns whether the given value is contained in the range set.
let inline contains (value : int32) (set : RangeSet1i) = set.Contains value
@@ -901,9 +895,6 @@ module RangeSet1ui =
/// Adds the given range to the set.
let inline add (range : Range1ui) (set : RangeSet1ui) = set.Add range
- []
- let inline insert (range : Range1ui) (set : RangeSet1ui) = set.Add range
-
/// Removes the given range from the set.
let inline remove (range : Range1ui) (set : RangeSet1ui) = set.Remove range
@@ -913,9 +904,6 @@ module RangeSet1ui =
/// Returns the intersection of the set with the given range.
let inline intersect (range : Range1ui) (set : RangeSet1ui) = set.Intersect range
- []
- let inline window (range : Range1ui) (set : RangeSet1ui) = intersect range set
-
/// Returns whether the given value is contained in the range set.
let inline contains (value : uint32) (set : RangeSet1ui) = set.Contains value
@@ -1354,9 +1342,6 @@ module RangeSet1l =
/// Adds the given range to the set.
let inline add (range : Range1l) (set : RangeSet1l) = set.Add range
- []
- let inline insert (range : Range1l) (set : RangeSet1l) = set.Add range
-
/// Removes the given range from the set.
let inline remove (range : Range1l) (set : RangeSet1l) = set.Remove range
@@ -1366,9 +1351,6 @@ module RangeSet1l =
/// Returns the intersection of the set with the given range.
let inline intersect (range : Range1l) (set : RangeSet1l) = set.Intersect range
- []
- let inline window (range : Range1l) (set : RangeSet1l) = intersect range set
-
/// Returns whether the given value is contained in the range set.
let inline contains (value : int64) (set : RangeSet1l) = set.Contains value
@@ -1807,9 +1789,6 @@ module RangeSet1ul =
/// Adds the given range to the set.
let inline add (range : Range1ul) (set : RangeSet1ul) = set.Add range
- []
- let inline insert (range : Range1ul) (set : RangeSet1ul) = set.Add range
-
/// Removes the given range from the set.
let inline remove (range : Range1ul) (set : RangeSet1ul) = set.Remove range
@@ -1819,9 +1798,6 @@ module RangeSet1ul =
/// Returns the intersection of the set with the given range.
let inline intersect (range : Range1ul) (set : RangeSet1ul) = set.Intersect range
- []
- let inline window (range : Range1ul) (set : RangeSet1ul) = intersect range set
-
/// Returns whether the given value is contained in the range set.
let inline contains (value : uint64) (set : RangeSet1ul) = set.Contains value
diff --git a/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSet_template.fs b/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSet_template.fs
index 412f4e753..e96baaeca 100644
--- a/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSet_template.fs
+++ b/src/Aardvark.Base.FSharp/Datastructures/Immutable/RangeSet_template.fs
@@ -462,9 +462,6 @@ module __rangeset__ =
/// Adds the given range to the set.
let inline add (range : __range__) (set : __rangeset__) = set.Add range
- []
- let inline insert (range : __range__) (set : __rangeset__) = set.Add range
-
/// Removes the given range from the set.
let inline remove (range : __range__) (set : __rangeset__) = set.Remove range
@@ -474,9 +471,6 @@ module __rangeset__ =
/// Returns the intersection of the set with the given range.
let inline intersect (range : __range__) (set : __rangeset__) = set.Intersect range
- []
- let inline window (range : __range__) (set : __rangeset__) = intersect range set
-
/// Returns whether the given value is contained in the range set.
let inline contains (value : __ltype__) (set : __rangeset__) = set.Contains value
diff --git a/src/Aardvark.Base.FSharp/Datastructures/Mutable/Order.fs b/src/Aardvark.Base.FSharp/Datastructures/Mutable/Order.fs
deleted file mode 100644
index 251765e51..000000000
--- a/src/Aardvark.Base.FSharp/Datastructures/Mutable/Order.fs
+++ /dev/null
@@ -1,299 +0,0 @@
-#if INTERACTIVE
-#r "..\\..\\Packages\\Rx-Core.2.2.4\\lib\\net45\\System.Reactive.Core.dll"
-#r "..\\..\\Packages\\NUnit.2.6.3\\lib\\nunit.framework.dll"
-#r "..\\..\\Bin\\Release\\Aardvark.Base.dll"
-#r "..\\..\\Bin\\Release\\Aardvark.Preliminary.dll"
-#r "..\\..\\Bin\\Release\\Aardvark.Base.FSharp.dll"
-open Aardvark.Base
-#else
-namespace Aardvark.Base
-#endif
-
-#nowarn "44"
-
-open System
-
-/// Time represents a order-maintenance structure
-/// providing operations "after" and "delete"
-/// maintaining O(1) comparisons between times
-[]
-[]
-type Time =
- class
- /// The representant-time for this tims
- val mutable public Representant : Time
-
- /// The total number of times currently in the time-list
- /// NOTE that Count is only valid for the representant-node
- val mutable public Count : int
-
-
- val mutable internal m_time : uint64
- val mutable internal NextArray : array
- val mutable internal PrevArray : array
-
- /// gets the direct successor for the time
- member x.Next = x.NextArray.[0].Target
-
- /// gets the direct predecessor for the time
- member x.Prev = x.PrevArray.[0].Target
-
- /// gets the height of the skip-node
- member internal x.Height =
- assert (x.NextArray.Length = x.PrevArray.Length)
- x.NextArray.Length
-
- /// gets the comparable key for the time (as uint64)
- member x.Time =
- x.m_time - x.Representant.m_time
-
- /// gets the n-th time after this one
- /// NOTE that this only works on representant-nodes
- member x.TryAt (index : int) =
- if x <> x.Representant then
- failwith "indexing operations can only be performed on the representant-time"
-
- let rec search (index : int) (level : int) (t : Time) : Option =
- if level < 0 then
- if index = 0 then Some t
- else None
- else
- let link = t.NextArray.[level]
- if index < link.Width then
- search index (level - 1) t
- else
- search (index - link.Width) level link.Target
-
- if index >= 0 && index < x.Count then
- search index (x.Height - 1) x
- else
- None
-
- member x.Item
- with get (index : int) =
- match x.TryAt(index) with
- | Some t -> t
- | None -> raise <| IndexOutOfRangeException()
-
- interface IComparable with
- member x.CompareTo o =
- match o with
- | :? Time as o ->
- assert (o.Representant = x.Representant)
- compare x.Time o.Time
- | _ -> failwithf "cannot compare time to %A" o
-
- override x.GetHashCode() = System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode(x)
- override x.Equals o = System.Object.ReferenceEquals(x, o)
- override x.ToString() = sprintf "%.5f" ((float x.Time) / (float System.UInt64.MaxValue))
- internal new (h) = { Representant = null; m_time = 0UL; NextArray = Array.zeroCreate h; PrevArray = Array.zeroCreate h; Count = 1 }
-
- end
-
-
-and TimeLink =
- struct
- val mutable public Width : int
- val mutable public Target : Time
-
- new(w,t) = { Width = w; Target = t }
- end
-
-[]
-[]
-module Time =
- let private random = Random()
- let private randomHeight() =
- let mutable h = 1
- while random.NextDouble() < 0.5 do
- h <- h + 1
- h
-
- let inline private (|TimeLink|) (t : TimeLink) =
- TimeLink(t.Width, t.Target)
-
- let private printLevels (t : Time) =
- assert (t = t.Representant)
- for l in 0..t.Height-1 do
- let (TimeLink(d,n)) = t.NextArray.[l]
- printf "%d: %A" l t
- printf " -(%d)-> %A " d n
- let mutable current = t.NextArray.[l].Target
- while current <> t do
- let (TimeLink(d,n)) = current.NextArray.[l]
- printf " -(%d)-> %A " d n
- current <- n
- printfn ""
-
-
- /// creates a new root-time
- let newRoot() =
- let h = randomHeight()
- let root = Time(1)
-
- root.Representant <- root
- root.NextArray.[0] <- TimeLink(1,root)
- root.PrevArray.[0] <- TimeLink(1,root)
-
- root
-
- /// computes the (unsigned) distance between two times.
- /// NOTE that "distance a a" is UInt64.MaxValue
- let private distance (t0 : Time) (t1 : Time) =
- if t0 = t1 then System.UInt64.MaxValue
- else t1.Time - t0.Time
-
- /// creates a new time directly after the given one
- /// in runtime O(log N) time.
- let after (t : Time) =
- let mutable dn = distance t t.NextArray.[0].Target
-
- // if the distance to the next time is 1 (no room)
- // relabel all times s.t. the new one can be inserted
- if dn = 1UL then
- // find a range s.t. distance(range) >= 1 + |range|^2
- let mutable current = t.NextArray.[0].Target
- let mutable j = 1UL
- while distance t current < 1UL + j * j do
- current <- current.NextArray.[0].Target
- j <- j + 1UL
-
- // distribute all times in the range equally spaced
- let step = (distance t current) / j
- current <- t.NextArray.[0].Target
- let mutable currentTime = t.m_time + step
- for k in 1UL..(j-1UL) do
- current.m_time <- currentTime
- current <- current.NextArray.[0].Target
- currentTime <- currentTime + step
-
- // store the distance to the next time
- dn <- step
-
- let back (n : Time) =
- n.PrevArray.[n.PrevArray.Length - 1]
-
- // insert the new time with distance (dn / 2) after
- // the given one (there has to be enough room now)
- let h = randomHeight()
- let res = Time h
- res.m_time <- t.m_time + dn / 2UL
- res.Representant <- t.Representant
-
-
- // since the predecessor might be "smaller" than
- // the new node we need to search the remaining links
- // by going backward in the list
- let mutable current = t
- let mutable distance = 1
-
- for i in 0..h-1 do
- let resize (n : Time) (h : int) =
- assert (n.Representant = n)
- if h > n.Height then
- let additional = Array.create (h - n.Height) (TimeLink(n.Count,n))
- n.NextArray <- Array.append n.NextArray additional
- n.PrevArray <- Array.append n.PrevArray additional
-
- // go backwards until a node with sufficient height is found
- // or until we've reached the representant
- while i >= current.Height && current <> t.Representant do
- let (TimeLink(d,l)) = back current
- current <- l
- distance <- distance + d
-
- // if the found node is not sufficiently high it must
- // be the representant and therefore it has to be resized
- if i >= current.Height then
- resize current h
-
- // current must now be sufficiently high
- let (TimeLink(d,n)) = current.NextArray.[i]
- current.NextArray.[i] <- TimeLink(distance, res)
- res.PrevArray.[i] <- TimeLink(distance, current)
- res.NextArray.[i] <- TimeLink(1 + d - distance, n)
- n.PrevArray.[i] <- TimeLink(1 + d - distance, res)
-
- // since the predecessor and the new node might be
- // smaller than the total height we need to increment
- // the width of all pointers "passing" the new node (above)
- let mutable current = t
- for i in h..t.Representant.Height-1 do
- while i >= current.Height && current <> t.Representant do
- let (TimeLink(d,l)) = back current
- current <- l
-
- let (TimeLink(d,n)) = current.NextArray.[i]
- current.NextArray.[i] <- TimeLink(d + 1, n)
- n.PrevArray.[i] <- TimeLink(d + 1, current)
-
- // finally increment the count and return the node
- t.Representant.Count <- t.Representant.Count + 1
- res
-
- /// creates a new time directly before the given one
- /// in runtime O(log N) time.
- let before (t : Time) =
- if t.Representant = t then failwith "cannot insert before root time"
- after (t.PrevArray.[0].Target)
-
- /// deletes a time in O(log N) runtime.
- let delete (t : Time) =
- for l in 0..t.Height-1 do
- let (TimeLink(dp, p)) = t.PrevArray.[l]
- let (TimeLink(dn, n)) = t.NextArray.[l]
-
- n.PrevArray.[l] <- TimeLink(dp + dn - 1, p)
- p.NextArray.[l] <- TimeLink(dp + dn - 1, n)
-
- let mutable current = t
- let mutable distance = 1
- for i in t.Height..t.Representant.Height-1 do
- let back (n : Time) =
- n.PrevArray.[n.PrevArray.Length - 1]
-
- // go backwards until a node with sufficient height is found
- // or until we've reached the representant
- while i >= current.Height && current <> t.Representant do
- let (TimeLink(d,l)) = back current
- current <- l
- distance <- distance + d
-
- let (TimeLink(dn, n)) = current.NextArray.[i]
-
- current.NextArray.[i] <- TimeLink(dn - 1, n)
- n.PrevArray.[i] <- TimeLink(dn - 1, current)
-
- // every level (except for 0) on which rep.NextArray.[level] = rep
- // is useless and is therefore removed
- let rep = t.Representant
- let mutable repHeight = rep.Height
- while repHeight > 1 && rep.NextArray.[repHeight - 1].Target = rep do
- repHeight <- repHeight - 1
-
- if repHeight < rep.Height then
- rep.NextArray <- Array.sub rep.NextArray 0 repHeight
- rep.PrevArray <- Array.sub rep.PrevArray 0 repHeight
- t.NextArray <- null
- t.PrevArray <- null
- t.m_time <- 0UL
- t.Representant.Count <- t.Representant.Count - 1
-
- /// deletes all times associated with the given one
- /// in O(1) runtime.
- /// NOTE that the given time must be a representant-node
- let deleteAll (t : Time) =
- if t = t.Representant then
- let h = randomHeight()
- t.NextArray <- Array.create 1 (TimeLink(1,t))
- t.PrevArray <- Array.create 1 (TimeLink(1,t))
- t.Count <- 1
- t.m_time <- 0UL
- else
- failwith "deleteAll shall only be called on root-times"
-
- /// gets the nth element after the given time in O(log N) runtime.
- /// NOTE that the given time must be a representant-node
- let nth (index : int) (t : Time) =
- t.TryAt index
-
diff --git a/src/Aardvark.Base.FSharp/Runtime/ExecutableMemory.fs b/src/Aardvark.Base.FSharp/Runtime/ExecutableMemory.fs
deleted file mode 100644
index 3aa024ae8..000000000
--- a/src/Aardvark.Base.FSharp/Runtime/ExecutableMemory.fs
+++ /dev/null
@@ -1,111 +0,0 @@
-#nowarn "51"
-#if INTERACTIVE
-#r "..\\..\\Bin\\Debug\\Aardvark.Base.dll"
-open Aardvark.Base
-#else
-namespace Aardvark.Base
-
-open System
-
-#endif
-
-
-
-module internal Kernel32 =
- open System
- open System.Runtime.InteropServices
-
- type AllocationType =
- | Commit=0x1000u
-
- type MemoryProtection =
- | ExecuteReadWrite = 0x40u
-
- type FreeType =
- | Decommit = 0x4000u
-
-
- module Imports =
- []
- extern IntPtr VirtualAlloc(IntPtr lpAddress, UIntPtr dwSize, AllocationType flAllocationType, MemoryProtection flProtect);
-
- []
- extern bool VirtualFree(IntPtr lpAddress, UIntPtr dwSize, FreeType freeType);
-
-
-module private Dl =
- open System
- open System.Runtime.InteropServices
-
- type Protection = None = 0x00
- | Read = 0x01
- | Write = 0x02
- | Execute = 0x04
- | ReadWriteExecute = 0x07
-
-
- module Imports =
- []
- extern int getpagesize()
-
- []
- extern int posix_memalign(nativeint* ptr, nativeint p, nativeint size)
-
- []
- extern int mprotect(IntPtr addr, nativeint size, Protection prot);
-
- []
- extern IntPtr malloc(nativeint size)
-
- []
- extern void free(nativeint ptr)
-
-
-
-[]
-module ExecutableMemory =
- open System
- let private os = System.Environment.OSVersion
-
- let alloc (size : nativeint) =
- match os with
- | Windows ->
- Kernel32.Imports.VirtualAlloc(0n, unativeint size, Kernel32.AllocationType.Commit, Kernel32.MemoryProtection.ExecuteReadWrite)
- | Linux | Mac ->
- let pageSize = Dl.Imports.getpagesize()
- let s = size
- let mutable mem = 0n
- let r = Dl.Imports.posix_memalign(&&mem, nativeint pageSize, s)
- if r<>0 then failwith "could not alloc aligned memory"
-
- let stat = Dl.Imports.mprotect(mem, s, Dl.Protection.ReadWriteExecute)
- if stat <> 0 then failwith "mprotect failed"
-
- mem
-
- let free (ptr : nativeint) (size : nativeint) =
- match os with
- | Windows ->
- Kernel32.Imports.VirtualFree(ptr, unativeint size, Kernel32.FreeType.Decommit) |> ignore
- | Linux | Mac ->
- Dl.Imports.free(ptr)
-
-
- let init (data : byte[]) =
- let ptr = alloc (nativeint data.Length)
- System.Runtime.InteropServices.Marshal.Copy(data, 0, ptr, data.Length)
- ptr
-
-
- // simple c function "int test(int a int b) { return a + b }"
- // compiled using gcc with no flags
- let simpleAdd = [| 0x55uy; // push %rbp
- 0x48uy; 0x89uy; 0xe5uy; // mov %rsp,%rbp
- 0x89uy; 0x7duy; 0xfcuy; // mov %edi,-0x4(%rbp)
- 0x89uy; 0x75uy; 0xf8uy; // mov %esi,-0x8(%rbp)
- 0x8buy; 0x45uy; 0xf8uy; // mov -0x8(%rbp),%eax
- 0x8buy; 0x55uy; 0xfcuy; // mov -0x4(%rbp),%edx
- 0x8duy; 0x04uy; 0x02uy; // lea (%rdx,%rax,1),%eax
- 0xc9uy; // leaveq
- 0xc3uy // retq
- |]
\ No newline at end of file
diff --git a/src/Aardvark.Base.FSharp/Runtime/NativeMemory.fs b/src/Aardvark.Base.FSharp/Runtime/NativeMemory.fs
index ea514199a..c4ca8bfd7 100644
--- a/src/Aardvark.Base.FSharp/Runtime/NativeMemory.fs
+++ b/src/Aardvark.Base.FSharp/Runtime/NativeMemory.fs
@@ -648,9 +648,6 @@ and MemoryManager(capacity : nativeint, config : MemoryManagerConfig) as this =
module MemoryManager =
let createHGlobal() = new MemoryManager(16n, Marshal.AllocHGlobal, fun ptr _ -> Marshal.FreeHGlobal ptr)
- []
- let createExecutable() = new MemoryManager(16n, ExecutableMemory.alloc, ExecutableMemory.free)
-
let private nopConfig = { malloc = (fun _ -> 0n); mfree = (fun _ _ -> ()); mcopy = (fun _ _ _ -> ()) }
let createNop() = new MemoryManager(16n, nopConfig)
diff --git a/src/Aardvark.Base.FSharp/Utilities/Interop/Dictionary.fs b/src/Aardvark.Base.FSharp/Utilities/Interop/Dictionary.fs
index 023aa746e..5cb8c82c1 100644
--- a/src/Aardvark.Base.FSharp/Utilities/Interop/Dictionary.fs
+++ b/src/Aardvark.Base.FSharp/Utilities/Interop/Dictionary.fs
@@ -348,10 +348,7 @@ module SymDict =
[]
module CSharpCollectionExtensions =
- open System
- open System.Runtime.CompilerServices
open System.Collections.Generic
- open System.Runtime.InteropServices
type Dictionary<'Key, 'Value> with
member inline x.TryFind(key : 'Key) : 'Value option = Dictionary.tryFind key x
@@ -363,23 +360,4 @@ module CSharpCollectionExtensions =
type SymbolDict<'Value> with
member inline x.TryFind(key : Symbol) : 'Value option = SymDict.tryFind key x
- member inline x.TryFindV(key : Symbol) : 'Value voption = SymDict.tryFindV key x
-
- type public DictionaryExtensions =
-
- []
- []
- static member TryRemove(x : Dictionary<'a,'b>, k,[] r: byref<'b>) =
- match x.TryGetValue k with
- | (true,v) -> r <- v; true
- | _ -> false
-
- []
- []
- static member GetOrAdd(x : Dictionary<'a,'b>, k : 'a, creator : 'a -> 'b) =
- match x.TryGetValue k with
- | (true,v) -> v
- | _ ->
- let v = creator k
- x.Add(k,v) |> ignore
- v
\ No newline at end of file
+ member inline x.TryFindV(key : Symbol) : 'Value voption = SymDict.tryFindV key x
\ No newline at end of file
diff --git a/src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs b/src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs
index 804f62926..ba5bff406 100644
--- a/src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs
+++ b/src/Aardvark.Base.FSharp/Utilities/Interop/FSLibExtensions.fs
@@ -51,10 +51,6 @@ module Prelude =
| Some x -> yield f x
}
- []
- let forany (f : 'a -> bool) (s : seq<'a>) =
- Seq.exists f s
-
let inline foldi (folder : int -> 'State -> 'T -> 'State) (state : 'State) (source : 'T seq) =
use e = source.GetEnumerator()
let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt folder
@@ -157,10 +153,6 @@ module Prelude =
module Array =
- []
- let forany (f : 'a -> bool) (a : 'a[]) =
- Array.exists f a
-
let inline foldi (folder : int -> 'State -> 'T -> 'State) (state : 'State) (array : 'T[]) =
let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(folder)
let mutable state = state
@@ -440,14 +432,6 @@ module EnumExtensions =
module ConversionHelpers =
- []
- let lookupTableOption (l : list<'a * 'b>) : ('a -> 'b option) =
- LookupTable.lookupTable' l
-
- []
- let lookupTable (l : list<'a * 'b>) : ('a -> 'b) =
- LookupTable.lookupTable l
-
[]
let inline convertEnum< ^a, ^b when ^a : (static member op_Explicit : ^a -> int)> (fmt : ^a) : ^b =
let v = int fmt
diff --git a/src/Aardvark.Base.FSharp/Utilities/Interop/String.fs b/src/Aardvark.Base.FSharp/Utilities/Interop/String.fs
index 995e7fbba..999bef34f 100644
--- a/src/Aardvark.Base.FSharp/Utilities/Interop/String.fs
+++ b/src/Aardvark.Base.FSharp/Utilities/Interop/String.fs
@@ -9,22 +9,6 @@ open System
open System.Text.RegularExpressions
open System.Runtime.CompilerServices
-[]
-[]
-module Strings =
- let partRx = Regex @"([A-Z][a-z0-9]*)[_]*"
-
- /// checks whether pattern is contained in str
- let contains (pattern: string) (str: string) = str.Contains pattern
-
- let toLower (str : string) = str.ToLower()
- let toUpper (str : string) = str.ToUpper()
-
- let inline split (sep : string) (str : string) = str.Split([| sep |], StringSplitOptions.None)
- let inline startsWith (s : string) (str : string) = str.StartsWith s
- let inline endsWith (s : string) (str : string) = str.EndsWith s
- let inline trim (str : string) = str.Trim()
-
[]
type StringExtensions private() =
diff --git a/src/Aardvark.Base.IO/BinaryReadingCoder.cs b/src/Aardvark.Base.IO/BinaryReadingCoder.cs
index ffccc819a..475f39318 100644
--- a/src/Aardvark.Base.IO/BinaryReadingCoder.cs
+++ b/src/Aardvark.Base.IO/BinaryReadingCoder.cs
@@ -846,24 +846,6 @@ public void CodeFraction(ref Fraction value)
value = new Fraction(numerator, denominator);
}
- public void CodeCameraExtrinsics(ref CameraExtrinsics v)
- {
- var rotation = default(M33d); var translation = default(V3d);
- CodeM33d(ref rotation); CodeV3d(ref translation);
- v = new CameraExtrinsics(rotation, translation);
- }
-
- public void CodeCameraIntrinsics(ref CameraIntrinsics v)
- {
- var focalLength = default(V2d); var principalPoint = default(V2d);
- double skew = 0.0, k1 = 0.0, k2 = 0.0, k3 = 0.0, p1 = 0.0, p2 = 0.0;
- CodeV2d(ref focalLength); CodeV2d(ref principalPoint);
- CodeDouble(ref skew);
- CodeDouble(ref k1); CodeDouble(ref k2); CodeDouble(ref k3);
- CodeDouble(ref p1); CodeDouble(ref p1);
- v = new CameraIntrinsics(focalLength, principalPoint, skew, k1, k2, k3, p1, p2);
- }
-
#endregion
#region Code Arrays
diff --git a/src/Aardvark.Base.IO/BinaryWritingCoder.cs b/src/Aardvark.Base.IO/BinaryWritingCoder.cs
index e1dc017bc..7421bd526 100644
--- a/src/Aardvark.Base.IO/BinaryWritingCoder.cs
+++ b/src/Aardvark.Base.IO/BinaryWritingCoder.cs
@@ -695,22 +695,6 @@ public void CodeFraction(ref Fraction value)
m_writer.Write(value.Denominator);
}
- public void CodeCameraExtrinsics(ref CameraExtrinsics v)
- {
- var rotation = v.Rotation; var translation = v.Translation;
- CodeM33d(ref rotation); CodeV3d(ref translation);
- }
-
- public void CodeCameraIntrinsics(ref CameraIntrinsics v)
- {
- var focalLength = v.FocalLength; var principalPoint = v.PrincipalPoint;
- double skew = v.Skew, k1 = v.K1, k2 = v.K2, k3 = v.K3, p1 = v.P1, p2 = v.P2;
- CodeV2d(ref focalLength); CodeV2d(ref principalPoint);
- CodeDouble(ref skew);
- CodeDouble(ref k1); CodeDouble(ref k2); CodeDouble(ref k3);
- CodeDouble(ref p1); CodeDouble(ref p1);
- }
-
#endregion
#region Code Arrays
diff --git a/src/Aardvark.Base.IO/FieldCoderExtensions.cs b/src/Aardvark.Base.IO/FieldCoderExtensions.cs
index 1fc60449e..51522b2ab 100644
--- a/src/Aardvark.Base.IO/FieldCoderExtensions.cs
+++ b/src/Aardvark.Base.IO/FieldCoderExtensions.cs
@@ -249,16 +249,6 @@ public static ILGenerator CreateDebugMethod(string name, Type returnType, Type[]
return mb.GetILGenerator();
}
- [Obsolete("cannot save dynamic assemblies anymore")]
- public static void SaveDebug()
- {
- s_assemblyBuilder = null;
- s_modBuilder = null;
- s_typeBuilder = null;
-
- throw new NotSupportedException("cannot save dynamic assemblies anymore");
- }
-
private static AssemblyBuilder s_assemblyBuilder;
private static ModuleBuilder s_modBuilder;
private static TypeBuilder s_typeBuilder;
diff --git a/src/Aardvark.Base.IO/ICoder.cs b/src/Aardvark.Base.IO/ICoder.cs
index 66ec8cd96..1807b28d5 100644
--- a/src/Aardvark.Base.IO/ICoder.cs
+++ b/src/Aardvark.Base.IO/ICoder.cs
@@ -82,9 +82,6 @@ public partial interface ICoder
void CodeIntSet(ref IntSet v);
void CodeSymbolSet(ref SymbolSet v);
- void CodeCameraIntrinsics(ref CameraIntrinsics v);
- void CodeCameraExtrinsics(ref CameraExtrinsics v);
-
void CodeStructArray(ref T[] a) where T : struct;
void CodeStructList(ref List l) where T : struct;
}
diff --git a/src/Aardvark.Base.IO/StreamCodeReader.cs b/src/Aardvark.Base.IO/StreamCodeReader.cs
index 7a4f9222b..22917da67 100644
--- a/src/Aardvark.Base.IO/StreamCodeReader.cs
+++ b/src/Aardvark.Base.IO/StreamCodeReader.cs
@@ -75,22 +75,6 @@ public Symbol ReadGuidSymbol()
#endregion
- #region Camera
-
- public CameraExtrinsics ReadCameraExtrinsics()
- {
- return new CameraExtrinsics(ReadM33d(), ReadV3d());
- }
-
- public CameraIntrinsics ReadCameraIntrinsics()
- {
- return new CameraIntrinsics(ReadV2d(), ReadV2d(),
- ReadDouble(), ReadDouble(), ReadDouble(),
- ReadDouble(), ReadDouble(), ReadDouble());
- }
-
- #endregion
-
#region Read Arrays and Lists
public long ReadArray(byte[] array, long index, long count)
diff --git a/src/Aardvark.Base.IO/StreamCodeWriter.cs b/src/Aardvark.Base.IO/StreamCodeWriter.cs
index 0d06ff346..0cc84a045 100644
--- a/src/Aardvark.Base.IO/StreamCodeWriter.cs
+++ b/src/Aardvark.Base.IO/StreamCodeWriter.cs
@@ -86,26 +86,6 @@ public void WriteGuidSymbol(Symbol value)
#endregion
- #region
-
- public void Write(CameraExtrinsics c)
- {
- Write(c.Rotation); Write(c.Translation);
- }
-
- public void Write(CameraIntrinsics c)
- {
- Write(c.FocalLength);
- Write(c.PrincipalPoint);
- Write(c.Skew);
- Write(c.K1); Write(c.K2); Write(c.K3);
- Write(c.P1); Write(c.P2);
- }
-
-
- #endregion
-
-
#region Write Arrays and Lists
#if !NET6_0_OR_GREATER
diff --git a/src/Aardvark.Base.IO/XmlReadingCoder.cs b/src/Aardvark.Base.IO/XmlReadingCoder.cs
index 83e1fc7a5..50af77477 100644
--- a/src/Aardvark.Base.IO/XmlReadingCoder.cs
+++ b/src/Aardvark.Base.IO/XmlReadingCoder.cs
@@ -667,16 +667,6 @@ public void CodeList_of_Type_(ref List value)
public void CodeList_of_Symbol_(ref List v) { throw new NotImplementedException(); }
public void CodeList_of_Fraction_(ref List v) { throw new NotImplementedException(); }
- public void CodeCameraExtrinsics(ref CameraExtrinsics v)
- {
- throw new NotSupportedException("cannot serialize single camera");
- }
-
- public void CodeCameraIntrinsics(ref CameraIntrinsics v)
- {
- throw new NotSupportedException("cannot serialize single camera");
- }
-
#endregion
#region IDisposable Members
@@ -1691,16 +1681,6 @@ public void CodeList_of_Symbol_(ref List v)
public void CodeList_of_Fraction_(ref List v) { CodeList(ref v, s => Fraction.Parse(s)); }
- public void CodeCameraExtrinsics(ref CameraExtrinsics v)
- {
- throw new NotSupportedException("cannot serialize single camera");
- }
-
- public void CodeCameraIntrinsics(ref CameraIntrinsics v)
- {
- throw new NotSupportedException("cannot serialize single camera");
- }
-
#endregion
#region IDisposable Members
diff --git a/src/Aardvark.Base.IO/XmlWritingCoder.cs b/src/Aardvark.Base.IO/XmlWritingCoder.cs
index 803921f9e..db2da501f 100644
--- a/src/Aardvark.Base.IO/XmlWritingCoder.cs
+++ b/src/Aardvark.Base.IO/XmlWritingCoder.cs
@@ -292,16 +292,6 @@ public void CodeList_of_Type_(ref List value)
public void CodeList_of_Symbol_(ref List v) { throw new NotImplementedException(); }
public void CodeList_of_Guid_(ref List v) { throw new NotImplementedException(); }
- public void CodeCameraExtrinsics(ref CameraExtrinsics v)
- {
- throw new NotSupportedException("cannot serialize single camera");
- }
-
- public void CodeCameraIntrinsics(ref CameraIntrinsics v)
- {
- throw new NotSupportedException("cannot serialize single camera");
- }
-
#endregion
#region IDisposable Members
@@ -1246,16 +1236,6 @@ public void CodeList_of_Type_(ref List value)
public void CodeList_of_Guid_(ref List v) { CodeListOfStruct(v); }
public void CodeList_of_Symbol_(ref List v) { throw new NotImplementedException(); }
- public void CodeCameraExtrinsics(ref CameraExtrinsics v)
- {
- throw new NotSupportedException("cannot serialize single camera");
- }
-
- public void CodeCameraIntrinsics(ref CameraIntrinsics v)
- {
- throw new NotSupportedException("cannot serialize single camera");
- }
-
#endregion
#region IDisposable Members
diff --git a/src/Aardvark.Base.Runtime/Aardvark.Base.Runtime.fsproj b/src/Aardvark.Base.Runtime/Aardvark.Base.Runtime.fsproj
index 77d0a15d0..5decea006 100644
--- a/src/Aardvark.Base.Runtime/Aardvark.Base.Runtime.fsproj
+++ b/src/Aardvark.Base.Runtime/Aardvark.Base.Runtime.fsproj
@@ -15,11 +15,6 @@
..\..\bin\Release
-
-
-type AdaptiveProgramStatistics =
- struct
- val mutable public DeltaProcessTime : TimeSpan
- val mutable public CompileTime : TimeSpan
- val mutable public WriteTime : TimeSpan
-
- val mutable public AddedFragmentCount : int
- val mutable public RemovedFragmentCount : int
- val mutable public CompiledFragmentCount : int
- val mutable public UpdatedFragmentCount : int
- val mutable public UpdatedJumpCount : int
-
- static member Zero =
- AdaptiveProgramStatistics(
- DeltaProcessTime = TimeSpan.Zero,
- CompileTime = TimeSpan.Zero,
- WriteTime = TimeSpan.Zero,
- AddedFragmentCount = 0,
- RemovedFragmentCount = 0,
- CompiledFragmentCount = 0,
- UpdatedFragmentCount = 0,
- UpdatedJumpCount = 0
- )
-
- static member (+) (l : AdaptiveProgramStatistics, r : AdaptiveProgramStatistics) =
- AdaptiveProgramStatistics(
- DeltaProcessTime = l.DeltaProcessTime + r.DeltaProcessTime,
- CompileTime = l.CompileTime + r.CompileTime,
- WriteTime = l.WriteTime + r.WriteTime,
- AddedFragmentCount = l.AddedFragmentCount + r.AddedFragmentCount,
- RemovedFragmentCount = l.RemovedFragmentCount + r.RemovedFragmentCount,
- CompiledFragmentCount = l.CompiledFragmentCount + r.CompiledFragmentCount,
- UpdatedFragmentCount = l.UpdatedFragmentCount + r.UpdatedFragmentCount,
- UpdatedJumpCount = l.UpdatedJumpCount + r.UpdatedJumpCount
- )
-
- static member (-) (l : AdaptiveProgramStatistics, r : AdaptiveProgramStatistics) =
- AdaptiveProgramStatistics(
- DeltaProcessTime = l.DeltaProcessTime - r.DeltaProcessTime,
- CompileTime = l.CompileTime - r.CompileTime,
- WriteTime = l.WriteTime - r.WriteTime,
- AddedFragmentCount = l.AddedFragmentCount - r.AddedFragmentCount,
- RemovedFragmentCount = l.RemovedFragmentCount - r.RemovedFragmentCount,
- CompiledFragmentCount = l.CompiledFragmentCount - r.CompiledFragmentCount,
- UpdatedFragmentCount = l.UpdatedFragmentCount - r.UpdatedFragmentCount,
- UpdatedJumpCount = l.UpdatedJumpCount - r.UpdatedJumpCount
- )
-
-
- override x.ToString() =
- String.concat "\r\n" [
- "AdaptiveProgramStatistics {"
- sprintf " DeltaProcessTime = %A" x.DeltaProcessTime
- sprintf " CompileTime = %A" x.CompileTime
- sprintf " WriteTime = %A" x.WriteTime
- sprintf " AddedFragmentCount = %A" x.AddedFragmentCount
- sprintf " RemovedFragmentCount = %A" x.RemovedFragmentCount
- sprintf " CompiledFragmentCount = %A" x.CompiledFragmentCount
- sprintf " UpdatedFragmentCount = %A" x.UpdatedFragmentCount
- sprintf " UpdatedJumpCount = %A" x.UpdatedJumpCount
- "}"
- ]
-
- end
-
-type IAdaptiveProgram<'i> =
- inherit IAdaptiveObject
- inherit IDisposable
-
- /// updates the program representation if needed and returns some statistics
- abstract member Update : AdaptiveToken -> AdaptiveProgramStatistics
-
- /// runs the program with the given input argument
- /// NOTE: that no updates are performed here
- abstract member Run : 'i -> unit
-
- /// disassembles the underlying program and returns
- /// an implementation specific representation
- abstract member Disassemble : unit -> obj
-
- /// gets or sets a flag indicating whether or not the program should automatically
- /// be defragmented whenever the jump-distance is non-zero
- abstract member AutoDefragmentation : bool with get, set
-
- /// explicitly starts a defragmentation task if needed
- abstract member StartDefragmentation : unit -> Task
-
- /// gets the number of native calls currently performed by the program
- abstract member NativeCallCount : int
-
- /// gets the number of elements currently contained in the program
- abstract member FragmentCount : int
-
- /// gets a total size for the underlying program data
- abstract member ProgramSizeInBytes : int64
-
- /// gets a total jump distance for the underlying program (if applicable)
- abstract member TotalJumpDistanceInBytes : int64
-
-[]
-type IAdaptiveCode<'instruction> =
- inherit IDisposable
- abstract member Content : list>>
-
-type AdaptiveCode<'instruction>(content : list>>) =
- interface IDisposable with
- member x.Dispose() = ()
-
- member x.Content = content
- interface IAdaptiveCode<'instruction> with
- member x.Content = content
-
-[]
-type IFragment<'store> =
- abstract member Storage : 'store
- abstract member Next : IFragment<'store>
- abstract member JumpDistance : int with get, set
-
-
-type FragmentHandler<'i, 'value, 'instruction, 'fragment> =
- {
- compileNeedsPrev : bool
- nativeCallCount : ref
- jumpDistance : ref
- run : 'i -> unit
-
- memorySize : unit -> int64
-
- compileDelta : Option<'value> -> 'value -> IAdaptiveCode<'instruction>
- prolog : 'fragment
- epilog : 'fragment
- startDefragmentation : obj -> ref -> IFragment<'fragment> -> Task
- alloc : array<'instruction> -> 'fragment
- free : 'fragment -> unit
- write : 'fragment -> array<'instruction> -> bool
- writeNext : 'fragment -> 'fragment -> int
- isNext : 'fragment -> 'fragment -> bool
- disassemble : 'fragment -> list<'instruction>
- dispose : unit -> unit
- }
-
-
-module internal GenericProgram =
-
- type Fragment<'i, 'a, 'instruction, 'fragment> =
- class
- inherit AdaptiveObject
-
- val mutable public Context : FragmentHandler<'i, 'a, 'instruction, 'fragment>
- val mutable public Storage : Option<'fragment>
- val mutable public Tag : Option<'a>
- val mutable public Prev : Fragment<'i, 'a, 'instruction, 'fragment>
- val mutable public Next : Fragment<'i, 'a, 'instruction, 'fragment>
- val mutable public Code : IAdaptiveCode<'instruction>
- val mutable public CodePrevTag : Option<'a>
- val mutable public CallCount : int
- val mutable public JumpDistance : int
- val mutable public IsDisposed : bool
-
- interface IFragment<'fragment> with
- member x.Next = x.Next :> IFragment<_>
- member x.Storage = x.Storage.Value
-
- member x.JumpDistance
- with get() = x.JumpDistance
- and set d = x.JumpDistance <- d
-
- member x.Recompile (token : AdaptiveToken) =
- x.EvaluateAlways token (fun token ->
- let hasCode = not (isNull x.Code)
-
- if x.Context.compileNeedsPrev then
- let upToDate = hasCode && Object.Equals(x.CodePrevTag, x.Prev.Tag)
-
- if not upToDate then
- if hasCode then x.Code.Dispose()
- x.Code <- x.Context.compileDelta x.Prev.Tag x.Tag.Value
- x.CodePrevTag <- x.Prev.Tag
- true
- else
- false
- else
- if not hasCode then
- x.Code <- x.Context.compileDelta None x.Tag.Value
- true
- else
- false
-
- )
-
- member x.WriteContent (token : AdaptiveToken) =
- x.EvaluateAlways token (fun token ->
- if not (isNull x.Code) then
- let code =
- x.Code.Content
- |> List.collect (fun c -> c.GetValue token)
- |> List.toArray
-
-
- Interlocked.Add(x.Context.nativeCallCount, code.Length - x.CallCount) |> ignore
- x.CallCount <- code.Length
-
- if Option.isNone x.Storage then
- x.Storage <- Some <| x.Context.alloc code
- true
- else
- x.Context.write x.Storage.Value code
- else
- false
- )
-
- member x.LinkNext(token : AdaptiveToken) =
- x.EvaluateAlways token (fun token ->
- if Unchecked.isNull x.Next && Unchecked.isNull x.Prev then
- Log.warn "[AdaptiveCode] tried to link detached fragment { prev = %A; next = %A }" x.Prev x.Next
- elif x.IsDisposed then
- Log.warn "[AdaptiveCode] tried to link disposed fragment"
- elif x.Next.IsDisposed then
- failwith "[AdaptiveCode] tried to link fragment with disposed next"
- elif Option.isNone x.Storage then
- failwith "[AdaptiveCode] tried to link uninitialized fragment"
- elif Option.isNone x.Next.Storage then
- failwith "[AdaptiveCode] tried to link fragment with uninitialized next"
- else
- let myFragment = x.Storage.Value
- let nextFragment = x.Next.Storage.Value
-
- if not (x.Context.isNext myFragment nextFragment) then
- let distance = x.Context.writeNext myFragment nextFragment
- Interlocked.Add(x.Context.jumpDistance, distance - x.JumpDistance) |> ignore
- x.JumpDistance <- distance
- )
-
- member x.Dispose() =
- x.Prev <- Unchecked.defaultof<_>
- x.Next <- Unchecked.defaultof<_>
- x.IsDisposed <- true
-
- Interlocked.Add(x.Context.jumpDistance, -x.JumpDistance) |> ignore
- x.JumpDistance <- 0
-
- Interlocked.Add(x.Context.nativeCallCount, -x.CallCount) |> ignore
- x.CallCount <- 0
-
- if Option.isSome x.Storage then
- x.Context.free x.Storage.Value
- x.Storage <- None
-
- if not (isNull x.Code) then
- x.Code.Dispose()
- x.CodePrevTag <- None
- x.Code <- null
-
- interface IDisposable with
- member x.Dispose() = x.Dispose()
-
-
- new(context, tag) =
- { Context = context
- Storage = None; Next = Unchecked.defaultof<_>;
- Prev = Unchecked.defaultof<_>; Tag = Some tag;
- Code = null; CodePrevTag = None
- CallCount = 0; JumpDistance = 0; IsDisposed = false }
-
- new(context, storage) =
- { Context = context
- Storage = Some storage; Next = Unchecked.defaultof<_>;
- Prev = Unchecked.defaultof<_>; Tag = None;
- Code = null; CodePrevTag = None
- CallCount = 0; JumpDistance = 0; IsDisposed = false }
- end
-
- []
- type Program<'i, 'k, 'instruction, 'fragment, 'a>
- (input : aset<'k * 'a>,
- keyComparer : IComparer<'k>,
- newHandler : unit -> FragmentHandler<'i, 'a, 'instruction, 'fragment>) =
- inherit AdaptiveObject()
-
- let reader = input.GetReader()
- let version = ref -1
-
- let cache = Dictionary>()
- let fragments = SortedDictionaryExt<'k, StableSet>>(keyComparer)
-
- let handler = newHandler()
-
- let prolog = new Fragment<_,_,_,_>(handler, handler.prolog)
- let epilog = new Fragment<_,_,_,_>(handler, handler.epilog)
-
- do prolog.Next <- epilog
- epilog.Prev <- prolog
- prolog.WriteContent(AdaptiveToken.Top) |> ignore
- epilog.WriteContent(AdaptiveToken.Top) |> ignore
- handler.writeNext prolog.Storage.Value epilog.Storage.Value |> ignore
-
-
- let deltaProcessWatch = System.Diagnostics.Stopwatch()
- let compileWatch = System.Diagnostics.Stopwatch()
- let writeWatch = System.Diagnostics.Stopwatch()
-
- let dirtyLock = obj()
- let mutable dirtySet = System.Collections.Generic.HashSet>()
-
- let mutable autoDefragmentation = 1
-
- #if DEBUG && false
- let validateCurrentState(deltas : list>) =
- let mutable hasErrors = false
- let mutable cnt = 0
- let mutable last = null
- let mutable current = prolog
- let all = HashSet()
- while not (isNull current) do
- all.Add current |> ignore
- if current.IsDisposed then
- hasErrors <- true
- Log.warn "found disposed fragment in list: %A" current.Id
-
- if current.Prev <> last then
- hasErrors <- true
- let lastId = if isNull last then "(null)" else string last.Id
- Log.warn "found invalid prev-pointer from %A to %s" current.Id lastId
-
- last <- current
- current <- current.Next
-
- cnt <- cnt + 1
-
- if cnt - 2 <> cache.Count then
- hasErrors <- true
- Log.warn "unexpected fragment count: { real = %A; cache = %A }" (cnt - 2) cache.Count
-
- for (KeyValue(o, c)) in cache do
- let k,t = unbox<'k * 'a> o
- if not (cache.ContainsKey o) then
- Log.warn "fun fact: enumerated values does not exist in dict"
-
- if c.IsDisposed then
- hasErrors <- true
- Log.warn "found disposed fragment in cache: { Id = %A; Key = %A; Tag = %A }" c.Id k t
-
- if not (all.Contains c) then
- hasErrors <- true
- Log.warn "found cached fragment which is not reachable: { Id = %A; Key = %A; Tag = %A }" c.Id k t
-
- if hasErrors then
- for d in deltas do
- match d with
- | Add (k,v) -> Log.warn "Add %A" k
- | Rem (k,v) -> Log.warn "Rem %A" k
- failwith "[AdaptiveCode] validation failed"
- #else
- let validateCurrentState(deltas : HashSetDelta<'k * 'v>) = ()
- #endif
- override x.InputChangedObject(t, o : IAdaptiveObject) =
- match o with
- | :? Fragment<'i, 'a, 'instruction, 'fragment> as o ->
- if not o.IsDisposed then
- lock dirtyLock (fun () -> dirtySet.Add o |> ignore)
- | _ ->
- ()
-
-
- member x.Run (v : 'i) =
- lock x (fun () ->
- handler.run v
- )
-
- member x.Disassemble() =
- lock x (fun () ->
- let code = List()
- let mutable current = prolog
- while current <> epilog do
- if current <> prolog then
- match current.Storage with
- | None -> code.Add [||]
- | Some s -> code.Add(handler.disassemble s |> List.toArray)
-
- match current.Storage, current.Next.Storage with
- | Some l, Some r ->
- if not (handler.isNext l r) then
- failwith "bad pointers"
- | _ -> ()
-
- current <- current.Next
- code.ToArray()
- )
-
- member x.Update token =
- // update basically runs in 4 stages:
- // 1) process input deltas adding/removing fragments
- // 2) create code for fragments which need to be recompiled.
- // recompile can be triggered either because they're new or their
- // predecessor changed and compileDelta depends on the it.
- // 3) write the code for all changed fragments to their underlying
- // (possibly native) representation. This is obviously needed for new
- // fragments but also for the ones where some inner-instruction changed.
- // 4) link fragments appropriately where needed. Fragments must obviously be
- // linked whenever Next changes but also when WriteContent() returns true
- // (which is the case when the underlying representation has been moved)
- // known issues:
- // - whenver an instruction changes the entire fragment is re-assembled and written
- // as a whole. The write itself may not be too bad but the assemble-step
- // (at least in the native implementation) might be expensive
- // - core-implementations (like CodeFragment) provide Append/Update/Clear function which
- // are no longer optimal for this new implementation.
- // a possibly better API would be (where bool indicates if the fragment was moved)
- // Write : list> -> bool * list
- // Update : Handle -> list -> bool
- x.EvaluateAlways token (fun token ->
- if x.OutOfDate then
- Interlocked.Increment(version) |> ignore
-
- // start by getting the deltas from our input-set
- let deltas = reader.GetChanges token
-
- // get all fragments whose inner code-representation changed.
- let dirtySet =
- lock dirtyLock (fun () ->
- let set = dirtySet
- dirtySet <- System.Collections.Generic.HashSet()
- set
- )
-
- // TODO: move to class-fields
- let deadSet = System.Collections.Generic.HashSet()
- let recompileSet = System.Collections.Generic.HashSet()
- let relinkSet = System.Collections.Generic.HashSet()
-
- let mutable added = 0
- let mutable removed = 0
-
-
- // utility function for creating a new fragment
- // between two given ones.
- // prev = None encodes for prolog
- // next = None encodes for epilog
- let createBetween (prev : Option>) (v : 'a) (next : Option>) =
- // create the new fragment
- let fragment = new Fragment<'i, 'a, 'instruction, 'fragment>(handler, v)
-
- // get the predecessor
- let prev =
- match prev with
- | Some l -> l
- | None -> prolog
-
- // get the successor and add it to the
- // recompile-set whenever compileDelta depends on
- // predecessors (since next's prev will be changed)
- let mutable next =
- match next with
- | Some r ->
- if handler.compileNeedsPrev then recompileSet.Add r |> ignore
- r
- | None -> epilog
-
- if prev.Next <> next then
- Log.warn "[AdaptiveCode] bad fragment creation: prev.Next <> next"
- Log.warn " using prev as anchor (next = prev.Next)"
- next <- prev.Next
-
-
-
- // prev's successor was changed so we need to relink it
- // NOTE that the new fragment must not be added here
- // since it will be processed by stages 1-4 anyway.
- relinkSet.Add prev |> ignore
-
- // insert the new fragment in the linked list.
- fragment.Prev <- prev
- fragment.Next <- next
- next.Prev <- fragment
- prev.Next <- fragment
-
- // finally return the new fragment
- fragment
-
- // stage 1: process all the deltas
- deltaProcessWatch.Restart()
- for d in deltas do
- match d with
- | Add (_,(k,v)) ->
- if cache.ContainsKey((k,v)) then
- Log.warn "[AdaptiveCode] duplicate addition of element %A" k
- else
- added <- added + 1
-
- // for new fragments we need to find the neighbouring ones
- // when possible which is achieved by searching for buckets
- // in our top-level trie.
- let left,self,right = SortedDictionary.neighbourhood k fragments
-
- // when the right bucket is existing (and therefore non-empty)
- // the new fragment's next will be the first element from that bucket
- let next =
- match right with
- | Some(_,r) -> r.First
- | None -> None
-
- // when the left bucket is existing (and therefore non-empty)
- // the new fragment's prev will be the last element from that bucket
- let prev =
- match left with
- | Some(_,l) -> l.Last
- | None -> None
-
- // create and insert the new fragment at the appropriate
- // position in the linked list.
- let fragment =
- match self with
- | Some self ->
- // if a bucket exists for the exact same key we add the new fragment
- // at the end of the bucket. The fragment's next will be the first one
- // in the right bucket (given by next)
- let prev =
- match self.Last with
- | Some last -> Some last
- | None -> prev
-
- let fragment = createBetween prev v next
- self.Add fragment |> ignore
-
- // the creation cannot fail here since we always create
- // a new fragment here (which cannot have been in the bucket)
- //created.Value
- fragment
-
- | None ->
- // if no bucket was created for the fragment's key yet
- // the fragments neighbours are prev and next (as defined above).
- let frag = createBetween prev v next
-
-
- // we obviously need to create a new bucket which will
- // simply contain the created fragment and add it to the
- // top-level trie.
- let set = StableSet()
- set.Add frag |> ignore
- fragments.[k] <- set
- frag
-
- // store the fragment in the cache (which is needed for removal)
- cache.[(k,v)] <- fragment
-
- // since the fragment was just created it must obviously be
- // recompiled.
- recompileSet.Add fragment |> ignore
-
- validateCurrentState deltas
-
- | Rem (_,(k,v)) ->
- let mutable set = Unchecked.defaultof<_>
- let mutable fragment = Unchecked.defaultof<_>
-
- // when an element is removed we first need
- // to find its associated bucket in the top-level
- // trie using its key.
- if not (fragments.TryGetValue(k, &set)) then
- failwithf "[AdaptiveProgram] failed to get containing bucket for %A" k
-
- // furthermore we need to find the associated
- // fragment for the given element and remove it
- // from the cache.
- if not (cache.TryGetValue((k,v), &fragment)) then
- failwithf "[AdaptiveProgram] failed to get fragment from cache: %A" k
-
- if not (cache.Remove (k,v)) then
- failwithf "[AdaptiveProgram] failed to remove fragment from cache: %A" k
-
- if not (set.Remove fragment) then
- failwithf "[AdaptiveProgram] failed to remove fragment from containing bucket: %A %A" fragment set
-
- // finally we can remove the fragment from the
- // associated bucket and the linked list.
- removed <- removed + 1
-
- // remove the fragment from the linked list
- fragment.Next.Prev <- fragment.Prev
- fragment.Prev.Next <- fragment.Next
-
- // the fragment's prev needs to be relinked since
- // its successor was just changed
- relinkSet.Add fragment.Prev |> ignore
-
-
- // the fragment's next needs to be recompiled whenever
- // compileDelta depends on predecessors.
- if handler.compileNeedsPrev && fragment.Next <> epilog then
- recompileSet.Add fragment.Next |> ignore
-
- // release all resources associated with the fragment
- fragment.Dispose()
-
- // since the fragment may be added to the recompileSet
- // by a subsequent change it is not sufficient to remove it
- // from recompile/relink/dirtySet but instead we need to
- // maintain a "persistent" deadSet.
- deadSet.Add fragment |> ignore
-
-
- // if the bucket just got empty remove it
- // from the top-level trie.
- if set.Count = 0 then
- if not (fragments.Remove k) then
- failwithf "[AdaptiveProgram] failed to remove bucket: %A" k
-
- validateCurrentState deltas
-
- deltaProcessWatch.Stop()
-
- validateCurrentState deltas
-
- // remove all dead fragments from the
- // update-sets
- dirtySet.ExceptWith deadSet
- recompileSet.ExceptWith deadSet
- relinkSet.ExceptWith deadSet
- recompileSet.ExceptWith [prolog; epilog]
-
- // stage 2: recompile
- compileWatch.Restart()
- for r in recompileSet do
- // create new code and if the code actually changed
- // add the fragment to dirty/relinkSet.
- if r.Recompile token then
- relinkSet.Add r |> ignore
- dirtySet.Add r |> ignore
- compileWatch.Stop()
-
-
- // stage 3: write
- writeWatch.Restart()
- for d in dirtySet do
- // each dirty fragment needs to be written
- // to its underlying representation.
- if d.WriteContent token then
- // whenever the fragment's location changed
- // it needs to be relinked.
- relinkSet.Add d.Prev |> ignore
-
- // stage 4: relink
- for d in relinkSet do
- try
- d.LinkNext token
- with _ ->
- let mutable index = -1
- let mutable current = prolog
- while not (Unchecked.isNull current) && current <> d do
- current <- current.Next
- index <- index + 1
- let reachable = current = d
- if not reachable then
- failwith "[AdaptiveCode] unreachable fragment not disposed"
- else
- Log.error "fragment reachable at index: %A" index
- reraise ()
-
- writeWatch.Stop()
-
-
- // if AutoDefragmentation is enabled and the total jumpDistance is non-zero
- // start a new defragmentation-task.
- if autoDefragmentation = 1 && relinkSet.Count > 0 && !handler.jumpDistance > 0 then
- handler.startDefragmentation (x :> obj) version |> ignore
-
- // finally return some update-statistics
- let stats =
- AdaptiveProgramStatistics (
- DeltaProcessTime = deltaProcessWatch.Elapsed,
- CompileTime = compileWatch.Elapsed,
- WriteTime = writeWatch.Elapsed,
-
- AddedFragmentCount = added,
- RemovedFragmentCount = removed,
- CompiledFragmentCount = recompileSet.Count,
- UpdatedFragmentCount = dirtySet.Count,
- UpdatedJumpCount = relinkSet.Count
- )
- stats
- else
- AdaptiveProgramStatistics.Zero
- )
-
- member x.Dispose() =
- for f in fragments do
- for f in f.Value do
- f.Dispose()
-
- fragments.Clear()
- dirtySet.Clear()
- handler.dispose()
- cache.Clear()
-
- interface IDisposable with
- member x.Dispose() = x.Dispose()
-
- interface IAdaptiveProgram<'i> with
- member x.AutoDefragmentation
- with get() = autoDefragmentation = 1
- and set d =
- autoDefragmentation <- if d then 1 else 0
- if d && !handler.jumpDistance > 0 then
- handler.startDefragmentation (x :> obj) version |> ignore
-
- member x.StartDefragmentation() =
- if !handler.jumpDistance > 0 then handler.startDefragmentation (x :> obj) version (prolog :> IFragment<_>)
- else Task.FromResult TimeSpan.Zero
-
- member x.Update(caller) = x.Update(caller)
- member x.Run v = x.Run v
-
- member x.FragmentCount = cache.Count
- member x.NativeCallCount = !handler.nativeCallCount
- member x.ProgramSizeInBytes = handler.memorySize() //int64 (memory.AllocatedBytes - prolog.Storage.Memory.Size - epilog.Storage.Memory.Size)
- member x.TotalJumpDistanceInBytes = int64 (!handler.jumpDistance - prolog.JumpDistance - epilog.JumpDistance)
- member x.Disassemble() = x.Disassemble() :> obj
-
-[]
-module FragmentHandler =
-
-
- module private Defragmentation =
-
- let rec private evacuateKernel (startVersion : int) (version : byref) (mem : MemoryManager) (results : List * managedptr>) (last : CodeFragment) (current : IFragment) =
- if isNull current then
- true
- else
- let currentMem = current.Storage.Memory
- let ptr = mem.Alloc(currentMem.Size)
- currentMem.CopyTo(ptr)
-
- let frag = CodeFragment(ptr, current.Storage.ContainsJmp)
-
- if not (isNull last) then
- last.WriteNextPointer(ptr.Offset) |> ignore
-
- results.Add(current, ptr)
-
- if version <> startVersion then false
- else evacuateKernel startVersion &version mem results frag current.Next
-
- let evacuate (lockObj : obj) (version : byref) (jumpDistance : ref) (memory : byref) (prolog : IFragment<_>) =
- let startVersion = version
- let results = List()
- let mem = new MemoryManager(memory.Capacity, ExecutableMemory.alloc, ExecutableMemory.free)
-
- let worked =
- try evacuateKernel startVersion &version mem results null prolog
- with _ -> false
-
- if worked then
- Monitor.Enter lockObj
- try
- if version = startVersion then
- for (frag,code) in results do
- frag.Storage.Memory <- code
- jumpDistance := !jumpDistance - frag.JumpDistance
- frag.JumpDistance <- 0
-
- let old = memory
- memory <- mem
- old.Dispose()
-
- true
- else
- mem.Dispose()
- false
- finally
- Monitor.Exit lockObj
- else
- mem.Dispose()
- false
-
-
-
- let nativeDifferential (maxArgs : int) (compileDelta : Option<'value> -> 'value -> IAdaptiveCode) () : FragmentHandler<'i, 'value, NativeCall, CodeFragment>=
-
- let dynamicArgs =
- if typeof<'i> = typeof then 0
- else 1
-
- let memory = ref <| MemoryManager.createExecutable ()
-
- let prolog = CodeFragment(!memory, ASM.functionProlog dynamicArgs maxArgs)
- let epilog = CodeFragment(!memory, ASM.functionEpilog dynamicArgs maxArgs)
-
-
- let jumpDistance = ref 0
- let nativeCallCount = ref 0
- let defragmentWatch = System.Diagnostics.Stopwatch()
- let mutable currentDefragTask = Task.FromResult TimeSpan.Zero
-
- let mutable defragRunning = 0
- let startDefragmentation (parent : obj) (version : ref) (first : IFragment<_>) =
- let startTask (f : unit -> 'x) =
- Task.Factory.StartNew(f, TaskCreationOptions.LongRunning)
-
- let tryDefragment () =
- Defragmentation.evacuate parent &version.contents jumpDistance &memory.contents first
-
- let start = Interlocked.Exchange(&defragRunning, 1)
- if start = 0 then
- let task =
- startTask (fun () ->
- Log.startTimed "defragmentation"
- defragmentWatch.Restart()
- while not (tryDefragment()) do
- Log.line "retry"
- defragmentWatch.Stop()
- Log.stop()
-
- Interlocked.Exchange(&defragRunning, 0) |> ignore
- defragmentWatch.Elapsed
- )
- currentDefragTask <- task
- task
- else
- currentDefragTask
-
- let mutable currentPtr = 0n
- let mutable wrapped = ignore
- let run arg =
- ReaderWriterLock.read memory.Value.PointerLock (fun () ->
- let entry = memory.Value.Pointer + prolog.Offset
- if entry <> currentPtr then
- currentPtr <- entry
- wrapped <- UnmanagedFunctions.wrap entry
-
- wrapped arg
-
- )
-
- {
- compileNeedsPrev = true
- nativeCallCount = nativeCallCount
- jumpDistance = jumpDistance
- prolog = prolog
- epilog = epilog
-
- compileDelta = compileDelta
- startDefragmentation = startDefragmentation
- run = run
-
- memorySize = fun () ->
- memory.Value.AllocatedBytes |> int64
-
- alloc = fun code ->
- let code = ASM.assembleCalls dynamicArgs code
- CodeFragment(!memory, code)
-
- free = fun frag ->
- frag.Dispose()
-
- write = fun frag code ->
- let code = ASM.assembleCalls dynamicArgs code
- let ptr = frag.Offset
- frag.Write code
- ptr <> frag.Offset
-
- writeNext = fun prev next ->
- prev.WriteNextPointer next.Offset
-
- isNext = fun prev frag ->
- prev.ReadNextPointer() = frag.Offset
-
- dispose = fun () ->
- memory.Value.Dispose()
-
- disassemble = fun f ->
- f.Calls |> Array.toList
- }
-
- let nativeSimple (maxArgs : int) (compile : 'value -> IAdaptiveCode) () =
- let desc = nativeDifferential maxArgs (fun _ v -> compile v) ()
- { desc with compileNeedsPrev = false }
-
- let native (maxArgs : int) () =
- nativeDifferential maxArgs (fun _ _ -> failwith "no compileDelta given") ()
-
- let warpDifferential (mapping : 'a -> 'b) (backward : 'b -> 'a) (compile : Option<'v> -> 'v -> IAdaptiveCode<'a>) (newInner : unit -> FragmentHandler<'i, 'v, 'b, 'frag>) =
- fun () ->
- let inner = newInner()
- {
- compileNeedsPrev = true
- nativeCallCount = inner.nativeCallCount
- jumpDistance = inner.jumpDistance
- prolog = inner.prolog
- epilog = inner.epilog
- compileDelta = compile
- startDefragmentation = inner.startDefragmentation
- run = inner.run
- memorySize = inner.memorySize
- alloc = fun code -> inner.alloc(code |> Array.map mapping)
- free = ignore
- write = fun frag code -> inner.write frag (code |> Array.map mapping)
- writeNext = fun prev next -> inner.writeNext prev next
- isNext = fun prev frag -> inner.isNext prev frag
- dispose = inner.dispose
- disassemble = fun f -> f |> inner.disassemble |> List.map backward
- }
-
- let wrapSimple (mapping : 'a -> 'b) (backward : 'b -> 'a) (compile : 'v -> IAdaptiveCode<'a>) (newInner : unit -> FragmentHandler<'i, 'v, 'b, 'frag>) =
- fun () ->
- let inner = newInner()
- {
- compileNeedsPrev = false
- nativeCallCount = inner.nativeCallCount
- jumpDistance = inner.jumpDistance
- prolog = inner.prolog
- epilog = inner.epilog
- compileDelta = fun _ v -> compile v
- startDefragmentation = inner.startDefragmentation
- run = inner.run
- memorySize = inner.memorySize
- alloc = fun code -> inner.alloc(code |> Array.map mapping)
- free = ignore
- write = fun frag code -> inner.write frag (code |> Array.map mapping)
- writeNext = fun prev next -> inner.writeNext prev next
- isNext = fun prev frag -> inner.isNext prev frag
- dispose = inner.dispose
- disassemble = fun f -> f |> inner.disassemble |> List.map backward
- }
-
-
- []
- type ManagedFragment<'a>(values : array<'a>) =
- let mutable next = null
- let mutable values = values
-
- member x.Values
- with get() = values
- and set v = values <- v
-
- member x.Next
- with get() : ManagedFragment<'a> = next
- and set (n : ManagedFragment<'a>) = next <- n
-
- let managedDifferential (compileDelta : Option<'v> -> 'v -> IAdaptiveCode<'i -> unit>) () : FragmentHandler<'i, 'v, 'i -> unit, ManagedFragment<'i -> unit>> =
- let prolog = ManagedFragment [||]
- let epilog = ManagedFragment [||]
-
- let rec run (l : ManagedFragment<'i -> unit>) (v : 'i) =
- for f in l.Values do f v
- if not (isNull l.Next) then
- run l.Next v
-
- {
- compileNeedsPrev = true
- nativeCallCount = ref 0
- jumpDistance = ref 0
- prolog = prolog
- epilog = epilog
- compileDelta = compileDelta
- startDefragmentation = fun _ _ _ -> Task.FromResult TimeSpan.Zero
- run = run prolog
- memorySize = fun () -> 0L
- alloc = fun code -> ManagedFragment<'i -> unit>(code)
- free = ignore
- write = fun frag code -> frag.Values <- code; false
- writeNext = fun prev next -> prev.Next <- next; 0
- isNext = fun prev frag -> prev.Next = frag
- dispose = fun () -> ()
- disassemble = fun f -> f.Values |> Array.toList
- }
-
- let managedSimple (compile : 'v -> IAdaptiveCode<'i -> unit>) () =
- { managedDifferential (fun _ v -> compile v) () with compileNeedsPrev = false }
-
-
-[]
-module AdaptiveProgram =
-
- let nativeDifferential (maxArgs : int) (comparer : IComparer<'k>) (compileDelta : Option<'v> -> 'v -> IAdaptiveCode) (input : aset<'k * 'v>) =
- new GenericProgram.Program<_,_,_,_,_>(input, comparer, FragmentHandler.nativeDifferential maxArgs compileDelta) :> IAdaptiveProgram<'i>
-
- let nativeSimple (maxArgs : int) (comparer : IComparer<'k>) (compile : 'v -> IAdaptiveCode) (input : aset<'k * 'v>) =
- new GenericProgram.Program<_,_,_,_,_>(input, comparer, FragmentHandler.nativeSimple maxArgs compile) :> IAdaptiveProgram<'i>
-
- let managedDifferential (comparer : IComparer<'k>) (compileDelta : Option<'v> -> 'v -> IAdaptiveCode<_>) (input : aset<'k * 'v>) =
- new GenericProgram.Program<_,_,_,_,_>(input, comparer, FragmentHandler.managedDifferential compileDelta) :> IAdaptiveProgram<'i>
-
- let managedSimple (comparer : IComparer<'k>) (compile : 'v -> IAdaptiveCode<_>) (input : aset<'k * 'v>) =
- new GenericProgram.Program<_,_,_,_,_>(input, comparer, FragmentHandler.managedSimple compile) :> IAdaptiveProgram<'i>
-
- let custom (comparer : IComparer<'k>) (createHandler : unit -> FragmentHandler<'i, 'value, 'instruction, 'fragment>) (input : aset<'k * 'value>) =
- new GenericProgram.Program<_,_,_,_,_>(input, comparer, createHandler) :> IAdaptiveProgram<'i>
-
-
- let inline run (p : IAdaptiveProgram) =
- p.Run()
-
- let inline update (p : IAdaptiveProgram<'a>) =
- p.Update(AdaptiveToken.Top)
-
-
- let inline nativeCallCount (p : IAdaptiveProgram<'i>) = p.NativeCallCount
- let inline fragmentCount (p : IAdaptiveProgram<'i>) = p.FragmentCount
- let inline programSizeInBytes (p : IAdaptiveProgram<'i>) = p.ProgramSizeInBytes
- let inline totalJumpDistanceInBytes (p : IAdaptiveProgram<'i>) = p.TotalJumpDistanceInBytes
diff --git a/src/Aardvark.Base.Runtime/Assembler/AMD64.fs b/src/Aardvark.Base.Runtime/Assembler/AMD64.fs
deleted file mode 100644
index fa34d15fd..000000000
--- a/src/Aardvark.Base.Runtime/Assembler/AMD64.fs
+++ /dev/null
@@ -1,879 +0,0 @@
-namespace Aardvark.Base.Runtime
-
-open System
-open System.Collections.Generic
-open System.IO
-open Aardvark.Base
-open System.Runtime.InteropServices
-open Microsoft.FSharp.NativeInterop
-open FSharp.Data.Adaptive
-
-#nowarn "9"
-#nowarn "44"
-#nowarn "51"
-
-[]
-module AMD64 =
-
- type Register =
- | Rax = 0
- | Rcx = 1
- | Rdx = 2
- | Rbx = 3
- | Rsp = 4
- | Rbp = 5
- | Rsi = 6
- | Rdi = 7
-
- | R8 = 8
- | R9 = 9
- | R10 = 10
- | R11 = 11
- | R12 = 12
- | R13 = 13
- | R14 = 14
- | R15 = 15
-
- | XMM0 = 16
- | XMM1 = 17
- | XMM2 = 18
- | XMM3 = 19
- | XMM4 = 20
- | XMM5 = 21
- | XMM6 = 22
- | XMM7 = 23
- | XMM8 = 24
- | XMM9 = 25
- | XMM10 = 26
- | XMM11 = 27
- | XMM12 = 28
- | XMM13 = 29
- | XMM14 = 30
- | XMM15 = 31
-
- type CallingConvention = { shadowSpace : bool; registers : Register[]; floatRegisters : Register[]; calleeSaved : Register[] }
-
- []
- module CallingConvention =
- let windows =
- {
- shadowSpace = true
- registers = [| Register.Rcx; Register.Rdx; Register.R8; Register.R9 |]
- floatRegisters = [| Register.XMM0; Register.XMM1; Register.XMM2; Register.XMM3 |]
- calleeSaved = [|Register.R12; Register.R13; Register.R14; Register.R15 |]
- }
-
- let linux =
- {
- shadowSpace = false
- registers = [| Register.Rdi; Register.Rsi; Register.Rdx; Register.Rcx; Register.R8; Register.R9 |]
- floatRegisters = [| Register.XMM0; Register.XMM1; Register.XMM2; Register.XMM3; Register.XMM4; Register.XMM5; Register.XMM6; Register.XMM7 |]
- calleeSaved = [|Register.R12; Register.R13; Register.R14; Register.R15 |]
- }
-
- []
- module private Utils =
- let inline rexAndModRM (wide : bool) (left : byte) (right : byte) (rex : byref) (modRM : byref) =
- let r = if left >= 8uy then 1uy else 0uy
- let b = if right >= 8uy then 1uy else 0uy
- let w = if wide then 1uy else 0uy
- rex <- 0x40uy ||| (w <<< 3) ||| (r <<< 2) ||| b
-
- let left = left &&& 0x07uy
- let right = right &&& 0x07uy
- modRM <- 0xC0uy ||| (left <<< 3) ||| right
-
- let inline rexAndModRM0 (wide : bool) (left : byte) (right : byte) (rex : byref) (modRM : byref) =
- let r = if left >= 8uy then 1uy else 0uy
- let b = if right >= 8uy then 1uy else 0uy
- let w = if wide then 1uy else 0uy
- rex <- 0x40uy ||| (w <<< 3) ||| (r <<< 2) ||| b
-
- let left = left &&& 0x07uy
- let right = right &&& 0x07uy
- modRM <- 0x00uy ||| (left <<< 3) ||| right
-
- let inline rexAndModRMSIB (wide : bool) (left : byte) (rex : byref) (modRM : byref) =
- let r = if left >= 8uy then 1uy else 0uy
- let w = if wide then 1uy else 0uy
- rex <- 0x40uy ||| (w <<< 3) ||| (r <<< 2)
-
- let left = left &&& 0x07uy
- modRM <- 0x40uy ||| (left <<< 3) ||| 0x04uy
-
-
- let inline dec (v : byref) =
- let o = v
- v <- o - 1
- if o < 0 then failwith "argument index out of bounds"
- o
-
- let private localConvention =
- match Environment.OSVersion with
- | Windows -> CallingConvention.windows
- | _ -> CallingConvention.linux
-
-
- let private registers =
- [|
- Aardvark.Base.Runtime.Register("rax", 0)
- Aardvark.Base.Runtime.Register("rcx", 1)
- Aardvark.Base.Runtime.Register("rdx", 2)
- Aardvark.Base.Runtime.Register("rbx", 3)
- Aardvark.Base.Runtime.Register("rsp", 4)
- Aardvark.Base.Runtime.Register("rbp", 5)
- Aardvark.Base.Runtime.Register("rsi", 6)
- Aardvark.Base.Runtime.Register("rdi", 7)
- Aardvark.Base.Runtime.Register("r8", 8)
- Aardvark.Base.Runtime.Register("r9", 9)
- Aardvark.Base.Runtime.Register("r10", 10)
- Aardvark.Base.Runtime.Register("r11", 11)
- Aardvark.Base.Runtime.Register("r12", 12)
- Aardvark.Base.Runtime.Register("r13", 13)
- Aardvark.Base.Runtime.Register("r14", 14)
- Aardvark.Base.Runtime.Register("r15", 15)
- Aardvark.Base.Runtime.Register("xmm0", 16)
- Aardvark.Base.Runtime.Register("xmm1", 17)
- Aardvark.Base.Runtime.Register("xmm2", 18)
- Aardvark.Base.Runtime.Register("xmm3", 19)
- Aardvark.Base.Runtime.Register("xmm4", 20)
- Aardvark.Base.Runtime.Register("xmm5", 21)
- Aardvark.Base.Runtime.Register("xmm6", 22)
- Aardvark.Base.Runtime.Register("xmm7", 23)
- Aardvark.Base.Runtime.Register("xmm8", 24)
- Aardvark.Base.Runtime.Register("xmm9", 25)
- Aardvark.Base.Runtime.Register("xmm10", 26)
- Aardvark.Base.Runtime.Register("xmm11", 27)
- Aardvark.Base.Runtime.Register("xmm12", 28)
- Aardvark.Base.Runtime.Register("xmm13", 29)
- Aardvark.Base.Runtime.Register("xmm14", 30)
- Aardvark.Base.Runtime.Register("xmm15", 31)
- |]
-
- let private calleeSaved = localConvention.calleeSaved |> Array.map (int >> Array.get registers)
- let private argumentRegisters = localConvention.registers |> Array.map (int >> Array.get registers)
- let private returnRegister = registers.[0]
-
- // Register.R12; Register.R13; Register.R14; Register.R15
-
- type AssemblerStream(stream : Stream, leaveOpen : bool) =
- let writer = new BinaryWriter(stream, Text.Encoding.UTF8, leaveOpen)
-
- static let localConvention =
- match Environment.OSVersion with
- | Windows -> CallingConvention.windows
- | _ -> CallingConvention.linux
-
- let mutable stackOffset = 0
- let mutable paddingPtr = []
- let mutable argumentOffset = 0
- let mutable argumentIndex = 0
-
- static let push = [| 0x48uy; 0x89uy; 0x44uy; 0x24uy |]
- static let callRax = [| 0xFFuy; 0xD0uy |]
-
- static let oneByteNop = [| 0x90uy |]
- static let twoByteNop = [| 0x66uy; 0x90uy |]
- static let threeByteNop = [| 0x0Fuy; 0x1Fuy; 0x00uy |]
- static let fourByteNop = [| 0x0Fuy; 0x1Fuy; 0x40uy; 0x00uy |]
- static let fiveByteNop = [| 0x0Fuy; 0x1Fuy; 0x44uy; 0x00uy; 0x00uy |]
- static let eightByteNop = [| 0x0Fuy; 0x1Fuy; 0x84uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy |]
-
- let pendingOffsets = Dict>()
-
- member x.NewLabel() =
- AssemblerLabel()
-
- member x.Mark(l : AssemblerLabel) =
- match pendingOffsets.TryRemove l with
- | (true, positions) ->
- let oldPos = stream.Position
-
- for p in positions do
- stream.Position <- p
- writer.Write(int (oldPos - (4L + p)))
-
- stream.Position <- oldPos
- | _ ->
- ()
-
- l.Position <- stream.Position
-
- member x.Cmp(l : Register, v : uint32) =
- if l >= Register.XMM0 then
- failwith "[AMD64] cannot compare media register"
- else
- let mutable rex = if l >= Register.R8 then 0x41uy else 0x40uy
- //rex <- 0x40uy ||| (w <<< 3) ||| (r <<< 2) ||| b
- let l = byte l &&& 0x7uy
-
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x81uy)
- writer.Write(0xF8uy + l)
- writer.Write(v)
-
- member x.Cmp(l : Register, v : uint64) =
- if l >= Register.XMM0 then
- failwith "[AMD64] cannot compare media register"
- else
- let mutable rex = if l >= Register.R8 then 0x49uy else 0x48uy
- let l = byte l &&& 0x7uy
-
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x3Buy)
- writer.Write(0xF8uy + l)
- writer.Write(v)
-
- member x.Mul(dst : Register, src : Register, wide : bool) =
- if dst >= Register.XMM0 || src >= Register.XMM0 then
- failwith "[AMD64] cannot multiply media register"
- else
- let mutable rex = 0uy
- let mutable modRM = 0uy
- rexAndModRM wide (byte dst) (byte src) &rex &modRM
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x0Fuy)
- writer.Write(0xAFuy)
- writer.Write(modRM)
-
-
- member x.Cmp(l : Register, r : Register, wide : bool) =
- if l >= Register.XMM0 || r >= Register.XMM0 then
- failwith "[AMD64] cannot compare media register"
- else
- let mutable rex = 0uy
- let mutable modRM = 0uy
- rexAndModRM wide (byte l) (byte r) &rex &modRM
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x3B)
- writer.Write(modRM)
-
- member x.Jump(l : AssemblerLabel) =
- if l.Position >= 0L then
- let offset = 5L + l.Position - stream.Position
- x.Jmp(int offset)
- else
- x.Jmp(0)
- let set = pendingOffsets.GetOrCreate(l, fun _ -> List())
- set.Add(stream.Position - 4L)
-
- member x.Jump(cond : JumpCondition, l : AssemblerLabel) =
- if l.Position >= 0L then
- let offset = 6L + l.Position - stream.Position
- x.Jmp(cond, int offset)
- else
- x.Jmp(cond, 0)
- let set = pendingOffsets.GetOrCreate(l, fun _ -> List())
- set.Add(stream.Position - 4L)
-
- member x.Jmp(cond : JumpCondition, offset : int) =
- writer.Write(0x0Fuy)
- writer.Write(byte cond)
- writer.Write(offset)
-
- member x.Leave() =
- writer.Write(0xC9uy)
-
- member x.Begin() =
- x.Push(Register.Rbp)
- x.Mov(Register.Rbp, Register.Rsp, true)
- stackOffset <- stackOffset - 8
-
- member x.End() =
- x.Leave()
- stackOffset <- stackOffset - 8
-
- member x.Mov(target : Register, source : Register, wide : bool) =
- if source <> target then
- let targetMedia = target >= Register.XMM0
- let sourceMedia = source >= Register.XMM0
-
- let mutable rex = 0x40uy
- let mutable modRM = 0uy
-
- let dst = byte target &&& 0x0Fuy
- let src = byte source &&& 0x0Fuy
-
-
- if targetMedia && sourceMedia then
- rexAndModRM wide dst src &rex &modRM
- writer.Write(0xF3uy)
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x0Fuy)
- writer.Write(0x7Euy)
- writer.Write(modRM)
-
- elif sourceMedia then
- rexAndModRM wide src dst &rex &modRM
- // MOVD reg/mem32, xmm 66 0F 7E /r
- // MOVD reg/mem64, xmm 66 0F 7E /r
-
- writer.Write(0x66uy)
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x0Fuy)
- writer.Write(0x7Euy)
- writer.Write(modRM)
-
- elif targetMedia then
- // MOVD xmm, reg/mem32 66 0F 6E /r
- // MOVD xmm, reg/mem64 66 0F 6E /r
-
- rexAndModRM wide dst src &rex &modRM
- writer.Write(0x66uy)
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x0Fuy)
- writer.Write(0x6Euy)
- writer.Write(modRM)
-
- else
- // MOV reg64, reg/mem64 8B/r
- // MOV reg32, reg/mem32 8B/r
-
- rexAndModRM wide dst src &rex &modRM
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x8Buy)
- writer.Write(modRM)
-
- member x.Load(target : Register, source : Register, wide : bool) =
- let targetMedia = target >= Register.XMM0
- let sourceMedia = source >= Register.XMM0
-
- let dst = byte target &&& 0x0Fuy
- let src = byte source &&& 0x0Fuy
-
- let mutable rex = 0x40uy
- let mutable modRM = 0uy
-
- if sourceMedia then
- failwith "mov reg|xmm, (xmm) not implemented"
-
- elif targetMedia then
- if wide then
- rexAndModRM0 false dst src &rex &modRM
- writer.Write(0xF3uy)
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x0Fuy)
- writer.Write(0x7Euy)
- writer.Write(modRM)
- if source = Register.Rsp then writer.Write(0x24uy)
-
- else
- // MOVD xmm, reg/mem32 66 0F 6E /r
- // MOVD xmm, reg/mem64 66 0F 6E /r
- rexAndModRM0 wide dst src &rex &modRM
- writer.Write(0x66uy)
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x0Fuy)
- writer.Write(0x6Euy)
- writer.Write(modRM)
- if source = Register.Rsp then writer.Write(0x24uy)
-
- else
- // MOV reg64, reg/mem64 8B/r
- // MOV reg32, reg/mem32 8B/r
- rexAndModRM0 wide dst src &rex &modRM
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x8Buy)
- writer.Write(modRM)
- if source = Register.Rsp then writer.Write(0x24uy)
-
- member x.Store(target : Register, source : Register, wide : bool) =
- let targetMedia = target >= Register.XMM0
- let sourceMedia = source >= Register.XMM0
-
- let mutable rex = 0x40uy
- let mutable modRM = 0uy
-
- let dst = byte target &&& 0x0Fuy
- let src = byte source &&& 0x0Fuy
-
- if targetMedia then
- failwith "mov (xmm), reg|xmm not implemented"
-
- elif sourceMedia then
- if wide then
- rexAndModRM0 false src dst &rex &modRM
- writer.Write(0x66uy)
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x0Fuy)
- writer.Write(0xD6uy)
- writer.Write(modRM)
- if target = Register.Rsp then writer.Write(0x24uy)
- else
- // MOVD reg/mem32, xmm 66 0F 7E /r
- // MOVD reg/mem64, xmm 66 0F 7E /r
-
- rexAndModRM0 wide src dst &rex &modRM
- writer.Write(0x66uy)
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x0Fuy)
- writer.Write(0x7Euy)
- writer.Write(modRM)
- if target = Register.Rsp then writer.Write(0x24uy)
- else
- // MOV reg/mem64, reg64 89/r
- // MOV reg/mem32, reg32 89/r
-
- rexAndModRM0 wide src dst &rex &modRM
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x89uy)
- writer.Write(modRM)
- if target = Register.Rsp then writer.Write(0x24uy)
-
- member x.Mov(target : Register, value : uint64) =
- if target < Register.XMM0 then
- let tb = target |> byte
- if tb >= 8uy then
- let tb = tb - 8uy
- let rex = 0x49uy
- writer.Write(rex)
- writer.Write(0xB8uy + tb)
- else
- let rex = 0x48uy
- writer.Write(rex)
- writer.Write(0xB8uy + tb)
-
- writer.Write value
-
- else
- x.Mov(Register.Rax, value)
- x.Mov(target, Register.Rax, true)
-
- member x.Mov(target : Register, value : uint32) =
- if target < Register.XMM0 then
- let tb = target |> byte
- if tb >= 8uy then
- let tb = tb - 8uy
- let rex = 0x41uy
- writer.Write(rex)
- writer.Write(0xB8uy + tb)
- else
- writer.Write(0xB8uy + tb)
-
- writer.Write value
-
- else
- x.Mov(Register.Rax, value)
- x.Mov(target, Register.Rax, false)
-
-
- member inline x.MovQWord(target : Register, source : Register) =
- x.Mov(target, source, true)
-
- member inline x.MovDWord(target : Register, source : Register) =
- x.Mov(target, source, false)
-
- member inline x.Mov(target : Register, value : nativeint) =
- x.Mov(target, uint64 value)
-
- member inline x.Mov(target : Register, value : unativeint) =
- x.Mov(target, uint64 value)
-
- member inline x.Mov(target : Register, value : int) =
- x.Mov(target, uint32 value)
-
- member inline x.Mov(target : Register, value : int64) =
- x.Mov(target, uint64 value)
-
- member inline x.Mov(target : Register, value : int8) =
- x.Mov(target, uint32 value)
-
- member inline x.Mov(target : Register, value : uint8) =
- x.Mov(target, uint32 value)
-
- member inline x.Mov(target : Register, value : int16) =
- x.Mov(target, uint32 value)
-
- member inline x.Mov(target : Register, value : uint16) =
- x.Mov(target, uint32 value)
-
- member inline x.Mov(target : Register, value : float32) =
- let mutable value = value
- let iv : uint32 = &&value |> NativePtr.cast |> NativePtr.read
- x.Mov(target, iv)
-
- member inline x.Mov(target : Register, value : float) =
- let mutable value = value
- let iv : uint64 = &&value |> NativePtr.cast |> NativePtr.read
- x.Mov(target, iv)
-
- member inline x.Load(target : Register, ptr : nativeint, wide : bool) =
- x.Mov(target, uint64 ptr)
- x.Load(target, target, wide)
-
-
- member inline x.Load(target : Register, ptr : nativeptr<'a>) =
- x.Load(target, NativePtr.toNativeInt ptr, sizeof<'a> = 8)
-
- member inline x.LoadQWord(target : Register, ptr : nativeint) =
- x.Load(target, ptr, true)
-
- member inline x.LoadDWord(target : Register, ptr : nativeint) =
- x.Load(target, ptr, false)
-
- member x.Add(target : Register, source : Register, wide : bool) =
- let mutable rex = 0x40uy
- let mutable modRM = 0uy
-
- if source >= Register.XMM0 || target >= Register.XMM0 then
- failwith "cannot add media register"
- else
- rexAndModRM wide (byte target) (byte source) &rex &modRM
-
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x03uy)
- writer.Write(modRM)
-
- member x.Add(target : Register, value : uint32) =
- if value > 0u then
- if target >= Register.XMM0 then
- failwith "cannot add media register"
- else
- let r = target |> byte
- let b = if r >= 8uy then 1uy else 0uy //(r &&& 0xF8uy) >>> 3
- let r = r &&& 0x07uy
- let rex = 0x48uy ||| b
-
- writer.Write(rex)
- writer.Write(0x81uy)
- writer.Write(0xC0uy + r)
- writer.Write(value)
-
- member x.Sub(target : Register, value : uint32) =
- if value > 0u then
- if target >= Register.XMM0 then
- failwith "cannot add media register"
- else
- let r = target |> byte
- let b = if r >= 8uy then 1uy else 0uy //(r &&& 0xF8uy) >>> 3
- let r = r &&& 0x07uy
- let rex = 0x48uy ||| b
-
- writer.Write(rex)
- writer.Write(0x81uy)
- writer.Write(0xE8uy + r)
- writer.Write(value)
-
- member x.Sub(target : Register, source : Register, wide : bool) =
- if target >= Register.XMM0 || source >= Register.XMM0 then
- failwith "cannot sub media register"
- else
- let mutable rex = 0x40uy
- let mutable modRM = 0uy
-
- rexAndModRM wide (byte source) (byte target) &rex &modRM
-
- if rex <> 0x40uy then writer.Write(rex)
- writer.Write(0x29uy)
- writer.Write(modRM)
-
-
-
- member x.Push(r : Register) =
- stackOffset <- stackOffset + 8
- if r >= Register.XMM0 then
- x.Sub(Register.Rsp, 8u)
- x.Store(Register.Rsp, r, true)
- else
- let r = r |> byte
- let b = if r >= 8uy then 1uy else 0uy //(r &&& 0xF8uy) >>> 3
- let r = r &&& 0x07uy
- let w = 1uy
- let rex = 0x40uy ||| (w <<< 3) ||| b
-
- let code = 0x50uy + r
- if rex <> 0x4uy then writer.Write(rex)
- writer.Write(code)
-
- member x.Push(value : uint64) =
- x.Mov(Register.Rax, value)
- x.Push(Register.Rax)
-// writer.Write(0x48uy)
-// writer.Write(0x68uy)
-// writer.Write(value)
-
- member x.Push(value : uint32) =
- stackOffset <- stackOffset + 8
- writer.Write(0x68uy)
- writer.Write(value)
-
- member x.Push(value : float) =
- stackOffset <- stackOffset + 8
- writer.Write(0x48uy)
- writer.Write(0x68uy)
- writer.Write(value)
-
- member x.Push(value : float32) =
- stackOffset <- stackOffset + 8
- writer.Write(0x68uy)
- writer.Write(value)
-
-
- member x.Pop(r : Register) =
- stackOffset <- stackOffset - 8
- if r >= Register.XMM0 then
- x.Load(r, Register.Rsp, true)
- x.Add(Register.Rsp, 8u)
- ()
- else
- let r = r |> byte
-
- let b = (r &&& 0xF8uy) >>> 3
- let r = r &&& 0x07uy
- let w = 1uy
- let rex = 0x40uy ||| (w <<< 3) ||| b
-
- let code = 0x58uy + r
- if rex <> 0x4uy then writer.Write(rex)
- writer.Write(code)
-
-
- member x.Jmp(offset : int) =
- writer.Write 0xE9uy
- writer.Write offset
-
- member x.Nop(width : int) =
- if width > 0 then
- match width with
- | 1 -> writer.Write oneByteNop
- | 2 -> writer.Write twoByteNop
- | 3 -> writer.Write threeByteNop
- | 4 -> writer.Write fourByteNop
- | 5 -> writer.Write fiveByteNop
- | 6 -> writer.Write threeByteNop; writer.Write threeByteNop // TODO: find good 6 byte nop sequence
- | 7 -> writer.Write fourByteNop; writer.Write threeByteNop // TODO: find good 7 byte nop sequence
- | _ -> writer.Write eightByteNop; x.Nop (width - 8)
-
- member x.BeginCall(args : int) =
- x.Sub(Register.Rsp, 8u)
- stream.Seek(-4L, SeekOrigin.Current) |> ignore
- let ptr = stream.Position
- writer.Write(0u)
- paddingPtr <- ptr :: paddingPtr
- argumentOffset <- 0
- argumentIndex <- args - 1
-
- member x.Call(cc : CallingConvention, r : Register) =
- if r >= Register.XMM0 then
- failwith "cannot call media register"
- else
-
- let paddingPtr =
- match paddingPtr with
- | h :: rest ->
- paddingPtr <- rest
- h
- | _ ->
- failwith "no padding offset"
-
- let additional =
- if stackOffset % 16 <> 0 then
- let p = stream.Position
- stream.Position <- paddingPtr
- writer.Write(8u)
- stream.Position <- p
- 8u
- else
- 0u
-
- if cc.shadowSpace then
- x.Sub(Register.Rsp, 8u * uint32 cc.registers.Length)
-
- let r = byte r
- if r >= 8uy then
- writer.Write(0x41uy)
- writer.Write(0xFFuy)
- writer.Write(0xD0uy + (r - 8uy))
-
- else
- writer.Write(0xFFuy)
- writer.Write(0xD0uy + r)
-
- let popSize =
- (if cc.shadowSpace then 8u * uint32 cc.registers.Length else 0u) +
- uint32 argumentOffset +
- additional
-
- if popSize > 0u then
- x.Add(Register.Rsp, popSize)
-
- stackOffset <- stackOffset - argumentOffset
- argumentOffset <- 0
-
- member x.Call(cc : CallingConvention, ptr : nativeint) =
- x.Mov(Register.Rax, ptr)
- x.Call(cc, Register.Rax)
-
-
- member x.Ret() =
- writer.Write(0xC3uy)
-
- member x.PushArg(cc : CallingConvention, value : uint64) =
- let i = dec &argumentIndex
- if i < cc.registers.Length then
- x.Mov(cc.registers.[i], value)
- else
- argumentOffset <- argumentOffset + 8
- x.Push(value)
-
- member x.PushArg(cc : CallingConvention, value : uint32) =
- let i = dec &argumentIndex
- if i < cc.registers.Length then
- x.Mov(cc.registers.[i], value)
- else
- argumentOffset <- argumentOffset + 8
- x.Push(value)
-
- member x.PushArg(cc : CallingConvention, value : float32) =
- let i = dec &argumentIndex
- if i < cc.floatRegisters.Length then
- x.Mov(cc.floatRegisters.[i], value)
- else
- argumentOffset <- argumentOffset + 8
- x.Push(value)
-
- member x.PushArg(cc : CallingConvention, value : float) =
- let i = dec &argumentIndex
- if i < cc.floatRegisters.Length then
- x.Mov(cc.floatRegisters.[i], value)
- else
- argumentOffset <- argumentOffset + 8
- x.Push(value)
-
- member x.PushIntArg(cc : CallingConvention, r : Register, wide : bool) =
- let i = dec &argumentIndex
- if i < cc.registers.Length then
- x.Mov(cc.registers.[i], r, wide)
- else
- argumentOffset <- argumentOffset + 8
- x.Push(r)
-
- member x.PushFloatArg(cc : CallingConvention, r : Register, wide : bool) =
- let i = dec &argumentIndex
- if i < cc.floatRegisters.Length then
- x.Mov(cc.floatRegisters.[i], r, wide)
- else
- argumentOffset <- argumentOffset + 8
- x.Push(r)
-
-
- member private x.Dispose(disposing : bool) =
- if disposing then
- GC.SuppressFinalize(x)
- if pendingOffsets.Count > 0 then
- failwith "[AMD64] some labels have not been defined"
-
- writer.Dispose()
-
-
- member x.ConditionalCall(condition : aval<'a>, callback : 'a -> unit) =
- let outOfDate : nativeptr = NativePtr.alloc 1
- NativePtr.write outOfDate (if condition.OutOfDate then 1 else 0)
- let sub = condition.AddMarkingCallback(fun () -> NativePtr.write outOfDate 1)
-
-
- let callback () =
- let value =
- lock condition (fun () ->
- let res = condition.GetValue(AdaptiveToken.Top)
- NativePtr.write outOfDate 0
- res
- )
- callback value
-
- let del = Marshal.PinDelegate(System.Action callback)
-
- let noEval = x.NewLabel()
- x.Load(Register.Rax, outOfDate)
- x.Cmp(Register.Rax, 0u)
- x.Jump(JumpCondition.Equal,noEval)
- x.BeginCall(0)
- x.Call(localConvention, del.Pointer)
- x.Mark noEval
-
- { new IDisposable with
- member x.Dispose() =
- sub.Dispose()
- NativePtr.write outOfDate 0
- NativePtr.free outOfDate
- del.Dispose()
- }
-
-
-
-
- member x.Dispose() = x.Dispose(true)
- override x.Finalize() = x.Dispose(false)
-
-
-
- interface IDisposable with
- member x.Dispose() = x.Dispose()
-
- interface IAssemblerStream with
-
- member x.Registers = registers
- member x.CalleeSavedRegisters = calleeSaved
- member x.ArgumentRegisters = argumentRegisters
- member x.ReturnRegister = returnRegister
-
-
- member x.Push(r : Runtime.Register) = x.Push(unbox r.Tag)
- member x.Pop(r : Runtime.Register) = x.Pop(unbox r.Tag)
- member x.Mov(target : Runtime.Register, source : Runtime.Register) = x.Mov(unbox target.Tag, unbox source.Tag, true)
- member x.Load(target : Runtime.Register, source : Runtime.Register, wide : bool) = x.Load(unbox target.Tag, unbox source.Tag, wide)
- member x.Store(target : Runtime.Register, source : Runtime.Register, wide : bool) = x.Store(unbox target.Tag, unbox source.Tag, wide)
-
-
- member x.NewLabel() = x.NewLabel()
- member x.Mark(l) = x.Mark(l)
- member x.Jump(cond : JumpCondition, label : AssemblerLabel) = x.Jump(cond, label)
- member x.Jump(label : AssemblerLabel) = x.Jump(label)
-
- member x.Copy(srcPtr : nativeint, dstPtr : nativeint, wide : bool) =
- let temp = localConvention.registers.[0]
- x.Load(Register.Rax, srcPtr, wide)
- x.Mov(temp, dstPtr)
- x.Store(temp, Register.Rax, wide)
-
- member x.Cmp(location : nativeint, value : int) =
- x.Load(Register.Rax, location, false)
- x.Cmp(Register.Rax, uint32 value)
-
- member x.AddInt(dst, src, wide) =
- x.Add(unbox dst.Tag, unbox src.Tag, wide)
-
- member x.MulInt(dst, src, wide) =
- x.Mul(unbox dst.Tag, unbox src.Tag, wide)
-
-
- member x.BeginFunction() = x.Begin()
- member x.EndFunction() = x.End()
- member x.BeginCall(args : int) = x.BeginCall(args)
- member x.Call (ptr : nativeint) = x.Call(localConvention, ptr)
- member x.CallIndirect(ptr : nativeptr) =
- x.Load(Register.Rax, ptr)
- x.Call(localConvention, Register.Rax)
-
- member x.PushArg(v : nativeint) = x.PushArg(localConvention, uint64 v)
- member x.PushArg(v : int) = x.PushArg(localConvention, uint32 v)
- member x.PushArg(v : float32) = x.PushArg(localConvention, v)
- member x.PushPtrArg(loc) = x.Load(Register.Rax, loc, true); x.PushIntArg(localConvention, Register.Rax, true)
- member x.PushIntArg(loc) = x.Load(Register.Rax, loc, false); x.PushIntArg(localConvention, Register.Rax, false)
- member x.PushFloatArg(loc) = x.Load(Register.Rax, loc, false); x.PushFloatArg(localConvention, Register.Rax, false)
- member x.PushDoubleArg(loc) = x.Load(Register.Rax, loc, true); x.PushFloatArg(localConvention, Register.Rax, true)
-
- member x.Ret() = x.Ret()
-
- member x.WriteOutput(v : nativeint) = x.Mov(Register.Rax, v)
- member x.WriteOutput(v : int) = x.Mov(Register.Rax, v)
- member x.WriteOutput(v : float32) = x.Mov(Register.XMM0, v)
-
- member x.Set(target : Runtime.Register, value : nativeint) = x.Mov(unbox target.Tag, value)
- member x.Set(target : Runtime.Register, value : int) = x.Mov(unbox target.Tag, value)
- member x.Set(target : Runtime.Register, value : float32) = x.Mov(unbox target.Tag, value)
-
- member x.Jump(offset : int) = x.Jmp(offset)
-
- new(stream : Stream) = new AssemblerStream(stream, false)
-
diff --git a/src/Aardvark.Base.Runtime/Assembler/AssemblerStream.fs b/src/Aardvark.Base.Runtime/Assembler/AssemblerStream.fs
deleted file mode 100644
index 87ad32311..000000000
--- a/src/Aardvark.Base.Runtime/Assembler/AssemblerStream.fs
+++ /dev/null
@@ -1,15 +0,0 @@
-namespace Aardvark.Base.Runtime
-
-open System
-open System.IO
-
-#nowarn "44"
-
-[]
-[]
-module AssemblerStream =
- let ofStream (s : Stream) =
- match sizeof with
- //| 4 -> new X86.AssemblerStream(s) :> IAssemblerStream
- | 8 -> new AMD64.AssemblerStream(s) :> IAssemblerStream
- | _ -> failwith "bad bitness"
diff --git a/src/Aardvark.Base.Runtime/Assembler/AssemblerTypes.fs b/src/Aardvark.Base.Runtime/Assembler/AssemblerTypes.fs
deleted file mode 100644
index 0245f6799..000000000
--- a/src/Aardvark.Base.Runtime/Assembler/AssemblerTypes.fs
+++ /dev/null
@@ -1,129 +0,0 @@
-namespace Aardvark.Base.Runtime
-
-open System
-open System.Collections.Generic
-open Aardvark.Base
-
-[]
-type Register =
- struct
- val mutable public Name : string
- val mutable public Tag : int
-
- override x.GetHashCode() = x.Tag
- override x.Equals o =
- match o with
- | :? Register as o -> x.Tag = o.Tag
- | _ -> false
-
- override x.ToString() =
- x.Name
-
- member x.CompareTo (o : Register) =
- compare x.Tag o.Tag
-
- interface IComparable with
- member x.CompareTo o =
- match o with
- | :? Register as o -> x.CompareTo o
- | _ -> failwithf "[Register] cannot compare to %A" o
-
- interface IComparable with
- member x.CompareTo o = x.CompareTo o
-
-
- new(name : string, tag : int) = { Name = name; Tag = tag }
-
- end
-
-type AssemblerLabel internal() =
- let mutable position = -1L
-
- member x.Position
- with get() = position
- and internal set p = position <- p
-
-type JumpCondition =
- | Equal = 0x84uy
- | NotEqual = 0x85uy
- | Less = 0x8Cuy
- | GreaterEqual = 0x8Duy
- | LessEqual = 0x8Euy
- | Greater = 0x8Fuy
-
-
-type IAssemblerStream =
- inherit IDisposable
-
- abstract member Registers : Register[]
- abstract member CalleeSavedRegisters : Register[]
- abstract member ArgumentRegisters : Register[]
- abstract member ReturnRegister : Register
-
- abstract member Push : Register -> unit
- abstract member Pop : Register -> unit
- abstract member Mov : target : Register * source : Register -> unit
- abstract member Load : target : Register * source : Register * wide : bool -> unit
- abstract member Store : target : Register * source : Register * wide : bool -> unit
-
- abstract member Set : target : Register * value : nativeint -> unit
- abstract member Set : target : Register * value : int -> unit
- abstract member Set : target : Register * value : float32 -> unit
-
- abstract member NewLabel : unit -> AssemblerLabel
- abstract member Mark : AssemblerLabel -> unit
- abstract member Cmp : location : nativeint * value : int32 -> unit
- abstract member Jump : JumpCondition * AssemblerLabel -> unit
- abstract member Jump : AssemblerLabel -> unit
-
- abstract member AddInt : target : Register * source : Register * wide : bool -> unit
- abstract member MulInt : target : Register * source : Register * wide : bool -> unit
-
- abstract member Copy : srcPtr : nativeint * dstPtr : nativeint * wide : bool -> unit
-
-
- /// emits a function-preamble (typically pushing the base-pointer, etc.)
- abstract member BeginFunction : unit -> unit
-
- /// emits a function-epilog (typically popping the base-pointer, etc.)
- abstract member EndFunction : unit -> unit
-
- /// switches to call-mode (no other calls then PushArg* are allowed between BeginCall and Call).
- /// Takes the number of arguments the function will take
- abstract member BeginCall : args : int -> unit
-
- /// calls the given function-pointer using the arguments pushed (via PushArg*) in reverse order
- abstract member Call : ptr : nativeint -> unit
- abstract member CallIndirect : ptr : nativeptr -> unit
-
- /// reads a pointer-sized integer value from the given location and pushes it onto the argument stack
- abstract member PushPtrArg : location : nativeint -> unit
- /// reads a 4 byte integer value from the given location and pushes it onto the argument stack
- abstract member PushIntArg : location : nativeint -> unit
- /// reads a 4 byte floating-point value from the given location and pushes it onto the argument stack
- abstract member PushFloatArg : location : nativeint -> unit
-
- /// reads a 8 byte floating-point value from the given location and pushes it onto the argument stack
- abstract member PushDoubleArg : location : nativeint -> unit
-
- /// pushes an immediate pointer-sized integer onto the argument stack
- abstract member PushArg : value : nativeint -> unit
- /// pushes an immediate 4 byte integer onto the argument stack
- abstract member PushArg : value : int -> unit
- /// pushes an immediate 4 byte floating-point onto the argument stack
- abstract member PushArg : value : float32 -> unit
-
- /// returns control to the caller
- abstract member Ret : unit -> unit
-
- /// writes a pointer-sized integer value to the output register
- abstract member WriteOutput : value : nativeint -> unit
- /// writes a 4 byte integer value to the output register
- abstract member WriteOutput : value : int -> unit
- /// writes a 4 byte floating-point value to the output register
- abstract member WriteOutput : value : float32 -> unit
-
- /// writes a relative jump to the stream (offset is relative to start of the instruction, e.g. offset=0 => nontermination)
- abstract member Jump : offset : int -> unit
-
-
diff --git a/src/Aardvark.Base.Runtime/Assembler/NativeProgram.fs b/src/Aardvark.Base.Runtime/Assembler/NativeProgram.fs
deleted file mode 100644
index 9b115962b..000000000
--- a/src/Aardvark.Base.Runtime/Assembler/NativeProgram.fs
+++ /dev/null
@@ -1,528 +0,0 @@
-namespace Aardvark.Base.Runtime
-
-open System
-open System.Collections.Generic
-open System.Threading
-open System.Runtime.InteropServices
-open System.IO
-open Aardvark.Base
-open Microsoft.FSharp.NativeInterop
-open FSharp.Data.Adaptive
-
-#nowarn "9"
-#nowarn "44"
-
-[]
-module private Helpers =
- let jumpInt =
- use ms = new MemoryStream()
- use w = AssemblerStream.ofStream ms
- w.Jump(0)
- ms.ToArray() |> Array.take (int ms.Length - 4)
-
- let ret =
- use ms = new MemoryStream()
- use w = AssemblerStream.ofStream ms
- w.EndFunction()
- w.Ret()
- ms.ToArray()
-
- let jumpSize = nativeint jumpInt.Length + 4n
-
-[]
-type private Fragment<'a, 'b> =
- class
- val mutable prev : Fragment<'a, 'b>
- val mutable next : Fragment<'a, 'b>
- val mutable public TotalJumpDistance : ref
- val mutable public Manager : MemoryManager
- val mutable public Pointer : managedptr
- val mutable public Tag : 'a
- val mutable public JumpDistance : int64
- val mutable public Stats : 'b
-
- member x.Dispose() =
- x.Manager.Free x.Pointer
- if not (isNull x.prev) then
- x.prev.Next <- x.next
- Interlocked.Add(x.TotalJumpDistance, -x.JumpDistance) |> ignore
- x.JumpDistance <- 0L
-
- member private x.writeJump() =
- if not (isNull x.next) then
- let target = x.next.Pointer.Offset
- let source = x.Pointer.Offset + x.Pointer.Size - jumpSize
- let offset = target - source - 5n |> int
- let dist = abs (int64 offset)
- Interlocked.Add(x.TotalJumpDistance, dist - x.JumpDistance) |> ignore
- x.JumpDistance <- dist
-
- let off = x.Pointer.Size - jumpSize |> int
- x.Pointer.Write(off, jumpInt)
- x.Pointer.Write(off + jumpInt.Length, offset)
- else
- Interlocked.Add(x.TotalJumpDistance, -x.JumpDistance) |> ignore
- x.JumpDistance <- 0L
-
- let off = x.Pointer.Size - jumpSize |> int
- x.Pointer.Write(off, ret)
-
-
-
- member x.Capacity = x.Pointer.Size - jumpSize
-
- member x.EntryPointer =
- x.Pointer.Parent.Pointer + x.Pointer.Offset
-
- member x.Realloc(newCapacity : nativeint) : unit =
- let newCapacity = newCapacity + jumpSize
- if newCapacity <> x.Pointer.Size then
- let moved =
- if x.Pointer.Free then
- x.Pointer <- x.Manager.Alloc(newCapacity)
- x.writeJump()
- true
- else
- x.Pointer |> ManagedPtr.realloc newCapacity
-
- x.writeJump()
- if moved && not (isNull x.prev) then
- x.prev.writeJump()
-
- member x.Prev
- with get() = x.prev
-
- member x.Next
- with get() = x.next
- and set n =
- x.next <- n
- if not (isNull n) then
- n.prev <- x
-
- x.writeJump()
-
- member x.GetStream() : Stream =
- new FragmentStream<'a, 'b>(x) :> Stream
-
- member x.AssemblerStream =
- AssemblerStream.ofStream (x.GetStream())
-
- new(totalJumps, manager, tag, stats) = { TotalJumpDistance = totalJumps; JumpDistance = 0L; Manager = manager; Tag = tag; Pointer = manager.Alloc(jumpSize); prev = null; next = null; Stats = stats }
- end
-
-and private FragmentStream<'a, 'b>(f : Fragment<'a, 'b>) =
- inherit Stream()
-
- let mutable capacity = f.Capacity
- let mutable offset = 0n
- let mutable additional : MemoryStream = null //new MemoryStream()
-
- override x.CanRead = false
- override x.CanWrite = true
- override x.CanSeek = true
-
- override x.Dispose(disposing) =
- x.Flush()
-
- base.Dispose(disposing)
- let o = Interlocked.Exchange(&additional, null)
- if not (isNull o) then
- o.Dispose()
- capacity <- 0n
- offset <- 0n
-
- override x.Position
- with get() = int64 offset
- and set v = offset <- nativeint v
-
- override x.Length = int64 capacity + (if isNull additional then 0L else additional.Length)
-
- override x.Write(d, o, c) =
- let newOffset = offset + nativeint c
- if newOffset <= capacity then
- f.Pointer.Use (fun ptr ->
- Marshal.Copy(d, o, ptr + offset, c)
- )
- offset <- newOffset
- else
- let additional =
- match additional with
- | null ->
- let s = new MemoryStream()
- additional <- s
- s
- | s -> s
-
- if offset < capacity then
- let storable = capacity - offset
- f.Pointer.Use (fun ptr ->
- Marshal.Copy(d, o, ptr + offset, int storable)
- )
-
- additional.Position <- 0L
- if c > int storable then
- additional.Write(d, o + int storable, c - int storable)
-
- offset <- newOffset
-
- else
- additional.Position <- int64 (offset - capacity)
- additional.Write(d, o, c)
- offset <- newOffset
-
-
-
-
-
- ()
-
- override x.Read(d, o, c) =
- failwith ""
-
- override x.SetLength(l : int64) =
- if nativeint l > capacity then
- let additional =
- match additional with
- | null ->
- let s = new MemoryStream()
- additional <- s
- s
- | s -> s
-
- additional.SetLength(l - int64 capacity)
-
- else
- if not (isNull additional) then
- additional.Dispose()
- additional <- null
-
- f.Realloc(nativeint l)
- capacity <- nativeint l
-
- override x.Seek(o : int64, origin : SeekOrigin) =
- match origin with
- | SeekOrigin.Begin -> offset <- nativeint o; int64 offset
- | SeekOrigin.Current -> offset <- offset + nativeint o; int64 offset
- | _ -> offset <- nativeint (x.Length - o); int64 offset
-
- override x.Flush() =
- if not (isNull additional) then
- additional.Flush()
- f.Realloc(offset)
-
- let arr = additional.ToArray()
- f.Pointer.Use (fun ptr ->
- Marshal.Copy(arr, 0, ptr + capacity, arr.Length)
- )
- additional.Dispose()
- additional <- null
- capacity <- f.Capacity
- elif offset <> capacity then
- f.Realloc(offset)
- capacity <- f.Capacity
-
-type NativeProgramUpdateStatistics =
- struct
- val mutable public Added : int
- val mutable public Removed : int
- val mutable public Updated : int
- val mutable public Compiled : int
- val mutable public Count : int
- val mutable public JumpDistance : int64
- static member Zero = NativeProgramUpdateStatistics()
- end
-
-[]
-type NativeProgram<'a, 'b> private(data : alist<'a>, isDifferential : bool, compileDelta : Option<'a> -> 'a -> IAssemblerStream -> 'b, zero : 'b, add : 'b -> 'b -> 'b, sub : 'b -> 'b -> 'b) =
- inherit AdaptiveObject()
- let compileDelta = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(compileDelta)
-
- let mutable disposed = false
- let manager = MemoryManager.createExecutable()
-
- let jumpDistance = ref 0L
- let mutable count = 0 // FragmentCount
- let mutable stats : 'b = zero
-
- let mutable prolog =
- let f = new Fragment<'a, 'b>(jumpDistance, manager, Unchecked.defaultof<'a>, zero)
- use s = f.AssemblerStream
- s.BeginFunction()
- f
-
- let reader = data.GetReader()
- let cache : SortedDictionaryExt> = SortedDictionary.empty
-
-
- let mutable lastEntryPointer = prolog.EntryPointer
- let mutable run : unit -> unit = UnmanagedFunctions.wrap lastEntryPointer
- let entryPointerStore = NativePtr.alloc 1
- do NativePtr.write entryPointerStore prolog.EntryPointer
-
- let release() =
- if not disposed then
- disposed <- true
- cache.Clear()
- manager.Dispose()
- prolog <- null
- NativePtr.write entryPointerStore 0n
- run <- id
- jumpDistance := 0L
- count <- 0
- stats <- zero
-
- member x.FragmentCount = count
-
- member x.Stats = stats
-
- member x.EntryPointer = entryPointerStore
-
- member x.AverageJumpDistance =
- if !jumpDistance = 0L then 0.0
- else float !jumpDistance / float count
-
- member x.TotalJumpDistance = !jumpDistance
-
- member x.Update(token : AdaptiveToken) : NativeProgramUpdateStatistics =
- x.EvaluateIfNeeded token NativeProgramUpdateStatistics.Zero (fun token ->
- if disposed then
- raise <| ObjectDisposedException("AdaptiveProgram")
-
- let ops = reader.GetChanges token
-
- let dirty =
- if isDifferential then System.Collections.Generic.HashSet>()
- else null
-
- let mutable added = 0
- let mutable removed = 0
- let mutable updated = 0
- let mutable compiled = 0
-
- for i, op in IndexListDelta.toSeq ops do
- match op with
- | Remove ->
- match cache.TryGetValue i with
- | (true, f) ->
- let n = f.Next
- f.Dispose()
- cache.Remove i |> ignore
- if isDifferential then
- if not (isNull n) then dirty.Add n |> ignore
- dirty.Remove f |> ignore
- count <- count - 1
- removed <- removed + 1
- stats <- sub stats f.Stats
- f.Stats <- zero
- | _ ->
- ()
-
- | Set v ->
- cache |> SortedDictionary.setWithNeighbours i (fun l s r ->
- let l = l |> Option.map snd
- let r = r |> Option.map snd
-
- let prev =
- if isDifferential then
- match l with
- | Some f ->
- if f = prolog then None
- else Some f.Tag
- | None ->
- None
- else
- None
-
- match s with
- | Some f ->
- f.Tag <- v
- let o = f.Stats
- let s = Operators.using f.AssemblerStream (fun s -> compileDelta.Invoke(prev, v, s))
- if isDifferential && not (isNull f.next) then dirty.Add f.next |> ignore
- stats <- add (sub stats o) s
- updated <- updated + 1
- compiled <- compiled + 1
- f.Stats <- s
- f
-
- | None ->
- let f = new Fragment<'a, 'b>(jumpDistance, manager, v, zero)
- let s = Operators.using f.AssemblerStream (fun s -> compileDelta.Invoke(prev, v, s))
- stats <- add stats s
- count <- count + 1
- f.Stats <- s
- match l with
- | None -> prolog.Next <- f
- | Some(p) -> p.Next <- f
-
- match r with
- | None -> f.Next <- null
- | Some(n) ->
- if isDifferential then dirty.Add n |> ignore
- f.Next <- n
-
- added <- added + 1
- compiled <- compiled + 1
- f
-
- ) |> ignore
-
- if isDifferential then
- dirty.Remove prolog |> ignore
- for d in dirty do
- let prev =
- if d.Prev = prolog then None
- else Some d.Prev.Tag
-
- let o = d.Stats
- let s = Operators.using d.AssemblerStream (fun s -> compileDelta.Invoke(prev, d.Tag, s))
- compiled <- compiled + 1
- stats <- add (sub stats o) s
- d.Stats <- s
-
- let ptr = prolog.EntryPointer
- if ptr <> lastEntryPointer then
- lastEntryPointer <- ptr
- NativePtr.write entryPointerStore ptr
- run <- UnmanagedFunctions.wrap ptr
-
- new NativeProgramUpdateStatistics(
- Added = added,
- Removed = removed,
- Updated = updated,
- Compiled = compiled,
- Count = count,
- JumpDistance = !jumpDistance
- )
-
- )
-
- member x.Update() = x.Update(AdaptiveToken.Top)
-
- member x.Run() =
- lock x (fun () ->
- if disposed then
- raise <| ObjectDisposedException("AdaptiveProgram")
-
- run()
- )
-
- member private x.Dispose(disposing : bool) =
- if disposing then
- GC.SuppressFinalize x
- lock x release
- else
- release()
-
- member x.Dispose() = x.Dispose(true)
- override x.Finalize() = x.Dispose(false)
-
-
- interface IDisposable with
- member x.Dispose() = x.Dispose()
-
- new(data : alist<'a>, compile : Option<'a> -> 'a -> IAssemblerStream -> 'b, zero, add, sub) = new NativeProgram<'a, 'b>(data, true, compile, zero, add, sub)
- new(data : alist<'a>, compile : 'a -> IAssemblerStream -> 'b, zero, add, sub) = new NativeProgram<'a, 'b>(data, false, (fun _ v s -> compile v s), zero, add, sub)
-
-[]
-[]
-module NativeProgram =
- let differential (compile : Option<'a> -> 'a -> IAssemblerStream -> 'b, zero, add, sub) (values : alist<'a>) =
- new NativeProgram<'a, 'b>(values, compile, zero, add, sub)
-
- let simple (compile : 'a -> IAssemblerStream -> 'b, zero, add, sub) (values : alist<'a>) =
- new NativeProgram<'a, 'b>(values, compile, zero, add, sub)
-
-[]
-type ChangeableNativeProgram<'a, 'b>(compile : 'a -> IAssemblerStream -> 'b, zero, add, sub) =
-
- let manager = MemoryManager.createExecutable()
-
- let entryPointer = NativePtr.alloc 1
- let jumpDistance = ref 0L
- let mutable prolog =
- let f = new Fragment<'a, 'b>(jumpDistance, manager, Unchecked.defaultof<'a>, zero)
- use s = f.AssemblerStream
- s.BeginFunction()
- f
-
- let mutable lastEntry = 0n
- let mutable run : unit -> unit = id
- let mutable stats = zero
-
- let updateEntry() =
- if prolog.EntryPointer <> lastEntry then
- lastEntry <- prolog.EntryPointer
- NativePtr.write entryPointer lastEntry
- run <- UnmanagedFunctions.wrap lastEntry
-
- do prolog.Next <- null; updateEntry()
-
- let mutable last = prolog
- let entries = Dict<'a, Fragment<'a, 'b>>()
-
- member x.Stats = stats
-
- member x.Add(value : 'a) =
- if isNull prolog then raise <| ObjectDisposedException("NativeProgram")
-
- if entries.ContainsKey value then
- false
- else
- let f = new Fragment<'a, 'b>(jumpDistance, manager, value, zero)
- let s = Operators.using f.AssemblerStream (fun s -> compile value s)
- stats <- add stats s
- last.Next <- f
- f.Next <- null
- f.Stats <- s
- last <- f
- entries.[value] <- f
- updateEntry()
- true
-
- member x.Remove(value : 'a) =
- if isNull prolog then raise <| ObjectDisposedException("NativeProgram")
-
- match entries.TryRemove value with
- | (true, f) ->
- let prev = f.Prev
- let next = f.Next
- prev.Next <- next
- if isNull next then last <- prev
- f.Dispose()
- stats <- sub stats f.Stats
- f.Stats <- zero
- updateEntry()
- true
- | _ ->
- false
-
- member x.EntryPointer =
- if isNull prolog then raise <| ObjectDisposedException("NativeProgram")
- entryPointer
-
- member x.Clear() =
- if not (isNull prolog) then
- for f in entries.Values do f.Dispose()
- entries.Clear()
- prolog.Next <- null
- last <- prolog
- stats <- zero
- updateEntry()
-
- member x.Run() = run()
-
- member x.Dispose() =
- if not (isNull prolog) then
- manager.Dispose()
- run <- id
- lastEntry <- 0n
- entries.Clear()
- prolog <- null
- NativePtr.free entryPointer
- last <- null
- stats <- zero
- jumpDistance := 0L
-
- interface IDisposable with
- member x.Dispose() = x.Dispose()
diff --git a/src/Aardvark.Base/Math/Base/Constant.cs b/src/Aardvark.Base/Math/Base/Constant.cs
index e7bcfc929..7e2ac9dd5 100644
--- a/src/Aardvark.Base/Math/Base/Constant.cs
+++ b/src/Aardvark.Base/Math/Base/Constant.cs
@@ -177,13 +177,6 @@ public static class Constant
///
public const double PiInv = 0.318309886183790671537767526745028724068919291480912897495;
- ///
- /// Ratio of a circle's circumference to its diameter as float
- /// in Euclidean geometry. Also known as Archimedes' constant.
- ///
- [Obsolete("Use ConstantF.Pi instead")]
- public const float PiF = (float)Pi;
-
///
/// Two times PI: the circumference of the unit circle.
///
@@ -244,12 +237,6 @@ public static class Constant
///
public const double Sqrt2Half = 0.70710678118654752440084436210485;
- ///
- /// Square root of 0.5.
- ///
- [Obsolete("Use ConstantF.Sqrt2Half instead")]
- public const float Sqrt2HalfF = (float)Sqrt2Half;
-
///
/// Square root of 3.
///
@@ -265,34 +252,16 @@ public static class Constant
///
public const double Ln2 = 0.69314718055994530941723212145818;
- ///
- /// Natural logarithm (base e) of 2 as float.
- ///
- [Obsolete("Use ConstantF.Ln2 instead")]
- public const float Ln2F = (float)Ln2;
-
///
/// 1 divided by logarithm of 2 (base e).
///
public const double Ln2Inv = 1.4426950408889634073599246810023;
- ///
- /// 1 divided by logarithm of 2 (base e) as float.
- ///
- [Obsolete("Use ConstantF.Ln2Inv instead")]
- public const float Ln2InvF = (float)Ln2Inv;
-
///
/// 1 divided by 3.
///
public const double OneThird = 0.33333333333333333333333333333333;
- ///
- /// 1 divided by 3.
- ///
- [Obsolete("Use ConstantF.OneThird instead")]
- public const double OneThirdF = (float)OneThird;
-
///
/// Used to convert degrees to radians.
/// See also
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -3939,11 +3934,6 @@ ushort parse(Text t)
public static bool TryParse(string s, out C3us result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C3us Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -6143,11 +6133,6 @@ uint parse(Text t)
public static bool TryParse(string s, out C3ui result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C3ui Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -8217,11 +8202,6 @@ float parse(Text t)
public static bool TryParse(string s, out C3f result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C3f Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -10328,11 +10308,6 @@ double parse(Text t)
public static bool TryParse(string s, out C3d result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C3d Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -12964,11 +12939,6 @@ byte parse(Text t)
public static bool TryParse(string s, out C4b result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C4b Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -15529,11 +15499,6 @@ ushort parse(Text t)
public static bool TryParse(string s, out C4us result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C4us Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -17999,11 +17964,6 @@ uint parse(Text t)
public static bool TryParse(string s, out C4ui result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C4ui Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -20254,11 +20214,6 @@ float parse(Text t)
public static bool TryParse(string s, out C4f result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C4f Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
@@ -22549,11 +22504,6 @@ double parse(Text t)
public static bool TryParse(string s, out C4d result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static C4d Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
diff --git a/src/Aardvark.Base/Math/Colors/Color_template.cs b/src/Aardvark.Base/Math/Colors/Color_template.cs
index 6dc25c158..9e3a8ddf9 100644
--- a/src/Aardvark.Base/Math/Colors/Color_template.cs
+++ b/src/Aardvark.Base/Math/Colors/Color_template.cs
@@ -1203,11 +1203,6 @@ __ftype__ parse(Text t)
public static bool TryParse(string s, out __type__ result)
=> TryParse(new Text(s), out result);
- [Obsolete("Parameter provider is unused.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static __type__ Parse(string s, IFormatProvider provider)
- => Parse(s);
-
///
/// Parses a color string with decimal format [R, G, B, A], or hexadecimal formats RRGGBBAA or RGBA.
///
diff --git a/src/Aardvark.Base/Math/Interpolation/Interpolation.cs b/src/Aardvark.Base/Math/Interpolation/Interpolation.cs
index 4381e57b3..e3fb7cb64 100644
--- a/src/Aardvark.Base/Math/Interpolation/Interpolation.cs
+++ b/src/Aardvark.Base/Math/Interpolation/Interpolation.cs
@@ -1,5 +1,4 @@
using System;
-using System.Runtime.CompilerServices;
using Ex = System.Linq.Expressions.Expression;
namespace Aardvark.Base
@@ -22,35 +21,6 @@ public static Func Generate(
return Ipol.Generate(a, b, c, d, interpolator);
}
- #endregion
-
- #region Spherical Linear Interpolation
-
- ///
- /// Spherical linear interpolation.
- ///
- /// Assumes q1 and q2 are normalized and that t in [0,1].
- ///
- /// This method interpolates along the shortest arc between q1 and q2.
- ///
- [Obsolete("Use Rot.SlerpShortest or Quaternion.SlerpShortest instead")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static Rot3d SlerpShortest(Rot3d q1, Rot3d q2, double t)
- => Rot.SlerpShortest(q1, q2, t);
-
- ///
- /// Spherical linear interpolation.
- ///
- /// Assumes q1 and q2 are normalized and that t in [0,1].
- ///
- /// This method interpolates along the shortest arc between q1 and q2.
- ///
- [Obsolete("Use Rot.SlerpShortest or Quaternion.SlerpShortest instead")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static Rot3f SlerpShortest(Rot3f q1, Rot3f q2, float t)
- => Rot.SlerpShortest(q1, q2, t);
-
-
#endregion
}
diff --git a/src/Aardvark.Base/Math/RangesBoxes/Cell.cs b/src/Aardvark.Base/Math/RangesBoxes/Cell.cs
index 2ef3aca05..534fa21f6 100644
--- a/src/Aardvark.Base/Math/RangesBoxes/Cell.cs
+++ b/src/Aardvark.Base/Math/RangesBoxes/Cell.cs
@@ -582,12 +582,6 @@ public static Cell Parse(byte[] buffer)
return new Cell(x, y, z, e);
}
- ///
- ///
- [Obsolete("Parameter 'offset' is not respected, use Parse(buffer) instead.")]
- public static Cell Parse(byte[] buffer, int offset)
- => Parse(buffer);
-
#endregion
}
}
diff --git a/src/Aardvark.Base/Math/Trafos/M44_auto.cs b/src/Aardvark.Base/Math/Trafos/M44_auto.cs
index 5a758daa1..bed73623a 100644
--- a/src/Aardvark.Base/Math/Trafos/M44_auto.cs
+++ b/src/Aardvark.Base/Math/Trafos/M44_auto.cs
@@ -157,32 +157,6 @@ public static M44f PerspectiveProjectionTransformRH(float l, float r, float t, f
return P;
}
-
-
- ///
- /// Builds a customized, left-handed perspective Off-Center projection matrix.
- ///
- [Obsolete("Broken, do not use.")]
- public static M44f PerspectiveProjectionTransformLH(float l, float r, float t, float b, float n, float f)
- {
- // Fx 0 0 0
- // 0 Fy 0 0
- // Sx Sy A 1
- // 0 0 B 0
- float Fx = 2 * n / (r - l);
- float Fy = 2 * n / (t - b);
- float Sx = (l + r) / (l - r);
- float Sy = (t + b) / (b - t);
- float A = f / (f - n);
- float B = n * f / (n - f);
-
- M44f P = new M44f(
- Fx, 0, 0, 0,
- 0, Fy, 0, 0,
- Sx, Sy, A, 1,
- 0, 0, B, 0);
- return P;
- }
#endregion
#region Static creators
@@ -398,32 +372,6 @@ public static M44d PerspectiveProjectionTransformRH(double l, double r, double t
return P;
}
-
-
- ///
- /// Builds a customized, left-handed perspective Off-Center projection matrix.
- ///
- [Obsolete("Broken, do not use.")]
- public static M44d PerspectiveProjectionTransformLH(double l, double r, double t, double b, double n, double f)
- {
- // Fx 0 0 0
- // 0 Fy 0 0
- // Sx Sy A 1
- // 0 0 B 0
- double Fx = 2 * n / (r - l);
- double Fy = 2 * n / (t - b);
- double Sx = (l + r) / (l - r);
- double Sy = (t + b) / (b - t);
- double A = f / (f - n);
- double B = n * f / (n - f);
-
- M44d P = new M44d(
- Fx, 0, 0, 0,
- 0, Fy, 0, 0,
- Sx, Sy, A, 1,
- 0, 0, B, 0);
- return P;
- }
#endregion
#region Static creators
diff --git a/src/Aardvark.Base/Math/Trafos/M44_template.cs b/src/Aardvark.Base/Math/Trafos/M44_template.cs
index 06babc898..73d7cc4c0 100644
--- a/src/Aardvark.Base/Math/Trafos/M44_template.cs
+++ b/src/Aardvark.Base/Math/Trafos/M44_template.cs
@@ -162,32 +162,6 @@ public static M4__x4t__ PerspectiveProjectionTransformRH(__ft__ l, __ft__ r, __f
return P;
}
-
-
- ///
- /// Builds a customized, left-handed perspective Off-Center projection matrix.
- ///
- [Obsolete("Broken, do not use.")]
- public static M4__x4t__ PerspectiveProjectionTransformLH(__ft__ l, __ft__ r, __ft__ t, __ft__ b, __ft__ n, __ft__ f)
- {
- // Fx 0 0 0
- // 0 Fy 0 0
- // Sx Sy A 1
- // 0 0 B 0
- __ft__ Fx = 2 * n / (r - l);
- __ft__ Fy = 2 * n / (t - b);
- __ft__ Sx = (l + r) / (l - r);
- __ft__ Sy = (t + b) / (b - t);
- __ft__ A = f / (f - n);
- __ft__ B = n * f / (n - f);
-
- M4__x4t__ P = new M4__x4t__(
- Fx, 0, 0, 0,
- 0, Fy, 0, 0,
- Sx, Sy, A, 1,
- 0, 0, B, 0);
- return P;
- }
#endregion
#region Static creators
diff --git a/src/Aardvark.Base/Math/Trafos/Trafo_auto.cs b/src/Aardvark.Base/Math/Trafos/Trafo_auto.cs
index e98132fe8..2f126e463 100644
--- a/src/Aardvark.Base/Math/Trafos/Trafo_auto.cs
+++ b/src/Aardvark.Base/Math/Trafos/Trafo_auto.cs
@@ -1132,10 +1132,6 @@ public static Trafo3f PerspectiveProjectionGL(float l, float r, float b, float t
);
}
- [Obsolete("Use PerspectiveProjectionGL instead.")]
- public static Trafo3f PerspectiveProjectionOpenGl(float l, float r, float b, float t, float n, float f)
- => Trafo3f.PerspectiveProjectionGL(l, r, b, t, n, f);
-
///
/// Creates a right-handed perspective projection transform, where z-negative points into the scene.
/// The resulting canonical view volume is [(-1, -1, -1), (+1, +1, +1)] and left-handed (handedness flip between view and NDC space).
@@ -1214,31 +1210,6 @@ public static Trafo3f PerspectiveProjectionReversedGL(float horizontalFovInRadia
return Trafo3f.PerspectiveProjectionReversedGL(-d, d, -d / aspect, d / aspect, n, f);
}
- ///
- /// Creates a left-handed perspective projection transform, where z-positive points into the scene.
- /// The resulting canonical view volume is [(-1, -1, 0), (+1, +1, +1)].
- ///
- [Obsolete("Broken, do not use.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static Trafo3f PerspectiveProjectionLH(float l, float r, float b, float t, float n, float f)
- {
- return new Trafo3f(
- new M44f(
- (2 * n) / (r - l), 0, 0, 0,
- 0, (2 * n) / (t - b), 0, 0,
- (l + r) / (l - r), (b + t) / (b - t), f / (f - n), 1,
- 0, 0, (n * f) / (n - f), 0
- ),
-
- new M44f(
- (r - l) / (2 * n), 0, 0, 0,
- 0, (t - b) / (2 * n), 0, 0,
- 0, 0, 0, (n - f) / (f * n),
- (r + l) / (2 * n), (t + b) / (2 * n), 1, 1 / n
- )
- );
- }
-
///
/// Creates a right-handed orthographic projection transform, where z-negative points into the scene.
/// The resulting canonical view volume is [(-1, -1, 0), (+1, +1, +1)].
@@ -1297,10 +1268,6 @@ public static Trafo3f OrthoProjectionGL(float l, float r, float b, float t, floa
);
}
- [Obsolete("Use OrthoProjectionGL instead.")]
- public static Trafo3f OrthoProjectionOpenGl(float l, float r, float b, float t, float n, float f)
- => Trafo3f.OrthoProjectionGL(l, r, b, t, n, f);
-
#endregion
#endregion
@@ -2700,10 +2667,6 @@ public static Trafo3d PerspectiveProjectionGL(double l, double r, double b, doub
);
}
- [Obsolete("Use PerspectiveProjectionGL instead.")]
- public static Trafo3d PerspectiveProjectionOpenGl(double l, double r, double b, double t, double n, double f)
- => Trafo3d.PerspectiveProjectionGL(l, r, b, t, n, f);
-
///
/// Creates a right-handed perspective projection transform, where z-negative points into the scene.
/// The resulting canonical view volume is [(-1, -1, -1), (+1, +1, +1)] and left-handed (handedness flip between view and NDC space).
@@ -2782,31 +2745,6 @@ public static Trafo3d PerspectiveProjectionReversedGL(double horizontalFovInRadi
return Trafo3d.PerspectiveProjectionReversedGL(-d, d, -d / aspect, d / aspect, n, f);
}
- ///
- /// Creates a left-handed perspective projection transform, where z-positive points into the scene.
- /// The resulting canonical view volume is [(-1, -1, 0), (+1, +1, +1)].
- ///
- [Obsolete("Broken, do not use.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static Trafo3d PerspectiveProjectionLH(double l, double r, double b, double t, double n, double f)
- {
- return new Trafo3d(
- new M44d(
- (2 * n) / (r - l), 0, 0, 0,
- 0, (2 * n) / (t - b), 0, 0,
- (l + r) / (l - r), (b + t) / (b - t), f / (f - n), 1,
- 0, 0, (n * f) / (n - f), 0
- ),
-
- new M44d(
- (r - l) / (2 * n), 0, 0, 0,
- 0, (t - b) / (2 * n), 0, 0,
- 0, 0, 0, (n - f) / (f * n),
- (r + l) / (2 * n), (t + b) / (2 * n), 1, 1 / n
- )
- );
- }
-
///
/// Creates a right-handed orthographic projection transform, where z-negative points into the scene.
/// The resulting canonical view volume is [(-1, -1, 0), (+1, +1, +1)].
@@ -2865,10 +2803,6 @@ public static Trafo3d OrthoProjectionGL(double l, double r, double b, double t,
);
}
- [Obsolete("Use OrthoProjectionGL instead.")]
- public static Trafo3d OrthoProjectionOpenGl(double l, double r, double b, double t, double n, double f)
- => Trafo3d.OrthoProjectionGL(l, r, b, t, n, f);
-
#endregion
#endregion
diff --git a/src/Aardvark.Base/Math/Trafos/Trafo_template.cs b/src/Aardvark.Base/Math/Trafos/Trafo_template.cs
index 9bcd8b20c..1ef06a357 100644
--- a/src/Aardvark.Base/Math/Trafos/Trafo_template.cs
+++ b/src/Aardvark.Base/Math/Trafos/Trafo_template.cs
@@ -705,10 +705,6 @@ public static __type__ PerspectiveProjectionGL(__rtype__ l, __rtype__ r, __rtype
);
}
- [Obsolete("Use PerspectiveProjectionGL instead.")]
- public static __type__ PerspectiveProjectionOpenGl(__rtype__ l, __rtype__ r, __rtype__ b, __rtype__ t, __rtype__ n, __rtype__ f)
- => __type__.PerspectiveProjectionGL(l, r, b, t, n, f);
-
///
/// Creates a right-handed perspective projection transform, where z-negative points into the scene.
/// The resulting canonical view volume is [(-1, -1, -1), (+1, +1, +1)] and left-handed (handedness flip between view and NDC space).
@@ -787,31 +783,6 @@ public static __type__ PerspectiveProjectionReversedGL(__rtype__ horizontalFovIn
return __type__.PerspectiveProjectionReversedGL(-d, d, -d / aspect, d / aspect, n, f);
}
- ///
- /// Creates a left-handed perspective projection transform, where z-positive points into the scene.
- /// The resulting canonical view volume is [(-1, -1, 0), (+1, +1, +1)].
- ///
- [Obsolete("Broken, do not use.")]
- [MethodImpl(MethodImplOptions.AggressiveInlining)]
- public static __type__ PerspectiveProjectionLH(__rtype__ l, __rtype__ r, __rtype__ b, __rtype__ t, __rtype__ n, __rtype__ f)
- {
- return new __type__(
- new __mmmt__(
- (2 * n) / (r - l), 0, 0, 0,
- 0, (2 * n) / (t - b), 0, 0,
- (l + r) / (l - r), (b + t) / (b - t), f / (f - n), 1,
- 0, 0, (n * f) / (n - f), 0
- ),
-
- new __mmmt__(
- (r - l) / (2 * n), 0, 0, 0,
- 0, (t - b) / (2 * n), 0, 0,
- 0, 0, 0, (n - f) / (f * n),
- (r + l) / (2 * n), (t + b) / (2 * n), 1, 1 / n
- )
- );
- }
-
///
/// Creates a right-handed orthographic projection transform, where z-negative points into the scene.
/// The resulting canonical view volume is [(-1, -1, 0), (+1, +1, +1)].
@@ -870,10 +841,6 @@ public static __type__ OrthoProjectionGL(__rtype__ l, __rtype__ r, __rtype__ b,
);
}
- [Obsolete("Use OrthoProjectionGL instead.")]
- public static __type__ OrthoProjectionOpenGl(__rtype__ l, __rtype__ r, __rtype__ b, __rtype__ t, __rtype__ n, __rtype__ f)
- => __type__.OrthoProjectionGL(l, r, b, t, n, f);
-
#endregion
//# }
diff --git a/src/Demo/Scratch/Program.fs b/src/Demo/Scratch/Program.fs
index b9938148f..8c15f6f98 100644
--- a/src/Demo/Scratch/Program.fs
+++ b/src/Demo/Scratch/Program.fs
@@ -144,170 +144,6 @@ type NativeStream() =
length <- length + nativeint count
offset <- offset + nativeint count
-
-module Benchmark =
- open System.Diagnostics
-
- type MyDelegate = delegate of float32 * float32 * int64 * float32 * int * float32 * int * float32 -> unit
-
- let callback =
- MyDelegate (fun a b c d e f g h ->
- printfn "a: %A" a
- printfn "b: %A" b
- printfn "c: %A" c
- printfn "d: %A" d
- printfn "e: %A" e
- printfn "f: %A" f
- printfn "g: %A" g
- printfn "h: %A" h
- )
-
- let pDel = Marshal.PinDelegate(callback)
- let ptr = pDel.Pointer
-
- let cnt = 1 <<< 12
-
- let args = [| 1.0f :> obj; 2.0f :> obj; 3L :> obj; 4.0f :> obj; 5 :> obj; 6.0f :> obj; 7 :> obj; 8.0f :> obj |]
- let calls = Array.init cnt (fun _ -> ptr, args)
-
- let runOld(iter : int) =
- // warmup
- for i in 1 .. 10 do
- Aardvark.Base.Assembler.compileCalls 0 calls |> ignore
-
- let sw = Stopwatch.StartNew()
- for i in 1 .. iter do
- Aardvark.Base.Assembler.compileCalls 0 calls |> ignore
- sw.Stop()
-
- sw.MicroTime / (float iter)
-
- let cc = AMD64.CallingConvention.windows
- let fillNew(cnt) =
- use s = new MemoryStream()
- use w = new AMD64.AssemblerStream(s)
-
- w.Begin()
-
- for i in 1 .. cnt do
- w.BeginCall(8)
- w.PushArg(cc, 7.0f)
- w.PushArg(cc, 6u)
- w.PushArg(cc, 5.0f)
- w.PushArg(cc, 4u)
- w.PushArg(cc, 3.0f)
- w.PushArg(cc, 2UL)
- w.PushArg(cc, 1.0f)
- w.PushArg(cc, 0.0f)
- w.Call(cc, ptr)
-
- w.End()
- w.Ret()
- //s.ToArray()
-
- let runNew(iter : int) =
- // warmup
- for i in 1 .. 10 do
- fillNew(cnt) |> ignore
-
- let sw = Stopwatch.StartNew()
- for i in 1 .. iter do
- fillNew(cnt) |> ignore
- sw.Stop()
-
- sw.MicroTime / (float iter)
-
- let run() =
-// let size = 1 <<< 14
-// while true do
-// fillNew size
-
- let ot = runOld 100
- let throughput = float cnt / ot.TotalSeconds
- Log.line "old: %A (%.0fc/s)" ot throughput
-
- let nt = runNew 100
- let throughput = float cnt / nt.TotalSeconds
- Log.line "new: %A (%.0fc/s)" nt throughput
-
- let speedup = ot / nt
- Log.line "factor: %A" speedup
-
-module Test =
-
- type MyDelegate = delegate of float32 * float32 * int * float32 * int * float32 * int * float32 -> unit
-
- let callback =
- MyDelegate (fun a b c d e f g h ->
- Log.start "call"
- Log.line "a: %A" a
- Log.line "b: %A" b
- Log.line "c: %A" c
- Log.line "d: %A" d
- Log.line "e: %A" e
- Log.line "f: %A" f
- Log.line "g: %A" g
- Log.line "h: %A" h
- Log.stop()
- )
-
- let ptr = Marshal.PinDelegate(callback)
-
- let run () =
- let store = NativePtr.alloc 1
- NativePtr.write store 100.0f
-
- use stream = new NativeStream()
- use asm = AssemblerStream.ofStream stream
-
- asm.BeginFunction()
-
- asm.BeginCall(8)
- asm.PushFloatArg(NativePtr.toNativeInt store)
- asm.PushArg(6)
- asm.PushArg(5.0f)
- asm.PushArg(4)
- asm.PushArg(3.0f)
- asm.PushArg(2)
- asm.PushArg(1.0f)
- asm.PushArg(0.0f)
- asm.Call(ptr.Pointer)
-
- asm.BeginCall(8)
- asm.PushArg(17.0f)
- asm.PushArg(16)
- asm.PushArg(15.0f)
- asm.PushArg(14)
- asm.PushArg(13.0f)
- asm.PushArg(12)
- asm.PushArg(11.0f)
- asm.PushArg(10.0f)
- asm.Call(ptr.Pointer)
-
- asm.WriteOutput(1234)
- asm.EndFunction()
- asm.Ret()
-
- let size = Fun.NextPowerOfTwo stream.Length |> nativeint
- let mem = ExecutableMemory.alloc size
- Marshal.Copy(stream.Pointer, mem, stream.Length)
-
- let managed : int -> int = UnmanagedFunctions.wrap mem
- Log.start "run(3)"
-
- if sizeof = 4 then Log.warn "32 bit"
- else Log.warn "64 bit"
-
-
- let res = managed 3
- Log.line "ret: %A" res
- Log.stop()
-
- ExecutableMemory.free mem size
-
- Environment.Exit 0
-
-
type MyDelegate = delegate of int * int * int * int64 * int64 -> unit // * int64 * int64 * int64 * int64 -> unit
open AMD64
@@ -1447,75 +1283,6 @@ let main argv =
-
-
-
-
-
- let callback =
- MyDelegate (fun a b c d e ->
- printfn "a: %A" a
- printfn "b: %A" b
- printfn "c: %A" c
- printfn "d: %A" d
- printfn "e: %A" e
- )
-
- let ptr = Marshal.PinDelegate(callback)
-
- let store = NativePtr.alloc 1
-
- use stream = new NativeStream()
- let asm = new AssemblerStream(stream, true)
-
- let data = NativePtr.alloc 1
- NativePtr.write data 12321.0
-
- let cc = CallingConvention.windows
-
- let l = asm.NewLabel()
-
- asm.Begin()
-
- asm.Load(Register.Rax, NativePtr.toNativeInt store, false)
- asm.Cmp(Register.Rax, 0u)
- asm.Jump(JumpCondition.Equal, l)
-
- asm.BeginCall(5)
- asm.PushArg(cc, 1234UL)
- asm.PushArg(cc, 4321UL)
- asm.PushArg(cc, 3u)
- asm.PushArg(cc, 2u)
- asm.PushArg(cc, 1u)
- asm.Call(cc, ptr.Pointer)
-
- asm.Mark(l)
-
- asm.BeginCall(5)
- asm.PushArg(cc, 81234UL)
- asm.PushArg(cc, 74321UL)
- asm.PushArg(cc, 6u)
- asm.PushArg(cc, 5u)
- asm.PushArg(cc, 4u)
- asm.Call(cc, ptr.Pointer)
-
- asm.End()
- asm.Ret()
- asm.Dispose()
-
- let size = Fun.NextPowerOfTwo stream.Length |> nativeint
- let mem = ExecutableMemory.alloc size
- Marshal.Copy(stream.Pointer, mem, stream.Length)
-
- let managed : int -> float32 = UnmanagedFunctions.wrap mem
-
- NativePtr.write store 0
- let res = managed 1234
- printfn "res = %A" res
- ExecutableMemory.free mem size
-
- Environment.Exit 0
-
let rand = RandomSystem()
let g = UndirectedGraph.ofNodes (Set.ofList [0..127]) (fun li ri -> float (ri - li) |> Some)
diff --git a/src/Tests/Aardvark.Base.FSharp.Benchmarks/RangeSet.fs b/src/Tests/Aardvark.Base.FSharp.Benchmarks/RangeSet.fs
index a8475a98f..35310b925 100644
--- a/src/Tests/Aardvark.Base.FSharp.Benchmarks/RangeSet.fs
+++ b/src/Tests/Aardvark.Base.FSharp.Benchmarks/RangeSet.fs
@@ -1,7 +1,5 @@
namespace Aardvark.Base.FSharp.Benchmarks
-#nowarn "44"
-
open System
open Aardvark.Base
@@ -11,18 +9,12 @@ module RangeSetTests =
[]
let ``[RangeSet] Insert`` (maxValue : bool) (mergeWithMaxValue : bool) =
- let mutable s1 = RangeSet64.empty
let mutable s2 = RangeSet1l.empty
let add (r : Range1l) =
- s1 <- s1 |> RangeSet64.insert r
s2 <- s2 |> RangeSet1l.add r
let equal (expected : Range1l list) =
- // Old implementation broken for MaxValue!
- if not maxValue then
- Seq.toList s1 |> should equal (Seq.toList s2)
-
Seq.toList s2 |> should equal expected
add <| Range1l(0L, 1L)
@@ -48,18 +40,12 @@ module RangeSetTests =
[]
let ``[RangeSet] Remove`` (maxValue : bool) =
let init = [ Range1l(0L, 4L); Range1l(6L, 8L); if maxValue then Range1l(42L, Int64.MaxValue) ]
- let mutable s1 = RangeSet64.ofList init
let mutable s2 = RangeSet1l.ofList init
let rem (r : Range1l) =
- s1 <- s1 |> RangeSet64.remove r
s2 <- s2 |> RangeSet1l.remove r
let equal (expected : Range1l list) =
- // Old implementation broken for MaxValue!
- if not maxValue then
- Seq.toList s1 |> should equal (Seq.toList s2)
-
Seq.toList s2 |> should equal expected
rem <| Range1l(3L, 3L)
@@ -88,28 +74,19 @@ module RangeSetTests =
[]
let ``[RangeSet] ToList`` (maxValue : bool) =
let init = [ Range1l(0L, 4L); Range1l(6L, 8L); if maxValue then Range1l(10L, Int64.MaxValue) ]
- let mutable s1 = RangeSet64.ofList init
let mutable s2 = RangeSet1l.ofList init
-
- RangeSet64.toList s1 |> should equal init
RangeSet1l.toList s2 |> should equal init
[]
let ``[RangeSet] ToArray`` (maxValue : bool) =
let init = [ Range1l(0L, 4L); Range1l(6L, 8L); if maxValue then Range1l(10L, Int64.MaxValue) ]
- let mutable s1 = RangeSet64.ofList init
let mutable s2 = RangeSet1l.ofList init
-
- RangeSet64.toArray s1 |> should equal (Array.ofList init)
RangeSet1l.toArray s2 |> should equal (Array.ofList init)
[]
let ``[RangeSet] ToSeq`` (maxValue : bool) =
let init = [ Range1l(0L, 4L); Range1l(6L, 8L); if maxValue then Range1l(10L, Int64.MaxValue) ]
- let mutable s1 = RangeSet64.ofList init
let mutable s2 = RangeSet1l.ofList init
-
- RangeSet64.toSeq s1 |> Seq.toList |> should equal init
RangeSet1l.toSeq s2 |> Seq.toList |> should equal init
[]
@@ -118,32 +95,19 @@ module RangeSetTests =
let min = init |> List.map (fun r -> r.Min) |> List.min
let max = init |> List.map (fun r -> r.Max) |> List.max
- let mutable s1 = RangeSet64.ofList init
let mutable s2 = RangeSet1l.ofList init
- s1.Min |> should equal s2.Min
s2.Min |> should equal min
-
- s1.Max |> should equal (max + 1L) // Old implementation is inconsistent!
s2.Max |> should equal max
-
- s1.Range |> should equal (Range1l(min, max + 1L))
s2.Range |> should equal (Range1l(min, max))
[]
let ``[RangeSet] Intersect`` (hasMaxValue : bool) (testMaxValue : bool) =
let init = [ Range1l(-3L, -2L); Range1l(1L, 4L); Range1l(6L, 8L); if hasMaxValue then Range1l(10L, Int64.MaxValue)]
- let s1 = RangeSet64.ofList init
let s2 = RangeSet1l.ofList init
let intersect (r : Range1l) =
- let r1 = s1 |> RangeSet64.window r
let r2 = s2 |> RangeSet1l.intersect r
-
- // Old implementation broken for MaxValue!
- if not (hasMaxValue || testMaxValue) then
- (RangeSet64.toList r1) |> should equal (RangeSet1l.toList r2)
-
RangeSet1l.toList r2
if testMaxValue then
@@ -167,22 +131,16 @@ module RangeSetTests =
[]
let ``[RangeSet] Enumerator`` (maxValue : bool) =
let init = [ Range1l(-3L, -2L); Range1l(1L, 4L); if maxValue then Range1l(6L, Int64.MaxValue) ]
- let s1 = RangeSet64.ofList init
let s2 = RangeSet1l.ofList init
let expected = Seq.ofList init
- s1 :> seq<_> |> should equal (s2 :> seq<_>)
s2 :> seq<_> |> should equal expected
[]
let ``[RangeSet] Equality`` (maxValue : bool) =
let init = [ Range1l(-3L, -2L); Range1l(1L, 4L); Range1l(6L, 8L); if maxValue then Range1l(34L, Int64.MaxValue) ]
- let mutable a1 = RangeSet64.ofList init
- let mutable b1 = RangeSet64.ofList init
let mutable a2 = RangeSet1l.ofList init
let mutable b2 = RangeSet1l.ofList init
-
- (a1 = b1) |> should be True
(a2 = b2) |> should be True
[]
@@ -219,101 +177,4 @@ module RangeSetTests =
set |> RangeSet1l.containsRange (Range1l(-2L, 3L)) |> should be False
- set |> RangeSet1l.containsRange (Range1l(20L, Int64.MaxValue)) |> should equal maxValue
-
-module RangeSetBenchmarks =
- open BenchmarkDotNet.Attributes;
-
- []
- type ``RangeSets``() =
- let rnd = RandomSystem(0)
-
- let mutable setOld = RangeSet64.empty
- let mutable setNew = RangeSet1l.empty
- let mutable ranges = List.empty
- let mutable ranges2 = List.empty
-
- []
- val mutable Count : int
-
- member private x.RandomRange() =
- let mutable l = Int64.MaxValue
- let mutable r = Int64.MinValue
-
- while l > r do
- l <- rnd.UniformLong()
- r <- l + rnd.UniformLong(100000L)
-
- Range1l(l, r)
-
- member private x.Generate(count : int) =
- List.init count (ignore >> x.RandomRange)
-
- []
- member x.Init() =
- ranges <- x.Generate x.Count
- ranges2 <- x.Generate x.Count
- setOld <- RangeSet64.ofList ranges
- setNew <- RangeSet1l.ofList ranges
-
-
- []
- member x.OfListOld() =
- RangeSet64.ofList ranges
-
- []
- member x.OfListNew() =
- RangeSet1l.ofList ranges
-
-
- []
- member x.InsertOld() =
- let mutable set = RangeSet64.empty
-
- for r in ranges do
- set <- set |> RangeSet64.insert r
-
- set
-
- []
- member x.InsertNew() =
- let mutable set = RangeSet1l.empty
-
- for r in ranges do
- set <- set |> RangeSet1l.add r
-
- set
-
-
- []
- member x.RemoveOld() =
- for r in ranges2 do
- setOld <- setOld |> RangeSet64.remove r
-
- setOld
-
- []
- member x.RemoveNew() =
- for r in ranges2 do
- setNew <- setNew |> RangeSet1l.remove r
-
- setNew
-
-
- []
- member x.IterateOld() =
- let mutable cnt = Int64.MinValue
-
- for r in setOld do
- cnt <- cnt + r.Min
-
- cnt
-
- []
- member x.IterateNew() =
- let mutable cnt = Int64.MinValue
-
- for r in setNew do
- cnt <- cnt + r.Min
-
- cnt
\ No newline at end of file
+ set |> RangeSet1l.containsRange (Range1l(20L, Int64.MaxValue)) |> should equal maxValue
\ No newline at end of file
diff --git a/src/Tests/Aardvark.Base.FSharp.Tests/Aardvark.Base.FSharp.Tests.fsproj b/src/Tests/Aardvark.Base.FSharp.Tests/Aardvark.Base.FSharp.Tests.fsproj
index 92ab4f93d..9378d6454 100644
--- a/src/Tests/Aardvark.Base.FSharp.Tests/Aardvark.Base.FSharp.Tests.fsproj
+++ b/src/Tests/Aardvark.Base.FSharp.Tests/Aardvark.Base.FSharp.Tests.fsproj
@@ -26,10 +26,8 @@
()
-
- let func(a : int) (b : int) (c : int) (d : int) (e : int) =
- calls.Add([|a :> obj; b; c; d; e|])
- sprintf "{ a = %d; b = %d; c = %d; d = %d; e = %d }" a b c d e |> Console.WriteLine
-
- let myfun = MyDelegate func
- let myfunPtr = Marshal.GetFunctionPointerForDelegate(myfun)
-
- []
- let ``[Fragment] execution working``() =
- let manager = MemoryManager.createExecutable()
-
- let maxArgs = 6
- let prolog = manager |> CodeFragment.prolog maxArgs
- let epilog = manager |> CodeFragment.epilog maxArgs
-
- let frag =
- manager |> CodeFragment.ofCalls [
- myfunPtr, [|1 :> obj; 2 :> obj; 3 :> obj; 4 :> obj; 5 :> obj|]
- myfunPtr, [|4 :> obj; 3 :> obj; 2 :> obj; 1 :> obj; 0 :> obj|]
- ]
-
-
- prolog.WriteNextPointer frag.Offset |> ignore
- frag.WriteNextPointer epilog.Offset |> ignore
-
-
- frag.ReadNextPointer() |> should equal epilog.Offset
- prolog.ReadNextPointer() |> should equal frag.Offset
-
- Console.WriteLine("Code:")
- let instructions = frag.Calls
- for (ptr, args) in instructions do
- Console.WriteLine(" {0}({1})", sprintf "%A" ptr, sprintf "%A" args)
-
-
- let run = CodeFragment.wrap prolog
- run()
-
- calls |> Seq.toList
- |> should equal [
- [|1 :> obj; 2 :> obj; 3 :> obj; 4 :> obj; 5 :> obj|]
- [|4 :> obj; 3 :> obj; 2 :> obj; 1 :> obj; 0 :> obj|]
- ]
-
- ()
-
-
- type PrintDelegate = delegate of int * int64 -> unit
- let printer (i : int) (l : int64) =
- printfn "i=%d l=%d" i l
- calls.Add([|i :> obj; l :> obj|])
-
- let pdel = PrintDelegate printer
- let pptr = Marshal.GetFunctionPointerForDelegate(pdel)
-
- []
- let ``[Fragment] pointer arguments working``() =
-
- let l0 = Marshal.AllocHGlobal sizeof
- let l1 = Marshal.AllocHGlobal sizeof
-
- let code =
- Array.concat [
- ASM.functionProlog 0 6
- ASM.assembleCalls 0 [pptr, [|Ptr32 l0 :> obj; Ptr64 l1 :> obj|]]
- ASM.functionEpilog 0 6
- ]
-
- let ptr = ExecutableMemory.alloc (nativeint code.Length)
- Marshal.Copy(code, 0, ptr, code.Length)
- let f : unit -> unit = UnmanagedFunctions.wrap ptr
-
- let run() =
- f()
- let arr = calls |> CSharpList.toArray
- calls.Clear()
- arr.[0]
-
-
- calls.Clear()
- Marshal.WriteInt32(l0, 1)
- Marshal.WriteInt64(l1, 10L)
- run() |> should equal [|1 :> obj; 10L :> obj|]
-
-
- Marshal.WriteInt32(l0, 5)
- Marshal.WriteInt64(l1, 6L)
- run() |> should equal [|5 :> obj; 6L :> obj|]
diff --git a/src/Tests/Aardvark.Base.FSharp.Tests/TimeTests.fs b/src/Tests/Aardvark.Base.FSharp.Tests/TimeTests.fs
deleted file mode 100644
index 6825b2cae..000000000
--- a/src/Tests/Aardvark.Base.FSharp.Tests/TimeTests.fs
+++ /dev/null
@@ -1,168 +0,0 @@
-namespace Aardvark.Base.FSharp.Tests
-#nowarn "44"
-
-open System
-open Aardvark.Base
-open FsUnit
-open NUnit.Framework
-
-module ``Time tests`` =
-
- let createTimesAfter (r : Time) (n : int) =
- let mutable current = r
- let mutable l = []
- for i in 1..n do
- current <- Time.after current
- l <- current::l
-
- l |> List.rev
-
- let checkTime (r : Time) (l : list) =
- for i in 0..r.Count-1 do
- match r |> Time.nth i with
- | Some t ->
- if List.nth l i <> t then
- failwithf "different at index: %A" i
- | None ->
- failwithf "could not get time for index: %A" i
-
- []
- let ``[Time] indexing test``() =
-
- let r = Time.newRoot()
- r |> Time.nth 0 |> should equal (Some r)
- r |> Time.nth 1 |> should equal None
- r |> Time.nth -1 |> should equal None
-
-
- // create 100 times
- let times = createTimesAfter r 100
-
- // the count should include the root time
- r.Count |> should equal 101
-
- let all = r::times
-
- // lookups should yield correct times
- all |> checkTime r
-
- // after deleting times the lookups should still be
- // consistent
- let random = Random()
- let newTimes =
- times |> List.filter (fun t ->
- if random.NextDouble() < 0.5 then
- Time.delete t
- false
- else
- true
- )
-
- let all = r::newTimes
- all |> List.length |> should equal r.Count
- all |> checkTime r
-
- []
- let ``[Time] delete all``() =
- let r = Time.newRoot()
- let someTimes = createTimesAfter r 100
-
-
- Time.deleteAll r
-
- r.Count |> should equal 1
- r.Next |> should equal r
- r.Prev |> should equal r
- r.Representant |> should equal r
- r.Time |> should equal 0UL
- r |> Time.nth 0 |> should equal (Some r)
- r |> Time.nth 1 |> should equal None
- r |> Time.nth -1 |> should equal None
-
- let ``[Time] insert order test``() =
- let r = Time.newRoot()
-
- let t0 = Time.after r
- let t1 = Time.after t0
- let t2 = Time.after t1
-
- r.Next |> should equal t0
- t0.Next |> should equal t1
- t1.Next |> should equal t2
- t2.Next |> should equal r
-
- r.Prev |> should equal t2
- t2.Prev |> should equal t1
- t1.Prev |> should equal t0
- t0.Prev |> should equal r
-
-
- r |> should be (lessThan t0)
- t0 |> should be (lessThan t1)
- t1 |> should be (lessThan t2)
-
- let ``[Time] delete test``() =
- let r = Time.newRoot()
- let t0 = Time.after r
- let t1 = Time.after t0
- let t2 = Time.after t1
-
- Time.delete t1
- let mutable failed = false
- try
- compare t1 r |> ignore
- with _ ->
- failed <- true
-
- if not failed then failwith "compare should not work on deleted time"
- t0.Next |> should equal t2
- t2.Prev |> should equal t0
-
- r.[0] |> should equal r
- r.[1] |> should equal t0
- r.[2] |> should equal t2
-
- []
- let ``[MicroTime] special values tests``() =
- MicroTime(infinity) |> should equal MicroTime.PositiveInfinity
- MicroTime(-infinity) |> should equal MicroTime.NegativeInfinity
- MicroTime(nan) |> should equal MicroTime.NegativeInfinity
-
- MicroTime.PositiveInfinity * 3 |> should equal MicroTime.PositiveInfinity
- MicroTime.PositiveInfinity * 3.0 |> should equal MicroTime.PositiveInfinity
- MicroTime.NegativeInfinity * 3 |> should equal MicroTime.NegativeInfinity
- MicroTime.NegativeInfinity * 3.0 |> should equal MicroTime.NegativeInfinity
-
- MicroTime.PositiveInfinity * -3 |> should equal MicroTime.NegativeInfinity
- MicroTime.PositiveInfinity * -3.0 |> should equal MicroTime.NegativeInfinity
- MicroTime.NegativeInfinity * -3 |> should equal MicroTime.PositiveInfinity
- MicroTime.NegativeInfinity * -3.0 |> should equal MicroTime.PositiveInfinity
-
- MicroTime.PositiveInfinity * 0 |> should equal MicroTime.NegativeInfinity
- MicroTime.PositiveInfinity * 0.0 |> should equal MicroTime.NegativeInfinity
- MicroTime.NegativeInfinity * 0 |> should equal MicroTime.NegativeInfinity
- MicroTime.NegativeInfinity * 0.0 |> should equal MicroTime.NegativeInfinity
-
- MicroTime(3L) * infinity |> should equal MicroTime.PositiveInfinity
- MicroTime(3L) * -infinity |> should equal MicroTime.NegativeInfinity
-
- MicroTime(-3L) * infinity |> should equal MicroTime.NegativeInfinity
- MicroTime(-3L) * -infinity |> should equal MicroTime.PositiveInfinity
-
- MicroTime.Zero * infinity |> should equal MicroTime.NegativeInfinity
- MicroTime.Zero * -infinity |> should equal MicroTime.NegativeInfinity
-
- MicroTime.PositiveInfinity / 3 |> should equal MicroTime.PositiveInfinity
- MicroTime.PositiveInfinity / 3.0 |> should equal MicroTime.PositiveInfinity
- MicroTime.NegativeInfinity / 3 |> should equal MicroTime.NegativeInfinity
- MicroTime.NegativeInfinity / 3.0 |> should equal MicroTime.NegativeInfinity
-
- MicroTime.PositiveInfinity / -3 |> should equal MicroTime.NegativeInfinity
- MicroTime.PositiveInfinity / -3.0 |> should equal MicroTime.NegativeInfinity
- MicroTime.NegativeInfinity / -3 |> should equal MicroTime.PositiveInfinity
- MicroTime.NegativeInfinity / -3.0 |> should equal MicroTime.PositiveInfinity
-
- ()
-
-
-
diff --git a/src/Tests/Aardvark.Base.Runtime.Tests/Aardvark.Base.Runtime.Tests.fsproj b/src/Tests/Aardvark.Base.Runtime.Tests/Aardvark.Base.Runtime.Tests.fsproj
index dffd378b4..2479adbaf 100644
--- a/src/Tests/Aardvark.Base.Runtime.Tests/Aardvark.Base.Runtime.Tests.fsproj
+++ b/src/Tests/Aardvark.Base.Runtime.Tests/Aardvark.Base.Runtime.Tests.fsproj
@@ -16,7 +16,6 @@
$(OutputPath)\net8.0
-
diff --git a/src/Tests/Aardvark.Base.Runtime.Tests/DynamicCode.fs b/src/Tests/Aardvark.Base.Runtime.Tests/DynamicCode.fs
deleted file mode 100644
index 1a365f642..000000000
--- a/src/Tests/Aardvark.Base.Runtime.Tests/DynamicCode.fs
+++ /dev/null
@@ -1,437 +0,0 @@
-namespace Aardvark.Base.Runtime.Tests
-
-
-open System
-open System.Threading
-open System.Threading.Tasks
-open System.Collections.Generic
-open Aardvark.Base
-open Aardvark.Base.Runtime
-open NUnit.Framework
-open FsUnit
-open FSharp.Data.Adaptive
-
-#nowarn "44"
-
-module DynamicCodeTests =
-
- type TestProgram<'i, 'a>(program : IAdaptiveProgram<'i>, getCalls : unit -> list<'a>) =
- inherit AdaptiveObject()
-
- member x.NativeCallCount = program.NativeCallCount
- member x.FragmentCount = program.FragmentCount
- member x.TotalJumpDistanceInBytes = program.TotalJumpDistanceInBytes
- member x.ProgramSizeInBytes = program.ProgramSizeInBytes
-
- member x.Disassemble() = program.Disassemble() |> unbox
-
- member x.AutoDefragmentation
- with get() = program.AutoDefragmentation
- and set d = program.AutoDefragmentation <- d
-
-
- member x.StartDefragmentation() =
- program.StartDefragmentation()
-
- member x.Update(token : AdaptiveToken) =
- x.EvaluateAlways token (fun token ->
- program.Update token
- )
-
- member x.Run i =
- let token = AdaptiveToken.Top
- x.EvaluateAlways token (fun token ->
- program.Update(token) |> ignore
- )
- program.Run i
- getCalls()
-
- member x.Dispose() =
- getCalls() |> ignore
- program.Dispose()
-
- interface IDisposable with
- member x.Dispose() = x.Dispose()
-
- type TestStruct =
- struct
- val mutable public Handle : int64
-
- override x.ToString() = sprintf "S%d" x.Handle
-
- new(h : int) = { Handle = int64 h }
- end
-
- []
- module TestProgram =
- open System.Runtime.InteropServices
- open System.Linq
-
- type private AppendDelegate = delegate of int * int -> unit
- type private AppendFDelegate = delegate of float32 * float32 -> unit
- let private calls = new ThreadLocal>(fun () -> List())
- let private callsF = new ThreadLocal>(fun () -> List())
-
- let private append (arg0 : int) (arg1 : int) =
- calls.Value.Add(arg0, arg1)
-
- let private appendF (arg0 : float32) (arg1 : float32) =
- callsF.Value.Add(arg0, arg1)
-
- let private dAppend = AppendDelegate append
- let private pAppend = Marshal.GetFunctionPointerForDelegate dAppend
-
- let private dAppendF = AppendFDelegate appendF
- let private pAppendF = Marshal.GetFunctionPointerForDelegate dAppendF
-
- let private getCalls() =
- let arr = calls.Value.ToArray()
- calls.Value.Clear()
- arr |> Array.toList
-
- let private getCallsF() =
- let arr = callsF.Value.ToArray()
- callsF.Value.Clear()
- arr |> Array.toList
-
- let private getCallsSelf() =
- let arr = calls.Value.ToArray()
- calls.Value.Clear()
- arr |> Array.toList |> List.map snd
-
- let private getCallsSelfF() =
- let arr = callsF.Value.ToArray()
- callsF.Value.Clear()
- arr |> Array.toList |> List.map snd
-
- let create (input : aset<'k * int>) =
- let compileDelta (l : Option) (r : int) =
- let l = match l with | Some l -> l | None -> 0
-
- new AdaptiveCode<_>([AVal.constant [pAppend, [|l :> obj; r :> obj|]]]) :> IAdaptiveCode<_>
-
- let program =
- input |> AdaptiveProgram.nativeDifferential 6 Comparer.Default compileDelta
-
- program.AutoDefragmentation <- false
-
- new TestProgram<_,_>(program, getCalls)
-
- let createMod (input : aset<'k * aval>) =
- let compileDelta (l : Option>) (r : aval) =
- let l = match l with | Some l -> l | None -> AVal.constant 0
- let call = AVal.map2 (fun l r -> [pAppend, [|l :> obj; r :> obj|]]) l r
- new AdaptiveCode<_>([call]) :> IAdaptiveCode<_>
-
- let program =
- input |> AdaptiveProgram.nativeDifferential 6 Comparer.Default compileDelta
- program.AutoDefragmentation <- false
-
- new TestProgram<_,_>(program, getCalls)
-
- let createSimple (input : aset) =
- let compile (r : int) =
- new AdaptiveCode<_>([AVal.constant [pAppend, [|r :> obj; r :> obj|]]]) :> IAdaptiveCode<_>
-
- let program =
- input
- |> ASet.map (fun i -> i,i)
- |> AdaptiveProgram.nativeSimple 6 Comparer.Default compile
-
- program.AutoDefragmentation <- false
-
- new TestProgram<_,_>(program, getCallsSelf)
-
- let createSimpleFloat (input : aset) =
- let compileDelta (l : Option) (r : float32) =
- let l = match l with | Some l -> l | None -> 0.0f
-
- new AdaptiveCode<_>([AVal.constant [pAppendF, [|l :> obj; r :> obj|]]]) :> IAdaptiveCode<_>
-
- let program =
- input |> ASet.map (fun i -> i,i) |> AdaptiveProgram.nativeDifferential 6 Comparer.Default compileDelta
-
- program.AutoDefragmentation <- false
-
- new TestProgram<_,_>(program, getCallsSelfF)
-
-
-
- let createDynamic (input : aset) =
- let compile (r : int) =
- new AdaptiveCode<_>([AVal.constant [pAppend, [|r :> obj|]]]) :> IAdaptiveCode<_>
-
- let program =
- input |> ASet.map (fun i -> i,i) |> AdaptiveProgram.nativeSimple 6 Comparer.Default compile
-
- program.AutoDefragmentation <- false
-
- new TestProgram(program, getCalls)
-
- let testF(a : int) (b : int) (c : int) (d : int) (e : int) =
- sprintf "(%A,%A,%A,%A,%A)" a b c d e |> Console.WriteLine
-
- type TestDel = delegate of int * int * int * int * int -> unit
- type SimpleDel = delegate of int -> unit
- let dTest = TestDel testF
- let pTest = System.Runtime.InteropServices.Marshal.GetFunctionPointerForDelegate(dTest)
-
- let simpleOut = List()
- let dSimple = SimpleDel (fun v -> printfn "%d" v; simpleOut.Add v)
- let pSimple = System.Runtime.InteropServices.Marshal.GetFunctionPointerForDelegate(dSimple)
-
-
-
- []
- let ``[DynamicCode] imperative``() =
- use prog = new ChangeableNativeProgram((fun i s -> s.BeginCall(1); s.PushArg(i); s.Call(pSimple); 0), 0, (fun a b -> a + b), (fun a b -> a - b))
-
- let run() =
- simpleOut.Clear()
- prog.Run()
- let res = simpleOut |> Seq.toList
- simpleOut.Clear()
- res
-
- run() |> should be Empty
-
- prog.Add(1) |> ignore
- run() |> should equal [1]
-
- prog.Add(2) |> ignore
- run() |> should equal [1;2]
-
- prog.Remove(1) |> ignore
- run() |> should equal [2]
-
- prog.Remove(2) |> ignore
- run() |> should be Empty
-
- prog.Clear()
- run() |> should be Empty
-
-
- ()
-
- []
- let ``[DynamicCode] lots of args``() =
- let input = cset [1,1]
- let prog =
- AdaptiveProgram.nativeSimple
- 6 Comparer.Default
- (fun a -> new AdaptiveCode<_>([AVal.constant [pTest, [|2 :> obj; 3 :> obj; 4 :> obj; 5 :> obj|]]]) :> IAdaptiveCode<_>)
- input
-
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.Run(1)
-
- ()
-
- []
- let ``[DynamicCode] add/remove/clear``() =
-
- let calls = cset [1,1; 2,2]
-
- use prog = TestProgram.create calls
-
- // test initial execution
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.NativeCallCount |> should equal 2
- prog.FragmentCount |> should equal 2
-
- prog.Run() |> should equal [0,1; 1,2]
-
-
- // test addition at end
- transact (fun () ->
- calls.Add (3,3) |> ignore
- )
-
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.NativeCallCount |> should equal 3
- prog.FragmentCount |> should equal 3
-
- prog.Run() |> should equal [0,1; 1,2; 2,3]
-
-
-
- // test removal at end
- transact (fun () ->
- calls.ExceptWith [(2,2); (3,3)]
- )
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.NativeCallCount |> should equal 1
- prog.FragmentCount |> should equal 1
-
- prog.Run() |> should equal [0,1]
-
-
-
- // test duplicate key stability
- transact (fun () ->
- calls.Add (1,2) |> ignore
- )
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.NativeCallCount |> should equal 2
- prog.FragmentCount |> should equal 2
-
- prog.Run() |> should equal [0,1; 1,2]
-
-
- // test removal at front
- transact (fun () ->
- calls.Remove (1,1) |> ignore
- )
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.NativeCallCount |> should equal 1
- prog.FragmentCount |> should equal 1
-
- prog.Run() |> should equal [0,2]
-
- // test addition at front
- transact (fun () ->
- calls.Add (0,1) |> ignore
- )
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.NativeCallCount |> should equal 2
- prog.FragmentCount |> should equal 2
-
- prog.Run() |> should equal [0,1;1,2]
-
- // test clear
- transact (fun () ->
- calls.Clear()
- )
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.NativeCallCount |> should equal 0
- prog.FragmentCount |> should equal 0
-
- prog.Run() |> should be Empty
- ()
-
- []
- let ``[DynamicCode] changes``() =
-
- let v1 = cval 1
- let v2 = cval 2
- let v3 = cval 3
-
- let input = cset [1, v1 :> aval<_>; 2, v2 :> aval<_>; 3, v3 :> aval<_>]
- use prog = TestProgram.createMod input
-
-
- prog.Run() |> should equal [0,1; 1,2; 2,3]
-
- transact (fun () -> v1.Value <- 4)
- prog.Run() |> should equal [0,4; 4,2; 2,3]
-
-
- transact (fun () -> v2.Value <- 3)
- prog.Run() |> should equal [0,4; 4,3; 3,3]
-
- transact (fun () -> v3.Value <- 2)
- prog.Run() |> should equal [0,4; 4,3; 3,2]
-
-
- transact (fun () -> input.Remove(1,v1 :> aval<_>)) |> should be True
- prog.Run() |> should equal [0,3; 3,2]
-
- prog.StartDefragmentation().Wait()
-
-
- []
- let ``[DynamicCode] defragmentation``() =
-
- let calls = cset [1..1000]
- use prog = TestProgram.createSimple calls
-
- // create some fragmentation
- prog.Update(AdaptiveToken.Top) |> ignore
- transact (fun () ->
- calls.ExceptWith [100..200]
- )
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.TotalJumpDistanceInBytes |> should not' (equal 0L)
-
-
- //defragment and check
- prog.StartDefragmentation().Wait()
- prog.TotalJumpDistanceInBytes |> should equal 0L
- prog.Run() |> should equal ([1..99] @ [201..1000])
-
-
- // re-add the removed calls and check defragment/run
- transact (fun () ->
- calls.UnionWith [100..200]
- )
- prog.Update(AdaptiveToken.Top) |> ignore
- prog.TotalJumpDistanceInBytes |> should not' (equal 0L)
- prog.StartDefragmentation().Wait()
- prog.TotalJumpDistanceInBytes |> should equal 0L
- prog.Run() |> should equal ([1..1000])
-
-
- ()
-
-
- []
- let ``[DynamicCode] dynamic arguments``() =
-
- let calls = cset [1]
- use prog = TestProgram.createDynamic calls
-
- prog.Run (TestStruct 5) |> should equal [5,1]
- prog.Run (TestStruct 7) |> should equal [7,1]
-
- transact (fun () -> calls.Add 2 |> ignore)
- prog.Run (TestStruct 5) |> should equal [5,1; 5,2]
-
-
- transact (fun () -> calls.Add 3 |> ignore)
- prog.Run (TestStruct 20) |> should equal [20,1; 20,2; 20,3]
-
-
- transact (fun () -> calls.Clear())
- prog.Run (TestStruct 20) |> should be Empty
-
-
- ()
-
-
- []
- let ``[DynamicCode] float arguments``() =
- let calls = cset [1.0f; 2.0f]
- use prog = TestProgram.createSimpleFloat calls
-
- prog.Update(AdaptiveToken.Top) |> ignore
- let res = prog.Run()
- res |> should equal [1.0f; 2.0f]
-
-
-
- []
- let ``[DynamicCode] huge changeset``() =
-
- let cnt = 250000
- let manyCalls = List.init cnt (fun i -> i, i+1)
-
- let calls = cset manyCalls
-
- use prog = TestProgram.create calls
-
- let sw = System.Diagnostics.Stopwatch()
- sw.Start()
- let stats = prog.Update(AdaptiveToken.Top)
- prog.NativeCallCount |> ignore
- prog.FragmentCount |> ignore
- sw.Stop()
- printfn "stats: %A" stats
- printfn "update took: %As" sw.Elapsed.TotalSeconds
- sw.Restart()
-
- prog.Run() |> ignore
-
- sw.Stop()
- printfn "run took: %As" sw.Elapsed.TotalSeconds
-
-