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 devicedb4
parent
5c0c87fcaa
commit
22e853ecb0
|
@ -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* ] ] }
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue