Move more code into codeGen/CodeGen/Platform.hs
authorIan Lynagh <ian@well-typed.com>
Tue, 28 Aug 2012 19:52:44 +0000 (20:52 +0100)
committerIan Lynagh <ian@well-typed.com>
Tue, 28 Aug 2012 19:52:44 +0000 (20:52 +0100)
HaskellMachRegs.h is no longer included in anything under compiler/

Also, includes/CodeGen.Platform.hs now includes "stg/MachRegs.h"
rather than <stg/MachRegs.h> which means that we always get the file
from the tree, rather than from the bootstrapping compiler.

28 files changed:
compiler/codeGen/CodeGen/Platform.hs
compiler/codeGen/CodeGen/Platform/ARM.hs
compiler/codeGen/CodeGen/Platform/NoRegs.hs
compiler/codeGen/CodeGen/Platform/PPC.hs
compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs
compiler/codeGen/CodeGen/Platform/SPARC.hs
compiler/codeGen/CodeGen/Platform/X86.hs
compiler/codeGen/CodeGen/Platform/X86_64.hs
compiler/ghc.cabal.in
compiler/nativeGen/AsmCodeGen.lhs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/PPC/Instr.hs
compiler/nativeGen/PPC/Regs.hs
compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
compiler/nativeGen/RegAlloc/Linear/Main.hs
compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
compiler/nativeGen/SPARC/CodeGen.hs
compiler/nativeGen/SPARC/CodeGen/Base.hs
compiler/nativeGen/SPARC/CodeGen/Gen32.hs
compiler/nativeGen/SPARC/Instr.hs
compiler/nativeGen/SPARC/RegPlate.hs [deleted file]
compiler/nativeGen/SPARC/Regs.hs
compiler/nativeGen/X86/CodeGen.hs
compiler/nativeGen/X86/Instr.hs
compiler/nativeGen/X86/Regs.hs
includes/CodeGen.Platform.hs

index 78fba97..ca3bafb 100644 (file)
@@ -1,8 +1,12 @@
 
-module CodeGen.Platform (callerSaves, activeStgRegs, haveRegBase) where
+module CodeGen.Platform
+       (callerSaves, activeStgRegs, haveRegBase, globalRegMaybe, freeReg)
+       where
 
 import CmmExpr
+import FastBool
 import Platform
+import Reg
 
 import qualified CodeGen.Platform.ARM        as ARM
 import qualified CodeGen.Platform.PPC        as PPC
@@ -71,3 +75,37 @@ haveRegBase platform
 
     | otherwise -> NoRegs.haveRegBase
 
+globalRegMaybe :: Platform -> GlobalReg -> Maybe RealReg
+globalRegMaybe platform
+ | platformUnregisterised platform = NoRegs.globalRegMaybe
+ | otherwise
+ = case platformArch platform of
+   ArchX86    -> X86.globalRegMaybe
+   ArchX86_64 -> X86_64.globalRegMaybe
+   ArchSPARC  -> SPARC.globalRegMaybe
+   ArchARM {} -> ARM.globalRegMaybe
+   arch
+    | arch `elem` [ArchPPC, ArchPPC_64] ->
+       case platformOS platform of
+       OSDarwin -> PPC_Darwin.globalRegMaybe
+       _        -> PPC.globalRegMaybe
+
+    | otherwise -> NoRegs.globalRegMaybe
+
+freeReg :: Platform -> RegNo -> FastBool
+freeReg platform
+ | platformUnregisterised platform = NoRegs.freeReg
+ | otherwise
+ = case platformArch platform of
+   ArchX86    -> X86.freeReg
+   ArchX86_64 -> X86_64.freeReg
+   ArchSPARC  -> SPARC.freeReg
+   ArchARM {} -> ARM.freeReg
+   arch
+    | arch `elem` [ArchPPC, ArchPPC_64] ->
+       case platformOS platform of
+       OSDarwin -> PPC_Darwin.freeReg
+       _        -> PPC.freeReg
+
+    | otherwise -> NoRegs.freeReg
+
index cad3eb7..727a435 100644 (file)
@@ -1,8 +1,6 @@
 
 module CodeGen.Platform.ARM where
 
-import CmmExpr
-
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_arm 1
 #include "../../../../includes/CodeGen.Platform.hs"
index 6d7c334..c4c63b7 100644 (file)
@@ -1,8 +1,6 @@
 
 module CodeGen.Platform.NoRegs where
 
-import CmmExpr
-
 #define MACHREGS_NO_REGS 1
 #include "../../../../includes/CodeGen.Platform.hs"
 
index 19d0609..bcbdfe2 100644 (file)
@@ -1,8 +1,6 @@
 
 module CodeGen.Platform.PPC where
 
-import CmmExpr
-
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_powerpc 1
 #include "../../../../includes/CodeGen.Platform.hs"
index a53ee06..42bf22f 100644 (file)
@@ -1,8 +1,6 @@
 
 module CodeGen.Platform.PPC_Darwin where
 
-import CmmExpr
-
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_powerpc 1
 #define MACHREGS_darwin 1
index 391d6c8..b49af14 100644 (file)
@@ -1,8 +1,6 @@
 
 module CodeGen.Platform.SPARC where
 
-import CmmExpr
-
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_sparc 1
 #include "../../../../includes/CodeGen.Platform.hs"
index c5ea94f..6dd74df 100644 (file)
@@ -1,8 +1,6 @@
 
 module CodeGen.Platform.X86 where
 
-import CmmExpr
-
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_i386 1
 #include "../../../../includes/CodeGen.Platform.hs"
index c5aa080..190d642 100644 (file)
@@ -1,8 +1,6 @@
 
 module CodeGen.Platform.X86_64 where
 
-import CmmExpr
-
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_x86_64 1
 #include "../../../../includes/CodeGen.Platform.hs"
index 12ed631..e02e9d9 100644 (file)
@@ -509,7 +509,6 @@ Library
             PPC.CodeGen
             SPARC.Base
             SPARC.Regs
-            SPARC.RegPlate
             SPARC.Imm
             SPARC.AddrMode
             SPARC.Cond
index 65fc4e3..6b1e93f 100644 (file)
@@ -179,7 +179,7 @@ nativeCodeGen dflags h us cmms
                          ,shortcutJump              = PPC.RegInfo.shortcutJump
                          ,pprNatCmmDecl              = PPC.Ppr.pprNatCmmDecl
                          ,maxSpillSlots             = PPC.Instr.maxSpillSlots
-                         ,allocatableRegs           = \_ -> PPC.Regs.allocatableRegs
+                         ,allocatableRegs           = PPC.Regs.allocatableRegs
                          ,ncg_x86fp_kludge          = id
                          ,ncgExpandTop              = id
                          ,ncgMakeFarBranches        = makeFarBranches
index b6c83ee..19cdfc7 100644 (file)
@@ -25,6 +25,7 @@ where
 #include "../includes/MachDeps.h"
 
 -- NCG stuff:
+import CodeGen.Platform
 import PPC.Instr
 import PPC.Cond
 import PPC.Regs
@@ -171,13 +172,13 @@ swizzleRegisterRep (Any _ codefn)     size = Any   size codefn
 
 
 -- | Grab the Reg for a CmmReg
-getRegisterReg :: CmmReg -> Reg
+getRegisterReg :: Platform -> CmmReg -> Reg
 
-getRegisterReg (CmmLocal (LocalReg u pk))
+getRegisterReg (CmmLocal (LocalReg u pk))
   = RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
 
-getRegisterReg (CmmGlobal mid)
-  = case globalRegMaybe mid of
+getRegisterReg platform (CmmGlobal mid)
+  = case globalRegMaybe platform mid of
         Just reg -> RegReal reg
         Nothing  -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
         -- By this stage, the only MagicIds remaining should be the
@@ -368,9 +369,9 @@ getRegister' _ (CmmReg (CmmGlobal PicBaseReg))
       reg <- getPicBaseNat archWordSize
       return (Fixed archWordSize reg nilOL)
 
-getRegister' _ (CmmReg reg)
+getRegister' dflags (CmmReg reg)
   = return (Fixed (cmmTypeSize (cmmRegType reg))
-                  (getRegisterReg reg) nilOL)
+                  (getRegisterReg (targetPlatform dflags) reg) nilOL)
 
 getRegister' dflags tree@(CmmRegOff _ _)
   = getRegister' dflags (mangleIndexTree tree)
@@ -763,12 +764,12 @@ assignMem_IntCode pk addr src = do
 -- dst is a reg, but src could be anything
 assignReg_IntCode _ reg src
     = do
+        dflags <- getDynFlags
+        let dst = getRegisterReg (targetPlatform dflags) reg
         r <- getRegister src
         return $ case r of
             Any _ code         -> code dst
             Fixed _ freg fcode -> fcode `snocOL` MR dst freg
-    where
-        dst = getRegisterReg reg
 
 
 
@@ -841,15 +842,17 @@ genCCall :: CmmCallTarget            -- function to call
          -> NatM InstrBlock
 genCCall target dest_regs argsAndHints
  = do dflags <- getDynFlags
-      case platformOS (targetPlatform dflags) of
-          OSLinux    -> genCCall' GCPLinux  target dest_regs argsAndHints
-          OSDarwin   -> genCCall' GCPDarwin target dest_regs argsAndHints
+      let platform = targetPlatform dflags
+      case platformOS platform of
+          OSLinux    -> genCCall' platform GCPLinux  target dest_regs argsAndHints
+          OSDarwin   -> genCCall' platform GCPDarwin target dest_regs argsAndHints
           _ -> panic "PPC.CodeGen.genCCall: not defined for this os"
 
 data GenCCallPlatform = GCPLinux | GCPDarwin
 
 genCCall'
-    :: GenCCallPlatform
+    :: Platform
+    -> GenCCallPlatform
     -> CmmCallTarget            -- function to call
     -> [HintedCmmFormal]        -- where to put the result
     -> [HintedCmmActual]        -- arguments (of mixed type)
@@ -893,13 +896,13 @@ genCCall'
 -}
 
 
-genCCall' _ (CmmPrim MO_WriteBarrier _) _ _
+genCCall' _ (CmmPrim MO_WriteBarrier _) _ _
  = return $ unitOL LWSYNC
 
-genCCall' _ (CmmPrim _ (Just stmts)) _ _
+genCCall' _ (CmmPrim _ (Just stmts)) _ _
     = stmtsToInstrs stmts
 
-genCCall' gcp target dest_regs argsAndHints
+genCCall' platform gcp target dest_regs argsAndHints
   = ASSERT (not $ any (`elem` [II16]) $ map cmmTypeSize argReps)
         -- we rely on argument promotion in the codeGen
     do
@@ -1086,7 +1089,7 @@ genCCall' gcp target dest_regs argsAndHints
                                           MR r_dest r4]
                     | otherwise -> unitOL (MR r_dest r3)
                     where rep = cmmRegType (CmmLocal dest)
-                          r_dest = getRegisterReg (CmmLocal dest)
+                          r_dest = getRegisterReg platform (CmmLocal dest)
                 _ -> panic "genCCall' moveResult: Bad dest_regs"
 
         outOfLineMachOp mop =
index 2e25bd5..ff70353 100644 (file)
@@ -33,6 +33,7 @@ import TargetReg
 import RegClass
 import Reg
 
+import CodeGen.Platform
 import Constants       (rESERVED_C_STACK_BYTES)
 import BlockId
 import OldCmm
@@ -178,7 +179,7 @@ data Instr
 --     allocation goes, are taken care of by the register allocator.
 --
 ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage
-ppc_regUsageOfInstr _ instr
+ppc_regUsageOfInstr platform instr
  = case instr of
     LD    _ reg addr   -> usage (regAddr addr, [reg])
     LA    _ reg addr   -> usage (regAddr addr, [reg])
