Merge branch 'master' of http://darcs.haskell.org/ghc

6 files changed, 171 insertions, 154 deletions

diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
index 07cfc0f825..5a413d341e 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/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index e6a078a05e..ba07e61871 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -24,6 +24,7 @@ import BlockId
 import OldCmm  hiding (RegSet)
 import Digraph
 import Outputable
+import Platform
 import Unique
 import UniqFM
 import UniqSet
@@ -34,7 +35,8 @@ import UniqSet
 --
 joinToTargets
 	:: (FR freeRegs, Instruction instr)
-	=> BlockMap RegSet		-- ^ maps the unique of the blockid to the set of vregs 
+	=> Platform
+	-> BlockMap RegSet		-- ^ maps the unique of the blockid to the set of vregs 
 					--	that are known to be live on the entry to each block.
 
 	-> BlockId			-- ^ id of the current block
@@ -44,19 +46,20 @@ joinToTargets
 		, instr)		--   the original branch instruction, but maybe patched to jump
 					--	to a fixup block first.
 
-joinToTargets block_live id instr
+joinToTargets platform block_live id instr
 
 	-- we only need to worry about jump instructions.
 	| not $ isJumpishInstr instr
 	= return ([], instr)
 
 	| otherwise
-	= joinToTargets' block_live [] id instr (jumpDestsOfInstr instr)
+	= joinToTargets' platform block_live [] id instr (jumpDestsOfInstr instr)
 
 -----
 joinToTargets'
 	:: (FR freeRegs, Instruction instr)
-	=> BlockMap RegSet		-- ^ maps the unique of the blockid to the set of vregs 
+	=> Platform
+	-> BlockMap RegSet		-- ^ maps the unique of the blockid to the set of vregs 
 					--	that are known to be live on the entry to each block.
 
 	-> [NatBasicBlock instr]	-- ^ acc blocks of fixup code.
@@ -70,11 +73,11 @@ joinToTargets'
 		, instr)
 
 -- no more targets to consider. all done.
-joinToTargets' _          new_blocks _ instr []
+joinToTargets' _        _          new_blocks _ instr []
 	= return (new_blocks, instr)
 
 -- handle a branch target.
-joinToTargets' block_live new_blocks block_id instr (dest:dests) 
+joinToTargets' platform block_live new_blocks block_id instr (dest:dests) 
  = do	
  	-- get the map of where the vregs are stored on entry to each basic block.
 	block_assig 	<- getBlockAssigR
@@ -97,18 +100,19 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests)
 	case mapLookup dest block_assig of
 	 Nothing 
 	  -> joinToTargets_first 
-	  		block_live new_blocks block_id instr dest dests
+	  		platform block_live new_blocks block_id instr dest dests
 			block_assig adjusted_assig to_free
 
 	 Just (_, dest_assig)
 	  -> joinToTargets_again 
-	  		block_live new_blocks block_id instr dest dests
+	  		platform block_live new_blocks block_id instr dest dests
 	  		adjusted_assig dest_assig 
 
 
 -- this is the first time we jumped to this block.
 joinToTargets_first :: (FR freeRegs, Instruction instr)
-                    => BlockMap RegSet
+                    => Platform
+                    -> BlockMap RegSet
                     -> [NatBasicBlock instr]
                     -> BlockId
                     -> instr
@@ -118,7 +122,7 @@ joinToTargets_first :: (FR freeRegs, Instruction instr)
                     -> RegMap Loc
                     -> [RealReg]
                     -> RegM freeRegs ([NatBasicBlock instr], instr)
-joinToTargets_first block_live new_blocks block_id instr dest dests
+joinToTargets_first platform block_live new_blocks block_id instr dest dests
 	block_assig src_assig 
 	to_free
 
@@ -129,12 +133,13 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
 	-- remember the current assignment on entry to this block.
 	setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)
 
-	joinToTargets' block_live new_blocks block_id instr dests
+	joinToTargets' platform block_live new_blocks block_id instr dests
 
 
 -- we've jumped to this block before
 joinToTargets_again :: (Instruction instr, FR freeRegs)
