Commit | Line | Data |
---|---|---|
fd2f0033 TT |
1 | ;;; dwarf-mode.el --- Browser for DWARF information. |
2 | ||
3 | ;; Version: 1.0 | |
4 | ||
5 | ;; This file is not part of GNU Emacs, but is distributed under the | |
6 | ;; same terms: | |
7 | ||
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. | |
12 | ||
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. | |
17 | ||
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/>. | |
20 | ||
21 | ;;; Code: | |
22 | ||
23 | (defvar dwarf-objdump-program "objdump") | |
24 | ||
25 | (defconst dwarf-font-lock-keywords | |
26 | '( | |
27 | ;; Name and linkage name. | |
28 | ("DW_AT_[a-z_]*name\\s *: .*:\\(.*\\)\\s *$" | |
29 | (1 font-lock-function-name-face)) | |
30 | ||
31 | ("Compilation Unit @ offset 0x[0-9a-f]+" | |
32 | (0 font-lock-string-face)) | |
33 | )) | |
34 | ||
35 | (defvar dwarf-file nil | |
36 | "Buffer-local variable holding the file name passed to objdump.") | |
37 | ||
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) | |
af61e67f | 50 | (expand-file-name dwarf-file) |
fd2f0033 TT |
51 | (if new-depth (list (concat "--dwarf-depth=" |
52 | (int-to-string new-depth)))))) | |
53 | (set-buffer-modified-p nil))) | |
54 | ||
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))) | |
61 | ||
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)))) | |
74 | ||
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)))) | |
92 | ||
93 | ;; Button definition. | |
94 | (define-button-type 'dwarf-die-button | |
95 | 'follow-link t | |
96 | 'action #'dwarf-die-button-action) | |
97 | ||
98 | ;; Helper regexp to match a DIE reference. | |
99 | (defconst dwarf-die-reference ": \\(<0x\\([0-9a-f]+\\)>\\)\\s *$") | |
100 | ||
101 | ;; Helper regexp to match a `...' indicating that there are hidden | |
102 | ;; children. | |
103 | (defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)") | |
104 | ||
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)))))) | |
128 | ||
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" | |
af61e67f | 139 | (expand-file-name dwarf-file))) |
fd2f0033 TT |
140 | (set-buffer-modified-p nil))) |
141 | ||
142 | ;;;###autoload | |
143 | (define-derived-mode dwarf-mode special-mode "DWARF" | |
144 | "Major mode for browsing DWARF output. | |
145 | ||
146 | \\{dwarf-mode-map}" | |
147 | ||
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)) | |
152 | ||
153 | (define-key dwarf-mode-map [(control ?m)] #'dwarf-insert-substructure) | |
154 | ||
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))) | |
166 | ||
167 | (provide 'dwarf-mode) |