Pass platform down to lastxmm

14 files changed, 129 insertions, 108 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 7c7d20cd39..e510070c01 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -140,7 +140,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,
     pprNatCmmDecl             :: NatCmmDecl statics instr -> SDoc,
     maxSpillSlots             :: Int,
-    allocatableRegs           :: [RealReg],
+    allocatableRegs           :: Platform -> [RealReg],
     ncg_x86fp_kludge          :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
     ncgExpandTop              :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
     ncgMakeFarBranches        :: [NatBasicBlock instr] -> [NatBasicBlock instr]
@@ -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
@@ -194,7 +194,7 @@ nativeCodeGen dflags h us cmms
                          ,shortcutJump              = SPARC.ShortcutJump.shortcutJump
                          ,pprNatCmmDecl              = SPARC.Ppr.pprNatCmmDecl
                          ,maxSpillSlots             = SPARC.Instr.maxSpillSlots
-                         ,allocatableRegs           = SPARC.Regs.allocatableRegs
+                         ,allocatableRegs           = \_ -> SPARC.Regs.allocatableRegs
                          ,ncg_x86fp_kludge          = id
                          ,ncgExpandTop              = map SPARC.CodeGen.Expand.expandTop
                          ,ncgMakeFarBranches        = id
@@ -402,7 +402,7 @@ cmmNativeGen dflags ncgImpl us cmm count
         let (withLiveness, usLive) =
                 {-# SCC "regLiveness" #-}
                 initUs usGen
-                        $ mapM regLiveness
+                        $ mapM (regLiveness platform)
                         $ map natCmmTopToLive native
 
         dumpIfSet_dyn dflags
@@ -419,7 +419,7 @@ cmmNativeGen dflags ncgImpl us cmm count
                         = foldr (\r -> plusUFM_C unionUniqSets
                                         $ unitUFM (targetClassOfRealReg platform r) (unitUniqSet r))
                                 emptyUFM
-                        $ allocatableRegs ncgImpl
+                        $ allocatableRegs ncgImpl platform
 
                 -- do the graph coloring register allocation
                 let ((alloced, regAllocStats), usAlloc)
diff --git a/compiler/nativeGen/Instruction.hs b/compiler/nativeGen/Instruction.hs
index b67ff9d40f..292cf82f6a 100644
--- a/compiler/nativeGen/Instruction.hs
+++ b/compiler/nativeGen/Instruction.hs
@@ -68,7 +68,8 @@ class   Instruction instr where
         --      allocation goes, are taken care of by the register allocator.
         --
         regUsageOfInstr
-                :: instr
+                :: Platform
+                -> instr
                 -> RegUsage
 
 
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 63872e163a..2e25bd5b16 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -177,8 +177,8 @@ data Instr
 --	The consequences of control flow transfers, as far as register
 -- 	allocation goes, are taken care of by the register allocator.
 --
-ppc_regUsageOfInstr :: Instr -> RegUsage
-ppc_regUsageOfInstr instr 
+ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage
+ppc_regUsageOfInstr _ instr
  = case instr of
     LD    _ reg addr  	-> usage (regAddr addr, [reg])
     LA    _ reg addr  	-> usage (regAddr addr, [reg])
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 46a32e2b6d..32b5e41402 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -119,7 +119,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
         -- build a map of the cost of spilling each instruction
         --      this will only actually be computed if we have to spill something.
         let spillCosts  = foldl' plusSpillCostInfo zeroSpillCostInfo
-                        $ map slurpSpillCostInfo code
+                        $ map (slurpSpillCostInfo platform) code
 
         -- the function to choose regs to leave uncolored
         let spill       = chooseSpill spillCosts
@@ -213,13 +213,13 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
 
                 -- spill the uncolored regs
                 (code_spilled, slotsFree', spillStats)
-                        <- regSpill code_coalesced slotsFree rsSpill
+                        <- regSpill platform code_coalesced slotsFree rsSpill
 
                 -- recalculate liveness
                 -- NOTE: we have to reverse the SCCs here to get them back into the reverse-dependency
                 --       order required by computeLiveness. If they're not in the correct order
                 --       that function will panic.
-                code_relive     <- mapM (regLiveness . reverseBlocksInTops) code_spilled
+                code_relive     <- mapM (regLiveness platform . reverseBlocksInTops) code_spilled
 
                 -- record what happened in this stage for debugging
                 let stat        =
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index d8a654a6a5..6e110266d1 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -20,6 +20,7 @@ import UniqFM
 import UniqSet
 import UniqSupply
 import Outputable
+import Platform
 
 import Data.List
 import Data.Maybe
@@ -40,7 +41,8 @@ import qualified Data.Set       as Set
 --
 regSpill
         :: Instruction instr
-        => [LiveCmmDecl statics instr]  -- ^ the code
+        => Platform
+        -> [LiveCmmDecl statics instr]  -- ^ the code
         -> UniqSet Int                  -- ^ available stack slots
         -> UniqSet VirtualReg           -- ^ the regs to spill
         -> UniqSM
@@ -48,7 +50,7 @@ regSpill
                 , UniqSet Int               -- left over slots
                 , SpillStats )              -- stats about what happened during spilling
 
-regSpill code slotsFree regs
+regSpill platform code slotsFree regs
 
         -- not enough slots to spill these regs
         | sizeUniqSet slotsFree < sizeUniqSet regs
@@ -68,7 +70,7 @@ regSpill code slotsFree regs
 
                 -- run the spiller on all the blocks
                 let (code', state')     =
-                        runState (mapM (regSpill_top regSlotMap) code)
+                        runState (mapM (regSpill_top platform regSlotMap) code)
                                  (initSpillS us)
 
                 return  ( code'
@@ -79,11 +81,12 @@ regSpill code slotsFree regs
 -- | Spill some registers to stack slots in a top-level thing.
 regSpill_top
         :: Instruction instr
-        => RegMap Int                   -- ^ map of vregs to slots they're being spilled to.
+        => Platform
+        -> RegMap Int                   -- ^ map of vregs to slots they're being spilled to.
         -> LiveCmmDecl statics instr    -- ^ the top level thing.
         -> SpillM (LiveCmmDecl statics instr)
 
-regSpill_top regSlotMap cmm
+regSpill_top platform regSlotMap cmm
  = case cmm of
         CmmData{}
          -> return cmm
@@ -110,7 +113,7 @@ regSpill_top regSlotMap cmm
                                 liveSlotsOnEntry'
 
                 -- Apply the spiller to all the basic blocks in the CmmProc.
-                sccs'           <- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
+                sccs'           <- mapM (mapSCCM (regSpill_block platform regSlotMap)) sccs
 
                 return  $ CmmProc info' label sccs'
 
@@ -137,12 +140,13 @@ regSpill_top regSlotMap cmm
 -- | Spill some registers to stack slots in a basic block.
 regSpill_block
         :: Instruction instr
-        => UniqFM Int           -- ^ map of vregs to slots they're being spilled to.
+        => Platform
+        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
         -> LiveBasicBlock instr
         -> SpillM (LiveBasicBlock instr)
 
-regSpill_block regSlotMap (BasicBlock i instrs)
- = do   instrss'        <- mapM (regSpill_instr regSlotMap) instrs
+regSpill_block platform regSlotMap (BasicBlock i instrs)
+ = do   instrss'        <- mapM (regSpill_instr platform regSlotMap) instrs
         return  $ BasicBlock i (concat instrss')
 
 
@@ -151,18 +155,19 @@ regSpill_block regSlotMap (BasicBlock i instrs)
 --   the appropriate RELOAD or SPILL meta instructions.
 regSpill_instr
         :: Instruction instr
-        => UniqFM Int           -- ^ map of vregs to slots they're being spilled to.
+        => Platform
+        -> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
         -> LiveInstr instr
         -> SpillM [LiveInstr instr]
 
-regSpill_instr _ li@(LiveInstr _ Nothing)
+regSpill_instr _ _ li@(LiveInstr _ Nothing)
  = do   return [li]
 
-regSpill_instr regSlotMap
+regSpill_instr platform regSlotMap
         (LiveInstr instr (Just _))
  = do
         -- work out which regs are read and written in this instr
-        let RU rlRead rlWritten = regUsageOfInstr instr
+        let RU rlRead rlWritten = regUsageOfInstr platform instr
 
         -- sometimes a register is listed as being read more than once,
         --      nub this so we don't end up inserting two lots of spill code.
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index 64069ddec9..9348dca936 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -211,7 +211,7 @@ cleanForward platform blockId assoc acc (li : instrs)
 
 	-- writing to a reg changes its value.
 	| LiveInstr instr _	<- li
-	, RU _ written		<- regUsageOfInstr instr
+	, RU _ written		<- regUsageOfInstr platform instr
 	= let assoc'	= foldr delAssoc assoc (map SReg $ nub written)
 	  in  cleanForward platform blockId assoc' (li : acc) instrs
 
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 44e1ed7e0f..abcc6a69b6 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -36,6 +36,7 @@ import UniqFM
 import UniqSet
 import Digraph		(flattenSCCs)
 import Outputable
+import Platform
 import State
 
 import Data.List	(nub, minimumBy)
@@ -70,10 +71,11 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
 --	and the number of instructions it was live on entry to (lifetime)
 --
 slurpSpillCostInfo :: (Outputable instr, Instruction instr)
-                   => LiveCmmDecl statics instr
+                   => Platform
+                   -> LiveCmmDecl statics instr
                    -> SpillCostInfo
 
-slurpSpillCostInfo cmm
+slurpSpillCostInfo platform cmm
 	= execState (countCmm cmm) zeroSpillCostInfo
  where
 	countCmm CmmData{}		= return ()
@@ -110,7 +112,7 @@ slurpSpillCostInfo cmm
 		mapM_ incLifetime $ uniqSetToList rsLiveEntry
 
 		-- increment counts for what regs were read/written from
-		let (RU read written)	= regUsageOfInstr instr
+		let (RU read written)	= regUsageOfInstr platform instr
 		mapM_ incUses	$ catMaybes $ map takeVirtualReg $ nub read
 		mapM_ incDefs 	$ catMaybes $ map takeVirtualReg $ nub written
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
index fd1fd272bd..5fc389b89e 100644
--- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
@@ -44,7 +44,7 @@ import qualified X86.Instr
 class Show freeRegs => FR freeRegs where
     frAllocateReg :: RealReg -> freeRegs -> freeRegs
     frGetFreeRegs :: RegClass -> freeRegs -> [RealReg]
-    frInitFreeRegs :: freeRegs
+    frInitFreeRegs :: Platform -> freeRegs
     frReleaseReg :: RealReg -> freeRegs -> freeRegs
 
 instance FR X86.FreeRegs where
@@ -56,13 +56,13 @@ instance FR X86.FreeRegs where
 instance FR PPC.FreeRegs where
     frAllocateReg  = PPC.allocateReg
     frGetFreeRegs  = PPC.getFreeRegs
-    frInitFreeRegs = PPC.initFreeRegs
+    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
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 07b6e33d25..7d6e85e664 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -191,10 +191,10 @@ linearRegAlloc
 linearRegAlloc dflags first_id block_live sccs
  = let platform = targetPlatform dflags
    in case platformArch platform of
-      ArchX86       -> linearRegAlloc' platform (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
-      ArchX86_64    -> linearRegAlloc' platform (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
-      ArchSPARC     -> linearRegAlloc' platform (frInitFreeRegs :: SPARC.FreeRegs) first_id block_live sccs
-      ArchPPC       -> linearRegAlloc' platform (frInitFreeRegs :: PPC.FreeRegs)   first_id block_live sccs
+      ArchX86       -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs)   first_id block_live sccs
+      ArchX86_64    -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs)   first_id block_live sccs
+      ArchSPARC     -> linearRegAlloc' platform (frInitFreeRegs platform :: SPARC.FreeRegs) first_id block_live sccs
+      ArchPPC       -> linearRegAlloc' platform (frInitFreeRegs platform :: PPC.FreeRegs)   first_id block_live sccs
       ArchARM _ _ _ -> panic "linearRegAlloc ArchARM"
       ArchPPC_64    -> panic "linearRegAlloc ArchPPC_64"
       ArchUnknown   -> panic "linearRegAlloc ArchUnknown"
@@ -304,7 +304,7 @@ processBlock
         -> RegM freeRegs [NatBasicBlock instr]   -- ^ block with registers allocated
 
 processBlock platform block_live (BasicBlock id instrs)
- = do   initBlock id block_live
+ = do   initBlock platform id block_live
         (instrs', fixups)
                 <- linearRA platform block_live [] [] id instrs
         return  $ BasicBlock id instrs' : fixups
@@ -312,8 +312,9 @@ processBlock platform block_live (BasicBlock id instrs)
 
 -- | Load the freeregs and current reg assignment into the RegM state
 --      for the basic block with this BlockId.
-initBlock :: FR freeRegs => BlockId -> BlockMap RegSet -> RegM freeRegs ()
-initBlock id block_live
+initBlock :: FR freeRegs
+          => Platform -> BlockId -> BlockMap RegSet -> RegM freeRegs ()
+initBlock platform id block_live
  = do   block_assig     <- getBlockAssigR
         case mapLookup id block_assig of
                 -- no prior info about this block: we must consider
@@ -325,9 +326,9 @@ initBlock id block_live
                  -> do  -- pprTrace "initFreeRegs" (text $ show initFreeRegs) (return ())
                         case mapLookup id block_live of
                           Nothing ->
-                            setFreeRegsR    frInitFreeRegs
+                            setFreeRegsR    (frInitFreeRegs platform)
                           Just live ->
-                            setFreeRegsR $ foldr frAllocateReg frInitFreeRegs [ r | RegReal r <- uniqSetToList live ]
+                            setFreeRegsR $ foldr frAllocateReg (frInitFreeRegs platform) [ r | RegReal r <- uniqSetToList live ]
                         setAssigR       emptyRegMap
 
                 -- load info about register assignments leading into this block.
@@ -447,7 +448,7 @@ genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
           -> RegM freeRegs ([instr], [NatBasicBlock instr])
 
 genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
-    case regUsageOfInstr instr              of { RU read written ->
+    case regUsageOfInstr platform instr of { RU read written ->
     do
     let real_written    = [ rr  | (RegReal     rr) <- written ]
     let virt_written    = [ vr  | (RegVirtual  vr) <- written ]
@@ -822,7 +823,7 @@ allocRegsAndSpill_spill platform reading keep spills alloc r rs assig spill_loc
                                 [ text "allocating vreg:  " <> text (show r)
                                 , text "assignment:       " <> text (show $ ufmToList assig)
                                 , text "freeRegs:         " <> text (show freeRegs)
-                                , text "initFreeRegs:     " <> text (show (frInitFreeRegs `asTypeOf` freeRegs)) ]
+                                , text "initFreeRegs:     " <> text (show (frInitFreeRegs platform `asTypeOf` freeRegs)) ]
 
                 result
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
index 7e7d99b008..debdf3cd03 100644
--- a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
@@ -14,6 +14,7 @@ import X86.Regs
 import RegClass
 import Reg
 import Panic
+import Platform
 
 import Data.Word
 import Data.Bits
@@ -35,9 +36,9 @@ releaseReg (RealRegSingle n) f
 releaseReg _ _	
 	= panic "RegAlloc.Linear.X86.FreeRegs.realeaseReg: no 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 f = go f 0
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index fc585d9438..2483e12213 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -87,9 +87,9 @@ data InstrSR instr
         | RELOAD Int Reg
 
 instance Instruction instr => Instruction (InstrSR instr) where
-        regUsageOfInstr i
+        regUsageOfInstr platform i
          = case i of
-                Instr  instr    -> regUsageOfInstr instr
+                Instr  instr    -> regUsageOfInstr platform instr
                 SPILL  reg _    -> RU [reg] []
                 RELOAD _ reg    -> RU [] [reg]
 
@@ -663,21 +663,22 @@ sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
 --
 regLiveness
         :: (Outputable instr, Instruction instr)
-        => LiveCmmDecl statics instr
+        => Platform
+        -> LiveCmmDecl statics instr
         -> UniqSM (LiveCmmDecl statics instr)
 
-regLiveness (CmmData i d)
+regLiveness _ (CmmData i d)
         = return $ CmmData i d
 
-regLiveness (CmmProc info lbl [])
+regLiveness _ (CmmProc info lbl [])
         | LiveInfo static mFirst _ _    <- info
         = return $ CmmProc
                         (LiveInfo static mFirst (Just mapEmpty) Map.empty)
                         lbl []
 
-regLiveness (CmmProc info lbl sccs)
+regLiveness platform (CmmProc info lbl sccs)
         | LiveInfo static mFirst _ liveSlotsOnEntry     <- info
-        = let   (ann_sccs, block_live)  = computeLiveness sccs
+        = let   (ann_sccs, block_live)  = computeLiveness platform sccs
 
           in    return $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
                            lbl ann_sccs
@@ -742,15 +743,16 @@ reverseBlocksInTops top
 --
 computeLiveness
         :: (Outputable instr, Instruction instr)
-        => [SCC (LiveBasicBlock instr)]
+        => Platform
+        -> [SCC (LiveBasicBlock instr)]
         -> ([SCC (LiveBasicBlock instr)],       -- instructions annotated with list of registers
                                                 -- which are "dead after this instruction".
                BlockMap RegSet)                 -- blocks annontated with set of live registers
                                                 -- on entry to the block.
 
-computeLiveness sccs
+computeLiveness platform sccs
  = case checkIsReverseDependent sccs of
-        Nothing         -> livenessSCCs emptyBlockMap [] sccs
+        Nothing         -> livenessSCCs platform emptyBlockMap [] sccs
         Just bad        -> pprPanic "RegAlloc.Liveness.computeLivenss"
                                 (vcat   [ text "SCCs aren't in reverse dependent order"
                                         , text "bad blockId" <+> ppr bad
@@ -758,22 +760,23 @@ computeLiveness sccs
 
 livenessSCCs
        :: Instruction instr
-       => BlockMap RegSet
+       => Platform
+       -> BlockMap RegSet
        -> [SCC (LiveBasicBlock instr)]          -- accum
        -> [SCC (LiveBasicBlock instr)]
        -> ( [SCC (LiveBasicBlock instr)]
           , BlockMap RegSet)
 
-livenessSCCs blockmap done []
+livenessSCCs _ blockmap done []
         = (done, blockmap)
 
-livenessSCCs blockmap done (AcyclicSCC block : sccs)
- = let  (blockmap', block')     = livenessBlock blockmap block
-   in   livenessSCCs blockmap' (AcyclicSCC block' : done) sccs
+livenessSCCs platform blockmap done (AcyclicSCC block : sccs)
+ = let  (blockmap', block')     = livenessBlock platform blockmap block
+   in   livenessSCCs platform blockmap' (AcyclicSCC block' : done) sccs
 
-livenessSCCs blockmap done
+livenessSCCs platform blockmap done
         (CyclicSCC blocks : sccs) =
-        livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
+        livenessSCCs platform blockmap' (CyclicSCC blocks':done) sccs
  where      (blockmap', blocks')
                 = iterateUntilUnchanged linearLiveness equalBlockMaps
                                       blockmap blocks
@@ -796,7 +799,7 @@ livenessSCCs blockmap done
                 => BlockMap RegSet -> [LiveBasicBlock instr]
                 -> (BlockMap RegSet, [LiveBasicBlock instr])
 
-            linearLiveness = mapAccumL livenessBlock
+            linearLiveness = mapAccumL (livenessBlock platform)
 
                 -- probably the least efficient way to compare two
                 -- BlockMaps for equality.
@@ -812,17 +815,18 @@ livenessSCCs blockmap done
 --
 livenessBlock
         :: Instruction instr
-        => BlockMap RegSet
+        => Platform
+        -> BlockMap RegSet
         -> LiveBasicBlock instr
         -> (BlockMap RegSet, LiveBasicBlock instr)
 
-livenessBlock blockmap (BasicBlock block_id instrs)
+livenessBlock platform blockmap (BasicBlock block_id instrs)
  = let
         (regsLiveOnEntry, instrs1)
-                = livenessBack emptyUniqSet blockmap [] (reverse instrs)
+            = livenessBack platform emptyUniqSet blockmap [] (reverse instrs)
         blockmap'       = mapInsert block_id regsLiveOnEntry blockmap
 
-        instrs2         = livenessForward regsLiveOnEntry instrs1
+        instrs2         = livenessForward platform regsLiveOnEntry instrs1
 
         output          = BasicBlock block_id instrs2
 
@@ -833,16 +837,17 @@ livenessBlock blockmap (BasicBlock block_id instrs)
 
 livenessForward
         :: Instruction instr
-        => RegSet                       -- regs live on this instr
+        => Platform
+        -> RegSet                       -- regs live on this instr
         -> [LiveInstr instr] -> [LiveInstr instr]
 
-livenessForward _           []  = []
-livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
+livenessForward _        _           []  = []
+livenessForward platform rsLiveEntry (li@(LiveInstr instr mLive) : lis)
         | Nothing               <- mLive
-        = li : livenessForward rsLiveEntry lis
+        = li : livenessForward platform rsLiveEntry lis
 
         | Just live     <- mLive
-        , RU _ written  <- regUsageOfInstr instr
+        , RU _ written  <- regUsageOfInstr platform instr
         = let
                 -- Regs that are written to but weren't live on entry to this instruction
                 --      are recorded as being born here.
@@ -854,9 +859,9 @@ livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
                                         `minusUniqSet` (liveDieWrite live)
 
         in LiveInstr instr (Just live { liveBorn = rsBorn })
-                : livenessForward rsLiveNext lis
+                : livenessForward platform rsLiveNext lis
 
-livenessForward _ _             = panic "RegLiveness.livenessForward: no match"
+livenessForward _ _ _             = panic "RegLiveness.livenessForward: no match"
 
 
 -- | Calculate liveness going backwards,
@@ -864,32 +869,34 @@ livenessForward _ _             = panic "RegLiveness.livenessForward: no match"
 
 livenessBack
         :: Instruction instr
-        => RegSet                       -- regs live on this instr
+        => Platform
+        -> RegSet                       -- regs live on this instr
         -> BlockMap RegSet              -- regs live on entry to other BBs
         -> [LiveInstr instr]            -- instructions (accum)
         -> [LiveInstr instr]            -- instructions
         -> (RegSet, [LiveInstr instr])
 
-livenessBack liveregs _        done []  = (liveregs, done)
+livenessBack _        liveregs _        done []  = (liveregs, done)
 
-livenessBack liveregs blockmap acc (instr : instrs)
- = let  (liveregs', instr')     = liveness1 liveregs blockmap instr
-   in   livenessBack liveregs' blockmap (instr' : acc) instrs
+livenessBack platform liveregs blockmap acc (instr : instrs)
+ = let  (liveregs', instr')     = liveness1 platform liveregs blockmap instr
+   in   livenessBack platform liveregs' blockmap (instr' : acc) instrs
 
 
 -- don't bother tagging comments or deltas with liveness
 liveness1
         :: Instruction instr
