extra/cuda/devices/devices.factor

   1 ! Copyright (C) 2010 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types alien.data alien.strings arrays assocs
   4 byte-arrays classes.struct combinators cuda cuda.ffi cuda.utils
   5 fry io io.encodings.utf8 kernel math.parser prettyprint
   6 sequences ;
   7 IN: cuda.devices
   8
   9 : #cuda-devices ( -- n )
  10     init-cuda
  11     int <c-object> [ cuDeviceGetCount cuda-error ] keep *int ;
  12
  13 : n>cuda-device ( n -- device )
  14     init-cuda
  15     [ CUdevice <c-object> ] dip [ cuDeviceGet cuda-error ] 2keep drop *int ;
  16
  17 : enumerate-cuda-devices ( -- devices )
  18     #cuda-devices iota [ n>cuda-device ] map ;
  19
  20 : with-each-cuda-device ( quot -- )
  21     [ enumerate-cuda-devices ] dip '[ <launcher> _ with-cuda ] each ; inline
  22
  23 : cuda-device-properties ( n -- properties )
  24     init-cuda
  25     [ CUdevprop <c-object> ] dip
  26     [ cuDeviceGetProperties cuda-error ] 2keep drop
  27     CUdevprop memory>struct ;
  28
  29 : cuda-devices ( -- assoc )
  30     enumerate-cuda-devices [ dup cuda-device-properties ] { } map>assoc ;
  31
  32 : cuda-device-name ( n -- string )
  33     init-cuda
  34     [ 256 [ <byte-array> ] keep ] dip
  35     [ cuDeviceGetName cuda-error ]
  36     [ 2drop utf8 alien>string ] 3bi ;
  37
  38 : cuda-device-capability ( n -- pair )
  39     init-cuda
  40     [ int <c-object> int <c-object> ] dip
  41     [ cuDeviceComputeCapability cuda-error ]
  42     [ drop [ *int ] bi@ ] 3bi 2array ;
  43
  44 : cuda-device-memory ( n -- bytes )
  45     init-cuda
  46     [ uint <c-object> ] dip
  47     [ cuDeviceTotalMem cuda-error ]
  48     [ drop *uint ] 2bi ;
  49
  50 : cuda-device-attribute ( attribute n -- n )
  51     init-cuda
  52     [ int <c-object> ] 2dip
  53     [ cuDeviceGetAttribute cuda-error ]
  54     [ 2drop *int ] 3bi ;
  55
  56 : cuda-device. ( n -- )
  57     init-cuda
  58     {
  59         [ "Device: " write number>string print ]
  60         [ "Name: " write cuda-device-name print ]
  61         [ "Memory: " write cuda-device-memory number>string print ]
  62         [
  63             "Capability: " write
  64             cuda-device-capability [ number>string ] map " " join print
  65         ]
  66         [ "Properties: " write cuda-device-properties . ]
  67         [
  68             "CU_DEVICE_ATTRIBUTE_GPU_OVERLAP: " write
  69             CU_DEVICE_ATTRIBUTE_GPU_OVERLAP swap
  70             cuda-device-attribute number>string print
  71         ]
  72     } cleave ;
  73
  74 : cuda. ( -- )
  75     init-cuda
  76     "CUDA Version: " write cuda-version number>string print nl
  77     #cuda-devices iota [ nl ] [ cuda-device. ] interleave ;
  78