From: Christophe Rhodes Date: Fri, 26 Sep 2003 17:19:13 +0000 (+0000) Subject: 0.8.3.94: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8f4ef01b8c9930d7dd0a56a96845a6d84ca5774d;p=sbcl.git 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. --- diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS index 51fcb32..7c51f47 100644 --- a/OPTIMIZATIONS +++ b/OPTIMIZATIONS @@ -154,5 +154,18 @@ of representation selection. Problem: inter-TN dependencies. #14 The derived type of (/ (THE (DOUBLE-FLOAT (0D0)) X) (THE (DOUBLE-FLOAT 1D0) Y)) is (DOUBLE-FLOAT 0.0d0). While it might be reasonable, it is -better to derive (DOUBLE-FLOAT (-0.0d0)). +better to derive (OR (MEMBER 0.0d0) (DOUBLE-FLOAT (0.0d0))). +-------------------------------------------------------------------------------- +#15 +On the alpha, the system is reluctant to refer directly to a constant bignum, +preferring to load a large constant through a slow sequence of instructions, +then cons up a bignum for it: + +(LAMBDA (A) + (DECLARE (OPTIMIZE (SAFETY 1) (SPEED 3) (DEBUG 1)) + (TYPE (INTEGER -10000 10000) A) + (IGNORABLE A)) + (CASE A + ((89 125 16) (ASH A (MIN 18 -706))) + (T (DPB -3 (BYTE 30 30) -1)))) -------------------------------------------------------------------------------- diff --git a/src/assembly/alpha/arith.lisp b/src/assembly/alpha/arith.lisp index e3d7216..fad4209 100644 --- a/src/assembly/alpha/arith.lisp +++ b/src/assembly/alpha/arith.lisp @@ -208,7 +208,7 @@ ;;;; division (define-assembly-routine (signed-truncate - (:note "(signed-byte 32) truncate") + (:note "(signed-byte 64) truncate") (:cost 60) (:policy :fast-safe) (:translate truncate) @@ -241,9 +241,8 @@ (emit-label label)) (inst move zero-tn rem) (inst move zero-tn quo) - (inst sll dividend 32 dividend) - (dotimes (i 32) + (dotimes (i 64) (inst srl dividend 63 temp1) (inst sll rem 1 rem) (inst bis temp1 rem rem) diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index 7f2a0bd..c680c61 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -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) diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index 30bf844..8985a46 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -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)) diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp index ce3cfa4..2d4900f 100644 --- a/tests/arith.pure.lisp +++ b/tests/arith.pure.lisp @@ -156,3 +156,32 @@ ;;; Alpha bignum arithmetic bug: (assert (= (* 966082078641 419216044685) 404997107848943140073085)) + +;;; Alpha smallnum arithmetic bug: +(assert (= (ash -129876 -1026) -1)) + +;;; Alpha middlenum (yes, really! Affecting numbers between 2^32 and +;;; 2^64 :) arithmetic bug +(let ((fn (compile nil '(LAMBDA (A B C D) + (DECLARE (TYPE (INTEGER -1621 -513) A) + (TYPE (INTEGER -3 34163) B) + (TYPE (INTEGER -9485132993 81272960) C) + (TYPE (INTEGER -255340814 519943) D) + (IGNORABLE A B C D) + (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) + (TRUNCATE C (MIN -100 4149605)))))) + (assert (= (funcall fn -1332 5864 -6963328729 -43789079) 69633287))) + +;;; Here's another fantastic Alpha backend bug: the code to load +;;; immediate 64-bit constants into a register was wrong. +(let ((fn (compile nil '(LAMBDA (A B C D) + (DECLARE (TYPE (INTEGER -3563 2733564) A) + (TYPE (INTEGER -548947 7159) B) + (TYPE (INTEGER -19 0) C) + (TYPE (INTEGER -2546009 0) D) + (IGNORABLE A B C D) + (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) + (CASE A + ((89 125 16) (ASH A (MIN 18 -706))) + (T (DPB -3 (BYTE 30 30) -1))))))) + (assert (= (funcall fn 1227072 -529823 -18 -792831) -2147483649))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index fc9124a..f1431f1 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -605,3 +605,12 @@ (LET ((V7 (%F1))) (+ 359749 35728422)))) -24076))) + +;;; bug in Alpha backend: not enough sanity checking of arguments to +;;; instructions +(assert (= (funcall (compile nil + '(lambda (x) + (declare (fixnum x)) + (ash x -257))) + 1024) + 0)) diff --git a/version.lisp-expr b/version.lisp-expr index 0e9f387..260689b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.3.93" +"0.8.3.94"