improve cuda library organization

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

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

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
+USING: accessors alien.c-types alien.strings byte-arrays cuda
-cuda.memory cuda.syntax cuda.utils destructors io
+cuda.contexts cuda.devices cuda.memory cuda.syntax destructors
-io.encodings.string io.encodings.utf8 kernel locals math
+io io.encodings.string io.encodings.utf8 kernel locals math
-math.parser namespaces sequences byte-arrays strings ;
+math.parser namespaces sequences strings ;
 IN: cuda.demos.hello-world
 
 CUDA-LIBRARY: hello vocab:cuda/demos/hello-world/hello.ptx

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

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
+assocs byte-arrays classes.struct combinators cuda
-cuda.syntax cuda.utils fry io io.encodings.utf8 kernel locals
+cuda.contexts cuda.ffi cuda.syntax fry io io.encodings.utf8
-math math.order math.parser namespaces prettyprint sequences ;
+kernel locals math math.order math.parser namespaces
+prettyprint sequences ;
 IN: cuda.devices
 
 : #cuda-devices ( -- n )

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
+alien.enums continuations cuda cuda.contexts cuda.ffi
-destructors fry gpu.buffers kernel ;
+cuda.gl.ffi destructors fry gpu.buffers kernel ;
 IN: cuda.gl
 
 : create-gl-cuda-context ( device flags -- context )

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
+USING: accessors alien.data alien.parser arrays
-cuda.ffi cuda.utils io.backend kernel namespaces sequences ;
+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 ;

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
+byte-arrays cuda cuda.ffi destructors fry io.encodings.string
-io.encodings.utf8 kernel locals math namespaces sequences strings ;
+io.encodings.utf8 kernel locals math namespaces sequences
+strings ;
 QUALIFIED-WITH: alien.c-types c
 IN: cuda.memory
 

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
 

extra/cuda/utils/utils.factor

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