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

cuda.libraries: rework parameter passing to fill entire parameter space in one API call

db4
Joe Groff 2010-05-20 17:23:47 -07:00
parent ca1426096a
commit 0d04406a41
1 changed files with 31 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,8 +1,10 @@
! Copyright (C) 2010 Doug Coleman. ! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.data alien.parser arrays USING: accessors alien.data alien.parser arrays assocs
assocs combinators cuda cuda.ffi fry io.backend kernel macros byte-arrays classes.struct combinators combinators.short-circuit
math namespaces sequences words ; cuda cuda.ffi fry generalizations io.backend kernel macros math
namespaces sequences words ;
FROM: classes.struct.private => compute-struct-offsets write-struct-slot ;
QUALIFIED-WITH: alien.c-types c QUALIFIED-WITH: alien.c-types c
IN: cuda.libraries IN: cuda.libraries
@ -17,18 +19,12 @@ 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-param-size ( function n -- )
cuParamSeti cuda-error ; inline cuParamSetSize cuda-error ; inline
: cuda-float ( function offset value -- )
cuParamSetf cuda-error ; inline
: cuda-vector ( function offset ptr n -- ) : cuda-vector ( function offset ptr n -- )
cuParamSetv cuda-error ; inline cuParamSetv cuda-error ; inline
: param-size ( function n -- )
cuParamSetSize cuda-error ; inline
: launch-function-grid ( function width height -- ) : launch-function-grid ( function width height -- )
cuLaunchGrid cuda-error ; inline cuLaunchGrid cuda-error ; inline
@ -50,15 +46,6 @@ dim-grid dim-block shared-size stream ;
: <grid-shared-stream> ( dim-grid dim-block shared-size stream -- grid ) : <grid-shared-stream> ( dim-grid dim-block shared-size stream -- grid )
grid boa ; inline grid boa ; 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 <PRIVATE
: block-dim ( block -- x y z ) : block-dim ( block -- x y z )
dup sequence? [ 3 1 pad-tail first3 ] [ 1 1 ] if ; inline dup sequence? [ 3 1 pad-tail first3 ] [ 1 1 ] if ; inline
@ -101,15 +88,32 @@ ERROR: no-cuda-library name ;
] ]
} 2cleave ; } 2cleave ;
: cuda-argument-setter ( offset c-type -- offset' quot ) <PRIVATE
c-type>cuda-setter : make-param-buffer ( function size -- buffer size )
[ over [ + ] dip ] dip [ cuda-param-size ] [ (byte-array) ] [ ] tri ; inline
'[ swap _ swap _ call ] ;
: fill-param-buffer ( values... buffer quots... n -- )
[ cleave-curry ] [ spread* ] bi ; inline
: >argument-type ( c-type -- c-type' )
dup { [ c:void* = ] [ c:pointer? ] } 1|| [ drop CUdeviceptr ] when ;
: >argument-struct-slot ( type -- slot )
"cuda-arg" swap >argument-type { } <struct-slot-spec> ;
: [cuda-arguments] ( c-types -- quot )
[ >argument-struct-slot ] map
[ compute-struct-offsets ]
[ [ '[ _ write-struct-slot ] ] [ ] map-as ]
[ length ] tri
'[
[ _ make-param-buffer [ drop @ _ fill-param-buffer ] 2keep ]
[ '[ _ 0 ] 2dip cuda-vector ] bi
] ;
PRIVATE>
MACRO: cuda-arguments ( c-types -- quot: ( args... function -- ) ) MACRO: cuda-arguments ( c-types -- quot: ( args... function -- ) )
[ 0 ] dip [ cuda-argument-setter ] map reverse [ [ 0 cuda-param-size ] ] [ [cuda-arguments] ] if-empty ;
swap '[ _ param-size ] suffix
'[ _ cleave ] ;
: get-function-ptr ( module string -- function ) : get-function-ptr ( module string -- function )
[ CUfunction <c-object> ] 2dip [ CUfunction <c-object> ] 2dip