+
+\f
+;;;; Single-stepping
+
+;;; The single-stepper works by inserting conditional trap instructions
+;;; into the generated code (see src/compiler/*/call.lisp), currently:
+;;;
+;;; 1) Before the code generated for a function call that was
+;;; translated to a VOP
+;;; 2) Just before the call instruction for a full call
+;;;
+;;; In both cases, the trap will only be executed if stepping has been
+;;; enabled, in which case it'll ultimately be handled by
+;;; HANDLE-SINGLE-STEP-TRAP, which will either signal a stepping condition,
+;;; or replace the function that's about to be called with a wrapper
+;;; which will signal the condition.
+
+(defun handle-single-step-trap (context-sap kind callee-register-offset)
+ (let ((context (sb!alien:sap-alien context-sap (* os-context-t))))
+ ;; The following calls must get tail-call eliminated for
+ ;; *STEP-FRAME* to get set correctly on non-x86.
+ (if (= kind single-step-before-trap)
+ (handle-single-step-before-trap context)
+ (handle-single-step-around-trap context callee-register-offset))))
+
+(defvar *step-frame* nil)
+
+(defun handle-single-step-before-trap (context)
+ (let ((step-info (single-step-info-from-context context)))
+ ;; If there was not enough debug information available, there's no
+ ;; sense in signaling the condition.
+ (when step-info
+ (let ((*step-frame*
+ #+(or x86 x86-64)
+ (signal-context-frame (sb!alien::alien-sap context))
+ #-(or x86 x86-64)
+ ;; KLUDGE: Use the first non-foreign frame as the
+ ;; *STACK-TOP-HINT*. Getting the frame from the signal
+ ;; context as on x86 would be cleaner, but
+ ;; SIGNAL-CONTEXT-FRAME doesn't seem seem to work at all
+ ;; on non-x86.
+ (loop with frame = (frame-down (top-frame))
+ while frame
+ for dfun = (frame-debug-fun frame)
+ do (when (typep dfun 'compiled-debug-fun)
+ (return frame))
+ do (setf frame (frame-down frame)))))
+ (sb!impl::step-form step-info
+ ;; We could theoretically store information in
+ ;; the debug-info about to determine the
+ ;; arguments here, but for now let's just pass
+ ;; on it.
+ :unknown)))))
+
+;;; This function will replace the fdefn / function that was in the
+;;; register at CALLEE-REGISTER-OFFSET with a wrapper function. To
+;;; ensure that the full call will use the wrapper instead of the
+;;; original, conditional trap must be emitted before the fdefn /
+;;; function is converted into a raw address.
+(defun handle-single-step-around-trap (context callee-register-offset)
+ ;; Fetch the function / fdefn we're about to call from the
+ ;; appropriate register.
+ (let* ((callee (sb!kernel::make-lisp-obj
+ (context-register context callee-register-offset)))
+ (step-info (single-step-info-from-context context)))
+ ;; If there was not enough debug information available, there's no
+ ;; sense in signaling the condition.
+ (unless step-info
+ (return-from handle-single-step-around-trap))
+ (let* ((fun (lambda (&rest args)
+ (flet ((call ()
+ (apply (typecase callee
+ (fdefn (fdefn-fun callee))
+ (function callee))
+ args)))
+ ;; Signal a step condition
+ (let* ((step-in
+ (let ((*step-frame* (frame-down (top-frame))))
+ (sb!impl::step-form step-info args))))
+ ;; And proceed based on its return value.
+ (if step-in
+ ;; STEP-INTO was selected. Use *STEP-OUT* to
+ ;; let the stepper know that selecting the
+ ;; STEP-OUT restart is valid inside this
+ (let ((sb!impl::*step-out* :maybe))
+ ;; Pass the return values of the call to
+ ;; STEP-VALUES, which will signal a
+ ;; condition with them in the VALUES slot.
+ (unwind-protect
+ (multiple-value-call #'sb!impl::step-values
+ step-info
+ (call))
+ ;; If the user selected the STEP-OUT
+ ;; restart during the call, resume
+ ;; stepping
+ (when (eq sb!impl::*step-out* t)
+ (sb!impl::enable-stepping))))
+ ;; STEP-NEXT / CONTINUE / OUT selected:
+ ;; Disable the stepper for the duration of
+ ;; the call.
+ (sb!impl::with-stepping-disabled
+ (call)))))))
+ (new-callee (etypecase callee
+ (fdefn
+ (let ((fdefn (make-fdefn (gensym))))
+ (setf (fdefn-fun fdefn) fun)
+ fdefn))
+ (function fun))))
+ ;; And then store the wrapper in the same place.
+ (setf (context-register context callee-register-offset)
+ (get-lisp-obj-address new-callee)))))
+
+;;; Given a signal context, fetch the step-info that's been stored in
+;;; the debug info at the trap point.
+(defun single-step-info-from-context (context)
+ (multiple-value-bind (pc-offset code)
+ (compute-lra-data-from-pc (context-pc context))
+ (let* ((debug-fun (debug-fun-from-pc code pc-offset))
+ (location (code-location-from-pc debug-fun
+ pc-offset
+ nil)))
+ (handler-case
+ (progn
+ (fill-in-code-location location)
+ (code-location-debug-source location)
+ (compiled-code-location-step-info location))
+ (debug-condition ()
+ nil)))))
+
+;;; Return the frame that triggered a single-step condition. Used to
+;;; provide a *STACK-TOP-HINT*.
+(defun find-stepped-frame ()
+ (or *step-frame*
+ (top-frame)))