X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FMachCode.lhs;h=2876efd36184a9d222bbc9f7279c2dad947682fb;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=e9fbdf4959c7bd144926582128f4a28e6ccc4e86;hpb=5819de0c5d78effa16e4c59987268eadb96b8d1d;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index e9fbdf4..2876efd 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -14,7 +14,6 @@ module MachCode ( stmtsToInstrs, InstrBlock ) where
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
 
-import Unique		( Unique )
 import MachMisc		-- may differ per-platform
 import MachRegs
 import OrdList		( OrdList, nilOL, isNilOL, unitOL, appOL, toOL,
@@ -37,11 +36,10 @@ import Stix		( getNatLabelNCG, StixStmt(..), StixExpr(..),
 			  StixReg(..), pprStixReg, StixVReg(..), CodeSegment(..), 
                           DestInfo, hasDestInfo,
                           pprStixExpr, repOfStixExpr,
-                          liftStrings,
                           NatM, thenNat, returnNat, mapNat, 
                           mapAndUnzipNat, mapAccumLNat,
-                          getDeltaNat, setDeltaNat, getUniqueNat,
-			  IF_OS_darwin(addImportNat COMMA,)
+                          getDeltaNat, setDeltaNat, 
+			  IF_ARCH_powerpc(addImportNat COMMA,)
                           ncgPrimopMoan,
 			  ncg_target_is_32bit
 			)
@@ -51,6 +49,8 @@ import qualified Outputable
 import CmdLineOpts	( opt_Static )
 import Stix		( pprStixStmt )
 
+import Maybe		( fromMaybe )
+
 -- DEBUGGING ONLY
 import Outputable	( assertPanic )
 import FastString
@@ -344,7 +344,7 @@ iselExpr64 (StCall fn cconv kind args)
 iselExpr64 expr
    = pprPanic "iselExpr64(i386)" (pprStixExpr expr)
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -436,7 +436,7 @@ iselExpr64 (StCall fn cconv kind args)
 iselExpr64 expr
    = pprPanic "iselExpr64(sparc)" (pprStixExpr expr)
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
 #if powerpc_TARGET_ARCH
@@ -524,7 +524,7 @@ iselExpr64 (StCall fn cconv kind args)
 iselExpr64 expr
    = pprPanic "iselExpr64(powerpc)" (pprStixExpr expr)
 
-#endif {- powerpc_TARGET_ARCH -}
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -889,7 +889,7 @@ getRegister leaf
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -1303,7 +1303,7 @@ getRegister leaf
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -1559,7 +1559,7 @@ getRegister leaf
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
 getRegister (StMachOp mop [x]) -- unary MachOps
@@ -1595,8 +1595,10 @@ getRegister (StMachOp mop [x]) -- unary MachOps
       MO_16S_to_NatS  -> integerExtend True  16 x
       MO_8U_to_32U    -> integerExtend False 24 x
 
-      other -> pprPanic "getRegister(powerpc) - unary StMachOp" 
-                                (pprMachOp mop)
+      MO_Flt_Neg      -> trivialUFCode FloatRep FNEG x
+      MO_Dbl_Neg      -> trivialUFCode FloatRep FNEG x
+
+      other_op -> getRegister (StCall (Left fn) CCallConv DoubleRep [x])
     where
         integerExtend signed nBits x
            = getRegister (
@@ -1607,6 +1609,44 @@ getRegister (StMachOp mop [x]) -- unary MachOps
             = getRegister expr		`thenNat` \ e_code ->
               returnNat (swizzleRegisterRep e_code new_rep)
 
+	(is_float_op, fn)
+	  = case mop of
+	      MO_Flt_Exp    -> (True,  FSLIT("exp"))
+	      MO_Flt_Log    -> (True,  FSLIT("log"))
+	      MO_Flt_Sqrt   -> (True,  FSLIT("sqrt"))
+
+	      MO_Flt_Sin    -> (True,  FSLIT("sin"))
+	      MO_Flt_Cos    -> (True,  FSLIT("cos"))
+	      MO_Flt_Tan    -> (True,  FSLIT("tan"))
+
+	      MO_Flt_Asin   -> (True,  FSLIT("asin"))
+	      MO_Flt_Acos   -> (True,  FSLIT("acos"))
+	      MO_Flt_Atan   -> (True,  FSLIT("atan"))
+
+	      MO_Flt_Sinh   -> (True,  FSLIT("sinh"))
+	      MO_Flt_Cosh   -> (True,  FSLIT("cosh"))
+	      MO_Flt_Tanh   -> (True,  FSLIT("tanh"))
+
+	      MO_Dbl_Exp    -> (False, FSLIT("exp"))
+	      MO_Dbl_Log    -> (False, FSLIT("log"))
+	      MO_Dbl_Sqrt   -> (False, FSLIT("sqrt"))
+
+	      MO_Dbl_Sin    -> (False, FSLIT("sin"))
+	      MO_Dbl_Cos    -> (False, FSLIT("cos"))
+	      MO_Dbl_Tan    -> (False, FSLIT("tan"))
+
+	      MO_Dbl_Asin   -> (False, FSLIT("asin"))
+	      MO_Dbl_Acos   -> (False, FSLIT("acos"))
+	      MO_Dbl_Atan   -> (False, FSLIT("atan"))
+
+	      MO_Dbl_Sinh   -> (False, FSLIT("sinh"))
+	      MO_Dbl_Cosh   -> (False, FSLIT("cosh"))
+	      MO_Dbl_Tanh   -> (False, FSLIT("tanh"))
+	      
+	      other -> pprPanic "getRegister(powerpc) - unary StMachOp" 
+                                (pprMachOp mop)
+
+
 getRegister (StMachOp mop [x, y]) -- dyadic PrimOps
   = case mop of
       MO_32U_Gt  -> condIntReg GTT x y
@@ -1644,14 +1684,23 @@ getRegister (StMachOp mop [x, y]) -- dyadic PrimOps
       MO_Dbl_Le -> condFltReg LE x y
 
       MO_Nat_Add -> trivialCode ADD x y
-      MO_Nat_Sub -> trivialCode SUBF y x
+      MO_Nat_Sub -> fromMaybe (trivialCode2 SUBF y x) $
+        case y of    -- subfi ('substract from' with immediate) doesn't exist
+          StInt imm -> if fits16Bits imm && imm /= (-32768)
+            then Just $ trivialCode ADD x (StInt (-imm))
+            else Nothing
+          _ -> Nothing
 
       MO_NatS_Mul -> trivialCode MULLW x y
       MO_NatU_Mul -> trivialCode MULLW x y
+      -- MO_NatS_MulMayOflo -> 
 
       MO_NatS_Quot -> trivialCode2 DIVW x y
       MO_NatU_Quot -> trivialCode2 DIVWU x y
       
+      MO_NatS_Rem  -> remainderCode DIVW x y
+      MO_NatU_Rem  -> remainderCode DIVWU x y
+      
       MO_Nat_And   -> trivialCode AND x y
       MO_Nat_Or    -> trivialCode OR x y
       MO_Nat_Xor   -> trivialCode XOR x y
@@ -1659,17 +1708,7 @@ getRegister (StMachOp mop [x, y]) -- dyadic PrimOps
       MO_Nat_Shl   -> trivialCode SLW x y
       MO_Nat_Shr   -> trivialCode SRW x y
       MO_Nat_Sar   -> trivialCode SRAW x y
-
-     {-  MO_NatS_Mul  -> trivialCode (SMUL False) x y
-      MO_NatU_Mul  -> trivialCode (UMUL False) x y
-      MO_NatS_MulMayOflo -> imulMayOflo x y
-			    imulMayOflo
-     -- ToDo: teach about V8+ SPARC div instructions
-      MO_NatS_Quot -> idiv FSLIT(".div")  x y
-      MO_NatS_Rem  -> idiv FSLIT(".rem")  x y
-      MO_NatU_Quot -> idiv FSLIT(".udiv")  x y
-      MO_NatU_Rem  -> idiv FSLIT(".urem")  x y -}
-
+      			    
       MO_Flt_Add   -> trivialFCode FloatRep  FADD x y
       MO_Flt_Sub   -> trivialFCode FloatRep  FSUB x y
       MO_Flt_Mul   -> trivialFCode FloatRep  FMUL x y
@@ -1679,13 +1718,12 @@ getRegister (StMachOp mop [x, y]) -- dyadic PrimOps
       MO_Dbl_Sub   -> trivialFCode DoubleRep FSUB x y
       MO_Dbl_Mul   -> trivialFCode DoubleRep FMUL x y
       MO_Dbl_Div   -> trivialFCode DoubleRep FDIV x y
-{-
+
       MO_Flt_Pwr  -> getRegister (StCall (Left FSLIT("pow")) CCallConv DoubleRep 
-                                         [promote x, promote y])
-		       where promote x = StMachOp MO_Flt_to_Dbl [x]
+                                         [x, y])
       MO_Dbl_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv DoubleRep 
                                         [x, y])
-	-}
+	
       other -> pprPanic "getRegister(powerpc) - binary StMachOp (1)" (pprMachOp mop)
 
 getRegister (StInd pk mem)
