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