Merge remote-tracking branch 'origin/master' into tc-untouchables

Conflicts:
	compiler/typecheck/TcMType.lhs
	compiler/typecheck/TcSMonad.lhs

30 files changed, 852 insertions, 733 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 6b1e93f271..8c608f1bf1 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -139,7 +139,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     shortcutStatics           :: (BlockId -> Maybe jumpDest) -> statics -> statics,
     shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,
     pprNatCmmDecl             :: NatCmmDecl statics instr -> SDoc,
-    maxSpillSlots             :: Int,
+    maxSpillSlots             :: DynFlags -> Int,
     allocatableRegs           :: Platform -> [RealReg],
     ncg_x86fp_kludge          :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
     ncgExpandTop              :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
@@ -160,7 +160,7 @@ nativeCodeGen dflags h us cmms
                         ,shortcutStatics           = X86.Instr.shortcutStatics
                         ,shortcutJump              = X86.Instr.shortcutJump
                         ,pprNatCmmDecl              = X86.Ppr.pprNatCmmDecl
-                        ,maxSpillSlots             = X86.Instr.maxSpillSlots (target32Bit platform)
+                        ,maxSpillSlots             = X86.Instr.maxSpillSlots
                         ,allocatableRegs           = X86.Regs.allocatableRegs
                         ,ncg_x86fp_kludge          = id
                         ,ncgExpandTop              = id
@@ -378,7 +378,7 @@ cmmNativeGen dflags ncgImpl us cmm count
         -- rewrite assignments to global regs
         let fixed_cmm =
                 {-# SCC "fixStgRegisters" #-}
-                fixStgRegisters platform cmm
+                fixStgRegisters dflags cmm
 
         -- cmm to cmm optimisations
         let (opt_cmm, imports) =
@@ -428,7 +428,7 @@ cmmNativeGen dflags ncgImpl us cmm count
                           $ Color.regAlloc
                                 dflags
                                 alloc_regs
-                                (mkUniqSet [0 .. maxSpillSlots ncgImpl])
+                                (mkUniqSet [0 .. maxSpillSlots ncgImpl dflags])
                                 withLiveness
 
                 -- dump out what happened during register allocation
@@ -955,13 +955,13 @@ cmmExprConFold referenceKind expr = do
     -- SDM: re-enabled for now, while cmmRewriteAssignments is turned off
     let expr' = if False -- dopt Opt_TryNewCodeGen dflags
                     then expr
-                    else cmmExprCon (targetPlatform dflags) expr
+                    else cmmExprCon dflags expr
     cmmExprNative referenceKind expr'
 
-cmmExprCon :: Platform -> CmmExpr -> CmmExpr
-cmmExprCon platform (CmmLoad addr rep) = CmmLoad (cmmExprCon platform addr) rep
-cmmExprCon platform (CmmMachOp mop args)
-    = cmmMachOpFold platform mop (map (cmmExprCon platform) args)
+cmmExprCon :: DynFlags -> CmmExpr -> CmmExpr
+cmmExprCon dflags (CmmLoad addr rep) = CmmLoad (cmmExprCon dflags addr) rep
+cmmExprCon dflags (CmmMachOp mop args)
+    = cmmMachOpFold dflags mop (map (cmmExprCon dflags) args)
 cmmExprCon _ other = other
 
 -- handles both PIC and non-PIC cases... a very strange mixture
@@ -993,9 +993,9 @@ cmmExprNative referenceKind expr = do
            -> do
                  dynRef <- cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
                  -- need to optimize here, since it's late
-                 return $ cmmMachOpFold platform (MO_Add wordWidth) [
+                 return $ cmmMachOpFold dflags (MO_Add (wordWidth dflags)) [
                      dynRef,
-                     (CmmLit $ CmmInt (fromIntegral off) wordWidth)
+                     (CmmLit $ CmmInt (fromIntegral off) (wordWidth dflags))
                    ]
 
         -- On powerpc (non-PIC), it's easier to jump directly to a label than
diff --git a/compiler/nativeGen/Instruction.hs b/compiler/nativeGen/Instruction.hs
index 292cf82f6a..64ba32c6dc 100644
--- a/compiler/nativeGen/Instruction.hs
+++ b/compiler/nativeGen/Instruction.hs
@@ -13,6 +13,7 @@ where
 import Reg
 
 import BlockId
+import DynFlags
 import OldCmm
 import Platform
 
@@ -105,7 +106,7 @@ class   Instruction instr where
 
         -- | An instruction to spill a register into a spill slot.
         mkSpillInstr
-                :: Platform
+                :: DynFlags
                 -> Reg          -- ^ the reg to spill
                 -> Int          -- ^ the current stack delta
                 -> Int          -- ^ spill slot to use
@@ -114,7 +115,7 @@ class   Instruction instr where
 
         -- | An instruction to reload a register from a spill slot.
         mkLoadInstr
-                :: Platform
+                :: DynFlags
                 -> Reg          -- ^ the reg to reload.
                 -> Int          -- ^ the current stack delta
                 -> Int          -- ^ the spill slot to use
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index 67945669f5..af4bb9e9ed 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -65,6 +65,7 @@ import Reg
 import NCGMonad
 
 
+import Hoopl
 import OldCmm
 import CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,
                           mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
@@ -74,7 +75,6 @@ import CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,
 import CLabel           ( mkForeignLabel )
 
 
-import StaticFlags	( opt_Static )
 import BasicTypes
 
 import Outputable
@@ -133,7 +133,7 @@ cmmMakeDynamicReference' dflags addImport referenceKind lbl
         AccessViaSymbolPtr -> do
               let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
               addImport symbolPtr
-              return $ CmmLoad (cmmMakePicReference dflags symbolPtr) bWord
+              return $ CmmLoad (cmmMakePicReference dflags symbolPtr) (bWord dflags)
 
         AccessDirectly -> case referenceKind of
                 -- for data, we might have to make some calculations:
@@ -160,8 +160,8 @@ cmmMakePicReference dflags lbl
 	= CmmLit $ CmmLabel lbl
 
 
-	| (dopt Opt_PIC dflags || not opt_Static) && absoluteLabel lbl 
-	= CmmMachOp (MO_Add wordWidth) 
+	| (dopt Opt_PIC dflags || not (dopt Opt_Static dflags)) && absoluteLabel lbl 
+	= CmmMachOp (MO_Add (wordWidth dflags)) 
 		[ CmmReg (CmmGlobal PicBaseReg)
 		, CmmLit $ picRelative 
 				(platformArch 	$ targetPlatform dflags)
@@ -213,14 +213,14 @@ howToAccessLabel
 -- To access the function at SYMBOL from our local module, we just need to
 -- dereference the local __imp_SYMBOL.
 --
--- If opt_Static is set then we assume that all our code will be linked
+-- If Opt_Static is set then we assume that all our code will be linked
 -- into the same .exe file. In this case we always access symbols directly, 
 -- and never use __imp_SYMBOL.
 --
 howToAccessLabel dflags _ OSMinGW32 _ lbl
 
 	-- Assume all symbols will be in the same PE, so just access them directly.
-	| opt_Static
+	| dopt Opt_Static dflags
 	= AccessDirectly
 	
 	-- If the target symbol is in another PE we need to access it via the
@@ -306,7 +306,7 @@ howToAccessLabel dflags _ os _ _
 	--           if we don't dynamically link to Haskell code,
 	--           it actually manages to do so without messing thins up.
 	| osElfTarget os
-	, not (dopt Opt_PIC dflags) && opt_Static 
+	, not (dopt Opt_PIC dflags) && dopt Opt_Static dflags
 	= AccessDirectly
 
 howToAccessLabel dflags arch os DataReference lbl
@@ -428,12 +428,12 @@ needImportedSymbols dflags arch os
 	-- PowerPC Linux: -fPIC or -dynamic
 	| osElfTarget os
 	, arch	== ArchPPC
-	= dopt Opt_PIC dflags || not opt_Static
+	= dopt Opt_PIC dflags || not (dopt Opt_Static dflags)
 
 	-- i386 (and others?): -dynamic but not -fPIC
 	| osElfTarget os
 	, arch	/= ArchPPC_64
-	= not opt_Static && not (dopt Opt_PIC dflags)
+	= not (dopt Opt_Static dflags) && not (dopt Opt_PIC dflags)
 
 	| otherwise
 	= False
@@ -622,7 +622,7 @@ pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
 --    section.
 --    The "official" GOT mechanism (label@got) isn't intended to be used
 --    in position dependent code, so we have to create our own "fake GOT"
---    when not Opt_PIC && not opt_Static.
+--    when not Opt_PIC && not (dopt Opt_Static dflags).
 --
 -- 2) PowerPC Linux is just plain broken.
 --    While it's theoretically possible to use GOT offsets larger
@@ -641,11 +641,11 @@ pprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 }) _
 	| osElfTarget (platformOS platform)
 	= empty
 
-pprImportedSymbol _ platform importedLbl
+pprImportedSymbol dflags platform importedLbl
 	| osElfTarget (platformOS platform)
 	= case dynamicLinkerLabelInfo importedLbl of
 	    Just (SymbolPtr, lbl)
-	      -> let symbolSize = case wordWidth of
+	      -> let symbolSize = case wordWidth dflags of
 		         W32 -> sLit "\t.long"
 		         W64 -> sLit "\t.quad"
 		         _ -> panic "Unknown wordRep in pprImportedSymbol"
@@ -703,8 +703,9 @@ initializePicBase_ppc ArchPPC os picReg
     (CmmProc info lab (ListGraph blocks) : statics)
     | osElfTarget os
     = do
+        dflags <- getDynFlags
         gotOffLabel <- getNewLabelNat
