Add NCG support for AIX/ppc32

This extends the previous work to revive the unregisterised GHC build
for AIX/ppc32. Strictly speaking, AIX runs on POWER4 (and later)
hardware, but the PPC32 instructions implemented in the PPC NCG
represent a compatible subset of the POWER4 ISA.

IBM AIX follows the PowerOpen ABI (and shares many similiarites with the
Linux PPC64 ELF V1 NCG backend) but uses the rather limited XCOFF
format (compared to ELF).

This doesn't support dynamic libraries yet.

A major limiting factor is that the AIX assembler does not support the
`@ha`/`@l` relocation types nor the ha16()/lo16() functions Darwin's
assembler supports. Therefore we need to avoid emitting those. In case
of numeric literals we simply compute the functions ourselves, while for
labels we have to use local TOCs and hope everything fits into a 16bit
offset (for ppc32 this gives us at most 16384 entries per TOC section,
which is enough to compile GHC).

Another issue is that XCOFF doesn't seem to have a relocation type for
label-differences, and therefore the label-differences placed into
tables-next-to-code can't be relocated, but the linker may rearrange
different sections, so we need to place all read-only sections into the
same `.text[PR]` section to workaround this.

Finally, the PowerOpen ABI distinguishes between function-descriptors
and actualy entry-point addresses. For AIX we need to be specific when
emitting assembler code whether we want the address of the function
descriptor `printf`) or for the entry-point (`.printf`). So we let the
asm pretty-printer prefix a dot to all emitted subroutine
calls (i.e. `BL`) on AIX only. For now, STG routines' entry-point labels
are not prefixed by a label and don't have any associated
function-descriptor.

Reviewers: austin, trommler, erikd, bgamari

Reviewed By: trommler, erikd, bgamari

Differential Revision: https://phabricator.haskell.org/D2019

7 files changed, 214 insertions, 28 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 15c5ff3481..bb5be5d04b 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -1167,10 +1167,10 @@ underscorePrefix :: Bool   -- leading underscore on assembler labels?
 underscorePrefix = (cLeadingUnderscore == "YES")
 
 asmTempLabelPrefix :: Platform -> LitString  -- for formatting labels
-asmTempLabelPrefix platform =
-    if platformOS platform == OSDarwin
-    then sLit "L"
-    else sLit ".L"
+asmTempLabelPrefix platform = case platformOS platform of
+    OSDarwin -> sLit "L"
+    OSAIX    -> sLit "__L" -- follow IBM XL C's convention
+    _        -> sLit ".L"
 
 pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
 pprDynamicLinkerAsmLabel platform dllInfo lbl
@@ -1186,6 +1186,11 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl
              SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
              _         -> panic "pprDynamicLinkerAsmLabel"
 
+   else if platformOS platform == OSAIX
+        then case dllInfo of
+             SymbolPtr -> text "LC.." <> ppr lbl -- GCC's naming convention
+             _         -> panic "pprDynamicLinkerAsmLabel"
+
    else if osElfTarget (platformOS platform)
         then if platformArch platform == ArchPPC
              then case dllInfo of
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index c11a36c7a3..d3cd2a5ffc 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -379,20 +379,6 @@ compiler/stage1/build/Parser_HC_OPTS += -O0 -fno-ignore-interface-pragmas -fcmm-
 compiler/stage2/build/Parser_HC_OPTS += -O0 -fno-ignore-interface-pragmas -fcmm-sink
 compiler/stage3/build/Parser_HC_OPTS += -O0 -fno-ignore-interface-pragmas -fcmm-sink
 
