Add "Unregisterised" as a field in the settings file

To explicitly choose whether you want an unregisterised build you now
need to use the "--enable-unregisterised"/"--disable-unregisterised"
configure flags.

compiler/cmm/CmmCallConv.hs

@@ -20,8 +20,9 @@ import PprCmm ()
 
 import Constants
 import qualified Data.List as L
-import StaticFlags (opt_Unregisterised)
+import DynFlags
 import Outputable
+import Platform
 
 -- Calculate the 'GlobalReg' or stack locations for function call
 -- parameters as used by the Cmm calling convention.
@@ -37,22 +38,22 @@ instance Outputable ParamLocation where
 -- | JD: For the new stack story, I want arguments passed on the stack to manifest as
 -- positive offsets in a CallArea, not negative offsets from the stack pointer.
 -- Also, I want byte offsets, not word offsets.
-assignArgumentsPos :: Convention -> (a -> CmmType) -> [a] ->
+assignArgumentsPos :: DynFlags -> Convention -> (a -> CmmType) -> [a] ->
                       [(a, ParamLocation)]
 -- Given a list of arguments, and a function that tells their types,
 -- return a list showing where each argument is passed
-assignArgumentsPos conv arg_ty reps = assignments
+assignArgumentsPos dflags conv arg_ty reps = assignments
     where -- The calling conventions (CgCallConv.hs) are complicated, to say the least
       regs = case (reps, conv) of
-               (_,   NativeNodeCall)   -> getRegsWithNode
-               (_,   NativeDirectCall) -> getRegsWithoutNode
+               (_,   NativeNodeCall)   -> getRegsWithNode dflags
+               (_,   NativeDirectCall) -> getRegsWithoutNode dflags
                ([_], NativeReturn)     -> allRegs
-               (_,   NativeReturn)     -> getRegsWithNode
+               (_,   NativeReturn)     -> getRegsWithNode dflags
                -- GC calling convention *must* put values in registers
                (_,   GC)               -> allRegs
                (_,   PrimOpCall)       -> allRegs
                ([_], PrimOpReturn)     -> allRegs
-               (_,   PrimOpReturn)     -> getRegsWithNode
+               (_,   PrimOpReturn)     -> getRegsWithNode dflags
                (_,   Slow)             -> noRegs
       -- The calling conventions first assign arguments to registers,
       -- then switch to the stack when we first run out of registers
@@ -110,25 +111,34 @@ type AvailRegs = ( [VGcPtr -> GlobalReg]   -- available vanilla regs.
 -- We take these register supplies from the *real* registers, i.e. those
 -- that are guaranteed to map to machine registers.
 
-vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
-vanillaRegNos | opt_Unregisterised = []
-              | otherwise          = regList mAX_Real_Vanilla_REG
-floatRegNos	  | opt_Unregisterised = []
-              | otherwise          = regList mAX_Real_Float_REG
-doubleRegNos  | opt_Unregisterised = []
-              | otherwise          = regList mAX_Real_Double_REG
-longRegNos	  | opt_Unregisterised = []
-              | otherwise          = regList mAX_Real_Long_REG
+vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: DynFlags -> [Int]
+vanillaRegNos dflags
+ | platformUnregisterised (targetPlatform dflags) = []
+ | otherwise                                      = regList mAX_Real_Vanilla_REG
+floatRegNos dflags
+ | platformUnregisterised (targetPlatform dflags) = []
+ | otherwise                                      = regList mAX_Real_Float_REG
+doubleRegNos dflags
+ | platformUnregisterised (targetPlatform dflags) = []
+ | otherwise                                      = regList mAX_Real_Double_REG
+longRegNos dflags
+ | platformUnregisterised (targetPlatform dflags) = []
+ | otherwise                                      = regList mAX_Real_Long_REG
 
 -- 
-getRegsWithoutNode, getRegsWithNode :: AvailRegs
-getRegsWithoutNode =
+getRegsWithoutNode, getRegsWithNode :: DynFlags -> AvailRegs
+getRegsWithoutNode dflags =
   (filter (\r -> r VGcPtr /= node) intRegs,
-   map FloatReg  floatRegNos, map DoubleReg doubleRegNos, map LongReg longRegNos)
-    where intRegs = map VanillaReg vanillaRegNos
-getRegsWithNode =
-  (intRegs, map FloatReg  floatRegNos, map DoubleReg doubleRegNos, map LongReg longRegNos)
-    where intRegs = map VanillaReg vanillaRegNos
+   map FloatReg  (floatRegNos dflags),
+   map DoubleReg (doubleRegNos dflags),
+   map LongReg   (longRegNos dflags))
+    where intRegs = map VanillaReg (vanillaRegNos dflags)
+getRegsWithNode dflags =
+  (intRegs,
+   map FloatReg  (floatRegNos dflags),
+   map DoubleReg (doubleRegNos dflags),
+   map LongReg   (longRegNos dflags))
+    where intRegs = map VanillaReg (vanillaRegNos dflags)
 
 allFloatRegs, allDoubleRegs, allLongRegs :: [GlobalReg]
 allVanillaRegs :: [VGcPtr -> GlobalReg]

