Encapsulate ClCell management inside operation

SparseLinearAlgebra · Oct 10, 2023 · 53c6715 · 53c6715
1 parent ca7b275
commit 53c6715
Show file tree

Hide file tree

Showing 5 changed files with 25 additions and 15 deletions.
diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs
@@ -50,7 +50,7 @@ module internal BFS =
                 level <- level + 1
 
                 //Assigning new level values
-                fillSubVectorTo queue levels front (clContext.CreateClCell level)
+                fillSubVectorTo queue levels front level
 
                 //Getting new frontier
                 spMVInPlace queue matrix front front
@@ -103,7 +103,7 @@ module internal BFS =
                 level <- level + 1
 
                 //Assigning new level values
-                fillSubVectorTo queue levels front (clContext.CreateClCell level)
+                fillSubVectorTo queue levels front level
 
                 //Getting new frontier
                 match spMSpV queue matrix front with
@@ -185,7 +185,7 @@ module internal BFS =
                 level <- level + 1
 
                 //Assigning new level values
-                fillSubVectorInPlace queue levels frontier (clContext.CreateClCell level)
+                fillSubVectorInPlace queue levels frontier level
 
                 match frontier with
                 | ClVector.Sparse _ ->

diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs
@@ -66,20 +66,24 @@ module Vector =
 
         let kernel = clContext.Compile(fillSubVectorKernel)
 
-        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'a option>) ->
+        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: 'a) (resultVector: ClArray<'a option>) ->
 
             let ndRange =
                 Range1D.CreateValid(leftVector.Length, workGroupSize)
 
             let kernel = kernel.GetKernel()
 
+            let valueCell = clContext.CreateClCell(value)
+
             processor.Post(
                 Msg.MsgSetArguments
-                    (fun () -> kernel.KernelFunc ndRange leftVector.Length leftVector maskVector value resultVector)
+                    (fun () -> kernel.KernelFunc ndRange leftVector.Length leftVector maskVector valueCell resultVector)
             )
 
             processor.Post(Msg.CreateRunMsg<_, _>(kernel))
 
+            valueCell.Free processor
+
     let assignByMask<'a, 'b when 'a: struct and 'b: struct>
         (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>)
         (clContext: ClContext)
@@ -89,7 +93,7 @@ module Vector =
         let assignByMask =
             assignByMaskInPlace maskOp clContext workGroupSize
 
-        fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) ->
+        fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: 'a) ->
             let resultVector =
                 clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftVector.Length)
 
@@ -114,13 +118,15 @@ module Vector =
 
         let kernel = clContext.Compile(fillSubVectorKernel)
 
-        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: Sparse<'b>) (value: ClCell<'a>) (resultVector: ClArray<'a option>) ->
+        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: Sparse<'b>) (value: 'a) (resultVector: ClArray<'a option>) ->
 
             let ndRange =
                 Range1D.CreateValid(maskVector.NNZ, workGroupSize)
 
             let kernel = kernel.GetKernel()
 
+            let valueCell = clContext.CreateClCell(value)
+
             processor.Post(
                 Msg.MsgSetArguments
                     (fun () ->
@@ -130,12 +136,14 @@ module Vector =
                             leftVector
                             maskVector.Indices
                             maskVector.Values
-                            value
+                            valueCell
                             resultVector)
             )
 
             processor.Post(Msg.CreateRunMsg<_, _>(kernel))
 
+            valueCell.Free processor
+
     let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize =
 
         let scatterValues =

diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs
@@ -281,7 +281,9 @@ module internal Map2 =
         let setPositions =
             Common.setPositions clContext workGroupSize
 
-        fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: ClCell<'a>) ->
+        fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: 'a) ->
+
+            let valueCell = clContext.CreateClCell(value)
 
             let bitmap, values, indices =
                 prepare
@@ -291,11 +293,12 @@ module internal Map2 =
                     leftVector.Indices
                     rightVector.Values
                     rightVector.Indices
-                    value
+                    valueCell
 
             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))

diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs
@@ -158,7 +158,7 @@ module Vector =
         let denseFillVector =
             Dense.Vector.assignByMask op clContext workGroupSize
 
-        fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: ClCell<'a>) ->
+        fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: 'a) ->
             match vector, mask with
             | ClVector.Sparse vector, ClVector.Sparse mask ->
                 ClVector.Sparse
@@ -198,7 +198,7 @@ module Vector =
         let assignBySparse =
             Dense.Vector.assignBySparseMaskInPlace op clContext workGroupSize
 
-        fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (mask: ClVector<'b>) (value: ClCell<'a>) ->
+        fun (processor: MailboxProcessor<_>) (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

diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs
@@ -51,7 +51,7 @@ 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<Msg> -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClCell<'a> -> ClVector<'a>)
+    (fillVector: MailboxProcessor<Msg> -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> 'a -> ClVector<'a>)
     isComplemented
     case
     (vector: 'a [], mask: 'a [], value: 'a)
@@ -72,10 +72,9 @@ let makeTest<'a when 'a: struct and 'a: equality>
         let clMaskVector = maskVector.ToDevice context
 
         try
-            let clValue = context.CreateClCell<'a> value
 
             let clActual =
-                fillVector q HostInterop clLeftVector clMaskVector clValue
+                fillVector q HostInterop clLeftVector clMaskVector value
 
             let cooClActual = toDense q HostInterop clActual