/[cmucl]/src/code/room.lisp
ViewVC logotype

Diff of /src/code/room.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.39 by rtoy, Mon Apr 19 02:18:04 2010 UTC revision 1.40 by rtoy, Tue Apr 20 17:57:45 2010 UTC
# Line 491  Line 491 
491                       (summary-totals (cons sum v))))                       (summary-totals (cons sum v))))
492                 summary)                 summary)
493    
494        (format t _"~2&Summary of spaces: ~(~{~A ~}~)~%" spaces)        (format t (intl:gettext "~2&Summary of spaces: ~(~{~A ~}~)~%") spaces)
495        (let ((summary-total-bytes 0)        (let ((summary-total-bytes 0)
496              (summary-total-objects 0))              (summary-total-objects 0))
497          (declare (type memory-size summary-total-bytes summary-total-objects))          (declare (type memory-size summary-total-bytes summary-total-objects))
# Line 520  Line 520 
520                (format t ".~%")                (format t ".~%")
521                (incf summary-total-bytes total-bytes)                (incf summary-total-bytes total-bytes)
522                (incf summary-total-objects total-objects))))                (incf summary-total-objects total-objects))))
523          (format t _"~%Summary total:~%    ~:D bytes, ~:D objects.~%"          (format t (intl:gettext "~%Summary total:~%    ~:D bytes, ~:D objects.~%")
524                  summary-total-bytes summary-total-objects)))))                  summary-total-bytes summary-total-objects)))))
525    
526    
# Line 530  Line 530 
530  ;;;  ;;;
531  (defun report-space-total (space-total cutoff)  (defun report-space-total (space-total cutoff)
532    (declare (list space-total) (type (or single-float null) cutoff))    (declare (list space-total) (type (or single-float null) cutoff))
533    (format t _"~2&Breakdown for ~(~A~) space:~%" (car space-total))    (format t (intl:gettext "~2&Breakdown for ~(~A~) space:~%") (car space-total))
534    (let* ((types (cdr space-total))    (let* ((types (cdr space-total))
535           (total-bytes (reduce #'+ (mapcar #'first types)))           (total-bytes (reduce #'+ (mapcar #'first types)))
536           (total-objects (reduce #'+ (mapcar #'second types)))           (total-objects (reduce #'+ (mapcar #'second types)))
# Line 615  Line 615 
615       space)       space)
616    
617      (format t      (format t
618              _"~:D code-object bytes, ~:D code words, with ~:D no-ops (~D%).~%"              (intl:gettext "~:D code-object bytes, ~:D code words, with ~:D no-ops (~D%).~%")
619              total-bytes code-words no-ops              total-bytes code-words no-ops
620              (round (* no-ops 100) code-words)))              (round (* no-ops 100) code-words)))
621    
# Line 694  Line 694 
694                 #.scavenger-hook-type)                 #.scavenger-hook-type)
695                (incf descriptor-words (truncate size word-bytes)))                (incf descriptor-words (truncate size word-bytes)))
696               (t               (t
697                (error _"Bogus type: ~D" type))))                (error (intl:gettext "Bogus type: ~D") type))))
698         space))         space))
699      (format t _"~:D words allocated for descriptor objects.~%"      (format t (intl:gettext "~:D words allocated for descriptor objects.~%")
700              descriptor-words)              descriptor-words)
701      (format t _"~:D bytes data/~:D words header for non-descriptor objects.~%"      (format t (intl:gettext "~:D bytes data/~:D words header for non-descriptor objects.~%")
702              non-descriptor-bytes non-descriptor-headers)              non-descriptor-bytes non-descriptor-headers)
703      (values)))      (values)))
704    
# Line 710  Line 710 
710    "Print a breakdown by instance type of all the instances allocated in    "Print a breakdown by instance type of all the instances allocated in
711    Space.  If TOP-N is true, print only information for the the TOP-N types with    Space.  If TOP-N is true, print only information for the the TOP-N types with
712    largest usage."    largest usage."
713    (format t _"~2&~@[Top ~D ~]~(~A~) instance types:~%" top-n space)    (format t (intl:gettext "~2&~@[Top ~D ~]~(~A~) instance types:~%") top-n space)
714    (let ((totals (make-hash-table :test #'eq))    (let ((totals (make-hash-table :test #'eq))
715          (total-objects 0)          (total-objects 0)
716          (total-bytes 0))          (total-bytes 0))
# Line 774  Line 774 
774  ;;;  ;;;
775  (defun find-holes (&rest spaces)  (defun find-holes (&rest spaces)
776    (dolist (space (or spaces '(:read-only :static :dynamic)))    (dolist (space (or spaces '(:read-only :static :dynamic)))
777      (format t _"In ~A space:~%" space)      (format t (intl:gettext "In ~A space:~%") space)
778      (let ((start-addr nil)      (let ((start-addr nil)
779            (total-bytes 0))            (total-bytes 0))
780        (declare (type (or null (unsigned-byte 32)) start-addr)        (declare (type (or null (unsigned-byte 32)) start-addr)
# Line 791  Line 791 
791                     (setf start-addr (di::get-lisp-obj-address object)                     (setf start-addr (di::get-lisp-obj-address object)
792                           total-bytes bytes))                           total-bytes bytes))
793                 (when start-addr                 (when start-addr
794                   (format t _"~D bytes at #x~X~%" total-bytes start-addr)                   (format t (intl:gettext "~D bytes at #x~X~%") total-bytes start-addr)
795                   (setf start-addr nil))))                   (setf start-addr nil))))
796         space)         space)
797        (when start-addr        (when start-addr
798          (format t _"~D bytes at #x~X~%" total-bytes start-addr))))          (format t (intl:gettext "~D bytes at #x~X~%") total-bytes start-addr))))
799    (values))    (values))
800    
801    
# Line 988  Line 988 
988                                        (c::debug-source-name source)                                        (c::debug-source-name source)
989                                        "FROM LISP")))                                        "FROM LISP")))
990                                 (t                                 (t
991                                  (warn _"No source for ~S" obj)                                  (warn (intl:gettext "No source for ~S") obj)
992                                  "NO SOURCE")))                                  "NO SOURCE")))
993                         "UNKNOWN"))                         "UNKNOWN"))
994                    (file-info (or (gethash file pkg-info)                    (file-info (or (gethash file pkg-info)
# Line 1099  Line 1099 
1099    
1100          (let ((residual (- (total-val) printed)))          (let ((residual (- (total-val) printed)))
1101            (unless (zerop residual)            (unless (zerop residual)
1102              (format t _"~8:D: Other~%" residual))))              (format t (intl:gettext "~8:D: Other~%") residual))))
1103    
1104        (format t _"~8:D: Total~%" (total-val))))        (format t (intl:gettext "~8:D: Total~%") (total-val))))
1105    (values))    (values))
1106    
1107    

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.40

  ViewVC Help
Powered by ViewVC 1.1.5