compiler/cmm/CmmLayoutStack.hs

@@ -929,7 +929,7 @@ lowerSafeForeignCall dflags block
                   caller_load <*>
                   loadThreadState dflags load_tso load_stack
 
-        (ret_args, regs, copyout) = copyOutOflow NativeReturn Jump (Young succ)
+        (ret_args, regs, copyout) = copyOutOflow dflags NativeReturn Jump (Young succ)
                                            (map (CmmReg . CmmLocal) res)
                                            updfr (0, [])
 

compiler/cmm/MkGraph.hs

@@ -24,6 +24,7 @@ import CmmCallConv (assignArgumentsPos, ParamLocation(..))
 
 
 import Compiler.Hoopl hiding (Unique, (<*>), mkFirst, mkMiddle, mkLast, mkLabel, mkBranch, Shape(..))
+import DynFlags
 import FastString
 import ForeignCall
 import Outputable
@@ -172,31 +173,35 @@ mkStore      :: CmmExpr -> CmmExpr -> CmmAGraph
 mkStore  l r  = mkMiddle $ CmmStore  l r
 
 ---------- Control transfer
-mkJump          :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
-mkJump e actuals updfr_off =
-  lastWithArgs Jump Old NativeNodeCall actuals updfr_off $
+mkJump          :: DynFlags -> CmmExpr -> [CmmActual] -> UpdFrameOffset
+                -> CmmAGraph
+mkJump dflags e actuals updfr_off =
+  lastWithArgs dflags Jump Old NativeNodeCall actuals updfr_off $
     toCall e Nothing updfr_off 0
 
-mkDirectJump    :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
-mkDirectJump e actuals updfr_off =
-  lastWithArgs Jump Old NativeDirectCall actuals updfr_off $
+mkDirectJump    :: DynFlags -> CmmExpr -> [CmmActual] -> UpdFrameOffset
+                -> CmmAGraph
+mkDirectJump dflags e actuals updfr_off =
+  lastWithArgs dflags Jump Old NativeDirectCall actuals updfr_off $
     toCall e Nothing updfr_off 0
 
-mkJumpGC        :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
-mkJumpGC e actuals updfr_off =
-  lastWithArgs Jump Old GC actuals updfr_off $
+mkJumpGC        :: DynFlags -> CmmExpr -> [CmmActual] -> UpdFrameOffset
+                -> CmmAGraph
+mkJumpGC dflags e actuals updfr_off =
+  lastWithArgs dflags Jump Old GC actuals updfr_off $
     toCall e Nothing updfr_off 0
 
-mkForeignJump   :: Convention -> CmmExpr -> [CmmActual] -> UpdFrameOffset
+mkForeignJump   :: DynFlags
+                -> Convention -> CmmExpr -> [CmmActual] -> UpdFrameOffset
                 -> CmmAGraph
-mkForeignJump conv e actuals updfr_off =
-  mkForeignJumpExtra conv e actuals updfr_off noExtraStack
+mkForeignJump dflags conv e actuals updfr_off =
+  mkForeignJumpExtra dflags conv e actuals updfr_off noExtraStack
 
-mkForeignJumpExtra :: Convention -> CmmExpr -> [CmmActual]
+mkForeignJumpExtra :: DynFlags -> Convention -> CmmExpr -> [CmmActual]
                 -> UpdFrameOffset -> (ByteOff, [(CmmExpr, ByteOff)])
                 -> CmmAGraph
