From 9fccc389948355ec05f405b8ec5c570b74815c4b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 24 May 2010 21:38:25 -0700
Subject: [PATCH] cuda.contexts, cuda.gl: factor out set-up-cuda-context and
 clean-up-cuda-context so they can be used by objects that own a cuda context
 (separate from with-cuda-context)

---
 extra/cuda/contexts/contexts.factor | 19 ++++++++++++-------
 extra/cuda/gl/gl.factor             |  2 +-
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/extra/cuda/contexts/contexts.factor b/extra/cuda/contexts/contexts.factor
index a218c588c5..7a9ab59a6a 100644
--- a/extra/cuda/contexts/contexts.factor
+++ b/extra/cuda/contexts/contexts.factor
@@ -1,8 +1,12 @@
 ! (c)2010 Joe Groff bsd license
 USING: alien.c-types alien.data continuations cuda cuda.ffi
-cuda.libraries fry kernel namespaces ;
+cuda.libraries alien.destructors fry kernel namespaces ;
 IN: cuda.contexts
 
+: set-up-cuda-context ( -- )
+    H{ } clone cuda-modules set-global
+    H{ } clone cuda-functions set-global ; inline
+
 : create-context ( device flags -- context )
     swap
     [ CUcontext <c-object> ] 2dip
@@ -16,14 +20,15 @@ IN: cuda.contexts
 
 : destroy-context ( context -- ) cuCtxDestroy cuda-error ; inline
 
-: (set-up-cuda-context) ( device flags create-quot -- )
-    H{ } clone cuda-modules set-global
-    H{ } clone cuda-functions set
-    call ; inline
+: clean-up-context ( context -- )
+    [ sync-context ] ignore-errors destroy-context ; inline
+
+DESTRUCTOR: destroy-context
+DESTRUCTOR: clean-up-context
 
 : (with-cuda-context) ( context quot -- )
-    swap '[ [ sync-context ] ignore-errors _ destroy-context ] [ ] cleanup ; inline
+    swap '[ _ clean-up-context ] [ ] cleanup ; inline
 
 : with-cuda-context ( device flags quot -- )
-    [ [ create-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline
+    [ set-up-cuda-context create-context ] dip (with-cuda-context) ; inline
 
diff --git a/extra/cuda/gl/gl.factor b/extra/cuda/gl/gl.factor
index f3a6b47cf6..71a2689b08 100644
--- a/extra/cuda/gl/gl.factor
+++ b/extra/cuda/gl/gl.factor
@@ -10,7 +10,7 @@ IN: cuda.gl
     [ cuGLCtxCreate cuda-error ] 3keep 2drop *void* ; inline
 
 : with-gl-cuda-context ( device flags quot -- )
-    [ [ create-gl-cuda-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline 
+    [ set-up-cuda-context create-gl-cuda-context ] dip (with-cuda-context) ; inline 
 
 : gl-buffer>resource ( gl-buffer flags -- resource )
     enum>number