Rename literal constructors
[ghc.git] / compiler / nativeGen / PPC / Ppr.hs
index 99f9ab7..3d9077d 100644 (file)
@@ -7,18 +7,9 @@
 -----------------------------------------------------------------------------
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module PPC.Ppr (
-        pprNatCmmDecl,
-        pprBasicBlock,
-        pprSectionHeader,
-        pprData,
-        pprInstr,
-        pprFormat,
-        pprImm,
-        pprDataItem,
-)
-
-where
+module PPC.Ppr (pprNatCmmDecl) where
+
+import GhcPrelude
 
 import PPC.Regs
 import PPC.Instr
@@ -31,17 +22,20 @@ import RegClass
 import TargetReg
 
 import Cmm hiding (topInfoTable)
-import BlockId
+import Hoopl.Collections
+import Hoopl.Label
 
+import BlockId
 import CLabel
 
-import Unique                ( pprUnique, Uniquable(..) )
+import Unique                ( pprUniqueAlways, getUnique )
 import Platform
 import FastString
 import Outputable
 import DynFlags
 
 import Data.Word
+import Data.Int
 import Data.Bits
 
 -- -----------------------------------------------------------------------------
@@ -49,7 +43,7 @@ import Data.Bits
 
 pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
-  pprSectionHeader section $$ pprDatas dats
+  pprSectionAlign section $$ pprDatas dats
 
 pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
   case topInfoTable proc of
@@ -59,7 +53,7 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
          []     -> -- special case for split markers:
            pprLabel lbl
          blocks -> -- special case for code without info table:
-           pprSectionHeader Text $$
+           pprSectionAlign (Section Text lbl) $$
            (case platformArch platform of
               ArchPPC_64 ELF_V1 -> pprFunctionDescriptor lbl
               ArchPPC_64 ELF_V2 -> pprFunctionPrologue lbl
@@ -69,38 +63,35 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
 
     Just (Statics info_lbl _) ->
       sdocWithPlatform $ \platform ->
+      pprSectionAlign (Section Text info_lbl) $$
       (if platformHasSubsectionsViaSymbols platform
-          then pprSectionHeader Text $$
-               ppr (mkDeadStripPreventer info_lbl) <> char ':'
+          then ppr (mkDeadStripPreventer info_lbl) <> char ':'
           else empty) $$
       vcat (map (pprBasicBlock top_info) blocks) $$
-         -- above: Even the first block gets a label, because with branch-chain
-         -- elimination, it might be the target of a goto.
-            (if platformHasSubsectionsViaSymbols platform
-             then
-             -- See Note [Subsections Via Symbols]
-                      text "\t.long "
-                  <+> ppr info_lbl
-                  <+> char '-'
-                  <+> ppr (mkDeadStripPreventer info_lbl)
-             else empty)
-
+      -- above: Even the first block gets a label, because with branch-chain
+      -- elimination, it might be the target of a goto.
+      (if platformHasSubsectionsViaSymbols platform
+       then
+       -- See Note [Subsections Via Symbols] in X86/Ppr.hs
+                text "\t.long "
+            <+> ppr info_lbl
+            <+> char '-'
+            <+> ppr (mkDeadStripPreventer info_lbl)
+       else empty)
 
 pprFunctionDescriptor :: CLabel -> SDoc
 pprFunctionDescriptor lab = pprGloblDecl lab
-                        $$  text ".section \".opd\",\"aw\""
-                        $$  text ".align 3"
+                        $$  text "\t.section \".opd\", \"aw\""
+                        $$  text "\t.align 3"
                         $$  ppr lab <> char ':'
-                        $$  text ".quad ."
-                        <> ppr lab
-                        <> text ",.TOC.@tocbase,0"
-                        $$  text ".previous"
-                        $$  text ".type "
-                        <> ppr lab
-                        <> text ", @function"
-                        $$  char '.'
-                        <> ppr lab
-                        <> char ':'
+                        $$  text "\t.quad ."
+                        <>  ppr lab
+                        <>  text ",.TOC.@tocbase,0"
+                        $$  text "\t.previous"
+                        $$  text "\t.type"
+                        <+> ppr lab
+                        <>  text ", @function"
+                        $$  char '.' <> ppr lab <> char ':'
 
 pprFunctionPrologue :: CLabel ->SDoc
 pprFunctionPrologue lab =  pprGloblDecl lab
@@ -115,16 +106,16 @@ pprFunctionPrologue lab =  pprGloblDecl lab
                         $$ text "\t.localentry\t" <> ppr lab
                         <> text ",.-" <> ppr lab
 
-pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
+pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
   = maybe_infotable $$
-    pprLabel (mkAsmTempLabel (getUnique blockid)) $$
+    pprLabel (blockLbl blockid) $$
     vcat (map pprInstr instrs)
   where
     maybe_infotable = case mapLookup blockid info_env of
        Nothing   -> empty
        Just (Statics info_lbl info) ->
-           pprSectionHeader Text $$
+           pprAlignForSection Text $$
            vcat (map pprData info) $$
            pprLabel info_lbl
 
@@ -138,21 +129,22 @@ pprData (CmmString str)          = pprASCII str
 pprData (CmmUninitialised bytes) = keyword <> int bytes
     where keyword = sdocWithPlatform $ \platform ->
                     case platformOS platform of
-                    OSDarwin -> ptext (sLit ".space ")
-                    _        -> ptext (sLit ".skip ")
+                    OSDarwin -> text ".space "
+                    OSAIX    -> text ".space "
+                    _        -> text ".skip "
 pprData (CmmStaticLit lit)       = pprDataItem lit
 
 pprGloblDecl :: CLabel -> SDoc
 pprGloblDecl lbl
   | not (externallyVisibleCLabel lbl) = empty
-  | otherwise = ptext (sLit ".globl ") <> ppr lbl
+  | otherwise = text ".globl " <> ppr lbl
 
 pprTypeAndSizeDecl :: CLabel -> SDoc
 pprTypeAndSizeDecl lbl
   = sdocWithPlatform $ \platform ->
     if platformOS platform == OSLinux && externallyVisibleCLabel lbl
-    then ptext (sLit ".type ") <>
-         ppr lbl <> ptext (sLit ", @object")
+    then text ".type " <>
+         ppr lbl <> text ", @object"
     else empty
 
 pprLabel :: CLabel -> SDoc
@@ -166,7 +158,7 @@ pprASCII str
   = vcat (map do1 str) $$ do1 0
     where
        do1 :: Word8 -> SDoc
-       do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
+       do1 w = text "\t.byte\t" <> int (fromIntegral w)
 
 
 -- -----------------------------------------------------------------------------
@@ -182,11 +174,11 @@ pprReg r
   = case r of
       RegReal    (RealRegSingle i) -> ppr_reg_no i
       RegReal    (RealRegPair{})   -> panic "PPC.pprReg: no reg pairs on this arch"
-      RegVirtual (VirtualRegI  u)  -> text "%vI_" <> pprUnique u
-      RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> pprUnique u
-      RegVirtual (VirtualRegF  u)  -> text "%vF_" <> pprUnique u
-      RegVirtual (VirtualRegD  u)  -> text "%vD_" <> pprUnique u
-      RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> pprUnique u
+      RegVirtual (VirtualRegI  u)  -> text "%vI_"   <> pprUniqueAlways u
+      RegVirtual (VirtualRegHi u)  -> text "%vHi_"  <> pprUniqueAlways u
+      RegVirtual (VirtualRegF  u)  -> text "%vF_"   <> pprUniqueAlways u
+      RegVirtual (VirtualRegD  u)  -> text "%vD_"   <> pprUniqueAlways u
+      RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> pprUniqueAlways u
   where
     ppr_reg_no :: Int -> SDoc
     ppr_reg_no i =
@@ -232,27 +224,27 @@ pprReg r
         _
          | i <= 31   -> int i      -- GPRs
          | i <= 63   -> int (i-32) -- FPRs
-         | otherwise -> ptext (sLit "very naughty powerpc register")
+         | otherwise -> text "very naughty powerpc register"
 
 
 
 pprFormat :: Format -> SDoc
 pprFormat x
  = ptext (case x of
-                II8        -> sLit "b"
-                II16        -> sLit "h"
-                II32        -> sLit "w"
-                II64        -> sLit "d"
-                FF32        -> sLit "fs"
-                FF64        -> sLit "fd"
-                _        -> panic "PPC.Ppr.pprFormat: no match")
+                II8  -> sLit "b"
+                II16 -> sLit "h"
+                II32 -> sLit "w"
+                II64 -> sLit "d"
+                FF32 -> sLit "fs"
+                FF64 -> sLit "fd"
+                _    -> panic "PPC.Ppr.pprFormat: no match")
 
 
 pprCond :: Cond -> SDoc
 pprCond c
  = ptext (case c of {
                 ALWAYS  -> sLit "";
-                EQQ        -> sLit "eq";        NE    -> sLit "ne";
+                EQQ     -> sLit "eq";  NE    -> sLit "ne";
                 LTT     -> sLit "lt";  GE    -> sLit "ge";
                 GTT     -> sLit "gt";  LE    -> sLit "le";
                 LU      -> sLit "lt";  GEU   -> sLit "ge";
@@ -267,13 +259,18 @@ pprImm (ImmCLbl l)    = ppr l
 pprImm (ImmIndex l i) = ppr l <> char '+' <> int i
 pprImm (ImmLit s)     = s
 
-pprImm (ImmFloat _)  = ptext (sLit "naughty float immediate")
-pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
+pprImm (ImmFloat _)  = text "naughty float immediate"
+pprImm (ImmDouble _) = text "naughty double immediate"
 
 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
                    <> lparen <> pprImm b <> rparen
 
+pprImm (LO (ImmInt i))     = pprImm (LO (ImmInteger (toInteger i)))
+pprImm (LO (ImmInteger i)) = pprImm (ImmInteger (toInteger lo16))
+  where
+    lo16 = fromInteger (i .&. 0xffff) :: Int16
+
 pprImm (LO i)
   = sdocWithPlatform $ \platform ->
     if platformOS platform == OSDarwin
@@ -286,6 +283,13 @@ pprImm (HI i)
     then hcat [ text "hi16(", pprImm i, rparen ]
     else pprImm i <> text "@h"
 
+pprImm (HA (ImmInt i))     = pprImm (HA (ImmInteger (toInteger i)))
+pprImm (HA (ImmInteger i)) = pprImm (ImmInteger ha16)
+  where
+    ha16 = if lo16 >= 0x8000 then hi16+1 else hi16
+    hi16 = (i `shiftR` 16)
+    lo16 = i .&. 0xffff
+
 pprImm (HA i)
   = sdocWithPlatform $ \platform ->
     if platformOS platform == OSDarwin
@@ -307,42 +311,54 @@ pprImm (HIGHESTA i)
 
 pprAddr :: AddrMode -> SDoc
 pprAddr (AddrRegReg r1 r2)
-  = pprReg r1 <+> ptext (sLit ", ") <+> pprReg r2
+  = pprReg r1 <> char ',' <+> pprReg r2
+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 ')' ]
 
-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 ')' ]
 
