Commit bc876206 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

A little more CPP removal

parent 7dd60ddd
......@@ -174,7 +174,16 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
GET_ARM_ISA()
test -z "[$]2" || eval "[$]2=\"ArchARM \$ARM_ISA \$ARM_ISA_EXT\""
;;
alpha|hppa|hppa1_1|ia64|m68k|mips|mipseb|mipsel|rs6000|s390|s390x|sparc64|vax)
alpha)
test -z "[$]2" || eval "[$]2=ArchAlpha"
;;
mips|mipseb)
test -z "[$]2" || eval "[$]2=ArchMipseb"
;;
mipsel)
test -z "[$]2" || eval "[$]2=ArchMipsel"
;;
hppa|hppa1_1|ia64|m68k|rs6000|s390|s390x|sparc64|vax)
test -z "[$]2" || eval "[$]2=ArchUnknown"
;;
*)
......
......@@ -59,10 +59,6 @@ import Data.Array.ST
import Control.Monad.ST
#if defined(alpha_TARGET_ARCH) || defined(mips_TARGET_ARCH) || defined(mipsel_TARGET_ARCH) || defined(arm_TARGET_ARCH)
#define BEWARE_LOAD_STORE_ALIGNMENT
#endif
-- --------------------------------------------------------------------------
-- Top level
......@@ -952,16 +948,21 @@ cCast :: Platform -> SDoc -> CmmExpr -> SDoc
cCast platform ty expr = parens ty <> pprExpr1 platform expr
cLoad :: Platform -> CmmExpr -> CmmType -> SDoc
#ifdef BEWARE_LOAD_STORE_ALIGNMENT
cLoad platform expr rep =
let decl = machRepCType rep <+> ptext (sLit "x") <> semi
struct = ptext (sLit "struct") <+> braces (decl)
packed_attr = ptext (sLit "__attribute__((packed))")
cast = parens (struct <+> packed_attr <> char '*')
in parens (cast <+> pprExpr1 platform expr) <> ptext (sLit "->x")
#else
cLoad platform expr rep = char '*' <> parens (cCast platform (machRepPtrCType rep) expr)
#endif
cLoad platform expr rep
| bewareLoadStoreAlignment (platformArch platform)
= let decl = machRepCType rep <+> ptext (sLit "x") <> semi
struct = ptext (sLit "struct") <+> braces (decl)
packed_attr = ptext (sLit "__attribute__((packed))")
cast = parens (struct <+> packed_attr <> char '*')
in parens (cast <+> pprExpr1 platform expr) <> ptext (sLit "->x")
| otherwise
= char '*' <> parens (cCast platform (machRepPtrCType rep) expr)
where -- On these platforms, unaligned loads are known to cause problems
bewareLoadStoreAlignment ArchAlpha = True
bewareLoadStoreAlignment ArchMipseb = True
bewareLoadStoreAlignment ArchMipsel = True
bewareLoadStoreAlignment (ArchARM {}) = True
bewareLoadStoreAlignment _ = False
isCmmWordType :: CmmType -> Bool
-- True of GcPtrReg/NonGcReg of native word size
......
......@@ -203,6 +203,12 @@ nativeCodeGen dflags h us cmms
panic "nativeCodeGen: No NCG for ARM"
ArchPPC_64 ->
panic "nativeCodeGen: No NCG for PPC 64"
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"
......
......@@ -113,6 +113,9 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl
ArchSPARC -> 14
ArchPPC_64 -> panic "trivColorable ArchPPC_64"
ArchARM _ _ -> panic "trivColorable ArchARM"
ArchAlpha -> panic "trivColorable ArchAlpha"
ArchMipseb -> panic "trivColorable ArchMipseb"
ArchMipsel -> panic "trivColorable ArchMipsel"
ArchUnknown -> panic "trivColorable ArchUnknown")
, count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_INTEGER
(virtualRegSqueeze RcInteger)
......@@ -133,6 +136,9 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclus
ArchSPARC -> 22
ArchPPC_64 -> panic "trivColorable ArchPPC_64"
ArchARM _ _ -> panic "trivColorable ArchARM"
ArchAlpha -> panic "trivColorable ArchAlpha"
ArchMipseb -> panic "trivColorable ArchMipseb"
ArchMipsel -> panic "trivColorable ArchMipsel"
ArchUnknown -> panic "trivColorable ArchUnknown")
, count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_FLOAT
(virtualRegSqueeze RcFloat)
......@@ -153,6 +159,9 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu
ArchSPARC -> 11
ArchPPC_64 -> panic "trivColorable ArchPPC_64"
ArchARM _ _ -> panic "trivColorable ArchARM"
ArchAlpha -> panic "trivColorable ArchAlpha"
ArchMipseb -> panic "trivColorable ArchMipseb"
ArchMipsel -> panic "trivColorable ArchMipsel"
ArchUnknown -> panic "trivColorable ArchUnknown")
, count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_DOUBLE
(virtualRegSqueeze RcDouble)
......@@ -173,6 +182,9 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts ex
ArchSPARC -> 0
ArchPPC_64 -> panic "trivColorable ArchPPC_64"
ArchARM _ _ -> panic "trivColorable ArchARM"
ArchAlpha -> panic "trivColorable ArchAlpha"
ArchMipseb -> panic "trivColorable ArchMipseb"
ArchMipsel -> panic "trivColorable ArchMipsel"
ArchUnknown -> panic "trivColorable ArchUnknown")
, count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_SSE
(virtualRegSqueeze RcDoubleSSE)
......
......@@ -67,5 +67,8 @@ maxSpillSlots platform
ArchSPARC -> SPARC.Instr.maxSpillSlots
ArchARM _ _ -> panic "maxSpillSlots ArchARM"
ArchPPC_64 -> panic "maxSpillSlots ArchPPC_64"
ArchAlpha -> panic "maxSpillSlots ArchAlpha"
ArchMipseb -> panic "maxSpillSlots ArchMipseb"
ArchMipsel -> panic "maxSpillSlots ArchMipsel"
ArchUnknown -> panic "maxSpillSlots ArchUnknown"
......@@ -186,6 +186,9 @@ linearRegAlloc dflags first_id block_live sccs
ArchPPC -> linearRegAlloc' platform (frInitFreeRegs :: PPC.FreeRegs) first_id block_live sccs
ArchARM _ _ -> panic "linearRegAlloc ArchARM"
ArchPPC_64 -> panic "linearRegAlloc ArchPPC_64"
ArchAlpha -> panic "linearRegAlloc ArchAlpha"
ArchMipseb -> panic "linearRegAlloc ArchMipseb"
ArchMipsel -> panic "linearRegAlloc ArchMipsel"
ArchUnknown -> panic "linearRegAlloc ArchUnknown"
linearRegAlloc'
......
......@@ -49,6 +49,9 @@ targetVirtualRegSqueeze platform
ArchSPARC -> SPARC.virtualRegSqueeze
ArchPPC_64 -> panic "targetVirtualRegSqueeze ArchPPC_64"
ArchARM _ _ -> panic "targetVirtualRegSqueeze ArchARM"
ArchAlpha -> panic "targetVirtualRegSqueeze ArchAlpha"
ArchMipseb -> panic "targetVirtualRegSqueeze ArchMipseb"
ArchMipsel -> panic "targetVirtualRegSqueeze ArchMipsel"
ArchUnknown -> panic "targetVirtualRegSqueeze ArchUnknown"
targetRealRegSqueeze :: Platform -> RegClass -> RealReg -> FastInt
......@@ -60,6 +63,9 @@ targetRealRegSqueeze platform
ArchSPARC -> SPARC.realRegSqueeze
ArchPPC_64 -> panic "targetRealRegSqueeze ArchPPC_64"
ArchARM _ _ -> panic "targetRealRegSqueeze ArchARM"
ArchAlpha -> panic "targetRealRegSqueeze ArchAlpha"
ArchMipseb -> panic "targetRealRegSqueeze ArchMipseb"
ArchMipsel -> panic "targetRealRegSqueeze ArchMipsel"
ArchUnknown -> panic "targetRealRegSqueeze ArchUnknown"
targetClassOfRealReg :: Platform -> RealReg -> RegClass
......@@ -71,6 +77,9 @@ targetClassOfRealReg platform
ArchSPARC -> SPARC.classOfRealReg
ArchPPC_64 -> panic "targetClassOfRealReg ArchPPC_64"
ArchARM _ _ -> panic "targetClassOfRealReg ArchARM"
ArchAlpha -> panic "targetClassOfRealReg ArchAlpha"
ArchMipseb -> panic "targetClassOfRealReg ArchMipseb"
ArchMipsel -> panic "targetClassOfRealReg ArchMipsel"
ArchUnknown -> panic "targetClassOfRealReg ArchUnknown"
-- TODO: This should look at targetPlatform too
......@@ -86,6 +95,9 @@ targetMkVirtualReg platform
ArchSPARC -> SPARC.mkVirtualReg
ArchPPC_64 -> panic "targetMkVirtualReg ArchPPC_64"
ArchARM _ _ -> panic "targetMkVirtualReg ArchARM"
ArchAlpha -> panic "targetMkVirtualReg ArchAlpha"
ArchMipseb -> panic "targetMkVirtualReg ArchMipseb"
ArchMipsel -> panic "targetMkVirtualReg ArchMipsel"
ArchUnknown -> panic "targetMkVirtualReg ArchUnknown"
targetRegDotColor :: Platform -> RealReg -> SDoc
......@@ -97,6 +109,9 @@ targetRegDotColor platform
ArchSPARC -> SPARC.regDotColor
ArchPPC_64 -> panic "targetRegDotColor ArchPPC_64"
ArchARM _ _ -> panic "targetRegDotColor ArchARM"
ArchAlpha -> panic "targetRegDotColor ArchAlpha"
ArchMipseb -> panic "targetRegDotColor ArchMipseb"
ArchMipsel -> panic "targetRegDotColor ArchMipsel"
ArchUnknown -> panic "targetRegDotColor ArchUnknown"
......
......@@ -38,28 +38,22 @@ regColors platform = listToUFM (normalRegColors platform ++ fpRegColors)
normalRegColors :: Platform -> [(Reg,String)]
normalRegColors platform
= case platformArch platform of
ArchX86 -> [ (eax, "#00ff00")
, (ebx, "#0000ff")
, (ecx, "#00ffff")
, (edx, "#0080ff") ]
ArchX86_64 -> [ (rax, "#00ff00"), (eax, "#00ff00")
, (rbx, "#0000ff"), (ebx, "#0000ff")
, (rcx, "#00ffff"), (ecx, "#00ffff")
, (rdx, "#0080ff"), (edx, "#00ffff")
, (r8, "#00ff80")
, (r9, "#008080")
, (r10, "#0040ff")
, (r11, "#00ff40")
, (r12, "#008040")
, (r13, "#004080")
, (r14, "#004040")
, (r15, "#002080") ]
ArchPPC -> panic "X86 normalRegColors ArchPPC"
ArchPPC_64 -> panic "X86 normalRegColors ArchPPC_64"
ArchSPARC -> panic "X86 normalRegColors ArchSPARC"
ArchARM _ _ -> panic "X86 normalRegColors ArchARM"
ArchUnknown -> panic "X86 normalRegColors ArchUnknown"
| target32Bit platform = [ (eax, "#00ff00")
, (ebx, "#0000ff")
, (ecx, "#00ffff")
, (edx, "#0080ff") ]
| otherwise = [ (rax, "#00ff00"), (eax, "#00ff00")
, (rbx, "#0000ff"), (ebx, "#0000ff")
, (rcx, "#00ffff"), (ecx, "#00ffff")
, (rdx, "#0080ff"), (edx, "#00ffff")
, (r8, "#00ff80")
, (r9, "#008080")
, (r10, "#0040ff")
, (r11, "#00ff40")
, (r12, "#008040")
, (r13, "#004080")
, (r14, "#004040")
, (r15, "#002080") ]
fpRegColors :: [(Reg,String)]
fpRegColors =
......
......@@ -42,6 +42,9 @@ data Arch
| ArchARM
{ armISA :: ArmISA
, armISAExt :: [ArmISAExt] }
| ArchAlpha
| ArchMipseb
| ArchMipsel
deriving (Read, Show, Eq)
......@@ -83,6 +86,9 @@ target32Bit p = case platformArch p of
ArchPPC_64 -> False
ArchSPARC -> True
ArchARM _ _ -> True
ArchMipseb -> True
ArchMipsel -> True
ArchAlpha -> False
-- | This predicates tells us whether the OS supports ELF-like shared libraries.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment