;; 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")
(: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"
;; 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")
#+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))
;; 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")
(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