-                    => BlockMap RegSet
+                    => Platform
+                    -> BlockMap RegSet
                     -> [NatBasicBlock instr]
                     -> BlockId
                     -> instr
@@ -143,13 +148,13 @@ joinToTargets_again :: (Instruction instr, FR freeRegs)
                     -> UniqFM Loc
                     -> UniqFM Loc
                     -> RegM freeRegs ([NatBasicBlock instr], instr)
-joinToTargets_again 
-	block_live new_blocks block_id instr dest dests
-	src_assig dest_assig
+joinToTargets_again
+    platform block_live new_blocks block_id instr dest dests
+    src_assig dest_assig
 
 	-- the assignments already match, no problem.
 	| ufmToList dest_assig == ufmToList src_assig
-	= joinToTargets' block_live new_blocks block_id instr dests
+	= joinToTargets' platform block_live new_blocks block_id instr dests
   
  	-- assignments don't match, need fixup code
 	| otherwise
@@ -184,7 +189,7 @@ joinToTargets_again
 			(return ())
 -}
 		delta 		<- getDeltaR
-		fixUpInstrs_ 	<- mapM (handleComponent delta instr) sccs
+		fixUpInstrs_ 	<- mapM (handleComponent platform delta instr) sccs
 		let fixUpInstrs	= concat fixUpInstrs_
 
 		-- make a new basic block containing the fixup code.
@@ -202,7 +207,7 @@ joinToTargets_again
 -}
 		-- if we didn't need any fixups, then don't include the block
 		case fixUpInstrs of 
-		 []	-> joinToTargets' block_live new_blocks block_id instr dests
+		 []	-> joinToTargets' platform block_live new_blocks block_id instr dests
 
 		 -- patch the original branch instruction so it goes to our
 		 --	fixup block instead.
@@ -211,7 +216,7 @@ joinToTargets_again
 								then mkBlockId fixup_block_id 
 								else bid) -- no change!
 						
-		 	   in	joinToTargets' block_live (block : new_blocks) block_id instr' dests
+		 	   in	joinToTargets' platform block_live (block : new_blocks) block_id instr' dests
 
 
 -- | Construct a graph of register\/spill movements.
@@ -281,14 +286,14 @@ expandNode vreg src dst
 --
 handleComponent 
 	:: Instruction instr
-	=> Int -> instr -> SCC (Unique, Loc, [Loc]) -> RegM freeRegs [instr]
+	=> Platform -> Int -> instr -> SCC (Unique, Loc, [Loc]) -> RegM freeRegs [instr]
 
 -- If the graph is acyclic then we won't get the swapping problem below.
 --	In this case we can just do the moves directly, and avoid having to
 --	go via a spill slot.
 --
-handleComponent delta _  (AcyclicSCC (vreg, src, dsts))
-	 = mapM (makeMove delta vreg src) dsts
+handleComponent platform delta _  (AcyclicSCC (vreg, src, dsts))
+	 = mapM (makeMove platform delta vreg src) dsts
 
 
 -- Handle some cyclic moves.
@@ -306,53 +311,54 @@ handleComponent delta _  (AcyclicSCC (vreg, src, dsts))
 --	are allocated exclusively for a virtual register and therefore can not
 --	require a fixup.
 --
-handleComponent delta instr 
+handleComponent platform delta instr
 	(CyclicSCC 	( (vreg, InReg sreg, (InReg dreg: _)) : rest))
         -- dest list may have more than one element, if the reg is also InMem.
  = do
 	-- spill the source into its slot
 	(instrSpill, slot) 
-			<- spillR (RegReal sreg) vreg
+			<- spillR platform (RegReal sreg) vreg
 
 	-- reload into destination reg
-	instrLoad	<- loadR  (RegReal dreg) slot
+	instrLoad	<- loadR platform (RegReal dreg) slot
 	
-	remainingFixUps <- mapM (handleComponent delta instr) 
+	remainingFixUps <- mapM (handleComponent platform delta instr) 
 				(stronglyConnCompFromEdgedVerticesR rest)
 
 	-- make sure to do all the reloads after all the spills,
 	--	so we don't end up clobbering the source values.
 	return ([instrSpill] ++ concat remainingFixUps ++ [instrLoad])
 