+pprSectionAlign :: Section -> SDoc
+pprSectionAlign sec@(Section seg _) =
+ sdocWithPlatform $ \platform ->
+   pprSectionHeader platform sec $$
+   pprAlignForSection seg
 
-pprSectionHeader :: Section -> SDoc
-pprSectionHeader seg =
+-- | Print appropriate alignment for the given section type.
+pprAlignForSection :: SectionType -> SDoc
+pprAlignForSection seg =
  sdocWithPlatform $ \platform ->
  let osDarwin = platformOS platform == OSDarwin
      ppc64    = not $ target32Bit platform
- in
- case seg of
-  Text              -> text ".text\n\t.align 2"
-  Data
-   | ppc64          -> text ".data\n.align 3"
-   | otherwise      -> text ".data\n.align 2"
-  ReadOnlyData
-   | osDarwin       -> text ".const\n\t.align 2"
-   | ppc64          -> text ".section .rodata\n\t.align 3"
-   | otherwise      -> text ".section .rodata\n\t.align 2"
-  RelocatableReadOnlyData
-   | osDarwin       -> text ".const_data\n\t.align 2"
-   | ppc64          -> text ".data\n\t.align 3"
-   | otherwise      -> text ".data\n\t.align 2"
-  UninitialisedData
-   | osDarwin       -> text ".const_data\n\t.align 2"
-   | ppc64          -> text ".section .bss\n\t.align 3"
-   | otherwise      -> text ".section .bss\n\t.align 2"
-  ReadOnlyData16
-   | osDarwin       -> text ".const\n\t.align 4"
-   | otherwise      -> text ".section .rodata\n\t.align 4"
-  OtherSection _ ->
-      panic "PprMach.pprSectionHeader: unknown section"
-
+ in ptext $ case seg of
+       Text              -> sLit ".align 2"
+       Data
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       ReadOnlyData
+        | osDarwin       -> sLit ".align 2"
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       RelocatableReadOnlyData
+        | osDarwin       -> sLit ".align 2"
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       UninitialisedData
+        | osDarwin       -> sLit ".align 2"
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       ReadOnlyData16
+        | osDarwin       -> sLit ".align 4"
+        | otherwise      -> sLit ".align 4"
+       -- TODO: This is copied from the ReadOnlyData case, but it can likely be
+       -- made more efficient.
+       CString
+        | osDarwin       -> sLit ".align 2"
+        | ppc64          -> sLit ".align 3"
+        | otherwise      -> sLit ".align 2"
+       OtherSection _    -> panic "PprMach.pprSectionAlign: unknown section"
 
 pprDataItem :: CmmLit -> SDoc
 pprDataItem lit
@@ -352,30 +368,30 @@ pprDataItem lit
         imm = litToImm lit
         archPPC_64 dflags = not $ target32Bit $ targetPlatform dflags
 
-        ppr_item II8   _ _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
+        ppr_item II8   _ _ = [text "\t.byte\t" <> pprImm imm]
 
-        ppr_item II32  _ _ = [ptext (sLit "\t.long\t") <> pprImm imm]
+        ppr_item II32  _ _ = [text "\t.long\t" <> pprImm imm]
 
         ppr_item II64 _ dflags
