Changeset 7486 for branches/working-0710


Ignore:
Timestamp:
Oct 21, 2007, 12:56:35 AM (12 years ago)
Author:
gb
Message:

Add a first cut of HEAP-UTILIZATION; will eventually need PPC versions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/lib/misc.lisp

    r7278 r7486  
    712712            (when (and line (parse-integer line :junk-allowed t) )
    713713              (return-from local-svn-revision line)))))))))
     714
     715
     716;;; Scan the heap, collecting infomation on the primitive object types
     717;;; found.  Report that information.
     718
     719(defun heap-utilization (&key (stream *debug-io*)
     720                              (gc-first t))
     721  (let* ((nconses 0)
     722         (nvectors (make-array 256))
     723         (vector-sizes (make-array 256))
     724         (array-size-function (arch::target-array-data-size-function
     725                               (backend-target-arch *host-backend*))))
     726    (declare (type (simple-vector 256) nvectors vector-sizes)
     727             (dynamic-extent nvectors vector-sizes))
     728    (when gc-first (gc))
     729    (%map-areas (lambda (thing)
     730                  (if (consp thing)
     731                    (incf nconses)
     732                    (let* ((typecode (typecode thing)))
     733                      (incf (aref nvectors typecode))
     734                      (incf (aref vector-sizes typecode)
     735                            (funcall array-size-function typecode (uvsize thing)))))))
     736    (report-heap-utilization stream nconses nvectors vector-sizes)
     737    (values)))
     738
     739#+x8664-target
     740(progn
     741  (defvar *x8664-vector-type-names*
     742    (let* ((a (make-array 256)))
     743      (dotimes (i 256 a)
     744        (let* ((fulltag (logand i x8664::fulltagmask))
     745               (names-vector
     746                (cond ((= fulltag x8664::fulltag-nodeheader-0)
     747                       *nodeheader-0-types*)
     748                      ((= fulltag x8664::fulltag-nodeheader-1)
     749                       *nodeheader-1-types*)
     750                      ((= fulltag x8664::fulltag-immheader-0)
     751                       *immheader-0-types*)
     752                      ((= fulltag x8664::fulltag-immheader-1)
     753                       *immheader-1-types*)
     754                      ((= fulltag x8664::fulltag-immheader-2)
     755                       *immheader-2-types*)))
     756               (name (if names-vector
     757                       (aref names-vector (ash i -4)))))
     758          ;; Special-case a few things ...
     759          (if (eq name 'symbol-vector)
     760            (setq name 'symbol)
     761            (if (eq name 'function-vector)
     762              (setq name 'function)))
     763          (setf (aref a i) name)))))
     764       
     765   
     766(defun report-heap-utilization (out nconses nvectors vector-sizes)
     767  (format out "~&Object type~42tCount~50tTotal Size in Bytes")
     768  (format out "~&CONS~36t~12d~48t~16d" nconses (* nconses target::cons.size))
     769  (dotimes (i (length nvectors))
     770    (let* ((count (aref nvectors i))
     771           (sizes (aref vector-sizes i)))
     772      (unless (zerop count)
     773        (format out "~&~a~36t~12d~48t~16d" (aref *x8664-vector-type-names* i)  count sizes)))))
     774                           
     775)
     776
     777#-x8664-target
     778(eval-when (:compile-toplevel)
     779  (warn "Need PPC versions of REPORT-HEAP-UTILIZATION"))
     780
Note: See TracChangeset for help on using the changeset viewer.