-        tmp <- getNewRegNat $ intSize wordWidth
+        tmp <- getNewRegNat $ intSize (wordWidth dflags)
         let 
             gotOffset = CmmData Text $ Statics gotOffLabel [
 			    CmmStaticLit (CmmLabelDiffOff gotLabel
@@ -752,18 +753,37 @@ initializePicBase_x86
 	-> NatM [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
 
 initializePicBase_x86 ArchX86 os picReg 
-	(CmmProc info lab (ListGraph blocks) : statics)
+        (CmmProc info lab (ListGraph blocks) : statics)
     | osElfTarget os
-    = return (CmmProc info lab (ListGraph (b':tail blocks)) : statics)
-    where BasicBlock bID insns = head blocks
-          b' = BasicBlock bID (X86.FETCHGOT picReg : insns)
+    = return (CmmProc info lab (ListGraph blocks') : statics)
+    where blocks' = case blocks of
+                     [] -> []
+                     (b:bs) -> fetchGOT b : map maybeFetchGOT bs
+
+          -- we want to add a FETCHGOT instruction to the beginning of
+          -- every block that is an entry point, which corresponds to
+          -- the blocks that have entries in the info-table mapping.
+          maybeFetchGOT b@(BasicBlock bID _)
+            | bID `mapMember` info = fetchGOT b
+            | otherwise            = b
+
+          fetchGOT (BasicBlock bID insns) =
+             BasicBlock bID (X86.FETCHGOT picReg : insns)
 
 initializePicBase_x86 ArchX86 OSDarwin picReg
 	(CmmProc info lab (ListGraph blocks) : statics)
-	= return (CmmProc info lab (ListGraph (b':tail blocks)) : statics)
+        = return (CmmProc info lab (ListGraph blocks') : statics)
 
-	where 	BasicBlock bID insns = head blocks
-          	b' = BasicBlock bID (X86.FETCHPC picReg : insns)
+    where blocks' = case blocks of
+                     [] -> []
+                     (b:bs) -> fetchPC b : map maybeFetchPC bs
+
+          maybeFetchPC b@(BasicBlock bID _)
+            | bID `mapMember` info = fetchPC b
+            | otherwise            = b
+
+          fetchPC (BasicBlock bID insns) =
+             BasicBlock bID (X86.FETCHPC picReg : insns)
 
 initializePicBase_x86 _ _ _ _
 	= panic "initializePicBase_x86: not needed"
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index ce4a54ca9b..1f036aa43e 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -124,7 +124,7 @@ stmtToInstrs stmt = do
       | target32Bit (targetPlatform dflags) &&
         isWord64 ty    -> assignReg_I64Code      reg src
       | otherwise        -> assignReg_IntCode size reg src
-        where ty = cmmRegType reg
+        where ty = cmmRegType dflags reg
               size = cmmTypeSize ty
 
     CmmStore addr src
@@ -132,7 +132,7 @@ stmtToInstrs stmt = do
       | target32Bit (targetPlatform dflags) &&
         isWord64 ty      -> assignMem_I64Code      addr src
       | otherwise        -> assignMem_IntCode size addr src
-        where ty = cmmExprType src
+        where ty = cmmExprType dflags src
               size = cmmTypeSize ty
 
     CmmCall target result_regs args _
@@ -206,9 +206,9 @@ temporary, then do the other computation, and then use the temporary:
 
 
 -- | Convert a BlockId to some CmmStatic data
-jumpTableEntry :: Maybe BlockId -> CmmStatic
-jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
-jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
+jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
+jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
+jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
     where blockLabel = mkAsmTempLabel (getUnique blockid)
 
 
@@ -218,12 +218,12 @@ jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
 
 -- Expand CmmRegOff.  ToDo: should we do it this way around, or convert
 -- CmmExprs into CmmRegOff?
-mangleIndexTree :: CmmExpr -> CmmExpr
-mangleIndexTree (CmmRegOff reg off)
+mangleIndexTree :: DynFlags -> CmmExpr -> CmmExpr
+mangleIndexTree dflags (CmmRegOff reg off)
   = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
-  where width = typeWidth (cmmRegType reg)
+  where width = typeWidth (cmmRegType dflags reg)
 
-mangleIndexTree _
+mangleIndexTree _ _
         = panic "PPC.CodeGen.mangleIndexTree: no match"
 
 -- -----------------------------------------------------------------------------
@@ -370,11 +370,11 @@ getRegister' _ (CmmReg (CmmGlobal PicBaseReg))
       return (Fixed archWordSize reg nilOL)
 
 getRegister' dflags (CmmReg reg)
-  = return (Fixed (cmmTypeSize (cmmRegType reg))
+  = return (Fixed (cmmTypeSize (cmmRegType dflags reg))
                   (getRegisterReg (targetPlatform dflags) reg) nilOL)
 
 getRegister' dflags tree@(CmmRegOff _ _)
-  = getRegister' dflags (mangleIndexTree tree)
+  = getRegister' dflags (mangleIndexTree dflags tree)
 
     -- for 32-bit architectuers, support some 64 -> 32 bit conversions:
     -- TO_W_(x), TO_W_(x >> 32)
@@ -561,8 +561,8 @@ getRegister' _ (CmmLit (CmmFloat f frep)) = do
             `consOL` (addr_code `snocOL` LD size dst addr)
     return (Any size code)
 
-getRegister' _ (CmmLit lit)
-  = let rep = cmmLitType lit
+getRegister' dflags (CmmLit lit)
+  = let rep = cmmLitType dflags lit
         imm = litToImm lit
         code dst = toOL [
               LIS dst (HA imm),
@@ -607,7 +607,8 @@ temporary, then do the other computation, and then use the temporary:
 -}
 
 getAmode :: CmmExpr -> NatM Amode
-getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
+getAmode tree@(CmmRegOff _ _) = do dflags <- getDynFlags
+                                   getAmode (mangleIndexTree dflags tree)
 
 getAmode (CmmMachOp (MO_Sub W32) [x, CmmLit (CmmInt i _)])
   | Just off <- makeImmediate W32 True (-i)
@@ -844,14 +845,14 @@ genCCall target dest_regs argsAndHints
  = do dflags <- getDynFlags
       let platform = targetPlatform dflags
       case platformOS platform of
-          OSLinux    -> genCCall' platform GCPLinux  target dest_regs argsAndHints
-          OSDarwin   -> genCCall' platform GCPDarwin target dest_regs argsAndHints
+          OSLinux    -> genCCall' dflags GCPLinux  target dest_regs argsAndHints
+          OSDarwin   -> genCCall' dflags GCPDarwin target dest_regs argsAndHints
           _ -> panic "PPC.CodeGen.genCCall: not defined for this os"
 
 data GenCCallPlatform = GCPLinux | GCPDarwin
 
 genCCall'
-    :: Platform
+    :: DynFlags
     -> GenCCallPlatform
     -> CmmCallTarget            -- function to call
     -> [HintedCmmFormal]        -- where to put the result
@@ -902,7 +903,7 @@ genCCall' _ _ (CmmPrim MO_WriteBarrier _) _ _
 genCCall' _ _ (CmmPrim _ (Just stmts)) _ _
     = stmtsToInstrs stmts
 
-genCCall' platform gcp target dest_regs argsAndHints
+genCCall' dflags gcp target dest_regs argsAndHints
   = ASSERT (not $ any (`elem` [II16]) $ map cmmTypeSize argReps)
         -- we rely on argument promotion in the codeGen
     do
@@ -934,6 +935,8 @@ genCCall' platform gcp target dest_regs argsAndHints
                         `snocOL` BCTRL usedRegs
                         `appOL`  codeAfter)
     where
+        platform = targetPlatform dflags
+
         initialStackOffset = case gcp of
                              GCPDarwin -> 24
                              GCPLinux  -> 8
@@ -955,7 +958,7 @@ genCCall' platform gcp target dest_regs argsAndHints
                       = argsAndHints
 
         args = map hintlessCmm argsAndHints'
-        argReps = map cmmExprType args
+        argReps = map (cmmExprType dflags) args
 
         roundTo a x | x `mod` a == 0 = x
                     | otherwise = x + a - (x `mod` a)
@@ -1060,23 +1063,23 @@ genCCall' platform gcp target dest_regs argsAndHints
                       GCPDarwin ->
                           case cmmTypeSize rep of
                           II8  -> (1, 0, 4, gprs)
+                          II16 -> (1, 0, 4, gprs)
                           II32 -> (1, 0, 4, gprs)
                           -- The Darwin ABI requires that we skip a
                           -- corresponding number of GPRs when we use
                           -- the FPRs.
                           FF32 -> (1, 1, 4, fprs)
                           FF64 -> (2, 1, 8, fprs)
-                          II16 -> panic "genCCall' passArguments II16"
                           II64 -> panic "genCCall' passArguments II64"
                           FF80 -> panic "genCCall' passArguments FF80"
                       GCPLinux ->
                           case cmmTypeSize rep of
                           II8  -> (1, 0, 4, gprs)
+                          II16 -> (1, 0, 4, gprs)
                           II32 -> (1, 0, 4, gprs)
                           -- ... the SysV ABI doesn't.
                           FF32 -> (0, 1, 4, fprs)
                           FF64 -> (0, 1, 8, fprs)
-                          II16 -> panic "genCCall' passArguments II16"
                           II64 -> panic "genCCall' passArguments II64"
                           FF80 -> panic "genCCall' passArguments FF80"
 
@@ -1089,7 +1092,7 @@ genCCall' platform gcp target dest_regs argsAndHints
                     | isWord64 rep -> toOL [MR (getHiVRegFromLo r_dest) r3,
                                           MR r_dest r4]
                     | otherwise -> unitOL (MR r_dest r3)
-                    where rep = cmmRegType (CmmLocal dest)
+                    where rep = cmmRegType dflags (CmmLocal dest)
                           r_dest = getRegisterReg platform (CmmLocal dest)
                 _ -> panic "genCCall' moveResult: Bad dest_regs"
 
@@ -1194,9 +1197,9 @@ generateJumpTableForInstr :: DynFlags -> Instr
 generateJumpTableForInstr dflags (BCTR ids (Just lbl)) =
     let jumpTable
             | dopt Opt_PIC dflags = map jumpTableEntryRel ids
-            | otherwise = map jumpTableEntry ids
+            | otherwise = map (jumpTableEntry dflags) ids
                 where jumpTableEntryRel Nothing
-                        = CmmStaticLit (CmmInt 0 wordWidth)
+                        = CmmStaticLit (CmmInt 0 (wordWidth dflags))
                       jumpTableEntryRel (Just blockid)
                         = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
                             where blockLabel = mkAsmTempLabel (getUnique blockid)
@@ -1376,10 +1379,10 @@ coerceInt2FP fromRep toRep x = do
                                  [CmmStaticLit (CmmInt 0x43300000 W32),
                                   CmmStaticLit (CmmInt 0x80000000 W32)],
                 XORIS itmp src (ImmInt 0x8000),
-                ST II32 itmp (spRel 3),
+                ST II32 itmp (spRel dflags 3),
                 LIS itmp (ImmInt 0x4330),
-                ST II32 itmp (spRel 2),
-                LD FF64 ftmp (spRel 2)
+                ST II32 itmp (spRel dflags 2),
+                LD FF64 ftmp (spRel dflags 2)
             ] `appOL` addr_code `appOL` toOL [
                 LD FF64 dst addr,
                 FSUB FF64 dst ftmp dst
@@ -1401,6 +1404,7 @@ coerceInt2FP fromRep toRep x = do
 
 coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
 coerceFP2Int _ toRep x = do
+    dflags <- getDynFlags
     -- the reps don't really matter: F*->FF64 and II32->I* are no-ops
     (src, code) <- getSomeReg x
     tmp <- getNewRegNat FF64
@@ -1409,7 +1413,7 @@ coerceFP2Int _ toRep x = do
                 -- convert to int in FP reg
             FCTIWZ tmp src,
                 -- store value (64bit) from FP to stack
-            ST FF64 tmp (spRel 2),
+            ST FF64 tmp (spRel dflags 2),
                 -- read low word of value (high word is undefined)
-            LD II32 dst (spRel 3)]
+            LD II32 dst (spRel dflags 3)]
     return (Any (intSize toRep) code')
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 1af08a6076..464a88a08b 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -34,8 +34,8 @@ import RegClass
 import Reg
 
 import CodeGen.Platform
-import Constants	(rESERVED_C_STACK_BYTES)
 import BlockId
+import DynFlags
 import OldCmm
 import FastString
 import CLabel
@@ -355,14 +355,15 @@ ppc_patchJumpInstr insn patchF
 
 -- | An instruction to spill a register into a spill slot.
 ppc_mkSpillInstr
-   :: Platform
+   :: DynFlags
    -> Reg       -- register to spill
    -> Int       -- current stack delta
    -> Int       -- spill slot to use
    -> Instr
 
-ppc_mkSpillInstr platform reg delta slot
-  = let	off     = spillSlotToOffset slot
+ppc_mkSpillInstr dflags reg delta slot
+  = let platform = targetPlatform dflags
+        off      = spillSlotToOffset dflags slot
     in
     let sz = case targetClassOfReg platform reg of
                 RcInteger -> II32
@@ -372,14 +373,15 @@ ppc_mkSpillInstr platform reg delta slot
 
 
 ppc_mkLoadInstr
-   :: Platform
+   :: DynFlags
    -> Reg       -- register to load
    -> Int       -- current stack delta
    -> Int       -- spill slot to use
    -> Instr
 
-ppc_mkLoadInstr platform reg delta slot
-  = let off     = spillSlotToOffset slot
+ppc_mkLoadInstr dflags reg delta slot
+  = let platform = targetPlatform dflags
+        off     = spillSlotToOffset dflags slot
     in
     let sz = case targetClassOfReg platform reg of
                 RcInteger -> II32
@@ -391,20 +393,21 @@ ppc_mkLoadInstr platform reg delta slot
 spillSlotSize :: Int
 spillSlotSize = 8
 
-maxSpillSlots :: Int
-maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
+maxSpillSlots :: DynFlags -> Int
+maxSpillSlots dflags
+    = ((rESERVED_C_STACK_BYTES dflags - 64) `div` spillSlotSize) - 1
 
 -- convert a spill slot number to a *byte* offset, with no sign:
 -- decide on a per arch basis whether you are spilling above or below
 -- the C stack pointer.
-spillSlotToOffset :: Int -> Int
-spillSlotToOffset slot
-   | slot >= 0 && slot < maxSpillSlots
+spillSlotToOffset :: DynFlags -> Int -> Int
+spillSlotToOffset dflags slot
+   | slot >= 0 && slot < maxSpillSlots dflags
    = 64 + spillSlotSize * slot
    | otherwise
    = pprPanic "spillSlotToOffset:" 
               (   text "invalid spill location: " <> int slot
-	      $$  text "maxSpillSlots:          " <> int maxSpillSlots)
+	      $$  text "maxSpillSlots:          " <> int (maxSpillSlots dflags))
 
 
 --------------------------------------------------------------------------------
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 55cc6d2a0d..576e19db1a 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -31,6 +31,7 @@ import RegClass
 import TargetReg
 
 import OldCmm
+import BlockId
 
 import CLabel
 
@@ -50,7 +51,7 @@ pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
   pprSectionHeader section $$ pprDatas dats
 
-pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) =
+pprNatCmmDecl proc@(CmmProc top_info lbl (ListGraph blocks)) =
   case topInfoTable proc of
     Nothing ->
        case blocks of
@@ -59,19 +60,15 @@ pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) =
          blocks -> -- special case for code without info table:
            pprSectionHeader Text $$
            pprLabel lbl $$ -- blocks guaranteed not null, so label needed
-           vcat (map pprBasicBlock blocks)
+           vcat (map (pprBasicBlock top_info) blocks)
 
-    Just (Statics info_lbl info) ->
+    Just (Statics info_lbl _) ->
       sdocWithPlatform $ \platform ->
-      pprSectionHeader Text $$
-      (
-           (if platformHasSubsectionsViaSymbols platform
-            then ppr (mkDeadStripPreventer info_lbl) <> char ':'
-            else empty) $$
-           vcat (map pprData info) $$
-           pprLabel info_lbl
-      ) $$
-      vcat (map pprBasicBlock blocks) $$
+      (if platformHasSubsectionsViaSymbols platform
+          then pprSectionHeader Text $$
+               ppr (mkDeadStripPreventer info_lbl) <> char ':'
+          else empty) $$
+      vcat (map (pprBasicBlock top_info) blocks) $$
          -- above: Even the first block gets a label, because with branch-chain
          -- elimination, it might be the target of a goto.
             (if platformHasSubsectionsViaSymbols platform
@@ -89,10 +86,18 @@ pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) =
              else empty)
 
 
-pprBasicBlock :: NatBasicBlock Instr -> SDoc
-pprBasicBlock (BasicBlock blockid instrs) =
-  pprLabel (mkAsmTempLabel (getUnique blockid)) $$
-  vcat (map pprInstr instrs)
+pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
+pprBasicBlock info_env (BasicBlock blockid instrs)
+  = maybe_infotable $$
+    pprLabel (mkAsmTempLabel (getUnique blockid)) $$
+    vcat (map pprInstr instrs)
+  where
+    maybe_infotable = case mapLookup blockid info_env of
+       Nothing   -> empty
+       Just (Statics info_lbl info) ->
+           pprSectionHeader Text $$
+           vcat (map pprData info) $$
+           pprLabel info_lbl
 
 
 
@@ -292,7 +297,8 @@ pprSectionHeader seg
 
 pprDataItem :: CmmLit -> SDoc
 pprDataItem lit
-  = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
+  = sdocWithDynFlags $ \dflags ->
+    vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit)
     where
         imm = litToImm lit
 
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index 7dccb6040e..d4123aca84 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -55,8 +55,8 @@ import CLabel           ( CLabel )
 import Unique
 
 import CodeGen.Platform
+import DynFlags
 import Outputable
-import Constants
 import FastBool
 import FastTypes
 import Platform
@@ -194,10 +194,11 @@ addrOffset addr off
 -- temporaries and for excess call arguments.  @fpRel@, where
 -- applicable, is the same but for the frame pointer.
 
-spRel :: Int    -- desired stack offset in words, positive or negative
+spRel :: DynFlags
+      -> Int    -- desired stack offset in words, positive or negative
       -> AddrMode
 
-spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE))
+spRel dflags n = AddrRegImm sp (ImmInt (n * wORD_SIZE dflags))
 
 
 -- argRegs is the set of regs which are read for an n-argument call to C.
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 32b5e41402..1611a710fb 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -174,7 +174,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
 
                 -- strip off liveness information,
                 --      and rewrite SPILL/RELOAD pseudos into real instructions along the way
-                let code_final          = map (stripLive platform) code_spillclean
+                let code_final          = map (stripLive dflags) code_spillclean
 
                 -- record what happened in this stage for debugging
                 let stat                =
diff --git a/compiler/nativeGen/RegAlloc/Linear/Base.hs b/compiler/nativeGen/RegAlloc/Linear/Base.hs
index 432acdf314..e58331347c 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Base.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Base.hs
@@ -13,7 +13,6 @@ module RegAlloc.Linear.Base (
 
         -- the allocator monad
         RA_State(..),
-        RegM(..)
 )
 
 where
@@ -22,6 +21,7 @@ import RegAlloc.Linear.StackMap
 import RegAlloc.Liveness
 import Reg
 
+import DynFlags
 import Outputable
 import Unique
 import UniqFM
@@ -126,11 +126,7 @@ data RA_State freeRegs
         -- | Record why things were spilled, for -ddrop-asm-stats.
         --      Just keep a list here instead of a map of regs -> reasons.
         --      We don't want to slow down the allocator if we're not going to emit the stats.
-        , ra_spills     :: [SpillReason] }
-
-
--- | The register allocator monad type.
-newtype RegM freeRegs a
-        = RegM { unReg :: RA_State freeRegs -> (# RA_State freeRegs, a #) }
+        , ra_spills     :: [SpillReason]
+        , ra_DynFlags   :: DynFlags }
 
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
index 887af1758a..fffdef761b 100644
--- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
@@ -18,6 +18,7 @@ where
 import Reg
 import RegClass
 
+import DynFlags
 import Panic
 import Platform
 
@@ -33,9 +34,10 @@ import Platform
 --	getFreeRegs cls f = filter ( (==cls) . regClass . RealReg ) f
 --	allocateReg f r = filter (/= r) f
 
-import qualified RegAlloc.Linear.PPC.FreeRegs   as PPC
-import qualified RegAlloc.Linear.SPARC.FreeRegs as SPARC
-import qualified RegAlloc.Linear.X86.FreeRegs   as X86
+import qualified RegAlloc.Linear.PPC.FreeRegs    as PPC
+import qualified RegAlloc.Linear.SPARC.FreeRegs  as SPARC
+import qualified RegAlloc.Linear.X86.FreeRegs    as X86
+import qualified RegAlloc.Linear.X86_64.FreeRegs as X86_64
 
 import qualified PPC.Instr
 import qualified SPARC.Instr
@@ -53,6 +55,12 @@ instance FR X86.FreeRegs where
     frInitFreeRegs = X86.initFreeRegs
     frReleaseReg   = \_ -> X86.releaseReg
 
+instance FR X86_64.FreeRegs where
+    frAllocateReg  = \_ -> X86_64.allocateReg
+    frGetFreeRegs  = X86_64.getFreeRegs
+    frInitFreeRegs = X86_64.initFreeRegs
+    frReleaseReg   = \_ -> X86_64.releaseReg
+
 instance FR PPC.FreeRegs where
     frAllocateReg  = \_ -> PPC.allocateReg
     frGetFreeRegs  = \_ -> PPC.getFreeRegs
@@ -65,13 +73,13 @@ instance FR SPARC.FreeRegs where
     frInitFreeRegs = SPARC.initFreeRegs
     frReleaseReg   = SPARC.releaseReg
 
-maxSpillSlots :: Platform -> Int
-maxSpillSlots platform
-              = case platformArch platform of
-                ArchX86       -> X86.Instr.maxSpillSlots True  -- 32bit
-                ArchX86_64    -> X86.Instr.maxSpillSlots False -- not 32bit
-                ArchPPC       -> PPC.Instr.maxSpillSlots
-                ArchSPARC     -> SPARC.Instr.maxSpillSlots
+maxSpillSlots :: DynFlags -> Int
+maxSpillSlots dflags
+              = case platformArch (targetPlatform dflags) of
+                ArchX86       -> X86.Instr.maxSpillSlots dflags
+                ArchX86_64    -> X86.Instr.maxSpillSlots dflags
+                ArchPPC       -> PPC.Instr.maxSpillSlots dflags
+                ArchSPARC     -> SPARC.Instr.maxSpillSlots dflags
                 ArchARM _ _ _ -> panic "maxSpillSlots ArchARM"
                 ArchPPC_64    -> panic "maxSpillSlots ArchPPC_64"
                 ArchUnknown   -> panic "maxSpillSlots ArchUnknown"
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index ea415e2661..6294743c48 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -1,24 +1,13 @@
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 -- | Handles joining of a jump instruction to its targets.
 
--- 	The first time we encounter a jump to a particular basic block, we
--- 	record the assignment of temporaries.  The next time we encounter a
--- 	jump to the same block, we compare our current assignment to the
--- 	stored one.  They might be different if spilling has occrred in one
--- 	branch; so some fixup code will be required to match up the assignments.
+--      The first time we encounter a jump to a particular basic block, we
+--      record the assignment of temporaries.  The next time we encounter a
+--      jump to the same block, we compare our current assignment to the
+--      stored one.  They might be different if spilling has occrred in one
+--      branch; so some fixup code will be required to match up the assignments.
 --
-module RegAlloc.Linear.JoinToTargets (
-	joinToTargets
-)
-
-where
+module RegAlloc.Linear.JoinToTargets (joinToTargets) where
 
 import RegAlloc.Linear.State
 import RegAlloc.Linear.Base
@@ -30,96 +19,94 @@ import Reg
 import BlockId
 import OldCmm  hiding (RegSet)
 import Digraph
+import DynFlags
 import Outputable
-import Platform
 import Unique
 import UniqFM
 import UniqSet
 
 
 -- | For a jump instruction at the end of a block, generate fixup code so its
---	vregs are in the correct regs for its destination.
+--      vregs are in the correct regs for its destination.
 --
 joinToTargets
-	:: (FR freeRegs, Instruction instr)
-	=> 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.
+        :: (FR freeRegs, Instruction instr)
+        => 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
-	-> instr			-- ^ branch instr on the end of the source block.
+        -> BlockId                      -- ^ id of the current block
+        -> instr                        -- ^ branch instr on the end of the source block.
 
-	-> RegM freeRegs ([NatBasicBlock instr]	--   fresh blocks of fixup code.
-		, instr)		--   the original branch instruction, but maybe patched to jump
-					--	to a fixup block first.
+        -> RegM freeRegs ([NatBasicBlock instr] -- fresh blocks of fixup code.
+                         , instr)               -- the original branch
+                                                -- instruction, but maybe
+                                                -- patched to jump
+                                                -- to a fixup block first.
 
-joinToTargets platform block_live id instr
+joinToTargets block_live id instr
 
-	-- we only need to worry about jump instructions.
-	| not $ isJumpishInstr instr
-	= return ([], instr)
+        -- we only need to worry about jump instructions.
+        | not $ isJumpishInstr instr
+        = return ([], instr)
 
-	| otherwise
-	= joinToTargets' platform block_live [] id instr (jumpDestsOfInstr instr)
+        | otherwise
+        = joinToTargets' block_live [] id instr (jumpDestsOfInstr instr)
 
 -----
 joinToTargets'
-	:: (FR freeRegs, Instruction instr)
-	=> 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.
+        :: (FR freeRegs, Instruction instr)
+        => 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.
+        -> [NatBasicBlock instr]        -- ^ acc blocks of fixup code.
 
-	-> BlockId			-- ^ id of the current block
-	-> instr			-- ^ branch instr on the end of the source block.
+        -> BlockId                      -- ^ id of the current block
+        -> instr                        -- ^ branch instr on the end of the source block.
 
-	-> [BlockId]			-- ^ branch destinations still to consider.
+        -> [BlockId]                    -- ^ branch destinations still to consider.
 
-	-> RegM freeRegs ( [NatBasicBlock instr]
-		, instr)
+        -> RegM freeRegs ([NatBasicBlock instr], instr)
 
 -- no more targets to consider. all done.
-joinToTargets' _        _          new_blocks _ instr []
-	= return (new_blocks, instr)
+joinToTargets' _          new_blocks _ instr []
+        = return (new_blocks, instr)
 
 -- handle a branch target.
-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
-
-	-- get the assignment on entry to the branch instruction.
-	assig 		<- getAssigR
-
-	-- adjust the current assignment to remove any vregs that are not live
-	-- on entry to the destination block.
-	let Just live_set 	= mapLookup dest block_live
-	let still_live uniq _ 	= uniq `elemUniqSet_Directly` live_set
-	let adjusted_assig	= filterUFM_Directly still_live assig
-
-	-- and free up those registers which are now free.
-	let to_free =
-		[ r 	| (reg, loc) <- ufmToList assig
-			, not (elemUniqSet_Directly reg live_set)
-			, r 	     <- regsOfLoc loc ]
-
-	case mapLookup dest block_assig of
-	 Nothing 
-	  -> joinToTargets_first 
-	  		platform block_live new_blocks block_id instr dest dests
-			block_assig adjusted_assig to_free
-
-	 Just (_, dest_assig)
-	  -> joinToTargets_again 
-	  		platform block_live new_blocks block_id instr dest dests
-	  		adjusted_assig dest_assig 
+joinToTargets' 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
+
+        -- get the assignment on entry to the branch instruction.
+        assig           <- getAssigR
+
+        -- adjust the current assignment to remove any vregs that are not live
+        -- on entry to the destination block.
+        let Just live_set       = mapLookup dest block_live
+        let still_live uniq _   = uniq `elemUniqSet_Directly` live_set
+        let adjusted_assig      = filterUFM_Directly still_live assig
+
+        -- and free up those registers which are now free.
+        let to_free =
+                [ r     | (reg, loc) <- ufmToList assig
+                        , not (elemUniqSet_Directly reg live_set)
+                        , r          <- regsOfLoc loc ]
+
+        case mapLookup dest block_assig of
+         Nothing
+          -> joinToTargets_first
+                        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
+                        adjusted_assig dest_assig
 
 
 -- this is the first time we jumped to this block.
 joinToTargets_first :: (FR freeRegs, Instruction instr)
-                    => Platform
-                    -> BlockMap RegSet
+                    => BlockMap RegSet
                     -> [NatBasicBlock instr]
                     -> BlockId
                     -> instr
@@ -129,24 +116,26 @@ joinToTargets_first :: (FR freeRegs, Instruction instr)
                     -> RegMap Loc
                     -> [RealReg]
                     -> RegM freeRegs ([NatBasicBlock instr], instr)
-joinToTargets_first platform block_live new_blocks block_id instr dest dests
-	block_assig src_assig 
-	to_free
+joinToTargets_first block_live new_blocks block_id instr dest dests
+        block_assig src_assig
+        to_free
 
- = do	-- free up the regs that are not live on entry to this block.
-  	freeregs 	<- getFreeRegsR
-	let freeregs' = foldr (frReleaseReg platform) freeregs to_free
-	
-	-- remember the current assignment on entry to this block.
-	setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)
+ = do   dflags <- getDynFlags
+        let platform = targetPlatform dflags
 
-	joinToTargets' platform block_live new_blocks block_id instr dests
+        -- free up the regs that are not live on entry to this block.
+        freeregs        <- getFreeRegsR
+        let freeregs' = foldr (frReleaseReg platform) freeregs to_free
+
+        -- 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
 
 
 -- we've jumped to this block before
 joinToTargets_again :: (Instruction instr, FR freeRegs)
-                    => Platform
-                    -> BlockMap RegSet
+                    => BlockMap RegSet
                     -> [NatBasicBlock instr]
                     -> BlockId
                     -> instr
@@ -156,82 +145,82 @@ joinToTargets_again :: (Instruction instr, FR freeRegs)
                     -> UniqFM Loc
                     -> RegM freeRegs ([NatBasicBlock instr], instr)
 joinToTargets_again
-    platform block_live new_blocks block_id instr dest dests
+    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' platform block_live new_blocks block_id instr dests
-  
- 	-- assignments don't match, need fixup code
-	| otherwise
-	= do	
-     
-		-- make a graph of what things need to be moved where.
-		let graph = makeRegMovementGraph src_assig dest_assig
-
-		-- look for cycles in the graph. This can happen if regs need to be swapped.
-		-- Note that we depend on the fact that this function does a
-		--	bottom up traversal of the tree-like portions of the graph.
-		--
-		--  eg, if we have
-		--	R1 -> R2 -> R3
-		--
-		--  ie move value in R1 to R2 and value in R2 to R3. 
-		--
-		-- We need to do the R2 -> R3 move before R1 -> R2.
-		--		
-		let sccs  = stronglyConnCompFromEdgedVerticesR graph
-
-{-		-- debugging
-		pprTrace 
-			("joinToTargets: making fixup code")
-			(vcat	[ text "        in block: "	<> ppr block_id
-				, text " jmp instruction: "	<> ppr instr
-				, text "  src assignment: "	<> ppr src_assig
-				, text " dest assignment: " 	<> ppr dest_assig
-				, text "  movement graph: "	<> ppr graph
-				, text "   sccs of graph: "	<> ppr sccs
-				, text ""])
-			(return ())
+        -- the assignments already match, no problem.
+        | ufmToList dest_assig == ufmToList src_assig
+        = joinToTargets' block_live new_blocks block_id instr dests
+
+        -- assignments don't match, need fixup code
+        | otherwise
+        = do
+
+                -- make a graph of what things need to be moved where.
+                let graph = makeRegMovementGraph src_assig dest_assig
+
+                -- look for cycles in the graph. This can happen if regs need to be swapped.
+                -- Note that we depend on the fact that this function does a
+                --      bottom up traversal of the tree-like portions of the graph.
+                --
+                --  eg, if we have
+                --      R1 -> R2 -> R3
+                --
+                --  ie move value in R1 to R2 and value in R2 to R3.
+                --
+                -- We need to do the R2 -> R3 move before R1 -> R2.
+                --
+                let sccs  = stronglyConnCompFromEdgedVerticesR graph
+
+{-              -- debugging
+                pprTrace
+                        ("joinToTargets: making fixup code")
+                        (vcat   [ text "        in block: "     <> ppr block_id
+                                , text " jmp instruction: "     <> ppr instr
+                                , text "  src assignment: "     <> ppr src_assig
+                                , text " dest assignment: "     <> ppr dest_assig
+                                , text "  movement graph: "     <> ppr graph
+                                , text "   sccs of graph: "     <> ppr sccs
+                                , text ""])
+                        (return ())
 -}
-		delta 		<- getDeltaR
-		fixUpInstrs_ 	<- mapM (handleComponent platform delta instr) sccs
-		let fixUpInstrs	= concat fixUpInstrs_
-
-		-- make a new basic block containing the fixup code.
-		--	A the end of the current block we will jump to the fixup one, 
-		--	then that will jump to our original destination.
-		fixup_block_id <- getUniqueR
-		let block = BasicBlock (mkBlockId fixup_block_id) 
-				$ fixUpInstrs ++ mkJumpInstr dest
-		
-{-		pprTrace
-			("joinToTargets: fixup code is:")
-			(vcat	[ ppr block
-				, text ""])
-			(return ())
+                delta           <- getDeltaR
+                fixUpInstrs_    <- mapM (handleComponent delta instr) sccs
+                let fixUpInstrs = concat fixUpInstrs_
+
+                -- make a new basic block containing the fixup code.
+                --      A the end of the current block we will jump to the fixup one,
+                --      then that will jump to our original destination.
+                fixup_block_id <- getUniqueR
+                let block = BasicBlock (mkBlockId fixup_block_id)
+                                $ fixUpInstrs ++ mkJumpInstr dest
+
+{-              pprTrace
+                        ("joinToTargets: fixup code is:")
+                        (vcat   [ ppr block
+                                , text ""])
+                        (return ())
 -}
-		-- if we didn't need any fixups, then don't include the block
-		case fixUpInstrs of 
-		 []	-> joinToTargets' platform block_live new_blocks block_id instr dests
+                -- 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
 
-		 -- patch the original branch instruction so it goes to our
-		 --	fixup block instead.
-		 _	-> let	instr'	=  patchJumpInstr instr 
-		 				(\bid -> if bid == dest 
-								then mkBlockId fixup_block_id 
-								else bid) -- no change!
-						
-		 	   in	joinToTargets' platform block_live (block : new_blocks) block_id instr' dests
+                 -- patch the original branch instruction so it goes to our
+                 --     fixup block instead.
+                 _      -> let  instr'  =  patchJumpInstr instr
+                                                (\bid -> if bid == dest
+                                                                then mkBlockId fixup_block_id
+                                                                else bid) -- no change!
+
+                           in   joinToTargets' block_live (block : new_blocks) block_id instr' dests
 
 
 -- | Construct a graph of register\/spill movements.
 --
--- 	Cyclic components seem to occur only very rarely.
+--      Cyclic components seem to occur only very rarely.
 --
--- 	We cut some corners by not handling memory-to-memory moves.
---	This shouldn't happen because every temporary gets its own stack slot.
+--      We cut some corners by not handling memory-to-memory moves.
+--      This shouldn't happen because every temporary gets its own stack slot.
 --
 makeRegMovementGraph :: RegMap Loc -> RegMap Loc -> [(Unique, Loc, [Loc])]
 makeRegMovementGraph adjusted_assig dest_assig
@@ -242,95 +231,96 @@ makeRegMovementGraph adjusted_assig dest_assig
 
 
 -- | Expand out the destination, so InBoth destinations turn into
---	a combination of InReg and InMem.
+--      a combination of InReg and InMem.
 
---	The InBoth handling is a little tricky here.  If the destination is
---	InBoth, then we must ensure that the value ends up in both locations.
---	An InBoth  destination must conflict with an InReg or InMem source, so
---	we expand an InBoth destination as necessary.
+--      The InBoth handling is a little tricky here.  If the destination is
+--      InBoth, then we must ensure that the value ends up in both locations.
+--      An InBoth  destination must conflict with an InReg or InMem source, so
+--      we expand an InBoth destination as necessary.
 --
---	An InBoth source is slightly different: we only care about the register
---	that the source value is in, so that we can move it to the destinations.
+--      An InBoth source is slightly different: we only care about the register
+--      that the source value is in, so that we can move it to the destinations.
 --
-expandNode 
-	:: a 
-	-> Loc 			-- ^ source of move
-	-> Loc 			-- ^ destination of move
-	-> [(a, Loc, [Loc])]
+expandNode
+        :: a
+        -> Loc                  -- ^ source of move
+        -> Loc                  -- ^ destination of move
+        -> [(a, Loc, [Loc])]
 
 expandNode vreg loc@(InReg src) (InBoth dst mem)
-	| src == dst = [(vreg, loc, [InMem mem])]
-	| otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
+        | src == dst = [(vreg, loc, [InMem mem])]
+        | otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
 
 expandNode vreg loc@(InMem src) (InBoth dst mem)
-	| src == mem = [(vreg, loc, [InReg dst])]
-	| otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
+        | src == mem = [(vreg, loc, [InReg dst])]
+        | otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
 
 expandNode _        (InBoth _ src) (InMem dst)
-	| src == dst = [] -- guaranteed to be true
+        | src == dst = [] -- guaranteed to be true
 
 expandNode _        (InBoth src _) (InReg dst)
-	| src == dst = []
+        | src == dst = []
 
 expandNode vreg     (InBoth src _) dst
-	= expandNode vreg (InReg src) dst
+        = expandNode vreg (InReg src) dst
 
 expandNode vreg src dst
-	| src == dst = []
-	| otherwise  = [(vreg, src, [dst])]
+        | src == dst = []
+        | otherwise  = [(vreg, src, [dst])]
 
 
 -- | Generate fixup code for a particular component in the move graph
---	This component tells us what values need to be moved to what
---	destinations. We have eliminated any possibility of single-node
---	cycles in expandNode above.
+--      This component tells us what values need to be moved to what
+--      destinations. We have eliminated any possibility of single-node
+--      cycles in expandNode above.
 --
-handleComponent 
-	:: Instruction instr
-	=> Platform -> Int -> instr -> SCC (Unique, Loc, [Loc]) -> RegM freeRegs [instr]
+handleComponent
+        :: Instruction instr
+        => 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.
+--      In this case we can just do the moves directly, and avoid having to
+--      go via a spill slot.
 --
-handleComponent platform delta _  (AcyclicSCC (vreg, src, dsts))
-	 = mapM (makeMove platform delta vreg src) dsts
+handleComponent delta _  (AcyclicSCC (vreg, src, dsts))
+        = mapM (makeMove delta vreg src) dsts
 
 
 -- Handle some cyclic moves.
---	This can happen if we have two regs that need to be swapped.
---	eg:
---	     vreg   source loc   dest loc
---	    (vreg1, InReg r1,    [InReg r2])
---	    (vreg2, InReg r2,    [InReg r1])
+--      This can happen if we have two regs that need to be swapped.
+--      eg:
+--           vreg   source loc   dest loc
+--          (vreg1, InReg r1,    [InReg r2])
+--          (vreg2, InReg r2,    [InReg r1])
+--
+--      To avoid needing temp register, we just spill all the source regs, then
+--      reaload them into their destination regs.
 --
---	To avoid needing temp register, we just spill all the source regs, then 
---	reaload them into their destination regs.
---	
---	Note that we can not have cycles that involve memory locations as
---	sources as single destination because memory locations (stack slots)
---	are allocated exclusively for a virtual register and therefore can not
---	require a fixup.
+--      Note that we can not have cycles that involve memory locations as
+--      sources as single destination because memory locations (stack slots)
+--      are allocated exclusively for a virtual register and therefore can not
+--      require a fixup.
 --
-handleComponent platform delta instr
-	(CyclicSCC 	( (vreg, InReg sreg, (InReg dreg: _)) : rest))
+handleComponent 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 platform (RegReal sreg) vreg
+        -- spill the source into its slot
+        (instrSpill, slot)
+                        <- spillR (RegReal sreg) vreg
 
-	-- reload into destination reg
-	instrLoad	<- loadR platform (RegReal dreg) slot
-	
-	remainingFixUps <- mapM (handleComponent platform delta instr) 
-				(stronglyConnCompFromEdgedVerticesR rest)
+        -- reload into destination reg
+        instrLoad       <- loadR (RegReal dreg) slot
 
-	-- 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])
+        remainingFixUps <- mapM (handleComponent delta instr)
+                                (stronglyConnCompFromEdgedVerticesR rest)
 
-handleComponent _ _ _ (CyclicSCC _)
+        -- 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 _)
  = panic "Register Allocator: handleComponent cyclic"
 
 
@@ -338,29 +328,31 @@ handleComponent _ _ _ (CyclicSCC _)
 --
 makeMove
     :: Instruction instr
-    => Platform
-    -> Int      -- ^ current C stack delta.
+    => 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
-	= panic $ "makeMove " ++ show vreg ++ " (" ++ show src ++ ") ("
-		++ show dst ++ ")"
-		++ " we don't handle mem->mem moves."
+makeMove delta vreg src dst
+ = do dflags <- getDynFlags
+      let platform = targetPlatform dflags
+
+      case (src, dst) of
+          (InReg s, InReg d) ->
+              do recordSpill (SpillJoinRR vreg)
+                 return $ mkRegRegMoveInstr platform (RegReal s) (RegReal d)
+          (InMem s, InReg d) ->
+              do recordSpill (SpillJoinRM vreg)
+                 return $ mkLoadInstr dflags (RegReal d) delta s
+          (InReg s, InMem d) ->
+              do recordSpill (SpillJoinRM vreg)
+                 return $ mkSpillInstr dflags (RegReal s) delta d
+          _ ->
+              -- we don't handle memory to memory moves.
+              -- they shouldn't happen because we don't share
+              -- stack slots between vregs.
+              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 c2f89de641..3f92ed975b 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -106,9 +106,10 @@ import RegAlloc.Linear.StackMap
 import RegAlloc.Linear.FreeRegs
 import RegAlloc.Linear.Stats
 import RegAlloc.Linear.JoinToTargets
-import qualified RegAlloc.Linear.PPC.FreeRegs   as PPC
-import qualified RegAlloc.Linear.SPARC.FreeRegs as SPARC
-import qualified RegAlloc.Linear.X86.FreeRegs   as X86
+import qualified RegAlloc.Linear.PPC.FreeRegs    as PPC
+import qualified RegAlloc.Linear.SPARC.FreeRegs  as SPARC
+import qualified RegAlloc.Linear.X86.FreeRegs    as X86
+import qualified RegAlloc.Linear.X86_64.FreeRegs as X86_64
 import TargetReg
 import RegAlloc.Liveness
 import Instruction
@@ -188,52 +189,51 @@ linearRegAlloc
 linearRegAlloc dflags first_id block_live sccs
  = let platform = targetPlatform dflags
    in case platformArch platform of
-      ArchX86       -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs)   first_id block_live sccs
-      ArchX86_64    -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs)   first_id block_live sccs
-      ArchSPARC     -> linearRegAlloc' platform (frInitFreeRegs platform :: SPARC.FreeRegs) first_id block_live sccs
-      ArchPPC       -> linearRegAlloc' platform (frInitFreeRegs platform :: PPC.FreeRegs)   first_id block_live sccs
+      ArchX86       -> linearRegAlloc' dflags (frInitFreeRegs platform :: X86.FreeRegs)    first_id block_live sccs
+      ArchX86_64    -> linearRegAlloc' dflags (frInitFreeRegs platform :: X86_64.FreeRegs) first_id block_live sccs
+      ArchSPARC     -> linearRegAlloc' dflags (frInitFreeRegs platform :: SPARC.FreeRegs)  first_id block_live sccs
+      ArchPPC       -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs)    first_id block_live sccs
       ArchARM _ _ _ -> panic "linearRegAlloc ArchARM"
       ArchPPC_64    -> panic "linearRegAlloc ArchPPC_64"
       ArchUnknown   -> panic "linearRegAlloc ArchUnknown"
 
 linearRegAlloc'
         :: (FR freeRegs, Outputable instr, Instruction instr)
-        => Platform
+        => DynFlags
         -> freeRegs
         -> BlockId                      -- ^ the first block
         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
         -> UniqSM ([NatBasicBlock instr], RegAllocStats)
 
-linearRegAlloc' platform initFreeRegs first_id block_live sccs
+linearRegAlloc' dflags initFreeRegs first_id block_live sccs
  = do   us      <- getUs
         let (_, _, stats, blocks) =
-                runR emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap platform) us
-                    $ linearRA_SCCs platform first_id block_live [] sccs
+                runR dflags emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap dflags) us
+                    $ linearRA_SCCs first_id block_live [] sccs
         return  (blocks, stats)
 
 
 linearRA_SCCs :: (FR freeRegs, Instruction instr, Outputable instr)
-              => Platform
-              -> BlockId
+              => BlockId
               -> BlockMap RegSet
               -> [NatBasicBlock instr]
               -> [SCC (LiveBasicBlock instr)]
               -> RegM freeRegs [NatBasicBlock instr]
 
-linearRA_SCCs _ _ _ blocksAcc []
+linearRA_SCCs _ _ blocksAcc []
         = return $ reverse blocksAcc
 
-linearRA_SCCs platform first_id block_live blocksAcc (AcyclicSCC block : sccs)
- = do   blocks' <- processBlock platform block_live block
-        linearRA_SCCs platform first_id block_live
+linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs)
+ = do   blocks' <- processBlock block_live block
+        linearRA_SCCs first_id block_live
                 ((reverse blocks') ++ blocksAcc)
                 sccs
 
-linearRA_SCCs platform first_id block_live blocksAcc (CyclicSCC blocks : sccs)
+linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
  = do
-        blockss' <- process platform first_id block_live blocks [] (return []) False
-        linearRA_SCCs platform first_id block_live
+        blockss' <- process first_id block_live blocks [] (return []) False
+        linearRA_SCCs first_id block_live
                 (reverse (concat blockss') ++ blocksAcc)
                 sccs
 
@@ -250,8 +250,7 @@ linearRA_SCCs platform first_id block_live blocksAcc (CyclicSCC blocks : sccs)
 -}
 
 process :: (FR freeRegs, Instruction instr, Outputable instr)
-        => Platform
-        -> BlockId
+        => BlockId
         -> BlockMap RegSet
         -> [GenBasicBlock (LiveInstr instr)]
         -> [GenBasicBlock (LiveInstr instr)]
@@ -259,10 +258,10 @@ process :: (FR freeRegs, Instruction instr, Outputable instr)
         -> Bool
         -> RegM freeRegs [[NatBasicBlock instr]]
 
-process _ _ _ [] []         accum _
+process _ _ [] []         accum _
         = return $ reverse accum
 
-process platform first_id block_live [] next_round accum madeProgress
+process first_id block_live [] next_round accum madeProgress
         | not madeProgress
 
           {- BUGS: There are so many unreachable blocks in the code the warnings are overwhelming.
@@ -272,10 +271,10 @@ process platform first_id block_live [] next_round accum madeProgress
         = return $ reverse accum
 
         | otherwise
-        = process platform first_id block_live
+        = process first_id block_live
                   next_round [] accum False
 
-process platform first_id block_live (b@(BasicBlock id _) : blocks)
+process first_id block_live (b@(BasicBlock id _) : blocks)
         next_round accum madeProgress
  = do
         block_assig <- getBlockAssigR
@@ -283,11 +282,11 @@ process platform first_id block_live (b@(BasicBlock id _) : blocks)
         if isJust (mapLookup id block_assig)
              || id == first_id
          then do
-                b'  <- processBlock platform block_live b
-                process platform first_id block_live blocks
+                b'  <- processBlock block_live b
+                process first_id block_live blocks
                         next_round (b' : accum) True
 
-         else   process platform first_id block_live blocks
+         else   process first_id block_live blocks
                         (b : next_round) accum madeProgress
 
 
@@ -295,24 +294,25 @@ process platform first_id block_live (b@(BasicBlock id _) : blocks)
 --
 processBlock
         :: (FR freeRegs, Outputable instr, Instruction instr)
-        => Platform
-        -> BlockMap RegSet              -- ^ live regs on entry to each basic block
+        => BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> LiveBasicBlock instr         -- ^ block to do register allocation on
         -> RegM freeRegs [NatBasicBlock instr]   -- ^ block with registers allocated
 
-processBlock platform block_live (BasicBlock id instrs)
- = do   initBlock platform id block_live
+processBlock block_live (BasicBlock id instrs)
+ = do   initBlock id block_live
         (instrs', fixups)
-                <- linearRA platform block_live [] [] id instrs
+                <- linearRA block_live [] [] id instrs
         return  $ BasicBlock id instrs' : fixups
 
 
 -- | Load the freeregs and current reg assignment into the RegM state
 --      for the basic block with this BlockId.
 initBlock :: FR freeRegs
-          => Platform -> BlockId -> BlockMap RegSet -> RegM freeRegs ()
-initBlock platform id block_live
- = do   block_assig     <- getBlockAssigR
+          => BlockId -> BlockMap RegSet -> RegM freeRegs ()
+initBlock id block_live
+ = do   dflags <- getDynFlags
+        let platform = targetPlatform dflags
+        block_assig     <- getBlockAssigR
         case mapLookup id block_assig of
                 -- no prior info about this block: we must consider
                 -- any fixed regs to be allocated, but we can ignore
@@ -337,8 +337,7 @@ initBlock platform id block_live
 -- | Do allocation for a sequence of instructions.
 linearRA
         :: (FR freeRegs, Outputable instr, Instruction instr)
-        => Platform
-        -> BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.
+        => BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.
         -> [instr]                              -- ^ accumulator for instructions already processed.
         -> [NatBasicBlock instr]                -- ^ accumulator for blocks of fixup code.
         -> BlockId                              -- ^ id of the current block, for debugging.
@@ -349,25 +348,23 @@ linearRA
                 , [NatBasicBlock instr])        --   fresh blocks of fixup code.
 
 
-linearRA _        _          accInstr accFixup _ []
+linearRA _          accInstr accFixup _ []
         = return
                 ( reverse accInstr              -- instrs need to be returned in the correct order.
                 , accFixup)                     -- it doesn't matter what order the fixup blocks are returned in.
 
 
-linearRA platform block_live accInstr accFixups id (instr:instrs)
+linearRA block_live accInstr accFixups id (instr:instrs)
  = do
-        (accInstr', new_fixups)
-                <- raInsn platform block_live accInstr id instr
+        (accInstr', new_fixups) <- raInsn block_live accInstr id instr
 
-        linearRA platform block_live accInstr' (new_fixups ++ accFixups) id instrs
+        linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs
 
 
 -- | Do allocation for a single instruction.
 raInsn
         :: (FR freeRegs, Outputable instr, Instruction instr)
-        => Platform
-        -> BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.
+        => BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.
         -> [instr]                              -- ^ accumulator for instructions already processed.
         -> BlockId                              -- ^ the id of the current block, for debugging
         -> LiveInstr instr                      -- ^ the instr to have its regs allocated, with liveness info.
@@ -375,17 +372,17 @@ raInsn
                 ( [instr]                       -- new instructions
                 , [NatBasicBlock instr])        -- extra fixup blocks
 
-raInsn _ _     new_instrs _ (LiveInstr ii Nothing)
+raInsn _     new_instrs _ (LiveInstr ii Nothing)
         | Just n        <- takeDeltaInstr ii
         = do    setDeltaR n
                 return (new_instrs, [])
 
-raInsn _ _     new_instrs _ (LiveInstr ii Nothing)
+raInsn _     new_instrs _ (LiveInstr ii Nothing)
         | isMetaInstr ii
         = return (new_instrs, [])
 
 
-raInsn platform block_live new_instrs id (LiveInstr (Instr instr) (Just live))
+raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
  = do
     assig    <- getAssigR
 
@@ -420,12 +417,12 @@ raInsn platform block_live new_instrs id (LiveInstr (Instr instr) (Just live))
           -}
            return (new_instrs, [])
 
-        _ -> genRaInsn platform block_live new_instrs id instr
+        _ -> genRaInsn block_live new_instrs id instr
                         (uniqSetToList $ liveDieRead live)
                         (uniqSetToList $ liveDieWrite live)
 
 
-raInsn _ _ _ _ instr
+raInsn _ _ _ instr
         = pprPanic "raInsn" (text "no match for:" <> ppr instr)
 
 
@@ -435,8 +432,7 @@ isInReg src assig | Just (InReg _) <- lookupUFM assig src = True
 
 
 genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
-          => Platform
-          -> BlockMap RegSet
+          => BlockMap RegSet
           -> [instr]
           -> BlockId
           -> instr
@@ -444,8 +440,10 @@ genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
           -> [Reg]
           -> RegM freeRegs ([instr], [NatBasicBlock instr])
 
-genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
-    case regUsageOfInstr platform instr of { RU read written ->
+genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
+  dflags <- getDynFlags
+  let platform = targetPlatform dflags
+  case regUsageOfInstr platform instr of { RU read written ->
     do
     let real_written    = [ rr  | (RegReal     rr) <- written ]
     let virt_written    = [ vr  | (RegVirtual  vr) <- written ]
@@ -471,32 +469,32 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
 
     -- (a), (b) allocate real regs for all regs read by this instruction.
     (r_spills, r_allocd) <-
-        allocateRegsAndSpill platform True{-reading-} virt_read [] [] virt_read
+        allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read
 
     -- (c) save any temporaries which will be clobbered by this instruction
-    clobber_saves <- saveClobberedTemps platform real_written r_dying
+    clobber_saves <- saveClobberedTemps real_written r_dying
 
     -- (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 platform block_live block_id instr
+        <- joinToTargets block_live block_id instr
 
     -- (e) Delete all register assignments for temps which are read
     --     (only) and die here.  Update the free register list.
-    releaseRegs platform r_dying
+    releaseRegs r_dying
 
     -- (f) Mark regs which are clobbered as unallocatable
-    clobberRegs platform real_written
+    clobberRegs real_written
 
     -- (g) Allocate registers for temporaries *written* (only)
     (w_spills, w_allocd) <-
-        allocateRegsAndSpill platform False{-writing-} virt_written [] [] virt_written
+        allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written
 
     -- (h) Release registers for temps which are written here and not
     -- used again.
-    releaseRegs platform w_dying
+    releaseRegs w_dying
 
     let
         -- (i) Patch the instruction
@@ -539,20 +537,23 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
 -- -----------------------------------------------------------------------------
 -- releaseRegs
 
-releaseRegs :: FR freeRegs => Platform -> [Reg] -> RegM freeRegs ()
-releaseRegs platform regs = do
+releaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs ()
+releaseRegs regs = do
+  dflags <- getDynFlags
+  let platform = targetPlatform dflags
   assig <- getAssigR
   free <- getFreeRegsR
+  let loop _     free _ | free `seq` False = undefined
+      loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
+      loop assig free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs
+      loop assig free (r:rs) =
+         case lookupUFM assig r of
+         Just (InBoth real _) -> loop (delFromUFM assig r)
+                                      (frReleaseReg platform real free) rs
+         Just (InReg real)    -> loop (delFromUFM assig r)
+                                      (frReleaseReg platform real free) rs
+         _                    -> loop (delFromUFM assig r) free rs
   loop assig free regs
- where
-  loop _     free _ | free `seq` False = undefined
-  loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
-  loop assig free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs
-  loop assig free (r:rs) =
-     case lookupUFM assig r of
-        Just (InBoth real _) -> loop (delFromUFM assig r) (frReleaseReg platform real free) rs
-        Just (InReg real) -> loop (delFromUFM assig r) (frReleaseReg platform real free) rs
-        _other            -> loop (delFromUFM assig r) free rs
 
 
 -- -----------------------------------------------------------------------------
@@ -571,16 +572,15 @@ releaseRegs platform regs = do
 
 saveClobberedTemps
         :: (Outputable instr, Instruction instr, FR freeRegs)
-        => Platform
-        -> [RealReg]            -- real registers clobbered by this instruction
+        => [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 platform clobbered dying
+saveClobberedTemps clobbered dying
  = do
         assig   <- getAssigR
         let to_spill
@@ -598,7 +598,9 @@ saveClobberedTemps platform clobbered dying
             = return (instrs, assig)
 
      clobber assig instrs ((temp, reg) : rest)
-       = do
+       = do dflags <- getDynFlags
+            let platform = targetPlatform dflags
+
             freeRegs <- getFreeRegsR
             let regclass = targetClassOfRealReg platform reg
                 freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs
@@ -619,7 +621,7 @@ saveClobberedTemps platform clobbered dying
 
               -- (2) no free registers: spill the value
               [] -> do
-                  (spill, slot)   <- spillR platform (RegReal reg) temp
+                  (spill, slot)   <- spillR (RegReal reg) temp
      
                   -- record why this reg was spilled for profiling
                   recordSpill (SpillClobber temp)
@@ -633,12 +635,14 @@ saveClobberedTemps platform clobbered dying
 -- | Mark all these real regs as allocated,
 --      and kick out their vreg assignments.
 --
-clobberRegs :: FR freeRegs => Platform -> [RealReg] -> RegM freeRegs ()
-clobberRegs _ []
+clobberRegs :: FR freeRegs => [RealReg] -> RegM freeRegs ()
+clobberRegs []
         = return ()
 
-clobberRegs platform clobbered
- = do
+clobberRegs clobbered
+ = do   dflags <- getDynFlags
+        let platform = targetPlatform dflags
+
         freeregs        <- getFreeRegsR
         setFreeRegsR $! foldr (frAllocateReg platform) freeregs clobbered
 
@@ -684,24 +688,23 @@ data SpillLoc = ReadMem StackSlot  -- reading from register only in memory
 
 allocateRegsAndSpill
         :: (FR freeRegs, Outputable instr, Instruction instr)
-        => Platform
-        -> Bool                 -- True <=> reading (load up spilled regs)
+        => 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 platform reading keep spills alloc (r:rs)
+allocateRegsAndSpill reading keep spills alloc (r:rs)
  = do   assig <- getAssigR
-        let doSpill = allocRegsAndSpill_spill platform reading keep spills alloc r rs assig
+        let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig
         case lookupUFM assig r of
                 -- case (1a): already in a register
                 Just (InReg my_reg) ->
-                        allocateRegsAndSpill platform reading keep spills (my_reg:alloc) rs
+                        allocateRegsAndSpill 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
@@ -710,7 +713,7 @@ allocateRegsAndSpill platform 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 platform reading keep spills (my_reg:alloc) rs
+                        allocateRegsAndSpill 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)
@@ -729,8 +732,7 @@ allocateRegsAndSpill platform reading keep spills alloc (r:rs)
 -- reading is redundant with reason, but we keep it around because it's
 -- convenient and it maintains the recursive structure of the allocator. -- EZY
 allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
-                        => Platform
-                        -> Bool
+                        => Bool
                         -> [VirtualReg]
                         -> [instr]
                         -> [RealReg]
@@ -739,8 +741,9 @@ allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
                         -> UniqFM Loc
                         -> SpillLoc
                         -> RegM freeRegs ([instr], [RealReg])
-allocRegsAndSpill_spill platform reading keep spills alloc r rs assig spill_loc
- = do
+allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
+ = do   dflags <- getDynFlags
+        let platform = targetPlatform dflags
         freeRegs                <- getFreeRegsR
         let freeRegs_thisClass  = frGetFreeRegs platform (classOfVirtualReg r) freeRegs
 
@@ -748,12 +751,12 @@ allocRegsAndSpill_spill platform reading keep spills alloc r rs assig spill_loc
 
          -- case (2): we have a free register
          (my_reg : _) ->
-           do   spills'   <- loadTemp platform r spill_loc my_reg spills
+           do   spills'   <- loadTemp r spill_loc my_reg spills
 
                 setAssigR       (addToUFM assig r $! newLocation spill_loc my_reg)
                 setFreeRegsR $  frAllocateReg platform my_reg freeRegs
 
-                allocateRegsAndSpill platform reading keep spills' (my_reg : alloc) rs
+                allocateRegsAndSpill reading keep spills' (my_reg : alloc) rs
 
 
           -- case (3): we need to push something out to free up a register
@@ -780,19 +783,19 @@ allocRegsAndSpill_spill platform reading keep spills alloc r rs assig spill_loc
                         -- 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 platform r spill_loc my_reg spills
+                        = do    spills' <- loadTemp 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 platform reading keep spills' (my_reg:alloc) rs
+                                allocateRegsAndSpill 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 platform (RegReal my_reg) temp_to_push_out
+                                (spill_insn, slot) <- spillR (RegReal my_reg) temp_to_push_out
                                 let spill_store  = (if reading then id else reverse)
                                                         [ -- COMMENT (fsLit "spill alloc")
                                                            spill_insn ]
@@ -806,9 +809,9 @@ allocRegsAndSpill_spill platform 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 platform r spill_loc my_reg spills
+                                spills' <- loadTemp r spill_loc my_reg spills
 
-                                allocateRegsAndSpill platform reading keep
+                                allocateRegsAndSpill reading keep
                                         (spill_store ++ spills')
                                         (my_reg:alloc) rs
 
@@ -835,19 +838,18 @@ newLocation _ my_reg = InReg my_reg
 -- | Load up a spilled temporary if we need to (read from memory).
 loadTemp
         :: (Outputable instr, Instruction instr)
-        => Platform
-        -> VirtualReg   -- the temp being loaded
+        => 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 platform vreg (ReadMem slot) hreg spills
+loadTemp vreg (ReadMem slot) hreg spills
  = do
-        insn <- loadR platform (RegReal hreg) slot
+        insn <- loadR (RegReal hreg) slot
         recordSpill (SpillLoad $ getUnique vreg)
         return  $  {- COMMENT (fsLit "spill load") : -} insn : spills
 
-loadTemp _ _ _ _ spills =
+loadTemp _ _ _ spills =
    return spills
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
index ea05cf0d0f..b1fc3c169e 100644
--- a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
@@ -28,8 +28,8 @@ where
 
 import RegAlloc.Linear.FreeRegs
 
+import DynFlags
 import Outputable
-import Platform
 import UniqFM
 import Unique
 
@@ -47,8 +47,8 @@ data StackMap
 
 
 -- | An empty stack map, with all slots available.
-emptyStackMap :: Platform -> StackMap
-emptyStackMap platform = StackMap [0 .. maxSpillSlots platform] emptyUFM
+emptyStackMap :: DynFlags -> StackMap
+emptyStackMap dflags = StackMap [0 .. maxSpillSlots dflags] emptyUFM
 
 
 -- | If this vreg unique already has a stack assignment then return the slot number,
diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs
index ca2ecd3883..a608a947e7 100644
--- a/compiler/nativeGen/RegAlloc/Linear/State.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/State.hs
@@ -1,39 +1,31 @@
 -- | State monad for the linear register allocator.
 
--- 	Here we keep all the state that the register allocator keeps track
--- 	of as it walks the instructions in a basic block.
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
+--      Here we keep all the state that the register allocator keeps track
+--      of as it walks the instructions in a basic block.
 
 module RegAlloc.Linear.State (
-	RA_State(..),
-	RegM,
-	runR,
-
-	spillR,
-	loadR,
-
-	getFreeRegsR,
-	setFreeRegsR,
-
-	getAssigR,
-	setAssigR,
-	
-	getBlockAssigR,
-	setBlockAssigR,
-	
-	setDeltaR,
-	getDeltaR,
-	
-	getUniqueR,
-	
-	recordSpill
+        RA_State(..),
+        RegM,
+        runR,
+
+        spillR,
+        loadR,
+
+        getFreeRegsR,
+        setFreeRegsR,
+
+        getAssigR,
+        setAssigR,
+
+        getBlockAssigR,
+        setBlockAssigR,
+
+        setDeltaR,
+        getDeltaR,
+
+        getUniqueR,
+
+        recordSpill
 )
 where
 
@@ -44,67 +36,79 @@ import RegAlloc.Liveness
 import Instruction
 import Reg
 
-import Platform
+import DynFlags
 import Unique
 import UniqSupply
 
 
+-- | The register allocator monad type.
+newtype RegM freeRegs a
+        = RegM { unReg :: RA_State freeRegs -> (# RA_State freeRegs, a #) }
+
+
 -- | The RegM Monad
 instance Monad (RegM freeRegs) where
   m >>= k   =  RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s }
   return a  =  RegM $ \s -> (# s, a #)
 
+instance HasDynFlags (RegM a) where
+    getDynFlags = RegM $ \s -> (# s, ra_DynFlags s #)
+
 
 -- | Run a computation in the RegM register allocator monad.
-runR 	:: BlockAssignment freeRegs
-	-> freeRegs 
-	-> RegMap Loc
-	-> StackMap 
-	-> UniqSupply
-  	-> RegM freeRegs a 
-	-> (BlockAssignment freeRegs, StackMap, RegAllocStats, a)
-
-runR block_assig freeregs assig stack us thing =
-  case unReg thing 
-  	(RA_State
-		{ ra_blockassig = block_assig
-		, ra_freeregs	= freeregs
-		, ra_assig	= assig
-		, ra_delta	= 0{-???-}
-		, ra_stack	= stack
-		, ra_us 	= us
-		, ra_spills 	= [] }) 
+runR    :: DynFlags
+        -> BlockAssignment freeRegs
+        -> freeRegs
+        -> RegMap Loc
+        -> StackMap
+        -> UniqSupply
+        -> RegM freeRegs a
+        -> (BlockAssignment freeRegs, StackMap, RegAllocStats, a)
+
+runR dflags block_assig freeregs assig stack us thing =
+  case unReg thing
+        (RA_State
+                { ra_blockassig = block_assig
+                , ra_freeregs   = freeregs
+                , ra_assig      = assig
+                , ra_delta      = 0{-???-}
+                , ra_stack      = stack
+                , ra_us         = us
+                , ra_spills     = []
+                , ra_DynFlags   = dflags })
    of
-	(# state'@RA_State
-		{ ra_blockassig = block_assig
-		, ra_stack	= stack' }
-		, returned_thing #)
-		
-	 -> 	(block_assig, stack', makeRAStats state', returned_thing)
+        (# state'@RA_State
+                { ra_blockassig = block_assig
+                , ra_stack      = stack' }
+                , returned_thing #)
+
+         ->     (block_assig, stack', makeRAStats state', returned_thing)
 
 
 -- | Make register allocator stats from its final state.
 makeRAStats :: RA_State freeRegs -> RegAllocStats
 makeRAStats state
-	= RegAllocStats
-	{ ra_spillInstrs	= binSpillReasons (ra_spills state) }
+        = RegAllocStats
+        { ra_spillInstrs        = binSpillReasons (ra_spills state) }
 
 
 spillR :: Instruction instr
-       => Platform -> Reg -> Unique -> RegM freeRegs (instr, Int)
+       => Reg -> Unique -> RegM freeRegs (instr, Int)
 
-spillR platform reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
-  let (stack',slot) = getStackSlotFor stack temp
-      instr  = mkSpillInstr platform reg delta slot
+spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
+  let dflags = ra_DynFlags s
+      (stack',slot) = getStackSlotFor stack temp
+      instr  = mkSpillInstr dflags reg delta slot
   in
   (# s{ra_stack=stack'}, (instr,slot) #)
 
 
 loadR :: Instruction instr
-      => Platform -> Reg -> Int -> RegM freeRegs instr
+      => Reg -> Int -> RegM freeRegs instr
 
-loadR platform reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
-  (# s, mkLoadInstr platform reg delta slot #)
+loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
+  let dflags = ra_DynFlags s
+  in (# s, mkLoadInstr dflags reg delta slot #)
 
 getFreeRegsR :: RegM freeRegs freeRegs
 getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
@@ -146,4 +150,5 @@ getUniqueR = RegM $ \s ->
 -- | Record that a spill instruction was inserted, for profiling.
 recordSpill :: SpillReason -> RegM freeRegs ()
 recordSpill spill
- 	= RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)
+    = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)
+
diff --git a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
index 6309b24b45..0fcd658120 100644
--- a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
@@ -1,5 +1,5 @@
 
--- | Free regs map for i386 and x86_64
+-- | Free regs map for i386
 module RegAlloc.Linear.X86.FreeRegs
 where
 
@@ -12,29 +12,25 @@ import Platform
 import Data.Word
 import Data.Bits
 
-type FreeRegs
-#ifdef i386_TARGET_ARCH
-        = Word32
-#else
-        = Word64
-#endif
+newtype FreeRegs = FreeRegs Word32
+    deriving Show
 
 noFreeRegs :: FreeRegs
-noFreeRegs = 0
+noFreeRegs = FreeRegs 0
 
 releaseReg :: RealReg -> FreeRegs -> FreeRegs
-releaseReg (RealRegSingle n) f
-        = f .|. (1 `shiftL` n)
+releaseReg (RealRegSingle n) (FreeRegs f)
+        = FreeRegs (f .|. (1 `shiftL` n))
 
 releaseReg _ _
-        = panic "RegAlloc.Linear.X86.FreeRegs.realeaseReg: no reg"
+        = panic "RegAlloc.Linear.X86.FreeRegs.releaseReg: no reg"
 
 initFreeRegs :: Platform -> FreeRegs
 initFreeRegs platform
         = foldr releaseReg noFreeRegs (allocatableRegs platform)
 
-getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazilly
-getFreeRegs platform cls f = go f 0
+getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
+getFreeRegs platform cls (FreeRegs f) = go f 0
 
   where go 0 _ = []
         go n m
@@ -47,10 +43,9 @@ getFreeRegs platform cls f = go f 0
         -- in order to find a floating-point one.
 
 allocateReg :: RealReg -> FreeRegs -> FreeRegs
-allocateReg (RealRegSingle r) f
-        = f .&. complement (1 `shiftL` r)
+allocateReg (RealRegSingle r) (FreeRegs f)
+        = FreeRegs (f .&. complement (1 `shiftL` r))
 
 allocateReg _ _
         = panic "RegAlloc.Linear.X86.FreeRegs.allocateReg: no reg"
 
-
diff --git a/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs
new file mode 100644
index 0000000000..c04fce9645
--- /dev/null
+++ b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs
@@ -0,0 +1,52 @@
+
+-- | Free regs map for x86_64
+module RegAlloc.Linear.X86_64.FreeRegs
+where
+
+import X86.Regs
+import RegClass
+import Reg
+import Panic
+import Platform
+
+import Data.Word
+import Data.Bits
+
+newtype FreeRegs = FreeRegs Word64
+    deriving Show
+
+noFreeRegs :: FreeRegs
+noFreeRegs = FreeRegs 0
+
+releaseReg :: RealReg -> FreeRegs -> FreeRegs
+releaseReg (RealRegSingle n) (FreeRegs f)
+        = FreeRegs (f .|. (1 `shiftL` n))
+
+releaseReg _ _
+        = panic "RegAlloc.Linear.X86_64.FreeRegs.releaseReg: no reg"
+
+initFreeRegs :: Platform -> FreeRegs
+initFreeRegs platform
+        = foldr releaseReg noFreeRegs (allocatableRegs platform)
+
+getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
+getFreeRegs platform cls (FreeRegs f) = go f 0
+
+  where go 0 _ = []
+        go n m
+          | n .&. 1 /= 0 && classOfRealReg platform (RealRegSingle m) == cls
+          = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
+
+          | otherwise
+          = go (n `shiftR` 1) $! (m+1)
+        -- ToDo: there's no point looking through all the integer registers
+        -- in order to find a floating-point one.
+
+allocateReg :: RealReg -> FreeRegs -> FreeRegs
+allocateReg (RealRegSingle r) (FreeRegs f)
+        = FreeRegs (f .&. complement (1 `shiftL` r))
+
+allocateReg _ _
+        = panic "RegAlloc.Linear.X86_64.FreeRegs.allocateReg: no reg"
+
+
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 2483e12213..ac58944f1c 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -39,6 +39,7 @@ import OldCmm hiding (RegSet)
 import OldPprCmm()
 
 import Digraph
+import DynFlags
 import Outputable
 import Platform
 import Unique
@@ -461,11 +462,11 @@ slurpReloadCoalesce live
 -- | Strip away liveness information, yielding NatCmmDecl
 stripLive
         :: (Outputable statics, Outputable instr, Instruction instr)
-        => Platform
+        => DynFlags
         -> LiveCmmDecl statics instr
         -> NatCmmDecl statics instr
 
-stripLive platform live
+stripLive dflags live
         = stripCmm live
 
  where  stripCmm :: (Outputable statics, Outputable instr, Instruction instr)
@@ -481,7 +482,7 @@ stripLive platform live
                                 = partition ((== first_id) . blockId) final_blocks
 
            in   CmmProc info label
-                          (ListGraph $ map (stripLiveBlock platform) $ first' : rest')
+                          (ListGraph $ map (stripLiveBlock dflags) $ first' : rest')
 
         -- procs used for stg_split_markers don't contain any blocks, and have no first_id.
         stripCmm (CmmProc (LiveInfo info Nothing _ _) label [])
@@ -496,11 +497,11 @@ stripLive platform live
 
 stripLiveBlock
         :: Instruction instr
-        => Platform
+        => DynFlags
         -> LiveBasicBlock instr
         -> NatBasicBlock instr
 
-stripLiveBlock platform (BasicBlock i lis)
+stripLiveBlock dflags (BasicBlock i lis)
  =      BasicBlock i instrs'
 
  where  (instrs', _)
@@ -511,11 +512,11 @@ stripLiveBlock platform (BasicBlock i lis)
 
         spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
          = do   delta   <- get
-                spillNat (mkSpillInstr platform reg delta slot : acc) instrs
+                spillNat (mkSpillInstr dflags reg delta slot : acc) instrs
 
         spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
          = do   delta   <- get
-                spillNat (mkLoadInstr platform reg delta slot : acc) instrs
+                spillNat (mkLoadInstr dflags reg delta slot : acc) instrs
 
         spillNat acc (LiveInstr (Instr instr) _ : instrs)
          | Just i <- takeDeltaInstr instr
diff --git a/compiler/nativeGen/SPARC/Base.hs b/compiler/nativeGen/SPARC/Base.hs
index de11b9f77c..aa7b057e69 100644
--- a/compiler/nativeGen/SPARC/Base.hs
+++ b/compiler/nativeGen/SPARC/Base.hs
@@ -25,7 +25,7 @@ module SPARC.Base (
 
 where
 
-import qualified Constants
+import DynFlags
 import Panic
 
 import Data.Int
@@ -40,9 +40,9 @@ wordLengthInBits
 	= wordLength * 8
 
 -- Size of the available spill area
-spillAreaLength :: Int
+spillAreaLength :: DynFlags -> Int
 spillAreaLength
-	= Constants.rESERVED_C_STACK_BYTES
+	= rESERVED_C_STACK_BYTES
 
 -- | We need 8 bytes because our largest registers are 64 bit.
 spillSlotSize :: Int
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index a3409dd28b..9d6aeaafc9 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -111,7 +111,9 @@ stmtsToInstrs stmts
 
 
 stmtToInstrs :: CmmStmt -> NatM InstrBlock
-stmtToInstrs stmt = case stmt of
+stmtToInstrs stmt = do
+  dflags <- getDynFlags
+  case stmt of
     CmmNop         -> return nilOL
     CmmComment s   -> return (unitOL (COMMENT s))
 
@@ -119,14 +121,14 @@ stmtToInstrs stmt = case stmt of
       | isFloatType ty  -> assignReg_FltCode size reg src
       | isWord64 ty     -> assignReg_I64Code      reg src
       | otherwise       -> assignReg_IntCode size reg src
-        where ty = cmmRegType reg
+        where ty = cmmRegType dflags reg
               size = cmmTypeSize ty
 
     CmmStore addr src
       | isFloatType ty  -> assignMem_FltCode size addr src
       | isWord64 ty     -> assignMem_I64Code      addr src
       | otherwise       -> assignMem_IntCode size addr src
-        where ty = cmmExprType src
+        where ty = cmmExprType dflags src
               size = cmmTypeSize ty
 
     CmmCall target result_regs args _
@@ -163,9 +165,9 @@ temporary, then do the other computation, and then use the temporary:
 
 
 -- | Convert a BlockId to some CmmStatic data
-jumpTableEntry :: Maybe BlockId -> CmmStatic
-jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
-jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
+jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
+jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
+jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
     where blockLabel = mkAsmTempLabel (getUnique blockid)
 
 
@@ -203,11 +205,12 @@ assignReg_IntCode _ reg src = do
 -- Floating point assignment to memory
 assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
 assignMem_FltCode pk addr src = do
+    dflags <- getDynFlags
     Amode dst__2 code1 <- getAmode addr
     (src__2, code2) <- getSomeReg src
     tmp1 <- getNewRegNat pk
     let
-        pk__2   = cmmExprType src
+        pk__2   = cmmExprType dflags src
         code__2 = code1 `appOL` code2 `appOL`
             if   sizeToWidth pk == typeWidth pk__2
             then unitOL (ST pk src__2 dst__2)
@@ -321,8 +324,8 @@ genSwitch dflags expr ids
 
 generateJumpTableForInstr :: DynFlags -> Instr
                           -> Maybe (NatCmmDecl CmmStatics Instr)
-generateJumpTableForInstr _ (JMP_TBL _ ids label) =
-        let jumpTable = map jumpTableEntry ids
+generateJumpTableForInstr dflags (JMP_TBL _ ids label) =
+        let jumpTable = map (jumpTableEntry dflags) ids
         in Just (CmmData ReadOnlyData (Statics label jumpTable))
 generateJumpTableForInstr _ _ = Nothing
 
@@ -458,17 +461,21 @@ genCCall target dest_regs argsAndHints
 -- | Generate code to calculate an argument, and move it into one
 --      or two integer vregs.
 arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
-arg_to_int_vregs arg
+arg_to_int_vregs arg = do dflags <- getDynFlags
+                          arg_to_int_vregs' dflags arg
+
+arg_to_int_vregs' :: DynFlags -> CmmExpr -> NatM (OrdList Instr, [Reg])
+arg_to_int_vregs' dflags arg
 
         -- If the expr produces a 64 bit int, then we can just use iselExpr64
-        | isWord64 (cmmExprType arg)
+        | isWord64 (cmmExprType dflags arg)
         = do    (ChildCode64 code r_lo) <- iselExpr64 arg
                 let r_hi                = getHiVRegFromLo r_lo
                 return (code, [r_hi, r_lo])
 
         | otherwise
         = do    (src, code)     <- getSomeReg arg
-                let pk          = cmmExprType arg
+                let pk          = cmmExprType dflags arg
 
                 case cmmTypeSize pk of
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Amode.hs b/compiler/nativeGen/SPARC/CodeGen/Amode.hs
index 92e70eb4dc..139064ccbd 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Amode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Amode.hs
@@ -33,7 +33,8 @@ getAmode
 	-> NatM Amode
 
 getAmode tree@(CmmRegOff _ _) 
-	= getAmode (mangleIndexTree tree)
+    = do dflags <- getDynFlags
+         getAmode (mangleIndexTree dflags tree)
 
 getAmode (CmmMachOp (MO_Sub _) [x, CmmLit (CmmInt i _)])
   | fits13Bits (-i)
diff --git a/compiler/nativeGen/SPARC/CodeGen/Base.hs b/compiler/nativeGen/SPARC/CodeGen/Base.hs
index 469361139b..367d9230ba 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Base.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Base.hs
@@ -29,6 +29,7 @@ import Size
 import Reg
 
 import CodeGen.Platform
+import DynFlags
 import OldCmm
 import OldPprCmm ()
 import Platform
@@ -114,13 +115,13 @@ getRegisterReg platform (CmmGlobal mid)
 
 -- Expand CmmRegOff.  ToDo: should we do it this way around, or convert
 -- CmmExprs into CmmRegOff?
-mangleIndexTree :: CmmExpr -> CmmExpr
+mangleIndexTree :: DynFlags -> CmmExpr -> CmmExpr
 
-mangleIndexTree (CmmRegOff reg off)
+mangleIndexTree dflags (CmmRegOff reg off)
 	= CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
-	where width = typeWidth (cmmRegType reg)
+	where width = typeWidth (cmmRegType dflags reg)
 
-mangleIndexTree _
+mangleIndexTree _ _
 	= panic "SPARC.CodeGen.Base.mangleIndexTree: no match"
 
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
index 74f20196df..d459d98212 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
@@ -93,14 +93,15 @@ condIntCode cond x y = do
 
 condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
 condFltCode cond x y = do
+    dflags <- getDynFlags
     (src1, code1) <- getSomeReg x
     (src2, code2) <- getSomeReg y
     tmp <- getNewRegNat FF64
     let
    	promote x = FxTOy FF32 FF64 x tmp
 
-    	pk1   = cmmExprType x
-    	pk2   = cmmExprType y
+    	pk1   = cmmExprType dflags x
+    	pk2   = cmmExprType dflags y
 
     	code__2 =
 		if pk1 `cmmEqType` pk2 then
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
index c2c47e99aa..f7c7419e15 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
@@ -57,11 +57,12 @@ getRegister :: CmmExpr -> NatM Register
 getRegister (CmmReg reg) 
   = do dflags <- getDynFlags
        let platform = targetPlatform dflags
-       return (Fixed (cmmTypeSize (cmmRegType reg))
-              (getRegisterReg platform reg) nilOL)
+       return (Fixed (cmmTypeSize (cmmRegType dflags reg))
+                     (getRegisterReg platform reg) nilOL)
 
 getRegister tree@(CmmRegOff _ _) 
-  = getRegister (mangleIndexTree tree)
+  = do dflags <- getDynFlags
+       getRegister (mangleIndexTree dflags tree)
 
 getRegister (CmmMachOp (MO_UU_Conv W64 W32)
              [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
@@ -490,14 +491,15 @@ trivialFCode
 	-> NatM Register
 
 trivialFCode pk instr x y = do
+    dflags <- getDynFlags
     (src1, code1) <- getSomeReg x
     (src2, code2) <- getSomeReg y
     tmp <- getNewRegNat FF64
     let
     	promote x = FxTOy FF32 FF64 x tmp
 
-    	pk1   = cmmExprType x
-    	pk2   = cmmExprType y
+    	pk1   = cmmExprType dflags x
+    	pk2   = cmmExprType dflags y
 
     	code__2 dst =
     	    	if pk1 `cmmEqType` pk2 then
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 021b2fb772..9404badea6 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -46,6 +46,7 @@ import Size
 import CLabel
 import CodeGen.Platform
 import BlockId
+import DynFlags
 import OldCmm
 import FastString
 import FastBool
@@ -372,15 +373,16 @@ sparc_patchJumpInstr insn patchF
 -- | Make a spill instruction.
 -- 	On SPARC we spill below frame pointer leaving 2 words/spill
 sparc_mkSpillInstr
-    :: Platform
+    :: DynFlags
     -> Reg      -- ^ register to spill
     -> Int      -- ^ current stack delta
     -> Int      -- ^ spill slot to use
     -> Instr
 
-sparc_mkSpillInstr platform reg _ slot
- = let	off     = spillSlotToOffset slot
-        off_w	= 1 + (off `div` 4)
+sparc_mkSpillInstr dflags reg _ slot
+ = let  platform = targetPlatform dflags
+        off      = spillSlotToOffset dflags slot
+        off_w    = 1 + (off `div` 4)
         sz 	= case targetClassOfReg platform reg of
 			RcInteger -> II32
 			RcFloat   -> FF32
@@ -392,14 +394,15 @@ sparc_mkSpillInstr platform reg _ slot
 
 -- | Make a spill reload instruction.
 sparc_mkLoadInstr
-    :: Platform
+    :: DynFlags
     -> Reg      -- ^ register to load into
     -> Int      -- ^ current stack delta
     -> Int      -- ^ spill slot to use
     -> Instr
 
-sparc_mkLoadInstr platform reg _ slot
-  = let off     = spillSlotToOffset slot
+sparc_mkLoadInstr dflags reg _ slot
+  = let platform = targetPlatform dflags
+        off      = spillSlotToOffset dflags slot
 	off_w	= 1 + (off `div` 4)
         sz	= case targetClassOfReg platform reg of
 			RcInteger -> II32
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index e57e5e2725..55afac0ee2 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -38,6 +38,7 @@ import PprBase
 import OldCmm
 import OldPprCmm()
 import CLabel
+import BlockId
 
 import Unique           ( Uniquable(..), pprUnique )
 import Outputable
@@ -52,7 +53,7 @@ pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
 pprNatCmmDecl (CmmData section dats) =
   pprSectionHeader section $$ pprDatas dats
 
-pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) =
+pprNatCmmDecl proc@(CmmProc top_info lbl (ListGraph blocks)) =
   case topInfoTable proc of
     Nothing ->
        case blocks of
@@ -61,19 +62,15 @@ pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) =
          blocks -> -- special case for code without info table:
            pprSectionHeader Text $$
            pprLabel lbl $$ -- blocks guaranteed not null, so label needed
-           vcat (map pprBasicBlock blocks)
+           vcat (map (pprBasicBlock top_info) blocks)
 
-    Just (Statics info_lbl info) ->
+    Just (Statics info_lbl _) ->
       sdocWithPlatform $ \platform ->
-      pprSectionHeader Text $$
-      (
-           (if platformHasSubsectionsViaSymbols platform
-            then ppr (mkDeadStripPreventer info_lbl) <> char ':'
-            else empty) $$
-           vcat (map pprData info) $$
-           pprLabel info_lbl
-      ) $$
-      vcat (map pprBasicBlock blocks) $$
+      (if platformHasSubsectionsViaSymbols platform
+          then pprSectionHeader Text $$
+               ppr (mkDeadStripPreventer info_lbl) <> char ':'
+          else empty) $$
+      vcat (map (pprBasicBlock top_info) blocks) $$
          -- above: Even the first block gets a label, because with branch-chain
          -- elimination, it might be the target of a goto.
             (if platformHasSubsectionsViaSymbols platform
@@ -91,10 +88,18 @@ pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) =
              else empty)
 
 
-pprBasicBlock :: NatBasicBlock Instr -> SDoc
-pprBasicBlock (BasicBlock blockid instrs) =
-  pprLabel (mkAsmTempLabel (getUnique blockid)) $$
-  vcat (map pprInstr instrs)
+pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
+pprBasicBlock info_env (BasicBlock blockid instrs)
+  = maybe_infotable $$
+    pprLabel (mkAsmTempLabel (getUnique blockid)) $$
+    vcat (map pprInstr instrs)
+  where
+    maybe_infotable = case mapLookup blockid info_env of
+       Nothing   -> empty
+       Just (Statics info_lbl info) ->
+           pprSectionHeader Text $$
+           vcat (map pprData info) $$
+           pprLabel info_lbl
 
 
 pprDatas :: CmmStatics -> SDoc
@@ -333,7 +338,8 @@ pprSectionHeader seg
 -- | Pretty print a data item.
 pprDataItem :: CmmLit -> SDoc
 pprDataItem lit
-  = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
+  = sdocWithDynFlags $ \dflags ->
+    vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit)
     where
         imm = litToImm lit
 
diff --git a/compiler/nativeGen/SPARC/Stack.hs b/compiler/nativeGen/SPARC/Stack.hs
index 7f75693889..65dfef0e25 100644
--- a/compiler/nativeGen/SPARC/Stack.hs
+++ b/compiler/nativeGen/SPARC/Stack.hs
@@ -20,6 +20,7 @@ import SPARC.Regs
 import SPARC.Base
 import SPARC.Imm
 
+import DynFlags
 import Outputable
 
 -- | Get an AddrMode relative to the address in sp.
@@ -42,15 +43,15 @@ fpRel n
 
 -- | Convert a spill slot number to a *byte* offset, with no sign.
 --
-spillSlotToOffset :: Int -> Int
-spillSlotToOffset slot
-	| slot >= 0 && slot < maxSpillSlots
+spillSlotToOffset :: DynFlags -> Int -> Int
+spillSlotToOffset dflags slot
+	| slot >= 0 && slot < maxSpillSlots dflags
 	= 64 + spillSlotSize * slot
 
 	| otherwise
 	= pprPanic "spillSlotToOffset:" 
 	              (   text "invalid spill location: " <> int slot
-		      $$  text "maxSpillSlots:          " <> int maxSpillSlots)
+		      $$  text "maxSpillSlots:          " <> int (maxSpillSlots dflags))
 
 
 -- | The maximum number of spill slots available on the C stack.
@@ -59,7 +60,7 @@ spillSlotToOffset slot
 --	Why do we reserve 64 bytes, instead of using the whole thing??
 --		-- BL 2009/02/15
 --
-maxSpillSlots :: Int
-maxSpillSlots 
-	= ((spillAreaLength - 64) `div` spillSlotSize) - 1
+maxSpillSlots :: DynFlags -> Int
+maxSpillSlots dflags
+	= ((spillAreaLength dflags - 64) `div` spillSlotSize) - 1
 
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index e8f2eccd6b..b83ede89aa 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -52,7 +52,6 @@ import Outputable
 import Unique
 import FastString
 import FastBool         ( isFastTrue )
-import Constants        ( wORD_SIZE )
 import DynFlags
 import Util
 
@@ -141,6 +140,7 @@ stmtsToInstrs stmts
 
 stmtToInstrs :: CmmStmt -> NatM InstrBlock
 stmtToInstrs stmt = do
+  dflags <- getDynFlags
   is32Bit <- is32BitPlatform
   case stmt of
     CmmNop         -> return nilOL
@@ -150,14 +150,14 @@ stmtToInstrs stmt = do
       | isFloatType ty         -> assignReg_FltCode size reg src
       | is32Bit && isWord64 ty -> assignReg_I64Code      reg src
       | otherwise              -> assignReg_IntCode size reg src
-        where ty = cmmRegType reg
+        where ty = cmmRegType dflags reg
               size = cmmTypeSize ty
 
     CmmStore addr src
       | isFloatType ty         -> assignMem_FltCode size addr src
       | is32Bit && isWord64 ty -> assignMem_I64Code      addr src
       | otherwise              -> assignMem_IntCode size addr src
-        where ty = cmmExprType src
+        where ty = cmmExprType dflags src
               size = cmmTypeSize ty
 
     CmmCall target result_regs args _
@@ -168,15 +168,15 @@ stmtToInstrs stmt = do
     CmmSwitch arg ids     -> do dflags <- getDynFlags
                                 genSwitch dflags arg ids
     CmmJump arg gregs     -> do dflags <- getDynFlags
-                                let platform = targetPlatform dflags
-                                genJump arg (jumpRegs platform gregs)
+                                genJump arg (jumpRegs dflags gregs)
     CmmReturn             ->
       panic "stmtToInstrs: return statement should have been cps'd away"
 
 
-jumpRegs :: Platform -> Maybe [GlobalReg] -> [Reg]
-jumpRegs platform Nothing      = allHaskellArgRegs platform
-jumpRegs platform (Just gregs) = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ]
+jumpRegs :: DynFlags -> Maybe [GlobalReg] -> [Reg]
+jumpRegs dflags Nothing      = allHaskellArgRegs dflags
+jumpRegs dflags (Just gregs) = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ]
+    where platform = targetPlatform dflags
 
 --------------------------------------------------------------------------------
 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
@@ -274,9 +274,9 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
 
 
 -- | Convert a BlockId to some CmmStatic data
-jumpTableEntry :: Maybe BlockId -> CmmStatic
-jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
-jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
+jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
+jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
+jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
     where blockLabel = mkAsmTempLabel (getUnique blockid)
 
 
@@ -285,10 +285,10 @@ jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
 
 -- Expand CmmRegOff.  ToDo: should we do it this way around, or convert
 -- CmmExprs into CmmRegOff?
-mangleIndexTree :: CmmReg -> Int -> CmmExpr
-mangleIndexTree reg off
+mangleIndexTree :: DynFlags -> CmmReg -> Int -> CmmExpr
+mangleIndexTree dflags reg off
   = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
-  where width = typeWidth (cmmRegType reg)
+  where width = typeWidth (cmmRegType dflags reg)
 
 -- | The dual to getAnyReg: compute an expression into a register, but
 --      we don't mind which one it is.
@@ -406,12 +406,13 @@ iselExpr64 expr
 
 --------------------------------------------------------------------------------
 getRegister :: CmmExpr -> NatM Register
-getRegister e = do is32Bit <- is32BitPlatform
-                   getRegister' is32Bit e
+getRegister e = do dflags <- getDynFlags
+                   is32Bit <- is32BitPlatform
+                   getRegister' dflags is32Bit e
 
-getRegister' :: Bool -> CmmExpr -> NatM Register
+getRegister' :: DynFlags -> Bool -> CmmExpr -> NatM Register
 
-getRegister' is32Bit (CmmReg reg)
+getRegister' dflags is32Bit (CmmReg reg)
   = case reg of
         CmmGlobal PicBaseReg
          | is32Bit ->
@@ -423,44 +424,43 @@ getRegister' is32Bit (CmmReg reg)
         _ ->
             do use_sse2 <- sse2Enabled
                let
-                 sz = cmmTypeSize (cmmRegType reg)
+                 sz = cmmTypeSize (cmmRegType dflags reg)
                  size | not use_sse2 && isFloatSize sz = FF80
                       | otherwise                      = sz
                --
-               dflags <- getDynFlags
                let platform = targetPlatform dflags
                return (Fixed size (getRegisterReg platform use_sse2 reg) nilOL)
 
 
-getRegister' is32Bit (CmmRegOff r n)
-  = getRegister' is32Bit $ mangleIndexTree r n
+getRegister' dflags is32Bit (CmmRegOff r n)
+  = getRegister' dflags is32Bit $ mangleIndexTree dflags r n
 
 -- for 32-bit architectuers, support some 64 -> 32 bit conversions:
 -- TO_W_(x), TO_W_(x >> 32)
 
-getRegister' is32Bit (CmmMachOp (MO_UU_Conv W64 W32)
+getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32)
                      [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
  | is32Bit = do
   ChildCode64 code rlo <- iselExpr64 x
   return $ Fixed II32 (getHiVRegFromLo rlo) code
 
-getRegister' is32Bit (CmmMachOp (MO_SS_Conv W64 W32)
+getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32)
                      [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
  | is32Bit = do
   ChildCode64 code rlo <- iselExpr64 x
   return $ Fixed II32 (getHiVRegFromLo rlo) code
 
-getRegister' is32Bit (CmmMachOp (MO_UU_Conv W64 W32) [x])
+getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32) [x])
  | is32Bit = do
   ChildCode64 code rlo <- iselExpr64 x
   return $ Fixed II32 rlo code
 
-getRegister' is32Bit (CmmMachOp (MO_SS_Conv W64 W32) [x])
+getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) [x])
  | is32Bit = do
   ChildCode64 code rlo <- iselExpr64 x
   return $ Fixed II32 rlo code
 
-getRegister' _ (CmmLit lit@(CmmFloat f w)) =
+getRegister' _ _ (CmmLit lit@(CmmFloat f w)) =
   if_sse2 float_const_sse2 float_const_x87
  where
   float_const_sse2
@@ -491,60 +491,60 @@ getRegister' _ (CmmLit lit@(CmmFloat f w)) =
       loadFloatAmode False w addr code
 
 -- catch simple cases of zero- or sign-extended load
-getRegister' _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad addr _]) = do
+getRegister' _ _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad addr _]) = do
   code <- intLoadCode (MOVZxL II8) addr
   return (Any II32 code)
 
-getRegister' _ (CmmMachOp (MO_SS_Conv W8 W32) [CmmLoad addr _]) = do
+getRegister' _ _ (CmmMachOp (MO_SS_Conv W8 W32) [CmmLoad addr _]) = do
   code <- intLoadCode (MOVSxL II8) addr
   return (Any II32 code)
 
-getRegister' _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad addr _]) = do
+getRegister' _ _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad addr _]) = do
   code <- intLoadCode (MOVZxL II16) addr
   return (Any II32 code)
 
-getRegister' _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad addr _]) = do
+getRegister' _ _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad addr _]) = do
   code <- intLoadCode (MOVSxL II16) addr
   return (Any II32 code)
 
 -- catch simple cases of zero- or sign-extended load
-getRegister' is32Bit (CmmMachOp (MO_UU_Conv W8 W64) [CmmLoad addr _])
+getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W8 W64) [CmmLoad addr _])
  | not is32Bit = do
   code <- intLoadCode (MOVZxL II8) addr
   return (Any II64 code)
 
-getRegister' is32Bit (CmmMachOp (MO_SS_Conv W8 W64) [CmmLoad addr _])
+getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W8 W64) [CmmLoad addr _])
  | not is32Bit = do
   code <- intLoadCode (MOVSxL II8) addr
   return (Any II64 code)
 
-getRegister' is32Bit (CmmMachOp (MO_UU_Conv W16 W64) [CmmLoad addr _])
+getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W16 W64) [CmmLoad addr _])
  | not is32Bit = do
   code <- intLoadCode (MOVZxL II16) addr
   return (Any II64 code)
 
-getRegister' is32Bit (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad addr _])
+getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad addr _])
  | not is32Bit = do
   code <- intLoadCode (MOVSxL II16) addr
   return (Any II64 code)
 
-getRegister' is32Bit (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad addr _])
+getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad addr _])
  | not is32Bit = do
   code <- intLoadCode (MOV II32) addr -- 32-bit loads zero-extend
   return (Any II64 code)
 
-getRegister' is32Bit (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad addr _])
+getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad addr _])
  | not is32Bit = do
   code <- intLoadCode (MOVSxL II32) addr
   return (Any II64 code)
 
-getRegister' is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg),
+getRegister' _ is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg),
                                      CmmLit displacement])
  | not is32Bit = do
       return $ Any II64 (\dst -> unitOL $
         LEA II64 (OpAddr (ripRel (litToImm displacement))) (OpReg dst))
 
