X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fprofile.lisp;h=a381821f1fd398826d7cb8f3aa6431aaa24124d2;hb=a1a2c079c7654defb618baad0dddcf0eaf2ce64f;hp=bf9086527c73b4931bd1db96f63091691d447693;hpb=4719b7d5d66c5930d3efd6a6d8e7572b16809f8d;p=sbcl.git

diff --git a/src/code/profile.lisp b/src/code/profile.lisp
index bf90865..a381821 100644
--- a/src/code/profile.lisp
+++ b/src/code/profile.lisp
@@ -101,9 +101,12 @@
 ;;; inline.
 (defmacro fastbig- (x y)
   (once-only ((x x) (y y))
-    `(if (and (typep ,x 'fixnum)
-	      (typep ,y 'fixnum))
+    `(if (and (typep ,x '(and fixnum unsigned-byte))
+	      (typep ,y '(and fixnum unsigned-byte)))
+	 ;; special case: can use fixnum arithmetic and be guaranteed
+	 ;; the result is also a fixnum
 	 (- ,x ,y)
+	 ;; general case
 	 (- ,x ,y))))
 (defmacro fastbig-1+ (x)
   (once-only ((x x))
@@ -161,11 +164,22 @@
 	 (aver (typep dconsing 'unsigned-byte))
 	 (aver (typep inner-enclosed-profiles 'unsigned-byte))
 	 (multiple-value-prog1
-	     (let ((start-ticks (get-internal-ticks))
-		   (start-consing (get-bytes-consed))
-		   (*enclosed-ticks* 0)
-		   (*enclosed-consing* 0)
-		   (*enclosed-profiles* 0))
+	     (let* ((start-ticks (get-internal-ticks))
+		    (*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)))
 	       (declare (inline pcounter-or-fixnum->integer))
 	       (multiple-value-prog1
 		   (multiple-value-call encapsulated-fun
@@ -173,8 +187,15 @@
 							       0
 							       arg-count))
 		 (let ((*computing-profiling-data-for* encapsulated-fun))
-		   (setf dticks (fastbig- (get-internal-ticks) start-ticks)
-			 dconsing (fastbig- (get-bytes-consed) start-consing))
+		   (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)))))
 		   (setf inner-enclosed-profiles
 			 (pcounter-or-fixnum->integer *enclosed-profiles*))
 		   (let ((net-dticks (fastbig- dticks *enclosed-ticks*)))
@@ -418,8 +439,14 @@ Lisp process."
 ;;;; overhead estimation
 
 ;;; We average the timing overhead over this many iterations.
-(defconstant +timer-overhead-iterations+
-  50000)
+;;;
+;;; (This is a variable, not a constant, so that it can be set in
+;;; .sbclrc if desired. Right now, that's an unsupported extension
+;;; 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*
+  500000)
 
 ;;; a dummy function that we profile to find profiling overhead
 (declaim (notinline compute-overhead-aux))
@@ -428,14 +455,15 @@ Lisp process."
 
 ;;; Return a newly computed OVERHEAD object.
 (defun compute-overhead ()
+  (format *debug-io* "~&measuring PROFILE overhead..")
   (flet ((frob ()
 	   (let ((start (get-internal-ticks))
 	         (fun (symbol-function 'compute-overhead-aux)))
-	     (dotimes (i +timer-overhead-iterations+)
+	     (dotimes (i *timer-overhead-iterations*)
 	       (funcall fun fun))
 	     (/ (float (- (get-internal-ticks) start))
 		(float +ticks-per-second+)
-		(float +timer-overhead-iterations+)))))
+		(float *timer-overhead-iterations*)))))
     (let (;; Measure unprofiled calls to estimate call overhead.
 	  (call-overhead (frob))
 	  total-overhead
@@ -453,14 +481,16 @@ Lisp process."
 	  (setf internal-overhead
 		(/ (float time)
 		   (float +ticks-per-second+)
-		   (float +timer-overhead-iterations+))))
+		   (float *timer-overhead-iterations*))))
 	(unprofile compute-overhead-aux))
-      (make-overhead :call call-overhead
-		     :total total-overhead
-		     :internal internal-overhead))))
+      (prog1
+	  (make-overhead :call call-overhead
+			 :total total-overhead
+			 :internal internal-overhead)
+	(format *debug-io* "done~%")))))
 
 ;;; It would be bad to compute *OVERHEAD*, save it into a .core file,
-;;; then load old *OVERHEAD* value from the .core file into a
+;;; then load the old *OVERHEAD* value from the .core file into a
 ;;; different machine running at a different speed. We avoid this by
 ;;; erasing *CALL-OVERHEAD* whenever we save a .core file.
 (pushnew (lambda ()