binutils-gdb/binutils/dwarf-mode.el

228 lines
7.8 KiB
EmacsLisp

;;; dwarf-mode.el --- Browser for DWARF information. -*-lexical-binding:t-*-
;; Version: 1.5
;; Copyright (C) 2012-2019 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.")
(defvar dwarf--process nil
"Running objdump process, or nil.")
(defvar dwarf--deletion-region nil
"Region to delete before inserting text in `dwarf--filter'.")
(defun dwarf--check-running ()
"Throw an exception if an objdump process is already running."
(when dwarf--process
(error "An objdump process is still running in this buffer")))
(defun dwarf--filter (proc string)
"Filter function for objdump processes."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(save-excursion
(let ((inhibit-read-only t))
(when dwarf--deletion-region
(apply #'delete-region dwarf--deletion-region)
(setq dwarf--deletion-region nil))
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point))
(set-buffer-modified-p nil))))))
(defun dwarf--sentinel (_proc _status)
(setq mode-line-process nil)
(setq dwarf--process nil))
(defun dwarf--invoke (start end &rest command)
"Invoke a command and arrange to insert output into the current buffer."
(setq mode-line-process "[Running]")
(setq dwarf--deletion-region (list start end))
(setq dwarf--process (make-process :name "objdump"
:buffer (current-buffer)
:command command
:connection-type 'pipe
:noquery t
:filter #'dwarf--filter
:sentinel #'dwarf--sentinel))
(set-marker (process-mark dwarf--process) (point)))
;; 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)
(dwarf--check-running)
(let ((inhibit-read-only t))
(beginning-of-line)
(apply #'dwarf--invoke
(point) (save-excursion
(end-of-line)
(forward-char)
(point))
dwarf-objdump-program "-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)
(dwarf--check-running)
(let ((inhibit-read-only t))
(dwarf--invoke (point-min) (point-max)
dwarf-objdump-program "-Wi" "--dwarf-depth=1"
(expand-file-name dwarf-file))
(set-buffer-modified-p nil)))
(defvar dwarf-mode-syntax-table
(let ((table (make-syntax-table)))
;; This at least makes it so mark-sexp on some hex digits inside
;; <...> does not also copy the ">".
(modify-syntax-entry ?< "(>" table)
(modify-syntax-entry ?> ")<" table)
table)
"Syntax table for dwarf-mode buffers.")
(defvar dwarf-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map special-mode-map)
(define-key map [(control ?m)] #'dwarf-insert-substructure)
map)
"Keymap for dwarf-mode buffers.")
(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))
;;;###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)
(setq default-directory (file-name-directory file))
(set (make-local-variable 'dwarf-file) file)
(set (make-local-variable 'dwarf--process) nil)
(set (make-local-variable 'dwarf--deletion-region) nil)
(dwarf-do-refresh)))
(provide 'dwarf-mode)
;;; dwarf-mode.el ends here