- (let ((address (pointer-address (pointer object))))
- (setf (gethash address *known-boxed-refs*) object)
- (setf (gethash address *boxed-ref-count*) 1)
- (setf (gethash address *boxed-ref-owner*)
- (gethash address *boxed-ref-owner* :foreign)))
- (debugf "setting g-boxed-ref-count of ~A to 1~%" (pointer object))
- (let ((p (pointer object))
- (type (type-of object))
- (s (format nil "~A" object)))
- (tg:finalize object (lambda ()
- (handler-case
- (dispose-boxed-ref type p)
- (error (e) (format t "Error ~A for ~A~%" e s)))))))
+ (with-recursive-lock-held (*g-boxed-gc-lock*)
+ (let ((address (pointer-address (pointer object))))
+ (awhen (gethash address *known-boxed-refs*)
+ (tg:cancel-finalization it))
+ (setf (gethash address *known-boxed-refs*) object)
+ (setf (gethash address *boxed-ref-count*) 1)
+ (setf (gethash address *boxed-ref-owner*)
+ (gethash address *boxed-ref-owner* :foreign)))
+ (debugf "setting g-boxed-ref-count of ~A (for ptr ~A) to 1~%" object (pointer object))
+ (let ((p (pointer object))
+ (type (type-of object))
+ (s (format nil "~A" object)))
+ (tg:finalize object (lambda ()
+ (handler-case
+ (dispose-boxed-ref type p)
+ (error (e) (format t "Error ~A for ~A~%" e s))))))))