X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.lhs;h=2381689890217674f6570f45f37f7da155723971;hb=823eeb495697765fc4b81e95e3632b09ab64cc0a;hp=ae2aa96df68bc05c82e298c2c1eb696a851b7ee1;hpb=ec269b1201dd73f6173d7d66ddbe2bbbc2244bf2;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index ae2aa96..2381689 100644
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -10,7 +10,7 @@ We start with the @pprXXX@s with some cross-platform commonality
 \begin{code}
 #include "nativeGen/NCG.h"
 
-module PprMach ( pprInstr, pprSize, pprUserReg ) where
+module PprMach ( pprInstr, pprSize, pprUserReg IF_OS_darwin(COMMA pprDyldSymbolStub, ) ) where
 
 #include "HsVersions.h"
 
@@ -19,13 +19,21 @@ import MachMisc
 
 import CLabel		( pprCLabel, externallyVisibleCLabel, labelDynamic )
 import Stix		( CodeSegment(..) )
-import Unique		( pprUnique )
 import Panic		( panic )
 import Pretty
+import FastString
 import qualified Outputable
 
-import ST
+#if __GLASGOW_HASKELL__ >= 504
+import Data.Array.ST
+import Data.Word	( Word8, Word16 )
+#else
 import MutableArray
+import Word             ( Word16 )
+#endif
+
+import MONAD_ST
+
 import Char		( chr, ord )
 import Maybe		( isJust )
 
@@ -168,6 +176,45 @@ pprReg IF_ARCH_i386(s,) r
 	_  -> SLIT("very naughty sparc register")
       })
 #endif
+#if powerpc_TARGET_ARCH
+    ppr_reg_no :: Int -> Doc
+    ppr_reg_no i = ptext
+      (case i of {
+	 0 -> SLIT("r0");   1 -> SLIT("r1");
+	 2 -> SLIT("r2");   3 -> SLIT("r3");
+	 4 -> SLIT("r4");   5 -> SLIT("r5");
+	 6 -> SLIT("r6");   7 -> SLIT("r7");
+	 8 -> SLIT("r8");   9 -> SLIT("r9");
+	10 -> SLIT("r10");  11 -> SLIT("r11");
+	12 -> SLIT("r12");  13 -> SLIT("r13");
+	14 -> SLIT("r14");  15 -> SLIT("r15");
+	16 -> SLIT("r16");  17 -> SLIT("r17");
+	18 -> SLIT("r18");  19 -> SLIT("r19");
+	20 -> SLIT("r20");  21 -> SLIT("r21");
+	22 -> SLIT("r22");  23 -> SLIT("r23");
+	24 -> SLIT("r24");  25 -> SLIT("r25");
+	26 -> SLIT("r26");  27 -> SLIT("r27");
+	28 -> SLIT("r28");  29 -> SLIT("r29");
+	30 -> SLIT("r30");  31 -> SLIT("r31");
+	32 -> SLIT("f0");  33 -> SLIT("f1");
+	34 -> SLIT("f2");  35 -> SLIT("f3");
+	36 -> SLIT("f4");  37 -> SLIT("f5");
+	38 -> SLIT("f6");  39 -> SLIT("f7");
+	40 -> SLIT("f8");  41 -> SLIT("f9");
+	42 -> SLIT("f10"); 43 -> SLIT("f11");
+	44 -> SLIT("f12"); 45 -> SLIT("f13");
+	46 -> SLIT("f14"); 47 -> SLIT("f15");
+	48 -> SLIT("f16"); 49 -> SLIT("f17");
+	50 -> SLIT("f18"); 51 -> SLIT("f19");
+	52 -> SLIT("f20"); 53 -> SLIT("f21");
+	54 -> SLIT("f22"); 55 -> SLIT("f23");
+	56 -> SLIT("f24"); 57 -> SLIT("f25");
+	58 -> SLIT("f26"); 59 -> SLIT("f27");
+	60 -> SLIT("f28"); 61 -> SLIT("f29");
+	62 -> SLIT("f30"); 63 -> SLIT("f31");
+	_  -> SLIT("very naughty powerpc register")
+      })
+#endif
 \end{code}
 
 %************************************************************************
