Remove more defaultTargetPlatform uses

author: Ian Lynagh <igloo@earth.li> 2011-07-15 18:13:49 +0100
committer: Ian Lynagh <igloo@earth.li> 2011-07-15 19:03:23 +0100
commit: 730301c60e6ccd9ed4fb248bcd2399f938a43d25 (patch)
tree: 680c524b5353acaff547e2a739185f3593557873 /compiler
parent: 5c718b15e83e3b205e13c882660a4952714c3b4c (diff)
download: haskell-730301c60e6ccd9ed4fb248bcd2399f938a43d25.tar.gz
18 files changed, 358 insertions, 315 deletions
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index c868488646..ec52266cee 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -245,7 +245,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
 		dumpIfSet_dyn dflags
 			Opt_D_dump_asm_conflicts "Register conflict graph"
 			$ Color.dotGraph 
-				targetRegDotColor 
+				(targetRegDotColor platform)
 				(Color.trivColorable platform
 					(targetVirtualRegSqueeze platform)
 					(targetRealRegSqueeze platform))
@@ -386,7 +386,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 	  	-- the regs usable for allocation
 		let (alloc_regs :: UniqFM (UniqSet RealReg))
 			= foldr (\r -> plusUFM_C unionUniqSets
-					$ unitUFM (targetClassOfRealReg r) (unitUniqSet r))
+					$ unitUFM (targetClassOfRealReg platform r) (unitUniqSet r))
 				emptyUFM
 			$ allocatableRegs ncgImpl
 
diff --git a/compiler/nativeGen/Instruction.hs b/compiler/nativeGen/Instruction.hs
index a9d985622a..b2db2ef206 100644
--- a/compiler/nativeGen/Instruction.hs
+++ b/compiler/nativeGen/Instruction.hs
@@ -14,6 +14,7 @@ import Reg
 
 import BlockId
 import OldCmm
+import Platform
 
 -- | Holds a list of source and destination registers used by a
 --      particular instruction.
@@ -103,7 +104,8 @@ class   Instruction instr where
 
         -- | An instruction to spill a register into a spill slot.
         mkSpillInstr
-                :: Reg          -- ^ the reg to spill
+                :: Platform
+                -> Reg          -- ^ the reg to spill
                 -> Int          -- ^ the current stack delta
                 -> Int          -- ^ spill slot to use
                 -> instr
@@ -111,7 +113,8 @@ class   Instruction instr where
 
         -- | An instruction to reload a register from a spill slot.
         mkLoadInstr
-                :: Reg          -- ^ the reg to reload.
+                :: Platform
+                -> Reg          -- ^ the reg to reload.
                 -> Int          -- ^ the current stack delta
                 -> Int          -- ^ the spill slot to use
                 -> instr
@@ -137,7 +140,8 @@ class   Instruction instr where
         -- | Copy the value in a register to another one.
         --      Must work for all register classes.
         mkRegRegMoveInstr
-                :: Reg          -- ^ source register
+                :: Platform
+                -> Reg          -- ^ source register
                 -> Reg          -- ^ destination register
                 -> instr
 
diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index 2a7376838a..57d2adf9b8 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -130,18 +130,20 @@ getNewLabelNat
 
 
 getNewRegNat :: Size -> NatM Reg
-getNewRegNat rep 
- = do	u <- getUniqueNat
- 	return (RegVirtual $ targetMkVirtualReg u rep)
+getNewRegNat rep
+ = do u <- getUniqueNat
+      dflags <- getDynFlagsNat
+      return (RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep)
 
 
 getNewRegPairNat :: Size -> NatM (Reg,Reg)
-getNewRegPairNat rep 
- = do	u 	<- getUniqueNat
- 	let vLo	= targetMkVirtualReg u rep
-	let lo 	= RegVirtual $ targetMkVirtualReg u rep
-	let hi 	= RegVirtual $ getHiVirtualRegFromLo vLo
-	return (lo, hi)
+getNewRegPairNat rep
+ = do u <- getUniqueNat
+      dflags <- getDynFlagsNat
+      let vLo = targetMkVirtualReg (targetPlatform dflags) u rep
+      let lo  = RegVirtual $ targetMkVirtualReg (targetPlatform dflags) u rep
+      let hi  = RegVirtual $ getHiVirtualRegFromLo vLo
+      return (lo, hi)
 
 
 getPicBaseMaybeNat :: NatM (Maybe Reg)
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 71373ee21d..4560266884 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -404,11 +404,12 @@ getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32) [x])
   ChildCode64 code rlo <- iselExpr64 x
   return $ Fixed II32 rlo code
 
