Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2143/src/compiler/x86-64
Modified Files:
Tag: x86-64-again-branch
arith.lisp array.lisp char.lisp insts.lisp type-vops.lisp
vm.lisp
Log Message:
0.8.15.14.x86-64-again-branch.11:
Creates a 170MB warm core that doesn't work.
* The high-byte register access (AH, etc) is impossible if the
instruction has a rex-prefix. Remove the high-byte registers
and add new low-byte registers SIL, DIL, R{8-15}B.
* Fix MOVE-TO/FROM-BASE-CHAR to take into account the above.
* Fix LOGCOUNT.
* Use sb!vm:word instead of the ugly '(unsigned-byte
#.sb!vm:n-word-bits) in some places.
* Fix CHECK-SIGNED-BYTE-32 again, this time for real.
Index: arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/arith.lisp,v
retrieving revision 1.3.4.3
retrieving revision 1.3.4.4
diff -u -d -r1.3.4.3 -r1.3.4.4
--- arith.lisp 17 Nov 2004 06:00:29 -0000 1.3.4.3
+++ arith.lisp 24 Nov 2004 20:02:00 -0000 1.3.4.4
@@ -959,6 +959,7 @@
(:temporary (:sc unsigned-reg :from (:argument 0)) t1)
(:generator 60
(move result arg)
+ (move t1 arg)
(inst mov temp result)
(inst shr temp 1)
@@ -991,8 +992,7 @@
(inst add result temp)
;;; now do the upper half
- (move t1 arg)
- (inst bswap t1)
+ (inst shr t1 32)
(inst mov temp t1)
(inst shr temp 1)
Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/array.lisp,v
retrieving revision 1.2.4.2
retrieving revision 1.2.4.3
diff -u -d -r1.2.4.2 -r1.2.4.3
--- array.lisp 17 Nov 2004 06:00:29 -0000 1.2.4.2
+++ array.lisp 24 Nov 2004 20:02:00 -0000 1.2.4.3
@@ -140,15 +140,11 @@
,element-type data-vector-set)))
)
(def-full-data-vector-frobs simple-vector * descriptor-reg any-reg)
- #+nil (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
- unsigned-reg)
(def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num
unsigned-reg)
(def-full-data-vector-frobs simple-array-signed-byte-61 tagged-num any-reg)
(def-full-data-vector-frobs simple-array-unsigned-byte-60
positive-fixnum any-reg)
- #+nil (def-full-data-vector-frobs simple-array-signed-byte-32
- signed-num signed-reg)
(def-full-data-vector-frobs simple-array-signed-byte-64
signed-num signed-reg)
(def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
Index: char.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/char.lisp,v
retrieving revision 1.1
retrieving revision 1.1.8.1
diff -u -d -r1.1 -r1.1.8.1
--- char.lisp 26 Jun 2004 17:48:22 -0000 1.1
+++ char.lisp 24 Nov 2004 20:02:00 -0000 1.1.8.1
@@ -15,34 +15,34 @@
;;; Move a tagged char to an untagged representation.
(define-vop (move-to-base-char)
- (:args (x :scs (any-reg control-stack) :target al))
- (:temporary (:sc byte-reg :offset al-offset
- :from (:argument 0) :to (:eval 0)) al)
- (:ignore al)
- (:temporary (:sc byte-reg :offset ah-offset :target y
- :from (:argument 0) :to (:result 0)) ah)
- (:results (y :scs (base-char-reg base-char-stack)))
+ (:args (x :scs (any-reg control-stack)))
+ (:results (y :scs (base-char-reg #+nil base-char-stack)))
(:note "character untagging")
(:generator 1
- (move rax-tn x)
- (move y ah)))
+ (let ((y-wide-tn (make-random-tn
+ :kind :normal
+ :sc (gethash 'any-reg
+ sb!c::*backend-meta-sc-names*)
+ :offset (tn-offset y))))
+ (move y-wide-tn x)
+ (inst shr y-wide-tn 8)
+ (inst and y-wide-tn #xff))))
(define-move-vop move-to-base-char :move
(any-reg control-stack) (base-char-reg base-char-stack))
;;; Move an untagged char to a tagged representation.
(define-vop (move-from-base-char)
- (:args (x :scs (base-char-reg base-char-stack) :target ah))
- (:temporary (:sc byte-reg :offset al-offset :target y
- :from (:argument 0) :to (:result 0)) al)
- (:temporary (:sc byte-reg :offset ah-offset
- :from (:argument 0) :to (:result 0)) ah)
- (:results (y :scs (any-reg descriptor-reg control-stack)))
+ (:args (x :scs (base-char-reg base-char-stack)))
+ (:results (y :scs (any-reg descriptor-reg #+nil control-stack)))
(:note "character tagging")
(:generator 1
- (move ah x) ; Maybe move char byte.
- (inst mov al base-char-widetag) ; x86 to type bits
- (inst and rax-tn #xffff) ; Remove any junk bits.
- (move y rax-tn)))
+ (move (make-random-tn :kind :normal :sc (gethash 'base-char-reg
+ sb!c::*backend-meta-sc-names*)
+ :offset (tn-offset y))
+ x)
+ (inst shl y n-widetag-bits)
+ (inst or y base-char-widetag)
+ (inst and y #xffff)))
(define-move-vop move-from-base-char :move
(base-char-reg base-char-stack) (any-reg descriptor-reg control-stack))
Index: insts.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/insts.lisp,v
retrieving revision 1.1.8.7
retrieving revision 1.1.8.8
diff -u -d -r1.1.8.7 -r1.1.8.8
--- insts.lisp 17 Nov 2004 06:00:29 -0000 1.1.8.7
+++ insts.lisp 24 Nov 2004 20:02:00 -0000 1.1.8.8
@@ -40,7 +40,7 @@
:dword)
(defparameter *byte-reg-names*
- #(al cl dl bl ah ch dh bh))
+ #(al cl dl bl sil dil r8b r9b r10b r11b r14b r15b))
(defparameter *word-reg-names*
#(ax cx dx bx sp bp si di))
(defparameter *dword-reg-names*
@@ -904,7 +904,8 @@
(rex-r (if-hi r))
(rex-x (if-hi x))
(rex-b (if-hi b)))
- (when (not (zerop (logior rex-w rex-r rex-x rex-b)))
+ (when (or (eq operand-size :byte) ;; REX needed to access SIL/DIL
+ (not (zerop (logior rex-w rex-r rex-x rex-b))))
(emit-rex-byte segment #b0100 rex-w rex-r rex-x rex-b)))))
(defun maybe-emit-rex-for-ea (segment ea reg)
Index: type-vops.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/type-vops.lisp,v
retrieving revision 1.1.8.4
retrieving revision 1.1.8.5
diff -u -d -r1.1.8.4 -r1.1.8.5
--- type-vops.lisp 11 Nov 2004 03:14:14 -0000 1.1.8.4
+++ type-vops.lisp 24 Nov 2004 20:02:00 -0000 1.1.8.5
@@ -184,7 +184,7 @@
(inst jmp :ne (if not-p target not-target))
(inst sar rax-tn (+ 32 3 -1))
(inst jmp (if not-p :nz :z) target)
- (inst cmp rax-tn #xffffffff)
+ (inst cmp rax-tn -1)
(inst jmp (if not-p :ne :eq) target)
NOT-TARGET))
@@ -199,7 +199,7 @@
(inst jmp :ne nope)
(inst sar rax-tn (+ 32 3 -1))
(inst jmp :z ok)
- (inst cmp rax-tn #xffffffff)
+ (inst cmp rax-tn -1)
(inst jmp :ne nope)
(emit-label OK)
(move result value))))
Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/vm.lisp,v
retrieving revision 1.2.8.5
retrieving revision 1.2.8.6
diff -u -d -r1.2.8.5 -r1.2.8.6
--- vm.lisp 8 Nov 2004 17:50:42 -0000 1.2.8.5
+++ vm.lisp 24 Nov 2004 20:02:00 -0000 1.2.8.6
@@ -18,7 +18,7 @@
;;;; register specs
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *byte-register-names* (make-array 8 :initial-element nil))
+ (defvar *byte-register-names* (make-array 32 :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 32 :initial-element nil))
@@ -49,15 +49,28 @@
;; 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.
- (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)
+ ;;
+ ;; High-byte are registers disabled on AMD64, since they can't be
+ ;; encoded for an op that has a REX-prefix. The overlap doesn't
+ ;; therefore exist anymore, but the numbering hasn't been changed
+ ;; to reflect this.
+ (defreg al 0 :byte)
+ (defreg cl 2 :byte)
+ (defreg dl 4 :byte)
+ (defreg bl 6 :byte)
+ (defreg sil 12 :byte)
+ (defreg dil 14 :byte)
+ (defreg r8b 16 :byte)
+ (defreg r9b 18 :byte)
+ (defreg r10b 20 :byte)
+ (defreg r11b 22 :byte)
+ (defreg r12b 24 :byte)
+ (defreg r13b 26 :byte)
+ (defreg r14b 28 :byte)
+ (defreg r15b 30 :byte)
+ (defregset *byte-regs*
+ al cl dl bl sil dil r8b r9b r10b
+ r11b #+nil r12b #+nil r13b r14b r15b)
;; word registers
(defreg ax 0 :word)
@@ -252,7 +265,7 @@
;; non-descriptor characters
(base-char-reg registers
:locations #.*byte-regs*
- :reserve-locations (#.ah-offset #.al-offset)
+ :reserve-locations (#.al-offset)
:constant-scs (immediate)
:save-p t
:alternate-scs (base-char-stack))
@@ -363,7 +376,8 @@
r8 r9 r10 r11 r12 r13 r14 r15)
(def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi)
(def-misc-reg-tns word-reg ax bx cx dx bp sp di si)
- (def-misc-reg-tns byte-reg al ah bl bh cl ch dl dh)
+ (def-misc-reg-tns byte-reg al cl dl bl sil dil r8b r9b r10b
+ r11b r14b r15b)
(def-misc-reg-tns single-reg
float0 float1 float2 float3 float4 float5 float6 float7
float8 float9 float10 float11 float12 float13 float14 float15))
|