Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-7.2

http://hackage.haskell.org/trac/ghc/changeset/555a6bf9c56074ddf98cf631be3c4152985c1ce5

>---------------------------------------------------------------

commit 555a6bf9c56074ddf98cf631be3c4152985c1ce5
Author: Ian Lynagh <[email protected]>
Date:   Fri Jul 15 19:06:04 2011 +0100

    Remove more defaultTargetPlatform uses

>---------------------------------------------------------------

 compiler/main/DriverPipeline.hs                |    2 +-
 compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs |    9 +++------
 compiler/nativeGen/RegAlloc/Linear/Main.hs     |    2 +-
 compiler/nativeGen/RegAlloc/Linear/StackMap.hs |    5 +++--
 compiler/nativeGen/TargetReg.hs                |    8 ++------
 compiler/nativeGen/X86/RegInfo.hs              |   21 +++++++++------------
 6 files changed, 19 insertions(+), 28 deletions(-)

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 18eba25..746ea88 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1454,7 +1454,7 @@ mkExtraObjToLinkIntoBinary dflags dep_packages = do
             escape = concatMap (charToC.fromIntegral.ord)
 
             elfSectionNote :: String
-            elfSectionNote = case platformArch defaultTargetPlatform of
+            elfSectionNote = case platformArch (targetPlatform dflags) of
                                ArchX86    -> "@note"
                                ArchX86_64 -> "@note"
                                ArchPPC    -> "@note"
diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs 
b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
index 07cfc0f..5a413d3 100644
--- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
@@ -58,12 +58,9 @@ instance FR SPARC.FreeRegs where
     frInitFreeRegs = SPARC.initFreeRegs
     frReleaseReg   = SPARC.releaseReg
 
--- TODO: We shouldn't be using defaultTargetPlatform here.
---       We should be passing DynFlags in instead, and looking at
---       its targetPlatform.
-
-maxSpillSlots :: Int
-maxSpillSlots = case platformArch defaultTargetPlatform of
+maxSpillSlots :: Platform -> Int
+maxSpillSlots platform
+              = case platformArch platform of
                 ArchX86     -> X86.Instr.maxSpillSlots
                 ArchX86_64  -> X86.Instr.maxSpillSlots
                 ArchPPC     -> PPC.Instr.maxSpillSlots
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs 
b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 35d41c2..8fa758d 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -200,7 +200,7 @@ linearRegAlloc'
 linearRegAlloc' platform initFreeRegs first_id block_live sccs
  = do   us      <- getUs
         let (_, _, stats, blocks) =
-                runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us
+                runR emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap 
platform) us
                     $ linearRA_SCCs platform first_id block_live [] sccs
         return  (blocks, stats)
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs 
b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
index 62bf6ad..1dd410a 100644
--- a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
@@ -22,6 +22,7 @@ where
 import RegAlloc.Linear.FreeRegs
 
 import Outputable
+import Platform
 import UniqFM
 import Unique
 
@@ -39,8 +40,8 @@ data StackMap
 
 
 -- | An empty stack map, with all slots available.
-emptyStackMap :: StackMap
-emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM
+emptyStackMap :: Platform -> StackMap
+emptyStackMap platform = StackMap [0 .. maxSpillSlots platform] emptyUFM
 
 
 -- | If this vreg unique already has a stack assignment then return the slot 
number,
diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs
index 456ec2b..0892697 100644
--- a/compiler/nativeGen/TargetReg.hs
+++ b/compiler/nativeGen/TargetReg.hs
@@ -40,10 +40,6 @@ import qualified PPC.Regs       as PPC
 
 import qualified SPARC.Regs     as SPARC
 
--- TODO: We shouldn't be using defaultTargetPlatform here.
---       We should be passing DynFlags in instead, and looking at
---       its targetPlatform.
-
 targetVirtualRegSqueeze :: Platform -> RegClass -> VirtualReg -> FastInt
 targetVirtualRegSqueeze platform
     = case platformArch platform of
@@ -95,8 +91,8 @@ targetMkVirtualReg platform
 targetRegDotColor :: Platform -> RealReg -> SDoc
 targetRegDotColor platform
     = case platformArch platform of
-      ArchX86     -> X86.regDotColor
-      ArchX86_64  -> X86.regDotColor
+      ArchX86     -> X86.regDotColor platform
+      ArchX86_64  -> X86.regDotColor platform
       ArchPPC     -> PPC.regDotColor
       ArchSPARC   -> SPARC.regDotColor
       ArchPPC_64  -> panic "targetRegDotColor ArchPPC_64"
diff --git a/compiler/nativeGen/X86/RegInfo.hs 
b/compiler/nativeGen/X86/RegInfo.hs
index 0f6613d..c09ebc5 100644
--- a/compiler/nativeGen/X86/RegInfo.hs
+++ b/compiler/nativeGen/X86/RegInfo.hs
@@ -28,20 +28,17 @@ mkVirtualReg u size
         FF80   -> VirtualRegD   u
         _other  -> VirtualRegI   u
 
-regDotColor :: RealReg -> SDoc
-regDotColor reg
- = let Just    str     = lookupUFM regColors reg
-   in  text str
+regDotColor :: Platform -> RealReg -> SDoc
+regDotColor platform reg
+ = let Just str = lookupUFM (regColors platform) reg
+   in text str
 
-regColors :: UniqFM [Char]
-regColors = listToUFM (normalRegColors ++ fpRegColors)
+regColors :: Platform -> UniqFM [Char]
+regColors platform = listToUFM (normalRegColors platform ++ fpRegColors)
 
--- TODO: We shouldn't be using defaultTargetPlatform here.
---       We should be passing DynFlags in instead, and looking at
---       its targetPlatform.
-
-normalRegColors :: [(Reg,String)]
-normalRegColors = case platformArch defaultTargetPlatform of
+normalRegColors :: Platform -> [(Reg,String)]
+normalRegColors platform
+                = case platformArch platform of
                   ArchX86 -> [ (eax, "#00ff00")
                              , (ebx, "#0000ff")
                              , (ecx, "#00ffff")



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to