diff options
Diffstat (limited to 'lisp/emacs-lisp/disass.el')
| -rw-r--r-- | lisp/emacs-lisp/disass.el | 41 |
1 files changed, 16 insertions, 25 deletions
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index a876e6b5744..850cc2085f7 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -54,7 +54,7 @@ (defun disassemble (object &optional buffer indent interactive-p) "Print disassembled code for OBJECT in (optional) BUFFER. OBJECT can be a symbol defined as a function, or a function itself -\(a lambda expression or a compiled-function object). +\(a lambda expression or a byte-code-function object). If OBJECT is not already compiled, we compile it, but do not redefine OBJECT if it is a symbol." (interactive @@ -70,7 +70,7 @@ redefine OBJECT if it is a symbol." (save-excursion (if (or interactive-p (null buffer)) (with-output-to-temp-buffer "*Disassemble*" - (set-buffer "*Disassemble*") + (set-buffer standard-output) (let ((lexical-binding lb)) (disassemble-internal object indent (not interactive-p)))) (set-buffer buffer) @@ -191,8 +191,6 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." (if (consp obj) (setq bytes (car (cdr obj)) ;the byte code constvec (car (cdr (cdr obj)))) ;constant vector - ;; If it is lazy-loaded, load it now - (fetch-bytecode obj) (setq bytes (aref obj 1) constvec (aref obj 2))) (cl-assert (not (multibyte-string-p bytes))) @@ -252,29 +250,22 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." ;; if the succeeding op is byte-switch, display the jump table ;; used (cond ((eq (car-safe (car-safe (cdr lap))) 'byte-switch) - (insert (format "<jump-table-%s (" (hash-table-test arg))) - (let ((first-time t)) - (maphash #'(lambda (value tag) - (if first-time - (setq first-time nil) - (insert " ")) - (insert (format "%s %s" value (cadr tag)))) - arg)) - (insert ")>")) - ;; if the value of the constant is compiled code, then - ;; recursively disassemble it. - ((or (byte-code-function-p arg) - (and (consp arg) (functionp arg) - (assq 'byte-code arg)) + (insert (format "<jump-table-%s (" (hash-table-test arg))) + (let ((first-time t)) + (maphash #'(lambda (value tag) + (if first-time + (setq first-time nil) + (insert " ")) + (insert (format "%s %s" value (cadr tag)))) + arg)) + (insert ")>")) + ;; if the value of the constant is compiled code, then + ;; recursively disassemble it. + ((or (byte-code-function-p arg) (and (eq (car-safe arg) 'macro) - (or (byte-code-function-p (cdr arg)) - (and (consp (cdr arg)) - (functionp (cdr arg)) - (assq 'byte-code (cdr arg)))))) + (byte-code-function-p (cdr arg)))) (cond ((byte-code-function-p arg) (insert "<compiled-function>\n")) - ((functionp arg) - (insert "<compiled lambda>")) (t (insert "<compiled macro>\n"))) (disassemble-internal arg @@ -287,7 +278,7 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler." (+ indent disassemble-recursive-indent))) ((eq (car-safe (car-safe arg)) 'byte-code) (insert "(<byte code>...)\n") - (mapc ;recurse on list of byte-code objects + (mapc ;Recurse on list of byte-code objects. (lambda (obj) (disassemble-1 obj |