From bf54963e7c4c265eff31ffecb894f87f6a30ebaa Mon Sep 17 00:00:00 2001
From: espen <espen>
Date: Thu, 21 Dec 2006 16:38:19 +0000
Subject: [PATCH] Changed how memory allocation/deallocation functions are
 specified

---
 gffi/defpackage.lisp |  5 +++--
 gffi/memory.lisp     | 15 ++++++++++-----
 glib/glib.lisp       | 10 ++++++----
 3 files changed, 19 insertions(+), 11 deletions(-)

diff --git a/gffi/defpackage.lisp b/gffi/defpackage.lisp
index 781dfe9..6eb9c55 100644
--- a/gffi/defpackage.lisp
+++ b/gffi/defpackage.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: defpackage.lisp,v 1.5 2006-09-27 08:44:08 espen Exp $
+;; $Id: defpackage.lisp,v 1.6 2006-12-21 16:38:19 espen Exp $
 
 (defpackage "GFFI"
   (:use "COMMON-LISP" "AUTOEXPORT" "PKG-CONFIG" "CLG-UTILS")
@@ -48,7 +48,8 @@
   (:export "MAKE-POINTER" "POINTER-ADDRESS" "NULL-POINTER-P" "POINTER=" 
 	   "POINTER+" "REF-POINTER" "REF-BYTE" "ALLOCATE-MEMORY"
 	   "DEALLOCATE-MEMORY" "COPY-MEMORY" "CLEAR-MEMORY" "MEMORY-CLEAR-P"
-	   "WITH-MEMORY" "WITH-POINTER")
+	   "WITH-MEMORY" "WITH-POINTER" "*MEMORY-ALLOCATOR*" 
+	   "*MEMORY-DEALLOCATOR*")
   ;; Symbols from interface.lisp
   (:export "DEFBINDING" "MKBINDING" "USE-PREFIX" "PACKAGE-PREFIX" 
 	   "DEFINE-CALLBACK" "CALLBACK" "CALLBACK-ADDRESS"
diff --git a/gffi/memory.lisp b/gffi/memory.lisp
index 997a632..2bcc394 100644
--- a/gffi/memory.lisp
+++ b/gffi/memory.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: memory.lisp,v 1.2 2006-06-08 13:24:25 espen Exp $
+;; $Id: memory.lisp,v 1.3 2006-12-21 16:38:19 espen Exp $
 
 
 (in-package "GFFI")
@@ -71,14 +71,19 @@
    #+clisp(ffi:memory-as location 'ffi:uchar offset)
    byte))
 
+(defparameter *memory-allocator* nil)
+(defparameter *memory-deallocator* nil)
+
 (defun allocate-memory (size)
-  (declare (ignore size))
-  (error "Memory allocator not set"))
+  (if *memory-allocator*
+      (funcall *memory-allocator* size)
+    (error "Memory allocator not set")))
 (declaim (ftype (function (integer) system-area-pointer) allocate-memory))
 
 (defun deallocate-memory (location)
-  (declare (ignore location))
-  (warn "Memory deallocator not set"))
+  (if *memory-deallocator*
+      (funcall *memory-deallocator* location)
+    (warn "Memory deallocator not set")))
 
 (defun copy-memory (from length &optional (to (allocate-memory length)))
   #+cmu(system-area-copy from 0 to 0 (* 8 length))
diff --git a/glib/glib.lisp b/glib/glib.lisp
index ec84bb9..7931877 100644
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: glib.lisp,v 1.38 2006-06-08 13:24:25 espen Exp $
+;; $Id: glib.lisp,v 1.39 2006-12-21 16:38:19 espen Exp $
 
 
 (in-package "GLIB")
@@ -36,10 +36,12 @@
 (defbinding (%deallocate-memory "g_free") () nil
   (address pointer))
 
-(setf
- (symbol-function 'allocate-memory) #'%allocate-memory
- (symbol-function 'deallocate-memory) #'%deallocate-memory)
+;; (setf
+;;  (symbol-function 'allocate-memory) #'%allocate-memory
+;;  (symbol-function 'deallocate-memory) #'%deallocate-memory)
 
+(setf *memory-allocator* #'%allocate-memory)
+(setf *memory-deallocator* #'%deallocate-memory)
 
 ;;;; User data mechanism
 
-- 
2.11.0