-# On IBM AIX we need to wrokaround XCOFF's TOC limitations (see also
-# comment in `aclocal.m4` about `-mminimal-toc` for more details)
-# However, Parser.hc defines so many symbols that `-mminimal-toc`
-# generates instructions with offsets exceeding the PPC offset
-# addressing limits.  So we need to counter-act this via `-mfull-toc`
-# which disables a preceding `-mminimal-toc` again.
-ifeq "$(HostOS_CPP)" "aix"
-compiler/stage1/build/Parser_HC_OPTS += -optc-mfull-toc
-endif
-ifeq "$(TargetOS_CPP)" "aix"
-compiler/stage2/build/Parser_HC_OPTS += -optc-mfull-toc
-compiler/stage3/build/Parser_HC_OPTS += -optc-mfull-toc
-endif
-
 ifeq "$(GhcProfiled)" "YES"
 # If we're profiling GHC then we want SCCs.  However, adding -auto-all
 # everywhere tends to give a hard-to-read profile, and adds lots of
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index 5cb90ad2a4..1a76728f09 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -158,6 +158,15 @@ cmmMakePicReference dflags lbl
         -- everything gets relocated at runtime
         | OSMinGW32 <- platformOS $ targetPlatform dflags
         = CmmLit $ CmmLabel lbl
+
+        | OSAIX <- platformOS $ targetPlatform dflags
+        = CmmMachOp (MO_Add W32)
+                [ CmmReg (CmmGlobal PicBaseReg)
+                , CmmLit $ picRelative
+                                (platformArch   $ targetPlatform dflags)
+                                (platformOS     $ targetPlatform dflags)
+                                lbl ]
+
         -- both ABI versions default to medium code model
         | ArchPPC_64 _ <- platformArch $ targetPlatform dflags
         = CmmMachOp (MO_Add W32) -- code model medium
@@ -289,6 +298,17 @@ howToAccessLabel dflags arch OSDarwin this_mod _ lbl
         | otherwise
         = AccessDirectly
 
+
+----------------------------------------------------------------------------
+-- AIX
+
+-- quite simple (for now)
+howToAccessLabel _dflags _arch OSAIX _this_mod kind _lbl
+        = case kind of
+            DataReference -> AccessViaSymbolPtr
+            CallReference -> AccessDirectly
+            JumpReference -> AccessDirectly
+
 -- ELF (Linux)
 --
 -- ELF tries to pretend to the main application code that dynamic linking does
@@ -393,6 +413,11 @@ picRelative arch OSDarwin lbl
         | arch /= ArchX86_64
         = CmmLabelDiffOff lbl mkPicBaseLabel 0
 
