1 ;;;; heap-grovelling memory usage stuff
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; type format database
16 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
17 (def!struct
(room-info (:make-load-form-fun just-dump-it-normally
))
18 ;; the name of this type
19 (name nil
:type symbol
)
20 ;; kind of type (how we determine length)
22 :type
(member :lowtag
:fixed
:header
:vector
23 :string
:code
:closure
:instance
))
24 ;; length if fixed-length, shift amount for element size if :VECTOR
25 (length nil
:type
(or fixnum null
))))
27 (eval-when (:compile-toplevel
:execute
)
29 (defvar *meta-room-info
* (make-array 256 :initial-element nil
))
31 (dolist (obj *primitive-objects
*)
32 (let ((widetag (primitive-object-widetag obj
))
33 (lowtag (primitive-object-lowtag obj
))
34 (name (primitive-object-name obj
))
35 (variable (primitive-object-variable-length-p obj
))
36 (size (primitive-object-size obj
)))
40 (let ((info (make-room-info :name name
42 (lowtag (symbol-value lowtag
)))
43 (declare (fixnum lowtag
))
45 (setf (svref *meta-room-info
* (logior lowtag
(ash i
3))) info
))))
48 (setf (svref *meta-room-info
* (symbol-value widetag
))
49 (make-room-info :name name
53 (dolist (code (list complex-base-string-widetag simple-array-widetag
54 complex-bit-vector-widetag complex-vector-widetag
55 complex-array-widetag complex-vector-nil-widetag
))
56 (setf (svref *meta-room-info
* code
)
57 (make-room-info :name
'array-header
60 (setf (svref *meta-room-info
* bignum-widetag
)
61 (make-room-info :name
'bignum
64 (setf (svref *meta-room-info
* closure-header-widetag
)
65 (make-room-info :name
'closure
68 (dolist (stuff '((simple-bit-vector-widetag . -
3)
69 (simple-vector-widetag .
2)
70 (simple-array-unsigned-byte-2-widetag . -
2)
71 (simple-array-unsigned-byte-4-widetag . -
1)
72 (simple-array-unsigned-byte-7-widetag .
0)
73 (simple-array-unsigned-byte-8-widetag .
0)
74 (simple-array-unsigned-byte-15-widetag .
1)
75 (simple-array-unsigned-byte-16-widetag .
1)
76 (simple-array-unsigned-byte-31-widetag .
2)
77 (simple-array-unsigned-byte-32-widetag .
2)
78 (simple-array-signed-byte-8-widetag .
0)
79 (simple-array-signed-byte-16-widetag .
1)
80 (simple-array-unsigned-byte-29-widetag .
2)
81 (simple-array-signed-byte-30-widetag .
2)
82 (simple-array-signed-byte-32-widetag .
2)
83 (simple-array-single-float-widetag .
2)
84 (simple-array-double-float-widetag .
3)
85 (simple-array-complex-single-float-widetag .
3)
86 (simple-array-complex-double-float-widetag .
4)))
87 (let* ((name (car stuff
))
89 (sname (string name
)))
90 (setf (svref *meta-room-info
* (symbol-value name
))
91 (make-room-info :name
(intern (subseq sname
93 (mismatch sname
"-WIDETAG"
98 (setf (svref *meta-room-info
* simple-base-string-widetag
)
99 (make-room-info :name
'simple-base-string
103 (setf (svref *meta-room-info
* simple-array-nil-widetag
)
104 (make-room-info :name
'simple-array-nil
108 (setf (svref *meta-room-info
* code-header-widetag
)
109 (make-room-info :name
'code
112 (setf (svref *meta-room-info
* instance-header-widetag
)
113 (make-room-info :name
'instance
118 (defparameter *room-info
* '#.
*meta-room-info
*)
119 (deftype spaces
() '(member :static
:dynamic
:read-only
))
121 ;;;; MAP-ALLOCATED-OBJECTS
123 ;;; Since they're represented as counts of words, we should never
124 ;;; need bignums to represent these:
125 (declaim (type fixnum
126 *static-space-free-pointer
*
127 *read-only-space-free-pointer
*))
129 (defun space-bounds (space)
130 (declare (type spaces space
))
133 (values (int-sap static-space-start
)
134 (int-sap (* *static-space-free-pointer
* n-word-bytes
))))
136 (values (int-sap read-only-space-start
)
137 (int-sap (* *read-only-space-free-pointer
* n-word-bytes
))))
139 (values (int-sap #!+gencgc dynamic-space-start
140 #!-gencgc
(current-dynamic-space-start))
141 (dynamic-space-free-pointer)))))
143 ;;; Return the total number of bytes used in SPACE.
144 (defun space-bytes (space)
145 (multiple-value-bind (start end
) (space-bounds space
)
146 (- (sap-int end
) (sap-int start
))))
148 ;;; Round SIZE (in bytes) up to the next dualword (eight byte) boundary.
149 #!-sb-fluid
(declaim (inline round-to-dualword
))
150 (defun round-to-dualword (size)
151 (declare (fixnum size
))
152 (logand (the fixnum
(+ size lowtag-mask
)) (lognot lowtag-mask
)))
154 ;;; Return the total size of a vector in bytes, including any pad.
155 #!-sb-fluid
(declaim (inline vector-total-size
))
156 (defun vector-total-size (obj info
)
157 (let ((shift (room-info-length info
))
158 (len (+ (length (the (simple-array * (*)) obj
))
159 (ecase (room-info-kind info
)
162 (declare (type (integer -
3 3) shift
))
164 (+ (* vector-data-offset n-word-bytes
)
169 (1- (the fixnum
(ash 1 (- shift
)))))))
171 (ash len shift
)))))))
173 ;;; Iterate over all the objects allocated in SPACE, calling FUN with
174 ;;; the object, the object's type code, and the objects total size in
175 ;;; bytes, including any header and padding.
176 #!-sb-fluid
(declaim (maybe-inline map-allocated-objects
))
177 (defun map-allocated-objects (fun space
)
178 (declare (type function fun
) (type spaces space
))
180 (multiple-value-bind (start end
) (space-bounds space
)
181 (declare (type system-area-pointer start end
))
182 (declare (optimize (speed 3) (safety 0)))
183 (let ((current start
)
187 (let* ((header (sap-ref-32 current
0))
188 (header-widetag (logand header
#xFF
))
189 (info (svref *room-info
* header-widetag
)))
192 (eq (room-info-kind info
) :lowtag
))
193 (let ((size (* cons-size n-word-bytes
)))
195 (make-lisp-obj (logior (sap-int current
)
196 list-pointer-lowtag
))
199 (setq current
(sap+ current size
))))
200 ((eql header-widetag closure-header-widetag
)
201 (let* ((obj (make-lisp-obj (logior (sap-int current
)
202 fun-pointer-lowtag
)))
203 (size (round-to-dualword
204 (* (the fixnum
(1+ (get-closure-length obj
)))
206 (funcall fun obj header-widetag size
)
207 (setq current
(sap+ current size
))))
208 ((eq (room-info-kind info
) :instance
)
209 (let* ((obj (make-lisp-obj
210 (logior (sap-int current
) instance-pointer-lowtag
)))
211 (size (round-to-dualword
212 (* (+ (%instance-length obj
) 1) n-word-bytes
))))
213 (declare (fixnum size
))
214 (funcall fun obj header-widetag size
)
215 (aver (zerop (logand size lowtag-mask
)))
217 (when (> size
200000) (break "implausible size, prev ~S" prev
))
220 (setq current
(sap+ current size
))))
222 (let* ((obj (make-lisp-obj
223 (logior (sap-int current
) other-pointer-lowtag
)))
224 (size (ecase (room-info-kind info
)
226 (aver (or (eql (room-info-length info
)
227 (1+ (get-header-data obj
)))
229 (simple-array-nil-p obj
)))
231 (* (room-info-length info
) n-word-bytes
)))
233 (vector-total-size obj info
))
236 (* (1+ (get-header-data obj
)) n-word-bytes
)))
239 (* (get-header-data obj
) n-word-bytes
))
241 (* (the fixnum
(%code-code-size obj
))
243 (declare (fixnum size
))
244 (funcall fun obj header-widetag size
)
245 (aver (zerop (logand size lowtag-mask
)))
247 (when (> size
200000)
248 (break "Implausible size, prev ~S" prev
))
251 (setq current
(sap+ current size
))))))
252 (unless (sap< current end
)
253 (aver (sap= current end
))
261 ;;; Return a list of 3-lists (bytes object type-name) for the objects
262 ;;; allocated in Space.
263 (defun type-breakdown (space)
264 (let ((sizes (make-array 256 :initial-element
0 :element-type
'fixnum
))
265 (counts (make-array 256 :initial-element
0 :element-type
'fixnum
)))
266 (map-allocated-objects
267 (lambda (obj type size
)
268 (declare (fixnum size
) (optimize (speed 3) (safety 0)) (ignore obj
))
269 (incf (aref sizes type
) size
)
270 (incf (aref counts type
)))
273 (let ((totals (make-hash-table :test
'eq
)))
275 (let ((total-count (aref counts i
)))
276 (unless (zerop total-count
)
277 (let* ((total-size (aref sizes i
))
278 (name (room-info-name (aref *room-info
* i
)))
279 (found (gethash name totals
)))
281 (incf (first found
) total-size
)
282 (incf (second found
) total-count
))
284 (setf (gethash name totals
)
285 (list total-size total-count name
))))))))
287 (collect ((totals-list))
288 (maphash (lambda (k v
)
292 (sort (totals-list) #'> :key
#'first
)))))
294 ;;; Handle the summary printing for MEMORY-USAGE. Totals is a list of lists
295 ;;; (space-name . totals-for-space), where totals-for-space is the list
296 ;;; returned by TYPE-BREAKDOWN.
297 (defun print-summary (spaces totals
)
298 (let ((summary (make-hash-table :test
'eq
)))
299 (dolist (space-total totals
)
300 (dolist (total (cdr space-total
))
301 (push (cons (car space-total
) total
)
302 (gethash (third total
) summary
))))
304 (collect ((summary-totals))
305 (maphash (lambda (k v
)
308 (declare (fixnum sum
))
309 (dolist (space-total v
)
310 (incf sum
(first (cdr space-total
))))
311 (summary-totals (cons sum v
))))
314 (format t
"~2&Summary of spaces: ~(~{~A ~}~)~%" spaces
)
315 (let ((summary-total-bytes 0)
316 (summary-total-objects 0))
317 (declare (fixnum summary-total-bytes summary-total-objects
))
318 (dolist (space-totals
319 (mapcar #'cdr
(sort (summary-totals) #'> :key
#'car
)))
320 (let ((total-objects 0)
323 (declare (fixnum total-objects total-bytes
))
325 (dolist (space-total space-totals
)
326 (let ((total (cdr space-total
)))
327 (setq name
(third total
))
328 (incf total-bytes
(first total
))
329 (incf total-objects
(second total
))
330 (spaces (cons (car space-total
) (first total
)))))
331 (format t
"~%~A:~% ~:D bytes, ~:D object~:P"
332 name total-bytes total-objects
)
333 (dolist (space (spaces))
334 (format t
", ~W% ~(~A~)"
335 (round (* (cdr space
) 100) total-bytes
)
338 (incf summary-total-bytes total-bytes
)
339 (incf summary-total-objects total-objects
))))
340 (format t
"~%Summary total:~% ~:D bytes, ~:D objects.~%"
341 summary-total-bytes summary-total-objects
)))))
343 ;;; Report object usage for a single space.
344 (defun report-space-total (space-total cutoff
)
345 (declare (list space-total
) (type (or single-float null
) cutoff
))
346 (format t
"~2&Breakdown for ~(~A~) space:~%" (car space-total
))
347 (let* ((types (cdr space-total
))
348 (total-bytes (reduce #'+ (mapcar #'first types
)))
349 (total-objects (reduce #'+ (mapcar #'second types
)))
350 (cutoff-point (if cutoff
351 (truncate (* (float total-bytes
) cutoff
))
354 (reported-objects 0))
355 (declare (fixnum total-objects total-bytes cutoff-point reported-objects
357 (loop for
(bytes objects name
) in types do
358 (when (<= bytes cutoff-point
)
359 (format t
" ~10:D bytes for ~9:D other object~2:*~P.~%"
360 (- total-bytes reported-bytes
)
361 (- total-objects reported-objects
))
363 (incf reported-bytes bytes
)
364 (incf reported-objects objects
)
365 (format t
" ~10:D bytes for ~9:D ~(~A~) object~2:*~P.~%"
367 (format t
" ~10:D bytes for ~9:D ~(~A~) object~2:*~P (space total.)~%"
368 total-bytes total-objects
(car space-total
))))
370 ;;; Print information about the heap memory in use. PRINT-SPACES is a
371 ;;; list of the spaces to print detailed information for.
372 ;;; COUNT-SPACES is a list of the spaces to scan. For either one, T
373 ;;; means all spaces (i.e. :STATIC, :DYNAMIC and :READ-ONLY.) If
374 ;;; PRINT-SUMMARY is true, then summary information will be printed.
375 ;;; The defaults print only summary information for dynamic space. If
376 ;;; true, CUTOFF is a fraction of the usage in a report below which
377 ;;; types will be combined as OTHER.
378 (defun memory-usage (&key print-spaces
(count-spaces '(:dynamic
))
379 (print-summary t
) cutoff
)
380 (declare (type (or single-float null
) cutoff
))
381 (let* ((spaces (if (eq count-spaces t
)
382 '(:static
:dynamic
:read-only
)
384 (totals (mapcar (lambda (space)
385 (cons space
(type-breakdown space
)))
388 (dolist (space-total totals
)
389 (when (or (eq print-spaces t
)
390 (member (car space-total
) print-spaces
))
391 (report-space-total space-total cutoff
)))
393 (when print-summary
(print-summary spaces totals
)))
397 ;;; Print info about how much code and no-ops there are in SPACE.
398 (defun count-no-ops (space)
399 (declare (type spaces space
))
403 (declare (fixnum code-words no-ops
)
404 (type unsigned-byte total-bytes
))
405 (map-allocated-objects
406 (lambda (obj type size
)
407 (declare (fixnum size
) (optimize (safety 0)))
408 (when (eql type code-header-widetag
)
409 (incf total-bytes size
)
410 (let ((words (truly-the fixnum
(%code-code-size obj
)))
411 (sap (truly-the system-area-pointer
412 (%primitive code-instructions obj
))))
413 (incf code-words words
)
415 (when (zerop (sap-ref-32 sap
(* i n-word-bytes
)))
420 "~:D code-object bytes, ~:D code words, with ~:D no-ops (~D%).~%"
421 total-bytes code-words no-ops
422 (round (* no-ops
100) code-words
)))
426 (defun descriptor-vs-non-descriptor-storage (&rest spaces
)
427 (let ((descriptor-words 0)
428 (non-descriptor-headers 0)
429 (non-descriptor-bytes 0))
430 (declare (type unsigned-byte descriptor-words non-descriptor-headers
431 non-descriptor-bytes
))
432 (dolist (space (or spaces
'(:read-only
:static
:dynamic
)))
433 (declare (inline map-allocated-objects
))
434 (map-allocated-objects
435 (lambda (obj type size
)
436 (declare (fixnum size
) (optimize (safety 0)))
438 (#.code-header-widetag
439 (let ((inst-words (truly-the fixnum
(%code-code-size obj
))))
440 (declare (type fixnum inst-words
))
441 (incf non-descriptor-bytes
(* inst-words n-word-bytes
))
442 (incf descriptor-words
443 (- (truncate size n-word-bytes
) inst-words
))))
445 #.single-float-widetag
446 #.double-float-widetag
447 #.simple-base-string-widetag
448 #.simple-array-nil-widetag
449 #.simple-bit-vector-widetag
450 #.simple-array-unsigned-byte-2-widetag
451 #.simple-array-unsigned-byte-4-widetag
452 #.simple-array-unsigned-byte-8-widetag
453 #.simple-array-unsigned-byte-16-widetag
454 #.simple-array-unsigned-byte-32-widetag
455 #.simple-array-signed-byte-8-widetag
456 #.simple-array-signed-byte-16-widetag
457 #.simple-array-signed-byte-30-widetag
458 #.simple-array-signed-byte-32-widetag
459 #.simple-array-single-float-widetag
460 #.simple-array-double-float-widetag
461 #.simple-array-complex-single-float-widetag
462 #.simple-array-complex-double-float-widetag
)
463 (incf non-descriptor-headers
)
464 (incf non-descriptor-bytes
(- size n-word-bytes
)))
465 ((#.list-pointer-lowtag
466 #.instance-pointer-lowtag
469 #.simple-array-widetag
470 #.simple-vector-widetag
471 #.complex-base-string-widetag
472 #.complex-vector-nil-widetag
473 #.complex-bit-vector-widetag
474 #.complex-vector-widetag
475 #.complex-array-widetag
476 #.closure-header-widetag
477 #.funcallable-instance-header-widetag
478 #.value-cell-header-widetag
479 #.symbol-header-widetag
481 #.weak-pointer-widetag
482 #.instance-header-widetag
)
483 (incf descriptor-words
(truncate size n-word-bytes
)))
485 (error "bogus widetag: ~W" type
))))
487 (format t
"~:D words allocated for descriptor objects.~%"
489 (format t
"~:D bytes data/~:D words header for non-descriptor objects.~%"
490 non-descriptor-bytes non-descriptor-headers
)
493 ;;; Print a breakdown by instance type of all the instances allocated
494 ;;; in SPACE. If TOP-N is true, print only information for the the
495 ;;; TOP-N types with largest usage.
496 (defun instance-usage (space &key
(top-n 15))
497 (declare (type spaces space
) (type (or fixnum null
) top-n
))
498 (format t
"~2&~@[Top ~W ~]~(~A~) instance types:~%" top-n space
)
499 (let ((totals (make-hash-table :test
'eq
))
502 (declare (fixnum total-objects total-bytes
))
503 (map-allocated-objects
504 (lambda (obj type size
)
505 (declare (fixnum size
) (optimize (speed 3) (safety 0)))
506 (when (eql type instance-header-widetag
)
508 (incf total-bytes size
)
509 (let* ((classoid (layout-classoid (%instance-ref obj
0)))
510 (found (gethash classoid totals
)))
512 (incf (the fixnum
(car found
)))
513 (incf (the fixnum
(cdr found
)) size
))
515 (setf (gethash classoid totals
) (cons 1 size
)))))))
518 (collect ((totals-list))
519 (maphash (lambda (classoid what
)
520 (totals-list (cons (prin1-to-string
521 (classoid-proper-name classoid
))
524 (let ((sorted (sort (totals-list) #'> :key
#'cddr
))
527 (declare (fixnum printed-bytes printed-objects
))
528 (dolist (what (if top-n
529 (subseq sorted
0 (min (length sorted
) top-n
))
531 (let ((bytes (cddr what
))
532 (objects (cadr what
)))
533 (incf printed-bytes bytes
)
534 (incf printed-objects objects
)
535 (format t
" ~A: ~:D bytes, ~:D object~:P.~%" (car what
)
538 (let ((residual-objects (- total-objects printed-objects
))
539 (residual-bytes (- total-bytes printed-bytes
)))
540 (unless (zerop residual-objects
)
541 (format t
" Other types: ~:D bytes, ~:D object~:P.~%"
542 residual-bytes residual-objects
))))
544 (format t
" ~:(~A~) instance total: ~:D bytes, ~:D object~:P.~%"
545 space total-bytes total-objects
)))
549 (defun find-holes (&rest spaces
)
550 (dolist (space (or spaces
'(:read-only
:static
:dynamic
)))
551 (format t
"In ~A space:~%" space
)
552 (let ((start-addr nil
)
554 (declare (type (or null
(unsigned-byte 32)) start-addr
)
555 (type (unsigned-byte 32) total-bytes
))
556 (map-allocated-objects
557 (lambda (object typecode bytes
)
558 (declare (ignore typecode
)
559 (type (unsigned-byte 32) bytes
))
560 (if (and (consp object
)
562 (eql (cdr object
) 0))
564 (incf total-bytes bytes
)
565 (setf start-addr
(sb!di
::get-lisp-obj-address object
)
568 (format t
"~:D bytes at #X~X~%" total-bytes start-addr
)
569 (setf start-addr nil
))))
572 (format t
"~:D bytes at #X~X~%" total-bytes start-addr
))))
575 ;;;; PRINT-ALLOCATED-OBJECTS
577 (defun print-allocated-objects (space &key
(percent 0) (pages 5)
578 type larger smaller count
579 (stream *standard-output
*))
580 (declare (type (integer 0 99) percent
) (type index pages
)
581 (type stream stream
) (type spaces space
)
582 (type (or index null
) type larger smaller count
))
583 (multiple-value-bind (start-sap end-sap
) (space-bounds space
)
584 (let* ((space-start (sap-int start-sap
))
585 (space-end (sap-int end-sap
))
586 (space-size (- space-end space-start
))
587 (pagesize (sb!sys
:get-page-size
))
588 (start (+ space-start
(round (* space-size percent
) 100)))
589 (printed-conses (make-hash-table :test
'eq
))
593 (declare (type (unsigned-byte 32) last-page start
)
594 (fixnum pages-so-far count-so-far pagesize
))
595 (labels ((note-conses (x)
596 (unless (or (atom x
) (gethash x printed-conses
))
597 (setf (gethash x printed-conses
) t
)
598 (note-conses (car x
))
599 (note-conses (cdr x
)))))
600 (map-allocated-objects
601 (lambda (obj obj-type size
)
602 (declare (optimize (safety 0)))
603 (let ((addr (get-lisp-obj-address obj
)))
604 (when (>= addr start
)
606 (> count-so-far count
)
607 (> pages-so-far pages
))
608 (return-from print-allocated-objects
(values)))
611 (let ((this-page (* (the (values (unsigned-byte 32) t
)
612 (truncate addr pagesize
))
614 (declare (type (unsigned-byte 32) this-page
))
615 (when (/= this-page last-page
)
616 (when (< pages-so-far pages
)
617 ;; FIXME: What is this? (ERROR "Argh..")? or
618 ;; a warning? or code that can be removed
619 ;; once the system is stable? or what?
620 (format stream
"~2&**** Page ~W, address ~X:~%"
622 (setq last-page this-page
)
623 (incf pages-so-far
))))
625 (when (and (or (not type
) (eql obj-type type
))
626 (or (not smaller
) (<= size smaller
))
627 (or (not larger
) (>= size larger
)))
630 (#.code-header-widetag
631 (let ((dinfo (%code-debug-info obj
)))
632 (format stream
"~&Code object: ~S~%"
634 (sb!c
::compiled-debug-info-name dinfo
)
636 (#.symbol-header-widetag
637 (format stream
"~&~S~%" obj
))
638 (#.list-pointer-lowtag
639 (unless (gethash obj printed-conses
)
641 (let ((*print-circle
* t
)
644 (format stream
"~&~S~%" obj
))))
647 (let ((str (write-to-string obj
:level
5 :length
10
649 (unless (eql type instance-header-widetag
)
650 (format stream
"~S: " (type-of obj
)))
651 (format stream
"~A~%"
652 (subseq str
0 (min (length str
) 60))))))))))
656 ;;;; LIST-ALLOCATED-OBJECTS, LIST-REFERENCING-OBJECTS
658 (defvar *ignore-after
* nil
)
660 (defun maybe-cons (space x stuff
)
661 (if (or (not (eq space
:dynamic
))
662 (< (get-lisp-obj-address x
) (get-lisp-obj-address *ignore-after
*)))
666 (defun list-allocated-objects (space &key type larger smaller count
668 (declare (type spaces space
)
669 (type (or index null
) larger smaller type count
)
670 (type (or function null
) test
)
671 (inline map-allocated-objects
))
672 (unless *ignore-after
* (setq *ignore-after
* (cons 1 2)))
673 (collect ((counted 0 1+))
675 (map-allocated-objects
676 (lambda (obj obj-type size
)
677 (declare (optimize (safety 0)))
678 (when (and (or (not type
) (eql obj-type type
))
679 (or (not smaller
) (<= size smaller
))
680 (or (not larger
) (>= size larger
))
681 (or (not test
) (funcall test obj
)))
682 (setq res
(maybe-cons space obj res
))
683 (when (and count
(>= (counted) count
))
684 (return-from list-allocated-objects res
))))
688 (defun list-referencing-objects (space object
)
689 (declare (type spaces space
) (inline map-allocated-objects
))
690 (unless *ignore-after
* (setq *ignore-after
* (cons 1 2)))
693 (setq res
(maybe-cons space x res
))))
694 (map-allocated-objects
695 (lambda (obj obj-type size
)
696 (declare (optimize (safety 0)) (ignore obj-type size
))
699 (when (or (eq (car obj
) object
) (eq (cdr obj
) object
))
702 (dotimes (i (%instance-length obj
))
703 (when (eq (%instance-ref obj i
) object
)
707 (dotimes (i (length obj
))
708 (when (eq (svref obj i
) object
)
712 (when (or (eq (symbol-name obj
) object
)
713 (eq (symbol-package obj
) object
)
714 (eq (symbol-plist obj
) object
)
715 (eq (symbol-value obj
) object
))