@@ -223,6 +270,15 @@ pprStSize x = ptext (case x of
 	F   -> SLIT("")
 	DF  -> SLIT("d")
 #endif
+#if powerpc_TARGET_ARCH
+	B   -> SLIT("b")
+	Bu  -> SLIT("b")
+        H   -> SLIT("h")
+        Hu  -> SLIT("h")
+	W   -> SLIT("w")
+	F   -> SLIT("fs")
+	DF  -> SLIT("fd")
+#endif
     )
 \end{code}
 
@@ -266,6 +322,14 @@ pprCond c = ptext (case c of {
 	NEG	-> SLIT("neg");	POS   -> SLIT("pos");
 	VC	-> SLIT("vc");	VS    -> SLIT("vs")
 #endif
+#if powerpc_TARGET_ARCH
+	ALWAYS  -> SLIT("");
+	EQQ	-> SLIT("eq");	NE    -> SLIT("ne");
+	LTT     -> SLIT("lt");  GE    -> SLIT("ge");
+	GTT     -> SLIT("gt");  LE    -> SLIT("le");
+	LU      -> SLIT("lt");  GEU   -> SLIT("ge");
+	GU      -> SLIT("gt");  LEU   -> SLIT("le");
+#endif
     })
 \end{code}
 
@@ -301,6 +365,22 @@ pprImm (HI i)
   where
     pp_hi = text "%hi("
 #endif
+#if powerpc_TARGET_ARCH
+pprImm (LO i)
+  = hcat [ pp_lo, pprImm i, rparen ]
+  where
+    pp_lo = text "lo16("
+
+pprImm (HI i)
+  = hcat [ pp_hi, pprImm i, rparen ]
+  where
+    pp_hi = text "hi16("
+
+pprImm (HA i)
+  = hcat [ pp_ha, pprImm i, rparen ]
+  where
+    pp_ha = text "ha16("
+#endif
 \end{code}
 
 %************************************************************************
@@ -367,6 +447,8 @@ pprAddr (AddrRegImm r1 (ImmInt i))
 pprAddr (AddrRegImm r1 (ImmInteger i))
   | i == 0 = pprReg r1
   | not (fits13Bits i) = largeOffsetError i
+-------------------
+
   | otherwise  = hcat [ pprReg r1, pp_sign, integer i ]
   where
     pp_sign = if i > 0 then char '+' else empty
@@ -374,6 +456,14 @@ pprAddr (AddrRegImm r1 (ImmInteger i))
 pprAddr (AddrRegImm r1 imm)
   = hcat [ pprReg r1, char '+', pprImm imm ]
 #endif
+#if powerpc_TARGET_ARCH
+pprAddr (AddrRegReg r1 r2)
+  = error "PprMach.pprAddr (AddrRegReg) unimplemented"
+
+pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
+pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
+pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
+#endif
 \end{code}
 
 %************************************************************************
@@ -387,33 +477,37 @@ pprInstr :: Instr -> Doc
 
 --pprInstr (COMMENT s) = empty -- nuke 'em
 pprInstr (COMMENT s)
-   =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s))
-     ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ptext s))
-     ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ptext s))
-     ,)))
+   =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
+     ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ftext s))
+     ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ftext s))
+     ,IF_ARCH_powerpc( ((<>) (ptext SLIT("; ")) (ftext s))
+     ,))))
 
 pprInstr (DELTA d)
-   = pprInstr (COMMENT (_PK_ ("\tdelta = " ++ show d)))
+   = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 
 pprInstr (SEGMENT TextSegment)
     =  IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
       ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-}
       ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
-      ,)))
+      ,IF_ARCH_powerpc(ptext SLIT(".text\n.align 2")
+      ,))))
 
 pprInstr (SEGMENT DataSegment)
     = ptext
 	 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 	,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 	,IF_ARCH_i386(SLIT(".data\n\t.align 4")
-	,)))
+        ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
+	,))))
 
 pprInstr (SEGMENT RoDataSegment)
     = ptext
 	 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
 	,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
 	,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