+-- On AIX we use an indirect local TOC anchored by 'gotLabel'.
+-- This way we use up only one global TOC entry per compilation-unit
+-- (this is quite similiar to GCC's @-mminimal-toc@ compilation mode)
+picRelative _ OSAIX lbl
+        = CmmLabelDiffOff lbl gotLabel 0
 
 -- PowerPC Linux:
 -- The PIC base register points to our fake GOT. Use a label difference
@@ -436,6 +461,9 @@ needImportedSymbols dflags arch os
         , arch  /= ArchX86_64
         = True
 
+        | os    == OSAIX
+        = True
+
         -- PowerPC Linux: -fPIC or -dynamic
         | osElfTarget os
         , arch  == ArchPPC
@@ -483,6 +511,16 @@ pprGotDeclaration dflags ArchX86 OSDarwin
 pprGotDeclaration _ _ OSDarwin
         = empty
 
+-- Emit XCOFF TOC section
+pprGotDeclaration _ _ OSAIX
+        = vcat $ [ text ".toc"
+                 , text ".tc ghc_toc_table[TC],.LCTOC1"
+                 , text ".csect ghc_toc_table[RW]"
+                   -- See Note [.LCTOC1 in PPC PIC code]
+                 , text ".set .LCTOC1,$+0x8000"
+                 ]
+
+
 -- PPC 64 ELF v1needs a Table Of Contents (TOC) on Linux
 pprGotDeclaration _ (ArchPPC_64 ELF_V1) OSLinux
         = text ".section \".toc\",\"aw\""
@@ -635,6 +673,24 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS
 pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
         = empty
 
+-- XCOFF / AIX
+--
+-- Similiar to PPC64 ELF v1, there's dedicated TOC register (r2). To
+-- workaround the limitation of a global TOC we use an indirect TOC
+-- with the label `ghc_toc_table`.
+--
+-- See also GCC's `-mminimal-toc` compilation mode or
+-- http://www.ibm.com/developerworks/rational/library/overview-toc-aix/
+--
+-- NB: No DSO-support yet
+
+pprImportedSymbol _ platform@(Platform { platformOS = OSAIX }) importedLbl
+        = case dynamicLinkerLabelInfo importedLbl of
+            Just (SymbolPtr, lbl)
+              -> vcat [
+                   text "LC.." <> pprCLabel platform lbl <> char ':',
+                   text "\t.long" <+> pprCLabel platform lbl ]
+            _ -> empty
 
 -- ELF / Linux
 --
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 56025f44ac..d8e328633d 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -84,7 +84,8 @@ cmmTopCodeGen (CmmProc info lab live graph) = do
       os   = platformOS $ targetPlatform dflags
       arch = platformArch $ targetPlatform dflags
   case arch of
-    ArchPPC    -> do
+    ArchPPC | os == OSAIX -> return tops
+            | otherwise -> do
       picBaseMb <- getPicBaseMaybeNat
       case picBaseMb of
            Just picBase -> initializePicBase_ppc arch os picBase tops
@@ -382,6 +383,10 @@ getRegister e = do dflags <- getDynFlags
 getRegister' :: DynFlags -> CmmExpr -> NatM Register
 
 getRegister' dflags (CmmReg (CmmGlobal PicBaseReg))
+  | OSAIX <- platformOS (targetPlatform dflags) = do
+        let code dst = toOL [ LD II32 dst tocAddr ]
+            tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]"))
+        return (Any II32 code)
   | target32Bit (targetPlatform dflags) = do
       reg <- getPicBaseNat $ archWordFormat (target32Bit (targetPlatform dflags))
       return (Fixed (archWordFormat (target32Bit (targetPlatform dflags)))
@@ -791,11 +796,23 @@ getAmode DS (CmmMachOp (MO_Add W64) [x, CmmLit (CmmInt i _)])
    -- (needed for PIC)
 getAmode _ (CmmMachOp (MO_Add W32) [x, CmmLit lit])
   = do
-        tmp <- getNewRegNat II32
+        dflags <- getDynFlags
         (src, srcCode) <- getSomeReg x
         let imm = litToImm lit
-            code = srcCode `snocOL` ADDIS tmp src (HA imm)
-        return (Amode (AddrRegImm tmp (LO imm)) code)
+        case () of
+            _ | OSAIX <- platformOS (targetPlatform dflags)
+              , isCmmLabelType lit ->
+                    -- HA16/LO16 relocations on labels not supported on AIX
+                    return (Amode (AddrRegImm src imm) srcCode)
+              | otherwise -> do
+                    tmp <- getNewRegNat II32
+                    let code = srcCode `snocOL` ADDIS tmp src (HA imm)
+                    return (Amode (AddrRegImm tmp (LO imm)) code)
+  where
+      isCmmLabelType (CmmLabel {})        = True
+      isCmmLabelType (CmmLabelOff {})     = True
+      isCmmLabelType (CmmLabelDiffOff {}) = True
+      isCmmLabelType _                    = False
 
 getAmode _ (CmmLit lit)
   = do
@@ -995,6 +1012,7 @@ genJump tree
                       ArchPPC_64 ELF_V1 -> genJump' tree (GCPLinux64ELF 1)
                       ArchPPC_64 ELF_V2 -> genJump' tree (GCPLinux64ELF 2)
                       _   -> panic "PPC.CodeGen.genJump: Unknown Linux"
+          OSAIX    -> genJump' tree GCPAIX
           OSDarwin -> genJump' tree GCPDarwin
           _ -> panic "PPC.CodeGen.genJump: not defined for this os"
 
@@ -1077,10 +1095,11 @@ genCCall target dest_regs argsAndHints
                    ArchPPC_64 ELF_V2 -> genCCall' dflags (GCPLinux64ELF 2)
                                            target dest_regs argsAndHints
                    _  -> panic "PPC.CodeGen.genCCall: Unknown Linux"
+       OSAIX    -> genCCall' dflags GCPAIX    target dest_regs argsAndHints
        OSDarwin -> genCCall' dflags GCPDarwin target dest_regs argsAndHints
        _ -> panic "PPC.CodeGen.genCCall: not defined for this os"
 
-data GenCCallPlatform = GCPLinux | GCPDarwin | GCPLinux64ELF Int
+data GenCCallPlatform = GCPLinux | GCPDarwin | GCPLinux64ELF Int | GCPAIX
 
 genCCall'
     :: DynFlags
@@ -1188,6 +1207,16 @@ genCCall' dflags gcp target dest_regs args
                        `snocOL` MTCTR r12
                        `snocOL` BCTRL usedRegs
                        `appOL`  codeAfter)
