X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=837ff7eee7ebe485984d90fcbe730bfdd13f906e;hb=ba38798a5ca26b90647a1993f348806cb32f2d1b;hp=77edb5807943ebd19e62df0c9a7518dbbb2b5205;hpb=be9eb6c67b5f43a095c3de17bea945c309d662e4;p=sbcl.git diff --git a/src/code/profile.lisp b/src/code/profile.lisp index 77edb58..837ff7e 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -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 @@ -217,14 +217,14 @@ ;;; 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))) @@ -239,13 +239,13 @@ ;;; Profile the named function, which should exist and not be profiled ;;; already. -(defun profile-1-unprofiled-function (name) +(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 @@ -254,21 +254,21 @@ (values)))) ;;; Profile the named function. If already profiled, unprofile first. -(defun profile-1-function (name) +(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) - (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" @@ -291,9 +291,9 @@ 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))) + `(mapc-on-named-funs #'profile-1-fun ',names))) (defmacro unprofile (&rest names) #+sb-doc @@ -303,17 +303,17 @@ named package. NAMES defaults to the list of names of all currently profiled functions." (if names - `(mapc-on-named-functions #'unprofile-1-function ',names) + `(mapc-on-named-funs #'unprofile-1-fun ',names) `(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))) + (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)))) @@ -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