@@ -230,21 +231,21 @@ ppc_regUsageOfInstr _ instr
     FETCHPC reg         -> usage ([], [reg])
     _                  -> noUsage
   where
-    usage (src, dst) = RU (filter interesting src)
-                         (filter interesting dst)
+    usage (src, dst) = RU (filter (interesting platform) src)
+                         (filter (interesting platform) dst)
     regAddr (AddrRegReg r1 r2) = [r1, r2]
     regAddr (AddrRegImm r1 _)  = [r1]
 
     regRI (RIReg r) = [r]
     regRI  _   = []
 
-interesting :: Reg -> Bool
-interesting (RegVirtual _)             = True
-interesting (RegReal (RealRegSingle i))        
-       = isFastTrue (freeReg i)
+interesting :: Platform -> Reg -> Bool
+interesting _        (RegVirtual _)              = True
+interesting platform (RegReal (RealRegSingle i))
+    = isFastTrue (freeReg platform i)
 
-interesting (RegReal (RealRegPair{}))  
-       = panic "PPC.Instr.interesting: no reg pairs on this arch"
+interesting _        (RegReal (RealRegPair{}))
+    = panic "PPC.Instr.interesting: no reg pairs on this arch"
 
 
 
index b86df54..2172d6d 100644 (file)
@@ -37,9 +37,6 @@ module PPC.Regs (
         fReg,
         sp, r3, r4, r27, r28, f1, f20, f21,
 
-        -- horrow show
-        freeReg,
-        globalRegMaybe,
         allocatableRegs
 
 )
@@ -48,7 +45,6 @@ where
 
 #include "nativeGen/NCG.h"
 #include "HsVersions.h"
-#include "../includes/stg/HaskellMachRegs.h"
 
 import Reg
 import RegClass
@@ -58,10 +54,12 @@ import OldCmm
 import CLabel           ( CLabel )
 import Unique
 
+import CodeGen.Platform
 import Outputable
 import Constants
 import FastBool
 import FastTypes
+import Platform
 
 import Data.Word        ( Word8, Word16, Word32 )
 import Data.Int         ( Int8, Int16, Int32 )
@@ -316,288 +314,10 @@ f1      = regSingle $ fReg 1
 f20     = regSingle $ fReg 20
 f21     = regSingle $ fReg 21
 
-
-
--- horror show -----------------------------------------------------------------
-freeReg :: RegNo -> FastBool
-globalRegMaybe :: GlobalReg -> Maybe RealReg
-
-
-#if powerpc_TARGET_ARCH
-#define r0 0
-#define r1 1
-#define r2 2
-#define r3 3
-#define r4 4
-#define r5 5
-#define r6 6
-#define r7 7
-#define r8 8
-#define r9 9
-#define r10 10
-#define r11 11
-#define r12 12
-#define r13 13
-#define r14 14
-#define r15 15
-#define r16 16
-#define r17 17
-#define r18 18
-#define r19 19
-#define r20 20
-#define r21 21
-#define r22 22
-#define r23 23
-#define r24 24
-#define r25 25
-#define r26 26
-#define r27 27
-#define r28 28
-#define r29 29
-#define r30 30
-#define r31 31
-
-#ifdef darwin_TARGET_OS
-#define f0  32
-#define f1  33
-#define f2  34
-#define f3  35
-#define f4  36
-#define f5  37
-#define f6  38
-#define f7  39
-#define f8  40
-#define f9  41
-#define f10 42
-#define f11 43
-#define f12 44
-#define f13 45
-#define f14 46
-#define f15 47
-#define f16 48
-#define f17 49
-#define f18 50
-#define f19 51
-#define f20 52
-#define f21 53
-#define f22 54
-#define f23 55
-#define f24 56
-#define f25 57
-#define f26 58
-#define f27 59
-#define f28 60
-#define f29 61
-#define f30 62
-#define f31 63
-#else
-#define fr0  32
-#define fr1  33
-#define fr2  34
-#define fr3  35
-#define fr4  36
-#define fr5  37
-#define fr6  38
-#define fr7  39
-#define fr8  40
-#define fr9  41
-#define fr10 42
-#define fr11 43
-#define fr12 44
-#define fr13 45
-#define fr14 46
-#define fr15 47
-#define fr16 48
-#define fr17 49
-#define fr18 50
-#define fr19 51
-#define fr20 52
-#define fr21 53
-#define fr22 54
-#define fr23 55
-#define fr24 56
-#define fr25 57
-#define fr26 58
-#define fr27 59
-#define fr28 60
-#define fr29 61
-#define fr30 62
-#define fr31 63
-#endif
-
-
-
-freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns, but it's actually free
-freeReg 1 = fastBool False -- The Stack Pointer
-#if !darwin_TARGET_OS
- -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that
-freeReg 2 = fastBool False
-#endif
-
-#ifdef REG_Base
-freeReg REG_Base = fastBool False
-#endif
-#ifdef REG_R1
-freeReg REG_R1   = fastBool False
-#endif
-#ifdef REG_R2
-freeReg REG_R2   = fastBool False
-#endif
-#ifdef REG_R3
-freeReg REG_R3   = fastBool False
-#endif
-#ifdef REG_R4
-freeReg REG_R4   = fastBool False
-#endif
-#ifdef REG_R5
-freeReg REG_R5   = fastBool False
-#endif
-#ifdef REG_R6
-freeReg REG_R6   = fastBool False
-#endif
-#ifdef REG_R7
-freeReg REG_R7   = fastBool False
-#endif
-#ifdef REG_R8
-freeReg REG_R8   = fastBool False
-#endif
-#ifdef REG_R9
-freeReg REG_R9   = fastBool False
-#endif
-#ifdef REG_R10
-freeReg REG_R10  = fastBool False
-#endif
-#ifdef REG_F1
-freeReg REG_F1 = fastBool False
-#endif
-#ifdef REG_F2
-freeReg REG_F2 = fastBool False
-#endif
-#ifdef REG_F3
-freeReg REG_F3 = fastBool False
-#endif
-#ifdef REG_F4
-freeReg REG_F4 = fastBool False
-#endif
-#ifdef REG_D1
-freeReg REG_D1 = fastBool False
-#endif
-#ifdef REG_D2
-freeReg REG_D2 = fastBool False
-#endif
-#ifdef REG_Sp
-freeReg REG_Sp   = fastBool False
-#endif
-#ifdef REG_Su
-freeReg REG_Su   = fastBool False
-#endif
-#ifdef REG_SpLim
-freeReg REG_SpLim = fastBool False
-#endif
-#ifdef REG_Hp
-freeReg REG_Hp   = fastBool False
-#endif
-#ifdef REG_HpLim
-freeReg REG_HpLim = fastBool False
-#endif
-freeReg _               = fastBool True
-
-
---  | Returns 'Nothing' if this global register is not stored
--- in a real machine register, otherwise returns @'Just' reg@, where
--- reg is the machine register it is stored in.
-
-
-#ifdef REG_Base
-globalRegMaybe BaseReg                  = Just (RealRegSingle REG_Base)
-#endif
-#ifdef REG_R1
-globalRegMaybe (VanillaReg 1 _)         = Just (RealRegSingle REG_R1)
-#endif
-#ifdef REG_R2
-globalRegMaybe (VanillaReg 2 _)         = Just (RealRegSingle REG_R2)
-#endif
-#ifdef REG_R3
-globalRegMaybe (VanillaReg 3 _)         = Just (RealRegSingle REG_R3)
-#endif
-#ifdef REG_R4
-globalRegMaybe (VanillaReg 4 _)         = Just (RealRegSingle REG_R4)
-#endif
-#ifdef REG_R5
-globalRegMaybe (VanillaReg 5 _)         = Just (RealRegSingle REG_R5)
-#endif
-#ifdef REG_R6
-globalRegMaybe (VanillaReg 6 _)         = Just (RealRegSingle REG_R6)
-#endif
-#ifdef REG_R7
-globalRegMaybe (VanillaReg 7 _)         = Just (RealRegSingle REG_R7)
-#endif
-#ifdef REG_R8
-globalRegMaybe (VanillaReg 8 _)         = Just (RealRegSingle REG_R8)
-#endif
-#ifdef REG_R9
-globalRegMaybe (VanillaReg 9 _)         = Just (RealRegSingle REG_R9)
-#endif
-#ifdef REG_R10
-globalRegMaybe (VanillaReg 10 _)        = Just (RealRegSingle REG_R10)
-#endif
-#ifdef REG_F1
-globalRegMaybe (FloatReg 1)             = Just (RealRegSingle REG_F1)
-#endif
-#ifdef REG_F2
-globalRegMaybe (FloatReg 2)             = Just (RealRegSingle REG_F2)
-#endif
-#ifdef REG_F3
-globalRegMaybe (FloatReg 3)             = Just (RealRegSingle REG_F3)
-#endif
-#ifdef REG_F4
-globalRegMaybe (FloatReg 4)             = Just (RealRegSingle REG_F4)
-#endif
-#ifdef REG_D1
-globalRegMaybe (DoubleReg 1)            = Just (RealRegSingle REG_D1)
-#endif
-#ifdef REG_D2
-globalRegMaybe (DoubleReg 2)            = Just (RealRegSingle REG_D2)
-#endif
-#ifdef REG_Sp
-globalRegMaybe Sp                       = Just (RealRegSingle REG_Sp)
-#endif
-#ifdef REG_Lng1
-globalRegMaybe (LongReg 1)              = Just (RealRegSingle REG_Lng1)
-#endif
-#ifdef REG_Lng2
-globalRegMaybe (LongReg 2)              = Just (RealRegSingle REG_Lng2)
-#endif
-#ifdef REG_SpLim
-globalRegMaybe SpLim                    = Just (RealRegSingle REG_SpLim)
-#endif
-#ifdef REG_Hp
-globalRegMaybe Hp                       = Just (RealRegSingle REG_Hp)
-#endif
-#ifdef REG_HpLim
-globalRegMaybe HpLim                    = Just (RealRegSingle REG_HpLim)
-#endif
-#ifdef REG_CurrentTSO
-globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)
-#endif
-#ifdef REG_CurrentNursery
-globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)
-#endif
-globalRegMaybe _                        = Nothing
-
-
-#else  /* powerpc_TARGET_ARCH */
-
-freeReg _               = 0#
-globalRegMaybe _        = panic "PPC.Regs.globalRegMaybe: not defined"
-
-#endif /* powerpc_TARGET_ARCH */
-
-
 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
 -- i.e., these are the regs for which we are prepared to allow the
 -- register allocator to attempt to map VRegs to.
-allocatableRegs :: [RealReg]
-allocatableRegs
-   = let isFree i = isFastTrue (freeReg i)
+allocatableRegs :: Platform -> [RealReg]
+allocatableRegs platform
+   = let isFree i = isFastTrue (freeReg platform i)
      in  map RealRegSingle $ filter isFree allMachRegNos
index 724d7d6..887af17 100644 (file)
@@ -42,27 +42,27 @@ import qualified SPARC.Instr
 import qualified X86.Instr
 
 class Show freeRegs => FR freeRegs where
-    frAllocateReg :: RealReg -> freeRegs -> freeRegs
+    frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs
     frGetFreeRegs :: Platform -> RegClass -> freeRegs -> [RealReg]
     frInitFreeRegs :: Platform -> freeRegs
-    frReleaseReg :: RealReg -> freeRegs -> freeRegs
+    frReleaseReg :: Platform -> RealReg -> freeRegs -> freeRegs
 
 instance FR X86.FreeRegs where
-    frAllocateReg  = X86.allocateReg
+    frAllocateReg  = \_ -> X86.allocateReg
     frGetFreeRegs  = X86.getFreeRegs
     frInitFreeRegs = X86.initFreeRegs
