Changeset 13460

Timestamp:

Feb 24, 2010, 9:05:35 AM (15 years ago)

Author:

gz

Message:

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

File:

• branches/working-0711/ccl/library/dominance.lisp (modified) (1 diff)

branches/working-0711/ccl/library/dominance.lisp

@@ -430 +430 @@
     cg))
 
-(defun idom-heap-utilization (&key unit (sort :size) (threshold 0.01))
+(defun idom-heap-utilization (&key unit (sort :size) (threshold 0.01) (area :tenured))
+  (check-type area (member :tenured :dynamic))
+  (multiple-value-bind (base end)
+      (cond ((eq area :tenured)
+             (let ((area-ptr (core-q (kernel-global-address 'tenured-area))))
+               (values (core-q area-ptr target::area.low)
+                       (core-q area-ptr target::area.active))))
+            ((eq area :dynamic)
+             (let* ((newest (core-q (core-q (kernel-global-address 'all-areas)) target::area.succ))
+                    (oldest (core-q (kernel-global-address 'tenured-area))))
+               (assert (loop for this = newest then older as older = (core-q this target::area.succ)
+                             until (eql this oldest)
+                             always (eql (core-q this target::area.low) (core-q older target::area.active))))
+               (values (core-q oldest target::area.low)
+                       (core-q newest target::area.active)))))
+    (let ((cg (current-core)))
+      (unless (and (eq base (cg.heap-base cg))
+                   (eq end (cg.heap-end cg)))
+        (setf (cg.stage cg) nil)
+        (setf (cg.heap-base cg) base)
+        (setf (cg.heap-end cg) end))))
   (cg-compute t)
   (loop with cg = (current-core)