contrib/binutils-2.25/binutils/dwarf-mode.el

   1 ;;; dwarf-mode.el --- Browser for DWARF information.
   2
   3 ;; Version: 1.2
   4
   5 ;; Copyright (C) 2012-2014 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.
  66 By default, expands just one level of children.
  67 A 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.
 159 This 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     (set (make-local-variable 'dwarf-file) file)
 166     (dwarf-do-refresh)))
 167
 168 (provide 'dwarf-mode)
 169
 170 ;;; dwarf-mode.el ends here