Playing around with a higher-level CUDA api. Also, changed some char* to c-string in cuda.ffi

extra/cuda/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/cuda/cuda-tests.factor

@@ -0,0 +1,7 @@
+! Copyright (C) 2010 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: cuda kernel tools.test ;
+IN: cuda.tests
+
+! [ ] [ [ 0 0 [ drop ] with-cuda-context ] with-cuda ] unit-test
+! [ ] [ 100 cuda-malloc cuda-free ] unit-test

extra/cuda/cuda.factor

@@ -0,0 +1,77 @@
+! 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 ;
+IN: cuda
+
+ERROR: throw-cuda-error n ;
+
+: cuda-error ( n -- )
+    {
+        { CUDA_SUCCESS [ ] }
+        [ throw-cuda-error ]
+    } case ;
+
+: cuda-version ( -- n )
+    int <c-object> [ cuDriverGetVersion cuda-error ] keep *int ;
+
+: 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 ;

extra/cuda/ffi/ffi.factor

@@ -307,12 +307,12 @@ FUNCTION: CUresult cuCtxPopCurrent ( CUcontext* pctx ) ;
 FUNCTION: CUresult cuCtxGetDevice ( CUdevice* device ) ;
 FUNCTION: CUresult cuCtxSynchronize ( ) ;
 
-FUNCTION: CUresult cuModuleLoad ( CUmodule* module, char* fname ) ;
+FUNCTION: CUresult cuModuleLoad ( CUmodule* module, c-string fname ) ;
 FUNCTION: CUresult cuModuleLoadData ( CUmodule* module, void* image ) ;
 FUNCTION: CUresult cuModuleLoadDataEx ( CUmodule* module, void* image, uint numOptions, CUjit_option* options, void** optionValues ) ;
 FUNCTION: CUresult cuModuleLoadFatBinary ( CUmodule* module, void* fatCubin ) ;
 FUNCTION: CUresult cuModuleUnload ( CUmodule hmod ) ;
-FUNCTION: CUresult cuModuleGetFunction ( CUfunction* hfunc, CUmodule hmod, char* name ) ;
+FUNCTION: CUresult cuModuleGetFunction ( CUfunction* hfunc, CUmodule hmod, c-string name ) ;
 FUNCTION: CUresult cuModuleGetGlobal ( CUdeviceptr* dptr, uint* bytes, CUmodule hmod, char* name ) ;
 FUNCTION: CUresult cuModuleGetTexRef ( CUtexref* pTexRef, CUmodule hmod, char* name ) ;