| 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. |
| 66 | By default, expands just one level of children. |
| 67 | A 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. |
| 159 | This 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 |