;;; FIXME: It might make sense to replace this with something
;;; with finer resolution, e.g. milliseconds or microseconds.
+;;; For that matter, maybe we should boost the internal clock
+;;; up to something faster, like milliseconds.
(defconstant +ticks-per-second+ internal-time-units-per-second)
\f
;;;; PCOUNTER
-;;; a PCOUNTER is used to represent an integer quantity which can grow
-;;; bigger than a fixnum, but typically does so, if at all, in many
-;;; small steps, where we don't want to cons on every step. (Total
-;;; system consing, time spent in a profiled function, and bytes
-;;; consed in a profiled function are all examples of such
+;;; a PCOUNTER is used to represent an unsigned integer quantity which
+;;; can grow bigger than a fixnum, but typically does so, if at all,
+;;; in many small steps, where we don't want to cons on every step.
+;;; (Total system consing, time spent in a profiled function, and
+;;; bytes consed in a profiled function are all examples of such
;;; quantities.)
(defstruct (pcounter (:copier nil))
- (integer 0 :type integer)
- (fixnum 0 :type fixnum))
+ (integer 0 :type unsigned-byte)
+ (fixnum 0 :type (and fixnum unsigned-byte)))
(declaim (ftype (function (pcounter integer) pcounter) incf-pcounter))
-(declaim (inline incf-pcounter))
+;;;(declaim (inline incf-pcounter)) ; FIXME: maybe inline when more stable
(defun incf-pcounter (pcounter delta)
(let ((sum (+ (pcounter-fixnum pcounter) delta)))
(cond ((typep sum 'fixnum)
pcounter)
(declaim (ftype (function (pcounter) integer) pcounter->integer))
-(declaim (inline pcounter->integer))
+;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable
(defun pcounter->integer (pcounter)
(+ (pcounter-integer pcounter)
(pcounter-fixnum pcounter)))
;;;; FIXNUM overflows.
(declaim (ftype (function ((or pcounter fixnum) integer) (or pcounter fixnum)) %incf-pcounter-or-fixnum))
-(declaim (inline %incf-pcounter-or-fixnum))
+;;;(declaim (inline %incf-pcounter-or-fixnum)) ; FIXME: maybe inline when more stable
(defun %incf-pcounter-or-fixnum (x delta)
(etypecase x
(fixnum
;;; name. This holds the functions that we call to manipulate the
;;; closure which implements the encapsulation.
(defvar *profiled-function-name->info* (make-hash-table))
-(defstruct profile-info
+(defstruct (profile-info (:copier nil))
(name (required-argument) :read-only t)
(encapsulated-fun (required-argument) :type function :read-only t)
(encapsulation-fun (required-argument) :type function :read-only t)
(declaim (type (or pcounter fixnum) *enclosed-profiles*))
;;; the components of profiling overhead
-(defstruct overhead
+(defstruct (overhead (:copier nil))
;; the number of ticks a bare function call takes. This is
;; factored into the other overheads, but not used for itself.
(call (required-argument) :type single-float :read-only t)
;;; will minimize profiling overhead.)
(defun profile-encapsulation-lambdas (encapsulated-fun)
(declare (type function encapsulated-fun))
- (declare (optimize speed safety))
(let* ((count 0)
(ticks 0)
(consing 0)
(values
;; ENCAPSULATION-FUN
(lambda (sb-c:&more arg-context arg-count)
- #+nil (declare (optimize (speed 3) (safety 0))) ; FIXME: remove #+NIL?
+ (declare (optimize speed safety))
+ ;; FIXME: Probably when this is stable, we should optimize (SAFETY 0).
(fastbig-incf-pcounter-or-fixnum count 1)
(let ((dticks 0)
(dconsing 0)
consing 0
profiles 0)))))
\f
-;;; interfaces
+;;;; interfaces
;;; A symbol or (SETF FOO) list names a function, a string names all
;;; the functions named by symbols in the named package.
;;; Profile the named function, which should exist and not be profiled
;;; already.
(defun profile-1-unprofiled-function (name)
+ (declare #.*optimize-byte-compilation*)
(let ((encapsulated-fun (fdefinition name)))
(multiple-value-bind (encapsulation-fun read-stats-fun clear-stats-fun)
(profile-encapsulation-lambdas encapsulated-fun)
;;; Profile the named function. If already profiled, unprofile first.
(defun profile-1-function (name)
+ (declare #.*optimize-byte-compilation*)
(cond ((fboundp name)
(when (gethash name *profiled-function-name->info*)
(warn "~S is already profiled, so unprofiling it first." name)
;;; Unprofile the named function, if it is profiled.
(defun unprofile-1-function (name)
+ (declare #.*optimize-byte-compilation*)
(let ((pinfo (gethash name *profiled-function-name->info*)))
(cond (pinfo
(remhash name *profiled-function-name->info*)
(warn "preserving current definition of redefined function ~S"
name)))
(t
- (warn "~S is not a profiled function."))))
+ (warn "~S is not a profiled function." name))))
(values))
(defmacro profile (&rest names)
reprofile (useful to notice function redefinition.) If a name is
undefined, then we give a warning and ignore it. See also
UNPROFILE, REPORT and RESET."
+ (declare #.*optimize-byte-compilation*)
(if (null names)
`(loop for k being each hash-key in *profiled-function-name->info*
collecting k)
a function. A string names all the functions named by symbols in the
named package. NAMES defaults to the list of names of all currently
profiled functions."
+ (declare #.*optimize-byte-compilation*)
(if names
`(mapc-on-named-functions #'unprofile-1-function ',names)
`(unprofile-all)))
(defun unprofile-all ()
+ (declare #.*optimize-byte-compilation*)
(dohash (name profile-info *profiled-function-name->info*)
(declare (ignore profile-info))
(unprofile-1-function name)))
\f
;;;; reporting results
-(defstruct time-info
+(defstruct (time-info (:copier nil))
name
calls
seconds
the unadjusted results are reported. The compensation may be somewhat
inaccurate when bignums are involved in runtime calculation, as in
a very-long-running Lisp process."
- (declare (optimize (speed 0)))
+ (declare #.*optimize-external-despite-byte-compilation*)
(unless (boundp '*overhead*)
(setf *overhead*
(compute-overhead)))
projects / sbcl.git / blobdiff