--- /dev/null
+! (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
+
! 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
-: 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
+TUPLE: cuda-error code ;
-: with-cuda-context ( device flags quot -- )
- [ [ create-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline
+: cuda-error ( code -- )
+ dup CUDA_SUCCESS = [ drop ] [ \ cuda-error boa throw ] if ;
-: 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 ;
+: cuda-version ( -- n )
+ c:int <c-object> [ cuDriverGetVersion cuda-error ] keep c:*int ;
-<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 ] ;
+: init-cuda ( -- )
+ 0 cuInit cuda-error ; inline
-: 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 ;
! 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
! 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
! 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 )
! (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 )
! 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
-TUPLE: cuda-library name path handle ;
+: ?delete-at ( key assoc -- old/key ? )
+ 2dup delete-at* [ 2nip t ] [ 2drop f ] if ; inline
-: <cuda-library> ( name path -- obj )
- \ cuda-library new
- swap >>path
- swap >>name ;
+: cuda-int* ( function offset value -- )
+ cuParamSeti cuda-error ; inline
-: add-cuda-library ( name path -- )
- normalize-path <cuda-library>
- dup name>> cuda-libraries get-global set-at ;
+: cuda-int ( offset value -- )
+ [ cuda-function get ] 2dip cuda-int* ; inline
-: ?delete-at ( key assoc -- old/key ? )
- 2dup delete-at* [ 2nip t ] [ 2drop f ] if ; inline
+: cuda-float* ( function offset value -- )
+ cuParamSetf cuda-error ; inline
-ERROR: no-cuda-library name ;
+: 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 *void* ;
+ [ 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 ;
: 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 )
+ \ cuda-library new
+ swap >>path
+ swap >>name ;
+
+: add-cuda-library ( name path -- )
+ normalize-path <cuda-library>
+ dup name>> cuda-libraries get-global set-at ;
+
! 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
! 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
+++ /dev/null
-! 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
-
projects / factor.git / commitdiff