From 1a3fd1dc8c13f500796b7e45db503cddb7be40ae Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 20 May 2010 14:32:35 -0700 Subject: [PATCH] improve cuda library organization --- extra/cuda/contexts/contexts.factor | 29 +++ extra/cuda/cuda.factor | 74 +------ .../cuda/demos/hello-world/hello-world.factor | 8 +- extra/cuda/demos/prefix-sum/prefix-sum.factor | 2 +- extra/cuda/devices/devices.factor | 7 +- extra/cuda/gl/gl.factor | 4 +- extra/cuda/libraries/libraries.factor | 183 ++++++++++++++---- extra/cuda/memory/memory.factor | 5 +- extra/cuda/syntax/syntax.factor | 2 +- extra/cuda/utils/utils.factor | 96 --------- 10 files changed, 204 insertions(+), 206 deletions(-) create mode 100644 extra/cuda/contexts/contexts.factor delete mode 100644 extra/cuda/utils/utils.factor diff --git a/extra/cuda/contexts/contexts.factor b/extra/cuda/contexts/contexts.factor new file mode 100644 index 0000000000..a218c588c5 --- /dev/null +++ b/extra/cuda/contexts/contexts.factor @@ -0,0 +1,29 @@ +! (c)2010 Joe Groff bsd license +USING: alien.c-types alien.data continuations cuda cuda.ffi +cuda.libraries fry kernel namespaces ; +IN: cuda.contexts + +: 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 + +: (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 -- ) + swap '[ [ sync-context ] ignore-errors _ destroy-context ] [ ] cleanup ; inline + +: with-cuda-context ( device flags quot -- ) + [ [ create-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline + diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor index a9b67446d8..2e2cdd660f 100644 --- a/extra/cuda/cuda.factor +++ b/extra/cuda/cuda.factor @@ -2,76 +2,22 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.data alien.parser alien.strings alien.syntax arrays assocs byte-arrays classes.struct -combinators continuations cuda.ffi cuda.memory cuda.utils +combinators continuations cuda.ffi destructors fry init io io.backend io.encodings.string io.encodings.utf8 kernel lexer locals macros math math.parser namespaces opengl.gl.extensions parser prettyprint quotations -sequences words cuda.libraries ; +sequences words ; QUALIFIED-WITH: alien.c-types c IN: cuda +TUPLE: cuda-error code ; + +: cuda-error ( code -- ) + dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ; + +: cuda-version ( -- n ) + c:int [ cuDriverGetVersion cuda-error ] keep c:*int ; + : init-cuda ( -- ) 0 cuInit cuda-error ; inline -TUPLE: function-launcher -dim-grid dim-block shared-size stream ; - -: (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 -- ) - swap '[ [ sync-context ] ignore-errors _ destroy-context ] [ ] cleanup ; inline - -: with-cuda-context ( device flags quot -- ) - [ [ create-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline - -: c-type>cuda-setter ( c-type -- n cuda-type ) - { - { [ dup c:int = ] [ drop 4 [ cuda-int* ] ] } - { [ dup c:uint = ] [ drop 4 [ cuda-int* ] ] } - { [ dup c:float = ] [ drop 4 [ cuda-float* ] ] } - { [ dup c:pointer? ] [ drop 4 [ cuda-int* ] ] } - { [ dup c:void* = ] [ drop 4 [ cuda-int* ] ] } - } cond ; - - - -: run-function-launcher ( function-launcher function -- ) - swap - { - [ dim-block>> block-dim function-block-shape* ] - [ shared-size>> function-shared-size* ] - [ - dim-grid>> - [ grid-dim launch-function-grid* ] - [ launch-function* ] if* - ] - } 2cleave ; - -: cuda-argument-setter ( offset c-type -- offset' quot ) - c-type>cuda-setter - [ over [ + ] dip ] dip - '[ swap _ swap _ call ] ; - -MACRO: cuda-arguments ( c-types -- quot: ( args... function -- ) ) - [ 0 ] dip [ cuda-argument-setter ] map reverse - swap '[ _ param-size* ] suffix - '[ _ cleave ] ; - -: define-cuda-word ( word module-name function-name arguments -- ) - [ - '[ - _ _ cached-function - [ nip _ cuda-arguments ] - [ run-function-launcher ] 2bi - ] - ] - [ 2nip \ function-launcher suffix c:void function-effect ] - 3bi define-declared ; diff --git a/extra/cuda/demos/hello-world/hello-world.factor b/extra/cuda/demos/hello-world/hello-world.factor index d097cb4a2d..4c2f68f011 100644 --- a/extra/cuda/demos/hello-world/hello-world.factor +++ b/extra/cuda/demos/hello-world/hello-world.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2010 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.strings cuda cuda.devices -cuda.memory cuda.syntax cuda.utils destructors io -io.encodings.string io.encodings.utf8 kernel locals math -math.parser namespaces sequences byte-arrays strings ; +USING: accessors alien.c-types alien.strings byte-arrays cuda +cuda.contexts cuda.devices cuda.memory cuda.syntax destructors +io io.encodings.string io.encodings.utf8 kernel locals math +math.parser namespaces sequences strings ; IN: cuda.demos.hello-world CUDA-LIBRARY: hello vocab:cuda/demos/hello-world/hello.ptx diff --git a/extra/cuda/demos/prefix-sum/prefix-sum.factor b/extra/cuda/demos/prefix-sum/prefix-sum.factor index daa1c6c674..badd7d905d 100644 --- a/extra/cuda/demos/prefix-sum/prefix-sum.factor +++ b/extra/cuda/demos/prefix-sum/prefix-sum.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types cuda cuda.syntax locals ; +USING: alien.c-types cuda cuda.contexts cuda.syntax locals ; IN: cuda.demos.prefix-sum CUDA-LIBRARY: prefix-sum vocab:cuda/demos/prefix-sum/prefix-sum.ptx diff --git a/extra/cuda/devices/devices.factor b/extra/cuda/devices/devices.factor index e86c46a9cc..594e894ce1 100644 --- a/extra/cuda/devices/devices.factor +++ b/extra/cuda/devices/devices.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2010 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types alien.data alien.strings arrays -assocs byte-arrays classes.struct combinators cuda cuda.ffi -cuda.syntax cuda.utils fry io io.encodings.utf8 kernel locals -math math.order math.parser namespaces prettyprint sequences ; +assocs byte-arrays classes.struct combinators cuda +cuda.contexts cuda.ffi cuda.syntax fry io io.encodings.utf8 +kernel locals math math.order math.parser namespaces +prettyprint sequences ; IN: cuda.devices : #cuda-devices ( -- n ) diff --git a/extra/cuda/gl/gl.factor b/extra/cuda/gl/gl.factor index 925c7d137f..f3a6b47cf6 100644 --- a/extra/cuda/gl/gl.factor +++ b/extra/cuda/gl/gl.factor @@ -1,7 +1,7 @@ ! (c)2010 Joe Groff bsd license USING: accessors alien.c-types alien.data alien.destructors -alien.enums continuations cuda cuda.ffi cuda.gl.ffi cuda.utils -destructors fry gpu.buffers kernel ; +alien.enums continuations cuda cuda.contexts cuda.ffi +cuda.gl.ffi destructors fry gpu.buffers kernel ; IN: cuda.gl : create-gl-cuda-context ( device flags -- context ) diff --git a/extra/cuda/libraries/libraries.factor b/extra/cuda/libraries/libraries.factor index 93b9842919..768c4e2ee1 100644 --- a/extra/cuda/libraries/libraries.factor +++ b/extra/cuda/libraries/libraries.factor @@ -1,14 +1,162 @@ ! Copyright (C) 2010 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.data arrays assocs -cuda.ffi cuda.utils io.backend kernel namespaces sequences ; +USING: accessors alien.data alien.parser arrays +assocs combinators cuda cuda.ffi fry io.backend kernel macros +math namespaces sequences words ; +QUALIFIED-WITH: alien.c-types c IN: cuda.libraries +SYMBOL: cuda-module +SYMBOL: cuda-function + +SYMBOL: cuda-modules +SYMBOL: cuda-functions + SYMBOL: cuda-libraries cuda-libraries [ H{ } clone ] initialize SYMBOL: current-cuda-library +: ?delete-at ( key assoc -- old/key ? ) + 2dup delete-at* [ 2nip t ] [ 2drop f ] if ; inline + +: cuda-int* ( function offset value -- ) + cuParamSeti cuda-error ; inline + +: cuda-int ( offset value -- ) + [ cuda-function get ] 2dip cuda-int* ; inline + +: cuda-float* ( function offset value -- ) + cuParamSetf cuda-error ; inline + +: cuda-float ( offset value -- ) + [ cuda-function get ] 2dip cuda-float* ; inline + +: cuda-vector* ( function offset ptr n -- ) + cuParamSetv cuda-error ; inline + +: cuda-vector ( offset ptr n -- ) + [ cuda-function get ] 3dip cuda-vector* ; inline + +: param-size* ( function n -- ) + cuParamSetSize cuda-error ; inline + +: param-size ( n -- ) + [ cuda-function get ] dip param-size* ; inline + +: launch-function-grid* ( function width height -- ) + cuLaunchGrid cuda-error ; inline + +: launch-function-grid ( width height -- ) + [ cuda-function get ] 2dip + cuLaunchGrid cuda-error ; inline + +: function-block-shape* ( function x y z -- ) + cuFuncSetBlockShape cuda-error ; inline + +: function-block-shape ( x y z -- ) + [ cuda-function get ] 3dip + cuFuncSetBlockShape cuda-error ; inline + +: function-shared-size* ( function n -- ) + cuFuncSetSharedSize cuda-error ; inline + +: function-shared-size ( n -- ) + [ cuda-function get ] dip + cuFuncSetSharedSize cuda-error ; inline + +TUPLE: function-launcher +dim-grid dim-block shared-size stream ; + +: c-type>cuda-setter ( c-type -- n cuda-type ) + { + { [ dup c:int = ] [ drop 4 [ cuda-int* ] ] } + { [ dup c:uint = ] [ drop 4 [ cuda-int* ] ] } + { [ dup c:float = ] [ drop 4 [ cuda-float* ] ] } + { [ dup c:pointer? ] [ drop 4 [ cuda-int* ] ] } + { [ dup c:void* = ] [ drop 4 [ cuda-int* ] ] } + } cond ; + + + +: load-module ( path -- module ) + [ CUmodule ] dip + [ cuModuleLoad cuda-error ] 2keep drop c:*void* ; + +: unload-module ( module -- ) + cuModuleUnload cuda-error ; + +: load-cuda-library ( library -- handle ) + path>> load-module ; + +ERROR: no-cuda-library name ; + +: lookup-cuda-library ( name -- cuda-library ) + cuda-libraries get ?at [ no-cuda-library ] unless ; + +: remove-cuda-library ( name -- library ) + cuda-libraries get ?delete-at [ no-cuda-library ] unless ; + +: unload-cuda-library ( name -- ) + remove-cuda-library handle>> unload-module ; + +: launch-function* ( function -- ) cuLaunch cuda-error ; inline + +: launch-function ( -- ) cuda-function get cuLaunch cuda-error ; inline + +: run-function-launcher ( function-launcher function -- ) + swap + { + [ dim-block>> block-dim function-block-shape* ] + [ shared-size>> function-shared-size* ] + [ + dim-grid>> + [ grid-dim launch-function-grid* ] + [ launch-function* ] if* + ] + } 2cleave ; + +: cuda-argument-setter ( offset c-type -- offset' quot ) + c-type>cuda-setter + [ over [ + ] dip ] dip + '[ swap _ swap _ call ] ; + +MACRO: cuda-arguments ( c-types -- quot: ( args... function -- ) ) + [ 0 ] dip [ cuda-argument-setter ] map reverse + swap '[ _ param-size* ] suffix + '[ _ cleave ] ; + +: get-function-ptr* ( module string -- function ) + [ CUfunction ] 2dip + [ cuModuleGetFunction cuda-error ] 3keep 2drop c:*void* ; + +: get-function-ptr ( string -- function ) + [ cuda-module get ] dip get-function-ptr* ; + +: cached-module ( module-name -- alien ) + lookup-cuda-library + cuda-modules get-global [ load-cuda-library ] cache ; + +: cached-function ( module-name function-name -- alien ) + [ cached-module ] dip + 2array cuda-functions get [ first2 get-function-ptr* ] cache ; + +: define-cuda-word ( word module-name function-name arguments -- ) + [ + '[ + _ _ cached-function + [ nip _ cuda-arguments ] + [ run-function-launcher ] 2bi + ] + ] + [ 2nip \ function-launcher suffix c:void function-effect ] + 3bi define-declared ; + TUPLE: cuda-library name path handle ; : ( name path -- obj ) @@ -20,34 +168,3 @@ TUPLE: cuda-library name path handle ; normalize-path dup name>> cuda-libraries get-global set-at ; -: ?delete-at ( key assoc -- old/key ? ) - 2dup delete-at* [ 2nip t ] [ 2drop f ] if ; inline - -ERROR: no-cuda-library name ; - -: load-module ( path -- module ) - [ CUmodule ] dip - [ cuModuleLoad cuda-error ] 2keep drop *void* ; - -: unload-module ( module -- ) - cuModuleUnload cuda-error ; - -: load-cuda-library ( library -- handle ) - path>> load-module ; - -: lookup-cuda-library ( name -- cuda-library ) - cuda-libraries get ?at [ no-cuda-library ] unless ; - -: remove-cuda-library ( name -- library ) - cuda-libraries get ?delete-at [ no-cuda-library ] unless ; - -: unload-cuda-library ( name -- ) - remove-cuda-library handle>> unload-module ; - -: cached-module ( module-name -- alien ) - lookup-cuda-library - cuda-modules get-global [ load-cuda-library ] cache ; - -: cached-function ( module-name function-name -- alien ) - [ cached-module ] dip - 2array cuda-functions get [ first2 get-function-ptr* ] cache ; diff --git a/extra/cuda/memory/memory.factor b/extra/cuda/memory/memory.factor index b9bfd768d8..f3c452093a 100644 --- a/extra/cuda/memory/memory.factor +++ b/extra/cuda/memory/memory.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2010 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.data alien.destructors assocs -byte-arrays cuda.ffi cuda.utils destructors fry io.encodings.string -io.encodings.utf8 kernel locals math namespaces sequences strings ; +byte-arrays cuda cuda.ffi destructors fry io.encodings.string +io.encodings.utf8 kernel locals math namespaces sequences +strings ; QUALIFIED-WITH: alien.c-types c IN: cuda.memory diff --git a/extra/cuda/syntax/syntax.factor b/extra/cuda/syntax/syntax.factor index 237a87f900..8f74c63243 100644 --- a/extra/cuda/syntax/syntax.factor +++ b/extra/cuda/syntax/syntax.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2010 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.parser cuda cuda.libraries cuda.utils io.backend +USING: alien.parser cuda cuda.libraries io.backend kernel lexer namespaces parser ; IN: cuda.syntax diff --git a/extra/cuda/utils/utils.factor b/extra/cuda/utils/utils.factor deleted file mode 100644 index 87abdb5508..0000000000 --- a/extra/cuda/utils/utils.factor +++ /dev/null @@ -1,96 +0,0 @@ -! Copyright (C) 2010 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.data alien.strings arrays -assocs byte-arrays classes.struct combinators cuda.ffi -io io.backend io.encodings.utf8 kernel math.parser namespaces -prettyprint sequences ; -IN: cuda.utils - -SYMBOL: cuda-module -SYMBOL: cuda-function - -SYMBOL: cuda-modules -SYMBOL: cuda-functions - -ERROR: throw-cuda-error n ; - -: cuda-error ( n -- ) - dup CUDA_SUCCESS = [ drop ] [ throw-cuda-error ] if ; - -: cuda-version ( -- n ) - int [ cuDriverGetVersion cuda-error ] keep *int ; - -: get-function-ptr* ( module string -- function ) - [ CUfunction ] 2dip - [ cuModuleGetFunction cuda-error ] 3keep 2drop *void* ; - -: get-function-ptr ( string -- function ) - [ cuda-module get ] dip get-function-ptr* ; - -: with-cuda-function ( string quot -- ) - [ - get-function-ptr* cuda-function set - ] dip call ; inline - -: 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 - -: launch-function ( -- ) cuda-function get cuLaunch cuda-error ; inline - -: cuda-int* ( function offset value -- ) - cuParamSeti cuda-error ; inline - -: cuda-int ( offset value -- ) - [ cuda-function get ] 2dip cuda-int* ; inline - -: cuda-float* ( function offset value -- ) - cuParamSetf cuda-error ; inline - -: cuda-float ( offset value -- ) - [ cuda-function get ] 2dip cuda-float* ; inline - -: cuda-vector* ( function offset ptr n -- ) - cuParamSetv cuda-error ; inline - -: cuda-vector ( offset ptr n -- ) - [ cuda-function get ] 3dip cuda-vector* ; inline - -: param-size* ( function n -- ) - cuParamSetSize cuda-error ; inline - -: param-size ( n -- ) - [ cuda-function get ] dip param-size* ; inline - -: launch-function-grid* ( function width height -- ) - cuLaunchGrid cuda-error ; inline - -: launch-function-grid ( width height -- ) - [ cuda-function get ] 2dip - cuLaunchGrid cuda-error ; inline - -: function-block-shape* ( function x y z -- ) - cuFuncSetBlockShape cuda-error ; inline - -: function-block-shape ( x y z -- ) - [ cuda-function get ] 3dip - cuFuncSetBlockShape cuda-error ; inline - -: function-shared-size* ( function n -- ) - cuFuncSetSharedSize cuda-error ; inline - -: function-shared-size ( n -- ) - [ cuda-function get ] dip - cuFuncSetSharedSize cuda-error ; inline -