Index: src/compiler/pack.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/pack.lisp,v
retrieving revision 1.20
diff -u -r1.20 pack.lisp
--- src/compiler/pack.lisp	6 Jan 2005 12:48:00 -0000	1.20
+++ src/compiler/pack.lisp	10 Apr 2005 20:14:06 -0000
@@ -1183,6 +1183,29 @@
 		       (setf (tn-ref-load-tn op)
 			     (pack-load-tn (car scs) op))))))))
 
+  ;; If the SB-REGPAIR contrib has been loaded, also check register pairs 
+  ;; early so that they get a chance to find free adjacent registers.
+  #!+x86
+  (when (gethash 'sb!vm::signed64-reg *backend-sc-names*)
+    (do ((scs scs (cdr scs))
+	 (op ops (tn-ref-across op)))
+	((null scs))
+      (let ((target (tn-ref-target op)))
+	(when (and (null target)
+		   (null (tn-ref-load-tn op))
+		   (eq (tn-sc (tn-ref-tn op))
+		       (sc-or-lose 'sb!vm::signed64-reg)))
+	  (let* ((load-tn (tn-ref-load-tn op))
+		 (load-scs (svref (car scs)
+				  (sc-number
+				   (tn-sc (or load-tn (tn-ref-tn op)))))))
+	    (if load-tn
+		(aver (eq load-scs t))
+		(unless (eq load-scs t)
+		  (setf (tn-ref-load-tn op)
+			(pack-load-tn (car scs) op)))))))))
+
+  ;; KLUDGE: OAOOM
   (do ((scs scs (cdr scs))
        (op ops (tn-ref-across op)))
       ((null scs))
Index: src/compiler/generic/primtype.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/primtype.lisp,v
retrieving revision 1.19
diff -u -r1.19 primtype.lisp
--- src/compiler/generic/primtype.lisp	1 Feb 2005 03:00:03 -0000	1.19
+++ src/compiler/generic/primtype.lisp	10 Apr 2005 20:14:08 -0000
@@ -47,6 +47,9 @@
 #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
 (!def-primitive-type signed-byte-64 (signed-reg descriptor-reg)
   :type (signed-byte 64))
+#!+x86					;for use by sb-regpair
+(!def-primitive-type signed-byte-64 (descriptor-reg)
+  :type (signed-byte 64))
 
 (defvar *fixnum-primitive-type* (primitive-type-or-lose 'fixnum))
 
@@ -62,6 +65,11 @@
   (:or signed-byte-64 fixnum unsigned-byte-63 positive-fixnum)
   #!-#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or))
   (:or signed-byte-32 fixnum unsigned-byte-31 positive-fixnum))
+#!+x86
+(!def-primitive-type-alias signed64-num
+  (:or positive-fixnum fixnum
+       unsigned-byte-31 unsigned-byte-32 signed-byte-32
+       signed-byte-64))
 
 ;;; other primitive immediate types
 (/show0 "primtype.lisp 68")
@@ -171,7 +179,9 @@
 			  (eq t2-name
 			      (ecase sb!vm::n-machine-word-bits
 				(32 'unsigned-byte-32)
-				(64 'unsigned-byte-64))))
+				(64 'unsigned-byte-64)))
+			  #!+x86
+			  (eq t2-name 'signed-byte-64))
 		      t2))
 		 (fixnum
 		  (case t2-name
@@ -185,7 +195,9 @@
 		       (primitive-type-or-lose
 			(ecase sb!vm::n-machine-word-bits
 			  (32 'signed-byte-32)
-			  (64 'signed-byte-64))))))
+			  (64 'signed-byte-64))))
+		    #!+x86
+		    (signed-byte-64 t2)))
 		 (#.(ecase sb!vm::n-machine-word-bits
 		      (32 'signed-byte-32)
 		      (64 'signed-byte-64))
@@ -201,7 +213,9 @@
 			    (ecase sb!vm::n-machine-word-bits
 			      (32 'unsigned-byte-32)
 			      (64 'unsigned-byte-64)))
-			t2))))))
+			t2))
+		 ;; FIXME some #!+x86 signed-byte-64 cases missing?
+		 ))))
       (etypecase type
 	(numeric-type
 	 (let ((lo (numeric-type-low type))
@@ -232,7 +246,10 @@
 					                 ,(1- (ash 1 31))))
 				       (64
 					`(signed-byte-64 ,(ash -1 63)
-							 ,(1- (ash 1 63))))))
+							 ,(1- (ash 1 63)))))
+				    #!+x86
+				    (signed-byte-64 ,(ash -1 63)
+ 						    ,(1- (ash 1 63))))
 				 (if (or (< hi sb!xc:most-negative-fixnum)
 					 (> lo sb!xc:most-positive-fixnum))
 				     (part-of bignum)
Index: src/compiler/x86/insts.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/insts.lisp,v
retrieving revision 1.32
diff -u -r1.32 insts.lisp
--- src/compiler/x86/insts.lisp	28 Jan 2005 09:01:29 -0000	1.32
+++ src/compiler/x86/insts.lisp	10 Apr 2005 20:14:17 -0000
@@ -672,7 +672,14 @@
 (defun reg-tn-encoding (tn)
   (declare (type tn tn))
   (aver (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
+  (aver (not (eq (sc-name (tn-sc tn)) 'signed64-reg)))
   (let ((offset (tn-offset tn)))
+    (setf offset
+          (cond				;eax,ebx,ecx,edx -> eax,ecx,edx,ebx
+	   ((< offset 2) offset)
+	   ((< offset 4) (+ offset 4))
+	   ((< offset 8) (- offset 2))
+	   (t offset)))
     (logior (ash (logand offset 1) 2)
 	    (ash offset -1))))
 
Index: src/compiler/x86/move.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/move.lisp,v
retrieving revision 1.11
diff -u -r1.11 move.lisp
--- src/compiler/x86/move.lisp	27 Oct 2004 16:40:01 -0000	1.11
+++ src/compiler/x86/move.lisp	10 Apr 2005 20:14:18 -0000
@@ -302,6 +302,10 @@
        ;;   inst jmp :nz bignum
        ;;   inst shl y 2
        ;;   emit-label done
+       ;;
+       ;; (However, note that negative numbers need to be accounted for, and
+       ;; the "twisty" code does that by testing OF (not CF), which compares
+       ;; the most significant bits. --DFL)
 
        (assemble (*elsewhere*)
 	  (emit-label bignum)
Index: src/compiler/x86/vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/vm.lisp,v
retrieving revision 1.21
diff -u -r1.21 vm.lisp
--- src/compiler/x86/vm.lisp	2 Nov 2004 08:37:55 -0000	1.21
+++ src/compiler/x86/vm.lisp	10 Apr 2005 20:14:20 -0000
@@ -21,6 +21,7 @@
   (defvar *byte-register-names* (make-array 8 :initial-element nil))
   (defvar *word-register-names* (make-array 16 :initial-element nil))
   (defvar *dword-register-names* (make-array 16 :initial-element nil))
+  (defvar *qword-register-names* (make-array 16 :initial-element nil))
   (defvar *float-register-names* (make-array 8 :initial-element nil)))
 
 (macrolet ((defreg (name offset size)
@@ -43,42 +44,53 @@
 				    (symbolicate name "-OFFSET"))
 				  regs))))))
 
-  ;; byte registers
-  ;;
   ;; Note: the encoding here is different than that used by the chip.
   ;; We use this encoding so that the compiler thinks that AX (and
   ;; EAX) overlap AL and AH instead of AL and CL.
+  ;;
+  ;; We also reorder registers so that eax+ebx form a register pair.
+  ;;
+  ;; Keep this is sync with REG-TN-ENCODING and x86-lispregs.h.
+
+  ;; byte registers
   (defreg al 0 :byte)
   (defreg ah 1 :byte)
-  (defreg cl 2 :byte)
-  (defreg ch 3 :byte)
-  (defreg dl 4 :byte)
-  (defreg dh 5 :byte)
-  (defreg bl 6 :byte)
-  (defreg bh 7 :byte)
-  (defregset *byte-regs* al ah cl ch dl dh bl bh)
+  (defreg bl 2 :byte)
+  (defreg bh 3 :byte)
+  (defreg cl 4 :byte)
+  (defreg ch 5 :byte)
+  (defreg dl 6 :byte)
+  (defreg dh 7 :byte)
+  (defregset *byte-regs* al ah bl bh cl ch dl dh)
 
   ;; word registers
   (defreg ax 0 :word)
-  (defreg cx 2 :word)
-  (defreg dx 4 :word)
-  (defreg bx 6 :word)
+  (defreg bx 2 :word)
+  (defreg cx 4 :word)
+  (defreg dx 6 :word)
   (defreg sp 8 :word)
   (defreg bp 10 :word)
   (defreg si 12 :word)
   (defreg di 14 :word)
-  (defregset *word-regs* ax cx dx bx si di)
+  (defregset *word-regs* ax bx cx dx si di)
 
   ;; double word registers
   (defreg eax 0 :dword)
-  (defreg ecx 2 :dword)
-  (defreg edx 4 :dword)
-  (defreg ebx 6 :dword)
+  (defreg ebx 2 :dword)
+  (defreg ecx 4 :dword)
+  (defreg edx 6 :dword)
   (defreg esp 8 :dword)
   (defreg ebp 10 :dword)
   (defreg esi 12 :dword)
   (defreg edi 14 :dword)
-  (defregset *dword-regs* eax ecx edx ebx esi edi)
+  (defregset *dword-regs* eax ebx ecx edx esi edi)
+
+  ;; register pairs, for use by the sb-regpair contrib
+  (defreg eax+ebx 0 :qword)
+  (defreg ecx+edx 4 :qword)
+  (defreg esp+ebp 8 :qword)
+  (defreg esi+edi 12 :qword)
+  (defregset *qword-regs* eax+ebx ecx+edx esi+edi)
 
   ;; floating point registers
   (defreg fr0 0 :float)
@@ -331,6 +343,7 @@
   '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
     signed-stack unsigned-stack sap-stack single-stack
     #!+sb-unicode character-reg #!+sb-unicode character-stack constant))
+(defparameter *qword-sc-names* '(signed64-reg signed64-stack))
 ;;; added by jrd. I guess the right thing to do is to treat floats
 ;;; as a separate size...
 ;;;
Index: src/runtime/x86-lispregs.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-lispregs.h,v
retrieving revision 1.3
diff -u -r1.3 x86-lispregs.h
--- src/runtime/x86-lispregs.h	18 Oct 2004 13:07:42 -0000	1.3
+++ src/runtime/x86-lispregs.h	10 Apr 2005 20:14:24 -0000
@@ -27,16 +27,16 @@
 #endif
 
 #define reg_EAX REG( 0)
-#define reg_ECX REG( 2)
-#define reg_EDX REG( 4)
-#define reg_EBX REG( 6)
+#define reg_EBX REG( 2)
+#define reg_ECX REG( 4)
+#define reg_EDX REG( 6)
 #define reg_ESP REG( 8)
 #define reg_EBP REG(10)
 #define reg_ESI REG(12)
 #define reg_EDI REG(14)
 #define reg_UESP REG(16)
 
-#define REGNAMES "EAX", "ECX", "EDX", "EBX", "ESP", "EBP", "ESI", "EDI", "UESP"
+#define REGNAMES "EAX", "EBX", "ECX", "EDX", "ESP", "EBP", "ESI", "EDI", "UESP"
 
 /* classification of registers
  *