Profiling and garbage collecting

[Timothy.Freeman@theory.cs.cmu.edu]

James Reinders (James.reinders@sam.cs.cmu.edu) is trying to write some
code to measure which user-written routines consume time with Sun
Common Lisp version 2.1.0 Beta.  His code works, except that when a
garbage collection happens, the routine that was executing gets
charged with the time consumed by the garbage collection.  He wants to
be able to measure the time spent by the garbage collection so that
the routine that was executing is not charged for it.  

Neither James nor I can figure out a way to do this.  Does anyone have
any ideas?

One thing he tried is to redefine the function system:gc so
that it does some accounting and then calls the garbage collector.
This loses miserably.  Here is the code he tried:

;;; -*- Mode: Lisp; Package: System; Syntax: Common-lisp; Base: 10. -*-

(in-package 'system)

(defun new-gc ()
    (system::old-gc))

(in-package 'user)

(defun setup ()
   (set (intern "*GCTIME*" 'user) 0)
   (if (not (fboundp 'system::old-gc))
       (setf (symbol-function 'system::old-gc) (symbol-function 'system::gc)))
   (setf (symbol-function 'system::gc) (symbol-function 'system::new-gc)))

(defmacro cgc() `(compile-file "~reinders/gc1.slisp"))
(defmacro lgc() `(load "~reinders/gc1"))

(defun mucho-cons( &rest args )
    (append (cons (apply #'+ args) '(1 2 3 -5))))

(defvar stuff '(0))

(defun doit ()
  (loop
   (setf stuff (apply #'mucho-cons stuff))))

And here's what happened:

;;; Sun Common Lisp, Beta Version 2.1.0B,  6-Jan-87
> (load "~/gc1")
#P"/usr/reinders/gc1.2bin"
> (setup)
#<Compiled-Function SYSTEM::NEW-GC 37B15F>
> (doit)
;;; GC: 10264 words [41056 bytes] of dynamic storage in use.
;;; 906988 words [3627952 bytes] of free storage available before a GC.
;;; 1824240 words [7296960 bytes] of free storage available if GC is disabled.

WARNING: The stack overflowed and was increased by #x10000 bytes.

WARNING: A serious error has occurred in the garbage collector.
You will probably lose this session.

WARNING: The stack overflowed and was increased by #x10000 bytes.

WARNING: A serious error has occurred in the garbage collector.
You will probably lose this session.

(((( etc. - infinitely ))))