-getRegister' is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
+getRegister' dflags is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
     sse2 <- sse2Enabled
     case mop of
       MO_F_Neg w
@@ -634,11 +634,11 @@ getRegister' is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
 
         conversionNop :: Size -> CmmExpr -> NatM Register
         conversionNop new_size expr
-            = do e_code <- getRegister' is32Bit expr
+            = do e_code <- getRegister' dflags is32Bit expr
                  return (swizzleRegisterRep e_code new_size)
 
 
-getRegister' is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
+getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
   sse2 <- sse2Enabled
   case mop of
       MO_F_Eq _ -> condFltReg is32Bit EQQ x y
@@ -812,14 +812,14 @@ getRegister' is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
            return (Fixed size result code)
 
 
-getRegister' _ (CmmLoad mem pk)
+getRegister' _ _ (CmmLoad mem pk)
   | isFloatType pk
   = do
     Amode addr mem_code <- getAmode mem
     use_sse2 <- sse2Enabled
     loadFloatAmode use_sse2 (typeWidth pk) addr mem_code
 
-getRegister' is32Bit (CmmLoad mem pk)
+getRegister' _ is32Bit (CmmLoad mem pk)
   | is32Bit && not (isWord64 pk)
   = do
     code <- intLoadCode instr mem
@@ -837,14 +837,14 @@ getRegister' is32Bit (CmmLoad mem pk)
         -- simpler we do our 8-bit arithmetic with full 32-bit registers.
 
 -- Simpler memory load code on x86_64
