Commit | Line | Data |
---|---|---|
e4905c74 | 1 | ;;; dwarf-mode.el --- Browser for DWARF information. -*-lexical-binding:t-*- |
fd2f0033 | 2 | |
d3511b24 | 3 | ;; Version: 1.6 |
fd2f0033 | 4 | |
250d07de | 5 | ;; Copyright (C) 2012-2021 Free Software Foundation, Inc. |
5bf135a7 | 6 | |
fd2f0033 TT |
7 | ;; This file is not part of GNU Emacs, but is distributed under the |
8 | ;; same terms: | |
9 | ||
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. | |
14 | ||
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. | |
19 | ||
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/>. | |
22 | ||
23 | ;;; Code: | |
24 | ||
25 | (defvar dwarf-objdump-program "objdump") | |
26 | ||
27 | (defconst dwarf-font-lock-keywords | |
28 | '( | |
29 | ;; Name and linkage name. | |
d3511b24 | 30 | ("DW_AT_[a-zA-Z_]*name\\s *:\\(?:\\s *(.*):\\)?\\s *\\(.*\\)\\s *$" |
fd2f0033 TT |
31 | (1 font-lock-function-name-face)) |
32 | ||
33 | ("Compilation Unit @ offset 0x[0-9a-f]+" | |
34 | (0 font-lock-string-face)) | |
35 | )) | |
36 | ||
37 | (defvar dwarf-file nil | |
38 | "Buffer-local variable holding the file name passed to objdump.") | |
39 | ||
c85fa91b TT |
40 | (defvar dwarf--process nil |
41 | "Running objdump process, or nil.") | |
42 | ||
43 | (defvar dwarf--deletion-region nil | |
44 | "Region to delete before inserting text in `dwarf--filter'.") | |
45 | ||
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"))) | |
50 | ||
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)))))) | |
64 | ||
65 | (defun dwarf--sentinel (_proc _status) | |
66 | (setq mode-line-process nil) | |
67 | (setq dwarf--process nil)) | |
68 | ||
69 | (defun dwarf--invoke (start end &rest command) | |
70 | "Invoke a command and arrange to insert output into the current buffer." | |
71 | (setq mode-line-process "[Running]") | |
72 | (setq dwarf--deletion-region (list start end)) | |
73 | (setq dwarf--process (make-process :name "objdump" | |
74 | :buffer (current-buffer) | |
75 | :command command | |
76 | :connection-type 'pipe | |
77 | :noquery t | |
78 | :filter #'dwarf--filter | |
79 | :sentinel #'dwarf--sentinel)) | |
80 | (set-marker (process-mark dwarf--process) (point))) | |
81 | ||
fd2f0033 TT |
82 | ;; Expand a "..." to show all the child DIES. NEW-DEPTH controls how |
83 | ;; deep to display the new dies; `nil' means display all of them. | |
84 | (defun dwarf-do-insert-substructure (new-depth die) | |
c85fa91b | 85 | (dwarf--check-running) |
fd2f0033 TT |
86 | (let ((inhibit-read-only t)) |
87 | (beginning-of-line) | |
c85fa91b TT |
88 | (apply #'dwarf--invoke |
89 | (point) (save-excursion | |
90 | (end-of-line) | |
91 | (forward-char) | |
92 | (point)) | |
93 | dwarf-objdump-program "-Wi" (concat "--dwarf-start=0x" die) | |
94 | (expand-file-name dwarf-file) | |
95 | (if new-depth (list (concat "--dwarf-depth=" | |
96 | (int-to-string new-depth))))) | |
fd2f0033 TT |
97 | (set-buffer-modified-p nil))) |
98 | ||
99 | (defun dwarf-insert-substructure-button (die) | |
100 | (beginning-of-line) | |
101 | (unless (looking-at "^ <\\([0-9]+\\)>") | |
102 | (error "Unrecognized line.")) | |
6f7b1488 | 103 | (let ((new-depth (1+ (string-to-number (match-string 1))))) |
fd2f0033 TT |
104 | (dwarf-do-insert-substructure new-depth die))) |
105 | ||
106 | (defun dwarf-insert-substructure (arg) | |
107 | "Expand a `...' to show children of the current DIE. | |
108 | By default, expands just one level of children. | |
109 | A prefix argument means expand all children." | |
110 | (interactive "P") | |
111 | (beginning-of-line) | |
112 | (unless (looking-at "^ <\\([0-9]+\\)><\\([0-9a-f]+\\)>") | |
113 | (error "Unrecognized line.")) | |
114 | (let ((die (match-string 2))) | |
115 | (if arg | |
116 | (dwarf-do-insert-substructure nil die) | |
117 | (dwarf-insert-substructure-button die)))) | |
118 | ||
119 | ;; Called when a button is pressed. | |
120 | ;; Either follows a DIE reference, or expands a "...". | |
121 | (defun dwarf-die-button-action (button) | |
122 | (let* ((die (button-get button 'die)) | |
d3511b24 TT |
123 | ;; Note that the first number can only be decimal. It is |
124 | ;; included in this search because otherwise following a ref | |
125 | ;; might lead to a zero-length boolean attribute in the | |
126 | ;; previous DIE. | |
127 | (die-rx (concat "^\\s *<[0-9]+><" die ">:")) | |
fd2f0033 TT |
128 | (old (point)) |
129 | (is-ref (button-get button 'die-ref))) | |
130 | (if is-ref | |
131 | (progn | |
132 | (goto-char (point-min)) | |
133 | (if (re-search-forward die-rx nil 'move) | |
134 | (push-mark old) | |
135 | (goto-char old) | |
136 | (error "Could not find DIE <0x%s>" die))) | |
137 | (dwarf-insert-substructure-button die)))) | |
138 | ||
139 | ;; Button definition. | |
140 | (define-button-type 'dwarf-die-button | |
141 | 'follow-link t | |
142 | 'action #'dwarf-die-button-action) | |
143 | ||
144 | ;; Helper regexp to match a DIE reference. | |
2e97048a | 145 | (defconst dwarf-die-reference "\\(<0x\\([0-9a-f]+\\)>\\)") |
fd2f0033 TT |
146 | |
147 | ;; Helper regexp to match a `...' indicating that there are hidden | |
148 | ;; children. | |
149 | (defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)") | |
150 | ||
151 | ;; jit-lock callback function to fontify a region. This applies the | |
152 | ;; buttons, since AFAICT there is no good way to apply buttons via | |
153 | ;; font-lock. | |
154 | (defun dwarf-fontify-region (start end) | |
155 | (save-excursion | |
156 | (let ((beg-line (progn (goto-char start) (line-beginning-position))) | |
157 | (end-line (progn (goto-char end) (line-end-position)))) | |
158 | (goto-char beg-line) | |
159 | (while (re-search-forward dwarf-die-reference end-line 'move) | |
160 | (let ((b-start (match-beginning 1)) | |
161 | (b-end (match-end 1)) | |
162 | (hex (match-string-no-properties 2))) | |
163 | (make-text-button b-start b-end :type 'dwarf-die-button | |
164 | 'die hex 'die-ref t))) | |
165 | ;; This is a bogus approach. Why can't we make buttons from the | |
166 | ;; font-lock defaults? | |
167 | (goto-char beg-line) | |
168 | (while (re-search-forward dwarf-die-more end-line 'move) | |
169 | (let ((hex (match-string-no-properties 1)) | |
170 | (b-start (match-beginning 2)) | |
171 | (b-end (match-end 2))) | |
172 | (make-text-button b-start b-end :type 'dwarf-die-button | |
173 | 'die hex 'die-ref nil)))))) | |
174 | ||
175 | ;; Run objdump and insert the contents into the buffer. The arguments | |
176 | ;; are the way they are because this is also called as a | |
177 | ;; revert-buffer-function. | |
178 | (defun dwarf-do-refresh (&rest ignore) | |
c85fa91b | 179 | (dwarf--check-running) |
fd2f0033 | 180 | (let ((inhibit-read-only t)) |
c85fa91b TT |
181 | (dwarf--invoke (point-min) (point-max) |
182 | dwarf-objdump-program "-Wi" "--dwarf-depth=1" | |
183 | (expand-file-name dwarf-file)) | |
fd2f0033 TT |
184 | (set-buffer-modified-p nil))) |
185 | ||
1021d1cb TT |
186 | (defvar dwarf-mode-syntax-table |
187 | (let ((table (make-syntax-table))) | |
188 | ;; This at least makes it so mark-sexp on some hex digits inside | |
189 | ;; <...> does not also copy the ">". | |
190 | (modify-syntax-entry ?< "(>" table) | |
191 | (modify-syntax-entry ?> ")<" table) | |
192 | table) | |
193 | "Syntax table for dwarf-mode buffers.") | |
194 | ||
22b63797 TT |
195 | (defvar dwarf-mode-map |
196 | (let ((map (make-sparse-keymap))) | |
197 | (set-keymap-parent map special-mode-map) | |
198 | (define-key map [(control ?m)] #'dwarf-insert-substructure) | |
199 | map) | |
200 | "Keymap for dwarf-mode buffers.") | |
201 | ||
fd2f0033 TT |
202 | (define-derived-mode dwarf-mode special-mode "DWARF" |
203 | "Major mode for browsing DWARF output. | |
204 | ||
205 | \\{dwarf-mode-map}" | |
206 | ||
207 | (set (make-local-variable 'font-lock-defaults) '(dwarf-font-lock-keywords)) | |
208 | ;; FIXME: we could be smarter and check the file time. | |
209 | (set (make-local-variable 'revert-buffer-function) #'dwarf-do-refresh) | |
210 | (jit-lock-register #'dwarf-fontify-region)) | |
211 | ||
6f7b1488 | 212 | ;;;###autoload |
fd2f0033 TT |
213 | (defun dwarf-browse (file) |
214 | "Invoke `objdump' and put output into a `dwarf-mode' buffer. | |
215 | This is the main interface to `dwarf-mode'." | |
216 | (interactive "fFile name: ") | |
217 | (let* ((base-name (file-name-nondirectory file)) | |
218 | (buffer (generate-new-buffer (concat "*DWARF for " base-name "*")))) | |
219 | (pop-to-buffer buffer) | |
220 | (dwarf-mode) | |
c42608e1 | 221 | (setq default-directory (file-name-directory file)) |
fd2f0033 | 222 | (set (make-local-variable 'dwarf-file) file) |
c85fa91b TT |
223 | (set (make-local-variable 'dwarf--process) nil) |
224 | (set (make-local-variable 'dwarf--deletion-region) nil) | |
fd2f0033 TT |
225 | (dwarf-do-refresh))) |
226 | ||
227 | (provide 'dwarf-mode) | |
6f7b1488 TT |
228 | |
229 | ;;; dwarf-mode.el ends here |