Commit d3c1dda6 authored by Peter Trommler's avatar Peter Trommler 🥁 Committed by Ben Gamari

Implement PowerPC 64-bit native code backend for Linux

Extend the PowerPC 32-bit native code generator for "64-bit
PowerPC ELF Application Binary Interface Supplement 1.9" by
Ian Lance Taylor and "Power Architecture 64-Bit ELF V2 ABI Specification --
OpenPOWER ABI for Linux Supplement" by IBM.
The latter ABI is mainly used on POWER7/7+ and POWER8
Linux systems running in little-endian mode. The code generator
supports both static and dynamic linking. PowerPC 64-bit
code for ELF ABI 1.9 and 2 is mostly position independent
anyway, and thus so is all the code emitted by the code
generator. In other words, -fPIC does not make a difference.

rts/stg/SMP.h support is implemented.

Following the spirit of the introductory comment in
PPC/CodeGen.hs, the rest of the code is a straightforward
extension of the 32-bit implementation.

Limitations:
* Code is generated only in the medium code model, which
  is also gcc's default
* Local symbols are not accessed directly, which seems to
  also be the case for 32-bit
* LLVM does not work, but this does not work on 32-bit either
* Must use the system runtime linker in GHCi, because the
  GHC linker for "static" object files (rts/Linker.c) for
  PPC 64-bit is not implemented. The system runtime
  (dynamic) linker works.
* The handling of the system stack (register 1) is not ELF-
  compliant so stack traces break. Instead of allocating a new
  stack frame, spill code should use the "official" spill area
  in the current stack frame and deallocation code should restore
  the back chain
* DWARF support is missing

Fixes #9863

Test Plan: validate (on powerpc, too)

Reviewers: simonmar, trofi, erikd, austin

Reviewed By: trofi

Subscribers: bgamari, arnons1, kgardas, thomie

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

