Changeset 7652 for branches

Timestamp:

Nov 15, 2007, 4:21:12 PM (17 years ago)

Author:

Gary Byers

Message:

Implement REPORT-HEAP-UTILIZATION for PPC, too.

File:

• branches/working-0711/ccl/lib/misc.lisp (modified) (2 diffs)

branches/working-0711/ccl/lib/misc.lisp

@@ -737 +737 @@
     (values)))
 
-#+x8664-target
-(progn
-  (defvar *x8664-vector-type-names*
-    (let* ((a (make-array 256)))
-      (dotimes (i 256 a)
-        (let* ((fulltag (logand i x8664::fulltagmask))
-               (names-vector
-                (cond ((= fulltag x8664::fulltag-nodeheader-0)
-                       *nodeheader-0-types*)
-                      ((= fulltag x8664::fulltag-nodeheader-1)
-                       *nodeheader-1-types*)
-                      ((= fulltag x8664::fulltag-immheader-0)
-                       *immheader-0-types*)
-                      ((= fulltag x8664::fulltag-immheader-1)
-                       *immheader-1-types*)
-                      ((= fulltag x8664::fulltag-immheader-2)
-                       *immheader-2-types*)))
-               (name (if names-vector
-                       (aref names-vector (ash i -4)))))
-          ;; Special-case a few things ...
-          (if (eq name 'symbol-vector)
-            (setq name 'symbol)
-            (if (eq name 'function-vector)
-              (setq name 'function)))
-          (setf (aref a i) name)))))
-        
+(defvar *heap-utilization-vector-type-names*
+  (let* ((a (make-array 256)))
+    #+x8664-target
+    (dotimes (i 256)
+      (let* ((fulltag (logand i x8664::fulltagmask))
+             (names-vector
+              (cond ((= fulltag x8664::fulltag-nodeheader-0)
+                     *nodeheader-0-types*)
+                    ((= fulltag x8664::fulltag-nodeheader-1)
+                     *nodeheader-1-types*)
+                    ((= fulltag x8664::fulltag-immheader-0)
+                     *immheader-0-types*)
+                    ((= fulltag x8664::fulltag-immheader-1)
+                     *immheader-1-types*)
+                    ((= fulltag x8664::fulltag-immheader-2)
+                     *immheader-2-types*)))
+             (name (if names-vector
+                     (aref names-vector (ash i -4)))))
+        ;; Special-case a few things ...
+        (if (eq name 'symbol-vector)
+          (setq name 'symbol)
+          (if (eq name 'function-vector)
+            (setq name 'function)))
+        (setf (aref a i) name)))
+    #+ppc64-target
+    (dotimes (i 256)
+      (let* ((lowtag (logand i ppc64::lowtagmask)))
+        (setf (%svref a i)
+              (cond ((= lowtag ppc64::lowtag-immheader)
+                     (%svref *immheader-types* (ash i -2)))
+                    ((= lowtag ppc64::lowtag-nodeheader)
+                     (%svref *nodeheader-types* (ash i -2)))))))
+    #+ppc32-target
+    (dotimes (i 256)
+      (let* ((fulltag (logand i ppc32::fulltagmask)))
+        (setf (%svref a i)
+              (cond ((= fulltag ppc32::fulltag-immheader)
+                     (%svref *immheader-types* (ash i -3)))
+                    ((= fulltag ppc32::fulltag-nodeheader)
+                     (%svref *nodeheader-types* (ash i -3)))))))
+    a))
+
+  
     
 (defun report-heap-utilization (out nconses nvectors vector-sizes)
@@ -771 +788 @@
            (sizes (aref vector-sizes i)))
       (unless (zerop count)
-        (format out "~&~a~36t~12d~48t~16d" (aref *x8664-vector-type-names* i)  count sizes)))))
+        (format out "~&~a~36t~12d~48t~16d" (aref *heap-utilization-vector-type-names* i)  count sizes)))))
                             
-)
-
-#-x8664-target
-(eval-when (:compile-toplevel)
-  (warn "Need PPC versions of REPORT-HEAP-UTILIZATION"))
-
+
+