;;; duplicate COMPILED-DEBUG-FUN structures.
(defvar *compiled-debug-funs* (make-hash-table :test 'eq))
-;;; Make a COMPILED-DEBUG-FUN for a SB!C::COMPILER-DEBUG-FUN
-;;; and its component. This maps the latter to the former in
-;;; *COMPILED-DEBUG-FUNS*. If there already is a
-;;; COMPILED-DEBUG-FUN, then this returns it from
-;;; *COMPILED-DEBUG-FUNS*.
+;;; Make a COMPILED-DEBUG-FUN for a SB!C::COMPILER-DEBUG-FUN and its
+;;; component. This maps the latter to the former in
+;;; *COMPILED-DEBUG-FUNS*. If there already is a COMPILED-DEBUG-FUN,
+;;; then this returns it from *COMPILED-DEBUG-FUNS*.
+;;;
+;;; FIXME: It seems this table can potentially grow without bounds,
+;;; and retains roots to functions that might otherwise be collected.
(defun make-compiled-debug-fun (compiler-debug-fun component)
- (or (gethash compiler-debug-fun *compiled-debug-funs*)
- (setf (gethash compiler-debug-fun *compiled-debug-funs*)
- (%make-compiled-debug-fun compiler-debug-fun component))))
+ (let ((table *compiled-debug-funs*))
+ (with-locked-hash-table (table)
+ (or (gethash compiler-debug-fun table)
+ (setf (gethash compiler-debug-fun table)
+ (%make-compiled-debug-fun compiler-debug-fun component))))))
(defstruct (bogus-debug-fun
(:include debug-fun)
(%function nil)))
(:copier nil))
%name)
-
-(defvar *ir1-lambda-debug-fun* (make-hash-table :test 'eq))
\f
;;;; DEBUG-BLOCKs
(:copier nil))
;; code-location information for the block
(code-locations nil :type simple-vector))
-
-(defvar *ir1-block-debug-block* (make-hash-table :test 'eq))
\f
;;;; breakpoints
(defun %set-stack-ref (s n value) (%set-stack-ref s n value))
(defun fun-code-header (fun) (fun-code-header fun))
(defun lra-code-header (lra) (lra-code-header lra))
-(defun make-lisp-obj (value) (make-lisp-obj value))
+(defun %make-lisp-obj (value) (%make-lisp-obj value))
(defun get-lisp-obj-address (thing) (get-lisp-obj-address thing))
(defun fun-word-offset (fun) (fun-word-offset fun))
#!-stack-grows-downward-not-upward
(and (sap< x (current-sp))
(sap<= control-stack-start x)
- (zerop (logand (sap-int x) #b11)))
+ (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask)))
#!+stack-grows-downward-not-upward
(and (sap>= x (current-sp))
(sap> control-stack-end x)
- (zerop (logand (sap-int x) #b11)))))
+ (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask)))))
+(declaim (inline component-ptr-from-pc))
(sb!alien:define-alien-routine component-ptr-from-pc (system-area-pointer)
(pc system-area-pointer))
+#!+(or x86 x86-64)
+(sb!alien:define-alien-routine valid-lisp-pointer-p sb!alien:int
+ (pointer system-area-pointer))
+
+(declaim (inline component-from-component-ptr))
(defun component-from-component-ptr (component-ptr)
(declare (type system-area-pointer component-ptr))
(make-lisp-obj (logior (sap-int component-ptr)
;;;
;;; XXX Should handle interrupted frames, both Lisp and C. At present
;;; it manages to find a fp trail, see linux hack below.
-(defun x86-call-context (fp &key (depth 0))
- (declare (type system-area-pointer fp)
- (fixnum depth))
-;; (format t "*CC ~S ~S~%" fp depth)
- (cond
- ((not (control-stack-pointer-valid-p fp))
- #+nil (format t "debug invalid fp ~S~%" fp)
- nil)
- (t
- ;; Check the two possible frame pointers.
- (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ ocfp-save-offset)
- sb!vm::n-word-bytes))))
- (lisp-ra (sap-ref-sap fp (- (* (1+ return-pc-save-offset)
- sb!vm::n-word-bytes))))
- (c-ocfp (sap-ref-sap fp (* 0 sb!vm:n-word-bytes)))
- (c-ra (sap-ref-sap fp (* 1 sb!vm:n-word-bytes))))
- #+nil (format t " lisp-ocfp=~S~% lisp-ra=~S~% c-ocfp=~S~% c-ra=~S~%"
- lisp-ocfp lisp-ra c-ocfp c-ra)
- (cond ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp)
- (ra-pointer-valid-p lisp-ra)
- (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp)
- (ra-pointer-valid-p c-ra))
- #+nil (format t
- "*C Both valid ~S ~S ~S ~S~%"
- lisp-ocfp lisp-ra c-ocfp c-ra)
- ;; Look forward another step to check their validity.
- (let ((lisp-path-fp (x86-call-context lisp-ocfp
- :depth (1+ depth)))
- (c-path-fp (x86-call-context c-ocfp :depth (1+ depth))))
- (cond ((and lisp-path-fp c-path-fp)
- ;; Both still seem valid - choose the lisp frame.
- #+nil (when (zerop depth)
- (format t
- "debug: both still valid ~S ~S ~S ~S~%"
- lisp-ocfp lisp-ra c-ocfp c-ra))
- #!+freebsd
- (if (sap> lisp-ocfp c-ocfp)
- (values lisp-ra lisp-ocfp)
- (values c-ra c-ocfp))
- #!-freebsd
- (values lisp-ra lisp-ocfp))
- (lisp-path-fp
- ;; The lisp convention is looking good.
- #+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra)
- (values lisp-ra lisp-ocfp))
- (c-path-fp
- ;; The C convention is looking good.
- #+nil (format t "*C c-ocfp ~S ~S~%" c-ocfp c-ra)
- (values c-ra c-ocfp))
- (t
- ;; Neither seems right?
- #+nil (format t "debug: no valid2 fp found ~S ~S~%"
- lisp-ocfp c-ocfp)
- nil))))
- ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp)
- (ra-pointer-valid-p lisp-ra))
- ;; The lisp convention is looking good.
- #+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra)
- (values lisp-ra lisp-ocfp))
- ((and (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp)
- #!-linux (ra-pointer-valid-p c-ra))
- ;; The C convention is looking good.
- #+nil (format t "*C c-ocfp ~S ~S~%" c-ocfp c-ra)
- (values c-ra c-ocfp))
- (t
- #+nil (format t "debug: no valid fp found ~S ~S~%"
- lisp-ocfp c-ocfp)
- nil))))))
+(declaim (maybe-inline x86-call-context))
+(defun x86-call-context (fp)
+ (declare (type system-area-pointer fp))
+ (labels ((fail ()
+ (values nil
+ (int-sap 0)
+ (int-sap 0)))
+ (handle (fp)
+ (cond
+ ((not (control-stack-pointer-valid-p fp))
+ (fail))
+ (t
+ ;; Check the two possible frame pointers.
+ (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ ocfp-save-offset)
+ sb!vm::n-word-bytes))))
+ (lisp-ra (sap-ref-sap fp (- (* (1+ return-pc-save-offset)
+ sb!vm::n-word-bytes))))
+ (c-ocfp (sap-ref-sap fp (* 0 sb!vm:n-word-bytes)))
+ (c-ra (sap-ref-sap fp (* 1 sb!vm:n-word-bytes))))
+ (cond ((and (sap> lisp-ocfp fp)
+ (control-stack-pointer-valid-p lisp-ocfp)
+ (ra-pointer-valid-p lisp-ra)
+ (sap> c-ocfp fp)
+ (control-stack-pointer-valid-p c-ocfp)
+ (ra-pointer-valid-p c-ra))
+ ;; Look forward another step to check their validity.
+ (let ((lisp-ok (handle lisp-ocfp))
+ (c-ok (handle c-ocfp)))
+ (cond ((and lisp-ok c-ok)
+ ;; Both still seem valid - choose the lisp frame.
+ #!+freebsd
+ (if (sap> lisp-ocfp c-ocfp)
+ (values t lisp-ra lisp-ocfp)
+ (values t c-ra c-ocfp))
+ #!-freebsd
+ (values t lisp-ra lisp-ocfp))
+ (lisp-ok
+ ;; The lisp convention is looking good.
+ (values t lisp-ra lisp-ocfp))
+ (c-ok
+ ;; The C convention is looking good.
+ (values t c-ra c-ocfp))
+ (t
+ ;; Neither seems right?
+ (fail)))))
+ ((and (sap> lisp-ocfp fp)
+ (control-stack-pointer-valid-p lisp-ocfp)
+ (ra-pointer-valid-p lisp-ra))
+ ;; The lisp convention is looking good.
+ (values t lisp-ra lisp-ocfp))
+ ((and (sap> c-ocfp fp)
+ (control-stack-pointer-valid-p c-ocfp)
+ #!-linux (ra-pointer-valid-p c-ra))
+ ;; The C convention is looking good.
+ (values t c-ra c-ocfp))
+ (t
+ (fail))))))))
+ (handle fp)))
) ; #+x86 PROGN
\f
(let ((fp (frame-pointer frame)))
(when (control-stack-pointer-valid-p fp)
#!+(or x86 x86-64)
- (multiple-value-bind (ra ofp) (x86-call-context fp)
- (and ra (compute-calling-frame ofp ra frame)))
+ (multiple-value-bind (ok ra ofp) (x86-call-context fp)
+ (and ok
+ (compute-calling-frame ofp ra frame)))
#!-(or x86 x86-64)
(compute-calling-frame
#!-alpha
#!-(or x86 x86-64)
(defun compute-calling-frame (caller lra up-frame)
(declare (type system-area-pointer caller))
+ (/noshow0 "entering COMPUTE-CALLING-FRAME")
(when (control-stack-pointer-valid-p caller)
+ (/noshow0 "in WHEN")
(multiple-value-bind (code pc-offset escaped)
(if lra
(multiple-value-bind (word-offset code)
"bogus stack frame"))
(t
(debug-fun-from-pc code pc-offset)))))
+ (/noshow0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
(make-compiled-frame caller up-frame d-fun
(code-location-from-pc d-fun pc-offset
escaped)
#!-(or x86 x86-64)
(defun find-escaped-frame (frame-pointer)
(declare (type system-area-pointer frame-pointer))
+ (/noshow0 "entering FIND-ESCAPED-FRAME")
(dotimes (index *free-interrupt-context-index* (values nil 0 nil))
+ (/noshow0 "at head of WITH-ALIEN")
(let ((scp (nth-interrupt-context index)))
+ (/noshow0 "got SCP")
(when (= (sap-int frame-pointer)
(sb!vm:context-register scp sb!vm::cfp-offset))
(without-gcing
+ (/noshow0 "in WITHOUT-GCING")
(let ((code (code-object-from-bits
(sb!vm:context-register scp sb!vm::code-offset))))
+ (/noshow0 "got CODE")
(when (symbolp code)
(return (values code 0 scp)))
(let* ((code-header-len (* (get-header-data code)
;; pc-offset to 0 to keep the backtrace from
;; exploding.
(setf pc-offset 0)))))
+ (/noshow0 "returning from FIND-ESCAPED-FRAME")
(return
(if (eq (%code-debug-info code) :bogus-lra)
(let ((real-lra (code-header-ref code
#!-(or x86 x86-64)
(defun code-object-from-bits (bits)
(declare (type (unsigned-byte 32) bits))
- (let ((object (make-lisp-obj bits)))
+ (let ((object (make-lisp-obj bits nil)))
(if (functionp object)
(or (fun-code-header object)
:undefined-function)
(sap-ref-32 catch
(* sb!vm:catch-block-previous-catch-slot
sb!vm:n-word-bytes)))))))
+
+;;; Modify the value of the OLD-TAG catches in FRAME to NEW-TAG
+(defun replace-frame-catch-tag (frame old-tag new-tag)
+ (let ((catch (descriptor-sap sb!vm:*current-catch-block*))
+ (fp (frame-pointer frame)))
+ (loop until (zerop (sap-int catch))
+ do (when (sap= fp
+ #!-alpha
+ (sap-ref-sap catch
+ (* sb!vm:catch-block-current-cont-slot
+ sb!vm:n-word-bytes))
+ #!+alpha
+ (int-sap
+ (sap-ref-32 catch
+ (* sb!vm:catch-block-current-cont-slot
+ sb!vm:n-word-bytes))))
+ (let ((current-tag
+ #!-(or x86 x86-64)
+ (stack-ref catch sb!vm:catch-block-tag-slot)
+ #!+(or x86 x86-64)
+ (make-lisp-obj
+ (sap-ref-word catch (* sb!vm:catch-block-tag-slot
+ sb!vm:n-word-bytes)))))
+ (when (eq current-tag old-tag)
+ #!-(or x86 x86-64)
+ (setf (stack-ref catch sb!vm:catch-block-tag-slot) new-tag)
+ #!+(or x86 x86-64)
+ (setf (sap-ref-word catch (* sb!vm:catch-block-tag-slot
+ sb!vm:n-word-bytes))
+ (get-lisp-obj-address new-tag)))))
+ do (setf catch
+ #!-alpha
+ (sap-ref-sap catch
+ (* sb!vm:catch-block-previous-catch-slot
+ sb!vm:n-word-bytes))
+ #!+alpha
+ (int-sap
+ (sap-ref-32 catch
+ (* sb!vm:catch-block-previous-catch-slot
+ sb!vm:n-word-bytes)))))))
+
+
\f
;;;; operations on DEBUG-FUNs
(compiled-debug-var-sc-offset debug-var))))))
;;; a helper function for working with possibly-invalid values:
-;;; Do (MAKE-LISP-OBJ VAL) only if the value looks valid.
+;;; Do (%MAKE-LISP-OBJ VAL) only if the value looks valid.
;;;
;;; (Such values can arise in registers on machines with conservative
;;; GC, and might also arise in debug variable locations when
;;; those variables are invalid.)
-(defun make-valid-lisp-obj (val)
+(defun make-lisp-obj (val &optional (errorp t))
(if (or
;; fixnum
(zerop (logand val sb!vm:fixnum-tag-mask))
;; unbound marker
(= val sb!vm:unbound-marker-widetag)
;; pointer
+ #!+(or x86 x86-64)
+ (not (zerop (valid-lisp-pointer-p (int-sap val))))
+ ;; FIXME: There is no fundamental reason not to use the above
+ ;; function on other platforms as well, but I didn't have
+ ;; others available while doing this. --NS 2007-06-21
+ #!-(or x86 x86-64)
(and (logbitp 0 val)
- ;; Check that the pointer is valid. XXX Could do a better
- ;; job. FIXME: e.g. by calling out to an is_valid_pointer
- ;; routine in the C runtime support code
(or (< sb!vm:read-only-space-start val
(* sb!vm:*read-only-space-free-pointer*
sb!vm:n-word-bytes))
sb!vm:n-word-bytes))
(< (current-dynamic-space-start) val
(sap-int (dynamic-space-free-pointer))))))
- (make-lisp-obj val)
- :invalid-object))
+ (values (%make-lisp-obj val) t)
+ (if errorp
+ (error "~S is not a valid argument to ~S"
+ val 'make-lisp-obj)
+ (values (make-unprintable-object (format nil "invalid object #x~X" val))
+ nil))))
#!-(or x86 x86-64)
(defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
#.sb!vm:descriptor-reg-sc-number
#!+rt #.sb!vm:word-pointer-reg-sc-number)
(sb!sys:without-gcing
- (with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
-
+ (with-escaped-value (val)
+ (make-lisp-obj val nil))))
(#.sb!vm:character-reg-sc-number
(with-escaped-value (val)
(code-char val)))
((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)
(without-gcing
(with-escaped-value (val)
- (make-valid-lisp-obj val))))
+ (make-lisp-obj val nil))))
(#.sb!vm:character-reg-sc-number
(with-escaped-value (val)
(code-char val)))
;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0
;;; gets the first binding, and 1 gets the AREF form.
-;;; temporary buffer used to build form-number => source-path translation in
-;;; FORM-NUMBER-TRANSLATIONS
-(defvar *form-number-temp* (make-array 10 :fill-pointer 0 :adjustable t))
-
-;;; table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS
-(defvar *form-number-circularity-table* (make-hash-table :test 'eq))
-
;;; This returns a table mapping form numbers to source-paths. A
;;; source-path indicates a descent into the TOPLEVEL-FORM form,
;;; going directly to the subform corressponding to the form number.
;;; NODE-SOURCE-PATH; that is, the first element is the form number and
;;; the last is the TOPLEVEL-FORM number.
(defun form-number-translations (form tlf-number)
- (clrhash *form-number-circularity-table*)
- (setf (fill-pointer *form-number-temp*) 0)
- (sub-translate-form-numbers form (list tlf-number))
- (coerce *form-number-temp* 'simple-vector))
-(defun sub-translate-form-numbers (form path)
- (unless (gethash form *form-number-circularity-table*)
- (setf (gethash form *form-number-circularity-table*) t)
- (vector-push-extend (cons (fill-pointer *form-number-temp*) path)
- *form-number-temp*)
- (let ((pos 0)
- (subform form)
- (trail form))
- (declare (fixnum pos))
- (macrolet ((frob ()
- '(progn
- (when (atom subform) (return))
- (let ((fm (car subform)))
- (when (consp fm)
- (sub-translate-form-numbers fm (cons pos path)))
- (incf pos))
- (setq subform (cdr subform))
- (when (eq subform trail) (return)))))
- (loop
- (frob)
- (frob)
- (setq trail (cdr trail)))))))
+ (let ((seen nil)
+ (translations (make-array 12 :fill-pointer 0 :adjustable t)))
+ (labels ((translate1 (form path)
+ (unless (member form seen)
+ (push form seen)
+ (vector-push-extend (cons (fill-pointer translations) path)
+ translations)
+ (let ((pos 0)
+ (subform form)
+ (trail form))
+ (declare (fixnum pos))
+ (macrolet ((frob ()
+ '(progn
+ (when (atom subform) (return))
+ (let ((fm (car subform)))
+ (when (consp fm)
+ (translate1 fm (cons pos path)))
+ (incf pos))
+ (setq subform (cdr subform))
+ (when (eq subform trail) (return)))))
+ (loop
+ (frob)
+ (frob)
+ (setq trail (cdr trail))))))))
+ (translate1 form (list tlf-number)))
+ (coerce translations 'simple-vector)))
;;; FORM is a top level form, and path is a source-path into it. This
;;; returns the form indicated by the source-path. Context is the
;;; This maps bogus-lra-components to cookies, so that
;;; HANDLE-FUN-END-BREAKPOINT can find the appropriate cookie for the
;;; breakpoint hook.
-(defvar *fun-end-cookies* (make-hash-table :test 'eq))
+(defvar *fun-end-cookies* (make-hash-table :test 'eq :synchronized t))
;;; This returns a hook function for the start helper breakpoint
;;; associated with a :FUN-END breakpoint. The returned function
;;;; breakpoint handlers (layer between C and exported interface)
;;; This maps components to a mapping of offsets to BREAKPOINT-DATAs.
-(defvar *component-breakpoint-offsets* (make-hash-table :test 'eq))
+(defvar *component-breakpoint-offsets* (make-hash-table :test 'eq :synchronized t))
;;; This returns the BREAKPOINT-DATA object associated with component cross
;;; offset. If none exists, this makes one, installs it, and returns it.
;;; We use this when there are no longer any active breakpoints
;;; corresponding to DATA.
(defun delete-breakpoint-data (data)
+ ;; Again, this looks brittle. Is there no danger of being interrupted
+ ;; here?
(let* ((component (breakpoint-data-component data))
(offsets (delete (breakpoint-data-offset data)
(gethash component *component-breakpoint-offsets*)
;;; [old C code] or HANDLE-FUN-END-BREAKPOINT calls this directly
;;; [new C code].
(defun handle-fun-end-breakpoint-aux (breakpoints data signal-context)
+ ;; FIXME: This looks brittle: what if we are interrupted somewhere
+ ;; here? ...or do we have interrupts disabled here?
(delete-breakpoint-data data)
(let* ((scp
(locally
;;; 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))))
+(defun handle-single-step-trap (kind callee-register-offset)
+ (let ((context (nth-interrupt-context (1- *free-interrupt-context-index*))))
;; The following calls must get tail-call eliminated for
- ;; *STEP-FRAME* to get set correctly.
+ ;; *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))))
;; If there was not enough debug information available, there's no
;; sense in signaling the condition.
(when step-info
- (let ((*step-frame* (frame-down (top-frame))))
- ;; KLUDGE: Use the first non-foreign frame as the
- ;; *STACK-TOP-HINT*. Getting the frame from the signal context
- ;; would be cleaner, but SIGNAL-CONTEXT-FRAME doesn't seem
- ;; seem to work very well currently.
- (loop while *step-frame*
- for dfun = (frame-debug-fun *step-frame*)
- do (when (typep dfun 'compiled-debug-fun)
- (return))
- do (setf *step-frame* (frame-down *step-frame*)))
+ (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
(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
+ (let* ((callee (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
(fdefn (fdefn-fun callee))
(function callee))
args)))
- (let ((sb!impl::*step-out* :maybe))
- (unwind-protect
- ;; 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
- ;; If STEP-INTO was selected we pass
- ;; the return values to STEP-VALUES which
- ;; will show the return value.
+ ;; 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 STEP-NEXT or STEP-CONTINUE was
- ;; selected we disable the stepper for
- ;; the duration of the call.
- (sb!impl::with-stepping-disabled
- (call))))
- ;; If the use selected the STEP-OUT restart
- ;; somewhere during the call, resume stepping
- (when (eq sb!impl::*step-out* t)
- (sb!impl::enable-stepping)))))))
+ ;; 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))))
projects / sbcl.git / blobdiff