2017-08-25 18:34:26 -04:00
|
|
|
! Copyright (C) 2010 Joe Groff.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2010-05-20 17:32:35 -04:00
|
|
|
USING: alien.c-types alien.data continuations cuda cuda.ffi
|
2010-05-25 00:38:25 -04:00
|
|
|
cuda.libraries alien.destructors fry kernel namespaces ;
|
2010-05-20 17:32:35 -04:00
|
|
|
IN: cuda.contexts
|
|
|
|
|
2010-05-25 00:38:25 -04:00
|
|
|
: set-up-cuda-context ( -- )
|
|
|
|
H{ } clone cuda-modules set-global
|
|
|
|
H{ } clone cuda-functions set-global ; inline
|
|
|
|
|
2010-05-20 17:32:35 -04:00
|
|
|
: create-context ( device flags -- context )
|
|
|
|
swap
|
2010-12-25 19:54:45 -05:00
|
|
|
[ { CUcontext } ] 2dip
|
|
|
|
'[ _ _ cuCtxCreate cuda-error ] with-out-parameters ; inline
|
2010-05-20 17:32:35 -04:00
|
|
|
|
|
|
|
: sync-context ( -- )
|
|
|
|
cuCtxSynchronize cuda-error ; inline
|
|
|
|
|
|
|
|
: context-device ( -- n )
|
2010-12-25 19:54:45 -05:00
|
|
|
{ CUdevice } [ cuCtxGetDevice cuda-error ] with-out-parameters ; inline
|
2010-05-20 17:32:35 -04:00
|
|
|
|
|
|
|
: destroy-context ( context -- ) cuCtxDestroy cuda-error ; inline
|
|
|
|
|
2010-05-25 00:38:25 -04:00
|
|
|
: clean-up-context ( context -- )
|
|
|
|
[ sync-context ] ignore-errors destroy-context ; inline
|
|
|
|
|
|
|
|
DESTRUCTOR: destroy-context
|
|
|
|
DESTRUCTOR: clean-up-context
|
2010-05-20 17:32:35 -04:00
|
|
|
|
|
|
|
: (with-cuda-context) ( context quot -- )
|
2010-05-25 00:38:25 -04:00
|
|
|
swap '[ _ clean-up-context ] [ ] cleanup ; inline
|
2010-05-20 17:32:35 -04:00
|
|
|
|
|
|
|
: with-cuda-context ( device flags quot -- )
|
2010-05-25 00:38:25 -04:00
|
|
|
[ set-up-cuda-context create-context ] dip (with-cuda-context) ; inline
|