Changeset 13490


Ignore:
Timestamp:
Mar 8, 2010, 4:28:19 PM (10 years ago)
Author:
gz
Message:

Add idom-frontier-heap-utilization

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/library/dominance.lisp

    r13465 r13490  
    4444  (node-doms #() :type simple-vector) ;; postorder-idx of node -> postorder-idx of its immediate dominator
    4545  (idoms #() :type simple-vector) ;; sequence of postorder indices of immediate dominators
     46  (revidoms #() :type simple-vector) ;; map dnode -> index in idoms
    4647  (logsizes #() :type simple-vector) ;; corresponding sequence of logical sizes (including all owned objects)
    4748  (physizes #() :type simple-vector) ;; corresponding sequence of physical sizes (including all owned objects)
     
    393394            while (> changed 0)))
    394395    (setf (cg.node-doms cg) doms)
     396    (setf (cg.idoms cg) (sort (delete root-idx (remove-duplicates doms)) #'<))
     397    (let ((nodes (cg.nodes cg)))
     398      (setf (cg.revidoms cg) (make-rev-map (cg.idoms cg) (lambda (ni) (aref nodes ni)))))
    395399    cg))
    396400
    397401(defmethod cg-compute ((stage (eql :idom-sizes)) &aux (cg (current-core)))
    398402  (let* ((nodes (cg.nodes cg))
    399          (pseudo-root (length nodes))
    400          (idom-nodes (sort (delete pseudo-root (remove-duplicates (cg.node-doms cg))) #'<))
    401          (idom-revnodes (make-rev-map idom-nodes (lambda (ni) (aref nodes ni))))
     403         (idom-nodes (cg.idoms cg))
     404         (idom-revnodes (cg.revidoms cg))
    402405         (seen (make-array (length (cg.head-p cg)) :element-type 'bit :initial-element 0))
    403406         (base (cg.heap-base cg))
     
    407410         (physizes (make-array nidoms)))
    408411    ;; Any object that's not an idom is only reachable by one idom,
    409     ;; so don't need to reinit SEEN bits between calls.
     412    ;; so don't need to reinit SEEN bits between iterations.
    410413    (setf (cg.idoms cg) idom-nodes)
    411414    (loop for i from 0 below nidoms as idom = (aref idom-nodes i)
     
    430433    cg))
    431434
    432 (defun idom-heap-utilization (&key unit (sort :size) (threshold 0.01) (area :tenured))
     435(defun idom-set-heap-range (area)
    433436  (check-type area (member :tenured :dynamic))
    434437  (multiple-value-bind (base end)
     
    450453        (setf (cg.stage cg) nil)
    451454        (setf (cg.heap-base cg) base)
    452         (setf (cg.heap-end cg) end))))
     455        (setf (cg.heap-end cg) end)))))
     456 
     457
     458(defun report-idom-heap-utilization (type-infos &key unit sort threshold)
     459  (let ((data  (loop for type being the hash-key of type-infos using (hash-value info)
     460                     collect (cons (core-type-string type) info))))
     461    (report-heap-utilization data :unit unit :sort sort :stream *standard-output* :threshold threshold)))
     462
     463(defun idom-heap-utilization (&key unit (sort :size) (threshold 0.01) (area :tenured))
     464  (idom-set-heap-range area)
    453465  (cg-compute t)
    454466  (loop with cg = (current-core)
     
    464476        do (incf (cadr info) logsz)
    465477        do (incf (caddr info) physz)
    466         finally (let ((data  (loop for type being the hash-key of type-infos using (hash-value info)
    467                                    collect (cons (core-type-string type) info))))
    468                   (report-heap-utilization data :unit unit :sort sort :stream *standard-output* :threshold threshold))))
    469 
     478        finally (report-idom-heap-utilization type-infos :unit unit :sort sort :threshold threshold)))
     479
     480(defun idom-frontier-heap-utilization (&key unit (sort :size) (threshold 0.01) (area :tenured) (test nil))
     481  ;; Compute the heap utilization WITHIN selected idom trees, aggregated.
     482  (idom-set-heap-range area)
     483  (cg-compute :idoms)
     484  (let* ((cg (current-core))
     485         (nodes (cg.nodes cg))
     486         (idom-nodes (cg.idoms cg))
     487         (idom-revnodes (cg.revidoms cg))
     488         (seen (make-array (length (cg.head-p cg)) :element-type 'bit :initial-element 0))
     489         (base (cg.heap-base cg))
     490         (high (cg.heap-end cg))
     491         (nidoms (length idom-nodes))
     492         (type-infos (make-hash-table :test 'eql)))
     493    (flet ((record (ptr)
     494             (multiple-value-bind (logsize physsize) (core-object-sizes ptr)
     495               (let* ((type (core-object-type-key ptr))
     496                      (info (or (gethash type type-infos) (setf (gethash type type-infos) (list 0 0 0)))))
     497                 (incf (car info))
     498                 (incf (cadr info) logsize)
     499                 (incf (caddr info) physsize)))))
     500      (loop for i from 0 below nidoms as idom = (aref idom-nodes i)
     501            do (let* ((dn (aref nodes idom))
     502                      (addr (addr base dn))
     503                      (ptr (tagged-ptr addr)))
     504                 (when (or (null test) (funcall test ptr))
     505                   ;; Ok, idom of interest.  Walk its subgraph
     506                   (record ptr)
     507                   (do-pointers (next addr)
     508                     (when (and (<= base next) (< next high))
     509                       (let ((next-dn (dnode base next)))
     510                         (unless (or (index-for-dnode idom-revnodes next-dn)
     511                                     (eql (aref seen next-dn) 1))
     512                           (setf (aref seen next-dn) 1)
     513                           (record next)
     514                           (descend-pointers next)))))))
     515            finally (report-idom-heap-utilization type-infos :unit unit :sort sort :threshold threshold)))))
Note: See TracChangeset for help on using the changeset viewer.