steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

improve cuda library organization

db4
Joe Groff 2010-05-20 14:32:35 -07:00
parent f31c579b7b
commit 1a3fd1dc8c
10 changed files with 204 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
extra/cuda/contexts/contexts.factor Normal file
View File

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

74
extra/cuda/cuda.factor
View File

@ -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 <c-object> [ 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 ;
<PRIVATE
: block-dim ( block -- x y z )
dup sequence? [ 3 1 pad-tail first3 ] [ 1 1 ] if ; inline
: grid-dim ( block -- x y )
dup sequence? [ 2 1 pad-tail first2 ] [ 1 ] if ; inline
PRIVATE>
: 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 ;

8
extra/cuda/demos/hello-world/hello-world.factor
View File

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

2
extra/cuda/demos/prefix-sum/prefix-sum.factor
View File

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

7
extra/cuda/devices/devices.factor
View File

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

4
extra/cuda/gl/gl.factor
View File

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

183
extra/cuda/libraries/libraries.factor
View File

@ -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 ;
<PRIVATE
: block-dim ( block -- x y z )
dup sequence? [ 3 1 pad-tail first3 ] [ 1 1 ] if ; inline
: grid-dim ( block -- x y )
dup sequence? [ 2 1 pad-tail first2 ] [ 1 ] if ; inline
PRIVATE>
: load-module ( path -- module )
[ CUmodule <c-object> ] 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 <c-object> ] 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 ;
: <cuda-library> ( name path -- obj )
@ -20,34 +168,3 @@ TUPLE: cuda-library name path handle ;
normalize-path <cuda-library>
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 <c-object> ] 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 ;

5
extra/cuda/memory/memory.factor
View File

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

2
extra/cuda/syntax/syntax.factor
View File

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

96
extra/cuda/utils/utils.factor
View File

@ -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 <c-object> [ cuDriverGetVersion cuda-error ] keep *int ;
: get-function-ptr* ( module string -- function )
[ CUfunction <c-object> ] 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 <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
: 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