aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/emacs-lisp/bytecomp.el4
-rw-r--r--lisp/emacs-lisp/disass.el63
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."
2585 (if (symbolp form) form "provided")) 2585 (if (symbolp form) form "provided"))
2586 fun) 2586 fun)
2587 (t 2587 (t
2588 (when (symbolp form) 2588 (when (or (symbolp form) (eq (car-safe fun) 'closure))
2589 ;; `fun' is a function *value*, so try to recover its corresponding
2590 ;; source code.
2589 (setq lexical-binding (eq (car fun) 'closure)) 2591 (setq lexical-binding (eq (car fun) 'closure))
2590 (setq fun (byte-compile--reify-function fun))) 2592 (setq fun (byte-compile--reify-function fun)))
2591 ;; Expand macros. 2593 ;; 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 @@
1;;; disass.el --- disassembler for compiled Emacs Lisp code 1;;; disass.el --- disassembler for compiled Emacs Lisp code -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1986, 1991, 2002-2015 Free Software Foundation, Inc. 3;; Copyright (C) 1986, 1991, 2002-2015 Free Software Foundation, Inc.
4 4
@@ -37,9 +37,9 @@
37 37
38(require 'macroexp) 38(require 'macroexp)
39 39
40;;; The variable byte-code-vector is defined by the new bytecomp.el. 40;; The variable byte-code-vector is defined by the new bytecomp.el.
41;;; The function byte-decompile-lapcode is defined in byte-opt.el. 41;; The function byte-decompile-lapcode is defined in byte-opt.el.
42;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt. 42;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
43(require 'byte-compile "bytecomp") 43(require 'byte-compile "bytecomp")
44 44
45(defvar disassemble-column-1-indent 8 "*") 45(defvar disassemble-column-1-indent 8 "*")
@@ -57,8 +57,8 @@ redefine OBJECT if it is a symbol."
57 (interactive (list (intern (completing-read "Disassemble function: " 57 (interactive (list (intern (completing-read "Disassemble function: "
58 obarray 'fboundp t)) 58 obarray 'fboundp t))
59 nil 0 t)) 59 nil 0 t))
60 (if (and (consp object) (not (eq (car object) 'lambda))) 60 (if (and (consp object) (not (functionp object)))
61 (setq object (list 'lambda () object))) 61 (setq object `(lambda () ,object)))
62 (or indent (setq indent 0)) ;Default indent to zero 62 (or indent (setq indent 0)) ;Default indent to zero
63 (save-excursion 63 (save-excursion
64 (if (or interactive-p (null buffer)) 64 (if (or interactive-p (null buffer))
@@ -72,37 +72,34 @@ redefine OBJECT if it is a symbol."
72 72
73(defun disassemble-internal (obj indent interactive-p) 73(defun disassemble-internal (obj indent interactive-p)
74 (let ((macro 'nil) 74 (let ((macro 'nil)
75 (name 'nil) 75 (name (when (symbolp obj)
76 (doc 'nil) 76 (prog1 obj
77 (setq obj (indirect-function obj)))))
77 args) 78 args)
78 (while (symbolp obj) 79 (setq obj (autoload-do-load obj name))
79 (setq name obj
80 obj (symbol-function obj)))
81 (if (subrp obj) 80 (if (subrp obj)
82 (error "Can't disassemble #<subr %s>" name)) 81 (error "Can't disassemble #<subr %s>" name))
83 (setq obj (autoload-do-load obj name))
84 (if (eq (car-safe obj) 'macro) ;Handle macros. 82 (if (eq (car-safe obj) 'macro) ;Handle macros.
85 (setq macro t 83 (setq macro t
86 obj (cdr obj))) 84 obj (cdr obj)))
87 (if (and (listp obj) (eq (car obj) 'byte-code)) 85 (if (eq (car-safe obj) 'byte-code)
88 (setq obj (list 'lambda nil obj))) 86 (setq obj `(lambda () ,obj)))
89 (if (and (listp obj) (not (eq (car obj) 'lambda))) 87 (when (consp obj)
90 (error "not a function")) 88 (unless (functionp obj) (error "not a function"))
91 (if (consp obj) 89 (if (assq 'byte-code obj)
92 (if (assq 'byte-code obj) 90 nil
93 nil 91 (if interactive-p (message (if name
94 (if interactive-p (message (if name 92 "Compiling %s's definition..."
95 "Compiling %s's definition..." 93 "Compiling definition...")
96 "Compiling definition...") 94 name))
97 name)) 95 (setq obj (byte-compile obj))
98 (setq obj (byte-compile obj)) 96 (if interactive-p (message "Done compiling. Disassembling..."))))
99 (if interactive-p (message "Done compiling. Disassembling..."))))
100 (cond ((consp obj) 97 (cond ((consp obj)
98 (setq args (help-function-arglist obj)) ;save arg list
101 (setq obj (cdr obj)) ;throw lambda away 99 (setq obj (cdr obj)) ;throw lambda away
102 (setq args (car obj)) ;save arg list
103 (setq obj (cdr obj))) 100 (setq obj (cdr obj)))
104 ((byte-code-function-p obj) 101 ((byte-code-function-p obj)
105 (setq args (aref obj 0))) 102 (setq args (help-function-arglist obj)))
106 (t (error "Compilation failed"))) 103 (t (error "Compilation failed")))
107 (if (zerop indent) ; not a nested function 104 (if (zerop indent) ; not a nested function
108 (progn 105 (progn
@@ -127,10 +124,7 @@ redefine OBJECT if it is a symbol."
127 (insert " args: ") 124 (insert " args: ")
128 (prin1 args (current-buffer)) 125 (prin1 args (current-buffer))
129 (insert "\n") 126 (insert "\n")
130 (let ((interactive (cond ((consp obj) 127 (let ((interactive (interactive-form obj)))
131 (assq 'interactive obj))
132 ((> (length obj) 5)
133 (list 'interactive (aref obj 5))))))
134 (if interactive 128 (if interactive
135 (progn 129 (progn
136 (setq interactive (nth 1 interactive)) 130 (setq interactive (nth 1 interactive))
@@ -226,15 +220,16 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
226 ;; but if the value of the constant is compiled code, then 220 ;; but if the value of the constant is compiled code, then
227 ;; recursively disassemble it. 221 ;; recursively disassemble it.
228 (cond ((or (byte-code-function-p arg) 222 (cond ((or (byte-code-function-p arg)
229 (and (eq (car-safe arg) 'lambda) 223 (and (consp arg) (functionp arg)
230 (assq 'byte-code arg)) 224 (assq 'byte-code arg))
231 (and (eq (car-safe arg) 'macro) 225 (and (eq (car-safe arg) 'macro)
232 (or (byte-code-function-p (cdr arg)) 226 (or (byte-code-function-p (cdr arg))
233 (and (eq (car-safe (cdr arg)) 'lambda) 227 (and (consp (cdr arg))
228 (functionp (cdr arg))
234 (assq 'byte-code (cdr arg)))))) 229 (assq 'byte-code (cdr arg))))))
235 (cond ((byte-code-function-p arg) 230 (cond ((byte-code-function-p arg)
236 (insert "<compiled-function>\n")) 231 (insert "<compiled-function>\n"))
237 ((eq (car-safe arg) 'lambda) 232 ((functionp arg)
238 (insert "<compiled lambda>")) 233 (insert "<compiled lambda>"))
239 (t (insert "<compiled macro>\n"))) 234 (t (insert "<compiled macro>\n")))
240 (disassemble-internal 235 (disassemble-internal