-mkForeignJumpExtra conv e actuals updfr_off extra_stack =
-  lastWithArgsAndExtraStack Jump Old conv actuals updfr_off extra_stack $
+mkForeignJumpExtra dflags conv e actuals updfr_off extra_stack =
+  lastWithArgsAndExtraStack dflags Jump Old conv actuals updfr_off extra_stack $
     toCall e Nothing updfr_off 0
 
 mkCbranch       :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
@@ -205,45 +210,47 @@ mkCbranch pred ifso ifnot = mkLast (CmmCondBranch pred ifso ifnot)
 mkSwitch        :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
 mkSwitch e tbl   = mkLast $ CmmSwitch e tbl
 
-mkReturn        :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
-mkReturn e actuals updfr_off =
-  lastWithArgs Ret  Old NativeReturn actuals updfr_off $
+mkReturn        :: DynFlags -> CmmExpr -> [CmmActual] -> UpdFrameOffset
+                -> CmmAGraph
+mkReturn dflags e actuals updfr_off =
+  lastWithArgs dflags Ret  Old NativeReturn actuals updfr_off $
     toCall e Nothing updfr_off 0
 
-mkReturnSimple  :: [CmmActual] -> UpdFrameOffset -> CmmAGraph
-mkReturnSimple actuals updfr_off =
-  mkReturn e actuals updfr_off
+mkReturnSimple  :: DynFlags -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
+mkReturnSimple dflags actuals updfr_off =
+  mkReturn dflags e actuals updfr_off
   where e = CmmLoad (CmmStackSlot Old updfr_off) gcWord
 
 mkBranch        :: BlockId -> CmmAGraph
 mkBranch bid     = mkLast (CmmBranch bid)
 
-mkFinalCall   :: CmmExpr -> CCallConv -> [CmmActual] -> UpdFrameOffset
+mkFinalCall   :: DynFlags
+              -> CmmExpr -> CCallConv -> [CmmActual] -> UpdFrameOffset
               -> CmmAGraph
-mkFinalCall f _ actuals updfr_off =
-  lastWithArgs Call Old NativeDirectCall actuals updfr_off $
+mkFinalCall dflags f _ actuals updfr_off =
+  lastWithArgs dflags Call Old NativeDirectCall actuals updfr_off $
     toCall f Nothing updfr_off 0
 
-mkCallReturnsTo :: CmmExpr -> Convention -> [CmmActual]
+mkCallReturnsTo :: DynFlags -> CmmExpr -> Convention -> [CmmActual]
                 -> BlockId
                 -> ByteOff
                 -> UpdFrameOffset
                 -> (ByteOff, [(CmmExpr,ByteOff)])
                 -> CmmAGraph
-mkCallReturnsTo f callConv actuals ret_lbl ret_off updfr_off extra_stack = do
-  lastWithArgsAndExtraStack Call (Young ret_lbl) callConv actuals
+mkCallReturnsTo dflags f callConv actuals ret_lbl ret_off updfr_off extra_stack = do
+  lastWithArgsAndExtraStack dflags Call (Young ret_lbl) callConv actuals
      updfr_off extra_stack $
        toCall f (Just ret_lbl) updfr_off ret_off
 
 -- Like mkCallReturnsTo, but does not push the return address (it is assumed to be
 -- already on the stack).
-mkJumpReturnsTo :: CmmExpr -> Convention -> [CmmActual]
+mkJumpReturnsTo :: DynFlags -> CmmExpr -> Convention -> [CmmActual]
                 -> BlockId
                 -> ByteOff
                 -> UpdFrameOffset
                 -> CmmAGraph
-mkJumpReturnsTo f callConv actuals ret_lbl ret_off updfr_off  = do
-  lastWithArgs JumpRet (Young ret_lbl) callConv actuals updfr_off $
+mkJumpReturnsTo dflags f callConv actuals ret_lbl ret_off updfr_off  = do
+  lastWithArgs dflags JumpRet (Young ret_lbl) callConv actuals updfr_off $
        toCall f (Just ret_lbl) updfr_off ret_off
 
 mkUnsafeCall  :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmAGraph
@@ -269,25 +276,26 @@ stackStubExpr w = CmmLit (CmmInt 0 w)
 -- the variables in their spill slots.
 -- Therefore, for copying arguments and results, we provide different
 -- functions to pass the arguments in an overflow area and to pass them in spill slots.
-copyInOflow  :: Convention -> Area -> [CmmFormal] -> (Int, CmmAGraph)
+copyInOflow  :: DynFlags -> Convention -> Area -> [CmmFormal]
+             -> (Int, CmmAGraph)
 
-copyInOflow conv area formals = (offset, catAGraphs $ map mkMiddle nodes)
-  where (offset, nodes) = copyIn oneCopyOflowI conv area formals
+copyInOflow dflags conv area formals = (offset, catAGraphs $ map mkMiddle nodes)
+  where (offset, nodes) = copyIn dflags oneCopyOflowI conv area formals
 
 type SlotCopier = Area -> (LocalReg, ByteOff) -> (ByteOff, [CmmNode O O]) ->
                           (ByteOff, [CmmNode O O])
-type CopyIn  = SlotCopier -> Convention -> Area -> [CmmFormal] -> (ByteOff, [CmmNode O O])
+type CopyIn  = DynFlags -> SlotCopier -> Convention -> Area -> [CmmFormal] -> (ByteOff, [CmmNode O O])
 
 -- Return the number of bytes used for copying arguments, as well as the
 -- instructions to copy the arguments.
 copyIn :: CopyIn
-copyIn oflow conv area formals =
+copyIn dflags oflow conv area formals =
   foldr ci (init_offset, []) args'
   where ci (reg, RegisterParam r) (n, ms) =
           (n, CmmAssign (CmmLocal reg) (CmmReg $ CmmGlobal r) : ms)
         ci (r, StackParam off) (n, ms) = oflow area (r, off) (n, ms)
         init_offset = widthInBytes wordWidth -- infotable
-        args  = assignArgumentsPos conv localRegType formals
+        args  = assignArgumentsPos dflags conv localRegType formals
         args' = foldl adjust [] args
           where adjust rst (v, StackParam off) = (v, StackParam (off + init_offset)) : rst
                 adjust rst x@(_, RegisterParam _) = x : rst
@@ -303,7 +311,7 @@ oneCopyOflowI area (reg, off) (n, ms) =
 
 data Transfer = Call | JumpRet | Jump | Ret deriving Eq
 
-copyOutOflow :: Convention -> Transfer -> Area -> [CmmActual]
+copyOutOflow :: DynFlags -> Convention -> Transfer -> Area -> [CmmActual]
              -> UpdFrameOffset
              -> (ByteOff, [(CmmExpr,ByteOff)]) -- extra stack stuff
              -> (Int, [GlobalReg], CmmAGraph)
@@ -317,7 +325,7 @@ copyOutOflow :: Convention -> Transfer -> Area -> [CmmActual]
 -- the info table for return and adjust the offsets of the other
 -- parameters.  If this is a call instruction, we adjust the offsets
 -- of the other parameters.