-getRegister' is32Bit (CmmLoad mem pk)
+getRegister' _ is32Bit (CmmLoad mem pk)
  | not is32Bit
   = do
     code <- intLoadCode (MOV size) mem
     return (Any size code)
   where size = intSize $ typeWidth pk
 
-getRegister' is32Bit (CmmLit (CmmInt 0 width))
+getRegister' _ is32Bit (CmmLit (CmmInt 0 width))
   = let
         size = intSize width
 
@@ -861,8 +861,8 @@ getRegister' is32Bit (CmmLit (CmmInt 0 width))
   -- optimisation for loading small literals on x86_64: take advantage
   -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit
   -- instruction forms are shorter.
-getRegister' is32Bit (CmmLit lit)
-  | not is32Bit, isWord64 (cmmLitType lit), not (isBigLit lit)
+getRegister' dflags is32Bit (CmmLit lit)
+  | not is32Bit, isWord64 (cmmLitType dflags lit), not (isBigLit lit)
   = let
         imm = litToImm lit
         code dst = unitOL (MOV II32 (OpImm imm) (OpReg dst))
@@ -877,15 +877,13 @@ getRegister' is32Bit (CmmLit lit)
         -- note2: all labels are small, because we're assuming the
         -- small memory model (see gcc docs, -mcmodel=small).
 
