From c624ab229bdcefb42e4b81ff613e53c982f58cc1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 3 Sep 2015 15:15:11 -0400 Subject: [PATCH] Fix disassembly of non-compiled lexical functions (bug#21377) * lisp/emacs-lisp/bytecomp.el (byte-compile): Handle `closure' arg. * lisp/emacs-lisp/disass.el: Use lexical-binding. (disassemble): Recognize `closure's as well. (disassemble-internal): Use indirect-function and help-function-arglist, and accept `closure's. (disassemble-internal): Use interactive-form. (disassemble-1): Use functionp. --- lisp/emacs-lisp/bytecomp.el | 4 ++- lisp/emacs-lisp/disass.el | 63 +++++++++++++++++++++------------------------ 2 files changed, 32 insertions(+), 35 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7182c0b6372..9edb8d7122c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2585,7 +2585,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (symbolp form) form "provided")) fun) (t - (when (symbolp form) + (when (or (symbolp form) (eq (car-safe fun) 'closure)) + ;; `fun' is a function *value*, so try to recover its corresponding + ;; source code. (setq lexical-binding (eq (car fun) 'closure)) (setq fun (byte-compile--reify-function fun))) ;; Expand macros. diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 15489fc2015..12cf605cce9 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -1,4 +1,4 @@ -;;; disass.el --- disassembler for compiled Emacs Lisp code +;;; disass.el --- disassembler for compiled Emacs Lisp code -*- lexical-binding:t -*- ;; Copyright (C) 1986, 1991, 2002-2015 Free Software Foundation, Inc. @@ -37,9 +37,9 @@ (require 'macroexp) -;;; The variable byte-code-vector is defined by the new bytecomp.el. -;;; The function byte-decompile-lapcode is defined in byte-opt.el. -;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt. +;; The variable byte-code-vector is defined by the new bytecomp.el. +;; The function byte-decompile-lapcode is defined in byte-opt.el. +;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt. (require 'byte-compile "bytecomp") (defvar disassemble-column-1-indent 8 "*") @@ -57,8 +57,8 @@ redefine OBJECT if it is a symbol." (interactive (list (intern (completing-read "Disassemble function: " obarray 'fboundp t)) nil 0 t)) - (if (and (consp object) (not (eq (car object) 'lambda))) - (setq object (list 'lambda () object))) + (if (and (consp object) (not (functionp object))) + (setq object `(lambda () ,object))) (or indent (setq indent 0)) ;Default indent to zero (save-excursion (if (or interactive-p (null buffer)) @@ -72,37 +72,34 @@ redefine OBJECT if it is a symbol." (defun disassemble-internal (obj indent interactive-p) (let ((macro 'nil) - (name 'nil) - (doc 'nil) + (name (when (symbolp obj) + (prog1 obj + (setq obj (indirect-function obj))))) args) - (while (symbolp obj) - (setq name obj - obj (symbol-function obj))) + (setq obj (autoload-do-load obj name)) (if (subrp obj) (error "Can't disassemble #" name)) - (setq obj (autoload-do-load obj name)) (if (eq (car-safe obj) 'macro) ;Handle macros. (setq macro t obj (cdr obj))) - (if (and (listp obj) (eq (car obj) 'byte-code)) - (setq obj (list 'lambda nil obj))) - (if (and (listp obj) (not (eq (car obj) 'lambda))) - (error "not a function")) - (if (consp obj) - (if (assq 'byte-code obj) - nil - (if interactive-p (message (if name - "Compiling %s's definition..." - "Compiling definition...") - name)) - (setq obj (byte-compile obj)) - (if interactive-p (message "Done compiling. Disassembling...")))) + (if (eq (car-safe obj) 'byte-code) + (setq obj `(lambda () ,obj))) + (when (consp obj) + (unless (functionp obj) (error "not a function")) + (if (assq 'byte-code obj) + nil + (if interactive-p (message (if name + "Compiling %s's definition..." + "Compiling definition...") + name)) + (setq obj (byte-compile obj)) + (if interactive-p (message "Done compiling. Disassembling...")))) (cond ((consp obj) + (setq args (help-function-arglist obj)) ;save arg list (setq obj (cdr obj)) ;throw lambda away - (setq args (car obj)) ;save arg list (setq obj (cdr obj))) ((byte-code-function-p obj) - (setq args (aref obj 0))) + (setq args (help-function-arglist obj))) (t (error "Compilation failed"))) (if (zerop indent) ; not a nested function (progn @@ -127,10 +124,7 @@ redefine OBJECT if it is a symbol." (insert " args: ") (prin1 args (current-buffer)) (insert "\n") - (let ((interactive (cond ((consp obj) - (assq 'interactive obj)) - ((> (length obj) 5) - (list 'interactive (aref obj 5)))))) + (let ((interactive (interactive-form obj))) (if interactive (progn (setq interactive (nth 1 interactive)) @@ -226,15 +220,16 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." ;; but if the value of the constant is compiled code, then ;; recursively disassemble it. (cond ((or (byte-code-function-p arg) - (and (eq (car-safe arg) 'lambda) + (and (consp arg) (functionp arg) (assq 'byte-code arg)) (and (eq (car-safe arg) 'macro) (or (byte-code-function-p (cdr arg)) - (and (eq (car-safe (cdr arg)) 'lambda) + (and (consp (cdr arg)) + (functionp (cdr arg)) (assq 'byte-code (cdr arg)))))) (cond ((byte-code-function-p arg) (insert "\n")) - ((eq (car-safe arg) 'lambda) + ((functionp arg) (insert "")) (t (insert "\n"))) (disassemble-internal -- 2.11.4.GIT