Following are two small hacks, WITH-FUNCTION-CALL-COUNT (counts how
often specified functions are called in a body of code), and BREAKON
(makes specified function do a BREAK at the beginning). There are plenty of
good serious metering facilities around; these are just two simple things I
had lying around. But perhaps some people will find them useful. You can
also get this by anonymous FTP from ftp.cs.umbc.edu (130.85.100.53),
in /pub/Memoization/Simple-Metering.lisp.
- Marty Hall
(proclaim '(inline skates))
============================== Cut Here ==============================
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: User; Base: 10 -*-
(in-package :User)
;;;===========================================================================
;;;===========================================================================
;;; Three simple tracing/metering utilities:
;;;
;;; With-Function-Call-Count: Takes list of function names and a body of code,
;;; ======================== and returns two values: (A) the normal return
;;; value of the body of code and (B) a list of the
;;; number of times the functions were called during
;;; the execution of the Body.
;;;
;;; Breakon: Takes a function name and changes the function to enter BREAK on
;;; ======= entry. Like SI:BREAKON on Symbolics.
;;;
;;; Unbreakon: Returns a function to state it was in before Breakon was called
;;; =========
;;;
;;; 3/93 Marty Hall. ยทยทยทยท@aplcenmp.apl.jhu.edu, (410) 792-6000 x3440
;;; No restrictions on use of any kind.
;;;===========================================================================
;;;===========================================================================
;;;===========================================================================
;;; Takes a list of function names and a body of code, and returns a list of
;;; the number of times the functions were called during the execution of the
;;; Body. See the doc string for more details. The UNWIND-PROTECT is to make
;;; sure the call-count gets reset even if the Body of code crashes. Also,
;;; this works for either regular or generic functions, but there is no way
;;; to specify that only one particular method of a generic function gets
;;; counted. Also (to risk stating the obvious), this will not work for
;;; counting macros or INLINEd functions. 3/93 Marty Hall.
(defmacro With-Function-Call-Count (Function-Name-List &body Body)
"Takes a list of function names and a body of code, and returns two values:
(A) the normal return value of the body of code and (B) a list of the
number of times the functions were called during the execution of the Body.
Eg:
(With-Function-Call-Count (Speed Latitude Longitude)
(Make-Top-Level-Display)
(Make-MAD-Display))
returns (867 651 651) as the secondary value, indicating SPEED was called
867 times, and LATITUDE and LONGITUDE 651 times each during the execution
of the top-level and MAD displays."
(let ((Call-Count-Variable (gensym "CALL-COUNT-"))
(Return-Value (gensym "RETURN-VALUE-")))
`(let (,Call-Count-Variable ,Return-Value)
(unwind-protect
(progn
(mapc #'Make-Function-Countable ',Function-Name-List)
(setq ,Return-Value (progn ,@Body))
(setq ,Call-Count-Variable
(mapcar #'(lambda (Function-Name)
(get Function-Name :Call-Count))
',Function-Name-List))
(values ,Return-Value ,Call-Count-Variable) )
(mapc #'Make-Function-Uncountable ',Function-Name-List) ) )
))
;;;===========================================================================
;;; Changes a function from its normal version to one that counts how often it
;;; is called. Should only be used temporarily. Also note this won't work for
;;; recursive routines without the addition of Make-Function-Countable,
;;; because the internal calls go to the non-counting version.
(defun Countable-Function (Function-Name)
"Takes a function NAME and returns a function OBJECT that does what #'NAME
did, except also keeps track of the number of times it has been called"
(let ((Function (symbol-function Function-Name)))
(setf (get Function-Name :Call-Count) 0)
(setf (get Function-Name :Non-Counting-Function) Function)
#'(lambda (&rest Args)
(incf (the fixnum (get Function-Name :Call-Count)))
(apply Function Args)) ))
;;;===========================================================================
;;; Makes function countable. 3/93 Marty Hall
(defun Make-Function-Countable (Function-Name)
"Given a function name changes it into equivalent version that counts
function calls"
(setf (symbol-function Function-Name)
(Countable-Function Function-Name)) )
;;;===========================================================================
;;; Undoes the above.
(defun Make-Function-Uncountable (Function-Name)
"Returns the function to its original (non-counting) state"
(let ((Original (get Function-Name :Non-Counting-Function)))
(cond
(Original
(setf (symbol-function Function-Name) Original)
(remf (symbol-plist Function-Name) :Non-Counting-Function)
(remf (symbol-plist Function-Name) :Call-Count)
Original)
(t
(format nil "~%Function ~S wasn't countable to begin with: unchanged."
Function-Name)))
))
;;;===========================================================================
;;; Often useful to find when you want to find out why/where a certain
;;; function is being called. Ie you know FOO is being called, but want to see
;;; who is calling it. Put BREAKOn on FOO then do a backtrace. To risk
;;; stating the obvious, this will not work for macros or INLINEd functions.
;;; Idea from si:breakon on Symbolics. 9/93 Marty Hall
(defun Breakon (Function-Name)
"Given a function name changes it into an `equivalent' version that BREAKs
upon entry"
(setf (symbol-function Function-Name)
(Function-with-Break Function-Name)) )
;;;===========================================================================
;;; Internal routine that returns the new function that does the BREAK.
(defun Function-with-Break (Function-Name)
"Takes a function NAME and returns a function OBJECT that does what #'NAME
did, except that it enters BREAK at the beginning (allowing a backtrace or
examination of the local variables). Use BREAKON instead of calling this
directly."
(let ((Function (symbol-function Function-Name)))
(setf (get Function-Name :Non-Breaking-Function) Function)
#'(lambda (&rest Args)
(break "`Breakon' specified for function ~S." Function-Name)
(apply Function Args)) ))
;;;===========================================================================
;;; Undoes the above. 9/93 Marty Hall
(defun Unbreakon (Function-Name)
"Returns the function to its original (non-breaking) state"
(let ((Original (get Function-Name :Non-Breaking-Function)))
(cond
(Original
(setf (symbol-function Function-Name) Original)
(remf (symbol-plist Function-Name) :Non-Breaking-Function)
Original)
(t
(format nil "~%BREAKON wasn't set for function ~S: unchanged."
Function-Name)))
))
;;;===========================================================================