X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/425c4d78d24f123702f74baf10847976bb4f04e6..a666b391b604d3afe86079e064e648d9062430ef:/glib/glib.lisp diff --git a/glib/glib.lisp b/glib/glib.lisp index e8f6f47..43eb8bc 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.42 2007-10-17 14:30:41 espen Exp $ +;; $Id: glib.lisp,v 1.44 2008-10-08 18:11:12 espen Exp $ (in-package "GLIB") @@ -39,24 +39,20 @@ ;;;; Memory management -(defbinding (%allocate-memory "g_malloc0") () pointer - (size unsigned-long)) +(deftype gsize () 'unsigned-int) -(defbinding (%deallocate-memory "g_free") () nil - (address pointer)) +(defbinding malloc0 () pointer + (size gsize)) -;; (setf -;; (symbol-function 'allocate-memory) #'%allocate-memory -;; (symbol-function 'deallocate-memory) #'%deallocate-memory) +(defbinding free () nil + (address pointer)) -(setf *memory-allocator* #'%allocate-memory) -(setf *memory-deallocator* #'%deallocate-memory) +(setf *memory-allocator* #'malloc0) +(setf *memory-deallocator* #'free) (defbinding (reallocate-memory "g_realloc") () pointer (address pointer) - (size unsigned-long)) - -(deftype gsize () 'unsigned-int) + (size gsize)) (defbinding (slice-alloc "g_slice_alloc0") () pointer (block-size gsize)) @@ -152,19 +148,22 @@ (deftype glist (type) `(or null (cons ,type list))) -(defbinding (%glist-append "g_list_append") () pointer +(defbinding (%glist-prepend "g_list_prepend") () pointer (glist (or null pointer)) (nil null)) +(defbinding (%glist-reverse "g_list_reverse") () pointer + (glist (or null pointer))) + (defun make-glist (element-type list &optional temp-p) (let ((writer (if (functionp element-type) element-type (writer-function element-type :temp temp-p)))) (loop for element in list - as glist = (%glist-append nil) then (%glist-append glist) + as glist = (%glist-prepend nil) then (%glist-prepend glist) do (funcall writer element glist) - finally (return glist)))) + finally (return (%glist-reverse glist))))) (defun glist-next (glist) (unless (null-pointer-p glist) @@ -324,12 +323,11 @@ #'(lambda (from to &optional (offset 0)) (unless (null-pointer-p (ref-pointer from offset)) (loop - as from-list = (ref-pointer from offset) - then (glist-next from-list) - as to-list = (setf (ref-pointer to offset) (%glist-append nil)) - then (%glist-append to-list) + as from-list = (ref-pointer from offset) then (glist-next from-list) + as to-list = (%glist-prepend nil) then (%glist-prepend to-list) do (funcall copy-element from-list to-list) - while (glist-next from-lisT))))))) + while (glist-next from-list) + finally (setf (ref-pointer to offset) (%glist-reverse to-list)))))))) ;;;; Single linked list (GSList)