diff --git a/extra/cuda/authors.txt b/extra/cuda/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/cuda/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/cuda/cuda-tests.factor b/extra/cuda/cuda-tests.factor new file mode 100644 index 0000000000..28fe222dff --- /dev/null +++ b/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 diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor new file mode 100644 index 0000000000..887740d542 --- /dev/null +++ b/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 [ cuDriverGetVersion cuda-error ] keep *int ; + +: init-cuda ( -- ) + 0 cuInit cuda-error ; + +: with-cuda ( quot -- ) + init-cuda [ ] [ ] cleanup ; inline + + [ cuDeviceGetCount cuda-error ] keep *int ; + +: n>cuda-device ( n -- device ) + [ CUdevice ] dip [ cuDeviceGet cuda-error ] 2keep drop *int ; + +: enumerate-cuda-devices ( -- devices ) + #cuda-devices iota [ n>cuda-device ] map ; + +: cuda-device>properties ( device -- properties ) + [ CUdevprop ] 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 ] 2dip + [ cuCtxCreate cuda-error ] 3keep 2drop *void* + ] dip + [ '[ _ @ ] ] + [ drop '[ _ cuCtxDestroy cuda-error ] ] 2bi + [ ] cleanup ; inline + +: with-cuda-module ( path quot -- ) + [ + normalize-path + [ CUmodule ] dip + [ cuModuleLoad cuda-error ] 2keep drop *void* + ] dip + [ '[ _ @ ] ] + [ drop '[ _ cuModuleUnload cuda-error ] ] 2bi + [ ] cleanup ; inline + +: get-cuda-function ( module string -- function ) + [ CUfunction ] 2dip + [ cuModuleGetFunction cuda-error ] 3keep 2drop *void* ; + +: cuda-malloc ( n -- ptr ) + [ CUdeviceptr ] dip + [ cuMemAlloc cuda-error ] 2keep drop *int ; + +: cuda-free ( ptr -- ) + cuMemFree cuda-error ; diff --git a/extra/cuda/ffi/ffi.factor b/extra/cuda/ffi/ffi.factor index ce6f8cb8b8..3d41f1e4c5 100644 --- a/extra/cuda/ffi/ffi.factor +++ b/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 ) ;