daily update
[binutils.git] / binutils / dwarf-mode.el
blobf95319ded5cfcd7bd2152d2a9ff553dd921035fd
1 ;;; dwarf-mode.el --- Browser for DWARF information.
3 ;; Version: 1.0
5 ;; This file is not part of GNU Emacs, but is distributed under the
6 ;; same terms:
8 ;; GNU Emacs is free software: you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21 ;;; Code:
23 (defvar dwarf-objdump-program "objdump")
25 (defconst dwarf-font-lock-keywords
27 ;; Name and linkage name.
28 ("DW_AT_[a-z_]*name\\s *: .*:\\(.*\\)\\s *$"
29 (1 font-lock-function-name-face))
31 ("Compilation Unit @ offset 0x[0-9a-f]+"
32 (0 font-lock-string-face))
35 (defvar dwarf-file nil
36 "Buffer-local variable holding the file name passed to objdump.")
38 ;; Expand a "..." to show all the child DIES. NEW-DEPTH controls how
39 ;; deep to display the new dies; `nil' means display all of them.
40 (defun dwarf-do-insert-substructure (new-depth die)
41 (let ((inhibit-read-only t))
42 (beginning-of-line)
43 (delete-region (point) (progn
44 (end-of-line)
45 (forward-char)
46 (point)))
47 (save-excursion
48 (apply #'call-process dwarf-objdump-program nil (current-buffer) nil
49 "-Wi" (concat "--dwarf-start=0x" die)
50 (expand-file-name dwarf-file)
51 (if new-depth (list (concat "--dwarf-depth="
52 (int-to-string new-depth))))))
53 (set-buffer-modified-p nil)))
55 (defun dwarf-insert-substructure-button (die)
56 (beginning-of-line)
57 (unless (looking-at "^ <\\([0-9]+\\)>")
58 (error "Unrecognized line."))
59 (let ((new-depth (1+ (string-to-int (match-string 1)))))
60 (dwarf-do-insert-substructure new-depth die)))
62 (defun dwarf-insert-substructure (arg)
63 "Expand a `...' to show children of the current DIE.
64 By default, expands just one level of children.
65 A prefix argument means expand all children."
66 (interactive "P")
67 (beginning-of-line)
68 (unless (looking-at "^ <\\([0-9]+\\)><\\([0-9a-f]+\\)>")
69 (error "Unrecognized line."))
70 (let ((die (match-string 2)))
71 (if arg
72 (dwarf-do-insert-substructure nil die)
73 (dwarf-insert-substructure-button die))))
75 ;; Called when a button is pressed.
76 ;; Either follows a DIE reference, or expands a "...".
77 (defun dwarf-die-button-action (button)
78 (let* ((die (button-get button 'die))
79 ;; Note that the first number can only be decimal.
80 (die-rx (concat "^\\s *\\(<[0-9]+>\\)?<"
81 die ">[^<]"))
82 (old (point))
83 (is-ref (button-get button 'die-ref)))
84 (if is-ref
85 (progn
86 (goto-char (point-min))
87 (if (re-search-forward die-rx nil 'move)
88 (push-mark old)
89 (goto-char old)
90 (error "Could not find DIE <0x%s>" die)))
91 (dwarf-insert-substructure-button die))))
93 ;; Button definition.
94 (define-button-type 'dwarf-die-button
95 'follow-link t
96 'action #'dwarf-die-button-action)
98 ;; Helper regexp to match a DIE reference.
99 (defconst dwarf-die-reference ": \\(<0x\\([0-9a-f]+\\)>\\)\\s *$")
101 ;; Helper regexp to match a `...' indicating that there are hidden
102 ;; children.
103 (defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)")
105 ;; jit-lock callback function to fontify a region. This applies the
106 ;; buttons, since AFAICT there is no good way to apply buttons via
107 ;; font-lock.
108 (defun dwarf-fontify-region (start end)
109 (save-excursion
110 (let ((beg-line (progn (goto-char start) (line-beginning-position)))
111 (end-line (progn (goto-char end) (line-end-position))))
112 (goto-char beg-line)
113 (while (re-search-forward dwarf-die-reference end-line 'move)
114 (let ((b-start (match-beginning 1))
115 (b-end (match-end 1))
116 (hex (match-string-no-properties 2)))
117 (make-text-button b-start b-end :type 'dwarf-die-button
118 'die hex 'die-ref t)))
119 ;; This is a bogus approach. Why can't we make buttons from the
120 ;; font-lock defaults?
121 (goto-char beg-line)
122 (while (re-search-forward dwarf-die-more end-line 'move)
123 (let ((hex (match-string-no-properties 1))
124 (b-start (match-beginning 2))
125 (b-end (match-end 2)))
126 (make-text-button b-start b-end :type 'dwarf-die-button
127 'die hex 'die-ref nil))))))
129 ;; Run objdump and insert the contents into the buffer. The arguments
130 ;; are the way they are because this is also called as a
131 ;; revert-buffer-function.
132 (defun dwarf-do-refresh (&rest ignore)
133 (let ((inhibit-read-only t))
134 (erase-buffer)
135 (save-excursion
136 (call-process dwarf-objdump-program
137 nil (current-buffer) nil
138 "-Wi" "--dwarf-depth=1"
139 (expand-file-name dwarf-file)))
140 (set-buffer-modified-p nil)))
142 ;;;###autoload
143 (define-derived-mode dwarf-mode special-mode "DWARF"
144 "Major mode for browsing DWARF output.
146 \\{dwarf-mode-map}"
148 (set (make-local-variable 'font-lock-defaults) '(dwarf-font-lock-keywords))
149 ;; FIXME: we could be smarter and check the file time.
150 (set (make-local-variable 'revert-buffer-function) #'dwarf-do-refresh)
151 (jit-lock-register #'dwarf-fontify-region))
153 (define-key dwarf-mode-map [(control ?m)] #'dwarf-insert-substructure)
155 ;;:###autoload
156 (defun dwarf-browse (file)
157 "Invoke `objdump' and put output into a `dwarf-mode' buffer.
158 This is the main interface to `dwarf-mode'."
159 (interactive "fFile name: ")
160 (let* ((base-name (file-name-nondirectory file))
161 (buffer (generate-new-buffer (concat "*DWARF for " base-name "*"))))
162 (pop-to-buffer buffer)
163 (dwarf-mode)
164 (set (make-local-variable 'dwarf-file) file)
165 (dwarf-do-refresh)))
167 (provide 'dwarf-mode)