]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/disass.el
(normal-splash-screen, fancy-splash-screens-1): Add a reference to the Lisp
[gnu-emacs] / lisp / emacs-lisp / disass.el
index d405db4200ec2b6e63490b239cc0799a8af7fee3..db114e3cdf8281e1f67295ab544e07d298181113 100644 (file)
@@ -1,10 +1,11 @@
 ;;; disass.el --- disassembler for compiled Emacs Lisp code
 
-;; Copyright (C) 1986, 1991 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1991, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Doug Cutting <doug@csli.stanford.edu>
 ;;     Jamie Zawinski <jwz@lucid.com>
-;; Maintainer: Jamie Zawinski <jwz@lucid.com>
+;; Maintainer: FSF
 ;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
@@ -21,8 +22,8 @@
 
 ;; 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -57,7 +58,7 @@ redefine OBJECT if it is a symbol."
   (interactive (list (intern (completing-read "Disassemble function: "
                                              obarray 'fboundp t))
                     nil 0 t))
-  (if (eq (car-safe object) 'byte-code)
+  (if (and (consp object) (not (eq (car object) 'lambda)))
       (setq object (list 'lambda () object)))
   (or indent (setq indent 0))          ;Default indent to zero
   (save-excursion
@@ -88,7 +89,7 @@ redefine OBJECT if it is a symbol."
        (setq macro t
              obj (cdr obj)))
     (if (and (listp obj) (eq (car obj) 'byte-code))
-       (setq obj (list 'lambda nil obj)))      
+       (setq obj (list 'lambda nil obj)))
     (if (and (listp obj) (not (eq (car obj) 'lambda)))
        (error "not a function"))
     (if (consp obj)
@@ -104,8 +105,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)
@@ -172,7 +174,7 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
       (fetch-bytecode obj)
       (setq bytes (aref obj 1)
            constvec (aref obj 2)))
-    (let ((lap (byte-decompile-bytecode bytes constvec))
+    (let ((lap (byte-decompile-bytecode (string-as-unibyte bytes) constvec))
          op arg opname pc-value)
       (let ((tagno 0)
            tmp
@@ -262,4 +264,7 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
          (insert "\n")))))
   nil)
 
+(provide 'disass)
+
+;;; arch-tag: 89482fe4-a087-4761-8dc6-d771054e763a
 ;;; disass.el ends here