@@ -1745,7 +1783,7 @@ getRegister leaf
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
-#endif {- powerpc_TARGET_ARCH -}
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -1828,7 +1866,7 @@ getAmode other
     in
     returnNat (Amode (AddrReg reg) code)
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -1896,7 +1934,7 @@ getAmode other
     in
     returnNat (Amode (AddrBaseIndex (Just reg) Nothing (ImmInt 0)) code)
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -1960,7 +1998,7 @@ getAmode other
     in
     returnNat (Amode (AddrRegImm reg off) code)
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #ifdef powerpc_TARGET_ARCH
 getAmode (StMachOp MO_Nat_Sub [x, StInt i])
@@ -2006,7 +2044,7 @@ getAmode other
     	off  = ImmInt 0
     in
     returnNat (Amode (AddrRegImm reg off) code)
-#endif {- powerpc_TARGET_ARCH -}
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
@@ -2035,7 +2073,7 @@ getCondCode :: StixExpr -> NatM CondCode
 
 #if alpha_TARGET_ARCH
 getCondCode = panic "MachCode.getCondCode: not on Alphas"
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2082,7 +2120,7 @@ getCondCode (StMachOp mop [x, y])
 
 getCondCode other =  pprPanic "getCondCode(2)(x86,sparc,powerpc)" (pprStixExpr other)
 
