Sun May 24 13:30:05 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* cleanup finalization stuff

- :documentation "Pointer to the C++ object.")

- (owned-p :accessor owned-p :initarg :owned-p

- :initform t

- :documentation "T when the object is owned by Lisp and

-NIL when C++ is the owner.")

- (const-p :reader const-p :initarg :const-p

- :initform nil

- :documentation "T when the object is const and NIL otherwise."))

+ :documentation "Pointer to the C++ object."))

- ((enumerations :initform (make-hash-table)

- :initarg :enumerations

- :reader enumerations

- :documentation "The enumerations of the class.

-Maps the type-id of the enumeration to a hash-table that

-maps an enum value to a symbol."))

+ ()

-(defun smoke-class-symbol (class)

- (if (external-p class)

- (class-name (find-smoke-class class))

- (lispify (name class))))

+(defun smoke-class-symbol (smoke-class)

+ "Returns the Lisp class-name of SMOKE-CLASS:"

+ (if (external-p smoke-class)

+ (class-name (find-smoke-class smoke-class))

+ (lispify (name smoke-class))))

- (pointer value))

+ (cast value (find-smoke-class (get-class type))))

+ ;(pointer value))

- (cancel-finalization value) ;; Fixme mark object as invalid or copy it

- ;(remove-object (pointer value))

- (remove-if-exists (pointer value));;FIXME!

- (setf (slot-value value 'pointer) (null-pointer))))

+ (cancel-finalization value) [_$_]

+ (unless (virtual-destructor-p (class-of value))

+ (remove-object (pointer value))))) ;; Fixme mark object as invalid or copy it

+

-;(eval-startup (:execute)

-; (memoize:memoize-function 'get-gf-for-method)

-; (memoize:clear-memoized-function 'get-gf-for-method))

-

- (setf (slot-value object 'owned-p) t)

+ (take-ownership object)

- :owned-p (stack-p type)

+ (when (stack-p type)

+ (take-ownership ret)

+ (add-object ret))

+(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)))

+ [_$_]

+ "Adds OBJECT to the pointer -> object map. It can later be retrived

+with GET-OBJECT."

- (when (owned-p object)

- (let ((finalizer (make-finalize object)))

- (finalize object finalizer)))

+(defun virtual-destructor-p (class)

+ "Returns T when CLASS has a virtual destructor and NIL otherwise."

+ (/= 0 (get-flag class :virtual-destructor)))

+

- (object-to-lisp (foreign-slot-value stack-item

- 'smoke-stack-item

- 'class)

- type))

+ (let ((object (object-to-lisp (foreign-slot-value stack-item

+ 'smoke-stack-item

+ 'class)

+ type)))

+ object))

- (boole boole-and (get-struct-slot-value type 'flags)

- (foreign-enum-value 'smoke-type-flags flag)))

+ (logand (get-struct-slot-value type 'flags)

+ #xF0 ;; = ! 0x0F

+ (foreign-enum-value 'smoke-type-flags flag)))

+

+(defun get-allocation-flag (type)

+ (logand (get-struct-slot-value type 'flags)

+ #x30))

- (/= 0 (get-flag type :stack)))

+ (= (get-allocation-flag type) (get-flag type :stack)))

- (/= 0 (get-flag type :reference)))

+ (= (get-allocation-flag type) (get-flag type :reference)))

- (/= 0 (get-flag type :pointer)))

+ (= (get-allocation-flag type) (get-flag type :pointer)))

- (boole boole-and (get-struct-slot-value type 'flags)

- (foreign-enum-value 'smoke-type-flags :type-id)))

+ (logand (get-struct-slot-value type 'flags)

+ (foreign-enum-value 'smoke-type-flags :type-id)))

+