home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / xdb.el < prev    next >
Encoding:
Text File  |  1992-12-12  |  17.3 KB  |  475 lines
  1. ;; LCD Archive Entry:
  2. ;; xdb|K. Shane Hartman|shane@ai.mit.edu|
  3. ;; Run HP PA-RISC symbolic debugger in emacs buffer.|
  4. ;; 92-12-12|$Revision: 1.11 $|~/packages/xdb.tar.Z|
  5.  
  6. ;; shane@ai.mit.edu:
  7. ;;
  8. ;; Modification of gdb.el... xdb is not quite as friendly for this stuff,
  9. ;; so we cons a shitload instead!  There is probably a better solution
  10. ;; but I am paid to write expert systems, not editors.  You do it and send
  11. ;; me the changes if you have the time because I don't.
  12. ;;
  13. ;; $Header: xdb.el,v 1.10 92/12/12 14:43:56 shane Exp $
  14.  
  15. ;; Run xdb under Emacs
  16. ;; Copyright (C) 1988 Free Software Foundation, Inc.
  17. ;; Copyright (C) 1992 K. Shane Hartman.
  18.  
  19. ;; This file was part of GNU Emacs.
  20.  
  21. ;; GNU Emacs is free software; you can redistribute it and/or modify
  22. ;; it under the terms of the GNU General Public License as published by
  23. ;; the Free Software Foundation; either version 1, or (at your option)
  24. ;; any later version.
  25.  
  26. ;; GNU Emacs is distributed in the hope that it will be useful,
  27. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  28. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  29. ;; GNU General Public License for more details.
  30.  
  31. ;; You should have received a copy of the GNU General Public License
  32. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  33. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  34.  
  35. ;; Author: W. Schelter, University of Texas
  36. ;;     wfs@rascal.ics.utexas.edu
  37. ;; Rewritten by rms.
  38.  
  39. ;; Some ideas are due to  Masanobu. 
  40.  
  41. ;; Description of XDB interface:
  42.  
  43. ;; A facility is provided for the simultaneous display of the source code
  44. ;; in one window, while using xdb to step through a function in the
  45. ;; other.  A small arrow in the source window, indicates the current
  46. ;; line.
  47.  
  48. ;; Starting up:
  49.  
  50. ;; In order to use this facility, invoke the command XDB to obtain a
  51. ;; shell window with the appropriate command bindings.  You will be asked
  52. ;; for the name of a file to run.  Xdb will be invoked on this file, in a
  53. ;; window named *xdb-foo* if the file is foo.
  54.  
  55. ;; M-s steps by one line, and redisplays the source file and line.
  56.  
  57. ;; You may easily create additional commands and bindings to interact
  58. ;; with the display.  For example to put the xdb command next on \M-n
  59. ;; (def-xdb next "\M-n")
  60.  
  61. ;; This causes the emacs command xdb-next to be defined, and runs
  62. ;; xdb-display-frame after the command.
  63.  
  64. ;; xdb-display-frame is the basic display function.  It tries to display
  65. ;; in the other window, the file and line corresponding to the current
  66. ;; position in the xdb window.  For example after a xdb-step, it would
  67. ;; display the line corresponding to the position for the last step.  Or
  68. ;; if you have done a backtrace in the xdb buffer, and move the cursor
  69. ;; into one of the frames, it would display the position corresponding to
  70. ;; that frame.
  71.  
  72. ;; xdb-display-frame is invoked automatically when a filename-and-line-number
  73. ;; appears in the output.
  74.  
  75.  
  76. (require 'shell)
  77.  
  78. (require 'cl)
  79.  
  80. (defvar xdb-prompt-pattern "^>"
  81.   "A regexp to recognize the prompt for xdb or xdb++.")
  82.  
  83. (defvar xdb-noframe-filter "[][}{><;?]"
  84.   "A regexp to match text that cannot possibly contain frame information.")
  85.  
  86. (defvar xdb-help-file (expand-file-name "xdb.help")
  87.   "Location of xdb help text")
  88.  
  89. (defvar xdb-paths nil
  90.   "A list of directories containing source code that should be made known
  91. to xdb on startup.  If nil, only source files in the program directory
  92. will be known to xdb.
  93.  
  94. The pathnames should be full, or relative to the program directory.
  95. Program directory refers to the directory of the program that is being
  96. debugged.")
  97.  
  98. (defvar xdb-mode-map nil
  99.   "Keymap for xdb-mode.")
  100.  
  101. (if xdb-mode-map
  102.    nil
  103.   (setq xdb-mode-map (copy-keymap shell-mode-map))
  104.   (define-key xdb-mode-map "\C-l" 'xdb-refresh)
  105.   (define-key xdb-mode-map "\M-h" 'xdb-help))
  106.  
  107. (define-key ctl-x-map " " 'xdb-break)
  108. (define-key ctl-x-map "&" 'send-xdb-command)
  109.  
  110. ;;Of course you may use `def-xdb' with any other xdb command, including
  111. ;;user defined ones.   
  112.  
  113. (defmacro def-xdb (name key &optional doc)
  114.   (let* ((fun (intern (format "xdb-%s" name)))
  115.      (cstr (list 'if '(not (= 1 arg))
  116.              (list 'format "%s %s" name 'arg)
  117.              name)))
  118.     (list 'progn
  119.        (list 'defun fun '(arg)
  120.         (or doc "")
  121.         '(interactive "p")
  122.         (list 'xdb-call cstr))
  123.       (list 'define-key 'xdb-mode-map key  (list 'quote fun)))))
  124.  
  125. (def-xdb "s"  "\M-s" "Step one source line with display")
  126. (def-xdb "S"  "\M-n" "Step one source line (skip functions)")
  127. (def-xdb "c"  "\M-c" "Continue with display")
  128.  
  129. (def-xdb "bu\\t\nc" "\C-c\C-f" "Finish executing current function")
  130. (def-xdb "up"       "\M-u" "Go up N stack frames (numeric arg) with display")
  131. (def-xdb "down"     "\M-d" "Go down N stack frames (numeric arg) with display")
  132. (def-xdb "top"      "\M-." "Go to the current stack frame.")
  133.  
  134. (defvar xdb-last-frame)
  135. (defvar xdb-last-frame-displayed-p)
  136. (defvar xdb-delete-prompt-marker)
  137. (defvar xdb-filter-accumulator)
  138.  
  139. (defun xdb-mode ()
  140.   "Major mode for interacting with an inferior Xdb process.
  141. The following commands are available:
  142.  
  143. \\[xdb-display-frame] displays in the other window the last line
  144. referred to in the xdb buffer.
  145.  
  146. \\[xdb-s], \\[xdb-S], and \\[xdb-c] in the xdb window
  147. call xdb to step one source line, step one source line (skip over calls),
  148. or continue to next breakpoint and then update
  149. the other window with the current file and position.
  150.  
  151. \\[xdb-bu\\t\nc] contines execution until the current procedure returns.
  152.  
  153. If you are in a source file, you may select a point to break
  154. at, by doing \\[xdb-break] at that line.
  155.  
  156. Commands:
  157. Many commands are inherited from shell mode. 
  158. Additionally we have:
  159.  
  160. \\[xdb-help] displays debugger command help.
  161. \\[xdb-display-frame] display frames file in other window
  162. \\[send-xdb-command] used for special printing of an arg at the current point.
  163. \\[xdb-up] goes up one stack frame.
  164. \\[xdb-down] goes down one stack frame.
  165. \\[xdb-top] goes to the top (current) stack frame.
  166. \\[xdb-s] advance one line in program
  167. \\[xdb-S] advance one line in program (skip over calls).
  168. \\[xdb-c] continue execution until a breakpoint is hit."
  169.   (interactive)
  170.   (kill-all-local-variables)
  171.   (setq major-mode 'xdb-mode)
  172.   (setq mode-name "Inferior Xdb")
  173.   (setq mode-line-process '(": %s"))
  174.   (use-local-map xdb-mode-map)
  175.   (make-local-variable 'last-input-start)
  176.   (setq last-input-start (make-marker))
  177.   (make-local-variable 'last-input-end)
  178.   (setq last-input-end (make-marker))
  179.   (make-local-variable 'xdb-last-frame)
  180.   (setq xdb-last-frame nil)
  181.   (make-local-variable 'xdb-last-frame-displayed-p)
  182.   (setq xdb-last-frame-displayed-p t)
  183.   (make-local-variable 'xdb-delete-prompt-marker)
  184.   (setq xdb-delete-prompt-marker nil)
  185.   (make-local-variable 'xdb-filter-accumulator)
  186.   (setq xdb-filter-accumulator nil)
  187.   (make-local-variable 'shell-prompt-pattern)
  188.   (setq shell-prompt-pattern xdb-prompt-pattern)
  189.   (run-hooks 'shell-mode-hook 'xdb-mode-hook))
  190.  
  191. (defvar current-xdb-buffer nil)
  192.  
  193. (defvar xdb-command-name "xdb"
  194.   "Pathname for executing xdb.")
  195.  
  196. (defun xdb (path)
  197.   "Run xdb on program FILE in buffer *xdb-file*.
  198. The directory containing FILE becomes the initial working directory
  199. and source-file directory for XDB.  If you wish to change this, use
  200. the XDB commands `cd DIR' and `directory'."
  201.   (interactive "FRun xdb on file: ")
  202.   (setq path (expand-file-name path))
  203.   (let ((file (file-name-nondirectory path)))
  204.     (switch-to-buffer (concat "*xdb-" file "*"))
  205.     (setq default-directory (file-name-directory path))
  206.     (or (bolp) (newline))
  207.     (insert "Current directory is " default-directory "\n")
  208.     (let ((form (list 'make-shell
  209.                       (concat "xdb-" file)
  210.                       xdb-command-name
  211.                       nil
  212.                       "-d"
  213.                       default-directory)))
  214.       (if xdb-paths
  215.           (dolist (p xdb-paths)
  216.                   (nconc (last form) (list "-d" p))))
  217.       (nconc (last form) (list file))
  218.       (eval form))
  219.     (xdb-mode)
  220.     (set-process-filter (get-buffer-process (current-buffer)) 'xdb-filter)
  221.     (set-process-sentinel (get-buffer-process (current-buffer)) 'xdb-sentinel)
  222.     (xdb-set-buffer)))
  223.  
  224. (defun xdb-set-buffer ()
  225.   (cond ((eq major-mode 'xdb-mode)
  226.     (setq current-xdb-buffer (current-buffer)))))
  227.  
  228. ;; This function is responsible for inserting output from XDB
  229. ;; into the buffer.
  230. ;; Aside from inserting the text, it notices and deletes
  231. ;; each filename-and-line-number;
  232. ;; that XDB prints to identify the selected frame.
  233. ;; It records the filename and line number, and maybe displays that file.
  234. (defun xdb-filter (proc string)
  235.   (let ((inhibit-quit t))
  236.     (xdb-filter-scan-input proc string)))
  237.  
  238. (defun xdb-make-file (file)
  239.   (if (not (file-exists-p file))
  240.       (let ((f nil))
  241.         (dolist (d xdb-paths)
  242.                 (if (null f)
  243.                     (progn (setq f (concat d "/" file))
  244.                            (if (not (file-exists-p f))
  245.                                (setq f nil)))))
  246.         (if f (setq file f))))
  247.   file)
  248.  
  249. (defun xdb-parse-frame (proc string)
  250.   (cond ((string-match "[^: ]+: [^: ]+: [0-9]+:" string 0)
  251.          (let* ((first-colon (string-match ":" string 0))
  252.                 (second-colon (string-match ":" string (1+ first-colon)))
  253.                 (third-colon (string-match ":" string (1+ second-colon))))
  254.            (setq xdb-last-frame-displayed-p nil)
  255.            (setq xdb-last-frame
  256.                  (cons (xdb-make-file (substring string 0 first-colon))
  257.                        (string-to-int (substring string (1+ second-colon)
  258.                                                  third-colon))))))
  259.         ((string-match "[^: ]+: [^: ]+: [0-9]+ \\+" string 0)
  260.          ;; A breakpoint
  261.          (let* ((first-colon (string-match ":" string 0))
  262.                 (second-colon (string-match ":" string (1+ first-colon)))
  263.                 (third-colon (string-match "+" string (1+ second-colon))))
  264.            (setq xdb-last-frame-displayed-p nil)
  265.            (setq xdb-last-frame
  266.                  (cons (xdb-make-file (substring string 0 first-colon))
  267.                        (string-to-int (substring string (1+ second-colon)
  268.                                                  third-colon))))))))
  269. (defun string-member (string char)
  270.   (let (result (len (length string)) (i 0))
  271.     (while (and (< i len) (not result))
  272.       (if (eq (aref string i) char)
  273.           (setq result i)
  274.         (setq i (1+ i))))
  275.     result))
  276.  
  277. (defun xdb-filter-scan-input (proc string)
  278.   (setq xdb-filter-accumulator (concat xdb-filter-accumulator string))
  279.   (let ((end (string-member xdb-filter-accumulator ?\012)))
  280.     (while end
  281.       (let ((line (substring xdb-filter-accumulator 0 (1+ end))))
  282.         (if (not (xdb-parse-frame proc line))
  283.             (xdb-filter-insert proc line))
  284.         (setq xdb-filter-accumulator
  285.               (substring xdb-filter-accumulator (1+ end))))
  286.       (setq end (string-member xdb-filter-accumulator ?\012)))
  287.     (cond ((string-match xdb-prompt-pattern xdb-filter-accumulator)
  288.            (progn (xdb-filter-insert proc xdb-filter-accumulator)
  289.                   (setq xdb-filter-accumulator nil)))
  290.           ((string-match xdb-noframe-filter xdb-filter-accumulator)
  291.            (progn (xdb-filter-insert proc xdb-filter-accumulator)
  292.                   (setq xdb-filter-accumulator nil))))))
  293.  
  294. (defun xdb-filter-insert (proc string)
  295.   (let ((moving (= (point) (process-mark proc)))
  296.     (output-after-point (< (point) (process-mark proc)))
  297.     (old-buffer (current-buffer))
  298.     start)
  299.     (set-buffer (process-buffer proc))
  300.     (unwind-protect
  301.     (save-excursion
  302.       ;; Insert the text, moving the process-marker.
  303.       (goto-char (process-mark proc))
  304.       (setq start (point))
  305.       (insert string)
  306.       (set-marker (process-mark proc) (point))
  307.       (xdb-maybe-delete-prompt)
  308.       ;; Check for a filename-and-line number.
  309.       (xdb-display-frame
  310.        ;; Don't display the specified file
  311.        ;; unless (1) point is at or after the position where output appears
  312.        ;; and (2) this buffer is on the screen.
  313.        (or output-after-point
  314.            (not (get-buffer-window (current-buffer))))
  315.        ;; Display a file only when a new filename-and-line-number appears.
  316.        t))
  317.       (set-buffer old-buffer))
  318.     (if moving (goto-char (process-mark proc)))))
  319.  
  320. (defun xdb-sentinel (proc msg)
  321.   (cond ((null (buffer-name (process-buffer proc)))
  322.      ;; buffer killed
  323.      ;; Stop displaying an arrow in a source file.
  324.      (setq overlay-arrow-position nil)
  325.      (set-process-buffer proc nil))
  326.     ((memq (process-status proc) '(signal exit))
  327.      ;; Stop displaying an arrow in a source file.
  328.      (setq overlay-arrow-position nil)
  329.      ;; Fix the mode line.
  330.      (setq mode-line-process
  331.            (concat ": "
  332.                (symbol-name (process-status proc))))
  333.      (let* ((obuf (current-buffer)))
  334.        ;; save-excursion isn't the right thing if
  335.        ;;  process-buffer is current-buffer
  336.        (unwind-protect
  337.            (progn
  338.          ;; Write something in *compilation* and hack its mode line,
  339.          (set-buffer (process-buffer proc))
  340.          ;; Force mode line redisplay soon
  341.          (set-buffer-modified-p (buffer-modified-p))
  342.          (if (eobp)
  343.              (insert ?\n mode-name " " msg)
  344.            (save-excursion
  345.              (goto-char (point-max))
  346.              (insert ?\n mode-name " " msg)))
  347.          ;; If buffer and mode line will show that the process
  348.          ;; is dead, we can delete it now.  Otherwise it
  349.          ;; will stay around until M-x list-processes.
  350.          (delete-process proc))
  351.          ;; Restore old buffer, but don't restore old point
  352.          ;; if obuf is the xdb buffer.
  353.          (set-buffer obuf))))))
  354.  
  355.  
  356. (defun xdb-refresh ()
  357.   "Fix up a possibly garbled display, and redraw the arrow."
  358.   (interactive)
  359.   (xdb-call "L")                        ;get the current location
  360.   (redraw-display)
  361.   (xdb-display-frame))
  362.  
  363. (defun xdb-display-frame (&optional nodisplay noauto)
  364.   "Find, obey and delete the last filename-and-line marker from XDB.
  365. The marker looks like FILENAME:\\032:\\032PROC:\\032LINE:\\032TEXT\\n.
  366. Obeying it means displaying in another window the specified file and line."
  367.   (interactive)
  368.   (xdb-set-buffer)
  369.   (and xdb-last-frame (not nodisplay)
  370.        (or (not xdb-last-frame-displayed-p) (not noauto))
  371.        (file-exists-p (car xdb-last-frame)) ;no garbage!
  372.        (progn (xdb-display-line (car xdb-last-frame) (cdr xdb-last-frame))
  373.           (setq xdb-last-frame-displayed-p t))))
  374.  
  375. ;; Make sure the file named TRUE-file is in a buffer that appears on the screen
  376. ;; and that its line LINE is visible.
  377. ;; Put the overlay-arrow on the line LINE in that buffer.
  378.  
  379. (defun xdb-display-line (true-file line)
  380.   (let* ((buffer (find-file-noselect true-file))
  381.      (window (display-buffer buffer t))
  382.      (pos))
  383.     (save-excursion
  384.       (set-buffer buffer)
  385.       (save-restriction
  386.     (widen)
  387.     (goto-line line)
  388.     (setq pos (point))
  389.     (setq overlay-arrow-string "=>")
  390.     (or overlay-arrow-position
  391.         (setq overlay-arrow-position (make-marker)))
  392.     (set-marker overlay-arrow-position (point) (current-buffer)))
  393.       (cond ((or (< pos (point-min)) (> pos (point-max)))
  394.          (widen)
  395.          (goto-char pos))))
  396.     (set-window-point window overlay-arrow-position)))
  397.  
  398. (defun xdb-help ()
  399.   "Display xdb command help."
  400.   (interactive)
  401.   (view-buffer (find-file-noselect xdb-help-file)))
  402.  
  403.  
  404. (defun xdb-call (command)
  405.   "Invoke xdb COMMAND displaying source in other window."
  406.   (interactive)
  407.   (goto-char (point-max))
  408.   (setq xdb-delete-prompt-marker (point-marker))
  409.   (xdb-set-buffer)
  410.   (send-string (get-buffer-process current-xdb-buffer)
  411.            (concat command "\n")))
  412.  
  413. (defun xdb-maybe-delete-prompt ()
  414.   (if (and xdb-delete-prompt-marker
  415.        (> (point-max) (marker-position xdb-delete-prompt-marker)))
  416.       (let (start)
  417.     (goto-char xdb-delete-prompt-marker)
  418.     (setq start (point))
  419.     (beginning-of-line)
  420.     (delete-region (point) start)
  421.     (setq xdb-delete-prompt-marker nil))))
  422.  
  423. (defun xdb-break ()
  424.   "Set XDB breakpoint at this source line."
  425.   (interactive)
  426.   (let ((file-name (file-name-nondirectory buffer-file-name))
  427.     (line (save-restriction
  428.         (widen)
  429.         (1+ (count-lines 1 (point))))))
  430.     (send-string (get-buffer-process current-xdb-buffer)
  431.          (concat "b " file-name ":" line "\n"))))
  432.  
  433. (defun xdb-read-address()
  434.   "Return a string containing the core-address found in the buffer at point."
  435.   (save-excursion
  436.    (let ((pt (point)) found begin)
  437.      (setq found (if (search-backward "0x" (- pt 7) t)(point)))
  438.      (cond (found (forward-char 2)
  439.                   (buffer-substring found
  440.                                     (progn (re-search-forward "[^0-9a-f]")
  441.                                            (forward-char -1)
  442.                                            (point))))
  443.        (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
  444.                  (point)))
  445.           (forward-char 1)
  446.           (re-search-forward "[^0-9]")
  447.           (forward-char -1)
  448.           (buffer-substring begin (point)))))))
  449.  
  450.  
  451. (defvar xdb-commands nil
  452.   "List of strings or functions used by send-xdb-command.
  453. It is for customization by you.")
  454.  
  455. (defun send-xdb-command (arg)
  456.   "This command reads the number where the cursor is positioned.  It
  457.  then inserts this ADDR at the end of the xdb buffer.  A numeric arg
  458.  selects the ARG'th member COMMAND of the list xdb-print-command.  If
  459.  COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
  460.  (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
  461.  is a possible string to be a member of xdb-commands.  "
  462.   (interactive "P")
  463.   (let (comm addr)
  464.     (if arg (setq comm (nth arg xdb-commands)))
  465.     (setq addr (xdb-read-address))
  466.     (if (eq (current-buffer) current-xdb-buffer)
  467.     (set-mark (point)))
  468.     (cond (comm
  469.        (setq comm
  470.          (if (stringp comm) (format comm addr) (funcall comm addr))))
  471.       (t (setq comm addr)))
  472.     (switch-to-buffer current-xdb-buffer)
  473.     (goto-char (point-max))
  474.     (insert-string comm)))
  475.