Learn how easy it is to sync an existing GitHub or Google Code repo to a SourceForge project! See Demo


Commit [c461e2] Maximize Restore History hopefully thread-safe SB-PROFILE

* Nuke PCOUNTER stuff, and replace it with a COUNTER local to

** New counter uses ATOMIC-INCF for atomicity, plus a lock and
an overflow counter to handle counts over word in size.

** Stack allocate counters and counter value cells when possible
to reduce overhead.

* Nuke the FASTBIG-stuff. A generic arithmetic call with fixnum args
is not that slow -- and if it turns out to be too slow after all,
then the compiler should take care of this under appropriate policy
instead of us using hacks like this.

* Test case from Volkan Yazici.

Nikodemus Siivola Nikodemus Siivola 2009-06-22

removed src/code/early-pcounter.lisp
changed build-order.lisp-expr
changed doc
changed doc/manual
changed doc/manual/profiling.texinfo
changed package-data-list.lisp-expr
changed src
changed src/code
changed src/code/profile.lisp
changed src/compiler
changed src/compiler/fndb.lisp
changed tests
changed version.lisp-expr
copied src/code/pcounter.lisp -> tests/profile.impure.lisp
File was removed.
build-order.lisp-expr Diff Switch to side-by-side view
doc/manual/profiling.texinfo Diff Switch to side-by-side view
package-data-list.lisp-expr Diff Switch to side-by-side view
src/code/profile.lisp Diff Switch to side-by-side view
src/compiler/fndb.lisp Diff Switch to side-by-side view
version.lisp-expr Diff Switch to side-by-side view
src/code/pcounter.lisp to tests/profile.impure.lisp
--- a/src/code/pcounter.lisp
+++ b/tests/profile.impure.lisp
@@ -1,84 +1,91 @@
+;;;; tests PROFILE with multiple threads
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
-;;;; a PCOUNTER is used to represent an unsigned integer quantity which
-;;;; can grow bigger than a fixnum, but typically does so, if at all,
-;;;; in many small steps, where we don't want to cons on every step.
-;;;; Such quantities typically arise in profiling, e.g.
-;;;; total system consing, time spent in a profiled function, and
-;;;; bytes consed in a profiled function are all examples of such
-;;;; quantities. The name is an abbreviation for "Profiling COUNTER".
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
-;;;; (This isn't one of my more brilliant names, so if you have a
-;;;; better suggestion, let me know. -- WHN 2001-06-22)
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
-;;; This stuff is implemented in the SB!PROFILE because the profiling
-;;; code is currently the only code which wants to poke around in the
-;;; implementation details.
-(in-package "SB!PROFILE")
-;;;; basic PCOUNTER stuff
+(load "assertoid.lisp")
+(load "test-util.lisp")
-(/show0 "pcounter.lisp 21")
+(defpackage :profile-test
+  (:use :cl :sb-thread))
-(declaim (maybe-inline incf-pcounter))
-(defun incf-pcounter (pcounter delta)
-  (aver (typep delta 'unsigned-byte))
-  (let ((sum (+ (pcounter-fixnum pcounter) delta)))
-    (cond ((typep sum 'fixnum)
-           (setf (pcounter-fixnum pcounter) sum))
-          (t
-           (incf (pcounter-integer pcounter) sum)
-           (setf (pcounter-fixnum pcounter) 0))))
-  pcounter)
+(in-package :profile-test)
-(/show0 "pcounter.lisp 34")
+(defun miller-rabin-prime-p (n &optional (s 50))
+ "Miller-Rabin primality test written by R. Matthew Emerson."
+ (flet ((witness-p (a n)
+          (loop with b = (- n 1)
+                for i from (integer-length b) downto 0
+                for d = 1 then (mod (* d d) n)
+                for x = d
+                do (progn
+                     (when (and (= d 1) (/= x 1) (/= x (- n 1)))
+                       (return-from witness-p t))
+                     (when (logbitp i b)
+                       (setf d (mod (* d a) n))))
+                finally (return (/= d 1)))))
+   (dotimes (i s n)
+     (let ((w (1+ (random (- n 1)))))
+       (when (witness-p w n)
+         (return-from miller-rabin-prime-p nil))))))
-;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable
-(defun pcounter->integer (pcounter)
-  (+ (pcounter-integer pcounter)
-     (pcounter-fixnum pcounter)))
-;;;; operations on (OR PCOUNTER FIXNUM)
-;;;; When we don't want to cons a PCOUNTER unless we're forced to, we
-;;;; start with a FIXNUM counter and only create a PCOUNTER if the
-;;;; FIXNUM overflows.
+(defun random-of-bit-size (n-bits)
+ "Returns a random number of maximum size `N-BITS'."
+ (random (ash 1 n-bits)))
-(/show0 "pcounter.lisp 47")
+(defun prime-of-bit-size (n-bits)
+ "Returns a prime number of maximum size `N-BITS'."
+ (loop for maybe-prime = (random-of-bit-size n-bits)
+       when (miller-rabin-prime-p maybe-prime)
+         do (return maybe-prime)))
-(declaim (inline %incf-pcounter-or-fixnum))
-(defun %incf-pcounter-or-fixnum (x delta)
-  (etypecase x
-    (fixnum
-     (let ((sum (+ x delta)))
-       (if (typep sum 'fixnum)
-           sum
-           (make-pcounter :integer sum))))
-    (pcounter
-     (incf-pcounter x delta))))
+(defun waste-cpu-cycles (n-primes n-prime-bits n-workers)
+  (if (= n-workers 1)
+      (handler-case
+          (progn
+            (loop repeat n-primes
+                  do (prime-of-bit-size n-prime-bits))
+            (list t))
+        (serious-condition (s)
+          s))
+      (let* ((r (make-semaphore))
+             (w (make-semaphore))
+             (workers
+              (loop repeat n-workers
+                    collect (sb-thread:make-thread
+                             (let ((rs (make-random-state)))
+                               (lambda ()
+                                 (block nil
+                                     (handler-bind ((serious-condition (lambda (c)
+                                                                         (princ c)
+                                                                         (sb-debug:backtrace)
+                                                                         (return c))))
+                                       (let ((*random-state* rs))
+                                         (signal-semaphore r)
+                                         (wait-on-semaphore w)
+                                         (loop repeat n-primes
+                                               do (prime-of-bit-size n-prime-bits))
+                                         t)))))))))
+        (loop repeat n-workers do (wait-on-semaphore r))
+        (signal-semaphore w n-workers)
+        (mapcar #'sb-thread:join-thread workers))))
-(define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum)
+(in-package :cl-user)
-(/show0 "pcounter.lisp 62")
-;;; Trade off space for execution time by handling the common fast
-;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic
-;;; arithmetic as a last resort.
-(defmacro fastbig-incf-pcounter-or-fixnum (x delta)
-  (let ((delta-sym (gensym "DELTA")))
-    `(let ((,delta-sym ,delta))
-       (aver (typep ,delta-sym 'unsigned-byte))
-       ;;(declare (type unsigned-byte ,delta-sym))
-       (if (typep ,delta-sym 'fixnum)
-           (incf-pcounter-or-fixnum ,x ,delta)
-           (incf-pcounter-or-fixnum ,x ,delta)))))
-(/show0 "pcounter.lisp 76")
-(declaim (maybe-inline pcounter-or-fixnum->integer))
-(defun pcounter-or-fixnum->integer (x)
-  (etypecase x
-    (fixnum x)
-    (pcounter (pcounter->integer x))))
-(/show0 "pcounter.lisp end")
+(with-test (:name (profile threads))
+  (profile "PROFILE-TEST")
+  ;; This used to signal an error with threads
+  (let* ((n #+sb-thread 5 #-sb-thread 1)
+         (res (profile-test::waste-cpu-cycles 10 256 n))
+         (want (make-list n :initial-element t)))
+    (unless (equal res want)
+      (error "wanted ~S, got ~S" want res)))
+  (report))