| 1 | ;;; dwarf-mode.el --- Browser for DWARF information. -*-lexical-binding:t-*- |
| 2 | |
| 3 | ;; Version: 1.5 |
| 4 | |
| 5 | ;; Copyright (C) 2012-2020 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 | (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 | |
| 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) |
| 85 | (dwarf--check-running) |
| 86 | (let ((inhibit-read-only t)) |
| 87 | (beginning-of-line) |
| 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))))) |
| 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.")) |
| 103 | (let ((new-depth (1+ (string-to-number (match-string 1))))) |
| 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)) |
| 123 | ;; Note that the first number can only be decimal. |
| 124 | (die-rx (concat "^\\s *\\(<[0-9]+>\\)?<" |
| 125 | die ">[^<]")) |
| 126 | (old (point)) |
| 127 | (is-ref (button-get button 'die-ref))) |
| 128 | (if is-ref |
| 129 | (progn |
| 130 | (goto-char (point-min)) |
| 131 | (if (re-search-forward die-rx nil 'move) |
| 132 | (push-mark old) |
| 133 | (goto-char old) |
| 134 | (error "Could not find DIE <0x%s>" die))) |
| 135 | (dwarf-insert-substructure-button die)))) |
| 136 | |
| 137 | ;; Button definition. |
| 138 | (define-button-type 'dwarf-die-button |
| 139 | 'follow-link t |
| 140 | 'action #'dwarf-die-button-action) |
| 141 | |
| 142 | ;; Helper regexp to match a DIE reference. |
| 143 | (defconst dwarf-die-reference "\\(<0x\\([0-9a-f]+\\)>\\)") |
| 144 | |
| 145 | ;; Helper regexp to match a `...' indicating that there are hidden |
| 146 | ;; children. |
| 147 | (defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)") |
| 148 | |
| 149 | ;; jit-lock callback function to fontify a region. This applies the |
| 150 | ;; buttons, since AFAICT there is no good way to apply buttons via |
| 151 | ;; font-lock. |
| 152 | (defun dwarf-fontify-region (start end) |
| 153 | (save-excursion |
| 154 | (let ((beg-line (progn (goto-char start) (line-beginning-position))) |
| 155 | (end-line (progn (goto-char end) (line-end-position)))) |
| 156 | (goto-char beg-line) |
| 157 | (while (re-search-forward dwarf-die-reference end-line 'move) |
| 158 | (let ((b-start (match-beginning 1)) |
| 159 | (b-end (match-end 1)) |
| 160 | (hex (match-string-no-properties 2))) |
| 161 | (make-text-button b-start b-end :type 'dwarf-die-button |
| 162 | 'die hex 'die-ref t))) |
| 163 | ;; This is a bogus approach. Why can't we make buttons from the |
| 164 | ;; font-lock defaults? |
| 165 | (goto-char beg-line) |
| 166 | (while (re-search-forward dwarf-die-more end-line 'move) |
| 167 | (let ((hex (match-string-no-properties 1)) |
| 168 | (b-start (match-beginning 2)) |
| 169 | (b-end (match-end 2))) |
| 170 | (make-text-button b-start b-end :type 'dwarf-die-button |
| 171 | 'die hex 'die-ref nil)))))) |
| 172 | |
| 173 | ;; Run objdump and insert the contents into the buffer. The arguments |
| 174 | ;; are the way they are because this is also called as a |
| 175 | ;; revert-buffer-function. |
| 176 | (defun dwarf-do-refresh (&rest ignore) |
| 177 | (dwarf--check-running) |
| 178 | (let ((inhibit-read-only t)) |
| 179 | (dwarf--invoke (point-min) (point-max) |
| 180 | dwarf-objdump-program "-Wi" "--dwarf-depth=1" |
| 181 | (expand-file-name dwarf-file)) |
| 182 | (set-buffer-modified-p nil))) |
| 183 | |
| 184 | (defvar dwarf-mode-syntax-table |
| 185 | (let ((table (make-syntax-table))) |
| 186 | ;; This at least makes it so mark-sexp on some hex digits inside |
| 187 | ;; <...> does not also copy the ">". |
| 188 | (modify-syntax-entry ?< "(>" table) |
| 189 | (modify-syntax-entry ?> ")<" table) |
| 190 | table) |
| 191 | "Syntax table for dwarf-mode buffers.") |
| 192 | |
| 193 | (defvar dwarf-mode-map |
| 194 | (let ((map (make-sparse-keymap))) |
| 195 | (set-keymap-parent map special-mode-map) |
| 196 | (define-key map [(control ?m)] #'dwarf-insert-substructure) |
| 197 | map) |
| 198 | "Keymap for dwarf-mode buffers.") |
| 199 | |
| 200 | (define-derived-mode dwarf-mode special-mode "DWARF" |
| 201 | "Major mode for browsing DWARF output. |
| 202 | |
| 203 | \\{dwarf-mode-map}" |
| 204 | |
| 205 | (set (make-local-variable 'font-lock-defaults) '(dwarf-font-lock-keywords)) |
| 206 | ;; FIXME: we could be smarter and check the file time. |
| 207 | (set (make-local-variable 'revert-buffer-function) #'dwarf-do-refresh) |
| 208 | (jit-lock-register #'dwarf-fontify-region)) |
| 209 | |
| 210 | ;;;###autoload |
| 211 | (defun dwarf-browse (file) |
| 212 | "Invoke `objdump' and put output into a `dwarf-mode' buffer. |
| 213 | This is the main interface to `dwarf-mode'." |
| 214 | (interactive "fFile name: ") |
| 215 | (let* ((base-name (file-name-nondirectory file)) |
| 216 | (buffer (generate-new-buffer (concat "*DWARF for " base-name "*")))) |
| 217 | (pop-to-buffer buffer) |
| 218 | (dwarf-mode) |
| 219 | (setq default-directory (file-name-directory file)) |
| 220 | (set (make-local-variable 'dwarf-file) file) |
| 221 | (set (make-local-variable 'dwarf--process) nil) |
| 222 | (set (make-local-variable 'dwarf--deletion-region) nil) |
| 223 | (dwarf-do-refresh))) |
| 224 | |
| 225 | (provide 'dwarf-mode) |
| 226 | |
| 227 | ;;; dwarf-mode.el ends here |