-        => RegSet
+        => Platform
+        -> RegSet
         -> BlockMap RegSet
         -> LiveInstr instr
         -> (RegSet, LiveInstr instr)
 
-liveness1 liveregs _ (LiveInstr instr _)
+liveness1 _ liveregs _ (LiveInstr instr _)
         | isMetaInstr instr
         = (liveregs, LiveInstr instr Nothing)
 
-liveness1 liveregs blockmap (LiveInstr instr _)
+liveness1 platform liveregs blockmap (LiveInstr instr _)
 
         | not_a_branch
         = (liveregs1, LiveInstr instr
@@ -906,7 +913,7 @@ liveness1 liveregs blockmap (LiveInstr instr _)
                         , liveDieWrite  = mkUniqSet w_dying }))
 
         where
-            !(RU read written) = regUsageOfInstr instr
+            !(RU read written) = regUsageOfInstr platform instr
 
             -- registers that were written here are dead going backwards.
             -- registers that were read here are live going backwards.
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 82e16eee72..b3429f7587 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -221,8 +221,8 @@ data Instr
 -- 	consequences of control flow transfers, as far as register
 -- 	allocation goes, are taken care of by the register allocator.
 --
-sparc_regUsageOfInstr :: Instr -> RegUsage
-sparc_regUsageOfInstr instr 
+sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage
+sparc_regUsageOfInstr _ instr
  = case instr of
     LD    _ addr reg  		-> usage (regAddr addr, 	[reg])
     ST    _ reg addr  		-> usage (reg : regAddr addr, 	[])
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index f31bf0349f..91d6ae4479 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -320,8 +320,8 @@ data Operand
 
 
 
