URL
https://opencores.org/ocsvn/open8_urisc/open8_urisc/trunk
Subversion Repositories open8_urisc
[/] [open8_urisc/] [trunk/] [gnu/] [binutils/] [binutils/] [dwarf-mode.el] - Rev 308
Go to most recent revision | Compare with Previous | Blame | View Log
;;; dwarf-mode.el --- Browser for DWARF information. ;; Version: 1.0 ;; 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-int (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]+\\)>\\)\\s *$") ;; 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))) ;;;###autoload (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)
Go to most recent revision | Compare with Previous | Blame | View Log