1;;; dwarf-mode.el --- Browser for DWARF information. -*-lexical-binding:t-*-
2
3;; Version: 1.7
4
5;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
6
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.
30    ("DW_AT_[a-zA-Z_]*name\\s *:\\(?:\\s *(.*):\\)?\\s *\\(.*\\)\\s *$"
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
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  (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))))
70
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)))
83
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)))
100
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)))
107
108(defun dwarf-insert-substructure (arg)
109  "Expand a `...' to show children of the current DIE.
110By default, expands just one level of children.
111A 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))))
120
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))))
140
141;; Button definition.
142(define-button-type 'dwarf-die-button
143  'follow-link t
144  'action #'dwarf-die-button-action)
145
146;; Helper regexp to match a DIE reference.
147(defconst dwarf-die-reference "\\(<0x\\([0-9a-f]+\\)>\\)")
148
149;; Helper regexp to match a `...' indicating that there are hidden
150;; children.
151(defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)")
152
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))))))
176
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)))
187
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.")
196
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.")
203
204(define-derived-mode dwarf-mode special-mode "DWARF"
205  "Major mode for browsing DWARF output.
206
207\\{dwarf-mode-map}"
208
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))
213
214;;;###autoload
215(defun dwarf-browse (file)
216  "Invoke `objdump' and put output into a `dwarf-mode' buffer.
217This 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)))
228
229(provide 'dwarf-mode)
230
231;;; dwarf-mode.el ends here
232