Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 52 lines (41 sloc) 1.898 kB
3a92e18 @Ramarren Add simple garbage pools.
authored
1 (in-package :cffi-clutter)
2
3 ;;; Simple garbage pools to generalize memory management, since in many cases (behaviours) precise
4 ;;; control over dynamic extent of objects may be necessary. This pools assume that they contain
5 ;;; only GObjects, which will be g-object-unref'ed when the pool lifetime ends.
6
7 (defclass gobject-garbage-pool ()
8 ((gobjects :accessor gobjects-of :initform (make-hash-table))
9 (name :accessor name-of :initform "Anonymous pool" :initarg :name)))
10
d219793 @Ramarren Add print-object method and change `collect` to `cleanup`.
authored
11 (defmethod print-object ((object gobject-garbage-pool) stream)
12 (print-unreadable-object (object stream :type t :identity t)
13 (format stream "GOBJ: ~a" (hash-table-count (gobjects-of object)))))
14
3a92e18 @Ramarren Add simple garbage pools.
authored
15 (defvar *current-pool* (make-instance 'gobject-garbage-pool :name "Top level pool"))
16
d219793 @Ramarren Add print-object method and change `collect` to `cleanup`.
authored
17 (defgeneric cleanup-pool (pool)
3a92e18 @Ramarren Add simple garbage pools.
authored
18 (:method ((pool gobject-garbage-pool))
19 (maphash #'(lambda (key value)
20 (dotimes (i value)
21 (g-object-unref key)))
22 (gobjects-of pool))
9fa6d23 @Ramarren Add sensible return values.
authored
23 (setf (gobjects-of pool) (make-hash-table))
24 pool))
3a92e18 @Ramarren Add simple garbage pools.
authored
25
26 (defmacro with-pool (pool &body body)
27 `(let ((*current-pool* ,pool))
28 (unwind-protect (progn ,@body)
d219793 @Ramarren Add print-object method and change `collect` to `cleanup`.
authored
29 (cleanup-pool *current-pool*))))
3a92e18 @Ramarren Add simple garbage pools.
authored
30
31 (defmacro with-new-pool (name &body body)
32 `(with-pool (make-instance 'gobject-garbage-pool :name ,name)
33 ,@body))
34
35 (defun pool (object &optional (pool *current-pool*))
9fa6d23 @Ramarren Add sensible return values.
authored
36 (incf (gethash object (gobjects-of pool) 0))
37 object)
3a92e18 @Ramarren Add simple garbage pools.
authored
38
39 (defun unpool (object &optional (pool *current-pool*))
40 (let ((pool-count (gethash object (gobjects-of pool))))
41 (cond ((null pool-count)
42 (error "Tried to unpool object which was not pooled."))
43 ((= 1 pool-count)
44 (remhash object (gobjects-of pool)))
9fa6d23 @Ramarren Add sensible return values.
authored
45 (t (decf (gethash object (gobjects-of pool))))))
46 object)
3a92e18 @Ramarren Add simple garbage pools.
authored
47
48 (defun unpool-unref (object &optional (pool *current-pool*))
49 (unpool object pool)
9fa6d23 @Ramarren Add sensible return values.
authored
50 (g-object-unref object)
51 (values))
Something went wrong with that request. Please try again.