-#endif {- i386_TARGET_ARCH || sparc_TARGET_ARCH || powerpc_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH || sparc_TARGET_ARCH || powerpc_TARGET_ARCH */
 
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -2099,7 +2137,7 @@ condIntCode, condFltCode :: Cond -> StixExpr -> StixExpr -> NatM CondCode
 #if alpha_TARGET_ARCH
 condIntCode = panic "MachCode.condIntCode: not on Alphas"
 condFltCode = panic "MachCode.condFltCode: not on Alphas"
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
@@ -2245,7 +2283,7 @@ condFltCode cond x y
     -- and true.  Hence we always supply EQQ as the condition to test.
     returnNat (CondCode True EQQ code__2)
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2311,7 +2349,7 @@ condFltCode cond x y
     in
     returnNat (CondCode True cond code__2)
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
 
@@ -2360,7 +2398,7 @@ condFltCode cond x y
     in
     returnNat (CondCode False cond code__2)
 
-#endif {- powerpc_TARGET_ARCH -} 
+#endif /* powerpc_TARGET_ARCH */
 
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -2418,7 +2456,7 @@ assignIntCode pk dst src
     in
     returnNat code__2
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2506,7 +2544,7 @@ assignReg_IntCode pk reg src
     in
     returnNat code
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2540,7 +2578,7 @@ assignReg_IntCode pk reg src
     in
     returnNat code__2
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
 
@@ -2571,7 +2609,7 @@ assignReg_IntCode pk reg src
     in
     returnNat code__2
 
-#endif {- powerpc_TARGET_ARCH -}
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
@@ -2611,7 +2649,7 @@ assignFltCode pk dst src
     in
     returnNat code__2
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2656,7 +2694,7 @@ assignReg_FltCode pk reg src
     returnNat code
 
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2711,7 +2749,7 @@ assignReg_FltCode pk reg src
     in
     returnNat code__2
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
 
