; .EnTete "Le-Lisp (c) version 15.2" " " "Print GC Infos"
; .EnPied "prgcinfo.ll" "%" " "
;
; .Centre "$Header: prgcinfo.ll,v 1.1 89/01/04 19:12:46 chaillou Exp $"

; Print GC Infos in a more readable way than (GCINFO)

; CAUTION : (PRGCINFO) works only with 32bit pointers Le-Lisp


; Use : (PRGCINFO) prints in a readable form the actual sizes
; of the different types of objets present in memory.


(setq #:sys-package:colon 'prgcinfo)

(defvar :initial (gcinfo t))
(defvar :list-name '(cons symbol string vector float fix heap code))
(defvar :list-size '(10   12     14     16     18    20  22   24))
(defvar :list-freq '(1    2      3      4      5     6   7    ()))
(defvar :size-obj  '(8    32     8      8      0     0   1    1))


(defun prgcinfo ()
    (with ((outchan ()))
          (print "Used memory in byte :")
	  (let ((:total 0.)
		(:current (gcinfo)))
	       (mapc (lambda (name freq size sobj)
		       (let ((used (- (:intval (nth size :initial) sobj)
				      (:intval (nth size :current) sobj))))
			 (unless (or (= used 0) (= used 0.0))
				 (prin name " : ")
				 (outpos 10)
				 (prin (if (fixp freq)
					   (nth freq :current)
					   ()))
				 (outpos 14)
				 (print used)
				 (incr :total used))))
		     :list-name
		     :list-freq
		     :list-size
		     :size-obj)
	       (print "Total     =   " :total))))
		

(defun :intval (n sobj)
    (* sobj
       (if (consp n)
	   (* (car n) 1024)
	   n)))