+                     GCPAIX          -> return ( dynCode
+                       -- AIX/XCOFF follows the PowerOPEN ABI
+                       -- which is quite similiar to LinuxPPC64/ELFv1
+                       `appOL`  codeBefore
+                       `snocOL` LD II32 r11 (AddrRegImm dynReg (ImmInt 0))
+                       `snocOL` LD II32 toc (AddrRegImm dynReg (ImmInt 4))
+                       `snocOL` MTCTR r11
+                       `snocOL` LD II32 r11 (AddrRegImm dynReg (ImmInt 8))
+                       `snocOL` BCTRL usedRegs
+                       `appOL`  codeAfter)
                      _              -> return ( dynCode
                        `snocOL` MTCTR dynReg
                        `appOL`  codeBefore
@@ -1204,6 +1233,7 @@ genCCall' dflags gcp target dest_regs args
                 return ()
 
         initialStackOffset = case gcp of
+                             GCPAIX          -> 24
                              GCPDarwin       -> 24
                              GCPLinux        -> 8
                              GCPLinux64ELF 1 -> 48
@@ -1211,6 +1241,9 @@ genCCall' dflags gcp target dest_regs args
                              _ -> panic "genCall': unknown calling convention"
             -- size of linkage area + size of arguments, in bytes
         stackDelta finalStack = case gcp of
+                                GCPAIX ->
+                                    roundTo 16 $ (24 +) $ max 32 $ sum $
+                                    map (widthInBytes . typeWidth) argReps
                                 GCPDarwin ->
                                     roundTo 16 $ (24 +) $ max 32 $ sum $
                                     map (widthInBytes . typeWidth) argReps
@@ -1239,6 +1272,7 @@ genCCall' dflags gcp target dest_regs args
         toc_before = case gcp of
            GCPLinux64ELF 1 -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 40))
            GCPLinux64ELF 2 -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 24))
+           GCPAIX          -> unitOL $ ST spFormat toc (AddrRegImm sp (ImmInt 20))
            _               -> nilOL
         toc_after labelOrExpr = case gcp of
            GCPLinux64ELF 1 -> case labelOrExpr of
@@ -1253,6 +1287,11 @@ genCCall' dflags gcp target dest_regs args
                                                      (AddrRegImm sp
                                                       (ImmInt 24))
                                                 ]
+           GCPAIX          -> case labelOrExpr of
+                                Left _  -> unitOL NOP
+                                Right _ -> unitOL (LD spFormat toc
+                                                      (AddrRegImm sp
+                                                       (ImmInt 20)))
            _               -> nilOL
         move_sp_up finalStack
                | delta > 64 =  -- TODO: fix-up stack back-chain
@@ -1271,6 +1310,18 @@ genCCall' dflags gcp target dest_regs args
                 let vr_hi = getHiVRegFromLo vr_lo
 
                 case gcp of