-	,)))
+        ,IF_ARCH_powerpc(SLIT(".const_data\n.align 2")
+	,))))
 
 pprInstr (LABEL clab)
   = let
@@ -427,7 +521,8 @@ pprInstr (LABEL clab)
 			 IF_ARCH_alpha(SLIT("\t.globl\t")
 		        ,IF_ARCH_i386(SLIT(".globl ")
 			,IF_ARCH_sparc(SLIT(".global\t")
-			,)))
+		        ,IF_ARCH_powerpc(SLIT(".globl ")
+			,))))
 			, pp_lab, char '\n'],
 	pp_lab,
 	char ':'
@@ -476,38 +571,19 @@ pprInstr (DATA s xs)
            = let bs = doubleToBytes (fromRational r)
              in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
 #endif
-
-        -- floatToBytes and doubleToBytes convert to the host's byte
-        -- order.  Providing that we're not cross-compiling for a 
-        -- target with the opposite endianness, this should work ok
-        -- on all targets.
-        floatToBytes :: Float -> [Int]
-        floatToBytes f
-           = runST (do
-                arr <- newFloatArray ((0::Int),3)
-                writeFloatArray arr 0 f
-                i0 <- readCharArray arr 0
-                i1 <- readCharArray arr 1
-                i2 <- readCharArray arr 2
-                i3 <- readCharArray arr 3
-                return (map ord [i0,i1,i2,i3])
-             )
-
-        doubleToBytes :: Double -> [Int]
-        doubleToBytes d
-           = runST (do
-                arr <- newDoubleArray ((0::Int),7)
-                writeDoubleArray arr 0 d
-                i0 <- readCharArray arr 0
-                i1 <- readCharArray arr 1
-                i2 <- readCharArray arr 2
-                i3 <- readCharArray arr 3
-                i4 <- readCharArray arr 4
-                i5 <- readCharArray arr 5
-                i6 <- readCharArray arr 6
-                i7 <- readCharArray arr 7
-                return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
-             )
+#if powerpc_TARGET_ARCH
+	ppr_item B  x = [ptext SLIT("\t.byte\t") <> pprImm x]
+	ppr_item Bu  x = [ptext SLIT("\t.byte\t") <> pprImm x]
+	ppr_item H  x = [ptext SLIT("\t.byte\t") <> pprImm x]
+	ppr_item Hu  x = [ptext SLIT("\t.byte\t") <> pprImm x]
+	ppr_item W  x = [ptext SLIT("\t.long\t") <> pprImm x]
+	ppr_item F  (ImmFloat r)
+           = let bs = floatToBytes (fromRational r)
+             in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
+    	ppr_item DF (ImmDouble r)
+           = let bs = doubleToBytes (fromRational r)
+             in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
+#endif
 
 -- fall through to rest of (machine-specific) pprInstr...
 \end{code}
@@ -868,8 +944,7 @@ pprRI :: RI -> Doc
 pprRI (RIReg r) = pprReg r
 pprRI (RIImm r) = pprImm r
 
-pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Doc
-
+pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
 pprRegRIReg name reg1 ri reg2
   = hcat [
  	char '\t',
@@ -882,8 +957,7 @@ pprRegRIReg name reg1 ri reg2
 	pprReg reg2
     ]
 
-pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
-
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 pprSizeRegRegReg name size reg1 reg2 reg3
   = hcat [
 	char '\t',
@@ -897,7 +971,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3
 	pprReg reg3
     ]
 
-#endif {-alpha_TARGET_ARCH-}
+#endif /* alpha_TARGET_ARCH */
 \end{code}
 
 %************************************************************************
@@ -1293,7 +1367,7 @@ pprOperand s (OpReg r)   = pprReg s r
 pprOperand s (OpImm i)   = pprDollImm i
 pprOperand s (OpAddr ea) = pprAddr ea
 
-pprSizeImmOp :: FAST_STRING -> Size -> Imm -> Operand -> Doc
+pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
 pprSizeImmOp name size imm op1
   = hcat [
         char '\t',
@@ -1306,7 +1380,7 @@ pprSizeImmOp name size imm op1
 	pprOperand size op1
     ]
 	