-    frReleaseReg   = X86.releaseReg
+    frReleaseReg   = \_ -> X86.releaseReg
 
 instance FR PPC.FreeRegs where
-    frAllocateReg  = PPC.allocateReg
+    frAllocateReg  = \_ -> PPC.allocateReg
     frGetFreeRegs  = \_ -> PPC.getFreeRegs
-    frInitFreeRegs = \_ -> PPC.initFreeRegs
-    frReleaseReg   = PPC.releaseReg
+    frInitFreeRegs = PPC.initFreeRegs
+    frReleaseReg   = \_ -> PPC.releaseReg
 
 instance FR SPARC.FreeRegs where
     frAllocateReg  = SPARC.allocateReg
     frGetFreeRegs  = \_ -> SPARC.getFreeRegs
-    frInitFreeRegs = \_ -> SPARC.initFreeRegs
+    frInitFreeRegs = SPARC.initFreeRegs
     frReleaseReg   = SPARC.releaseReg
 
 maxSpillSlots :: Platform -> Int
index c17b65d..ea415e2 100644 (file)
@@ -135,7 +135,7 @@ joinToTargets_first platform block_live new_blocks block_id instr dest dests
 
  = do  -- free up the regs that are not live on entry to this block.
        freeregs        <- getFreeRegsR
-       let freeregs'   = foldr frReleaseReg freeregs to_free 
+       let freeregs' = foldr (frReleaseReg platform) freeregs to_free
        
        -- remember the current assignment on entry to this block.
        setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)
index 54c6990..c2f89de 100644 (file)
@@ -130,9 +130,6 @@ import Data.Maybe
 import Data.List
 import Control.Monad
 
-#include "../includes/stg/HaskellMachRegs.h"
-
-
 -- -----------------------------------------------------------------------------
 -- Top level of the register allocator
 
@@ -328,7 +325,7 @@ initBlock platform id block_live
                           Nothing ->
                             setFreeRegsR    (frInitFreeRegs platform)
                           Just live ->
-                            setFreeRegsR $ foldr frAllocateReg (frInitFreeRegs platform) [ r | RegReal r <- uniqSetToList live ]
+                            setFreeRegsR $ foldr (frAllocateReg platform) (frInitFreeRegs platform) [ r | RegReal r <- uniqSetToList live ]
                         setAssigR       emptyRegMap
 
                 -- load info about register assignments leading into this block.
@@ -488,10 +485,10 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
 
     -- (e) Delete all register assignments for temps which are read
     --     (only) and die here.  Update the free register list.
-    releaseRegs r_dying
+    releaseRegs platform r_dying
 
     -- (f) Mark regs which are clobbered as unallocatable
-    clobberRegs real_written
+    clobberRegs platform real_written
 
     -- (g) Allocate registers for temporaries *written* (only)
     (w_spills, w_allocd) <-
@@ -499,7 +496,7 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
 
     -- (h) Release registers for temps which are written here and not
     -- used again.
-    releaseRegs w_dying
+    releaseRegs platform w_dying
 
     let
         -- (i) Patch the instruction
@@ -542,19 +539,19 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
 -- -----------------------------------------------------------------------------
 -- releaseRegs
 
-releaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs ()
-releaseRegs regs = do
+releaseRegs :: FR freeRegs => Platform -> [Reg] -> RegM freeRegs ()
+releaseRegs platform regs = do
   assig <- getAssigR
   free <- getFreeRegsR
   loop assig free regs
  where
   loop _     free _ | free `seq` False = undefined
   loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
-  loop assig free (RegReal rr : rs) = loop assig (frReleaseReg rr free) rs
+  loop assig free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs
   loop assig free (r:rs) =
      case lookupUFM assig r of
-        Just (InBoth real _) -> loop (delFromUFM assig r) (frReleaseReg real free) rs
-        Just (InReg real) -> loop (delFromUFM assig r) (frReleaseReg real free) rs
+        Just (InBoth real _) -> loop (delFromUFM assig r) (frReleaseReg platform real free) rs
+        Just (InReg real) -> loop (delFromUFM assig r) (frReleaseReg platform real free) rs
         _other            -> loop (delFromUFM assig r) free rs
 
 
@@ -612,7 +609,7 @@ saveClobberedTemps platform clobbered dying
               -- clobbered by this instruction; use it to save the
               -- clobbered value.
               (my_reg : _) -> do
-                  setFreeRegsR (frAllocateReg my_reg freeRegs)
+                  setFreeRegsR (frAllocateReg platform my_reg freeRegs)
 
                   let new_assign = addToUFM assig temp (InReg my_reg)
                   let instr = mkRegRegMoveInstr platform
@@ -636,14 +633,14 @@ saveClobberedTemps platform clobbered dying
 -- | Mark all these real regs as allocated,
 --      and kick out their vreg assignments.
 --
-clobberRegs :: FR freeRegs => [RealReg] -> RegM freeRegs ()
-clobberRegs []
+clobberRegs :: FR freeRegs => Platform -> [RealReg] -> RegM freeRegs ()
+clobberRegs []
         = return ()
 
-clobberRegs clobbered
+clobberRegs platform clobbered
  = do
         freeregs        <- getFreeRegsR
-        setFreeRegsR $! foldr frAllocateReg freeregs clobbered
+        setFreeRegsR $! foldr (frAllocateReg platform) freeregs clobbered
 
         assig           <- getAssigR
         setAssigR $! clobber assig (ufmToList assig)
@@ -754,7 +751,7 @@ allocRegsAndSpill_spill platform reading keep spills alloc r rs assig spill_loc
            do   spills'   <- loadTemp platform r spill_loc my_reg spills
 
                 setAssigR       (addToUFM assig r $! newLocation spill_loc my_reg)
-                setFreeRegsR $  frAllocateReg my_reg freeRegs
+                setFreeRegsR $  frAllocateReg platform my_reg freeRegs
 
                 allocateRegsAndSpill platform reading keep spills' (my_reg : alloc) rs
 
index 10726cd..2c83481 100644 (file)
@@ -15,6 +15,7 @@ import RegClass
 import Reg
 
 import Outputable
+import Platform
 
 import Data.Word
 import Data.Bits
@@ -45,8 +46,8 @@ releaseReg (RealRegSingle r) (FreeRegs g f)
 releaseReg _ _
        = panic "RegAlloc.Linear.PPC.releaseReg: bad reg"
     
-initFreeRegs :: FreeRegs
-initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
+initFreeRegs :: Platform -> FreeRegs
+initFreeRegs platform = foldr releaseReg noFreeRegs (allocatableRegs platform)
 
 getFreeRegs :: RegClass -> FreeRegs -> [RealReg]       -- lazilly
 getFreeRegs cls (FreeRegs g f)
index d3bc88c..d15ad07 100644 (file)
@@ -11,11 +11,12 @@ module RegAlloc.Linear.SPARC.FreeRegs
 where
 
 import SPARC.Regs
-import SPARC.RegPlate
 import RegClass
 import Reg
 
+import CodeGen.Platform
 import Outputable
+import Platform
 import FastBool
 
 import Data.Word
@@ -50,9 +51,9 @@ noFreeRegs = FreeRegs 0 0 0
 
 
 -- | The initial set of free regs.
-initFreeRegs :: FreeRegs
-initFreeRegs 
- =     foldr releaseReg noFreeRegs allocatableRegs
+initFreeRegs :: Platform -> FreeRegs
+initFreeRegs platform
+ =     foldr (releaseReg platform) noFreeRegs allocatableRegs
 
                        
 -- | Get all the free registers of this class.
@@ -75,13 +76,13 @@ getFreeRegs cls (FreeRegs g f d)
 
 
 -- | Grab a register.
-allocateReg :: RealReg -> FreeRegs -> FreeRegs
-allocateReg 
+allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
+allocateReg platform
         reg@(RealRegSingle r)
             (FreeRegs g f d)
 
        -- can't allocate free regs
-       | not $ isFastTrue (freeReg r)
+       | not $ isFastTrue (freeReg platform r)
        = pprPanic "SPARC.FreeRegs.allocateReg: not allocating pinned reg" (ppr reg)
        
        -- a general purpose reg
@@ -108,7 +109,7 @@ allocateReg
        | otherwise
        = pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
                        
-allocateReg
+allocateReg _
         reg@(RealRegPair r1 r2)
              (FreeRegs g f d)
        
@@ -131,13 +132,13 @@ allocateReg
 --     The register liveness information says that most regs die after a C call, 
 --     but we still don't want to allocate to some of them.
 --
-releaseReg :: RealReg -> FreeRegs -> FreeRegs
-releaseReg 
+releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
+releaseReg platform
         reg@(RealRegSingle r) 
        regs@(FreeRegs g f d)
 
        -- don't release pinned reg
-       | not $ isFastTrue (freeReg r)
+       | not $ isFastTrue (freeReg platform r)
        = regs
 
        -- a general purpose reg
@@ -161,7 +162,7 @@ releaseReg
        | otherwise
        = pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
        
-releaseReg 
+releaseReg _
         reg@(RealRegPair r1 r2) 
             (FreeRegs g f d)
 
index 8409182..a3409dd 100644 (file)
@@ -191,12 +191,12 @@ assignMem_IntCode pk addr src = do
 
 assignReg_IntCode :: Size -> CmmReg  -> CmmExpr -> NatM InstrBlock
 assignReg_IntCode _ reg src = do
+    dflags <- getDynFlags
     r <- getRegister src
+    let dst = getRegisterReg (targetPlatform dflags) reg
     return $ case r of
         Any _ code         -> code dst
         Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst
-    where
-      dst = getRegisterReg reg
 
 
 
@@ -218,8 +218,10 @@ assignMem_FltCode pk addr src = do
 -- Floating point assignment to a register/temporary
 assignReg_FltCode :: Size -> CmmReg  -> CmmExpr -> NatM InstrBlock
 assignReg_FltCode pk dstCmmReg srcCmmExpr = do
+    dflags <- getDynFlags
+    let platform = targetPlatform dflags
     srcRegister <- getRegister srcCmmExpr
-    let dstReg  = getRegisterReg dstCmmReg
+    let dstReg  = getRegisterReg platform dstCmmReg
 
     return $ case srcRegister of
         Any _ code                  -> code dstReg
@@ -537,7 +539,7 @@ assign_code _ [] = nilOL
 assign_code platform [CmmHinted dest _hint]
  = let  rep     = localRegType dest
         width   = typeWidth rep
-        r_dest  = getRegisterReg (CmmLocal dest)
+        r_dest  = getRegisterReg platform (CmmLocal dest)
 
         result
                 | isFloatType rep
index 8990072..4693611 100644 (file)
@@ -25,12 +25,13 @@ import SPARC.Instr
 import SPARC.Cond
 import SPARC.AddrMode
 import SPARC.Regs
-import SPARC.RegPlate
 import Size
 import Reg
 
+import CodeGen.Platform
 import OldCmm
 import OldPprCmm ()
+import Platform
 
 import Outputable
 import OrdList
@@ -98,13 +99,13 @@ setSizeOfRegister reg size
 
 --------------------------------------------------------------------------------
 -- | Grab the Reg for a CmmReg
-getRegisterReg :: CmmReg -> Reg
+getRegisterReg :: Platform -> CmmReg -> Reg
 
-getRegisterReg (CmmLocal (LocalReg u pk))
+getRegisterReg (CmmLocal (LocalReg u pk))
        = RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
 
-getRegisterReg (CmmGlobal mid)
-  = case globalRegMaybe mid of
+getRegisterReg platform (CmmGlobal mid)
+  = case globalRegMaybe platform mid of
         Just reg -> RegReal reg
         Nothing  -> pprPanic
                         "SPARC.CodeGen.Base.getRegisterReg: global is in memory"
