/[gcl]/gcl/lsp/gcl_autoload.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_autoload.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by camm, Fri Oct 14 00:33:00 2005 UTC revision 1.14 by camm, Sat Nov 12 18:33:42 2005 UTC
# Line 240  Line 240 
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
# Line 285  Line 275 
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))
# Line 303  Line 292 
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"))

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26