-getRegister' _ (CmmLit lit)
-  = let
-        size = cmmTypeSize (cmmLitType lit)
-        imm = litToImm lit
-        code dst = unitOL (MOV size (OpImm imm) (OpReg dst))
-    in
-        return (Any size code)
+getRegister' dflags _ (CmmLit lit)
+  = do let size = cmmTypeSize (cmmLitType dflags lit)
+           imm = litToImm lit
+           code dst = unitOL (MOV size (OpImm imm) (OpReg dst))
+       return (Any size code)
 
-getRegister' _ other = pprPanic "getRegister(x86)" (ppr other)
+getRegister' _ _ other = pprPanic "getRegister(x86)" (ppr other)
 
 
 intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
@@ -958,7 +956,8 @@ getAmode e = do is32Bit <- is32BitPlatform
                 getAmode' is32Bit e
 
 getAmode' :: Bool -> CmmExpr -> NatM Amode
-getAmode' _ (CmmRegOff r n) = getAmode $ mangleIndexTree r n
+getAmode' _ (CmmRegOff r n) = do dflags <- getDynFlags
+                                 getAmode $ mangleIndexTree dflags r n
 
 getAmode' is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg),
                                                   CmmLit displacement])
@@ -1047,7 +1046,8 @@ getNonClobberedOperand (CmmLit lit) = do
      else do
 
   is32Bit <- is32BitPlatform
