X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=1f4f79332a980b1e2138d4cdbbe6c6cde94f600c;hb=acce826c593a188b231b7b7918c752bda21d0201;hp=b1b35440dfb67eca27c9d49b5959a78508f19a45;hpb=0a82f2db352cc348d2107a882e50af222ff97ed3;p=sbcl.git

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index b1b3544..1f4f793 100644
--- 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))
-  (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,12 @@
 
 ;;; 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:
-       (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)))
@@ -239,7 +237,7 @@
 
 ;;; 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)
@@ -254,18 +252,18 @@
       (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)
-	   (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)
+(defun unprofile-1-fun (name)
   (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)
-      `(mapc-on-named-functions #'profile-1-function ',names)))
+      `(mapc-on-named-funs #'profile-1-fun ',names)))
 
 (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
-      `(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-1-function name)))
+    (unprofile-1-fun name)))
 
 (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)))
+             (declare (type function fun))
 	     (dotimes (i *timer-overhead-iterations*)
 	       (funcall fun fun))
 	     (/ (float (- (get-internal-ticks) start))