X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=dbdc65e77263c321b50a0a2d569049de4c16bfd2;hb=20748f2dd7965dcd1446a1cb27e5a5af18a0e5bb;hp=9653bd52ffb66f6173aca84a1559b6ea71d1361d;hpb=dec94b039e8ec90baf21463df839a6181de606f6;p=sbcl.git diff --git a/src/code/profile.lisp b/src/code/profile.lisp index 9653bd5..dbdc65e 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -33,13 +33,13 @@ (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))))))) |# ;;;; global data structures @@ -47,13 +47,13 @@ ;;; 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 @@ -85,13 +85,13 @@ (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 @@ -224,7 +224,7 @@ (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))) @@ -245,7 +245,7 @@ (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 @@ -256,7 +256,7 @@ ;;; Profile the named function. If already profiled, unprofile first. (defun profile-1-function (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)) @@ -266,9 +266,9 @@ ;;; Unprofile the named function, if it is profiled. (defun unprofile-1-function (name) - (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" @@ -291,7 +291,7 @@ undefined, then we give a warning and ignore it. See also UNPROFILE, REPORT and RESET." (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))) @@ -307,13 +307,13 @@ `(unprofile-all))) (defun unprofile-all () - (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)))) @@ -356,7 +356,7 @@ Lisp process." (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.~@ @@ -416,7 +416,7 @@ Lisp process." "~%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))) @@ -459,7 +459,7 @@ Lisp process." (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