-x86_regUsageOfInstr :: Instr -> RegUsage
-x86_regUsageOfInstr instr
+x86_regUsageOfInstr :: Platform -> Instr -> RegUsage
+x86_regUsageOfInstr platform instr
  = case instr of
     MOV    _ src dst    -> usageRW src dst
     MOVZxL _ src dst    -> usageRW src dst
@@ -359,8 +359,8 @@ x86_regUsageOfInstr instr
     JXX_GBL _ _         -> mkRU [] []
     JMP     op regs     -> mkRUR (use_R op regs)
     JMP_TBL op _ _ _    -> mkRUR (use_R op [])
-    CALL (Left _)  params   -> mkRU params callClobberedRegs
-    CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
+    CALL (Left _)  params   -> mkRU params (callClobberedRegs platform)
+    CALL (Right reg) params -> mkRU (reg:params) (callClobberedRegs platform)
     CLTD   _            -> mkRU [eax] [edx]
     NOP                 -> mkRU [] []
 
diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs
index 9e36b087d7..f331698556 100644
--- a/compiler/nativeGen/X86/Regs.hs
+++ b/compiler/nativeGen/X86/Regs.hs
@@ -230,13 +230,13 @@ firstfake, lastfake :: RegNo
 firstfake = 16
 lastfake  = 21
 
