[thirdparty/binutils-gdb.git] / binutils / dwarf-mode.el

;;; dwarf-mode.el --- Browser for DWARF information. -*-lexical-binding:t-*-

;; Version: 1.8

;; Copyright (C) 2012-2023 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-zA-Z_]*name\\s *:\\(?:\\s *(.*):\\)?\\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)
  (when (buffer-live-p (process-buffer proc))
    (with-current-buffer (process-buffer proc)
      (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.  It is
	 ;; included in this search because otherwise following a ref
	 ;; might lead to a zero-length boolean attribute in the
	 ;; previous DIE.
	 (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)))

(defun dwarf-refresh-all ()
  "Refresh the current buffer without eliding substructure.
Note that this can result in very voluminous output."
  (interactive)
  (dwarf--check-running)
  (let ((inhibit-read-only t))
    (dwarf--invoke (point-min) (point-max)
		   dwarf-objdump-program "-Wi"
		   (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)
    (define-key map "A" #'dwarf-refresh-all)
    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))
  (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
Commit	Line	Data
e4905c74	1	;;; dwarf-mode.el --- Browser for DWARF information. --lexical-binding:t--
fd2f0033	2
93c80543	3	;; Version: 1.8
fd2f0033	4
d87bef3a	5	;; Copyright (C) 2012-2023 Free Software Foundation, Inc.
5bf135a7	6
fd2f0033 TT	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.
d3511b24	30	("DW_AT_[a-zA-Z_]name\\s :\\(?:\\s (.):\\)?\\s \\(.\\)\\s *$"
fd2f0033 TT	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
c85fa91b TT	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
cda8dc94 TT	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))))
c85fa91b TT	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
fd2f0033 TT	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)
c85fa91b	87	(dwarf--check-running)
fd2f0033 TT	88	(let ((inhibit-read-only t))
fd2f0033 TT	89	(beginning-of-line)
c85fa91b TT	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)))))
fd2f0033 TT	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."))
6f7b1488	105	(let ((new-depth (1+ (string-to-number (match-string 1)))))
fd2f0033 TT	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)
93c80543	114	(unless (looking-at "^ <\\([0-9]+\\)><\\([0-9a-f]+\\)>: \\.\\.\\.")
fd2f0033 TT	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))
d3511b24 TT	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 ">:"))
fd2f0033 TT	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.
2e97048a	147	(defconst dwarf-die-reference "\\(<0x\\([0-9a-f]+\\)>\\)")
fd2f0033 TT	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.
0d120726	180	(defun dwarf-do-refresh (&rest _ignore)
c85fa91b	181	(dwarf--check-running)
fd2f0033	182	(let ((inhibit-read-only t))
c85fa91b TT	183	(dwarf--invoke (point-min) (point-max)
	184	dwarf-objdump-program "-Wi" "--dwarf-depth=1"
	185	(expand-file-name dwarf-file))
fd2f0033 TT	186	(set-buffer-modified-p nil)))
fd2f0033 TT	187
93c80543 TT	188	(defun dwarf-refresh-all ()
	189	"Refresh the current buffer without eliding substructure.
	190	Note that this can result in very voluminous output."
	191	(interactive)
	192	(dwarf--check-running)
	193	(let ((inhibit-read-only t))
	194	(dwarf--invoke (point-min) (point-max)
	195	dwarf-objdump-program "-Wi"
	196	(expand-file-name dwarf-file))
	197	(set-buffer-modified-p nil)))
	198
1021d1cb TT	199	(defvar dwarf-mode-syntax-table
	200	(let ((table (make-syntax-table)))
	201	;; This at least makes it so mark-sexp on some hex digits inside
	202	;; <...> does not also copy the ">".
	203	(modify-syntax-entry ?< "(>" table)
	204	(modify-syntax-entry ?> ")<" table)
	205	table)
	206	"Syntax table for dwarf-mode buffers.")
	207
22b63797 TT	208	(defvar dwarf-mode-map
	209	(let ((map (make-sparse-keymap)))
	210	(set-keymap-parent map special-mode-map)
	211	(define-key map [(control ?m)] #'dwarf-insert-substructure)
93c80543	212	(define-key map "A" #'dwarf-refresh-all)
22b63797 TT	213	map)
	214	"Keymap for dwarf-mode buffers.")
	215
fd2f0033 TT	216	(define-derived-mode dwarf-mode special-mode "DWARF"
	217	"Major mode for browsing DWARF output.
	218
	219	\\{dwarf-mode-map}"
	220
	221	(set (make-local-variable 'font-lock-defaults) '(dwarf-font-lock-keywords))
fd2f0033 TT	222	(set (make-local-variable 'revert-buffer-function) #'dwarf-do-refresh)
	223	(jit-lock-register #'dwarf-fontify-region))
	224
6f7b1488	225	;;;###autoload
fd2f0033 TT	226	(defun dwarf-browse (file)
	227	"Invoke `objdump' and put output into a `dwarf-mode' buffer.
	228	This is the main interface to `dwarf-mode'."
	229	(interactive "fFile name: ")
	230	(let* ((base-name (file-name-nondirectory file))
	231	(buffer (generate-new-buffer (concat "DWARF for " base-name ""))))
	232	(pop-to-buffer buffer)
	233	(dwarf-mode)
c42608e1	234	(setq default-directory (file-name-directory file))
fd2f0033	235	(set (make-local-variable 'dwarf-file) file)
c85fa91b TT	236	(set (make-local-variable 'dwarf--process) nil)
c85fa91b TT	237	(set (make-local-variable 'dwarf--deletion-region) nil)
fd2f0033 TT	238	(dwarf-do-refresh)))
	239
	240	(provide 'dwarf-mode)
6f7b1488 TT	241
6f7b1488 TT	242	;;; dwarf-mode.el ends here