Update of /cvsroot/sbcl/sbcl/src/compiler/ppc
In directory sc8-pr-cvs1:/tmp/cvs-serv3307/src/compiler/ppc
Modified Files:
float.lisp
Log Message:
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
Index: float.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ppc/float.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- float.lisp 15 Aug 2003 18:07:08 -0000 1.2
+++ float.lisp 1 Sep 2003 15:29:34 -0000 1.3
@@ -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:
|