Remove more defaultTargetPlatform uses

7 files changed, 166 insertions, 147 deletions

diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 3cdc1228da..5321a34695 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -165,7 +165,7 @@ regAlloc_spin
 	 	let code_patched	= map (patchRegsFromGraph platform graph_colored_lint) code_coalesced
 
 		-- clean out unneeded SPILL/RELOADs
-		let code_spillclean	= map cleanSpills code_patched
+		let code_spillclean	= map (cleanSpills platform) code_patched
 
 		-- strip off liveness information, 
 		--	and rewrite SPILL/RELOAD pseudos into real instructions along the way
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index 710055c045..efb11b5636 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -39,6 +39,7 @@ import UniqFM
 import Unique
 import State
 import Outputable
+import Platform
 
 import Data.List
 import Data.Maybe
@@ -52,22 +53,23 @@ type Slot = Int
 
 
 -- | Clean out unneeded spill\/reloads from this top level thing.
-cleanSpills 
-	:: Instruction instr
-	=> LiveCmmTop statics instr -> LiveCmmTop statics instr
+cleanSpills
+    :: Instruction instr
+    => Platform -> LiveCmmTop statics instr -> LiveCmmTop statics instr
 
-cleanSpills cmm
-	= evalState (cleanSpin 0 cmm) initCleanS
+cleanSpills platform cmm
+    = evalState (cleanSpin platform 0 cmm) initCleanS
 
 -- | do one pass of cleaning
-cleanSpin 
-	:: Instruction instr
-	=> Int 
-	-> LiveCmmTop statics instr 
-	-> CleanM (LiveCmmTop statics instr)
+cleanSpin
+    :: Instruction instr
+    => Platform
+    -> Int
+    -> LiveCmmTop statics instr
+    -> CleanM (LiveCmmTop statics instr)
 
 {-
-cleanSpin spinCount code
+cleanSpin _ spinCount code
  = do	jumpValid	<- gets sJumpValid
 	pprTrace "cleanSpin"
 	 	(  int spinCount
@@ -78,7 +80,7 @@ cleanSpin spinCount code
 	 $ cleanSpin' spinCount code
 -}
 
-cleanSpin spinCount code
+cleanSpin platform spinCount code
  = do
  	-- init count of cleaned spills\/reloads
 	modify $ \s -> s
@@ -86,7 +88,7 @@ cleanSpin spinCount code
 		, sCleanedReloadsAcc	= 0
 		, sReloadedBy		= emptyUFM }
 
- 	code_forward	<- mapBlockTopM cleanBlockForward  code
+ 	code_forward	<- mapBlockTopM (cleanBlockForward platform) code
 	code_backward	<- cleanTopBackward code_forward
 	
 	-- During the cleaning of each block we collected information about what regs
@@ -107,16 +109,17 @@ cleanSpin spinCount code
 	   then return code
 
 	-- otherwise go around again
-	   else cleanSpin (spinCount + 1) code_backward
+	   else cleanSpin platform (spinCount + 1) code_backward
 
 
 -- | Clean one basic block
-cleanBlockForward 
-	:: Instruction instr
-	=> LiveBasicBlock instr 
-	-> CleanM (LiveBasicBlock instr)
+cleanBlockForward
+    :: Platform
+    -> Instruction instr
+    => LiveBasicBlock instr
+    -> CleanM (LiveBasicBlock instr)
 
-cleanBlockForward (BasicBlock blockId instrs)
+cleanBlockForward platform (BasicBlock blockId instrs)
  = do
  	-- see if we have a valid association for the entry to this block
  	jumpValid	<- gets sJumpValid
@@ -124,7 +127,7 @@ cleanBlockForward (BasicBlock blockId instrs)
 				Just assoc	-> assoc
 				Nothing		-> emptyAssoc
 
- 	instrs_reload	<- cleanForward    blockId assoc [] instrs
+ 	instrs_reload	<- cleanForward platform blockId assoc [] instrs
 	return	$ BasicBlock blockId instrs_reload
 
 
@@ -135,37 +138,38 @@ cleanBlockForward (BasicBlock blockId instrs)
 --	  then we don't need to do the reload.
 --
 cleanForward
-	:: Instruction instr
-	=> BlockId			-- ^ the block that we're currently in
-	-> Assoc Store	 		-- ^ two store locations are associated if they have the same value
-	-> [LiveInstr instr]		-- ^ acc
-	-> [LiveInstr instr] 		-- ^ instrs to clean (in backwards order)
-	-> CleanM [LiveInstr instr]	-- ^ cleaned instrs  (in forward   order)
-
-cleanForward _ _ acc []
+    :: Instruction instr
+    => Platform
+    -> BlockId                  -- ^ the block that we're currently in
+    -> Assoc Store              -- ^ two store locations are associated if they have the same value
+    -> [LiveInstr instr]        -- ^ acc
+    -> [LiveInstr instr]        -- ^ instrs to clean (in backwards order)
+    -> CleanM [LiveInstr instr] -- ^ cleaned instrs  (in forward   order)
+
+cleanForward _ _ _ acc []
 	= return acc
 
 -- write out live range joins via spill slots to just a spill and a reg-reg move
 --	hopefully the spill will be also be cleaned in the next pass
 --
