Index: /trunk/ccl/level-0/PPC/ppc-float.lisp
===================================================================
--- /trunk/ccl/level-0/PPC/ppc-float.lisp	(revision 392)
+++ /trunk/ccl/level-0/PPC/ppc-float.lisp	(revision 393)
@@ -23,19 +23,4 @@
   
 
-; 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,4 +479,5 @@
   (blr))
 
+#+ppc32-target
 (defppclapfunction %double-float->short-float ((src arg_y) (result arg_z))
   (clear-fpu-exceptions)
@@ -500,8 +486,17 @@
   (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,7 +504,15 @@
   (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,9 +524,6 @@
 (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,21 +532,15 @@
 (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,7 +551,6 @@
   (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,5 +574,5 @@
   (oris imm0 imm0 #xc000)
   @ret
-  (srwi arg_z imm0 (- 8 ppc32::fixnumshift))
+  (srwi arg_z imm0 (- 8 target::fixnumshift))
   (blr))
   
@@ -605,7 +598,11 @@
     (%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,6 +623,8 @@
     (%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,5 +666,5 @@
     (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,7 +718,7 @@
 (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,7 +728,7 @@
 (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,5 +737,5 @@
 (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)