- (when (and *sampling*
- *samples*
- (< *samples-index* (length (the simple-vector *samples*))))
- (sb-sys:without-gcing
- (sb-thread:with-mutex (*sigprof-handler-lock*)
- (with-alien ((scp (* os-context-t) :local scp))
- (let* ((pc-ptr (sb-vm:context-pc scp))
- (fp (sb-vm::context-register scp #.sb-vm::ebp-offset)))
- ;; For some reason completely bogus small values for the
- ;; frame pointer are returned every now and then, leading
- ;; to segfaults. Try to avoid these cases.
- ;;
- ;; FIXME: Do a more thorough sanity check on ebp, or figure
- ;; out why this is happening.
- ;; -- JES, 2005-01-11
- (when (< fp 4096)
- (dotimes (i +sample-depth+)
- (record (int-sap 0)))
- (return-from sigprof-handler nil))
- (let ((fp (int-sap fp))
- (ok t))
- (declare (type system-area-pointer fp pc-ptr))
- (dotimes (i +sample-depth+)
- (record pc-ptr)
- (when ok
+ (let ((sb-vm:*alloc-signal* nil)
+ (samples *samples*))
+ (when (and *sampling*
+ samples
+ (< (samples-trace-count samples)
+ (samples-max-samples samples)))
+ (sb-sys:without-gcing
+ (sb-thread:with-mutex (*sigprof-handler-lock*)
+ (with-alien ((scp (* os-context-t) :local scp))
+ (let* ((pc-ptr (sb-vm:context-pc scp))
+ (fp (sb-vm::context-register scp #.sb-vm::ebp-offset)))
+ ;; For some reason completely bogus small values for the
+ ;; frame pointer are returned every now and then, leading
+ ;; to segfaults. Try to avoid these cases.
+ ;;
+ ;; FIXME: Do a more thorough sanity check on ebp, or figure
+ ;; out why this is happening.
+ ;; -- JES, 2005-01-11
+ (when (< fp 4096)
+ (return-from sigprof-handler nil))
+ (incf (samples-trace-count samples))
+ (let ((fp (int-sap fp))
+ (ok t))
+ (declare (type system-area-pointer fp pc-ptr))
+ ;; FIXME: How annoying. The XC doesn't store enough
+ ;; type information about SB-DI::X86-CALL-CONTEXT,
+ ;; even if we declaim the ftype explicitly in
+ ;; src/code/debug-int. And for some reason that type
+ ;; information is needed for the inlined version to
+ ;; be compiled without boxing the returned saps. So
+ ;; we declare the correct ftype here manually, even
+ ;; if the compiler should be able to deduce this
+ ;; exact same information.
+ (declare (ftype (function (system-area-pointer)
+ (values (member nil t)
+ system-area-pointer
+ system-area-pointer))
+ sb-di::x86-call-context))
+ (record-trace-start samples)
+ (dotimes (i (samples-max-depth samples))
+ (record samples pc-ptr)