index 454e786..c2c47e9 100644 (file)
@@ -32,6 +32,7 @@ import Reg
 import OldCmm
 
 import Control.Monad (liftM)
+import DynFlags
 import OrdList
 import Outputable
 
@@ -54,8 +55,10 @@ getSomeReg expr = do
 getRegister :: CmmExpr -> NatM Register
 
 getRegister (CmmReg reg) 
-  = return (Fixed (cmmTypeSize (cmmRegType reg)) 
-                 (getRegisterReg reg) nilOL)
+  = do dflags <- getDynFlags
+       let platform = targetPlatform dflags
+       return (Fixed (cmmTypeSize (cmmRegType reg))
+              (getRegisterReg platform reg) nilOL)
 
 getRegister tree@(CmmRegOff _ _) 
   = getRegister (mangleIndexTree tree)
index b3429f7..021b2fb 100644 (file)
@@ -36,7 +36,6 @@ import SPARC.Imm
 import SPARC.AddrMode
 import SPARC.Cond
 import SPARC.Regs
-import SPARC.RegPlate
 import SPARC.Base
 import TargetReg
 import Instruction
@@ -45,6 +44,7 @@ import Reg
 import Size
 
 import CLabel
+import CodeGen.Platform
 import BlockId
 import OldCmm
 import FastString
@@ -222,7 +222,7 @@ data Instr
 --     allocation goes, are taken care of by the register allocator.
 --
 sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage
-sparc_regUsageOfInstr _ instr
+sparc_regUsageOfInstr platform instr
  = case instr of
     LD    _ addr reg           -> usage (regAddr addr,         [reg])
     ST    _ reg addr           -> usage (reg : regAddr addr,   [])
@@ -266,7 +266,8 @@ sparc_regUsageOfInstr _ instr
 
   where
     usage (src, dst) 
-     = RU (filter interesting src) (filter interesting dst)
+     = RU (filter (interesting platform) src)
+          (filter (interesting platform) dst)
 
     regAddr (AddrRegReg r1 r2) = [r1, r2]
     regAddr (AddrRegImm r1 _)  = [r1]
@@ -277,12 +278,12 @@ sparc_regUsageOfInstr _ instr
 
 -- | Interesting regs are virtuals, or ones that are allocatable 
 --     by the register allocator.
-interesting :: Reg -> Bool
-interesting reg
+interesting :: Platform -> Reg -> Bool
+interesting platform reg
  = case reg of
        RegVirtual _                    -> True
-       RegReal (RealRegSingle r1)      -> isFastTrue (freeReg r1)
-       RegReal (RealRegPair r1 _)      -> isFastTrue (freeReg r1)
+       RegReal (RealRegSingle r1)      -> isFastTrue (freeReg platform r1)
+       RegReal (RealRegPair r1 _)      -> isFastTrue (freeReg platform r1)
 
 
 
diff --git a/compiler/nativeGen/SPARC/RegPlate.hs b/compiler/nativeGen/SPARC/RegPlate.hs
deleted file mode 100644 (file)
index be638a9..0000000
+++ /dev/null
@@ -1,318 +0,0 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
--- | Nasty #ifdefery that generates the definitions for
---     freeReg and globalRegMaybe from the information in includes/MachRegs.h.
---     
---     If the current TARGET_ARCH isn't sparc then these functions will be wrong.
---
-module SPARC.RegPlate (
-       freeReg,
-       globalRegMaybe
-)
-
-where
-
-#include "HsVersions.h"
-
-import Reg
-import CmmExpr
-import FastBool
-
--- Register numbers for SPARC hardware registers.
---     These names are the same as the ones in Regs.hs, but those have
---     type Reg and not RegNo.
---
-#ifdef sparc_TARGET_ARCH
-
-#define g0     0
-#define g1     1
-#define g2     2
-#define g3     3
-#define g4     4
-#define g5     5
-#define g6     6
-#define g7     7
-
-#define o0     8
-#define o1     9       
-#define o2     10
-#define o3     11
-#define o4     12
-#define o5     13
-#define o6     14
-#define o7     15
-
-#define l0     16
-#define l1     17
-#define l2     18
-#define l3     19
-#define l4     20
-#define l5     21
-#define l6     22
-#define l7     23
-
-#define i0     24
-#define i1     25
-#define i2     26
-#define i3     27
-#define i4     28
-#define i5     29
-#define i6     30
-#define i7     31
-
-#define f0     32
-#define f1     33
-#define f2     34
-#define f3     35
-#define f4     36
-#define f5     37
-#define f6     38
-#define f7     39
-#define f8     40
-#define f9     41
-#define f10    42
-#define f11    43
-#define f12    44
-#define f13    45
-#define f14    46
-#define f15    47
-#define f16    48
-#define f17    49
-#define f18    50
-#define f19    51
-#define f20    52
-#define f21    53
-#define f22    54
-#define f23    55
-#define f24    56
-#define f25    57
-#define f26    58
-#define f27    59
-#define f28    60
-#define f29    61
-#define f30    62
-#define f31    63
-
-
-#include "../includes/stg/HaskellMachRegs.h"
-
--- | Check whether a machine register is free for allocation.
-freeReg :: RegNo -> FastBool
-
-
--- SPARC regs used by the OS / ABI
--- %g0(r0) is always zero
-freeReg g0     = fastBool False
-
--- %g5(r5) - %g7(r7) 
---     are reserved for the OS
-freeReg g5     = fastBool False
-freeReg g6     = fastBool False
-freeReg g7     = fastBool False
-
--- %o6(r14) 
---     is the C stack pointer
-freeReg        o6      = fastBool False
-
--- %o7(r15) 
---     holds the C return address
-freeReg        o7      = fastBool False
-
--- %i6(r30) 
---     is the C frame pointer
-freeReg        i6      = fastBool False
-
--- %i7(r31) 
---     is used for C return addresses
-freeReg        i7      = fastBool False
-
--- %f0(r32) - %f1(r32)
---     are C floating point return regs
-freeReg f0     = fastBool False
-freeReg f1     = fastBool False
-       
-{-
-freeReg regNo
-       -- don't release high half of double regs
-       | regNo >= f0
-       , regNo <  NCG_FirstFloatReg
-       , regNo `mod` 2 /= 0
-       = fastBool False
--}
---------------------------------------
-
-
-#ifdef REG_Base
-freeReg REG_Base = fastBool False
-#endif
-#ifdef REG_R1
-freeReg REG_R1 = fastBool False
-#endif 
-#ifdef REG_R2  
-freeReg REG_R2 = fastBool False
-#endif 
-#ifdef REG_R3  
-freeReg REG_R3 = fastBool False
-#endif 
-#ifdef REG_R4  
-freeReg REG_R4 = fastBool False
-#endif 
-#ifdef REG_R5  
-freeReg REG_R5 = fastBool False
-#endif 
-#ifdef REG_R6  
-freeReg REG_R6 = fastBool False
-#endif 
-#ifdef REG_R7  
-freeReg REG_R7 = fastBool False
-#endif 
-#ifdef REG_R8  
-freeReg REG_R8 = fastBool False
-#endif
-#ifdef REG_R9
-freeReg REG_R9 = fastBool False
-#endif
-#ifdef REG_R10
-freeReg REG_R10        = fastBool False
-#endif
-#ifdef REG_F1
-freeReg REG_F1 = fastBool False
-#endif
-#ifdef REG_F2
-freeReg REG_F2 = fastBool False
-#endif
-#ifdef REG_F3
-freeReg REG_F3 = fastBool False
-#endif
-#ifdef REG_F4
-freeReg REG_F4 = fastBool False
-#endif
-#ifdef REG_D1
-freeReg REG_D1 = fastBool False
-#endif
-#ifdef REG_D1_2
-freeReg REG_D1_2 = fastBool False
-#endif
-#ifdef REG_D2
-freeReg REG_D2 = fastBool False
-#endif
-#ifdef REG_D2_2
-freeReg REG_D2_2 = fastBool False
-#endif
-#ifdef REG_Sp 
-freeReg REG_Sp = fastBool False
-#endif 
-#ifdef REG_Su
-freeReg REG_Su = fastBool False
-#endif 
-#ifdef REG_SpLim 
-freeReg REG_SpLim = fastBool False
-#endif 
-#ifdef REG_Hp 
-freeReg REG_Hp = fastBool False
-#endif
-#ifdef REG_HpLim
-freeReg REG_HpLim = fastBool False
-#endif
-freeReg _      = fastBool True
-
-
-
---  | Returns 'Nothing' if this global register is not stored
--- in a real machine register, otherwise returns @'Just' reg@, where
--- reg is the machine register it is stored in.
-
-
-globalRegMaybe :: GlobalReg -> Maybe RealReg
-
-#ifdef REG_Base
-globalRegMaybe BaseReg                 = Just (RealRegSingle REG_Base)
-#endif
-#ifdef REG_R1
-globalRegMaybe (VanillaReg 1 _)                = Just (RealRegSingle REG_R1)
-#endif 
-#ifdef REG_R2 
-globalRegMaybe (VanillaReg 2 _)                = Just (RealRegSingle REG_R2)
-#endif 
-#ifdef REG_R3 
-globalRegMaybe (VanillaReg 3 _)        = Just (RealRegSingle REG_R3)
-#endif 
-#ifdef REG_R4 
-globalRegMaybe (VanillaReg 4 _)                = Just (RealRegSingle REG_R4)
-#endif 
-#ifdef REG_R5 
-globalRegMaybe (VanillaReg 5 _)                = Just (RealRegSingle REG_R5)
-#endif 
-#ifdef REG_R6 
-globalRegMaybe (VanillaReg 6 _)                = Just (RealRegSingle REG_R6)
-#endif 
-#ifdef REG_R7 
-globalRegMaybe (VanillaReg 7 _)                = Just (RealRegSingle REG_R7)
-#endif 
-#ifdef REG_R8 
-globalRegMaybe (VanillaReg 8 _)                = Just (RealRegSingle REG_R8)
-#endif
-#ifdef REG_R9 
-globalRegMaybe (VanillaReg 9 _)                = Just (RealRegSingle REG_R9)
-#endif
-#ifdef REG_R10 
-globalRegMaybe (VanillaReg 10 _)       = Just (RealRegSingle REG_R10)
-#endif
-#ifdef REG_F1
-globalRegMaybe (FloatReg 1)            = Just (RealRegSingle REG_F1)
-#endif                                 
-#ifdef REG_F2                          
-globalRegMaybe (FloatReg 2)            = Just (RealRegSingle REG_F2)
-#endif                                 
-#ifdef REG_F3                          
-globalRegMaybe (FloatReg 3)            = Just (RealRegSingle REG_F3)
-#endif                                 
-#ifdef REG_F4                          
-globalRegMaybe (FloatReg 4)            = Just (RealRegSingle REG_F4)
-#endif                                 
-#ifdef REG_D1                          
-globalRegMaybe (DoubleReg 1)           = Just (RealRegPair REG_D1 (REG_D1 + 1))
-#endif                                 
-#ifdef REG_D2                          
-globalRegMaybe (DoubleReg 2)           = Just (RealRegPair REG_D2 (REG_D2 + 1))
-#endif
-#ifdef REG_Sp      
-globalRegMaybe Sp                      = Just (RealRegSingle REG_Sp)
-#endif
-#ifdef REG_Lng1                                
-globalRegMaybe (LongReg 1)             = Just (RealRegSingle REG_Lng1)
-#endif                                 
-#ifdef REG_Lng2                                
-globalRegMaybe (LongReg 2)             = Just (RealRegSingle REG_Lng2)
-#endif
-#ifdef REG_SpLim                               
-globalRegMaybe SpLim                   = Just (RealRegSingle REG_SpLim)
-#endif                                 
-#ifdef REG_Hp                          
-globalRegMaybe Hp                      = Just (RealRegSingle REG_Hp)
-#endif                                 
-#ifdef REG_HpLim                       
-globalRegMaybe HpLim                   = Just (RealRegSingle REG_HpLim)
-#endif                                 
-#ifdef REG_CurrentTSO                          
-globalRegMaybe CurrentTSO              = Just (RealRegSingle REG_CurrentTSO)
-#endif                                 
-#ifdef REG_CurrentNursery                              
-globalRegMaybe CurrentNursery          = Just (RealRegSingle REG_CurrentNursery)
-#endif                                 
-globalRegMaybe _                       = Nothing
-
-#else
-freeReg :: RegNo -> FastBool
-freeReg                = error "SPARC.RegPlate.freeReg: not defined"
-
-globalRegMaybe :: GlobalReg -> Maybe RealReg
-globalRegMaybe = error "SPARC.RegPlate.globalRegMaybe: not defined"
-
-#endif
index ff899c2..2c34bdc 100644 (file)
@@ -39,7 +39,7 @@ module SPARC.Regs (
 where
 
 
-import SPARC.RegPlate
+import CodeGen.Platform.SPARC
 import Reg
 import RegClass
 import Size
index c00a0d5..e8f2ecc 100644 (file)
@@ -27,6 +27,7 @@ import X86.Instr
 import X86.Cond
 import X86.Regs
 import X86.RegInfo
+import CodeGen.Platform
 import CPrim
 import Instruction
 import PIC
@@ -166,14 +167,16 @@ stmtToInstrs stmt = do
     CmmCondBranch arg id  -> genCondJump id arg
     CmmSwitch arg ids     -> do dflags <- getDynFlags
                                 genSwitch dflags arg ids
-    CmmJump arg gregs     -> genJump arg (jumpRegs gregs)
+    CmmJump arg gregs     -> do dflags <- getDynFlags
+                                let platform = targetPlatform dflags
+                                genJump arg (jumpRegs platform gregs)
     CmmReturn             ->
       panic "stmtToInstrs: return statement should have been cps'd away"
 
 
-jumpRegs :: Maybe [GlobalReg] -> [Reg]
-jumpRegs Nothing      = allHaskellArgRegs
-jumpRegs (Just gregs) = [ RegReal r | Just r <- map globalRegMaybe gregs ]
+jumpRegs :: Platform -> Maybe [GlobalReg] -> [Reg]
+jumpRegs platform Nothing      = allHaskellArgRegs platform
+jumpRegs platform (Just gregs) = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ]
 
 --------------------------------------------------------------------------------
 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
