1 ! Copyright (C) 2010 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data alien.strings arrays
4 assocs byte-arrays combinators cuda cuda.contexts cuda.ffi
5 cuda.libraries io io.encodings.utf8 kernel math math.order
6 math.parser prettyprint sequences splitting ;
9 : #cuda-devices ( -- n )
10 { int } [ cuDeviceGetCount cuda-error ] with-out-parameters ;
12 : n>cuda-device ( n -- device )
13 [ { CUdevice } ] dip '[ _ cuDeviceGet cuda-error ] with-out-parameters ;
15 : enumerate-cuda-devices ( -- devices )
16 #cuda-devices <iota> [ n>cuda-device ] map ;
18 : with-each-cuda-device ( quot -- )
19 [ enumerate-cuda-devices ] dip '[ 0 _ with-cuda-context ] each ; inline
21 : cuda-device-properties ( n -- properties )
23 [ cuDeviceGetProperties cuda-error ] keepd ;
25 : cuda-devices ( -- assoc )
26 enumerate-cuda-devices [ dup cuda-device-properties ] { } map>assoc ;
28 : cuda-device-name ( n -- string )
29 [ 256 [ <byte-array> ] keep ] dip
30 [ cuDeviceGetName cuda-error ]
31 [ 2drop utf8 alien>string ] 3bi ;
33 : cuda-device-capability ( n -- pair )
35 '[ _ cuDeviceComputeCapability cuda-error ] with-out-parameters
38 : cuda-device-memory ( n -- bytes )
40 '[ _ cuDeviceTotalMem_v2 cuda-error ] with-out-parameters ;
42 : cuda-device-attribute ( attribute n -- n )
44 '[ _ _ cuDeviceGetAttribute cuda-error ] with-out-parameters ;
46 : cuda-device. ( n -- )
48 [ "Device: " write number>string print ]
49 [ "Name: " write cuda-device-name print ]
50 [ "Memory: " write cuda-device-memory number>string print ]
53 cuda-device-capability [ number>string ] map join-words print
55 [ "Properties: " write cuda-device-properties . ]
57 "CU_DEVICE_ATTRIBUTE_GPU_OVERLAP: " write
58 CU_DEVICE_ATTRIBUTE_GPU_OVERLAP swap
59 cuda-device-attribute number>string print
63 : cuda-devices. ( -- )
65 enumerate-cuda-devices [ cuda-device. ] each ;
69 "CUDA Version: " write cuda-version number>string print nl
70 #cuda-devices <iota> [ nl ] [ cuda-device. ] interleave ;
73 [ 1 - + ] keep /i ; inline
75 : context-device-properties ( -- props )
76 context-device cuda-device-properties ; inline
78 :: (distribute-jobs) ( job-count per-job-shared max-shared-size max-block-size
79 -- grid-size block-size per-block-shared )
80 per-job-shared [ max-block-size ] [ max-shared-size swap /i max-block-size min ] if-zero
81 job-count min :> job-max-block-size
82 job-count job-max-block-size up/i :> grid-size
83 job-count grid-size up/i :> block-size
84 block-size per-job-shared * :> per-block-shared
86 grid-size block-size per-block-shared ; inline
88 : distribute-jobs ( job-count per-job-shared -- launcher )
89 context-device-properties
90 [ sharedMemPerBlock>> ] [ maxThreadsPerBlock>> ] bi
91 (distribute-jobs) <grid-shared> ; inline