Skip to content
Snippets Groups Projects
debug.lisp 60.2 KiB
Newer Older
ram's avatar
ram committed
;;; -*- Mode: Lisp; Package: Debug; Log: code.log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug.lisp,v 1.62 2003/07/20 11:02:48 gerd Exp $")
ram's avatar
ram committed
;;; **********************************************************************
;;;
chiles's avatar
 
chiles committed
;;; CMU Common Lisp Debugger.  This includes a basic command-line oriented
;;; debugger interface as well as support for Hemlock to deliver debugger
;;; commands to a slave Lisp.
ram's avatar
ram committed
;;;
;;; Written by Bill Chiles.
ram's avatar
ram committed
;;;

ram's avatar
ram committed

(export '(internal-debug *in-the-debugger* backtrace *flush-debug-errors*
ram's avatar
ram committed
	  *debug-print-level* *debug-print-length* *debug-prompt*
cracauer's avatar
 
cracauer committed
	  *default-print-frame-call-verbosity*
	  *debug-readtable* *help-line-scroll-count* *stack-top-hint*
chiles's avatar
 
chiles committed

	  *auto-eval-in-frame* var arg
	  *only-block-start-locations* *print-location-kind*
ram's avatar
ram committed

chiles's avatar
 
chiles committed
	  do-debug-command))
ram's avatar
ram committed

(in-package "LISP")
(export '(invoke-debugger *debugger-hook* step))
ram's avatar
ram committed

(in-package "DEBUG")

;;;
;;; Used to communicate to debug-loop that we are at a step breakpoint.
;;;
(define-condition step-condition (simple-condition) ())
ram's avatar
ram committed
;;;; Variables, parameters, and constants.

(defparameter *debug-print-level* 3
  "*PRINT-LEVEL* is bound to this value when debug prints a function call.  If
ram's avatar
ram committed
  null, use *PRINT-LEVEL*")

(defparameter *debug-print-length* 5
  "*PRINT-LENGTH* is bound to this value when debug prints a function call.  If
  null, use *PRINT-LENGTH*.")

cracauer's avatar
 
cracauer committed
(defparameter *default-print-frame-call-verbosity* 1
  "default value for the verbose argument to print-frame-call.  If set to >= 2, source will be printed for all frames")

ram's avatar
ram committed
(defvar *in-the-debugger* nil
  "This is T while in the debugger.")

(defvar *debug-command-level* 0
  "Pushes and pops/exits inside the debugger change this.")

(defvar *stack-top-hint* nil
  "If this is bound before the debugger is invoked, it is used as the stack
(defvar *real-stack-top* nil)

(defvar *current-frame* nil)

;;; DEBUG-PROMPT -- Internal.
;;;
;;; This is the default for *debug-prompt*.
;;;
(defun debug-prompt ()
  (let ((*standard-output* *debug-io*))
    (terpri)
    (prin1 (di:frame-number *current-frame*))
    (dotimes (i *debug-command-level*) (princ "]"))
    (princ " ")
    (force-output)))

(defparameter *debug-prompt* #'debug-prompt
  "This is a function of no arguments that prints the debugger prompt
   on *debug-io*.")

(defconstant debug-help-string
"
The prompt is right square brackets, the number indicating how many
  recursive command loops you are in.
Debug commands do not affect * and friends, but evaluation in the debug loop
  do affect these variables.
Any command may be uniquely abbreviated.

Getting in and out of DEBUG:
  Q        throws to top level.
  GO       calls CONTINUE which tries to proceed with the restart 'continue.
  RESTART  invokes restart numbered as shown (prompt if not given).
  ERROR    prints the error condition and restart cases.
  FLUSH    toggles *flush-debug-errors*, which is initially t.
 
  The name of any restart, or its number, is a valid command, and is the same
    as using RESTART to invoke that restart.

Changing frames:
  U  up frame        D  down frame       T  top frame       B  bottom frame

  F n   goes to frame n.

Inspecting frames:
  BACKTRACE [n]  shows n frames going down the stack.
  L              lists locals in current function.
  P, PP          displays current function call.
  SOURCE [n]     displays frame's source form with n levels of enclosing forms.
  VSOURCE [n]    displays frame's source form without any ellipsis.

Breakpoints and steps:
  LIST-LOCATIONS [{function | :c}]  list the locations for breakpoints.
    Specify :c for the current frame.  Abbreviation: LL
  LIST-BREAKPOINTS                  list the active breakpoints.
    Abbreviations: LB, LBP
  DELETE-BREAKPOINT [n]             remove breakpoint n or all breakpoints.
    Abbreviations: DEL, DBP    
  BREAKPOINT {n | :end | :start} [:break form] [:function function]
    [{:print form}*] [:condition form]    set a breakpoint.
    Abbreviations: BR, BP
  STEP [n]                          step to the next location or step n times.

Function and macro commands:
 (DEBUG:DEBUG-RETURN expression)
    returns expression's values from the current frame, exiting the debugger.
 (DEBUG:ARG n)
    returns the n'th argument, remaining in the debugger.
 (DEBUG:VAR string-or-symbol [id])
    returns the specified variable's value, remaining in the debugger.

See the CMU Common Lisp User's Manual for more information.
")


;;;; Breakpoint state:

(defvar *only-block-start-locations* nil
ram's avatar
ram committed
  "When true, the LIST-LOCATIONS command only displays block start locations.
   Otherwise, all locations are displayed.")

(defvar *print-location-kind* nil
ram's avatar
ram committed
  "If true, list the code location type in the LIST-LOCATIONS command.")

;;; A list of the types of code-locations that should not be stepped to and
ram's avatar
ram committed
;;; should not be listed when listing breakpoints.
;;;
(defvar *bad-code-location-types* '(:call-site :internal-error))
(declaim (type list *bad-code-location-types*))
ram's avatar
ram committed

;;; Code locations of the possible breakpoints
;;;
(defvar *possible-breakpoints*)
(declaim (type list *possible-breakpoints*))

;;; A list of the made and active breakpoints, each is a breakpoint-info
ram's avatar
ram committed
;;;
(defvar *breakpoints* nil)
(declaim (type list *breakpoints*))

;;; A list of breakpoint-info structures of the made and active step
;;; breakpoints.
;;;
(defvar *step-breakpoints* nil)  
(declaim (type list *step-breakpoints*))

;;; Number of times left to step.
ram's avatar
ram committed
;;;
(defvar *number-of-steps* 1)
(declaim (type integer *number-of-steps*))

;;; Used when listing and setting breakpoints.
ram's avatar
ram committed
;;;
(defvar *default-breakpoint-debug-function* nil)
(declaim (type (or list di:debug-function) *default-breakpoint-debug-function*))
ram's avatar
ram committed


;;;; Code location utilities:

;;; FIRST-CODE-LOCATION -- Internal.
;;;
;;; Returns the first code-location in the passed debug block
;;;
(defun first-code-location (debug-block)
  (let ((found nil)
	(first-code-location nil))
    (di:do-debug-block-locations (code-location debug-block)
      (unless found 
	(setf first-code-location code-location)
	(setf found t)))
    first-code-location))

;;; NEXT-CODE-LOCATIONS -- Internal.
;;;
ram's avatar
ram committed
;;; Returns a list of the next code-locations following the one passed.  One of
;;; the *bad-code-location-types* will not be returned.
Loading
Loading full blame...