(declaim (ftype (function ((or symbol cons)) (values fixnum t)) fun-signature))
(defun fun-signature (name)
(let ((type (info :function :type name)))
- (cond ((not (function-type-p type))
+ (cond ((not (fun-type-p type))
(values 0 t))
(t
- (values (length (function-type-required type))
- (or (function-type-optional type)
- (function-type-keyp type)
- (function-type-rest type)))))))
+ (values (length (fun-type-required type))
+ (or (fun-type-optional type)
+ (fun-type-keyp type)
+ (fun-type-rest type)))))))
|#
\f
;;;; global data structures
;;; We associate a PROFILE-INFO structure with each profiled function
;;; name. This holds the functions that we call to manipulate the
;;; closure which implements the encapsulation.
-(defvar *profiled-function-name->info* (make-hash-table))
+(defvar *profiled-fun-name->info* (make-hash-table))
(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)
- (read-stats-fun (required-argument) :type function :read-only t)
- (clear-stats-fun (required-argument) :type function :read-only t))
+ (name (missing-arg) :read-only t)
+ (encapsulated-fun (missing-arg) :type function :read-only t)
+ (encapsulation-fun (missing-arg) :type function :read-only t)
+ (read-stats-fun (missing-arg) :type function :read-only t)
+ (clear-stats-fun (missing-arg) :type function :read-only t))
;;; These variables are used to subtract out the time and consing for
;;; recursive and other dynamically nested profiled calls. The total
(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)
+ (call (missing-arg) :type single-float :read-only t)
;; the number of ticks that will be charged to a profiled
;; function due to the profiling code
- (internal (required-argument) :type single-float :read-only t)
+ (internal (missing-arg) :type single-float :read-only t)
;; the number of ticks of overhead for profiling that a single
;; profiled call adds to the total runtime for the program
- (total (required-argument) :type single-float :read-only t))
+ (total (missing-arg) :type single-float :read-only t))
(defvar *overhead*)
(declaim (type overhead *overhead*))
+(makunbound '*overhead*) ; in case we reload this file when tweaking
\f
;;;; profile encapsulations
(declare (type (or pcounter fixnum) count ticks consing profiles))
(values
;; ENCAPSULATION-FUN
- (lambda (sb-c:&more arg-context arg-count)
+ (lambda (&more arg-context arg-count)
(declare (optimize speed safety))
;; Make sure that we're not recursing infinitely.
(when (boundp '*computing-profiling-data-for*)
(*enclosed-ticks* 0)
(*enclosed-consing* 0)
(*enclosed-profiles* 0)
- (nbf-pcounter *n-bytes-freed-or-purified-pcounter*)
- ;; Typically NBF-PCOUNTER will represent a bignum.
- ;; In general we don't want to cons up a new bignum for every
- ;; encapsulated call, so instead we keep track of
- ;; the PCOUNTER internals, so that as long as we
- ;; only cons small amounts, we'll almost always
- ;; just do fixnum arithmetic. (And for encapsulated
- ;; functions which cons large amounts, then we don't
- ;; much care about a single extra consed bignum.)
- (start-consing-integer (pcounter-integer nbf-pcounter))
- (start-consing-fixnum (pcounter-fixnum nbf-pcounter)))
+ (nbf0 *n-bytes-freed-or-purified*)
+ (dynamic-usage-0 (sb-kernel:dynamic-usage)))
(declare (inline pcounter-or-fixnum->integer))
(multiple-value-prog1
(multiple-value-call encapsulated-fun
(sb-c:%more-arg-values arg-context
0
arg-count))
- (let ((*computing-profiling-data-for* encapsulated-fun))
+ (let ((*computing-profiling-data-for* encapsulated-fun)
+ (dynamic-usage-1 (sb-kernel:dynamic-usage)))
(setf dticks (fastbig- (get-internal-ticks) start-ticks))
(setf dconsing
- (if (eq (pcounter-integer nbf-pcounter)
- start-consing-integer)
- (- (pcounter-fixnum nbf-pcounter)
- start-consing-fixnum)
- (- (get-bytes-consed)
- (+ pcounter-integer pcounter-fixnum))))
+ (if (eql *n-bytes-freed-or-purified* nbf0)
+ ;; common special case where we can avoid
+ ;; bignum arithmetic
+ (- dynamic-usage-1 dynamic-usage-0)
+ ;; general case
+ (- (get-bytes-consed) nbf0 dynamic-usage-0)))
(setf inner-enclosed-profiles
(pcounter-or-fixnum->integer *enclosed-profiles*))
(let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
;;; A symbol or (SETF FOO) list names a function, a string names all
;;; the functions named by symbols in the named package.
-(defun mapc-on-named-functions (function names)
+(defun mapc-on-named-funs (function names)
(dolist (name names)
(etypecase name
(symbol (funcall function name))
(list
;; We call this just for the side effect of checking that
;; NAME is a legal function name:
- (function-name-block-name name)
+ (fun-name-block-name name)
;; Then we map onto it.
(funcall function name))
(string (let ((package (find-undeleted-package-or-lose name)))
;;; Profile the named function, which should exist and not be profiled
;;; already.
-(defun profile-1-unprofiled-function (name)
- (declare #.*optimize-byte-compilation*)
+(defun profile-1-unprofiled-fun (name)
(let ((encapsulated-fun (fdefinition name)))
(multiple-value-bind (encapsulation-fun read-stats-fun clear-stats-fun)
(profile-encapsulation-lambdas encapsulated-fun)
(setf (fdefinition name)
encapsulation-fun)
- (setf (gethash name *profiled-function-name->info*)
+ (setf (gethash name *profiled-fun-name->info*)
(make-profile-info :name name
:encapsulated-fun encapsulated-fun
:encapsulation-fun encapsulation-fun
(values))))
;;; Profile the named function. If already profiled, unprofile first.
-(defun profile-1-function (name)
- (declare #.*optimize-byte-compilation*)
+(defun profile-1-fun (name)
(cond ((fboundp name)
- (when (gethash name *profiled-function-name->info*)
+ (when (gethash name *profiled-fun-name->info*)
(warn "~S is already profiled, so unprofiling it first." name)
- (unprofile-1-function name))
- (profile-1-unprofiled-function name))
+ (unprofile-1-fun name))
+ (profile-1-unprofiled-fun name))
(t
(warn "ignoring undefined function ~S" name)))
(values))
;;; 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*)))
+(defun unprofile-1-fun (name)
+ (let ((pinfo (gethash name *profiled-fun-name->info*)))
(cond (pinfo
- (remhash name *profiled-function-name->info*)
+ (remhash name *profiled-fun-name->info*)
(if (eq (fdefinition name) (profile-info-encapsulation-fun pinfo))
(setf (fdefinition name) (profile-info-encapsulated-fun pinfo))
(warn "preserving current definition of redefined function ~S"
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*
+ `(loop for k being each hash-key in *profiled-fun-name->info*
collecting k)
- `(mapc-on-named-functions #'profile-1-function ',names)))
+ `(mapc-on-named-funs #'profile-1-fun ',names)))
(defmacro unprofile (&rest names)
#+sb-doc
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)
+ `(mapc-on-named-funs #'unprofile-1-fun ',names)
`(unprofile-all)))
(defun unprofile-all ()
- (declare #.*optimize-byte-compilation*)
- (dohash (name profile-info *profiled-function-name->info*)
+ (dohash (name profile-info *profiled-fun-name->info*)
(declare (ignore profile-info))
- (unprofile-1-function name)))
+ (unprofile-1-fun name)))
(defun reset ()
"Reset the counters for all profiled functions."
- (dohash (name profile-info *profiled-function-name->info*)
+ (dohash (name profile-info *profiled-fun-name->info*)
(declare (ignore name))
(funcall (profile-info-clear-stats-fun profile-info))))
\f
for profiling overhead. The compensation may be rather inaccurate when
bignums are involved in runtime calculation, as in a very-long-running
Lisp process."
- (declare #.*optimize-external-despite-byte-compilation*)
(unless (boundp '*overhead*)
(setf *overhead*
(compute-overhead)))
(let ((time-info-list ())
(no-call-name-list ()))
- (dohash (name pinfo *profiled-function-name->info*)
+ (dohash (name pinfo *profiled-fun-name->info*)
(unless (eq (fdefinition name)
(profile-info-encapsulation-fun pinfo))
(warn "Function ~S has been redefined, so times may be inaccurate.~@
"~%These functions were not called:~%~{~<~%~:; ~S~>~}~%"
(sort no-call-name-list #'string<
:key (lambda (name)
- (symbol-name (function-name-block-name name))))))
+ (symbol-name (fun-name-block-name name))))))
(values)))
\f
;;; that I (WHN) use for my own experimentation, but it might
;;; become supported someday. Comments?)
(declaim (type unsigned-byte *timer-overhead-iterations*))
-(defvar *timer-overhead-iterations*
+(defparameter *timer-overhead-iterations*
500000)
;;; a dummy function that we profile to find profiling overhead
(setf total-overhead
(- (frob) call-overhead)))
(let* ((pinfo (gethash 'compute-overhead-aux
- *profiled-function-name->info*))
+ *profiled-fun-name->info*))
(read-stats-fun (profile-info-read-stats-fun pinfo))
(time (nth-value 1 (funcall read-stats-fun))))
(setf internal-overhead
projects / sbcl.git / blobdiff