diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-08-19 16:48:59 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-08-19 16:48:59 -0700 |
commit | 07fcbb558d797272b9f43547da60beda485873a3 (patch) | |
tree | 77d5da14e9f9d9d8b1d877c70c01296fd3893796 /lisp/emacs-lisp/disass.el | |
parent | c9bdeff3e45a7ac84a74a81bb048046f82dddc91 (diff) | |
parent | fb81c8c3adf8633f2f617c82f6019aef630860c7 (diff) | |
download | emacs-07fcbb558d797272b9f43547da60beda485873a3.tar.gz |
Merge remote-tracking branch 'origin/master' into athena/unstable
Diffstat (limited to 'lisp/emacs-lisp/disass.el')
-rw-r--r-- | lisp/emacs-lisp/disass.el | 31 |
1 files changed, 28 insertions, 3 deletions
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 0d2890999a4..712fa511707 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 "*") @@ -73,8 +75,9 @@ redefine OBJECT if it is a symbol." (disassemble-internal object indent nil))) nil) - -(defun disassemble-internal (obj indent interactive-p) +(declare-function native-comp-unit-file "data.c") +(declare-function subr-native-comp-unit "data.c") +(cl-defun disassemble-internal (obj indent interactive-p) (let ((macro 'nil) (name (when (symbolp obj) (prog1 obj @@ -82,7 +85,29 @@ 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 "<" + (when (eq system-type 'darwin) + "_") + (comp-c-func-name + (subr-name obj) "F" t) + ">:")))) + (beginning-of-line) + (delete-region (point-min) (point)) + (when (re-search-forward "^.*<.*>:" nil t 2) + (delete-region (match-beginning 0) (point-max))) + (asm-mode) + (setq buffer-read-only t) + (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))) |