X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprofile.lisp;h=1f4f79332a980b1e2138d4cdbbe6c6cde94f600c;hb=148e3820ad314a9b59d0133c1d60eaac4af9118b;hp=a381821f1fd398826d7cb8f3aa6431aaa24124d2;hpb=75d94847e52a0e26dc5eb4d66e78dd823fd93d5b;p=sbcl.git

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index a381821..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,15 +85,16 @@
 (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
 
 ;;;; profile encapsulations
 
@@ -144,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*)
@@ -168,34 +169,24 @@
 		    (*enclosed-ticks* 0)
 		    (*enclosed-consing* 0)
 		    (*enclosed-profiles* 0)
-		    (nbf-pcounter *n-bytes-freed-or-purified-pcounter*)
-		    ;; Typically NBF-PCOUNTER will represent a bignum.
-		    ;; In general we don't want to cons up a new
-		    ;; bignum for every encapsulated call, so instead
-		    ;; we keep track of the PCOUNTER internals, so
-		    ;; that as long as we only cons small amounts,
-		    ;; we'll almost always just do fixnum arithmetic.
-		    ;; (And for encapsulated functions which cons
-		    ;; large amounts, then we don't much care about a
-		    ;; single extra consed bignum.)
-		    (start-consing-integer (pcounter-integer nbf-pcounter))
-		    (start-consing-fixnum (pcounter-fixnum nbf-pcounter)))
+		    (nbf0 *n-bytes-freed-or-purified*)
+		    (dynamic-usage-0 (sb-kernel:dynamic-usage)))
 	       (declare (inline pcounter-or-fixnum->integer))
 	       (multiple-value-prog1
 		   (multiple-value-call encapsulated-fun
 					(sb-c:%more-arg-values arg-context
 							       0
 							       arg-count))
-		 (let ((*computing-profiling-data-for* encapsulated-fun))
+		 (let ((*computing-profiling-data-for* encapsulated-fun)
+		       (dynamic-usage-1 (sb-kernel:dynamic-usage)))
 		   (setf dticks (fastbig- (get-internal-ticks) start-ticks))
 		   (setf dconsing
-			 (if (eq (pcounter-integer nbf-pcounter)
-				 start-consing-integer)
-			     (- (pcounter-fixnum nbf-pcounter)
-				start-consing-fixnum)
-			     (- (get-bytes-consed)
-				(+ (pcounter-integer nbf-pcounter)
-				   (pcounter-fixnum nbf-pcounter)))))
+			 (if (eql *n-bytes-freed-or-purified* nbf0)
+			     ;; common special case where we can avoid
+			     ;; bignum arithmetic
+			     (- dynamic-usage-1 dynamic-usage-0)
+			     ;; general case
+			     (- (get-bytes-consed) nbf0 dynamic-usage-0)))
 		   (setf inner-enclosed-profiles
 			 (pcounter-or-fixnum->integer *enclosed-profiles*))
 		   (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
@@ -226,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)))
@@ -248,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
@@ -264,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"
@@ -302,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
@@ -315,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))))
 
@@ -366,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.~@
@@ -432,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)))
 
@@ -445,7 +427,7 @@ Lisp process."
 ;;; that I (WHN) use for my own experimentation, but it might
 ;;; become supported someday. Comments?)
 (declaim (type unsigned-byte *timer-overhead-iterations*))
-(defvar *timer-overhead-iterations*
+(defparameter *timer-overhead-iterations*
   500000)
 
 ;;; a dummy function that we profile to find profiling overhead
@@ -459,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))
@@ -475,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