240 |
;(defun allocated-relocatable-pages () |
;(defun allocated-relocatable-pages () |
241 |
; (si::nrbpage)) |
; (si::nrbpage)) |
242 |
|
|
|
;; FIXME This has to come straight from enum.h. CM 20050114 |
|
|
(defvar *type-list* |
|
|
'(cons |
|
|
fixnum bignum ratio short-float long-float complex |
|
|
character symbol package hash-table |
|
|
array vector string bit-vector |
|
|
structure stream random-state readtable pathname |
|
|
cfun cclosure sfun gfun vfun afun closure cfdata spice)) |
|
|
|
|
|
|
|
243 |
(defun heaprep nil |
(defun heaprep nil |
244 |
|
|
245 |
(let ((f (list |
(let ((f (list |
275 |
rbused (nth 7 l) rbfree (nth 8 l) nrbpage (nth 9 l) |
rbused (nth 7 l) rbfree (nth 8 l) nrbpage (nth 9 l) |
276 |
rbgbccount (nth 10 l) |
rbgbccount (nth 10 l) |
277 |
l (nthcdr 11 l)) |
l (nthcdr 11 l)) |
278 |
(do ((l l (nthcdr 6 l)) |
(do ((l l (nthcdr 7 l)) |
279 |
(tl *type-list* (cdr tl)) |
(i 0 (+ i (if (nth 3 l) (nth 3 l) 0)))) |
|
(i 0 (+ i (if (nth 2 l) (nth 2 l) 0)))) |
|
280 |
((null l) (setq npage i)) |
((null l) (setq npage i)) |
281 |
(let ((typename (car tl)) |
(let ((typename (intern (nth 0 l))) |
282 |
(nused (nth 0 l)) |
(nused (nth 1 l)) |
283 |
(nfree (nth 1 l)) |
(nfree (nth 2 l)) |
284 |
(npage (nth 2 l)) |
(npage (nth 3 l)) |
285 |
(maxpage (nth 3 l)) |
(maxpage (nth 4 l)) |
286 |
(gbccount (nth 4 l)) |
(gbccount (nth 5 l)) |
287 |
(ws (nth 5 l))) |
(ws (nth 6 l))) |
288 |
(if nused |
(if nused |
289 |
(push (list typename ws npage maxpage |
(push (list typename ws npage maxpage |
290 |
(if (zerop (+ nused nfree)) |
(if (zerop (+ nused nfree)) |
292 |
(/ nused 0.01 (+ nused nfree))) |
(/ nused 0.01 (+ nused nfree))) |
293 |
(if (zerop gbccount) nil gbccount)) |
(if (zerop gbccount) nil gbccount)) |
294 |
info-list) |
info-list) |
295 |
(let ((a (assoc (nth nfree *type-list*) link-alist))) |
(let* ((nfree (intern nfree)) |
296 |
|
(a (assoc nfree link-alist))) |
297 |
(if a |
(if a |
298 |
(nconc a (list typename)) |
(nconc a (list typename)) |
299 |
(push (list (nth nfree *type-list*) typename) |
(push (list nfree typename) |
300 |
link-alist)))))) |
link-alist)))))) |
301 |
(terpri) |
(terpri) |
302 |
(format t "~@[~2A~]~8@A/~A~14T~6@A%~@[~8@A~]~30T~{~A~^ ~}~%~%" "WS" "UP" "MP" "FI" "GC" '("TYPES")) |
(format t "~@[~2A~]~8@A/~A~14T~6@A%~@[~8@A~]~30T~{~A~^ ~}~%~%" "WS" "UP" "MP" "FI" "GC" '("TYPES")) |