lisp/gud.el

   1 ;; Grand Unified Debugger mode --- run gdb, sdb, dbx under Emacs control
   2 ;;      @(#)gud.el      1.10
   3
   4 ;; This file is part of GNU Emacs.
   5
   6 ;; GNU Emacs is free software; you can redistribute it and/or modify
   7 ;; it under the terms of the GNU General Public License as published by
   8 ;; the Free Software Foundation; either version 1, or (at your option)
   9 ;; any later version.
  10
  11 ;; GNU Emacs is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;; GNU General Public License for more details.
  15
  16 ;; You should have received a copy of the GNU General Public License
  17 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20 ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>
  21 ;; It was later ewritten by rms.  Some ideas were due to Masanobu.
  22 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <eric@thyrsus.com>
  23 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
  24 ;; who also hacked the mode to use comint.el.
  25
  26 ;; Note: use of this package with sdb requires that your tags.el support
  27 ;; the find-tag-noselect entry point.  Stock distributions up to 18.57 do
  28 ;; *not* include this feature; if it's not included with this file, email
  29 ;; eric@snark.thyrsus.com for it or get 18.58.
  30
  31 (require 'comint)
  32 (require 'tags)
  33
  34 ;; ======================================================================
  35 ;; the overloading mechanism
  36
  37 (defun gud-overload-functions (gud-overload-alist)
  38   "Overload functions defined in GUD-OVERLOAD-ALIST.
  39 This association list has elements of the form
  40
  41      (ORIGINAL-FUNCTION-NAME  OVERLOAD-FUNCTION)"
  42   (let ((binding nil)
  43         (overloads gud-overload-alist))
  44     (while overloads
  45       (setq binding (car overloads)
  46             overloads (cdr overloads))
  47       (fset (car binding) (symbol-function (car (cdr binding))))
  48       )))
  49
  50 (defun gud-debugger-startup (f d)
  51   (error "GUD not properly entered."))
  52
  53 (defun gud-marker-filter (proc s)
  54   (error "GUD not properly entered."))
  55
  56 (defun gud-visit-file (f)
  57   (error "GUD not properly entered."))
  58
  59 (defun gud-set-break (proc f n)
  60   (error "GUD not properly entered."))
  61
  62 ;; This macro is used below to define some basic debugger interface commands.
  63 ;; Of course you may use `def-gud' with any other debugger command, including
  64 ;; user defined ones.
  65
  66 (defmacro def-gud (func name key &optional doc)
  67   (let* ((cstr (list 'if '(not (= 1 arg))
  68                      (list 'format "%s %s" name 'arg) name)))
  69     (list 'progn
  70           (list 'defun func '(arg)
  71                 (or doc "")
  72                 '(interactive "p")
  73                 (list 'gud-call cstr))
  74           (list 'define-key 'gud-mode-map key  (list 'quote func)))))
  75
  76 ;; All debugger-specific information is collected here
  77 ;; Here's how it works, in case you ever need to add a debugger to the table.
  78 ;;
  79 ;; Each entry must define the following at startup:
  80 ;;
  81 ;;<name>
  82 ;; comint-prompt-regexp
  83 ;; gud-<name>-startup-command
  84 ;; gud-<name>-marker-filter
  85 ;; gud-<name>-file-visit
  86 ;; gud-<name>-set-break
  87 ;;
  88 ;; The job of the startup-command method is to fire up a copy of the debugger,
  89 ;; given an object file and source directory.
  90 ;;
  91 ;; The job of the marker-filter method is to detect file/line markers in
  92 ;; strings and set the global gud-last-frame to indicate what display
  93 ;; action (if any) should be triggered by the marker.  Note that only
  94 ;; whetever the method *returns* is displayed in the buffer; thus, you
  95 ;; can filter the debugger's output, interpreting some and passing on
  96 ;; the rest.
  97 ;;
  98 ;; The job of the visit-file method is to visit and return the buffer indicated
  99 ;; by the car of gud-tag-frame.  This may be a file name, a tag name, or
 100 ;; something else.
 101 ;;
 102 ;; The job of the gud-set-break method is to send the commands necessary
 103 ;; to set a breakpoint at a given line in a given source file.
 104 ;;
 105 ;; Debugger-specific information begins here:
 106
 107 ;; ======================================================================
 108 ;; gdb functions
 109
 110 (defun gud-gdb-debugger-startup (f d)
 111   (make-comint (concat "gud-" f) "gdb" nil "-fullname" "-cd" d f))
 112
 113 (defun gud-gdb-marker-filter (proc s)
 114   (if (string-match  "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" s)
 115       (progn
 116         (setq gud-last-frame
 117               (cons
 118                (substring string (match-beginning 1) (match-end 1))
 119                (string-to-int
 120                 (substring string (match-beginning 2) (match-end 2)))))
 121         ;; this computation means the ^Z^Z-initiated marker in the
 122         ;; input string is never emitted.
 123         (concat
 124          (substring string 0 (match-beginning 0))
 125          (substring string (match-end 0))
 126          ))
 127     string))
 128
 129 (defun gud-gdb-visit-file (f)
 130   (find-file-noselect f))
 131
 132 (defun gud-gdb-set-break (proc f n)
 133   (gud-call "break %s:%d" f n))
 134
 135 ;;;###autoload
 136 (defun gdb (path)
 137   "Run gdb on program FILE in buffer *gud-FILE*.
 138 The directory containing FILE becomes the initial working directory
 139 and source-file directory for your debugger."
 140   (interactive "fRun gdb on file: ")
 141   (gud-overload-functions '((gud-debugger-startup gud-gdb-debugger-startup)
 142                             (gud-marker-filter    gud-gdb-marker-filter)
 143                             (gud-visit-file       gud-gdb-visit-file)
 144                             (gud-set-break        gud-gdb-set-break)))
 145
 146   (def-gud gud-step   "step"   "\C-cs"    "Step one source line with display")
 147   (def-gud gud-stepi  "stepi"  "\C-ci"    "Step one instruction with display")
 148   (def-gud gud-next   "next"   "\C-cn"    "Step one line (skip functions)")
 149   (def-gud gud-cont   "cont"   "\C-c\C-c" "Continue with display")
 150
 151   (def-gud gud-finish "finish" "\C-c\C-f" "Finish executing current function")
 152   (def-gud gud-up     "up"     "\C-c<"    "Up N stack frames (numeric arg)")
 153   (def-gud gud-down   "down"   "\C-c>"    "Down N stack frames (numeric arg)")
 154
 155   (gud-common-init path)
 156
 157   (setq comint-prompt-regexp "^(.*gdb[+]?) *")
 158   (run-hooks 'gdb-mode-hook)
 159   )
 160
 161
 162 ;; ======================================================================
 163 ;; sdb functions
 164
 165 (defun gud-sdb-debugger-startup (f d)
 166   (make-comint (concat "gud-" f) "sdb" nil f "-" d))
 167
 168 (defun gud-sdb-marker-filter (proc str)
 169   (if (string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n"
 170                     str)
 171       (setq gud-last-frame
 172             (cons
 173              (substring string (match-beginning 2) (match-end 2))
 174              (string-to-int
 175               (substring string (match-beginning 3) (match-end 3))))))
 176   string)
 177
 178 (defun gud-sdb-visit-file (f)
 179   (find-tag-noselect f t))
 180
 181 (defun gud-sdb-set-break (proc f n)
 182   (gud-queue-send (format "e %s" f) (format "%d b" n)))
 183
 184 ;;;###autoload
 185 (defun sdb (path)
 186   "Run sdb on program FILE in buffer *gud-FILE*.
 187 The directory containing FILE becomes the initial working directory
 188 and source-file directory for your debugger."
 189   (if (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name)))
 190       (error "The sdb support requires a valid tags table to work."))
 191   (interactive "fRun sdb on file: ")
 192   (gud-overload-functions '((gud-debugger-startup gud-sdb-debugger-startup)
 193                             (gud-marker-filter    gud-sdb-marker-filter)
 194                             (gud-visit-file       gud-sdb-visit-file)
 195                             (gud-set-break        gud-sdb-set-break)))
 196
 197   (def-gud gud-step  "s"   "\C-cs" "Step one source line with display")
 198   (def-gud gud-stepi "i"   "\C-ci" "Step one instruction with display")
 199   (def-gud gud-next  "S"   "\C-cn" "Step one source line (skip functions)")
 200   (def-gud gud-cont  "c"   "\C-cc" "Continue with display")
 201
 202   (gud-common-init path)
 203
 204   (setq comint-prompt-pattern  "\\(^\\|\n\\)\\*")
 205   (run-hooks 'sdb-mode-hook)
 206   )
 207
 208 ;; ======================================================================
 209 ;; dbx functions
 210
 211 (defun gud-dbx-debugger-startup (f d)
 212   (make-comint (concat "gud-" file) "dbx" nil f))
 213
 214 (defun gud-dbx-marker-filter (proc str)
 215   (if (string-match
 216        "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" str)
 217       (setq gud-last-frame
 218             (cons
 219              (substring string (match-beginning 2) (match-end 2))
 220              (string-to-int
 221               (substring string (match-beginning 1) (match-end 1))))))
 222   string)
 223
 224 (defun gud-dbx-visit-file (f)
 225   (find-file-noselect f))
 226
 227 (defun gud-dbx-set-break (proc f n)
 228   (gud-call "stop at \"%s\":%d" f n))
 229
 230 ;;;###autoload
 231 (defun dbx (path)
 232   "Run dbx on program FILE in buffer *gud-FILE*.
 233 The directory containing FILE becomes the initial working directory
 234 and source-file directory for your debugger."
 235   (interactive "fRun dbx on file: ")
 236   (gud-overload-functions '((gud-debugger-startup gud-dbx-debugger-startup)
 237                             (gud-marker-filter    gud-dbx-marker-filter)
 238                             (gud-visit-file       gud-dbx-visit-file)
 239                             (gud-set-break        gud-dbx-set-break)))
 240
 241   (make-local-variable 'comint-prompt-regexp)
 242   (setq comint-prompt-regexp  "^[^)]*dbx) *")
 243
 244   (gud-common-init path)
 245
 246   (run-hooks 'dbx-mode-hook)
 247   )
 248
 249 ;;
 250 ;; End of debugger-specific information
 251 ;;
 252
 253 (defvar gud-mode-map nil
 254   "Keymap for gud-mode.")
 255
 256 (defvar gud-command-queue nil)
 257
 258 (if gud-mode-map
 259    nil
 260   (setq gud-mode-map (copy-keymap comint-mode-map))
 261   (define-key gud-mode-map "\C-l" 'gud-refresh))
 262
 263 (define-key ctl-x-map " " 'gud-break)
 264 (define-key ctl-x-map "&" 'send-gud-command)
 265
 266 \f
 267 (defun gud-mode ()
 268   "Major mode for interacting with an inferior debugger process.
 269 The following commands are available:
 270
 271 \\{gud-mode-map}
 272
 273 \\[gud-display-frame] displays in the other window
 274 the last line referred to in the gud buffer.
 275
 276 \\[gud-step],\\[gud-next], and \\[gud-nexti] in the gud window,
 277 do a step-one-line, step-one-line (not entering function calls), and
 278 step-one-instruction and then update the other window
 279 with the current file and position.  \\[gud-cont] continues
 280 execution.
 281
 282 If you are in a source file, you may set a breakpoint at the current
 283 line in the current source file by doing \\[gud-break].
 284
 285 Commands:
 286 Many commands are inherited from comint mode.
 287 Additionally we have:
 288
 289 \\[gud-display-frame] display frames file in other window
 290 \\[gud-step] advance one line in program
 291 \\[gud-next] advance one line in program (skip over calls).
 292 \\[send-gud-command] used for special printing of an arg at the current point.
 293 C-x SPACE sets break point at current line."
 294   (interactive)
 295   (comint-mode)
 296 ; (kill-all-local-variables)
 297   (setq major-mode 'gud-mode)
 298   (setq mode-name "Debugger")
 299   (setq mode-line-process '(": %s"))
 300   (use-local-map gud-mode-map)
 301   (make-local-variable 'gud-last-frame)
 302   (setq gud-last-frame nil)
 303   (make-local-variable 'comint-prompt-regexp)
 304   (run-hooks 'gud-mode-hook)
 305 )
 306
 307 (defvar current-gud-buffer nil)
 308
 309 (defun gud-common-init (path)
 310   ;; perform initializations common to all debuggers
 311   (setq path (expand-file-name path))
 312   (let ((file (file-name-nondirectory path)))
 313     (switch-to-buffer (concat "*gud-" file "*"))
 314     (setq default-directory (file-name-directory path))
 315     (or (bolp) (newline))
 316     (insert "Current directory is " default-directory "\n")
 317     (gud-debugger-startup file default-directory))
 318   (gud-mode)
 319   (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
 320   (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
 321   (setq gud-command-queue nil)
 322   (gud-set-buffer)
 323   )
 324
 325 (defun gud-set-buffer ()
 326   (cond ((eq major-mode 'gud-mode)
 327         (setq current-gud-buffer (current-buffer)))))
 328 \f
 329 (defun gud-filter (proc string)
 330   ;; This function is responsible for inserting output from your debugger
 331   ;; into the buffer.  The hard work is done by the method that is
 332   ;; the value of gud-marker-filter.
 333   (let ((inhibit-quit t))
 334     (gud-filter-insert proc (gud-marker-filter proc string))
 335     ;; If we've got queued commands and we see a prompt, pop one and send it.
 336     ;; In theory we should check that a prompt has been issued before sending
 337     ;; queued commands.  In practice, command responses from the first through
 338     ;; penultimate elements of a command sequence are short enough that we
 339     ;; don't really have to bother.
 340     (if gud-command-queue
 341         (progn
 342           (gud-call (car gud-command-queue))
 343           (setq gud-command-queue (cdr gud-command-queue))
 344           )
 345       )))
 346
 347 (defun gud-filter-insert (proc string)
 348   ;; Here's where the actual buffer insertion is done
 349   (let ((moving (= (point) (process-mark proc)))
 350         (output-after-point (< (point) (process-mark proc)))
 351         (old-buffer (current-buffer))
 352         start)
 353     (set-buffer (process-buffer proc))
 354     (unwind-protect
 355         (save-excursion
 356           ;; Insert the text, moving the process-marker.
 357           (goto-char (process-mark proc))
 358           (setq start (point))
 359           (insert-before-markers string)
 360           (set-marker (process-mark proc) (point))
 361           ;; Check for a filename-and-line number.
 362           ;; Don't display the specified file
 363           ;; unless (1) point is at or after the position where output appears
 364           ;; and (2) this buffer is on the screen.
 365           (if (and gud-last-frame (not output-after-point)
 366                   (get-buffer-window (current-buffer)))
 367               (gud-display-frame))
 368           )
 369       (set-buffer old-buffer))
 370     (if moving (goto-char (process-mark proc)))))
 371
 372 (defun gud-sentinel (proc msg)
 373   (cond ((null (buffer-name (process-buffer proc)))
 374          ;; buffer killed
 375          ;; Stop displaying an arrow in a source file.
 376          (setq overlay-arrow-position nil)
 377          (set-process-buffer proc nil))
 378         ((memq (process-status proc) '(signal exit))
 379          ;; Stop displaying an arrow in a source file.
 380          (setq overlay-arrow-position nil)
 381          ;; Fix the mode line.
 382          (setq mode-line-process
 383                (concat ": "
 384                        (symbol-name (process-status proc))))
 385          (let* ((obuf (current-buffer)))
 386            ;; save-excursion isn't the right thing if
 387            ;;  process-buffer is current-buffer
 388            (unwind-protect
 389                (progn
 390                  ;; Write something in *compilation* and hack its mode line,
 391                  (set-buffer (process-buffer proc))
 392                  ;; Force mode line redisplay soon
 393                  (set-buffer-modified-p (buffer-modified-p))
 394                  (if (eobp)
 395                      (insert ?\n mode-name " " msg)
 396                    (save-excursion
 397                      (goto-char (point-max))
 398                      (insert ?\n mode-name " " msg)))
 399                  ;; If buffer and mode line will show that the process
 400                  ;; is dead, we can delete it now.  Otherwise it
 401                  ;; will stay around until M-x list-processes.
 402                  (delete-process proc))
 403              ;; Restore old buffer, but don't restore old point
 404              ;; if obuf is the gud buffer.
 405              (set-buffer obuf))))))
 406
 407
 408 (defun gud-refresh (&optional arg)
 409   "Fix up a possibly garbled display, and redraw the arrow."
 410   (interactive "P")
 411   (recenter arg)
 412   (gud-display-frame))
 413
 414 (defun gud-display-frame ()
 415   "Find and obey the last filename-and-line marker from the debugger.
 416 Obeying it means displaying in another window the specified file and line."
 417   (interactive)
 418   (if gud-last-frame
 419    (progn
 420      (gud-set-buffer)
 421      (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
 422      (setq gud-last-frame nil))))
 423
 424 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
 425 ;; and that its line LINE is visible.
 426 ;; Put the overlay-arrow on the line LINE in that buffer.
 427
 428 (defun gud-display-line (true-file line)
 429   (let* ((buffer (gud-visit-file true-file))
 430          (window (display-buffer buffer t))
 431          (pos))
 432     (save-excursion
 433       (set-buffer buffer)
 434       (save-restriction
 435         (widen)
 436         (goto-line line)
 437         (setq pos (point))
 438         (setq overlay-arrow-string "=>")
 439         (or overlay-arrow-position
 440             (setq overlay-arrow-position (make-marker)))
 441         (set-marker overlay-arrow-position (point) (current-buffer)))
 442       (cond ((or (< pos (point-min)) (> pos (point-max)))
 443              (widen)
 444              (goto-char pos))))
 445     (set-window-point window overlay-arrow-position)))
 446 \f
 447 (defun gud-call (command &rest args)
 448   "Invoke the debugger COMMAND displaying source in other window."
 449   (interactive)
 450   (gud-set-buffer)
 451   (goto-char (point-max))
 452   (let ((command (concat (apply 'format command args) "\n"))
 453         (proc (get-buffer-process current-gud-buffer)))
 454     (gud-filter-insert proc command)
 455     (send-string proc command)
 456     ))
 457
 458 (defun gud-queue-send (&rest cmdlist)
 459   ;; Send the first command, queue the rest for send after successive
 460   ;; send on subsequent prompts
 461   (interactive)
 462   (gud-call (car cmdlist))
 463   (setq gud-command-queue (append gud-command-queue (cdr cmdlist))))
 464
 465 (defun gud-apply-from-source (func)
 466   ;; Apply a method from the gud buffer environment, passing it file and line.
 467   ;; This is intended to be used for gud commands called from a source file.
 468   (if (not buffer-file-name)
 469       (error "There is no file associated with this buffer"))
 470   (let ((file (file-name-nondirectory buffer-file-name))
 471         (line (save-restriction (widen) (1+ (count-lines 1 (point))))))
 472     (save-excursion
 473       (gud-set-buffer)
 474       (funcall func
 475                (get-buffer-process current-gud-buffer)
 476                file
 477                line)
 478       )))
 479
 480 (defun gud-break ()
 481   "Set breakpoint at this source line."
 482   (interactive)
 483   (gud-apply-from-source 'gud-set-break))
 484
 485 (defun gud-read-address()
 486   "Return a string containing the core-address found in the buffer at point."
 487   (save-excursion
 488    (let ((pt (dot)) found begin)
 489      (setq found (if (search-backward "0x" (- pt 7) t)(dot)))
 490      (cond (found (forward-char 2)
 491                   (setq result
 492                         (buffer-substring found
 493                                  (progn (re-search-forward "[^0-9a-f]")
 494                                         (forward-char -1)
 495                                         (dot)))))
 496            (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
 497                                  (dot)))
 498               (forward-char 1)
 499               (re-search-forward "[^0-9]")
 500               (forward-char -1)
 501               (buffer-substring begin (dot)))))))
 502
 503
 504 (defvar gud-commands nil
 505   "List of strings or functions used by send-gud-command.
 506 It is for customization by you.")
 507
 508 (defun send-gud-command (arg)
 509
 510   "This command reads the number where the cursor is positioned.  It
 511  then inserts this ADDR at the end of the debugger buffer.  A numeric arg
 512  selects the ARG'th member COMMAND of the list gud-print-command.  If
 513  COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
 514  (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
 515  is a possible string to be a member of gud-commands.  "
 516
 517
 518   (interactive "P")
 519   (let (comm addr)
 520     (if arg (setq comm (nth arg gud-commands)))
 521     (setq addr (gud-read-address))
 522     (if (eq (current-buffer) current-gud-buffer)
 523         (set-mark (point)))
 524     (cond (comm
 525            (setq comm
 526                  (if (stringp comm) (format comm addr) (funcall comm addr))))
 527           (t (setq comm addr)))
 528     (switch-to-buffer current-gud-buffer)
 529     (goto-char (dot-max))
 530     (insert-string comm)))
 531
 532 ;; gud.e ends here
 533