From ca8d5ed6ecd5ca3eafa2923ee04e56dc474bd964 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 23 Dec 2019 11:51:33 +0100 Subject: add disassemble support for native compiled functions --- lisp/emacs-lisp/disass.el | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/disass.el') 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 #" 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 #" name))) (if (eq (car-safe obj) 'macro) ;Handle macros. (setq macro t obj (cdr obj))) -- cgit v1.2.3 From 92e285fdf0821d8a01db598c4e2ac7e2e0fbb3cf Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 26 Dec 2019 08:35:01 +0100 Subject: set disassemble buffer in read only --- lisp/emacs-lisp/disass.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/emacs-lisp/disass.el') diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index c23dbe1e068..82c8de6e133 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -103,6 +103,7 @@ redefine OBJECT if it is a symbol." (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 #" name))) (if (eq (car-safe obj) 'macro) ;Handle macros. -- cgit v1.2.3 From 8f81859497b7dd0c537d24a27985a26ffc778a3a Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 2 Jul 2020 21:32:09 +0200 Subject: Rework `comp-c-func-name' arguments * lisp/emacs-lisp/comp.el (comp-c-func-name): Add FIRST argument to ignore the compiler context and return the first name. * lisp/emacs-lisp/disass.el (disassemble-internal): Update the `comp-c-func-name' call. --- lisp/emacs-lisp/comp.el | 8 +++++--- lisp/emacs-lisp/disass.el | 2 +- 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/disass.el') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 205966f57c6..a16cf1dcc88 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -566,9 +566,11 @@ instruction." (or (comp-spill-decl-spec function-name 'speed) comp-speed)) -(defun comp-c-func-name (name prefix) +(defun comp-c-func-name (name prefix &optional first) "Given NAME return a name suitable for the native code. -Put PREFIX in front of it." +Add PREFIX in front of it. If FIRST is not nil pick the first +available name ignoring compilation context and potential name +clashes." ;; Unfortunatelly not all symbol names are valid as C function names... ;; Nassi's algorithm here: (let* ((orig-name (if (symbolp name) (symbol-name name) name)) @@ -583,7 +585,7 @@ Put PREFIX in front of it." "-" "_" orig-name)) (human-readable (replace-regexp-in-string (rx (not (any "0-9a-z_"))) "" human-readable))) - (if comp-ctxt + (if (null first) ;; Prevent C namespace conflicts. (cl-loop with h = (comp-ctxt-funcs-h comp-ctxt) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 82c8de6e133..aa8b248f39e 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -96,7 +96,7 @@ redefine OBJECT if it is a symbol." (regexp-quote (concat "<" (comp-c-func-name - (subr-name obj) "F") + (subr-name obj) "F" t) ">:")))) (beginning-of-line) (delete-region (point-min) (point)) -- cgit v1.2.3 From 39bdb3f6f54cdba80f1efbecab4bbb08428e7cc8 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 4 Dec 2020 22:31:36 +0100 Subject: Vanilla build warning clean-up * lisp/emacs-lisp/disass.el (native-comp-unit-file) (subr-native-comp-unit): Declare function. * lisp/progmodes/elisp-mode.el (native-compile): Likewise. * lisp/emacs-lisp/package.el (comp-el-to-eln-filename): Likewise. * lisp/startup.el (normal-top-level): Silence warning. * src/data.c (syms_of_data): 'Ssubr_native_lambda_list' is always defined. * src/pdumper.c (dump_cold_native_subr): Move under ifdefs. (dump_drain_cold_data): Add ifdefs. --- lisp/emacs-lisp/disass.el | 3 ++- lisp/emacs-lisp/package.el | 1 + lisp/progmodes/elisp-mode.el | 1 + lisp/startup.el | 1 + src/data.c | 2 +- src/pdumper.c | 4 ++++ 6 files changed, 10 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/disass.el') diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 7e7db7b441d..7fb370f5df5 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -75,7 +75,8 @@ redefine OBJECT if it is a symbol." (disassemble-internal object indent nil))) nil) - +(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) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 0ee2e58d528..e980f8841e0 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2221,6 +2221,7 @@ If some packages are not installed propose to install them." (equal (cadr (assq (package-desc-name pkg) package-alist)) pkg)) +(declare-function comp-el-to-eln-filename "comp.c") (defun package--delete-directory (dir) "Delete DIR recursively. Clean-up the corresponding .eln files if Emacs is native diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index dac3aaf2a53..13bba7f77a8 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -203,6 +203,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (byte-recompile-file buffer-file-name nil 0) (load buffer-file-name)) +(declare-function native-compile "comp") (defun emacs-lisp-native-compile-and-load () "Native-compile synchronously the current file (if it has changed). Load the compiled code when finished. diff --git a/lisp/startup.el b/lisp/startup.el index 2beeaa195d0..f9de7fa94f6 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -535,6 +535,7 @@ It is the default value of the variable `top-level'." (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) (when (featurep 'nativecomp) + (defvar comp-eln-load-path) (let ((path-env (getenv "EMACSNATIVELOADPATH"))) (when path-env (dolist (path (split-string path-env ":")) diff --git a/src/data.c b/src/data.c index 1435cb03779..fea39867c99 100644 --- a/src/data.c +++ b/src/data.c @@ -4055,8 +4055,8 @@ syms_of_data (void) defsubr (&Ssubr_arity); defsubr (&Ssubr_name); defsubr (&Ssubr_native_elisp_p); -#ifdef HAVE_NATIVE_COMP defsubr (&Ssubr_native_lambda_list); +#ifdef HAVE_NATIVE_COMP defsubr (&Ssubr_native_comp_unit); defsubr (&Snative_comp_unit_file); defsubr (&Snative_comp_unit_set_file); diff --git a/src/pdumper.c b/src/pdumper.c index 1a7aee6343a..b3abbd66f0c 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -3405,6 +3405,7 @@ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object) } } +#ifdef HAVE_NATIVE_COMP static void dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr) { @@ -3425,6 +3426,7 @@ dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr) const char *c_name = XSUBR (subr)->native_c_name[0]; dump_write (ctx, c_name, 1 + strlen (c_name)); } +#endif static void dump_drain_cold_data (struct dump_context *ctx) @@ -3469,9 +3471,11 @@ dump_drain_cold_data (struct dump_context *ctx) case COLD_OP_BIGNUM: dump_cold_bignum (ctx, data); break; +#ifdef HAVE_NATIVE_COMP case COLD_OP_NATIVE_SUBR: dump_cold_native_subr (ctx, data); break; +#endif default: emacs_abort (); } -- cgit v1.2.3 From b44abacc8cfee02de45773424dd7b18d8794a6c3 Mon Sep 17 00:00:00 2001 From: Jimmy Yuen Ho Wong Date: Tue, 3 Aug 2021 08:14:38 +0100 Subject: * Fix error while disassembling native code on macOS * lisp/emacs-lisp/disass.el (disassemble-internal): Make sure the regexp that searches for a symbol takes into account of llvm-objdump's output format. --- lisp/emacs-lisp/disass.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp/emacs-lisp/disass.el') diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 6ac76f1c19d..712fa511707 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -95,6 +95,8 @@ redefine OBJECT if it is a symbol." (re-search-forward (concat "^.*" (regexp-quote (concat "<" + (when (eq system-type 'darwin) + "_") (comp-c-func-name (subr-name obj) "F" t) ">:")))) -- cgit v1.2.3