binutils/dwarf-mode.el

   1 ;;; dwarf-mode.el --- Browser for DWARF information. -*-lexical-binding:t-*-
   2
   3 ;; Version: 1.7
   4
   5 ;; Copyright (C) 2012-2023 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.
 110 By default, expands just one level of children.
 111 A 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.
 217 This 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