1;;; dwarf-mode.el --- Browser for DWARF information. 2 3;; Version: 1.3 4 5;; Copyright (C) 2012-2017 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 (setq default-directory (file-name-directory file)) 166 (set (make-local-variable 'dwarf-file) file) 167 (dwarf-do-refresh))) 168 169(provide 'dwarf-mode) 170 171;;; dwarf-mode.el ends here 172