From 72a34c4188d01b13b47a0862c0330a904fd636f9 Mon Sep 17 00:00:00 2001 From: Attila Lendvai Date: Tue, 6 Apr 2010 17:24:54 +0200 Subject: [PATCH] make SB-SPROF:WITH-PROFILING not loop by default ...and in non-loop mode it properly returns the result values of the macro body. --- contrib/sb-sprof/sb-sprof.lisp | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp index c4b72ef13..a9f6f051c 100644 --- a/contrib/sb-sprof/sb-sprof.lisp +++ b/contrib/sb-sprof/sb-sprof.lisp @@ -643,7 +643,7 @@ profiling, and :TIME for wallclock profilgin.") (max-samples '*max-samples*) (reset nil) (mode '*sampling-mode*) - (loop t) + (loop nil) (max-depth most-positive-fixnum) show-progress (threads '(list sb-thread:*current-thread*)) @@ -700,6 +700,7 @@ profiling, and :TIME for wallclock profilgin.") If true (the default) repeatedly evaluate BODY. If false, evaluate if only once." (declare (type report-type report)) + (check-type loop boolean) `(let* ((*sample-interval* ,sample-interval) (*alloc-interval* ,alloc-interval) (*sampling* nil) @@ -709,21 +710,22 @@ profiling, and :TIME for wallclock profilgin.") (unwind-protect (progn (start-profiling :max-depth ,max-depth :threads ,threads) - (loop - (when (>= (samples-trace-count *samples*) - (samples-max-samples *samples*)) - (return)) - ,@(when show-progress - `((format t "~&===> ~d of ~d samples taken.~%" - (samples-trace-count *samples*) - (samples-max-samples *samples*)))) - (let ((.last-index. (samples-index *samples*))) - ,@body - (when (= .last-index. (samples-index *samples*)) - (warn "No sampling progress; possibly a profiler bug.") - (return))) - (unless ,loop - (return)))) + ,(if loop + `(loop + (when (>= (samples-trace-count *samples*) + (samples-max-samples *samples*)) + (return)) + ,@(when show-progress + `((format t "~&===> ~d of ~d samples taken.~%" + (samples-trace-count *samples*) + (samples-max-samples *samples*)))) + (let ((.last-index. (samples-index *samples*))) + ,@body + (when (= .last-index. (samples-index *samples*)) + (warn "No sampling progress; possibly a profiler bug.") + (return)))) + `(progn + ,@body))) (stop-profiling)) ,@(when report-p `((report :type ,report))))) -- 2.11.4.GIT