Changed how memory allocation/deallocation functions are specified

diff --git a/gffi/defpackage.lisp b/gffi/defpackage.lisp
index 1c3b456435ab5e433da697fc9c496594c9df8a42..ec9a2ede94951d1b568e1c3158adb421177fd8d2 100644 (file)
--- 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.
 
 ;; 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")
 
 (defpackage "GFFI"
   (:use "COMMON-LISP" "AUTOEXPORT" "PKG-CONFIG" "CLG-UTILS")


@@ -48,7 +48,8 @@ (defpackage "GFFI"
   (: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"
   (: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"
   ;; 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 042057e07c8a5134ca6457b4ca50ed95eedcf177..dd71a5a84f1cb9e37b7488855a5e98f8be6cf0d7 100644 (file)
--- 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.
 
 ;; 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")
 
 
 (in-package "GFFI")


@@ -71,14 +71,19 @@ (defun (setf ref-byte) (byte location &optional (offset 0))
    #+clisp(ffi:memory-as location 'ffi:uchar offset)
    byte))
 
    #+clisp(ffi:memory-as location 'ffi:uchar offset)
    byte))
 

+(defparameter *memory-allocator* nil)
+(defparameter *memory-deallocator* nil)
+

 (defun allocate-memory (size)
 (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)
 (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))
 
 (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 88d960eb2e6eaf20c8a67fba9e1d59ee776d5f19..30d82fce0954c7ed84bd785ef050c3d17a73cdd2 100644 (file)
--- 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.
 
 ;; 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")
 
 
 (in-package "GLIB")


@@ -36,10 +36,12 @@ (defbinding (%allocate-memory "g_malloc0") () pointer
 (defbinding (%deallocate-memory "g_free") () nil
   (address pointer))
 
 (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
 
 
 ;;;; User data mechanism