From: Christophe Rhodes Date: Mon, 1 Sep 2003 15:29:34 +0000 (+0000) Subject: 0.8.3.21: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=10e7ad98e711db20ada209a4be37f06c466cfbe8;p=sbcl.git 0.8.3.21: Fix PPC floating point backend bugs ... STFD moves a doubleword to the effective address. Better not have that effective address be a 32-bit area (e.g. SINGLE-STACK) then --- diff --git a/BUGS b/BUGS index a20b8ff..545ec9c 100644 --- a/BUGS +++ b/BUGS @@ -1205,3 +1205,28 @@ WORKAROUND: There are lots of special variables in SBCL, and I feel sure that at least some of them are indicative of potentially thread-unsafe parts of the system. See doc/internals/notes/threading-specials + +285: PPC randomness + In SBCL 0.8.3.1x on a powerpc running Linux (dunno if Darwin is + similarly affected): + * (dotimes (i 100) (random 1663553320000000)) + + NIL + * (dotimes (i 100) (random 1663553340000000)) + + NIL + * (dotimes (i 100) (random 1663553350000000)) + + debugger invoked on condition of type TYPE-ERROR: + The value -30653269094906 + is not of type + (OR (SINGLE-FLOAT 0.0) (DOUBLE-FLOAT 0.0d0) (RATIONAL 0)). + + and, weirdly, the frame is: + ("hairy arg processor for top level local call RANDOM" + 1663553347392000 + #S(RANDOM-STATE + :STATE #(0 2567483615 188 1503590015 2333049409 322761517 ...))) + + (the type error doesn't seem to be terribly deterministic in when it + occurs. Bigger numbers seem better able to trigger the error) diff --git a/NEWS b/NEWS index 97fb78a..9e14331 100644 --- a/NEWS +++ b/NEWS @@ -2013,6 +2013,9 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: combination. (reported by Andreas Fuchs) * bug fix: RUN-PROGRAM now does not fail if some element in $PATH names a non-existent directory. (thanks to Andreas Fuchs) + * bug fix: ROUND and TRUNCATE could, under certain circumstances on + the PPC platform, lead to stack corruption; this has been fixed. + (reported by Rainer Joswig) * optimization: restored some effective method precomputation in CLOS (turned off by an ANSI fix in sbcl-0.8.3); the amount of precomputation is now tunable. diff --git a/src/compiler/ppc/float.lisp b/src/compiler/ppc/float.lisp index ed7bdaa..d2bd56f 100644 --- a/src/compiler/ppc/float.lisp +++ b/src/compiler/ppc/float.lisp @@ -502,8 +502,7 @@ (:args (x :scs (,from-sc) :target temp)) (:temporary (:from (:argument 0) :sc single-reg) temp) (:temporary (:scs (double-stack)) stack-temp) - (:results (y :scs (signed-reg) - :load-if (not (sc-is y signed-stack)))) + (:results (y :scs (signed-reg))) (:arg-types ,from-type) (:result-types signed-num) (:translate ,trans) @@ -514,22 +513,15 @@ (:generator 5 (note-this-location vop :internal-error) (inst ,inst temp x) - (sc-case y - (signed-stack - (inst stfd temp (current-nfp-tn vop) - (* (tn-offset y) sb!vm:n-word-bytes))) - (signed-reg - (inst stfd temp (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes)) - (inst lwz y (current-nfp-tn vop) - (+ 4 (* (tn-offset stack-temp) sb!vm:n-word-bytes))))))))) + (inst stfd temp (current-nfp-tn vop) + (* (tn-offset stack-temp) sb!vm:n-word-bytes)) + (inst lwz y (current-nfp-tn vop) + (+ 4 (* (tn-offset stack-temp) sb!vm:n-word-bytes))))))) (frob %unary-truncate single-reg single-float fctiwz) (frob %unary-truncate double-reg double-float fctiwz) (frob %unary-round single-reg single-float fctiw) (frob %unary-round double-reg double-float fctiw)) - - (define-vop (make-single-float) (:args (bits :scs (signed-reg) :target res :load-if (not (sc-is bits signed-stack)))) @@ -624,69 +616,50 @@ (define-vop (double-float-high-bits) (:args (float :scs (double-reg descriptor-reg) :load-if (not (sc-is float double-stack)))) - (:results (hi-bits :scs (signed-reg) - :load-if (or (sc-is float descriptor-reg double-stack) - (not (sc-is hi-bits signed-stack))))) - (:temporary (:scs (signed-stack)) stack-temp) + (:results (hi-bits :scs (signed-reg))) + (:temporary (:scs (double-stack)) stack-temp) (:arg-types double-float) (:result-types signed-num) (:translate double-float-high-bits) (:policy :fast-safe) (:vop-var vop) (:generator 5 - (sc-case hi-bits - (signed-reg - (sc-case float - (double-reg - (inst stfd float (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes)) - (inst lwz hi-bits (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes))) - (double-stack - (inst lwz hi-bits (current-nfp-tn vop) - (* (tn-offset float) sb!vm:n-word-bytes))) - (descriptor-reg - (loadw hi-bits float sb!vm:double-float-value-slot - sb!vm:other-pointer-lowtag)))) - (signed-stack - (sc-case float - (double-reg - (inst stfd float (current-nfp-tn vop) - (* (tn-offset hi-bits) sb!vm:n-word-bytes)))))))) + (sc-case float + (double-reg + (inst stfd float (current-nfp-tn vop) + (* (tn-offset stack-temp) sb!vm:n-word-bytes)) + (inst lwz hi-bits (current-nfp-tn vop) + (* (tn-offset stack-temp) sb!vm:n-word-bytes))) + (double-stack + (inst lwz hi-bits (current-nfp-tn vop) + (* (tn-offset float) sb!vm:n-word-bytes))) + (descriptor-reg + (loadw hi-bits float sb!vm:double-float-value-slot + sb!vm:other-pointer-lowtag))))) (define-vop (double-float-low-bits) (:args (float :scs (double-reg descriptor-reg) :load-if (not (sc-is float double-stack)))) - (:results (lo-bits :scs (unsigned-reg) - :load-if (or (sc-is float descriptor-reg double-stack) - (not (sc-is lo-bits unsigned-stack))))) - (:temporary (:scs (unsigned-stack)) stack-temp) + (:results (lo-bits :scs (unsigned-reg))) + (:temporary (:scs (double-stack)) stack-temp) (:arg-types double-float) (:result-types unsigned-num) (:translate double-float-low-bits) (:policy :fast-safe) (:vop-var vop) (:generator 5 - (sc-case lo-bits - (unsigned-reg - (sc-case float - (double-reg - (inst stfd float (current-nfp-tn vop) - (* (tn-offset stack-temp) sb!vm:n-word-bytes)) - (inst lwz lo-bits (current-nfp-tn vop) - (* (1+ (tn-offset stack-temp)) sb!vm:n-word-bytes))) - (double-stack - (inst lwz lo-bits (current-nfp-tn vop) - (* (1+ (tn-offset float)) sb!vm:n-word-bytes))) - (descriptor-reg - (loadw lo-bits float (1+ sb!vm:double-float-value-slot) - sb!vm:other-pointer-lowtag)))) - (unsigned-stack - (sc-case float - (double-reg - (inst stfd float (current-nfp-tn vop) - (* (tn-offset lo-bits) sb!vm:n-word-bytes)))))))) - + (sc-case float + (double-reg + (inst stfd float (current-nfp-tn vop) + (* (tn-offset stack-temp) sb!vm:n-word-bytes)) + (inst lwz lo-bits (current-nfp-tn vop) + (* (1+ (tn-offset stack-temp)) sb!vm:n-word-bytes))) + (double-stack + (inst lwz lo-bits (current-nfp-tn vop) + (* (1+ (tn-offset float)) sb!vm:n-word-bytes))) + (descriptor-reg + (loadw lo-bits float (1+ sb!vm:double-float-value-slot) + sb!vm:other-pointer-lowtag))))) ;;;; Float mode hackery: diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index c5e6d61..69ff13c 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -129,5 +129,10 @@ ;;; expanders. (funcall (formatter "~@<~A~:*~A~:>") nil 3) +;;; the PPC floating point backend was at one point sufficiently +;;; broken that this looped infinitely or caused segmentation +;;; violations through stack corruption. +(print 0.0001) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index d1e0356..7d52788 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.20" +"0.8.3.21"