(lisp-mode-shared-map): Bind `backspace' to `backward-delete-char-untabify'.

[gnu-emacs] / lisp / emacs-lisp / disass.el

diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index b60ba5a2385ba8878f2809b835115545a14802fa..bf9e9d04cccb5eb393f424d7407a72c888640933 100644 (file)
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -1,6 +1,6 @@
 ;;; disass.el --- disassembler for compiled Emacs Lisp code
 
-;;; Copyright (C) 1986, 1991 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1991 Free Software Foundation, Inc.
 
 ;; Author: Doug Cutting <doug@csli.stanford.edu>
 ;;     Jamie Zawinski <jwz@lucid.com>
@@ -20,8 +20,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
@@ -41,7 +42,7 @@
 ;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
 (require 'byte-compile "bytecomp")
 
-(defvar disassemble-column-1-indent 5 "*")
+(defvar disassemble-column-1-indent 8 "*")
 (defvar disassemble-column-2-indent 10 "*")
 
 (defvar disassemble-recursive-indent 3 "*")
@@ -79,9 +80,15 @@ redefine OBJECT if it is a symbol."
            obj (symbol-function obj)))
     (if (subrp obj)
        (error "Can't disassemble #<subr %s>" name))
+    (if (and (listp obj) (eq (car obj) 'autoload))
+       (progn
+         (load (nth 1 obj))
+         (setq obj (symbol-function 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)
@@ -97,8 +104,9 @@ redefine OBJECT if it is a symbol."
           (setq obj (cdr obj))         ;throw lambda away
           (setq args (car obj))        ;save arg list
           (setq obj (cdr obj)))
-         (t
-          (setq args (aref obj 0))))
+         ((byte-code-function-p obj)
+          (setq args (aref obj 0)))
+          (t (error "Compilation failed")))
     (if (zerop indent) ; not a nested function
        (progn
          (indent-to indent)
@@ -108,7 +116,8 @@ redefine OBJECT if it is a symbol."
                          (if name (format " %s" name) "")))))
     (let ((doc (if (consp obj)
                   (and (stringp (car obj)) (car obj))
-                (and (> (length obj) 4) (aref obj 4)))))
+                ;; Use documentation to get lazy-loaded doc string
+                (documentation obj t))))
       (if (and doc (stringp doc))
          (progn (and (consp obj) (setq obj (cdr obj)))
                 (indent-to indent)
@@ -160,10 +169,12 @@ 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)))
-    (let ((lap (byte-decompile-bytecode bytes constvec))
-         op arg opname)
+    (let ((lap (byte-decompile-bytecode (string-as-unibyte bytes) constvec))
+         op arg opname pc-value)
       (let ((tagno 0)
            tmp
            (lap lap))
@@ -171,12 +182,26 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
          (setcar (cdr tmp) (setq tagno (1+ tagno)))
          (setq lap (cdr (memq tmp lap)))))
       (while lap
+       ;; Take off the pc value of the next thing
+       ;; and put it in pc-value.
+       (setq pc-value nil)
+       (if (numberp (car lap))
+           (setq pc-value (car lap)
+                 lap (cdr lap)))
+       ;; Fetch the next op and its arg.
        (setq op (car (car lap))
              arg (cdr (car lap)))
+       (setq lap (cdr lap))
        (indent-to indent)
        (if (eq 'TAG op)
-           (insert (int-to-string (car arg)) ":")
-
+           (progn
+             ;; We have a label.  Display it, but first its pc value.
+             (if pc-value
+                 (insert (format "%d:" pc-value)))
+             (insert (int-to-string (car arg))))
+         ;; We have an instruction.  Display its pc value first.
+         (if pc-value
+             (insert (format "%d" pc-value)))
          (indent-to (+ indent disassemble-column-1-indent))
          (if (and op
                   (string-match "^byte-" (setq opname (symbol-name op))))
@@ -235,8 +260,9 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
                        (let ((print-escape-newlines t))
                          (prin1 arg (current-buffer))))))
                )
-         (insert "\n"))
-       (setq lap (cdr lap)))))
+         (insert "\n")))))
   nil)
 
+(provide 'disass)
+
 ;;; disass.el ends here