From cb589c1f73c0621f4adb577a61b2499133ab8048 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 15 May 2010 11:45:02 -0700 Subject: [PATCH] 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 --- extra/cuda/cuda.factor | 26 +++---------------- .../cuda/demos/hello-world/hello-world.factor | 3 ++- extra/cuda/demos/prefix-sum/prefix-sum.factor | 5 ++-- extra/cuda/devices/devices.factor | 4 +-- extra/cuda/gl/gl.factor | 5 ++-- extra/cuda/utils/utils.factor | 10 ++++--- 6 files changed, 18 insertions(+), 35 deletions(-) diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor index 893058eec5..93de4174e9 100644 --- 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 } ; - -: ( 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 5db01e412a..d097cb4a2d 100644 --- 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 c7e59b515a..1ea8d83b44 100644 --- 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 7ad7b32c8d..fdc86b05f2 100644 --- 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 '[ _ with-cuda ] each ; inline + [ enumerate-cuda-devices ] dip '[ 0 _ with-cuda-context ] each ; inline : cuda-device-properties ( n -- properties ) [ CUdevprop ] 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 2250c895e0..ae4cefb11f 100644 --- 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 ] 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 f329313ceb..a8e6210970 100644 --- 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 ] 2dip [ cuCtxCreate cuda-error ] 3keep 2drop *void* ; inline : sync-context ( -- ) cuCtxSynchronize cuda-error ; inline +: context-device ( -- n ) + CUdevice [ 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 +