X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=1f4f79332a980b1e2138d4cdbbe6c6cde94f600c;hb=25e76ec2b1083ac6a4bba42af7ad7b5a8239f2b8;hp=02fc54a6c1a44295af0d80aeb83ebddf8d68a576;hpb=bde2d08778488aba0ff0c30bc0afb17fbdacb4e4;p=sbcl.git

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index 02fc54a..1f4f793 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
@@ -145,7 +145,7 @@
     (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*)
@@ -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:
-       (function-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,14 +237,13 @@
 
 ;;; Profile the named function, which should exist and not be profiled
 ;;; already.
-(defun profile-1-unprofiled-function (name)
-  (declare #.*optimize-byte-compilation*)
+(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
@@ -255,23 +252,21 @@
       (values))))
 
 ;;; Profile the named function. If already profiled, unprofile first.
-(defun profile-1-function (name)
-  (declare #.*optimize-byte-compilation*)
+(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)
-  (declare #.*optimize-byte-compilation*)
-  (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"
@@ -293,11 +288,10 @@
    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)))
+      `(mapc-on-named-funs #'profile-1-fun ',names)))
 
 (defmacro unprofile (&rest names)
   #+sb-doc
@@ -306,20 +300,18 @@
   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)
+      `(mapc-on-named-funs #'unprofile-1-fun ',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)))
+    (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))))
 
@@ -357,13 +349,12 @@
 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.~@
@@ -423,7 +414,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)))
 
@@ -450,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))
@@ -466,7 +458,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