gnu1987/emacs18.41/lisp/disass.elc

(require (quote byte-compile) "bytecomp")

(defvar disassemble-column-1-indent 4 "\
*")

(defvar disassemble-column-2-indent 9 "\
*")

(defvar disassemble-recursive-indent 3 "\
*")

(defun disassemble (object &optional stream indent interactive-p) "\
Print disassembled code for OBJECT on (optional) STREAM.
OBJECT can be a function name, lambda expression or any function object
returned by SYMBOL-FUNCTION.  If OBJECT is not already compiled, we will
compile it (but not redefine it)." (interactive (byte-code "ÃÄÅÆÁ$!ÂÇÁF‡" [obarray t nil intern completing-read "Disassemble function: " fboundp 0] 6)) (byte-code "ˆ†	ȉˆƒÉ�Ê
Á$‘‚'Ê
†$Â$ˆÂ‡" [obarray t nil indent interactive-p object standard-output stream 0 "*Disassemble*" disassemble-internal] 6))

(defun disassemble-internal (obj stream indent interactive-p) (byte-code "ÆÆÆÆ9…K‰ˆ‚ˆÌ!…\"ÍÎ	\"ˆ@À=…0ÅA‰ˆ@Ï=?…<ÍÐ!ˆÑÒ\"ƒHÆ‚h…YÓ	ƒVÔ‚WÕ	\"ˆÖ!‰ˆ…hÓ×!ˆA‰ˆ@‰ˆA‰ˆØ	\"ˆÙÚÛ†‡	ƒŽÜ‚�݃—Þ‚˜Ý	ƒ£Úß	\"‚¤Ý$	\"ˆ@;…±@
…ÒA‰ˆØ	\"ˆÙà	\"ˆÙ
	\"ˆá	!)ˆØ	\"ˆÙâ	\"ˆã	\"ˆá	!ˆÑÊ\"A@

…(
Ø	\"ˆÙä	\"ˆå
!Ò=ƒ
æ
	\\#‚(
ã
	\"ˆá	!)ˆÑÒ\"‰ˆæ	#,ˆ…B
ÓÝ!‡" [macro name doc args obj t nil interactive-p indent stream interactive disassemble-recursive-indent subrp error "Can't disassemble #<subr %s>" lambda "not a function" assq byte-code message "Compiling %s's definition..." "Compiling definition..." byte-compile-lambda "Done compiling.  Disassembling..." write-spaces princ format "byte code%s%s%s:
" " for" "" " macro" " %s" " doc: " terpri " args: " prin1 " interactive: " car-safe disassemble-1] 31))

(defun disassemble-1 (obj &optional stream indent) "\
Prints the byte-code call OBJ to (optional) STREAM.
OBJ should be a call to BYTE-CODE generated by the byte compiler." (byte-code "†Þ‰ˆ	†
‰ˆA@ßAA@ÍÍÍ	G‰	ˆà	!ˆ
T‰	W…¶
á	\"ˆâã
!‰	\"ˆäå	\"ˆáæ
Gç#	\"ˆ
H‰ˆè ‰ˆH‰ˆ:…{@‰ˆé!‰ˆâ	\"ˆ?ƒ”Í‚®
äå	\"ˆáæGç#	\"ˆâ=†»=†»=ƒÆH‚¬
=†û=†û=†û=†û=†û=†û=ƒ
‚¬
=†
=ƒ«
H‰ˆê!ë=…*
ìí\"ƒD
âî	\"ˆà	!ˆï	\\#ˆð‚¨
ê!í=ƒd
âñ	\"ˆà	!ˆò	\\#ˆð‚¨
êê!!í=ƒ‚
âó	\"ˆà	!ˆôõ\"ˆð‚¨
í=…“

ö\\H÷\\=ƒ 

ö\\‰ˆø‚¨
Üã!)‚¬
ù	\"ˆà	!ˆ‚/.ˆÍ‡" [indent stream standard-output bytes obj ptr constants offset tmp length disassemble-column-1-indent op byte-code-vector nil disassemble-column-2-indent byte-varref byte-varset byte-varbind byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop byte-call byte-unbind byte-constant byte-constant2 disassemble-recursive-indent t print-escape-newlines 0 -1 terpri write-spaces princ prin1-to-string write-char 32 - 1 disassemble-offset symbol-name car-safe lambda assq byte-code "<compiled lambda>" disassemble "" "<byte code>" disassemble-1 "(<byte code>...)" mapcar (lambda (obj) (byte-code "Ä	
\\#‡" [obj stream indent disassemble-recursive-indent disassemble-1] 5)) 4 3 "<compiled call to byte-code.  compiled code compiled?>" "<error in disassembler>"] 32))

(defun disassemble-offset nil "\
Don't call this!" (byte-code "Ê	
WƒHË	Ì\"‰ˆË	Í\"‰ˆÎ=ƒ'T‰ˆH‚EÌ=ƒDT‰ˆHT‰ˆÏHÐ\"\\‚E‚Œ	Yƒ_	Z‰ˆ‰ˆ‚Œ	U†q	Y…q		Xƒ‹T‰ˆHT‰ˆÏHÐ\"\\‚ŒÊ)‡" [tem op byte-nth ptr bytes t byte-constant byte-constant2 byte-goto byte-goto-if-not-nil-else-pop nil logand 7 248 6 lsh 8] 7))

(defun write-spaces (n &optional stream) "\
Print N spaces to (optional) STREAM." (byte-code "†	‰ˆ
ÃW…Ɉp=ƒÄÅ
\"‚2
ÃV…2ÆÅ\"ˆ
S‰ˆ‚‡" [stream standard-output n 0 insert-char 32 write-char] 5))

(defconst byte-code-vector (quote [<not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> (varref . 1) <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> (varset . -1) <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> (varbind . 0) <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> (call . -) <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> (unbind . -) <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> (nth . -1) symbolp consp stringp listp (eq . -1) (memq . -1) not car cdr (cons . -1) list1 (list2 . -1) (list3 . -2) (list4 . -3) length (aref . -1) (aset . -2) symbol-value symbol-function (set . -1) (fset . -1) (get . -1) (substring . -2) (concat2 . -1) (concat3 . -2) (concat4 . -3) sub1 add1 (eqlsign . -1) (gtr . -1) (lss . -1) (leq . -1) (geq . -1) (diff . -1) negate (plus . -1) (max . -1) (min . -1) <not-an-opcode> (point . 1) (mark\(obsolete\) . 1) goto-char insert (point-max . 1) (point-min . 1) char-after (following-char . 1) (preceding-char . 1) (current-column . 1) (indent-to . 1) (scan-buffer\(obsolete\) . -2) (eolp . 1) (eobp . 1) (bolp . 1) (bobp . 1) (current-buffer . 1) set-buffer (read-char . 1) set-mark\(obsolete\) interactive-p <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> (constant2 . 1) goto goto-if-nil goto-if-not-nil (goto-if-nil-else-pop . -1) (goto-if-not-nil-else-pop . -1) return (discard . -1) (dup . 1) (save-excursion . 1) (save-window-excursion . 1) (save-restriction . 1) (catch . -1) (unwind-protect . 1) (condition-case . -2) (temp-output-buffer-setup . -1) temp-output-buffer-show <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> <not-an-opcode> (constant . 1)]))