1;;; dwarf-mode.el --- Browser for DWARF information. 2 3;; Version: 1.1 4 5;; This file is not part of GNU Emacs, but is distributed under the 6;; same terms: 7 8;; GNU Emacs is free software: you can redistribute it and/or modify 9;; it under the terms of the GNU General Public License as published by 10;; the Free Software Foundation, either version 3 of the License, or 11;; (at your option) any later version. 12 13;; GNU Emacs is distributed in the hope that it will be useful, 14;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16;; GNU General Public License for more details. 17 18;; You should have received a copy of the GNU General Public License 19;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 20 21;;; Code: 22 23(defvar dwarf-objdump-program "objdump") 24 25(defconst dwarf-font-lock-keywords 26 '( 27 ;; Name and linkage name. 28 ("DW_AT_[a-z_]*name\\s *: .*:\\(.*\\)\\s *$" 29 (1 font-lock-function-name-face)) 30 31 ("Compilation Unit @ offset 0x[0-9a-f]+" 32 (0 font-lock-string-face)) 33 )) 34 35(defvar dwarf-file nil 36 "Buffer-local variable holding the file name passed to objdump.") 37 38;; Expand a "..." to show all the child DIES. NEW-DEPTH controls how 39;; deep to display the new dies; `nil' means display all of them. 40(defun dwarf-do-insert-substructure (new-depth die) 41 (let ((inhibit-read-only t)) 42 (beginning-of-line) 43 (delete-region (point) (progn 44 (end-of-line) 45 (forward-char) 46 (point))) 47 (save-excursion 48 (apply #'call-process dwarf-objdump-program nil (current-buffer) nil 49 "-Wi" (concat "--dwarf-start=0x" die) 50 (expand-file-name dwarf-file) 51 (if new-depth (list (concat "--dwarf-depth=" 52 (int-to-string new-depth)))))) 53 (set-buffer-modified-p nil))) 54 55(defun dwarf-insert-substructure-button (die) 56 (beginning-of-line) 57 (unless (looking-at "^ <\\([0-9]+\\)>") 58 (error "Unrecognized line.")) 59 (let ((new-depth (1+ (string-to-number (match-string 1))))) 60 (dwarf-do-insert-substructure new-depth die))) 61 62(defun dwarf-insert-substructure (arg) 63 "Expand a `...' to show children of the current DIE. 64By default, expands just one level of children. 65A prefix argument means expand all children." 66 (interactive "P") 67 (beginning-of-line) 68 (unless (looking-at "^ <\\([0-9]+\\)><\\([0-9a-f]+\\)>") 69 (error "Unrecognized line.")) 70 (let ((die (match-string 2))) 71 (if arg 72 (dwarf-do-insert-substructure nil die) 73 (dwarf-insert-substructure-button die)))) 74 75;; Called when a button is pressed. 76;; Either follows a DIE reference, or expands a "...". 77(defun dwarf-die-button-action (button) 78 (let* ((die (button-get button 'die)) 79 ;; Note that the first number can only be decimal. 80 (die-rx (concat "^\\s *\\(<[0-9]+>\\)?<" 81 die ">[^<]")) 82 (old (point)) 83 (is-ref (button-get button 'die-ref))) 84 (if is-ref 85 (progn 86 (goto-char (point-min)) 87 (if (re-search-forward die-rx nil 'move) 88 (push-mark old) 89 (goto-char old) 90 (error "Could not find DIE <0x%s>" die))) 91 (dwarf-insert-substructure-button die)))) 92 93;; Button definition. 94(define-button-type 'dwarf-die-button 95 'follow-link t 96 'action #'dwarf-die-button-action) 97 98;; Helper regexp to match a DIE reference. 99(defconst dwarf-die-reference ": \\(<0x\\([0-9a-f]+\\)>\\)\\s *$") 100 101;; Helper regexp to match a `...' indicating that there are hidden 102;; children. 103(defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)") 104 105;; jit-lock callback function to fontify a region. This applies the 106;; buttons, since AFAICT there is no good way to apply buttons via 107;; font-lock. 108(defun dwarf-fontify-region (start end) 109 (save-excursion 110 (let ((beg-line (progn (goto-char start) (line-beginning-position))) 111 (end-line (progn (goto-char end) (line-end-position)))) 112 (goto-char beg-line) 113 (while (re-search-forward dwarf-die-reference end-line 'move) 114 (let ((b-start (match-beginning 1)) 115 (b-end (match-end 1)) 116 (hex (match-string-no-properties 2))) 117 (make-text-button b-start b-end :type 'dwarf-die-button 118 'die hex 'die-ref t))) 119 ;; This is a bogus approach. Why can't we make buttons from the 120 ;; font-lock defaults? 121 (goto-char beg-line) 122 (while (re-search-forward dwarf-die-more end-line 'move) 123 (let ((hex (match-string-no-properties 1)) 124 (b-start (match-beginning 2)) 125 (b-end (match-end 2))) 126 (make-text-button b-start b-end :type 'dwarf-die-button 127 'die hex 'die-ref nil)))))) 128 129;; Run objdump and insert the contents into the buffer. The arguments 130;; are the way they are because this is also called as a 131;; revert-buffer-function. 132(defun dwarf-do-refresh (&rest ignore) 133 (let ((inhibit-read-only t)) 134 (erase-buffer) 135 (save-excursion 136 (call-process dwarf-objdump-program 137 nil (current-buffer) nil 138 "-Wi" "--dwarf-depth=1" 139 (expand-file-name dwarf-file))) 140 (set-buffer-modified-p nil))) 141 142;;;###autoload 143(define-derived-mode dwarf-mode special-mode "DWARF" 144 "Major mode for browsing DWARF output. 145 146\\{dwarf-mode-map}" 147 148 (set (make-local-variable 'font-lock-defaults) '(dwarf-font-lock-keywords)) 149 ;; FIXME: we could be smarter and check the file time. 150 (set (make-local-variable 'revert-buffer-function) #'dwarf-do-refresh) 151 (jit-lock-register #'dwarf-fontify-region)) 152 153(define-key dwarf-mode-map [(control ?m)] #'dwarf-insert-substructure) 154 155;;;###autoload 156(defun dwarf-browse (file) 157 "Invoke `objdump' and put output into a `dwarf-mode' buffer. 158This is the main interface to `dwarf-mode'." 159 (interactive "fFile name: ") 160 (let* ((base-name (file-name-nondirectory file)) 161 (buffer (generate-new-buffer (concat "*DWARF for " base-name "*")))) 162 (pop-to-buffer buffer) 163 (dwarf-mode) 164 (set (make-local-variable 'dwarf-file) file) 165 (dwarf-do-refresh))) 166 167(provide 'dwarf-mode) 168 169;;; dwarf-mode.el ends here 170