-  if is32BitLit is32Bit lit && not (isFloatType (cmmLitType lit))
+  dflags <- getDynFlags
+  if is32BitLit is32Bit lit && not (isFloatType (cmmLitType dflags lit))
     then return (OpImm (litToImm lit), nilOL)
     else getNonClobberedOperand_generic (CmmLit lit)
 
@@ -1100,7 +1100,8 @@ getOperand (CmmLit lit) = do
     else do
 
   is32Bit <- is32BitPlatform
-  if is32BitLit is32Bit lit && not (isFloatType (cmmLitType lit))
+  dflags <- getDynFlags
+  if is32BitLit is32Bit lit && not (isFloatType (cmmLitType dflags lit))
     then return (OpImm (litToImm lit), nilOL)
     else getOperand_generic (CmmLit lit)
 
@@ -1276,21 +1277,23 @@ condIntCode' _ cond x (CmmLit (CmmInt 0 pk)) = do
 
 -- anything vs operand
 condIntCode' is32Bit cond x y | isOperand is32Bit y = do
+    dflags <- getDynFlags
     (x_reg, x_code) <- getNonClobberedReg x
     (y_op,  y_code) <- getOperand y
     let
         code = x_code `appOL` y_code `snocOL`
-                  CMP (cmmTypeSize (cmmExprType x)) y_op (OpReg x_reg)
+                  CMP (cmmTypeSize (cmmExprType dflags x)) y_op (OpReg x_reg)
     return (CondCode False cond code)
 
 -- anything vs anything
 condIntCode' _ cond x y = do
+  dflags <- getDynFlags
   (y_reg, y_code) <- getNonClobberedReg y
   (x_op, x_code) <- getRegOrMem x
   let
         code = y_code `appOL`
                x_code `snocOL`
-                  CMP (cmmTypeSize (cmmExprType x)) (OpReg y_reg) x_op
+                  CMP (cmmTypeSize (cmmExprType dflags x)) (OpReg y_reg) x_op
   return (CondCode False cond code)
 
 
@@ -1317,12 +1320,13 @@ condFltCode cond x y
   -- an operand, but the right must be a reg.  We can probably do better
   -- than this general case...
   condFltCode_sse2 = do
+    dflags <- getDynFlags
     (x_reg, x_code) <- getNonClobberedReg x
     (y_op, y_code) <- getOperand y
     let
         code = x_code `appOL`
                y_code `snocOL`
-                  CMP (floatSize $ cmmExprWidth x) y_op (OpReg x_reg)
+                  CMP (floatSize $ cmmExprWidth dflags x) y_op (OpReg x_reg)
         -- NB(1): we need to use the unsigned comparison operators on the
         -- result of this comparison.
     return (CondCode True (condToUnsigned cond) code)
@@ -1713,7 +1717,7 @@ genCCall32 target dest_regs args = do
     (CmmPrim _ (Just stmts), _) ->
         stmtsToInstrs stmts
 
-    _ -> genCCall32' target dest_regs args
+    _ -> genCCall32' dflags target dest_regs args
 
   where divOp1 platform signed width results [CmmHinted arg_x _, CmmHinted arg_y _]
             = divOp platform signed width results Nothing arg_x arg_y
@@ -1750,19 +1754,20 @@ genCCall32 target dest_regs args = do
         divOp _ _ _ _ _ _ _
             = panic "genCCall32: Wrong number of results for divOp"
 
-genCCall32' :: CmmCallTarget            -- function to call
+genCCall32' :: DynFlags
+            -> CmmCallTarget            -- function to call
             -> [HintedCmmFormal]        -- where to put the result
             -> [HintedCmmActual]        -- arguments (of mixed type)
             -> NatM InstrBlock
-genCCall32' target dest_regs args = do
+genCCall32' dflags target dest_regs args = do
         let
             -- Align stack to 16n for calls, assuming a starting stack
             -- alignment of 16n - word_size on procedure entry. Which we
             -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
-            sizes               = map (arg_size . cmmExprType . hintlessCmm) (reverse args)
-            raw_arg_size        = sum sizes + wORD_SIZE
+            sizes               = map (arg_size . cmmExprType dflags . hintlessCmm) (reverse args)
+            raw_arg_size        = sum sizes + wORD_SIZE dflags
             arg_pad_size        = (roundTo 16 $ raw_arg_size) - raw_arg_size
-            tot_arg_size        = raw_arg_size + arg_pad_size - wORD_SIZE
+            tot_arg_size        = raw_arg_size + arg_pad_size - wORD_SIZE dflags
         delta0 <- getDeltaNat
         setDeltaNat (delta0 - arg_pad_size)
 
@@ -1780,7 +1785,7 @@ genCCall32' target dest_regs args = do
                where fn_imm = ImmCLbl lbl
             CmmCallee expr conv
                -> do { (dyn_r, dyn_c) <- getSomeReg expr
-                     ; ASSERT( isWord32 (cmmExprType expr) )
+                     ; ASSERT( isWord32 (cmmExprType dflags expr) )
                        return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }
             CmmPrim _ _
                 -> panic $ "genCCall: Can't handle CmmPrim call type here, error "
@@ -1896,7 +1901,7 @@ genCCall32' target dest_regs args = do
                     DELTA (delta-size))
 
           where
-             arg_ty = cmmExprType arg
+             arg_ty = cmmExprType dflags arg
              size = arg_size arg_ty -- Byte size
 
 genCCall64 :: CmmCallTarget            -- function to call
@@ -1953,8 +1958,7 @@ genCCall64 target dest_regs args = do
 
     _ ->
         do dflags <- getDynFlags
-           let platform = targetPlatform dflags
-           genCCall64' platform target dest_regs args
+           genCCall64' dflags target dest_regs args
 
   where divOp1 platform signed width results [CmmHinted arg_x _, CmmHinted arg_y _]
             = divOp platform signed width results Nothing arg_x arg_y
@@ -1989,12 +1993,12 @@ genCCall64 target dest_regs args = do
         divOp _ _ _ _ _ _ _
             = panic "genCCall64: Wrong number of results for divOp"
 
-genCCall64' :: Platform
+genCCall64' :: DynFlags
             -> CmmCallTarget            -- function to call
             -> [HintedCmmFormal]        -- where to put the result
             -> [HintedCmmActual]        -- arguments (of mixed type)
             -> NatM InstrBlock
-genCCall64' platform target dest_regs args = do
+genCCall64' dflags target dest_regs args = do
     -- load up the register arguments
     (stack_args, int_regs_used, fp_regs_used, load_args_code)
          <-
@@ -2021,14 +2025,14 @@ genCCall64' platform target dest_regs args = do
     -- alignment of 16n - word_size on procedure entry. Which we
     -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
     (real_size, adjust_rsp) <-
-        if (tot_arg_size + wORD_SIZE) `rem` 16 == 0
+        if (tot_arg_size + wORD_SIZE dflags) `rem` 16 == 0
             then return (tot_arg_size, nilOL)
             else do -- we need to adjust...
                 delta <- getDeltaNat
-                setDeltaNat (delta - wORD_SIZE)
-                return (tot_arg_size + wORD_SIZE, toOL [
-                                SUB II64 (OpImm (ImmInt wORD_SIZE)) (OpReg rsp),
-                                DELTA (delta - wORD_SIZE) ])
+                setDeltaNat (delta - wORD_SIZE dflags)
+                return (tot_arg_size + wORD_SIZE dflags, toOL [
+                                SUB II64 (OpImm (ImmInt (wORD_SIZE dflags))) (OpReg rsp),
+                                DELTA (delta - wORD_SIZE dflags) ])
 
     -- push the stack args, right to left
     push_code <- push_args (reverse stack_args) nilOL
@@ -2070,7 +2074,7 @@ genCCall64' platform target dest_regs args = do
                     -- stdcall has callee do it, but is not supported on
                     -- x86_64 target (see #3336)
                   (if real_size==0 then [] else
-                   [ADD (intSize wordWidth) (OpImm (ImmInt real_size)) (OpReg esp)])
+                   [ADD (intSize (wordWidth dflags)) (OpImm (ImmInt real_size)) (OpReg esp)])
                   ++
                   [DELTA (delta + real_size)]
                )
@@ -2097,7 +2101,8 @@ genCCall64' platform target dest_regs args = do
             call                `appOL`
             assign_code dest_regs)
 
-  where arg_size = 8 -- always, at the mo
+  where platform = targetPlatform dflags
+        arg_size = 8 -- always, at the mo
 
         load_args :: [CmmHinted CmmExpr]
                   -> [Reg]                  -- int regs avail for args
@@ -2122,7 +2127,7 @@ genCCall64' platform target dest_regs args = do
                  arg_code <- getAnyReg arg
                  load_args rest rs fregs (code `appOL` arg_code r)
             where
-              arg_rep = cmmExprType arg
+              arg_rep = cmmExprType dflags arg
 
               push_this_arg = do
                 (args',ars,frs,code') <- load_args rest aregs fregs code
@@ -2156,7 +2161,7 @@ genCCall64' platform target dest_regs args = do
                  load_args_win rest (ireg : usedInt) usedFP regs
                                (code `appOL` arg_code ireg)
             where
-              arg_rep = cmmExprType arg
+              arg_rep = cmmExprType dflags arg
 
         push_args [] code = return code
         push_args ((CmmHinted arg _):rest) code
@@ -2165,9 +2170,9 @@ genCCall64' platform target dest_regs args = do
              delta <- getDeltaNat
              setDeltaNat (delta-arg_size)
              let code' = code `appOL` arg_code `appOL` toOL [
-                            SUB (intSize wordWidth) (OpImm (ImmInt arg_size)) (OpReg rsp) ,
+                            SUB (intSize (wordWidth dflags)) (OpImm (ImmInt arg_size)) (OpReg rsp) ,
                             DELTA (delta-arg_size),
-                            MOV (floatSize width) (OpReg arg_reg) (OpAddr  (spRel platform 0))]
+                            MOV (floatSize width) (OpReg arg_reg) (OpAddr (spRel dflags 0))]
              push_args rest code'
 
            | otherwise = do
@@ -2183,14 +2188,14 @@ genCCall64' platform target dest_regs args = do
                                     DELTA (delta-arg_size)]
              push_args rest code'
             where
-              arg_rep = cmmExprType arg
+              arg_rep = cmmExprType dflags arg
               width = typeWidth arg_rep
 
         leaveStackSpace n = do
              delta <- getDeltaNat
              setDeltaNat (delta - n * arg_size)
              return $ toOL [
-                         SUB II64 (OpImm (ImmInt (n * wORD_SIZE))) (OpReg rsp),
+                         SUB II64 (OpImm (ImmInt (n * wORD_SIZE dflags))) (OpReg rsp),
                          DELTA (delta - n * arg_size)]
 
 -- | We're willing to inline and unroll memcpy/memset calls that touch
@@ -2282,11 +2287,11 @@ genSwitch dflags expr ids
         dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
-                                       (EAIndex reg wORD_SIZE) (ImmInt 0))
+                                       (EAIndex reg (wORD_SIZE dflags)) (ImmInt 0))
 
         return $ if target32Bit (targetPlatform dflags)
                  then e_code `appOL` t_code `appOL` toOL [
-                                ADD (intSize wordWidth) op (OpReg tableReg),
+                                ADD (intSize (wordWidth dflags)) op (OpReg tableReg),
                                 JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl
                        ]
                  else case platformOS (targetPlatform dflags) of
@@ -2299,7 +2304,7 @@ genSwitch dflags expr ids
                           -- if L0 is not preceded by a non-anonymous
                           -- label in its section.
                           e_code `appOL` t_code `appOL` toOL [
-                                   ADD (intSize wordWidth) op (OpReg tableReg),
+                                   ADD (intSize (wordWidth dflags)) op (OpReg tableReg),
                                    JMP_TBL (OpReg tableReg) ids Text lbl
                            ]
                       _ ->
@@ -2313,14 +2318,14 @@ genSwitch dflags expr ids
                           -- once binutils 2.17 is standard.
                           e_code `appOL` t_code `appOL` toOL [
                                    MOVSxL II32 op (OpReg reg),
-                                   ADD (intSize wordWidth) (OpReg reg) (OpReg tableReg),
+                                   ADD (intSize (wordWidth dflags)) (OpReg reg) (OpReg tableReg),
                                    JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl
                            ]
   | otherwise
   = do
         (reg,e_code) <- getSomeReg expr
         lbl <- getNewLabelNat
-        let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl))
+        let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (wORD_SIZE dflags)) (ImmCLbl lbl))
             code = e_code `appOL` toOL [
                     JMP_TBL op ids ReadOnlyData lbl
                  ]
@@ -2337,12 +2342,12 @@ createJumpTable dflags ids section lbl
     = let jumpTable
             | dopt Opt_PIC dflags =
                   let jumpTableEntryRel Nothing
-                          = CmmStaticLit (CmmInt 0 wordWidth)
+                          = CmmStaticLit (CmmInt 0 (wordWidth dflags))
                       jumpTableEntryRel (Just blockid)
                           = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
                           where blockLabel = mkAsmTempLabel (getUnique blockid)
                   in map jumpTableEntryRel ids
-            | otherwise = map jumpTableEntry ids
+            | otherwise = map (jumpTableEntry dflags) ids
       in CmmData section (1, Statics lbl jumpTable)
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index a2263b3116..7f0e48e769 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -30,10 +30,10 @@ import FastString
 import FastBool
 import Outputable
 import Platform
-import Constants        (rESERVED_C_STACK_BYTES)
 
 import BasicTypes       (Alignment)
 import CLabel
+import DynFlags
 import UniqSet
 import Unique
 
@@ -613,62 +613,65 @@ x86_patchJumpInstr insn patchF
 -- -----------------------------------------------------------------------------
 -- | Make a spill instruction.
 x86_mkSpillInstr
-    :: Platform
+    :: DynFlags
     -> Reg      -- register to spill
     -> Int      -- current stack delta
     -> Int      -- spill slot to use
     -> Instr
 
-x86_mkSpillInstr platform reg delta slot
-  = let off     = spillSlotToOffset is32Bit slot
+x86_mkSpillInstr dflags reg delta slot
+  = let off     = spillSlotToOffset dflags slot
     in
     let off_w = (off - delta) `div` (if is32Bit then 4 else 8)
     in case targetClassOfReg platform reg of
            RcInteger   -> MOV (archWordSize is32Bit)
-                              (OpReg reg) (OpAddr (spRel platform off_w))
-           RcDouble    -> GST FF80 reg (spRel platform off_w) {- RcFloat/RcDouble -}
-           RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel platform off_w))
+                              (OpReg reg) (OpAddr (spRel dflags off_w))
+           RcDouble    -> GST FF80 reg (spRel dflags off_w) {- RcFloat/RcDouble -}
+           RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel dflags off_w))
            _         -> panic "X86.mkSpillInstr: no match"
-    where is32Bit = target32Bit platform
+    where platform = targetPlatform dflags
+          is32Bit = target32Bit platform
 
 -- | Make a spill reload instruction.
 x86_mkLoadInstr
-    :: Platform
+    :: DynFlags
     -> Reg      -- register to load
     -> Int      -- current stack delta
     -> Int      -- spill slot to use
     -> Instr
 
-x86_mkLoadInstr platform reg delta slot
-  = let off     = spillSlotToOffset is32Bit slot
+x86_mkLoadInstr dflags reg delta slot
+  = let off     = spillSlotToOffset dflags slot
     in
         let off_w = (off-delta) `div` (if is32Bit then 4 else 8)
         in case targetClassOfReg platform reg of
               RcInteger -> MOV (archWordSize is32Bit)
-                               (OpAddr (spRel platform off_w)) (OpReg reg)
-              RcDouble  -> GLD FF80 (spRel platform off_w) reg {- RcFloat/RcDouble -}
-              RcDoubleSSE -> MOV FF64 (OpAddr (spRel platform off_w)) (OpReg reg)
+                               (OpAddr (spRel dflags off_w)) (OpReg reg)
+              RcDouble  -> GLD FF80 (spRel dflags off_w) reg {- RcFloat/RcDouble -}
+              RcDoubleSSE -> MOV FF64 (OpAddr (spRel dflags off_w)) (OpReg reg)
               _           -> panic "X86.x86_mkLoadInstr"
-    where is32Bit = target32Bit platform
+    where platform = targetPlatform dflags
+          is32Bit = target32Bit platform
 
-spillSlotSize :: Bool -> Int
-spillSlotSize is32Bit = if is32Bit then 12 else 8
+spillSlotSize :: DynFlags -> Int
+spillSlotSize dflags = if is32Bit then 12 else 8
+    where is32Bit = target32Bit (targetPlatform dflags)
 
-maxSpillSlots :: Bool -> Int
-maxSpillSlots is32Bit
-    = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize is32Bit) - 1
+maxSpillSlots :: DynFlags -> Int
+maxSpillSlots dflags
+    = ((rESERVED_C_STACK_BYTES dflags - 64) `div` spillSlotSize dflags) - 1
 
 -- convert a spill slot number to a *byte* offset, with no sign:
 -- decide on a per arch basis whether you are spilling above or below
 -- the C stack pointer.
-spillSlotToOffset :: Bool -> Int -> Int
-spillSlotToOffset is32Bit slot
-   | slot >= 0 && slot < maxSpillSlots is32Bit
-   = 64 + spillSlotSize is32Bit * slot
+spillSlotToOffset :: DynFlags -> Int -> Int
+spillSlotToOffset dflags slot
+   | slot >= 0 && slot < maxSpillSlots dflags
+   = 64 + spillSlotSize dflags * slot
    | otherwise
    = pprPanic "spillSlotToOffset:"
               (   text "invalid spill location: " <> int slot
-              $$  text "maxSpillSlots:          " <> int (maxSpillSlots is32Bit))
+              $$  text "maxSpillSlots:          " <> int (maxSpillSlots dflags))
 
 --------------------------------------------------------------------------------
 
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 6411fb94b1..420da7cc3d 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -34,6 +34,7 @@ import PprBase
 
 import BlockId
 import BasicTypes       (Alignment)
+import DynFlags
 import OldCmm
 import CLabel
 import Unique           ( pprUnique, Uniquable(..) )
@@ -419,12 +420,13 @@ pprSectionHeader seg
 
 
 pprDataItem :: CmmLit -> SDoc
-pprDataItem lit = sdocWithPlatform $ \platform -> pprDataItem' platform lit
+pprDataItem lit = sdocWithDynFlags $ \dflags -> pprDataItem' dflags lit
 
-pprDataItem' :: Platform -> CmmLit -> SDoc
-pprDataItem' platform lit
-  = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
+pprDataItem' :: DynFlags -> CmmLit -> SDoc
+pprDataItem' dflags lit
+  = vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit)
     where
+        platform = targetPlatform dflags
         imm = litToImm lit
 
         -- These seem to be common:
diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs
index 16938a8f15..4eec96f5e1 100644
--- a/compiler/nativeGen/X86/Regs.hs
+++ b/compiler/nativeGen/X86/Regs.hs
@@ -54,11 +54,11 @@ import RegClass
 import OldCmm
 import CmmCallConv
 import CLabel           ( CLabel )
+import DynFlags
 import Outputable
 import Platform
 import FastTypes
 import FastBool
-import Constants
 
 
 -- | regSqueeze_class reg
@@ -195,14 +195,14 @@ addrModeRegs _ = []
 -- applicable, is the same but for the frame pointer.
 
 
-spRel :: Platform
+spRel :: DynFlags
       -> Int -- ^ desired stack offset in words, positive or negative
       -> AddrMode
-spRel platform n
- | target32Bit platform
-    = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt (n * wORD_SIZE))
+spRel dflags n
+ | target32Bit (targetPlatform dflags)
+    = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt (n * wORD_SIZE dflags))
  | otherwise
-    = AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt (n * wORD_SIZE))
+    = AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt (n * wORD_SIZE dflags))
 
 -- The register numbers must fit into 32 bits on x86, so that we can
 -- use a Word32 to represent the set of free registers in the register
@@ -440,8 +440,9 @@ instrClobberedRegs platform
 --
 
 -- All machine registers that are used for argument-passing to Haskell functions
-allHaskellArgRegs :: Platform -> [Reg]
-allHaskellArgRegs platform = [ RegReal r | Just r <- map (globalRegMaybe platform) globalArgRegs ]
+allHaskellArgRegs :: DynFlags -> [Reg]
+allHaskellArgRegs dflags = [ RegReal r | Just r <- map (globalRegMaybe platform) (globalArgRegs dflags) ]
+    where platform = targetPlatform dflags
 
 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
 -- i.e., these are the regs for which we are prepared to allow the