-getRegister' _ (CmmLoad mem pk)
+getRegister' dflags (CmmLoad mem pk)
   | not (isWord64 pk)
   = do
+        let platform = targetPlatform dflags
         Amode addr addr_code <- getAmode mem
-        let code dst = ASSERT((targetClassOfReg dst == RcDouble) == isFloatType pk)
+        let code dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk)
                        addr_code `snocOL` LD size dst addr
         return (Any size code)
           where size = cmmTypeSize pk
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index d13d6afca6..ffe5408033 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -32,6 +32,7 @@ import OldCmm
 import FastString
 import CLabel
 import Outputable
+import Platform
 import FastBool
 
 --------------------------------------------------------------------------------
@@ -43,18 +44,18 @@ archWordSize	= II32
 
 -- | Instruction instance for powerpc
 instance Instruction Instr where
-	regUsageOfInstr		= ppc_regUsageOfInstr
-	patchRegsOfInstr	= ppc_patchRegsOfInstr
-	isJumpishInstr		= ppc_isJumpishInstr
-	jumpDestsOfInstr	= ppc_jumpDestsOfInstr
-	patchJumpInstr		= ppc_patchJumpInstr
-	mkSpillInstr		= ppc_mkSpillInstr
-	mkLoadInstr		= ppc_mkLoadInstr
-	takeDeltaInstr		= ppc_takeDeltaInstr
-	isMetaInstr		= ppc_isMetaInstr
-	mkRegRegMoveInstr	= ppc_mkRegRegMoveInstr
-	takeRegRegMoveInstr	= ppc_takeRegRegMoveInstr
-	mkJumpInstr		= ppc_mkJumpInstr
+        regUsageOfInstr         = ppc_regUsageOfInstr
+        patchRegsOfInstr        = ppc_patchRegsOfInstr
+        isJumpishInstr          = ppc_isJumpishInstr
+        jumpDestsOfInstr        = ppc_jumpDestsOfInstr
+        patchJumpInstr          = ppc_patchJumpInstr
+        mkSpillInstr            = ppc_mkSpillInstr
+        mkLoadInstr             = ppc_mkLoadInstr
+        takeDeltaInstr          = ppc_takeDeltaInstr
+        isMetaInstr             = ppc_isMetaInstr
+        mkRegRegMoveInstr _     = ppc_mkRegRegMoveInstr
+        takeRegRegMoveInstr     = ppc_takeRegRegMoveInstr
+        mkJumpInstr             = ppc_mkJumpInstr
 
 
 -- -----------------------------------------------------------------------------
@@ -346,15 +347,16 @@ ppc_patchJumpInstr insn patchF
 
 -- | An instruction to spill a register into a spill slot.
 ppc_mkSpillInstr
-   :: Reg		-- register to spill
-   -> Int		-- current stack delta
-   -> Int		-- spill slot to use
+   :: Platform
+   -> Reg       -- register to spill
+   -> Int       -- current stack delta
+   -> Int       -- spill slot to use
    -> Instr
 
-ppc_mkSpillInstr reg delta slot
+ppc_mkSpillInstr platform reg delta slot
   = let	off     = spillSlotToOffset slot
     in
-    let sz = case targetClassOfReg reg of
+    let sz = case targetClassOfReg platform reg of
                 RcInteger -> II32
                 RcDouble  -> FF64
 		_	  -> panic "PPC.Instr.mkSpillInstr: no match"
@@ -362,15 +364,16 @@ ppc_mkSpillInstr reg delta slot
 
 
 ppc_mkLoadInstr
-   :: Reg		-- register to load
-   -> Int		-- current stack delta
-   -> Int		-- spill slot to use
+   :: Platform
+   -> Reg       -- register to load
+   -> Int       -- current stack delta
+   -> Int       -- spill slot to use
    -> Instr
 
-ppc_mkLoadInstr reg delta slot
+ppc_mkLoadInstr platform reg delta slot
   = let off     = spillSlotToOffset slot
     in
-    let sz = case targetClassOfReg reg of
+    let sz = case targetClassOfReg platform reg of
                 RcInteger -> II32
                 RcDouble  -> FF64
 		_         -> panic "PPC.Instr.mkLoadInstr: no match"
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index de8db68e65..54056c9e4d 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -58,12 +58,12 @@ pprNatCmmTop _ (CmmData section dats) =
 pprNatCmmTop _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl
 
  -- special case for code without an info table:
-pprNatCmmTop _ (CmmProc Nothing lbl (ListGraph blocks)) =
+pprNatCmmTop platform (CmmProc Nothing lbl (ListGraph blocks)) =
   pprSectionHeader Text $$
   pprLabel lbl $$ -- blocks guaranteed not null, so label needed
-  vcat (map pprBasicBlock blocks)
+  vcat (map (pprBasicBlock platform) blocks)
 
-pprNatCmmTop _ (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
+pprNatCmmTop platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
   pprSectionHeader Text $$
   (
 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
@@ -73,7 +73,7 @@ pprNatCmmTop _ (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blo
        vcat (map pprData info) $$
        pprLabel info_lbl
   ) $$
-  vcat (map pprBasicBlock blocks)
+  vcat (map (pprBasicBlock platform) blocks)
      -- above: Even the first block gets a label, because with branch-chain
      -- elimination, it might be the target of a goto.
 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
@@ -90,10 +90,10 @@ pprNatCmmTop _ (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blo
 #endif
 
 
-pprBasicBlock :: NatBasicBlock Instr -> Doc
-pprBasicBlock (BasicBlock blockid instrs) =
+pprBasicBlock :: Platform -> NatBasicBlock Instr -> Doc
+pprBasicBlock platform (BasicBlock blockid instrs) =
   pprLabel (mkAsmTempLabel (getUnique blockid)) $$
-  vcat (map pprInstr instrs)
+  vcat (map (pprInstr platform) instrs)
 
 
 
@@ -143,7 +143,7 @@ pprASCII str
 -- pprInstr: print an 'Instr'
 
 instance PlatformOutputable Instr where
-    pprPlatform _ instr = Outputable.docToSDoc $ pprInstr instr
+    pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr
 
 
 pprReg :: Reg -> Doc
@@ -337,26 +337,26 @@ pprDataItem lit
 		= panic "PPC.Ppr.pprDataItem: no match"
 
 
-pprInstr :: Instr -> Doc
+pprInstr :: Platform -> Instr -> Doc
 
-pprInstr (COMMENT _) = empty -- nuke 'em
+pprInstr _ (COMMENT _) = empty -- nuke 'em
 {-
-pprInstr (COMMENT s)
+pprInstr _ (COMMENT s)
      IF_OS_linux(
         ((<>) (ptext (sLit "# ")) (ftext s)),
         ((<>) (ptext (sLit "; ")) (ftext s)))
 -}
-pprInstr (DELTA d)
-   = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
+pprInstr platform (DELTA d)
+   = pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 
-pprInstr (NEWBLOCK _)
+pprInstr _ (NEWBLOCK _)
    = panic "PprMach.pprInstr: NEWBLOCK"
 
-pprInstr (LDATA _ _)
+pprInstr _ (LDATA _ _)
    = panic "PprMach.pprInstr: LDATA"
 
 {-
-pprInstr (SPILL reg slot)
+pprInstr _ (SPILL reg slot)
    = hcat [
    	ptext (sLit "\tSPILL"),
 	char '\t',
@@ -364,7 +364,7 @@ pprInstr (SPILL reg slot)
 	comma,
 	ptext (sLit "SLOT") <> parens (int slot)]
 
-pprInstr (RELOAD slot reg)
+pprInstr _ (RELOAD slot reg)
    = hcat [
    	ptext (sLit "\tRELOAD"),
 	char '\t',
@@ -373,7 +373,7 @@ pprInstr (RELOAD slot reg)
 	pprReg reg]
 -}
 
-pprInstr (LD sz reg addr) = hcat [
+pprInstr _ (LD sz reg addr) = hcat [
 	char '\t',
 	ptext (sLit "l"),
 	ptext (case sz of
@@ -391,7 +391,7 @@ pprInstr (LD sz reg addr) = hcat [
 	ptext (sLit ", "),
 	pprAddr addr
     ]
-pprInstr (LA sz reg addr) = hcat [
+pprInstr _ (LA sz reg addr) = hcat [
 	char '\t',
 	ptext (sLit "l"),
 	ptext (case sz of
@@ -409,7 +409,7 @@ pprInstr (LA sz reg addr) = hcat [
 	ptext (sLit ", "),
 	pprAddr addr
     ]
-pprInstr (ST sz reg addr) = hcat [
+pprInstr _ (ST sz reg addr) = hcat [
 	char '\t',
 	ptext (sLit "st"),
 	pprSize sz,
@@ -420,7 +420,7 @@ pprInstr (ST sz reg addr) = hcat [
 	ptext (sLit ", "),
 	pprAddr addr
     ]
-pprInstr (STU sz reg addr) = hcat [
+pprInstr _ (STU sz reg addr) = hcat [
 	char '\t',
 	ptext (sLit "st"),
 	pprSize sz,
@@ -431,7 +431,7 @@ pprInstr (STU sz reg addr) = hcat [
 	ptext (sLit ", "),
 	pprAddr addr
     ]
-pprInstr (LIS reg imm) = hcat [
+pprInstr _ (LIS reg imm) = hcat [
 	char '\t',
 	ptext (sLit "lis"),
 	char '\t',
@@ -439,7 +439,7 @@ pprInstr (LIS reg imm) = hcat [
 	ptext (sLit ", "),
 	pprImm imm
     ]
-pprInstr (LI reg imm) = hcat [
+pprInstr _ (LI reg imm) = hcat [
 	char '\t',
 	ptext (sLit "li"),
 	char '\t',
@@ -447,11 +447,11 @@ pprInstr (LI reg imm) = hcat [
 	ptext (sLit ", "),
 	pprImm imm
     ]
-pprInstr (MR reg1 reg2) 
+pprInstr platform (MR reg1 reg2) 
     | reg1 == reg2 = empty
     | otherwise = hcat [
 	char '\t',
-	case targetClassOfReg reg1 of
+	case targetClassOfReg platform reg1 of
 	    RcInteger -> ptext (sLit "mr")
 	    _ -> ptext (sLit "fmr"),
 	char '\t',
@@ -459,7 +459,7 @@ pprInstr (MR reg1 reg2)
 	ptext (sLit ", "),
 	pprReg reg2
     ]
-pprInstr (CMP sz reg ri) = hcat [
+pprInstr _ (CMP sz reg ri) = hcat [
 	char '\t',
 	op,
 	char '\t',
@@ -475,7 +475,7 @@ pprInstr (CMP sz reg ri) = hcat [
 		    RIReg _ -> empty
 		    RIImm _ -> char 'i'
 	    ]
-pprInstr (CMPL sz reg ri) = hcat [
+pprInstr _ (CMPL sz reg ri) = hcat [
 	char '\t',
 	op,
 	char '\t',
@@ -491,7 +491,7 @@ pprInstr (CMPL sz reg ri) = hcat [
 		    RIReg _ -> empty
 		    RIImm _ -> char 'i'
 	    ]
-pprInstr (BCC cond blockid) = hcat [
+pprInstr _ (BCC cond blockid) = hcat [
 	char '\t',
 	ptext (sLit "b"),
 	pprCond cond,
@@ -500,7 +500,7 @@ pprInstr (BCC cond blockid) = hcat [
     ]
     where lbl = mkAsmTempLabel (getUnique blockid)
 
-pprInstr (BCCFAR cond blockid) = vcat [
+pprInstr _ (BCCFAR cond blockid) = vcat [
         hcat [
             ptext (sLit "\tb"),
             pprCond (condNegate cond),
@@ -513,33 +513,33 @@ pprInstr (BCCFAR cond blockid) = vcat [
     ]
     where lbl = mkAsmTempLabel (getUnique blockid)
 
-pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
+pprInstr _ (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
 	char '\t',
 	ptext (sLit "b"),
 	char '\t',
 	pprCLabel_asm lbl
     ]
 
-pprInstr (MTCTR reg) = hcat [
+pprInstr _ (MTCTR reg) = hcat [
 	char '\t',
 	ptext (sLit "mtctr"),
 	char '\t',
 	pprReg reg
     ]
-pprInstr (BCTR _ _) = hcat [
+pprInstr _ (BCTR _ _) = hcat [
 	char '\t',
 	ptext (sLit "bctr")
     ]
-pprInstr (BL lbl _) = hcat [
+pprInstr _ (BL lbl _) = hcat [
 	ptext (sLit "\tbl\t"),
         pprCLabel_asm lbl
     ]
-pprInstr (BCTRL _) = hcat [
+pprInstr _ (BCTRL _) = hcat [
 	char '\t',
 	ptext (sLit "bctrl")
     ]
-pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
-pprInstr (ADDIS reg1 reg2 imm) = hcat [
+pprInstr _ (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
+pprInstr _ (ADDIS reg1 reg2 imm) = hcat [
 	char '\t',
 	ptext (sLit "addis"),
 	char '\t',
@@ -550,15 +550,15 @@ pprInstr (ADDIS reg1 reg2 imm) = hcat [
 	pprImm imm
     ]
 
-pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
-pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
-pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
-pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
-pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
-pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
-pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
+pprInstr _ (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
+pprInstr _ (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
+pprInstr _ (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
+pprInstr _ (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
+pprInstr _ (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
+pprInstr _ (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
+pprInstr _ (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
 
-pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
+pprInstr _ (MULLW_MayOflo reg1 reg2 reg3) = vcat [
          hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
                                           pprReg reg2, ptext (sLit ", "),
                                           pprReg reg3 ],
@@ -570,7 +570,7 @@ pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
 
     	-- for some reason, "andi" doesn't exist.
 	-- we'll use "andi." instead.
-pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
+pprInstr _ (AND reg1 reg2 (RIImm imm)) = hcat [
 	char '\t',
 	ptext (sLit "andi."),
 	char '\t',
@@ -580,12 +580,12 @@ pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
 	ptext (sLit ", "),
 	pprImm imm
     ]
-pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
+pprInstr _ (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
 
-pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
-pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
+pprInstr _ (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
+pprInstr _ (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
 
-pprInstr (XORIS reg1 reg2 imm) = hcat [
+pprInstr _ (XORIS reg1 reg2 imm) = hcat [
 	char '\t',
 	ptext (sLit "xoris"),
 	char '\t',
@@ -596,7 +596,7 @@ pprInstr (XORIS reg1 reg2 imm) = hcat [
 	pprImm imm
     ]
 
-pprInstr (EXTS sz reg1 reg2) = hcat [
+pprInstr _ (EXTS sz reg1 reg2) = hcat [
 	char '\t',
 	ptext (sLit "exts"),
 	pprSize sz,
@@ -606,13 +606,13 @@ pprInstr (EXTS sz reg1 reg2) = hcat [
 	pprReg reg2
     ]
 
-pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
-pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
+pprInstr _ (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
+pprInstr _ (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
 
-pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
-pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
-pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
-pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
+pprInstr _ (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
+pprInstr _ (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
+pprInstr _ (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
+pprInstr _ (RLWINM reg1 reg2 sh mb me) = hcat [
         ptext (sLit "\trlwinm\t"),
         pprReg reg1,
         ptext (sLit ", "),
@@ -625,13 +625,13 @@ pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
         int me
     ]
     
-pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
-pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
-pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
-pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
-pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
+pprInstr _ (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
+pprInstr _ (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
+pprInstr _ (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
+pprInstr _ (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
+pprInstr _ (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
 
-pprInstr (FCMP reg1 reg2) = hcat [
+pprInstr _ (FCMP reg1 reg2) = hcat [
 	char '\t',
 	ptext (sLit "fcmpu\tcr0, "),
 	    -- Note: we're using fcmpu, not fcmpo
@@ -642,10 +642,10 @@ pprInstr (FCMP reg1 reg2) = hcat [
 	pprReg reg2
     ]
 
-pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
-pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
+pprInstr _ (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
+pprInstr _ (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
 
-pprInstr (CRNOR dst src1 src2) = hcat [
+pprInstr _ (CRNOR dst src1 src2) = hcat [
         ptext (sLit "\tcrnor\t"),
         int dst,
         ptext (sLit ", "),
@@ -654,28 +654,28 @@ pprInstr (CRNOR dst src1 src2) = hcat [
         int src2
     ]
 
-pprInstr (MFCR reg) = hcat [
+pprInstr _ (MFCR reg) = hcat [
 	char '\t',
 	ptext (sLit "mfcr"),
 	char '\t',
 	pprReg reg
     ]
 
-pprInstr (MFLR reg) = hcat [
+pprInstr _ (MFLR reg) = hcat [
 	char '\t',
 	ptext (sLit "mflr"),
 	char '\t',
 	pprReg reg
     ]
 
-pprInstr (FETCHPC reg) = vcat [
+pprInstr _ (FETCHPC reg) = vcat [
         ptext (sLit "\tbcl\t20,31,1f"),
         hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
     ]
 
-pprInstr LWSYNC = ptext (sLit "\tlwsync")
+pprInstr _ LWSYNC = ptext (sLit "\tlwsync")
 
--- pprInstr _ = panic "pprInstr (ppc)"
+-- pprInstr _ _ = panic "pprInstr (ppc)"
 
 
 pprLogic :: LitString -> Reg -> Reg -> RI -> Doc
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
diff --git a/compiler/nativeGen/SPARC/CodeGen/CCall.hs b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
index 7445f7168e..3e629c47f5 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CCall.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
@@ -24,8 +24,10 @@ import CLabel
 import BasicTypes
 
 import OrdList
+import DynFlags
 import FastString
 import Outputable
+import Platform
 
 {-
    Now the biggest nightmare---calls.  Most of the nastiness is buried in
@@ -137,6 +139,7 @@ genCCall target dest_regs argsAndHints
         let transfer_code
            	= toOL (move_final vregs allArgRegs extraStackArgsHere)
 				
+	dflags <- getDynFlagsNat
 	return 
 	 $ 	argcode			`appOL`
 		move_sp_down		`appOL`
@@ -144,7 +147,7 @@ genCCall target dest_regs argsAndHints
 		callinsns		`appOL`
 		unitOL NOP		`appOL`
 		move_sp_up		`appOL`
-		assign_code dest_regs
+		assign_code (targetPlatform dflags) dest_regs
 
 
 -- | Generate code to calculate an argument, and move it into one
@@ -224,11 +227,11 @@ move_final (v:vs) (a:az) offset
 -- | Assign results returned from the call into their 
 --	desination regs.
 --
-assign_code :: [CmmHinted LocalReg] -> OrdList Instr
+assign_code :: Platform -> [CmmHinted LocalReg] -> OrdList Instr
 
-assign_code []	= nilOL
+assign_code _ [] = nilOL
 
-assign_code [CmmHinted dest _hint]	
+assign_code platform [CmmHinted dest _hint]
  = let	rep	= localRegType dest
 	width	= typeWidth rep
 	r_dest 	= getRegisterReg (CmmLocal dest)
@@ -244,20 +247,20 @@ assign_code [CmmHinted dest _hint]
 
 		| not $ isFloatType rep
 		, W32	<- width
-		= unitOL $ mkRegRegMoveInstr (regSingle $ oReg 0) r_dest
+		= unitOL $ mkRegRegMoveInstr platform (regSingle $ oReg 0) r_dest
 
 		| not $ isFloatType rep
 		, W64		<- width
 		, r_dest_hi	<- getHiVRegFromLo r_dest
-		= toOL 	[ mkRegRegMoveInstr (regSingle $ oReg 0) r_dest_hi
-			, mkRegRegMoveInstr (regSingle $ oReg 1) r_dest]
+		= toOL 	[ mkRegRegMoveInstr platform (regSingle $ oReg 0) r_dest_hi
+			, mkRegRegMoveInstr platform (regSingle $ oReg 1) r_dest]
 
 		| otherwise
 		= panic "SPARC.CodeGen.GenCCall: no match"
 		
    in	result
 
-assign_code _
+assign_code _ _
 	= panic "SPARC.CodeGen.GenCCall: no match"
 
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
index 180ec315ee..6bf2a8f32d 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
@@ -23,6 +23,7 @@ import Reg
 
 import OldCmm
 
+import DynFlags
 import OrdList
 import Outputable
 
@@ -182,10 +183,12 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
 	-- compute expr and load it into r_dst_lo
 	(a_reg, a_code)	<- getSomeReg expr
 
-	let code	= a_code
+	dflags <- getDynFlagsNat
+	let platform = targetPlatform dflags
+	    code	= a_code
 		`appOL`	toOL
-			[ mkRegRegMoveInstr g0    r_dst_hi 	-- clear high 32 bits
-			, mkRegRegMoveInstr a_reg r_dst_lo ]
+			[ mkRegRegMoveInstr platform g0    r_dst_hi 	-- clear high 32 bits
+			, mkRegRegMoveInstr platform a_reg r_dst_lo ]
 			
 	return	$ ChildCode64 code r_dst_lo
 
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 816af9ba2a..61090e05c8 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -43,6 +43,7 @@ import OldCmm
 import FastString
 import FastBool
 import Outputable
+import Platform
 
 
 -- | Register or immediate
@@ -363,15 +364,16 @@ sparc_patchJumpInstr insn patchF
 -- | Make a spill instruction.
 -- 	On SPARC we spill below frame pointer leaving 2 words/spill
 sparc_mkSpillInstr
-	:: Reg		-- ^ register to spill
-	-> Int		-- ^ current stack delta
-	-> Int		-- ^ spill slot to use
-	-> Instr
+    :: Platform
+    -> Reg      -- ^ register to spill
+    -> Int      -- ^ current stack delta
+    -> Int      -- ^ spill slot to use
+    -> Instr
 
-sparc_mkSpillInstr reg _ slot
+sparc_mkSpillInstr platform reg _ slot
  = let	off     = spillSlotToOffset slot
         off_w	= 1 + (off `div` 4)
-        sz 	= case targetClassOfReg reg of
+        sz 	= case targetClassOfReg platform reg of
 			RcInteger -> II32
 			RcFloat   -> FF32
 			RcDouble  -> FF64
@@ -382,15 +384,16 @@ sparc_mkSpillInstr reg _ slot
 
 -- | Make a spill reload instruction.
 sparc_mkLoadInstr
-	:: Reg		-- ^ register to load into
-	-> Int		-- ^ current stack delta
-	-> Int		-- ^ spill slot to use
-	-> Instr
+    :: Platform
+    -> Reg      -- ^ register to load into
+    -> Int      -- ^ current stack delta
+    -> Int      -- ^ spill slot to use
+    -> Instr
 
-sparc_mkLoadInstr reg _ slot
+sparc_mkLoadInstr platform reg _ slot
   = let off     = spillSlotToOffset slot
 	off_w	= 1 + (off `div` 4)
-        sz	= case targetClassOfReg reg of
+        sz	= case targetClassOfReg platform reg of
 			RcInteger -> II32
 			RcFloat   -> FF32
 			RcDouble  -> FF64
@@ -430,13 +433,14 @@ sparc_isMetaInstr instr
 --	have to go via memory.
 --
 sparc_mkRegRegMoveInstr
-	:: Reg
-	-> Reg
-	-> Instr
-
-sparc_mkRegRegMoveInstr src dst
-	| srcClass	<- targetClassOfReg src
-	, dstClass	<- targetClassOfReg dst
+    :: Platform
+    -> Reg
+    -> Reg
+    -> Instr
+
+sparc_mkRegRegMoveInstr platform src dst
+	| srcClass	<- targetClassOfReg platform src
+	, dstClass	<- targetClassOfReg platform dst
 	, srcClass == dstClass
 	= case srcClass of
 		RcInteger -> ADD  False False src (RIReg g0) dst
diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs
index cf2cf80b75..456ec2b3e5 100644
--- a/compiler/nativeGen/TargetReg.hs
+++ b/compiler/nativeGen/TargetReg.hs
@@ -66,9 +66,9 @@ targetRealRegSqueeze platform
       ArchARM     -> panic "targetRealRegSqueeze ArchARM"
       ArchUnknown -> panic "targetRealRegSqueeze ArchUnknown"
 
-targetClassOfRealReg :: RealReg -> RegClass
-targetClassOfRealReg
-    = case platformArch defaultTargetPlatform of
+targetClassOfRealReg :: Platform -> RealReg -> RegClass
+targetClassOfRealReg platform
+    = case platformArch platform of
       ArchX86     -> X86.classOfRealReg
       ArchX86_64  -> X86.classOfRealReg
       ArchPPC     -> PPC.classOfRealReg
@@ -81,9 +81,9 @@ targetClassOfRealReg
 targetWordSize :: Size
 targetWordSize = intSize wordWidth
 
-targetMkVirtualReg :: Unique -> Size -> VirtualReg
-targetMkVirtualReg
-    = case platformArch defaultTargetPlatform of
+targetMkVirtualReg :: Platform -> Unique -> Size -> VirtualReg
+targetMkVirtualReg platform
+    = case platformArch platform of
       ArchX86     -> X86.mkVirtualReg
       ArchX86_64  -> X86.mkVirtualReg
       ArchPPC     -> PPC.mkVirtualReg
@@ -92,9 +92,9 @@ targetMkVirtualReg
       ArchARM     -> panic "targetMkVirtualReg ArchARM"
       ArchUnknown -> panic "targetMkVirtualReg ArchUnknown"
 
-targetRegDotColor :: RealReg -> SDoc
-targetRegDotColor
-    = case platformArch defaultTargetPlatform of
+targetRegDotColor :: Platform -> RealReg -> SDoc
+targetRegDotColor platform
+    = case platformArch platform of
       ArchX86     -> X86.regDotColor
       ArchX86_64  -> X86.regDotColor
       ArchPPC     -> PPC.regDotColor
@@ -104,10 +104,10 @@ targetRegDotColor
       ArchUnknown -> panic "targetRegDotColor ArchUnknown"
 
 
-targetClassOfReg :: Reg -> RegClass
-targetClassOfReg reg
+targetClassOfReg :: Platform -> Reg -> RegClass
+targetClassOfReg platform reg
  = case reg of
- 	RegVirtual vr	-> classOfVirtualReg vr
-	RegReal rr	-> targetClassOfRealReg rr
+   RegVirtual vr -> classOfVirtualReg vr
+   RegReal rr -> targetClassOfRealReg platform rr
 
 
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index 0e70dbb503..0e292ac21f 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -25,6 +25,7 @@ import OldCmm
 import FastString
 import FastBool
 import Outputable
+import Platform
 import Constants	(rESERVED_C_STACK_BYTES)
 
 import BasicTypes       (Alignment)
@@ -603,16 +604,17 @@ x86_patchJumpInstr insn patchF
 -- -----------------------------------------------------------------------------
 -- | Make a spill instruction.
 x86_mkSpillInstr
-	:: Reg		-- register to spill
-	-> Int		-- current stack delta
-	-> Int		-- spill slot to use
-	-> Instr
+    :: Platform
+    -> Reg      -- register to spill
+    -> Int      -- current stack delta
+    -> Int      -- spill slot to use
+    -> Instr
 
-x86_mkSpillInstr reg delta slot
+x86_mkSpillInstr platform reg delta slot
   = let	off     = spillSlotToOffset slot
     in
     let off_w = (off-delta) `div` IF_ARCH_i386(4,8)
-    in case targetClassOfReg reg of
+    in case targetClassOfReg platform reg of
 	   RcInteger   -> MOV IF_ARCH_i386(II32,II64)
                               (OpReg reg) (OpAddr (spRel off_w))
 	   RcDouble    -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -}
@@ -622,16 +624,17 @@ x86_mkSpillInstr reg delta slot
 
 -- | Make a spill reload instruction.
 x86_mkLoadInstr
-	:: Reg		-- register to load
-	-> Int		-- current stack delta
-	-> Int		-- spill slot to use
-	-> Instr
+    :: Platform
+    -> Reg      -- register to load
+    -> Int      -- current stack delta
+    -> Int      -- spill slot to use
+    -> Instr
 
-x86_mkLoadInstr reg delta slot
+x86_mkLoadInstr platform reg delta slot
   = let off     = spillSlotToOffset slot
     in
 	let off_w = (off-delta) `div` IF_ARCH_i386(4,8)
-        in case targetClassOfReg reg of
+        in case targetClassOfReg platform reg of
               RcInteger -> MOV IF_ARCH_i386(II32,II64) 
                                (OpAddr (spRel off_w)) (OpReg reg)
               RcDouble  -> GLD FF80 (spRel off_w) reg {- RcFloat/RcDouble -}
@@ -689,12 +692,13 @@ x86_isMetaInstr instr
 --	have to go via memory.
 --
 x86_mkRegRegMoveInstr
-	:: Reg
-	-> Reg
-	-> Instr
+    :: Platform
+    -> Reg
+    -> Reg
+    -> Instr
 
-x86_mkRegRegMoveInstr src dst
- = case targetClassOfReg src of
+x86_mkRegRegMoveInstr platform src dst
+ = case targetClassOfReg platform src of
 #if   i386_TARGET_ARCH
         RcInteger -> MOV II32 (OpReg src) (OpReg dst)
 #else
author	Ian Lynagh <igloo@earth.li>	2011-07-15 18:13:49 +0100
committer	Ian Lynagh <igloo@earth.li>	2011-07-15 19:03:23 +0100
commit	730301c60e6ccd9ed4fb248bcd2399f938a43d25 (patch)
tree	680c524b5353acaff547e2a739185f3593557873 /compiler
parent	5c718b15e83e3b205e13c882660a4952714c3b4c (diff)
download	haskell-730301c60e6ccd9ed4fb248bcd2399f938a43d25.tar.gz