(kind (required-argument)
:type (member :lowtag :fixed :header :vector
:string :code :closure :instance))
- ;; Length if fixed-length, shift amount for element size if :vector.
+ ;; Length if fixed-length, shift amount for element size if :VECTOR.
(length nil :type (or fixnum null))))
(eval-when (:compile-toplevel :execute)
(setq current (sap+ current size))))
((eql header-type closure-header-type)
(let* ((obj (make-lisp-obj (logior (sap-int current)
- function-pointer-type)))
+ fun-pointer-type)))
(size (round-to-dualword
(* (the fixnum (1+ (get-closure-length obj)))
word-bytes))))
(* (+ (%instance-length obj) 1) word-bytes))))
(declare (fixnum size))
(funcall fun obj header-type size)
- (assert (zerop (logand size lowtag-mask)))
+ (aver (zerop (logand size lowtag-mask)))
#+nil
(when (> size 200000) (break "implausible size, prev ~S" prev))
#+nil
(logior (sap-int current) other-pointer-type)))
(size (ecase (room-info-kind info)
(:fixed
- (assert (or (eql (room-info-length info)
+ (aver (or (eql (room-info-length info)
(1+ (get-header-data obj)))
(floatp obj)))
(round-to-dualword
word-bytes)))))))
(declare (fixnum size))
(funcall fun obj header-type size)
- (assert (zerop (logand size lowtag-mask)))
+ (aver (zerop (logand size lowtag-mask)))
#+nil
(when (> size 200000)
(break "Implausible size, prev ~S" prev))
(setq prev current)
(setq current (sap+ current size))))))
(unless (sap< current end)
- (assert (sap= current end))
+ (aver (sap= current end))
(return)))
#+nil
(format t " ~10:D bytes for ~9:D ~(~A~) object~2:*~P (space total.)~%"
total-bytes total-objects (car space-total))))
+;;; Print information about the heap memory in use. PRINT-SPACES is a
+;;; list of the spaces to print detailed information for.
+;;; COUNT-SPACES is a list of the spaces to scan. For either one, T
+;;; means all spaces (i.e. :STATIC, :DYNAMIC and :READ-ONLY.) If
+;;; PRINT-SUMMARY is true, then summary information will be printed.
+;;; The defaults print only summary information for dynamic space. If
+;;; true, CUTOFF is a fraction of the usage in a report below which
+;;; types will be combined as OTHER.
(defun memory-usage (&key print-spaces (count-spaces '(:dynamic))
(print-summary t) cutoff)
- #!+sb-doc
- "Print out information about the heap memory in use. :Print-Spaces is a list
- of the spaces to print detailed information for. :Count-Spaces is a list of
- the spaces to scan. For either one, T means all spaces (:Static, :Dyanmic
- and :Read-Only.) If :Print-Summary is true, then summary information will be
- printed. The defaults print only summary information for dynamic space.
- If true, Cutoff is a fraction of the usage in a report below which types will
- be combined as OTHER."
(declare (type (or single-float null) cutoff))
(let* ((spaces (if (eq count-spaces t)
'(:static :dynamic :read-only)
(values))
\f
+;;; Print info about how much code and no-ops there are in SPACE.
(defun count-no-ops (space)
- #!+sb-doc
- "Print info about how much code and no-ops there are in Space."
(declare (type spaces space))
(let ((code-words 0)
(no-ops 0)
non-descriptor-bytes non-descriptor-headers)
(values)))
\f
+;;; Print a breakdown by instance type of all the instances allocated
+;;; in SPACE. If TOP-N is true, print only information for the the
+;;; TOP-N types with largest usage.
(defun instance-usage (space &key (top-n 15))
(declare (type spaces space) (type (or fixnum null) top-n))
- #!+sb-doc
- "Print a breakdown by instance type of all the instances allocated in
- Space. If TOP-N is true, print only information for the the TOP-N types with
- largest usage."
(format t "~2&~@[Top ~D ~]~(~A~) instance types:~%" top-n space)
(let ((totals (make-hash-table :test 'eq))
(total-objects 0)
(let ((residual-objects (- total-objects printed-objects))
(residual-bytes (- total-bytes printed-bytes)))
(unless (zerop residual-objects)
- (format t " Other types: ~:D bytes, ~D: object~:P.~%"
+ (format t " Other types: ~:D bytes, ~D object~:P.~%"
residual-bytes residual-objects))))
(format t " ~:(~A~) instance total: ~:D bytes, ~:D object~:P.~%"
(return-from print-allocated-objects (values)))
(unless count
- (let ((this-page (* (the (unsigned-byte 32)
- (truncate addr pagesize))
+ (let ((this-page (* (the (values (unsigned-byte 32) t)
+ (truncate addr pagesize))
pagesize)))
(declare (type (unsigned-byte 32) this-page))
(when (/= this-page last-page)
(when (< pages-so-far pages)
+ ;; FIXME: What is this? (ERROR "Argh..")? or
+ ;; a warning? or code that can be removed
+ ;; once the system is stable? or what?
(format stream "~2&**** Page ~D, address ~X:~%"
pages-so-far addr))
(setq last-page this-page)
projects / sbcl.git / blobdiff