Mon Jun 8 11:20:54 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Make unreadable cycles garbage collectable.
hunk ./src/clos.lisp 110
- ((pointer :reader pointer :initarg :pointer
- :documentation "Pointer to the C++ object."))
+ ((pointer :reader pointer
+ :initarg :pointer
+ :documentation "Pointer to the C++ object.")
+ ;; We can not have a global table of objects owned by C++,
+ ;; since then they would be alway reacable from Lisp and thus
+ ;; cycles would never be garbage collected.
+ (owned-objects :accessor owned-objects
+ :initform nil
+ :type list
+ :documentation "Objecsts owned by the C++ instance."))
hunk ./src/clos.lisp 267
- (remove-wrapper-object object)
hunk ./src/clos.lisp 292
-(defun put-returnvalue (stack value type)
+(defun put-returnvalue (stack value type object)
hunk ./src/clos.lisp 304
- (disown-object value))))))
+ (transfer-ownership-to value object))))))
hunk ./src/clos.lisp 342
- (return-type method))
+ (return-type method)
+ object)
hunk ./src/clos.lisp 364
- (put-returnvalue stack return-value (return-type method))
+ (put-returnvalue stack return-value [_$_]
+ (return-type method)
+ (get-object object))
hunk ./src/clos.lisp 447
-(defvar *cxx-wrapper-objects* (make-synchronized-hash-table))
-
-(defun keep-wrapper (object)
- (assert (not (gethash object *cxx-wrapper-objects*)))
- (setf (gethash object *cxx-wrapper-objects*) object))
+(defun keep-wrapper (object new-owner)
+ (assert (not (member object (owned-objects new-owner)))
+ ()
+ "~A has already been called for ~A." #'keep-wrapper object)
+ (push object (owned-objects new-owner)))
hunk ./src/clos.lisp 453
-(defun remove-wrapper-object (object)
- (remhash object *cxx-wrapper-objects*))
+(defun remove-wrapper-object (object owner)
+ (remove object (owned-objects owner)))
hunk ./src/clos.lisp 456
-(defun disown-object (object)
+(defun transfer-ownership-to (object new-owner)
hunk ./src/clos.lisp 465
- (keep-wrapper object))
+ (keep-wrapper object new-owner))
hunk ./src/clos.lisp 471
-
-(defun take-ownership (object)
+(defun take-ownership (object &optional current-owner)
hunk ./src/clos.lisp 474
- (remove-wrapper-object object)
+ (when current-owner
+ (remove-wrapper-object object current-owner))
hunk ./src/clos.lisp 478
-
-;(eval-when (:load-toplevel)
-; (trace disown-object
-; keep-wrapper
-; remove-wrapper-object [_$_]
-;take-ownership
-;put-returnvalue
-;))
hunk ./src/objects/enum.lisp 79
+(defun enum-logior (&rest enums)
+ (apply #'logior (mapcar #'value enums)))
+
hunk ./src/package.lisp 6
+ #:enum-logior
hunk ./src/smoke.lisp 191
- "Declares METHOD transfers the ownership of OBJECT to C++."
+ "Declares METHOD transfers the ownership of OBJECT to the
+first argument of LAMBDA-LIST."
hunk ./src/smoke.lisp 194
- (disown-object ,object)))
+ (transfer-ownership-to ,object ,(if (consp (first lambda-list))
+ (first (first lambda-list))
+ (first lambda-list)))))