-cleanForward blockId assoc acc (li1 : li2 : instrs)
+cleanForward platform blockId assoc acc (li1 : li2 : instrs)
 
 	| LiveInstr (SPILL  reg1  slot1) _	<- li1
 	, LiveInstr (RELOAD slot2 reg2)  _	<- li2
 	, slot1 == slot2
 	= do
 		modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
-		cleanForward blockId assoc acc
-			(li1 : LiveInstr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs)
+		cleanForward platform blockId assoc acc
+			(li1 : LiveInstr (mkRegRegMoveInstr platform reg1 reg2) Nothing : instrs)
 
 
-cleanForward blockId assoc acc (li@(LiveInstr i1 _) : instrs)
+cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs)
 	| Just (r1, r2)	<- takeRegRegMoveInstr i1
 	= if r1 == r2
 		-- erase any left over nop reg reg moves while we're here
 		--	this will also catch any nop moves that the "write out live range joins" case above
 		--	happens to add
-		then cleanForward blockId assoc acc instrs
+		then cleanForward platform blockId assoc acc instrs
 
 		-- if r1 has the same value as some slots and we copy r1 to r2,
 		--	then r2 is now associated with those slots instead
@@ -173,50 +177,51 @@ cleanForward blockId assoc acc (li@(LiveInstr i1 _) : instrs)
 					$ delAssoc (SReg r2)
 					$ assoc
 
-			cleanForward blockId assoc' (li : acc) instrs
+			cleanForward platform blockId assoc' (li : acc) instrs
 
 
-cleanForward blockId assoc acc (li : instrs)
+cleanForward platform blockId assoc acc (li : instrs)
 
 	-- update association due to the spill
 	| LiveInstr (SPILL reg slot) _	<- li
 	= let	assoc'	= addAssoc (SReg reg)  (SSlot slot)
 			$ delAssoc (SSlot slot)
 			$ assoc
-	  in	cleanForward blockId assoc' (li : acc) instrs
+	  in	cleanForward platform blockId assoc' (li : acc) instrs
 
 	-- clean a reload instr
 	| LiveInstr (RELOAD{}) _	<- li
-	= do	(assoc', mli)	<- cleanReload blockId assoc li
+	= do	(assoc', mli)	<- cleanReload platform blockId assoc li
 		case mli of
-		 Nothing	-> cleanForward blockId assoc' acc 		instrs
-		 Just li'	-> cleanForward blockId assoc' (li' : acc)	instrs
+		 Nothing	-> cleanForward platform blockId assoc' acc 		instrs
+		 Just li'	-> cleanForward platform blockId assoc' (li' : acc)	instrs
 
 	-- remember the association over a jump
 	| LiveInstr instr _ 	<- li
 	, targets		<- jumpDestsOfInstr instr
 	, not $ null targets
 	= do	mapM_ (accJumpValid assoc) targets
-		cleanForward blockId assoc (li : acc) instrs
+		cleanForward platform blockId assoc (li : acc) instrs
 
 	-- writing to a reg changes its value.
 	| LiveInstr instr _	<- li
 	, RU _ written		<- regUsageOfInstr instr
 	= let assoc'	= foldr delAssoc assoc (map SReg $ nub written)
-	  in  cleanForward blockId assoc' (li : acc) instrs
+	  in  cleanForward platform blockId assoc' (li : acc) instrs
 
 
 
 -- | Try and rewrite a reload instruction to something more pleasing
 --
-cleanReload 
-	:: Instruction instr
-	=> BlockId 
-	-> Assoc Store 
-	-> LiveInstr instr
-	-> CleanM (Assoc Store, Maybe (LiveInstr instr))
+cleanReload
+    :: Instruction instr
+    => Platform
+    -> BlockId
+    -> Assoc Store
+    -> LiveInstr instr
+    -> CleanM (Assoc Store, Maybe (LiveInstr instr))
 
-cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _)
+cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg) _)
 
 	-- if the reg we're reloading already has the same value as the slot
 	--	then we can erase the instruction outright
@@ -233,7 +238,7 @@ cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _)
 				$ delAssoc (SReg reg)
 				$ assoc
 
