- `(let* ((*sample-interval* ,sample-interval)
- (*alloc-interval* ,alloc-interval)
- (*sampling* nil)
- (*sampling-mode* ,mode)
- (*max-samples* ,max-samples))
- ,@(when reset '((reset)))
- (unwind-protect
- (progn
- (start-profiling :max-depth ,max-depth :threads ,threads)
- ,(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)))))
+ (with-unique-names (values last-index oops)
+ `(let* ((*sample-interval* ,sample-interval)
+ (*alloc-interval* ,alloc-interval)
+ (*sampling* nil)
+ (*sampling-mode* ,mode)
+ (*max-samples* ,max-samples))
+ ,@(when reset '((reset)))
+ (flet ((,oops ()
+ (warn "~@<No sampling progress; run too short, sampling interval ~
+ too long, inappropriate set of sampled thread, or possibly ~
+ a profiler bug.~:@>")))
+ (unwind-protect
+ (progn
+ (start-profiling :max-depth ,max-depth :threads ,threads)
+ ,(if loop
+ `(let (,values)
+ (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*)))
+ (setf ,values (multiple-value-list (progn ,@body)))
+ (when (= ,last-index (samples-index *samples*))
+ (,oops)
+ (return))))
+ (values-list ,values))
+ `(let ((,last-index (samples-index *samples*)))
+ (multiple-value-prog1 (progn ,@body)
+ (when (= ,last-index (samples-index *samples*))
+ (,oops))))))
+ (stop-profiling)))
+ ,@(when report-p `((report :type ,report))))))