cuda: more API cleanups:

	- remove useless with-cuda and with-cuda-program combinators
	- eliminate redundant cuda-device, cuda-context variables
	- rearrange arguments of with-*cuda-context to ( device flags quot -- )
	- don't pass context to with-cuda-context quot
	- add context-device word to ask for current device

diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor
index 893058eec5e4642e169ed624a8c51141c553db2a..93de4174e9917383056edb959990526e9c019f1c 100644 (file)
--- a/extra/cuda/cuda.factor
+++ b/extra/cuda/cuda.factor
@@ -10,40 +10,20 @@ sequences words cuda.libraries ;
 QUALIFIED-WITH: alien.c-types c
 IN: cuda
 
-TUPLE: launcher
-{ device integer initial: 0 }
-{ device-flags initial: 0 } ;
-
-: <launcher> ( device-id -- launcher )
-    launcher new
-        swap >>device ; inline
-
 TUPLE: function-launcher
 dim-grid dim-block shared-size stream ;
 
-: (set-up-cuda-context) ( flags device create-quot -- )
+: (set-up-cuda-context) ( device flags create-quot -- )
     H{ } clone cuda-modules set-global
     H{ } clone cuda-functions set
     call ; inline
 
 : (with-cuda-context) ( context quot -- )
-    [ '[ _ @ ] ]
-    [ drop '[ [ sync-context ] ignore-errors _ destroy-context ] ] 2bi
-    [ ] cleanup ; inline
+    swap '[ [ sync-context ] ignore-errors _ destroy-context ] [ ] cleanup ; inline
 
-: with-cuda-context ( flags device quot -- )
+: with-cuda-context ( device flags quot -- )
     [ [ create-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline
 
-: with-cuda-program ( flags device quot -- )
-    [ dup cuda-device set ] 2dip
-    '[ cuda-context set _ call ] with-cuda-context ; inline
-
-: with-cuda ( launcher quot -- )
-    init-cuda [
-        [ cuda-launcher set ]
-        [ [ device>> ] [ device-flags>> ] bi ] bi
-    ] [ with-cuda-program ] bi* ; inline
-
 : c-type>cuda-setter ( c-type -- n cuda-type )
     {
         { [ dup c:int = ] [ drop 4 [ cuda-int* ] ] }

diff --git a/extra/cuda/demos/hello-world/hello-world.factor b/extra/cuda/demos/hello-world/hello-world.factor
index 5db01e412ac576c84baff215b6539839e3a175f8..d097cb4a2df2b50c8e35b7befe23aea64801a859 100644 (file)
--- a/extra/cuda/demos/hello-world/hello-world.factor
+++ b/extra/cuda/demos/hello-world/hello-world.factor
@@ -11,9 +11,10 @@ CUDA-LIBRARY: hello vocab:cuda/demos/hello-world/hello.ptx
 CUDA-FUNCTION: helloWorld ( char* string-ptr ) ;
 
 : cuda-hello-world ( -- )
+    init-cuda
     [
         [
-            cuda-launcher get device>> number>string
+            context-device number>string
             "CUDA device " ": " surround write
             "Hello World!" >byte-array [ - ] map-index host>device &cuda-free
 

diff --git a/extra/cuda/demos/prefix-sum/prefix-sum.factor b/extra/cuda/demos/prefix-sum/prefix-sum.factor
index c7e59b515a15b62bead8d6c47d9e1030c8f09189..1ea8d83b442399ec586c46ac42d9b95f1f60ebc6 100644 (file)
--- a/extra/cuda/demos/prefix-sum/prefix-sum.factor
+++ b/extra/cuda/demos/prefix-sum/prefix-sum.factor
@@ -8,9 +8,8 @@ CUDA-LIBRARY: prefix-sum vocab:cuda/demos/prefix-sum/prefix-sum.ptx
 CUDA-FUNCTION: prefix_sum_block ( uint* in, uint* out, uint n ) ;
 
 :: cuda-prefix-sum ( -- )
-    T{ launcher { device 0 } }
-    [
+    0 0 [
         ! { 1 1 1 } { 2 1 } 0 3<<< prefix_sum_block
-    ] with-cuda ;
+    ] with-cuda-context ;
 
 MAIN: cuda-prefix-sum

diff --git a/extra/cuda/devices/devices.factor b/extra/cuda/devices/devices.factor
index 7ad7b32c8d5e5d9563dce96cd7dbb900957a9c71..fdc86b05f23be2a1799476a656950fe989c0298e 100644 (file)
--- a/extra/cuda/devices/devices.factor
+++ b/extra/cuda/devices/devices.factor
@@ -16,7 +16,7 @@ IN: cuda.devices
     #cuda-devices iota [ n>cuda-device ] map ;
 
 : with-each-cuda-device ( quot -- )
-    [ enumerate-cuda-devices ] dip '[ <launcher> _ with-cuda ] each ; inline
+    [ enumerate-cuda-devices ] dip '[ 0 _ with-cuda-context ] each ; inline
 
 : cuda-device-properties ( n -- properties )
     [ CUdevprop <struct> ] dip
@@ -81,6 +81,6 @@ IN: cuda.devices
     grid-size block-size per-block-shared ; inline
 
 : distribute-jobs ( job-count per-job-shared -- launcher )
-    cuda-device get cuda-device-properties 
+    context-device cuda-device-properties 
     [ sharedMemPerBlock>> ] [ maxThreadsDim>> first ] bi
     (distribute-jobs) 3<<< ; inline

diff --git a/extra/cuda/gl/gl.factor b/extra/cuda/gl/gl.factor
index 2250c895e0112c14fecd1421ba823a58f4f82582..ae4cefb11f01d46a784284aed8fe5741a225250f 100644 (file)
--- a/extra/cuda/gl/gl.factor
+++ b/extra/cuda/gl/gl.factor
@@ -4,11 +4,12 @@ continuations cuda cuda.ffi cuda.gl.ffi cuda.utils destructors
 fry gpu.buffers kernel ;
 IN: cuda.gl
 
-: create-gl-cuda-context ( flags device -- context )
+: create-gl-cuda-context ( device flags -- context )
+    swap
     [ CUcontext <c-object> ] 2dip
     [ cuGLCtxCreate cuda-error ] 3keep 2drop *void* ; inline
 
-: with-gl-cuda-context ( flags device quot -- )
+: with-gl-cuda-context ( device flags quot -- )
     [ [ create-gl-cuda-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline 
 
 : gl-buffer>resource ( gl-buffer flags -- resource )

diff --git a/extra/cuda/utils/utils.factor b/extra/cuda/utils/utils.factor
index f329313cebdeba9ced3143b35465a928af790ef8..a8e6210970bbecddddbcb63eb72dfc563cce776d 100644 (file)
--- a/extra/cuda/utils/utils.factor
+++ b/extra/cuda/utils/utils.factor
@@ -6,11 +6,8 @@ io io.backend io.encodings.utf8 kernel math.parser namespaces
 prettyprint sequences ;
 IN: cuda.utils
 
-SYMBOL: cuda-device
-SYMBOL: cuda-context
 SYMBOL: cuda-module
 SYMBOL: cuda-function
-SYMBOL: cuda-launcher
 
 SYMBOL: cuda-modules
 SYMBOL: cuda-functions
@@ -38,13 +35,17 @@ ERROR: throw-cuda-error n ;
         get-function-ptr* cuda-function set
     ] dip call ; inline
 
-: create-context ( flags device -- context )
+: create-context ( device flags -- context )
+    swap
     [ CUcontext <c-object> ] 2dip
     [ cuCtxCreate cuda-error ] 3keep 2drop *void* ; inline
 
 : sync-context ( -- )
     cuCtxSynchronize cuda-error ; inline
 
+: context-device ( -- n )
+    CUdevice <c-object> [ cuCtxGetDevice cuda-error ] keep *int ; inline
+
 : destroy-context ( context -- ) cuCtxDestroy cuda-error ; inline
 
 : launch-function* ( function -- ) cuLaunch cuda-error ; inline
@@ -95,3 +96,4 @@ ERROR: throw-cuda-error n ;
 : function-shared-size ( n -- )
     [ cuda-function get ] dip
     cuFuncSetSharedSize cuda-error ; inline
+