Changeset 393

Timestamp:

Jan 25, 2004, 2:07:10 PM (21 years ago)

Author:

Gary Byers

Message:

Some conditionalization, mostly dealing with immediate/non-immediate
SHORT-FLOATs.

File:

• trunk/ccl/level-0/PPC/ppc-float.lisp (modified) (14 diffs)

trunk/ccl/level-0/PPC/ppc-float.lisp

@@ -23 +23 @@
   
 
-; see "Optimizing PowerPC Code" p. 156
-; Note that the constant #x4330000080000000 is now in fp-s32conv
-  (defppclapmacro int-to-freg (int freg imm)
-    `(let ((temp 8)
-           (temp.h 8)
-           (temp.l 12))
-      (stwu tsp -16 tsp)
-      (stw tsp 4 tsp)
-      (stfd ppc::fp-s32conv temp tsp)
-      (unbox-fixnum ,imm ,int)
-      (xoris ,imm ,imm #x8000)       ; invert sign of unboxed fixnum
-      (stw ,imm temp.l tsp)
-      (lfd ,freg temp tsp)
-      (lwz tsp 0 tsp)
-      (fsub ,freg ,freg ppc::fp-s32conv)))
  
 
@@ -494 +479 @@
   (blr))
 
+#+ppc32-target
 (defppclapfunction %double-float->short-float ((src arg_y) (result arg_z))
   (clear-fpu-exceptions)
@@ -500 +486 @@
   (put-single-float fp1 result)
   (blr))
+
+#+ppc64-target
+(defppclapfunction %double-float->short-float ((src arg_z))
+  (clear-fpu-exceptions)
+  (get-double-float fp0 src)
+  (frsp fp1 fp0)
+  (stfs fp1 ppc64::tcr.single-float-convert rcontext)
+  (ld arg_z ppc64::tcr.single-float-convert rcontext)
+  (blr))
   
 
 
-
+#+ppc32-target
 (defppclapfunction %int-to-sfloat ((int arg_y) (sfloat arg_z))
   (int-to-freg int fp0 imm0)
@@ -509 +504 @@
   (blr))
 
+#+ppc64-target
+(defppclapfunction %int-to-sfloat ((int arg_z))
+  (int-to-freg int fp0 imm0)
+  (stfs fp0 ppc64::tcr.single-float-convert rcontext)
+  (ld arg_z ppc64::tcr.single-float-convert rcontext)
+  (blr))
+  
+
 (defppclapfunction %int-to-dfloat ((int arg_y) (dfloat arg_z))
   (int-to-freg int fp0 imm0)
-  (stfd fp0 ppc32::double-float.value dfloat)
+  (stfd fp0 target::double-float.value dfloat)
   (blr))
 
@@ -521 +524 @@
 (defppclapfunction %get-fpscr-control ()
   (mffs fp0)
-  (stwu tsp -16 tsp)
-  (stw tsp 4 tsp)
-  (stfd fp0 8 tsp)
-  (lbz imm0 (+ 8 7) tsp)
-  (lwz tsp 0 tsp)
+  (stfd fp0 target::tcr.lisp-fpscr-high rcontext)
+  (lbz imm0 (+ target::tcr.lisp-fpscr-high 7) rcontext)
   (box-fixnum arg_z imm0)
   (blr))
@@ -532 +532 @@
 (defppclapfunction %get-fpscr-status ()
   (mffs fp0)
-  (stwu tsp -16 tsp)
-  (stw tsp 4 tsp)
-  (stfd fp0 8 tsp)
-  (lwz imm0 12 tsp)
-  (lwz tsp 0 tsp)
+  (stfd fp0 target::tcr.lisp-fpscr-high rcontext)
+  (lwz imm0 target::tcr.lisp-fpscr-low tsp)
   (clrrwi imm0 imm0 8)
-  (srwi arg_z imm0 (- 8 ppc32::fixnumshift))
+  (srwi arg_z imm0 (- 8 target::fixnumshift))
   (blr))
 
 ; Set the high 24 bits of the FPSCR; leave the low 8 unchanged
 (defppclapfunction %set-fpscr-status ((new arg_z))
-  (slwi imm0 new (- 8 ppc32::fixnumshift))
-  (stwu tsp -16 tsp)
-  (stw tsp 4 tsp)
-  (stw imm0 12 tsp)
-  (lfd fp0 8 tsp)
-  (lwz tsp 0 tsp)
+  (slwi imm0 new (- 8 target::fixnumshift))
+  (stw imm0 target::tcr.lisp-fpscr-low rcontext)
+  (lfd fp0 target::tcr.lisp-fpscr-high rcontext)
   (mtfsf #xfc fp0)                      ; set status fields [0-5]
   (blr))
@@ -557 +551 @@
   (stwu tsp -16 tsp)
   (stw tsp 4 tsp)
-  (stw imm0 12 tsp)
-  (lfd fp0 8 tsp)
-  (lwz tsp 0 tsp)
+  (stw imm0 target::tcr.lisp-fpscr-low rcontext)
+  (lfd fp0 target::tcr.lisp-fpscr-high rcontext)
   (mtfsf #x03 fp0)                      ; set control fields [6-7]
   (blr))
@@ -581 +574 @@
   (oris imm0 imm0 #xc000)
   @ret
-  (srwi arg_z imm0 (- 8 ppc32::fixnumshift))
+  (srwi arg_z imm0 (- 8 target::fixnumshift))
   (blr))
   
@@ -605 +598 @@
     (%fp-error-from-status fp-status 
                            (%get-fpscr-control)
-                           operation 
-                           (%copy-short-float op0 (%make-sfloat)) 
-                           (%copy-short-float op1 (%make-sfloat)))))
+                           operation
+                           #+ppc32-target
+                           (%copy-short-float op0 (%make-sfloat))
+                           #+ppc64-target op0
+                           #+ppc32-target
+                           (%copy-short-float op1 (%make-sfloat))
+                           #+ppc64-target op1)))
 
 (defun %df-check-exception-1 (operation op0 fp-status)
@@ -626 +623 @@
     (%fp-error-from-status fp-status 
                            (%get-fpscr-control)
-                           operation 
-                           (%copy-short-float op0 (%make-sfloat)))))
+                           operation
+                           #+ppc32-target
+                           (%copy-short-float op0 (%make-sfloat))
+                           #+ppc64-target op0)))
 
 
@@ -667 +666 @@
     (t 'unknown)))
 
-; Don't we already have about 20 versions of this ?
+;;; Don't we already have about 20 versions of this ?
 (defppclapfunction %double-float-from-macptr! ((ptr arg_x) (byte-offset arg_y) (dest arg_z))
   (lwz imm0 ppc32::macptr.address ptr)
@@ -719 +718 @@
 (defppclapfunction %single-float-ptr->double-float-ptr ((single arg_y) (double arg_z))
   (check-nargs 2)
-  (lwz imm0 ppc32::macptr.address single)
+  (macptr-ptr imm0 single)
   (lfs fp0 0 imm0)
-  (lwz imm0 ppc32::macptr.address double)
+  (macptr-ptr imm0 double)
   (stfd fp0 0 imm0)
   (blr))
@@ -729 +728 @@
 (defppclapfunction %double-float-ptr->single-float-ptr ((double arg_y) (single arg_z))
   (check-nargs 2)
-  (lwz imm0 ppc32::macptr.address double)
+  (macptr-ptr imm0 double)
   (lfd fp0 0 imm0)
-  (lwz imm0 ppc32::macptr.address single)
+  (macptr-ptr imm0 single)
   (stfs fp0 0 imm0)
   (blr))
@@ -738 +737 @@
 (defppclapfunction %set-ieee-single-float-from-double ((src arg_y) (macptr arg_z))
   (check-nargs 2)
-  (lwz imm0 ppc32::macptr.address macptr)
+  (macptr-ptr imm0 macptr)
   (get-double-float fp1 src)
   (stfs fp1 0 imm0)