@@ -219,16 +222,16 @@ swizzleRegisterRep (Any _ codefn)     size = Any   size codefn
 
 
 -- | Grab the Reg for a CmmReg
-getRegisterReg :: Bool -> CmmReg -> Reg
+getRegisterReg :: Platform -> Bool -> CmmReg -> Reg
 
-getRegisterReg use_sse2 (CmmLocal (LocalReg u pk))
+getRegisterReg use_sse2 (CmmLocal (LocalReg u pk))
   = let sz = cmmTypeSize pk in
     if isFloatSize sz && not use_sse2
        then RegVirtual (mkVirtualReg u FF80)
        else RegVirtual (mkVirtualReg u sz)
 
-getRegisterReg _ (CmmGlobal mid)
-  = case globalRegMaybe mid of
+getRegisterReg platform _ (CmmGlobal mid)
+  = case globalRegMaybe platform mid of
         Just reg -> RegReal $ reg
         Nothing  -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
         -- By this stage, the only MagicIds remaining should be the
@@ -424,7 +427,9 @@ getRegister' is32Bit (CmmReg reg)
                  size | not use_sse2 && isFloatSize sz = FF80
                       | otherwise                      = sz
                --
-               return (Fixed size (getRegisterReg use_sse2 reg) nilOL)
+               dflags <- getDynFlags
+               let platform = targetPlatform dflags
+               return (Fixed size (getRegisterReg platform use_sse2 reg) nilOL)
 
 
 getRegister' is32Bit (CmmRegOff r n)
@@ -1052,9 +1057,11 @@ getNonClobberedOperand (CmmLoad mem pk) = do
   if (not (isFloatType pk) || use_sse2)
       && (if is32Bit then not (isWord64 pk) else True)
     then do
+      dflags <- getDynFlags
+      let platform = targetPlatform dflags
       Amode src mem_code <- getAmode mem
       (src',save_code) <-
-        if (amodeCouldBeClobbered src)
+        if (amodeCouldBeClobbered platform src)
                 then do
                    tmp <- getNewRegNat (archWordSize is32Bit)
                    return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0),
@@ -1072,12 +1079,12 @@ getNonClobberedOperand_generic e = do
     (reg, code) <- getNonClobberedReg e
     return (OpReg reg, code)
 
-amodeCouldBeClobbered :: AddrMode -> Bool
-amodeCouldBeClobbered amode = any regClobbered (addrModeRegs amode)
+amodeCouldBeClobbered :: Platform -> AddrMode -> Bool
+amodeCouldBeClobbered platform amode = any (regClobbered platform) (addrModeRegs amode)
 
-regClobbered :: Reg -> Bool
-regClobbered (RegReal (RealRegSingle rr)) = isFastTrue (freeReg rr)
-regClobbered _ = False
+regClobbered :: Platform -> Reg -> Bool
+regClobbered platform (RegReal (RealRegSingle rr)) = isFastTrue (freeReg platform rr)
+regClobbered _ = False
 
 -- getOperand: the operand is not required to remain valid across the
 -- computation of an arbitrary expression.
@@ -1385,12 +1392,16 @@ assignMem_IntCode pk addr src = do
 -- Assign; dst is a reg, rhs is mem
 assignReg_IntCode pk reg (CmmLoad src _) = do
   load_code <- intLoadCode (MOV pk) src
-  return (load_code (getRegisterReg False{-no sse2-} reg))
+  dflags <- getDynFlags
+  let platform = targetPlatform dflags
+  return (load_code (getRegisterReg platform False{-no sse2-} reg))
 
 -- dst is a reg, but src could be anything
 assignReg_IntCode _ reg src = do
+  dflags <- getDynFlags
+  let platform = targetPlatform dflags
   code <- getAnyReg src
-  return (code (getRegisterReg False{-no sse2-} reg))
+  return (code (getRegisterReg platform False{-no sse2-} reg))
 
 
 -- Floating point assignment to memory
@@ -1409,7 +1420,9 @@ assignMem_FltCode pk addr src = do
 assignReg_FltCode _ reg src = do
   use_sse2 <- sse2Enabled
   src_code <- getAnyReg src
-  return (src_code (getRegisterReg use_sse2 reg))
+  dflags <- getDynFlags
+  let platform = targetPlatform dflags
+  return (src_code (getRegisterReg platform use_sse2 reg))
 
 
 genJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock
@@ -1594,6 +1607,8 @@ genCCall _ (CmmPrim MO_WriteBarrier _) _ _ = return nilOL
 genCCall is32Bit (CmmPrim (MO_PopCnt width) _) dest_regs@[CmmHinted dst _]
          args@[CmmHinted src _] = do
     sse4_2 <- sse4_2Enabled
+    dflags <- getDynFlags
+    let platform = targetPlatform dflags
     if sse4_2
         then do code_src <- getAnyReg src
                 src_r <- getNewRegNat size
@@ -1602,12 +1617,11 @@ genCCall is32Bit (CmmPrim (MO_PopCnt width) _) dest_regs@[CmmHinted dst _]
                          -- The POPCNT instruction doesn't take a r/m8
                          unitOL (MOVZxL II8 (OpReg src_r) (OpReg src_r)) `appOL`
                          unitOL (POPCNT II16 (OpReg src_r)
-                                 (getRegisterReg False (CmmLocal dst)))
+                                 (getRegisterReg platform False (CmmLocal dst)))
                      else
                          unitOL (POPCNT size (OpReg src_r)
-                                 (getRegisterReg False (CmmLocal dst))))
+                                 (getRegisterReg platform False (CmmLocal dst))))
         else do
-            dflags <- getDynFlags
             targetExpr <- cmmMakeDynamicReference dflags addImportNat
                           CallReference lbl
             let target = CmmCallee targetExpr CCallConv
@@ -1624,8 +1638,10 @@ genCCall32 :: CmmCallTarget            -- function to call
            -> [HintedCmmFormal]        -- where to put the result
            -> [HintedCmmActual]        -- arguments (of mixed type)
            -> NatM InstrBlock
-genCCall32 target dest_regs args =
-    case (target, dest_regs) of
+genCCall32 target dest_regs args = do
+  dflags <- getDynFlags
+  let platform = targetPlatform dflags
+  case (target, dest_regs) of
     -- void return type prim op
     (CmmPrim op _, []) ->
         outOfLineCmmOp op Nothing args
@@ -1656,23 +1672,23 @@ genCCall32 target dest_regs args =
         actuallyInlineFloatOp instr size [CmmHinted x _]
               = do res <- trivialUFCode size (instr size) x
                    any <- anyReg res
-                   return (any (getRegisterReg False (CmmLocal r)))
+                   return (any (getRegisterReg platform False (CmmLocal r)))
 
         actuallyInlineFloatOp _ _ args
               = panic $ "genCCall32.actuallyInlineFloatOp: bad number of arguments! ("
                       ++ show (length args) ++ ")"
 