@@ -2729,15 +2767,8 @@ assignMem_FltCode pk addr src
 
     	src__2  = registerName register tmp1
     	pk__2   = registerRep register
-    	sz__2   = primRepToSize pk__2
 
-	code__2 = if pk__2 == DoubleRep || pk == pk__2
-	    then code1 `appOL` code2 `snocOL` ST sz src__2 dst__2
-	    else panic "###PPC MachCode.assignMem_FltCode: FloatRep"
-    	{- code__2 = code1 `appOL` code2 `appOL`
-	    if   pk == pk__2 
-            then unitOL (ST sz src__2 dst__2)
-	    else toOL [FxTOy sz__2 sz src__2 tmp1, ST sz tmp1 dst__2] -}
+	code__2 = code1 `appOL` code2 `snocOL` ST sz src__2 dst__2
     in
     returnNat code__2
 
@@ -2756,7 +2787,7 @@ assignReg_FltCode pk reg src
                else c_src
     in
     returnNat code
-#endif {- powerpc_TARGET_ARCH -}
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
@@ -2801,7 +2832,7 @@ genJump tree
     else
     returnNat (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0))
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2831,7 +2862,7 @@ genJump dsts tree
     imm    = maybeImm tree
     target = case imm of Just x -> x
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2853,11 +2884,12 @@ genJump dsts tree
     in
     returnNat (code `snocOL` JMP dsts (AddrRegReg target g0) `snocOL` NOP)
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
 genJump dsts (StCLbl lbl)
-    = returnNat (toOL [BCC ALWAYS lbl])
+  | hasDestInfo dsts = panic "genJump(powerpc): CLbl and dsts"
+  | otherwise        = returnNat (toOL [BCC ALWAYS lbl])
 
 genJump dsts tree
   = getRegister tree	    	    	    `thenNat` \ register ->
@@ -2866,8 +2898,8 @@ genJump dsts tree
     	code   = registerCode register tmp
     	target = registerName register tmp
     in
-    returnNat (code `snocOL` MTCTR target `snocOL` BCTR)
-#endif {- sparc_TARGET_ARCH -}
+    returnNat (code `snocOL` MTCTR target `snocOL` BCTR dsts)
+#endif /* sparc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -3048,7 +3080,7 @@ genCondJump lbl (StPrim op [x, y])
 	AddrLtOp -> (CMP ULT, NE)
 	AddrLeOp -> (CMP ULE, NE)
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -3062,7 +3094,7 @@ genCondJump lbl bool
     in
     returnNat (code `snocOL` JXX cond lbl)
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -3084,7 +3116,7 @@ genCondJump lbl bool
        )
     )
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
 
@@ -3098,7 +3130,7 @@ genCondJump lbl bool
     returnNat (
        code `snocOL` BCC cond lbl    )
 