-           | archPPC_64 dflags = [ptext (sLit "\t.quad\t") <> pprImm imm]
+           | archPPC_64 dflags = [text "\t.quad\t" <> pprImm imm]
 
 
         ppr_item FF32 (CmmFloat r _) _
            = let bs = floatToBytes (fromRational r)
-             in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
+             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 
         ppr_item FF64 (CmmFloat r _) _
            = let bs = doubleToBytes (fromRational r)
-             in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
+             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
 
-        ppr_item II16 _ _      = [ptext (sLit "\t.short\t") <> pprImm imm]
+        ppr_item II16 _ _      = [text "\t.short\t" <> pprImm imm]
 
         ppr_item II64 (CmmInt x _) dflags
            | not(archPPC_64 dflags) =
-                [ptext (sLit "\t.long\t")
+                [text "\t.long\t"
                     <> int (fromIntegral
                         (fromIntegral (x `shiftR` 32) :: Word32)),
-                 ptext (sLit "\t.long\t")
+                 text "\t.long\t"
                     <> int (fromIntegral (fromIntegral x :: Word32))]
 
         ppr_item _ _ _
@@ -388,8 +404,8 @@ pprInstr (COMMENT _) = empty -- nuke 'em
 {-
 pprInstr (COMMENT s) =
      if platformOS platform == OSLinux
-     then ptext (sLit "# ") <> ftext s
-     else ptext (sLit "; ") <> ftext s
+     then text "# " <> ftext s
+     else text "; " <> ftext s
 -}
 pprInstr (DELTA d)
    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
@@ -403,24 +419,24 @@ pprInstr (LDATA _ _)
 {-
 pprInstr (SPILL reg slot)
    = hcat [
-           ptext (sLit "\tSPILL"),
+           text "\tSPILL",
         char '\t',
         pprReg reg,
         comma,
-        ptext (sLit "SLOT") <> parens (int slot)]
+        text "SLOT" <> parens (int slot)]
 
 pprInstr (RELOAD slot reg)
    = hcat [
-           ptext (sLit "\tRELOAD"),
+           text "\tRELOAD",
         char '\t',
-        ptext (sLit "SLOT") <> parens (int slot),
+        text "SLOT" <> parens (int slot),
         comma,
         pprReg reg]
 -}
 
 pprInstr (LD fmt reg addr) = hcat [
         char '\t',
-        ptext (sLit "l"),
+        text "l",
         ptext (case fmt of
             II8  -> sLit "bz"
             II16 -> sLit "hz"
@@ -434,21 +450,33 @@ pprInstr (LD fmt reg addr) = hcat [
                      AddrRegReg _ _ -> char 'x',
         char '\t',
         pprReg reg,
-        ptext (sLit ", "),
+        text ", ",
         pprAddr addr
     ]
+
 pprInstr (LDFAR fmt reg (AddrRegImm source off)) =
    sdocWithPlatform $ \platform -> vcat [
          pprInstr (ADDIS (tmpReg platform) source (HA off)),
          pprInstr (LD fmt reg (AddrRegImm (tmpReg platform) (LO off)))
     ]
-
 pprInstr (LDFAR _ _ _) =
    panic "PPC.Ppr.pprInstr LDFAR: no match"
 
+pprInstr (LDR fmt reg1 addr) = hcat [
+  text "\tl",
+  case fmt of
+    II32 -> char 'w'
+    II64 -> char 'd'
+    _    -> panic "PPC.Ppr.Instr LDR: no match",
+  text "arx\t",
+  pprReg reg1,
+  text ", ",
+  pprAddr addr
+  ]
+
 pprInstr (LA fmt reg addr) = hcat [
         char '\t',
-        ptext (sLit "l"),
+        text "l",
         ptext (case fmt of
             II8  -> sLit "ba"
             II16 -> sLit "ha"
@@ -462,18 +490,18 @@ pprInstr (LA fmt reg addr) = hcat [
                      AddrRegReg _ _ -> char 'x',
         char '\t',
         pprReg reg,
-        ptext (sLit ", "),
+        text ", ",
         pprAddr addr
     ]
 pprInstr (ST fmt reg addr) = hcat [
         char '\t',
-        ptext (sLit "st"),
+        text "st",
         pprFormat fmt,
         case addr of AddrRegImm _ _ -> empty
                      AddrRegReg _ _ -> char 'x',
         char '\t',
         pprReg reg,
-        ptext (sLit ", "),
+        text ", ",
         pprAddr addr
     ]
 pprInstr (STFAR fmt reg (AddrRegImm source off)) =
@@ -481,34 +509,45 @@ pprInstr (STFAR fmt reg (AddrRegImm source off)) =
          pprInstr (ADDIS (tmpReg platform) source (HA off)),
          pprInstr (ST fmt reg (AddrRegImm (tmpReg platform) (LO off)))
     ]
-
 pprInstr (STFAR _ _ _) =
    panic "PPC.Ppr.pprInstr STFAR: no match"
 pprInstr (STU fmt reg addr) = hcat [
         char '\t',
-        ptext (sLit "st"),
+        text "st",
         pprFormat fmt,
-        ptext (sLit "u\t"),
+        char 'u',
         case addr of AddrRegImm _ _ -> empty
                      AddrRegReg _ _ -> char 'x',
+        char '\t',
         pprReg reg,
-        ptext (sLit ", "),
+        text ", ",
         pprAddr addr
     ]
+pprInstr (STC fmt reg1 addr) = hcat [
+  text "\tst",
+  case fmt of
+    II32 -> char 'w'
+    II64 -> char 'd'
+    _    -> panic "PPC.Ppr.Instr STC: no match",
+  text "cx.\t",
+  pprReg reg1,
+  text ", ",
+  pprAddr addr
+  ]
 pprInstr (LIS reg imm) = hcat [
         char '\t',
-        ptext (sLit "lis"),
+        text "lis",
         char '\t',
         pprReg reg,
-        ptext (sLit ", "),
+        text ", ",
         pprImm imm
     ]
 pprInstr (LI reg imm) = hcat [
         char '\t',
-        ptext (sLit "li"),
+        text "li",
         char '\t',
         pprReg reg,
-        ptext (sLit ", "),
+        text ", ",
         pprImm imm
     ]
 pprInstr (MR reg1 reg2)
@@ -517,11 +556,11 @@ pprInstr (MR reg1 reg2)
         char '\t',
         sdocWithPlatform $ \platform ->
         case targetClassOfReg platform reg1 of
-            RcInteger -> ptext (sLit "mr")
-            _ -> ptext (sLit "fmr"),
+            RcInteger -> text "mr"
+            _ -> text "fmr",
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2
     ]
 pprInstr (CMP fmt reg ri) = hcat [
@@ -529,12 +568,12 @@ pprInstr (CMP fmt reg ri) = hcat [
         op,
         char '\t',
         pprReg reg,
-        ptext (sLit ", "),
+        text ", ",
         pprRI ri
     ]
     where
         op = hcat [
-                ptext (sLit "cmp"),
+                text "cmp",
                 pprFormat fmt,
                 case ri of
                     RIReg _ -> empty
@@ -545,165 +584,245 @@ pprInstr (CMPL fmt reg ri) = hcat [
         op,
         char '\t',
         pprReg reg,
-        ptext (sLit ", "),
+        text ", ",
         pprRI ri
     ]
     where
         op = hcat [
-                ptext (sLit "cmpl"),
+                text "cmpl",
                 pprFormat fmt,
                 case ri of
                     RIReg _ -> empty
                     RIImm _ -> char 'i'
             ]
-pprInstr (BCC cond blockid) = hcat [
+pprInstr (BCC cond blockid prediction) = hcat [
         char '\t',
-        ptext (sLit "b"),
+        text "b",
         pprCond cond,
+        pprPrediction prediction,
         char '\t',
         ppr lbl
     ]
-    where lbl = mkAsmTempLabel (getUnique blockid)
+    where lbl = mkLocalBlockLabel (getUnique blockid)
+          pprPrediction p = case p of
+            Nothing    -> empty
+            Just True  -> char '+'
+            Just False -> char '-'
 
-pprInstr (BCCFAR cond blockid) = vcat [
+pprInstr (BCCFAR cond blockid prediction) = vcat [
         hcat [
-            ptext (sLit "\tb"),
+            text "\tb",
             pprCond (condNegate cond),
-            ptext (sLit "\t$+8")
+            neg_prediction,
+            text "\t$+8"
         ],
         hcat [
-            ptext (sLit "\tb\t"),
+            text "\tb\t",
             ppr lbl
         ]
     ]
-    where lbl = mkAsmTempLabel (getUnique blockid)
-
-pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
+    where lbl = mkLocalBlockLabel (getUnique blockid)
+          neg_prediction = case prediction of
+            Nothing    -> empty
+            Just True  -> char '-'
+            Just False -> char '+'
+
+pprInstr (JMP lbl)
+  -- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"
+  | isForeignLabel lbl = panic "PPC.Ppr.pprInstr: JMP to ForeignLabel"
+  | otherwise =
+    hcat [ -- an alias for b that takes a CLabel
         char '\t',
-        ptext (sLit "b"),
+        text "b",
         char '\t',
         ppr lbl
     ]
 
 pprInstr (MTCTR reg) = hcat [
         char '\t',
-        ptext (sLit "mtctr"),
+        text "mtctr",
         char '\t',
         pprReg reg
     ]
 pprInstr (BCTR _ _) = hcat [
         char '\t',
-        ptext (sLit "bctr")
-    ]
-pprInstr (BL lbl _) = hcat [
-        ptext (sLit "\tbl\t"),
-        ppr lbl
+        text "bctr"
     ]
+pprInstr (BL lbl _) = do
+    sdocWithPlatform $ \platform -> case platformOS platform of
+        OSAIX ->
+          -- On AIX, "printf" denotes a function-descriptor (for use
+          -- by function pointers), whereas the actual entry-code
+          -- address is denoted by the dot-prefixed ".printf" label.
+          -- Moreover, the PPC NCG only ever emits a BL instruction
+          -- for calling C ABI functions. Most of the time these calls
+          -- originate from FFI imports and have a 'ForeignLabel',
+          -- but when profiling the codegen inserts calls via
+          -- 'emitRtsCallGen' which are 'CmmLabel's even though
+          -- they'd technically be more like 'ForeignLabel's.
+          hcat [
+            text "\tbl\t.",
+            ppr lbl
+          ]
+        _ ->
+          hcat [
+            text "\tbl\t",
+            ppr lbl
+          ]
 pprInstr (BCTRL _) = hcat [
         char '\t',
-        ptext (sLit "bctrl")
+        text "bctrl"
     ]
 pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
-pprInstr (ADDI reg1 reg2 imm) = hcat [
-        char '\t',
-        ptext (sLit "addi"),
-        char '\t',
-        pprReg reg1,
-        ptext (sLit ", "),
-        pprReg reg2,
-        ptext (sLit ", "),
-        pprImm imm
-    ]
 pprInstr (ADDIS reg1 reg2 imm) = hcat [
         char '\t',
-        ptext (sLit "addis"),
+        text "addis",
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2,
-        ptext (sLit ", "),
+        text ", ",
         pprImm imm
     ]
 
+pprInstr (ADDO reg1 reg2 reg3) = pprLogic (sLit "addo") reg1 reg2 (RIReg reg3)
 pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
 pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
+pprInstr (ADDZE reg1 reg2) = pprUnary (sLit "addze") reg1 reg2
 pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
-pprInstr (SUBFC reg1 reg2 reg3) = pprLogic (sLit "subfc") reg1 reg2 (RIReg reg3)
+pprInstr (SUBFO reg1 reg2 reg3) = pprLogic (sLit "subfo") reg1 reg2 (RIReg reg3)
+pprInstr (SUBFC reg1 reg2 ri) = hcat [
+        char '\t',
+        text "subf",
+        case ri of
+            RIReg _ -> empty
+            RIImm _ -> char 'i',
+        text "c\t",
+        pprReg reg1,
+        text ", ",
+        pprReg reg2,
+        text ", ",
+        pprRI ri
+    ]
 pprInstr (SUBFE reg1 reg2 reg3) = pprLogic (sLit "subfe") reg1 reg2 (RIReg reg3)
-pprInstr (MULLD reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mulld") reg1 reg2 ri
-pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
-pprInstr (MULLD reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") 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 (DIVD reg1 reg2 reg3) = pprLogic (sLit "divd") reg1 reg2 (RIReg reg3)
-pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
-pprInstr (DIVDU reg1 reg2 reg3) = pprLogic (sLit "divdu") reg1 reg2 (RIReg reg3)
-
-pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
-         hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
-                                          pprReg reg2, ptext (sLit ", "),
-                                          pprReg reg3 ],
-         hcat [ ptext (sLit "\tmfxer\t"),  pprReg reg1 ],
-         hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
-                                          pprReg reg1, ptext (sLit ", "),
-                                          ptext (sLit "2, 31, 31") ]
-    ]
-pprInstr (MULLD_MayOflo reg1 reg2 reg3) = vcat [
-         hcat [ ptext (sLit "\tmulldo\t"), pprReg reg1, ptext (sLit ", "),
-                                          pprReg reg2, ptext (sLit ", "),
-                                          pprReg reg3 ],
-         hcat [ ptext (sLit "\tmfxer\t"),  pprReg reg1 ],
-         hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
-                                          pprReg reg1, ptext (sLit ", "),
-                                          ptext (sLit "2, 31, 31") ]
+pprInstr (MULL fmt reg1 reg2 ri) = pprMul fmt reg1 reg2 ri
+pprInstr (MULLO fmt reg1 reg2 reg3) = hcat [
+        char '\t',
+        text "mull",
+        case fmt of
+          II32 -> char 'w'
+          II64 -> char 'd'
+          _    -> panic "PPC: illegal format",
+        text "o\t",
+        pprReg reg1,
+        text ", ",
+        pprReg reg2,
+        text ", ",
+        pprReg reg3
+    ]
+pprInstr (MFOV fmt reg) = vcat [
+        hcat [
+            char '\t',
+            text "mfxer",
+            char '\t',
+            pprReg reg
+            ],
+        hcat [
+            char '\t',
+            text "extr",
+            case fmt of
+              II32 -> char 'w'
+              II64 -> char 'd'
+              _    -> panic "PPC: illegal format",
+            text "i\t",
+            pprReg reg,
+            text ", ",
+            pprReg reg,
+            text ", 1, ",
+            case fmt of
+              II32 -> text "1"
+              II64 -> text "33"
+              _    -> panic "PPC: illegal format"
+            ]
+        ]
+
+pprInstr (MULHU fmt reg1 reg2 reg3) = hcat [
+        char '\t',
+        text "mulh",
+        case fmt of
+          II32 -> char 'w'
+          II64 -> char 'd'
+          _    -> panic "PPC: illegal format",
+        text "u\t",
+        pprReg reg1,
+        text ", ",
+        pprReg reg2,
+        text ", ",
+        pprReg reg3
     ]
 
+pprInstr (DIV fmt sgn reg1 reg2 reg3) = pprDiv fmt sgn reg1 reg2 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."),
+        text "andi.",
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2,
-        ptext (sLit ", "),
+        text ", ",
         pprImm imm
     ]
 pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
+pprInstr (ANDC reg1 reg2 reg3) = pprLogic (sLit "andc") reg1 reg2 (RIReg reg3)
+pprInstr (NAND reg1 reg2 reg3) = pprLogic (sLit "nand") reg1 reg2 (RIReg reg3)
 
 pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
 pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
 
 pprInstr (ORIS reg1 reg2 imm) = hcat [
         char '\t',
-        ptext (sLit "oris"),
+        text "oris",
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2,
-        ptext (sLit ", "),
+        text ", ",
         pprImm imm
     ]
 
 pprInstr (XORIS reg1 reg2 imm) = hcat [
         char '\t',
-        ptext (sLit "xoris"),
+        text "xoris",
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2,
-        ptext (sLit ", "),
+        text ", ",
         pprImm imm
     ]
 
 pprInstr (EXTS fmt reg1 reg2) = hcat [
         char '\t',
-        ptext (sLit "exts"),
+        text "exts",
         pprFormat fmt,
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
+        pprReg reg2
+    ]
+pprInstr (CNTLZ fmt reg1 reg2) = hcat [
+        char '\t',
+        text "cntlz",
+        case fmt of
+          II32 -> char 'w'
+          II64 -> char 'd'
+          _    -> panic "PPC: illegal format",
+        char '\t',
+        pprReg reg1,
+        text ", ",
         pprReg reg2
     ]
 
@@ -752,32 +871,58 @@ pprInstr (SRA fmt reg1 reg2 ri) =
          in pprLogic (sLit op) reg1 reg2 (limitShiftRI fmt ri)
 
 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
-        ptext (sLit "\trlwinm\t"),
+        text "\trlwinm\t",
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2,
-        ptext (sLit ", "),
+        text ", ",
         int sh,
-        ptext (sLit ", "),
+        text ", ",
         int mb,
-        ptext (sLit ", "),
+        text ", ",
         int me
     ]
 
+pprInstr (CLRLI fmt reg1 reg2 n) = hcat [
+        text "\tclrl",
+        pprFormat fmt,
+        text "i ",
+        pprReg reg1,
+        text ", ",
+        pprReg reg2,
+        text ", ",
+        int n
+    ]
+pprInstr (CLRRI fmt reg1 reg2 n) = hcat [
+        text "\tclrr",
+        pprFormat fmt,
+        text "i ",
+        pprReg reg1,
+        text ", ",
+        pprReg reg2,
+        text ", ",
+        int n
+    ]
+
 pprInstr (FADD fmt reg1 reg2 reg3) = pprBinaryF (sLit "fadd") fmt reg1 reg2 reg3
 pprInstr (FSUB fmt reg1 reg2 reg3) = pprBinaryF (sLit "fsub") fmt reg1 reg2 reg3
 pprInstr (FMUL fmt reg1 reg2 reg3) = pprBinaryF (sLit "fmul") fmt reg1 reg2 reg3
 pprInstr (FDIV fmt reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") fmt reg1 reg2 reg3
+pprInstr (FABS reg1 reg2) = pprUnary (sLit "fabs") reg1 reg2
 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
 
 pprInstr (FCMP reg1 reg2) = hcat [
         char '\t',
-        ptext (sLit "fcmpu\tcr0, "),
+        text "fcmpu\t0, ",
             -- 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
+            -- We don't handle invalid fp ops, so we don't care.
+            -- Morever, we use `fcmpu 0, ...` rather than `fcmpu cr0, ...` for
+            -- better portability since some non-GNU assembler (such as
+            -- IBM's `as`) tend not to support the symbolic register name cr0.
+            -- This matches the syntax that GCC seems to emit for PPC targets.
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2
     ]
 
@@ -787,48 +932,40 @@ pprInstr (FCFID reg1 reg2) = pprUnary (sLit "fcfid") reg1 reg2
 pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
 
 pprInstr (CRNOR dst src1 src2) = hcat [
-        ptext (sLit "\tcrnor\t"),
+        text "\tcrnor\t",
         int dst,
-        ptext (sLit ", "),
+        text ", ",
         int src1,
-        ptext (sLit ", "),
+        text ", ",
         int src2
     ]
 
 pprInstr (MFCR reg) = hcat [
         char '\t',
-        ptext (sLit "mfcr"),
+        text "mfcr",
         char '\t',
         pprReg reg
     ]
 
 pprInstr (MFLR reg) = hcat [
         char '\t',
-        ptext (sLit "mflr"),
+        text "mflr",
         char '\t',
         pprReg reg
     ]
 
 pprInstr (FETCHPC reg) = vcat [
-        ptext (sLit "\tbcl\t20,31,1f"),
-        hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
+        text "\tbcl\t20,31,1f",
+        hcat [ text "1:\tmflr\t", pprReg reg ]
     ]
 
-pprInstr (FETCHTOC reg lab) = vcat [
-        hcat [ ptext (sLit "0:\taddis\t"), pprReg reg,
-               ptext (sLit ",12,.TOC.-0b@ha") ],
-        hcat [ ptext (sLit "\taddi\t"), pprReg reg,
-               char ',', pprReg reg,
-               ptext (sLit ",.TOC.-0b@l") ],
-        hcat [ ptext (sLit "\t.localentry\t"),
-               ppr lab,
-               ptext (sLit ",.-"),
-               ppr lab]
-    ]
+pprInstr HWSYNC = text "\tsync"
+
+pprInstr ISYNC  = text "\tisync"
 
-pprInstr LWSYNC = ptext (sLit "\tlwsync")
+pprInstr LWSYNC = text "\tlwsync"
 
-pprInstr NOP = ptext (sLit "\tnop")
+pprInstr NOP = text "\tnop"
 
 pprInstr (UPDATE_SP fmt amount@(ImmInt offset))
    | fits16Bits offset = vcat [
@@ -849,7 +986,7 @@ pprInstr (UPDATE_SP fmt amount)
 -- pprInstr _ = panic "pprInstr (ppc)"
 
 
-pprLogic :: LitString -> Reg -> Reg -> RI -> SDoc
+pprLogic :: PtrString -> Reg -> Reg -> RI -> SDoc
 pprLogic op reg1 reg2 ri = hcat [
         char '\t',
         ptext op,
@@ -858,34 +995,71 @@ pprLogic op reg1 reg2 ri = hcat [
             RIImm _ -> char 'i',
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
+        pprReg reg2,
+        text ", ",
+        pprRI ri
+    ]
+
+
+pprMul :: Format -> Reg -> Reg -> RI -> SDoc
+pprMul fmt reg1 reg2 ri = hcat [
+        char '\t',
+        text "mull",
+        case ri of
+            RIReg _ -> case fmt of
+              II32 -> char 'w'
+              II64 -> char 'd'
+              _    -> panic "PPC: illegal format"
+            RIImm _ -> char 'i',
+        char '\t',
+        pprReg reg1,
+        text ", ",
         pprReg reg2,
-        ptext (sLit ", "),
+        text ", ",
         pprRI ri
     ]
 
 
-pprUnary :: LitString -> Reg -> Reg -> SDoc
+pprDiv :: Format -> Bool -> Reg -> Reg -> Reg -> SDoc
+pprDiv fmt sgn reg1 reg2 reg3 = hcat [
+        char '\t',
+        text "div",
+        case fmt of
+          II32 -> char 'w'
+          II64 -> char 'd'
+          _    -> panic "PPC: illegal format",
+        if sgn then empty else char 'u',
+        char '\t',
+        pprReg reg1,
+        text ", ",
+        pprReg reg2,
+        text ", ",
+        pprReg reg3
+    ]
+
+
+pprUnary :: PtrString -> Reg -> Reg -> SDoc
 pprUnary op reg1 reg2 = hcat [
         char '\t',
         ptext op,
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2
     ]
 
 
-pprBinaryF :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc
+pprBinaryF :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
 pprBinaryF op fmt reg1 reg2 reg3 = hcat [
         char '\t',
         ptext op,
         pprFFormat fmt,
         char '\t',
         pprReg reg1,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg2,
-        ptext (sLit ", "),
+        text ", ",
         pprReg reg3
     ]
 
@@ -907,4 +1081,3 @@ limitShiftRI II64 (RIImm (ImmInt i)) | i > 63 || i < 0 =
 limitShiftRI II32 (RIImm (ImmInt i)) | i > 31 || i < 0 =
   panic $ "PPC.Ppr: 32 bit: Shift by " ++ show i ++ " bits is not allowed."
 limitShiftRI _ x = x
-