1 ! (c)2010 Joe Groff bsd license
2 USING: accessors alien alien.c-types alien.data alien.destructors
3 alien.enums continuations cuda cuda.contexts cuda.ffi
4 cuda.gl.ffi destructors fry gpu.buffers kernel ;
7 : create-gl-cuda-context ( device flags -- context )
10 '[ _ _ cuGLCtxCreate cuda-error ] with-out-parameters ; inline
12 : with-gl-cuda-context ( device flags quot -- )
13 [ set-up-cuda-context create-gl-cuda-context ] dip (with-cuda-context) ; inline
15 : gl-buffer>resource ( gl-buffer flags -- resource )
17 [ { CUgraphicsResource } ] 2dip
18 '[ _ _ cuGraphicsGLRegisterBuffer cuda-error ] with-out-parameters ; inline
20 : buffer>resource ( buffer flags -- resource )
21 [ handle>> ] dip gl-buffer>resource ; inline
23 : map-resource ( resource -- device-ptr size )
24 [ 1 swap void* <ref> f cuGraphicsMapResources cuda-error ] [
25 [ { CUdeviceptr uint } ] dip
26 '[ _ cuGraphicsResourceGetMappedPointer cuda-error ]
30 : unmap-resource ( resource -- )
31 1 swap void* <ref> f cuGraphicsUnmapResources cuda-error ; inline
33 DESTRUCTOR: unmap-resource
35 : free-resource ( resource -- )
36 cuGraphicsUnregisterResource cuda-error ; inline
38 DESTRUCTOR: free-resource
40 : with-mapped-resource ( ..a resource quot: ( ..a device-ptr size -- ..b ) -- ..b )
41 over [ map-resource ] 2dip '[ _ unmap-resource ] [ ] cleanup ; inline
45 { resource pinned-c-ptr } ;
47 : <cuda-buffer> ( upload usage kind size initial-data flags -- buffer )
48 [ <buffer> dup ] dip buffer>resource cuda-buffer boa ; inline
50 M: cuda-buffer dispose
51 [ [ free-resource ] when* f ] change-resource
52 buffer>> dispose ; inline
54 : with-mapped-cuda-buffer ( ..a cuda-buffer quot: ( ..a device-ptr size -- ..b ) -- ..b )
55 [ resource>> ] dip with-mapped-resource ; inline