X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdisassem.lisp;h=c8fa15f8708091e0547d1377b2104f900b02c189;hb=b63c4fb9b98fa8188e17ba926e150ba417a74635;hp=2341203f7714737b4e4c0c0eccf88860ce964767;hpb=8a19c6876412b8ad1cf729297c2a373d63a0d0ec;p=sbcl.git

diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index 2341203..c8fa15f 100644
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -18,8 +18,8 @@
 (deftype text-width () '(integer 0 1000))
 (deftype alignment () '(integer 0 64))
 (deftype offset () '(signed-byte 24))
-(deftype address () '(unsigned-byte 32))
-(deftype length () '(unsigned-byte 24))
+(deftype address () '(unsigned-byte #.sb!vm:n-word-bits))
+(deftype disassem-length () '(unsigned-byte 24))
 (deftype column () '(integer 0 1000))
 
 (def!constant max-filtered-value-index 32)
@@ -35,7 +35,6 @@
 (declaim (type hash-table *disassem-insts*))
 
 (defvar *disassem-inst-space* nil)
-(declaim (type (or null inst-space) *disassem-inst-space*))
 
 ;;; minimum alignment of instructions, in bytes
 (defvar *disassem-inst-alignment-bytes* sb!vm:n-word-bytes)
@@ -50,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.")
 
@@ -132,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))
@@ -140,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))
@@ -233,7 +240,7 @@
   (mask dchunk-zero :type dchunk)       ; bits in the inst that are constant
   (id dchunk-zero :type dchunk)         ; value of those constant bits
 
-  (length 0 :type length)               ; in bytes
+  (length 0 :type disassem-length)               ; in bytes
 
   (print-name nil :type symbol)
 
@@ -260,6 +267,10 @@
 (def!method print-object ((ispace inst-space) stream)
   (print-unreadable-object (ispace stream :type t :identity t)))
 
+;;; now that we've defined the structure, we can declaim the type of
+;;; the variable:
+(declaim (type (or null inst-space) *disassem-inst-space*))
+
 (defstruct (inst-space-choice (:conc-name ischoice-)
                               (:copier nil))
   (common-id dchunk-zero :type dchunk)  ; applies to *parent's* mask
@@ -319,7 +330,7 @@
   (name nil)
   (args nil :type list)
 
-  (length 0 :type length)               ; in bytes
+  (length 0 :type disassem-length)               ; in bytes
 
   (default-printer nil :type list))
 
@@ -344,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))
@@ -943,7 +955,7 @@
 		    (let ((form (maybe-listify adjusted-forms)))
 		      (if (and (not (eq use-label t))
 			       (not (atom adjusted-forms))
-			       (/= (Length adjusted-forms) 1))
+			       (/= (length adjusted-forms) 1))
 			  (pd-error
 			   "cannot label a multiple-field argument ~
                               unless using a function: ~S" arg)
@@ -1214,6 +1226,7 @@
       (cons car cdr)))
 
 (defun sharing-mapcar (fun list)
+  (declare (type function fun))
   #!+sb-doc
   "A simple (one list arg) mapcar that avoids consing up a new list
   as long as the results of calling FUN on the elements of LIST are
@@ -1508,11 +1521,11 @@
 (declaim (maybe-inline sign-extend aligned-p align tab tab0))
 
 (defun bytes-to-bits (bytes)
-  (declare (type length bytes))
+  (declare (type disassem-length bytes))
   (* bytes sb!vm:n-byte-bits))
 
 (defun bits-to-bytes (bits)
-  (declare (type length bits))
+  (declare (type disassem-length bits))
   (multiple-value-bind (bytes rbits)
       (truncate bits sb!vm:n-byte-bits)
     (when (not (zerop rbits))