0.9.1.54: dynamic-extent lists and closures on ppc

[sbcl.git] / src / compiler / disassem.lisp

diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index 785c81f..588c19c 100644 (file)
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -18,7 +18,7 @@
 (deftype text-width () '(integer 0 1000))
 (deftype alignment () '(integer 0 64))
 (deftype offset () '(signed-byte 24))
-(deftype address () '(unsigned-byte 32))
+(deftype address () '(unsigned-byte #.sb!vm:n-word-bits))
 (deftype disassem-length () '(unsigned-byte 24))
 (deftype column () '(integer 0 1000))
 
@@ -49,7 +49,15 @@
 (defvar *disassem-opcode-column-width* 6)
 (declaim (type text-width *disassem-opcode-column-width*))
 
-(defvar *disassem-note-column* 45
+;;; the width of the column in which instruction-bytes are printed. A
+;;; value of zero disables the printing of instruction bytes.
+(defvar *disassem-inst-column-width* 16
+  #!+sb-doc
+  "The width of instruction bytes.") 
+(declaim (type text-width *disassem-inst-column-width*))
+        
+
+(defvar *disassem-note-column* (+ 45 *disassem-inst-column-width*)
   #!+sb-doc
   "The column in which end-of-line comments for notes are started.")
 
@@ -131,7 +139,7 @@
                  dchunk=
                  dchunk-count-bits))
 
-(def!constant dchunk-bits 32)
+(def!constant dchunk-bits #.sb!vm:n-word-bits)
 
 (deftype dchunk ()
   `(unsigned-byte ,dchunk-bits))
@@ -139,7 +147,7 @@
   `(integer 0 ,dchunk-bits))
 
 (def!constant dchunk-zero 0)
-(def!constant dchunk-one #xFFFFFFFF)
+(def!constant dchunk-one #.(1- (expt 2 sb!vm:n-word-bits)))
 
 (defun dchunk-extract (from pos)
   (declare (type dchunk from))
@@ -347,6 +355,7 @@
           (let* ((old-arg (car this-arg-temps))
                  (new-arg (find (arg-name old-arg) args :key #'arg-name)))
             (and new-arg
+                  (= (arg-position old-arg) (arg-position new-arg))
                  (every (lambda (this-kind-temps)
                           (funcall (find-arg-form-checker
                                     (car this-kind-temps))
@@ -1553,7 +1562,7 @@
   (write value :stream stream :radix t :base 16 :escape nil))
 \f
 (defun read-signed-suffix (length dstate)
-  (declare (type (member 8 16 32) length)
+  (declare (type (member 8 16 32 64) length)
            (type disassem-state dstate)
            (optimize (speed 3) (safety 0)))
   (sign-extend (read-suffix length dstate) length))
@@ -1578,6 +1587,9 @@
              :type (member :big-endian :little-endian))
   ;; for user code to hang stuff off of
   (properties nil :type list)
+  ;; for user code to hang stuff off of, cleared each time before an
+  ;; instruction is processed
+  (inst-properties nil :type list)
   (filtered-values (make-array max-filtered-value-index)
                   :type filtered-value-vector)
   ;; used for prettifying printing
@@ -1630,3 +1642,12 @@
 ;;; it's defined before it's used. -- WHN ca. 19990701
 (defmacro dstate-get-prop (dstate name)
   `(getf (dstate-properties ,dstate) ,name))
+
+;;; Push NAME on the list of instruction properties in DSTATE.
+(defun dstate-put-inst-prop (dstate name)
+  (push name (dstate-inst-properties dstate)))
+
+;;; Return non-NIL if NAME is on the list of instruction properties in
+;;; DSTATE.
+(defun dstate-get-inst-prop (dstate name)
+  (member name (dstate-inst-properties dstate) :test #'eq))