factor: trim using lists

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

diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor
index 887740d54235993ebb65a85e7aaeabd9508a64b4..4278ab938b8da5b32b2339bd5b30b844568cd260 100644 (file)
--- a/extra/cuda/cuda.factor
+++ b/extra/cuda/cuda.factor
@@ -1,77 +1,16 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.data assocs classes.struct
-combinators continuations cuda.ffi fry io.backend kernel
-sequences ;
+USING: alien.c-types alien.data cuda.ffi kernel ;
+QUALIFIED-WITH: alien.c-types c
 IN: cuda
 
-ERROR: throw-cuda-error n ;
+ERROR: cuda-error-state code ;
 
-: cuda-error ( n -- )
-    {
-        { CUDA_SUCCESS [ ] }
-        [ throw-cuda-error ]
-    } case ;
+: cuda-error ( code -- )
+    dup CUDA_SUCCESS = [ drop ] [ cuda-error-state ] if ;
 
 : cuda-version ( -- n )
-    int <c-object> [ cuDriverGetVersion cuda-error ] keep *int ;
+    { c:int } [ cuDriverGetVersion cuda-error ] with-out-parameters ;
 
 : init-cuda ( -- )
-    0 cuInit cuda-error ;
-
-: with-cuda ( quot -- )
-    init-cuda [ ] [ ] cleanup ; inline
-
-<PRIVATE
-
-: #cuda-devices ( -- n )
-    int <c-object> [ cuDeviceGetCount cuda-error ] keep *int ;
-
-: n>cuda-device ( n -- device )
-    [ CUdevice <c-object> ] dip [ cuDeviceGet cuda-error ] 2keep drop *int ;
-
-: enumerate-cuda-devices ( -- devices )
-    #cuda-devices iota [ n>cuda-device ] map ;
-
-: cuda-device>properties ( device -- properties )
-    [ CUdevprop <c-object> ] dip
-    [ cuDeviceGetProperties cuda-error ] 2keep drop
-    CUdevprop memory>struct ;
-
-: cuda-device-properties ( -- properties )
-    enumerate-cuda-devices [ cuda-device>properties ] map ;
-
-PRIVATE>
-
-: cuda-devices ( -- assoc )
-    enumerate-cuda-devices [ dup cuda-device>properties ] { } map>assoc ;
-
-: with-cuda-context ( flags device quot -- )
-    [
-        [ CUcontext <c-object> ] 2dip
-        [ cuCtxCreate cuda-error ] 3keep 2drop *void*
-    ] dip 
-    [ '[ _ @ ] ]
-    [ drop '[ _ cuCtxDestroy cuda-error ] ] 2bi
-    [ ] cleanup ; inline
-
-: with-cuda-module ( path quot -- )
-    [
-        normalize-path
-        [ CUmodule <c-object> ] dip
-        [ cuModuleLoad cuda-error ] 2keep drop *void*
-    ] dip
-    [ '[ _ @ ] ]
-    [ drop '[ _ cuModuleUnload cuda-error ] ] 2bi
-    [ ] cleanup ; inline
-
-: get-cuda-function ( module string -- function )
-    [ CUfunction <c-object> ] 2dip
-    [ cuModuleGetFunction cuda-error ] 3keep 2drop *void* ;
-
-: cuda-malloc ( n -- ptr )
-    [ CUdeviceptr <c-object> ] dip
-    [ cuMemAlloc cuda-error ] 2keep drop *int ;
-
-: cuda-free ( ptr -- )
-    cuMemFree cuda-error ;
+    0 cuInit cuda-error ; inline