-handleComponent _ _ (CyclicSCC _)
+handleComponent _ _ _ (CyclicSCC _)
  = panic "Register Allocator: handleComponent cyclic"
 
 
 -- | Move a vreg between these two locations.
 --
-makeMove 
-	:: Instruction instr
-	=> Int 		-- ^ current C stack delta.
-	-> Unique 	-- ^ unique of the vreg that we're moving.
-	-> Loc 		-- ^ source location.
-	-> Loc 		-- ^ destination location.
-	-> RegM freeRegs instr	-- ^ move instruction.
-
-makeMove _     vreg (InReg src) (InReg dst)
- = do	recordSpill (SpillJoinRR vreg)
- 	return	$ mkRegRegMoveInstr (RegReal src) (RegReal dst)
-
-makeMove delta vreg (InMem src) (InReg dst)
- = do	recordSpill (SpillJoinRM vreg)
- 	return	$ mkLoadInstr  (RegReal dst) delta src
-
-makeMove delta vreg (InReg src) (InMem dst)
- = do	recordSpill (SpillJoinRM vreg)
-	return	$ mkSpillInstr (RegReal src) delta dst
+makeMove
+    :: Instruction instr
+    => Platform
+    -> Int      -- ^ current C stack delta.
+    -> Unique   -- ^ unique of the vreg that we're moving.
+    -> Loc      -- ^ source location.
+    -> Loc      -- ^ destination location.
+    -> RegM freeRegs instr  -- ^ move instruction.
+
+makeMove platform _     vreg (InReg src) (InReg dst)
+ = do recordSpill (SpillJoinRR vreg)
+      return $ mkRegRegMoveInstr platform (RegReal src) (RegReal dst)
+
+makeMove platform delta vreg (InMem src) (InReg dst)
+ = do recordSpill (SpillJoinRM vreg)
+      return $ mkLoadInstr platform (RegReal dst) delta src
+
+makeMove platform delta vreg (InReg src) (InMem dst)
+ = do recordSpill (SpillJoinRM vreg)
+      return $ mkSpillInstr platform (RegReal src) delta dst
 
 -- we don't handle memory to memory moves.
 --	they shouldn't happen because we don't share stack slots between vregs.
-makeMove _     vreg src dst
+makeMove _        _     vreg src dst
 	= panic $ "makeMove " ++ show vreg ++ " (" ++ show src ++ ") ("
 		++ show dst ++ ")"
 		++ " we don't handle mem->mem moves."
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 3682ffbe1d..8fa758d063 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -127,10 +127,10 @@ import Control.Monad
 
 -- Allocate registers
 regAlloc
-        :: (Outputable instr, Instruction instr)
+        :: (PlatformOutputable instr, Instruction instr)
         => DynFlags
-        -> LiveCmmTop instr
-        -> UniqSM (NatCmmTop instr, Maybe RegAllocStats)
+        -> LiveCmmTop statics instr
+        -> UniqSM (NatCmmTop statics instr, Maybe RegAllocStats)
 
 regAlloc _ (CmmData sec d)
         = return
@@ -170,7 +170,7 @@ regAlloc _ (CmmProc _ _ _)
 --   an entry in the block map or it is the first block.
 --
 linearRegAlloc
-        :: (Outputable instr, Instruction instr)
+        :: (PlatformOutputable instr, Instruction instr)
         => DynFlags
         -> BlockId                      -- ^ the first block
         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
@@ -178,51 +178,54 @@ linearRegAlloc
         -> UniqSM ([NatBasicBlock instr], RegAllocStats)
 
 linearRegAlloc dflags first_id block_live sccs