-#endif {- powerpc_TARGET_ARCH -}
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -3194,7 +3226,7 @@ genCCall fn cconv kind args
 	in
 	returnNat (([], offset + 1), code . mkSeqInstr (ST sz src (spRel offset)))
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -3306,7 +3338,7 @@ genCCall fn cconv ret_rep args
 	in
 	returnNat (code, reg, sz)
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -3447,11 +3479,13 @@ genCCall fn cconv kind args
                    , 
                    [v1]
                 )
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
+
+#if darwin_TARGET_OS
 {-
-    The PowerPC calling convention (at least for Darwin/Mac OS X)
+    The PowerPC calling convention for Darwin/Mac OS X
     is described in Apple's document
     "Inside Mac OS X - Mach-O Runtime Architecture".
     Parameters may be passed in general-purpose registers, in
@@ -3558,7 +3592,124 @@ genCCall fn cconv kind args
 		    `snocOL` storeWord vr_hi gprs stackOffset
 		    `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
 		((take 2 gprs) ++ accumUsed)
-#endif {- powerpc_TARGET_ARCH -}
+#else
+
+{-
+    PowerPC Linux uses the System V Release 4 Calling Convention
+    for PowerPC. It is described in the
+    "System V Application Binary Interface PowerPC Processor Supplement".
+    
+    Like the Darwin/Mac OS X code above, this allocates a new stack frame
+    so that the parameter area doesn't conflict with the spill slots.
+-}
+
+genCCall fn cconv kind args
+  = mapNat prepArg args `thenNat` \ preppedArgs ->
+    let
+	(argReps,argCodes,vregs) = unzip3 preppedArgs
+
+	    -- size of linkage area + size of arguments, in bytes
+	stackDelta = roundTo16 finalStack
+	roundTo16 x | x `mod` 16 == 0 = x
+		    | otherwise = x + 16 - (x `mod` 16)
+
+	move_sp_down = toOL [STU W sp (AddrRegImm sp (ImmInt (-stackDelta))), DELTA (-stackDelta)]
+	move_sp_up = toOL [ADD sp sp (RIImm (ImmInt stackDelta)), DELTA 0]
+
+	(moveFinalCode,usedRegs,finalStack) =
+            move_final (zip vregs argReps)
+	               allArgRegs allFPArgRegs
+	               eXTRA_STK_ARGS_HERE
+	               (toOL []) []
+
+	passArguments = concatOL argCodes
+	    `appOL` move_sp_down
+	    `appOL` moveFinalCode
+    in 
+	case fn of
+	    Left lbl ->
+		addImportNat lbl			`thenNat` \ _ ->
+		returnNat (passArguments
+			    `snocOL`	BL (ImmLit $ ftext  lbl)
+					   usedRegs
+			    `appOL`	move_sp_up)
+	    Right dyn ->
+		getRegister dyn				`thenNat` \ dynReg ->
+		getNewRegNCG (registerRep dynReg)	`thenNat` \ tmp ->
+		returnNat (registerCode dynReg tmp
+			    `appOL`	passArguments
+			    `snocOL`	MTCTR (registerName dynReg tmp)
+			    `snocOL`	BCTRL usedRegs
+			    `appOL`	move_sp_up)
+    where
+    prepArg arg
+        | is64BitRep (repOfStixExpr arg)
+        = iselExpr64 arg		`thenNat` \ (ChildCode64 code vr_lo) ->
+          let r_lo = VirtualRegI vr_lo
+              r_hi = getHiVRegFromLo r_lo
+          in  returnNat (repOfStixExpr arg, code, Right (r_hi,r_lo))
+	| otherwise
+	= getRegister arg			`thenNat` \ register ->
+	  getNewRegNCG (registerRep register)	`thenNat` \ tmp ->
+	  returnNat (registerRep register, registerCode register tmp, Left (registerName register tmp))
+    move_final [] _ _ stackOffset accumCode accumUsed = (accumCode, accumUsed, stackOffset)
+    move_final ((Left vr,rep):vregs) gprs fprs stackOffset accumCode accumUsed
+	| not (is64BitRep rep) =
+	case rep of
+	    FloatRep ->
+                case fprs of
+                    fpr : fprs' -> move_final vregs gprs fprs' stackOffset
+                                              (accumCode `snocOL` MR fpr vr)
+                                              (fpr : accumUsed)
+                    [] -> move_final vregs gprs fprs (stackOffset+4)
+                                     (accumCode `snocOL`
+                                        ST F vr (AddrRegImm sp (ImmInt stackOffset)))
+                                     accumUsed
+	    DoubleRep ->
+                case fprs of
+                    fpr : fprs' -> move_final vregs gprs fprs' stackOffset
+                                              (accumCode `snocOL` MR fpr vr)
+                                              (fpr : accumUsed)
+                    [] -> move_final vregs gprs fprs (stackOffset+8)
+                                     (accumCode `snocOL`
+                                        ST DF vr (AddrRegImm sp (ImmInt stackOffset)))
+                                     accumUsed
+	    VoidRep -> panic "MachCode.genCCall(powerpc): void parameter"
+	    _ ->
+                case gprs of
+                    gpr : gprs' -> move_final vregs gprs' fprs stackOffset
+                                              (accumCode `snocOL` MR gpr vr)
+                                              (gpr : accumUsed)
+                    [] -> move_final vregs gprs fprs (stackOffset+4)
+                                     (accumCode `snocOL`
+                                        ST W vr (AddrRegImm sp (ImmInt stackOffset)))
+                                     accumUsed
+		
+    move_final ((Right (vr_hi,vr_lo),rep):vregs) gprs fprs stackOffset accumCode accumUsed
+	| is64BitRep rep =
+            case gprs of
+                hireg : loreg : regs | even (length gprs) ->
+                    move_final vregs regs fprs stackOffset
+                               (regCode hireg loreg) accumUsed
+                _skipped : hireg : loreg : regs ->
+                    move_final vregs regs fprs stackOffset
+                               (regCode hireg loreg) accumUsed
+                _ -> -- only one or no regs left
+                    move_final vregs [] fprs (stackOffset+8)
+                               stackCode accumUsed
+	where
+            stackCode =
+                accumCode
+                    `snocOL` ST W vr_hi (AddrRegImm sp (ImmInt stackOffset))
+                    `snocOL` ST W vr_lo (AddrRegImm sp (ImmInt (stackOffset+4)))
+            regCode hireg loreg =
+                accumCode
+                    `snocOL` MR hireg vr_hi
+                    `snocOL` MR loreg vr_lo
+
+#endif                
+                
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
@@ -3589,7 +3740,7 @@ condIntReg, condFltReg :: Cond -> StixExpr -> StixExpr -> NatM Register
 #if alpha_TARGET_ARCH
 condIntReg = panic "MachCode.condIntReg (not on Alpha)"
 condFltReg = panic "MachCode.condFltReg (not on Alpha)"
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -3625,7 +3776,7 @@ condFltReg cond x y
     in
     returnNat (Any IntRep code__2)
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -3724,7 +3875,7 @@ condFltReg cond x y
     in
     returnNat (Any IntRep code__2)
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
 condIntReg cond x y
@@ -3752,7 +3903,7 @@ condFltReg cond x y
 	    LABEL lbl]
     in
     returnNat (Any IntRep code__2)
-#endif {- powerpc_TARGET_ARCH -}
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
@@ -3882,7 +4033,7 @@ trivialUFCode _ instr x
     in
     returnNat (Any DoubleRep code__2)
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -4063,7 +4214,7 @@ trivialUFCode pk instr x
     in
     returnNat (Any pk code__2)
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -4151,7 +4302,7 @@ trivialUFCode pk instr x
     in
     returnNat (Any pk code__2)
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
 trivialCode instr x (StInt y)
@@ -4217,13 +4368,13 @@ trivialFCode pk instr x y
     	code2 = registerCode register2 tmp2
     	src2  = registerName register2 tmp2
 
+	dstRep = if pk1 == FloatRep && pk2 == FloatRep then FloatRep else DoubleRep
+
     	code__2 dst =
-    	    	if pk1 == pk2 then
     	            code1 `appOL` code2 `snocOL`
-    	    	    instr (primRepToSize pk) dst src1 src2
-    	    	else panic "###PPC MachCode.trivialFCode: type mismatch"
+    	    	    instr (primRepToSize dstRep) dst src1 src2
     in
-    returnNat (Any (if pk1 == pk2 then pk1 else DoubleRep) code__2)
+    returnNat (Any dstRep code__2)
 
 trivialUCode instr x
   = getRegister x		`thenNat` \ register ->
@@ -4234,8 +4385,42 @@ trivialUCode instr x
     	code__2 dst = code `snocOL` instr dst src
     in
     returnNat (Any IntRep code__2)
-trivialUFCode pk instr x  = panic "###PPC MachCode.trivialUFCode"
-#endif {- powerpc_TARGET_ARCH -}
+trivialUFCode pk instr x
+  = getRegister x		`thenNat` \ register ->
+    getNewRegNCG (registerRep register)
+				`thenNat` \ tmp ->
+    let
+    	code = registerCode register tmp
+    	src  = registerName register tmp
+    	code__2 dst = code `snocOL` instr dst src
+    in
+    returnNat (Any pk code__2)
+  
+-- There is no "remainder" instruction on the PPC, so we have to do
+-- it the hard way.
+-- The "div" parameter is the division instruction to use (DIVW or DIVWU)
+
+remainderCode :: (Reg -> Reg -> Reg -> Instr)
+    -> StixExpr -> StixExpr -> NatM Register
+remainderCode div x y
+  = getRegister x		`thenNat` \ register1 ->
+    getRegister y		`thenNat` \ register2 ->
+    getNewRegNCG IntRep		`thenNat` \ tmp1 ->
+    getNewRegNCG IntRep		`thenNat` \ tmp2 ->
+    let
+    	code1 = registerCode register1 tmp1
+    	src1  = registerName register1 tmp1
+    	code2 = registerCode register2 tmp2
+    	src2  = registerName register2 tmp2
+    	code__2 dst = code1 `appOL` code2 `appOL` toOL [
+		div dst src1 src2,
+		MULLW dst dst (RIReg src2),
+		SUBF dst dst src1
+	    ]
+    in
+    returnNat (Any IntRep code__2)
+
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}
@@ -4297,7 +4482,7 @@ coerceFP2Int x
     in
     returnNat (Any IntRep code__2)
 
-#endif {- alpha_TARGET_ARCH -}
+#endif /* alpha_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -4332,7 +4517,7 @@ coerceFP2Int fprep x
 coerceDbl2Flt x = panic "MachCode.coerceDbl2Flt: unused on x86"
 coerceFlt2Dbl x = panic "MachCode.coerceFlt2Dbl: unused on x86"
 
-#endif {- i386_TARGET_ARCH -}
+#endif /* i386_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -4388,14 +4573,56 @@ coerceFlt2Dbl x
         returnNat (Any DoubleRep
                        (\dst -> code `snocOL` FxTOy F DF src dst)) 
 
-#endif {- sparc_TARGET_ARCH -}
+#endif /* sparc_TARGET_ARCH */
 
 #if powerpc_TARGET_ARCH
-coerceInt2FP pk x	= panic "###PPC MachCode.coerceInt2FP"
-coerceFP2Int fprep x	= panic "###PPC MachCode.coerceFP2Int"
+coerceInt2FP pk x
+  = ASSERT(pk == DoubleRep)
+    getRegister x		    `thenNat` \ register ->
+    getNewRegNCG IntRep		    `thenNat` \ reg ->
+    getNatLabelNCG 	    	    `thenNat` \ lbl ->
+    getNewRegNCG PtrRep    	    `thenNat` \ itmp ->
+    getNewRegNCG DoubleRep    	    `thenNat` \ ftmp ->
+    let
+        code = registerCode register reg
+    	src  = registerName register reg
+    	code__2 dst = code `appOL` toOL [
+		SEGMENT RoDataSegment,
+		LABEL lbl,
+		DATA W [ImmInt 0x43300000, ImmInt 0x80000000],
+		SEGMENT TextSegment,
+		XORIS itmp src (ImmInt 0x8000),
+		ST W itmp (spRel (-1)),
+		LIS itmp (ImmInt 0x4330),
+		ST W itmp (spRel (-2)),
+		LD DF ftmp (spRel (-2)),
+		LIS itmp (HA (ImmCLbl lbl)),
+		LD DF dst (AddrRegImm itmp (LO (ImmCLbl lbl))),
+		FSUB DF dst ftmp dst
+	    ]
+    in
+	returnNat (Any DoubleRep code__2)
+
+coerceFP2Int fprep x
+  = ASSERT(fprep == DoubleRep || fprep == FloatRep)
+    getRegister x		`thenNat` \ register ->
+    getNewRegNCG fprep		`thenNat` \ reg ->
+    getNewRegNCG DoubleRep	`thenNat` \ tmp ->
+    let
+    	code = registerCode register reg
+    	src  = registerName register reg
+    	code__2 dst = code `appOL` toOL [
+		-- convert to int in FP reg
+    	    FCTIWZ tmp src,
+		-- store value (64bit) from FP to stack
+    	    ST DF tmp (spRel (-2)),
+		-- read low word of value (high word is undefined)
+    	    LD W dst (spRel (-1))]	
+    in
+    returnNat (Any IntRep code__2)
 coerceDbl2Flt x		= panic "###PPC MachCode.coerceDbl2Flt"
 coerceFlt2Dbl x		= panic "###PPC MachCode.coerceFlt2Dbl"
-#endif {- powerpc_TARGET_ARCH -}
+#endif /* powerpc_TARGET_ARCH */
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 \end{code}