Automatic date update in version.in
[binutils-gdb.git] / binutils / dwarf-mode.el
blob9df875ca4fe8526e680698339d55e208afea1ed6
1 ;;; dwarf-mode.el --- Browser for DWARF information. -*-lexical-binding:t-*-
3 ;; Version: 1.7
5 ;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
7 ;; This file is not part of GNU Emacs, but is distributed under the
8 ;; same terms:
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Code:
25 (defvar dwarf-objdump-program "objdump")
27 (defconst dwarf-font-lock-keywords
29 ;; Name and linkage name.
30 ("DW_AT_[a-zA-Z_]*name\\s *:\\(?:\\s *(.*):\\)?\\s *\\(.*\\)\\s *$"
31 (1 font-lock-function-name-face))
33 ("Compilation Unit @ offset 0x[0-9a-f]+"
34 (0 font-lock-string-face))
37 (defvar dwarf-file nil
38 "Buffer-local variable holding the file name passed to objdump.")
40 (defvar dwarf--process nil
41 "Running objdump process, or nil.")
43 (defvar dwarf--deletion-region nil
44 "Region to delete before inserting text in `dwarf--filter'.")
46 (defun dwarf--check-running ()
47 "Throw an exception if an objdump process is already running."
48 (when dwarf--process
49 (error "An objdump process is still running in this buffer")))
51 (defun dwarf--filter (proc string)
52 "Filter function for objdump processes."
53 (when (buffer-live-p (process-buffer proc))
54 (with-current-buffer (process-buffer proc)
55 (save-excursion
56 (let ((inhibit-read-only t))
57 (when dwarf--deletion-region
58 (apply #'delete-region dwarf--deletion-region)
59 (setq dwarf--deletion-region nil))
60 (goto-char (process-mark proc))
61 (insert string)
62 (set-marker (process-mark proc) (point))
63 (set-buffer-modified-p nil))))))
65 (defun dwarf--sentinel (proc _status)
66 (when (buffer-live-p (process-buffer proc))
67 (with-current-buffer (process-buffer proc)
68 (setq mode-line-process nil)
69 (setq dwarf--process nil))))
71 (defun dwarf--invoke (start end &rest command)
72 "Invoke a command and arrange to insert output into the current buffer."
73 (setq mode-line-process "[Running]")
74 (setq dwarf--deletion-region (list start end))
75 (setq dwarf--process (make-process :name "objdump"
76 :buffer (current-buffer)
77 :command command
78 :connection-type 'pipe
79 :noquery t
80 :filter #'dwarf--filter
81 :sentinel #'dwarf--sentinel))
82 (set-marker (process-mark dwarf--process) (point)))
84 ;; Expand a "..." to show all the child DIES. NEW-DEPTH controls how
85 ;; deep to display the new dies; `nil' means display all of them.
86 (defun dwarf-do-insert-substructure (new-depth die)
87 (dwarf--check-running)
88 (let ((inhibit-read-only t))
89 (beginning-of-line)
90 (apply #'dwarf--invoke
91 (point) (save-excursion
92 (end-of-line)
93 (forward-char)
94 (point))
95 dwarf-objdump-program "-Wi" (concat "--dwarf-start=0x" die)
96 (expand-file-name dwarf-file)
97 (if new-depth (list (concat "--dwarf-depth="
98 (int-to-string new-depth)))))
99 (set-buffer-modified-p nil)))
101 (defun dwarf-insert-substructure-button (die)
102 (beginning-of-line)
103 (unless (looking-at "^ <\\([0-9]+\\)>")
104 (error "Unrecognized line."))
105 (let ((new-depth (1+ (string-to-number (match-string 1)))))
106 (dwarf-do-insert-substructure new-depth die)))
108 (defun dwarf-insert-substructure (arg)
109 "Expand a `...' to show children of the current DIE.
110 By default, expands just one level of children.
111 A prefix argument means expand all children."
112 (interactive "P")
113 (beginning-of-line)
114 (unless (looking-at "^ <\\([0-9]+\\)><\\([0-9a-f]+\\)>")
115 (error "Unrecognized line."))
116 (let ((die (match-string 2)))
117 (if arg
118 (dwarf-do-insert-substructure nil die)
119 (dwarf-insert-substructure-button die))))
121 ;; Called when a button is pressed.
122 ;; Either follows a DIE reference, or expands a "...".
123 (defun dwarf-die-button-action (button)
124 (let* ((die (button-get button 'die))
125 ;; Note that the first number can only be decimal. It is
126 ;; included in this search because otherwise following a ref
127 ;; might lead to a zero-length boolean attribute in the
128 ;; previous DIE.
129 (die-rx (concat "^\\s *<[0-9]+><" die ">:"))
130 (old (point))
131 (is-ref (button-get button 'die-ref)))
132 (if is-ref
133 (progn
134 (goto-char (point-min))
135 (if (re-search-forward die-rx nil 'move)
136 (push-mark old)
137 (goto-char old)
138 (error "Could not find DIE <0x%s>" die)))
139 (dwarf-insert-substructure-button die))))
141 ;; Button definition.
142 (define-button-type 'dwarf-die-button
143 'follow-link t
144 'action #'dwarf-die-button-action)
146 ;; Helper regexp to match a DIE reference.
147 (defconst dwarf-die-reference "\\(<0x\\([0-9a-f]+\\)>\\)")
149 ;; Helper regexp to match a `...' indicating that there are hidden
150 ;; children.
151 (defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)")
153 ;; jit-lock callback function to fontify a region. This applies the
154 ;; buttons, since AFAICT there is no good way to apply buttons via
155 ;; font-lock.
156 (defun dwarf-fontify-region (start end)
157 (save-excursion
158 (let ((beg-line (progn (goto-char start) (line-beginning-position)))
159 (end-line (progn (goto-char end) (line-end-position))))
160 (goto-char beg-line)
161 (while (re-search-forward dwarf-die-reference end-line 'move)
162 (let ((b-start (match-beginning 1))
163 (b-end (match-end 1))
164 (hex (match-string-no-properties 2)))
165 (make-text-button b-start b-end :type 'dwarf-die-button
166 'die hex 'die-ref t)))
167 ;; This is a bogus approach. Why can't we make buttons from the
168 ;; font-lock defaults?
169 (goto-char beg-line)
170 (while (re-search-forward dwarf-die-more end-line 'move)
171 (let ((hex (match-string-no-properties 1))
172 (b-start (match-beginning 2))
173 (b-end (match-end 2)))
174 (make-text-button b-start b-end :type 'dwarf-die-button
175 'die hex 'die-ref nil))))))
177 ;; Run objdump and insert the contents into the buffer. The arguments
178 ;; are the way they are because this is also called as a
179 ;; revert-buffer-function.
180 (defun dwarf-do-refresh (&rest ignore)
181 (dwarf--check-running)
182 (let ((inhibit-read-only t))
183 (dwarf--invoke (point-min) (point-max)
184 dwarf-objdump-program "-Wi" "--dwarf-depth=1"
185 (expand-file-name dwarf-file))
186 (set-buffer-modified-p nil)))
188 (defvar dwarf-mode-syntax-table
189 (let ((table (make-syntax-table)))
190 ;; This at least makes it so mark-sexp on some hex digits inside
191 ;; <...> does not also copy the ">".
192 (modify-syntax-entry ?< "(>" table)
193 (modify-syntax-entry ?> ")<" table)
194 table)
195 "Syntax table for dwarf-mode buffers.")
197 (defvar dwarf-mode-map
198 (let ((map (make-sparse-keymap)))
199 (set-keymap-parent map special-mode-map)
200 (define-key map [(control ?m)] #'dwarf-insert-substructure)
201 map)
202 "Keymap for dwarf-mode buffers.")
204 (define-derived-mode dwarf-mode special-mode "DWARF"
205 "Major mode for browsing DWARF output.
207 \\{dwarf-mode-map}"
209 (set (make-local-variable 'font-lock-defaults) '(dwarf-font-lock-keywords))
210 ;; FIXME: we could be smarter and check the file time.
211 (set (make-local-variable 'revert-buffer-function) #'dwarf-do-refresh)
212 (jit-lock-register #'dwarf-fontify-region))
214 ;;;###autoload
215 (defun dwarf-browse (file)
216 "Invoke `objdump' and put output into a `dwarf-mode' buffer.
217 This is the main interface to `dwarf-mode'."
218 (interactive "fFile name: ")
219 (let* ((base-name (file-name-nondirectory file))
220 (buffer (generate-new-buffer (concat "*DWARF for " base-name "*"))))
221 (pop-to-buffer buffer)
222 (dwarf-mode)
223 (setq default-directory (file-name-directory file))
224 (set (make-local-variable 'dwarf-file) file)
225 (set (make-local-variable 'dwarf--process) nil)
226 (set (make-local-variable 'dwarf--deletion-region) nil)
227 (dwarf-do-refresh)))
229 (provide 'dwarf-mode)
231 ;;; dwarf-mode.el ends here