add disassemble support for native compiled functions

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 49f25d85c0eaabcd6284464a482bbd6b009af729..e8a9b6c2b694ed2fd0e14781a5aaa24ce3d90c47 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -360,12 +360,12 @@ VERBOSITY is a number between 0 and 3."
 \f
 ;;; 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 51b7db24f3cc9cc0692c96c9be40734722366865..c23dbe1e06860b29d8385b402a2e3f4169b86d20 100644 (file)
--- 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)))