lisp/gud.el

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