Mercurial > emacs
diff lisp/gud.el @ 460:c103b99fd872
Initial revision
author | Eric S. Raymond <esr@snark.thyrsus.com> |
---|---|
date | Wed, 18 Dec 1991 10:42:47 +0000 |
parents | |
children | ab9a55b26bd4 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gud.el Wed Dec 18 10:42:47 1991 +0000 @@ -0,0 +1,521 @@ +;; Grand Unified Debugger mode --- run gdb, sdb, dbx under Emacs control +;; @(#)gud.el 1.8 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu> +;; It was later ewritten by rms. Some ideas were due to Masanobu. +;; Grand Unification (sdb/dbx support) by Eric S. Raymond <eric@thyrsus.com> +;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>, +;; who also hacked the mode to use comint.el. + +;; Note: use of this package with sdb requires that your tags.el support +;; the find-tag-noselect entry point. Stock distributions up to 18.57 do +;; *not* include this feature; if it's not included with this file, email +;; eric@snark.thyrsus.com for it or get 18.58. + +(require 'comint) +(require 'tags) + +;; ====================================================================== +;; the overloading mechanism + +(defun gud-overload-functions (gud-overload-alist) + "Overload functions defined in GUD-OVERLOAD-ALIST. +This association list has elements of the form + + (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)" + (let ((binding nil) + (overloads gud-overload-alist)) + (while overloads + (setq binding (car overloads) + overloads (cdr overloads)) + (fset (car binding) (symbol-function (car (cdr binding)))) + ))) + +(defun gud-debugger-startup (f d) + (error "GUD not properly entered.")) + +(defun gud-marker-filter (proc s) + (error "GUD not properly entered.")) + +(defun gud-visit-file (f) + (error "GUD not properly entered.")) + +(defun gud-set-break (proc f n) + (error "GUD not properly entered.")) + +;; This macro is used below to define some basic debugger interface commands. +;; Of course you may use `def-gud' with any other debugger command, including +;; user defined ones. + +(defmacro def-gud (func name key &optional doc) + (let* ((cstr (list 'if '(not (= 1 arg)) + (list 'format "%s %s" name 'arg) name))) + (list 'progn + (list 'defun func '(arg) + (or doc "") + '(interactive "p") + (list 'gud-call cstr)) + (list 'define-key 'gud-mode-map key (list 'quote func))))) + +;; All debugger-specific information is collected here +;; Here's how it works, in case you ever need to add a debugger to the table. +;; +;; Each entry must define the following at startup: +;; +;;<name> +;; comint-prompt-regexp +;; gud-<name>-startup-command +;; gud-<name>-marker-filter +;; gud-<name>-file-visit +;; gud-<name>-set-break +;; + +;; ====================================================================== +;; gdb functions + +(defun gud-gdb-debugger-startup (f d) + (make-comint (concat "gud-" f) "gdb" nil "-fullname" "-cd" d f)) + +(defun gud-gdb-marker-filter (proc s) + (if (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" s) + (progn + (setq gud-last-frame + (cons + (substring string (match-beginning 1) (match-end 1)) + (string-to-int + (substring string (match-beginning 2) (match-end 2))))) + ;; this computation means the ^Z^Z-initiated marker in the + ;; input string is never emitted. + (concat + (substring string 0 (match-beginning 0)) + (substring string (match-end 0)) + )) + string)) + +(defun gud-gdb-visit-file (f) + (find-file-noselect f)) + +(defun gud-gdb-set-break (proc f n) + (gud-call "break %s:%d" f n)) + +(defun gdb (path) + "Run gdb on program FILE in buffer *gud-FILE*. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger." + (interactive "fRun gdb on file: ") + (gud-overload-functions '((gud-debugger-startup gud-gdb-debugger-startup) + (gud-marker-filter gud-gdb-marker-filter) + (gud-visit-file gud-gdb-visit-file) + (gud-set-break gud-gdb-set-break))) + + (def-gud gud-step "step" "\C-cs" "Step one source line with display") + (def-gud gud-stepi "stepi" "\C-ci" "Step one instruction with display") + (def-gud gud-next "next" "\C-cn" "Step one line (skip functions)") + (def-gud gud-cont "cont" "\C-c\C-c" "Continue with display") + + (def-gud gud-finish "finish" "\C-c\C-f" "Finish executing current function") + (def-gud gud-up "up" "\C-c<" "Up N stack frames (numeric arg)") + (def-gud gud-down "down" "\C-c>" "Down N stack frames (numeric arg)") + + (gud-common-init path) + + (setq comint-prompt-regexp "^(.*gdb[+]?) *") + (run-hooks 'gdb-mode-hook) + ) + + +;; ====================================================================== +;; sdb functions + +(defun gud-sdb-debugger-startup (f d) + (make-comint (concat "gud-" f) "sdb" nil f "-" d)) + +(defun gud-sdb-marker-filter (proc str) + (if (string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" + str) + (setq gud-last-frame + (cons + (substring string (match-beginning 2) (match-end 2)) + (string-to-int + (substring string (match-beginning 3) (match-end 3)))))) + string) + +(defun gud-sdb-visit-file (f) + (find-tag-noselect f t)) + +(defun gud-sdb-set-break (proc f n) + (gud-queue-send (format "e %s" f) (format "%d b" n))) + +(defun sdb (path) + "Run sdb on program FILE in buffer *gud-FILE*. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger." + (if (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name))) + (error "The sdb support requires a valid tags table to work.")) + (interactive "fRun sdb on file: ") + (gud-overload-functions '((gud-debugger-startup gud-sdb-debugger-startup) + (gud-marker-filter gud-sdb-marker-filter) + (gud-visit-file gud-sdb-visit-file) + (gud-set-break gud-sdb-set-break))) + + (def-gud gud-step "s" "\C-cs" "Step one source line with display") + (def-gud gud-stepi "i" "\C-ci" "Step one instruction with display") + (def-gud gud-next "S" "\C-cn" "Step one source line (skip functions)") + (def-gud gud-cont "c" "\C-cc" "Continue with display") + + (gud-common-init path) + + (setq comint-prompt-pattern "\\(^\\|\n\\)\\*") + (run-hooks 'sdb-mode-hook) + ) + +;; ====================================================================== +;; dbx functions + +(defun gud-dbx-debugger-startup (f d) + (make-comint (concat "gud-" file) "dbx" nil f)) + +(defun gud-dbx-marker-filter (proc str) + (if (string-match + "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" str) + (setq gud-last-frame + (cons + (substring string (match-beginning 2) (match-end 2)) + (string-to-int + (substring string (match-beginning 1) (match-end 1)))))) + string) + +(defun gud-dbx-visit-file (f) + (find-file-noselect f)) + +(defun gud-dbx-set-break (proc f n) + (gud-call "stop at \"%s\":%d" f n)) + +(defun dbx (path) + "Run dbx on program FILE in buffer *gud-FILE*. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger." + (interactive "fRun dbx on file: ") + (gud-overload-functions '((gud-debugger-startup gud-dbx-debugger-startup) + (gud-marker-filter gud-dbx-marker-filter) + (gud-visit-file gud-dbx-visit-file) + (gud-set-break gud-dbx-set-break))) + + (make-local-variable 'comint-prompt-regexp) + (setq comint-prompt-regexp "^[^)]*dbx) *") + + (gud-common-init path) + + (run-hooks 'dbx-mode-hook) + ) + +;; The job of the debugger-startup method is to fire up a copy of the debugger, +;; given an object file and source directory. +;; +;; The job of the marker-filter method is to detect file/line markers in +;; strings and set the global gud-last-frame to indicate what display +;; action (if any) should be triggered by the marker +;; +;; The job of the visit-file method is to visit and return the buffer indicated +;; by the car of gud-tag-frame. This may be a file name, a tag name, or +;; something else. +;; +;; The job of the gud-set-break method is to send the commands necessary +;; to set a breakpoint at a given line in a given source file. +;; +;; End of debugger-specific information + +(defvar gud-mode-map nil + "Keymap for gud-mode.") + +(defvar gud-command-queue nil) + +(if gud-mode-map + nil + (setq gud-mode-map (copy-keymap comint-mode-map)) + (define-key gud-mode-map "\C-l" 'gud-refresh)) + +(define-key ctl-x-map " " 'gud-break) +(define-key ctl-x-map "&" 'send-gud-command) + + +(defun gud-mode () + "Major mode for interacting with an inferior debugger process. +The following commands are available: + +\\{gud-mode-map} + +\\[gud-display-frame] displays in the other window +the last line referred to in the gud buffer. + +\\[gud-step],\\[gud-next], and \\[gud-nexti] in the gud window, +do a step-one-line, step-one-line (not entering function calls), and +step-one-instruction and then update the other window +with the current file and position. \\[gud-cont] continues +execution. + +If you are in a source file, you may set a breakpoint at the current +line in the current source file by doing \\[gud-break]. + +Commands: +Many commands are inherited from comint mode. +Additionally we have: + +\\[gud-display-frame] display frames file in other window +\\[gud-step] advance one line in program +\\[gud-next] advance one line in program (skip over calls). +\\[send-gud-command] used for special printing of an arg at the current point. +C-x SPACE sets break point at current line." + (interactive) + (comint-mode) +; (kill-all-local-variables) + (setq major-mode 'gud-mode) + (setq mode-name "Debugger") + (setq mode-line-process '(": %s")) + (use-local-map gud-mode-map) + (make-local-variable 'gud-last-frame) + (setq gud-last-frame nil) + (make-local-variable 'comint-prompt-regexp) + (run-hooks 'gud-mode-hook) +) + +(defvar current-gud-buffer nil) + +(defun gud-common-init (path) + ;; perform initializations common to all debuggers + (setq path (expand-file-name path)) + (let ((file (file-name-nondirectory path))) + (switch-to-buffer (concat "*gud-" file "*")) + (setq default-directory (file-name-directory path)) + (or (bolp) (newline)) + (insert "Current directory is " default-directory "\n") + (gud-debugger-startup file default-directory)) + (gud-mode) + (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) + (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) + (setq gud-command-queue nil) + (gud-set-buffer) + ) + +(defun gud-set-buffer () + (cond ((eq major-mode 'gud-mode) + (setq current-gud-buffer (current-buffer))))) + +(defun gud-filter (proc string) + ;; This function is responsible for inserting output from your debugger + ;; into the buffer. The hard work is done by the method that is + ;; the value of gud-marker-filter. + (let ((inhibit-quit t)) + (gud-filter-insert proc (gud-marker-filter proc string)) + ;; If we've got queued commands and we see a prompt, pop one and send it. + ;; In theory we should check that a prompt has been issued before sending + ;; queued commands. In practice, command responses from the first through + ;; penultimate elements of a command sequence are short enough that we + ;; don't really have to bother. + (if gud-command-queue + (progn + (gud-call (car gud-command-queue)) + (setq gud-command-queue (cdr gud-command-queue)) + ) + ))) + +(defun gud-filter-insert (proc string) + ;; Here's where the actual buffer insertion is done + (let ((moving (= (point) (process-mark proc))) + (output-after-point (< (point) (process-mark proc))) + (old-buffer (current-buffer)) + start) + (set-buffer (process-buffer proc)) + (unwind-protect + (save-excursion + ;; Insert the text, moving the process-marker. + (goto-char (process-mark proc)) + (setq start (point)) + (insert-before-markers string) + (set-marker (process-mark proc) (point)) + ;; Check for a filename-and-line number. + ;; Don't display the specified file + ;; unless (1) point is at or after the position where output appears + ;; and (2) this buffer is on the screen. + (if (and gud-last-frame (not output-after-point) + (get-buffer-window (current-buffer))) + (gud-display-frame)) + ) + (set-buffer old-buffer)) + (if moving (goto-char (process-mark proc))))) + +(defun gud-sentinel (proc msg) + (cond ((null (buffer-name (process-buffer proc))) + ;; buffer killed + ;; Stop displaying an arrow in a source file. + (setq overlay-arrow-position nil) + (set-process-buffer proc nil)) + ((memq (process-status proc) '(signal exit)) + ;; Stop displaying an arrow in a source file. + (setq overlay-arrow-position nil) + ;; Fix the mode line. + (setq mode-line-process + (concat ": " + (symbol-name (process-status proc)))) + (let* ((obuf (current-buffer))) + ;; save-excursion isn't the right thing if + ;; process-buffer is current-buffer + (unwind-protect + (progn + ;; Write something in *compilation* and hack its mode line, + (set-buffer (process-buffer proc)) + ;; Force mode line redisplay soon + (set-buffer-modified-p (buffer-modified-p)) + (if (eobp) + (insert ?\n mode-name " " msg) + (save-excursion + (goto-char (point-max)) + (insert ?\n mode-name " " msg))) + ;; If buffer and mode line will show that the process + ;; is dead, we can delete it now. Otherwise it + ;; will stay around until M-x list-processes. + (delete-process proc)) + ;; Restore old buffer, but don't restore old point + ;; if obuf is the gud buffer. + (set-buffer obuf)))))) + + +(defun gud-refresh (&optional arg) + "Fix up a possibly garbled display, and redraw the arrow." + (interactive "P") + (recenter arg) + (gud-display-frame)) + +(defun gud-display-frame () + "Find and obey the last filename-and-line marker from the debugger. +Obeying it means displaying in another window the specified file and line." + (interactive) + (if gud-last-frame + (progn + (gud-set-buffer) + (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) + (setq gud-last-frame nil)))) + +;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen +;; and that its line LINE is visible. +;; Put the overlay-arrow on the line LINE in that buffer. + +(defun gud-display-line (true-file line) + (let* ((buffer (gud-visit-file true-file)) + (window (display-buffer buffer t)) + (pos)) + (save-excursion + (set-buffer buffer) + (save-restriction + (widen) + (goto-line line) + (setq pos (point)) + (setq overlay-arrow-string "=>") + (or overlay-arrow-position + (setq overlay-arrow-position (make-marker))) + (set-marker overlay-arrow-position (point) (current-buffer))) + (cond ((or (< pos (point-min)) (> pos (point-max))) + (widen) + (goto-char pos)))) + (set-window-point window overlay-arrow-position))) + +(defun gud-call (command &rest args) + "Invoke the debugger COMMAND displaying source in other window." + (interactive) + (gud-set-buffer) + (goto-char (point-max)) + (let ((command (concat (apply 'format command args) "\n")) + (proc (get-buffer-process current-gud-buffer))) + (gud-filter-insert proc command) + (send-string proc command) + )) + +(defun gud-queue-send (&rest cmdlist) + ;; Send the first command, queue the rest for send after successive + ;; send on subsequent prompts + (interactive) + (gud-call (car cmdlist)) + (setq gud-command-queue (append gud-command-queue (cdr cmdlist)))) + +(defun gud-apply-from-source (func) + ;; Apply a method from the gud buffer environment, passing it file and line. + ;; This is intended to be used for gud commands called from a source file. + (if (not buffer-file-name) + (error "There is no file associated with this buffer")) + (let ((file (file-name-nondirectory buffer-file-name)) + (line (save-restriction (widen) (1+ (count-lines 1 (point)))))) + (save-excursion + (gud-set-buffer) + (funcall func + (get-buffer-process current-gud-buffer) + file + line) + ))) + +(defun gud-break () + "Set breakpoint at this source line." + (interactive) + (gud-apply-from-source 'gud-set-break)) + +(defun gud-read-address() + "Return a string containing the core-address found in the buffer at point." + (save-excursion + (let ((pt (dot)) found begin) + (setq found (if (search-backward "0x" (- pt 7) t)(dot))) + (cond (found (forward-char 2) + (setq result + (buffer-substring found + (progn (re-search-forward "[^0-9a-f]") + (forward-char -1) + (dot))))) + (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1) + (dot))) + (forward-char 1) + (re-search-forward "[^0-9]") + (forward-char -1) + (buffer-substring begin (dot))))))) + + +(defvar gud-commands nil + "List of strings or functions used by send-gud-command. +It is for customization by you.") + +(defun send-gud-command (arg) + + "This command reads the number where the cursor is positioned. It + then inserts this ADDR at the end of the debugger buffer. A numeric arg + selects the ARG'th member COMMAND of the list gud-print-command. If + COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise + (funcall COMMAND ADDR) is inserted. eg. \"p (rtx)%s->fld[0].rtint\" + is a possible string to be a member of gud-commands. " + + + (interactive "P") + (let (comm addr) + (if arg (setq comm (nth arg gud-commands))) + (setq addr (gud-read-address)) + (if (eq (current-buffer) current-gud-buffer) + (set-mark (point))) + (cond (comm + (setq comm + (if (stringp comm) (format comm addr) (funcall comm addr)))) + (t (setq comm addr))) + (switch-to-buffer current-gud-buffer) + (goto-char (dot-max)) + (insert-string comm)))