Sun May 31 19:41:26 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Ownership for return values on the stack
hunk ./src/clos.lisp 124
-(defclass smoke-wrapper-class (smoke-standard-class)
+(defclass cxx:class (smoke-standard-class)
hunk ./src/clos.lisp 126
- :type symbol)))
+ :type symbol))
+ (:documentation "Metaclass to extend Smoke Objects."))
hunk ./src/clos.lisp 129
-(defmethod smoke ((class smoke-wrapper-class))
+(defmethod smoke ((class cxx:class))
hunk ./src/clos.lisp 132
-(defclass cxx:class (smoke-wrapper-class)
- ()
- (:documentation "Metaclass to extend Smoke Objects."))
-
hunk ./src/clos.lisp 136
-(defmethod closer-mop:validate-superclass ((class smoke-wrapper-class) (superclass smoke-standard-class))
+(defmethod closer-mop:validate-superclass ((class cxx:class) (superclass smoke-standard-class))
hunk ./src/clos.lisp 159
- ((class smoke-wrapper-class)
+ ((class cxx:class)
hunk ./src/clos.lisp 176
- ((class smoke-wrapper-class)
+ ((class cxx:class)
hunk ./src/clos.lisp 259
+ (remove-wrapper-object object)
hunk ./src/clos.lisp 276
+ "Returns ARGUMENT converted to TYPE. If USER is true, user defined
+conversion sequences are considered."
hunk ./src/clos.lisp 296
- (cancel-finalization converted-value) [_$_]
- (when (and (class-p type)
- (not (virtual-destructor-p (get-class type))))
- (if (pointerp converted-value)
- (remove-object converted-value)
- (progn
- (cancel-finalization value)
- (remove-object (pointer value))))))))))
+ (cancel-finalization converted-value)
+ (disown-object value))))))
hunk ./src/clos.lisp 400
+
+(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 remove-wrapper-object (object)
+ (remhash object *cxx-wrapper-objects*))
+
+(defun disown-object (object)
+ "Transfers the ownership of OBJECT to C++."
+ (cancel-finalization object)
+ (if (typep (class-of object) 'cxx:class)
+ (progn
+ (assert (virtual-destructor-p (class-of object))
+ ()
+ "The ownership of the object ~A is transfered to C++, but
+it has a nonvirtual destructor." object)
+ (keep-wrapper object))
+ (when (and (typep object 'smoke-standard-object)
+ (not (virtual-destructor-p (class-of object))))
+ (remove-object (pointer object)))))
+ [_$_]
+
+
+(defun take-ownership (object)
+ "Assigns the ownership of OBJECT to Lisp. i.e.:
+cl-smoke is responsible for deleting the object."
+ (remove-wrapper-object object)
+ (let ((finalizer (make-finalize object)))
+ (finalize object finalizer)))
+
+;(eval-when (:load-toplevel)
+; (trace disown-object
+; keep-wrapper
+; remove-wrapper-object [_$_]
+;take-ownership
+;put-returnvalue
+;))
hunk ./src/object-map.lisp 4
-(defun make-weak-synchronized-hash-table (&key weakness)
- (make-weak-hash-table :weakness weakness :synchronized t))
+(defun make-synchronized-hash-table (&key weakness)
+ (if weakness
+ (make-weak-hash-table :weakness weakness :synchronized t)
+ (make-weak-hash-table :synchronized t)))
hunk ./src/object-map.lisp 12
- (defun make-weak-synchronized-hash-table (&key weakness)
- (make-weak-hash-table :weakness weakness)))
+ (defun make-synchronized-hash-table (&key weakness)
+ (if weakness
+ (make-weak-hash-table :weakness weakness)
+ (make-weak-hash-table))))
hunk ./src/object-map.lisp 19
-(cerror "Use unsynchronized hash-table"
- "Synchronized hash table not implemented.")
-(defun make-weak-synchronized-hash-table (&key weakness)
- #-cmucl (make-weak-hash-table :weakness weakness)
- #+cmucl (make-hash-table :weak-p weakness)
- ))
+ (cerror "Use unsynchronized hash-table"
+ "Synchronized hash table not implemented.")
+ (defun make-synchronized-hash-table (&key weakness)
+ (if weakness
+ #-cmucl (make-weak-hash-table :weakness weakness)
+ #+cmucl (make-hash-table :weak-p weakness)
+ (make-hash-table))))
hunk ./src/object-map.lisp 28
-(defvar *object-map* (make-weak-synchronized-hash-table :weakness :value))
+(defvar *object-map* (make-synchronized-hash-table :weakness :value)
+ "Contains all objects constructed by Smoke, that are not yet destructed;
+except object with a non virtual destuctor which had their ownership transfered
+to C++.")
hunk ./src/object-map.lisp 55
+(defun report-finalize-error (condition function object pointer)
+ (warn "error calling finalizer ~A for ~A ~A:~%~5T~A"
+ function object pointer condition))
hunk ./src/object-map.lisp 67
- (condition (condition)
- (format *debug-io* "error finalize ~A ~A~%" (name class)
- condition))))))
- [_$_]
-
-(defun take-ownership (object)
- "Assigns the ownership of OBJECT to Lisp. i.e.:
-cl-smoke is responsible for deleting the object."
- (let ((finalizer (make-finalize object)))
- (finalize object finalizer)))
+ (error (condition)
+ (report-finalize-error condition 't (name class) pointer))))))
hunk ./src/overload-resolution.lisp 484
+ (assert (valid-p method)
+ ()
+ "No applicable method ~A() for ~A." name object-or-class)
hunk ./src/smoke.lisp 196
-