1;;; dwarf-mode.el --- Browser for DWARF information.
2
3;; Version: 1.2
4
5;; Copyright (C) 2012-2016 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-z_]*name\\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;; Expand a "..." to show all the child DIES.  NEW-DEPTH controls how
41;; deep to display the new dies; `nil' means display all of them.
42(defun dwarf-do-insert-substructure (new-depth die)
43  (let ((inhibit-read-only t))
44    (beginning-of-line)
45    (delete-region (point) (progn
46			     (end-of-line)
47			     (forward-char)
48			     (point)))
49    (save-excursion
50      (apply #'call-process dwarf-objdump-program nil (current-buffer) nil
51	     "-Wi" (concat "--dwarf-start=0x" die)
52	     (expand-file-name dwarf-file)
53	     (if new-depth (list (concat "--dwarf-depth="
54					 (int-to-string new-depth))))))
55    (set-buffer-modified-p nil)))
56
57(defun dwarf-insert-substructure-button (die)
58  (beginning-of-line)
59  (unless (looking-at "^ <\\([0-9]+\\)>")
60    (error "Unrecognized line."))
61  (let ((new-depth (1+ (string-to-number (match-string 1)))))
62    (dwarf-do-insert-substructure new-depth die)))
63
64(defun dwarf-insert-substructure (arg)
65  "Expand a `...' to show children of the current DIE.
66By default, expands just one level of children.
67A prefix argument means expand all children."
68  (interactive "P")
69  (beginning-of-line)
70  (unless (looking-at "^ <\\([0-9]+\\)><\\([0-9a-f]+\\)>")
71    (error "Unrecognized line."))
72  (let ((die (match-string 2)))
73    (if arg
74	(dwarf-do-insert-substructure nil die)
75      (dwarf-insert-substructure-button die))))
76
77;; Called when a button is pressed.
78;; Either follows a DIE reference, or expands a "...".
79(defun dwarf-die-button-action (button)
80  (let* ((die (button-get button 'die))
81	 ;; Note that the first number can only be decimal.
82	 (die-rx (concat "^\\s *\\(<[0-9]+>\\)?<"
83			 die ">[^<]"))
84	 (old (point))
85	 (is-ref (button-get button 'die-ref)))
86    (if is-ref
87	(progn
88	  (goto-char (point-min))
89	  (if (re-search-forward die-rx nil 'move)
90	      (push-mark old)
91	    (goto-char old)
92	    (error "Could not find DIE <0x%s>" die)))
93      (dwarf-insert-substructure-button die))))
94
95;; Button definition.
96(define-button-type 'dwarf-die-button
97  'follow-link t
98  'action #'dwarf-die-button-action)
99
100;; Helper regexp to match a DIE reference.
101(defconst dwarf-die-reference "\\(<0x\\([0-9a-f]+\\)>\\)")
102
103;; Helper regexp to match a `...' indicating that there are hidden
104;; children.
105(defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)")
106
107;; jit-lock callback function to fontify a region.  This applies the
108;; buttons, since AFAICT there is no good way to apply buttons via
109;; font-lock.
110(defun dwarf-fontify-region (start end)
111  (save-excursion
112    (let ((beg-line (progn (goto-char start) (line-beginning-position)))
113	  (end-line (progn (goto-char end) (line-end-position))))
114      (goto-char beg-line)
115      (while (re-search-forward dwarf-die-reference end-line 'move)
116	(let ((b-start (match-beginning 1))
117	      (b-end (match-end 1))
118	      (hex (match-string-no-properties 2)))
119	  (make-text-button b-start b-end :type 'dwarf-die-button
120			    'die hex 'die-ref t)))
121      ;; This is a bogus approach.  Why can't we make buttons from the
122      ;; font-lock defaults?
123      (goto-char beg-line)
124      (while (re-search-forward dwarf-die-more end-line 'move)
125	(let ((hex (match-string-no-properties 1))
126	      (b-start (match-beginning 2))
127	      (b-end (match-end 2)))
128	  (make-text-button b-start b-end :type 'dwarf-die-button
129			    'die hex 'die-ref nil))))))
130
131;; Run objdump and insert the contents into the buffer.  The arguments
132;; are the way they are because this is also called as a
133;; revert-buffer-function.
134(defun dwarf-do-refresh (&rest ignore)
135  (let ((inhibit-read-only t))
136    (erase-buffer)
137    (save-excursion
138      (call-process dwarf-objdump-program
139		    nil (current-buffer) nil
140		    "-Wi" "--dwarf-depth=1"
141		    (expand-file-name dwarf-file)))
142    (set-buffer-modified-p nil)))
143
144(define-derived-mode dwarf-mode special-mode "DWARF"
145  "Major mode for browsing DWARF output.
146
147\\{dwarf-mode-map}"
148
149  (set (make-local-variable 'font-lock-defaults) '(dwarf-font-lock-keywords))
150  ;; FIXME: we could be smarter and check the file time.
151  (set (make-local-variable 'revert-buffer-function) #'dwarf-do-refresh)
152  (jit-lock-register #'dwarf-fontify-region))
153
154(define-key dwarf-mode-map [(control ?m)] #'dwarf-insert-substructure)
155
156;;;###autoload
157(defun dwarf-browse (file)
158  "Invoke `objdump' and put output into a `dwarf-mode' buffer.
159This is the main interface to `dwarf-mode'."
160  (interactive "fFile name: ")
161  (let* ((base-name (file-name-nondirectory file))
162	 (buffer (generate-new-buffer (concat "*DWARF for " base-name "*"))))
163    (pop-to-buffer buffer)
164    (dwarf-mode)
165    (set (make-local-variable 'dwarf-file) file)
166    (dwarf-do-refresh)))
167
168(provide 'dwarf-mode)
169
170;;; dwarf-mode.el ends here
171