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.ffi cuda.utils io
   5 io.encodings.utf8 kernel math.parser prettyprint sequences ;
   6 IN: cuda.devices
   7
   8 : #cuda-devices ( -- n )
   9     int <c-object> [ cuDeviceGetCount cuda-error ] keep *int ;
  10
  11 : n>cuda-device ( n -- device )
  12     [ CUdevice <c-object> ] dip [ cuDeviceGet cuda-error ] 2keep drop *int ;
  13
  14 : enumerate-cuda-devices ( -- devices )
  15     #cuda-devices iota [ n>cuda-device ] map ;
  16
  17 : cuda-device-properties ( device -- properties )
  18     [ CUdevprop <c-object> ] dip
  19     [ cuDeviceGetProperties cuda-error ] 2keep drop
  20     CUdevprop memory>struct ;
  21
  22 : cuda-devices ( -- assoc )
  23     enumerate-cuda-devices [ dup cuda-device-properties ] { } map>assoc ;
  24
  25 : cuda-device-name ( n -- string )
  26     [ 256 [ <byte-array> ] keep ] dip
  27     [ cuDeviceGetName cuda-error ]
  28     [ 2drop utf8 alien>string ] 3bi ;
  29
  30 : cuda-device-capability ( n -- pair )
  31     [ int <c-object> int <c-object> ] dip
  32     [ cuDeviceComputeCapability cuda-error ]
  33     [ drop [ *int ] bi@ ] 3bi 2array ;
  34
  35 : cuda-device-memory ( n -- bytes )
  36     [ uint <c-object> ] dip
  37     [ cuDeviceTotalMem cuda-error ]
  38     [ drop *uint ] 2bi ;
  39
  40 : cuda-device-attribute ( attribute dev -- n )
  41     [ int <c-object> ] 2dip
  42     [ cuDeviceGetAttribute cuda-error ]
  43     [ 2drop *int ] 3bi ;
  44
  45 : cuda-device. ( n -- )
  46     {
  47         [ "Device: " write number>string print ]
  48         [ "Name: " write cuda-device-name print ]
  49         [ "Memory: " write cuda-device-memory number>string print ]
  50         [
  51             "Capability: " write
  52             cuda-device-capability [ number>string ] map " " join print
  53         ]
  54         [ "Properties: " write cuda-device-properties . ]
  55         [
  56             "CU_DEVICE_ATTRIBUTE_GPU_OVERLAP: " write
  57             CU_DEVICE_ATTRIBUTE_GPU_OVERLAP swap
  58             cuda-device-attribute number>string print
  59         ]
  60     } cleave ;
  61
  62 : cuda. ( -- )
  63     "CUDA Version: " write cuda-version number>string print nl
  64     #cuda-devices iota [ nl ] [ cuda-device. ] interleave ;
  65