-firstxmm, lastxmm :: RegNo
+firstxmm :: RegNo
 firstxmm  = 24
-#if i386_TARGET_ARCH
-lastxmm   = 31
-#else
-lastxmm   = 39
-#endif
+
+lastxmm :: Platform -> RegNo
+lastxmm platform
+ | target32Bit platform = 31
+ | otherwise            = 39
 
 lastint :: RegNo
 #if i386_TARGET_ARCH
@@ -245,11 +245,15 @@ lastint = 7 -- not %r8..%r15
 lastint = 15
 #endif
 
-intregnos, fakeregnos, xmmregnos, floatregnos :: [RegNo]
+intregnos, fakeregnos :: [RegNo]
 intregnos   = [0..lastint]
 fakeregnos  = [firstfake .. lastfake]
-xmmregnos   = [firstxmm  .. lastxmm]
-floatregnos = fakeregnos ++ xmmregnos;
+
+xmmregnos :: Platform -> [RegNo]
+xmmregnos platform = [firstxmm  .. lastxmm platform]
+
+floatregnos :: Platform -> [RegNo]
+floatregnos platform = fakeregnos ++ xmmregnos platform
 
 
 -- argRegs is the set of regs which are read for an n-argument call to C.
@@ -259,8 +263,8 @@ argRegs :: RegNo -> [Reg]
 argRegs _       = panic "MachRegs.argRegs(x86): should not be used!"
 
 -- | The complete set of machine registers.