-    (CmmPrim (MO_S_QuotRem  width) _, _) -> divOp1 True  width dest_regs args
-    (CmmPrim (MO_U_QuotRem  width) _, _) -> divOp1 False width dest_regs args
-    (CmmPrim (MO_U_QuotRem2 width) _, _) -> divOp2 False width dest_regs args
+    (CmmPrim (MO_S_QuotRem  width) _, _) -> divOp1 platform True  width dest_regs args
+    (CmmPrim (MO_U_QuotRem  width) _, _) -> divOp1 platform False width dest_regs args
+    (CmmPrim (MO_U_QuotRem2 width) _, _) -> divOp2 platform False width dest_regs args
     (CmmPrim (MO_Add2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) ->
         case args of
         [CmmHinted arg_x _, CmmHinted arg_y _] ->
             do hCode <- getAnyReg (CmmLit (CmmInt 0 width))
                lCode <- getAnyReg (CmmMachOp (MO_Add width) [arg_x, arg_y])
                let size = intSize width
-                   reg_l = getRegisterReg True (CmmLocal res_l)
-                   reg_h = getRegisterReg True (CmmLocal res_h)
+                   reg_l = getRegisterReg platform True (CmmLocal res_l)
+                   reg_h = getRegisterReg platform True (CmmLocal res_h)
                    code = hCode reg_h `appOL`
                           lCode reg_l `snocOL`
                           ADC size (OpImm (ImmInteger 0)) (OpReg reg_h)
@@ -1684,8 +1700,8 @@ genCCall32 target dest_regs args =
             do (y_reg, y_code) <- getRegOrMem arg_y
                x_code <- getAnyReg arg_x
                let size = intSize width
-                   reg_h = getRegisterReg True (CmmLocal res_h)
-                   reg_l = getRegisterReg True (CmmLocal res_l)
+                   reg_h = getRegisterReg platform True (CmmLocal res_h)
+                   reg_l = getRegisterReg platform True (CmmLocal res_l)
                    code = y_code `appOL`
                           x_code rax `appOL`
                           toOL [MUL2 size y_reg,
@@ -1699,21 +1715,21 @@ genCCall32 target dest_regs args =
 
     _ -> genCCall32' target dest_regs args
 
-  where divOp1 signed width results [CmmHinted arg_x _, CmmHinted arg_y _]
-            = divOp signed width results Nothing arg_x arg_y
-        divOp1 _ _ _ _
+  where divOp1 platform signed width results [CmmHinted arg_x _, CmmHinted arg_y _]
+            = divOp platform signed width results Nothing arg_x arg_y
+        divOp1 _ _ _ _ _
             = panic "genCCall32: Wrong number of arguments for divOp1"
-        divOp2 signed width results [CmmHinted arg_x_high _,
-                                     CmmHinted arg_x_low _,
-                                     CmmHinted arg_y _]
-            = divOp signed width results (Just arg_x_high) arg_x_low arg_y
-        divOp2 _ _ _ _
+        divOp2 platform signed width results [CmmHinted arg_x_high _,
+                                              CmmHinted arg_x_low _,
+                                              CmmHinted arg_y _]
+            = divOp platform signed width results (Just arg_x_high) arg_x_low arg_y
+        divOp2 _ _ _ _ _
             = panic "genCCall64: Wrong number of arguments for divOp2"
-        divOp signed width [CmmHinted res_q _, CmmHinted res_r _]
-                           m_arg_x_high arg_x_low arg_y
+        divOp platform signed width [CmmHinted res_q _, CmmHinted res_r _]
+              m_arg_x_high arg_x_low arg_y
             = do let size = intSize width
-                     reg_q = getRegisterReg True (CmmLocal res_q)
-                     reg_r = getRegisterReg True (CmmLocal res_r)
+                     reg_q = getRegisterReg platform True (CmmLocal res_q)
+                     reg_r = getRegisterReg platform True (CmmLocal res_r)
                      widen | signed    = CLTD size
                            | otherwise = XOR size (OpReg rdx) (OpReg rdx)
                      instr | signed    = IDIV
@@ -1731,7 +1747,7 @@ genCCall32 target dest_regs args =
                           toOL [instr size y_reg,
                                 MOV size (OpReg rax) (OpReg reg_q),
                                 MOV size (OpReg rdx) (OpReg reg_r)]
-        divOp _ _ _ _ _ _
+        divOp _ _ _ _ _ _ _
             = panic "genCCall32: Wrong number of results for divOp"
 
 genCCall32' :: CmmCallTarget            -- function to call
@@ -1795,6 +1811,9 @@ genCCall32' target dest_regs args = do
                    )
         setDeltaNat delta0
 
+        dflags <- getDynFlags
+        let platform = targetPlatform dflags
+
         let
             -- assign the results, if necessary
             assign_code []     = nilOL
@@ -1820,7 +1839,7 @@ genCCall32' target dest_regs args = do
                     w  = typeWidth ty
                     b  = widthInBytes w
                     r_dest_hi = getHiVRegFromLo r_dest
-                    r_dest    = getRegisterReg use_sse2 (CmmLocal dest)
+                    r_dest    = getRegisterReg platform use_sse2 (CmmLocal dest)
             assign_code many = pprPanic "genCCall.assign_code - too many return values:" (ppr many)
 
         return (push_code `appOL`
@@ -1884,8 +1903,10 @@ genCCall64 :: CmmCallTarget            -- function to call
            -> [HintedCmmFormal]        -- where to put the result
            -> [HintedCmmActual]        -- arguments (of mixed type)
            -> NatM InstrBlock
-genCCall64 target dest_regs args =
-    case (target, dest_regs) of
+genCCall64 target dest_regs args = do
+  dflags <- getDynFlags
+  let platform = targetPlatform dflags
+  case (target, dest_regs) of
 
     (CmmPrim op _, []) ->
         -- void return type prim op
@@ -1895,17 +1916,17 @@ genCCall64 target dest_regs args =
         -- we only cope with a single result for foreign calls
         outOfLineCmmOp op (Just res) args
 
-    (CmmPrim (MO_S_QuotRem  width) _, _) -> divOp1 True  width dest_regs args
-    (CmmPrim (MO_U_QuotRem  width) _, _) -> divOp1 False width dest_regs args
-    (CmmPrim (MO_U_QuotRem2 width) _, _) -> divOp2 False width dest_regs args
+    (CmmPrim (MO_S_QuotRem  width) _, _) -> divOp1 platform True  width dest_regs args
+    (CmmPrim (MO_U_QuotRem  width) _, _) -> divOp1 platform False width dest_regs args
+    (CmmPrim (MO_U_QuotRem2 width) _, _) -> divOp2 platform False width dest_regs args
     (CmmPrim (MO_Add2 width) _, [CmmHinted res_h _, CmmHinted res_l _]) ->
         case args of
         [CmmHinted arg_x _, CmmHinted arg_y _] ->
             do hCode <- getAnyReg (CmmLit (CmmInt 0 width))
                lCode <- getAnyReg (CmmMachOp (MO_Add width) [arg_x, arg_y])
                let size = intSize width
-                   reg_l = getRegisterReg True (CmmLocal res_l)
-                   reg_h = getRegisterReg True (CmmLocal res_h)
+                   reg_l = getRegisterReg platform True (CmmLocal res_l)
+                   reg_h = getRegisterReg platform True (CmmLocal res_h)
                    code = hCode reg_h `appOL`
                           lCode reg_l `snocOL`
                           ADC size (OpImm (ImmInteger 0)) (OpReg reg_h)
@@ -1917,8 +1938,8 @@ genCCall64 target dest_regs args =
             do (y_reg, y_code) <- getRegOrMem arg_y
                x_code <- getAnyReg arg_x
                let size = intSize width
-                   reg_h = getRegisterReg True (CmmLocal res_h)
-                   reg_l = getRegisterReg True (CmmLocal res_l)
+                   reg_h = getRegisterReg platform True (CmmLocal res_h)
+                   reg_l = getRegisterReg platform True (CmmLocal res_l)
                    code = y_code `appOL`
                           x_code rax `appOL`
                           toOL [MUL2 size y_reg,
@@ -1935,21 +1956,21 @@ genCCall64 target dest_regs args =
            let platform = targetPlatform dflags
            genCCall64' platform target dest_regs args
 
-  where divOp1 signed width results [CmmHinted arg_x _, CmmHinted arg_y _]
-            = divOp signed width results Nothing arg_x arg_y
-        divOp1 _ _ _ _
+  where divOp1 platform signed width results [CmmHinted arg_x _, CmmHinted arg_y _]
+            = divOp platform signed width results Nothing arg_x arg_y
+        divOp1 _ _ _ _ _
             = panic "genCCall64: Wrong number of arguments for divOp1"
-        divOp2 signed width results [CmmHinted arg_x_high _,
-                                     CmmHinted arg_x_low _,
-                                     CmmHinted arg_y _]
-            = divOp signed width results (Just arg_x_high) arg_x_low arg_y
-        divOp2 _ _ _ _
+        divOp2 platform signed width results [CmmHinted arg_x_high _,
+                                              CmmHinted arg_x_low _,
+                                              CmmHinted arg_y _]
+            = divOp platform signed width results (Just arg_x_high) arg_x_low arg_y
+        divOp2 _ _ _ _ _
             = panic "genCCall64: Wrong number of arguments for divOp2"
-        divOp signed width [CmmHinted res_q _, CmmHinted res_r _]
-                           m_arg_x_high arg_x_low arg_y
+        divOp platform signed width [CmmHinted res_q _, CmmHinted res_r _]
+              m_arg_x_high arg_x_low arg_y
             = do let size = intSize width
-                     reg_q = getRegisterReg True (CmmLocal res_q)
-                     reg_r = getRegisterReg True (CmmLocal res_r)
+                     reg_q = getRegisterReg platform True (CmmLocal res_q)
+                     reg_r = getRegisterReg platform True (CmmLocal res_r)
                      widen | signed    = CLTD size
                            | otherwise = XOR size (OpReg rdx) (OpReg rdx)
                      instr | signed    = IDIV
@@ -1965,7 +1986,7 @@ genCCall64 target dest_regs args =
                           toOL [instr size y_reg,
                                 MOV size (OpReg rax) (OpReg reg_q),
                                 MOV size (OpReg rdx) (OpReg reg_r)]
-        divOp _ _ _ _ _ _
+        divOp _ _ _ _ _ _ _
             = panic "genCCall64: Wrong number of results for divOp"
 
 genCCall64' :: Platform
@@ -2065,7 +2086,7 @@ genCCall64' platform target dest_regs args = do
                 _ -> unitOL (MOV (cmmTypeSize rep) (OpReg rax) (OpReg r_dest))
           where
                 rep = localRegType dest
-                r_dest = getRegisterReg True (CmmLocal dest)
+                r_dest = getRegisterReg platform True (CmmLocal dest)
         assign_code _many = panic "genCCall.assign_code many"
 
     return (load_args_code      `appOL`
index 91d6ae4..c8066e1 100644 (file)
@@ -24,6 +24,7 @@ import Reg
 import TargetReg
 
 import BlockId
+import CodeGen.Platform
 import OldCmm
 import FastString
 import FastBool
@@ -449,16 +450,16 @@ x86_regUsageOfInstr platform instr
               use_index (EAIndex i _) tl = i : tl
 
     mkRUR src = src' `seq` RU src' []
-        where src' = filter interesting src
+        where src' = filter (interesting platform) src
 
     mkRU src dst = src' `seq` dst' `seq` RU src' dst'
-        where src' = filter interesting src
-              dst' = filter interesting dst
+        where src' = filter (interesting platform) src
+              dst' = filter (interesting platform) dst
 
-interesting :: Reg -> Bool
-interesting (RegVirtual _)              = True
-interesting (RegReal (RealRegSingle i)) = isFastTrue (freeReg i)
-interesting (RegReal (RealRegPair{}))   = panic "X86.interesting: no reg pairs on this arch"
+interesting :: Platform -> Reg -> Bool
+interesting _        (RegVirtual _)              = True
+interesting platform (RegReal (RealRegSingle i)) = isFastTrue (freeReg platform i)
+interesting _        (RegReal (RealRegPair{}))   = panic "X86.interesting: no reg pairs on this arch"
 
 
 
index a53c4fc..16938a8 100644 (file)
@@ -39,10 +39,6 @@ module X86.Regs (
         ripRel,
         allFPArgRegs,
 
-        -- horror show
-        freeReg,
-        globalRegMaybe,
-
         allocatableRegs
 )
 
@@ -51,19 +47,7 @@ where
 #include "nativeGen/NCG.h"
 #include "HsVersions.h"
 
-#if i386_TARGET_ARCH == 0 && x86_64_TARGET_ARCH == 0
--- Compiling for some arch other than Intel so we choose x86-64 as default.
-#undef arm_TARGET_ARCH
-#undef powerpc_TARGET_ARCH
-#undef powerpc64_TARGET_ARCH
-#undef sparc_TARGET_ARCH
-
-#undef x86_64_TARGET_ARCH
-#define x86_64_TARGET_ARCH 1
-#endif
-
-#include "../includes/stg/HaskellMachRegs.h"
-
+import CodeGen.Platform
 import Reg
 import RegClass
 
@@ -416,10 +400,6 @@ xmm n = regSingle (firstxmm+n)
 
 
 
--- horror show -----------------------------------------------------------------
-freeReg                 :: RegNo -> FastBool
-globalRegMaybe          :: GlobalReg -> Maybe RealReg
-
 -- | these are the regs which we cannot assume stay alive over a C call.
 callClobberedRegs       :: Platform -> [Reg]
 -- caller-saves registers
@@ -457,203 +437,17 @@ instrClobberedRegs platform
  | target32Bit platform = [ eax, ecx, edx ]
  | otherwise            = [ rax, rcx, rdx ]
 
-#if i386_TARGET_ARCH
-#define eax 0
-#define ebx 1
-#define ecx 2
-#define edx 3
-#define esi 4
-#define edi 5
-#define ebp 6
-#define esp 7
-#endif
-
-#if x86_64_TARGET_ARCH
-#define rax   0
-#define rbx   1
-#define rcx   2
-#define rdx   3
-#define rsi   4
-#define rdi   5
-#define rbp   6
-#define rsp   7
-#define r8    8
-#define r9    9
-#define r10   10
-#define r11   11
-#define r12   12
-#define r13   13
-#define r14   14
-#define r15   15
-#endif
-
-#define fake0 16
-#define fake1 17
-#define fake2 18
-#define fake3 19
-#define fake4 20
-#define fake5 21
-
-#define xmm0  24
-#define xmm1  25
-#define xmm2  26
-#define xmm3  27
-#define xmm4  28
-#define xmm5  29
-#define xmm6  30
-#define xmm7  31
-#define xmm8  32
-#define xmm9  33
-#define xmm10 34
-#define xmm11 35
-#define xmm12 36
-#define xmm13 37
-#define xmm14 38
-#define xmm15 39
-
-#if i386_TARGET_ARCH
-freeReg esp = fastBool False  --        %esp is the C stack pointer
-#endif
-
-#if i386_TARGET_ARCH
-freeReg esi = fastBool False -- Note [esi/edi not allocatable]
-freeReg edi = fastBool False
-#endif
-
-#if x86_64_TARGET_ARCH
-freeReg rsp = fastBool False  --        %rsp is the C stack pointer
-#endif
-
--- split patterns in two functions to prevent overlaps
-freeReg r         = freeRegBase r
-
-freeRegBase :: RegNo -> FastBool
-
-#ifdef REG_Base
-freeRegBase REG_Base = fastBool False
-#endif
-#ifdef REG_Sp
-freeRegBase REG_Sp   = fastBool False
-#endif
-#ifdef REG_SpLim
-freeRegBase REG_SpLim = fastBool False
-#endif
-#ifdef REG_Hp
-freeRegBase REG_Hp   = fastBool False
-#endif
-#ifdef REG_HpLim
-freeRegBase REG_HpLim = fastBool False
-#endif
-
--- All other regs are considered to be "free", because we can track
--- their liveness accurately.
-freeRegBase _ = fastBool True
-
---  | Returns 'Nothing' if this global register is not stored
--- in a real machine register, otherwise returns @'Just' reg@, where
--- reg is the machine register it is stored in.
-
-#ifdef REG_Base
-globalRegMaybe BaseReg                  = Just (RealRegSingle REG_Base)
-#endif
-#ifdef REG_R1
-globalRegMaybe (VanillaReg 1 _)         = Just (RealRegSingle REG_R1)
-#endif
-#ifdef REG_R2
-globalRegMaybe (VanillaReg 2 _)         = Just (RealRegSingle REG_R2)
-#endif
-#ifdef REG_R3
-globalRegMaybe (VanillaReg 3 _)         = Just (RealRegSingle REG_R3)
-#endif
-#ifdef REG_R4
-globalRegMaybe (VanillaReg 4 _)         = Just (RealRegSingle REG_R4)
-#endif
-#ifdef REG_R5
-globalRegMaybe (VanillaReg 5 _)         = Just (RealRegSingle REG_R5)
-#endif
-#ifdef REG_R6
-globalRegMaybe (VanillaReg 6 _)         = Just (RealRegSingle REG_R6)
-#endif
-#ifdef REG_R7
-globalRegMaybe (VanillaReg 7 _)         = Just (RealRegSingle REG_R7)
-#endif
-#ifdef REG_R8
-globalRegMaybe (VanillaReg 8 _)         = Just (RealRegSingle REG_R8)
-#endif
-#ifdef REG_R9
-globalRegMaybe (VanillaReg 9 _)         = Just (RealRegSingle REG_R9)
-#endif
-#ifdef REG_R10
-globalRegMaybe (VanillaReg 10 _)        = Just (RealRegSingle REG_R10)
-#endif
-#ifdef REG_F1
-globalRegMaybe (FloatReg 1)             = Just (RealRegSingle REG_F1)
-#endif
-#ifdef REG_F2
-globalRegMaybe (FloatReg 2)             = Just (RealRegSingle REG_F2)
-#endif
-#ifdef REG_F3
-globalRegMaybe (FloatReg 3)             = Just (RealRegSingle REG_F3)
-#endif
-#ifdef REG_F4
-globalRegMaybe (FloatReg 4)             = Just (RealRegSingle REG_F4)
-#endif
-#ifdef REG_D1
-globalRegMaybe (DoubleReg 1)            = Just (RealRegSingle REG_D1)
-#endif
-#ifdef REG_D2
-globalRegMaybe (DoubleReg 2)            = Just (RealRegSingle REG_D2)
-#endif
-#ifdef REG_Sp
-globalRegMaybe Sp                       = Just (RealRegSingle REG_Sp)
-#endif
-#ifdef REG_Lng1
-globalRegMaybe (LongReg 1)              = Just (RealRegSingle REG_Lng1)
-#endif
-#ifdef REG_Lng2
-globalRegMaybe (LongReg 2)              = Just (RealRegSingle REG_Lng2)
-#endif
-#ifdef REG_SpLim
-globalRegMaybe SpLim                    = Just (RealRegSingle REG_SpLim)
-#endif
-#ifdef REG_Hp
-globalRegMaybe Hp                       = Just (RealRegSingle REG_Hp)
-#endif
-#ifdef REG_HpLim
-globalRegMaybe HpLim                    = Just (RealRegSingle REG_HpLim)
-#endif
-#ifdef REG_CurrentTSO
-globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)
-#endif
-#ifdef REG_CurrentNursery
-globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)
-#endif
-globalRegMaybe _                        = Nothing
-
 --
 
 -- All machine registers that are used for argument-passing to Haskell functions
-allHaskellArgRegs :: [Reg]
-allHaskellArgRegs = [ RegReal r | Just r <- map globalRegMaybe globalArgRegs ]
+allHaskellArgRegs :: Platform -> [Reg]
+allHaskellArgRegs platform = [ RegReal r | Just r <- map (globalRegMaybe platform) globalArgRegs ]
 
 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
 -- i.e., these are the regs for which we are prepared to allow the
 -- register allocator to attempt to map VRegs to.
 allocatableRegs :: Platform -> [RealReg]
 allocatableRegs platform
-   = let isFree i = isFastTrue (freeReg i)
+   = let isFree i = isFastTrue (freeReg platform i)
      in  map RealRegSingle $ filter isFree (allMachRegNos platform)
 
-{-
-Note [esi/edi not allocatable]
-
-%esi is mapped to R1, so %esi would normally be allocatable while it
-is not being used for R1.  However, %esi has no 8-bit version on x86,
-and the linear register allocator is not sophisticated enough to
-handle this irregularity (we need more RegClasses).  The
-graph-colouring allocator also cannot handle this - it was designed
-with more flexibility in mind, but the current implementation is
-restricted to the same set of classes as the linear allocator.
-
-Hence, on x86 esi and edi are treated as not allocatable.
--}
index 7b29ede..0ba57a4 100644 (file)
@@ -1,5 +1,244 @@
 
-#include <stg/MachRegs.h>
+import CmmExpr
+import FastBool
+#if !(MACHREGS_i386 || MACHREGS_x86_64 || MACHREGS_sparc || MACHREGS_powerpc)
+import Panic
+#endif
+import Reg
+
+#include "stg/MachRegs.h"
+
+#if MACHREGS_i386 || MACHREGS_x86_64
+
+# if MACHREGS_i386
+#  define eax 0
+#  define ebx 1
+#  define ecx 2
+#  define edx 3
+#  define esi 4
+#  define edi 5
+#  define ebp 6
+#  define esp 7
+# endif
+
+# if MACHREGS_x86_64
+#  define rax   0
+#  define rbx   1
+#  define rcx   2
+#  define rdx   3
+#  define rsi   4
+#  define rdi   5
+#  define rbp   6
+#  define rsp   7
+#  define r8    8
+#  define r9    9
+#  define r10   10
+#  define r11   11
+#  define r12   12
+#  define r13   13
+#  define r14   14
+#  define r15   15
+# endif
+
+# define fake0 16
+# define fake1 17
+# define fake2 18
+# define fake3 19
+# define fake4 20
+# define fake5 21
+
+# define xmm0  24
+# define xmm1  25
+# define xmm2  26
+# define xmm3  27
+# define xmm4  28
+# define xmm5  29
+# define xmm6  30
+# define xmm7  31
+# define xmm8  32
+# define xmm9  33
+# define xmm10 34
+# define xmm11 35
+# define xmm12 36
+# define xmm13 37
+# define xmm14 38
+# define xmm15 39
+
+#elif MACHREGS_powerpc
+
+# define r0 0
+# define r1 1
+# define r2 2
+# define r3 3
+# define r4 4
+# define r5 5
+# define r6 6
+# define r7 7
+# define r8 8
+# define r9 9
+# define r10 10
+# define r11 11
+# define r12 12
+# define r13 13
+# define r14 14
+# define r15 15
+# define r16 16
+# define r17 17
+# define r18 18
+# define r19 19
+# define r20 20
+# define r21 21
+# define r22 22
+# define r23 23
+# define r24 24
+# define r25 25
+# define r26 26
+# define r27 27
+# define r28 28
+# define r29 29
+# define r30 30
+# define r31 31
+
+# if MACHREGS_darwin
+#  define f0  32
+#  define f1  33
+#  define f2  34
+#  define f3  35
+#  define f4  36
+#  define f5  37
+#  define f6  38
+#  define f7  39
+#  define f8  40
+#  define f9  41
+#  define f10 42
+#  define f11 43
+#  define f12 44
+#  define f13 45
+#  define f14 46
+#  define f15 47
+#  define f16 48
+#  define f17 49
+#  define f18 50
+#  define f19 51
+#  define f20 52
+#  define f21 53
+#  define f22 54
+#  define f23 55
+#  define f24 56
+#  define f25 57
+#  define f26 58
+#  define f27 59
+#  define f28 60
+#  define f29 61
+#  define f30 62
+#  define f31 63
+# else
+#  define fr0  32
+#  define fr1  33
+#  define fr2  34
+#  define fr3  35
+#  define fr4  36
+#  define fr5  37
+#  define fr6  38
+#  define fr7  39
+#  define fr8  40
+#  define fr9  41
+#  define fr10 42
+#  define fr11 43
+#  define fr12 44
+#  define fr13 45
+#  define fr14 46
+#  define fr15 47
+#  define fr16 48
+#  define fr17 49
+#  define fr18 50
+#  define fr19 51
+#  define fr20 52
+#  define fr21 53
+#  define fr22 54
+#  define fr23 55
+#  define fr24 56
+#  define fr25 57
+#  define fr26 58
+#  define fr27 59
+#  define fr28 60
+#  define fr29 61
+#  define fr30 62
+#  define fr31 63
+# endif
+
+#elif MACHREGS_sparc
+
+# define g0  0
+# define g1  1
+# define g2  2
+# define g3  3
+# define g4  4
+# define g5  5
+# define g6  6
+# define g7  7
+
+# define o0  8
+# define o1  9
+# define o2  10
+# define o3  11
+# define o4  12
+# define o5  13
+# define o6  14
+# define o7  15
+
+# define l0  16
+# define l1  17
+# define l2  18
+# define l3  19
+# define l4  20
+# define l5  21
+# define l6  22
+# define l7  23
+
+# define i0  24
+# define i1  25
+# define i2  26
+# define i3  27
+# define i4  28
+# define i5  29
+# define i6  30
+# define i7  31
+
+# define f0  32
+# define f1  33
+# define f2  34
+# define f3  35
+# define f4  36
+# define f5  37
+# define f6  38
+# define f7  39
+# define f8  40
+# define f9  41
+# define f10 42
+# define f11 43
+# define f12 44
+# define f13 45
+# define f14 46
+# define f15 47
+# define f16 48
+# define f17 49
+# define f18 50
+# define f19 51
+# define f20 52
+# define f21 53
+# define f22 54
+# define f23 55
+# define f24 56
+# define f25 57
+# define f26 58
+# define f27 59
+# define f28 60
+# define f29 61
+# define f30 62
+# define f31 63
+
+#endif
 
 callerSaves :: GlobalReg -> Bool
 #ifdef CALLER_SAVES_Base
@@ -150,3 +389,347 @@ haveRegBase = True
 haveRegBase = False
 #endif
 
+--  | Returns 'Nothing' if this global register is not stored
+-- in a real machine register, otherwise returns @'Just' reg@, where
+-- reg is the machine register it is stored in.
+globalRegMaybe :: GlobalReg -> Maybe RealReg
+#if MACHREGS_i386 || MACHREGS_x86_64 || MACHREGS_sparc || MACHREGS_powerpc
+# ifdef REG_Base
+globalRegMaybe BaseReg                  = Just (RealRegSingle REG_Base)
+# endif
+# ifdef REG_R1
+globalRegMaybe (VanillaReg 1 _)         = Just (RealRegSingle REG_R1)
+# endif
+# ifdef REG_R2
+globalRegMaybe (VanillaReg 2 _)         = Just (RealRegSingle REG_R2)
+# endif
+# ifdef REG_R3
+globalRegMaybe (VanillaReg 3 _)         = Just (RealRegSingle REG_R3)
+# endif
+# ifdef REG_R4
+globalRegMaybe (VanillaReg 4 _)         = Just (RealRegSingle REG_R4)
+# endif
+# ifdef REG_R5
+globalRegMaybe (VanillaReg 5 _)         = Just (RealRegSingle REG_R5)
+# endif
+# ifdef REG_R6
+globalRegMaybe (VanillaReg 6 _)         = Just (RealRegSingle REG_R6)
+# endif
+# ifdef REG_R7
+globalRegMaybe (VanillaReg 7 _)         = Just (RealRegSingle REG_R7)
+# endif
+# ifdef REG_R8
+globalRegMaybe (VanillaReg 8 _)         = Just (RealRegSingle REG_R8)
+# endif
+# ifdef REG_R9
+globalRegMaybe (VanillaReg 9 _)         = Just (RealRegSingle REG_R9)
+# endif
+# ifdef REG_R10
+globalRegMaybe (VanillaReg 10 _)        = Just (RealRegSingle REG_R10)
+# endif
+# ifdef REG_F1
+globalRegMaybe (FloatReg 1)             = Just (RealRegSingle REG_F1)
+# endif
+# ifdef REG_F2
+globalRegMaybe (FloatReg 2)             = Just (RealRegSingle REG_F2)
+# endif
+# ifdef REG_F3
+globalRegMaybe (FloatReg 3)             = Just (RealRegSingle REG_F3)
+# endif
+# ifdef REG_F4
+globalRegMaybe (FloatReg 4)             = Just (RealRegSingle REG_F4)
+# endif
+# ifdef REG_D1
+globalRegMaybe (DoubleReg 1)            =
+#  if MACHREGS_sparc
+                                          Just (RealRegPair REG_D1 (REG_D1 + 1))
+#  else
+                                          Just (RealRegSingle REG_D1)
+#  endif
+# endif
+# ifdef REG_D2
+globalRegMaybe (DoubleReg 2)            =
+#  if MACHREGS_sparc
+                                          Just (RealRegPair REG_D2 (REG_D2 + 1))
+#  else
+                                          Just (RealRegSingle REG_D2)
+#  endif
+# endif
+# ifdef REG_Sp
+globalRegMaybe Sp                       = Just (RealRegSingle REG_Sp)
+# endif
+# ifdef REG_Lng1
+globalRegMaybe (LongReg 1)              = Just (RealRegSingle REG_Lng1)
+# endif
+# ifdef REG_Lng2
+globalRegMaybe (LongReg 2)              = Just (RealRegSingle REG_Lng2)
+# endif
+# ifdef REG_SpLim
+globalRegMaybe SpLim                    = Just (RealRegSingle REG_SpLim)
+# endif
+# ifdef REG_Hp
+globalRegMaybe Hp                       = Just (RealRegSingle REG_Hp)
+# endif
+# ifdef REG_HpLim
+globalRegMaybe HpLim                    = Just (RealRegSingle REG_HpLim)
+# endif
+# ifdef REG_CurrentTSO
+globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)
+# endif
+# ifdef REG_CurrentNursery
+globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)
+# endif
+globalRegMaybe _                        = Nothing
+#else
+globalRegMaybe = panic "globalRegMaybe not defined for this platform"
+#endif
+
+freeReg :: RegNo -> FastBool
+
+#if MACHREGS_i386 || MACHREGS_x86_64
+
+# if MACHREGS_i386
+freeReg esp = fastBool False -- %esp is the C stack pointer
+freeReg esi = fastBool False -- Note [esi/edi not allocatable]
+freeReg edi = fastBool False
+# endif
+# if MACHREGS_x86_64
+freeReg rsp = fastBool False  --        %rsp is the C stack pointer
+# endif
+
+{-
+Note [esi/edi not allocatable]
+
+%esi is mapped to R1, so %esi would normally be allocatable while it
+is not being used for R1.  However, %esi has no 8-bit version on x86,
+and the linear register allocator is not sophisticated enough to
+handle this irregularity (we need more RegClasses).  The
+graph-colouring allocator also cannot handle this - it was designed
+with more flexibility in mind, but the current implementation is
+restricted to the same set of classes as the linear allocator.
+
+Hence, on x86 esi and edi are treated as not allocatable.
+-}
+
+-- split patterns in two functions to prevent overlaps
+freeReg r         = freeRegBase r
+
+freeRegBase :: RegNo -> FastBool
+# ifdef REG_Base
+freeRegBase REG_Base = fastBool False
+# endif
+# ifdef REG_Sp
+freeRegBase REG_Sp   = fastBool False
+# endif
+# ifdef REG_SpLim
+freeRegBase REG_SpLim = fastBool False
+# endif
+# ifdef REG_Hp
+freeRegBase REG_Hp   = fastBool False
+# endif
+# ifdef REG_HpLim
+freeRegBase REG_HpLim = fastBool False
+# endif
+-- All other regs are considered to be "free", because we can track
+-- their liveness accurately.
+freeRegBase _ = fastBool True
+
+#elif MACHREGS_powerpc
+
+freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns,
+                           -- but it's actually free
+freeReg 1 = fastBool False -- The Stack Pointer
+# if !MACHREGS_darwin
+-- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that
+freeReg 2 = fastBool False
+# endif
+# ifdef REG_Base
+freeReg REG_Base = fastBool False
+# endif
+# ifdef REG_R1
+freeReg REG_R1   = fastBool False
+# endif
+# ifdef REG_R2
+freeReg REG_R2   = fastBool False
+# endif
+# ifdef REG_R3
+freeReg REG_R3   = fastBool False
+# endif
+# ifdef REG_R4
+freeReg REG_R4   = fastBool False
+# endif
+# ifdef REG_R5
+freeReg REG_R5   = fastBool False
+# endif
+# ifdef REG_R6
+freeReg REG_R6   = fastBool False
+# endif
+# ifdef REG_R7
+freeReg REG_R7   = fastBool False
+# endif
+# ifdef REG_R8
+freeReg REG_R8   = fastBool False
+# endif
+# ifdef REG_R9
+freeReg REG_R9   = fastBool False
+# endif
+# ifdef REG_R10
+freeReg REG_R10  = fastBool False
+# endif
+# ifdef REG_F1
+freeReg REG_F1 = fastBool False
+# endif
+# ifdef REG_F2
+freeReg REG_F2 = fastBool False
+# endif
+# ifdef REG_F3
+freeReg REG_F3 = fastBool False
+# endif
+# ifdef REG_F4
+freeReg REG_F4 = fastBool False
+# endif
+# ifdef REG_D1
+freeReg REG_D1 = fastBool False
+# endif
+# ifdef REG_D2
+freeReg REG_D2 = fastBool False
+# endif
+# ifdef REG_Sp
+freeReg REG_Sp   = fastBool False
+# endif
+# ifdef REG_Su
+freeReg REG_Su   = fastBool False
+# endif
+# ifdef REG_SpLim
+freeReg REG_SpLim = fastBool False
+# endif
+# ifdef REG_Hp
+freeReg REG_Hp   = fastBool False
+# endif
+# ifdef REG_HpLim
+freeReg REG_HpLim = fastBool False
+# endif
+freeReg _               = fastBool True
+
+#elif MACHREGS_sparc
+
+-- SPARC regs used by the OS / ABI
+-- %g0(r0) is always zero
+freeReg g0  = fastBool False
+
+-- %g5(r5) - %g7(r7)
+--  are reserved for the OS
+freeReg g5  = fastBool False
+freeReg g6  = fastBool False
+freeReg g7  = fastBool False
+
+-- %o6(r14)
+--  is the C stack pointer
+freeReg o6  = fastBool False
+
+-- %o7(r15)
+--  holds the C return address
+freeReg o7  = fastBool False
+
+-- %i6(r30)
+--  is the C frame pointer
+freeReg i6  = fastBool False
+
+-- %i7(r31)
+--  is used for C return addresses
+freeReg i7  = fastBool False
+
+-- %f0(r32) - %f1(r32)
+--  are C floating point return regs
+freeReg f0  = fastBool False
+freeReg f1  = fastBool False
+
+{-
+freeReg regNo
+    -- don't release high half of double regs
+    | regNo >= f0
+    , regNo <  NCG_FirstFloatReg
+    , regNo `mod` 2 /= 0
+    = fastBool False
+-}
+
+# ifdef REG_Base
+freeReg REG_Base = fastBool False
+# endif
+# ifdef REG_R1
+freeReg REG_R1  = fastBool False
+# endif
+# ifdef REG_R2
+freeReg REG_R2  = fastBool False
+# endif
+# ifdef REG_R3
+freeReg REG_R3  = fastBool False
+# endif
+# ifdef REG_R4
+freeReg REG_R4  = fastBool False
+# endif
+# ifdef REG_R5
+freeReg REG_R5  = fastBool False
+# endif
+# ifdef REG_R6
+freeReg REG_R6  = fastBool False
+# endif
+# ifdef REG_R7
+freeReg REG_R7  = fastBool False
+# endif
+# ifdef REG_R8
+freeReg REG_R8  = fastBool False
+# endif
+# ifdef REG_R9
+freeReg REG_R9  = fastBool False
+# endif
+# ifdef REG_R10
+freeReg REG_R10 = fastBool False
+# endif
+# ifdef REG_F1
+freeReg REG_F1  = fastBool False
+# endif
+# ifdef REG_F2
+freeReg REG_F2  = fastBool False
+# endif
+# ifdef REG_F3
+freeReg REG_F3  = fastBool False
+# endif
+# ifdef REG_F4
+freeReg REG_F4  = fastBool False
+# endif
+# ifdef REG_D1
+freeReg REG_D1  = fastBool False
+# endif
+# ifdef REG_D1_2
+freeReg REG_D1_2 = fastBool False
+# endif
+# ifdef REG_D2
+freeReg REG_D2  = fastBool False
+# endif
+# ifdef REG_D2_2
+freeReg REG_D2_2 = fastBool False
+# endif
+# ifdef REG_Sp
+freeReg REG_Sp  = fastBool False
+# endif
+# ifdef REG_Su
+freeReg REG_Su  = fastBool False
+# endif
+# ifdef REG_SpLim
+freeReg REG_SpLim = fastBool False
+# endif
+# ifdef REG_Hp
+freeReg REG_Hp  = fastBool False
+# endif
+# ifdef REG_HpLim
+freeReg REG_HpLim = fastBool False
+# endif
+freeReg _   = fastBool True
+
+#else
+
+freeReg = panic "freeReg not defined for this platform"
+
+#endif
+