diff options
Diffstat (limited to 'binutils-2.25/binutils/dwarf-mode.el')
-rw-r--r-- | binutils-2.25/binutils/dwarf-mode.el | 170 |
1 files changed, 170 insertions, 0 deletions
diff --git a/binutils-2.25/binutils/dwarf-mode.el b/binutils-2.25/binutils/dwarf-mode.el new file mode 100644 index 00000000..c20c8d7d --- /dev/null +++ b/binutils-2.25/binutils/dwarf-mode.el @@ -0,0 +1,170 @@ +;;; dwarf-mode.el --- Browser for DWARF information. + +;; Version: 1.2 + +;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. + +;; This file is not part of GNU Emacs, but is distributed under the +;; same terms: + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(defvar dwarf-objdump-program "objdump") + +(defconst dwarf-font-lock-keywords + '( + ;; Name and linkage name. + ("DW_AT_[a-z_]*name\\s *: .*:\\(.*\\)\\s *$" + (1 font-lock-function-name-face)) + + ("Compilation Unit @ offset 0x[0-9a-f]+" + (0 font-lock-string-face)) + )) + +(defvar dwarf-file nil + "Buffer-local variable holding the file name passed to objdump.") + +;; Expand a "..." to show all the child DIES. NEW-DEPTH controls how +;; deep to display the new dies; `nil' means display all of them. +(defun dwarf-do-insert-substructure (new-depth die) + (let ((inhibit-read-only t)) + (beginning-of-line) + (delete-region (point) (progn + (end-of-line) + (forward-char) + (point))) + (save-excursion + (apply #'call-process dwarf-objdump-program nil (current-buffer) nil + "-Wi" (concat "--dwarf-start=0x" die) + (expand-file-name dwarf-file) + (if new-depth (list (concat "--dwarf-depth=" + (int-to-string new-depth)))))) + (set-buffer-modified-p nil))) + +(defun dwarf-insert-substructure-button (die) + (beginning-of-line) + (unless (looking-at "^ <\\([0-9]+\\)>") + (error "Unrecognized line.")) + (let ((new-depth (1+ (string-to-number (match-string 1))))) + (dwarf-do-insert-substructure new-depth die))) + +(defun dwarf-insert-substructure (arg) + "Expand a `...' to show children of the current DIE. +By default, expands just one level of children. +A prefix argument means expand all children." + (interactive "P") + (beginning-of-line) + (unless (looking-at "^ <\\([0-9]+\\)><\\([0-9a-f]+\\)>") + (error "Unrecognized line.")) + (let ((die (match-string 2))) + (if arg + (dwarf-do-insert-substructure nil die) + (dwarf-insert-substructure-button die)))) + +;; Called when a button is pressed. +;; Either follows a DIE reference, or expands a "...". +(defun dwarf-die-button-action (button) + (let* ((die (button-get button 'die)) + ;; Note that the first number can only be decimal. + (die-rx (concat "^\\s *\\(<[0-9]+>\\)?<" + die ">[^<]")) + (old (point)) + (is-ref (button-get button 'die-ref))) + (if is-ref + (progn + (goto-char (point-min)) + (if (re-search-forward die-rx nil 'move) + (push-mark old) + (goto-char old) + (error "Could not find DIE <0x%s>" die))) + (dwarf-insert-substructure-button die)))) + +;; Button definition. +(define-button-type 'dwarf-die-button + 'follow-link t + 'action #'dwarf-die-button-action) + +;; Helper regexp to match a DIE reference. +(defconst dwarf-die-reference "\\(<0x\\([0-9a-f]+\\)>\\)") + +;; Helper regexp to match a `...' indicating that there are hidden +;; children. +(defconst dwarf-die-more "^ <[0-9]+><\\([0-9a-z]+\\)>: \\([.][.][.]\\)") + +;; jit-lock callback function to fontify a region. This applies the +;; buttons, since AFAICT there is no good way to apply buttons via +;; font-lock. +(defun dwarf-fontify-region (start end) + (save-excursion + (let ((beg-line (progn (goto-char start) (line-beginning-position))) + (end-line (progn (goto-char end) (line-end-position)))) + (goto-char beg-line) + (while (re-search-forward dwarf-die-reference end-line 'move) + (let ((b-start (match-beginning 1)) + (b-end (match-end 1)) + (hex (match-string-no-properties 2))) + (make-text-button b-start b-end :type 'dwarf-die-button + 'die hex 'die-ref t))) + ;; This is a bogus approach. Why can't we make buttons from the + ;; font-lock defaults? + (goto-char beg-line) + (while (re-search-forward dwarf-die-more end-line 'move) + (let ((hex (match-string-no-properties 1)) + (b-start (match-beginning 2)) + (b-end (match-end 2))) + (make-text-button b-start b-end :type 'dwarf-die-button + 'die hex 'die-ref nil)))))) + +;; Run objdump and insert the contents into the buffer. The arguments +;; are the way they are because this is also called as a +;; revert-buffer-function. +(defun dwarf-do-refresh (&rest ignore) + (let ((inhibit-read-only t)) + (erase-buffer) + (save-excursion + (call-process dwarf-objdump-program + nil (current-buffer) nil + "-Wi" "--dwarf-depth=1" + (expand-file-name dwarf-file))) + (set-buffer-modified-p nil))) + +(define-derived-mode dwarf-mode special-mode "DWARF" + "Major mode for browsing DWARF output. + +\\{dwarf-mode-map}" + + (set (make-local-variable 'font-lock-defaults) '(dwarf-font-lock-keywords)) + ;; FIXME: we could be smarter and check the file time. + (set (make-local-variable 'revert-buffer-function) #'dwarf-do-refresh) + (jit-lock-register #'dwarf-fontify-region)) + +(define-key dwarf-mode-map [(control ?m)] #'dwarf-insert-substructure) + +;;;###autoload +(defun dwarf-browse (file) + "Invoke `objdump' and put output into a `dwarf-mode' buffer. +This is the main interface to `dwarf-mode'." + (interactive "fFile name: ") + (let* ((base-name (file-name-nondirectory file)) + (buffer (generate-new-buffer (concat "*DWARF for " base-name "*")))) + (pop-to-buffer buffer) + (dwarf-mode) + (set (make-local-variable 'dwarf-file) file) + (dwarf-do-refresh))) + +(provide 'dwarf-mode) + +;;; dwarf-mode.el ends here |