Changeset 13460


Ignore:
Timestamp:
Feb 24, 2010, 5:05:35 PM (9 years ago)
Author:
gz
Message:

Add :area arg to idom-heap-utilization, can be :tenured or :dynamic

File:
1 edited

Legend:

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

    r13442 r13460  
    430430    cg))
    431431
    432 (defun idom-heap-utilization (&key unit (sort :size) (threshold 0.01))
     432(defun idom-heap-utilization (&key unit (sort :size) (threshold 0.01) (area :tenured))
     433  (check-type area (member :tenured :dynamic))
     434  (multiple-value-bind (base end)
     435      (cond ((eq area :tenured)
     436             (let ((area-ptr (core-q (kernel-global-address 'tenured-area))))
     437               (values (core-q area-ptr target::area.low)
     438                       (core-q area-ptr target::area.active))))
     439            ((eq area :dynamic)
     440             (let* ((newest (core-q (core-q (kernel-global-address 'all-areas)) target::area.succ))
     441                    (oldest (core-q (kernel-global-address 'tenured-area))))
     442               (assert (loop for this = newest then older as older = (core-q this target::area.succ)
     443                             until (eql this oldest)
     444                             always (eql (core-q this target::area.low) (core-q older target::area.active))))
     445               (values (core-q oldest target::area.low)
     446                       (core-q newest target::area.active)))))
     447    (let ((cg (current-core)))
     448      (unless (and (eq base (cg.heap-base cg))
     449                   (eq end (cg.heap-end cg)))
     450        (setf (cg.stage cg) nil)
     451        (setf (cg.heap-base cg) base)
     452        (setf (cg.heap-end cg) end))))
    433453  (cg-compute t)
    434454  (loop with cg = (current-core)
Note: See TracChangeset for help on using the changeset viewer.