-		return	(assoc', Just $ LiveInstr (mkRegRegMoveInstr reg2 reg) Nothing)
+		return	(assoc', Just $ LiveInstr (mkRegRegMoveInstr platform reg2 reg) Nothing)
 
 	-- gotta keep this instr
 	| otherwise
@@ -247,7 +252,7 @@ cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _)
 
 	    	return	(assoc', Just li)
 
-cleanReload _ _ _
+cleanReload _ _ _ _
 	= panic "RegSpillClean.cleanReload: unhandled instr"
 
 
diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
index ccbe3fe22d..15ec6e7f87 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
@@ -74,7 +74,7 @@ instance (Outputable statics, PlatformOutputable instr) => PlatformOutputable (R
 	$$ text ""
 	$$ text "#  Initial register conflict graph."
 	$$ Color.dotGraph 
-		targetRegDotColor
+		(targetRegDotColor platform)
 		(trivColorable platform
 			(targetVirtualRegSqueeze platform)
 			(targetRealRegSqueeze platform))
@@ -111,7 +111,7 @@ instance (Outputable statics, PlatformOutputable instr) => PlatformOutputable (R
 
 	$$ text "#  Register conflict graph (colored)."
 	$$ Color.dotGraph 
-		targetRegDotColor
+		(targetRegDotColor platform)
 		(trivColorable platform
 			(targetVirtualRegSqueeze platform)
 			(targetRealRegSqueeze platform))
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 f72f644930..35d41c21ba 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -370,7 +370,7 @@ raInsn _ _     new_instrs _ (LiveInstr ii Nothing)
         = 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
 
@@ -405,7 +405,7 @@ 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)
 
@@ -415,7 +415,8 @@ raInsn platform _ _ _ instr
 
 
 genRaInsn :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
-          => BlockMap RegSet
+          => Platform
+          -> BlockMap RegSet
           -> [instr]
           -> BlockId
           -> instr
@@ -423,7 +424,7 @@ genRaInsn :: (FR freeRegs, Instruction instr, PlatformOutputable 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 ]
@@ -435,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
@@ -453,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.
@@ -471,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.
@@ -554,15 +555,16 @@ releaseRegs regs = do
 
 saveClobberedTemps
         :: (PlatformOutputable instr, Instruction instr)
-        => [RealReg]            -- real registers clobbered by this instruction
+        => 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
@@ -581,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)
@@ -646,23 +648,24 @@ data SpillLoc = ReadMem StackSlot  -- reading from register only in memory
 
 allocateRegsAndSpill
         :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
-        => Bool                 -- True <=> reading (load up spilled regs)
+        => 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
@@ -671,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)
@@ -690,7 +693,8 @@ 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, PlatformOutputable instr)
-                        => Bool
+                        => Platform
+                        -> Bool
                         -> [VirtualReg]
                         -> [instr]
                         -> [RealReg]
@@ -699,7 +703,7 @@ allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, PlatformOutputable i
                         -> 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
@@ -708,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
@@ -725,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.
@@ -733,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 ]
@@ -766,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
 
@@ -795,18 +799,19 @@ newLocation _ my_reg = InReg my_reg
 -- | Load up a spilled temporary if we need to (read from memory).
 loadTemp
         :: (PlatformOutputable instr, Instruction instr)
-        => VirtualReg   -- the temp being loaded
+        => 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/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/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 01337308b8..2b7975dcb4 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -127,7 +127,8 @@ instance Instruction instr => Instruction (InstrSR instr) where
                 Instr instr     -> isMetaInstr instr
                 _               -> False
 
-        mkRegRegMoveInstr r1 r2 = Instr (mkRegRegMoveInstr r1 r2)
+        mkRegRegMoveInstr platform r1 r2
+            = Instr (mkRegRegMoveInstr platform r1 r2)
 
         takeRegRegMoveInstr i
          = case i of
@@ -478,7 +479,7 @@ stripLive platform live
                                 = partition ((== first_id) . blockId) final_blocks
 
            in   CmmProc info label
-                          (ListGraph $ map stripLiveBlock $ first' : rest')
+                          (ListGraph $ map (stripLiveBlock platform) $ first' : rest')
 
         -- procs used for stg_split_markers don't contain any blocks, and have no first_id.
         stripCmm (CmmProc (LiveInfo info Nothing _ _) label [])
@@ -493,10 +494,11 @@ stripLive platform live
 
 stripLiveBlock
         :: Instruction instr
-        => LiveBasicBlock instr
+        => Platform
+        -> LiveBasicBlock instr
         -> NatBasicBlock instr
 
-stripLiveBlock (BasicBlock i lis)
+stripLiveBlock platform (BasicBlock i lis)
  =      BasicBlock i instrs'
 
  where  (instrs', _)
@@ -507,11 +509,11 @@ stripLiveBlock (BasicBlock i lis)
 
         spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
          = do   delta   <- get
-                spillNat (mkSpillInstr reg delta slot : acc) instrs
+                spillNat (mkSpillInstr platform reg delta slot : acc) instrs
 
         spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
          = do   delta   <- get
-                spillNat (mkLoadInstr reg delta slot : acc) instrs
+                spillNat (mkLoadInstr platform reg delta slot : acc) instrs
 
         spillNat acc (LiveInstr (Instr instr) _ : instrs)
          | Just i <- takeDeltaInstr instr