extra/cuda/devices/devices.factor

   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 classes.struct combinators cuda
   5 cuda.contexts cuda.ffi cuda.libraries fry io io.encodings.utf8
   6 kernel locals math math.order math.parser namespaces
   7 prettyprint sequences ;
   8 IN: cuda.devices
   9
  10 : #cuda-devices ( -- n )
  11     { int } [ cuDeviceGetCount cuda-error ] with-out-parameters ;
  12
  13 : n>cuda-device ( n -- device )
  14     [ { CUdevice } ] dip '[ _ cuDeviceGet cuda-error ] with-out-parameters ;
  15
  16 : enumerate-cuda-devices ( -- devices )
  17     #cuda-devices <iota> [ n>cuda-device ] map ;
  18
  19 : with-each-cuda-device ( quot -- )
  20     [ enumerate-cuda-devices ] dip '[ 0 _ with-cuda-context ] each ; inline
  21
  22 : cuda-device-properties ( n -- properties )
  23     [ CUdevprop <struct> ] dip
  24     [ cuDeviceGetProperties cuda-error ] keepd ;
  25
  26 : cuda-devices ( -- assoc )
  27     enumerate-cuda-devices [ dup cuda-device-properties ] { } map>assoc ;
  28
  29 : cuda-device-name ( n -- string )
  30     [ 256 [ <byte-array> ] keep ] dip
  31     [ cuDeviceGetName cuda-error ]
  32     [ 2drop utf8 alien>string ] 3bi ;
  33
  34 : cuda-device-capability ( n -- pair )
  35     [ { int int } ] dip
  36     '[ _ cuDeviceComputeCapability cuda-error ] with-out-parameters
  37     2array ;
  38
  39 : cuda-device-memory ( n -- bytes )
  40     [ { ulonglong } ] dip
  41     '[ _ cuDeviceTotalMem_v2 cuda-error ] with-out-parameters ;
  42
  43 : cuda-device-attribute ( attribute n -- n )
  44     [ { int } ] 2dip
  45     '[ _ _ cuDeviceGetAttribute cuda-error ] with-out-parameters ;
  46
  47 : cuda-device. ( n -- )
  48     {
  49         [ "Device: " write number>string print ]
  50         [ "Name: " write cuda-device-name print ]
  51         [ "Memory: " write cuda-device-memory number>string print ]
  52         [
  53             "Capability: " write
  54             cuda-device-capability [ number>string ] map unwords print
  55         ]
  56         [ "Properties: " write cuda-device-properties . ]
  57         [
  58             "CU_DEVICE_ATTRIBUTE_GPU_OVERLAP: " write
  59             CU_DEVICE_ATTRIBUTE_GPU_OVERLAP swap
  60             cuda-device-attribute number>string print
  61         ]
  62     } cleave ;
  63
  64 : cuda-devices. ( -- )
  65     init-cuda
  66     enumerate-cuda-devices [ cuda-device. ] each ;
  67
  68 : cuda. ( -- )
  69     init-cuda
  70     "CUDA Version: " write cuda-version number>string print nl
  71     #cuda-devices <iota> [ nl ] [ cuda-device. ] interleave ;
  72
  73 : up/i ( x y -- z )
  74     [ 1 - + ] keep /i ; inline
  75
  76 : context-device-properties ( -- props )
  77     context-device cuda-device-properties ; inline
  78
  79 :: (distribute-jobs) ( job-count per-job-shared max-shared-size max-block-size
  80                        -- grid-size block-size per-block-shared )
  81     per-job-shared [ max-block-size ] [ max-shared-size swap /i max-block-size min ] if-zero
  82         job-count min :> job-max-block-size
  83     job-count job-max-block-size up/i :> grid-size
  84     job-count grid-size up/i          :> block-size
  85     block-size per-job-shared *       :> per-block-shared
  86
  87     grid-size block-size per-block-shared ; inline
  88
  89 : distribute-jobs ( job-count per-job-shared -- launcher )
  90     context-device-properties
  91     [ sharedMemPerBlock>> ] [ maxThreadsPerBlock>> ] bi
  92     (distribute-jobs) <grid-shared> ; inline