From: Andrea Corallo <akrl@sdf.org>
Date: Mon, 23 Dec 2019 10:51:33 +0000 (+0100)
Subject: add disassemble support for native compiled functions
X-Git-Tag: emacs-28.0.90~2727^2~892
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ca8d5ed6ecd5ca3eafa2923ee04e56dc474bd964;p=emacs.git

add disassemble support for native compiled functions
---

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 49f25d85c0e..e8a9b6c2b69 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -360,12 +360,12 @@ VERBOSITY is a number between 0 and 3."
 
 ;;; spill-lap pass specific code.
 
-(defun comp-c-func-name (symbol prefix)
-  "Given SYMBOL return a name suitable for the native code.
+(defun comp-c-func-name (name prefix)
+  "Given NAME return a name suitable for the native code.
 Put PREFIX in front of it."
   ;; Unfortunatelly not all symbol names are valid as C function names...
   ;; Nassi's algorithm here:
-  (let* ((orig-name (symbol-name symbol))
+  (let* ((orig-name (if (symbolp name) (symbol-name name) name))
          (crypted (cl-loop with str = (make-string (* 2 (length orig-name)) 0)
 	                   for j from 0 by 2
 	                   for i across orig-name
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 51b7db24f3c..c23dbe1e068 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -43,6 +43,8 @@
 ;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
 (require 'byte-compile "bytecomp")
 
+(declare-function comp-c-func-name "comp.el")
+
 (defvar disassemble-column-1-indent 8 "*")
 (defvar disassemble-column-2-indent 10 "*")
 
@@ -75,7 +77,7 @@ redefine OBJECT if it is a symbol."
   nil)
 
 
-(defun disassemble-internal (obj indent interactive-p)
+(cl-defun disassemble-internal (obj indent interactive-p)
   (let ((macro 'nil)
 	(name (when (symbolp obj)
                 (prog1 obj
@@ -83,7 +85,26 @@ redefine OBJECT if it is a symbol."
 	args)
     (setq obj (autoload-do-load obj name))
     (if (subrp obj)
-	(error "Can't disassemble #<subr %s>" name))
+        (if (and (fboundp 'subr-native-elisp-p)
+                 (subr-native-elisp-p obj))
+            (progn
+              (require 'comp)
+              (call-process "objdump" nil (current-buffer) t "-S"
+                            (native-comp-unit-file (subr-native-comp-unit obj)))
+              (goto-char (point-min))
+              (re-search-forward (concat "^.*"
+                                         (regexp-quote
+                                          (concat "<"
+                                                  (comp-c-func-name
+                                                   (subr-name obj) "F")
+                                                  ">:"))))
+              (beginning-of-line)
+              (delete-region (point-min) (point))
+              (when (re-search-forward "^.*<.*>:" nil t 2)
+                (delete-region (match-beginning 0) (point-max)))
+              (asm-mode)
+              (cl-return-from disassemble-internal))
+	  (error "Can't disassemble #<subr %s>" name)))
     (if (eq (car-safe obj) 'macro)	;Handle macros.
 	(setq macro t
 	      obj (cdr obj)))