(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)
(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 a single extra consed
- ;; bignum tends to be proportionally negligible.)
- (nbf0-integer (pcounter-integer nbf-pcounter))
- (nbf0-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
(dynamic-usage-1 (sb-kernel:dynamic-usage)))
(setf dticks (fastbig- (get-internal-ticks) start-ticks))
(setf dconsing
- (if (and (eq (pcounter-integer nbf-pcounter)
- nbf0-integer)
- (eq (pcounter-fixnum nbf-pcounter)
- nbf0-fixnum))
+ (if (eql *n-bytes-freed-or-purified* nbf0)
;; common special case where we can avoid
;; bignum arithmetic
- (- dynamic-usage-1
- dynamic-usage-0)
+ (- dynamic-usage-1 dynamic-usage-0)
;; general case
- (- (get-bytes-consed)
- nbf0-integer
- nbf0-fixnum
- dynamic-usage-0)))
+ (- (get-bytes-consed) nbf0 dynamic-usage-0)))
(setf inner-enclosed-profiles
(pcounter-or-fixnum->integer *enclosed-profiles*))
(let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
(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*)
(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
;;; 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*)
+ (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 the named function, if it is profiled.
(defun unprofile-1-function (name)
- (declare #.*optimize-byte-compilation*)
- (let ((pinfo (gethash name *profiled-function-name->info*)))
+ (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)))
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*)
+ (dohash (name profile-info *profiled-fun-name->info*)
(declare (ignore profile-info))
(unprofile-1-function 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
(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