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
db4
Joe Groff 2010-05-15 11:45:02 -07:00
parent 5c0c87fcaa
commit 22e853ecb0
6 changed files with 18 additions and 35 deletions

View File

@ -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* ] ] }

View File

@ -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

View File

@ -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

View File

@ -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

View File

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

View File

@ -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