From: Christophe R. <cr...@us...> - 2003-09-26 17:19:29
|
Update of /cvsroot/sbcl/sbcl/src/compiler/alpha In directory sc8-pr-cvs1:/tmp/cvs-serv30573/src/compiler/alpha Modified Files: arith.lisp insts.lisp Log Message: 0.8.3.94: Compiler fixes (touching only files in the alpha backend) ... the assembly routine for (signed-byte 32) [sic] truncate did in fact work only for signed-byte 32 quantities, but was being called on signed-byte 64 quantities. Fix it. ... the translators for ASH were broken in amusing ways: some led to internal compiler errors when fed out-of-range numbers; more insidiously, others allowed temporaries to be overwritten in some cases. Fix them. ... lastly but not leastly, the %LI code to load an immediate was wrong in a very small proportion of cases. After much scribbling, deduce why and fix it. ... test cases to go with all of the above. Index: arith.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/arith.lisp,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- arith.lisp 16 Sep 2003 12:07:40 -0000 1.10 +++ arith.lisp 26 Sep 2003 17:19:14 -0000 1.11 @@ -196,7 +196,7 @@ (:translate ash) (:policy :fast-safe) (:temporary (:sc non-descriptor-reg) ndesc) - (:temporary (:sc non-descriptor-reg :to :eval) temp) + (:temporary (:sc non-descriptor-reg) temp) (:generator 3 (inst bge amount positive) (inst subq zero-tn amount ndesc) @@ -223,7 +223,7 @@ (:translate ash) (:policy :fast-safe) (:temporary (:sc non-descriptor-reg) ndesc) - (:temporary (:sc non-descriptor-reg :to :eval) temp) + (:temporary (:sc non-descriptor-reg) temp) (:generator 3 (inst bge amount positive) (inst subq zero-tn amount ndesc) @@ -249,8 +249,8 @@ (:result-types signed-num) (:generator 1 (cond - ((< count 0) (inst sra number (- count) result)) - ((> count 0) (inst sll number count result)) + ((< count 0) (inst sra number (min 63 (- count)) result)) + ((> count 0) (inst sll number (min 63 count) result)) (t (bug "identity ASH not transformed away"))))) (define-vop (fast-ash-c/unsigned=>unsigned) @@ -266,7 +266,7 @@ (cond ((< count -63) (move zero-tn result)) ((< count 0) (inst sra number (- count) result)) - ((> count 0) (inst sll number count result)) + ((> count 0) (inst sll number (min 63 count) result)) (t (bug "identity ASH not transformed away"))))) (define-vop (signed-byte-64-len) Index: insts.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/insts.lisp,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- insts.lisp 6 Jun 2003 12:52:53 -0000 1.13 +++ insts.lisp 26 Sep 2003 17:19:14 -0000 1.14 @@ -495,10 +495,36 @@ (unless (= high 0) (inst ldah reg high reg))))) ((or (unsigned-byte 32) (signed-byte 64) (unsigned-byte 64)) + ;; Since it took NJF and CSR a good deal of puzzling to work out + ;; (a) what a previous version of this was doing and (b) why it + ;; was wrong: + ;; + ;; write VALUE = a_63 * 2^63 + a_48-62 * 2^48 + ;; + a_47 * 2^47 + a_32-46 * 2^32 + ;; + a_31 * 2^31 + a_16-30 * 2^16 + ;; + a_15 * 2^15 + a_0-14 + ;; + ;; then, because of the wonders of sign-extension and + ;; twos-complement arithmetic modulo 2^64, if a_15 is set, LDA + ;; (which sign-extends its argument) will add + ;; + ;; (a_15 * 2^15 + a_0-14 - 65536). + ;; + ;; So we need to add that 65536 back on, which is what this + ;; LOGBITP business is doing. The same applies for bits 31 and + ;; 47 (bit 63 is taken care of by the fact that all of this + ;; arithmetic is mod 2^64 anyway), but we have to be careful that + ;; we consider the altered value, not the original value. + ;; + ;; I think, anyway. -- CSR, 2003-09-26 (let* ((value1 (if (logbitp 15 value) (+ value (ash 1 16)) value)) - (value2 (if (logbitp 31 value) (+ value (ash 1 32)) value1)) - (value3 (if (logbitp 47 value) (+ value (ash 1 48)) value2))) + (value2 (if (logbitp 31 value1) (+ value1 (ash 1 32)) value1)) + (value3 (if (logbitp 47 value2) (+ value2 (ash 1 48)) value2))) (inst lda reg (ldb (byte 16 32) value2) zero-tn) + ;; FIXME: Don't yet understand these conditionals. If I'm + ;; right, surely we can just consider the zeroness of the + ;; particular bitfield, not the zeroness of the whole thing? + ;; -- CSR, 2003-09-26 (unless (= value3 0) (inst ldah reg (ldb (byte 16 48) value3) reg)) (unless (and (= value2 0) (= value3 0)) |