0.7.12.18:

[sbcl.git] / src / code / profile.lisp

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index b1b3544..1f4f793 100644 (file)
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -49,11 +49,11 @@
 ;;; closure which implements the encapsulation.
 (defvar *profiled-fun-name->info* (make-hash-table))
 (defstruct (profile-info (:copier nil))
 ;;; closure which implements the encapsulation.
 (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
 
 ;;; 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.
 (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
   ;; 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
   ;; 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
 (defvar *overhead*)
 (declaim (type overhead *overhead*))
 (makunbound '*overhead*) ; in case we reload this file when tweaking

@@ -217,14 +217,12 @@
 
 ;;; A symbol or (SETF FOO) list names a function, a string names all
 ;;; the functions named by symbols in the named package.
 
 ;;; 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
   (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:
-       (fun-name-block-name name)
+       (legal-fun-name-or-type-error name)

        ;; Then we map onto it.
        (funcall function name))
       (string (let ((package (find-undeleted-package-or-lose name)))
        ;; Then we map onto it.
        (funcall function name))
       (string (let ((package (find-undeleted-package-or-lose name)))

@@ -239,7 +237,7 @@
 
 ;;; Profile the named function, which should exist and not be profiled
 ;;; already.
 
 ;;; 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)
   (let ((encapsulated-fun (fdefinition name)))
     (multiple-value-bind (encapsulation-fun read-stats-fun clear-stats-fun)
        (profile-encapsulation-lambdas encapsulated-fun)

@@ -254,18 +252,18 @@
       (values))))
 
 ;;; Profile the named function. If already profiled, unprofile first.
       (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-fun-name->info*)
           (warn "~S is already profiled, so unprofiling it first." name)
   (cond ((fboundp name)
         (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.
        (t
         (warn "ignoring undefined function ~S" name)))
   (values))
 
 ;;; Unprofile the named function, if it is profiled.

-(defun unprofile-1-function (name)
+(defun unprofile-1-fun (name)

   (let ((pinfo (gethash name *profiled-fun-name->info*)))
     (cond (pinfo
           (remhash name *profiled-fun-name->info*)
   (let ((pinfo (gethash name *profiled-fun-name->info*)))
     (cond (pinfo
           (remhash name *profiled-fun-name->info*)

@@ -293,7 +291,7 @@
   (if (null names)
       `(loop for k being each hash-key in *profiled-fun-name->info*
             collecting k)
   (if (null names)
       `(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
 
 (defmacro unprofile (&rest names)
   #+sb-doc

@@ -303,13 +301,13 @@
   named package. NAMES defaults to the list of names of all currently 
   profiled functions."
   (if names
   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-fun-name->info*)
     (declare (ignore profile-info))
       `(unprofile-all)))
 
 (defun unprofile-all ()
   (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."
 
 (defun reset ()
   "Reset the counters for all profiled functions."

@@ -443,6 +441,7 @@ Lisp process."
   (flet ((frob ()
           (let ((start (get-internal-ticks))
                 (fun (symbol-function 'compute-overhead-aux)))
   (flet ((frob ()
           (let ((start (get-internal-ticks))
                 (fun (symbol-function 'compute-overhead-aux)))

+             (declare (type function fun))

             (dotimes (i *timer-overhead-iterations*)
               (funcall fun fun))
             (/ (float (- (get-internal-ticks) start))
             (dotimes (i *timer-overhead-iterations*)
               (funcall fun fun))
             (/ (float (- (get-internal-ticks) start))