factor: trim using lists

[factor.git] / extra / cuda / cuda.factor

diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor
index d4202ba66577f88f849125b7051e6d39a6108afc..4278ab938b8da5b32b2339bd5b30b844568cd260 100644 (file)
--- a/extra/cuda/cuda.factor
+++ b/extra/cuda/cuda.factor
@@ -1,91 +1,16 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! 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
-destructors fry init io io.backend io.encodings.string
-io.encodings.utf8 kernel lexer locals macros math math.parser
-namespaces nested-comments opengl.gl.extensions parser
-prettyprint quotations sequences words cuda.libraries ;
-QUALIFIED-WITH: alien.c-types a
+USING: alien.c-types alien.data cuda.ffi kernel ;
+QUALIFIED-WITH: alien.c-types c
 IN: cuda
 
-TUPLE: launcher
-{ device integer initial: 0 }
-{ device-flags initial: 0 } ;
+ERROR: cuda-error-state code ;
 
-: <launcher> ( device-id -- launcher )
-    launcher new
-        swap >>device ; inline
+: cuda-error ( code -- )
+    dup CUDA_SUCCESS = [ drop ] [ cuda-error-state ] if ;
 
-TUPLE: function-launcher
-dim-grid dim-block shared-size stream ;
+: cuda-version ( -- n )
+    { c:int } [ cuDriverGetVersion cuda-error ] with-out-parameters ;
 
-: with-cuda-context ( flags device quot -- )
-    H{ } clone cuda-modules set-global
-    H{ } clone cuda-functions set
-    [ create-context ] dip 
-    [ '[ _ @ ] ]
-    [ drop '[ _ destroy-context ] ] 2bi
-    [ ] cleanup ; inline
-
-: with-cuda-program ( flags device quot -- )
-    [ dup cuda-device set ] 2dip
-    '[ cuda-context set _ call ] with-cuda-context ; inline
-
-: with-cuda ( launcher quot -- )
-    init-cuda [
-        [ cuda-launcher set ]
-        [ [ device>> ] [ device-flags>> ] bi ] bi
-    ] [ with-cuda-program ] bi* ; inline
-
-: c-type>cuda-setter ( c-type -- n cuda-type )
-    {
-        { [ dup a:int = ] [ drop 4 [ cuda-int* ] ] }
-        { [ dup a:uint = ] [ drop 4 [ cuda-int* ] ] }
-        { [ dup a:float = ] [ drop 4 [ cuda-float* ] ] }
-        { [ dup a:pointer? ] [ drop 4 [ cuda-int* ] ] }
-        { [ dup a: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>> [
-                launch-function*
-            ] [
-                grid-dim launch-function-grid*
-            ] if-empty
-        ]
-    } 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 a:void function-effect ]
-    3bi define-declared ;
+: init-cuda ( -- )
+    0 cuInit cuda-error ; inline