add disassemble support for native compiled functions

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

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)))