procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix disassembly of non-compiled lexical functions (bug#21377)

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2015-09-03 15:15:11 -04:00
parent 2d19f8c8b4
commit c624ab229b
2 changed files with 32 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lisp/emacs-lisp/bytecomp.el
View file

@ -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.

63
lisp/emacs-lisp/disass.el
View file

@ -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 #<subr %s>" 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 "<compiled-function>\n"))
((eq (car-safe arg) 'lambda)
((functionp arg)
(insert "<compiled lambda>"))
(t (insert "<compiled macro>\n")))
(disassemble-internal