X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-sprof%2Fsb-sprof.lisp;h=775924ac15d397b9ba9b3c110c03f8759a06022d;hb=597826f00530e8d0c6f4a8ccda2e366f56b65579;hp=b7a9dcc90811223d4af7c22d93dad2293eb9ccaf;hpb=0adc5551b93e9c3ac86d584a28009633e4615c96;p=sbcl.git diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp index b7a9dcc..775924a 100644 --- a/contrib/sb-sprof/sb-sprof.lisp +++ b/contrib/sb-sprof/sb-sprof.lisp @@ -360,10 +360,8 @@ profiling") (defvar *alloc-region-size* #-gencgc (get-page-size) - ;; This hardcoded 2 matches the one in gc_find_freeish_pages. It's not - ;; really worth genesifying. #+gencgc - (* 2 sb-vm:gencgc-page-bytes)) + (max sb-vm:gencgc-alloc-granularity sb-vm:gencgc-card-bytes)) (declaim (type number *alloc-region-size*)) (defvar *samples* nil) @@ -492,9 +490,10 @@ profiling") (defun profiled-threads () (let ((profiled-threads *profiled-threads*)) - (if (eq :all profiled-threads) - (remove *timer-thread* (sb-thread:list-all-threads)) - profiled-threads))) + (remove *timer-thread* + (if (eq :all profiled-threads) + (sb-thread:list-all-threads) + profiled-threads)))) (defun profiled-thread-p (thread) (let ((profiled-threads *profiled-threads*)) @@ -508,13 +507,14 @@ profiling") (defvar *profiler-lock* (sb-thread:make-mutex :name "Statistical Profiler")) (defvar *distribution-lock* (sb-thread:make-mutex :name "Wallclock profiling lock")) - (define-alien-routine pthread-kill int (signal int) (os-thread unsigned-long)) + (declaim (inline pthread-kill)) + (define-alien-routine pthread-kill int (os-thread unsigned-long) (signal int)) ;;; A random thread will call this in response to either a timer firing, ;;; This in turn will distribute the notice to those threads we are ;;; interested using SIGPROF. (defun thread-distribution-handler () - (declare (optimize sb-c::merge-tail-calls)) + (declare (optimize speed (space 0))) (when *sampling* #+sb-thread (let ((lock *distribution-lock*)) @@ -865,9 +865,7 @@ The following keyword args are recognized: (if (and (consp name) (member (first name) '(sb-c::xep sb-c::tl-xep sb-c::&more-processor - sb-c::varargs-entry sb-c::top-level-form - sb-c::hairy-arg-processor sb-c::&optional-processor))) (second name) name)))