extra/cuda/cuda.factor

   1 ! Copyright (C) 2010 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.data alien.parser alien.strings
   4 alien.syntax arrays assocs byte-arrays classes.struct
   5 combinators continuations cuda.ffi cuda.memory cuda.utils
   6 destructors fry init io io.backend io.encodings.string
   7 io.encodings.utf8 kernel lexer locals macros math math.parser
   8 namespaces nested-comments opengl.gl.extensions parser
   9 prettyprint quotations sequences words ;
  10 QUALIFIED-WITH: alien.c-types a
  11 IN: cuda
  12
  13 TUPLE: launcher
  14 { device integer initial: 0 }
  15 { device-flags initial: 0 } ;
  16
  17 : <launcher> ( device-id -- launcher )
  18     launcher new
  19         swap >>device ; inline
  20
  21 TUPLE: function-launcher
  22 dim-block dim-grid shared-size stream ;
  23
  24 : with-cuda-context ( flags device quot -- )
  25     H{ } clone cuda-modules set-global
  26     H{ } clone cuda-functions set
  27     [ create-context ] dip
  28     [ '[ _ @ ] ]
  29     [ drop '[ _ destroy-context ] ] 2bi
  30     [ ] cleanup ; inline
  31
  32 : with-cuda-program ( flags device quot -- )
  33     [ dup cuda-device set ] 2dip
  34     '[ cuda-context set _ call ] with-cuda-context ; inline
  35
  36 : with-cuda ( launcher quot -- )
  37     init-cuda
  38     [ H{ } clone cuda-memory-hashtable ] 2dip '[
  39         _
  40         [ cuda-launcher set ]
  41         [ [ device>> ] [ device-flags>> ] bi ] bi
  42         _ with-cuda-program
  43     ] with-variable ; inline
  44
  45 : c-type>cuda-setter ( c-type -- n cuda-type )
  46     {
  47         { [ dup a:int = ] [ drop 4 [ cuda-int* ] ] }
  48         { [ dup a:uint = ] [ drop 4 [ cuda-int* ] ] }
  49         { [ dup a:float = ] [ drop 4 [ cuda-float* ] ] }
  50         { [ dup a:pointer? ] [ drop 4 [ ptr>> cuda-int* ] ] }
  51         { [ dup a:void* = ] [ drop 4 [ ptr>> cuda-int* ] ] }
  52     } cond ;
  53
  54 : run-function-launcher ( function-launcher function -- )
  55     swap
  56     {
  57         [ dim-block>> first3 function-block-shape* ]
  58         [ shared-size>> function-shared-size* ]
  59         [
  60             dim-grid>> [
  61                 launch-function*
  62             ] [
  63                 first2 launch-function-grid*
  64             ] if-empty
  65         ]
  66     } 2cleave ;
  67
  68 : cuda-argument-setter ( offset c-type -- offset' quot )
  69     c-type>cuda-setter
  70     [ over [ + ] dip ] dip
  71     '[ swap _ swap _ call ] ;
  72
  73 MACRO: cuda-arguments ( c-types -- quot: ( args... function -- ) )
  74     [ 0 ] dip [ cuda-argument-setter ] map reverse
  75     swap '[ _ param-size* ] suffix
  76     '[ _ cleave ] ;
  77
  78 : define-cuda-word ( word module-name function-name arguments -- )
  79     [
  80         '[
  81             _ _ cached-function
  82             [ nip _ cuda-arguments ]
  83             [ run-function-launcher ] 2bi
  84         ]
  85     ]
  86     [ 2nip \ function-launcher suffix a:void function-effect ]
  87     3bi define-declared ;
  88
  89 [ init-cuda ] "cuda-init" add-startup-hook