Re: mcl cons monitoring support?

["Mark A. Tapia" <markt@dgp.toronto.edu>]

I've made changes to the consing monitoring in Mark Kantorwitz's monitor package
to support MCL2.0f3 (the summer release). The new version contains
ephemeral garbage collection and routines for determining the number
of garbage collections (gccounts) and the amount of time spent in garbage
collection (gctime).

Here is the file for consing under mcl2.0b1p3 (I don't remember where
the source came from):

;;; ****************************************************************
;;; get-consing.lisp ***********************************************
;;; ****************************************************************

;;; based on ccl memory-usage.lisp
(in-package :ccl :use 'ccl)
(export '(get-consing reset-consing) 'ccl)

(defvar *bytes-consed-chkpt* 0)

(eval-when (eval compile)
  (defconstant $currentA5 #x904)
  (defconstant $pagecounts #x-18e)
  (defconstant $lstFP #x-a42)
  (defconstant $consfirstob 64)
  (defconstant $pagesize 4096))

(let ((old-gc (symbol-function 'gc))
      (ccl:*warn-if-redefine-kernel* nil))
  (setf (symbol-function 'gc)
        #'(lambda ()
            (let ((old-consing (total-bytes-consed)))
              (prog1
                (funcall old-gc)
                (incf *bytes-consed-chkpt* (- old-consing (total-bytes-consed)))
                )))))

(defun total-bytes-consed (&aux pages fp)
  "Returns number of conses (8 bytes each)"
  (let* ((a5 (ccl::%get-ptr $currentA5))
         (ptr (ccl::%inc-ptr a5 $pagecounts)))
    (ccl::%ilsr 3 (ccl::%i+ (ccl::%i- (ccl::%ilsl 12 (ccl::%i- (setq pages (ccl::%get-word ptr 0)) 1))
                       (ccl::%i* pages $consfirstob))
                  (if (eq 0 (setq fp (ccl::%get-long a5 $lstFP)))
                    $pagesize
                    (ccl::%ilogand2  #xfff fp))))))

(defun get-consing ()
  (+ (total-bytes-consed) *bytes-consed-chkpt*))
;; My added function to reset the information
(defun reset-consing ()
  (setq *bytes-consed-chkpt* 0))

-----> end of version for b1p3

Here's the version for f3:

;;; ****************************************************************
;;; get-consing.lisp ***********************************************
;;; ****************************************************************

;;; based on ccl memory-usage.lisp
(in-package ccl)
(export '(get-consing reset-consing) 'ccl)

(defvar *bytes-consed-chkpt* 0)

(let ((old-gc (symbol-function 'gc))
      (ccl:*warn-if-redefine-kernel* nil))
  (setf (symbol-function 'gc)
        #'(lambda ()
            (let ((old-consing (total-bytes-consed)))
              (prog1
                (funcall old-gc)
                (incf *bytes-consed-chkpt* (- (total-bytes-consed) old-consing ))
                )))))

(defun total-bytes-consed (&aux pages fp)
  (total-bytes-allocated))
(defun get-consing ()
  (+ (total-bytes-consed) *bytes-consed-chkpt*))
;; My added function to reset the information
(defun reset-consing ()
  (setq *bytes-consed-chkpt* 0))