+                    GCPAIX -> -- same as for Darwin
+                        do let storeWord vr (gpr:_) _ = MR gpr vr
+                               storeWord vr [] offset
+                                   = ST II32 vr (AddrRegImm sp (ImmInt offset))
+                           passArguments args
+                                         (drop 2 gprs)
+                                         fprs
+                                         (stackOffset+8)
+                                         (accumCode `appOL` code
+                                               `snocOL` storeWord vr_hi gprs stackOffset
+                                               `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
+                                         ((take 2 gprs) ++ accumUsed)
                     GCPDarwin ->
                         do let storeWord vr (gpr:_) _ = MR gpr vr
                                storeWord vr [] offset
@@ -1315,6 +1366,8 @@ genCCall' dflags gcp target dest_regs args
                                      -- The Darwin ABI requires that we reserve
                                      -- stack slots for register parameters
                                      GCPDarwin -> stackOffset + stackBytes
+                                     -- ... so does the PowerOpen ABI.
+                                     GCPAIX    -> stackOffset + stackBytes
                                      -- ... the SysV ABI 32-bit doesn't.
                                      GCPLinux -> stackOffset
                                      -- ... but SysV ABI 64-bit does.
@@ -1339,6 +1392,10 @@ genCCall' dflags gcp target dest_regs args
                                    -- stackOffset is at least 4-byte aligned
                                    -- The Darwin ABI is happy with that.
                                    stackOffset
+                               GCPAIX ->
+                                   -- The 32bit PowerOPEN ABI is happy with
+                                   -- 32bit-alignment as well...
+                                   stackOffset
                                GCPLinux
                                    -- ... the SysV ABI requires 8-byte
                                    -- alignment for doubles.
@@ -1354,6 +1411,26 @@ genCCall' dflags gcp target dest_regs args
                 stackSlot = AddrRegImm sp (ImmInt stackOffset')
                 (nGprs, nFprs, stackBytes, regs)
                     = case gcp of
+                      GCPAIX ->
+                          case cmmTypeFormat rep of
+                          II8  -> (1, 0, 4, gprs)
+                          II16 -> (1, 0, 4, gprs)
+                          II32 -> (1, 0, 4, gprs)
+                          -- The PowerOpen ABI requires that we skip a
+                          -- corresponding number of GPRs when we use
+                          -- the FPRs.
+                          --
+                          -- E.g. for a `double` two GPRs are skipped,
+                          -- whereas for a `float` one GPR is skipped
+                          -- when parameters are assigned to
+                          -- registers.
+                          --
+                          -- The PowerOpen ABI specification can be found at
+                          -- ftp://www.sourceware.org/pub/binutils/ppc-docs/ppc-poweropen/
+                          FF32 -> (1, 1, 4, fprs)
+                          FF64 -> (2, 1, 8, fprs)
+                          II64 -> panic "genCCall' passArguments II64"
+                          FF80 -> panic "genCCall' passArguments FF80"
                       GCPDarwin ->
                           case cmmTypeFormat rep of
                           II8  -> (1, 0, 4, gprs)
@@ -1482,6 +1559,23 @@ genCCall' dflags gcp target dest_regs args
 
 genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock
 genSwitch dflags expr targets
+  | OSAIX <- platformOS (targetPlatform dflags)
+  = do
+        (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
+        let fmt = archWordFormat $ target32Bit $ targetPlatform dflags
+            sha = if target32Bit $ targetPlatform dflags then 2 else 3
+        tmp <- getNewRegNat fmt
+        lbl <- getNewLabelNat
+        dynRef <- cmmMakeDynamicReference dflags DataReference lbl
+        (tableReg,t_code) <- getSomeReg $ dynRef
+        let code = e_code `appOL` t_code `appOL` toOL [
+                            SL fmt tmp reg (RIImm (ImmInt sha)),
+                            LD fmt tmp (AddrRegReg tableReg tmp),
+                            MTCTR tmp,
+                            BCTR ids (Just lbl)
+                    ]
+        return code
+
   | (gopt Opt_PIC dflags) || (not $ target32Bit $ targetPlatform dflags)
   = do
         (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset)
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 9326813a78..16e8dc14e0 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -31,6 +31,7 @@ import Outputable
 import DynFlags
 
 import Data.Word
+import Data.Int
 import Data.Bits
 
 -- -----------------------------------------------------------------------------
@@ -127,6 +128,7 @@ pprData (CmmUninitialised bytes) = keyword <> int bytes
     where keyword = sdocWithPlatform $ \platform ->
                     case platformOS platform of
                     OSDarwin -> text ".space "
+                    OSAIX    -> text ".space "
                     _        -> text ".skip "
 pprData (CmmStaticLit lit)       = pprDataItem lit
 
@@ -262,6 +264,11 @@ 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
@@ -274,6 +281,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
@@ -570,7 +584,11 @@ pprInstr (BCCFAR cond blockid) = vcat [
     ]
     where lbl = mkAsmTempLabel (getUnique blockid)
 
-pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
+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',
         text "b",
         char '\t',
@@ -587,10 +605,21 @@ pprInstr (BCTR _ _) = hcat [
         char '\t',
         text "bctr"
     ]
-pprInstr (BL lbl _) = hcat [
-        text "\tbl\t",
-        ppr lbl
-    ]
+pprInstr (BL lbl _) = do
+    sdocWithPlatform $ \platform -> case platformOS platform of
+        OSAIX | isForeignLabel lbl ->
+          -- 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
+          hcat [
+            text "\tbl\t.",
+            ppr lbl
+          ]
+        _ ->
+          hcat [
+            text "\tbl\t",
+            ppr lbl
+          ]
 pprInstr (BCTRL _) = hcat [
         char '\t',
         text "bctrl"
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index 14bdab734b..780aecc5b1 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -229,6 +229,7 @@ allArgRegs = map regSingle [3..10]
 callClobberedRegs :: Platform -> [Reg]
 callClobberedRegs platform
   = case platformOS platform of
+    OSAIX    -> map regSingle (0:[2..12] ++ map fReg [0..13])
     OSDarwin -> map regSingle (0:[2..12] ++ map fReg [0..13])
     OSLinux  -> map regSingle (0:[2..13] ++ map fReg [0..13])
     _        -> panic "PPC.Regs.callClobberedRegs: not defined for this architecture"
@@ -260,6 +261,7 @@ showReg n
 allFPArgRegs :: Platform -> [Reg]
 allFPArgRegs platform
     = case platformOS platform of
+      OSAIX    -> map (regSingle . fReg) [1..13]
       OSDarwin -> map (regSingle . fReg) [1..13]
       OSLinux  -> map (regSingle . fReg) [1..8]
       _        -> panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs
index e5c1a28eb6..859f68dac0 100644
--- a/compiler/nativeGen/PprBase.hs
+++ b/compiler/nativeGen/PprBase.hs
@@ -89,6 +89,7 @@ doubleToBytes d
 pprSectionHeader :: Platform -> Section -> SDoc
 pprSectionHeader platform (Section t suffix) =
  case platformOS platform of
+   OSAIX    -> pprXcoffSectionHeader t
    OSDarwin -> pprDarwinSectionHeader t
    _        -> pprGNUSectionHeader t suffix
 
@@ -109,6 +110,19 @@ pprGNUSectionHeader t suffix = sdocWithDynFlags $ \dflags ->
       OtherSection _ ->
         panic "PprBase.pprGNUSectionHeader: unknown section type"
 
+-- XCOFF doesn't support relocating label-differences, so we place all
+-- RO sections into .text[PR] sections
+pprXcoffSectionHeader :: SectionType -> SDoc
+pprXcoffSectionHeader t = text $ case t of
+     Text                    -> ".csect .text[PR]"
+     Data                    -> ".csect .data[RW]"
+     ReadOnlyData            -> ".csect .text[PR] # ReadOnlyData"
+     RelocatableReadOnlyData -> ".csect .text[PR] # RelocatableReadOnlyData"
+     ReadOnlyData16          -> ".csect .text[PR] # ReadOnlyData16"
+     UninitialisedData       -> ".csect .data[BS]"
+     OtherSection _          ->
+       panic "PprBase.pprXcoffSectionHeader: unknown section type"
+
 pprDarwinSectionHeader :: SectionType -> SDoc
 pprDarwinSectionHeader t =
   ptext $ case t of