-pprSizeOp :: FAST_STRING -> Size -> Operand -> Doc
+pprSizeOp :: LitString -> Size -> Operand -> Doc
 pprSizeOp name size op1
   = hcat [
     	char '\t',
@@ -1316,7 +1390,7 @@ pprSizeOp name size op1
 	pprOperand size op1
     ]
 
-pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
+pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
 pprSizeOpOp name size op1 op2
   = hcat [
     	char '\t',
@@ -1328,7 +1402,7 @@ pprSizeOpOp name size op1 op2
 	pprOperand size op2
     ]
 
-pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
+pprSizeByteOpOp :: LitString -> Size -> Operand -> Operand -> Doc
 pprSizeByteOpOp name size op1 op2
   = hcat [
     	char '\t',
@@ -1340,7 +1414,7 @@ pprSizeByteOpOp name size op1 op2
 	pprOperand size op2
     ]
 
-pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc
+pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc
 pprSizeOpReg name size op1 reg
   = hcat [
     	char '\t',
@@ -1352,7 +1426,7 @@ pprSizeOpReg name size op1 reg
 	pprReg size reg
     ]
 
-pprSizeReg :: FAST_STRING -> Size -> Reg -> Doc
+pprSizeReg :: LitString -> Size -> Reg -> Doc
 pprSizeReg name size reg1
   = hcat [
     	char '\t',
@@ -1362,7 +1436,7 @@ pprSizeReg name size reg1
 	pprReg size reg1
     ]
 
-pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
+pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
 pprSizeRegReg name size reg1 reg2
   = hcat [
     	char '\t',
@@ -1374,7 +1448,7 @@ pprSizeRegReg name size reg1 reg2
         pprReg size reg2
     ]
 
-pprCondRegReg :: FAST_STRING -> Size -> Cond -> Reg -> Reg -> Doc
+pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
 pprCondRegReg name size cond reg1 reg2
   = hcat [
     	char '\t',
@@ -1386,7 +1460,7 @@ pprCondRegReg name size cond reg1 reg2
         pprReg size reg2
     ]
 
-pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> Doc
+pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
 pprSizeSizeRegReg name size1 size2 reg1 reg2
   = hcat [
     	char '\t',
@@ -1395,11 +1469,12 @@ pprSizeSizeRegReg name size1 size2 reg1 reg2
         pprSize size2,
 	space,
 	pprReg size1 reg1,
+
         comma,
         pprReg size2 reg2
     ]
 
-pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 pprSizeRegRegReg name size reg1 reg2 reg3
   = hcat [
     	char '\t',
@@ -1413,7 +1488,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3
         pprReg size reg3
     ]
 
-pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> Doc
+pprSizeAddr :: LitString -> Size -> MachRegsAddr -> Doc
 pprSizeAddr name size op
   = hcat [
     	char '\t',
@@ -1423,7 +1498,7 @@ pprSizeAddr name size op
 	pprAddr op
     ]
 
-pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> Doc
+pprSizeAddrReg :: LitString -> Size -> MachRegsAddr -> Reg -> Doc
 pprSizeAddrReg name size op dst
   = hcat [
     	char '\t',
@@ -1435,7 +1510,7 @@ pprSizeAddrReg name size op dst
 	pprReg size dst
     ]
 
-pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> Doc
+pprSizeRegAddr :: LitString -> Size -> Reg -> MachRegsAddr -> Doc
 pprSizeRegAddr name size src op
   = hcat [
     	char '\t',
@@ -1447,7 +1522,7 @@ pprSizeRegAddr name size src op
 	pprAddr op
     ]
 
-pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
+pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
 pprOpOp name size op1 op2
   = hcat [
     	char '\t',
@@ -1457,7 +1532,7 @@ pprOpOp name size op1 op2
 	pprOperand size op2
     ]
 
-pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc
+pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
 pprSizeOpOpCoerce name size1 size2 op1 op2
   = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
 	pprOperand size1 op1,
@@ -1465,11 +1540,11 @@ pprSizeOpOpCoerce name size1 size2 op1 op2
 	pprOperand size2 op2
     ]
 
-pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc
+pprCondInstr :: LitString -> Cond -> Doc -> Doc
 pprCondInstr name cond arg
   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
 
-#endif {-i386_TARGET_ARCH-}
+#endif /* i386_TARGET_ARCH */
 \end{code}
 
 %************************************************************************
@@ -1687,8 +1762,10 @@ pprInstr (BF cond b lab)
 
 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
 
-pprInstr (CALL imm n _)
+pprInstr (CALL (Left imm) n _)
   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
+pprInstr (CALL (Right reg) n _)
+  = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
 \end{code}
 
 Continue with SPARC-only printing bits and bobs:
@@ -1697,7 +1774,7 @@ pprRI :: RI -> Doc
 pprRI (RIReg r) = pprReg r
 pprRI (RIImm r) = pprImm r
 
-pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
+pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
 pprSizeRegReg name size reg1 reg2
   = hcat [
     	char '\t',
@@ -1710,7 +1787,7 @@ pprSizeRegReg name size reg1 reg2
 	pprReg reg2
     ]
 
-pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
 pprSizeRegRegReg name size reg1 reg2 reg3
   = hcat [
     	char '\t',
@@ -1725,7 +1802,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3
 	pprReg reg3
     ]
 
-pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc
+pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
 pprRegRIReg name b reg1 ri reg2
   = hcat [
 	char '\t',
@@ -1738,7 +1815,7 @@ pprRegRIReg name b reg1 ri reg2
 	pprReg reg2
     ]
 
-pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
+pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
 pprRIReg name b ri reg1
   = hcat [
 	char '\t',
@@ -1754,5 +1831,356 @@ pp_rbracket_comma = text "],"
 pp_comma_lbracket = text ",["
 pp_comma_a	  = text ",a"
 
-#endif {-sparc_TARGET_ARCH-}
+#endif /* sparc_TARGET_ARCH */
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{@pprInstr@ for PowerPC}
+%*									*
+%************************************************************************
+
+\begin{code}
+#if powerpc_TARGET_ARCH
+pprInstr (LD sz reg addr) = hcat [
+	char '\t',
+	ptext SLIT("l"),
+	ptext (case sz of
+	    B   -> SLIT("ba")
+	    Bu  -> SLIT("bz")
+	    H   -> SLIT("ha")
+	    Hu  -> SLIT("hz")
+	    W   -> SLIT("wz")
+	    F   -> SLIT("fs")
+	    DF  -> SLIT("fd")),
+	char '\t',
+	pprReg reg,
+	ptext SLIT(", "),
+	pprAddr addr
+    ]
+pprInstr (ST sz reg addr) = hcat [
+	char '\t',
+	ptext SLIT("st"),
+	pprSize sz,
+	char '\t',
+	pprReg reg,
+	ptext SLIT(", "),
+	pprAddr addr
+    ]
+pprInstr (STU sz reg addr) = hcat [
+	char '\t',
+	ptext SLIT("st"),
+	pprSize sz,
+	ptext SLIT("u\t"),
+	pprReg reg,
+	ptext SLIT(", "),
+	pprAddr addr
+    ]
+pprInstr (LIS reg imm) = hcat [
+	char '\t',
+	ptext SLIT("lis"),
+	char '\t',
+	pprReg reg,
+	ptext SLIT(", "),
+	pprImm imm
+    ]
+pprInstr (LI reg imm) = hcat [
+	char '\t',
+	ptext SLIT("li"),
+	char '\t',
+	pprReg reg,
+	ptext SLIT(", "),
+	pprImm imm
+    ]
+pprInstr (MR reg1 reg2) 
+    | reg1 == reg2 = empty
+    | otherwise = hcat [
+	char '\t',
+	case regClass reg1 of
+	    RcInteger -> ptext SLIT("mr")
+	    _ -> ptext SLIT("fmr"),
+	char '\t',
+	pprReg reg1,
+	ptext SLIT(", "),
+	pprReg reg2
+    ]
+pprInstr (CMP sz reg ri) = hcat [
+	char '\t',
+	op,
+	char '\t',
+	pprReg reg,
+	ptext SLIT(", "),
+	pprRI ri
+    ]
+    where
+	op = hcat [
+		ptext SLIT("cmp"),
+		pprSize sz,
+		case ri of
+		    RIReg _ -> empty
+		    RIImm _ -> char 'i'
+	    ]
+pprInstr (CMPL sz reg ri) = hcat [
+	char '\t',
+	op,
+	char '\t',
+	pprReg reg,
+	ptext SLIT(", "),
+	pprRI ri
+    ]
+    where
+	op = hcat [
+		ptext SLIT("cmpl"),
+		pprSize sz,
+		case ri of
+		    RIReg _ -> empty
+		    RIImm _ -> char 'i'
+	    ]
+pprInstr (BCC cond lbl) = hcat [
+	char '\t',
+	ptext SLIT("b"),
+	pprCond cond,
+	char '\t',
+	pprCLabel_asm lbl
+    ]
+
+pprInstr (MTCTR reg) = hcat [
+	char '\t',
+	ptext SLIT("mtctr"),
+	char '\t',
+	pprReg reg
+    ]
+pprInstr (BCTR _) = hcat [
+	char '\t',
+	ptext SLIT("bctr")
+    ]
+pprInstr (BL imm _) = hcat [
+	char '\t',
+	ptext SLIT("bl"),
+	char '\t',
+	pprImm imm
+    ]
+pprInstr (BCTRL _) = hcat [
+	char '\t',
+	ptext SLIT("bctrl")
+    ]
+pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
+pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
+pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
+pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
+pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
+pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
+
+    	-- for some reason, "andi" doesn't exist.
+	-- we'll use "andi." instead.
+pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
+	char '\t',
+	ptext SLIT("andi."),
+	char '\t',
+	pprReg reg1,
+	ptext SLIT(", "),
+	pprReg reg2,
+	ptext SLIT(", "),
+	pprImm imm
+    ]
+pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 (toUI16 ri)
+
+pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 (toUI16 ri)
+pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 (toUI16 ri)
+
+pprInstr (XORIS reg1 reg2 imm) = hcat [
+	char '\t',
+	ptext SLIT("xoris"),
+	char '\t',
+	pprReg reg1,
+	ptext SLIT(", "),
+	pprReg reg2,
+	ptext SLIT(", "),
+	pprImm imm
+    ]
+
+pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 ri
+pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 ri
+pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 ri
+pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
+pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
+
+pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
+pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
+pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
+pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
+pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
+
+pprInstr (FCMP reg1 reg2) = hcat [
+	char '\t',
+	ptext SLIT("fcmpu\tcr0, "),
+	    -- Note: we're using fcmpu, not fcmpo
+	    -- The difference is with fcmpo, compare with NaN is an invalid operation.
+	    -- We don't handle invalid fp ops, so we don't care
+	pprReg reg1,
+	ptext SLIT(", "),
+	pprReg reg2
+    ]
+
+pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
+
+pprInstr _ = ptext SLIT("something")
+
+pprLogic op reg1 reg2 ri = hcat [
+	char '\t',
+	ptext op,
+	case ri of
+	    RIReg _ -> empty
+	    RIImm _ -> char 'i',
+	char '\t',
+	pprReg reg1,
+	ptext SLIT(", "),
+	pprReg reg2,
+	ptext SLIT(", "),
+	pprRI ri
+    ]
+    
+pprUnary op reg1 reg2 = hcat [
+	char '\t',
+	ptext op,
+	char '\t',
+	pprReg reg1,
+	ptext SLIT(", "),
+	pprReg reg2
+    ]
+    
+pprBinaryF op sz reg1 reg2 reg3 = hcat [
+	char '\t',
+	ptext op,
+	pprFSize sz,
+	char '\t',
+	pprReg reg1,
+	ptext SLIT(", "),
+	pprReg reg2,
+	ptext SLIT(", "),
+	pprReg reg3
+    ]
+    
+pprRI :: RI -> Doc
+pprRI (RIReg r) = pprReg r
+pprRI (RIImm r) = pprImm r
+
+pprFSize DF = empty
+pprFSize F = char 's'
+
+-- hack to ensure that negative vals come out in non-negative form
+-- (assuming that fromIntegral{Int->Word16} will do a 'c-style'
+-- conversion, and not throw a fit/exception.)
+toUI16 :: RI -> RI
+toUI16 (RIImm (ImmInt x)) 
+  | x < 0 = RIImm (ImmInt (fromIntegral ((fromIntegral x) :: Word16)))
+toUI16 (RIImm (ImmInteger x)) 
+  | x < 0 = RIImm (ImmInt (fromIntegral ((fromIntegral x) :: Word16)))
+toUI16 x = x
+
+{-
+  The Mach-O object file format used in Darwin/Mac OS X needs a so-called
+  "symbol stub" for every function that might be imported from a dynamic
+  library.
+  The stubs are always the same, and they are all output at the end of the
+  generated assembly (see AsmCodeGen.lhs), so we don't use the Instr datatype.
+  Instead, we just pretty-print it directly.
+-}
+
+#if darwin_TARGET_OS
+pprDyldSymbolStub fn =
+    vcat [
+	ptext SLIT(".symbol_stub"),
+	ptext SLIT("L_") <> ftext fn <> ptext SLIT("$stub:"),
+	    ptext SLIT("\t.indirect_symbol _") <> ftext fn,
+	    ptext SLIT("\tlis r11,ha16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
+	    ptext SLIT("\tlwz r12,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)(r11)"),
+	    ptext SLIT("\tmtctr r12"),
+	    ptext SLIT("\taddi r11,r11,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
+	    ptext SLIT("\tbctr"),
+	ptext SLIT(".lazy_symbol_pointer"),
+	ptext SLIT("L_") <> ftext fn <> ptext SLIT("$lazy_ptr:"),
+	    ptext SLIT("\t.indirect_symbol _") <> ftext fn,
+	    ptext SLIT("\t.long dyld_stub_binding_helper")
+    ]
+#endif
+
+
+#endif /* powerpc_TARGET_ARCH */
+\end{code}
+
+\begin{code}
+#if __GLASGOW_HASKELL__ >= 504
+newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
+newFloatArray = newArray_
+
+newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
+newDoubleArray = newArray_
+
+castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
+castFloatToCharArray = castSTUArray
+
+castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
+castDoubleToCharArray = castSTUArray
+
+writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
+writeFloatArray = writeArray
+
+writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
+writeDoubleArray = writeArray
+
+readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
+readCharArray arr i = do 
+  w <- readArray arr i
+  return $! (chr (fromIntegral w))
+
+#else
+
+castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
+castFloatToCharArray = return
+
+castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
+
+
+castDoubleToCharArray = return
+
+#endif
+
+-- floatToBytes and doubleToBytes convert to the host's byte
+-- order.  Providing that we're not cross-compiling for a 
+-- target with the opposite endianness, this should work ok
+-- on all targets.
+
+-- ToDo: this stuff is very similar to the shenanigans in PprAbs,
+-- could they be merged?
+
+floatToBytes :: Float -> [Int]
+floatToBytes f
+   = runST (do
+        arr <- newFloatArray ((0::Int),3)
+        writeFloatArray arr 0 f
+	arr <- castFloatToCharArray arr
+        i0 <- readCharArray arr 0
+        i1 <- readCharArray arr 1
+        i2 <- readCharArray arr 2
+        i3 <- readCharArray arr 3
+        return (map ord [i0,i1,i2,i3])
+     )
+
+doubleToBytes :: Double -> [Int]
+doubleToBytes d
+   = runST (do
+        arr <- newDoubleArray ((0::Int),7)
+        writeDoubleArray arr 0 d
+	arr <- castDoubleToCharArray arr
+        i0 <- readCharArray arr 0
+        i1 <- readCharArray arr 1
+        i2 <- readCharArray arr 2
+        i3 <- readCharArray arr 3
+        i4 <- readCharArray arr 4
+        i5 <- readCharArray arr 5
+        i6 <- readCharArray arr 6
+        i7 <- readCharArray arr 7
+        return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
+     )
 \end{code}