Changeset 13486


Ignore:
Timestamp:
Mar 5, 2010, 5:37:59 PM (9 years ago)
Author:
gz
Message:

Merge r13435,r13440,r13467 into trunk: heap-utilization tweaks

Location:
trunk/source
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source

  • trunk/source/lib/misc.lisp

    r13462 r13486  
    896896                              (sort :size)
    897897                              (classes nil)
    898                               (start nil))
     898                              (start nil)
     899                              (threshold (and classes 0.00005)))
    899900  "Show statistics about types of objects in the heap.
    900901   If :GC-FIRST is true (the default), do a full gc before scanning the heap.
     
    908909   If :CLASSES is true, classifies by class rather than just typecode"
    909910  (let ((data (collect-heap-utilization :gc-first gc-first :start start :area area :classes classes)))
    910     (report-heap-utilization data :stream stream :unit unit :sort sort)))
     911    (report-heap-utilization data :stream stream :unit unit :sort sort :threshold threshold)))
    911912
    912913(defun collect-heap-utilization (&key (gc-first t) start area classes)
     
    10001001                          (class (class-of (if (eql typecode target::subtag-slot-vector)
    10011002                                             (uvref thing slot-vector.instance)
    1002                                              thing)))
     1003                                             (if (eql typecode target::subtag-function)
     1004                                               (function-vector-to-function thing)
     1005                                               thing))))
    10031006                          (index (or (gethash class map)
    10041007                                     (let ((count (hash-table-count map)))
     
    10351038                                 icount (aref inst-sizes index) (aref inst-psizes index)) data))
    10361039                   (when (plusp scount)
    1037                      (push (list (format nil "(SLOT-VECTOR ~s)" name)
     1040                     (push (list (format nil "~s slot vector" name)
    10381041                                 scount (aref slotv-sizes index) (aref slotv-psizes index)) data))))
    10391042               map)
     
    10831086
    10841087 
    1085 (defun report-heap-utilization (data &key stream unit sort)
     1088(defun report-heap-utilization (data &key stream unit sort threshold)
     1089  (check-type threshold (or null (real 0 1)))
    10861090  (let* ((div (ecase unit
    10871091                ((nil) 1)
     
    10971101         (total-lsize 0)
    10981102         (total-psize 0)
    1099          (max-name 0))
    1100     (loop for (name count lsize psize) in data
    1101       do (incf total-count count)
    1102       do (incf total-lsize lsize)
    1103       do (incf total-psize psize)
    1104       do (setq max-name (max max-name
    1105                              (length (if (stringp name)
    1106                                        name
    1107                                        (if (symbolp name)
    1108                                          (symbol-name name)
    1109                                          (princ-to-string name)))))))
    1110     (setq data
    1111           (if sort-key
    1112             (sort data #'> :key sort-key)
    1113             (sort data #'string-lessp :key #'(lambda (name)
    1114                                                (if (stringp name)
    1115                                                  name
    1116                                                  (if (symbolp name)
    1117                                                    (symbol-name name)
    1118                                                    (princ-to-string name)))))))
    1119                                                    
    1120     (format stream "~&Object type~vtCount     Logical size   Physical size   % of Heap~%~vt ~a~vt ~2:*~a"
    1121             (+ max-name 7)
    1122             (+ max-name 15)
    1123             (ecase unit
    1124               ((nil) "  (in bytes)")
    1125               (:kb   "(in kilobytes)")
    1126               (:mb   "(in megabytes)")
    1127               (:gb   "(in gigabytes)"))
    1128             (+ max-name 31))
    1129     (loop for (type count logsize physsize) in data
    1130       do (if unit
    1131            (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
    1132                    type
    1133                    (1+ max-name)
    1134                    count
    1135                    (/ logsize div)
    1136                    (/ physsize div)
    1137                    (* 100.0 (/ physsize total-psize)))
    1138            (format stream "~&~a~vt~11d~16d~16d~11,2f%"
    1139                    type
    1140                    (1+ max-name)
    1141                    count
    1142                    logsize
    1143                    physsize
    1144                    (* 100.0 (/ physsize total-psize)))))
    1145     (if unit
    1146       (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
    1147               "Total"
    1148               (1+ max-name)
    1149               total-count
    1150               (/ total-lsize div)
    1151               (/ total-psize div)
    1152               100.0d0)
    1153       (format stream "~&~a~vt~11d~16d~16d~11,2f%"
    1154               "Total"
    1155               (1+ max-name)
    1156               total-count
    1157               total-lsize
    1158               total-psize
    1159               100.0d0)))
     1103         (max-name 0)
     1104         (others (list "All others" 0 0 0)))
     1105
     1106    (when (hash-table-p data)
     1107      (setq data
     1108            (let ((alist nil))
     1109              (maphash (lambda (type measures) (push (cons type measures) alist)) data)
     1110              alist)))
     1111
     1112    (flet ((type-string (name)
     1113             (if (stringp name)
     1114               name
     1115               (if (symbolp name)
     1116                 (symbol-name name)
     1117                 (princ-to-string name)))))
     1118      (loop for (nil count lsize psize) in data
     1119            do (incf total-count count)
     1120            do (incf total-lsize lsize)
     1121            do (incf total-psize psize))
     1122
     1123      (when (and data threshold)
     1124        (setq data (sort data #'< :key #'cadddr))
     1125        (loop while (< (/ (cadddr (car data)) total-psize) threshold)
     1126              do (destructuring-bind (type count lsize psize) (pop data)
     1127                   (declare (ignore type))
     1128                   (incf (cadr others) count)
     1129                   (incf (caddr others) lsize)
     1130                   (incf (cadddr others) psize))))
     1131
     1132      (setq data
     1133            (if sort-key
     1134              (sort data #'> :key sort-key)
     1135              (sort data #'string-lessp :key #'(lambda (s) (type-string (car s))))))
     1136
     1137      (when (> (cadr others) 0)
     1138        (setq data (nconc data (list others))))
     1139
     1140      (setq max-name (loop for (name) in data maximize (length (type-string name))))
     1141
     1142      (format stream "~&Object type~vtCount     Logical size   Physical size   % of Heap~%~vt ~a~vt ~2:*~a"
     1143              (+ max-name 7)
     1144              (+ max-name 15)
     1145              (ecase unit
     1146                ((nil) "  (in bytes)")
     1147                (:kb   "(in kilobytes)")
     1148                (:mb   "(in megabytes)")
     1149                (:gb   "(in gigabytes)"))
     1150              (+ max-name 31))
     1151      (loop for (type count logsize physsize) in data
     1152            do (if unit
     1153                 (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
     1154                         (type-string type)
     1155                         (1+ max-name)
     1156                         count
     1157                         (/ logsize div)
     1158                         (/ physsize div)
     1159                         (* 100.0 (/ physsize total-psize)))
     1160                 (format stream "~&~a~vt~11d~16d~16d~11,2f%"
     1161                         (type-string type)
     1162                         (1+ max-name)
     1163                         count
     1164                         logsize
     1165                         physsize
     1166                         (* 100.0 (/ physsize total-psize)))))
     1167      (if unit
     1168        (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
     1169                "Total"
     1170                (1+ max-name)
     1171                total-count
     1172                (/ total-lsize div)
     1173                (/ total-psize div)
     1174                100.0d0)
     1175        (format stream "~&~a~vt~11d~16d~16d~11,2f%"
     1176                "Total"
     1177                (1+ max-name)
     1178                total-count
     1179                total-lsize
     1180                total-psize
     1181                100.0d0))))
    11601182  (values))
    11611183
Note: See TracChangeset for help on using the changeset viewer.