- = case platformArch $ targetPlatform dflags of
-   ArchX86     -> linearRegAlloc' (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
-   ArchX86_64  -> linearRegAlloc' (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
-   ArchSPARC   -> linearRegAlloc' (frInitFreeRegs :: SPARC.FreeRegs) first_id block_live sccs
-   ArchPPC     -> linearRegAlloc' (frInitFreeRegs :: PPC.FreeRegs)   first_id block_live sccs
-   ArchARM     -> panic "linearRegAlloc ArchARM"
-   ArchPPC_64  -> panic "linearRegAlloc ArchPPC_64"
-   ArchUnknown -> panic "linearRegAlloc ArchUnknown"
+ = 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
+      ArchARM     -> panic "linearRegAlloc ArchARM"
+      ArchPPC_64  -> panic "linearRegAlloc ArchPPC_64"
+      ArchUnknown -> panic "linearRegAlloc ArchUnknown"
 
 linearRegAlloc'
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => freeRegs
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> freeRegs
         -> BlockId                      -- ^ the first block
         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
         -> UniqSM ([NatBasicBlock instr], RegAllocStats)
 
-linearRegAlloc' initFreeRegs first_id block_live sccs
+linearRegAlloc' platform initFreeRegs first_id block_live sccs
  = do   us      <- getUs
         let (_, _, stats, blocks) =
-                runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us
-                    $ linearRA_SCCs first_id block_live [] sccs
+                runR emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap platform) us
+                    $ linearRA_SCCs platform first_id block_live [] sccs
         return  (blocks, stats)
 
 
-linearRA_SCCs :: (FR freeRegs, Instruction instr, Outputable instr)
-              => BlockId
+linearRA_SCCs :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+              => Platform
+              -> BlockId
               -> BlockMap RegSet
               -> [NatBasicBlock instr]
               -> [SCC (LiveBasicBlock instr)]
               -> RegM freeRegs [NatBasicBlock instr]
 
-linearRA_SCCs _ _ blocksAcc []
+linearRA_SCCs _ _ _ blocksAcc []
         = return $ reverse blocksAcc
 
-linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs)
- = do   blocks' <- processBlock block_live block
-        linearRA_SCCs first_id block_live
+linearRA_SCCs platform first_id block_live blocksAcc (AcyclicSCC block : sccs)
+ = do   blocks' <- processBlock platform block_live block
+        linearRA_SCCs platform first_id block_live
                 ((reverse blocks') ++ blocksAcc)
                 sccs
 
-linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
+linearRA_SCCs platform first_id block_live blocksAcc (CyclicSCC blocks : sccs)
  = do
-        blockss' <- process first_id block_live blocks [] (return []) False
-        linearRA_SCCs first_id block_live
+        blockss' <- process platform first_id block_live blocks [] (return []) False
+        linearRA_SCCs platform first_id block_live
                 (reverse (concat blockss') ++ blocksAcc)
                 sccs
 
@@ -238,8 +241,9 @@ linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
    more sanity checking to guard against this eventuality.
 -}
 
-process :: (FR freeRegs, Instruction instr, Outputable instr)
-        => BlockId
+process :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+        => Platform
+        -> BlockId
         -> BlockMap RegSet
         -> [GenBasicBlock (LiveInstr instr)]
         -> [GenBasicBlock (LiveInstr instr)]
@@ -247,10 +251,10 @@ process :: (FR freeRegs, Instruction instr, Outputable instr)
         -> Bool
         -> RegM freeRegs [[NatBasicBlock instr]]
 
-process _ _ [] []         accum _
+process _ _ _ [] []         accum _
         = return $ reverse accum
 
-process first_id block_live [] next_round accum madeProgress
+process platform first_id block_live [] next_round accum madeProgress
         | not madeProgress
 
           {- BUGS: There are so many unreachable blocks in the code the warnings are overwhelming.
@@ -260,10 +264,10 @@ process first_id block_live [] next_round accum madeProgress
         = return $ reverse accum
 
         | otherwise
-        = process first_id block_live
+        = process platform first_id block_live
                   next_round [] accum False
 
-process first_id block_live (b@(BasicBlock id _) : blocks)
+process platform first_id block_live (b@(BasicBlock id _) : blocks)
         next_round accum madeProgress
  = do
         block_assig <- getBlockAssigR
@@ -271,26 +275,27 @@ process first_id block_live (b@(BasicBlock id _) : blocks)
         if isJust (mapLookup id block_assig)
              || id == first_id
          then do
-                b'  <- processBlock block_live b
-                process first_id block_live blocks
+                b'  <- processBlock platform block_live b
+                process platform first_id block_live blocks
                         next_round (b' : accum) True
 
-         else   process first_id block_live blocks
+         else   process platform first_id block_live blocks
                         (b : next_round) accum madeProgress
 
 
 -- | Do register allocation on this basic block
 --
 processBlock
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => BlockMap RegSet              -- ^ live regs on entry to each basic block
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> LiveBasicBlock instr         -- ^ block to do register allocation on
         -> RegM freeRegs [NatBasicBlock instr]   -- ^ block with registers allocated
 
-processBlock block_live (BasicBlock id instrs)
+processBlock platform block_live (BasicBlock id instrs)
  = do   initBlock id
         (instrs', fixups)
-                <- linearRA block_live [] [] id instrs
+                <- linearRA platform block_live [] [] id instrs
         return  $ BasicBlock id instrs' : fixups
 
 
@@ -316,8 +321,9 @@ initBlock id
 
 -- | Do allocation for a sequence of instructions.
 linearRA
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.
         -> [instr]                              -- ^ accumulator for instructions already processed.
         -> [NatBasicBlock instr]                -- ^ accumulator for blocks of fixup code.
         -> BlockId                              -- ^ id of the current block, for debugging.
@@ -328,24 +334,25 @@ linearRA
                 , [NatBasicBlock instr])        --   fresh blocks of fixup code.
 
 
-linearRA _          accInstr accFixup _ []
+linearRA _        _          accInstr accFixup _ []
         = return
                 ( reverse accInstr              -- instrs need to be returned in the correct order.
                 , accFixup)                     -- it doesn't matter what order the fixup blocks are returned in.
 
 
-linearRA block_live accInstr accFixups id (instr:instrs)
+linearRA platform block_live accInstr accFixups id (instr:instrs)
  = do
         (accInstr', new_fixups)
-                <- raInsn block_live accInstr id instr
+                <- raInsn platform block_live accInstr id instr
 
-        linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs
+        linearRA platform block_live accInstr' (new_fixups ++ accFixups) id instrs
 
 
 -- | Do allocation for a single instruction.
 raInsn
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.
         -> [instr]                              -- ^ accumulator for instructions already processed.
         -> BlockId                              -- ^ the id of the current block, for debugging
         -> LiveInstr instr                      -- ^ the instr to have its regs allocated, with liveness info.
@@ -353,17 +360,17 @@ raInsn
                 ( [instr]                       -- new instructions
                 , [NatBasicBlock instr])        -- extra fixup blocks
 
-raInsn _     new_instrs _ (LiveInstr ii Nothing)
+raInsn _ _     new_instrs _ (LiveInstr ii Nothing)
         | Just n        <- takeDeltaInstr ii
         = do    setDeltaR n
                 return (new_instrs, [])
 
-raInsn _     new_instrs _ (LiveInstr ii Nothing)
+raInsn _ _     new_instrs _ (LiveInstr ii Nothing)
         | isMetaInstr ii
         = return (new_instrs, [])
 
 
-raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
+raInsn platform block_live new_instrs id (LiveInstr (Instr instr) (Just live))
  = do
     assig    <- getAssigR
 
@@ -398,17 +405,18 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
           -}
            return (new_instrs, [])
 
-        _ -> genRaInsn block_live new_instrs id instr
+        _ -> genRaInsn platform block_live new_instrs id instr
                         (uniqSetToList $ liveDieRead live)
                         (uniqSetToList $ liveDieWrite live)
 
 
-raInsn _ _ _ instr
-        = pprPanic "raInsn" (text "no match for:" <> ppr instr)
+raInsn platform _ _ _ instr
+        = pprPanic "raInsn" (text "no match for:" <> pprPlatform platform instr)
 
 
-genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
-          => BlockMap RegSet
+genRaInsn :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+          => Platform
+          -> BlockMap RegSet
           -> [instr]
           -> BlockId
           -> instr
@@ -416,7 +424,7 @@ genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
           -> [Reg]
           -> RegM freeRegs ([instr], [NatBasicBlock instr])
 
-genRaInsn block_live new_instrs block_id instr r_dying w_dying =
+genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
     case regUsageOfInstr instr              of { RU read written ->
     do
     let real_written    = [ rr  | (RegReal     rr) <- written ]
@@ -428,7 +436,7 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying =
     let virt_read       = nub [ vr      | (RegVirtual vr) <- read ]
 
     -- (a) save any temporaries which will be clobbered by this instruction
-    clobber_saves       <- saveClobberedTemps real_written r_dying
+    clobber_saves       <- saveClobberedTemps platform real_written r_dying
 
     -- debugging
 {-    freeregs <- getFreeRegsR
@@ -446,14 +454,14 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying =
 
     -- (b), (c) allocate real regs for all regs read by this instruction.
     (r_spills, r_allocd) <-
-        allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read
+        allocateRegsAndSpill platform True{-reading-} virt_read [] [] virt_read
 
     -- (d) Update block map for new destinations
     -- NB. do this before removing dead regs from the assignment, because
     -- these dead regs might in fact be live in the jump targets (they're
     -- only dead in the code that follows in the current basic block).
     (fixup_blocks, adjusted_instr)
-        <- joinToTargets block_live block_id instr
+        <- joinToTargets platform block_live block_id instr
 
     -- (e) Delete all register assignments for temps which are read
     --     (only) and die here.  Update the free register list.
@@ -464,7 +472,7 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying =
 
     -- (g) Allocate registers for temporaries *written* (only)
     (w_spills, w_allocd) <-
-        allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written
+        allocateRegsAndSpill platform False{-writing-} virt_written [] [] virt_written
 
     -- (h) Release registers for temps which are written here and not
     -- used again.
@@ -546,16 +554,17 @@ releaseRegs regs = do
 
 
 saveClobberedTemps
-        :: (Outputable instr, Instruction instr)
-        => [RealReg]            -- real registers clobbered by this instruction
+        :: (PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> [RealReg]            -- real registers clobbered by this instruction
         -> [Reg]                -- registers which are no longer live after this insn
         -> RegM freeRegs [instr]         -- return: instructions to spill any temps that will
                                 -- be clobbered.
 
-saveClobberedTemps [] _
+saveClobberedTemps _ [] _
         = return []
 
-saveClobberedTemps clobbered dying
+saveClobberedTemps platform clobbered dying
  = do
         assig   <- getAssigR
         let to_spill
@@ -574,7 +583,7 @@ saveClobberedTemps clobbered dying
 
         clobber assig instrs ((temp, reg) : rest)
          = do
-                (spill, slot)   <- spillR (RegReal reg) temp
+                (spill, slot)   <- spillR platform (RegReal reg) temp
 
                 -- record why this reg was spilled for profiling
                 recordSpill (SpillClobber temp)
@@ -638,24 +647,25 @@ data SpillLoc = ReadMem StackSlot  -- reading from register only in memory
 --   the list of free registers and free stack slots.
 
 allocateRegsAndSpill
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => Bool                 -- True <=> reading (load up spilled regs)
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> Bool                 -- True <=> reading (load up spilled regs)
         -> [VirtualReg]         -- don't push these out
         -> [instr]              -- spill insns
         -> [RealReg]            -- real registers allocated (accum.)
         -> [VirtualReg]         -- temps to allocate
         -> RegM freeRegs ( [instr] , [RealReg])
 
-allocateRegsAndSpill _       _    spills alloc []
+allocateRegsAndSpill _        _       _    spills alloc []
         = return (spills, reverse alloc)
 
-allocateRegsAndSpill reading keep spills alloc (r:rs)
+allocateRegsAndSpill platform reading keep spills alloc (r:rs)
  = do   assig <- getAssigR
-        let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig
+        let doSpill = allocRegsAndSpill_spill platform reading keep spills alloc r rs assig
         case lookupUFM assig r of
                 -- case (1a): already in a register
                 Just (InReg my_reg) ->
-                        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
+                        allocateRegsAndSpill platform reading keep spills (my_reg:alloc) rs
 
                 -- case (1b): already in a register (and memory)
                 -- NB1. if we're writing this register, update its assignment to be
@@ -664,7 +674,7 @@ allocateRegsAndSpill reading keep spills alloc (r:rs)
                 -- are also read by the same instruction.
                 Just (InBoth my_reg _)
                  -> do  when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))
-                        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
+                        allocateRegsAndSpill platform reading keep spills (my_reg:alloc) rs
 
                 -- Not already in a register, so we need to find a free one...
                 Just (InMem slot) | reading   -> doSpill (ReadMem slot)
@@ -682,8 +692,9 @@ allocateRegsAndSpill reading keep spills alloc (r:rs)
 
 -- reading is redundant with reason, but we keep it around because it's
 -- convenient and it maintains the recursive structure of the allocator. -- EZY
-allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
-                        => Bool
+allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+                        => Platform
+                        -> Bool
                         -> [VirtualReg]
                         -> [instr]
                         -> [RealReg]
@@ -692,7 +703,7 @@ allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
                         -> UniqFM Loc
                         -> SpillLoc
                         -> RegM freeRegs ([instr], [RealReg])
-allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
+allocRegsAndSpill_spill platform reading keep spills alloc r rs assig spill_loc
  = do
         freeRegs                <- getFreeRegsR
         let freeRegs_thisClass  = frGetFreeRegs (classOfVirtualReg r) freeRegs
@@ -701,12 +712,12 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
 
          -- case (2): we have a free register
          (my_reg : _) ->
-           do   spills'   <- loadTemp r spill_loc my_reg spills
+           do   spills'   <- loadTemp platform r spill_loc my_reg spills
 
                 setAssigR       (addToUFM assig r $! newLocation spill_loc my_reg)
                 setFreeRegsR $  frAllocateReg my_reg freeRegs
 
-                allocateRegsAndSpill reading keep spills' (my_reg : alloc) rs
+                allocateRegsAndSpill platform reading keep spills' (my_reg : alloc) rs
 
 
           -- case (3): we need to push something out to free up a register
@@ -718,7 +729,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
                         = [ (temp, reg, mem)
                                 | (temp, InBoth reg mem) <- ufmToList assig
                                 , temp `notElem` keep'
-                                , targetClassOfRealReg reg == classOfVirtualReg r ]
+                                , targetClassOfRealReg platform reg == classOfVirtualReg r ]
 
                 -- the vregs we could kick out that are only in a reg
                 --      this would require writing the reg to a new slot before using it.
@@ -726,26 +737,26 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
                         = [ (temp, reg)
                                 | (temp, InReg reg)     <- ufmToList assig
                                 , temp `notElem` keep'
-                                , targetClassOfRealReg reg == classOfVirtualReg r ]
+                                , targetClassOfRealReg platform reg == classOfVirtualReg r ]
 
                 let result
 
                         -- we have a temporary that is in both register and mem,
                         -- just free up its register for use.
                         | (temp, my_reg, slot) : _      <- candidates_inBoth
-                        = do    spills' <- loadTemp r spill_loc my_reg spills
+                        = do    spills' <- loadTemp platform r spill_loc my_reg spills
                                 let assig1  = addToUFM assig temp (InMem slot)
                                 let assig2  = addToUFM assig1 r $! newLocation spill_loc my_reg
 
                                 setAssigR assig2
-                                allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
+                                allocateRegsAndSpill platform reading keep spills' (my_reg:alloc) rs
 
                         -- otherwise, we need to spill a temporary that currently
                         -- resides in a register.
                         | (temp_to_push_out, (my_reg :: RealReg)) : _
                                         <- candidates_inReg
                         = do
-                                (spill_insn, slot) <- spillR (RegReal my_reg) temp_to_push_out
+                                (spill_insn, slot) <- spillR platform (RegReal my_reg) temp_to_push_out
                                 let spill_store  = (if reading then id else reverse)
                                                         [ -- COMMENT (fsLit "spill alloc")
                                                            spill_insn ]
@@ -759,9 +770,9 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
                                 setAssigR assig2
 
                                 -- if need be, load up a spilled temp into the reg we've just freed up.
-                                spills' <- loadTemp r spill_loc my_reg spills
+                                spills' <- loadTemp platform r spill_loc my_reg spills
 
-                                allocateRegsAndSpill reading keep
+                                allocateRegsAndSpill platform reading keep
                                         (spill_store ++ spills')
                                         (my_reg:alloc) rs
 
@@ -787,19 +798,20 @@ newLocation _ my_reg = InReg my_reg
 
 -- | Load up a spilled temporary if we need to (read from memory).
 loadTemp
-        :: (Outputable instr, Instruction instr)
-        => VirtualReg   -- the temp being loaded
+        :: (PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> VirtualReg   -- the temp being loaded
         -> SpillLoc     -- the current location of this temp
         -> RealReg      -- the hreg to load the temp into
         -> [instr]
         -> RegM freeRegs [instr]
 
-loadTemp vreg (ReadMem slot) hreg spills
+loadTemp platform vreg (ReadMem slot) hreg spills
  = do
-        insn <- loadR (RegReal hreg) slot
+        insn <- loadR platform (RegReal hreg) slot
         recordSpill (SpillLoad $ getUnique vreg)
         return  $  {- COMMENT (fsLit "spill load") : -} insn : spills
 
-loadTemp _ _ _ spills =
+loadTemp _ _ _ _ spills =
    return spills
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
index 62bf6adb2a..1dd410aa46 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/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs
index 05db9de350..9999a1e2e4 100644
--- a/compiler/nativeGen/RegAlloc/Linear/State.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/State.hs
@@ -36,6 +36,7 @@ import RegAlloc.Liveness
 import Instruction
 import Reg
 
+import Platform
 import Unique
 import UniqSupply
 
@@ -81,21 +82,21 @@ makeRAStats state
 	{ ra_spillInstrs	= binSpillReasons (ra_spills state) }
 
 
-spillR 	:: Instruction instr
-	=> Reg -> Unique -> RegM freeRegs (instr, Int)
+spillR :: Instruction instr
+       => Platform -> Reg -> Unique -> RegM freeRegs (instr, Int)
 
-spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
+spillR platform reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
   let (stack',slot) = getStackSlotFor stack temp
-      instr  = mkSpillInstr reg delta slot
+      instr  = mkSpillInstr platform reg delta slot
   in
   (# s{ra_stack=stack'}, (instr,slot) #)
 
 
-loadR 	:: Instruction instr
-	=> Reg -> Int -> RegM freeRegs instr
+loadR :: Instruction instr
+      => Platform -> Reg -> Int -> RegM freeRegs instr
 
-loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
-  (# s, mkLoadInstr reg delta slot #)
+loadR platform reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
+  (# s, mkLoadInstr platform reg delta slot #)
 
 getFreeRegsR :: RegM freeRegs freeRegs
 getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
diff --git a/compiler/nativeGen/RegAlloc/Linear/Stats.hs b/compiler/nativeGen/RegAlloc/Linear/Stats.hs
index c80f77f893..0c059eac27 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Stats.hs
@@ -37,7 +37,7 @@ binSpillReasons reasons
 -- | Count reg-reg moves remaining in this code.
 countRegRegMovesNat 
 	:: Instruction instr
-	=> NatCmmTop instr -> Int
+	=> NatCmmTop statics instr -> Int
 
 countRegRegMovesNat cmm
 	= execState (mapGenBlockTopM countBlock cmm) 0
@@ -58,7 +58,7 @@ countRegRegMovesNat cmm
 -- | Pretty print some RegAllocStats
 pprStats 
 	:: Instruction instr 
-	=> [NatCmmTop instr] -> [RegAllocStats] -> SDoc
+	=> [NatCmmTop statics instr] -> [RegAllocStats] -> SDoc
 
 pprStats code statss
  = let	-- sum up all the instrs inserted by the spiller