- (unless *ignore-after* (setq *ignore-after* (cons 1 2)))
- (let ((res ()))
- (flet ((res (x)
- (setq res (maybe-cons space x res))))
- (map-allocated-objects
- (lambda (obj obj-type size)
- (declare (optimize (safety 0)) (ignore obj-type size))
- (typecase obj
- (cons
- (when (or (eq (car obj) object) (eq (cdr obj) object))
- (res obj)))
- (instance
- (dotimes (i (%instance-length obj))
- (when (eq (%instance-ref obj i) object)
- (res obj)
- (return))))
- (simple-vector
- (dotimes (i (length obj))
- (when (eq (svref obj i) object)
- (res obj)
- (return))))
- (symbol
- (when (or (eq (symbol-name obj) object)
- (eq (symbol-package obj) object)
- (eq (symbol-plist obj) object)
- (eq (symbol-value obj) object))
- (res obj)))))
- space))
- res))
+ (unless *ignore-after*
+ (setq *ignore-after* (cons 1 2)))
+ (flet ((maybe-call (fun obj)
+ (when (valid-obj space obj)
+ (funcall fun obj))))
+ (map-allocated-objects
+ (lambda (obj obj-type size)
+ (declare (optimize (safety 0)) (ignore obj-type size))
+ (typecase obj
+ (cons
+ (when (or (eq (car obj) object)
+ (eq (cdr obj) object))
+ (maybe-call fun obj)))
+ (instance
+ (dotimes (i (%instance-length obj))
+ (when (eq (%instance-ref obj i) object)
+ (maybe-call fun obj)
+ (return))))
+ (code-component
+ (let ((length (get-header-data obj)))
+ (do ((i code-constants-offset (1+ i)))
+ ((= i length))
+ (when (eq (code-header-ref obj i) object)
+ (maybe-call fun obj)
+ (return)))))
+ (simple-vector
+ (dotimes (i (length obj))
+ (when (eq (svref obj i) object)
+ (maybe-call fun obj)
+ (return))))
+ (symbol
+ (when (or (eq (symbol-name obj) object)
+ (eq (symbol-package obj) object)
+ (eq (symbol-plist obj) object)
+ (eq (symbol-value obj) object))
+ (maybe-call fun obj)))))
+ space)))
+
+(defun list-referencing-objects (space object)
+ (collect ((res))
+ (map-referencing-objects
+ (lambda (obj) (res obj)) space object)
+ (res)))