Move some code to cuda.devices

db4
Doug Coleman 2010-04-19 01:21:21 -05:00
parent f0543e6bdd
commit 6b2024055f
3 changed files with 74 additions and 69 deletions

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1,65 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.data alien.strings arrays assocs
byte-arrays classes.struct combinators cuda.ffi cuda.utils io
io.encodings.utf8 kernel math.parser prettyprint sequences ;
IN: cuda.devices
: #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-devices ( -- assoc )
enumerate-cuda-devices [ dup cuda-device-properties ] { } map>assoc ;
: cuda-device-name ( n -- string )
[ 256 [ <byte-array> ] keep ] dip
[ cuDeviceGetName cuda-error ]
[ 2drop utf8 alien>string ] 3bi ;
: cuda-device-capability ( n -- pair )
[ int <c-object> int <c-object> ] dip
[ cuDeviceComputeCapability cuda-error ]
[ drop [ *int ] bi@ ] 3bi 2array ;
: cuda-device-memory ( n -- bytes )
[ uint <c-object> ] dip
[ cuDeviceTotalMem cuda-error ]
[ drop *uint ] 2bi ;
: cuda-device-attribute ( attribute dev -- n )
[ int <c-object> ] 2dip
[ cuDeviceGetAttribute cuda-error ]
[ 2drop *int ] 3bi ;
: cuda-device. ( n -- )
{
[ "Device: " write number>string print ]
[ "Name: " write cuda-device-name print ]
[ "Memory: " write cuda-device-memory number>string print ]
[
"Capability: " write
cuda-device-capability [ number>string ] map " " join print
]
[ "Properties: " write cuda-device-properties . ]
[
"CU_DEVICE_ATTRIBUTE_GPU_OVERLAP: " write
CU_DEVICE_ATTRIBUTE_GPU_OVERLAP swap
cuda-device-attribute number>string print
]
} cleave ;
: cuda. ( -- )
"CUDA Version: " write cuda-version number>string print nl
#cuda-devices iota [ nl ] [ cuda-device. ] interleave ;

View File

@ -1,10 +1,9 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors 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 ;
QUALIFIED-WITH: alien.c-types a
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-device
@ -25,43 +24,11 @@ ERROR: throw-cuda-error n ;
0 cuInit cuda-error ;
: cuda-version ( -- n )
a:int <c-object> [ cuDriverGetVersion cuda-error ] keep a:*int ;
: #cuda-devices ( -- n )
a:int <c-object> [ cuDeviceGetCount cuda-error ] keep a:*int ;
: n>cuda-device ( n -- device )
[ CUdevice <c-object> ] dip [ cuDeviceGet cuda-error ] 2keep drop a:*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-devices ( -- assoc )
enumerate-cuda-devices [ dup cuda-device-properties ] { } map>assoc ;
: cuda-device-name ( n -- string )
[ 256 [ <byte-array> ] keep ] dip
[ cuDeviceGetName cuda-error ]
[ 2drop utf8 alien>string ] 3bi ;
: cuda-device-capability ( n -- pair )
[ a:int <c-object> a:int <c-object> ] dip
[ cuDeviceComputeCapability cuda-error ]
[ drop [ a:*int ] bi@ ] 3bi 2array ;
: cuda-device-memory ( n -- bytes )
[ a:uint <c-object> ] dip
[ cuDeviceTotalMem cuda-error ]
[ drop a:*uint ] 2bi ;
int <c-object> [ cuDriverGetVersion cuda-error ] keep *int ;
: get-function-ptr* ( module string -- function )
[ CUfunction <c-object> ] 2dip
[ cuModuleGetFunction cuda-error ] 3keep 2drop a:*void* ;
[ cuModuleGetFunction cuda-error ] 3keep 2drop *void* ;
: get-function-ptr ( string -- function )
[ cuda-module get ] dip get-function-ptr* ;
@ -73,7 +40,7 @@ ERROR: throw-cuda-error n ;
: create-context ( flags device -- context )
[ CUcontext <c-object> ] 2dip
[ cuCtxCreate cuda-error ] 3keep 2drop a:*void* ;
[ cuCtxCreate cuda-error ] 3keep 2drop *void* ;
: destroy-context ( context -- ) cuCtxDestroy cuda-error ;
@ -100,7 +67,7 @@ ERROR: no-cuda-library name ;
: load-module ( path -- module )
[ CUmodule <c-object> ] dip
[ cuModuleLoad cuda-error ] 2keep drop a:*void* ;
[ cuModuleLoad cuda-error ] 2keep drop *void* ;
: unload-module ( module -- )
cuModuleUnload cuda-error ;
@ -161,13 +128,6 @@ ERROR: no-cuda-library name ;
[ cuda-function get ] 2dip
cuLaunchGrid cuda-error ;
ERROR: bad-cuda-parameter parameter ;
: cuda-device-attribute ( attribute dev -- n )
[ a:int <c-object> ] 2dip
[ cuDeviceGetAttribute cuda-error ]
[ 2drop a:*int ] 3bi ;
: function-block-shape* ( function x y z -- )
cuFuncSetBlockShape cuda-error ;
@ -181,24 +141,3 @@ ERROR: bad-cuda-parameter parameter ;
: function-shared-size ( n -- )
[ cuda-function get ] dip
cuFuncSetSharedSize cuda-error ;
: cuda-device. ( n -- )
{
[ "Device: " write number>string print ]
[ "Name: " write cuda-device-name print ]
[ "Memory: " write cuda-device-memory number>string print ]
[
"Capability: " write
cuda-device-capability [ number>string ] map " " join print
]
[ "Properties: " write cuda-device-properties . ]
[
"CU_DEVICE_ATTRIBUTE_GPU_OVERLAP: " write
CU_DEVICE_ATTRIBUTE_GPU_OVERLAP swap
cuda-device-attribute number>string print
]
} cleave ;
: cuda. ( -- )
"CUDA Version: " write cuda-version number>string print nl
#cuda-devices iota [ nl ] [ cuda-device. ] interleave ;