sdcc-3.9.0 fork implementing GNU assembler syntax

This fork aims to provide better support for stm8-binutils

1 files changed, 218 insertions, 0 deletions

diff --git a/support/sdbinutils/binutils/dwarf-mode.el b/support/sdbinutils/binutils/dwarf-mode.el
new file mode 100644
index 0000000..8eed1b7
--- /dev/null
+++ b/support/sdbinutils/binutils/dwarf-mode.el
@@ -0,0 +1,218 @@
+;;; dwarf-mode.el --- Browser for DWARF information. -*-lexical-binding:t-*-
+
+;; Version: 1.4
+
+;; Copyright (C) 2012-2018 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-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