Changeset 13492

Timestamp:

Mar 8, 2010, 9:06:05 AM (15 years ago)

Author:

gz

Message:

get rid of open-core-graph, make it so can just use open-core

File:

• branches/working-0711/ccl/library/dominance.lisp (modified) (4 diffs)

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

@@ -20 +20 @@
 ;(setq *print-simple-bit-vector* nil)
 
-(export '(open-core-graph idom-heap-utilization))
+(export '(idom-heap-utilization))
 
 #|
-(setq cg (open-core-graph  "home:core.28209"))
+(open-core "home:core.28209")
 (idom-heap-utilization :unit nil :sort :size)
 |#
@@ -34 +34 @@
   (heap-base 0 :type fixnum)
   (heap-end 0 :type fixnum)
-  (stage nil) ;; indication of what has been computed, and what hasn't so can restart.
-  (head-p (make-array 0 :element-type 'bit) :type simple-bit-vector)
-  (ptrs-p (make-array 0 :element-type 'bit) :type simple-bit-vector)
+  (stage nil) ;; indication of what has been computed and what hasn't, so can restart.
+  (head-p #.(make-array 0 :element-type 'bit) :type simple-bit-vector)
+  (ptrs-p #.(make-array 0 :element-type 'bit) :type simple-bit-vector)
   ;; Nodes after eliminating single-entry and leaf objects
   (nodes #() :type simple-vector) ;; map postorder-idx -> dnode
@@ -49 +49 @@
   )
 
+(setq *core-info-class* 'core-graph)
+
+
 (defun open-core-graph (pathname &key image)
   (let ((cg (%cons-cg)))
     (open-core pathname :core-info cg :image image)
-    (let ((area-ptr (core-q (kernel-global-address 'tenured-area))))
-      (setf (cg.heap-base cg) (core-q area-ptr target::area.low))
-      (setf (cg.heap-end cg) (core-q area-ptr target::area.active)))
     cg))
 
@@ -62 +62 @@
   (assert (memq stage *cg-stages*))
   (check-type cg core-graph)
+  (when (eql (cg.heap-base cg) 0)
+    (let ((area-ptr (core-q (kernel-global-address 'tenured-area))))
+      (setf (cg.heap-base cg) (core-q area-ptr target::area.low))
+      (setf (cg.heap-end cg) (core-q area-ptr target::area.active))))
   ;; ensure have all the prereqs
   (loop for undone = (cdr (memq (cg.stage cg) *cg-stages*))