GHC Trac Issues: #9863
parent bdf7f133
......@@ -188,7 +188,10 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
test -z "[$]2" || eval "[$]2=ArchPPC"
;;
powerpc64)
test -z "[$]2" || eval "[$]2=ArchPPC_64"
test -z "[$]2" || eval "[$]2=\"ArchPPC_64 {ppc_64ABI = ELF_V1}\""
;;
powerpc64le)
test -z "[$]2" || eval "[$]2=\"ArchPPC_64 {ppc_64ABI = ELF_V2}\""
;;
sparc)
test -z "[$]2" || eval "[$]2=ArchSPARC"
......@@ -209,7 +212,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
mipsel)
test -z "[$]2" || eval "[$]2=ArchMipsel"
;;
hppa|hppa1_1|ia64|m68k|powerpc64le|rs6000|s390|s390x|sparc64|vax)
hppa|hppa1_1|ia64|m68k|rs6000|s390|s390x|sparc64|vax)
test -z "[$]2" || eval "[$]2=ArchUnknown"
;;
*)
......
......@@ -1187,6 +1187,14 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl
GotSymbolPtr -> ppr lbl <> text "@gotpcrel"
GotSymbolOffset -> ppr lbl
SymbolPtr -> text ".LC_" <> ppr lbl
else if platformArch platform == ArchPPC_64 ELF_V1
|| platformArch platform == ArchPPC_64 ELF_V2
then case dllInfo of
GotSymbolPtr -> text ".LC_" <> ppr lbl
<> text "@toc"
GotSymbolOffset -> ppr lbl
SymbolPtr -> text ".LC_" <> ppr lbl
_ -> panic "pprDynamicLinkerAsmLabel"
else case dllInfo of
CodeStub -> ppr lbl <> text "@plt"
SymbolPtr -> text ".LC_" <> ppr lbl
......
......@@ -31,7 +31,7 @@ callerSaves platform
ArchARM {} -> ARM.callerSaves
ArchARM64 -> ARM64.callerSaves
arch
| arch `elem` [ArchPPC, ArchPPC_64] ->
| arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
case platformOS platform of
OSDarwin -> PPC_Darwin.callerSaves
_ -> PPC.callerSaves
......@@ -54,7 +54,7 @@ activeStgRegs platform
ArchARM {} -> ARM.activeStgRegs
ArchARM64 -> ARM64.activeStgRegs
arch
| arch `elem` [ArchPPC, ArchPPC_64] ->
| arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
case platformOS platform of
OSDarwin -> PPC_Darwin.activeStgRegs
_ -> PPC.activeStgRegs
......@@ -72,7 +72,7 @@ haveRegBase platform
ArchARM {} -> ARM.haveRegBase
ArchARM64 -> ARM64.haveRegBase
arch
| arch `elem` [ArchPPC, ArchPPC_64] ->
| arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
case platformOS platform of
OSDarwin -> PPC_Darwin.haveRegBase
_ -> PPC.haveRegBase
......@@ -90,7 +90,7 @@ globalRegMaybe platform
ArchARM {} -> ARM.globalRegMaybe
ArchARM64 -> ARM64.globalRegMaybe
arch
| arch `elem` [ArchPPC, ArchPPC_64] ->
| arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
case platformOS platform of
OSDarwin -> PPC_Darwin.globalRegMaybe
_ -> PPC.globalRegMaybe
......@@ -108,7 +108,7 @@ freeReg platform
ArchARM {} -> ARM.freeReg
ArchARM64 -> ARM64.freeReg
arch
| arch `elem` [ArchPPC, ArchPPC_64] ->
| arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
case platformOS platform of
OSDarwin -> PPC_Darwin.freeReg
_ -> PPC.freeReg
......
......@@ -172,12 +172,12 @@ nativeCodeGen dflags this_mod modLoc h us cmms
ArchSPARC -> nCG' (sparcNcgImpl dflags)
ArchARM {} -> panic "nativeCodeGen: No NCG for ARM"
ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64"
ArchPPC_64 -> panic "nativeCodeGen: No NCG for PPC 64"
ArchPPC_64 _ -> nCG' (ppcNcgImpl dflags)
ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha"
ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb"
ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel"
ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch"
ArchJavaScript -> panic "nativeCodeGen: No NCG for JavaScript"
ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
x86NcgImpl :: DynFlags -> NcgImpl (Alignment, CmmStatics) X86.Instr.Instr X86.Instr.JumpDest
x86NcgImpl dflags
......
......@@ -158,7 +158,14 @@ cmmMakePicReference dflags lbl
-- everything gets relocated at runtime
| OSMinGW32 <- platformOS $ targetPlatform dflags
= CmmLit $ CmmLabel lbl
-- both ABI versions default to medium code model
| ArchPPC_64 _ <- platformArch $ targetPlatform dflags
= CmmMachOp (MO_Add W32) -- code model medium
[ CmmReg (CmmGlobal PicBaseReg)
, CmmLit $ picRelative
(platformArch $ targetPlatform dflags)
(platformOS $ targetPlatform dflags)
lbl ]
| (gopt Opt_PIC dflags || not (gopt Opt_Static dflags)) && absoluteLabel lbl
= CmmMachOp (MO_Add (wordWidth dflags))
......@@ -293,13 +300,17 @@ howToAccessLabel dflags arch OSDarwin this_mod _ lbl
-- from position independent code. It is also required from the main program
-- when dynamic libraries containing Haskell code are used.
howToAccessLabel _ ArchPPC_64 os _ kind _
howToAccessLabel _ (ArchPPC_64 _) os _ kind _
| osElfTarget os
= if kind == DataReference
= case kind of
-- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
then AccessViaSymbolPtr
-- actually, .label instead of label
else AccessDirectly
DataReference -> AccessViaSymbolPtr
-- RTLD does not generate stubs for function descriptors
-- in tail calls. Create a symbol pointer and generate
-- the code to load the function descriptor at the call site.
JumpReference -> AccessViaSymbolPtr
-- regular calls are handled by the runtime linker
_ -> AccessDirectly
howToAccessLabel dflags _ os _ _ _
-- no PIC -> the dynamic linker does everything for us;
......@@ -430,9 +441,14 @@ needImportedSymbols dflags arch os
, arch == ArchPPC
= gopt Opt_PIC dflags || not (gopt Opt_Static dflags)
-- PowerPC 64 Linux: always
| osElfTarget os
, arch == ArchPPC_64 ELF_V1 || arch == ArchPPC_64 ELF_V2
= True
-- i386 (and others?): -dynamic but not -fPIC
| osElfTarget os
, arch /= ArchPPC_64
, arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
= not (gopt Opt_Static dflags) && not (gopt Opt_PIC dflags)
| otherwise
......@@ -467,16 +483,30 @@ pprGotDeclaration dflags ArchX86 OSDarwin
pprGotDeclaration _ _ OSDarwin
= empty
-- PPC 64 ELF v1needs a Table Of Contents (TOC) on Linux
pprGotDeclaration _ (ArchPPC_64 ELF_V1) OSLinux
= ptext (sLit ".section \".toc\",\"aw\"")
-- In ELF v2 we also need to tell the assembler that we want ABI
-- version 2. This would normally be done at the top of the file
-- right after a file directive, but I could not figure out how
-- to do that.
pprGotDeclaration _ (ArchPPC_64 ELF_V2) OSLinux
= vcat [ ptext (sLit ".abiversion 2"),
ptext (sLit ".section \".toc\",\"aw\"")
]
pprGotDeclaration _ (ArchPPC_64 _) _
= panic "pprGotDeclaration: ArchPPC_64 only Linux supported"
-- Emit GOT declaration
-- Output whatever needs to be output once per .s file.
pprGotDeclaration dflags arch os
| osElfTarget os
, arch /= ArchPPC_64
, arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
, not (gopt Opt_PIC dflags)
= empty
| osElfTarget os
, arch /= ArchPPC_64
, arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
= vcat [
-- See Note [.LCTOC1 in PPC PIC code]
ptext (sLit ".section \".got2\",\"aw\""),
......@@ -635,9 +665,16 @@ pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
-- the NCG will keep track of all DynamicLinkerLabels it uses
-- and output each of them using pprImportedSymbol.
pprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 }) _
pprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 _ })
importedLbl
| osElfTarget (platformOS platform)
= empty
= case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> vcat [
ptext (sLit ".section \".toc\", \"aw\""),
ptext (sLit ".LC_") <> pprCLabel platform lbl <> char ':',
ptext (sLit "\t.quad") <+> pprCLabel platform lbl ]
_ -> empty
pprImportedSymbol dflags platform importedLbl
| osElfTarget (platformOS platform)
......@@ -735,6 +772,28 @@ initializePicBase_ppc ArchPPC OSDarwin picReg
where BasicBlock bID insns = entry
b' = BasicBlock bID (PPC.FETCHPC picReg : insns)
-------------------------------------------------------------------------
-- Load TOC into register 2
-- PowerPC 64-bit ELF ABI 2.0 requires the address of the callee
-- in register 12.
-- We pass the label to FETCHTOC and create a .localentry too.
-- TODO: Explain this better and refer to ABI spec!
{-
We would like to do approximately this, but spill slot allocation
might be added before the first BasicBlock. That violates the ABI.
For now we will emit the prologue code in the pretty printer,
which is also what we do for ELF v1.
initializePicBase_ppc (ArchPPC_64 ELF_V2) OSLinux picReg
(CmmProc info lab live (ListGraph (entry:blocks)) : statics)
= do
bID <-getUniqueM
return (CmmProc info lab live (ListGraph (b':entry:blocks))
: statics)
where BasicBlock entryID _ = entry
b' = BasicBlock bID [PPC.FETCHTOC picReg lab,
PPC.BCC PPC.ALWAYS entryID]
-}
initializePicBase_ppc _ _ _ _
= panic "initializePicBase_ppc: not needed"
......
This diff is collapsed.
......@@ -49,8 +49,10 @@ import Data.Maybe (fromMaybe)
--------------------------------------------------------------------------------
-- Size of a PPC memory address, in bytes.
--
archWordSize :: Size
archWordSize = II32
archWordSize :: Bool -> Size
archWordSize is32Bit
| is32Bit = II32
| otherwise = II64
-- | Instruction instance for powerpc
......@@ -76,6 +78,7 @@ ppc_mkStackAllocInstr platform amount
= case platformArch platform of
ArchPPC -> -- SUB II32 (OpImm (ImmInt amount)) (OpReg esp)
ADD sp sp (RIImm (ImmInt (-amount)))
ArchPPC_64 _ -> STU II64 sp (AddrRegImm sp (ImmInt (-amount)))
arch -> panic $ "ppc_mkStackAllocInstr " ++ show arch
ppc_mkStackDeallocInstr :: Platform -> Int -> Instr
......@@ -83,6 +86,7 @@ ppc_mkStackDeallocInstr platform amount
= case platformArch platform of
ArchPPC -> -- ADD II32 (OpImm (ImmInt amount)) (OpReg esp)
ADD sp sp (RIImm (ImmInt amount))
ArchPPC_64 _ -> ADD sp sp (RIImm (ImmInt amount))
arch -> panic $ "ppc_mkStackDeallocInstr " ++ show arch
--
......@@ -210,9 +214,12 @@ data Instr
| SUBF Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1
| SUBFC Reg Reg Reg -- (carrying) dst, src1, src2 ; dst = src2 - src1
| SUBFE Reg Reg Reg -- (extend) dst, src1, src2 ; dst = src2 - src1
| MULLD Reg Reg RI
| MULLW Reg Reg RI
| DIVW Reg Reg Reg
| DIVD Reg Reg Reg
| DIVWU Reg Reg Reg
| DIVDU Reg Reg Reg
| MULLW_MayOflo Reg Reg Reg
-- dst = 1 if src1 * src2 overflows
......@@ -220,9 +227,16 @@ data Instr
-- mullwo. dst, src1, src2
-- mfxer dst
-- rlwinm dst, dst, 2, 31,31
| MULLD_MayOflo Reg Reg Reg
-- dst = 1 if src1 * src2 overflows
-- pseudo-instruction; pretty-printed as:
-- mulldo. dst, src1, src2
-- mfxer dst
-- rlwinm dst, dst, 2, 31,31
| AND Reg Reg RI -- dst, src1, src2
| OR Reg Reg RI -- dst, src1, src2
| ORIS Reg Reg Imm -- OR Immediate Shifted dst, src1, src2
| XOR Reg Reg RI -- dst, src1, src2
| XORIS Reg Reg Imm -- XOR Immediate Shifted dst, src1, src2
......@@ -231,9 +245,9 @@ data Instr
| NEG Reg Reg
| NOT Reg Reg
| SLW Reg Reg RI -- shift left word
| SRW Reg Reg RI -- shift right word
| SRAW Reg Reg RI -- shift right arithmetic word
| SL Size Reg Reg RI -- shift left
| SR Size Reg Reg RI -- shift right
| SRA Size Reg Reg RI -- shift right arithmetic
| RLWINM Reg Reg Int Int Int -- Rotate Left Word Immediate then AND with Mask
......@@ -246,6 +260,8 @@ data Instr
| FCMP Reg Reg
| FCTIWZ Reg Reg -- convert to integer word
| FCTIDZ Reg Reg -- convert to integer double word
| FCFID Reg Reg -- convert from integer double word
| FRSP Reg Reg -- reduce to single precision
-- (but destination is a FP register)
......@@ -255,9 +271,13 @@ data Instr
| MFLR Reg -- move from link register
| FETCHPC Reg -- pseudo-instruction:
-- bcl to next insn, mflr reg
| FETCHTOC Reg CLabel -- pseudo-instruction
-- add TOC offset to address in r12
-- print .localentry for label
| LWSYNC -- memory barrier
| NOP -- no operation, PowerPC 64 bit
-- needs this as place holder to
-- reload TOC pointer
-- | Get the registers that are being used by this instruction.
-- regUsage doesn't need to do any trickery for jumps and such.
......@@ -292,22 +312,28 @@ ppc_regUsageOfInstr platform instr
SUBF reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
SUBFC reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
SUBFE reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
MULLD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
MULLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
DIVW reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
DIVD reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
DIVWU reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
DIVDU reg1 reg2 reg3 -> usage ([reg2,reg3], [reg1])
MULLW_MayOflo reg1 reg2 reg3
-> usage ([reg2,reg3], [reg1])
MULLD_MayOflo reg1 reg2 reg3
-> usage ([reg2,reg3], [reg1])
AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
ORIS reg1 reg2 _ -> usage ([reg2], [reg1])
XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
XORIS reg1 reg2 _ -> usage ([reg2], [reg1])
EXTS _ reg1 reg2 -> usage ([reg2], [reg1])
NEG reg1 reg2 -> usage ([reg2], [reg1])
NOT reg1 reg2 -> usage ([reg2], [reg1])
SLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
SRW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
SRAW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
SL _ reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
SR _ reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
SRA _ reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1])
RLWINM reg1 reg2 _ _ _ -> usage ([reg2], [reg1])
FADD _ r1 r2 r3 -> usage ([r2,r3], [r1])
......@@ -317,10 +343,13 @@ ppc_regUsageOfInstr platform instr
FNEG r1 r2 -> usage ([r2], [r1])
FCMP r1 r2 -> usage ([r1,r2], [])
FCTIWZ r1 r2 -> usage ([r2], [r1])
FCTIDZ r1 r2 -> usage ([r2], [r1])
FCFID r1 r2 -> usage ([r2], [r1])
FRSP r1 r2 -> usage ([r2], [r1])
MFCR reg -> usage ([], [reg])
MFLR reg -> usage ([], [reg])
FETCHPC reg -> usage ([], [reg])
FETCHTOC reg _ -> usage ([], [reg])
_ -> noUsage
where
usage (src, dst) = RU (filter (interesting platform) src)
......@@ -369,21 +398,27 @@ ppc_patchRegsOfInstr instr env
SUBF reg1 reg2 reg3 -> SUBF (env reg1) (env reg2) (env reg3)
SUBFC reg1 reg2 reg3 -> SUBFC (env reg1) (env reg2) (env reg3)
SUBFE reg1 reg2 reg3 -> SUBFE (env reg1) (env reg2) (env reg3)
MULLD reg1 reg2 ri -> MULLD (env reg1) (env reg2) (fixRI ri)
MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri)
DIVW reg1 reg2 reg3 -> DIVW (env reg1) (env reg2) (env reg3)
DIVD reg1 reg2 reg3 -> DIVD (env reg1) (env reg2) (env reg3)
DIVWU reg1 reg2 reg3 -> DIVWU (env reg1) (env reg2) (env reg3)
DIVDU reg1 reg2 reg3 -> DIVDU (env reg1) (env reg2) (env reg3)
MULLW_MayOflo reg1 reg2 reg3
-> MULLW_MayOflo (env reg1) (env reg2) (env reg3)
MULLD_MayOflo reg1 reg2 reg3
-> MULLD_MayOflo (env reg1) (env reg2) (env reg3)
AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri)
OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri)
ORIS reg1 reg2 imm -> ORIS (env reg1) (env reg2) imm
XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri)
XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
EXTS sz reg1 reg2 -> EXTS sz (env reg1) (env reg2)
NEG reg1 reg2 -> NEG (env reg1) (env reg2)
NOT reg1 reg2 -> NOT (env reg1) (env reg2)
SLW reg1 reg2 ri -> SLW (env reg1) (env reg2) (fixRI ri)
SRW reg1 reg2 ri -> SRW (env reg1) (env reg2) (fixRI ri)
SRAW reg1 reg2 ri -> SRAW (env reg1) (env reg2) (fixRI ri)
SL sz reg1 reg2 ri -> SL sz (env reg1) (env reg2) (fixRI ri)
SR sz reg1 reg2 ri -> SR sz (env reg1) (env reg2) (fixRI ri)
SRA sz reg1 reg2 ri -> SRA sz (env reg1) (env reg2) (fixRI ri)
RLWINM reg1 reg2 sh mb me
-> RLWINM (env reg1) (env reg2) sh mb me
FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3)
......@@ -393,10 +428,13 @@ ppc_patchRegsOfInstr instr env
FNEG r1 r2 -> FNEG (env r1) (env r2)
FCMP r1 r2 -> FCMP (env r1) (env r2)
FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2)
FCTIDZ r1 r2 -> FCTIDZ (env r1) (env r2)
FCFID r1 r2 -> FCFID (env r1) (env r2)
FRSP r1 r2 -> FRSP (env r1) (env r2)
MFCR reg -> MFCR (env reg)
MFLR reg -> MFLR (env reg)
FETCHPC reg -> FETCHPC (env reg)
FETCHTOC reg lab -> FETCHTOC (env reg) lab
_ -> instr
where
fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
......@@ -459,9 +497,12 @@ ppc_mkSpillInstr
ppc_mkSpillInstr dflags reg delta slot
= let platform = targetPlatform dflags
off = spillSlotToOffset slot
arch = platformArch platform
in
let sz = case targetClassOfReg platform reg of
RcInteger -> II32
RcInteger -> case arch of
ArchPPC -> II32
_ -> II64
RcDouble -> FF64
_ -> panic "PPC.Instr.mkSpillInstr: no match"
in ST sz reg (AddrRegImm sp (ImmInt (off-delta)))
......@@ -477,9 +518,12 @@ ppc_mkLoadInstr
ppc_mkLoadInstr dflags reg delta slot
= let platform = targetPlatform dflags
off = spillSlotToOffset slot
arch = platformArch platform
in
let sz = case targetClassOfReg platform reg of
RcInteger -> II32
RcInteger -> case arch of
ArchPPC -> II32
_ -> II64
RcDouble -> FF64
_ -> panic "PPC.Instr.mkLoadInstr: no match"
in LD sz reg (AddrRegImm sp (ImmInt (off-delta)))
......@@ -500,8 +544,8 @@ maxSpillSlots dflags
-- = 0 -- useful for testing allocMoreStack
-- | The number of bytes that the stack pointer should be aligned
-- to. This is 16 both on PPC32 and PPC64 at least for Darwin, but I'm
-- not sure this is correct for other OSes.
-- to. This is 16 both on PPC32 and PPC64 at least for Darwin, and
-- Linux (see ELF processor specific supplements).
stackAlign :: Int
stackAlign = 16
......
......@@ -39,11 +39,11 @@ import Unique ( pprUnique, Uniquable(..) )
import Platform
import FastString
import Outputable
import DynFlags
import Data.Word
import Data.Bits
-- -----------------------------------------------------------------------------
-- Printing this stuff out
......@@ -54,12 +54,17 @@ pprNatCmmDecl (CmmData section dats) =
pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
case topInfoTable proc of
Nothing ->
sdocWithPlatform $ \platform ->
case blocks of
[] -> -- special case for split markers:
pprLabel lbl
blocks -> -- special case for code without info table:
pprSectionHeader Text $$
pprLabel lbl $$ -- blocks guaranteed not null, so label needed
(case platformArch platform of
ArchPPC_64 ELF_V1 -> pprFunctionDescriptor lbl
ArchPPC_64 ELF_V2 -> pprFunctionPrologue lbl
_ -> pprLabel lbl) $$ -- blocks guaranteed not null,
-- so label needed
vcat (map (pprBasicBlock top_info) blocks)
Just (Statics info_lbl _) ->
......@@ -81,6 +86,35 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
else empty)
pprFunctionDescriptor :: CLabel -> SDoc
pprFunctionDescriptor lab = pprGloblDecl lab
$$ text ".section \".opd\",\"aw\""
$$ text ".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 ':'
pprFunctionPrologue :: CLabel ->SDoc
pprFunctionPrologue lab = pprGloblDecl lab
$$ text ".type "
<> ppr lab
<> text ", @function"
$$ ppr lab <> char ':'
$$ text "0:\taddis\t" <> pprReg toc
<> text ",12,.TOC.-0b@ha"
$$ text "\taddi\t" <> pprReg toc
<> char ',' <> pprReg toc <> text ",.TOC.-0b@l"
$$ text "\t.localentry\t" <> ppr lab
<> text ",.-" <> ppr lab
pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
pprBasicBlock info_env (BasicBlock blockid instrs)
= maybe_infotable $$
......@@ -208,6 +242,7 @@ pprSize x
II8 -> sLit "b"
II16 -> sLit "h"
II32 -> sLit "w"
II64 -> sLit "d"
FF32 -> sLit "fs"
FF64 -> sLit "fd"
_ -> panic "PPC.Ppr.pprSize: no match")
......@@ -257,6 +292,18 @@ pprImm (HA i)
then hcat [ text "ha16(", pprImm i, rparen ]
else pprImm i <> text "@ha"
pprImm (HIGHERA i)
= sdocWithPlatform $ \platform ->
if platformOS platform == OSDarwin
then panic "PPC.pprImm: highera not implemented on Darwin"
else pprImm i <> text "@highera"
pprImm (HIGHESTA i)
= sdocWithPlatform $ \platform ->
if platformOS platform == OSDarwin
then panic "PPC.pprImm: highesta not implemented on Darwin"
else pprImm i <> text "@highesta"
pprAddr :: AddrMode -> SDoc
pprAddr (AddrRegReg r1 r2)
......@@ -270,18 +317,25 @@ pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
pprSectionHeader :: Section -> SDoc
pprSectionHeader seg =
sdocWithPlatform $ \platform ->
let osDarwin = platformOS platform == OSDarwin in
let osDarwin = platformOS platform == OSDarwin
ppc64 = not $ target32Bit platform
in
case seg of
Text -> text ".text\n\t.align 2"
Data -> text ".data\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"
......@@ -293,32 +347,38 @@ pprSectionHeader seg =
pprDataItem :: CmmLit -> SDoc
pprDataItem lit
= sdocWithDynFlags $ \dflags ->
vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit)
vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit dflags)
where
imm = litToImm lit
archPPC_64 dflags = not $ target32Bit $ targetPlatform dflags
ppr_item II8 _ _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
ppr_item II32 _ _ = [ptext (sLit "\t.long\t") <> pprImm imm]
ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
ppr_item II64 _ dflags
| archPPC_64 dflags = [ptext (sLit "\t.quad\t") <> pprImm imm]
ppr_item FF32 (CmmFloat r _)
ppr_item FF32 (CmmFloat r _) _
= let bs = floatToBytes (fromRational r)
in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
ppr_item FF64 (CmmFloat r _)
ppr_item FF64 (CmmFloat r _) _
= let bs = doubleToBytes (fromRational r)
in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
ppr_item II16 _ = [ptext (sLit "\t.short\t") <> pprImm imm]
ppr_item II16 _ _ = [ptext (sLit "\t.short\t") <> pprImm imm]
ppr_item II64 (CmmInt x _) =
ppr_item II64 (CmmInt x _) dflags
| not(archPPC_64 dflags) =
[ptext (sLit "\t.long\t")
<> int (fromIntegral
(fromIntegral (x `shiftR` 32) :: Word32)),
ptext (sLit "\t.long\t")
<> int (fromIntegral (fromIntegral x :: Word32))]
ppr_item _