-allMachRegNos :: [RegNo]
-allMachRegNos  = intregnos ++ floatregnos
+allMachRegNos :: Platform -> [RegNo]
+allMachRegNos platform = intregnos ++ floatregnos platform
 
 -- | Take the class of a register.
 {-# INLINE classOfRealReg      #-}
@@ -420,7 +424,7 @@ globalRegMaybe          :: GlobalReg -> Maybe RealReg
 allArgRegs              :: [(Reg, Reg)]
 allIntArgRegs           :: [Reg]
 allFPArgRegs            :: [Reg]
-callClobberedRegs       :: [Reg]
+callClobberedRegs       :: Platform -> [Reg]
 
 #if i386_TARGET_ARCH
 #define eax 0
@@ -636,24 +640,24 @@ instrClobberedRegs = map RealRegSingle [ rax, rcx, rdx ]
 
 #if   i386_TARGET_ARCH
 -- caller-saves registers
-callClobberedRegs
-  = map regSingle ([eax,ecx,edx]  ++ floatregnos)
+callClobberedRegs platform
+  = map regSingle ([eax,ecx,edx]  ++ floatregnos platform)
 
 #else
 -- all xmm regs are caller-saves
 -- caller-saves registers
-callClobberedRegs
-  = map regSingle ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ floatregnos)
+callClobberedRegs platform
+  = map regSingle ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ floatregnos platform)
 
 #endif
 
 -- 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
+allocatableRegs :: Platform -> [RealReg]
+allocatableRegs platform
    = let isFree i = isFastTrue (freeReg i)
-     in  map RealRegSingle $ filter isFree allMachRegNos
+     in  map RealRegSingle $ filter isFree (allMachRegNos platform)
 
 {-
 Note [esi/edi not allocatable]