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

cuda.libraries: scrape out some useless code

Joe Groff 2010-05-20 15:57:23 -07:00
parent 1c07f69833
commit ccf8ed377b
1 changed files with 20 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,9 +6,6 @@ math namespaces sequences words ;
QUALIFIED-WITH: alien.c-types c QUALIFIED-WITH: alien.c-types c
IN: cuda.libraries IN: cuda.libraries
SYMBOL: cuda-module
SYMBOL: cuda-function
SYMBOL: cuda-modules SYMBOL: cuda-modules
SYMBOL: cuda-functions SYMBOL: cuda-functions
@ -20,49 +17,25 @@ SYMBOL: current-cuda-library
: ?delete-at ( key assoc -- old/key ? ) : ?delete-at ( key assoc -- old/key ? )
2dup delete-at* [ 2nip t ] [ 2drop f ] if ; inline 2dup delete-at* [ 2nip t ] [ 2drop f ] if ; inline
: cuda-int* ( function offset value -- ) : cuda-int ( function offset value -- )
cuParamSeti cuda-error ; inline cuParamSeti cuda-error ; inline
: cuda-int ( offset value -- ) : cuda-float ( function offset value -- )
[ cuda-function get ] 2dip cuda-int* ; inline
: cuda-float* ( function offset value -- )
cuParamSetf cuda-error ; inline cuParamSetf cuda-error ; inline
: cuda-float ( offset value -- ) : cuda-vector ( function offset ptr n -- )
[ cuda-function get ] 2dip cuda-float* ; inline
: cuda-vector* ( function offset ptr n -- )
cuParamSetv cuda-error ; inline cuParamSetv cuda-error ; inline
: cuda-vector ( offset ptr n -- ) : param-size ( function n -- )
[ cuda-function get ] 3dip cuda-vector* ; inline
: param-size* ( function n -- )
cuParamSetSize cuda-error ; inline cuParamSetSize cuda-error ; inline
: param-size ( n -- ) : launch-function-grid ( function width height -- )
[ cuda-function get ] dip param-size* ; inline
: launch-function-grid* ( function width height -- )
cuLaunchGrid cuda-error ; inline cuLaunchGrid cuda-error ; inline
: launch-function-grid ( width height -- ) : function-block-shape ( function x y z -- )
[ cuda-function get ] 2dip
cuLaunchGrid cuda-error ; inline
: function-block-shape* ( function x y z -- )
cuFuncSetBlockShape cuda-error ; inline cuFuncSetBlockShape cuda-error ; inline
: function-block-shape ( x y z -- ) : function-shared-size ( function n -- )
[ 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 cuFuncSetSharedSize cuda-error ; inline
TUPLE: grid TUPLE: grid
@ -79,11 +52,11 @@ dim-grid dim-block shared-size stream ;
: c-type>cuda-setter ( c-type -- n cuda-type ) : c-type>cuda-setter ( c-type -- n cuda-type )
{ {
{ [ dup c:int = ] [ drop 4 [ cuda-int* ] ] } { [ dup c:int = ] [ drop 4 [ cuda-int ] ] }
{ [ dup c:uint = ] [ drop 4 [ cuda-int* ] ] } { [ dup c:uint = ] [ drop 4 [ cuda-int ] ] }
{ [ dup c:float = ] [ drop 4 [ cuda-float* ] ] } { [ dup c:float = ] [ drop 4 [ cuda-float ] ] }
{ [ dup c:pointer? ] [ drop 4 [ cuda-int* ] ] } { [ dup c:pointer? ] [ drop 4 [ cuda-int ] ] }
{ [ dup c:void* = ] [ drop 4 [ cuda-int* ] ] } { [ dup c:void* = ] [ drop 4 [ cuda-int ] ] }
} cond ; } cond ;
<PRIVATE <PRIVATE
@ -114,19 +87,17 @@ ERROR: no-cuda-library name ;
: unload-cuda-library ( name -- ) : unload-cuda-library ( name -- )
remove-cuda-library handle>> unload-module ; remove-cuda-library handle>> unload-module ;
: launch-function* ( function -- ) cuLaunch cuda-error ; inline : launch-function ( function -- ) cuLaunch cuda-error ; inline
: launch-function ( -- ) cuda-function get cuLaunch cuda-error ; inline
: run-grid ( grid function -- ) : run-grid ( grid function -- )
swap swap
{ {
[ dim-block>> block-dim function-block-shape* ] [ dim-block>> block-dim function-block-shape ]
[ shared-size>> function-shared-size* ] [ shared-size>> function-shared-size ]
[ [
dim-grid>> dim-grid>>
[ grid-dim launch-function-grid* ] [ grid-dim launch-function-grid ]
[ launch-function* ] if* [ launch-function ] if*
] ]
} 2cleave ; } 2cleave ;
@ -137,23 +108,20 @@ ERROR: no-cuda-library name ;
MACRO: cuda-arguments ( c-types -- quot: ( args... function -- ) ) MACRO: cuda-arguments ( c-types -- quot: ( args... function -- ) )
[ 0 ] dip [ cuda-argument-setter ] map reverse [ 0 ] dip [ cuda-argument-setter ] map reverse
swap '[ _ param-size* ] suffix swap '[ _ param-size ] suffix
'[ _ cleave ] ; '[ _ cleave ] ;
: get-function-ptr* ( module string -- function ) : get-function-ptr ( module string -- function )
[ CUfunction <c-object> ] 2dip [ CUfunction <c-object> ] 2dip
[ cuModuleGetFunction cuda-error ] 3keep 2drop c:*void* ; [ cuModuleGetFunction cuda-error ] 3keep 2drop c:*void* ;
: get-function-ptr ( string -- function )
[ cuda-module get ] dip get-function-ptr* ;
: cached-module ( module-name -- alien ) : cached-module ( module-name -- alien )
lookup-cuda-library lookup-cuda-library
cuda-modules get-global [ load-cuda-library ] cache ; cuda-modules get-global [ load-cuda-library ] cache ;
: cached-function ( module-name function-name -- alien ) : cached-function ( module-name function-name -- alien )
[ cached-module ] dip [ cached-module ] dip
2array cuda-functions get [ first2 get-function-ptr* ] cache ; 2array cuda-functions get [ first2 get-function-ptr ] cache ;
MACRO: cuda-invoke ( module-name function-name arguments -- ) MACRO: cuda-invoke ( module-name function-name arguments -- )
'[ '[