-copyOutOflow conv transfer area actuals updfr_off
+copyOutOflow dflags conv transfer area actuals updfr_off
   (extra_stack_off, extra_stack_stuff)
   = foldr co (init_offset, [], mkNop) (args' ++ stack_params)
   where 
@@ -347,7 +355,7 @@ copyOutOflow conv transfer area actuals updfr_off
     arg_offset = init_offset + extra_stack_off
 
     args :: [(CmmExpr, ParamLocation)]   -- The argument and where to put it
-    args = assignArgumentsPos conv cmmExprType actuals
+    args = assignArgumentsPos dflags conv cmmExprType actuals
 
     args' = foldl adjust setRA args
       where adjust rst   (v, StackParam off)  = (v, StackParam (off + arg_offset)) : rst
@@ -355,26 +363,27 @@ copyOutOflow conv transfer area actuals updfr_off
 
 
 
-mkCallEntry :: Convention -> [CmmFormal] -> (Int, CmmAGraph)
-mkCallEntry conv formals = copyInOflow conv Old formals
+mkCallEntry :: DynFlags -> Convention -> [CmmFormal] -> (Int, CmmAGraph)
+mkCallEntry dflags conv formals = copyInOflow dflags conv Old formals
 
-lastWithArgs :: Transfer -> Area -> Convention -> [CmmActual]
+lastWithArgs :: DynFlags -> Transfer -> Area -> Convention -> [CmmActual]
              -> UpdFrameOffset
              -> (ByteOff -> [GlobalReg] -> CmmAGraph)
              -> CmmAGraph
-lastWithArgs transfer area conv actuals updfr_off last =
-  lastWithArgsAndExtraStack transfer area conv actuals
+lastWithArgs dflags transfer area conv actuals updfr_off last =
+  lastWithArgsAndExtraStack dflags transfer area conv actuals
                             updfr_off noExtraStack last
 
-lastWithArgsAndExtraStack :: Transfer -> Area -> Convention -> [CmmActual]
+lastWithArgsAndExtraStack :: DynFlags
+             -> Transfer -> Area -> Convention -> [CmmActual]
              -> UpdFrameOffset -> (ByteOff, [(CmmExpr,ByteOff)])
              -> (ByteOff -> [GlobalReg] -> CmmAGraph)
              -> CmmAGraph
-lastWithArgsAndExtraStack transfer area conv actuals updfr_off
+lastWithArgsAndExtraStack dflags transfer area conv actuals updfr_off
                           extra_stack last =
   copies <*> last outArgs regs
  where
-  (outArgs, regs, copies) = copyOutOflow conv transfer area actuals
+  (outArgs, regs, copies) = copyOutOflow dflags conv transfer area actuals
                                updfr_off extra_stack
 
 

compiler/codeGen/CgCallConv.hs

@@ -43,10 +43,10 @@ import Id
 import Name
 import Util
 import DynFlags
-import StaticFlags
 import Module
 import FastString
 import Outputable
+import Platform
 import Data.Bits
 
 -------------------------------------------------------------------------
@@ -255,16 +255,19 @@ getSequelAmode
 -- registers.  This is used for calling special RTS functions and PrimOps
 -- which expect their arguments to always be in the same registers.
 
-assignCallRegs, assignPrimOpCallRegs, assignReturnRegs
-        :: [(CgRep,a)]          -- Arg or result values to assign
-        -> ([(a, GlobalReg)],   -- Register assignment in same order
-                                -- for *initial segment of* input list
-                                --   (but reversed; doesn't matter)
-                                -- VoidRep args do not appear here
-            [(CgRep,a)])        -- Leftover arg or result values
+type AssignRegs a = [(CgRep,a)]          -- Arg or result values to assign
+                 -> ([(a, GlobalReg)],   -- Register assignment in same order
+                                         -- for *initial segment of* input list
+                                         --   (but reversed; doesn't matter)
+                                         -- VoidRep args do not appear here
+                     [(CgRep,a)])        -- Leftover arg or result values
 
-assignCallRegs args
-  = assign_regs args (mkRegTbl [node])
+assignCallRegs       :: DynFlags -> AssignRegs a
+assignPrimOpCallRegs ::             AssignRegs a
+assignReturnRegs     :: DynFlags -> AssignRegs a
+
+assignCallRegs dflags args
+  = assign_regs args (mkRegTbl dflags [node])
         -- The entry convention for a function closure
         -- never uses Node for argument passing; instead
         -- Node points to the function closure itself
@@ -273,7 +276,7 @@ assignPrimOpCallRegs args
  = assign_regs args (mkRegTbl_allRegs [])
         -- For primops, *all* arguments must be passed in registers
 
-assignReturnRegs args
+assignReturnRegs dflags args
  -- when we have a single non-void component to return, use the normal
  -- unpointed return convention.  This make various things simpler: it
  -- means we can assume a consistent convention for IO, which is useful
@@ -285,7 +288,7 @@ assignReturnRegs args
  | [(rep,arg)] <- non_void_args, CmmGlobal r <- dataReturnConvPrim rep
     = ([(arg, r)], [])
  | otherwise
-    = assign_regs args (mkRegTbl [])
+    = assign_regs args (mkRegTbl dflags [])
         -- For returning unboxed tuples etc,
         -- we use all regs
  where
@@ -327,24 +330,28 @@ assign_reg _         _                  = Nothing
 -- We take these register supplies from the *real* registers, i.e. those
 -- that are guaranteed to map to machine registers.
 
-useVanillaRegs :: Int
-useVanillaRegs | opt_Unregisterised = 0
-               | otherwise          = mAX_Real_Vanilla_REG
-useFloatRegs :: Int
-useFloatRegs   | opt_Unregisterised = 0
-               | otherwise          = mAX_Real_Float_REG
-useDoubleRegs :: Int
-useDoubleRegs  | opt_Unregisterised = 0
-               | otherwise          = mAX_Real_Double_REG
-useLongRegs :: Int
-useLongRegs    | opt_Unregisterised = 0
-               | otherwise          = mAX_Real_Long_REG
-
-vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
-vanillaRegNos    = regList useVanillaRegs
-floatRegNos      = regList useFloatRegs
-doubleRegNos     = regList useDoubleRegs
-longRegNos       = regList useLongRegs
+useVanillaRegs :: DynFlags -> Int
+useVanillaRegs dflags
+ | platformUnregisterised (targetPlatform dflags) = 0
+ | otherwise                                      = mAX_Real_Vanilla_REG
+useFloatRegs :: DynFlags -> Int
+useFloatRegs dflags
+ | platformUnregisterised (targetPlatform dflags) = 0
+ | otherwise                                      = mAX_Real_Float_REG
+useDoubleRegs :: DynFlags -> Int
+useDoubleRegs dflags
+ | platformUnregisterised (targetPlatform dflags) = 0
+ | otherwise                                      = mAX_Real_Double_REG
+useLongRegs :: DynFlags -> Int
+useLongRegs dflags
+ | platformUnregisterised (targetPlatform dflags) = 0
+ | otherwise                                      = mAX_Real_Long_REG
+
+vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: DynFlags -> [Int]
+vanillaRegNos dflags = regList $ useVanillaRegs dflags
+floatRegNos   dflags = regList $ useFloatRegs   dflags
+doubleRegNos  dflags = regList $ useDoubleRegs  dflags
+longRegNos    dflags = regList $ useLongRegs    dflags
 
 allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
 allVanillaRegNos = regList mAX_Vanilla_REG
@@ -361,9 +368,12 @@ type AvailRegs = ( [Int]   -- available vanilla regs.
                  , [Int]   -- longs (int64 and word64)
                  )
 
-mkRegTbl :: [GlobalReg] -> AvailRegs
-mkRegTbl regs_in_use
-  = mkRegTbl' regs_in_use vanillaRegNos floatRegNos doubleRegNos longRegNos
+mkRegTbl :: DynFlags -> [GlobalReg] -> AvailRegs
+mkRegTbl dflags regs_in_use
+  = mkRegTbl' regs_in_use (vanillaRegNos dflags)
+                          (floatRegNos   dflags)
+                          (doubleRegNos  dflags)
+                          (longRegNos    dflags)
 
 mkRegTbl_allRegs :: [GlobalReg] -> AvailRegs
 mkRegTbl_allRegs regs_in_use

compiler/codeGen/CgClosure.lhs

@@ -273,10 +273,12 @@ Node points to closure is available. -- HWL
 \begin{code}
 closureCodeBody _binder_info cl_info cc args body 
   = ASSERT( length args > 0 )
-  do { 	-- Get the current virtual Sp (it might not be zero, 
+  do {
+    dflags <- getDynFlags
+        -- Get the current virtual Sp (it might not be zero, 
 	-- eg. if we're compiling a let-no-escape).
-    vSp <- getVirtSp
-  ; let (reg_args, other_args) = assignCallRegs (addIdReps args)
+  ; vSp <- getVirtSp
+  ; let (reg_args, other_args) = assignCallRegs dflags (addIdReps args)
 	(sp_top, stk_args)     = mkVirtStkOffsets vSp other_args
 
 	-- Allocate the global ticky counter

compiler/codeGen/CgCon.lhs

@@ -271,11 +271,13 @@ bindUnboxedTupleComponents
 
 bindUnboxedTupleComponents args
  =  do  {
-          vsp <- getVirtSp
+          dflags <- getDynFlags
+
+        ; vsp <- getVirtSp
         ; rsp <- getRealSp
 
            -- Assign as many components as possible to registers
-        ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
+        ; let (reg_args, stk_args) = assignReturnRegs dflags (addIdReps args)
 
                 -- Separate the rest of the args into pointers and non-pointers
               (ptr_args, nptr_args) = separateByPtrFollowness stk_args

compiler/codeGen/CgTailCall.lhs

@@ -255,7 +255,7 @@ directCall sp lbl args extra_args live_node assts = do
   dflags <- getDynFlags
   let
 	-- First chunk of args go in registers
-	(reg_arg_amodes, stk_args) = assignCallRegs args
+	(reg_arg_amodes, stk_args) = assignCallRegs dflags args
      
 	-- Any "extra" arguments are placed in frames on the
 	-- stack after the other arguments.
@@ -354,7 +354,8 @@ pushUnboxedTuple :: VirtualSpOffset		-- Sp at which to start pushing
 pushUnboxedTuple sp [] 
   = return (sp, noStmts, [])
 pushUnboxedTuple sp amodes
-  = do	{ let	(reg_arg_amodes, stk_arg_amodes) = assignReturnRegs amodes
+  = do	{ dflags <- getDynFlags
+        ; let	(reg_arg_amodes, stk_arg_amodes) = assignReturnRegs dflags amodes
                 live_regs = map snd reg_arg_amodes
 	
 		-- separate the rest of the args into pointers and non-pointers

compiler/codeGen/StgCmmBind.hs

@@ -470,7 +470,8 @@ mkSlowEntryCode cl_info arg_regs -- function closure is already in `Node'
        let slow_lbl = closureSlowEntryLabel  cl_info
            fast_lbl = closureLocalEntryLabel dflags cl_info
            -- mkDirectJump does not clobber `Node' containing function closure
-           jump = mkDirectJump (mkLblExpr fast_lbl)
+           jump = mkDirectJump dflags
+                               (mkLblExpr fast_lbl)
                                (map (CmmReg . CmmLocal) arg_regs)
                                initUpdFrameOff
        emitProcWithConvention Slow Nothing slow_lbl arg_regs jump
@@ -680,7 +681,7 @@ link_caf _is_upd = do
         -- assuming lots of things, like the stack pointer hasn't
         -- moved since we entered the CAF.
        (let target = entryCode dflags (closureInfoPtr (CmmReg nodeReg)) in
-        mkJump target [] updfr)
+        mkJump dflags target [] updfr)
 
   ; return hp_rel }
 

compiler/codeGen/StgCmmExpr.hs

@@ -674,7 +674,7 @@ emitEnter fun = do
       -- test, just generating an enter.
       Return _ -> do
         { let entry = entryCode dflags $ closureInfoPtr $ CmmReg nodeReg
-        ; emit $ mkForeignJump NativeNodeCall entry
+        ; emit $ mkForeignJump dflags NativeNodeCall entry
                     [cmmUntag fun] updfr_off
         ; return AssignedDirectly
         }
@@ -706,11 +706,11 @@ emitEnter fun = do
       --
       AssignTo res_regs _ -> do
        { lret <- newLabelC
-       ; let (off, copyin) = copyInOflow NativeReturn (Young lret) res_regs
+       ; let (off, copyin) = copyInOflow dflags NativeReturn (Young lret) res_regs
        ; lcall <- newLabelC
        ; updfr_off <- getUpdFrameOff
        ; let area = Young lret
-       ; let (outArgs, regs, copyout) = copyOutOflow NativeNodeCall Call area
+       ; let (outArgs, regs, copyout) = copyOutOflow dflags NativeNodeCall Call area
                                           [fun] updfr_off (0,[])
          -- refer to fun via nodeReg after the copyout, to avoid having
          -- both live simultaneously; this sometimes enables fun to be

compiler/codeGen/StgCmmForeign.hs

@@ -214,10 +214,11 @@ emitForeignCall safety results target args _ret
     return AssignedDirectly
 
   | otherwise = do
+    dflags <- getDynFlags
     updfr_off <- getUpdFrameOff
     temp_target <- load_target_into_temp target
     k <- newLabelC
-    let (off, copyout) = copyInOflow NativeReturn (Young k) results
+    let (off, copyout) = copyInOflow dflags NativeReturn (Young k) results
        -- see Note [safe foreign call convention]
     emit $
            (    mkStore (CmmStackSlot (Young k) (widthInBytes wordWidth))

compiler/codeGen/StgCmmHeap.hs

@@ -348,7 +348,8 @@ entryHeapCheck :: ClosureInfo
                -> FCode ()
 
 entryHeapCheck cl_info offset nodeSet arity args code
-  = do let is_thunk = arity == 0
+  = do dflags <- getDynFlags
+       let is_thunk = arity == 0
            is_fastf = case closureFunInfo cl_info of
                            Just (_, ArgGen _) -> False
                            _otherwise         -> True
@@ -365,9 +366,9 @@ entryHeapCheck cl_info offset nodeSet arity args code
               Function (slow): Set R1 = node, call generic_gc -}
            gc_call upd = setN <*> gc_lbl upd
            gc_lbl upd
-               | is_thunk  = mkDirectJump (CmmReg $ CmmGlobal GCEnter1) [] sp
-               | is_fastf  = mkDirectJump (CmmReg $ CmmGlobal GCFun) [] sp
-               | otherwise = mkForeignJump Slow (CmmReg $ CmmGlobal GCFun) args' upd
+               | is_thunk  = mkDirectJump dflags (CmmReg $ CmmGlobal GCEnter1) [] sp
+               | is_fastf  = mkDirectJump dflags (CmmReg $ CmmGlobal GCFun) [] sp
+               | otherwise = mkForeignJump dflags Slow (CmmReg $ CmmGlobal GCFun) args' upd
                where sp = max offset upd
            {- DT (12/08/10) This is a little fishy, mainly the sp fix up amount.
             - This is since the ncg inserts spills before the stack/heap check.
@@ -447,8 +448,9 @@ altHeapCheck regs code
   = case cannedGCEntryPoint regs of
       Nothing -> genericGC code
       Just gc -> do
+        dflags <- getDynFlags
         lret <- newLabelC
-        let (off, copyin) = copyInOflow NativeReturn (Young lret) regs
+        let (off, copyin) = copyInOflow dflags NativeReturn (Young lret) regs
         lcont <- newLabelC
         emitOutOfLine lret (copyin <*> mkBranch lcont)
         emitLabel lcont
@@ -464,15 +466,16 @@ cannedGCReturnsTo :: Bool -> CmmExpr -> [LocalReg] -> Label -> ByteOff
                   -> FCode a
                   -> FCode a
 cannedGCReturnsTo cont_on_stack gc regs lret off code
-  = do updfr_sz <- getUpdFrameOff
-       heapCheck False (gc_call gc updfr_sz) code
+  = do dflags <- getDynFlags
+       updfr_sz <- getUpdFrameOff
+       heapCheck False (gc_call dflags gc updfr_sz) code
   where
     reg_exprs = map (CmmReg . CmmLocal) regs
       -- Note [stg_gc arguments]
 
-    gc_call label sp
-      | cont_on_stack = mkJumpReturnsTo label GC reg_exprs lret off sp
-      | otherwise     = mkCallReturnsTo label GC reg_exprs lret off sp (0,[])
+    gc_call dflags label sp
+      | cont_on_stack = mkJumpReturnsTo dflags label GC reg_exprs lret off sp
+      | otherwise     = mkCallReturnsTo dflags label GC reg_exprs lret off sp (0,[])
 
 genericGC :: FCode a -> FCode a
 genericGC code

compiler/codeGen/StgCmmLayout.hs

@@ -78,12 +78,13 @@ import FastString
 --
 emitReturn :: [CmmExpr] -> FCode ReturnKind
 emitReturn results
-  = do { sequel    <- getSequel;
+  = do { dflags    <- getDynFlags
+       ; sequel    <- getSequel
        ; updfr_off <- getUpdFrameOff
        ; case sequel of
            Return _ ->
              do { adjustHpBackwards
-                ; emit (mkReturnSimple results updfr_off) }
+                ; emit (mkReturnSimple dflags results updfr_off) }
            AssignTo regs adjust ->
              do { if adjust then adjustHpBackwards else return ()
                 ; emitMultiAssign  regs results }
@@ -109,18 +110,19 @@ emitCallWithExtraStack
    :: (Convention, Convention) -> CmmExpr -> [CmmExpr]
    -> (ByteOff, [(CmmExpr,ByteOff)]) -> FCode ReturnKind
 emitCallWithExtraStack (callConv, retConv) fun args extra_stack