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

disass.el (disassemble-1): Minor simplification

Browse source 
* lisp/emacs-lisp/disass.el (disassemble-1): Remove code for functions
of the form (lambda ARGS (byte-code ...)) which we don't use any
more nowadays.
This commit is contained in:
Stefan Monnier 2024-03-04 23:42:50 -05:00
parent 418ad866bf
commit 218748c262
1 changed files with 16 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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)
@ -250,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
@ -285,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