cuda: streamline memory api

extra/cuda/cuda.factor

@@ -34,21 +34,18 @@ dim-block dim-grid shared-size stream ;
     '[ cuda-context set _ call ] with-cuda-context ; inline
 
 : with-cuda ( launcher quot -- )
-    init-cuda
+    init-cuda [
-    [ H{ } clone cuda-memory-hashtable ] 2dip '[
-        _ 
         [ cuda-launcher set ]
         [ [ device>> ] [ device-flags>> ] bi ] bi
-        _ with-cuda-program
+    ] [ with-cuda-program ] bi* ; inline
-    ] with-variable ; inline
 
 : c-type>cuda-setter ( c-type -- n cuda-type )
     {
         { [ dup a:int = ] [ drop 4 [ cuda-int* ] ] }
         { [ dup a:uint = ] [ drop 4 [ cuda-int* ] ] }
         { [ dup a:float = ] [ drop 4 [ cuda-float* ] ] }
-        { [ dup a:pointer? ] [ drop 4 [ ptr>> cuda-int* ] ] }
+        { [ dup a:pointer? ] [ drop 4 [ cuda-int* ] ] }
-        { [ dup a:void* = ] [ drop 4 [ ptr>> cuda-int* ] ] }
+        { [ dup a:void* = ] [ drop 4 [ cuda-int* ] ] }
     } cond ;
 
 : run-function-launcher ( function-launcher function -- )

extra/cuda/demos/hello-world/hello-world.factor

@@ -3,7 +3,7 @@
 USING: accessors alien.c-types alien.strings cuda cuda.devices
 cuda.memory cuda.syntax cuda.utils destructors io
 io.encodings.string io.encodings.utf8 kernel locals math
-math.parser namespaces sequences ;
+math.parser namespaces sequences byte-arrays strings ;
 IN: cuda.demos.hello-world
 
 CUDA-LIBRARY: hello vocab:cuda/demos/hello-world/hello.ptx
@@ -12,12 +12,14 @@ CUDA-FUNCTION: helloWorld ( char* string-ptr ) ;
 
 : cuda-hello-world ( -- )
     [
-        cuda-launcher get device>> number>string
+        [
-        "CUDA device " ": " surround write
+            cuda-launcher get device>> number>string
-        "Hello World!" [ - ] map-index host>device
+            "CUDA device " ": " surround write
+            "Hello World!" >byte-array [ - ] map-index host>device &cuda-free
 
-        [ { 6 1 1 } { 2 1 } 2<<< helloWorld ]
+            [ { 6 1 1 } { 2 1 } 2<<< helloWorld ]
-        [ device>host utf8 decode print ] bi
+            [ 12 device>host >string print ] bi
+        ] with-destructors
     ] with-each-cuda-device ;
 
 MAIN: cuda-hello-world

extra/cuda/memory/memory.factor

@@ -1,75 +1,48 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.data assocs byte-arrays cuda.ffi
+USING: accessors alien alien.data alien.destructors assocs
-cuda.utils destructors io.encodings.string io.encodings.utf8
+byte-arrays cuda.ffi cuda.utils destructors fry io.encodings.string
-kernel locals namespaces sequences strings ;
+io.encodings.utf8 kernel locals namespaces sequences strings ;
-QUALIFIED-WITH: alien.c-types a
+QUALIFIED-WITH: alien.c-types c
 IN: cuda.memory
 
-SYMBOL: cuda-memory-hashtable
-
-TUPLE: cuda-memory < disposable ptr length ;
-
-: <cuda-memory> ( ptr length -- obj )
-    cuda-memory new-disposable
-        swap >>length
-        swap >>ptr ;
-
-: add-cuda-memory ( obj -- obj )
-    dup dup ptr>> cuda-memory-hashtable get set-at ;
-
-: delete-cuda-memory ( obj -- )
-    cuda-memory-hashtable delete-at ;
-
-ERROR: invalid-cuda-memory ptr ;
-
-: cuda-memory-length ( cuda-memory -- n )
-    ptr>> cuda-memory-hashtable get ?at [
-        length>>
-    ] [
-        invalid-cuda-memory
-    ] if ;
-
-M: cuda-memory byte-length length>> ;
-
 : cuda-malloc ( n -- ptr )
     [ CUdeviceptr <c-object> ] dip
-    [ cuMemAlloc cuda-error ] 2keep
+    '[ _ cuMemAlloc cuda-error ] keep
-    [ a:*int ] dip <cuda-memory> add-cuda-memory ;
+    c:*int ;
 
-: cuda-free* ( ptr -- )
+: cuda-free ( ptr -- )
     cuMemFree cuda-error ;
 
-M: cuda-memory dispose ( ptr -- )
+DESTRUCTOR: cuda-free
-    ptr>> cuda-free* ;
 
 : memcpy-device>device ( dest-ptr src-ptr count -- )
-    cuMemcpyDtoD cuda-error ;
+    cuMemcpyDtoD cuda-error ; inline
 
 : memcpy-device>array ( dest-array dest-index src-ptr count -- )
-    cuMemcpyDtoA cuda-error ;
+    cuMemcpyDtoA cuda-error ; inline
 
 : memcpy-array>device ( dest-ptr src-array src-index count -- )
-    cuMemcpyAtoD cuda-error ;
+    cuMemcpyAtoD cuda-error ; inline
 
 : memcpy-array>host ( dest-ptr src-array src-index count -- )
-    cuMemcpyAtoH cuda-error ;
+    cuMemcpyAtoH cuda-error ; inline
 
 : memcpy-host>array ( dest-array dest-index src-ptr count -- )
-    cuMemcpyHtoA cuda-error ;
+    cuMemcpyHtoA cuda-error ; inline
 
 : memcpy-array>array ( dest-array dest-index src-array src-ptr count -- )
-    cuMemcpyAtoA cuda-error ;
+    cuMemcpyAtoA cuda-error ; inline
 
-GENERIC: host>device ( obj -- ptr )
+: memcpy-host>device ( dest-ptr src-ptr count -- )
+    cuMemcpyHtoD cuda-error ; inline
 
-M: string host>device utf8 encode host>device ;
+: memcpy-device>host ( dest-ptr src-ptr count -- )
+    cuMemcpyDtoH cuda-error ; inline
 
-M: byte-array host>device ( byte-array -- ptr )
+: host>device ( data -- ptr )
-    [ length cuda-malloc ] keep
+    [ >c-ptr ] [ byte-length ] bi
-    [ [ ptr>> ] dip dup length cuMemcpyHtoD cuda-error ]
+    [ nip cuda-malloc dup ] [ memcpy-host>device ] 2bi ; inline
-    [ drop ] 2bi ;
 
-:: device>host ( ptr -- seq )
+: device>host ( ptr len -- byte-array )
-    ptr byte-length <byte-array>
+    [ nip <byte-array> dup ] [ memcpy-device>host ] 2bi ; inline
-    [ ptr [ ptr>> ] [ byte-length ] bi cuMemcpyDtoH cuda-error ] keep ;