factor: trim using lists

[factor.git] / extra / cuda / memory / memory.factor

diff --git a/extra/cuda/memory/memory.factor b/extra/cuda/memory/memory.factor
index 1ababcb8a0f8ddc991695e3c6cf95d5281761bb3..92cb9dec31ca452e815f13e06baaae1f6e8083f8 100644 (file)
--- a/extra/cuda/memory/memory.factor
+++ b/extra/cuda/memory/memory.factor
@@ -1,75 +1,49 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.data assocs byte-arrays cuda.ffi
-cuda.utils destructors io.encodings.string io.encodings.utf8
-kernel locals namespaces sequences strings ;
-QUALIFIED-WITH: alien.c-types a
+USING: alien alien.c-types alien.data alien.destructors
+byte-arrays cuda cuda.ffi kernel math ;
+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
-    [ a:*int ] dip <cuda-memory> add-cuda-memory ;
+    [ { CUdeviceptr } ] dip
+    '[ _ cuMemAlloc cuda-error ] with-out-parameters ; inline
+
+: cuda-malloc-type ( n type -- ptr )
+    c:heap-size * cuda-malloc ; inline
 
-: cuda-free* ( ptr -- )
-    cuMemFree cuda-error ;
+: cuda-free ( ptr -- )
+    cuMemFree cuda-error ; inline
 
-M: cuda-memory dispose ( ptr -- )
-    ptr>> cuda-free* ;
+DESTRUCTOR: 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 )
-    [ length cuda-malloc ] keep
-    [ [ ptr>> ] dip dup length cuMemcpyHtoD cuda-error ]
-    [ drop ] 2bi ;
+: host>device ( data -- ptr )
+    binary-object
+    [ nip cuda-malloc dup ] [ memcpy-host>device ] 2bi ; inline
 
-:: device>host ( ptr -- seq )
-    ptr byte-length <byte-array>
-    [ ptr [ ptr>> ] [ byte-length ] bi cuMemcpyDtoH cuda-error ] keep ;
+: device>host ( ptr len -- byte-array )
+    [ nip <byte-array> dup ] [ memcpy-device>host ] 2bi ; inline