diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs index c34492dc..9aa375d6 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs @@ -9,7 +9,6 @@ open GraphBLAS.FSharp.IO open GraphBLAS.FSharp.Benchmarks open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ArraysExtensions -open GraphBLAS.FSharp.Objects.MailboxProcessorExtensions open GraphBLAS.FSharp.Backend.Quotes [] @@ -41,7 +40,7 @@ type Benchmarks<'elem when 'elem : struct>( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + //p.Error.Add(fun e -> failwithf "%A" e) p static member AvailableContexts = Utils.availableContexts @@ -70,7 +69,7 @@ type Benchmarks<'elem when 'elem : struct>( this.ResultLevels <- this.FunToBenchmark this.Processor matrix vertex member this.ClearInputMatrix() = - matrix.Dispose this.Processor + matrix.Dispose() member this.ClearResult() = match this.ResultLevels with @@ -114,12 +113,12 @@ type WithoutTransferBenchmark<'elem when 'elem : struct>( override this.GlobalSetup() = this.ReadMatrix() this.LoadMatrixToGPU() - finish this.Processor + this.Processor.Synchronize() [] override this.IterationCleanup() = this.ClearResult() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup() = @@ -128,7 +127,7 @@ type WithoutTransferBenchmark<'elem when 'elem : struct>( [] override this.Benchmark() = this.BFS() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() type BFSWithoutTransferBenchmarkBool() = @@ -183,7 +182,7 @@ type WithTransferBenchmark<'elem when 'elem : struct>( [] override this.GlobalSetup() = this.ReadMatrix() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup() = @@ -193,7 +192,7 @@ type WithTransferBenchmark<'elem when 'elem : struct>( override this.IterationCleanup() = this.ClearInputMatrix() this.ClearResult() - finish this.Processor + this.Processor.Synchronize() [] override this.Benchmark() = @@ -202,7 +201,7 @@ type WithTransferBenchmark<'elem when 'elem : struct>( match this.ResultLevels with | ClVector.Dense result -> result.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() | _ -> failwith "Impossible" type BFSWithTransferBenchmarkBool() = diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/PageRank.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/PageRank.fs index c00c5f70..dfd98a89 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/PageRank.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/PageRank.fs @@ -7,7 +7,6 @@ open GraphBLAS.FSharp.IO open Brahma.FSharp open Microsoft.FSharp.Core open GraphBLAS.FSharp.Objects.ArraysExtensions -open GraphBLAS.FSharp.Objects.MailboxProcessorExtensions open GraphBLAS.FSharp.Benchmarks open GraphBLAS.FSharp.Objects @@ -40,7 +39,7 @@ type Benchmarks( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + //p.Error.Add(fun e -> failwithf "%A" e) p static member AvailableContexts = Utils.availableContexts @@ -69,12 +68,12 @@ type Benchmarks( this.Result <- this.FunToBenchmark this.Processor matrixPrepared Constants.PageRank.accuracy member this.ClearInputMatrix() = - matrix.Dispose this.Processor + matrix.Dispose() member this.ClearPreparedMatrix() = - matrixPrepared.Dispose this.Processor + matrixPrepared.Dispose() - member this.ClearResult() = this.Result.Dispose this.Processor + member this.ClearResult() = this.Result.Dispose() member this.ReadMatrix() = let converter = @@ -113,15 +112,15 @@ type PageRankWithoutTransferBenchmarkFloat32() = override this.GlobalSetup() = this.ReadMatrix() this.LoadMatrixToGPU() - finish this.Processor + this.Processor.Synchronize() this.PrepareMatrix() this.ClearInputMatrix() - finish this.Processor + this.Processor.Synchronize() [] override this.IterationCleanup() = this.ClearResult() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup() = @@ -130,4 +129,4 @@ type PageRankWithoutTransferBenchmarkFloat32() = [] override this.Benchmark() = this.PageRank() - finish this.Processor + this.Processor.Synchronize() diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/BFSBenchmarks.txt b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/BFSBenchmarks.txt index ff803830..b282136e 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/BFSBenchmarks.txt +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/BFSBenchmarks.txt @@ -1,4 +1,7 @@ wing.mtx coAuthorsCiteseer.mtx -hollywood-2009.mtx -roadNet-CA.mtx \ No newline at end of file +!hollywood-2009.mtx +roadNet-CA.mtx +belgium_osm.mtx +road_central.mtx +coPapersDBLP.mtx \ No newline at end of file diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj index 1ab92795..0ccc2f46 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj @@ -1,4 +1,4 @@ - + Exe @@ -25,9 +25,9 @@ - + - + \ No newline at end of file diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs index 0867e214..f23a8c08 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs @@ -15,7 +15,7 @@ open Expecto module Utils = type BenchmarkContext = { ClContext: Brahma.FSharp.ClContext - Queue: MailboxProcessor } + Queue: RawCommandQueue } let getMatricesFilenames configFilename = let getFullPathToConfig filename = @@ -103,9 +103,11 @@ module Utils = let context = Brahma.FSharp.ClContext(device, translator) - let queue = context.QueueProvider.CreateQueue() + let queue = + RawCommandQueue(context.ClDevice.Device, context.Context, context.Translator) { ClContext = context; Queue = queue }) + seq { for wgSize in workGroupSizes do for context in contexts do @@ -119,13 +121,14 @@ module Utils = let normalFloatGenerator = (Arb.Default.NormalFloat() - |> Arb.toGen - |> Gen.map float) + |> Arb.toGen + |> Gen.map float) - let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x.Equals y + let fIsEqual x y = + abs (x - y) < Accuracy.medium.absolute + || x.Equals y - let nextInt (random: System.Random) = - random.Next() + let nextInt (random: System.Random) = random.Next() module VectorGenerator = let private pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) createVector = @@ -144,8 +147,10 @@ module VectorGenerator = |> pairOfVectorsOfEqualSize Arb.generate let floatPair format = - let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x = y + let fIsEqual x y = + abs (x - y) < Accuracy.medium.absolute || x = y - let createVector array = Utils.createVectorFromArray format array (fIsEqual 0.0) + let createVector array = + Utils.createVectorFromArray format array (fIsEqual 0.0) pairOfVectorsOfEqualSize Utils.normalFloatGenerator createVector diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs index 190369f5..34446811 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs @@ -8,7 +8,6 @@ open GraphBLAS.FSharp.IO open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions -open GraphBLAS.FSharp.Objects.MailboxProcessorExtensions open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Benchmarks @@ -41,7 +40,7 @@ type Benchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : st member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + //p.Error.Add(fun e -> failwithf "%A" e) p static member AvailableContexts = Utils.availableContexts @@ -80,11 +79,11 @@ type Benchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : st this.ResultMatrix <- this.FunToBenchmark this.Processor HostInterop firstMatrix secondMatrix member this.ClearInputMatrices() = - firstMatrix.Dispose this.Processor - secondMatrix.Dispose this.Processor + firstMatrix.Dispose() + secondMatrix.Dispose() member this.ClearResult() = - this.ResultMatrix.Dispose this.Processor + this.ResultMatrix.Dispose() member this.ReadMatrices() = firstMatrixHost <- this.ReadMatrix <| fst this.InputMatrixReader @@ -119,12 +118,12 @@ module WithoutTransfer = override this.GlobalSetup() = this.ReadMatrices () this.LoadMatricesToGPU () - finish this.Processor + this.Processor.Synchronize() [] override this.Benchmark () = this.EWiseAddition() - finish this.Processor + this.Processor.Synchronize() [] override this.IterationCleanup () = @@ -252,7 +251,7 @@ module WithTransfer = [] override this.GlobalSetup() = this.ReadMatrices() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup() = () @@ -261,16 +260,15 @@ module WithTransfer = override this.IterationCleanup() = this.ClearInputMatrices() this.ClearResult() - finish this.Processor + this.Processor.Synchronize() [] override this.Benchmark() = this.LoadMatricesToGPU() this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() resultToHost this.ResultMatrix this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe - + this.Processor.Synchronize() module COO = type Float32() = diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs index d379739c..db0125e3 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs @@ -8,7 +8,6 @@ open GraphBLAS.FSharp.IO open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions -open GraphBLAS.FSharp.Objects.MailboxProcessorExtensions open GraphBLAS.FSharp.Benchmarks [] @@ -40,7 +39,7 @@ type Benchmarks<'elem when 'elem : struct>( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + //p.Error.Add(fun e -> failwithf "%A" e) p static member AvailableContexts = Utils.availableContexts @@ -78,11 +77,11 @@ type Benchmarks<'elem when 'elem : struct>( this.ResultMatrix <- this.FunToBenchmark this.Processor DeviceOnly matrix matrix member this.ClearInputMatrices() = - matrix.Dispose this.Processor + matrix.Dispose() member this.ClearResult() = match this.ResultMatrix with - | Some matrix -> matrix.Dispose this.Processor + | Some matrix -> matrix.Dispose() | None -> () member this.ReadMatrices() = @@ -116,17 +115,17 @@ module WithoutTransfer = override this.GlobalSetup() = this.ReadMatrices() this.LoadMatricesToGPU() - finish this.Processor + this.Processor.Synchronize() [] override this.Benchmark() = this.Mxm() - finish this.Processor + this.Processor.Synchronize() [] override this.IterationCleanup () = this.ClearResult() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup () = diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs index 18ff0b22..3cfd844e 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs @@ -8,7 +8,6 @@ open Brahma.FSharp open GraphBLAS.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions -open GraphBLAS.FSharp.Objects.MailboxProcessorExtensions open GraphBLAS.FSharp.Benchmarks [] @@ -46,7 +45,7 @@ type Masked<'elem when 'elem : struct>( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + //p.Error.Add(fun e -> failwithf "%A" e) p static member AvaliableContexts = Utils.availableContexts @@ -101,12 +100,12 @@ type Masked<'elem when 'elem : struct>( this.ResultMatrix <- this.FunToBenchmark this.Processor firstMatrix secondMatrix mask member this.ClearInputMatrices() = - firstMatrix.Dispose this.Processor - secondMatrix.Dispose this.Processor - mask.Dispose this.Processor + firstMatrix.Dispose() + secondMatrix.Dispose() + mask.Dispose() member this.ClearResult() = - this.ResultMatrix.Dispose this.Processor + this.ResultMatrix.Dispose() member this.ReadMask(maskReader) = maskHost <- Matrix.COO <| this.ReadMatrix maskReader @@ -153,17 +152,17 @@ type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( this.ReadMatrices () this.LoadMatricesToGPU () this.ConvertSecondMatrixToCSC() - finish this.Processor + this.Processor.Synchronize() [] override this.Benchmark () = this.Mxm() - finish this.Processor + this.Processor.Synchronize() [] override this.IterationCleanup () = this.ClearResult() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup () = @@ -185,20 +184,20 @@ type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( override this.GlobalSetup() = this.ReadMatrices() this.LoadMatricesToGPU () - finish this.Processor + this.Processor.Synchronize() [] override this.Benchmark() = this.ConvertSecondMatrixToCSC() this.Mxm() - finish this.Processor + this.Processor.Synchronize() [] override this.IterationCleanup() = this.ClearResult() this.ConvertSecondMatrixToCSR() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup() = diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs index 9d78980b..92daae68 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs @@ -10,7 +10,6 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions -open GraphBLAS.FSharp.Objects.MailboxProcessorExtensions [] [] @@ -41,7 +40,7 @@ type Benchmarks<'elem when 'elem : struct>( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf $"%A{e}") + //p.Error.Add(fun e -> failwithf $"%A{e}") p static member AvailableContexts = Utils.availableContexts @@ -64,12 +63,12 @@ type Benchmarks<'elem when 'elem : struct>( | ex -> raise ex member this.ClearInputVectors()= - firstVector.Dispose this.Processor - secondVector.Dispose this.Processor + firstVector.Dispose() + secondVector.Dispose() member this.ClearResult() = match this.ResultVector with - | Some v -> v.Dispose this.Processor + | Some v -> v.Dispose() | None -> () member this.CreateVectors() = @@ -105,18 +104,18 @@ module WithoutTransfer = override this.IterationSetup() = this.CreateVectors() this.LoadVectorsToGPU() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() [] override this.Benchmark() = this.Map2() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() [] override this.IterationCleanup() = this.ClearResult() this.ClearInputVectors() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup() = () @@ -161,7 +160,7 @@ module WithTransfer = [] override this.IterationSetup() = this.CreateVectors() - finish this.Processor + this.Processor.Synchronize() [] override this.Benchmark () = @@ -170,7 +169,7 @@ module WithTransfer = match this.ResultVector with | Some v -> v.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() | None -> () @@ -178,7 +177,7 @@ module WithTransfer = override this.IterationCleanup () = this.ClearInputVectors() this.ClearResult() - finish this.Processor + this.Processor.Synchronize() [] override this.GlobalCleanup() = () diff --git a/paket.dependencies b/paket.dependencies index a434e23e..41db4390 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -16,7 +16,7 @@ nuget System.CodeDom >= 7.0 nuget FSharp.Quotations.Evaluator 2.1.0 nuget FSharpx.Collections >= 3.1 nuget FSharpx.Text.StructuredFormat >= 3.1 -nuget Brahma.FSharp 2.0.5 +nuget Brahma.FSharp 3.0.0-alpha1.5 nuget BenchmarkDotNet nuget MathNet.Numerics.FSharp 4.0.0 nuget MathNet.Numerics.MKL.Win-x64 2.5.0 @@ -59,4 +59,4 @@ group Docs group Analyzers source https://www.nuget.org/api/v2 source https://api.nuget.org/v3/index.json - nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2 \ No newline at end of file + nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2 diff --git a/paket.lock b/paket.lock index 7cae92f5..9f567142 100644 --- a/paket.lock +++ b/paket.lock @@ -19,26 +19,26 @@ NUGET System.Reflection.Emit.Lightweight (>= 4.7) - restriction: && (< net6.0) (>= netstandard2.0) System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: && (< net6.0) (>= netstandard2.0) BenchmarkDotNet.Annotations (0.13.9) - restriction: >= netstandard2.0 - Brahma.FSharp (2.0.5) - Brahma.FSharp.OpenCL.Printer (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Shared (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Translator (>= 2.0.5) - restriction: >= net7.0 + Brahma.FSharp (3.0.0-alpha1.5) + Brahma.FSharp.OpenCL.Printer (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Shared (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Translator (>= 3.0.0-alpha1.5) - restriction: >= net7.0 FSharp.Core (7.0) - restriction: >= net7.0 FSharp.Quotations.Evaluator (>= 2.1) - restriction: >= net7.0 - YC.OpenCL.NET (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.AST (2.0.5) - restriction: >= net7.0 + YC.OpenCL.NET (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.AST (3.0.0-alpha1.5) - restriction: >= net7.0 FSharp.Core (7.0) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Printer (2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.AST (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Translator (>= 2.0.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Printer (3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.AST (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Translator (>= 3.0.0-alpha1.5) - restriction: >= net7.0 FSharp.Core (7.0) - restriction: >= net7.0 FSharpx.Collections (>= 3.1) - restriction: >= net7.0 FSharpx.Text.StructuredFormat (>= 3.1) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Shared (2.0.5) - restriction: >= net7.0 - YC.OpenCL.NET (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Translator (2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.AST (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Shared (>= 2.0.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Shared (3.0.0-alpha1.5) - restriction: >= net7.0 + YC.OpenCL.NET (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Translator (3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.AST (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Shared (>= 3.0.0-alpha1.5) - restriction: >= net7.0 FSharp.Core (7.0) - restriction: >= net7.0 FSharp.Quotations.Evaluator (>= 2.1) - restriction: >= net7.0 FSharpx.Collections (>= 3.1) - restriction: >= net7.0 diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs index 3215f298..2c2e3011 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs @@ -34,7 +34,7 @@ module internal BFS = let containsNonZero = Vector.exists Predicates.isSome clContext workGroupSize - fun (queue: MailboxProcessor) (matrix: ClMatrix) (source: int) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix) (source: int) -> let vertexCount = matrix.RowCount let levels = @@ -62,7 +62,7 @@ module internal BFS = not <| (containsNonZero queue front).ToHostAndFree queue - front.Dispose queue + front.Dispose() levels @@ -87,7 +87,7 @@ module internal BFS = let fillSubVectorTo = Vector.assignByMaskInPlace Mask.assign clContext workGroupSize - fun (queue: MailboxProcessor) (matrix: ClMatrix) (source: int) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix) (source: int) -> let vertexCount = matrix.RowCount let levels = @@ -108,18 +108,18 @@ module internal BFS = //Getting new frontier match spMSpV queue matrix front with | None -> - front.Dispose queue + front.Dispose() stop <- true | Some newFrontier -> - front.Dispose queue + front.Dispose() //Filtering visited vertices match maskComplemented queue DeviceOnly newFrontier levels with | None -> stop <- true - newFrontier.Dispose queue + newFrontier.Dispose() | Some f -> front <- f - newFrontier.Dispose queue + newFrontier.Dispose() levels @@ -159,17 +159,17 @@ module internal BFS = ClArray.count Predicates.isSome clContext workGroupSize //Push or pull functions - let getNNZ (queue: MailboxProcessor) (v: ClVector) = + let getNNZ (queue: RawCommandQueue) (v: ClVector) = match v with | ClVector.Sparse v -> v.NNZ | ClVector.Dense v -> countNNZ queue v - let SPARSITY = 0.001f + let SPARSITY = 0.05f let push nnz size = (float32 nnz) / (float32 size) <= SPARSITY - fun (queue: MailboxProcessor) (matrix: ClMatrix) (source: int) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix) (source: int) -> let vertexCount = matrix.RowCount let levels = @@ -192,17 +192,17 @@ module internal BFS = //Getting new frontier match spMSpV queue matrix frontier with | None -> - frontier.Dispose queue + frontier.Dispose() stop <- true | Some newFrontier -> - frontier.Dispose queue + frontier.Dispose() //Filtering visited vertices match maskComplemented queue DeviceOnly newFrontier levels with | None -> stop <- true - newFrontier.Dispose queue + newFrontier.Dispose() | Some newMaskedFrontier -> - newFrontier.Dispose queue + newFrontier.Dispose() //Push/pull let NNZ = getNNZ queue newMaskedFrontier @@ -211,7 +211,7 @@ module internal BFS = frontier <- newMaskedFrontier else frontier <- toDense queue DeviceOnly newMaskedFrontier - newMaskedFrontier.Dispose queue + newMaskedFrontier.Dispose() | ClVector.Dense oldFrontier -> //Getting new frontier spMVInPlace queue matrix frontier frontier @@ -227,8 +227,8 @@ module internal BFS = if not stop then if (push NNZ frontier.Size) then frontier <- toSparse queue DeviceOnly frontier - oldFrontier.Free queue + oldFrontier.Free() else - frontier.Dispose queue + frontier.Dispose() levels diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs index b7c82e6a..4a1c8522 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs @@ -20,7 +20,7 @@ module internal MSBFS = ClArray.mapInPlace ArithmeticOperations.intNotQ clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize + Common.PrefixSum.standardExcludeInPlace clContext workGroupSize let scatterIndices = Scatter.lastOccurrence clContext workGroupSize @@ -28,7 +28,7 @@ module internal MSBFS = let scatterValues = Scatter.lastOccurrence clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (front: ClMatrix.COO<_>) (intersection: ClArray) -> + fun (queue: RawCommandQueue) allocationMode (front: ClMatrix.COO<_>) (intersection: ClArray) -> invert queue intersection @@ -72,7 +72,7 @@ module internal MSBFS = let findIntersection = Intersect.findKeysIntersection clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (level: int) (front: ClMatrix.COO<_>) (levels: ClMatrix.COO<_>) -> + fun (queue: RawCommandQueue) allocationMode (level: int) (front: ClMatrix.COO<_>) (levels: ClMatrix.COO<_>) -> // Find intersection of levels and front indices. let intersection = @@ -82,7 +82,7 @@ module internal MSBFS = let newFront = updateFront queue allocationMode front intersection - intersection.Free queue + intersection.Free() match newFront with | Some f -> @@ -91,7 +91,7 @@ module internal MSBFS = // Set current level value to all remaining front positions setLevel queue levelClCell 0 f.Values.Length f.Values - levelClCell.Free queue + levelClCell.Free() // Update levels let newLevels = mergeDisjoint queue levels f @@ -114,7 +114,7 @@ module internal MSBFS = let updateFrontAndLevels = updateFrontAndLevels clContext workGroupSize - fun (queue: MailboxProcessor) (matrix: ClMatrix<'a>) (source: int list) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix<'a>) (source: int list) -> let vertexCount = matrix.RowCount let sourceVertexCount = source.Length @@ -138,26 +138,26 @@ module internal MSBFS = //Getting new frontier match spGeMM queue DeviceOnly (ClMatrix.COO front) matrix with | None -> - front.Dispose queue + front.Dispose() stop <- true | Some newFrontier -> - front.Dispose queue + front.Dispose() //Filtering visited vertices match updateFrontAndLevels queue DeviceOnly level newFrontier levels with | l, Some f -> front <- f - levels.Dispose queue + levels.Dispose() levels <- l - newFrontier.Dispose queue + newFrontier.Dispose() | _, None -> stop <- true - newFrontier.Dispose queue + newFrontier.Dispose() ClMatrix.COO levels @@ -173,7 +173,7 @@ module internal MSBFS = let copyIndices = ClArray.copyTo clContext workGroupSize - fun (queue: MailboxProcessor) allocationMode (front: ClMatrix.COO<_>) (parents: ClMatrix.COO<_>) -> + fun (queue: RawCommandQueue) allocationMode (front: ClMatrix.COO<_>) (parents: ClMatrix.COO<_>) -> // Find intersection of levels and front indices. let intersection = @@ -183,7 +183,7 @@ module internal MSBFS = let newFront = frontExclude queue allocationMode front intersection - intersection.Free queue + intersection.Free() match newFront with | Some f -> @@ -208,7 +208,7 @@ module internal MSBFS = let updateFrontAndParents = updateFrontAndParents clContext workGroupSize - fun (queue: MailboxProcessor) (inputMatrix: ClMatrix<'a>) (source: int list) -> + fun (queue: RawCommandQueue) (inputMatrix: ClMatrix<'a>) (source: int list) -> let vertexCount = inputMatrix.RowCount let sourceVertexCount = source.Length @@ -242,24 +242,24 @@ module internal MSBFS = //Getting new frontier match spGeMM queue DeviceOnly (ClMatrix.COO front) matrix with | None -> - front.Dispose queue + front.Dispose() stop <- true | Some newFrontier -> - front.Dispose queue + front.Dispose() //Filtering visited vertices match updateFrontAndParents queue DeviceOnly newFrontier parents with | p, Some f -> front <- f - parents.Dispose queue + parents.Dispose() parents <- p - newFrontier.Dispose queue + newFrontier.Dispose() | _, None -> stop <- true - newFrontier.Dispose queue + newFrontier.Dispose() ClMatrix.COO parents diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fs b/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fs index eecff073..a13d567a 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fs @@ -16,9 +16,9 @@ module PageRank = type PageRankMatrix = | PreparedMatrix of ClMatrix - member this.Dispose(processor: MailboxProcessor) = + member this.Dispose() = match this with - | PreparedMatrix matrix -> matrix.Dispose processor + | PreparedMatrix matrix -> matrix.Dispose() let private countOutDegree (clContext: ClContext) workGroupSize = @@ -38,7 +38,7 @@ module PageRank = let zeroCreate = GraphBLAS.FSharp.ClArray.zeroCreate clContext workGroupSize - fun (queue: MailboxProcessor) (matrix: ClMatrix.CSR) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR) -> let outDegree: ClArray = zeroCreate queue DeviceOnly matrix.ColumnCount @@ -96,7 +96,7 @@ module PageRank = let multiply = clContext.Compile multiply - fun (queue: MailboxProcessor) (matrix: ClMatrix) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix) -> match matrix with | ClMatrix.CSR matrix -> @@ -111,28 +111,18 @@ module PageRank = let ndRange = Range1D.CreateValid(matrix.RowCount * workGroupSize, workGroupSize) - queue.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - matrix.RowCount - matrix.RowPointers - matrix.Values - outDegree - resultValues) - ) + kernel.KernelFunc ndRange matrix.RowCount matrix.RowPointers matrix.Values outDegree resultValues - queue.Post(Msg.CreateRunMsg<_, _> kernel) + queue.RunKernel(kernel) - outDegree.Free queue + outDegree.Free() let newMatrix = { Context = clContext RowCount = matrix.RowCount ColumnCount = matrix.ColumnCount - RowPointers = copy queue DeviceOnly matrix.RowPointers - Columns = copy queue DeviceOnly matrix.Columns + RowPointers = copy queue DeviceOnly matrix.RowPointers matrix.RowPointers.Length + Columns = copy queue DeviceOnly matrix.Columns matrix.Columns.Length Values = resultValues } transposeInPlace queue DeviceOnly newMatrix @@ -162,7 +152,7 @@ module PageRank = let create = GraphBLAS.FSharp.Vector.create clContext workGroupSize - fun (queue: MailboxProcessor) (PreparedMatrix matrix) accuracy -> + fun (queue: RawCommandQueue) (PreparedMatrix matrix) accuracy -> let vertexCount = matrix.RowCount //None is 0 @@ -206,8 +196,8 @@ module PageRank = rank <- prevRank prevRank <- temp - prevRank.Dispose queue - errors.Dispose queue - addition.Dispose queue + prevRank.Dispose() + errors.Dispose() + addition.Dispose() rank diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fsi b/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fsi index 290f6a1f..1f95c19c 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fsi +++ b/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fsi @@ -7,8 +7,8 @@ open GraphBLAS.FSharp.Objects module PageRank = [] type PageRankMatrix = - member Dispose : MailboxProcessor -> unit + member Dispose : unit -> unit - val internal prepareMatrix : ClContext -> int -> (MailboxProcessor -> ClMatrix -> PageRankMatrix) + val internal prepareMatrix : ClContext -> int -> (RawCommandQueue -> ClMatrix -> PageRankMatrix) - val internal run : ClContext -> int -> (MailboxProcessor -> PageRankMatrix -> float32 -> ClVector) + val internal run : ClContext -> int -> (RawCommandQueue -> PageRankMatrix -> float32 -> ClVector) diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs b/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs index 489a796c..d7c80f96 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs @@ -33,7 +33,7 @@ module internal SSSP = let containsNonZero = Vector.exists Predicates.isSome clContext workGroupSize - fun (queue: MailboxProcessor) (matrix: ClMatrix) (source: int) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix) (source: int) -> let vertexCount = matrix.RowCount //None is System.Int32.MaxValue @@ -73,7 +73,7 @@ module internal SSSP = <| (containsNonZero queue front1) .ToHostAndFree(queue) - front1.Dispose queue - front2.Dispose queue + front1.Dispose() + front2.Dispose() distance diff --git a/src/GraphBLAS-sharp.Backend/Common/Bitmap.fs b/src/GraphBLAS-sharp.Backend/Common/Bitmap.fs index 889cd43f..8063e43a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Bitmap.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Bitmap.fs @@ -24,7 +24,7 @@ module Bitmap = let kernel = clContext.Compile(getUniqueBitmap) - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (inputArray: ClArray<'a>) -> let inputLength = inputArray.Length @@ -36,9 +36,9 @@ module Bitmap = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray inputLength bitmap)) + kernel.KernelFunc ndRange inputArray inputLength bitmap - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel bitmap @@ -67,7 +67,7 @@ module Bitmap = let firstGetBitmap = getUniqueBitmap clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> let firstBitmap = firstGetBitmap processor DeviceOnly firstArray @@ -77,8 +77,8 @@ module Bitmap = let result = map processor allocationMode firstBitmap secondBitmap - firstBitmap.Free processor - secondBitmap.Free processor + firstBitmap.Free() + secondBitmap.Free() result diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 260a3728..9c21781e 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -28,7 +28,7 @@ module ClArray = let program = clContext.Compile(init) - fun (processor: MailboxProcessor<_>) allocationMode (length: int) -> + fun (processor: RawCommandQueue) allocationMode (length: int) -> let outputArray = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) @@ -37,8 +37,8 @@ module ClArray = let ndRange = Range1D.CreateValid(length, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange outputArray length)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange outputArray length + processor.RunKernel kernel outputArray @@ -59,7 +59,7 @@ module ClArray = let program = clContext.Compile(create) - fun (processor: MailboxProcessor<_>) allocationMode (length: int) (value: 'a) -> + fun (processor: RawCommandQueue) allocationMode (length: int) (value: 'a) -> let value = clContext.CreateClCell(value) let outputArray = @@ -70,9 +70,9 @@ module ClArray = let ndRange = Range1D.CreateValid(length, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange outputArray length value)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) - value.Free processor + kernel.KernelFunc ndRange outputArray length value + processor.RunKernel kernel + value.Free() outputArray @@ -85,7 +85,7 @@ module ClArray = let create = create clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode length -> + fun (processor: RawCommandQueue) allocationMode length -> create processor allocationMode length Unchecked.defaultof<'a> /// @@ -95,29 +95,30 @@ module ClArray = /// Should be a power of 2 and greater than 1. let copy (clContext: ClContext) workGroupSize = let copy = - <@ fun (ndRange: Range1D) (inputArrayBuffer: ClArray<'a>) (outputArrayBuffer: ClArray<'a>) inputArrayLength -> + <@ fun (ndRange: Range1D) (inputArrayBuffer: ClArray<'a>) (outputArrayBuffer: ClArray<'a>) resultSize -> let i = ndRange.GlobalID0 - if i < inputArrayLength then + if i < resultSize then outputArrayBuffer.[i] <- inputArrayBuffer.[i] @> let program = clContext.Compile(copy) - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (inputArray: ClArray<'a>) (resultSize: int) -> + if resultSize > inputArray.Length then + failwith "Result size is greater than input array size" + let ndRange = - Range1D.CreateValid(inputArray.Length, workGroupSize) + Range1D.CreateValid(resultSize, workGroupSize) let outputArray = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultSize) let kernel = program.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray outputArray inputArray.Length) - ) + kernel.KernelFunc ndRange inputArray outputArray resultSize - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel outputArray @@ -137,7 +138,7 @@ module ClArray = let program = clContext.Compile(copy) - fun (processor: MailboxProcessor<_>) (source: ClArray<'a>) (destination: ClArray<'a>) -> + fun (processor: RawCommandQueue) (source: ClArray<'a>) (destination: ClArray<'a>) -> if source.Length <> destination.Length then failwith "The source array length differs from the destination array length." @@ -146,9 +147,9 @@ module ClArray = let kernel = program.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange source destination source.Length)) + kernel.KernelFunc ndRange source destination source.Length - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel /// /// Creates an array of the given size by replicating the values of the given initial array. @@ -167,7 +168,7 @@ module ClArray = let kernel = clContext.Compile(replicate) - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) count -> + fun (processor: RawCommandQueue) allocationMode (inputArray: ClArray<'a>) count -> let outputArrayLength = inputArray.Length * count let outputArray = @@ -178,12 +179,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange inputArray outputArray inputArray.Length outputArrayLength) - ) + kernel.KernelFunc ndRange inputArray outputArray inputArray.Length outputArrayLength - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel outputArray @@ -195,6 +193,86 @@ module ClArray = /// Should be sorted. let removeDuplications (clContext: ClContext) workGroupSize = + let sequential = + <@ fun (ndRange: Range1D) (length: int) (keys: ClArray<'a>) (resultKeys: ClArray<'a>) (resultCount: ClCell) -> + let gid = ndRange.GlobalID0 + + if gid = 0 then + let mutable count = 0 + let mutable currentKey = keys.[0] + + let mutable offset = 1 + + while offset < length do + if keys.[offset] <> currentKey then + resultKeys.[count] <- currentKey + currentKey <- keys.[offset] + count <- count + 1 + + offset <- offset + 1 + + resultKeys.[count] <- currentKey + resultCount.Value <- count + 1 @> + + let maxWorkGroupSize = clContext.ClDevice.MaxWorkGroupSize + + let small = + <@ fun (ndRange: Range1D) keysLength (keys: ClArray<'a>) (resultKeys: ClArray<'a>) (resultCount: ClCell) -> + let lid = ndRange.LocalID0 + + let alignedSize = + (%ArithmeticOperations.ceilToPowerOfTwo) keysLength + + let offsets = localArray maxWorkGroupSize + + let mutable isUniqueKey = 0 + + if lid < keysLength then + let is_neq = lid > 0 && keys.[lid] <> keys.[lid - 1] + let is_first = lid = 0 + + if is_neq || is_first then + isUniqueKey <- 1 + else + isUniqueKey <- 0 + + offsets.[lid] <- isUniqueKey + + let mutable offset = 1 + + while offset < alignedSize do + barrierLocal () + let mutable value = offsets.[lid] + + if (offset <= lid) then + value <- value + offsets.[lid - offset] + + barrierLocal () + offsets.[lid] <- value + offset <- offset * 2 + + barrierLocal () + + let n_values = offsets.[keysLength - 1] + + if lid < n_values then + let id = lid + 1 + + let start_idx = + (%Search.Bin.lowerPositionLocal) keysLength id offsets + + match start_idx with + | Some idx -> resultKeys.[lid] <- keys.[idx] + | None -> () + + if lid = 0 then + resultCount.Value <- n_values @> + + let sequential = clContext.Compile sequential + let small = clContext.Compile small + + let copy = copy clContext workGroupSize + let scatter = Scatter.lastOccurrence clContext workGroupSize @@ -204,23 +282,72 @@ module ClArray = let prefixSumExclude = ScanInternal.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + let sequentialSwitch = 32 + let smallSwitch = maxWorkGroupSize - let bitmap = - getUniqueBitmap processor DeviceOnly inputArray + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) -> - let resultLength = - (prefixSumExclude processor bitmap) - .ToHostAndFree(processor) + let inputLength = inputArray.Length - let outputArray = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + if inputLength = 1 then + copy processor DeviceOnly inputArray 1 + elif inputLength <= sequentialSwitch then + let resultLength = clContext.CreateClCell() - scatter processor bitmap inputArray outputArray + let temp = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, inputLength) - bitmap.Free processor + let kernel = sequential.GetKernel() - outputArray + let ndRange = Range1D.CreateValid(1, maxWorkGroupSize) + + kernel.KernelFunc ndRange inputArray.Length inputArray temp resultLength + + processor.RunKernel kernel + + let result = + copy processor DeviceOnly temp (resultLength.ToHostAndFree processor) + + temp.Free() + + result + else if inputLength <= smallSwitch then + let resultLength = clContext.CreateClCell() + + let temp = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, inputLength) + + let kernel = small.GetKernel() + + let ndRange = + Range1D.CreateValid(inputLength, maxWorkGroupSize) + + kernel.KernelFunc ndRange inputArray.Length inputArray temp resultLength + + processor.RunKernel kernel + + let result = + copy processor DeviceOnly temp (resultLength.ToHostAndFree processor) + + temp.Free() + + result + else + let bitmap = + getUniqueBitmap processor DeviceOnly inputArray + + let resultLength = + (prefixSumExclude processor bitmap) + .ToHostAndFree(processor) + + let outputArray = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor bitmap inputArray outputArray + + bitmap.Free() + + outputArray /// /// Tests if any element of the array satisfies the given predicate. @@ -242,7 +369,7 @@ module ClArray = let kernel = clContext.Compile exists - fun (processor: MailboxProcessor<_>) (vector: ClArray<'a>) -> + fun (processor: RawCommandQueue) (vector: ClArray<'a>) -> let result = clContext.CreateClCell false @@ -251,9 +378,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange vector.Length vector result)) + kernel.KernelFunc ndRange vector.Length vector result - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel result @@ -284,7 +411,7 @@ module ClArray = let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) -> + fun (processor: RawCommandQueue) (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) -> if values.Length <> positions.Length then failwith "Lengths must be the same" @@ -294,12 +421,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange values.Length values positions result result.Length) - ) + kernel.KernelFunc ndRange values.Length values positions result result.Length - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Applies the given function to each element of the array. @@ -319,7 +443,7 @@ module ClArray = let assignValues = assignOption predicate clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (sourceValues: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (sourceValues: ClArray<'a>) -> let positions = getBitmap processor DeviceOnly sourceValues @@ -329,7 +453,7 @@ module ClArray = .ToHostAndFree(processor) if resultLength = 0 then - positions.Free processor + positions.Free() None else @@ -338,7 +462,7 @@ module ClArray = assignValues processor sourceValues positions result - positions.Free processor + positions.Free() Some result @@ -371,7 +495,7 @@ module ClArray = let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) -> + fun (processor: RawCommandQueue) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) -> if firstValues.Length <> secondValues.Length || secondValues.Length <> positions.Length then @@ -382,20 +506,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstValues.Length - firstValues - secondValues - positions - result - result.Length) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange firstValues.Length firstValues secondValues positions result result.Length + + processor.RunKernel kernel /// /// Applies the given function to each pair of elements of the two given arrays. @@ -415,7 +528,7 @@ module ClArray = let assignValues = assignOption2 predicate clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> + fun (processor: RawCommandQueue) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> let positions = getBitmap processor DeviceOnly firstValues secondValues @@ -450,7 +563,7 @@ module ClArray = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) startIndex count -> + fun (processor: RawCommandQueue) allocationMode (sourceArray: ClArray<'a>) startIndex count -> if count <= 0 then failwith "Count must be greater than zero" @@ -468,9 +581,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange startIndex count sourceArray result)) + kernel.KernelFunc ndRange startIndex count sourceArray result - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel result @@ -486,7 +599,7 @@ module ClArray = let sub = sub clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode chunkSize (sourceArray: ClArray<'a>) -> if chunkSize <= 0 then failwith "The size of the chunk cannot be less than 1" @@ -513,7 +626,7 @@ module ClArray = let chunkBySizeLazy = lazyChunkBySize clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode chunkSize (sourceArray: ClArray<'a>) -> chunkBySizeLazy processor allocationMode chunkSize sourceArray |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray @@ -538,7 +651,7 @@ module ClArray = let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) (sourceArray: ClArray<'a>) sourceIndex (targetArray: ClArray<'a>) targetIndex count -> + fun (processor: RawCommandQueue) (sourceArray: ClArray<'a>) sourceIndex (targetArray: ClArray<'a>) targetIndex count -> if count = 0 then // nothing to do () @@ -559,12 +672,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange sourceIndex sourceArray targetArray targetIndex count) - ) + kernel.KernelFunc ndRange sourceIndex sourceArray targetArray targetIndex count - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Builds a new array that contains the elements of each of the given sequence of arrays. @@ -575,7 +685,7 @@ module ClArray = let blit = blit clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (sourceArrays: ClArray<'a> seq) -> + fun (processor: RawCommandQueue) allocationMode (sourceArrays: ClArray<'a> seq) -> let resultLength = sourceArrays @@ -613,7 +723,7 @@ module ClArray = let kernel = clContext.Compile fill - fun (processor: MailboxProcessor<_>) value firstPosition count (targetArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) value firstPosition count (targetArray: ClArray<'a>) -> if count = 0 then () else @@ -628,11 +738,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange firstPosition count value targetArray) - ) + kernel.KernelFunc ndRange firstPosition count value targetArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Returns an array of each element in the input array and its predecessor, @@ -651,7 +759,7 @@ module ClArray = let map = Map.map2 <@ fun first second -> (first, second) @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (values: ClArray<'a>) -> if values.Length > 1 then let resultLength = values.Length - 1 @@ -668,8 +776,8 @@ module ClArray = let result = map processor allocationMode firstItems secondItems - firstItems.Free processor - secondItems.Free processor + firstItems.Free() + secondItems.Free() Some result else @@ -693,7 +801,7 @@ module ClArray = let program = clContext.Compile(kernel) - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (value: ClCell<'a>) -> + fun (processor: RawCommandQueue) (values: ClArray<'a>) (value: ClCell<'a>) -> let result = clContext.CreateClCell Unchecked.defaultof<'b> @@ -701,8 +809,8 @@ module ClArray = let ndRange = Range1D.CreateValid(1, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values value result)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange values.Length values value result + processor.RunKernel kernel result @@ -744,7 +852,7 @@ module ClArray = let program = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (index: int) (array: ClArray<'a>) -> + fun (processor: RawCommandQueue) (index: int) (array: ClArray<'a>) -> if index < 0 || index >= array.Length then failwith "Index out of range" @@ -756,8 +864,8 @@ module ClArray = let ndRange = Range1D.CreateValid(1, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange index array result)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange index array result + processor.RunKernel kernel result @@ -778,7 +886,7 @@ module ClArray = let program = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) (index: int) (value: 'a) -> + fun (processor: RawCommandQueue) (array: ClArray<'a>) (index: int) (value: 'a) -> if index < 0 || index >= array.Length then failwith "Index out of range" @@ -789,8 +897,8 @@ module ClArray = let ndRange = Range1D.CreateValid(1, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange index array value)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange index array value + processor.RunKernel kernel let count<'a> (predicate: Expr<'a -> bool>) (clContext: ClContext) workGroupSize = @@ -800,14 +908,14 @@ module ClArray = let getBitmap = Map.map<'a, int> (Map.predicateBitmap predicate) clContext workGroupSize - fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> + fun (processor: RawCommandQueue) (array: ClArray<'a>) -> let bitmap = getBitmap processor DeviceOnly array let result = (sum processor bitmap).ToHostAndFree processor - bitmap.Free processor + bitmap.Free() result @@ -883,7 +991,7 @@ module ClArray = let scatter = Scatter.lastOccurrence clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (excludeBitmap: ClArray) (inputArray: ClArray<'a>) -> + fun (queue: RawCommandQueue) allocationMode (excludeBitmap: ClArray) (inputArray: ClArray<'a>) -> invert queue excludeBitmap diff --git a/src/GraphBLAS-sharp.Backend/Common/Common.fs b/src/GraphBLAS-sharp.Backend/Common/Common.fs index 4794b463..852da1c4 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Common.fs @@ -7,6 +7,24 @@ open GraphBLAS.FSharp.Backend.Common module Common = module Sort = module Bitonic = + /// + /// Sorts in-place input array of values by their indices, + /// which are stored in two given arrays of keys: rows and columns. + /// When comparing, it first looks at rows, then columns. + /// Note that maximum possible workGroupSize is used internally for better perfomance. + /// + /// + /// + /// let keys = [| 0; 0; 3; 2; 1; 0; 5 |] + /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; |] + /// sortKeyValuesInplace clContext 32 processor rows columns values + /// ... + /// > val keys = [| 0; 0; 0; 1; 2; 3; 5 |] + /// > val values = [| 1.9; 2.8; 6.4; 5.5; 4.6; 3.7; 7.3 |] + /// + /// + let sortKeyValuesInplace<'a> = Sort.Bitonic.sortKeyValuesInplace<'a> + /// /// Sorts in-place input array of values by their 2d indices, /// which are stored in two given arrays of keys: rows and columns. @@ -25,7 +43,8 @@ module Common = /// > val values = [| 1.9; 2.8; 6.4; 5.5; 4.6; 3.7; 7.3 |] /// /// - let sortKeyValuesInplace<'a> = Sort.Bitonic.sortKeyValuesInplace<'a> + let sortRowsColumnsValuesInplace<'a> = + Sort.Bitonic.sortRowsColumnsValuesInplace<'a> module Radix = /// diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 32d90859..dbcaf382 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -34,16 +34,16 @@ module Gather = let program = clContext.Compile gather - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> let kernel = program.GetKernel() let ndRange = Range1D.CreateValid(outputArray.Length, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values outputArray)) + kernel.KernelFunc ndRange values.Length values outputArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Fills the given output array using the given value and position arrays. Array of positions indicates @@ -76,7 +76,7 @@ module Gather = let program = clContext.Compile gather - fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> if positions.Length <> outputArray.Length then failwith "Lengths must be the same" @@ -86,9 +86,6 @@ module Gather = let ndRange = Range1D.CreateValid(positions.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray) - ) + kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel diff --git a/src/GraphBLAS-sharp.Backend/Common/Map.fs b/src/GraphBLAS-sharp.Backend/Common/Map.fs index 2459e1ef..9e0cacea 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Map.fs @@ -25,7 +25,7 @@ module Map = let kernel = clContext.Compile map - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (inputArray: ClArray<'a>) -> let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) @@ -35,9 +35,9 @@ module Map = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length inputArray result)) + kernel.KernelFunc ndRange inputArray.Length inputArray result - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel result @@ -60,16 +60,16 @@ module Map = let kernel = clContext.Compile map - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) -> let ndRange = Range1D.CreateValid(inputArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length inputArray)) + kernel.KernelFunc ndRange inputArray.Length inputArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Builds a new array whose elements are the results of applying the given function @@ -91,7 +91,7 @@ module Map = let kernel = clContext.Compile map - fun (processor: MailboxProcessor<_>) allocationMode (value: 'a) (inputArray: ClArray<'b>) -> + fun (processor: RawCommandQueue) allocationMode (value: 'a) (inputArray: ClArray<'b>) -> let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) @@ -103,13 +103,11 @@ module Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length valueClCell inputArray result) - ) + kernel.KernelFunc ndRange inputArray.Length valueClCell inputArray result - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel - valueClCell.Free processor + valueClCell.Free() result @@ -136,19 +134,16 @@ module Map = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> + fun (processor: RawCommandQueue) (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> let ndRange = Range1D.CreateValid(resultArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange resultArray.Length leftArray rightArray resultArray) - ) + kernel.KernelFunc ndRange resultArray.Length leftArray rightArray resultArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Builds a new array whose elements are the results of applying the given function @@ -164,7 +159,7 @@ module Map = let map2 = map2InPlace<'a, 'b, 'c> map clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> let resultArray = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftArray.Length) diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index c606a087..31ac8e88 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -25,7 +25,7 @@ module internal PrefixSumInternal = let program = clContext.Compile(update) - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (inputArrayLength: int) (vertices: ClArray<'a>) (bunchLength: int) (mirror: bool) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (inputArrayLength: int) (vertices: ClArray<'a>) (bunchLength: int) (mirror: bool) -> let kernel = program.GetKernel() @@ -34,13 +34,10 @@ module internal PrefixSumInternal = let mirror = clContext.CreateClCell mirror - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange inputArrayLength bunchLength inputArray vertices mirror) - ) + kernel.KernelFunc ndRange inputArrayLength bunchLength inputArray vertices mirror - processor.Post(Msg.CreateRunMsg<_, _> kernel) - mirror.Free processor + processor.RunKernel kernel + mirror.Free() let private scanGeneral beforeLocalSumClear @@ -93,7 +90,7 @@ module internal PrefixSumInternal = let program = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (inputArrayLength: int) (vertices: ClArray<'a>) (verticesLength: int) (totalSum: ClCell<'a>) (zero: 'a) (mirror: bool) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (inputArrayLength: int) (vertices: ClArray<'a>) (verticesLength: int) (totalSum: ClCell<'a>) (zero: 'a) (mirror: bool) -> // TODO: передавать zero как константу let zero = clContext.CreateClCell(zero) @@ -105,24 +102,12 @@ module internal PrefixSumInternal = let mirror = clContext.CreateClCell mirror - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - inputArrayLength - verticesLength - inputArray - vertices - totalSum - zero - mirror) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - zero.Free processor - mirror.Free processor + kernel.KernelFunc ndRange inputArrayLength verticesLength inputArray vertices totalSum zero mirror + + processor.RunKernel kernel + + zero.Free() + mirror.Free() let private scanExclusive<'a when 'a: struct> = scanGeneral @@ -153,7 +138,7 @@ module internal PrefixSumInternal = let update = update opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (zero: 'a) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (zero: 'a) -> let firstVertices = clContext.CreateClArray<'a>( @@ -195,8 +180,8 @@ module internal PrefixSumInternal = verticesArrays <- swap verticesArrays verticesLength <- (verticesLength - 1) / workGroupSize + 1 - firstVertices.Free processor - secondVertices.Free processor + firstVertices.Free() + secondVertices.Free() totalSum @@ -231,7 +216,7 @@ module internal PrefixSumInternal = let scan = runExcludeInPlace <@ (+) @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> + fun (processor: RawCommandQueue) (inputArray: ClArray) -> scan processor inputArray 0 @@ -256,7 +241,7 @@ module internal PrefixSumInternal = let scan = runIncludeInPlace <@ (+) @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> + fun (processor: RawCommandQueue) (inputArray: ClArray) -> scan processor inputArray 0 @@ -288,19 +273,16 @@ module internal PrefixSumInternal = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> + fun (processor: RawCommandQueue) uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> let kernel = kernel.GetKernel() let ndRange = Range1D.CreateValid(values.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange values.Length uniqueKeysCount values keys offsets) - ) + kernel.KernelFunc ndRange values.Length uniqueKeysCount values keys offsets - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel /// /// Exclude scan by key. diff --git a/src/GraphBLAS-sharp.Backend/Common/Scan.fs b/src/GraphBLAS-sharp.Backend/Common/Scan.fs index 636d89c1..b88c97fb 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scan.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scan.fs @@ -105,7 +105,7 @@ module internal ScanInternal = let preScan = clContext.Compile(preScan) - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> let numberOfGroups = inputArray.Length / valuesPerBlock + (if inputArray.Length % valuesPerBlock = 0 then @@ -121,12 +121,9 @@ module internal ScanInternal = let preScanKernel = preScan.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> preScanKernel.KernelFunc ndRangePreScan inputArray.Length inputArray carry totalSum) - ) + preScanKernel.KernelFunc ndRangePreScan inputArray.Length inputArray carry totalSum - processor.Post(Msg.CreateRunMsg<_, _>(preScanKernel)) + processor.RunKernel preScanKernel carry, numberOfGroups > 1 @@ -150,7 +147,7 @@ module internal ScanInternal = let scan = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (carry: ClArray<'a>) (totalSum: ClCell<'a>) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (carry: ClArray<'a>) (totalSum: ClCell<'a>) -> let numberOfGroups = inputArray.Length / valuesPerBlock + (if inputArray.Length % valuesPerBlock = 0 then @@ -163,11 +160,9 @@ module internal ScanInternal = let scan = scan.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> scan.KernelFunc ndRangeScan inputArray.Length inputArray carry totalSum) - ) + scan.KernelFunc ndRangeScan inputArray.Length inputArray carry totalSum - processor.Post(Msg.CreateRunMsg<_, _>(scan)) + processor.RunKernel scan let runExcludeInPlace plus zero (clContext: ClContext) workGroupSize = @@ -190,7 +185,7 @@ module internal ScanInternal = let scan = scan plus false clContext workGroupSize let getTotalSum = clContext.Compile(getTotalSum) - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) -> let totalSum = clContext.CreateClCell<'a>() @@ -198,17 +193,14 @@ module internal ScanInternal = preScanSaveSum processor inputArray totalSum if not needRecursion then - carry.Free processor + carry.Free() let ndRangeTotalSum = Range1D.CreateValid(1, 1) let getTotalSum = getTotalSum.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> getTotalSum.KernelFunc ndRangeTotalSum inputArray.Length inputArray totalSum) - ) + getTotalSum.KernelFunc ndRangeTotalSum inputArray.Length inputArray totalSum - processor.Post(Msg.CreateRunMsg<_, _>(getTotalSum)) + processor.RunKernel getTotalSum else let mutable carryStack = [ carry; inputArray ] let mutable stop = not needRecursion @@ -223,7 +215,7 @@ module internal ScanInternal = carryStack <- carry :: carryStack else stop <- true - carry.Free processor + carry.Free() stop <- false @@ -237,7 +229,7 @@ module internal ScanInternal = else scan processor inputCarry carry totalSum - carry.Free processor + carry.Free() carryStack <- carryStack.Tail | _ -> failwith "carryStack always has at least 2 elements" @@ -265,6 +257,6 @@ module internal ScanInternal = let scan = runExcludeInPlace <@ (+) @> 0 clContext workGroupSize - fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> + fun (processor: RawCommandQueue) (inputArray: ClArray) -> scan processor inputArray diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 82980465..c816ab7a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -26,7 +26,7 @@ module Scatter = let program = clContext.Compile(run) - fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> + fun (processor: RawCommandQueue) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> if positions.Length <> values.Length then failwith "Lengths must be the same" @@ -38,12 +38,9 @@ module Scatter = let kernel = program.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange positions positionsLength values result result.Length) - ) + kernel.KernelFunc ndRange positions positionsLength values result result.Length - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Creates a new array from the given one where it is indicated @@ -114,7 +111,7 @@ module Scatter = let program = clContext.Compile(run) - fun (processor: MailboxProcessor<_>) (positions: ClArray) (result: ClArray<'a>) -> + fun (processor: RawCommandQueue) (positions: ClArray) (result: ClArray<'a>) -> let positionsLength = positions.Length @@ -123,11 +120,9 @@ module Scatter = let kernel = program.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions positionsLength result result.Length) - ) + kernel.KernelFunc ndRange positions positionsLength result result.Length - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs index 5aba906b..724de235 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs @@ -5,7 +5,7 @@ open GraphBLAS.FSharp.Backend module Bitonic = - let sortKeyValuesInplace<'a> (clContext: ClContext) (workGroupSize: int) = + let sortRowsColumnsValuesInplace<'a> (clContext: ClContext) (workGroupSize: int) = let localSize = Common.Utils.floorToPower2 ( @@ -209,7 +209,236 @@ module Bitonic = let localStep = clContext.Compile(localStep) let globalStep = clContext.Compile(globalStep) - fun (queue: MailboxProcessor<_>) (rows: ClArray) (cols: ClArray) (values: ClArray<'a>) -> + fun (queue: RawCommandQueue) (rows: ClArray) (cols: ClArray) (values: ClArray<'a>) -> + + let size = values.Length + + if (size = 1) then + () + else if (size <= localSize) then + let numberOfThreads = + Common.Utils.ceilToMultiple waveSize (min size maxThreadsPerBlock) + + let ndRangeLocal = + Range1D.CreateValid(numberOfThreads, numberOfThreads) + + let kernel = localStep.GetKernel() + + kernel.KernelFunc ndRangeLocal rows cols values values.Length + queue.RunKernel(kernel) + else + let numberOfGroups = + size / localSize + + (if size % localSize = 0 then 0 else 1) + + let ndRangeLocal = + Range1D.CreateValid(maxThreadsPerBlock * numberOfGroups, maxThreadsPerBlock) + + let kernelLocal = localStep.GetKernel() + + kernelLocal.KernelFunc ndRangeLocal rows cols values values.Length + + queue.RunKernel(kernelLocal) + + let ndRangeGlobal = + Range1D.CreateValid(maxWorkGroupSize, maxWorkGroupSize) + + let kernelGlobal = globalStep.GetKernel() + + kernelGlobal.KernelFunc ndRangeGlobal rows cols values values.Length (localSize * 2) + + queue.RunKernel(kernelGlobal) + + + let sortKeyValuesInplace<'a> (clContext: ClContext) (workGroupSize: int) = + + let localSize = + Common.Utils.floorToPower2 ( + int (clContext.ClDevice.LocalMemSize) + / (sizeof + sizeof<'a>) + ) + + let maxThreadsPerBlock = + min (clContext.ClDevice.MaxWorkGroupSize) (localSize / 2) + + let waveSize = 32 + let maxWorkGroupSize = clContext.ClDevice.MaxWorkGroupSize + + let localStep = + <@ fun (ndRange: Range1D) (rows: ClArray) (vals: ClArray<'a>) (length: int) -> + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + let workGroupSize = ndRange.LocalWorkSize + let groupId = gid / workGroupSize + + let offset = groupId * localSize + let border = min (offset + localSize) length + let n = border - offset + + let nAligned = + (%Quotes.ArithmeticOperations.ceilToPowerOfTwo) n + + let numberOfThreads = nAligned / 2 + + let sortedKeys = localArray localSize + let sortedVals = localArray<'a> localSize + + let mutable i = lid + + while i + offset < border do + let key = rows.[i + offset] + sortedKeys.[i] <- key + sortedVals.[i] <- vals.[i + offset] + i <- i + workGroupSize + + barrierLocal () + + let mutable segmentSize = 2 + + while segmentSize <= nAligned do + let segmentSizeHalf = segmentSize / 2 + + let mutable tid = lid + + while tid < numberOfThreads do + let segmentId = tid / segmentSizeHalf + let innerId = tid % segmentSizeHalf + let innerIdSibling = segmentSize - innerId - 1 + let i = segmentId * segmentSize + innerId + let j = segmentId * segmentSize + innerIdSibling + + if (i < n && j < n && sortedKeys.[i] > sortedKeys.[j]) then + let tempK = sortedKeys.[i] + sortedKeys.[i] <- sortedKeys.[j] + sortedKeys.[j] <- tempK + let tempV = sortedVals.[i] + sortedVals.[i] <- sortedVals.[j] + sortedVals.[j] <- tempV + + tid <- tid + workGroupSize + + barrierLocal () + + let mutable k = segmentSizeHalf / 2 + + while k > 0 do + + let mutable tid = lid + + while tid < numberOfThreads do + let segmentSizeInner = k * 2 + let segmentId = tid / k + let innerId = tid % k + let innerIdSibling = innerId + k + let i = segmentId * segmentSizeInner + innerId + + let j = + segmentId * segmentSizeInner + innerIdSibling + + if (i < n && j < n && sortedKeys.[i] > sortedKeys.[j]) then + let tempK = sortedKeys.[i] + sortedKeys.[i] <- sortedKeys.[j] + sortedKeys.[j] <- tempK + let tempV = sortedVals.[i] + sortedVals.[i] <- sortedVals.[j] + sortedVals.[j] <- tempV + + tid <- tid + workGroupSize + + k <- k / 2 + barrierLocal () + + segmentSize <- segmentSize * 2 + + let mutable i = lid + + while i + offset < border do + let key = sortedKeys.[i] + rows.[i + offset] <- key + vals.[i + offset] <- sortedVals.[i] + i <- i + workGroupSize @> + + let globalStep = + <@ fun (ndRange: Range1D) (rows: ClArray) (vals: ClArray<'a>) (length: int) (segmentStart: int) -> + let lid = ndRange.LocalID0 + let workGroupSize = ndRange.LocalWorkSize + + let n = length + + let nAligned = + (%Quotes.ArithmeticOperations.ceilToPowerOfTwo) n + + let numberOfThreads = nAligned / 2 + + let mutable segmentSize = segmentStart + + while segmentSize <= nAligned do + let segmentSizeHalf = segmentSize / 2 + + let mutable tid = lid + + while tid < numberOfThreads do + let segmentId = tid / segmentSizeHalf + let innerId = tid % segmentSizeHalf + let innerIdSibling = segmentSize - innerId - 1 + let i = segmentId * segmentSize + innerId + let j = segmentId * segmentSize + innerIdSibling + + if (i < n && j < n) then + let keyI = rows.[i] + let keyJ = rows.[j] + + if (keyI > keyJ) then + let tempR = rows.[i] + rows.[i] <- rows.[j] + rows.[j] <- tempR + let tempV = vals.[i] + vals.[i] <- vals.[j] + vals.[j] <- tempV + + tid <- tid + workGroupSize + + barrierGlobal () + + let mutable k = segmentSizeHalf / 2 + + while k > 0 do + + let mutable tid = lid + + while tid < numberOfThreads do + let segmentSizeInner = k * 2 + let segmentId = tid / k + let innerId = tid % k + let innerIdSibling = innerId + k + let i = segmentId * segmentSizeInner + innerId + + let j = + segmentId * segmentSizeInner + innerIdSibling + + if (i < n && j < n) then + let keyI = rows.[i] + let keyJ = rows.[j] + + if (keyI > keyJ) then + let tempR = rows.[i] + rows.[i] <- rows.[j] + rows.[j] <- tempR + let tempV = vals.[i] + vals.[i] <- vals.[j] + vals.[j] <- tempV + + tid <- tid + workGroupSize + + k <- k / 2 + barrierGlobal () + + segmentSize <- segmentSize * 2 @> + + let localStep = clContext.Compile(localStep) + let globalStep = clContext.Compile(globalStep) + + fun (queue: RawCommandQueue) (rows: ClArray) (values: ClArray<'a>) -> let size = values.Length @@ -224,8 +453,8 @@ module Bitonic = let kernel = localStep.GetKernel() - queue.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRangeLocal rows cols values values.Length)) - queue.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRangeLocal rows values values.Length + queue.RunKernel(kernel) else let numberOfGroups = size / localSize @@ -236,20 +465,15 @@ module Bitonic = let kernelLocal = localStep.GetKernel() - queue.Post( - Msg.MsgSetArguments(fun () -> kernelLocal.KernelFunc ndRangeLocal rows cols values values.Length) - ) + kernelLocal.KernelFunc ndRangeLocal rows values values.Length - queue.Post(Msg.CreateRunMsg<_, _>(kernelLocal)) + queue.RunKernel(kernelLocal) let ndRangeGlobal = Range1D.CreateValid(maxWorkGroupSize, maxWorkGroupSize) let kernelGlobal = globalStep.GetKernel() - queue.Post( - Msg.MsgSetArguments - (fun () -> kernelGlobal.KernelFunc ndRangeGlobal rows cols values values.Length (localSize * 2)) - ) + kernelGlobal.KernelFunc ndRangeGlobal rows values values.Length (localSize * 2) - queue.Post(Msg.CreateRunMsg<_, _>(kernelGlobal)) + queue.RunKernel(kernelGlobal) \ No newline at end of file diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index abace8a4..11cb9d81 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -76,7 +76,7 @@ module internal Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (indices: ClArray) (clWorkGroupCount: ClCell) (shift: ClCell) -> + fun (processor: RawCommandQueue) (indices: ClArray) (clWorkGroupCount: ClCell) (shift: ClCell) -> let ndRange = Range1D.CreateValid(indices.Length, workGroupSize) @@ -92,20 +92,9 @@ module internal Radix = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - indices.Length - indices - clWorkGroupCount - shift - globalOffsets - localOffsets) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange indices.Length indices clWorkGroupCount shift globalOffsets localOffsets + + processor.RunKernel kernel globalOffsets, localOffsets @@ -133,20 +122,16 @@ module internal Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (keys: ClArray) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (result: ClArray) -> + fun (processor: RawCommandQueue) (keys: ClArray) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (result: ClArray) -> let ndRange = Range1D.CreateValid(keys.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange keys.Length keys shift workGroupCount globalOffset localOffsets result) - ) + kernel.KernelFunc ndRange keys.Length keys shift workGroupCount globalOffset localOffsets result - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel let private runKeysOnly (clContext: ClContext) workGroupSize bitCount = let copy = ClArray.copy clContext workGroupSize @@ -160,11 +145,12 @@ module internal Radix = let scatter = scatter clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) (keys: ClArray) -> + fun (processor: RawCommandQueue) (keys: ClArray) -> if keys.Length <= 1 then - copy processor DeviceOnly keys // TODO(allocation mode) + copy processor DeviceOnly keys keys.Length else - let firstKeys = copy processor DeviceOnly keys + let firstKeys = + copy processor DeviceOnly keys keys.Length let secondKeys = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys.Length) @@ -183,17 +169,17 @@ module internal Radix = let globalOffset, localOffset = count processor (fst pair) workGroupCount shift - (prefixSum processor globalOffset).Free processor + (prefixSum processor globalOffset).Free() scatter processor (fst pair) shift workGroupCount globalOffset localOffset (snd pair) pair <- swap pair - globalOffset.Free processor - localOffset.Free processor - shift.Free processor + globalOffset.Free() + localOffset.Free() + shift.Free() - (snd pair).Free processor + (snd pair).Free() fst pair let standardRunKeysOnly clContext workGroupSize = @@ -224,30 +210,26 @@ module internal Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (keys: ClArray) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> + fun (processor: RawCommandQueue) (keys: ClArray) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> let ndRange = Range1D.CreateValid(keys.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - keys.Length - keys - values - shift - workGroupCount - globalOffset - localOffsets - resultKeys - resultValues) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + keys.Length + keys + values + shift + workGroupCount + globalOffset + localOffsets + resultKeys + resultValues + + processor.RunKernel kernel let private runByKeys (clContext: ClContext) workGroupSize bitCount = let copy = ClArray.copy clContext workGroupSize @@ -264,19 +246,21 @@ module internal Radix = let scatterByKey = scatterByKey clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) allocationMode (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (keys: ClArray) (values: ClArray<'a>) -> if values.Length <> keys.Length then failwith "Mismatch of key lengths and value. Lengths must be the same" if values.Length <= 1 then - copy processor DeviceOnly keys, dataCopy processor DeviceOnly values + copy processor DeviceOnly keys keys.Length, dataCopy processor DeviceOnly values values.Length else - let firstKeys = copy processor DeviceOnly keys + let firstKeys = + copy processor DeviceOnly keys keys.Length let secondKeys = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys.Length) - let firstValues = dataCopy processor DeviceOnly values + let firstValues = + dataCopy processor DeviceOnly values values.Length let secondValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values.Length) @@ -303,7 +287,7 @@ module internal Radix = let globalOffset, localOffset = count processor currentKeys workGroupCount shift - (prefixSum processor globalOffset).Free processor + (prefixSum processor globalOffset).Free() scatterByKey processor @@ -319,12 +303,12 @@ module internal Radix = keysPair <- swap keysPair valuesPair <- swap valuesPair - globalOffset.Free processor - localOffset.Free processor - shift.Free processor + globalOffset.Free() + localOffset.Free() + shift.Free() - (snd keysPair).Free processor - (snd valuesPair).Free processor + (snd keysPair).Free() + (snd valuesPair).Free() (fst keysPair, fst valuesPair) @@ -332,11 +316,11 @@ module internal Radix = let runByKeys = runByKeys clContext workGroupSize defaultBitCount - fun (processor: MailboxProcessor<_>) allocationMode (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (keys: ClArray) (values: ClArray<'a>) -> let keys, values = runByKeys processor allocationMode keys values - keys.Free processor + keys.Free() values diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index 73aad03b..475e4069 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -14,7 +14,7 @@ module Reduce = /// let private runGeneral (clContext: ClContext) workGroupSize scan scanToCell = - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) -> let scan = scan processor @@ -50,8 +50,8 @@ module Reduce = let result = scanToCell processor fstVertices verticesLength - firstVerticesArray.Free processor - secondVerticesArray.Free processor + firstVerticesArray.Free() + secondVerticesArray.Free() result @@ -80,17 +80,15 @@ module Reduce = let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultArray) - ) + kernel.KernelFunc ndRange valuesLength valuesArray resultArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel let private scanToCellSum (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize zero = @@ -117,7 +115,7 @@ module Reduce = let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength -> + fun (processor: RawCommandQueue) (valuesArray: ClArray<'a>) valuesLength -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) @@ -126,9 +124,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultCell)) + kernel.KernelFunc ndRange valuesLength valuesArray resultCell - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel resultCell @@ -149,7 +147,7 @@ module Reduce = let run = runGeneral clContext workGroupSize scan scanToCell - fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> run processor array + fun (processor: RawCommandQueue) (array: ClArray<'a>) -> run processor array let private scanReduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) @@ -179,18 +177,16 @@ module Reduce = let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultArray) - ) + kernel.KernelFunc ndRange valuesLength valuesArray resultArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel let private scanToCellReduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) @@ -220,7 +216,7 @@ module Reduce = let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength -> + fun (processor: RawCommandQueue) (valuesArray: ClArray<'a>) valuesLength -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) @@ -230,9 +226,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultCell)) + kernel.KernelFunc ndRange valuesLength valuesArray resultCell - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel resultCell @@ -252,7 +248,7 @@ module Reduce = let run = runGeneral clContext workGroupSize scan scanToCell - fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> run processor array + fun (processor: RawCommandQueue) (array: ClArray<'a>) -> run processor array /// /// Reduction of an array of values by an array of keys. @@ -295,7 +291,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -308,12 +304,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys) - ) + kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel reducedValues, reducedKeys @@ -352,7 +345,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -365,21 +358,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - keys.Length - offsets - keys - values - reducedValues - reducedKeys) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange resultLength keys.Length offsets keys values reducedValues reducedKeys + + processor.RunKernel kernel reducedValues, reducedKeys @@ -448,7 +429,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> if keys.Length > workGroupSize then failwith "The length of the value should not exceed the size of the workgroup" @@ -463,12 +444,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys) - ) + kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel reducedValues, reducedKeys @@ -531,14 +509,14 @@ module Reduce = let prefixSum = ScanInternal.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (keys: ClArray) (values: ClArray<'a option>) -> + fun (processor: RawCommandQueue) allocationMode (keys: ClArray) (values: ClArray<'a option>) -> let offsets = getUniqueBitmap processor DeviceOnly keys let uniqueKeysCount = (prefixSum processor offsets) - .ToHostAndFree processor + .ToHostAndFree(processor) let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) @@ -554,33 +532,29 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - uniqueKeysCount - keys.Length - offsets - keys - values - reducedValues - reducedKeys - resultPositions) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - offsets.Free processor + kernel.KernelFunc + ndRange + uniqueKeysCount + keys.Length + offsets + keys + values + reducedValues + reducedKeys + resultPositions + + processor.RunKernel kernel + + offsets.Free() let resultLength = (prefixSum processor resultPositions) - .ToHostAndFree processor + .ToHostAndFree(processor) if resultLength = 0 then - reducedValues.Free processor - reducedKeys.Free processor - resultPositions.Free processor + reducedValues.Free() + reducedKeys.Free() + resultPositions.Free() None else // write values @@ -589,7 +563,7 @@ module Reduce = scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free() // write keys let resultKeys = @@ -597,8 +571,8 @@ module Reduce = scatterIndices processor resultPositions reducedKeys resultKeys - reducedKeys.Free processor - resultPositions.Free processor + reducedKeys.Free() + resultPositions.Free() Some(resultValues, resultKeys) @@ -663,7 +637,7 @@ module Reduce = let prefixSum = ScanInternal.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) @@ -679,31 +653,27 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - keys.Length - offsets - keys - values - reducedValues - reducedKeys - resultPositions) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + resultLength + keys.Length + offsets + keys + values + reducedValues + reducedKeys + resultPositions + + processor.RunKernel kernel let resultLength = (prefixSum processor resultPositions) - .ToHostAndFree processor + .ToHostAndFree(processor) if resultLength = 0 then - reducedValues.Free processor - reducedKeys.Free processor - resultPositions.Free processor + reducedValues.Free() + reducedKeys.Free() + resultPositions.Free() None else @@ -713,7 +683,7 @@ module Reduce = scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free() // write keys let resultKeys = @@ -721,8 +691,8 @@ module Reduce = scatterIndices processor resultPositions reducedKeys resultKeys - reducedKeys.Free processor - resultPositions.Free processor + reducedKeys.Free() + resultPositions.Free() Some(resultValues, resultKeys) @@ -772,7 +742,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -788,21 +758,17 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstKeys.Length - firstKeys - secondKeys - values - reducedValues - firstReducedKeys - secondReducedKeys) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + firstKeys.Length + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + + processor.RunKernel kernel reducedValues, firstReducedKeys, secondReducedKeys @@ -845,7 +811,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -861,23 +827,19 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - firstKeys.Length - offsets - firstKeys - secondKeys - values - reducedValues - firstReducedKeys - secondReducedKeys) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + + processor.RunKernel kernel reducedValues, firstReducedKeys, secondReducedKeys @@ -942,7 +904,7 @@ module Reduce = let prefixSum = ScanInternal.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -961,34 +923,30 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - firstKeys.Length - offsets - firstKeys - secondKeys - values - reducedValues - firstReducedKeys - secondReducedKeys - resultPositions) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + resultPositions + + processor.RunKernel kernel let resultLength = (prefixSum processor resultPositions) - .ToHostAndFree processor + .ToHostAndFree(processor) if resultLength = 0 then - reducedValues.Free processor - firstReducedKeys.Free processor - secondReducedKeys.Free processor - resultPositions.Free processor + reducedValues.Free() + firstReducedKeys.Free() + secondReducedKeys.Free() + resultPositions.Free() None else @@ -998,7 +956,7 @@ module Reduce = scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free() // write first keys let resultFirstKeys = @@ -1006,7 +964,7 @@ module Reduce = scatterIndices processor resultPositions firstReducedKeys resultFirstKeys - firstReducedKeys.Free processor + firstReducedKeys.Free() // write second keys let resultSecondKeys = @@ -1014,8 +972,8 @@ module Reduce = scatterIndices processor resultPositions secondReducedKeys resultSecondKeys - secondReducedKeys.Free processor + secondReducedKeys.Free() - resultPositions.Free processor + resultPositions.Free() Some(resultValues, resultFirstKeys, resultSecondKeys) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 4300c9ec..dd6fa038 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -13,7 +13,6 @@ - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs index d5a326a3..701b5f4f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs @@ -30,7 +30,7 @@ module internal Intersect = let kernel = clContext.Compile <| findIntersection - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> let bitmapSize = leftMatrix.NNZ @@ -42,20 +42,16 @@ module internal Intersect = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - leftMatrix.NNZ - rightMatrix.NNZ - leftMatrix.Rows - leftMatrix.Columns - rightMatrix.Rows - rightMatrix.Columns - bitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + leftMatrix.NNZ + rightMatrix.NNZ + leftMatrix.Rows + leftMatrix.Columns + rightMatrix.Rows + rightMatrix.Columns + bitmap + + processor.RunKernel kernel bitmap diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs index 5d99f062..e3434771 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module internal Map = let private preparePositions<'a, 'b> opAdd (clContext: ClContext) workGroupSize = @@ -40,7 +41,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> let (resultLength: int) = columnCount * rowCount @@ -61,24 +62,21 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - values.Length - values - rowPointers - columns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + + kernel.KernelFunc + ndRange + rowCount + columnCount + values.Length + values + rowPointers + columns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -94,7 +92,7 @@ module internal Map = let setPositions = Common.setPositions<'b> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> let bitmap, values, rows, columns = map queue matrix.RowCount matrix.ColumnCount matrix.Values matrix.Rows matrix.Columns @@ -102,10 +100,10 @@ module internal Map = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(rows)) - queue.Post(Msg.CreateFreeMsg<_>(columns)) + bitmap.Free() + values.Free() + rows.Free() + columns.Free() { Context = clContext RowCount = matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs index a728d546..33a74edc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs @@ -5,6 +5,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Matrix @@ -44,7 +45,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> let (resultLength: int) = columnCount * rowCount @@ -65,28 +66,24 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - leftValues.Length - rightValues.Length - leftValues - leftRows - leftColumns - rightValues - rightRows - rightColumns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + rowCount + columnCount + leftValues.Length + rightValues.Length + leftValues + leftRows + leftColumns + rightValues + rightRows + rightColumns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -105,7 +102,7 @@ module internal Map2 = let setPositions = Common.setPositions<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> let bitmap, values, rows, columns = map2 @@ -122,10 +119,10 @@ module internal Map2 = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(rows)) - queue.Post(Msg.CreateFreeMsg<_>(columns)) + bitmap.Free() + values.Free() + rows.Free() + columns.Free() { Context = clContext RowCount = matrixLeft.RowCount @@ -176,7 +173,7 @@ module internal Map2 = let kernel = clContext.Compile(preparePositions) - fun (processor: MailboxProcessor<_>) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + fun (processor: RawCommandQueue) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> let length = leftValues.Length let ndRange = @@ -190,22 +187,18 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allRows - allColumns - leftValues - rightValues - allValues - rawPositionsGpu - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + length + allRows + allColumns + leftValues + rightValues + allValues + rawPositionsGpu + isLeft + + processor.RunKernel kernel rawPositionsGpu, allValues @@ -227,7 +220,7 @@ module internal Map2 = let setPositions = Common.setPositions<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft = merge queue matrixLeft matrixRight @@ -235,17 +228,17 @@ module internal Map2 = let rawPositions, allValues = preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + leftMergedValues.Free() + rightMergedValues.Free() let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode allRows allColumns allValues rawPositions - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(rawPositions)) - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) + isLeft.Free() + rawPositions.Free() + allRows.Free() + allColumns.Free() + allValues.Free() { Context = clContext RowCount = matrixLeft.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index 5c7838fc..9bf0f6ce 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -22,13 +22,13 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: COO<'a>) -> { Context = clContext RowCount = matrix.RowCount ColumnCount = matrix.ColumnCount - Rows = copy processor allocationMode matrix.Rows - Columns = copy processor allocationMode matrix.Columns - Values = copyData processor allocationMode matrix.Values } + Rows = copy processor allocationMode matrix.Rows matrix.Rows.Length + Columns = copy processor allocationMode matrix.Columns matrix.Columns.Length + Values = copyData processor allocationMode matrix.Values matrix.Values.Length } /// /// Builds a new COO matrix whose elements are the results of applying the given function @@ -83,16 +83,16 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> let resultRows = - copy processor allocationMode matrix.Rows + copy processor allocationMode matrix.Rows matrix.Rows.Length let resultColumns = - copy processor allocationMode matrix.Columns + copy processor allocationMode matrix.Columns matrix.Columns.Length let resultValues = - copyData processor allocationMode matrix.Values + copyData processor allocationMode matrix.Values matrix.Values.Length { Context = clContext RowIndices = resultRows @@ -124,7 +124,7 @@ module Matrix = let scan = Common.PrefixSum.runBackwardsIncludeInPlace <@ min @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (rowIndices: ClArray) rowCount -> + fun (processor: RawCommandQueue) allocationMode (rowIndices: ClArray) rowCount -> let nnz = rowIndices.Length @@ -134,10 +134,10 @@ module Matrix = let kernel = program.GetKernel() let ndRange = Range1D.CreateValid(nnz, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowIndices nnz rowPointers)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange rowIndices nnz rowPointers + processor.RunKernel kernel - (scan processor rowPointers nnz).Free processor + (scan processor rowPointers nnz).Free() rowPointers @@ -154,15 +154,15 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> let rowPointers = prepare processor allocationMode matrix.Rows matrix.RowCount let cols = - copy processor allocationMode matrix.Columns + copy processor allocationMode matrix.Columns matrix.Columns.Length let values = - copyData processor allocationMode matrix.Values + copyData processor allocationMode matrix.Values matrix.Values.Length { Context = clContext RowCount = matrix.RowCount @@ -180,11 +180,11 @@ module Matrix = let toCSRInPlace (clContext: ClContext) workGroupSize = let prepare = compressRows clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> let rowPointers = prepare processor allocationMode matrix.Rows matrix.RowCount - matrix.Rows.Free processor + matrix.Rows.Free() { Context = clContext RowCount = matrix.RowCount @@ -202,9 +202,9 @@ module Matrix = let transposeInPlace (clContext: ClContext) workGroupSize = let sort = - Common.Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize + Common.Sort.Bitonic.sortRowsColumnsValuesInplace clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.COO<'a>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix.COO<'a>) -> sort queue matrix.Columns matrix.Rows matrix.Values { Context = clContext @@ -227,14 +227,14 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> { Context = clContext RowCount = matrix.RowCount ColumnCount = matrix.ColumnCount - Rows = copy queue allocationMode matrix.Rows - Columns = copy queue allocationMode matrix.Columns - Values = copyData queue allocationMode matrix.Values } + Rows = copy queue allocationMode matrix.Rows matrix.Rows.Length + Columns = copy queue allocationMode matrix.Columns matrix.Columns.Length + Values = copyData queue allocationMode matrix.Values matrix.Values.Length } |> transposeInPlace queue /// @@ -288,7 +288,7 @@ module Matrix = let blitData = ClArray.blit clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode startRow count (matrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode startRow count (matrix: ClMatrix.COO<'a>) -> if count <= 0 then failwith "Count must be greater than zero" @@ -311,8 +311,8 @@ module Matrix = .ToHostAndFree processor - 1 - firstRowClCell.Free processor - lastRowClCell.Free processor + firstRowClCell.Free() + lastRowClCell.Free() let resultLength = lastIndex - firstIndex + 1 diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs index 1401f3cc..340d9db2 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs @@ -132,7 +132,7 @@ module Merge = let kernel = clContext.Compile(merge) - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> + fun (processor: RawCommandQueue) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> let firstSide = leftMatrix.Columns.Length let secondSide = rightMatrix.Columns.Length @@ -158,28 +158,24 @@ module Merge = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - leftMatrix.Rows - leftMatrix.Columns - leftMatrix.Values - rightMatrix.Rows - rightMatrix.Columns - rightMatrix.Values - allRows - allColumns - leftMergedValues - rightMergedValues - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + leftMatrix.Rows + leftMatrix.Columns + leftMatrix.Values + rightMatrix.Rows + rightMatrix.Columns + rightMatrix.Values + allRows + allColumns + leftMergedValues + rightMergedValues + isLeft + + processor.RunKernel kernel allRows, allColumns, leftMergedValues, rightMergedValues, isLeft @@ -199,7 +195,7 @@ module Merge = let merge = run clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'a>) -> let length = leftMatrix.Columns.Length @@ -212,14 +208,12 @@ module Merge = let mergeValuesKernel = mergeValuesKernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> mergeValuesKernel.KernelFunc ndRange length leftValues rightValues isLeft) - ) + mergeValuesKernel.KernelFunc ndRange length leftValues rightValues isLeft - processor.Post(Msg.CreateRunMsg<_, _>(mergeValuesKernel)) + processor.RunKernel(mergeValuesKernel) - isLeft.Free processor - rightValues.Free processor + isLeft.Free() + rightValues.Free() { Context = clContext Rows = rows diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 8d068d09..2d407992 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -41,7 +41,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> let (resultLength: int) = columnCount * rowCount @@ -62,23 +62,19 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - values - rowPointers - columns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + rowCount + columnCount + values + rowPointers + columns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -94,7 +90,7 @@ module internal Map = let setPositions = Common.setPositions<'b> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let bitmap, values, rows, columns = map queue matrix.RowCount matrix.ColumnCount matrix.Values matrix.RowPointers matrix.Columns @@ -102,10 +98,10 @@ module internal Map = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - bitmap.Free queue - values.Free queue - rows.Free queue - columns.Free queue + bitmap.Free() + values.Free() + rows.Free() + columns.Free() { Context = clContext RowCount = matrix.RowCount @@ -144,7 +140,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) (operand: ClCell<'a option>) (matrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) (operand: ClCell<'a option>) (matrix: ClMatrix.CSR<'b>) -> let resultLength = matrix.RowCount * matrix.ColumnCount @@ -165,24 +161,20 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - operand - matrix.RowCount - matrix.ColumnCount - matrix.Values - matrix.RowPointers - matrix.Columns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + operand + matrix.RowCount + matrix.ColumnCount + matrix.Values + matrix.RowPointers + matrix.Columns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -198,20 +190,20 @@ module internal Map = let setPositions = Common.setPositionsOption<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (value: 'a option) (matrix: ClMatrix.CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (value: 'a option) (matrix: ClMatrix.CSR<'b>) -> let valueClCell = clContext.CreateClCell value let bitmap, values, rows, columns = mapWithValue queue valueClCell matrix - valueClCell.Free queue + valueClCell.Free() let result = setPositions queue allocationMode rows columns values bitmap - bitmap.Free queue - values.Free queue - rows.Free queue - columns.Free queue + bitmap.Free() + values.Free() + rows.Free() + columns.Free() result |> Option.map diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs index 70599c16..4e0b9322 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module internal Map2 = let private preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = @@ -46,7 +47,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> let (resultLength: int) = columnCount * rowCount @@ -67,26 +68,22 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - leftValues - leftRows - leftColumns - rightValues - rightRows - rightColumns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + rowCount + columnCount + leftValues + leftRows + leftColumns + rightValues + rightRows + rightColumns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -105,7 +102,7 @@ module internal Map2 = let setPositions = Common.setPositions<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> let bitmap, values, rows, columns = map2 @@ -122,10 +119,10 @@ module internal Map2 = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(rows)) - queue.Post(Msg.CreateFreeMsg<_>(columns)) + bitmap.Free() + values.Free() + rows.Free() + columns.Free() { Context = clContext RowCount = matrixLeft.RowCount @@ -166,7 +163,7 @@ module internal Map2 = let kernel = clContext.Compile(preparePositions) - fun (processor: MailboxProcessor<_>) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isEndOfRow: ClArray) (isLeft: ClArray) -> + fun (processor: RawCommandQueue) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isEndOfRow: ClArray) (isLeft: ClArray) -> let length = leftValues.Length let ndRange = @@ -180,22 +177,18 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allColumns - leftValues - rightValues - allValues - rowPositions - isEndOfRow - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + length + allColumns + leftValues + rightValues + allValues + rowPositions + isEndOfRow + isLeft + + processor.RunKernel kernel rowPositions, allValues let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> @@ -212,7 +205,7 @@ module internal Map2 = let setPositions = Common.setPositions<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> let allRows, allColumns, leftMergedValues, rightMergedValues, isRowEnd, isLeft = merge queue matrixLeft matrixRight @@ -220,18 +213,18 @@ module internal Map2 = let positions, allValues = preparePositions queue allColumns leftMergedValues rightMergedValues isRowEnd isLeft - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + leftMergedValues.Free() + rightMergedValues.Free() let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode allRows allColumns allValues positions - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(isRowEnd)) - queue.Post(Msg.CreateFreeMsg<_>(positions)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) + allRows.Free() + isLeft.Free() + isRowEnd.Free() + positions.Free() + allColumns.Free() + allValues.Free() { Context = clContext RowCount = matrixLeft.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 0bea32dd..06d8ee7a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -32,7 +32,7 @@ module Matrix = let program = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, matrix.Columns.Length) @@ -42,18 +42,9 @@ module Matrix = let ndRange = Range1D.CreateValid(matrix.Columns.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - matrix.Columns.Length - matrix.RowPointers.Length - matrix.RowPointers - rows) - ) + kernel.KernelFunc ndRange matrix.Columns.Length matrix.RowPointers.Length matrix.RowPointers rows - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel rows @@ -77,7 +68,7 @@ module Matrix = let program = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (row: int) (column: int) (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) (row: int) (column: int) (matrix: ClMatrix.CSR<'a>) -> if row < 0 || row >= matrix.RowCount then failwith "Row out of range" @@ -91,13 +82,9 @@ module Matrix = let ndRange = Range1D.CreateValid(1, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange row column matrix.RowPointers matrix.Columns matrix.Values result) - ) + kernel.KernelFunc ndRange row column matrix.RowPointers matrix.Columns matrix.Values result - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel result @@ -128,7 +115,7 @@ module Matrix = let blitData = ClArray.blit clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode startIndex count (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode startIndex count (matrix: ClMatrix.CSR<'a>) -> if count <= 0 then failwith "Count must be greater than zero" @@ -153,19 +140,9 @@ module Matrix = let ndRange = Range1D.CreateValid(matrix.Columns.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - startIndex - matrix.RowPointers.Length - matrix.RowPointers - rows) - ) + kernel.KernelFunc ndRange resultLength startIndex matrix.RowPointers.Length matrix.RowPointers rows - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel let startPosition = rowPointers.[startIndex] @@ -202,14 +179,14 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = prepare processor allocationMode matrix let cols = - copy processor allocationMode matrix.Columns + copy processor allocationMode matrix.Columns matrix.Columns.Length let values = - copyData processor allocationMode matrix.Values + copyData processor allocationMode matrix.Values matrix.Values.Length { Context = clContext RowCount = matrix.RowCount @@ -228,10 +205,10 @@ module Matrix = let prepare = expandRowPointers clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = prepare processor allocationMode matrix - processor.Post(Msg.CreateFreeMsg(matrix.RowPointers)) + matrix.RowPointers.Free() { Context = clContext RowCount = matrix.RowCount @@ -298,7 +275,7 @@ module Matrix = let toCSRInPlace = COO.Matrix.toCSRInPlace clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOOInPlace queue allocationMode matrix |> transposeInPlace queue |> toCSRInPlace queue allocationMode @@ -318,7 +295,7 @@ module Matrix = let toCSRInPlace = COO.Matrix.toCSRInPlace clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOO queue allocationMode matrix |> transposeInPlace queue |> toCSRInPlace queue allocationMode @@ -334,7 +311,7 @@ module Matrix = let getChunkIndices = ClArray.sub clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let getChunkValues = getChunkValues processor allocationMode matrix.Values @@ -372,7 +349,7 @@ module Matrix = let runLazy = byRowsLazy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> runLazy processor allocationMode matrix |> Seq.map (fun lazyValue -> lazyValue.Value) @@ -385,7 +362,7 @@ module Matrix = let byRows = byRows clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = byRows processor allocationMode matrix |> Seq.toList @@ -407,7 +384,7 @@ module Matrix = let subtract = Backend.Common.Map.map <@ fun (fst, snd) -> snd - fst @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'b>) -> let pointerPairs = pairwise processor DeviceOnly matrix.RowPointers // since row pointers length in matrix always >= 2 @@ -417,6 +394,6 @@ module Matrix = let rowsLength = subtract processor allocationMode pointerPairs - pointerPairs.Free processor + pointerPairs.Free() rowsLength diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs index 8376053e..373cbceb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs @@ -161,7 +161,7 @@ module Merge = let kernel = clContext.Compile(merge) - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let firstLength = leftMatrix.Columns.Length let secondLength = rightMatrix.Columns.Length @@ -194,25 +194,21 @@ module Merge = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - leftMatrix.RowPointers - leftMatrix.Columns - leftMatrix.Values - rightMatrix.RowPointers - rightMatrix.Columns - rightMatrix.Values - allRows - allColumns - leftMergedValues - rightMergedValues - isEndOfRow - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + leftMatrix.RowPointers + leftMatrix.Columns + leftMatrix.Values + rightMatrix.RowPointers + rightMatrix.Columns + rightMatrix.Values + allRows + allColumns + leftMergedValues + rightMergedValues + isEndOfRow + isLeft + + processor.RunKernel kernel allRows, allColumns, leftMergedValues, rightMergedValues, isEndOfRow, isLeft diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index e13b889e..f77cd6bc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -19,7 +19,7 @@ module internal Common = let sum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> let resultLength = (sum processor positions).ToHostAndFree(processor) @@ -54,7 +54,7 @@ module internal Common = let sum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> let resultLength = (sum processor positions).ToHostAndFree(processor) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs index 9b3c2fbd..5435a6d8 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs @@ -13,7 +13,7 @@ module Matrix = let concatValues = ClArray.concat clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: LIL<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: LIL<'a>) -> let rowsPointers = matrix.Rows diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index b15c85e1..3af45c69 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -24,32 +24,32 @@ module Matrix = let vectorCopy = Sparse.Vector.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> ClMatrix.COO { Context = clContext RowCount = m.RowCount ColumnCount = m.ColumnCount - Rows = copy processor allocationMode m.Rows - Columns = copy processor allocationMode m.Columns - Values = copyData processor allocationMode m.Values } + Rows = copy processor allocationMode m.Rows m.Rows.Length + Columns = copy processor allocationMode m.Columns m.Columns.Length + Values = copyData processor allocationMode m.Values m.Values.Length } | ClMatrix.CSR m -> ClMatrix.CSR { Context = clContext RowCount = m.RowCount ColumnCount = m.ColumnCount - RowPointers = copy processor allocationMode m.RowPointers - Columns = copy processor allocationMode m.Columns - Values = copyData processor allocationMode m.Values } + RowPointers = copy processor allocationMode m.RowPointers m.RowPointers.Length + Columns = copy processor allocationMode m.Columns m.Columns.Length + Values = copyData processor allocationMode m.Values m.Values.Length } | ClMatrix.CSC m -> ClMatrix.CSC { Context = clContext RowCount = m.RowCount ColumnCount = m.ColumnCount - Rows = copy processor allocationMode m.Rows - ColumnPointers = copy processor allocationMode m.ColumnPointers - Values = copyData processor allocationMode m.Values } + Rows = copy processor allocationMode m.Rows m.Rows.Length + ColumnPointers = copy processor allocationMode m.ColumnPointers m.ColumnPointers.Length + Values = copyData processor allocationMode m.Values m.Values.Length } | ClMatrix.LIL matrix -> matrix.Rows |> List.map (Option.map (vectorCopy processor allocationMode)) @@ -75,7 +75,7 @@ module Matrix = let vectorCopyTo = Sparse.Vector.copyTo clContext workGroupSize - fun (processor: MailboxProcessor<_>) (source: ClMatrix<'a>) (destination: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) (source: ClMatrix<'a>) (destination: ClMatrix<'a>) -> if source.NNZ <> destination.NNZ || source.RowCount <> destination.RowCount || source.ColumnCount <> destination.ColumnCount then @@ -119,7 +119,7 @@ module Matrix = let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> toCSR processor allocationMode m |> ClMatrix.CSR | ClMatrix.CSR _ -> copy processor allocationMode matrix @@ -144,7 +144,7 @@ module Matrix = let transposeInPlace = CSR.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> toCSRInPlace processor allocationMode m @@ -171,7 +171,7 @@ module Matrix = let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> copy processor allocationMode matrix | ClMatrix.CSR m -> toCOO processor allocationMode m |> ClMatrix.COO @@ -198,7 +198,7 @@ module Matrix = let transposeInPlace = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> matrix | ClMatrix.CSR m -> @@ -229,7 +229,7 @@ module Matrix = let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> copy processor allocationMode matrix | ClMatrix.CSR m -> @@ -262,7 +262,7 @@ module Matrix = let transposeCOOInPlace = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> matrix | ClMatrix.CSR m -> @@ -292,7 +292,7 @@ module Matrix = let CSRToLIL = CSR.Matrix.toLIL clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC m -> m.ToCSR @@ -325,7 +325,7 @@ module Matrix = let COOTransposeInPlace = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) matrix -> + fun (processor: RawCommandQueue) matrix -> match matrix with | ClMatrix.COO m -> COOTransposeInPlace processor m |> ClMatrix.COO | ClMatrix.CSR m -> ClMatrix.CSC m.ToCSC @@ -352,7 +352,7 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix -> + fun (processor: RawCommandQueue) allocationMode matrix -> match matrix with | ClMatrix.COO m -> COOTranspose processor allocationMode m @@ -361,17 +361,17 @@ module Matrix = { Context = m.Context RowCount = m.ColumnCount ColumnCount = m.RowCount - Rows = copy processor allocationMode m.Columns - ColumnPointers = copy processor allocationMode m.RowPointers - Values = copyData processor allocationMode m.Values } + Rows = copy processor allocationMode m.Columns m.Columns.Length + ColumnPointers = copy processor allocationMode m.RowPointers m.RowPointers.Length + Values = copyData processor allocationMode m.Values m.Values.Length } |> ClMatrix.CSC | ClMatrix.CSC m -> { Context = m.Context RowCount = m.ColumnCount ColumnCount = m.RowCount - RowPointers = copy processor allocationMode m.ColumnPointers - Columns = copy processor allocationMode m.Rows - Values = copyData processor allocationMode m.Values } + RowPointers = copy processor allocationMode m.ColumnPointers m.ColumnPointers.Length + Columns = copy processor allocationMode m.Rows m.Rows.Length + Values = copyData processor allocationMode m.Values m.Values.Length } |> ClMatrix.CSR | ClMatrix.LIL _ -> failwith "Not yet implemented" diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index c4176b66..bc628250 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -1,23 +1,23 @@ namespace GraphBLAS.FSharp.Objects open Brahma.FSharp -open GraphBLAS.FSharp.Objects.MailboxProcessorExtensions module ArraysExtensions = type ClArray<'a> with - member this.FreeAndWait(q: MailboxProcessor) = - q.Post(Msg.CreateFreeMsg this) - finish q + member this.FreeAndWait(q: RawCommandQueue) = + this.Dispose() + q.Synchronize() - member this.ToHost(q: MailboxProcessor) = + member this.ToHost(q: RawCommandQueue) = let dst = Array.zeroCreate this.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) + q.ToHost(this, dst, true) + dst - member this.Free(q: MailboxProcessor<_>) = q.Post <| Msg.CreateFreeMsg this + member this.Free() = this.Dispose() - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q - this.Free q + this.Free() result diff --git a/src/GraphBLAS-sharp.Backend/Objects/ClCellExtensions.fs b/src/GraphBLAS-sharp.Backend/Objects/ClCellExtensions.fs index 20334aae..f6d44184 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ClCellExtensions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ClCellExtensions.fs @@ -4,14 +4,15 @@ open Brahma.FSharp module ClCellExtensions = type ClCell<'a> with - member this.ToHost(processor: MailboxProcessor<_>) = - processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(this, (Array.zeroCreate<'a> 1), ch)).[0] + member this.ToHost(processor: RawCommandQueue) = + let res = Array.zeroCreate<'a> 1 + processor.ToHost(this, res, true) + res.[0] - member this.Free(processor: MailboxProcessor<_>) = - processor.Post(Msg.CreateFreeMsg<_>(this)) + member this.Free() = this.Dispose() - member this.ToHostAndFree(processor: MailboxProcessor<_>) = + member this.ToHostAndFree(processor: RawCommandQueue) = let result = this.ToHost processor - this.Free processor + this.Dispose() result diff --git a/src/GraphBLAS-sharp.Backend/Objects/Common.fs b/src/GraphBLAS-sharp.Backend/Objects/Common.fs index 9efb172a..8c722ee0 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Common.fs @@ -3,4 +3,4 @@ open Brahma.FSharp type IDeviceMemObject = - abstract Dispose : MailboxProcessor -> unit + abstract Dispose : unit -> unit diff --git a/src/GraphBLAS-sharp.Backend/Objects/MailboxProcessorExtensions.fs b/src/GraphBLAS-sharp.Backend/Objects/MailboxProcessorExtensions.fs deleted file mode 100644 index fb56045c..00000000 --- a/src/GraphBLAS-sharp.Backend/Objects/MailboxProcessorExtensions.fs +++ /dev/null @@ -1,6 +0,0 @@ -namespace GraphBLAS.FSharp.Objects - -open Brahma.FSharp - -module MailboxProcessorExtensions = - let finish (q: MailboxProcessor) = q.PostAndReply(Msg.MsgNotifyMe) diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 901cb6c3..24062848 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -2,7 +2,6 @@ namespace GraphBLAS.FSharp.Objects open Brahma.FSharp open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Objects.MailboxProcessorExtensions type MatrixFormat = | CSR @@ -20,12 +19,12 @@ module ClMatrix = Values: ClArray<'elem> } interface IDeviceMemObject with - member this.Dispose q = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Columns)) - q.Post(Msg.CreateFreeMsg<_>(this.RowPointers)) + member this.Dispose() = + this.Values.Dispose() + this.Columns.Dispose() + this.RowPointers.Dispose() - member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -46,13 +45,12 @@ module ClMatrix = Values: ClArray<'elem> } interface IDeviceMemObject with - member this.Dispose q = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Rows)) - q.Post(Msg.CreateFreeMsg<_>(this.ColumnPointers)) - finish q + member this.Dispose() = + this.Values.Dispose() + this.Rows.Dispose() + this.ColumnPointers.Dispose() - member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -73,13 +71,12 @@ module ClMatrix = Values: ClArray<'elem> } interface IDeviceMemObject with - member this.Dispose q = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Columns)) - q.Post(Msg.CreateFreeMsg<_>(this.Rows)) - finish q + member this.Dispose() = + this.Values.Dispose() + this.Columns.Dispose() + this.Rows.Dispose() - member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -90,10 +87,10 @@ module ClMatrix = Rows: ClVector.Sparse<'elem> option list } interface IDeviceMemObject with - member this.Dispose q = + member this.Dispose() = this.Rows |> Seq.choose id - |> Seq.iter (fun vector -> vector.Dispose q) + |> Seq.iter (fun vector -> vector.Dispose()) member this.NNZ = this.Rows @@ -111,13 +108,12 @@ module ClMatrix = Values: ClArray<'elem> } interface IDeviceMemObject with - member this.Dispose q = - q.Post(Msg.CreateFreeMsg<_>(this.RowIndices)) - q.Post(Msg.CreateFreeMsg<_>(this.ColumnIndices)) - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - finish q + member this.Dispose() = + this.RowIndices.Dispose() + this.ColumnIndices.Dispose() + this.Values.Dispose() - member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -166,12 +162,12 @@ type ClMatrix<'a when 'a: struct> = /// /// Release device resources allocated for the matrix. /// - member this.Dispose q = + member this.Dispose() = match this with - | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.LIL matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose() + | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose() + | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose() + | ClMatrix.LIL matrix -> (matrix :> IDeviceMemObject).Dispose() /// /// Gets the number of non-zero elements in matrix. diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index e7a221f1..4d100afa 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -15,11 +15,11 @@ module ClVector = Size: int } interface IDeviceMemObject with - member this.Dispose(q) = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Indices)) + member this.Dispose() = + this.Values.Dispose() + this.Indices.Dispose() - member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -48,7 +48,7 @@ type ClVector<'a when 'a: struct> = /// /// Release device resources allocated for the vector. /// - member this.Dispose(q) = + member this.Dispose() = match this with - | Sparse vector -> vector.Dispose(q) - | Dense vector -> vector.FreeAndWait(q) + | Sparse vector -> vector.Dispose() + | Dense vector -> vector.Free() diff --git a/src/GraphBLAS-sharp.Backend/Operations/Kronecker.fs b/src/GraphBLAS-sharp.Backend/Operations/Kronecker.fs index 9ff810bf..aa1469df 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/Kronecker.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/Kronecker.fs @@ -41,7 +41,7 @@ module internal Kronecker = let updateBitmap = clContext.Compile <| updateBitmap op - fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrixRight: CSR<'b>) (bitmap: ClArray) -> + fun (processor: RawCommandQueue) (operand: ClCell<'a>) (matrixRight: CSR<'b>) (bitmap: ClArray) -> let resultLength = matrixRight.NNZ + 1 @@ -54,13 +54,9 @@ module internal Kronecker = matrixRight.ColumnCount * matrixRight.RowCount - matrixRight.NNZ - processor.Post( - Msg.MsgSetArguments - (fun () -> - updateBitmap.KernelFunc ndRange operand matrixRight.NNZ numberOfZeros matrixRight.Values bitmap) - ) + updateBitmap.KernelFunc ndRange operand matrixRight.NNZ numberOfZeros matrixRight.Values bitmap - processor.Post(Msg.CreateRunMsg<_, _> updateBitmap) + processor.RunKernel(updateBitmap) let private getAllocationSize (clContext: ClContext) workGroupSize op = @@ -76,7 +72,7 @@ module internal Kronecker = let opOnHost = op.Evaluate() - fun (queue: MailboxProcessor<_>) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> + fun (queue: RawCommandQueue) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> let nnz = match opOnHost None None with @@ -100,11 +96,11 @@ module internal Kronecker = updateBitmap queue value matrixRight bitmap - value.Free queue + value.Free() let bitmapSum = sum queue bitmap - bitmap.Free queue + bitmap.Free() let leftZeroCount = matrixLeft.ColumnCount * matrixLeft.RowCount @@ -142,7 +138,7 @@ module internal Kronecker = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrix: CSR<'b>) (resultDenseMatrix: ClArray<'c>) (resultBitmap: ClArray) -> + fun (processor: RawCommandQueue) (operand: ClCell<'a>) (matrix: CSR<'b>) (resultDenseMatrix: ClArray<'c>) (resultBitmap: ClArray) -> let resultLength = matrix.RowCount * matrix.ColumnCount @@ -151,22 +147,19 @@ module internal Kronecker = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - operand - matrix.RowCount - matrix.ColumnCount - matrix.Values - matrix.RowPointers - matrix.Columns - resultBitmap - resultDenseMatrix) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + + kernel.KernelFunc + ndRange + operand + matrix.RowCount + matrix.ColumnCount + matrix.Values + matrix.RowPointers + matrix.Columns + resultBitmap + resultDenseMatrix + + processor.RunKernel kernel let private setPositions<'c when 'c: struct> (clContext: ClContext) workGroupSize = @@ -193,7 +186,7 @@ module internal Kronecker = let scan = Common.PrefixSum.standardIncludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) rowCount columnCount (rowOffset: int) (columnOffset: int) (startIndex: int) (resultMatrix: COO<'c>) (values: ClArray<'c>) (bitmap: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (rowOffset: int) (columnOffset: int) (startIndex: int) (resultMatrix: COO<'c>) (values: ClArray<'c>) (bitmap: ClArray) -> let sum = scan processor bitmap @@ -205,27 +198,23 @@ module internal Kronecker = let rowOffset = rowOffset |> clContext.CreateClCell let columnOffset = columnOffset |> clContext.CreateClCell - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - startIndex - rowOffset - columnOffset - bitmap - values - resultMatrix.Rows - resultMatrix.Columns - resultMatrix.Values) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - rowOffset.Free processor - columnOffset.Free processor + kernel.KernelFunc + ndRange + rowCount + columnCount + startIndex + rowOffset + columnOffset + bitmap + values + resultMatrix.Rows + resultMatrix.Columns + resultMatrix.Values + + processor.RunKernel kernel + + rowOffset.Free() + columnOffset.Free() (sum.ToHostAndFree processor) + startIndex @@ -245,7 +234,7 @@ module internal Kronecker = let kernel = clContext.Compile <| copyToResult - fun (processor: MailboxProcessor<_>) startIndex (rowOffset: int) (columnOffset: int) (resultMatrix: COO<'c>) (sourceMatrix: COO<'c>) -> + fun (processor: RawCommandQueue) startIndex (rowOffset: int) (columnOffset: int) (resultMatrix: COO<'c>) (sourceMatrix: COO<'c>) -> let ndRange = Range1D.CreateValid(sourceMatrix.NNZ, workGroupSize) @@ -255,27 +244,23 @@ module internal Kronecker = let rowOffset = rowOffset |> clContext.CreateClCell let columnOffset = columnOffset |> clContext.CreateClCell - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - startIndex - sourceMatrix.NNZ - rowOffset - columnOffset - sourceMatrix.Rows - sourceMatrix.Columns - sourceMatrix.Values - resultMatrix.Rows - resultMatrix.Columns - resultMatrix.Values) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - rowOffset.Free processor - columnOffset.Free processor + kernel.KernelFunc + ndRange + startIndex + sourceMatrix.NNZ + rowOffset + columnOffset + sourceMatrix.Rows + sourceMatrix.Columns + sourceMatrix.Values + resultMatrix.Rows + resultMatrix.Columns + resultMatrix.Values + + processor.RunKernel kernel + + rowOffset.Free() + columnOffset.Free() let private insertZero (clContext: ClContext) workGroupSize = @@ -348,12 +333,12 @@ module internal Kronecker = preparePositions queue value matrixRight mappedMatrix bitmap - value.Free queue + value.Free() startIndex <- setPositions rowOffset columnOffset startIndex resultMatrix mappedMatrix bitmap - bitmap.Free queue - mappedMatrix.Free queue + bitmap.Free() + mappedMatrix.Free() startIndex @@ -367,7 +352,7 @@ module internal Kronecker = let insertZero = insertZero clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (resultNNZ: int) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (resultNNZ: int) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> let resultRows = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultNNZ) @@ -436,9 +421,9 @@ module internal Kronecker = let mapAll = mapAll clContext workGroupSize op let bitonic = - Common.Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize + Common.Sort.Bitonic.sortRowsColumnsValuesInplace clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> let matrixZero = mapWithValue queue allocationMode None matrixRight @@ -447,16 +432,14 @@ module internal Kronecker = getSize queue matrixZero matrixLeft matrixRight if size = 0 then - matrixZero - |> Option.iter (fun m -> m.Dispose queue) + matrixZero |> Option.iter (fun m -> m.Dispose()) None else let result = mapAll queue allocationMode size matrixZero matrixLeft matrixRight - matrixZero - |> Option.iter (fun m -> m.Dispose queue) + matrixZero |> Option.iter (fun m -> m.Dispose()) bitonic queue result.Rows result.Columns result.Values diff --git a/src/GraphBLAS-sharp.Backend/Operations/Operations.fs b/src/GraphBLAS-sharp.Backend/Operations/Operations.fs index 2e99b7dc..ff06f1d5 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/Operations.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/Operations.fs @@ -29,7 +29,7 @@ module Operations = let mapDense = Dense.Vector.map op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix -> + fun (processor: RawCommandQueue) allocationMode matrix -> match matrix with | ClVector.Sparse v -> mapSparse processor allocationMode v @@ -58,7 +58,7 @@ module Operations = let map2Sparse = Sparse.Vector.map2 op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Dense left, ClVector.Dense right -> map2Dense processor allocationMode left right @@ -88,7 +88,7 @@ module Operations = let map2Dense = Dense.Vector.map2AtLeastOne op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Sparse left, ClVector.Sparse right -> Option.map ClVector.Sparse (map2Sparse processor allocationMode left right) @@ -112,7 +112,7 @@ module Operations = let map2Dense = Dense.Vector.map2InPlace map clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Dense left, ClVector.Dense right -> map2Dense processor left right left | _ -> failwith "Unsupported vector format" @@ -131,7 +131,7 @@ module Operations = let map2Dense = Dense.Vector.map2InPlace map clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) (resultVector: ClVector<'c>) -> + fun (processor: RawCommandQueue) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) (resultVector: ClVector<'c>) -> match leftVector, rightVector, resultVector with | ClVector.Dense left, ClVector.Dense right, ClVector.Dense result -> map2Dense processor left right result @@ -151,7 +151,7 @@ module Operations = let map2Dense = Dense.Vector.map2 map clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Dense left, ClVector.Dense right -> map2Dense processor allocationFlag left right | _ -> failwith "Unsupported vector format" @@ -173,7 +173,7 @@ module Operations = let map2SparseDense = Sparse.Map2.runSparseDense map clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Sparse left, ClVector.Sparse right -> Option.map ClVector.Sparse (map2Sparse processor allocationFlag left right) @@ -202,7 +202,7 @@ module Operations = let transposeCOO = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix -> + fun (processor: RawCommandQueue) allocationMode matrix -> match matrix with | ClMatrix.COO m -> mapCOO processor allocationMode m |> ClMatrix.COO | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.COO @@ -235,7 +235,7 @@ module Operations = let transposeCOO = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> + fun (processor: RawCommandQueue) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> map2COO processor allocationMode m1 m2 @@ -272,7 +272,7 @@ module Operations = let COOTranspose = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> + fun (processor: RawCommandQueue) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> COOMap2 processor allocationMode m1 m2 @@ -304,7 +304,7 @@ module Operations = let runTo = SpMV.runTo add mul clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) (result: ClVector<'c>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) (result: ClVector<'c>) -> match matrix, vector, result with | ClMatrix.CSR m, ClVector.Dense v, ClVector.Dense r -> runTo queue m v r | _ -> failwith "Not implemented yet" @@ -325,7 +325,7 @@ module Operations = let run = SpMV.run add mul clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationFlag (matrix: ClMatrix<'a>) (vector: ClVector<'b>) -> + fun (queue: RawCommandQueue) allocationFlag (matrix: ClMatrix<'a>) (vector: ClVector<'b>) -> match matrix, vector with | ClMatrix.CSR m, ClVector.Dense v -> run queue allocationFlag m v |> ClVector.Dense | _ -> failwith "Not implemented yet" @@ -347,7 +347,7 @@ module Operations = let run = SpMSpV.runBoolStandard add mul clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix) (vector: ClVector) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix) (vector: ClVector) -> match matrix, vector with | ClMatrix.CSR m, ClVector.Sparse v -> Option.map ClVector.Sparse (run queue m v) | _ -> failwith "Not implemented yet" @@ -369,7 +369,7 @@ module Operations = let run = SpMSpV.run add mul clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) -> match matrix, vector with | ClMatrix.CSR m, ClVector.Sparse v -> Option.map ClVector.Sparse (run queue m v) | _ -> failwith "Not implemented yet" @@ -386,7 +386,7 @@ module Operations = let kronecker (op: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = let run = Kronecker.run clContext workGroupSize op - fun (queue: MailboxProcessor<_>) allocationFlag (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) -> + fun (queue: RawCommandQueue) allocationFlag (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) -> match matrix1, matrix2 with | ClMatrix.CSR m1, ClMatrix.CSR m2 -> let result = run queue allocationFlag m1 m2 @@ -414,7 +414,7 @@ module Operations = let runCSRnCSC = SpGeMM.Masked.run opAdd opMul clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> + fun (queue: RawCommandQueue) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> match matrix1, matrix2, mask with | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" @@ -436,7 +436,7 @@ module Operations = let run = SpGeMM.Expand.run opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> match leftMatrix, rightMatrix with | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> let allocCapacity = @@ -476,7 +476,7 @@ module Operations = let run = SpGeMM.Expand.COO.run opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> match leftMatrix, rightMatrix with | ClMatrix.COO leftMatrix, ClMatrix.CSR rightMatrix -> let allocCapacity = diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs index 45ff0df0..6980c017 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs @@ -20,7 +20,7 @@ module internal Expand = let prefixSum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrixColumns: ClArray) (rightMatrixRowsLengths: ClArray) -> + fun (processor: RawCommandQueue) (leftMatrixColumns: ClArray) (rightMatrixRowsLengths: ClArray) -> let segmentsLengths = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixColumns.Length) @@ -31,7 +31,7 @@ module internal Expand = // compute pointers let length = (prefixSum processor segmentsLengths) - .ToHostAndFree processor + .ToHostAndFree(processor) length, segmentsLengths @@ -48,7 +48,7 @@ module internal Expand = let scatter = Common.Scatter.lastOccurrence clContext workGroupSize - fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: ClArray) (rows: ClArray) -> + fun (processor: RawCommandQueue) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: ClArray) (rows: ClArray) -> let positions = getBitmap processor DeviceOnly firstValues secondValues @@ -58,7 +58,7 @@ module internal Expand = .ToHostAndFree(processor) if resultLength = 0 then - positions.Free processor + positions.Free() None else @@ -77,7 +77,7 @@ module internal Expand = assignValues processor firstValues secondValues positions resultValues - positions.Free processor + positions.Free() Some(resultValues, resultColumns, resultRows) @@ -112,14 +112,14 @@ module internal Expand = let rightMatrixGather = Common.Gather.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) (lengths: int) (segmentsPointers: ClArray) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) (lengths: int) (segmentsPointers: ClArray) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute left matrix positions let leftMatrixPositions = zeroCreate processor DeviceOnly lengths idScatter processor segmentsPointers leftMatrixPositions (maxPrefixSum processor leftMatrixPositions 0) - .Free processor + .Free() // Compute right matrix positions let rightMatrixPositions = create processor DeviceOnly lengths 1 @@ -131,7 +131,7 @@ module internal Expand = scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions - requiredRightMatrixPointers.Free processor + requiredRightMatrixPointers.Free() // another way to get offsets ??? let offsets = @@ -139,7 +139,7 @@ module internal Expand = segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets - offsets.Free processor + offsets.Free() // compute columns let columns = @@ -158,7 +158,7 @@ module internal Expand = leftMatrixGather processor leftMatrixPositions leftMatrix.Values leftMatrixValues - leftMatrixPositions.Free processor + leftMatrixPositions.Free() // compute right matrix values let rightMatrixValues = @@ -166,7 +166,7 @@ module internal Expand = rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues - rightMatrixPositions.Free processor + rightMatrixPositions.Free() // left, right matrix values, columns and rows indices leftMatrixValues, rightMatrixValues, columns, rows @@ -182,7 +182,7 @@ module internal Expand = let sortKeys = Common.Sort.Radix.standardRunKeysOnly clContext workGroupSize - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> + fun (processor: RawCommandQueue) (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> // sort by columns let valuesSortedByColumns = sortByKeyValues processor DeviceOnly columns values @@ -201,9 +201,9 @@ module internal Expand = let sortedRows = sortKeys processor rowsSortedByColumns - valuesSortedByColumns.Free processor - rowsSortedByColumns.Free processor - sortedColumns.Free processor + valuesSortedByColumns.Free() + rowsSortedByColumns.Free() + sortedColumns.Free() valuesSortedByRows, columnsSortedByRows, sortedRows @@ -221,26 +221,26 @@ module internal Expand = let idScatter = Common.Scatter.initFirstOccurrence Map.id clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> let bitmap = getUniqueBitmap processor DeviceOnly columns rows let uniqueKeysCount = (prefixSum processor bitmap) - .ToHostAndFree processor + .ToHostAndFree(processor) let offsets = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) idScatter processor bitmap offsets - bitmap.Free processor + bitmap.Free() let reduceResult = reduce processor allocationMode uniqueKeysCount offsets columns rows values - offsets.Free processor + offsets.Free() // reducedValues, reducedColumns, reducedRows option reduceResult @@ -259,13 +259,13 @@ module internal Expand = let reduce = reduce opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (rightMatrixRowsNNZ: ClArray) (rightMatrix: ClMatrix.CSR<'b>) (leftMatrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (rightMatrixRowsNNZ: ClArray) (rightMatrix: ClMatrix.CSR<'b>) (leftMatrix: ClMatrix.COO<'a>) -> let length, segmentPointers = getSegmentPointers processor leftMatrix.Columns rightMatrixRowsNNZ if length = 0 then - segmentPointers.Free processor + segmentPointers.Free() length, None else @@ -273,16 +273,16 @@ module internal Expand = let leftMatrixValues, rightMatrixValues, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix - segmentPointers.Free processor + segmentPointers.Free() // multiply let mulResult = multiply processor leftMatrixValues rightMatrixValues columns rows - leftMatrixValues.Free processor - rightMatrixValues.Free processor - columns.Free processor - rows.Free processor + leftMatrixValues.Free() + rightMatrixValues.Free() + columns.Free() + rows.Free() let result = mulResult @@ -292,17 +292,17 @@ module internal Expand = let sortedValues, sortedColumns, sortedRows = sort processor resultValues resultColumns resultRows - resultValues.Free processor - resultColumns.Free processor - resultRows.Free processor + resultValues.Free() + resultColumns.Free() + resultRows.Free() // addition let reduceResult = reduce processor allocationMode sortedValues sortedColumns sortedRows - sortedValues.Free processor - sortedColumns.Free processor - sortedRows.Free processor + sortedValues.Free() + sortedColumns.Free() + sortedRows.Free() reduceResult) @@ -316,7 +316,7 @@ module internal Expand = let expandRowPointers = CSR.Matrix.expandRowPointers clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix.CSR<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> let rows = expandRowPointers processor DeviceOnly leftMatrix @@ -332,7 +332,7 @@ module internal Expand = let _, result = runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix leftMatrixCOO - rows.Free processor + rows.Free() result |> Option.map @@ -360,7 +360,7 @@ module internal Expand = let runCOO = runCOO opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.CSR<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.CSR<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> // extract segment lengths by left matrix rows pointers let segmentPointersByLeftMatrixRows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) @@ -386,11 +386,11 @@ module internal Expand = // find largest row that fit into maxAllocSize let upperBound = - (upperBound currentBound).ToHostAndFree processor + (upperBound currentBound).ToHostAndFree(processor) let endRow = upperBound - 2 - currentBound.Free processor + currentBound.Free() // TODO(handle largest rows) // (we can split row, multiply and merge them but merge path needed) @@ -416,7 +416,7 @@ module internal Expand = let result = helper 0 0 [] |> List.rev - segmentPointersByLeftMatrixRows.Free processor + segmentPointersByLeftMatrixRows.Free() result @@ -438,7 +438,7 @@ module internal Expand = let runManySteps = runManySteps opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let rightMatrixRowsNNZ = getNNZInRows processor DeviceOnly rightMatrix @@ -449,7 +449,7 @@ module internal Expand = if generalLength = 0 then None elif generalLength < maxAllocSize then - segmentLengths.Free processor + segmentLengths.Free() runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix else @@ -464,8 +464,8 @@ module internal Expand = rightMatrixRowsNNZ rightMatrix - rightMatrixRowsNNZ.Free processor - segmentLengths.Free processor + rightMatrixRowsNNZ.Free() + segmentLengths.Free() match result with | _ :: _ -> @@ -482,13 +482,12 @@ module internal Expand = // TODO(overhead: compute result length 3 time) // release resources valuesList - |> List.iter (fun array -> array.Free processor) + |> List.iter (fun array -> array.Free()) columnsList - |> List.iter (fun array -> array.Free processor) + |> List.iter (fun array -> array.Free()) - rowsList - |> List.iter (fun array -> array.Free processor) + rowsList |> List.iter (fun array -> array.Free()) { Context = clContext RowCount = leftMatrix.RowCount @@ -505,7 +504,7 @@ module internal Expand = let runCOO = runCOO opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.COO<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix.COO<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> let _, result = runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix leftMatrix @@ -539,7 +538,7 @@ module internal Expand = let runCOO = runCOO opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.COO<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.COO<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> let leftRowPointers = compress processor allocationMode leftMatrix.Rows leftMatrix.RowCount @@ -569,11 +568,11 @@ module internal Expand = // find largest row that fit into maxAllocSize let upperBound = - (upperBound currentBound).ToHostAndFree processor + (upperBound currentBound).ToHostAndFree(processor) let endRow = upperBound - 2 - currentBound.Free processor + currentBound.Free() // TODO(handle largest rows) // (we can split row, multiply and merge them but merge path needed) @@ -599,7 +598,7 @@ module internal Expand = let result = helper 0 0 [] |> List.rev - segmentPointersByLeftMatrixRows.Free processor + segmentPointersByLeftMatrixRows.Free() result @@ -621,7 +620,7 @@ module internal Expand = let runManySteps = runManySteps opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode maxAllocSize (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let rightMatrixRowsNNZ = getNNZInRows processor DeviceOnly rightMatrix @@ -632,7 +631,7 @@ module internal Expand = if generalLength = 0 then None elif generalLength < maxAllocSize then - segmentLengths.Free processor + segmentLengths.Free() runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix else @@ -647,8 +646,8 @@ module internal Expand = rightMatrixRowsNNZ rightMatrix - rightMatrixRowsNNZ.Free processor - segmentLengths.Free processor + rightMatrixRowsNNZ.Free() + segmentLengths.Free() match result with | _ :: _ -> @@ -665,13 +664,12 @@ module internal Expand = // TODO(overhead: compute result length 3 time) // release resources valuesList - |> List.iter (fun array -> array.Free processor) + |> List.iter (fun array -> array.Free()) columnsList - |> List.iter (fun array -> array.Free processor) + |> List.iter (fun array -> array.Free()) - rowsList - |> List.iter (fun array -> array.Free processor) + rowsList |> List.iter (fun array -> array.Free()) { Context = clContext RowCount = leftMatrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Masked.fs b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Masked.fs index 8c4e600a..ab825f7f 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Masked.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Masked.fs @@ -7,6 +7,7 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClCellExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module internal Masked = let private calculate @@ -107,7 +108,7 @@ module internal Masked = let program = context.Compile(run) - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> + fun (queue: RawCommandQueue) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> let values = context.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, mask.NNZ) @@ -120,24 +121,20 @@ module internal Masked = let ndRange = Range1D.CreateValid(workGroupSize * mask.NNZ, workGroupSize) - queue.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - matrixLeft.RowPointers - matrixLeft.Columns - matrixLeft.Values - matrixRight.Rows - matrixRight.ColumnPointers - matrixRight.Values - mask.Rows - mask.Columns - values - bitmap) - ) - - queue.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + matrixLeft.RowPointers + matrixLeft.Columns + matrixLeft.Values + matrixRight.Rows + matrixRight.ColumnPointers + matrixRight.Values + mask.Rows + mask.Columns + values + bitmap + + queue.RunKernel(kernel) values, bitmap @@ -160,7 +157,7 @@ module internal Masked = let scanInPlace = Common.PrefixSum.standardExcludeInPlace context workGroupSize - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> + fun (queue: RawCommandQueue) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> let values, positions = calculate queue matrixLeft matrixRight mask @@ -176,8 +173,8 @@ module internal Masked = scatter queue positions mask.Columns resultColumns scatterData queue positions values resultValues - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(positions)) + values.Free() + positions.Free() { Context = context RowCount = matrixLeft.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpMSpV.fs b/src/GraphBLAS-sharp.Backend/Operations/SpMSpV.fs index 2ec56f1e..e4f61fea 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/SpMSpV.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/SpMSpV.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Operations +namespace GraphBLAS.FSharp.Backend.Operations open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common @@ -33,7 +33,7 @@ module SpMSpV = let collectRows = clContext.Compile collectRows - fun (queue: MailboxProcessor<_>) size (vectorIndices: ClArray) (rowOffsets: ClArray) -> + fun (queue: RawCommandQueue) size (vectorIndices: ClArray) (rowOffsets: ClArray) -> let ndRange = Range1D.CreateValid(size * 2 + 1, workGroupSize) @@ -44,11 +44,9 @@ module SpMSpV = let collectRows = collectRows.GetKernel() - queue.Post( - Msg.MsgSetArguments(fun () -> collectRows.KernelFunc ndRange size vectorIndices rowOffsets resultRows) - ) + collectRows.KernelFunc ndRange size vectorIndices rowOffsets resultRows - queue.Post(Msg.CreateRunMsg<_, _>(collectRows)) + queue.RunKernel(collectRows) resultRows @@ -69,15 +67,15 @@ module SpMSpV = let prepareOffsets = clContext.Compile prepareOffsets - fun (queue: MailboxProcessor<_>) size (input: ClArray) -> + fun (queue: RawCommandQueue) size (input: ClArray) -> let ndRange = Range1D.CreateValid(size, workGroupSize) let prepareOffsets = prepareOffsets.GetKernel() - queue.Post(Msg.MsgSetArguments(fun () -> prepareOffsets.KernelFunc ndRange size input)) + prepareOffsets.KernelFunc ndRange size input - queue.Post(Msg.CreateRunMsg<_, _>(prepareOffsets)) + queue.RunKernel(prepareOffsets) let resSize = (sum queue input).ToHostAndFree queue @@ -115,7 +113,7 @@ module SpMSpV = let gather = clContext.Compile gather - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> //Collect R[v] and R[v + 1] for each v in vector let collectedRows = @@ -126,7 +124,7 @@ module SpMSpV = computeOffsetsInplace queue (vector.NNZ * 2 + 1) collectedRows if gatherArraySize = 0 then - collectedRows.Free queue + collectedRows.Free() None else let ndRange = @@ -144,25 +142,21 @@ module SpMSpV = clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, gatherArraySize) if gatherArraySize > 0 then - queue.Post( - Msg.MsgSetArguments - (fun () -> - gather.KernelFunc - ndRange - vector.NNZ - collectedRows - matrix.RowPointers - matrix.Columns - matrix.Values - vector.Indices - resultRows - resultIndices - resultValues) - ) - - queue.Post(Msg.CreateRunMsg<_, _>(gather)) - - collectedRows.Free queue + gather.KernelFunc + ndRange + vector.NNZ + collectedRows + matrix.RowPointers + matrix.Columns + matrix.Values + vector.Indices + resultRows + resultIndices + resultValues + + queue.RunKernel gather + + collectedRows.Free() Some(resultRows, resultIndices, resultValues) @@ -185,7 +179,7 @@ module SpMSpV = let multiply = clContext.Compile multiply - fun (queue: MailboxProcessor<_>) (columnIndices: ClArray) (matrixValues: ClArray<'a>) (vector: Sparse<'b>) -> + fun (queue: RawCommandQueue) (columnIndices: ClArray) (matrixValues: ClArray<'a>) (vector: Sparse<'b>) -> let resultLength = columnIndices.Length @@ -197,21 +191,17 @@ module SpMSpV = let multiply = multiply.GetKernel() - queue.Post( - Msg.MsgSetArguments - (fun () -> - multiply.KernelFunc - ndRange - resultLength - vector.NNZ - columnIndices - matrixValues - vector.Indices - vector.Values - result) - ) - - queue.Post(Msg.CreateRunMsg<_, _>(multiply)) + multiply.KernelFunc + ndRange + resultLength + vector.NNZ + columnIndices + matrixValues + vector.Indices + vector.Values + result + + queue.RunKernel(multiply) result @@ -225,9 +215,8 @@ module SpMSpV = //TODO: Common.Gather? let gather = gather clContext workGroupSize - //TODO: Radix sort let sort = - Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize + Sort.Bitonic.sortRowsColumnsValuesInplace clContext workGroupSize let multiplyScalar = multiplyScalar clContext mul workGroupSize @@ -235,7 +224,7 @@ module SpMSpV = let segReduce = Reduce.ByKey.Option.segmentSequential add clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> gather queue matrix vector |> Option.map (fun (gatherRows, gatherIndices, gatherValues) -> @@ -246,8 +235,8 @@ module SpMSpV = let multipliedValues = multiplyScalar queue sortedRows sortedValues vector - sortedValues.Free queue - sortedRows.Free queue + sortedValues.Free() + sortedRows.Free() let result = segReduce queue DeviceOnly sortedIndices multipliedValues @@ -259,8 +248,8 @@ module SpMSpV = Values = reducedValues Size = matrix.ColumnCount }) - multipliedValues.Free queue - sortedIndices.Free queue + multipliedValues.Free() + sortedIndices.Free() result) |> Option.bind id @@ -276,7 +265,7 @@ module SpMSpV = let gather = gather clContext workGroupSize let sort = - Sort.Radix.standardRunKeysOnly clContext workGroupSize + Sort.Bitonic.sortRowsColumnsValuesInplace clContext workGroupSize let removeDuplicates = GraphBLAS.FSharp.ClArray.removeDuplications clContext workGroupSize @@ -284,20 +273,18 @@ module SpMSpV = let create = GraphBLAS.FSharp.ClArray.create clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> gather queue matrix vector |> Option.map (fun (gatherRows, gatherIndices, gatherValues) -> - gatherRows.Free queue - gatherValues.Free queue - - let sortedIndices = sort queue gatherIndices + sort queue gatherIndices gatherRows gatherValues - let resultIndices = removeDuplicates queue sortedIndices + let resultIndices = removeDuplicates queue gatherIndices - gatherIndices.Free queue - sortedIndices.Free queue + gatherIndices.Free() + gatherRows.Free() + gatherValues.Free() { Context = clContext Indices = resultIndices diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpMV.fs b/src/GraphBLAS-sharp.Backend/Operations/SpMV.fs index 34b5f821..374a4f7a 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/SpMV.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/SpMV.fs @@ -5,6 +5,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module internal SpMV = let runTo @@ -97,7 +98,7 @@ module internal SpMV = let multiplyValues = clContext.Compile multiplyValues let reduceValuesByRows = clContext.Compile reduceValuesByRows - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) (result: ClArray<'c option>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) (result: ClArray<'c option>) -> let matrixLength = matrix.Values.Length @@ -112,36 +113,17 @@ module internal SpMV = let multiplyValues = multiplyValues.GetKernel() - queue.Post( - Msg.MsgSetArguments - (fun () -> - multiplyValues.KernelFunc - ndRange1 - matrixLength - matrix.Columns - matrix.Values - vector - intermediateArray) - ) + multiplyValues.KernelFunc ndRange1 matrixLength matrix.Columns matrix.Values vector intermediateArray - queue.Post(Msg.CreateRunMsg<_, _>(multiplyValues)) + queue.RunKernel multiplyValues let reduceValuesByRows = reduceValuesByRows.GetKernel() - queue.Post( - Msg.MsgSetArguments - (fun () -> - reduceValuesByRows.KernelFunc - ndRange2 - matrix.RowCount - intermediateArray - matrix.RowPointers - result) - ) + reduceValuesByRows.KernelFunc ndRange2 matrix.RowCount intermediateArray matrix.RowPointers result - queue.Post(Msg.CreateRunMsg<_, _>(reduceValuesByRows)) + queue.RunKernel reduceValuesByRows - queue.Post(Msg.CreateFreeMsg intermediateArray) + intermediateArray.Free() let run (add: Expr<'c option -> 'c option -> 'c option>) @@ -151,7 +133,7 @@ module internal SpMV = = let runTo = runTo add mul clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) -> let result = clContext.CreateClArrayWithSpecificAllocationMode<'c option>(allocationMode, matrix.RowCount) diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index 6b6a7629..36a74c67 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects.ClVector open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClCellExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module Vector = let map<'a, 'b when 'a: struct and 'b: struct> @@ -18,7 +19,7 @@ module Vector = let map = Map.map op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClArray<'a option>) -> map processor allocationMode leftVector @@ -31,7 +32,7 @@ module Vector = let map2InPlace = Map.map2InPlace opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + fun (processor: RawCommandQueue) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> map2InPlace processor leftVector rightVector resultVector @@ -43,7 +44,7 @@ module Vector = let map2 = Map.map2 opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> map2 processor allocationMode leftVector rightVector @@ -66,7 +67,7 @@ module Vector = let kernel = clContext.Compile(fillSubVectorKernel) - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: 'a) (resultVector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: 'a) (resultVector: ClArray<'a option>) -> let ndRange = Range1D.CreateValid(leftVector.Length, workGroupSize) @@ -75,14 +76,11 @@ module Vector = let valueCell = clContext.CreateClCell(value) - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange leftVector.Length leftVector maskVector valueCell resultVector) - ) + kernel.KernelFunc ndRange leftVector.Length leftVector maskVector valueCell resultVector - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel - valueCell.Free processor + valueCell.Free() let assignByMask<'a, 'b when 'a: struct and 'b: struct> (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) @@ -93,7 +91,7 @@ module Vector = let assignByMask = assignByMaskInPlace maskOp clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: 'a) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: 'a) -> let resultVector = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftVector.Length) @@ -118,7 +116,7 @@ module Vector = let kernel = clContext.Compile(fillSubVectorKernel) - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: Sparse<'b>) (value: 'a) (resultVector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) (leftVector: ClArray<'a option>) (maskVector: Sparse<'b>) (value: 'a) (resultVector: ClArray<'a option>) -> let ndRange = Range1D.CreateValid(maskVector.NNZ, workGroupSize) @@ -127,22 +125,20 @@ module Vector = let valueCell = clContext.CreateClCell(value) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - maskVector.NNZ - leftVector - maskVector.Indices - maskVector.Values - valueCell - resultVector) - ) + kernel.KernelFunc + ndRange + maskVector.NNZ + leftVector + maskVector.Indices + maskVector.Values + valueCell + resultVector - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - valueCell.Free processor + processor.RunKernel kernel + + + valueCell.Free() let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize = @@ -164,7 +160,7 @@ module Vector = let allValues = Map.map (Map.optionToValueOrZero Unchecked.defaultof<'a>) clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClArray<'a option>) -> let positions = getBitmap processor DeviceOnly vector @@ -181,7 +177,7 @@ module Vector = scatterIndices processor positions allIndices resultIndices - processor.Post <| Msg.CreateFreeMsg<_>(allIndices) + allIndices.Free() // compute result values let resultValues = @@ -191,9 +187,65 @@ module Vector = scatterValues processor positions allValues resultValues - processor.Post <| Msg.CreateFreeMsg<_>(allValues) + allValues.Free() + + positions.Free() + + { Context = clContext + Indices = resultIndices + Values = resultValues + Size = vector.Length } + + let toSparse2<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) (inputLength: int) (inputValues: ClArray<'a option>) (resultSize: ClCell) (resultIndices: ClArray) (resultValues: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < inputLength then + match inputValues.[gid] with + | Some v -> + let offset = atomic (+) resultSize.Value 1 + resultIndices.[offset] <- gid + resultValues.[offset] <- v + | None -> () @> + + let kernel = clContext.Compile kernel + + let copy = ClArray.copy clContext workGroupSize + let copyValues = ClArray.copy clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (vector: ClArray<'a option>) -> + + let tempIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Length) + + let tempValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, vector.Length) + + let resultLengthCell = clContext.CreateClCell(0) + + let ndRange = + Range1D.CreateValid(vector.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc ndRange vector.Length vector resultLengthCell tempIndices tempValues + + processor.RunKernel kernel + + let resultLength = + resultLengthCell.ToHostAndFree(processor) + + let resultIndices = + copy processor allocationMode tempIndices resultLength + + let resultValues = + copyValues processor allocationMode tempValues resultLength - processor.Post <| Msg.CreateFreeMsg<_>(positions) + tempIndices.Free() + tempValues.Free() { Context = clContext Indices = resultIndices @@ -208,13 +260,13 @@ module Vector = let reduce = Common.Reduce.reduce opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) (vector: ClArray<'a option>) -> choose processor DeviceOnly vector |> function | Some values -> let result = reduce processor values - processor.Post(Msg.CreateFreeMsg<_>(values)) + values.Free() result | None -> clContext.CreateClCell Unchecked.defaultof<'a> @@ -229,7 +281,7 @@ module Vector = let map = Backend.Common.Map.map <@ Some @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode size (elements: (int * 'a) list) -> + fun (processor: RawCommandQueue) allocationMode size (elements: (int * 'a) list) -> let indices, values = elements |> Array.ofList |> Array.unzip let values = @@ -244,8 +296,8 @@ module Vector = scatter processor indices mappedValues result - processor.Post(Msg.CreateFreeMsg(mappedValues)) - processor.Post(Msg.CreateFreeMsg(indices)) - processor.Post(Msg.CreateFreeMsg(values)) + mappedValues.Free() + indices.Free() + values.Free() result diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs index 8ad13044..ab10edc8 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs @@ -12,7 +12,7 @@ module internal Common = let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = let sum = - Common.PrefixSum.standardExcludeInPlace clContext workGroupSize + Common.ScanInternal.standardExcludeInPlace clContext workGroupSize let valuesScatter = Common.Scatter.lastOccurrence clContext workGroupSize @@ -20,7 +20,7 @@ module internal Common = let indicesScatter = Common.Scatter.lastOccurrence clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> let resultLength = (sum processor positions).ToHostAndFree(processor) @@ -40,7 +40,7 @@ module internal Common = let setPositionsOption<'a when 'a: struct> (clContext: ClContext) workGroupSize = let sum = - Common.PrefixSum.standardExcludeInPlace clContext workGroupSize + Common.ScanInternal.standardExcludeInPlace clContext workGroupSize let valuesScatter = Common.Scatter.lastOccurrence clContext workGroupSize @@ -48,7 +48,7 @@ module internal Common = let indicesScatter = Common.Scatter.lastOccurrence clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> let resultLength = (sum processor positions).ToHostAndFree(processor) @@ -77,7 +77,7 @@ module internal Common = let mapIndices = Common.Map.mapWithValue clContext workGroupSize <@ fun x y -> x + y @> - fun (processor: MailboxProcessor<_>) allocationMode (vectors: Sparse<'a> seq) -> + fun (processor: RawCommandQueue) allocationMode (vectors: Sparse<'a> seq) -> let vectorIndices, _ = vectors diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs index f0a69a41..82ba61fe 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -37,7 +37,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) (size: int) (values: ClArray<'a>) (indices: ClArray) -> + fun (processor: RawCommandQueue) (size: int) (values: ClArray<'a>) (indices: ClArray) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, size) @@ -52,21 +52,9 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - size - values.Length - values - indices - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange size values.Length values indices resultBitmap resultValues resultIndices + + processor.RunKernel kernel resultBitmap, resultValues, resultIndices @@ -82,7 +70,7 @@ module internal Map = let setPositions = Common.setPositions<'b> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> + fun (queue: RawCommandQueue) allocationMode (vector: ClVector.Sparse<'a>) -> let bitmap, values, indices = map queue vector.Size vector.Values vector.Indices @@ -90,9 +78,9 @@ module internal Map = let resultValues, resultIndices = setPositions queue allocationMode values indices bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(indices)) + bitmap.Free() + values.Free() + indices.Free() { Context = clContext Indices = resultIndices @@ -122,7 +110,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) (value: ClCell<'a option>) (vector: Sparse<'b>) -> + fun (processor: RawCommandQueue) (value: ClCell<'a option>) (vector: Sparse<'b>) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Size) @@ -138,22 +126,18 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - value - vector.Size - vector.Values.Length - vector.Indices - vector.Values - resultIndices - resultValues - resultBitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + value + vector.Size + vector.Values.Length + vector.Indices + vector.Values + resultIndices + resultValues + resultBitmap + + processor.RunKernel kernel resultIndices, resultValues, resultBitmap @@ -176,21 +160,21 @@ module internal Map = let init = ClArray.init <@ id @> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (value: 'a option) size -> + fun (queue: RawCommandQueue) allocationMode (value: 'a option) size -> function | Some vector -> let valueClCell = clContext.CreateClCell value let indices, values, bitmap = map queue valueClCell vector - valueClCell.Free queue + valueClCell.Free() let result = setPositions queue allocationMode values indices bitmap - indices.Free queue - values.Free queue - bitmap.Free queue + indices.Free() + values.Free() + bitmap.Free() result |> Option.map diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs index fb91840f..78fadbe9 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs @@ -5,6 +5,7 @@ open FSharp.Quotations open Microsoft.FSharp.Control open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions open GraphBLAS.FSharp.Objects.ClVector open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Backend.Quotes @@ -37,7 +38,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) -> + fun (processor: RawCommandQueue) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) @@ -53,24 +54,20 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vectorLenght - leftValues.Length - rightValues.Length - leftValues - leftIndices - rightValues - rightIndices - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + vectorLenght + leftValues.Length + rightValues.Length + leftValues + leftIndices + rightValues + rightIndices + resultBitmap + resultValues + resultIndices + + processor.RunKernel kernel resultBitmap, resultValues, resultIndices @@ -82,7 +79,7 @@ module internal Map2 = let setPositions = Common.setPositionsOption clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> let bitmap, allValues, allIndices = prepare @@ -102,9 +99,9 @@ module internal Map2 = Indices = resultIndices Size = leftVector.Size }) - allIndices.Free processor - allValues.Free processor - bitmap.Free processor + allIndices.Free() + allValues.Free() + bitmap.Free() result @@ -134,7 +131,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b option>) -> + fun (processor: RawCommandQueue) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b option>) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) @@ -150,21 +147,18 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vectorLenght - leftValues - leftIndices - rightValues - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + + kernel.KernelFunc + ndRange + vectorLenght + leftValues + leftIndices + rightValues + resultBitmap + resultValues + resultIndices + + processor.RunKernel kernel resultBitmap, resultValues, resultIndices @@ -181,7 +175,7 @@ module internal Map2 = let setPositions = Common.setPositionsOption clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClArray<'b option>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClArray<'b option>) -> let bitmap, allValues, allIndices = prepare processor leftVector.NNZ leftVector.Values leftVector.Indices rightVector @@ -195,9 +189,9 @@ module internal Map2 = Indices = resultIndices Size = leftVector.Size }) - allIndices.Free processor - allValues.Free processor - bitmap.Free processor + allIndices.Free() + allValues.Free() + bitmap.Free() result @@ -232,7 +226,7 @@ module internal Map2 = let kernel = clContext.Compile <| assign op - fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (value: ClCell<'a>) -> + fun (processor: RawCommandQueue) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (value: ClCell<'a>) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) @@ -248,25 +242,22 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vectorLenght - leftValues.Length - rightValues.Length - leftValues - leftIndices - rightValues - rightIndices - value - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + kernel.KernelFunc + ndRange + vectorLenght + leftValues.Length + rightValues.Length + leftValues + leftIndices + rightValues + rightIndices + value + resultBitmap + resultValues + resultIndices + + processor.RunKernel kernel resultBitmap, resultValues, resultIndices @@ -281,7 +272,7 @@ module internal Map2 = let setPositions = Common.setPositions clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: 'a) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: 'a) -> let valueCell = clContext.CreateClCell(value) @@ -298,10 +289,10 @@ module internal Map2 = let resultValues, resultIndices = setPositions processor allocationMode values indices bitmap - processor.Post(Msg.CreateFreeMsg<_>(valueCell)) - processor.Post(Msg.CreateFreeMsg<_>(indices)) - processor.Post(Msg.CreateFreeMsg<_>(values)) - processor.Post(Msg.CreateFreeMsg<_>(bitmap)) + valueCell.Free() + indices.Free() + values.Free() + bitmap.Free() { Context = clContext Values = resultValues @@ -337,7 +328,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + fun (processor: RawCommandQueue) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> let length = allIndices.Length @@ -352,21 +343,9 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allIndices - leftValues - rightValues - isLeft - allValues - positions) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange length allIndices leftValues rightValues isLeft allValues positions + + processor.RunKernel kernel allValues, positions @@ -383,16 +362,16 @@ module internal Map2 = let setPositions = Common.setPositionsOption clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> let allIndices, leftValues, rightValues, isLeft = merge processor leftVector rightVector let allValues, positions = prepare processor allIndices leftValues rightValues isLeft - processor.Post(Msg.CreateFreeMsg<_>(leftValues)) - processor.Post(Msg.CreateFreeMsg<_>(rightValues)) - processor.Post(Msg.CreateFreeMsg<_>(isLeft)) + leftValues.Free() + rightValues.Free() + isLeft.Free() let result = setPositions processor allocationMode allValues allIndices positions @@ -403,8 +382,8 @@ module internal Map2 = Indices = resultIndices Size = max leftVector.Size rightVector.Size }) - processor.Post(Msg.CreateFreeMsg<_>(allIndices)) - processor.Post(Msg.CreateFreeMsg<_>(allValues)) - processor.Post(Msg.CreateFreeMsg<_>(positions)) + allIndices.Free() + allValues.Free() + positions.Free() result diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs index 4c310edf..32e560c3 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs @@ -119,7 +119,7 @@ module internal Merge = let kernel = clContext.Compile merge - fun (processor: MailboxProcessor<_>) (firstVector: ClVector.Sparse<'a>) (secondVector: ClVector.Sparse<'b>) -> + fun (processor: RawCommandQueue) (firstVector: ClVector.Sparse<'a>) (secondVector: ClVector.Sparse<'b>) -> let firstSide = firstVector.Indices.Length @@ -144,24 +144,20 @@ module internal Merge = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - firstVector.Indices - firstVector.Values - secondVector.Indices - secondVector.Values - allIndices - firstValues - secondValues - isLeftBitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + firstVector.Indices + firstVector.Values + secondVector.Indices + secondVector.Values + allIndices + firstValues + secondValues + isLeftBitmap + + processor.RunKernel kernel allIndices, firstValues, secondValues, isLeftBitmap diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs index 1a7fb8f7..e6463634 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs @@ -15,10 +15,10 @@ module Vector = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: Sparse<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: Sparse<'a>) -> { Context = clContext - Indices = copy processor allocationMode vector.Indices - Values = copyData processor allocationMode vector.Values + Indices = copy processor allocationMode vector.Indices vector.Indices.Length + Values = copyData processor allocationMode vector.Values vector.Values.Length Size = vector.Size } let copyTo (clContext: ClContext) workGroupSize = @@ -26,7 +26,7 @@ module Vector = let copyDataTo = ClArray.copyTo clContext workGroupSize - fun (processor: MailboxProcessor<_>) (source: Sparse<'a>) (destination: Sparse<'a>) -> + fun (processor: RawCommandQueue) (source: Sparse<'a>) (destination: Sparse<'a>) -> copyTo processor source.Indices destination.Indices copyDataTo processor source.Values destination.Values @@ -59,7 +59,7 @@ module Vector = let create = ClArray.zeroCreate clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector.Sparse<'a>) -> let resultVector = create processor allocationMode vector.Size @@ -68,13 +68,9 @@ module Vector = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange vector.Indices.Length vector.Values vector.Indices resultVector) - ) + kernel.KernelFunc ndRange vector.Indices.Length vector.Values vector.Indices resultVector - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel(kernel) resultVector @@ -83,7 +79,7 @@ module Vector = let reduce = Common.Reduce.reduce opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values + fun (processor: RawCommandQueue) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values let ofList (clContext: ClContext) allocationMode size (elements: (int * 'a) list) = let indices, values = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index bbba4404..0d10dd08 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -22,7 +22,7 @@ module Vector = let create (clContext: ClContext) workGroupSize = let create = ClArray.create clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode size format value -> + fun (processor: RawCommandQueue) allocationMode size format value -> match format with | Sparse -> failwith "Attempting to create full sparse vector" | Dense -> @@ -37,8 +37,7 @@ module Vector = let zeroCreate (clContext: ClContext) workGroupSize = let create = create clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode size format -> - create processor allocationMode size format None + fun (processor: RawCommandQueue) allocationMode size format -> create processor allocationMode size format None /// /// Builds vector of given format with fixed size and fills it with the values from the given list. @@ -55,7 +54,7 @@ module Vector = let map = Common.Map.map <@ Some @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode format size (elements: (int * 'a) list) -> + fun (processor: RawCommandQueue) allocationMode format size (elements: (int * 'a) list) -> match format with | Sparse -> let indices, values = @@ -84,9 +83,9 @@ module Vector = scatter processor indices mappedValues result - processor.Post(Msg.CreateFreeMsg(mappedValues)) - processor.Post(Msg.CreateFreeMsg(indices)) - processor.Post(Msg.CreateFreeMsg(values)) + mappedValues.Dispose() + indices.Dispose() + values.Dispose() ClVector.Dense result @@ -102,14 +101,14 @@ module Vector = let copyOptionData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) -> match vector with | ClVector.Sparse vector -> ClVector.Sparse <| sparseCopy processor allocationMode vector | ClVector.Dense vector -> ClVector.Dense - <| copyOptionData processor allocationMode vector + <| copyOptionData processor allocationMode vector vector.Length /// /// Sparsifies the given vector if it is in a dense format. @@ -123,7 +122,7 @@ module Vector = let copy = copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) -> match vector with | ClVector.Dense vector -> ClVector.Sparse @@ -142,11 +141,11 @@ module Vector = let copy = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) -> match vector with | ClVector.Dense vector -> ClVector.Dense - <| copy processor allocationMode vector + <| copy processor allocationMode vector vector.Length | ClVector.Sparse vector -> ClVector.Dense <| toDense processor allocationMode vector @@ -159,7 +158,7 @@ module Vector = let denseFillVector = Dense.Vector.assignByMask op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: 'a) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: 'a) -> match vector, mask with | ClVector.Sparse vector, ClVector.Sparse mask -> ClVector.Sparse @@ -199,7 +198,7 @@ module Vector = let assignBySparse = Dense.Vector.assignBySparseMaskInPlace op clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (mask: ClVector<'b>) (value: 'a) -> + fun (processor: RawCommandQueue) (vector: ClVector<'a>) (mask: ClVector<'b>) (value: 'a) -> match vector, mask with | ClVector.Dense vector, ClVector.Dense mask -> assignByDense processor vector mask value vector | ClVector.Dense vector, ClVector.Sparse mask -> assignBySparse processor vector mask value vector @@ -229,7 +228,7 @@ module Vector = let map2Dense = Dense.Vector.map2InPlace map clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Dense left, ClVector.Dense right -> map2Dense processor left right left | _ -> failwith "Unsupported vector format" @@ -248,7 +247,7 @@ module Vector = let map2Dense = Dense.Vector.map2InPlace map clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) (resultVector: ClVector<'c>) -> + fun (processor: RawCommandQueue) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) (resultVector: ClVector<'c>) -> match leftVector, rightVector, resultVector with | ClVector.Dense left, ClVector.Dense right, ClVector.Dense result -> map2Dense processor left right result | _ -> failwith "Unsupported vector format" @@ -267,7 +266,7 @@ module Vector = let map2Dense = Dense.Vector.map2 map clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Dense left, ClVector.Dense right -> map2Dense processor allocationFlag left right | _ -> failwith "Unsupported vector format" @@ -289,7 +288,7 @@ module Vector = let map2SparseDense = Sparse.Map2.runSparseDense map clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Sparse left, ClVector.Sparse right -> Option.map ClVector.Sparse (map2Sparse processor allocationFlag left right) @@ -308,7 +307,7 @@ module Vector = let existsDense = ClArray.exists predicate clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) (vector: ClVector<'a>) -> match vector with | ClVector.Dense vector -> existsDense processor vector | _ -> failwith "Unsupported format" @@ -332,7 +331,7 @@ module Vector = let denseReduce = Dense.Vector.reduce opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) (vector: ClVector<'a>) -> match vector with | ClVector.Sparse vector -> sparseReduce processor vector | ClVector.Dense vector -> denseReduce processor vector diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index a0e8332a..a34c7c29 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -9,68 +9,68 @@ open GraphBLAS.FSharp.Objects.ClVectorExtensions module MatrixExtensions = // Matrix.Free type ClMatrix.COO<'a when 'a: struct> with - member this.Free(q: MailboxProcessor<_>) = - this.Columns.Free q - this.Values.Free q - this.Rows.Free q + member this.Free(q: RawCommandQueue) = + this.Columns.Free() + this.Values.Free() + this.Rows.Free() - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = { RowCount = this.RowCount ColumnCount = this.ColumnCount Rows = this.Rows.ToHost q Columns = this.Columns.ToHost q Values = this.Values.ToHost q } - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q this.Free q result type ClMatrix.CSR<'a when 'a: struct> with - member this.Free(q: MailboxProcessor<_>) = - this.Values.Free q - this.Columns.Free q - this.RowPointers.Free q + member this.Free(q: RawCommandQueue) = + this.Values.Free() + this.Columns.Free() + this.RowPointers.Free() - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = { RowCount = this.RowCount ColumnCount = this.ColumnCount RowPointers = this.RowPointers.ToHost q ColumnIndices = this.Columns.ToHost q Values = this.Values.ToHost q } - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q this.Free q result type ClMatrix.CSC<'a when 'a: struct> with - member this.Free(q: MailboxProcessor<_>) = - this.Values.Free q - this.Rows.Free q - this.ColumnPointers.Free q + member this.Free(q: RawCommandQueue) = + this.Values.Free() + this.Rows.Free() + this.ColumnPointers.Free() - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = { RowCount = this.RowCount ColumnCount = this.ColumnCount RowIndices = this.Rows.ToHost q ColumnPointers = this.ColumnPointers.ToHost q Values = this.Values.ToHost q } - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q this.Free q result type ClMatrix.LIL<'a when 'a: struct> with - member this.Free(q: MailboxProcessor<_>) = + member this.Free(q: RawCommandQueue) = this.Rows - |> List.iter (Option.iter (fun row -> row.Dispose q)) + |> List.iter (Option.iter (fun row -> row.Dispose())) - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = { RowCount = this.RowCount ColumnCount = this.ColumnCount Rows = @@ -78,32 +78,32 @@ module MatrixExtensions = |> List.map (Option.map (fun row -> row.ToHost q)) NNZ = this.NNZ } - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q this.Free q result type ClMatrix<'a when 'a: struct> with - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = match this with | ClMatrix.COO m -> m.ToHost q |> Matrix.COO | ClMatrix.CSR m -> m.ToHost q |> Matrix.CSR | ClMatrix.CSC m -> m.ToHost q |> Matrix.CSC | ClMatrix.LIL m -> m.ToHost q |> Matrix.LIL - member this.Free(q: MailboxProcessor<_>) = + member this.Free(q: RawCommandQueue) = match this with | ClMatrix.COO m -> m.Free q | ClMatrix.CSR m -> m.Free q | ClMatrix.CSC m -> m.Free q | ClMatrix.LIL m -> m.Free q - member this.FreeAndWait(processor: MailboxProcessor<_>) = + member this.FreeAndWait(processor: RawCommandQueue) = this.Free processor - processor.PostAndReply(MsgNotifyMe) + processor.Synchronize() - member this.ToHostAndFree(processor: MailboxProcessor<_>) = + member this.ToHostAndFree(processor: RawCommandQueue) = let result = this.ToHost processor this.Free processor diff --git a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs index cfe098e7..bd69f8bb 100644 --- a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs @@ -6,13 +6,13 @@ open GraphBLAS.FSharp.Objects.ArraysExtensions module ClVectorExtensions = type ClVector.Sparse<'a> with - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: Brahma.FSharp.RawCommandQueue) = { Indices = this.Indices.ToHost q Values = this.Values.ToHost q Size = this.Size } type ClVector<'a when 'a: struct> with - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: Brahma.FSharp.RawCommandQueue) = match this with | ClVector.Sparse vector -> Vector.Sparse <| vector.ToHost q | ClVector.Dense vector -> Vector.Dense <| vector.ToHost q diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs index 2a0453a8..8575af21 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs @@ -76,11 +76,11 @@ let testFixtures (testContext: TestContext) = let resHostSparse = resSparse.ToHost queue let resHostPushPull = resPushPull.ToHost queue - matrix.Dispose queue - matrixBool.Dispose queue - res.Dispose queue - resSparse.Dispose queue - resPushPull.Dispose queue + matrix.Dispose() + matrixBool.Dispose() + res.Dispose() + resSparse.Dispose() + resPushPull.Dispose() match resHost, resHostSparse, resHostPushPull with | Vector.Dense resHost, Vector.Dense resHostSparse, Vector.Dense resHostPushPull -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs index 3adad360..af94bbe0 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs @@ -51,7 +51,7 @@ let makeLevelsTest context queue bfs (matrix: int [,]) = let actual: ClMatrix = bfs queue matrixDevice source let actual = actual.ToHostAndFree queue - matrixDevice.Dispose queue + matrixDevice.Dispose() match actual, expected with | Matrix.COO a, Matrix.COO e -> Utils.compareCOOMatrix (=) a e @@ -103,7 +103,7 @@ let makeParentsTest context queue bfs (matrix: int [,]) = let actual: ClMatrix = bfs queue matrixDevice source let actual = actual.ToHostAndFree queue - matrixDevice.Dispose queue + matrixDevice.Dispose() match actual, expected with | Matrix.COO a, Matrix.COO e -> Utils.compareCOOMatrix (=) a e diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs index ebd3eab6..6495407a 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs @@ -102,9 +102,9 @@ let testFixtures (testContext: TestContext) = let resHost = res.ToHost queue - preparedMatrix.Dispose queue - matrix.Dispose queue - res.Dispose queue + preparedMatrix.Dispose() + matrix.Dispose() + res.Dispose() match resHost with | Vector.Dense resHost -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/SSSP.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/SSSP.fs index 3cffbd7d..4c3f312d 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/SSSP.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/SSSP.fs @@ -51,8 +51,8 @@ let testFixtures (testContext: TestContext) = let resHost = resDense.ToHost queue - matrix.Dispose queue - resDense.Dispose queue + matrix.Dispose() + resDense.Dispose() match resHost with | Vector.Dense resHost -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs index 55df7a4a..bc026886 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs @@ -24,7 +24,7 @@ let makeTest<'a> isEqual testFun (source: 'a [], sourceIndex, target: 'a [], tar testFun processor clSource sourceIndex clTarget targetIndex count - clSource.Free processor + clSource.Free() let actual = clTarget.ToHostAndFree processor // write to target --- target expected diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs index 4797b6fb..83f55a79 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs @@ -73,8 +73,8 @@ let makeTest2 testContext isEqual opMap testFun (firstArray: 'a [], secondArray: testFun processor HostInterop clFirstArray clSecondArray let actual = clActual.ToHostAndFree processor - clFirstArray.Free processor - clSecondArray.Free processor + clFirstArray.Free() + clSecondArray.Free() "Results must be the same" |> Utils.compareArrays isEqual actual expected diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs index 513984c4..315aa12f 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs @@ -25,7 +25,7 @@ let makeTestGetChunk<'a when 'a: equality> testFun (array: 'a [], startPosition, let (clActual: ClArray<'a>) = testFun processor HostInterop clArray startPosition count - clArray.Free processor + clArray.Free() let actual = clActual.ToHostAndFree processor "Results must be the same" @@ -56,7 +56,7 @@ let makeTestChunkBySize<'a when 'a: equality> isEqual testFun (array: 'a [], chu let clActual: ClArray<'a> [] = (testFun processor HostInterop chunkSize clArray) - clArray.Free processor + clArray.Free() let actual = clActual diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs index 1d704e0c..526a85f2 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs @@ -26,8 +26,7 @@ let makeTest<'a> isEqual testFun (arrays: 'a [] []) = // release let actual = clActual.ToHostAndFree processor - clArrays - |> Seq.iter (fun array -> array.Free processor) + clArrays |> Seq.iter (fun array -> array.Free()) let expected = Seq.concat arrays |> Seq.toArray diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs index cd8f4a59..68f3adff 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs @@ -19,15 +19,18 @@ let q = Context.defaultContext.Queue let config = Utils.defaultConfig -let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = +let makeTest<'a when 'a: equality> + (copyFun: RawCommandQueue -> AllocationFlag -> ClArray<'a> -> int -> ClArray<'a>) + (array: array<'a>) + = if array.Length > 0 then - let clArray = context.CreateClArray array + let clArray: ClArray<'a> = context.CreateClArray array let actual = - (copyFun q HostInterop clArray: ClArray<_>) + (copyFun q DeviceOnly clArray clArray.Length) .ToHostAndFree q - clArray.Free q + clArray.Free() logger.debug ( eventX "Actual is {actual}" @@ -43,7 +46,7 @@ let creatTest<'a when 'a: equality> = |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" let testCases = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ creatTest creatTest diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs index 33a94b92..c5817d45 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs @@ -29,8 +29,8 @@ let makeTest<'a> isEqual (zero: 'a) testFun ((array, bitmap): 'a array * int arr actual |> Option.map (fun a -> a.ToHostAndFree processor) - arrayCl.Free processor - bitmapCl.Free processor + arrayCl.Free() + bitmapCl.Free() let expected = (bitmap, array) diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs index 00e21cde..638ecd75 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs @@ -24,7 +24,7 @@ let makeTest<'a when 'a: equality> testFun (array: 'a [], position) = let result: ClCell<'a> = testFun processor position clArray - clArray.Free processor + clArray.Free() let actual = result.ToHost processor let expected = Array.item position array diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs index 2689de09..b5e3712a 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs @@ -7,6 +7,7 @@ open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions let context = defaultContext.Queue @@ -30,10 +31,7 @@ let makeTest (testContext: TestContext) mapFun zero isEqual (array: 'a option [] let (actualDevice: ClArray<_>) = mapFun q HostInterop clArray - let actualHost = Array.zeroCreate actualDevice.Length - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) - |> ignore + let actualHost = actualDevice.ToHostAndFree q let expected = Array.map (mapOptionToValue zero) array diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs index a291858e..b2903f04 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs @@ -6,6 +6,7 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions let context = defaultContext.Queue @@ -29,10 +30,7 @@ let makeTest<'a when 'a: equality> testContext clMapFun hostMapFun isEqual (left let (actualDevice: ClArray<'a>) = clMapFun q HostInterop leftClArray rightClArray - let actualHost = Array.zeroCreate actualDevice.Length - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) - |> ignore + let actualHost = actualDevice.ToHostAndFree q let expected = Array.map2 hostMapFun leftArray rightArray diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs index 276cf286..6b08b6cd 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs @@ -6,6 +6,7 @@ open Expecto.Logging.Message open Brahma.FSharp open GraphBLAS.FSharp open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Objects.ArraysExtensions let logger = Log.create "RemoveDuplicates.Tests" @@ -15,7 +16,7 @@ let testCases = let removeDuplicates_wg_2 = ClArray.removeDuplications context 2 let removeDuplicates_wg_32 = ClArray.removeDuplications context 32 let q = Context.defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ testCase "Simple correctness test" <| fun () -> @@ -26,8 +27,7 @@ let testCases = let actual = let clActual = removeDuplicates_wg_2 q clArray - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + clActual.ToHostAndFree q logger.debug ( eventX "Actual is {actual}" @@ -55,8 +55,7 @@ let testCases = let actual = let clActual = removeDuplicates q clArray - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + clActual.ToHostAndFree q logger.debug ( eventX "Actual is {actual}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs index dd698189..b6d11d3c 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs @@ -27,7 +27,7 @@ let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = (replicateFun q HostInterop clArray i: ClArray<'a>) .ToHostAndFree q - clArray.Free q + clArray.Free() logger.debug ( eventX $"Actual is {actual}" @@ -46,7 +46,7 @@ let createTest<'a when 'a: equality> = |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" let testCases = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ createTest createTest diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs index 094d8f44..ab68213b 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs @@ -39,8 +39,8 @@ let makeTest isEqual testFun (array: (uint * 'a * 'a) []) = testFun processor clPositions clValues clTarget - clPositions.Free processor - clValues.Free processor + clPositions.Free() + clValues.Free() let actual = clTarget.ToHostAndFree processor @@ -81,7 +81,7 @@ let makeTestInit isEqual testFun indexMap (array: ('a * 'a) []) = testFun processor clValues clTarget - clValues.Free processor + clValues.Free() let actual = clTarget.ToHostAndFree processor diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs index 439d24f6..8f6457ad 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs @@ -19,7 +19,7 @@ let wgSize = Constants.Common.defaultWorkGroupSize let q = Context.defaultContext.Queue -let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zero (array: 'a []) = +let makeTest (reduce: RawCommandQueue -> ClArray<'a> -> ClCell<'a>) plus zero (array: 'a []) = if array.Length > 0 then let reduce = reduce q @@ -33,7 +33,7 @@ let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zer let clArray = context.CreateClArray array let total = reduce clArray - clArray.Free q + clArray.Free() total.ToHostAndFree q logger.debug ( @@ -59,7 +59,7 @@ let testFixtures plus plusQ zero name = |> testPropertyWithConfig config $"Correctness on %s{name}" let tests = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ testFixtures (+) <@ (+) @> 0 "int add" testFixtures (+) <@ (+) @> 0uy "byte add" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs index 16a5f46b..18abe5c8 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs @@ -52,8 +52,8 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let clActualValues, clActualKeys: ClArray<'a> * ClArray = reduce processor HostInterop resultLength clKeys clValues - clValues.Free processor - clKeys.Free processor + clValues.Free() + clKeys.Free() let actualValues = clActualValues.ToHostAndFree processor let actualKeys = clActualKeys.ToHostAndFree processor @@ -235,9 +235,9 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = let clActualValues, clFirstActualKeys, clSecondActualKeys: ClArray<'a> * ClArray * ClArray = reduce processor HostInterop resultLength clFirstKeys clSecondKeys clValues - clValues.Free processor - clFirstKeys.Free processor - clSecondKeys.Free processor + clValues.Free() + clFirstKeys.Free() + clSecondKeys.Free() let actualValues = clActualValues.ToHostAndFree processor diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs index 3953c3c0..a05a7165 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs @@ -32,7 +32,7 @@ let makeTest plus zero sum (array: 'a []) = let clArray = context.CreateClArray array let (total: ClCell<_>) = sum q clArray - clArray.Free q + clArray.Free() total.ToHostAndFree q logger.debug ( @@ -57,7 +57,7 @@ let testFixtures plus (plusQ: Expr<'a -> 'a -> 'a>) zero name = let tests = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ testFixtures (+) <@ (+) @> 0 "int add" testFixtures (+) <@ (+) @> 0uy "byte add" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs index d48efa75..9da27c2b 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs @@ -41,8 +41,8 @@ let makeTestSequentialSegments isEqual scanHost scanDevice (keysAndValues: (int scanDevice processor uniqueKeysCount clValues clKeys clOffsets let actual = clValues.ToHostAndFree processor - clKeys.Free processor - clOffsets.Free processor + clKeys.Free() + clOffsets.Free() let keysAndValues = Array.zip keys values diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs index 3773eefd..d7379ac9 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs @@ -78,8 +78,6 @@ let testFixtures plus plusQ zero isEqual name = |> testPropertyWithConfig config $"Correctness on %s{name}" let tests = - q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures (+) <@ (+) @> 0 (=) "int add" testFixtures (+) <@ (+) @> 0uy (=) "byte add" testFixtures max <@ max @> 0 (=) "int max" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs index 4923ed6f..a9e337dd 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs @@ -33,8 +33,8 @@ let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (r scatter q clPositions clValues clResult - clValues.Free q - clPositions.Free q + clValues.Free() + clPositions.Free() clResult.ToHostAndFree q $"Arrays should be equal." @@ -51,7 +51,7 @@ let testFixturesFirst<'a when 'a: equality> = |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let tests = - q.Error.Add(fun e -> failwithf $"%A{e}") + //q.Error.Add(fun e -> failwithf $"%A{e}") let last = [ testFixturesLast @@ -81,7 +81,7 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: scatter q clPositions clResult - clPositions.Free q + clPositions.Free() let actual = clResult.ToHostAndFree q $"Arrays should be equal." @@ -95,7 +95,7 @@ let createInitTest clScatter hostScatter name valuesMap valuesMapQ = |> testPropertyWithConfig config name let initTests = - q.Error.Add(fun e -> failwithf $"%A{e}") + //sq.Error.Add(fun e -> failwithf $"%A{e}") let inc = ((+) 1) diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs index c2477bd4..f1533586 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs @@ -95,12 +95,12 @@ module Bitonic = $"Values for keys %A{actualRows.[i - 1]}, %A{actualCols.[i - 1]} are not the same" let testFixtures<'a when 'a: equality> = - Sort.Bitonic.sortKeyValuesInplace<'a> context wgSize + Sort.Bitonic.sortRowsColumnsValuesInplace<'a> context wgSize |> makeTest |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let tests = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs index 537a66d8..a34300d5 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs @@ -10,6 +10,7 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Convert.Tests" @@ -21,7 +22,7 @@ let context = defaultContext.ClContext let q = defaultContext.Queue -q.Error.Add(fun e -> failwithf "%A" e) +//q.Error.Add(fun e -> failwithf "%A" e) let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = let mtx = @@ -32,8 +33,8 @@ let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = let mBefore = mtx.ToDevice context let mAfter: ClMatrix<'a> = convertFun q HostInterop mBefore let res = mAfter.ToHost q - mBefore.Dispose q - mAfter.Dispose q + mBefore.Dispose() + mAfter.Dispose() res logger.debug ( diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs index d1137e1b..d4def956 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs @@ -55,8 +55,8 @@ let makeTest<'a when 'a: struct> isZero testFun (leftMatrix: 'a [,], rightMatrix let actual = actual.ToHostAndFree processor - m1.Dispose processor - m2.Dispose processor + m1.Dispose() + m2.Dispose() // Check result "Matrices should be equal" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs index 94470fc3..c015716a 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs @@ -9,6 +9,7 @@ open GraphBLAS.FSharp.Tests.TestCases open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Backend.Quotes +open Brahma.FSharp let config = { Utils.defaultConfig with @@ -51,11 +52,11 @@ let makeTest testContext zero isEqual op kroneckerFun (leftMatrix: 'a [,], right let actual = Option.map (fun (m: ClMatrix<'a>) -> m.ToHost processor) result - m1.Dispose processor - m2.Dispose processor + m1.Dispose() + m2.Dispose() match result with - | Some m -> m.Dispose processor + | Some m -> m.Dispose() | _ -> () // Check result @@ -68,7 +69,7 @@ let createGeneralTest testContext (zero: 'a) isEqual op opQ testName = |> testPropertyWithConfig config $"test on %A{typeof<'a>} %s{testName}" let generalTests (testContext: TestContext) = - [ testContext.Queue.Error.Add(fun e -> failwithf "%A" e) + [ //testContext.Queue.Error.Add(fun e -> failwithf "%A" e) createGeneralTest testContext false (=) (&&) ArithmeticOperations.boolMulOption "mul" createGeneralTest testContext false (=) (||) ArithmeticOperations.boolSumOption "sum" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs index d84811a1..a5303ed8 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs @@ -13,6 +13,7 @@ open GraphBLAS.FSharp.Tests.TestCases open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.MatrixExtensions +open Brahma.FSharp let logger = Log.create "Map.Tests" @@ -51,7 +52,7 @@ let checkResult isEqual op zero (baseMtx: 'a [,]) (actual: Matrix<'a>) = let correctnessGenericTest zero op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'b>) + (addFun: RawCommandQueue -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'b>) toCOOFun (isEqual: 'a -> 'a -> bool) q @@ -70,13 +71,13 @@ let correctnessGenericTest let res = addFun q HostInterop m - m.Dispose q + m.Dispose() let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res let actual = cooRes.ToHost q - cooRes.Dispose q - res.Dispose q + cooRes.Dispose() + res.Dispose() logger.debug ( eventX "Actual is {actual}" @@ -108,7 +109,7 @@ let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = let testFixturesMapNot case = [ let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notOption) ] @@ -118,7 +119,7 @@ let notTests = let testFixturesMapAdd case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case 0 10 (+) (=) ArithmeticOperations.addLeftConst @@ -135,7 +136,7 @@ let addTests = let testFixturesMapMul case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case 0 10 (*) (=) ArithmeticOperations.mulLeftConst diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs index 112e230c..6462e6c7 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs @@ -13,6 +13,7 @@ open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Map2.Tests" @@ -51,7 +52,7 @@ let checkResult isEqual op zero (baseMtx1: 'a [,]) (baseMtx2: 'a [,]) (actual: M let correctnessGenericTest zero op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'a> -> ClMatrix<'c>) + (addFun: RawCommandQueue -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'a> -> ClMatrix<'c>) toCOOFun (isEqual: 'a -> 'a -> bool) q @@ -75,14 +76,14 @@ let correctnessGenericTest let res = addFun q HostInterop m1 m2 - m1.Dispose q - m2.Dispose q + m1.Dispose() + m2.Dispose() let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res let actual = cooRes.ToHost q - cooRes.Dispose q - res.Dispose q + cooRes.Dispose() + res.Dispose() logger.debug ( eventX "Actual is {actual}" @@ -111,7 +112,7 @@ let createTestMap2Add case (zero: 'a) add isEqual addQ map2 = let testFixturesMap2Add case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap2Add case false (||) (=) ArithmeticOperations.boolSumOption Operations.Matrix.map2 createTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumOption Operations.Matrix.map2 @@ -128,7 +129,7 @@ let addTests = let testFixturesMap2AddAtLeastOne case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Operations.Matrix.map2AtLeastOne createTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Operations.Matrix.map2AtLeastOne @@ -159,7 +160,7 @@ let addAtLeastOneTests = let testFixturesMap2MulAtLeastOne case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap2Add case false (&&) (=) ArithmeticOperations.boolMulAtLeastOne Operations.Matrix.map2AtLeastOne createTestMap2Add case 0 (*) (=) ArithmeticOperations.intMulAtLeastOne Operations.Matrix.map2AtLeastOne diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs index c491034e..cbee2338 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs @@ -68,8 +68,8 @@ let makeTestCOO isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = (clIsLeft: ClArray)) = testFun processor clLeftMatrix clRightMatrix - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() let leftValues = clLeftValues.ToHostAndFree processor let rightValues = clRightValues.ToHostAndFree processor @@ -131,8 +131,8 @@ let makeTestCOODisjoint isEqual zero testFun (array: ('a * 'a) [,]) = let actual = actual.ToHostAndFree processor - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() rightArray |> Array2D.iteri @@ -185,12 +185,12 @@ let makeTestCSR isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = (clIsLeft: ClArray)) = testFun processor clLeftMatrix clRightMatrix - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() let leftValues = clLeftValues.ToHostAndFree processor let rightValues = clRightValues.ToHostAndFree processor - clIsEndOfRow.Free processor + clIsEndOfRow.Free() let isLeft = clIsLeft.ToHostAndFree processor let actualValues = diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs index 5b75cdd0..81363f08 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs @@ -26,7 +26,7 @@ let makeTest isZero testFun (array: 'a [,]) = let clMatrix = matrix.ToDevice context let (clActual: ClArray) = testFun processor HostInterop clMatrix - clMatrix.Dispose processor + clMatrix.Dispose() let actual = clActual.ToHostAndFree processor let expected = diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index 2daf91fd..4b4f04dc 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -47,8 +47,8 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let actualLength, (clActual: ClArray) = testFun processor clLeftMatrix.Columns clRightMatrix.RowPointers - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() let actualPointers = clActual.ToHostAndFree processor @@ -132,9 +132,9 @@ let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) clActualRows: ClArray) = testFun processor length clSegmentPointers clLeftMatrix clRightMatrix - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - clSegmentPointers.Free processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() + clSegmentPointers.Free() let actualLeftValues = clActualLeftValues.ToHostAndFree processor @@ -200,7 +200,7 @@ let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightAr | Some clMatrixActual -> let matrixActual = clMatrixActual.ToHost processor - clMatrixActual.Dispose processor + clMatrixActual.Dispose() Utils.compareCOOMatrix isEqual matrixActual expected | None -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs index 916c97a9..c9b51f45 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs @@ -41,7 +41,7 @@ let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightAr | Some clMatrixActual -> let matrixActual = clMatrixActual.ToHost processor - clMatrixActual.Dispose processor + clMatrixActual.Dispose() Utils.compareCOOMatrix isEqual matrixActual expected | None -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs index e5a1e826..188f9bcd 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context +open Brahma.FSharp let logger = Log.create "SpGeMM.Masked.Tests" @@ -49,10 +50,10 @@ let makeTest context q zero isEqual plus mul mxmFun (leftMatrix: 'a [,], rightMa let (result: ClMatrix<'a>) = mxmFun q m1 m2 matrixMask let actual = result.ToHost q - m1.Dispose q - m2.Dispose q - matrixMask.Dispose q - result.Dispose q + m1.Dispose() + m2.Dispose() + matrixMask.Dispose() + result.Dispose() // Check result "Matrices should be equal" @@ -66,7 +67,7 @@ let tests = arbitrary = [ typeof ] } let q = defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ let add = <@ fun x y -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs index d6b9cfe9..8408daab 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs @@ -89,8 +89,8 @@ let makeTestRegular context q transposeFun hostTranspose isEqual zero case (arra let m = mtx.ToDevice context let (mT: ClMatrix<'a>) = transposeFun q HostInterop m let res = mT.ToHost q - m.Dispose q - mT.Dispose q + m.Dispose() + mT.Dispose() res logger.debug ( @@ -125,7 +125,7 @@ let createTest<'a when 'a: equality and 'a: struct> case (zero: 'a) isEqual = let testFixtures case = let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ createTest case 0 (=) diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs index 5d40ca00..5af11879 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs @@ -50,8 +50,8 @@ let checkResult isZero isComplemented (actual: Vector<'a>) (vector: 'a []) (mask let makeTest<'a when 'a: struct and 'a: equality> (isZero: 'a -> bool) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (fillVector: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> 'a -> ClVector<'a>) + (toDense: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (fillVector: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> 'a -> ClVector<'a>) isComplemented case (vector: 'a [], mask: 'a [], value: 'a) @@ -80,10 +80,10 @@ let makeTest<'a when 'a: struct and 'a: equality> let actual = cooClActual.ToHost q - clLeftVector.Dispose q - clMaskVector.Dispose q - clActual.Dispose q - cooClActual.Dispose q + clLeftVector.Dispose() + clMaskVector.Dispose() + clActual.Dispose() + cooClActual.Dispose() checkResult isZero isComplemented actual vector mask value with diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs index ac9073f9..a755be58 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs @@ -10,6 +10,7 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Backend.Vector.Convert.Tests" @@ -20,7 +21,7 @@ let wgSize = Constants.Common.defaultWorkGroupSize let makeTest formatFrom - (convertFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (convertFun: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) isZero case (array: 'a []) @@ -40,8 +41,8 @@ let makeTest let res = convertedVector.ToHost q - clVector.Dispose q - convertedVector.Dispose q + clVector.Dispose() + convertedVector.Dispose() res @@ -62,7 +63,7 @@ let testFixtures case = let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) match case.Format with | Sparse -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs index 3910ddcd..df17455f 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs @@ -9,6 +9,7 @@ open TestCases open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Vector.copy.Tests" @@ -36,7 +37,7 @@ let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vect let correctnessGenericTest<'a when 'a: struct> isEqual zero - (copy: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (copy: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) (case: OperationCase) (array: 'a []) = @@ -53,8 +54,8 @@ let correctnessGenericTest<'a when 'a: struct> let clVectorCopy = copy q HostInterop clVector let actual = clVectorCopy.ToHost q - clVector.Dispose q - clVectorCopy.Dispose q + clVector.Dispose() + clVectorCopy.Dispose() checkResult isEqual actual expected diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map.fs index 25fed6a3..e1445b96 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map.fs @@ -14,6 +14,7 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClVectorExtensions open Mono.CompilerServices.SymbolWriter +open Brahma.FSharp let logger = Log.create "Vector.Map.Tests" @@ -45,8 +46,8 @@ let checkResult isEqual op zero (baseVector: 'a []) (actual: Vector<'b>) = let correctnessGenericTest zero op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (addFun: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (toDense: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) (isEqual: 'a -> 'a -> bool) (case: OperationCase) (array: 'a []) @@ -67,14 +68,14 @@ let correctnessGenericTest try let res = addFun q HostInterop vector - vector.Dispose q + vector.Dispose() let denseActual = toDense q HostInterop res let actual = denseActual.ToHost q - res.Dispose q - denseActual.Dispose q + res.Dispose() + denseActual.Dispose() checkResult isEqual op zero array actual with @@ -101,7 +102,7 @@ let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = let testFixturesMapNot case = [ let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notOption) ] @@ -111,7 +112,7 @@ let notTests = let testFixturesMapAdd case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case 0 10 (+) (=) ArithmeticOperations.addLeftConst @@ -128,7 +129,7 @@ let addTests = let testFixturesMapMul case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case 0 10 (*) (=) ArithmeticOperations.mulLeftConst diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs index 0ef5a5dc..d7d8515d 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs @@ -10,6 +10,7 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Vector.ElementWise.Tests" @@ -44,8 +45,8 @@ let correctnessGenericTest isEqual zero op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClVector<'a> option) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (addFun: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClVector<'a> option) + (toDense: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) case (leftArray: 'a [], rightArray: 'a []) = @@ -77,14 +78,14 @@ let correctnessGenericTest let actual = denseActual.ToHost q - res.Dispose q - denseActual.Dispose q + res.Dispose() + denseActual.Dispose() checkResult isEqual zero op actual leftArray rightArray | _ -> () - firstVector.Dispose q - secondVector.Dispose q + firstVector.Dispose() + secondVector.Dispose() with | ex when ex.Message = "InvalidBufferSize" -> () | ex -> raise ex diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs index a1afec05..21629319 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs @@ -34,8 +34,8 @@ let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = (isLeftBitmap: ClArray)) = testFun processor clFirstVector clSecondVector - clFirstVector.Dispose processor - clSecondVector.Dispose processor + clFirstVector.Dispose() + clSecondVector.Dispose() let actualIndices = allIndices.ToHostAndFree processor let actualFirstValues = firstValues.ToHostAndFree processor diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs index 436aba91..54b572a7 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs @@ -10,6 +10,7 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Vector.ofList.Tests" @@ -35,8 +36,8 @@ let checkResult let correctnessGenericTest<'a when 'a: struct> (isEqual: 'a -> 'a -> bool) - (ofList: MailboxProcessor<_> -> AllocationFlag -> VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) - (toCoo: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (ofList: RawCommandQueue -> AllocationFlag -> VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) + (toCoo: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) (case: OperationCase) (elements: (int * 'a) []) (sizeDelta: int) @@ -64,8 +65,8 @@ let correctnessGenericTest<'a when 'a: struct> let actual = clCooActual.ToHost q - clActual.Dispose q - clCooActual.Dispose q + clActual.Dispose() + clCooActual.Dispose() checkResult isEqual indices values actual actualSize @@ -88,7 +89,7 @@ let testFixtures (case: OperationCase) = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf $"%A{e}") + //q.Error.Add(fun e -> failwithf $"%A{e}") creatTest case creatTest case diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs index 00e157bf..f247564a 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs @@ -52,7 +52,7 @@ let testFixtures case = let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ createTest case (=) 0 (+) <@ (+) @> "add" createTest case (=) 0uy (+) <@ (+) @> "add" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMSpV.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMSpV.fs index f4195db7..20243b01 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMSpV.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMSpV.fs @@ -10,6 +10,7 @@ open GraphBLAS.FSharp.Tests.TestCases open Microsoft.FSharp.Collections open Microsoft.FSharp.Core open GraphBLAS.FSharp.Objects +open Brahma.FSharp let config = Utils.defaultConfig @@ -59,7 +60,7 @@ let correctnessGenericTest some sumOp mulOp - (spMV: MailboxProcessor<_> -> ClMatrix<'a> -> ClVector<'a> -> ClVector<'a> option) + (spMV: RawCommandQueue -> ClMatrix<'a> -> ClVector<'a> -> ClVector<'a> option) (isEqual: 'a -> 'a -> bool) q (testContext: TestContext) @@ -85,11 +86,11 @@ let correctnessGenericTest match spMV testContext.Queue m v with | Some (ClVector.Sparse res) -> - m.Dispose q - v.Dispose q + m.Dispose() + v.Dispose() let hostResIndices = res.Indices.ToHost q let hostResValues = res.Values.ToHost q - res.Dispose q + res.Dispose() checkResult sumOp mulOp zero matrix vector hostResIndices hostResValues | _ -> failwith "Result should not be empty while standard operations are tested" @@ -114,7 +115,7 @@ let createTest spmspv testContext (zero: 'a) some isEqual add mul addQ mulQ = let testFixturesSpMSpV (testContext: TestContext) = [ let context = testContext.ClContext let q = testContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTest Operations.SpMSpVBool diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs index b4688fa4..d18c7f7c 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs @@ -51,7 +51,7 @@ let correctnessGenericTest zero sumOp mulOp - (spMV: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClVector<'a> -> ClVector<'a>) + (spMV: RawCommandQueue -> AllocationFlag -> ClMatrix<'a> -> ClVector<'a> -> ClVector<'a>) (isEqual: 'a -> 'a -> bool) q (testContext: TestContext) @@ -72,8 +72,8 @@ let correctnessGenericTest let res = spMV testContext.Queue HostInterop m v - m.Dispose q - v.Dispose q + m.Dispose() + v.Dispose() match res with | ClVector.Dense res -> @@ -102,7 +102,7 @@ let createTest testContext (zero: 'a) isEqual add mul addQ mulQ = let testFixturesSpMV (testContext: TestContext) = [ let context = testContext.ClContext let q = testContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSumOption ArithmeticOperations.boolMulOption createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs index cccfa3d7..fb15d602 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs @@ -10,6 +10,7 @@ open TestCases open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Vector.zeroCreate.Tests" @@ -30,7 +31,7 @@ let checkResult size (actual: Vector<'a>) = Expect.equal vector.Indices [| 0 |] "The index array must contain the 0" let correctnessGenericTest<'a when 'a: struct and 'a: equality> - (zeroCreate: MailboxProcessor<_> -> AllocationFlag -> int -> VectorFormat -> ClVector<'a>) + (zeroCreate: RawCommandQueue -> AllocationFlag -> int -> VectorFormat -> ClVector<'a>) (case: OperationCase) (vectorSize: int) = @@ -46,7 +47,7 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> let hostVector = clVector.ToHost q - clVector.Dispose q + clVector.Dispose() checkResult vectorSize hostVector with @@ -69,7 +70,7 @@ let testFixtures case = let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ createTest case createTest case diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 947287bc..b2e819ef 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -402,7 +402,7 @@ module HostPrimitives = module Context = type TestContext = { ClContext: ClContext - Queue: MailboxProcessor } + Queue: RawCommandQueue } let availableContexts (platformRegex: string) = let mutable e = ErrorCode.Unknown @@ -465,7 +465,10 @@ module Context = let translator = FSQuotationToOpenCLTranslator device let context = ClContext(device, translator) - let queue = context.QueueProvider.CreateQueue() + + let queue = + RawCommandQueue(context.ClDevice.Device, context.Context, context.Translator) + { ClContext = context; Queue = queue }) @@ -475,7 +478,8 @@ module Context = let context = ClContext(device, FSQuotationToOpenCLTranslator device) - let queue = context.QueueProvider.CreateQueue() + let queue = + RawCommandQueue(context.ClDevice.Device, context.Context, context.Translator) { ClContext = context; Queue = queue }