Pass DynFlags down to wordWidth
authorIan Lynagh <ian@well-typed.com>
Wed, 12 Sep 2012 15:32:34 +0000 (16:32 +0100)
committerIan Lynagh <ian@well-typed.com>
Wed, 12 Sep 2012 15:32:34 +0000 (16:32 +0100)
41 files changed:
compiler/cmm/CmmBuildInfoTables.hs
compiler/cmm/CmmCallConv.hs
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmLayoutStack.hs
compiler/cmm/CmmLint.hs
compiler/cmm/CmmMachOp.hs
compiler/cmm/CmmOpt.hs
compiler/cmm/CmmParse.y
compiler/cmm/CmmPipeline.hs
compiler/cmm/CmmRewriteAssignments.hs
compiler/cmm/CmmType.hs
compiler/cmm/CmmUtils.hs
compiler/cmm/MkGraph.hs
compiler/cmm/OldCmmLint.hs
compiler/cmm/PprC.hs
compiler/cmm/PprCmmExpr.hs
compiler/codeGen/CgClosure.lhs
compiler/codeGen/CgCon.lhs
compiler/codeGen/CgForeignCall.hs
compiler/codeGen/CgHeapery.lhs
compiler/codeGen/CgInfoTbls.hs
compiler/codeGen/CgPrimOp.hs
compiler/codeGen/CgProf.hs
compiler/codeGen/CgTailCall.lhs
compiler/codeGen/CgTicky.hs
compiler/codeGen/CgUtils.hs
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmExpr.hs
compiler/codeGen/StgCmmForeign.hs
compiler/codeGen/StgCmmHeap.hs
compiler/codeGen/StgCmmLayout.hs
compiler/codeGen/StgCmmMonad.hs
compiler/codeGen/StgCmmPrim.hs
compiler/codeGen/StgCmmProf.hs
compiler/codeGen/StgCmmTicky.hs
compiler/codeGen/StgCmmUtils.hs
compiler/nativeGen/AsmCodeGen.lhs
compiler/nativeGen/PIC.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/SPARC/CodeGen.hs
compiler/nativeGen/X86/CodeGen.hs

index 0cfcc0d..7d24361 100644 (file)
@@ -33,6 +33,7 @@ import CLabel
 import Cmm
 import CmmUtils
 import Data.List
+import DynFlags
 import Maybes
 import Module
 import Outputable
@@ -166,17 +167,17 @@ srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
 -- in the SRT. Then, if the number of CAFs is small enough to fit in a bitmap,
 -- we make sure they're all close enough to the bottom of the table that the
 -- bitmap will be able to cover all of them.
-buildSRT :: TopSRT -> CAFSet -> UniqSM (TopSRT, Maybe CmmDecl, C_SRT)
-buildSRT topSRT cafs =
+buildSRT :: DynFlags -> TopSRT -> CAFSet -> UniqSM (TopSRT, Maybe CmmDecl, C_SRT)
+buildSRT dflags topSRT cafs =
   do let
          -- For each label referring to a function f without a static closure,
          -- replace it with the CAFs that are reachable from f.
          sub_srt topSRT localCafs =
            let cafs = Set.elems localCafs
                mkSRT topSRT =
-                 do localSRTs <- procpointSRT (lbl topSRT) (elt_map topSRT) cafs
+                 do localSRTs <- procpointSRT dflags (lbl topSRT) (elt_map topSRT) cafs
                     return (topSRT, localSRTs)
-           in if length cafs > maxBmpSize then
+           in if length cafs > maxBmpSize dflags then
                 mkSRT (foldl add_if_missing topSRT cafs)
               else -- make sure all the cafs are near the bottom of the srt
                 mkSRT (add_if_too_far topSRT cafs)
@@ -196,7 +197,7 @@ buildSRT topSRT cafs =
                add srt [] = srt
                add srt@(TopSRT {next_elt = next}) (caf : rst) =
                  case cafOffset srt caf of
-                   Just ix -> if next - ix > maxBmpSize then
+                   Just ix -> if next - ix > maxBmpSize dflags then
                                 add (addCAF caf srt) rst
                               else srt
                    Nothing -> add (addCAF caf srt) rst
@@ -206,12 +207,12 @@ buildSRT topSRT cafs =
 
 -- Construct an SRT bitmap.
 -- Adapted from simpleStg/SRT.lhs, which expects Id's.
-procpointSRT :: CLabel -> Map CLabel Int -> [CLabel] ->
+procpointSRT :: DynFlags -> CLabel -> Map CLabel Int -> [CLabel] ->
                 UniqSM (Maybe CmmDecl, C_SRT)
-procpointSRT _ _ [] =
+procpointSRT _ _ [] =
  return (Nothing, NoC_SRT)
-procpointSRT top_srt top_table entries =
- do (top, srt) <- bitmap `seq` to_SRT top_srt offset len bitmap
+procpointSRT dflags top_srt top_table entries =
+ do (top, srt) <- bitmap `seq` to_SRT dflags top_srt offset len bitmap
     return (top, srt)
   where
     ints = map (expectJust "constructSRT" . flip Map.lookup top_table) entries
@@ -221,20 +222,20 @@ procpointSRT top_srt top_table entries =
     len = P.last bitmap_entries + 1
     bitmap = intsToBitmap len bitmap_entries
 
-maxBmpSize :: Int
-maxBmpSize = widthInBits wordWidth `div` 2
+maxBmpSize :: DynFlags -> Int
+maxBmpSize dflags = widthInBits (wordWidth dflags) `div` 2
 
 -- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT.
-to_SRT :: CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT)
-to_SRT top_srt off len bmp
-  | len > maxBmpSize || bmp == [fromIntegral srt_escape]
+to_SRT :: DynFlags -> CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT)
+to_SRT dflags top_srt off len bmp
+  | len > maxBmpSize dflags || bmp == [fromIntegral srt_escape]
   = do id <- getUniqueM
        let srt_desc_lbl = mkLargeSRTLabel id
            tbl = CmmData RelocatableReadOnlyData $
                    Statics srt_desc_lbl $ map CmmStaticLit
                      ( cmmLabelOffW top_srt off
-                     : mkWordCLit (fromIntegral len)
-                     : map mkWordCLit bmp)
+                     : mkWordCLit dflags (fromIntegral len)
+                     : map (mkWordCLit dflags) bmp)
        return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape)
   | otherwise
   = return (Nothing, C_SRT top_srt off (fromIntegral (head bmp)))
@@ -318,11 +319,12 @@ flattenCAFSets cpsdecls = zipWith (bundle flatmap) zipped localCAFs
      localCAFs = unzipWith localCAFInfo zipped
      flatmap   = mkTopCAFInfo localCAFs -- transitive closure of localCAFs
 
-doSRTs :: TopSRT
+doSRTs :: DynFlags
+       -> TopSRT
        -> [(CAFEnv, [CmmDecl])]
        -> IO (TopSRT, [CmmDecl])
 
-doSRTs topSRT tops
+doSRTs dflags topSRT tops
   = do
      let caf_decls = flattenCAFSets tops
      us <- mkSplitUniqSupply 'u'
@@ -330,19 +332,19 @@ doSRTs topSRT tops
      return (topSRT', reverse gs' {- Note [reverse gs] -})
   where
     setSRT (topSRT, rst) (caf_map, decl@(CmmProc{})) = do
-       (topSRT, srt_tables, srt_env) <- buildSRTs topSRT caf_map
+       (topSRT, srt_tables, srt_env) <- buildSRTs dflags topSRT caf_map
        let decl' = updInfoSRTs srt_env decl
        return (topSRT, decl': srt_tables ++ rst)
     setSRT (topSRT, rst) (_, decl) =
       return (topSRT, decl : rst)
 
-buildSRTs :: TopSRT -> BlockEnv CAFSet
+buildSRTs :: DynFlags -> TopSRT -> BlockEnv CAFSet
           -> UniqSM (TopSRT, [CmmDecl], BlockEnv C_SRT)
-buildSRTs top_srt caf_map
+buildSRTs dflags top_srt caf_map
   = foldM doOne (top_srt, [], mapEmpty) (mapToList caf_map)
   where
   doOne (top_srt, decls, srt_env) (l, cafs)
-    = do (top_srt, mb_decl, srt) <- buildSRT top_srt cafs
+    = do (top_srt, mb_decl, srt) <- buildSRT dflags top_srt cafs
          return ( top_srt, maybeToList mb_decl ++ decls
                 , mapInsert l srt srt_env )
 
index dd1b6af..5e75e61 100644 (file)
@@ -78,9 +78,9 @@ assignArgumentsPos dflags conv arg_ty reps = assignments
                         _ -> (assts, (r:rs))
               int = case (w, regs) of
                       (W128, _) -> panic "W128 unsupported register type"
-                      (_, (v:vs, fs, ds, ls)) | widthInBits w <= widthInBits wordWidth
+                      (_, (v:vs, fs, ds, ls)) | widthInBits w <= widthInBits (wordWidth dflags)
                           -> k (RegisterParam (v gcp), (vs, fs, ds, ls))
-                      (_, (vs, fs, ds, l:ls)) | widthInBits w > widthInBits wordWidth
+                      (_, (vs, fs, ds, l:ls)) | widthInBits w > widthInBits (wordWidth dflags)
                           -> k (RegisterParam l, (vs, fs, ds, ls))
                       _   -> (assts, (r:rs))
               k (asst, regs') = assign_regs ((r, asst) : assts) rs regs'
index 29affae..3bbbb5e 100644 (file)
@@ -114,8 +114,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
               -- Use a zero place-holder in place of the
               -- entry-label in the info table
               return (top_decls ++
-                      [mkRODataLits info_lbl (zeroCLit : rel_std_info ++
-                                                         rel_extra_bits)])
+                      [mkRODataLits info_lbl (zeroCLit dflags : rel_std_info ++
+                                                                rel_extra_bits)])
           _nonempty ->
              -- Separately emit info table (with the function entry
              -- point as first entry) and the entry code
@@ -172,9 +172,9 @@ mkInfoTableContents dflags
     -- (which in turn came from a handwritten .cmm file)
 
   | StackRep frame <- smrep
-  = do { (prof_lits, prof_data) <- mkProfLits prof
+  = do { (prof_lits, prof_data) <- mkProfLits dflags prof
        ; let (srt_label, srt_bitmap) = mkSRTLit srt
-       ; (liveness_lit, liveness_data) <- mkLivenessBits frame
+       ; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame
        ; let
              std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
              rts_tag | Just tag <- mb_rts_tag = tag
@@ -184,8 +184,8 @@ mkInfoTableContents dflags
        ; return (prof_data ++ liveness_data, (std_info, srt_label)) }
 
   | HeapRep _ ptrs nonptrs closure_type <- smrep
-  = do { let layout  = packHalfWordsCLit ptrs nonptrs
-       ; (prof_lits, prof_data) <- mkProfLits prof
+  = do { let layout  = packHalfWordsCLit dflags ptrs nonptrs
+       ; (prof_lits, prof_data) <- mkProfLits dflags prof
        ; let (srt_label, srt_bitmap) = mkSRTLit srt
        ; (mb_srt_field, mb_layout, extra_bits, ct_data)
                                 <- mk_pieces closure_type srt_label
@@ -208,24 +208,24 @@ mkInfoTableContents dflags
       = return (Nothing, Nothing, srt_label, [])
 
     mk_pieces (ThunkSelector offset) _no_srt
-      = return (Just 0, Just (mkWordCLit offset), [], [])
+      = return (Just 0, Just (mkWordCLit dflags offset), [], [])
          -- Layout known (one free var); we use the layout field for offset
 
     mk_pieces (Fun arity (ArgSpec fun_type)) srt_label 
-      = do { let extra_bits = packHalfWordsCLit fun_type arity : srt_label
+      = do { let extra_bits = packHalfWordsCLit dflags fun_type arity : srt_label
            ; return (Nothing, Nothing,  extra_bits, []) }
 
     mk_pieces (Fun arity (ArgGen arg_bits)) srt_label
-      = do { (liveness_lit, liveness_data) <- mkLivenessBits arg_bits
+      = do { (liveness_lit, liveness_data) <- mkLivenessBits dflags arg_bits
            ; let fun_type | null liveness_data = aRG_GEN
                           | otherwise          = aRG_GEN_BIG
-                 extra_bits = [ packHalfWordsCLit fun_type arity
+                 extra_bits = [ packHalfWordsCLit dflags fun_type arity
                               , srt_lit, liveness_lit, slow_entry ]
            ; return (Nothing, Nothing, extra_bits, liveness_data) }
       where
         slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
         srt_lit = case srt_label of
-                    []          -> mkIntCLit 0
+                    []          -> mkIntCLit dflags 0
                     (lit:_rest) -> ASSERT( null _rest ) lit
 
     mk_pieces BlackHole _ = panic "mk_pieces: BlackHole"
@@ -297,12 +297,12 @@ makeRelativeRefTo _ _ lit = lit
 -- The head of the stack layout is the top of the stack and
 -- the least-significant bit.
 
-mkLivenessBits :: Liveness -> UniqSM (CmmLit, [RawCmmDecl])
+mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
               -- ^ Returns:
               --   1. The bitmap (literal value or label)
               --   2. Large bitmap CmmData if needed
 
-mkLivenessBits liveness
+mkLivenessBits dflags liveness
   | n_bits > mAX_SMALL_BITMAP_SIZE    -- does not fit in one word
   = do { uniq <- getUniqueUs
        ; let bitmap_lbl = mkBitmapLabel uniq
@@ -310,7 +310,7 @@ mkLivenessBits liveness
                  [mkRODataLits bitmap_lbl lits]) }
 
   | otherwise -- Fits in one word
-  = return (mkWordCLit bitmap_word, [])
+  = return (mkWordCLit dflags bitmap_word, [])
   where
     n_bits = length liveness
 
@@ -324,7 +324,7 @@ mkLivenessBits liveness
     bitmap_word = fromIntegral n_bits
               .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
 
-    lits = mkWordCLit (fromIntegral n_bits) : map mkWordCLit bitmap
+    lits = mkWordCLit dflags (fromIntegral n_bits) : map (mkWordCLit dflags) bitmap
       -- The first word is the size.  The structure must match
       -- StgLargeBitmap in includes/rts/storage/InfoTable.h
 
@@ -361,7 +361,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit
        | dopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
        | otherwise = []
 
-    type_lit = packHalfWordsCLit cl_type srt_len
+    type_lit = packHalfWordsCLit dflags cl_type srt_len
 
 -------------------------------------------------------------------------
 --
@@ -369,9 +369,9 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit
 --
 -------------------------------------------------------------------------
 
-mkProfLits :: ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
-mkProfLits NoProfilingInfo       = return ((zeroCLit, zeroCLit), [])
-mkProfLits (ProfilingInfo td cd)
+mkProfLits :: DynFlags -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
+mkProfLits dflags NoProfilingInfo       = return ((zeroCLit dflags, zeroCLit dflags), [])
+mkProfLits (ProfilingInfo td cd)
   = do { (td_lit, td_decl) <- newStringLit td
        ; (cd_lit, cd_decl) <- newStringLit cd
        ; return ((td_lit,cd_lit), [td_decl,cd_decl]) }
index 0ddbfb6..ea9a4bb 100644 (file)
@@ -776,12 +776,12 @@ arguments.
 areaToSp :: DynFlags -> ByteOff -> ByteOff -> (Area -> StackLoc) -> CmmExpr -> CmmExpr
 areaToSp dflags sp_old _sp_hwm area_off (CmmStackSlot area n) =
   cmmOffset dflags (CmmReg spReg) (sp_old - area_off area - n)
-areaToSp _ _ sp_hwm _ (CmmLit CmmHighStackMark) = mkIntExpr sp_hwm
-areaToSp _ _ _ _ (CmmMachOp (MO_U_Lt _)  -- Note [null stack check]
-                      [CmmMachOp (MO_Sub _)
-                              [ CmmReg (CmmGlobal Sp)
-                              , CmmLit (CmmInt 0 _)],
-                       CmmReg (CmmGlobal SpLim)]) = zeroExpr
+areaToSp dflags _ sp_hwm _ (CmmLit CmmHighStackMark) = mkIntExpr dflags sp_hwm
+areaToSp dflags _ _ _ (CmmMachOp (MO_U_Lt _)  -- Note [null stack check]
+                          [CmmMachOp (MO_Sub _)
+                                  [ CmmReg (CmmGlobal Sp)
+                                  , CmmLit (CmmInt 0 _)],
+                           CmmReg (CmmGlobal SpLim)]) = zeroExpr dflags
 areaToSp _ _ _ _ other = other
 
 -- -----------------------------------------------------------------------------
@@ -920,7 +920,7 @@ lowerSafeForeignCall dflags block
     load_stack <- newTemp (gcWord dflags)
     let suspend = saveThreadState dflags <*>
                   caller_save <*>
-                  mkMiddle (callSuspendThread id intrbl)
+                  mkMiddle (callSuspendThread dflags id intrbl)
         midCall = mkUnsafeCall tgt res args
         resume  = mkMiddle (callResumeThread new_base id) <*>
                   -- Assign the result to BaseReg: we
@@ -941,7 +941,7 @@ lowerSafeForeignCall dflags block
         jump = CmmCall { cml_target    = CmmLoad (CmmReg spReg) (bWord dflags)
                        , cml_cont      = Just succ
                        , cml_args_regs = regs
-                       , cml_args      = widthInBytes wordWidth
+                       , cml_args      = widthInBytes (wordWidth dflags)
                        , cml_ret_args  = ret_args
                        , cml_ret_off   = updfr }
 
@@ -966,12 +966,12 @@ foreignLbl name = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
 newTemp :: CmmType -> UniqSM LocalReg
 newTemp rep = getUniqueM >>= \u -> return (LocalReg u rep)
 
-callSuspendThread :: LocalReg -> Bool -> CmmNode O O
-callSuspendThread id intrbl =
+callSuspendThread :: DynFlags -> LocalReg -> Bool -> CmmNode O O
+callSuspendThread dflags id intrbl =
   CmmUnsafeForeignCall
        (ForeignTarget (foreignLbl (fsLit "suspendThread"))
              (ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint]))
-       [id] [CmmReg (CmmGlobal BaseReg), mkIntExpr (fromEnum intrbl)]
+       [id] [CmmReg (CmmGlobal BaseReg), mkIntExpr dflags (fromEnum intrbl)]
 
 callResumeThread :: LocalReg -> LocalReg -> CmmNode O O
 callResumeThread new_base id =
index 53238ed..0afe2a3 100644 (file)
@@ -88,9 +88,9 @@ lintCmmExpr (CmmLoad expr rep) = do
 lintCmmExpr expr@(CmmMachOp op args) = do
   dflags <- getDynFlags
   tys <- mapM lintCmmExpr args
-  if map (typeWidth . cmmExprType dflags) args == machOpArgReps op
+  if map (typeWidth . cmmExprType dflags) args == machOpArgReps dflags op
         then cmmCheckMachOp op args tys
-        else cmmLintMachOpErr expr (map (cmmExprType dflags) args) (machOpArgReps op)
+        else cmmLintMachOpErr expr (map (cmmExprType dflags) args) (machOpArgReps dflags op)
 lintCmmExpr (CmmRegOff reg offset)
   = do dflags <- getDynFlags
        let rep = typeWidth (cmmRegType dflags reg)
@@ -158,9 +158,10 @@ lintCmmLast labels node = case node of
   CmmBranch id -> checkTarget id
 
   CmmCondBranch e t f -> do
+            dflags <- getDynFlags
             mapM_ checkTarget [t,f]
             _ <- lintCmmExpr e
-            checkCond e
+            checkCond dflags e
 
   CmmSwitch e branches -> do
             dflags <- getDynFlags
@@ -190,10 +191,10 @@ lintTarget (ForeignTarget e _) = lintCmmExpr e >> return ()
 lintTarget (PrimTarget {})     = return ()
 
 
-checkCond :: CmmExpr -> CmmLint ()
-checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
-checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
-checkCond expr
+checkCond :: DynFlags -> CmmExpr -> CmmLint ()
+checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
+checkCond dflags (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth dflags = return () -- constant values
+checkCond expr
     = cmmLintErr (hang (text "expression is not a conditional:") 2
                          (ppr expr))
 
index 6e152c5..520c7e7 100644 (file)
@@ -123,59 +123,62 @@ mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot
     , mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe
     , mo_wordULe, mo_wordUGt, mo_wordULt
     , mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr
-    , mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
     , mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord, mo_u_32ToWord, mo_s_32ToWord
-    , mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64
+    , mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64
+    :: DynFlags -> MachOp
+
+mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
+    , mo_32To8, mo_32To16
     :: MachOp
 
-mo_wordAdd      = MO_Add wordWidth
-mo_wordSub      = MO_Sub wordWidth
-mo_wordEq       = MO_Eq  wordWidth
-mo_wordNe       = MO_Ne  wordWidth
-mo_wordMul      = MO_Mul wordWidth
-mo_wordSQuot    = MO_S_Quot wordWidth
-mo_wordSRem     = MO_S_Rem wordWidth
-mo_wordSNeg     = MO_S_Neg wordWidth
-mo_wordUQuot    = MO_U_Quot wordWidth
-mo_wordURem     = MO_U_Rem wordWidth
-
-mo_wordSGe      = MO_S_Ge  wordWidth
-mo_wordSLe      = MO_S_Le  wordWidth
-mo_wordSGt      = MO_S_Gt  wordWidth
-mo_wordSLt      = MO_S_Lt  wordWidth
-
-mo_wordUGe      = MO_U_Ge  wordWidth
-mo_wordULe      = MO_U_Le  wordWidth
-mo_wordUGt      = MO_U_Gt  wordWidth
-mo_wordULt      = MO_U_Lt  wordWidth
-
-mo_wordAnd      = MO_And wordWidth
-mo_wordOr       = MO_Or  wordWidth
-mo_wordXor      = MO_Xor wordWidth
-mo_wordNot      = MO_Not wordWidth
-mo_wordShl      = MO_Shl wordWidth
-mo_wordSShr     = MO_S_Shr wordWidth
-mo_wordUShr     = MO_U_Shr wordWidth
-
-mo_u_8To32      = MO_UU_Conv W8 W32
-mo_s_8To32      = MO_SS_Conv W8 W32
-mo_u_16To32     = MO_UU_Conv W16 W32
-mo_s_16To32     = MO_SS_Conv W16 W32
-
-mo_u_8ToWord    = MO_UU_Conv W8  wordWidth
-mo_s_8ToWord    = MO_SS_Conv W8  wordWidth
-mo_u_16ToWord   = MO_UU_Conv W16 wordWidth
-mo_s_16ToWord   = MO_SS_Conv W16 wordWidth
-mo_s_32ToWord   = MO_SS_Conv W32 wordWidth
-mo_u_32ToWord   = MO_UU_Conv W32 wordWidth
-
-mo_WordTo8      = MO_UU_Conv wordWidth W8
-mo_WordTo16     = MO_UU_Conv wordWidth W16
-mo_WordTo32     = MO_UU_Conv wordWidth W32
-mo_WordTo64     = MO_UU_Conv wordWidth W64
-
-mo_32To8        = MO_UU_Conv W32 W8
-mo_32To16       = MO_UU_Conv W32 W16
+mo_wordAdd      dflags = MO_Add (wordWidth dflags)
+mo_wordSub      dflags = MO_Sub (wordWidth dflags)
+mo_wordEq       dflags = MO_Eq  (wordWidth dflags)
+mo_wordNe       dflags = MO_Ne  (wordWidth dflags)
+mo_wordMul      dflags = MO_Mul (wordWidth dflags)
+mo_wordSQuot    dflags = MO_S_Quot (wordWidth dflags)
+mo_wordSRem     dflags = MO_S_Rem (wordWidth dflags)
+mo_wordSNeg     dflags = MO_S_Neg (wordWidth dflags)
+mo_wordUQuot    dflags = MO_U_Quot (wordWidth dflags)
+mo_wordURem     dflags = MO_U_Rem (wordWidth dflags)
+
+mo_wordSGe      dflags = MO_S_Ge  (wordWidth dflags)
+mo_wordSLe      dflags = MO_S_Le  (wordWidth dflags)
+mo_wordSGt      dflags = MO_S_Gt  (wordWidth dflags)
+mo_wordSLt      dflags = MO_S_Lt  (wordWidth dflags)
+
+mo_wordUGe      dflags = MO_U_Ge  (wordWidth dflags)
+mo_wordULe      dflags = MO_U_Le  (wordWidth dflags)
+mo_wordUGt      dflags = MO_U_Gt  (wordWidth dflags)
+mo_wordULt      dflags = MO_U_Lt  (wordWidth dflags)
+
+mo_wordAnd      dflags = MO_And (wordWidth dflags)
+mo_wordOr       dflags = MO_Or  (wordWidth dflags)
+mo_wordXor      dflags = MO_Xor (wordWidth dflags)
+mo_wordNot      dflags = MO_Not (wordWidth dflags)
+mo_wordShl      dflags = MO_Shl (wordWidth dflags)
+mo_wordSShr     dflags = MO_S_Shr (wordWidth dflags)
+mo_wordUShr     dflags = MO_U_Shr (wordWidth dflags)
+
+mo_u_8To32             = MO_UU_Conv W8 W32
+mo_s_8To32             = MO_SS_Conv W8 W32
+mo_u_16To32            = MO_UU_Conv W16 W32
+mo_s_16To32            = MO_SS_Conv W16 W32
+
+mo_u_8ToWord    dflags = MO_UU_Conv W8  (wordWidth dflags)
+mo_s_8ToWord    dflags = MO_SS_Conv W8  (wordWidth dflags)
+mo_u_16ToWord   dflags = MO_UU_Conv W16 (wordWidth dflags)
+mo_s_16ToWord   dflags = MO_SS_Conv W16 (wordWidth dflags)
+mo_s_32ToWord   dflags = MO_SS_Conv W32 (wordWidth dflags)
+mo_u_32ToWord   dflags = MO_UU_Conv W32 (wordWidth dflags)
+
+mo_WordTo8      dflags = MO_UU_Conv (wordWidth dflags) W8
+mo_WordTo16     dflags = MO_UU_Conv (wordWidth dflags) W16
+mo_WordTo32     dflags = MO_UU_Conv (wordWidth dflags) W32
+mo_WordTo64     dflags = MO_UU_Conv (wordWidth dflags) W64
+
+mo_32To8               = MO_UU_Conv W32 W8
+mo_32To16              = MO_UU_Conv W32 W16
 
 
 -- ----------------------------------------------------------------------------
@@ -350,8 +353,8 @@ comparisonResultRep = bWord  -- is it?
 -- its arguments are the same as the MachOp expects.  This is used when
 -- linting a CmmExpr.
 
-machOpArgReps :: MachOp -> [Width]
-machOpArgReps op =
+machOpArgReps :: DynFlags -> MachOp -> [Width]
+machOpArgReps dflags op =
   case op of
     MO_Add    r         -> [r,r]
     MO_Sub    r         -> [r,r]
@@ -392,9 +395,9 @@ machOpArgReps op =
     MO_Or    r          -> [r,r]
     MO_Xor   r          -> [r,r]
     MO_Not   r          -> [r]
-    MO_Shl   r          -> [r,wordWidth]
-    MO_U_Shr r          -> [r,wordWidth]
-    MO_S_Shr r          -> [r,wordWidth]
+    MO_Shl   r          -> [r, wordWidth dflags]
+    MO_U_Shr r          -> [r, wordWidth dflags]
+    MO_S_Shr r          -> [r, wordWidth dflags]
 
     MO_SS_Conv from _   -> [from]
     MO_UU_Conv from _   -> [from]
index 5f20824..0df24a6 100644 (file)
@@ -183,8 +183,7 @@ cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr)
          -- not CmmLocal: that might invalidate the usage analysis results
   isTiny _ = False
 
-  platform = targetPlatform dflags
-  foldExp (CmmMachOp op args) = cmmMachOpFold platform op args
+  foldExp (CmmMachOp op args) = cmmMachOpFold dflags op args
   foldExp e = e
 
   ncgDebugTrace str x = if ncgDebugIsOn then trace str x else x
@@ -302,17 +301,17 @@ inlineExpr _ _ other_expr = other_expr
 -- been optimized and folded.
 
 cmmMachOpFold
-    :: Platform
+    :: DynFlags
     -> MachOp       -- The operation from an CmmMachOp
     -> [CmmExpr]    -- The optimized arguments
     -> CmmExpr
 
-cmmMachOpFold platform op args = fromMaybe (CmmMachOp op args) (cmmMachOpFoldM platform op args)
+cmmMachOpFold dflags op args = fromMaybe (CmmMachOp op args) (cmmMachOpFoldM dflags op args)
 
 -- Returns Nothing if no changes, useful for Hoopl, also reduces
 -- allocation!
 cmmMachOpFoldM
-    :: Platform
+    :: DynFlags
     -> MachOp
     -> [CmmExpr]
     -> Maybe CmmExpr
@@ -338,7 +337,7 @@ cmmMachOpFoldM _ (MO_SS_Conv rep1 rep2) [x] | rep1 == rep2 = Just x
 cmmMachOpFoldM _ (MO_UU_Conv rep1 rep2) [x] | rep1 == rep2 = Just x
 
 -- Eliminate nested conversions where possible
-cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]]
+cmmMachOpFoldM dflags conv_outer [CmmMachOp conv_inner [x]]
   | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
     Just (_,   rep3,signed2) <- isIntConversion conv_outer
   = case () of
@@ -348,13 +347,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]]
         -- but remember to use the signedness from the widening, just in case
         -- the final conversion is a widen.
         | rep1 < rep2 && rep2 > rep3 ->
-            Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x]
+            Just $ cmmMachOpFold dflags (intconv signed1 rep1 rep3) [x]
         -- Nested widenings: collapse if the signedness is the same
         | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
-            Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x]
+            Just $ cmmMachOpFold dflags (intconv signed1 rep1 rep3) [x]
         -- Nested narrowings: collapse
         | rep1 > rep2 && rep2 > rep3 ->
-            Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x]
+            Just $ cmmMachOpFold dflags (MO_UU_Conv rep1 rep3) [x]
         | otherwise ->
             Nothing
   where
@@ -371,22 +370,22 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]]
 -- but what if the architecture only supports word-sized loads, should
 -- we do the transformation anyway?
 
-cmmMachOpFoldM _ mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
+cmmMachOpFoldM dflags mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
   = case mop of
         -- for comparisons: don't forget to narrow the arguments before
         -- comparing, since they might be out of range.
-        MO_Eq _   -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) wordWidth)
-        MO_Ne _   -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) wordWidth)
+        MO_Eq _   -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth dflags))
+        MO_Ne _   -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth dflags))
 
-        MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u >  y_u then 1 else 0) wordWidth)
-        MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) wordWidth)
-        MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u <  y_u then 1 else 0) wordWidth)
-        MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) wordWidth)
+        MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u >  y_u then 1 else 0) (wordWidth dflags))
+        MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth dflags))
+        MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u <  y_u then 1 else 0) (wordWidth dflags))
+        MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth dflags))
 
-        MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s >  y_s then 1 else 0) wordWidth)
-        MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) wordWidth)
-        MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s <  y_s then 1 else 0) wordWidth)
-        MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) wordWidth)
+        MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s >  y_s then 1 else 0) (wordWidth dflags))
+        MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth dflags))
+        MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s <  y_s then 1 else 0) (wordWidth dflags))
+        MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth dflags))
 
         MO_Add r -> Just $ CmmLit (CmmInt (x + y) r)
         MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r)
@@ -418,9 +417,9 @@ cmmMachOpFoldM _ mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
 -- also assume that constants have been shifted to the right when
 -- possible.
 
-cmmMachOpFoldM platform op [x@(CmmLit _), y]
+cmmMachOpFoldM dflags op [x@(CmmLit _), y]
    | not (isLit y) && isCommutableMachOp op
-   = Just (cmmMachOpFold platform op [y, x])
+   = Just (cmmMachOpFold dflags op [y, x])
 
 -- Turn (a+b)+c into a+(b+c) where possible.  Because literals are
 -- moved to the right, it is more likely that we will find
@@ -438,19 +437,19 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y]
 -- Also don't do it if arg1 is PicBaseReg, so that we don't separate the
 -- PicBaseReg from the corresponding label (or label difference).
 --
-cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
+cmmMachOpFoldM dflags mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
    | mop2 `associates_with` mop1
      && not (isLit arg1) && not (isPicReg arg1)
-   = Just (cmmMachOpFold platform mop2 [arg1, cmmMachOpFold platform mop1 [arg2,arg3]])
+   = Just (cmmMachOpFold dflags mop2 [arg1, cmmMachOpFold dflags mop1 [arg2,arg3]])
    where
      MO_Add{} `associates_with` MO_Sub{} = True
      mop1 `associates_with` mop2 =
         mop1 == mop2 && isAssociativeMachOp mop1
 
 -- special case: (a - b) + c  ==>  a + (c - b)
-cmmMachOpFoldM platform mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3]
+cmmMachOpFoldM dflags mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3]
    | not (isLit arg1) && not (isPicReg arg1)
-   = Just (cmmMachOpFold platform mop1 [arg1, cmmMachOpFold platform mop2 [arg3,arg2]])
+   = Just (cmmMachOpFold dflags mop1 [arg1, cmmMachOpFold dflags mop2 [arg3,arg2]])
 
 -- Make a RegOff if we can
 cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
@@ -479,9 +478,9 @@ cmmMachOpFoldM _ (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 -- narrowing throws away bits from the operand, there's no way to do
 -- the same comparison at the larger size.
 
-cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
+cmmMachOpFoldM dflags cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
   |     -- powerPC NCG has a TODO for I8/I16 comparisons, so don't try
-    platformArch platform `elem` [ArchX86, ArchX86_64],
+    platformArch (targetPlatform dflags) `elem` [ArchX86, ArchX86_64],
         -- if the operand is widened:
     Just (rep, signed, narrow_fn) <- maybe_conversion conv,
         -- and this is a comparison operation:
@@ -489,7 +488,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
         -- and the literal fits in the smaller size:
     i == narrow_fn rep i
         -- then we can do the comparison at the smaller size
-  = Just (cmmMachOpFold platform narrow_cmp [x, CmmLit (CmmInt i rep)])
+  = Just (cmmMachOpFold dflags narrow_cmp [x, CmmLit (CmmInt i rep)])
  where
     maybe_conversion (MO_UU_Conv from to)
         | to > from
@@ -522,7 +521,7 @@ cmmMachOpFoldM platform cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
 
 -- We can often do something with constants of 0 and 1 ...
 
-cmmMachOpFoldM _ mop [x, y@(CmmLit (CmmInt 0 _))]
+cmmMachOpFoldM dflags mop [x, y@(CmmLit (CmmInt 0 _))]
   = case mop of
         MO_Add   _ -> Just x
         MO_Sub   _ -> Just x
@@ -537,15 +536,15 @@ cmmMachOpFoldM _ mop [x, y@(CmmLit (CmmInt 0 _))]
         MO_Eq    _ | Just x' <- maybeInvertCmmExpr x -> Just x'
         MO_U_Gt  _ | isComparisonExpr x -> Just x
         MO_S_Gt  _ | isComparisonExpr x -> Just x
-        MO_U_Lt  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 wordWidth)
-        MO_S_Lt  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 wordWidth)
-        MO_U_Ge  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 wordWidth)
-        MO_S_Ge  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 wordWidth)
+        MO_U_Lt  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags))
+        MO_S_Lt  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags))
+        MO_U_Ge  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags))
+        MO_S_Ge  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags))
         MO_U_Le  _ | Just x' <- maybeInvertCmmExpr x -> Just x'
         MO_S_Le  _ | Just x' <- maybeInvertCmmExpr x -> Just x'
         _ -> Nothing
 
-cmmMachOpFoldM _ mop [x, (CmmLit (CmmInt 1 rep))]
+cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt 1 rep))]
   = case mop of
         MO_Mul    _ -> Just x
         MO_S_Quot _ -> Just x
@@ -556,24 +555,24 @@ cmmMachOpFoldM _ mop [x, (CmmLit (CmmInt 1 rep))]
         MO_Eq    _ | isComparisonExpr x -> Just x
         MO_U_Lt  _ | Just x' <- maybeInvertCmmExpr x -> Just x'
         MO_S_Lt  _ | Just x' <- maybeInvertCmmExpr x -> Just x'
-        MO_U_Gt  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 wordWidth)
-        MO_S_Gt  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 wordWidth)
-        MO_U_Le  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 wordWidth)
-        MO_S_Le  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 wordWidth)
+        MO_U_Gt  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags))
+        MO_S_Gt  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 0 (wordWidth dflags))
+        MO_U_Le  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags))
+        MO_S_Le  _ | isComparisonExpr x -> Just $ CmmLit (CmmInt 1 (wordWidth dflags))
         MO_U_Ge  _ | isComparisonExpr x -> Just x
         MO_S_Ge  _ | isComparisonExpr x -> Just x
         _ -> Nothing
 
 -- Now look for multiplication/division by powers of 2 (integers).
 
-cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))]
+cmmMachOpFoldM dflags mop [x, (CmmLit (CmmInt n _))]
   = case mop of
         MO_Mul rep
            | Just p <- exactLog2 n ->
-                 Just (cmmMachOpFold platform (MO_Shl rep) [x, CmmLit (CmmInt p rep)])
+                 Just (cmmMachOpFold dflags (MO_Shl rep) [x, CmmLit (CmmInt p rep)])
         MO_U_Quot rep
            | Just p <- exactLog2 n ->
-                 Just (cmmMachOpFold platform (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)])
+                 Just (cmmMachOpFold dflags (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)])
         MO_S_Quot rep
            | Just p <- exactLog2 n, 
              CmmReg _ <- x ->   -- We duplicate x below, hence require
@@ -601,7 +600,7 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))]
                          CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
                     x3 = CmmMachOp (MO_Add rep) [x, x2]
                 in
-                Just (cmmMachOpFold platform (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)])
+                Just (cmmMachOpFold dflags (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)])
         _ -> Nothing
 
 -- ToDo (#7116): optimise floating-point multiplication, e.g. x*2.0 -> x+x
index bfde123..7937b88 100644 (file)
@@ -1053,9 +1053,9 @@ doSwitch mb_range scrut arms deflt
 initEnv :: DynFlags -> Env
 initEnv dflags = listToUFM [
   ( fsLit "SIZEOF_StgHeader",
-    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE)) wordWidth) )),
+    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE)) (wordWidth dflags)) )),
   ( fsLit "SIZEOF_StgInfoTable",
-    VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) wordWidth) ))
+    VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) ))
   ]
 
 parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe CmmGroup)
index e87502b..6ee40d9 100644 (file)
@@ -43,7 +43,7 @@ cmmPipeline hsc_env topSRT prog =
 
      tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
 
-     (topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs topSRT tops
+     (topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops
      dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
 
      return (topSRT, cmms)
index 8248836..585d78e 100644 (file)
@@ -22,7 +22,6 @@ import StgCmmUtils
 
 import DynFlags
 import UniqSupply
-import Platform
 import UniqFM
 import Unique
 import BlockId
@@ -38,7 +37,6 @@ import Prelude hiding (succ, zip)
 
 rewriteAssignments :: DynFlags -> CmmGraph -> UniqSM CmmGraph
 rewriteAssignments dflags g = do
-  let platform = targetPlatform dflags
   -- Because we need to act on forwards and backwards information, we
   -- first perform usage analysis and bake this information into the
   -- graph (backwards transform), and then do a forwards transform
@@ -47,7 +45,7 @@ rewriteAssignments dflags g = do
   g'' <- liftM fst $ dataflowPassFwd g' [(g_entry g, fact_bot assignmentLattice)] $
                                      analRewFwd assignmentLattice
                                                 (assignmentTransfer dflags)
-                                                (assignmentRewrite `thenFwdRw` machOpFoldRewrite platform)
+                                                (assignmentRewrite `thenFwdRw` machOpFoldRewrite dflags)
   return (modifyGraph eraseRegUsage g'')
 
 ----------------------------------------------------------------
@@ -615,8 +613,8 @@ assignmentRewrite = mkFRewrite3 first middle last
 -- in literals, which we can inline more aggressively, and inlining
 -- gives us opportunities for more folding.  However, we don't need any
 -- facts to do MachOp folding.
-machOpFoldRewrite :: Platform -> FwdRewrite UniqSM (WithRegUsage CmmNode) a
-machOpFoldRewrite platform = mkFRewrite3 first middle last
+machOpFoldRewrite :: DynFlags -> FwdRewrite UniqSM (WithRegUsage CmmNode) a
+machOpFoldRewrite dflags = mkFRewrite3 first middle last
   where first _ _ = return Nothing
         middle :: WithRegUsage CmmNode O O -> a -> GenCmmReplGraph (WithRegUsage CmmNode) O O
         middle (Plain m) _ = return (fmap (mkMiddle . Plain) (foldNode m))
@@ -626,7 +624,7 @@ machOpFoldRewrite platform = mkFRewrite3 first middle last
         last (Plain l) _ = return (fmap (mkLast . Plain) (foldNode l))
         foldNode :: CmmNode e x -> Maybe (CmmNode e x)
         foldNode n = mapExpDeepM foldExp n
-        foldExp (CmmMachOp op args) = cmmMachOpFoldM platform op args
+        foldExp (CmmMachOp op args) = cmmMachOpFoldM dflags op args
         foldExp _ = Nothing
 
 -- ToDo: Outputable instance for UsageMap and AssignmentMap
index 4c5d6b1..66b4c83 100644 (file)
@@ -97,13 +97,13 @@ f64    = cmmFloat W64
 
 -- CmmTypes of native word widths
 bWord :: DynFlags -> CmmType
-bWord _ = cmmBits wordWidth
+bWord dflags = cmmBits (wordWidth dflags)
 
 bHalfWord :: DynFlags -> CmmType
 bHalfWord dflags = cmmBits (halfWordWidth dflags)
 
 gcWord :: DynFlags -> CmmType
-gcWord _ = CmmType GcPtrCat wordWidth
+gcWord dflags = CmmType GcPtrCat (wordWidth dflags)
 
 cInt, cLong :: CmmType
 cInt  = cmmBits cIntWidth
@@ -160,10 +160,11 @@ mrStr W80  = sLit("W80")
 
 
 -------- Common Widths  ------------
-wordWidth :: Width
-wordWidth | wORD_SIZE == 4 = W32
-          | wORD_SIZE == 8 = W64
-          | otherwise      = panic "MachOp.wordRep: Unknown word size"
+wordWidth :: DynFlags -> Width
+wordWidth _
+ | wORD_SIZE == 4 = W32
+ | wORD_SIZE == 8 = W64
+ | otherwise      = panic "MachOp.wordRep: Unknown word size"
 
 halfWordWidth :: DynFlags -> Width
 halfWordWidth _
index 07130f3..75bdf61 100644 (file)
@@ -121,17 +121,17 @@ typeForeignHint = primRepForeignHint . typePrimRep
 --
 ---------------------------------------------------
 
-mkIntCLit :: Int -> CmmLit
-mkIntCLit i = CmmInt (toInteger i) wordWidth
+mkIntCLit :: DynFlags -> Int -> CmmLit
+mkIntCLit dflags i = CmmInt (toInteger i) (wordWidth dflags)
 
-mkIntExpr :: Int -> CmmExpr
-mkIntExpr i = CmmLit $! mkIntCLit i
+mkIntExpr :: DynFlags -> Int -> CmmExpr
+mkIntExpr dflags i = CmmLit $! mkIntCLit dflags i
 
-zeroCLit :: CmmLit
-zeroCLit = CmmInt 0 wordWidth
+zeroCLit :: DynFlags -> CmmLit
+zeroCLit dflags = CmmInt 0 (wordWidth dflags)
 
-zeroExpr :: CmmExpr
-zeroExpr = CmmLit zeroCLit
+zeroExpr :: DynFlags -> CmmExpr
+zeroExpr dflags = CmmLit (zeroCLit dflags)
 
 mkByteStringCLit :: Unique -> [Word8] -> (CmmLit, GenCmmDecl CmmStatics info stmt)
 -- We have to make a top-level decl for the string,
@@ -156,21 +156,21 @@ mkRODataLits lbl lits
     needsRelocation (CmmLabelOff _ _) = True
     needsRelocation _                 = False
 
-mkWordCLit :: StgWord -> CmmLit
-mkWordCLit wd = CmmInt (fromIntegral wd) wordWidth
+mkWordCLit :: DynFlags -> StgWord -> CmmLit
+mkWordCLit dflags wd = CmmInt (fromIntegral wd) (wordWidth dflags)
 
-packHalfWordsCLit :: (Integral a, Integral b) => a -> b -> CmmLit
+packHalfWordsCLit :: (Integral a, Integral b) => DynFlags -> a -> b -> CmmLit
 -- Make a single word literal in which the lower_half_word is
 -- at the lower address, and the upper_half_word is at the
 -- higher address
 -- ToDo: consider using half-word lits instead
 --       but be careful: that's vulnerable when reversed
-packHalfWordsCLit lower_half_word upper_half_word
+packHalfWordsCLit dflags lower_half_word upper_half_word
 #ifdef WORDS_BIGENDIAN
-   = mkWordCLit ((fromIntegral lower_half_word `shiftL` hALF_WORD_SIZE_IN_BITS)
+   = mkWordCLit dflags ((fromIntegral lower_half_word `shiftL` hALF_WORD_SIZE_IN_BITS)
                  .|. fromIntegral upper_half_word)
 #else
-   = mkWordCLit ((fromIntegral lower_half_word)
+   = mkWordCLit dflags ((fromIntegral lower_half_word)
                  .|. (fromIntegral upper_half_word `shiftL` hALF_WORD_SIZE_IN_BITS))
 #endif
 
@@ -243,7 +243,7 @@ cmmIndexExpr dflags width base idx =
   cmmOffsetExpr dflags base byte_off
   where
     idx_w = cmmExprWidth dflags idx
-    byte_off = CmmMachOp (MO_Shl idx_w) [idx, mkIntExpr (widthInLog width)]
+    byte_off = CmmMachOp (MO_Shl idx_w) [idx, mkIntExpr dflags (widthInLog width)]
 
 cmmLoadIndex :: DynFlags -> CmmType -> CmmExpr -> Int -> CmmExpr
 cmmLoadIndex dflags ty expr ix = CmmLoad (cmmIndex dflags (typeWidth ty) expr ix) ty
@@ -269,7 +269,7 @@ cmmOffsetLitB = cmmOffsetLit
 cmmOffsetExprW :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
 -- The second arg is a *word* offset; need to change it to bytes
 cmmOffsetExprW dflags  e (CmmLit (CmmInt n _)) = cmmOffsetW dflags e (fromInteger n)
-cmmOffsetExprW dflags e wd_off = cmmIndexExpr dflags wordWidth e wd_off
+cmmOffsetExprW dflags e wd_off = cmmIndexExpr dflags (wordWidth dflags) e wd_off
 
 cmmOffsetW :: DynFlags -> CmmExpr -> WordOff -> CmmExpr
 cmmOffsetW dflags e n = cmmOffsetB dflags e (wORD_SIZE * n)
@@ -290,20 +290,20 @@ cmmLoadIndexW dflags base off ty = CmmLoad (cmmOffsetW dflags base off) ty
 cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
   cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
   cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord
-  :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOrWord  e1 e2 = CmmMachOp mo_wordOr  [e1, e2]
-cmmAndWord e1 e2 = CmmMachOp mo_wordAnd [e1, e2]
-cmmNeWord  e1 e2 = CmmMachOp mo_wordNe  [e1, e2]
-cmmEqWord  e1 e2 = CmmMachOp mo_wordEq  [e1, e2]
-cmmULtWord e1 e2 = CmmMachOp mo_wordULt [e1, e2]
-cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
-cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
---cmmShlWord e1 e2 = CmmMachOp mo_wordShl [e1, e2]
-cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
-cmmAddWord e1 e2 = CmmMachOp mo_wordAdd [e1, e2]
-cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2]
-cmmMulWord e1 e2 = CmmMachOp mo_wordMul [e1, e2]
-cmmQuotWord e1 e2 = CmmMachOp mo_wordUQuot [e1, e2]
+  :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
+cmmOrWord dflags  e1 e2 = CmmMachOp (mo_wordOr dflags)  [e1, e2]
+cmmAndWord dflags e1 e2 = CmmMachOp (mo_wordAnd dflags) [e1, e2]
+cmmNeWord dflags  e1 e2 = CmmMachOp (mo_wordNe dflags)  [e1, e2]
+cmmEqWord dflags  e1 e2 = CmmMachOp (mo_wordEq dflags)  [e1, e2]
+cmmULtWord dflags e1 e2 = CmmMachOp (mo_wordULt dflags) [e1, e2]
+cmmUGeWord dflags e1 e2 = CmmMachOp (mo_wordUGe dflags) [e1, e2]
+cmmUGtWord dflags e1 e2 = CmmMachOp (mo_wordUGt dflags) [e1, e2]
+--cmmShlWord dflags e1 e2 = CmmMachOp (mo_wordShl dflags) [e1, e2]
+cmmUShrWord dflags e1 e2 = CmmMachOp (mo_wordUShr dflags) [e1, e2]
+cmmAddWord dflags e1 e2 = CmmMachOp (mo_wordAdd dflags) [e1, e2]
+cmmSubWord dflags e1 e2 = CmmMachOp (mo_wordSub dflags) [e1, e2]
+cmmMulWord dflags e1 e2 = CmmMachOp (mo_wordMul dflags) [e1, e2]
+cmmQuotWord dflags e1 e2 = CmmMachOp (mo_wordUQuot dflags) [e1, e2]
 
 cmmNegate :: DynFlags -> CmmExpr -> CmmExpr
 cmmNegate _      (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
@@ -342,28 +342,27 @@ hasNoGlobalRegs _ = False
 
 -- Tag bits mask
 --cmmTagBits = CmmLit (mkIntCLit tAG_BITS)
-cmmTagMask, cmmPointerMask :: CmmExpr
-cmmTagMask = mkIntExpr tAG_MASK
-cmmPointerMask = mkIntExpr (complement tAG_MASK)
+cmmTagMask, cmmPointerMask :: DynFlags -> CmmExpr
+cmmTagMask dflags = mkIntExpr dflags tAG_MASK
+cmmPointerMask dflags = mkIntExpr dflags (complement tAG_MASK)
 
 -- Used to untag a possibly tagged pointer
 -- A static label need not be untagged
-cmmUntag, cmmGetTag :: CmmExpr -> CmmExpr
-cmmUntag e@(CmmLit (CmmLabel _)) = e
+cmmUntag, cmmGetTag :: DynFlags -> CmmExpr -> CmmExpr
+cmmUntag e@(CmmLit (CmmLabel _)) = e
 -- Default case
-cmmUntag e = (e `cmmAndWord` cmmPointerMask)
+cmmUntag dflags e = cmmAndWord dflags e (cmmPointerMask dflags)
 
-cmmGetTag e = (e `cmmAndWord` cmmTagMask)
+cmmGetTag dflags e = cmmAndWord dflags e (cmmTagMask dflags)
 
 -- Test if a closure pointer is untagged
-cmmIsTagged :: CmmExpr -> CmmExpr
-cmmIsTagged e = (e `cmmAndWord` cmmTagMask)
-                 `cmmNeWord` zeroExpr
+cmmIsTagged :: DynFlags -> CmmExpr -> CmmExpr
+cmmIsTagged dflags e = cmmNeWord dflags (cmmAndWord dflags e (cmmTagMask dflags)) (zeroExpr dflags)
 
-cmmConstrTag, cmmConstrTag1 :: CmmExpr -> CmmExpr
-cmmConstrTag e = (e `cmmAndWord` cmmTagMask) `cmmSubWord` mkIntExpr 1
+cmmConstrTag, cmmConstrTag1 :: DynFlags -> CmmExpr -> CmmExpr
+cmmConstrTag dflags e = cmmSubWord dflags (cmmAndWord dflags e (cmmTagMask dflags)) (mkIntExpr dflags 1)
 -- Get constructor tag, but one based.
-cmmConstrTag1 e = e `cmmAndWord` cmmTagMask
+cmmConstrTag1 dflags e = cmmAndWord dflags e (cmmTagMask dflags)
 
 
 --------------------------------------------
index d9dfb42..3233dbe 100644 (file)
@@ -306,7 +306,7 @@ copyIn dflags oflow conv area formals =
   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
+        init_offset = widthInBytes (wordWidth dflags) -- infotable
         args  = assignArgumentsPos dflags conv localRegType formals
         args' = foldl adjust [] args
           where adjust rst (v, StackParam off) = (v, StackParam (off + init_offset)) : rst
@@ -356,10 +356,10 @@ copyOutOflow dflags conv transfer area actuals updfr_off
                   case transfer of
                      Call ->
                        ([(CmmLit (CmmBlock id), StackParam init_offset)],
-                       widthInBytes wordWidth)
+                       widthInBytes (wordWidth dflags))
                      JumpRet ->
                        ([],
-                       widthInBytes wordWidth)
+                       widthInBytes (wordWidth dflags))
                      _other ->
                        ([], 0)
             Old -> ([], updfr_off)
index 009a784..9146aa7 100644 (file)
@@ -80,9 +80,9 @@ lintCmmExpr dflags (CmmLoad expr rep) = do
   return rep
 lintCmmExpr dflags expr@(CmmMachOp op args) = do
   tys <- mapM (lintCmmExpr dflags) args
-  if map (typeWidth . cmmExprType dflags) args == machOpArgReps op
+  if map (typeWidth . cmmExprType dflags) args == machOpArgReps dflags op
        then cmmCheckMachOp dflags op args tys
-       else cmmLintMachOpErr expr (map (cmmExprType dflags) args) (machOpArgReps op)
+       else cmmLintMachOpErr expr (map (cmmExprType dflags) args) (machOpArgReps dflags op)
 lintCmmExpr dflags (CmmRegOff reg offset)
   = lintCmmExpr dflags (CmmMachOp (MO_Add rep)
                [CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])
@@ -137,7 +137,7 @@ lintCmmStmt dflags labels = lint
           lint (CmmCall target _res args _) =
               do lintTarget dflags labels target
                  mapM_ (lintCmmExpr dflags . hintlessCmm) args
-          lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr dflags e >> checkCond e
+          lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr dflags e >> checkCond dflags e
           lint (CmmSwitch e branches) = do
             mapM_ checkTarget $ catMaybes branches
             erep <- lintCmmExpr dflags e
@@ -159,10 +159,10 @@ lintTarget dflags labels (CmmPrim _ (Just stmts))
     = mapM_ (lintCmmStmt dflags labels) stmts
 
 
-checkCond :: CmmExpr -> CmmLint ()
-checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
-checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
-checkCond expr
+checkCond :: DynFlags -> CmmExpr -> CmmLint ()
+checkCond _      (CmmMachOp mop _) | isComparisonMachOp mop = return ()
+checkCond dflags (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth dflags = return () -- constant values
+checkCond _      expr
     = cmmLintErr (hang (text "expression is not a conditional:") 2
                        (ppr expr))
 
index 01c64da..b40b34a 100644 (file)
@@ -149,9 +149,10 @@ pprBBlock (BasicBlock lbl stmts) =
 
 pprWordArray :: CLabel -> [CmmStatic] -> SDoc
 pprWordArray lbl ds
-  = hcat [ pprLocalness lbl, ptext (sLit "StgWord")
+  = sdocWithDynFlags $ \dflags ->
+    hcat [ pprLocalness lbl, ptext (sLit "StgWord")
          , space, ppr lbl, ptext (sLit "[] = {") ]
-    $$ nest 8 (commafy (pprStatics ds))
+    $$ nest 8 (commafy (pprStatics dflags ds))
     $$ ptext (sLit "};")
 
 --
@@ -178,10 +179,10 @@ pprStmt stmt =
                           -- some debugging option is on.  They can get quite
                           -- large.
 
-    CmmAssign dest src -> pprAssign dest src
+    CmmAssign dest src -> pprAssign dflags dest src
 
     CmmStore  dest src
-        | typeWidth rep == W64 && wordWidth /= W64
+        | typeWidth rep == W64 && wordWidth dflags /= W64
         -> (if isFloatType rep then ptext (sLit "ASSIGN_DBL")
                                else ptext (sLit ("ASSIGN_Word64"))) <>
            parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
@@ -248,7 +249,8 @@ pprStmt stmt =
     CmmBranch ident          -> pprBranch ident
     CmmCondBranch expr ident -> pprCondBranch expr ident
     CmmJump lbl _            -> mkJMP_(pprExpr lbl) <> semi
-    CmmSwitch arg ids        -> pprSwitch arg ids
+    CmmSwitch arg ids        -> sdocWithDynFlags $ \dflags ->
+                                pprSwitch dflags arg ids
 
 pprForeignCall :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual]
                -> (SDoc, SDoc)
@@ -297,8 +299,8 @@ pprCondBranch expr ident
 -- 'undefined'. However, they may be defined one day, so we better
 -- document this behaviour.
 --
-pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc
-pprSwitch e maybe_ids
+pprSwitch :: DynFlags -> CmmExpr -> [ Maybe BlockId ] -> SDoc
+pprSwitch dflags e maybe_ids
   = let pairs  = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
         pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
     in
@@ -313,11 +315,11 @@ pprSwitch e maybe_ids
     caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
         where
         do_fallthrough ix =
-                 hsep [ ptext (sLit "case") , pprHexVal ix wordWidth <> colon ,
+                 hsep [ ptext (sLit "case") , pprHexVal ix (wordWidth dflags) <> colon ,
                         ptext (sLit "/* fall through */") ]
 
         final_branch ix =
-                hsep [ ptext (sLit "case") , pprHexVal ix wordWidth <> colon ,
+                hsep [ ptext (sLit "case") , pprHexVal ix (wordWidth dflags) <> colon ,
                        ptext (sLit "goto") , (pprBlockId ident) <> semi ]
 
     caseify (_     , _    ) = panic "pprSwtich: swtich with no cases!"
@@ -341,7 +343,7 @@ pprExpr e = case e of
     CmmLit lit -> pprLit lit
 
 
-    CmmLoad e ty -> pprLoad e ty
+    CmmLoad e ty -> sdocWithDynFlags $ \dflags -> pprLoad dflags e ty
     CmmReg reg      -> pprCastReg reg
     CmmRegOff reg 0 -> pprCastReg reg
 
@@ -356,26 +358,26 @@ pprExpr e = case e of
     CmmStackSlot _ _   -> panic "pprExpr: CmmStackSlot not supported!"
 
 
-pprLoad :: CmmExpr -> CmmType -> SDoc
-pprLoad e ty
-  | width == W64, wordWidth /= W64
+pprLoad :: DynFlags -> CmmExpr -> CmmType -> SDoc
+pprLoad dflags e ty
+  | width == W64, wordWidth dflags /= W64
   = (if isFloatType ty then ptext (sLit "PK_DBL")
                        else ptext (sLit "PK_Word64"))
     <> parens (mkP_ <> pprExpr1 e)
 
   | otherwise
   = case e of
-        CmmReg r | isPtrReg r && width == wordWidth && not (isFloatType ty)
+        CmmReg r | isPtrReg r && width == wordWidth dflags && not (isFloatType ty)
                  -> char '*' <> pprAsPtrReg r
 
-        CmmRegOff r 0 | isPtrReg r && width == wordWidth && not (isFloatType ty)
+        CmmRegOff r 0 | isPtrReg r && width == wordWidth dflags && not (isFloatType ty)
                       -> char '*' <> pprAsPtrReg r
 
-        CmmRegOff r off | isPtrReg r && width == wordWidth
+        CmmRegOff r off | isPtrReg r && width == wordWidth dflags
                         , off `rem` wORD_SIZE == 0 && not (isFloatType ty)
         -- ToDo: check that the offset is a word multiple?
         --       (For tagging to work, I had to avoid unaligned loads. --ARY)
-                        -> pprAsPtrReg r <> brackets (ppr (off `shiftR` wordShift))
+                        -> pprAsPtrReg r <> brackets (ppr (off `shiftR` wordShift dflags))
 
         _other -> cLoad e ty
   where
@@ -474,38 +476,38 @@ pprLit1 other = pprLit other
 -- ---------------------------------------------------------------------------
 -- Static data
 
-pprStatics :: [CmmStatic] -> [SDoc]
-pprStatics [] = []
-pprStatics (CmmStaticLit (CmmFloat f W32) : rest)
+pprStatics :: DynFlags -> [CmmStatic] -> [SDoc]
+pprStatics [] = []
+pprStatics dflags (CmmStaticLit (CmmFloat f W32) : rest)
   -- floats are padded to a word, see #1852
   | wORD_SIZE == 8, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
-  = pprLit1 (floatToWord f) : pprStatics rest'
+  = pprLit1 (floatToWord dflags f) : pprStatics dflags rest'
   | wORD_SIZE == 4
-  = pprLit1 (floatToWord f) : pprStatics rest
+  = pprLit1 (floatToWord dflags f) : pprStatics dflags rest
   | otherwise
   = pprPanic "pprStatics: float" (vcat (map ppr' rest))
     where ppr' (CmmStaticLit l) = sdocWithDynFlags $ \dflags ->
                                   ppr (cmmLitType dflags l)
           ppr' _other           = ptext (sLit "bad static!")
-pprStatics (CmmStaticLit (CmmFloat f W64) : rest)
-  = map pprLit1 (doubleToWords f) ++ pprStatics rest
-pprStatics (CmmStaticLit (CmmInt i W64) : rest)
-  | wordWidth == W32
+pprStatics dflags (CmmStaticLit (CmmFloat f W64) : rest)
+  = map pprLit1 (doubleToWords dflags f) ++ pprStatics dflags rest
+pprStatics dflags (CmmStaticLit (CmmInt i W64) : rest)
+  | wordWidth dflags == W32
 #ifdef WORDS_BIGENDIAN
-  = pprStatics (CmmStaticLit (CmmInt q W32) :
-                CmmStaticLit (CmmInt r W32) : rest)
+  = pprStatics dflags (CmmStaticLit (CmmInt q W32) :
+                       CmmStaticLit (CmmInt r W32) : rest)
 #else
-  = pprStatics (CmmStaticLit (CmmInt r W32) :
-                CmmStaticLit (CmmInt q W32) : rest)
+  = pprStatics dflags (CmmStaticLit (CmmInt r W32) :
+                       CmmStaticLit (CmmInt q W32) : rest)
 #endif
   where r = i .&. 0xffffffff
         q = i `shiftR` 32
-pprStatics (CmmStaticLit (CmmInt _ w) : _)
-  | w /= wordWidth
+pprStatics dflags (CmmStaticLit (CmmInt _ w) : _)
+  | w /= wordWidth dflags
   = panic "pprStatics: cannot emit a non-word-sized static literal"
-pprStatics (CmmStaticLit lit : rest)
-  = pprLit1 lit : pprStatics rest
-pprStatics (other : _)
+pprStatics dflags (CmmStaticLit lit : rest)
+  = pprLit1 lit : pprStatics dflags rest
+pprStatics (other : _)
   = pprPanic "pprWord" (pprStatic other)
 
 pprStatic :: CmmStatic -> SDoc
@@ -710,19 +712,19 @@ mkP_  = ptext (sLit "(P_)")        -- StgWord*
 --
 -- Generating assignments is what we're all about, here
 --
-pprAssign :: CmmReg -> CmmExpr -> SDoc
+pprAssign :: DynFlags -> CmmReg -> CmmExpr -> SDoc
 
 -- dest is a reg, rhs is a reg
-pprAssign r1 (CmmReg r2)
+pprAssign r1 (CmmReg r2)
    | isPtrReg r1 && isPtrReg r2
    = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, semi ]
 
 -- dest is a reg, rhs is a CmmRegOff
-pprAssign r1 (CmmRegOff r2 off)
+pprAssign dflags r1 (CmmRegOff r2 off)
    | isPtrReg r1 && isPtrReg r2 && (off `rem` wORD_SIZE == 0)
    = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, op, int off', semi ]
   where
-        off1 = off `shiftR` wordShift
+        off1 = off `shiftR` wordShift dflags
 
         (op,off') | off >= 0  = (char '+', off1)
                   | otherwise = (char '-', -off1)
@@ -730,7 +732,7 @@ pprAssign r1 (CmmRegOff r2 off)
 -- dest is a reg, rhs is anything.
 -- We can't cast the lvalue, so we have to cast the rhs if necessary.  Casting
 -- the lvalue elicits a warning from new GCC versions (3.4+).
-pprAssign r1 r2
+pprAssign r1 r2
   | isFixedPtrReg r1             = mkAssign (mkP_ <> pprExpr1 r2)
   | Just ty <- strangeRegType r1 = mkAssign (parens ty <> pprExpr1 r2)
   | otherwise                    = mkAssign (pprExpr r2)
@@ -907,9 +909,9 @@ pprExternDecl _in_srt lbl
   -- If the label we want to refer to is a stdcall function (on Windows) then
   -- we must generate an appropriate prototype for it, so that the C compiler will
   -- add the @n suffix to the label (#2276)
-  stdcall_decl sz =
+  stdcall_decl sz = sdocWithDynFlags $ \dflags ->
         ptext (sLit "extern __attribute__((stdcall)) void ") <> ppr lbl
-        <> parens (commafy (replicate (sz `quot` wORD_SIZE) (machRep_U_CType wordWidth)))
+        <> parens (commafy (replicate (sz `quot` wORD_SIZE) (machRep_U_CType (wordWidth dflags))))
         <> semi
 
 type TEState = (UniqSet LocalReg, Map CLabel ())
@@ -990,10 +992,10 @@ cLoad expr rep
           bewareLoadStoreAlignment (ArchARM {}) = True
           bewareLoadStoreAlignment _            = False
 
-isCmmWordType :: CmmType -> Bool
+isCmmWordType :: DynFlags -> CmmType -> Bool
 -- True of GcPtrReg/NonGcReg of native word size
-isCmmWordType ty = not (isFloatType ty)
-                   && typeWidth ty == wordWidth
+isCmmWordType dflags ty = not (isFloatType ty)
+                       && typeWidth ty == wordWidth dflags
 
 -- This is for finding the types of foreign call arguments.  For a pointer
 -- argument, we always cast the argument to (void *), to avoid warnings from
@@ -1004,8 +1006,10 @@ machRepHintCType rep SignedHint = machRep_S_CType (typeWidth rep)
 machRepHintCType rep _other     = machRepCType rep
 
 machRepPtrCType :: CmmType -> SDoc
-machRepPtrCType r | isCmmWordType r = ptext (sLit "P_")
-                  | otherwise       = machRepCType r <> char '*'
+machRepPtrCType r
+ = sdocWithDynFlags $ \dflags ->
+   if isCmmWordType dflags r then ptext (sLit "P_")
+                             else machRepCType r <> char '*'
 
 machRepCType :: CmmType -> SDoc
 machRepCType ty | isFloatType ty = machRep_F_CType w
@@ -1019,20 +1023,26 @@ machRep_F_CType W64 = ptext (sLit "StgDouble")
 machRep_F_CType _   = panic "machRep_F_CType"
 
 machRep_U_CType :: Width -> SDoc
-machRep_U_CType w | w == wordWidth = ptext (sLit "W_")
-machRep_U_CType W8  = ptext (sLit "StgWord8")
-machRep_U_CType W16 = ptext (sLit "StgWord16")
-machRep_U_CType W32 = ptext (sLit "StgWord32")
-machRep_U_CType W64 = ptext (sLit "StgWord64")
-machRep_U_CType _   = panic "machRep_U_CType"
+machRep_U_CType w
+ = sdocWithDynFlags $ \dflags ->
+   case w of
+   _ | w == wordWidth dflags -> ptext (sLit "W_")
+   W8  -> ptext (sLit "StgWord8")
+   W16 -> ptext (sLit "StgWord16")
+   W32 -> ptext (sLit "StgWord32")
+   W64 -> ptext (sLit "StgWord64")
+   _   -> panic "machRep_U_CType"
 
 machRep_S_CType :: Width -> SDoc
-machRep_S_CType w | w == wordWidth = ptext (sLit "I_")
-machRep_S_CType W8  = ptext (sLit "StgInt8")
-machRep_S_CType W16 = ptext (sLit "StgInt16")
-machRep_S_CType W32 = ptext (sLit "StgInt32")
-machRep_S_CType W64 = ptext (sLit "StgInt64")
-machRep_S_CType _   = panic "machRep_S_CType"
+machRep_S_CType w
+ = sdocWithDynFlags $ \dflags ->
+   case w of
+   _ | w == wordWidth dflags -> ptext (sLit "I_")
+   W8  -> ptext (sLit "StgInt8")
+   W16 -> ptext (sLit "StgInt16")
+   W32 -> ptext (sLit "StgInt32")
+   W64 -> ptext (sLit "StgInt64")
+   _   -> panic "machRep_S_CType"
 
 
 -- ---------------------------------------------------------------------
@@ -1062,18 +1072,18 @@ castDoubleToIntArray :: STUArray s Int Double -> ST s (STUArray s Int Int)
 castDoubleToIntArray = castSTUArray
 
 -- floats are always 1 word
-floatToWord :: Rational -> CmmLit
-floatToWord r
+floatToWord :: DynFlags -> Rational -> CmmLit
+floatToWord dflags r
   = runST (do
         arr <- newArray_ ((0::Int),0)
         writeArray arr 0 (fromRational r)
         arr' <- castFloatToIntArray arr
         i <- readArray arr' 0
-        return (CmmInt (toInteger i) wordWidth)
+        return (CmmInt (toInteger i) (wordWidth dflags))
     )
 
-doubleToWords :: Rational -> [CmmLit]
-doubleToWords r
+doubleToWords :: DynFlags -> Rational -> [CmmLit]
+doubleToWords dflags r
   | big_doubles                         -- doubles are 2 words
   = runST (do
         arr <- newArray_ ((0::Int),1)
@@ -1081,8 +1091,8 @@ doubleToWords r
         arr' <- castDoubleToIntArray arr
         i1 <- readArray arr' 0
         i2 <- readArray arr' 1
-        return [ CmmInt (toInteger i1) wordWidth
-               , CmmInt (toInteger i2) wordWidth
+        return [ CmmInt (toInteger i1) (wordWidth dflags)
+               , CmmInt (toInteger i2) (wordWidth dflags)
                ]
     )
   | otherwise                           -- doubles are 1 word
@@ -1091,14 +1101,14 @@ doubleToWords r
         writeArray arr 0 (fromRational r)
         arr' <- castDoubleToIntArray arr
         i <- readArray arr' 0
-        return [ CmmInt (toInteger i) wordWidth ]
+        return [ CmmInt (toInteger i) (wordWidth dflags) ]
     )
 
 -- ---------------------------------------------------------------------------
 -- Utils
 
-wordShift :: Int
-wordShift = widthInLog wordWidth
+wordShift :: DynFlags -> Int
+wordShift dflags = widthInLog (wordWidth dflags)
 
 commafy :: [SDoc] -> SDoc
 commafy xs = hsep $ punctuate comma xs
index 2c481c3..7d2f482 100644 (file)
@@ -187,10 +187,11 @@ infixMachOp mop
 --  has the natural machine word size, we do not append the type
 --
 pprLit :: CmmLit -> SDoc
-pprLit lit = case lit of
+pprLit lit = sdocWithDynFlags $ \dflags ->
+             case lit of
     CmmInt i rep ->
         hcat [ (if i < 0 then parens else id)(integer i)
-             , ppUnless (rep == wordWidth) $
+             , ppUnless (rep == wordWidth dflags) $
                space <> dcolon <+> ppr rep ]
 
     CmmFloat f rep     -> hsep [ double (fromRat f), dcolon, ppr rep ]
index f8062cf..fce9104 100644 (file)
@@ -320,10 +320,11 @@ mkFunEntryCode cl_info cc reg_args stk_args sp_top reg_save_code body = do
 
         -- Do the business
   ; funWrapper cl_info reg_args reg_save_code $ do
-       { tickyEnterFun cl_info
+        { dflags <- getDynFlags
+        ; tickyEnterFun cl_info
         ; enterCostCentreFun cc
-              (CmmMachOp mo_wordSub [ CmmReg nodeReg
-                                    , mkIntExpr (funTag cl_info) ])
+              (CmmMachOp (mo_wordSub dflags) [ CmmReg nodeReg
+                                             , mkIntExpr dflags (funTag cl_info) ])
               (node : map snd reg_args) -- live regs
 
         ; cgExpr body }
@@ -429,7 +430,7 @@ funWrapper closure_info arg_regs reg_save_code fun_body = do
   ; whenC (tag /= 0 && node_points) $ do
         l <- newLabelC
         stmtC (CmmCondBranch (CmmMachOp mo_wordEq [cmmGetTag (CmmReg nodeReg),
-                                                   mkIntExpr tag)]) l)
+                                                   mkIntExpr dflags tag)]) l)
         stmtC (CmmStore (CmmLit (mkWordCLit 0)) (mkWordExpr 0))
         labelC l
   -}
@@ -598,7 +599,7 @@ link_caf cl_info _is_upd = do
        -- node is live, so save it.
 
   -- see Note [atomic CAF entry] in rts/sm/Storage.c
-  ; emitIf (CmmMachOp mo_wordEq [ CmmReg (CmmLocal ret), zeroExpr]) $
+  ; emitIf (CmmMachOp (mo_wordEq dflags) [ CmmReg (CmmLocal ret), zeroExpr dflags]) $
         -- re-enter R1.  Doing this directly is slightly dodgy; we're
         -- assuming lots of things, like the stack pointer hasn't
         -- moved since we entered the CAF.
index 146f284..57fd10d 100644 (file)
@@ -355,7 +355,7 @@ cgReturnDataCon con amodes = do
   where
     node_live   = Just [node]
     enter_it dflags
-                = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
+                = stmtsC [ CmmAssign nodeReg (cmmUntag dflags (CmmReg nodeReg)),
                            CmmJump (entryCode dflags $ closureInfoPtr dflags $ CmmReg nodeReg)
                                    node_live
                          ]
index 213745d..b835e78 100644 (file)
@@ -152,7 +152,7 @@ emitForeignCall' safety results target args vols _srt ret
     stmtC (CmmCall (CmmCallee suspendThread CCallConv)
                         [ CmmHinted id AddrHint ]
                         [ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint
-                        , CmmHinted (CmmLit (CmmInt (fromIntegral (fromEnum (playInterruptible safety))) wordWidth)) NoHint]
+                        , CmmHinted (CmmLit (CmmInt (fromIntegral (fromEnum (playInterruptible safety))) (wordWidth dflags))) NoHint]
                         ret)
     stmtC (CmmCall temp_target results temp_args ret)
     stmtC (CmmCall (CmmCallee resumeThread CCallConv)
@@ -243,7 +243,7 @@ emitLoadThreadState = do
         -- HpAlloc = 0;
         --   HpAlloc is assumed to be set to non-zero only by a failed
         --   a heap check, see HeapStackCheck.cmm:GC_GENERIC
-        CmmAssign hpAlloc (CmmLit zeroCLit)
+        CmmAssign hpAlloc (CmmLit (zeroCLit dflags))
     ]
   emitOpenNursery
   -- and load the current cost centre stack from the TSO when profiling:
@@ -264,10 +264,10 @@ emitOpenNursery =
             (cmmOffsetExpr dflags
                 (CmmLoad (nursery_bdescr_start dflags) (bWord dflags))
                 (cmmOffset dflags
-                  (CmmMachOp mo_wordMul [
-                    CmmMachOp (MO_SS_Conv W32 wordWidth)
+                  (CmmMachOp (mo_wordMul dflags) [
+                    CmmMachOp (MO_SS_Conv W32 (wordWidth dflags))
                       [CmmLoad (nursery_bdescr_blocks dflags) b32],
-                    mkIntExpr bLOCK_SIZE
+                    mkIntExpr dflags bLOCK_SIZE
                    ])
                   (-1)
                 )
index daca30c..e37783c 100644 (file)
@@ -208,22 +208,22 @@ mkStaticClosureFields dflags cl_info ccs caf_refs payload
 
     padding_wds
         | not is_caf = []
-        | otherwise  = ASSERT(null payload) [mkIntCLit 0]
+        | otherwise  = ASSERT(null payload) [mkIntCLit dflags 0]
 
     static_link_field
         | is_caf || staticClosureNeedsLink cl_info = [static_link_value]
         | otherwise                                = []
 
     saved_info_field
-        | is_caf     = [mkIntCLit 0]
+        | is_caf     = [mkIntCLit dflags 0]
         | otherwise  = []
 
         -- for a static constructor which has NoCafRefs, we set the
         -- static link field to a non-zero value so the garbage
         -- collector will ignore it.
     static_link_value
-        | caf_refs      = mkIntCLit 0
-        | otherwise     = mkIntCLit 1
+        | caf_refs      = mkIntCLit dflags 0
+        | otherwise     = mkIntCLit dflags 1
 
 mkStaticClosure :: DynFlags -> CLabel -> CostCentreStack -> [CmmLit]
   -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
@@ -412,18 +412,18 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code
   | ptrs > 255 || nptrs > 255 = panic "altHeapCheck"
   | otherwise
   = initHeapUsage $ \ hpHw -> do
-        { codeOnly $ do { do_checks 0 {- no stack check -} hpHw
+        { dflags <- getDynFlags
+        ; let full_fail_code  = fail_code `plusStmts` oneStmt assign_liveness
+              assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9 VNonGcPtr))    -- Ho ho ho!
+                                          (CmmLit (mkWordCLit dflags liveness))
+              liveness        = mkRegLiveness regs ptrs nptrs
+              live            = Just $ map snd regs
+              rts_label       = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_ut")))
+        ; codeOnly $ do { do_checks 0 {- no stack check -} hpHw
                                     full_fail_code rts_label live
                         ; tickyAllocHeap hpHw }
         ; setRealHp hpHw
         ; code }
-  where
-    full_fail_code  = fail_code `plusStmts` oneStmt assign_liveness
-    assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9 VNonGcPtr))    -- Ho ho ho!
-                                (CmmLit (mkWordCLit liveness))
-    liveness        = mkRegLiveness regs ptrs nptrs
-    live            = Just $ map snd regs
-    rts_label       = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_ut")))
 
 \end{code}
 
@@ -462,15 +462,27 @@ do_checks _ hp _ _ _
             "structures in the code."])
 
 do_checks stk hp reg_save_code rts_lbl live
-  = do_checks' (mkIntExpr (stk*wORD_SIZE))
-               (mkIntExpr (hp*wORD_SIZE))
-         (stk /= 0) (hp /= 0) reg_save_code rts_lbl live
+  = do dflags <- getDynFlags
+       do_checks' (mkIntExpr dflags (stk*wORD_SIZE))
+                  (mkIntExpr dflags (hp*wORD_SIZE))
+           (stk /= 0) (hp /= 0) reg_save_code rts_lbl live
 
 -- The offsets are now in *bytes*
 do_checks' :: CmmExpr -> CmmExpr -> Bool -> Bool -> CmmStmts -> CmmExpr
            -> Maybe [GlobalReg] -> Code
 do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl live
   = do  { dflags <- getDynFlags
+
+        -- Stk overflow if (Sp - stk_bytes < SpLim)
+        ; let stk_oflo = CmmMachOp (mo_wordULt dflags)
+                             [CmmMachOp (mo_wordSub dflags) [CmmReg spReg, stk_expr],
+                              CmmReg (CmmGlobal SpLim)]
+
+        -- Hp overflow if (Hp > HpLim)
+        -- (Hp has been incremented by now)
+        -- HpLim points to the LAST WORD of valid allocation space.
+              hp_oflo = CmmMachOp (mo_wordUGt dflags)
+                            [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
   
         ; doGranAllocate hp_expr
 
@@ -506,17 +518,6 @@ do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl live
                 -- with slop at the end of the current block, which can
                 -- confuse the LDV profiler.
     }
-  where
-        -- Stk overflow if (Sp - stk_bytes < SpLim)
-    stk_oflo = CmmMachOp mo_wordULt
-                  [CmmMachOp mo_wordSub [CmmReg spReg, stk_expr],
-                   CmmReg (CmmGlobal SpLim)]
-
-        -- Hp overflow if (Hp > HpLim)
-        -- (Hp has been incremented by now)
-        -- HpLim points to the LAST WORD of valid allocation space.
-    hp_oflo = CmmMachOp mo_wordUGt
-                  [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
 \end{code}
 
 %************************************************************************
@@ -532,15 +533,16 @@ hpChkGen bytes liveness reentry
        let platform = targetPlatform dflags
            assigns = mkStmts [ mk_vanilla_assignment dflags 9 liveness,
                                mk_vanilla_assignment dflags 10 reentry ]
-       do_checks' zeroExpr bytes False True assigns
+       do_checks' (zeroExpr dflags) bytes False True assigns
                   stg_gc_gen (Just (activeStgRegs platform))
 
 -- a heap check where R1 points to the closure to enter on return, and
 -- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
 hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> Code
 hpChkNodePointsAssignSp0 bytes sp0
-  = do_checks' zeroExpr bytes False True assign
-          stg_gc_enter1 (Just [node])
+  = do dflags <- getDynFlags
+       do_checks' (zeroExpr dflags) bytes False True assign
+           stg_gc_enter1 (Just [node])
   where assign = oneStmt (CmmStore (CmmReg spReg) sp0)
 
 stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
@@ -549,7 +551,7 @@ stkChkGen bytes liveness reentry
        let platform = targetPlatform dflags
            assigns = mkStmts [ mk_vanilla_assignment dflags 9 liveness,
                                mk_vanilla_assignment dflags 10 reentry ]
-       do_checks' bytes zeroExpr True False assigns
+       do_checks' bytes (zeroExpr dflags) True False assigns
                   stg_gc_gen (Just (activeStgRegs platform))
 
 mk_vanilla_assignment :: DynFlags -> Int -> CmmExpr -> CmmStmt
@@ -558,8 +560,9 @@ mk_vanilla_assignment dflags n e
 
 stkChkNodePoints :: CmmExpr -> Code
 stkChkNodePoints bytes
-  = do_checks' bytes zeroExpr True False noStmts
-          stg_gc_enter1 (Just [node])
+  = do dflags <- getDynFlags
+       do_checks' bytes (zeroExpr dflags) True False noStmts
+           stg_gc_enter1 (Just [node])
 
 stg_gc_gen :: CmmExpr
 stg_gc_gen = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_gen")))
index 68cbe0f..18e3532 100644 (file)
@@ -214,15 +214,15 @@ emitAlgReturnTarget
        -> FCode (CLabel, SemiTaggingStuff)
 
 emitAlgReturnTarget name branches mb_deflt fam_sz
-  = do  { blks <- getCgStmts $
+  = do  { blks <- getCgStmts $ do
                     -- is the constructor tag in the node reg?
+                    dflags <- getDynFlags
                     if isSmallFamily fam_sz
                         then do -- yes, node has constr. tag
-                          let tag_expr = cmmConstrTag1 (CmmReg nodeReg)
+                          let tag_expr = cmmConstrTag1 dflags (CmmReg nodeReg)
                               branches' = [(tag+1,branch)|(tag,branch)<-branches]
                           emitSwitch tag_expr branches' mb_deflt 1 fam_sz
                         else do -- no, get tag from info table
-                          dflags <- getDynFlags
                           let -- Note that ptr _always_ has tag 1
                               -- when the family size is big enough
                               untagged_ptr = cmmRegOffB nodeReg (-1)
@@ -296,7 +296,7 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
 -- This lives in the SRT field of the info table
 -- (constructors don't need SRTs).
 getConstrTag dflags closure_ptr
-  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) wordWidth) [infoTableConstrTag dflags info_table]
+  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) (wordWidth dflags)) [infoTableConstrTag dflags info_table]
   where
     info_table = infoTable dflags (closureInfoPtr dflags closure_ptr)
 
@@ -304,7 +304,7 @@ cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr
 -- Takes a closure pointer, and return the closure type
 -- obtained from the info table
 cmmGetClosureType dflags closure_ptr
-  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) wordWidth) [infoTableClosureType dflags info_table]
+  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) (wordWidth dflags)) [infoTableClosureType dflags info_table]
   where
     info_table = infoTable dflags (closureInfoPtr dflags closure_ptr)
 
index aaa97a2..1accdbe 100644 (file)
@@ -62,7 +62,7 @@ emitPrimOp :: DynFlags
 --  First we handle various awkward cases specially.  The remaining
 -- easy cases are then handled by translateOp, defined below.
 
-emitPrimOp _      [res_r,res_c] IntAddCOp [aa,bb] _
+emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb] _
 {-
    With some bit-twiddling, we can define int{Add,Sub}Czh portably in
    C, and without needing any comparisons.  This may not be the
@@ -84,19 +84,19 @@ emitPrimOp _      [res_r,res_c] IntAddCOp [aa,bb] _
 
 -}
    = stmtsC [
-        CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
+        CmmAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),
         CmmAssign (CmmLocal res_c) $
-          CmmMachOp mo_wordUShr [
-                CmmMachOp mo_wordAnd [
-                    CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
-                    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
+          CmmMachOp (mo_wordUShr dflags) [
+                CmmMachOp (mo_wordAnd dflags) [
+                    CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
+                    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
                 ],
-                mkIntExpr (wORD_SIZE_IN_BITS - 1)
+                mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
           ]
      ]
 
 
-emitPrimOp _      [res_r,res_c] IntSubCOp [aa,bb] _
+emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb] _
 {- Similarly:
    #define subIntCzh(r,c,a,b)                                   \
    { r = ((I_)(a)) - ((I_)(b));                                 \
@@ -107,14 +107,14 @@ emitPrimOp _      [res_r,res_c] IntSubCOp [aa,bb] _
    c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
 -}
    = stmtsC [
-        CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
+        CmmAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),
         CmmAssign (CmmLocal res_c) $
-          CmmMachOp mo_wordUShr [
-                CmmMachOp mo_wordAnd [
-                    CmmMachOp mo_wordXor [aa,bb],
-                    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
+          CmmMachOp (mo_wordUShr dflags) [
+                CmmMachOp (mo_wordAnd dflags) [
+                    CmmMachOp (mo_wordXor dflags) [aa,bb],
+                    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
                 ],
-                mkIntExpr (wORD_SIZE_IN_BITS - 1)
+                mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
           ]
      ]
 
@@ -160,8 +160,8 @@ emitPrimOp dflags [res] GetCCSOfOp [arg] _live
   = stmtC (CmmAssign (CmmLocal res) val)
   where
     val
-     | dopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag arg)
-     | otherwise                      = CmmLit zeroCLit
+     | dopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
+     | otherwise                      = CmmLit (zeroCLit dflags)
 
 emitPrimOp _      [res] GetCurrentCCSOp [_dummy_arg] _live
    = stmtC (CmmAssign (CmmLocal res) curCCS)
@@ -210,14 +210,14 @@ emitPrimOp dflags [res] StableNameToIntOp [arg] _
 --  #define eqStableNamezh(r,sn1,sn2)                                   \
 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 emitPrimOp dflags [res] EqStableNameOp [arg1,arg2] _
-   = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
+   = stmtC (CmmAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [
                              cmmLoadIndexW dflags arg1 (fixedHdrSize dflags) (bWord dflags),
                              cmmLoadIndexW dflags arg2 (fixedHdrSize dflags) (bWord dflags)
                       ]))
 
 
-emitPrimOp _      [res] ReallyUnsafePtrEqualityOp [arg1,arg2] _
-   = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
+emitPrimOp dflags [res] ReallyUnsafePtrEqualityOp [arg1,arg2] _
+   = stmtC (CmmAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [arg1,arg2]))
 
 --  #define addrToHValuezh(r,a) r=(P_)a
 emitPrimOp _      [res] AddrToAnyOp [arg] _
@@ -226,7 +226,7 @@ emitPrimOp _      [res] AddrToAnyOp [arg] _
 --  #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
 --  Note: argument may be tagged!
 emitPrimOp dflags [res] DataToTagOp [arg] _
-   = stmtC (CmmAssign (CmmLocal res) (getConstrTag dflags (cmmUntag arg)))
+   = stmtC (CmmAssign (CmmLocal res) (getConstrTag dflags (cmmUntag dflags arg)))
 
 {- Freezing arrays-of-ptrs requires changing an info table, for the
    benefit of the generational collector.  It needs to scavenge mutable
@@ -296,116 +296,116 @@ emitPrimOp dflags [res] SizeofMutableArrayArrayOp [arg] live
 
 -- IndexXXXoffAddr
 
-emitPrimOp _      res IndexOffAddrOp_Char      args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
-emitPrimOp _      res IndexOffAddrOp_WideChar  args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res IndexOffAddrOp_Char      args _ = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args
+emitPrimOp dflags res IndexOffAddrOp_WideChar  args _ = doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp dflags res IndexOffAddrOp_Int       args _ = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res IndexOffAddrOp_Word      args _ = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res IndexOffAddrOp_Addr      args _ = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp _      res IndexOffAddrOp_Float     args _ = doIndexOffAddrOp Nothing f32 res args
 emitPrimOp _      res IndexOffAddrOp_Double    args _ = doIndexOffAddrOp Nothing f64 res args
 emitPrimOp dflags res IndexOffAddrOp_StablePtr args _ = doIndexOffAddrOp Nothing (bWord dflags) res args
-emitPrimOp _      res IndexOffAddrOp_Int8      args _ = doIndexOffAddrOp (Just mo_s_8ToWord)  b8  res args
-emitPrimOp _      res IndexOffAddrOp_Int16     args _ = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
-emitPrimOp _      res IndexOffAddrOp_Int32     args _ = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
+emitPrimOp dflags res IndexOffAddrOp_Int8      args _ = doIndexOffAddrOp (Just (mo_s_8ToWord dflags))  b8  res args
+emitPrimOp dflags res IndexOffAddrOp_Int16     args _ = doIndexOffAddrOp (Just (mo_s_16ToWord dflags)) b16 res args
+emitPrimOp dflags res IndexOffAddrOp_Int32     args _ = doIndexOffAddrOp (Just (mo_s_32ToWord dflags)) b32 res args
 emitPrimOp _      res IndexOffAddrOp_Int64     args _ = doIndexOffAddrOp Nothing b64 res args
-emitPrimOp _      res IndexOffAddrOp_Word8     args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8   res args
-emitPrimOp _      res IndexOffAddrOp_Word16    args _ = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
-emitPrimOp _      res IndexOffAddrOp_Word32    args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res IndexOffAddrOp_Word8     args _ = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8   res args
+emitPrimOp dflags res IndexOffAddrOp_Word16    args _ = doIndexOffAddrOp (Just (mo_u_16ToWord dflags)) b16 res args
+emitPrimOp dflags res IndexOffAddrOp_Word32    args _ = doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp _      res IndexOffAddrOp_Word64    args _ = doIndexOffAddrOp Nothing b64 res args
 
 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
 
-emitPrimOp _      res ReadOffAddrOp_Char      args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
-emitPrimOp _      res ReadOffAddrOp_WideChar  args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res ReadOffAddrOp_Char      args _ = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args
+emitPrimOp dflags res ReadOffAddrOp_WideChar  args _ = doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp dflags res ReadOffAddrOp_Int       args _ = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res ReadOffAddrOp_Word      args _ = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res ReadOffAddrOp_Addr      args _ = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp _      res ReadOffAddrOp_Float     args _ = doIndexOffAddrOp Nothing f32 res args
 emitPrimOp _      res ReadOffAddrOp_Double    args _ = doIndexOffAddrOp Nothing f64 res args
 emitPrimOp dflags res ReadOffAddrOp_StablePtr args _ = doIndexOffAddrOp Nothing (bWord dflags) res args
-emitPrimOp _      res ReadOffAddrOp_Int8      args _ = doIndexOffAddrOp (Just mo_s_8ToWord) b8  res args
-emitPrimOp _      res ReadOffAddrOp_Int16     args _ = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
-emitPrimOp _      res ReadOffAddrOp_Int32     args _ = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
+emitPrimOp dflags res ReadOffAddrOp_Int8      args _ = doIndexOffAddrOp (Just (mo_s_8ToWord dflags)) b8  res args
+emitPrimOp dflags res ReadOffAddrOp_Int16     args _ = doIndexOffAddrOp (Just (mo_s_16ToWord dflags)) b16 res args
+emitPrimOp dflags res ReadOffAddrOp_Int32     args _ = doIndexOffAddrOp (Just (mo_s_32ToWord dflags)) b32 res args
 emitPrimOp _      res ReadOffAddrOp_Int64     args _ = doIndexOffAddrOp Nothing b64 res args
-emitPrimOp _      res ReadOffAddrOp_Word8     args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8  res args
-emitPrimOp _      res ReadOffAddrOp_Word16    args _ = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
-emitPrimOp _      res ReadOffAddrOp_Word32    args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res ReadOffAddrOp_Word8     args _ = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8  res args
+emitPrimOp dflags res ReadOffAddrOp_Word16    args _ = doIndexOffAddrOp (Just (mo_u_16ToWord dflags)) b16 res args
+emitPrimOp dflags res ReadOffAddrOp_Word32    args _ = doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp _      res ReadOffAddrOp_Word64    args _ = doIndexOffAddrOp Nothing b64 res args
 
 -- IndexXXXArray
 
-emitPrimOp _      res IndexByteArrayOp_Char      args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
-emitPrimOp _      res IndexByteArrayOp_WideChar  args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res IndexByteArrayOp_Char      args _ = doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8 res args
+emitPrimOp dflags res IndexByteArrayOp_WideChar  args _ = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp dflags res IndexByteArrayOp_Int       args _ = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res IndexByteArrayOp_Word      args _ = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res IndexByteArrayOp_Addr      args _ = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp _      res IndexByteArrayOp_Float     args _ = doIndexByteArrayOp Nothing f32 res args
 emitPrimOp _      res IndexByteArrayOp_Double    args _ = doIndexByteArrayOp Nothing f64 res args
 emitPrimOp dflags res IndexByteArrayOp_StablePtr args _ = doIndexByteArrayOp Nothing (bWord dflags) res args
-emitPrimOp _      res IndexByteArrayOp_Int8      args _ = doIndexByteArrayOp (Just mo_s_8ToWord) b8  res args
-emitPrimOp _      res IndexByteArrayOp_Int16     args _ = doIndexByteArrayOp (Just mo_s_16ToWord) b16  res args
-emitPrimOp _      res IndexByteArrayOp_Int32     args _ = doIndexByteArrayOp (Just mo_s_32ToWord) b32  res args
+emitPrimOp dflags res IndexByteArrayOp_Int8      args _ = doIndexByteArrayOp (Just (mo_s_8ToWord dflags)) b8  res args
+emitPrimOp dflags res IndexByteArrayOp_Int16     args _ = doIndexByteArrayOp (Just (mo_s_16ToWord dflags)) b16  res args
+emitPrimOp dflags res IndexByteArrayOp_Int32     args _ = doIndexByteArrayOp (Just (mo_s_32ToWord dflags)) b32  res args
 emitPrimOp _      res IndexByteArrayOp_Int64     args _ = doIndexByteArrayOp Nothing b64  res args
-emitPrimOp _      res IndexByteArrayOp_Word8     args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8  res args
-emitPrimOp _      res IndexByteArrayOp_Word16    args _ = doIndexByteArrayOp (Just mo_u_16ToWord) b16  res args
-emitPrimOp _      res IndexByteArrayOp_Word32    args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32  res args
+emitPrimOp dflags res IndexByteArrayOp_Word8     args _ = doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8  res args
+emitPrimOp dflags res IndexByteArrayOp_Word16    args _ = doIndexByteArrayOp (Just (mo_u_16ToWord dflags)) b16  res args
+emitPrimOp dflags res IndexByteArrayOp_Word32    args _ = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32  res args
 emitPrimOp _      res IndexByteArrayOp_Word64    args _ = doIndexByteArrayOp Nothing b64  res args
 
 -- ReadXXXArray, identical to IndexXXXArray.
 
-emitPrimOp _      res ReadByteArrayOp_Char       args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
-emitPrimOp _      res ReadByteArrayOp_WideChar   args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res ReadByteArrayOp_Char       args _ = doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8 res args
+emitPrimOp dflags res ReadByteArrayOp_WideChar   args _ = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp dflags res ReadByteArrayOp_Int        args _ = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res ReadByteArrayOp_Word       args _ = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res ReadByteArrayOp_Addr       args _ = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp _      res ReadByteArrayOp_Float      args _ = doIndexByteArrayOp Nothing f32 res args
 emitPrimOp _      res ReadByteArrayOp_Double     args _ = doIndexByteArrayOp Nothing f64 res args
 emitPrimOp dflags res ReadByteArrayOp_StablePtr  args _ = doIndexByteArrayOp Nothing (bWord dflags) res args
-emitPrimOp _      res ReadByteArrayOp_Int8       args _ = doIndexByteArrayOp (Just mo_s_8ToWord) b8  res args
-emitPrimOp _      res ReadByteArrayOp_Int16      args _ = doIndexByteArrayOp (Just mo_s_16ToWord) b16  res args
-emitPrimOp _      res ReadByteArrayOp_Int32      args _ = doIndexByteArrayOp (Just mo_s_32ToWord) b32  res args
+emitPrimOp dflags res ReadByteArrayOp_Int8       args _ = doIndexByteArrayOp (Just (mo_s_8ToWord dflags)) b8  res args
+emitPrimOp dflags res ReadByteArrayOp_Int16      args _ = doIndexByteArrayOp (Just (mo_s_16ToWord dflags)) b16  res args
+emitPrimOp dflags res ReadByteArrayOp_Int32      args _ = doIndexByteArrayOp (Just (mo_s_32ToWord dflags)) b32  res args
 emitPrimOp _      res ReadByteArrayOp_Int64      args _ = doIndexByteArrayOp Nothing b64  res args
-emitPrimOp _      res ReadByteArrayOp_Word8      args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8  res args
-emitPrimOp _      res ReadByteArrayOp_Word16     args _ = doIndexByteArrayOp (Just mo_u_16ToWord) b16  res args
-emitPrimOp _      res ReadByteArrayOp_Word32     args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32  res args
+emitPrimOp dflags res ReadByteArrayOp_Word8      args _ = doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8  res args
+emitPrimOp dflags res ReadByteArrayOp_Word16     args _ = doIndexByteArrayOp (Just (mo_u_16ToWord dflags)) b16  res args
+emitPrimOp dflags res ReadByteArrayOp_Word32     args _ = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32  res args
 emitPrimOp _      res ReadByteArrayOp_Word64     args _ = doIndexByteArrayOp Nothing b64  res args
 
 -- WriteXXXoffAddr
 
-emitPrimOp _      res WriteOffAddrOp_Char       args _ = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
-emitPrimOp _      res WriteOffAddrOp_WideChar   args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
+emitPrimOp dflags res WriteOffAddrOp_Char       args _ = doWriteOffAddrOp (Just (mo_WordTo8 dflags)) b8 res args
+emitPrimOp dflags res WriteOffAddrOp_WideChar   args _ = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
 emitPrimOp dflags res WriteOffAddrOp_Int        args _ = doWriteOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res WriteOffAddrOp_Word       args _ = doWriteOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res WriteOffAddrOp_Addr       args _ = doWriteOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp _      res WriteOffAddrOp_Float      args _ = doWriteOffAddrOp Nothing f32 res args
 emitPrimOp _      res WriteOffAddrOp_Double     args _ = doWriteOffAddrOp Nothing f64 res args
 emitPrimOp dflags res WriteOffAddrOp_StablePtr  args _ = doWriteOffAddrOp Nothing (bWord dflags) res args
-emitPrimOp _      res WriteOffAddrOp_Int8       args _ = doWriteOffAddrOp (Just mo_WordTo8) b8  res args
-emitPrimOp _      res WriteOffAddrOp_Int16      args _ = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
-emitPrimOp _      res WriteOffAddrOp_Int32      args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
+emitPrimOp dflags res WriteOffAddrOp_Int8       args _ = doWriteOffAddrOp (Just (mo_WordTo8 dflags)) b8  res args
+emitPrimOp dflags res WriteOffAddrOp_Int16      args _ = doWriteOffAddrOp (Just (mo_WordTo16 dflags)) b16 res args
+emitPrimOp dflags res WriteOffAddrOp_Int32      args _ = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
 emitPrimOp _      res WriteOffAddrOp_Int64      args _ = doWriteOffAddrOp Nothing b64 res args
-emitPrimOp _      res WriteOffAddrOp_Word8      args _ = doWriteOffAddrOp (Just mo_WordTo8) b8  res args
-emitPrimOp _      res WriteOffAddrOp_Word16     args _ = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
-emitPrimOp _      res WriteOffAddrOp_Word32     args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
+emitPrimOp dflags res WriteOffAddrOp_Word8      args _ = doWriteOffAddrOp (Just (mo_WordTo8 dflags)) b8  res args
+emitPrimOp dflags res WriteOffAddrOp_Word16     args _ = doWriteOffAddrOp (Just (mo_WordTo16 dflags)) b16 res args
+emitPrimOp dflags res WriteOffAddrOp_Word32     args _ = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
 emitPrimOp _      res WriteOffAddrOp_Word64     args _ = doWriteOffAddrOp Nothing b64 res args
 
 -- WriteXXXArray
 
-emitPrimOp _      res WriteByteArrayOp_Char      args _ = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
-emitPrimOp _      res WriteByteArrayOp_WideChar  args _ = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
+emitPrimOp dflags res WriteByteArrayOp_Char      args _ = doWriteByteArrayOp (Just (mo_WordTo8 dflags)) b8 res args
+emitPrimOp dflags res WriteByteArrayOp_WideChar  args _ = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args
 emitPrimOp dflags res WriteByteArrayOp_Int       args _ = doWriteByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res WriteByteArrayOp_Word      args _ = doWriteByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res WriteByteArrayOp_Addr      args _ = doWriteByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp _      res WriteByteArrayOp_Float     args _ = doWriteByteArrayOp Nothing f32 res args
 emitPrimOp _      res WriteByteArrayOp_Double    args _ = doWriteByteArrayOp Nothing f64 res args
 emitPrimOp dflags res WriteByteArrayOp_StablePtr args _ = doWriteByteArrayOp Nothing (bWord dflags) res args
-emitPrimOp _      res WriteByteArrayOp_Int8      args _ = doWriteByteArrayOp (Just mo_WordTo8) b8  res args
-emitPrimOp _      res WriteByteArrayOp_Int16     args _ = doWriteByteArrayOp (Just mo_WordTo16) b16  res args
-emitPrimOp _      res WriteByteArrayOp_Int32     args _ = doWriteByteArrayOp (Just mo_WordTo32) b32  res args
+emitPrimOp dflags res WriteByteArrayOp_Int8      args _ = doWriteByteArrayOp (Just (mo_WordTo8 dflags)) b8  res args
+emitPrimOp dflags res WriteByteArrayOp_Int16     args _ = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b16  res args
+emitPrimOp dflags res WriteByteArrayOp_Int32     args _ = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32  res args
 emitPrimOp _      res WriteByteArrayOp_Int64     args _ = doWriteByteArrayOp Nothing b64  res args
-emitPrimOp _      res WriteByteArrayOp_Word8     args _ = doWriteByteArrayOp (Just mo_WordTo8) b8  res args
-emitPrimOp _      res WriteByteArrayOp_Word16    args _ = doWriteByteArrayOp (Just mo_WordTo16) b16  res args
-emitPrimOp _      res WriteByteArrayOp_Word32    args _ = doWriteByteArrayOp (Just mo_WordTo32) b32  res args
+emitPrimOp dflags res WriteByteArrayOp_Word8     args _ = doWriteByteArrayOp (Just (mo_WordTo8 dflags)) b8  res args
+emitPrimOp dflags res WriteByteArrayOp_Word16    args _ = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b16  res args
+emitPrimOp dflags res WriteByteArrayOp_Word32    args _ = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32  res args
 emitPrimOp _      res WriteByteArrayOp_Word64    args _ = doWriteByteArrayOp Nothing b64  res args
 
 -- Copying and setting byte arrays
@@ -422,27 +422,27 @@ emitPrimOp _ [] SetByteArrayOp [ba,off,len,c] live =
 -- to the correct width before calling the primop.  Otherwise this can result
 -- in a crash e.g. when calling the helper hs_popcnt8() which assumes that the
 -- argument is <=0xff.
-emitPrimOp _ [res] PopCnt8Op [w] live =
-  emitPopCntCall res (CmmMachOp mo_WordTo8 [w]) W8 live
-emitPrimOp _ [res] PopCnt16Op [w] live =
-  emitPopCntCall res (CmmMachOp mo_WordTo16 [w]) W16 live
-emitPrimOp _ [res] PopCnt32Op [w] live =
-  emitPopCntCall res (CmmMachOp mo_WordTo32 [w]) W32 live
-emitPrimOp _ [res] PopCnt64Op [w] live =
-  emitPopCntCall res (CmmMachOp mo_WordTo64 [w]) W64 live
-emitPrimOp _ [res] PopCntOp [w] live =
-  emitPopCntCall res w wordWidth live
+emitPrimOp dflags [res] PopCnt8Op [w] live =
+  emitPopCntCall res (CmmMachOp (mo_WordTo8 dflags) [w]) W8 live
+emitPrimOp dflags [res] PopCnt16Op [w] live =
+  emitPopCntCall res (CmmMachOp (mo_WordTo16 dflags) [w]) W16 live
+emitPrimOp dflags [res] PopCnt32Op [w] live =
+  emitPopCntCall res (CmmMachOp (mo_WordTo32 dflags) [w]) W32 live
+emitPrimOp dflags [res] PopCnt64Op [w] live =
+  emitPopCntCall res (CmmMachOp (mo_WordTo64 dflags) [w]) W64 live
+emitPrimOp dflags [res] PopCntOp [w] live =
+  emitPopCntCall res w (wordWidth dflags) live
 
 -- The rest just translate straightforwardly
-emitPrimOp _ [res] op [arg] _
+emitPrimOp dflags [res] op [arg] _
    | nopOp op
    = stmtC (CmmAssign (CmmLocal res) arg)
 
    | Just (mop,rep) <- narrowOp op
    = stmtC (CmmAssign (CmmLocal res) $
-            CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
+            CmmMachOp (mop rep (wordWidth dflags)) [CmmMachOp (mop (wordWidth dflags) rep) [arg]])
 
-emitPrimOp _ [res] op args live
+emitPrimOp dflags [res] op args live
    | Just prim <- callishOp op
    = do vols <- getVolatileRegs live
         emitForeignCall' PlayRisky
@@ -453,30 +453,30 @@ emitPrimOp _ [res] op args live
            NoC_SRT -- No SRT b/c we do PlayRisky
            CmmMayReturn
 
-   | Just mop <- translateOp op
+   | Just mop <- translateOp dflags op
    = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
      stmtC stmt
 
-emitPrimOp _ [res_q, res_r] IntQuotRemOp [arg_x, arg_y] _
+emitPrimOp dflags [res_q, res_r] IntQuotRemOp [arg_x, arg_y] _
     = let genericImpl
               = [CmmAssign (CmmLocal res_q)
-                           (CmmMachOp (MO_S_Quot wordWidth) [arg_x, arg_y]),
+                           (CmmMachOp (MO_S_Quot (wordWidth dflags)) [arg_x, arg_y]),
                  CmmAssign (CmmLocal res_r)
-                           (CmmMachOp (MO_S_Rem  wordWidth) [arg_x, arg_y])]
-          stmt = CmmCall (CmmPrim (MO_S_QuotRem wordWidth) (Just genericImpl))
+                           (CmmMachOp (MO_S_Rem  (wordWidth dflags)) [arg_x, arg_y])]
+          stmt = CmmCall (CmmPrim (MO_S_QuotRem (wordWidth dflags)) (Just genericImpl))
                          [CmmHinted res_q NoHint,
                           CmmHinted res_r NoHint]
                          [CmmHinted arg_x NoHint,
                           CmmHinted arg_y NoHint]
                          CmmMayReturn
       in stmtC stmt
-emitPrimOp _ [res_q, res_r] WordQuotRemOp [arg_x, arg_y] _
+emitPrimOp dflags [res_q, res_r] WordQuotRemOp [arg_x, arg_y] _
     = let genericImpl
               = [CmmAssign (CmmLocal res_q)
-                           (CmmMachOp (MO_U_Quot wordWidth) [arg_x, arg_y]),
+                           (CmmMachOp (MO_U_Quot (wordWidth dflags)) [arg_x, arg_y]),
                  CmmAssign (CmmLocal res_r)
-                           (CmmMachOp (MO_U_Rem  wordWidth) [arg_x, arg_y])]
-          stmt = CmmCall (CmmPrim (MO_U_QuotRem wordWidth) (Just genericImpl))
+                           (CmmMachOp (MO_U_Rem  (wordWidth dflags)) [arg_x, arg_y])]
+          stmt = CmmCall (CmmPrim (MO_U_QuotRem (wordWidth dflags)) (Just genericImpl))
                          [CmmHinted res_q NoHint,
                           CmmHinted res_r NoHint]
                          [CmmHinted arg_x NoHint,
@@ -485,17 +485,17 @@ emitPrimOp _ [res_q, res_r] WordQuotRemOp [arg_x, arg_y] _
       in stmtC stmt
 emitPrimOp dflags [res_q, res_r] WordQuotRem2Op [arg_x_high, arg_x_low, arg_y] _
     = do let ty = cmmExprType dflags arg_x_high
-             shl   x i = CmmMachOp (MO_Shl   wordWidth) [x, i]
-             shr   x i = CmmMachOp (MO_U_Shr wordWidth) [x, i]
-             or    x y = CmmMachOp (MO_Or    wordWidth) [x, y]
-             ge    x y = CmmMachOp (MO_U_Ge  wordWidth) [x, y]
-             ne    x y = CmmMachOp (MO_Ne    wordWidth) [x, y]
-             minus x y = CmmMachOp (MO_Sub   wordWidth) [x, y]
-             times x y = CmmMachOp (MO_Mul   wordWidth) [x, y]
+             shl   x i = CmmMachOp (MO_Shl   (wordWidth dflags)) [x, i]
+             shr   x i = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, i]
+             or    x y = CmmMachOp (MO_Or    (wordWidth dflags)) [x, y]
+             ge    x y = CmmMachOp (MO_U_Ge  (wordWidth dflags)) [x, y]
+             ne    x y = CmmMachOp (MO_Ne    (wordWidth dflags)) [x, y]
+             minus x y = CmmMachOp (MO_Sub   (wordWidth dflags)) [x, y]
+             times x y = CmmMachOp (MO_Mul   (wordWidth dflags)) [x, y]
              zero   = lit 0
              one    = lit 1
-             negone = lit (fromIntegral (widthInBits wordWidth) - 1)
-             lit i = CmmLit (CmmInt i wordWidth)
+             negone = lit (fromIntegral (widthInBits (wordWidth dflags)) - 1)
+             lit i = CmmLit (CmmInt i (wordWidth dflags))
              f :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode [CmmStmt]
              f 0 acc high _ = return [CmmAssign (CmmLocal res_q) acc,
                                       CmmAssign (CmmLocal res_r) high]
@@ -526,8 +526,8 @@ emitPrimOp dflags [res_q, res_r] WordQuotRem2Op [arg_x_high, arg_x_low, arg_y] _
                                       (CmmReg (CmmLocal rhigh''))
                                       (CmmReg (CmmLocal rlow'))
                     return (this ++ rest)
-         genericImpl <- f (widthInBits wordWidth) zero arg_x_high arg_x_low
-         let stmt = CmmCall (CmmPrim (MO_U_QuotRem2 wordWidth) (Just genericImpl))
+         genericImpl <- f (widthInBits (wordWidth dflags)) zero arg_x_high arg_x_low
+         let stmt = CmmCall (CmmPrim (MO_U_QuotRem2 (wordWidth dflags)) (Just genericImpl))
                             [CmmHinted res_q NoHint,
                              CmmHinted res_r NoHint]
                             [CmmHinted arg_x_high NoHint,
@@ -552,15 +552,15 @@ emitPrimOp dflags [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
               CmmAssign (CmmLocal res_l)
                   (or (toTopHalf (CmmReg (CmmLocal r2)))
                       (bottomHalf (CmmReg (CmmLocal r1))))]
-               where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
-                     toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
-                     bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
-                     add x y = CmmMachOp (MO_Add wordWidth) [x, y]
-                     or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+               where topHalf x = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, hww]
+                     toTopHalf x = CmmMachOp (MO_Shl (wordWidth dflags)) [x, hww]
+                     bottomHalf x = CmmMachOp (MO_And (wordWidth dflags)) [x, hwm]
+                     add x y = CmmMachOp (MO_Add (wordWidth dflags)) [x, y]
+                     or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]
                      hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth dflags)))
-                                          wordWidth)
-                     hwm = CmmLit (CmmInt (halfWordMask dflags) wordWidth)
-          stmt = CmmCall (CmmPrim (MO_Add2 wordWidth) (Just genericImpl))
+                                          (wordWidth dflags))
+                     hwm = CmmLit (CmmInt (halfWordMask dflags) (wordWidth dflags))
+          stmt = CmmCall (CmmPrim (MO_Add2 (wordWidth dflags)) (Just genericImpl))
                          [CmmHinted res_h NoHint,
                           CmmHinted res_l NoHint]
                          [CmmHinted arg_x NoHint,
@@ -594,17 +594,17 @@ emitPrimOp dflags [res_h, res_l] WordMul2Op [arg_x, arg_y] _
                         topHalf (CmmReg xhyl),
                         topHalf (CmmReg xlyh),
                         topHalf (CmmReg r)])]
-               where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
-                     toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
-                     bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
-                     add x y = CmmMachOp (MO_Add wordWidth) [x, y]
+               where topHalf x = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, hww]
+                     toTopHalf x = CmmMachOp (MO_Shl (wordWidth dflags)) [x, hww]
+                     bottomHalf x = CmmMachOp (MO_And (wordWidth dflags)) [x, hwm]
+                     add x y = CmmMachOp (MO_Add (wordWidth dflags)) [x, y]
                      sum = foldl1 add
-                     mul x y = CmmMachOp (MO_Mul wordWidth) [x, y]
-                     or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+                     mul x y = CmmMachOp (MO_Mul (wordWidth dflags)) [x, y]
+                     or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]
                      hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth dflags)))
-                                          wordWidth)
-                     hwm = CmmLit (CmmInt (halfWordMask dflags) wordWidth)
-          stmt = CmmCall (CmmPrim (MO_U_Mul2 wordWidth) (Just genericImpl))
+                                          (wordWidth dflags))
+                     hwm = CmmLit (CmmInt (halfWordMask dflags) (wordWidth dflags))
+          stmt = CmmCall (CmmPrim (MO_U_Mul2 (wordWidth dflags)) (Just genericImpl))
                          [CmmHinted res_h NoHint,
                           CmmHinted res_l NoHint]
                          [CmmHinted arg_x NoHint,
@@ -643,125 +643,125 @@ narrowOp _              = Nothing
 
 -- Native word signless ops
 
-translateOp :: PrimOp -> Maybe MachOp
-translateOp IntAddOp       = Just mo_wordAdd
-translateOp IntSubOp       = Just mo_wordSub
-translateOp WordAddOp      = Just mo_wordAdd
-translateOp WordSubOp      = Just mo_wordSub
-translateOp AddrAddOp      = Just mo_wordAdd
-translateOp AddrSubOp      = Just mo_wordSub
-
-translateOp IntEqOp        = Just mo_wordEq
-translateOp IntNeOp        = Just mo_wordNe
-translateOp WordEqOp       = Just mo_wordEq
-translateOp WordNeOp       = Just mo_wordNe
-translateOp AddrEqOp       = Just mo_wordEq
-translateOp AddrNeOp       = Just mo_wordNe
-
-translateOp AndOp          = Just mo_wordAnd
-translateOp OrOp           = Just mo_wordOr
-translateOp XorOp          = Just mo_wordXor
-translateOp NotOp          = Just mo_wordNot
-translateOp SllOp          = Just mo_wordShl
-translateOp SrlOp          = Just mo_wordUShr
-
-translateOp AddrRemOp      = Just mo_wordURem
+translateOp :: DynFlags -> PrimOp -> Maybe MachOp
+translateOp dflags IntAddOp       = Just (mo_wordAdd dflags)
+translateOp dflags IntSubOp       = Just (mo_wordSub dflags)
+translateOp dflags WordAddOp      = Just (mo_wordAdd dflags)
+translateOp dflags WordSubOp      = Just (mo_wordSub dflags)
+translateOp dflags AddrAddOp      = Just (mo_wordAdd dflags)
+translateOp dflags AddrSubOp      = Just (mo_wordSub dflags)
+
+translateOp dflags IntEqOp        = Just (mo_wordEq dflags)
+translateOp dflags IntNeOp        = Just (mo_wordNe dflags)
+translateOp dflags WordEqOp       = Just (mo_wordEq dflags)
+translateOp dflags WordNeOp       = Just (mo_wordNe dflags)
+translateOp dflags AddrEqOp       = Just (mo_wordEq dflags)
+translateOp dflags AddrNeOp       = Just (mo_wordNe dflags)
+
+translateOp dflags AndOp          = Just (mo_wordAnd dflags)
+translateOp dflags OrOp           = Just (mo_wordOr dflags)
+translateOp dflags XorOp          = Just (mo_wordXor dflags)
+translateOp dflags NotOp          = Just (mo_wordNot dflags)
+translateOp dflags SllOp          = Just (mo_wordShl dflags)
+translateOp dflags SrlOp          = Just (mo_wordUShr dflags)
+
+translateOp dflags AddrRemOp      = Just (mo_wordURem dflags)
 
 -- Native word signed ops
 
-translateOp IntMulOp        = Just mo_wordMul
-translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordWidth)
-translateOp IntQuotOp       = Just mo_wordSQuot
-translateOp IntRemOp        = Just mo_wordSRem
-translateOp IntNegOp        = Just mo_wordSNeg
+translateOp dflags IntMulOp        = Just (mo_wordMul dflags)
+translateOp dflags IntMulMayOfloOp = Just (MO_S_MulMayOflo (wordWidth dflags))
+translateOp dflags IntQuotOp       = Just (mo_wordSQuot dflags)
+translateOp dflags IntRemOp        = Just (mo_wordSRem dflags)
+translateOp dflags IntNegOp        = Just (mo_wordSNeg dflags)
 
 
-translateOp IntGeOp        = Just mo_wordSGe
-translateOp IntLeOp        = Just mo_wordSLe
-translateOp IntGtOp        = Just mo_wordSGt
-translateOp IntLtOp        = Just mo_wordSLt
+translateOp dflags IntGeOp        = Just (mo_wordSGe dflags)
+translateOp dflags IntLeOp        = Just (mo_wordSLe dflags)
+translateOp dflags IntGtOp        = Just (mo_wordSGt dflags)
+translateOp dflags IntLtOp        = Just (mo_wordSLt dflags)
 
-translateOp ISllOp         = Just mo_wordShl
-translateOp ISraOp         = Just mo_wordSShr
-translateOp ISrlOp         = Just mo_wordUShr
+translateOp dflags ISllOp         = Just (mo_wordShl dflags)
+translateOp dflags ISraOp         = Just (mo_wordSShr dflags)
+translateOp dflags ISrlOp         = Just (mo_wordUShr dflags)
 
 -- Native word unsigned ops
 
-translateOp WordGeOp       = Just mo_wordUGe
-translateOp WordLeOp       = Just mo_wordULe
-translateOp WordGtOp       = Just mo_wordUGt
-translateOp WordLtOp       = Just mo_wordULt
+translateOp dflags WordGeOp       = Just (mo_wordUGe dflags)
+translateOp dflags WordLeOp       = Just (mo_wordULe dflags)
+translateOp dflags WordGtOp       = Just (mo_wordUGt dflags)
+translateOp dflags WordLtOp       = Just (mo_wordULt dflags)
 
-translateOp WordMulOp      = Just mo_wordMul
-translateOp WordQuotOp     = Just mo_wordUQuot
-translateOp WordRemOp      = Just mo_wordURem
+translateOp dflags WordMulOp      = Just (mo_wordMul dflags)
+translateOp dflags WordQuotOp     = Just (mo_wordUQuot dflags)
+translateOp dflags WordRemOp      = Just (mo_wordURem dflags)
 
-translateOp AddrGeOp       = Just mo_wordUGe
-translateOp AddrLeOp       = Just mo_wordULe
-translateOp AddrGtOp       = Just mo_wordUGt
-translateOp AddrLtOp       = Just mo_wordULt
+translateOp dflags AddrGeOp       = Just (mo_wordUGe dflags)
+translateOp dflags AddrLeOp       = Just (mo_wordULe dflags)
+translateOp dflags AddrGtOp       = Just (mo_wordUGt dflags)
+translateOp dflags AddrLtOp       = Just (mo_wordULt dflags)
 
 -- Char# ops
 
-translateOp CharEqOp       = Just (MO_Eq wordWidth)
-translateOp CharNeOp       = Just (MO_Ne wordWidth)
-translateOp CharGeOp       = Just (MO_U_Ge wordWidth)
-translateOp CharLeOp       = Just (MO_U_Le wordWidth)
-translateOp CharGtOp       = Just (MO_U_Gt wordWidth)
-translateOp CharLtOp       = Just (MO_U_Lt wordWidth)
+translateOp dflags CharEqOp       = Just (MO_Eq (wordWidth dflags))
+translateOp dflags CharNeOp       = Just (MO_Ne (wordWidth dflags))
+translateOp dflags CharGeOp       = Just (MO_U_Ge (wordWidth dflags))
+translateOp dflags CharLeOp       = Just (MO_U_Le (wordWidth dflags))
+translateOp dflags CharGtOp       = Just (MO_U_Gt (wordWidth dflags))
+translateOp dflags CharLtOp       = Just (MO_U_Lt (wordWidth dflags))
 
 -- Double ops
 
-translateOp DoubleEqOp     = Just (MO_F_Eq W64)
-translateOp DoubleNeOp     = Just (MO_F_Ne W64)
-translateOp DoubleGeOp     = Just (MO_F_Ge W64)
-translateOp DoubleLeOp     = Just (MO_F_Le W64)
-translateOp DoubleGtOp     = Just (MO_F_Gt W64)
-translateOp DoubleLtOp     = Just (MO_F_Lt W64)
+translateOp _      DoubleEqOp     = Just (MO_F_Eq W64)
+translateOp _      DoubleNeOp     = Just (MO_F_Ne W64)
+translateOp _      DoubleGeOp     = Just (MO_F_Ge W64)
+translateOp _      DoubleLeOp     = Just (MO_F_Le W64)
+translateOp _      DoubleGtOp     = Just (MO_F_Gt W64)
+translateOp _      DoubleLtOp     = Just (MO_F_Lt W64)
 
-translateOp DoubleAddOp    = Just (MO_F_Add W64)
-translateOp DoubleSubOp    = Just (MO_F_Sub W64)
-translateOp DoubleMulOp    = Just (MO_F_Mul W64)
-translateOp DoubleDivOp    = Just (MO_F_Quot W64)
-translateOp DoubleNegOp    = Just (MO_F_Neg W64)
+translateOp _      DoubleAddOp    = Just (MO_F_Add W64)
+translateOp _      DoubleSubOp    = Just (MO_F_Sub W64)
+translateOp _      DoubleMulOp    = Just (MO_F_Mul W64)
+translateOp _      DoubleDivOp    = Just (MO_F_Quot W64)
+translateOp _      DoubleNegOp    = Just (MO_F_Neg W64)
 
 -- Float ops
 
-translateOp FloatEqOp     = Just (MO_F_Eq W32)
-translateOp FloatNeOp     = Just (MO_F_Ne W32)
-translateOp FloatGeOp     = Just (MO_F_Ge W32)
-translateOp FloatLeOp     = Just (MO_F_Le W32)
-translateOp FloatGtOp     = Just (MO_F_Gt W32)
-translateOp FloatLtOp     = Just (MO_F_Lt W32)
+translateOp _      FloatEqOp     = Just (MO_F_Eq W32)
+translateOp _      FloatNeOp     = Just (MO_F_Ne W32)
+translateOp _      FloatGeOp     = Just (MO_F_Ge W32)
+translateOp _      FloatLeOp     = Just (MO_F_Le W32)
+translateOp _      FloatGtOp     = Just (MO_F_Gt W32)
+translateOp _      FloatLtOp     = Just (MO_F_Lt W32)
 
-translateOp FloatAddOp    = Just (MO_F_Add  W32)
-translateOp FloatSubOp    = Just (MO_F_Sub  W32)
-translateOp FloatMulOp    = Just (MO_F_Mul  W32)
-translateOp FloatDivOp    = Just (MO_F_Quot W32)
-translateOp FloatNegOp    = Just (MO_F_Neg  W32)
+translateOp _      FloatAddOp    = Just (MO_F_Add  W32)
+translateOp _      FloatSubOp    = Just (MO_F_Sub  W32)
+translateOp _      FloatMulOp    = Just (MO_F_Mul  W32)
+translateOp _      FloatDivOp    = Just (MO_F_Quot W32)
+translateOp _      FloatNegOp    = Just (MO_F_Neg  W32)
 
 -- Conversions
 
-translateOp Int2DoubleOp   = Just (MO_SF_Conv wordWidth W64)
-translateOp Double2IntOp   = Just (MO_FS_Conv W64 wordWidth)
+translateOp dflags Int2DoubleOp   = Just (MO_SF_Conv (wordWidth dflags) W64)
+translateOp dflags Double2IntOp   = Just (MO_FS_Conv W64 (wordWidth dflags))
 
-translateOp Int2FloatOp    = Just (MO_SF_Conv wordWidth W32)
-translateOp Float2IntOp    = Just (MO_FS_Conv W32 wordWidth)
+translateOp dflags Int2FloatOp    = Just (MO_SF_Conv (wordWidth dflags) W32)
+translateOp dflags Float2IntOp    = Just (MO_FS_Conv W32 (wordWidth dflags))
 
-translateOp Float2DoubleOp = Just (MO_FF_Conv W32 W64)
-translateOp Double2FloatOp = Just (MO_FF_Conv W64 W32)
+translateOp _      Float2DoubleOp = Just (MO_FF_Conv W32 W64)
+translateOp _      Double2FloatOp = Just (MO_FF_Conv W64 W32)
 
 -- Word comparisons masquerading as more exotic things.
 
-translateOp SameMutVarOp           = Just mo_wordEq
-translateOp SameMVarOp             = Just mo_wordEq
-translateOp SameMutableArrayOp     = Just mo_wordEq
-translateOp SameMutableByteArrayOp = Just mo_wordEq
-translateOp SameMutableArrayArrayOp= Just mo_wordEq
-translateOp SameTVarOp             = Just mo_wordEq
-translateOp EqStablePtrOp          = Just mo_wordEq
+translateOp dflags SameMutVarOp           = Just (mo_wordEq dflags)
+translateOp dflags SameMVarOp             = Just (mo_wordEq dflags)
+translateOp dflags SameMutableArrayOp     = Just (mo_wordEq dflags)
+translateOp dflags SameMutableByteArrayOp = Just (mo_wordEq dflags)
+translateOp dflags SameMutableArrayArrayOp= Just (mo_wordEq dflags)
+translateOp dflags SameTVarOp             = Just (mo_wordEq dflags)
+translateOp dflags EqStablePtrOp          = Just (mo_wordEq dflags)
 
-translateOp _ = Nothing
+translateOp _      _ = Nothing
 
 -- These primops are implemented by CallishMachOps, because they sometimes
 -- turn into foreign calls depending on the backend.
@@ -846,7 +846,7 @@ doWritePtrArrayOp addr idx val
           cmmOffsetExpr dflags
            (cmmOffsetExprW dflags (cmmOffsetB dflags addr (arrPtrsHdrSize dflags))
                           (loadArrPtrsSize dflags addr))
-           (card idx)
+           (card dflags idx)
           ) (CmmLit (CmmInt 1 W8))
 
 loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
@@ -900,7 +900,8 @@ doCopyByteArrayOp = emitCopyByteArray copy
     -- Copy data (we assume the arrays aren't overlapping since
     -- they're of different types)
     copy _src _dst dst_p src_p bytes live =
-        emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit 1)) live
+        do dflags <- getDynFlags
+           emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags 1)) live
 
 -- | Takes a source 'MutableByteArray#', an offset in the source
 -- array, a destination 'MutableByteArray#', an offset into the
@@ -915,9 +916,10 @@ doCopyMutableByteArrayOp = emitCopyByteArray copy
     -- we were provided are the same array!
     -- TODO: Optimize branch for common case of no aliasing.
     copy src dst dst_p src_p bytes live =
-        emitIfThenElse (cmmEqWord src dst)
-        (emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit 1)) live)
-        (emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit 1)) live)
+        do dflags <- getDynFlags
+           emitIfThenElse (cmmEqWord dflags src dst)
+               (emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit dflags 1)) live)
+               (emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags 1)) live)
 
 emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                   -> StgLiveVars -> Code)
@@ -941,7 +943,7 @@ doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
 doSetByteArrayOp ba off len c live
     = do dflags <- getDynFlags
          p <- assignTemp $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off
-         emitMemsetCall p c len (CmmLit (mkIntCLit 1)) live
+         emitMemsetCall p c len (CmmLit (mkIntCLit dflags 1)) live
 
 -- ----------------------------------------------------------------------------
 -- Copying pointer arrays
@@ -964,7 +966,8 @@ doCopyArrayOp = emitCopyArray copy
     -- Copy data (we assume the arrays aren't overlapping since
     -- they're of different types)
     copy _src _dst dst_p src_p bytes live =
-        emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)) live
+        do dflags <- getDynFlags
+           emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags wORD_SIZE)) live
 
 -- | Takes a source 'MutableArray#', an offset in the source array, a
 -- destination 'MutableArray#', an offset into the destination array,
@@ -978,9 +981,10 @@ doCopyMutableArrayOp = emitCopyArray copy
     -- we were provided are the same array!
     -- TODO: Optimize branch for common case of no aliasing.
     copy src dst dst_p src_p bytes live =
-        emitIfThenElse (cmmEqWord src dst)
-        (emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)) live)
-        (emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)) live)
+        do dflags <- getDynFlags
+           emitIfThenElse (cmmEqWord dflags src dst)
+               (emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit dflags wORD_SIZE)) live)
+               (emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags wORD_SIZE)) live)
 
 emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                   -> StgLiveVars -> Code)
@@ -1003,7 +1007,7 @@ emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 live = do
     dst_elems_p <- assignTemp $ cmmOffsetB dflags dst (arrPtrsHdrSize dflags)
     dst_p <- assignTemp $ cmmOffsetExprW dflags dst_elems_p dst_off
     src_p <- assignTemp $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off
-    bytes <- assignTemp $ cmmMulWord n (CmmLit (mkIntCLit wORD_SIZE))
+    bytes <- assignTemp $ cmmMulWord dflags n (CmmLit (mkIntCLit dflags wORD_SIZE))
 
     copy src dst dst_p src_p bytes live
 
@@ -1020,20 +1024,24 @@ emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr
                -> StgLiveVars -> Code
 emitCloneArray info_p res_r src0 src_off0 n0 live = do
     dflags <- getDynFlags
+    let arrPtrsHdrSizeW dflags = CmmLit $ mkIntCLit dflags $ fixedHdrSize dflags +
+                                     (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE)
+        myCapability = cmmSubWord dflags (CmmReg baseReg)
+                                         (CmmLit (mkIntCLit dflags oFFSET_Capability_r))
     -- Assign the arguments to temporaries so the code generator can
     -- calculate liveness for us.
     src <- assignTemp_ src0
     src_off <- assignTemp_ src_off0
     n <- assignTemp_ n0
 
-    card_bytes <- assignTemp $ cardRoundUp n
-    size <- assignTemp $ n `cmmAddWord` bytesToWordsRoundUp card_bytes
-    words <- assignTemp $ arrPtrsHdrSizeW dflags `cmmAddWord` size
+    card_bytes <- assignTemp $ cardRoundUp dflags n
+    size <- assignTemp $ cmmAddWord dflags n (bytesToWordsRoundUp dflags card_bytes)
+    words <- assignTemp $ cmmAddWord dflags (arrPtrsHdrSizeW dflags) size
 
     arr_r <- newTemp (bWord dflags)
     emitAllocateCall arr_r myCapability words live
-    tickyAllocPrim (CmmLit (mkIntCLit (arrPtrsHdrSize dflags))) (n `cmmMulWord` wordSize)
-        (CmmLit $ mkIntCLit 0)
+    tickyAllocPrim (CmmLit (mkIntCLit dflags (arrPtrsHdrSize dflags))) (cmmMulWord dflags n (wordSize dflags))
+        (CmmLit $ mkIntCLit dflags 0)
 
     let arr = CmmReg (CmmLocal arr_r)
     emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCS
@@ -1046,47 +1054,45 @@ emitCloneArray info_p res_r src0 src_off0 n0 live = do
     src_p <- assignTemp $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags))
              src_off
 
-    emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize)
-        (CmmLit (mkIntCLit wORD_SIZE)) live
+    emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags))
+        (CmmLit (mkIntCLit dflags wORD_SIZE)) live
 
     emitMemsetCall (cmmOffsetExprW dflags dst_p n)
-        (CmmLit (mkIntCLit 1))
+        (CmmLit (mkIntCLit dflags 1))
         card_bytes
-        (CmmLit (mkIntCLit wORD_SIZE))
+        (CmmLit (mkIntCLit dflags wORD_SIZE))
         live
     stmtC $ CmmAssign (CmmLocal res_r) arr
-  where
-    arrPtrsHdrSizeW dflags = CmmLit $ mkIntCLit $ fixedHdrSize dflags +
-                                 (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE)
-    myCapability = CmmReg baseReg `cmmSubWord`
-                   CmmLit (mkIntCLit oFFSET_Capability_r)
 
 -- | Takes and offset in the destination array, the base address of
 -- the card table, and the number of elements affected (*not* the
 -- number of cards).  Marks the relevant cards as dirty.
 emitSetCards :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
 emitSetCards dst_start dst_cards_start n live = do
-    start_card <- assignTemp $ card dst_start
-    emitMemsetCall (dst_cards_start `cmmAddWord` start_card)
-        (CmmLit (mkIntCLit 1))
-        (cardRoundUp n)
-        (CmmLit (mkIntCLit 1)) -- no alignment (1 byte)
+    dflags <- getDynFlags
+    start_card <- assignTemp $ card dflags dst_start
+    emitMemsetCall (cmmAddWord dflags dst_cards_start start_card)
+        (CmmLit (mkIntCLit dflags 1))
+        (cardRoundUp dflags n)
+        (CmmLit (mkIntCLit dflags 1)) -- no alignment (1 byte)
         live
 
 -- Convert an element index to a card index
-card :: CmmExpr -> CmmExpr
-card i = i `cmmUShrWord` (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS))
+card :: DynFlags -> CmmExpr -> CmmExpr
+card dflags i = cmmUShrWord dflags i (CmmLit (mkIntCLit dflags mUT_ARR_PTRS_CARD_BITS))
 
 -- Convert a number of elements to a number of cards, rounding up
-cardRoundUp :: CmmExpr -> CmmExpr
-cardRoundUp i = card (i `cmmAddWord` (CmmLit (mkIntCLit ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS) - 1))))
+cardRoundUp :: DynFlags -> CmmExpr -> CmmExpr
+cardRoundUp dflags i = card dflags (cmmAddWord dflags i (CmmLit (mkIntCLit dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS) - 1))))
 
-bytesToWordsRoundUp :: CmmExpr -> CmmExpr
-bytesToWordsRoundUp e = (e `cmmAddWord` CmmLit (mkIntCLit (wORD_SIZE - 1)))
-                        `cmmQuotWord` wordSize
+bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr
+bytesToWordsRoundUp dflags e
+    = cmmQuotWord dflags
+          (cmmAddWord dflags e (CmmLit (mkIntCLit dflags (wORD_SIZE - 1))))
+          (wordSize dflags)
 
-wordSize :: CmmExpr
-wordSize = CmmLit (mkIntCLit wORD_SIZE)
+wordSize :: DynFlags -> CmmExpr
+wordSize dflags = CmmLit (mkIntCLit dflags wORD_SIZE)
 
 -- | Emit a call to @memcpy@.
 emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars
index 975787e..87c13ee 100644 (file)
@@ -80,11 +80,11 @@ staticProfHdr :: DynFlags -> CostCentreStack -> [CmmLit]
 -- The profiling header words in a static closure
 -- Was SET_STATIC_PROF_HDR
 staticProfHdr dflags ccs = ifProfilingL dflags [mkCCostCentreStack ccs,
-                                                staticLdvInit]
+                                                staticLdvInit dflags]
 
 dynProfHdr :: DynFlags -> CmmExpr -> [CmmExpr]
 -- Profiling header words in a dynamic closure
-dynProfHdr dflags ccs = ifProfilingL dflags [ccs, dynLdvInit]
+dynProfHdr dflags ccs = ifProfilingL dflags [ccs, dynLdvInit dflags]
 
 initUpdFrameProf :: CmmExpr -> Code
 -- Initialise the profiling field of an update frame
@@ -104,7 +104,7 @@ profDynAlloc :: ClosureInfo -> CmmExpr -> Code
 profDynAlloc cl_info ccs
   = ifProfiling $
     do dflags <- getDynFlags
-       profAlloc (mkIntExpr (closureSize dflags cl_info)) ccs
+       profAlloc (mkIntExpr dflags (closureSize dflags cl_info)) ccs
 
 -- | Record the allocation of a closure (size is given by a CmmExpr)
 -- The size must be in words, because the allocation counter in a CCS counts
@@ -118,9 +118,9 @@ profAlloc words ccs
     do dflags <- getDynFlags
        stmtC (addToMemE alloc_rep
                    (cmmOffsetB dflags ccs oFFSET_CostCentreStack_mem_alloc)
-                   (CmmMachOp (MO_UU_Conv wordWidth alloc_rep) $
-                     [CmmMachOp mo_wordSub [words,
-                                            mkIntExpr (profHdrSize dflags)]]))
+                   (CmmMachOp (MO_UU_Conv (wordWidth dflags) alloc_rep) $
+                     [CmmMachOp (mo_wordSub dflags) [words,
+                                                     mkIntExpr dflags (profHdrSize dflags)]]))
                    -- subtract the "profiling overhead", which is the
                    -- profiling header in a closure.
  where
@@ -175,20 +175,19 @@ emitCostCentreDecl cc = do
                    showPpr dflags (costCentreSrcSpan cc)
            -- XXX going via FastString to get UTF-8 encoding is silly
   ; let
-     lits = [ zero,     -- StgInt ccID,
+     is_caf | isCafCC cc = mkIntCLit dflags (ord 'c') -- 'c' == is a CAF
+            | otherwise  = zero dflags
+     lits = [ zero dflags,     -- StgInt ccID,
               label,    -- char *label,
               modl,     -- char *module,
               loc,      -- char *srcloc,
               zero64,   -- StgWord64 mem_alloc
-              zero,     -- StgWord time_ticks
+              zero dflags,     -- StgWord time_ticks
               is_caf,   -- StgInt is_caf
-              zero      -- struct _CostCentre *link
+              zero dflags      -- struct _CostCentre *link
             ]
   ; emitDataLits (mkCCLabel cc) lits
   }
-  where
-     is_caf | isCafCC cc = mkIntCLit (ord 'c') -- 'c' == is a CAF
-            | otherwise  = zero
 
 
 emitCostCentreStackDecl
@@ -196,20 +195,21 @@ emitCostCentreStackDecl
    -> Code
 emitCostCentreStackDecl ccs
   | Just cc <- maybeSingletonCCS ccs = do
-  { let
+  { dflags <- getDynFlags
+  ; let
         -- Note: to avoid making any assumptions about how the
         -- C compiler (that compiles the RTS, in particular) does
         -- layouts of structs containing long-longs, simply
         -- pad out the struct with zero words until we hit the
         -- size of the overall struct (which we get via DerivedConstants.h)
         --
-     lits = zero : mkCCostCentre cc : replicate (sizeof_ccs_words - 2) zero
+     lits = zero dflags : mkCCostCentre cc : replicate (sizeof_ccs_words - 2) (zero dflags)
   ; emitDataLits (mkCCSLabel ccs) lits
   }
   | otherwise = pprPanic "emitCostCentreStackDecl" (ppr ccs)
 
-zero :: CmmLit
-zero = mkIntCLit 0
+zero :: DynFlags -> CmmLit
+zero dflags = mkIntCLit dflags 0
 zero64 :: CmmLit
 zero64 = CmmInt 0 W64
 
@@ -255,17 +255,17 @@ bumpSccCount dflags ccs
 --
 -- Initial value for the LDV field in a static closure
 --
-staticLdvInit :: CmmLit
+staticLdvInit :: DynFlags -> CmmLit
 staticLdvInit = zeroCLit
 
 --
 -- Initial value of the LDV field in a dynamic closure
 --
-dynLdvInit :: CmmExpr
-dynLdvInit =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE
-  CmmMachOp mo_wordOr [
-      CmmMachOp mo_wordShl [loadEra, mkIntExpr lDV_SHIFT ],
-      CmmLit (mkWordCLit lDV_STATE_CREATE)
+dynLdvInit :: DynFlags -> CmmExpr
+dynLdvInit dflags =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE
+  CmmMachOp (mo_wordOr dflags) [
+      CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags lDV_SHIFT ],
+      CmmLit (mkWordCLit dflags lDV_STATE_CREATE)
   ]
 
 --
@@ -273,7 +273,7 @@ dynLdvInit =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE
 --
 ldvRecordCreate :: CmmExpr -> Code
 ldvRecordCreate closure = do dflags <- getDynFlags
-                             stmtC $ CmmStore (ldvWord dflags closure) dynLdvInit
+                             stmtC $ CmmStore (ldvWord dflags closure) (dynLdvInit dflags)
 
 --
 -- Called when a closure is entered, marks the closure as having been "used".
@@ -295,19 +295,19 @@ ldvEnter cl_ptr = do
   let
         -- don't forget to substract node's tag
     ldv_wd = ldvWord dflags cl_ptr
-    new_ldv_wd = cmmOrWord (cmmAndWord (CmmLoad ldv_wd (bWord dflags))
-                                       (CmmLit (mkWordCLit lDV_CREATE_MASK)))
-                 (cmmOrWord loadEra (CmmLit (mkWordCLit lDV_STATE_USE)))
+    new_ldv_wd = cmmOrWord dflags (cmmAndWord dflags (CmmLoad ldv_wd (bWord dflags))
+                                                     (CmmLit (mkWordCLit dflags lDV_CREATE_MASK)))
+                 (cmmOrWord dflags (loadEra dflags) (CmmLit (mkWordCLit dflags lDV_STATE_USE)))
   ifProfiling $
      -- if (era > 0) {
      --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
      --                era | LDV_STATE_USE }
-    emitIf (CmmMachOp mo_wordUGt [loadEra, CmmLit zeroCLit])
+    emitIf (CmmMachOp (mo_wordUGt dflags) [loadEra dflags, CmmLit (zeroCLit dflags)])
            (stmtC (CmmStore ldv_wd new_ldv_wd))
 
-loadEra :: CmmExpr
-loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth)
-          [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId $ fsLit("era"))) cInt]
+loadEra :: DynFlags -> CmmExpr
+loadEra dflags = CmmMachOp (MO_UU_Conv cIntWidth (wordWidth dflags))
+                           [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId $ fsLit("era"))) cInt]
 
 ldvWord :: DynFlags -> CmmExpr -> CmmExpr
 -- Takes the address of a closure, and returns
index b82e308..5f5ff90 100644 (file)
@@ -193,7 +193,7 @@ performTailCall fun_info arg_amodes pending_assts
     fun_name  = idName fun_id
     lf_info   = cgIdInfoLF fun_info
     fun_has_cafs = idCafInfo fun_id
-    untag_node = CmmAssign nodeReg (cmmUntag (CmmReg nodeReg))
+    untag_node dflags = CmmAssign nodeReg (cmmUntag dflags (CmmReg nodeReg))
     -- Test if closure is a constructor
     maybeSwitchOnCons dflags enterClosure eob
               | EndOfBlockInfo _ (CaseAlts lbl _ _) <- eob,
@@ -203,7 +203,7 @@ performTailCall fun_info arg_amodes pending_assts
               = do { is_constr <- newLabelC
                    -- Is the pointer tagged?
                    -- Yes, jump to switch statement
-                   ; stmtC (CmmCondBranch (cmmIsTagged (CmmReg nodeReg)) 
+                   ; stmtC (CmmCondBranch (cmmIsTagged dflags (CmmReg nodeReg)) 
                                 is_constr)
                    -- No, enter the closure.
                    ; enterClosure
@@ -232,7 +232,7 @@ performTailCall fun_info arg_amodes pending_assts
 -}
               -- No case expression involved, enter the closure.
               | otherwise
-              = do { stmtC untag_node
+              = do { stmtC $ untag_node dflags
                    ; enterClosure
                    }
         where
index bc9a94c..85b07a0 100644 (file)
@@ -98,14 +98,14 @@ emitTickyCounter cl_info args on_stk
 -- krc: note that all the fields are I32 now; some were I16 before, 
 -- but the code generator wasn't handling that properly and it led to chaos, 
 -- panic and disorder.
-           [ mkIntCLit 0,
-             mkIntCLit (length args),-- Arity
-             mkIntCLit on_stk, -- Words passed on stack
+           [ mkIntCLit dflags 0,
+             mkIntCLit dflags (length args),-- Arity
+             mkIntCLit dflags on_stk,  -- Words passed on stack
              fun_descr_lit,
              arg_descr_lit,
-             zeroCLit,                 -- Entry count
-             zeroCLit,                 -- Allocs
-             zeroCLit                  -- Link
+             zeroCLit dflags,          -- Entry count
+             zeroCLit dflags,          -- Allocs
+             zeroCLit dflags                   -- Link
            ] }
   where
     name = closureName cl_info
@@ -179,17 +179,17 @@ registerTickyCtr :: CLabel -> Code
 registerTickyCtr ctr_lbl
   = do dflags <- getDynFlags
        let -- krc: code generator doesn't handle Not, so we test for Eq 0 instead
-           test = CmmMachOp (MO_Eq wordWidth)
+           test = CmmMachOp (MO_Eq (wordWidth dflags))
                      [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl 
                                        oFFSET_StgEntCounter_registeredp)) (bWord dflags),
-                      CmmLit (mkIntCLit 0)]
+                      CmmLit (mkIntCLit dflags 0)]
            register_stmts
              = [ CmmStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_link))
                           (CmmLoad ticky_entry_ctrs (bWord dflags))
                , CmmStore ticky_entry_ctrs (mkLblExpr ctr_lbl)
                , CmmStore (CmmLit (cmmLabelOffB ctr_lbl 
                                        oFFSET_StgEntCounter_registeredp))
-                          (CmmLit (mkIntCLit 1)) ]
+                          (CmmLit (mkIntCLit dflags 1)) ]
            ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
        emitIf test (stmtsC register_stmts)
 
index ca03dfa..2ed464b 100644 (file)
@@ -93,33 +93,34 @@ addIdReps ids = [(idCgRep id, id) | id <- ids]
 
 cgLit :: Literal -> FCode CmmLit
 cgLit (MachStr s) = newByteStringCLit (bytesFB s)
-cgLit other_lit   = return (mkSimpleLit other_lit)
-
-mkSimpleLit :: Literal -> CmmLit
-mkSimpleLit (MachChar   c)    = CmmInt (fromIntegral (ord c)) wordWidth
-mkSimpleLit MachNullAddr      = zeroCLit
-mkSimpleLit (MachInt i)       = CmmInt i wordWidth
-mkSimpleLit (MachInt64 i)     = CmmInt i W64
-mkSimpleLit (MachWord i)      = CmmInt i wordWidth
-mkSimpleLit (MachWord64 i)    = CmmInt i W64
-mkSimpleLit (MachFloat r)     = CmmFloat r W32
-mkSimpleLit (MachDouble r)    = CmmFloat r W64
-mkSimpleLit (MachLabel fs ms fod)
+cgLit other_lit   = do dflags <- getDynFlags
+                       return (mkSimpleLit dflags other_lit)
+
+mkSimpleLit :: DynFlags -> Literal -> CmmLit
+mkSimpleLit dflags (MachChar   c)    = CmmInt (fromIntegral (ord c)) (wordWidth dflags)
+mkSimpleLit dflags MachNullAddr      = zeroCLit dflags
+mkSimpleLit dflags (MachInt i)       = CmmInt i (wordWidth dflags)
+mkSimpleLit _      (MachInt64 i)     = CmmInt i W64
+mkSimpleLit dflags (MachWord i)      = CmmInt i (wordWidth dflags)
+mkSimpleLit _      (MachWord64 i)    = CmmInt i W64
+mkSimpleLit _      (MachFloat r)     = CmmFloat r W32
+mkSimpleLit _      (MachDouble r)    = CmmFloat r W64
+mkSimpleLit _      (MachLabel fs ms fod)
         = CmmLabel (mkForeignLabel fs ms labelSrc fod)
         where
                 -- TODO: Literal labels might not actually be in the current package...
                 labelSrc = ForeignLabelInThisPackage
-mkSimpleLit (MachStr _) = panic "mkSimpleLit: MachStr"
+mkSimpleLit (MachStr _) = panic "mkSimpleLit: MachStr"
 -- No LitInteger's should be left by the time this is called. CorePrep
 -- should have converted them all to a real core representation.
-mkSimpleLit (LitInteger {}) = panic "mkSimpleLit: LitInteger"
+mkSimpleLit (LitInteger {}) = panic "mkSimpleLit: LitInteger"
 
 mkLtOp :: DynFlags -> Literal -> MachOp
 -- On signed literals we must do a signed comparison
-mkLtOp _      (MachInt _)    = MO_S_Lt wordWidth
+mkLtOp dflags (MachInt _)    = MO_S_Lt (wordWidth dflags)
 mkLtOp _      (MachFloat _)  = MO_F_Lt W32
 mkLtOp _      (MachDouble _) = MO_F_Lt W64
-mkLtOp dflags lit            = MO_U_Lt (typeWidth (cmmLitType dflags (mkSimpleLit lit)))
+mkLtOp dflags lit            = MO_U_Lt (typeWidth (cmmLitType dflags (mkSimpleLit dflags lit)))
 
 
 ---------------------------------------------------
@@ -478,12 +479,13 @@ mk_switch _tag_expr [(_tag,stmts)] Nothing _lo_tag _hi_tag _via_C
         -- can't happen, so no need to test
 
 -- SINGLETON BRANCH: one equality check to do
-mk_switch tag_expr [(tag,stmts)] (Just deflt) _lo_tag _hi_tag _via_C
-  = return (CmmCondBranch cond deflt `consCgStmt` stmts)
-  where
-    cond  =  cmmNeWord tag_expr (CmmLit (mkIntCLit tag))
+mk_switch tag_expr [(tag,stmts)] (Just deflt) _lo_tag _hi_tag _via_C = do
+  dflags <- getDynFlags
+  let
+    cond  =  cmmNeWord dflags tag_expr (CmmLit (mkIntCLit dflags tag))
         -- We have lo_tag < hi_tag, but there's only one branch,
         -- so there must be a default
+  return (CmmCondBranch cond deflt `consCgStmt` stmts)
 
 -- ToDo: we might want to check for the two branch case, where one of
 -- the branches is the tag 0, because comparing '== 0' is likely to be
@@ -521,8 +523,9 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
 
   -- if we can knock off a bunch of default cases with one if, then do so
   | Just deflt <- mb_deflt, (lowest_branch - lo_tag) >= n_branches
-  = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
-       ; let cond = cmmULtWord tag_expr' (CmmLit (mkIntCLit lowest_branch))
+  = do { dflags <- getDynFlags
+       ; (assign_tag, tag_expr') <- assignTemp' tag_expr
+       ; let cond = cmmULtWord dflags tag_expr' (CmmLit (mkIntCLit dflags lowest_branch))
              branch = CmmCondBranch cond deflt
        ; stmts <- mk_switch tag_expr' branches mb_deflt
                         lowest_branch hi_tag via_C
@@ -530,8 +533,9 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
        }
 
   | Just deflt <- mb_deflt, (hi_tag - highest_branch) >= n_branches
-  = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
-       ; let cond = cmmUGtWord tag_expr' (CmmLit (mkIntCLit highest_branch))
+  = do { dflags <- getDynFlags
+       ; (assign_tag, tag_expr') <- assignTemp' tag_expr
+       ; let cond = cmmUGtWord dflags tag_expr' (CmmLit (mkIntCLit dflags highest_branch))
              branch = CmmCondBranch cond deflt
        ; stmts <- mk_switch tag_expr' branches mb_deflt
                         lo_tag highest_branch via_C
@@ -539,14 +543,15 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
        }
 
   | otherwise   -- Use an if-tree
-  = do  { (assign_tag, tag_expr') <- assignTemp' tag_expr
+  = do  { dflags <- getDynFlags
+        ; (assign_tag, tag_expr') <- assignTemp' tag_expr
                 -- To avoid duplication
         ; lo_stmts <- mk_switch tag_expr' lo_branches mb_deflt
                                 lo_tag (mid_tag-1) via_C
         ; hi_stmts <- mk_switch tag_expr' hi_branches mb_deflt
                                 mid_tag hi_tag via_C
         ; hi_id <- forkCgStmts hi_stmts
-        ; let cond = cmmUGeWord tag_expr' (CmmLit (mkIntCLit mid_tag))
+        ; let cond = cmmUGeWord dflags tag_expr' (CmmLit (mkIntCLit dflags mid_tag))
               branch_stmt = CmmCondBranch cond hi_id
         ; return (assign_tag `consCgStmt` (branch_stmt `consCgStmt` lo_stmts))
         }
@@ -632,7 +637,7 @@ mk_lit_switch :: CmmExpr -> BlockId
               -> FCode CgStmts
 mk_lit_switch scrut deflt_blk_id [(lit,blk)]
   = do dflags <- getDynFlags
-       let cmm_lit = mkSimpleLit lit
+       let cmm_lit = mkSimpleLit dflags lit
            rep     = cmmLitType dflags cmm_lit
            ne      = if isFloatType rep then MO_F_Ne else MO_Ne
            cond    = CmmMachOp (ne (typeWidth rep)) [scrut, CmmLit cmm_lit]
@@ -655,7 +660,7 @@ mk_lit_switch scrut deflt_blk_id branches
     is_lo (t,_) = t < mid_lit
 
     cond dflags = CmmMachOp (mkLtOp dflags mid_lit)
-                            [scrut, CmmLit (mkSimpleLit mid_lit)]
+                            [scrut, CmmLit (mkSimpleLit dflags mid_lit)]
 
 -------------------------------------------------------------------------
 --
@@ -782,6 +787,7 @@ possiblySameLoc _  _    _          _    = True  -- Conservative
 
 getSRTInfo :: FCode C_SRT
 getSRTInfo = do
+  dflags <- getDynFlags
   srt_lbl <- getSRTLabel
   srt <- getSRT
   case srt of
@@ -795,8 +801,8 @@ getSRTInfo = do
             let srt_desc_lbl = mkLargeSRTLabel id
             emitRODataLits "getSRTInfo" srt_desc_lbl
              ( cmmLabelOffW srt_lbl off
-               : mkWordCLit (fromIntegral len)
-               : map mkWordCLit bmp)
+               : mkWordCLit dflags (fromIntegral len)
+               : map (mkWordCLit dflags) bmp)
             return (C_SRT srt_desc_lbl 0 srt_escape)
 
       | otherwise
@@ -914,10 +920,10 @@ fixStgRegExpr dflags expr
             -- expand it and defer to the above code.
             case reg `elem` activeStgRegs platform of
                 True  -> expr
-                False -> fixStgRegExpr dflags (CmmMachOp (MO_Add wordWidth) [
+                False -> fixStgRegExpr dflags (CmmMachOp (MO_Add (wordWidth dflags)) [
                                     CmmReg (CmmGlobal reg),
                                     CmmLit (CmmInt (fromIntegral offset)
-                                                wordWidth)])
+                                                (wordWidth dflags))])
 
         -- CmmLit, CmmReg (CmmLocal), CmmStackSlot
         _other -> expr
index b3a3fc8..e3383bb 100644 (file)
@@ -458,9 +458,9 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
                       node' = if node_points then Just node else Nothing
                 ; tickyEnterFun cl_info
                 ; enterCostCentreFun cc
-                    (CmmMachOp mo_wordSub
+                    (CmmMachOp (mo_wordSub dflags)
                          [ CmmReg nodeReg
-                         , mkIntExpr (funTag cl_info) ])
+                         , mkIntExpr dflags (funTag cl_info) ])
                 ; whenC node_points (ldvEnterClosure cl_info)
                 ; granYield arg_regs node_points
 
@@ -508,7 +508,7 @@ mkSlowEntryCode cl_info arg_regs -- function closure is already in `Node'
            jump = mkDirectJump dflags
                                (mkLblExpr fast_lbl)
                                (map (CmmReg . CmmLocal) arg_regs)
-                               initUpdFrameOff
+                               (initUpdFrameOff dflags)
        emitProcWithConvention Slow Nothing slow_lbl arg_regs jump
   | otherwise = return ()
 
@@ -716,7 +716,7 @@ link_caf node _is_upd = do
   -- see Note [atomic CAF entry] in rts/sm/Storage.c
   ; updfr  <- getUpdFrameOff
   ; emit =<< mkCmmIfThen
-      (CmmMachOp mo_wordEq [ CmmReg (CmmLocal ret), CmmLit zeroCLit])
+      (CmmMachOp (mo_wordEq dflags) [ CmmReg (CmmLocal ret), CmmLit (zeroCLit dflags)])
         -- re-enter R1.  Doing this directly is slightly dodgy; we're
         -- assuming lots of things, like the stack pointer hasn't
         -- moved since we entered the CAF.
index a87bef1..ccd7d96 100644 (file)
@@ -515,7 +515,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts
         ; if isSmallFamily fam_sz
           then do
                 let   -- Yes, bndr_reg has constr. tag in ls bits
-                   tag_expr = cmmConstrTag1 (CmmReg bndr_reg)
+                   tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg)
                    branches' = [(tag+1,branch) | (tag,branch) <- branches]
                 emitSwitch tag_expr branches' mb_deflt 1 fam_sz
                 return AssignedDirectly
@@ -688,7 +688,7 @@ emitEnter fun = do
       Return _ -> do
         { let entry = entryCode dflags $ closureInfoPtr dflags $ CmmReg nodeReg
         ; emit $ mkForeignJump dflags NativeNodeCall entry
-                    [cmmUntag fun] updfr_off
+                    [cmmUntag dflags fun] updfr_off
         ; return AssignedDirectly
         }
 
@@ -732,7 +732,7 @@ emitEnter fun = do
              the_call = toCall entry (Just lret) updfr_off off outArgs regs
        ; emit $
            copyout <*>
-           mkCbranch (cmmIsTagged (CmmReg nodeReg)) lret lcall <*>
+           mkCbranch (cmmIsTagged dflags (CmmReg nodeReg)) lret lcall <*>
            outOfLine lcall the_call <*>
            mkLabel lret <*>
            copyin
index 0a6b6b9..d6a9b92 100644 (file)
@@ -222,7 +222,7 @@ emitForeignCall safety results target args _ret
     let (off, copyout) = copyInOflow dflags NativeReturn (Young k) results
        -- see Note [safe foreign call convention]
     emit $
-           (    mkStore (CmmStackSlot (Young k) (widthInBytes wordWidth))
+           (    mkStore (CmmStackSlot (Young k) (widthInBytes (wordWidth dflags)))
                         (CmmLit (CmmBlock k))
             <*> mkLast (CmmForeignCall { tgt  = temp_target
                                        , res  = results
@@ -337,10 +337,10 @@ openNursery dflags = catAGraphs [
             (cmmOffsetExpr dflags
                 (CmmLoad (nursery_bdescr_start dflags) (bWord dflags))
                 (cmmOffset dflags
-                  (CmmMachOp mo_wordMul [
-                    CmmMachOp (MO_SS_Conv W32 wordWidth)
+                  (CmmMachOp (mo_wordMul dflags) [
+                    CmmMachOp (MO_SS_Conv W32 (wordWidth dflags))
                       [CmmLoad (nursery_bdescr_blocks dflags) b32],
-                    mkIntExpr bLOCK_SIZE
+                    mkIntExpr dflags bLOCK_SIZE
                    ])
                   (-1)
                 )
index 27d4244..a19810b 100644 (file)
@@ -181,7 +181,7 @@ mkStaticClosureFields dflags info_tbl ccs caf_refs payload
 
     padding
         | not is_caf = []
-        | otherwise  = ASSERT(null payload) [mkIntCLit 0]
+        | otherwise  = ASSERT(null payload) [mkIntCLit dflags 0]
 
     static_link_field
         | is_caf || staticClosureNeedsLink (mayHaveCafRefs caf_refs) info_tbl
@@ -190,15 +190,15 @@ mkStaticClosureFields dflags info_tbl ccs caf_refs payload
         = []
 
     saved_info_field
-        | is_caf     = [mkIntCLit 0]
+        | is_caf     = [mkIntCLit dflags 0]
         | otherwise  = []
 
         -- For a static constructor which has NoCafRefs, we set the
         -- static link field to a non-zero value so the garbage
         -- collector will ignore it.
     static_link_value
-        | mayHaveCafRefs caf_refs  = mkIntCLit 0
-        | otherwise                = mkIntCLit 1  -- No CAF refs
+        | mayHaveCafRefs caf_refs  = mkIntCLit dflags 0
+        | otherwise                = mkIntCLit dflags 1  -- No CAF refs
 
 
 mkStaticClosure :: DynFlags -> CLabel -> CostCentreStack -> [CmmLit]
@@ -401,9 +401,9 @@ entryHeapCheck cl_info nodeSet arity args code
                               W32 -> Just (sLit "stg_gc_f1")
                               W64 -> Just (sLit "stg_gc_d1")
                               _other -> Nothing
-        | width == wordWidth = Just (mkGcLabel "stg_gc_unbx_r1")
-        | width == W64       = Just (mkGcLabel "stg_gc_l1")
-        | otherwise          = Nothing
+        | width == wordWidth dflags = Just (mkGcLabel "stg_gc_unbx_r1")
+        | width == W64              = Just (mkGcLabel "stg_gc_l1")
+        | otherwise                 = Nothing
         where
           ty = localRegType reg
           width = typeWidth ty
@@ -437,11 +437,11 @@ entryHeapCheck cl_info nodeSet arity args code
 --           else we do a normal call to stg_gc_noregs
 
 altHeapCheck :: [LocalReg] -> FCode a -> FCode a
-altHeapCheck regs code
-  = case cannedGCEntryPoint regs of
+altHeapCheck regs code = do
+    dflags <- getDynFlags
+    case cannedGCEntryPoint dflags regs of
       Nothing -> genericGC code
       Just gc -> do
-        dflags <- getDynFlags
         lret <- newLabelC
         let (off, copyin) = copyInOflow dflags NativeReturn (Young lret) regs
         lcont <- newLabelC
@@ -451,9 +451,10 @@ altHeapCheck regs code
 
 altHeapCheckReturnsTo :: [LocalReg] -> Label -> ByteOff -> FCode a -> FCode a
 altHeapCheckReturnsTo regs lret off code
-  = case cannedGCEntryPoint regs of
-      Nothing -> genericGC code
-      Just gc -> cannedGCReturnsTo True gc regs lret off code
+  = do dflags <- getDynFlags
+       case cannedGCEntryPoint dflags regs of
+           Nothing -> genericGC code
+           Just gc -> cannedGCReturnsTo True gc regs lret off code
 
 cannedGCReturnsTo :: Bool -> CmmExpr -> [LocalReg] -> Label -> ByteOff
                   -> FCode a
@@ -478,8 +479,8 @@ genericGC code
        call <- mkCall generic_gc (GC, GC) [] [] updfr_sz (0,[])
        heapCheck False (call <*> mkBranch lretry) code
 
-cannedGCEntryPoint :: [LocalReg] -> Maybe CmmExpr
-cannedGCEntryPoint regs
+cannedGCEntryPoint :: DynFlags -> [LocalReg] -> Maybe CmmExpr
+cannedGCEntryPoint dflags regs
   = case regs of
       []  -> Just (mkGcLabel "stg_gc_noregs")
       [reg]
@@ -489,9 +490,9 @@ cannedGCEntryPoint regs
                                   W64       -> Just (mkGcLabel "stg_gc_d1")
                                   _         -> Nothing
         
-          | width == wordWidth -> Just (mkGcLabel "stg_gc_unbx_r1")
-          | width == W64       -> Just (mkGcLabel "stg_gc_l1")
-          | otherwise          -> Nothing
+          | width == wordWidth dflags -> Just (mkGcLabel "stg_gc_unbx_r1")
+          | width == W64              -> Just (mkGcLabel "stg_gc_l1")
+          | otherwise                 -> Nothing
           where
               ty = localRegType reg
               width = typeWidth ty
@@ -540,15 +541,31 @@ do_checks :: Bool       -- Should we check the stack?
           -> CmmAGraph  -- What to do on failure
           -> FCode ()
 do_checks checkStack alloc do_gc = do
+  dflags <- getDynFlags
+  let
+    alloc_lit = mkIntExpr dflags (alloc*wORD_SIZE) -- Bytes
+    bump_hp = cmmOffsetExprB dflags (CmmReg hpReg) alloc_lit
+
+    -- Sp overflow if (Sp - CmmHighStack < SpLim)
+    sp_oflo = CmmMachOp (mo_wordULt dflags)
+                  [CmmMachOp (MO_Sub (typeWidth (cmmRegType dflags spReg)))
+                             [CmmReg spReg, CmmLit CmmHighStackMark],
+                   CmmReg spLimReg]
+
+    -- Hp overflow if (Hp > HpLim)
+    -- (Hp has been incremented by now)
+    -- HpLim points to the LAST WORD of valid allocation space.
+    hp_oflo = CmmMachOp (mo_wordUGt dflags)
+                        [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
+
+    alloc_n = mkAssign (CmmGlobal HpAlloc) alloc_lit
   gc_id <- newLabelC
 
   when checkStack $ do
-     dflags <- getDynFlags
-     emit =<< mkCmmIfGoto (sp_oflo dflags) gc_id
+     emit =<< mkCmmIfGoto sp_oflo gc_id
 
   when (alloc /= 0) $ do
-     dflags <- getDynFlags
-     emitAssign hpReg (bump_hp dflags)
+     emitAssign hpReg bump_hp
      emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id)
 
   emitOutOfLine gc_id $
@@ -560,24 +577,6 @@ do_checks checkStack alloc do_gc = do
                 -- stack check succeeds.  Otherwise we might end up
                 -- with slop at the end of the current block, which can
                 -- confuse the LDV profiler.
-  where
-    alloc_lit = mkIntExpr (alloc*wORD_SIZE) -- Bytes
-    bump_hp dflags = cmmOffsetExprB dflags (CmmReg hpReg) alloc_lit
-
-    -- Sp overflow if (Sp - CmmHighStack < SpLim)
-    sp_oflo dflags
-            = CmmMachOp mo_wordULt
-                  [CmmMachOp (MO_Sub (typeWidth (cmmRegType dflags spReg)))
-                             [CmmReg spReg, CmmLit CmmHighStackMark],
-                   CmmReg spLimReg]
-
-    -- Hp overflow if (Hp > HpLim)
-    -- (Hp has been incremented by now)
-    -- HpLim points to the LAST WORD of valid allocation space.
-    hp_oflo = CmmMachOp mo_wordUGt
-                  [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
-
-    alloc_n = mkAssign (CmmGlobal HpAlloc) alloc_lit
 
 {-
 
index b670b24..1469554 100644 (file)
@@ -608,7 +608,7 @@ getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
 -- This lives in the SRT field of the info table
 -- (constructors don't need SRTs).
 getConstrTag dflags closure_ptr
-  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) wordWidth) [infoTableConstrTag dflags info_table]
+  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) (wordWidth dflags)) [infoTableConstrTag dflags info_table]
   where
     info_table = infoTable dflags (closureInfoPtr dflags closure_ptr)
 
@@ -616,7 +616,7 @@ cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr
 -- Takes a closure pointer, and return the closure type
 -- obtained from the info table
 cmmGetClosureType dflags closure_ptr
-  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) wordWidth) [infoTableClosureType dflags info_table]
+  = CmmMachOp (MO_UU_Conv (halfWordWidth dflags) (wordWidth dflags)) [infoTableClosureType dflags info_table]
   where
     info_table = infoTable dflags (closureInfoPtr dflags closure_ptr)
 
index 39bd1fe..fb290d8 100644 (file)
@@ -283,15 +283,15 @@ initCgInfoDown dflags mod
   = MkCgInfoDown {     cgd_dflags    = dflags,
                        cgd_mod       = mod,
                        cgd_statics   = emptyVarEnv,
-                        cgd_updfr_off = initUpdFrameOff,
+                        cgd_updfr_off = initUpdFrameOff dflags,
                        cgd_ticky     = mkTopTickyCtrLabel,
                        cgd_sequel    = initSequel }
 
 initSequel :: Sequel
 initSequel = Return False
 
-initUpdFrameOff :: UpdFrameOffset
-initUpdFrameOff = widthInBytes wordWidth -- space for the RA
+initUpdFrameOff :: DynFlags -> UpdFrameOffset
+initUpdFrameOff dflags = widthInBytes (wordWidth dflags) -- space for the RA
 
 
 --------------------------------------------------------
@@ -518,11 +518,12 @@ forkClosureBody :: FCode () -> FCode ()
 -- C-- from the fork is incorporated.
 
 forkClosureBody body_code
-  = do { info <- getInfoDown
+  = do { dflags <- getDynFlags
+       ; info <- getInfoDown
        ; us   <- newUniqSupply
        ; state <- getState
        ; let   body_info_down = info { cgd_sequel    = initSequel
-                                      , cgd_updfr_off = initUpdFrameOff }
+                                      , cgd_updfr_off = initUpdFrameOff dflags }
                fork_state_in = (initCgState us) { cgs_binds = cgs_binds state }
                ((),fork_state_out)
                    = doFCode body_code body_info_down fork_state_in
@@ -534,12 +535,13 @@ forkStatics :: FCode a -> FCode a
 -- The Abstract~C returned is attached to the current state, but the
 -- bindings and usage information is otherwise unchanged.
 forkStatics body_code
-  = do { info  <- getInfoDown
+  = do { dflags <- getDynFlags
+       ; info  <- getInfoDown
        ; us    <- newUniqSupply
        ; state <- getState
        ; let   rhs_info_down = info { cgd_statics = cgs_binds state
                                     , cgd_sequel  = initSequel 
-                                    , cgd_updfr_off = initUpdFrameOff }
+                                    , cgd_updfr_off = initUpdFrameOff dflags }
                (result, fork_state_out) = doFCode body_code rhs_info_down 
                                                   (initCgState us)
        ; setState (state `addCodeBlocksFrom` fork_state_out)
@@ -680,7 +682,7 @@ emitProcWithConvention conv mb_info lbl args blocks
         ; us <- newUniqSupply
         ; let (offset, entry) = mkCallEntry dflags conv args
               blks = initUs_ us $ lgraphOfAGraph $ entry <*> blocks
-        ; let sinfo = StackInfo {arg_space = offset, updfr_space = Just initUpdFrameOff}
+        ; let sinfo = StackInfo {arg_space = offset, updfr_space = Just (initUpdFrameOff dflags)}
               tinfo = TopInfo {info_tbls = infos, stack_info=sinfo}
               proc_block = CmmProc tinfo lbl blks
 
index e16557e..4efb272 100644 (file)
@@ -158,7 +158,7 @@ emitPrimOp :: DynFlags
 -- First we handle various awkward cases specially.  The remaining
 -- easy cases are then handled by translateOp, defined below.
 
-emitPrimOp _ [res_r,res_c] IntAddCOp [aa,bb]
+emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb]
 {- 
    With some bit-twiddling, we can define int{Add,Sub}Czh portably in
    C, and without needing any comparisons.  This may not be the
@@ -180,19 +180,19 @@ emitPrimOp _ [res_r,res_c] IntAddCOp [aa,bb]
 
 -}
    = emit $ catAGraphs [
-        mkAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
+        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),
         mkAssign (CmmLocal res_c) $
-         CmmMachOp mo_wordUShr [
-               CmmMachOp mo_wordAnd [
-                   CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
-                   CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
+         CmmMachOp (mo_wordUShr dflags) [
+               CmmMachOp (mo_wordAnd dflags) [
+                   CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
+                   CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
                ], 
-                mkIntExpr (wORD_SIZE_IN_BITS - 1)
+                mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
          ]
      ]
 
 
-emitPrimOp _ [res_r,res_c] IntSubCOp [aa,bb]
+emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb]
 {- Similarly:
    #define subIntCzh(r,c,a,b)                                  \
    { r = ((I_)(a)) - ((I_)(b));                                        \
@@ -203,14 +203,14 @@ emitPrimOp _ [res_r,res_c] IntSubCOp [aa,bb]
    c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
 -}
    = emit $ catAGraphs [
-        mkAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
+        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),
         mkAssign (CmmLocal res_c) $
-         CmmMachOp mo_wordUShr [
-               CmmMachOp mo_wordAnd [
-                   CmmMachOp mo_wordXor [aa,bb],
-                   CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
+         CmmMachOp (mo_wordUShr dflags) [
+               CmmMachOp (mo_wordAnd dflags) [
+                   CmmMachOp (mo_wordXor dflags) [aa,bb],
+                   CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
                ], 
-                mkIntExpr (wORD_SIZE_IN_BITS - 1)
+                mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
          ]
      ]
 
@@ -241,8 +241,8 @@ emitPrimOp dflags [res] GetCCSOfOp [arg]
   = emitAssign (CmmLocal res) val
   where
     val
-     | dopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag arg)
-     | otherwise                      = CmmLit zeroCLit
+     | dopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
+     | otherwise                      = CmmLit (zeroCLit dflags)
 
 emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg]
    = emitAssign (CmmLocal res) curCCS
@@ -283,14 +283,14 @@ emitPrimOp dflags [res] StableNameToIntOp [arg]
 --  #define eqStableNamezh(r,sn1,sn2)                                  \
 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 emitPrimOp dflags [res] EqStableNameOp [arg1,arg2]
-   = emitAssign (CmmLocal res) (CmmMachOp mo_wordEq [
+   = emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [
                                    cmmLoadIndexW dflags arg1 (fixedHdrSize dflags) (bWord dflags),
                                    cmmLoadIndexW dflags arg2 (fixedHdrSize dflags) (bWord dflags)
                          ])
 
 
-emitPrimOp _      [res] ReallyUnsafePtrEqualityOp [arg1,arg2]
-   = emitAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2])
+emitPrimOp dflags [res] ReallyUnsafePtrEqualityOp [arg1,arg2]
+   = emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [arg1,arg2])
 
 --  #define addrToHValuezh(r,a) r=(P_)a
 emitPrimOp _      [res] AddrToAnyOp [arg]
@@ -299,7 +299,7 @@ emitPrimOp _      [res] AddrToAnyOp [arg]
 --  #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
 --  Note: argument may be tagged!
 emitPrimOp dflags [res] DataToTagOp [arg]
-   = emitAssign (CmmLocal res) (getConstrTag dflags (cmmUntag arg))
+   = emitAssign (CmmLocal res) (getConstrTag dflags (cmmUntag dflags arg))
 
 {- Freezing arrays-of-ptrs requires changing an info table, for the
    benefit of the generational collector.  It needs to scavenge mutable
@@ -372,116 +372,116 @@ emitPrimOp dflags [res] SizeofMutableArrayArrayOp [arg]
 
 -- IndexXXXoffAddr
 
-emitPrimOp _      res IndexOffAddrOp_Char      args = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
-emitPrimOp _      res IndexOffAddrOp_WideChar  args = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res IndexOffAddrOp_Char      args = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args
+emitPrimOp dflags res IndexOffAddrOp_WideChar  args = doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp dflags res IndexOffAddrOp_Int       args = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res IndexOffAddrOp_Word      args = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res IndexOffAddrOp_Addr      args = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp _      res IndexOffAddrOp_Float     args = doIndexOffAddrOp Nothing f32 res args
 emitPrimOp _      res IndexOffAddrOp_Double    args = doIndexOffAddrOp Nothing f64 res args
 emitPrimOp dflags res IndexOffAddrOp_StablePtr args = doIndexOffAddrOp Nothing (bWord dflags) res args
-emitPrimOp _      res IndexOffAddrOp_Int8      args = doIndexOffAddrOp (Just mo_s_8ToWord) b8  res args
-emitPrimOp _      res IndexOffAddrOp_Int16     args = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
-emitPrimOp _      res IndexOffAddrOp_Int32     args = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
+emitPrimOp dflags res IndexOffAddrOp_Int8      args = doIndexOffAddrOp (Just (mo_s_8ToWord dflags)) b8  res args
+emitPrimOp dflags res IndexOffAddrOp_Int16     args = doIndexOffAddrOp (Just (mo_s_16ToWord dflags)) b16 res args
+emitPrimOp dflags res IndexOffAddrOp_Int32     args = doIndexOffAddrOp (Just (mo_s_32ToWord dflags)) b32 res args
 emitPrimOp _      res IndexOffAddrOp_Int64     args = doIndexOffAddrOp Nothing b64 res args
-emitPrimOp _      res IndexOffAddrOp_Word8     args = doIndexOffAddrOp (Just mo_u_8ToWord) b8  res args
-emitPrimOp _      res IndexOffAddrOp_Word16    args = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
-emitPrimOp _      res IndexOffAddrOp_Word32    args = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res IndexOffAddrOp_Word8     args = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8  res args
+emitPrimOp dflags res IndexOffAddrOp_Word16    args = doIndexOffAddrOp (Just (mo_u_16ToWord dflags)) b16 res args
+emitPrimOp dflags res IndexOffAddrOp_Word32    args = doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp _      res IndexOffAddrOp_Word64    args = doIndexOffAddrOp Nothing b64 res args
 
 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
 
-emitPrimOp _      res ReadOffAddrOp_Char      args = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
-emitPrimOp _      res ReadOffAddrOp_WideChar  args = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res ReadOffAddrOp_Char      args = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args
+emitPrimOp dflags res ReadOffAddrOp_WideChar  args = doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp dflags res ReadOffAddrOp_Int       args = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res ReadOffAddrOp_Word      args = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp dflags res ReadOffAddrOp_Addr      args = doIndexOffAddrOp Nothing (bWord dflags) res args
 emitPrimOp _      res ReadOffAddrOp_Float     args = doIndexOffAddrOp Nothing f32 res args
 emitPrimOp _      res ReadOffAddrOp_Double    args = doIndexOffAddrOp Nothing f64 res args
 emitPrimOp dflags res ReadOffAddrOp_StablePtr args = doIndexOffAddrOp Nothing (bWord dflags) res args
-emitPrimOp _      res ReadOffAddrOp_Int8      args = doIndexOffAddrOp (Just mo_s_8ToWord) b8  res args
-emitPrimOp _      res ReadOffAddrOp_Int16     args = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
-emitPrimOp _      res ReadOffAddrOp_Int32     args = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
+emitPrimOp dflags res ReadOffAddrOp_Int8      args = doIndexOffAddrOp (Just (mo_s_8ToWord dflags)) b8  res args
+emitPrimOp dflags res ReadOffAddrOp_Int16     args = doIndexOffAddrOp (Just (mo_s_16ToWord dflags)) b16 res args
+emitPrimOp dflags res ReadOffAddrOp_Int32     args = doIndexOffAddrOp (Just (mo_s_32ToWord dflags)) b32 res args
 emitPrimOp _      res ReadOffAddrOp_Int64     args = doIndexOffAddrOp Nothing b64 res args
-emitPrimOp _      res ReadOffAddrOp_Word8     args = doIndexOffAddrOp (Just mo_u_8ToWord) b8  res args
-emitPrimOp _      res ReadOffAddrOp_Word16    args = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
-emitPrimOp _      res ReadOffAddrOp_Word32    args = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res ReadOffAddrOp_Word8     args = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8  res args
+emitPrimOp dflags res ReadOffAddrOp_Word16    args = doIndexOffAddrOp (Just (mo_u_16ToWord dflags)) b16 res args
+emitPrimOp dflags res ReadOffAddrOp_Word32    args = doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp _      res ReadOffAddrOp_Word64    args = doIndexOffAddrOp Nothing b64 res args
 
 -- IndexXXXArray
 
-emitPrimOp _      res IndexByteArrayOp_Char      args = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
-emitPrimOp _      res IndexByteArrayOp_WideChar  args = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res IndexByteArrayOp_Char      args = doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8 res args
+emitPrimOp dflags res IndexByteArrayOp_WideChar  args = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp dflags res IndexByteArrayOp_Int       args = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res IndexByteArrayOp_Word      args = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res IndexByteArrayOp_Addr      args = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp _      res IndexByteArrayOp_Float     args = doIndexByteArrayOp Nothing f32 res args
 emitPrimOp _      res IndexByteArrayOp_Double    args = doIndexByteArrayOp Nothing f64 res args
 emitPrimOp dflags res IndexByteArrayOp_StablePtr args = doIndexByteArrayOp Nothing (bWord dflags) res args
-emitPrimOp _      res IndexByteArrayOp_Int8      args = doIndexByteArrayOp (Just mo_s_8ToWord) b8  res args
-emitPrimOp _      res IndexByteArrayOp_Int16     args = doIndexByteArrayOp (Just mo_s_16ToWord) b16  res args
-emitPrimOp _      res IndexByteArrayOp_Int32     args = doIndexByteArrayOp (Just mo_s_32ToWord) b32  res args
+emitPrimOp dflags res IndexByteArrayOp_Int8      args = doIndexByteArrayOp (Just (mo_s_8ToWord dflags)) b8  res args
+emitPrimOp dflags res IndexByteArrayOp_Int16     args = doIndexByteArrayOp (Just (mo_s_16ToWord dflags)) b16  res args
+emitPrimOp dflags res IndexByteArrayOp_Int32     args = doIndexByteArrayOp (Just (mo_s_32ToWord dflags)) b32  res args
 emitPrimOp _      res IndexByteArrayOp_Int64     args = doIndexByteArrayOp Nothing b64  res args
-emitPrimOp _      res IndexByteArrayOp_Word8     args = doIndexByteArrayOp (Just mo_u_8ToWord) b8  res args
-emitPrimOp _      res IndexByteArrayOp_Word16    args = doIndexByteArrayOp (Just mo_u_16ToWord) b16  res args
-emitPrimOp _      res IndexByteArrayOp_Word32    args = doIndexByteArrayOp (Just mo_u_32ToWord) b32  res args
+emitPrimOp dflags res IndexByteArrayOp_Word8     args = doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8  res args
+emitPrimOp dflags res IndexByteArrayOp_Word16    args = doIndexByteArrayOp (Just (mo_u_16ToWord dflags)) b16  res args
+emitPrimOp dflags res IndexByteArrayOp_Word32    args = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32  res args
 emitPrimOp _      res IndexByteArrayOp_Word64    args = doIndexByteArrayOp Nothing b64  res args
 
 -- ReadXXXArray, identical to IndexXXXArray.
 
-emitPrimOp _      res ReadByteArrayOp_Char       args = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
-emitPrimOp _      res ReadByteArrayOp_WideChar   args = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
+emitPrimOp dflags res ReadByteArrayOp_Char       args = doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8 res args
+emitPrimOp dflags res ReadByteArrayOp_WideChar   args = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args
 emitPrimOp dflags res ReadByteArrayOp_Int        args = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res ReadByteArrayOp_Word       args = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp dflags res ReadByteArrayOp_Addr       args = doIndexByteArrayOp Nothing (bWord dflags) res args
 emitPrimOp _      res ReadByteArrayOp_Float      args = doIndexByteArrayOp Nothing f32 res args
 emitPrimOp _      res ReadByteArrayOp_Double     args = doIndexByteArrayOp Nothing f64 res args
 emitPrimOp dflags res ReadByteArrayOp_StablePtr  args = doIndexByteArrayOp Nothing (bWord dflags) res args
-emitPrimOp _      res ReadByteArrayOp_Int8       args = doIndexByteArrayOp (Just mo_s_8ToWord) b8  res args
-emitPrimOp _      res ReadByteArrayOp_Int16      args = doIndexByteArrayOp (Just mo_s_16ToWord) b16  res args
-emitPrimOp _      res ReadByteArrayOp_Int32      args = doIndexByteArrayOp (Just mo_s_32ToWord) b32  res args
+emitPrimOp dflags res ReadByteArrayOp_Int8       args = doIndexByteArrayOp (Just (mo_s_8ToWord dflags)) b8  res args
+emitPrimOp dflags res ReadByteArrayOp_Int16      args = doIndexByteArrayOp (Just (mo_s_16ToWord dflags)) b16  res args
+emitPrimOp dflags res ReadByteArrayOp_Int32      args = doIndexByteArrayOp (Just (mo_s_32ToWord dflags)) b32  res args
 emitPrimOp _      res ReadByteArrayOp_Int64      args = doIndexByteArrayOp Nothing b64  res args
-emitPrimOp _      res ReadByteArrayOp_Word8      args = doIndexByteArrayOp (Just mo_u_8ToWord) b8  res args
-emitPrimOp _      res ReadByteArrayOp_Word16     args = doIndexByteArrayOp (Just mo_u_16ToWord) b16  res args
-emitPrimOp _      res ReadByteArrayOp_Word32     args = doIndexByteArrayOp (Just mo_u_32ToWord) b32  res args
+emitPrimOp dflags res ReadByteArrayOp_Word8      args = doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8  res args
+emitPrimOp dflags res ReadByteArrayOp_Word16     args = doIndexByteArrayOp (Just (mo_u_16ToWord dflags)) b16  res args
+emitPrimOp dflags res ReadByteArrayOp_Word32     args = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32  res args
 emitPrimOp _      res ReadByteArrayOp_Word64     args = doIndexByteArrayOp Nothing b64  res args
 
 -- WriteXXXoffAddr
 
-emitPrimOp _      res WriteOffAddrOp_Char       args = doWriteOffAddrOp (Just mo_WordTo8)  res args
-emitPrimOp _      res WriteOffAddrOp_WideChar   args = doWriteOffAddrOp (Just mo_WordTo32) res args
+emitPrimOp dflags res WriteOffAddrOp_Char       args = doWriteOffAddrOp (Just (mo_WordTo8 dflags))  res args
+emitPrimOp dflags res WriteOffAddrOp_WideChar   args = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) res args
 emitPrimOp _      res WriteOffAddrOp_Int        args = doWriteOffAddrOp Nothing res args
 emitPrimOp _      res WriteOffAddrOp_Word       args = doWriteOffAddrOp Nothing res args
 emitPrimOp _      res WriteOffAddrOp_Addr       args = doWriteOffAddrOp Nothing res args
 emitPrimOp _      res WriteOffAddrOp_Float      args = doWriteOffAddrOp Nothing res args
 emitPrimOp _      res WriteOffAddrOp_Double     args = doWriteOffAddrOp Nothing res args
 emitPrimOp _      res WriteOffAddrOp_StablePtr  args = doWriteOffAddrOp Nothing res args
-emitPrimOp _      res WriteOffAddrOp_Int8       args = doWriteOffAddrOp (Just mo_WordTo8)  res args
-emitPrimOp _      res WriteOffAddrOp_Int16      args = doWriteOffAddrOp (Just mo_WordTo16) res args
-emitPrimOp _      res WriteOffAddrOp_Int32      args = doWriteOffAddrOp (Just mo_WordTo32) res args
+emitPrimOp dflags res WriteOffAddrOp_Int8       args = doWriteOffAddrOp (Just (mo_WordTo8 dflags))  res args
+emitPrimOp dflags res WriteOffAddrOp_Int16      args = doWriteOffAddrOp (Just (mo_WordTo16 dflags)) res args
+emitPrimOp dflags res WriteOffAddrOp_Int32      args = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) res args
 emitPrimOp _      res WriteOffAddrOp_Int64      args = doWriteOffAddrOp Nothing res args
-emitPrimOp _      res WriteOffAddrOp_Word8      args = doWriteOffAddrOp (Just mo_WordTo8)  res args
-emitPrimOp _      res WriteOffAddrOp_Word16     args = doWriteOffAddrOp (Just mo_WordTo16) res args
-emitPrimOp _      res WriteOffAddrOp_Word32     args = doWriteOffAddrOp (Just mo_WordTo32) res args
+emitPrimOp dflags res WriteOffAddrOp_Word8      args = doWriteOffAddrOp (Just (mo_WordTo8 dflags))  res args
+emitPrimOp dflags res WriteOffAddrOp_Word16     args = doWriteOffAddrOp (Just (mo_WordTo16 dflags)) res args
+emitPrimOp dflags res WriteOffAddrOp_Word32     args = doWriteOffAddrOp (Just (mo_WordTo32 dflags)) res args
 emitPrimOp _      res WriteOffAddrOp_Word64     args = doWriteOffAddrOp Nothing res args
 
 -- WriteXXXArray
 
-emitPrimOp _      res WriteByteArrayOp_Char      args = doWriteByteArrayOp (Just mo_WordTo8)  res args
-emitPrimOp _      res WriteByteArrayOp_WideChar  args = doWriteByteArrayOp (Just mo_WordTo32) res args
+emitPrimOp dflags res WriteByteArrayOp_Char      args = doWriteByteArrayOp (Just (mo_WordTo8 dflags))  res args
+emitPrimOp dflags res WriteByteArrayOp_WideChar  args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) res args
 emitPrimOp _      res WriteByteArrayOp_Int       args = doWriteByteArrayOp Nothing res args
 emitPrimOp _      res WriteByteArrayOp_Word      args = doWriteByteArrayOp Nothing res args
 emitPrimOp _      res WriteByteArrayOp_Addr      args = doWriteByteArrayOp Nothing res args
 emitPrimOp _      res WriteByteArrayOp_Float     args = doWriteByteArrayOp Nothing res args
 emitPrimOp _      res WriteByteArrayOp_Double    args = doWriteByteArrayOp Nothing res args
 emitPrimOp _      res WriteByteArrayOp_StablePtr args = doWriteByteArrayOp Nothing res args
-emitPrimOp _      res WriteByteArrayOp_Int8      args = doWriteByteArrayOp (Just mo_WordTo8)  res args
-emitPrimOp _      res WriteByteArrayOp_Int16     args = doWriteByteArrayOp (Just mo_WordTo16) res args
-emitPrimOp _      res WriteByteArrayOp_Int32     args = doWriteByteArrayOp (Just mo_WordTo32) res args
+emitPrimOp dflags res WriteByteArrayOp_Int8      args = doWriteByteArrayOp (Just (mo_WordTo8 dflags))  res args
+emitPrimOp dflags res WriteByteArrayOp_Int16     args = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) res args
+emitPrimOp dflags res WriteByteArrayOp_Int32     args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) res args
 emitPrimOp _      res WriteByteArrayOp_Int64     args = doWriteByteArrayOp Nothing  res args
-emitPrimOp _      res WriteByteArrayOp_Word8     args = doWriteByteArrayOp (Just mo_WordTo8)  res args
-emitPrimOp _      res WriteByteArrayOp_Word16    args = doWriteByteArrayOp (Just mo_WordTo16) res args
-emitPrimOp _      res WriteByteArrayOp_Word32    args = doWriteByteArrayOp (Just mo_WordTo32) res args
+emitPrimOp dflags res WriteByteArrayOp_Word8     args = doWriteByteArrayOp (Just (mo_WordTo8 dflags))  res args
+emitPrimOp dflags res WriteByteArrayOp_Word16    args = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) res args
+emitPrimOp dflags res WriteByteArrayOp_Word32    args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) res args
 emitPrimOp _      res WriteByteArrayOp_Word64    args = doWriteByteArrayOp Nothing res args
 
 -- Copying and setting byte arrays
@@ -493,31 +493,31 @@ emitPrimOp _      [] SetByteArrayOp [ba,off,len,c] =
     doSetByteArrayOp ba off len c
 
 -- Population count
-emitPrimOp _      [res] PopCnt8Op [w] =
-  emitPopCntCall res (CmmMachOp mo_WordTo8 [w]) W8
-emitPrimOp _      [res] PopCnt16Op [w] =
-  emitPopCntCall res (CmmMachOp mo_WordTo16 [w]) W16
-emitPrimOp _      [res] PopCnt32Op [w] =
-  emitPopCntCall res (CmmMachOp mo_WordTo32 [w]) W32
+emitPrimOp dflags [res] PopCnt8Op [w] =
+  emitPopCntCall res (CmmMachOp (mo_WordTo8 dflags) [w]) W8
+emitPrimOp dflags [res] PopCnt16Op [w] =
+  emitPopCntCall res (CmmMachOp (mo_WordTo16 dflags) [w]) W16
+emitPrimOp dflags [res] PopCnt32Op [w] =
+  emitPopCntCall res (CmmMachOp (mo_WordTo32 dflags) [w]) W32
 emitPrimOp _      [res] PopCnt64Op [w] =
   emitPopCntCall res w W64 -- arg always has type W64, no need to narrow
-emitPrimOp _ [res] PopCntOp [w] =
-  emitPopCntCall res w wordWidth
+emitPrimOp dflags [res] PopCntOp [w] =
+  emitPopCntCall res w (wordWidth dflags)
 
 -- The rest just translate straightforwardly
-emitPrimOp _s [res] op [arg]
+emitPrimOp dflags [res] op [arg]
    | nopOp op
    = emitAssign (CmmLocal res) arg
 
    | Just (mop,rep) <- narrowOp op
    = emitAssign (CmmLocal res) $
-           CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]]
+           CmmMachOp (mop rep (wordWidth dflags)) [CmmMachOp (mop (wordWidth dflags) rep) [arg]]
 
-emitPrimOp _ r@[res] op args
+emitPrimOp dflags r@[res] op args
    | Just prim <- callishOp op
    = do emitPrimCall r prim args
 
-   | Just mop <- translateOp op
+   | Just mop <- translateOp dflags op
    = let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) in
      emit stmt
 
@@ -531,19 +531,19 @@ type GenericOp = [CmmFormal] -> [CmmActual] -> FCode ()
 callishPrimOpSupported :: DynFlags -> PrimOp -> Either CallishMachOp GenericOp
 callishPrimOpSupported dflags op
   = case op of
-      IntQuotRemOp   | ncg && x86ish  -> Left (MO_S_QuotRem  wordWidth)
-                     | otherwise      -> Right genericIntQuotRemOp
+      IntQuotRemOp   | ncg && x86ish  -> Left (MO_S_QuotRem  (wordWidth dflags))
+                     | otherwise      -> Right (genericIntQuotRemOp dflags)
 
-      WordQuotRemOp  | ncg && x86ish  -> Left (MO_U_QuotRem  wordWidth)
-                     | otherwise      -> Right genericWordQuotRemOp
+      WordQuotRemOp  | ncg && x86ish  -> Left (MO_U_QuotRem  (wordWidth dflags))
+                     | otherwise      -> Right (genericWordQuotRemOp dflags)
 
-      WordQuotRem2Op | ncg && x86ish  -> Left (MO_U_QuotRem2 wordWidth)
+      WordQuotRem2Op | ncg && x86ish  -> Left (MO_U_QuotRem2 (wordWidth dflags))
                      | otherwise      -> Right (genericWordQuotRem2Op dflags)
 
-      WordAdd2Op     | ncg && x86ish  -> Left (MO_Add2       wordWidth)
+      WordAdd2Op     | ncg && x86ish  -> Left (MO_Add2       (wordWidth dflags))
                      | otherwise      -> Right genericWordAdd2Op
 
-      WordMul2Op     | ncg && x86ish  -> Left (MO_U_Mul2     wordWidth)
+      WordMul2Op     | ncg && x86ish  -> Left (MO_U_Mul2     (wordWidth dflags))
                      | otherwise      -> Right genericWordMul2Op
 
       _ -> panic "emitPrimOp: can't translate PrimOp" (ppr op)
@@ -557,37 +557,37 @@ callishPrimOpSupported dflags op
              ArchX86_64 -> True
              _          -> False
 
-genericIntQuotRemOp :: GenericOp
-genericIntQuotRemOp [res_q, res_r] [arg_x, arg_y]
+genericIntQuotRemOp :: DynFlags -> GenericOp
+genericIntQuotRemOp dflags [res_q, res_r] [arg_x, arg_y]
    = emit $ mkAssign (CmmLocal res_q)
-              (CmmMachOp (MO_S_Quot wordWidth) [arg_x, arg_y]) <*>
+              (CmmMachOp (MO_S_Quot (wordWidth dflags)) [arg_x, arg_y]) <*>
             mkAssign (CmmLocal res_r)
-              (CmmMachOp (MO_S_Rem  wordWidth) [arg_x, arg_y])
-genericIntQuotRemOp _ _ = panic "genericIntQuotRemOp"
+              (CmmMachOp (MO_S_Rem  (wordWidth dflags)) [arg_x, arg_y])
+genericIntQuotRemOp _ _ = panic "genericIntQuotRemOp"
 
-genericWordQuotRemOp :: GenericOp
-genericWordQuotRemOp [res_q, res_r] [arg_x, arg_y]
+genericWordQuotRemOp :: DynFlags -> GenericOp
+genericWordQuotRemOp dflags [res_q, res_r] [arg_x, arg_y]
     = emit $ mkAssign (CmmLocal res_q)
-               (CmmMachOp (MO_U_Quot wordWidth) [arg_x, arg_y]) <*>
+               (CmmMachOp (MO_U_Quot (wordWidth dflags)) [arg_x, arg_y]) <*>
              mkAssign (CmmLocal res_r)
-               (CmmMachOp (MO_U_Rem  wordWidth) [arg_x, arg_y])
-genericWordQuotRemOp _ _ = panic "genericWordQuotRemOp"
+               (CmmMachOp (MO_U_Rem  (wordWidth dflags)) [arg_x, arg_y])
+genericWordQuotRemOp _ _ = panic "genericWordQuotRemOp"
 
 genericWordQuotRem2Op :: DynFlags -> GenericOp
 genericWordQuotRem2Op dflags [res_q, res_r] [arg_x_high, arg_x_low, arg_y]
-    = emit =<< f (widthInBits wordWidth) zero arg_x_high arg_x_low
+    = emit =<< f (widthInBits (wordWidth dflags)) zero arg_x_high arg_x_low
     where    ty = cmmExprType dflags arg_x_high
-             shl   x i = CmmMachOp (MO_Shl   wordWidth) [x, i]
-             shr   x i = CmmMachOp (MO_U_Shr wordWidth) [x, i]
-             or    x y = CmmMachOp (MO_Or    wordWidth) [x, y]
-             ge    x y = CmmMachOp (MO_U_Ge  wordWidth) [x, y]
-             ne    x y = CmmMachOp (MO_Ne    wordWidth) [x, y]
-             minus x y = CmmMachOp (MO_Sub   wordWidth) [x, y]
-             times x y = CmmMachOp (MO_Mul   wordWidth) [x, y]
+             shl   x i = CmmMachOp (MO_Shl   (wordWidth dflags)) [x, i]
+             shr   x i = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, i]
+             or    x y = CmmMachOp (MO_Or    (wordWidth dflags)) [x, y]
+             ge    x y = CmmMachOp (MO_U_Ge  (wordWidth dflags)) [x, y]
+             ne    x y = CmmMachOp (MO_Ne    (wordWidth dflags)) [x, y]
+             minus x y = CmmMachOp (MO_Sub   (wordWidth dflags)) [x, y]
+             times x y = CmmMachOp (MO_Mul   (wordWidth dflags)) [x, y]
              zero   = lit 0
              one    = lit 1
-             negone = lit (fromIntegral (widthInBits wordWidth) - 1)
-             lit i = CmmLit (CmmInt i wordWidth)
+             negone = lit (fromIntegral (widthInBits (wordWidth dflags)) - 1)
+             lit i = CmmLit (CmmInt i (wordWidth dflags))
 
              f :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode CmmAGraph
              f 0 acc high _ = return (mkAssign (CmmLocal res_q) acc <*>
@@ -627,14 +627,14 @@ genericWordAdd2Op [res_h, res_l] [arg_x, arg_y]
   = do dflags <- getDynFlags
        r1 <- newTemp (cmmExprType dflags arg_x)
        r2 <- newTemp (cmmExprType dflags arg_x)
-       let topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
-           toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
-           bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
-           add x y = CmmMachOp (MO_Add wordWidth) [x, y]
-           or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+       let topHalf x = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, hww]
+           toTopHalf x = CmmMachOp (MO_Shl (wordWidth dflags)) [x, hww]
+           bottomHalf x = CmmMachOp (MO_And (wordWidth dflags)) [x, hwm]
+           add x y = CmmMachOp (MO_Add (wordWidth dflags)) [x, y]
+           or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]
            hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth dflags)))
-                                wordWidth)
-           hwm = CmmLit (CmmInt (halfWordMask dflags) wordWidth)
+                                (wordWidth dflags))
+           hwm = CmmLit (CmmInt (halfWordMask dflags) (wordWidth dflags))
        emit $ catAGraphs
           [mkAssign (CmmLocal r1)
                (add (bottomHalf arg_x) (bottomHalf arg_y)),
@@ -658,16 +658,16 @@ genericWordMul2Op [res_h, res_l] [arg_x, arg_y]
       r    <- liftM CmmLocal $ newTemp t
       -- This generic implementation is very simple and slow. We might
       -- well be able to do better, but for now this at least works.
-      let topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
-          toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
-          bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
-          add x y = CmmMachOp (MO_Add wordWidth) [x, y]
+      let topHalf x = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, hww]
+          toTopHalf x = CmmMachOp (MO_Shl (wordWidth dflags)) [x, hww]
+          bottomHalf x = CmmMachOp (MO_And (wordWidth dflags)) [x, hwm]
+          add x y = CmmMachOp (MO_Add (wordWidth dflags)) [x, y]
           sum = foldl1 add
-          mul x y = CmmMachOp (MO_Mul wordWidth) [x, y]
-          or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+          mul x y = CmmMachOp (MO_Mul (wordWidth dflags)) [x, y]
+          or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]
           hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth dflags)))
-                               wordWidth)
-          hwm = CmmLit (CmmInt (halfWordMask dflags) wordWidth)
+                               (wordWidth dflags))
+          hwm = CmmLit (CmmInt (halfWordMask dflags) (wordWidth dflags))
       emit $ catAGraphs
              [mkAssign xlyl
                   (mul (bottomHalf arg_x) (bottomHalf arg_y)),
@@ -713,125 +713,125 @@ narrowOp _              = Nothing
 
 -- Native word signless ops
 
-translateOp :: PrimOp -> Maybe MachOp
-translateOp IntAddOp       = Just mo_wordAdd
-translateOp IntSubOp       = Just mo_wordSub
-translateOp WordAddOp      = Just mo_wordAdd
-translateOp WordSubOp      = Just mo_wordSub
-translateOp AddrAddOp      = Just mo_wordAdd
-translateOp AddrSubOp      = Just mo_wordSub
-
-translateOp IntEqOp        = Just mo_wordEq
-translateOp IntNeOp        = Just mo_wordNe
-translateOp WordEqOp       = Just mo_wordEq
-translateOp WordNeOp       = Just mo_wordNe
-translateOp AddrEqOp       = Just mo_wordEq
-translateOp AddrNeOp       = Just mo_wordNe
-
-translateOp AndOp          = Just mo_wordAnd
-translateOp OrOp           = Just mo_wordOr
-translateOp XorOp          = Just mo_wordXor
-translateOp NotOp          = Just mo_wordNot
-translateOp SllOp         = Just mo_wordShl
-translateOp SrlOp         = Just mo_wordUShr
-
-translateOp AddrRemOp     = Just mo_wordURem
+translateOp :: DynFlags -> PrimOp -> Maybe MachOp
+translateOp dflags IntAddOp       = Just (mo_wordAdd dflags)
+translateOp dflags IntSubOp       = Just (mo_wordSub dflags)
+translateOp dflags WordAddOp      = Just (mo_wordAdd dflags)
+translateOp dflags WordSubOp      = Just (mo_wordSub dflags)
+translateOp dflags AddrAddOp      = Just (mo_wordAdd dflags)
+translateOp dflags AddrSubOp      = Just (mo_wordSub dflags)
+
+translateOp dflags IntEqOp        = Just (mo_wordEq dflags)
+translateOp dflags IntNeOp        = Just (mo_wordNe dflags)
+translateOp dflags WordEqOp       = Just (mo_wordEq dflags)
+translateOp dflags WordNeOp       = Just (mo_wordNe dflags)
+translateOp dflags AddrEqOp       = Just (mo_wordEq dflags)
+translateOp dflags AddrNeOp       = Just (mo_wordNe dflags)
+
+translateOp dflags AndOp          = Just (mo_wordAnd dflags)
+translateOp dflags OrOp           = Just (mo_wordOr dflags)
+translateOp dflags XorOp          = Just (mo_wordXor dflags)
+translateOp dflags NotOp          = Just (mo_wordNot dflags)
+translateOp dflags SllOp          = Just (mo_wordShl dflags)
+translateOp dflags SrlOp          = Just (mo_wordUShr dflags)
+
+translateOp dflags AddrRemOp      = Just (mo_wordURem dflags)
 
 -- Native word signed ops
 
-translateOp IntMulOp        = Just mo_wordMul
-translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordWidth)
-translateOp IntQuotOp       = Just mo_wordSQuot
-translateOp IntRemOp        = Just mo_wordSRem
-translateOp IntNegOp        = Just mo_wordSNeg
+translateOp dflags IntMulOp        = Just (mo_wordMul dflags)
+translateOp dflags IntMulMayOfloOp = Just (MO_S_MulMayOflo (wordWidth dflags))
+translateOp dflags IntQuotOp       = Just (mo_wordSQuot dflags)
+translateOp dflags IntRemOp        = Just (mo_wordSRem dflags)
+translateOp dflags IntNegOp        = Just (mo_wordSNeg dflags)
 
 
-translateOp IntGeOp        = Just mo_wordSGe
-translateOp IntLeOp        = Just mo_wordSLe
-translateOp IntGtOp        = Just mo_wordSGt
-translateOp IntLtOp        = Just mo_wordSLt
+translateOp dflags IntGeOp        = Just (mo_wordSGe dflags)
+translateOp dflags IntLeOp        = Just (mo_wordSLe dflags)
+translateOp dflags IntGtOp        = Just (mo_wordSGt dflags)
+translateOp dflags IntLtOp        = Just (mo_wordSLt dflags)
 
-translateOp ISllOp        = Just mo_wordShl
-translateOp ISraOp        = Just mo_wordSShr
-translateOp ISrlOp        = Just mo_wordUShr
+translateOp dflags ISllOp         = Just (mo_wordShl dflags)
+translateOp dflags ISraOp         = Just (mo_wordSShr dflags)
+translateOp dflags ISrlOp         = Just (mo_wordUShr dflags)
 
 -- Native word unsigned ops
 
-translateOp WordGeOp       = Just mo_wordUGe
-translateOp WordLeOp       = Just mo_wordULe
-translateOp WordGtOp       = Just mo_wordUGt
-translateOp WordLtOp       = Just mo_wordULt
+translateOp dflags WordGeOp       = Just (mo_wordUGe dflags)
+translateOp dflags WordLeOp       = Just (mo_wordULe dflags)
+translateOp dflags WordGtOp       = Just (mo_wordUGt dflags)
+translateOp dflags WordLtOp       = Just (mo_wordULt dflags)
 
-translateOp WordMulOp      = Just mo_wordMul
-translateOp WordQuotOp     = Just mo_wordUQuot
-translateOp WordRemOp      = Just mo_wordURem
+translateOp dflags WordMulOp      = Just (mo_wordMul dflags)
+translateOp dflags WordQuotOp     = Just (mo_wordUQuot dflags)
+translateOp dflags WordRemOp      = Just (mo_wordURem dflags)
 
-translateOp AddrGeOp       = Just mo_wordUGe
-translateOp AddrLeOp       = Just mo_wordULe
-translateOp AddrGtOp       = Just mo_wordUGt
-translateOp AddrLtOp       = Just mo_wordULt
+translateOp dflags AddrGeOp       = Just (mo_wordUGe dflags)
+translateOp dflags AddrLeOp       = Just (mo_wordULe dflags)
+translateOp dflags AddrGtOp       = Just (mo_wordUGt dflags)
+translateOp dflags AddrLtOp       = Just (mo_wordULt dflags)
 
 -- Char# ops
 
-translateOp CharEqOp       = Just (MO_Eq wordWidth)
-translateOp CharNeOp       = Just (MO_Ne wordWidth)
-translateOp CharGeOp       = Just (MO_U_Ge wordWidth)
-translateOp CharLeOp       = Just (MO_U_Le wordWidth)
-translateOp CharGtOp       = Just (MO_U_Gt wordWidth)
-translateOp CharLtOp       = Just (MO_U_Lt wordWidth)
+translateOp dflags CharEqOp       = Just (MO_Eq (wordWidth dflags))
+translateOp dflags CharNeOp       = Just (MO_Ne (wordWidth dflags))
+translateOp dflags CharGeOp       = Just (MO_U_Ge (wordWidth dflags))
+translateOp dflags CharLeOp       = Just (MO_U_Le (wordWidth dflags))
+translateOp dflags CharGtOp       = Just (MO_U_Gt (wordWidth dflags))
+translateOp dflags CharLtOp       = Just (MO_U_Lt (wordWidth dflags))
 
 -- Double ops
 
-translateOp DoubleEqOp     = Just (MO_F_Eq W64)
-translateOp DoubleNeOp     = Just (MO_F_Ne W64)
-translateOp DoubleGeOp     = Just (MO_F_Ge W64)
-translateOp DoubleLeOp     = Just (MO_F_Le W64)
-translateOp DoubleGtOp     = Just (MO_F_Gt W64)
-translateOp DoubleLtOp     = Just (MO_F_Lt W64)
+translateOp _      DoubleEqOp     = Just (MO_F_Eq W64)
+translateOp _      DoubleNeOp     = Just (MO_F_Ne W64)
+translateOp _      DoubleGeOp     = Just (MO_F_Ge W64)
+translateOp _      DoubleLeOp     = Just (MO_F_Le W64)
+translateOp _      DoubleGtOp     = Just (MO_F_Gt W64)
+translateOp _      DoubleLtOp     = Just (MO_F_Lt W64)
 
-translateOp DoubleAddOp    = Just (MO_F_Add W64)
-translateOp DoubleSubOp    = Just (MO_F_Sub W64)
-translateOp DoubleMulOp    = Just (MO_F_Mul W64)
-translateOp DoubleDivOp    = Just (MO_F_Quot W64)
-translateOp DoubleNegOp    = Just (MO_F_Neg W64)
+translateOp _      DoubleAddOp    = Just (MO_F_Add W64)
+translateOp _      DoubleSubOp    = Just (MO_F_Sub W64)
+translateOp _      DoubleMulOp    = Just (MO_F_Mul W64)
+translateOp _      DoubleDivOp    = Just (MO_F_Quot W64)
+translateOp _      DoubleNegOp    = Just (MO_F_Neg W64)
 
 -- Float ops
 
-translateOp FloatEqOp     = Just (MO_F_Eq W32)
-translateOp FloatNeOp     = Just (MO_F_Ne W32)
-translateOp FloatGeOp     = Just (MO_F_Ge W32)
-translateOp FloatLeOp     = Just (MO_F_Le W32)
-translateOp FloatGtOp     = Just (MO_F_Gt W32)
-translateOp FloatLtOp     = Just (MO_F_Lt W32)
+translateOp _      FloatEqOp     = Just (MO_F_Eq W32)
+translateOp _      FloatNeOp     = Just (MO_F_Ne W32)
+translateOp _      FloatGeOp     = Just (MO_F_Ge W32)
+translateOp _      FloatLeOp     = Just (MO_F_Le W32)
+translateOp _      FloatGtOp     = Just (MO_F_Gt W32)
+translateOp _      FloatLtOp     = Just (MO_F_Lt W32)
 
-translateOp FloatAddOp    = Just (MO_F_Add  W32)
-translateOp FloatSubOp    = Just (MO_F_Sub  W32)
-translateOp FloatMulOp    = Just (MO_F_Mul  W32)
-translateOp FloatDivOp    = Just (MO_F_Quot W32)
-translateOp FloatNegOp    = Just (MO_F_Neg  W32)
+translateOp _      FloatAddOp    = Just (MO_F_Add  W32)
+translateOp _      FloatSubOp    = Just (MO_F_Sub  W32)
+translateOp _      FloatMulOp    = Just (MO_F_Mul  W32)
+translateOp _      FloatDivOp    = Just (MO_F_Quot W32)
+translateOp _      FloatNegOp    = Just (MO_F_Neg  W32)
 
 -- Conversions
 
-translateOp Int2DoubleOp   = Just (MO_SF_Conv wordWidth W64)
-translateOp Double2IntOp   = Just (MO_FS_Conv W64 wordWidth)
+translateOp dflags Int2DoubleOp   = Just (MO_SF_Conv (wordWidth dflags) W64)
+translateOp dflags Double2IntOp   = Just (MO_FS_Conv W64 (wordWidth dflags))
 
-translateOp Int2FloatOp    = Just (MO_SF_Conv wordWidth W32)
-translateOp Float2IntOp    = Just (MO_FS_Conv W32 wordWidth)
+translateOp dflags Int2FloatOp    = Just (MO_SF_Conv (wordWidth dflags) W32)
+translateOp dflags Float2IntOp    = Just (MO_FS_Conv W32 (wordWidth dflags))
 
-translateOp Float2DoubleOp = Just (MO_FF_Conv W32 W64)
-translateOp Double2FloatOp = Just (MO_FF_Conv W64 W32)
+translateOp _      Float2DoubleOp = Just (MO_FF_Conv W32 W64)
+translateOp _      Double2FloatOp = Just (MO_FF_Conv W64 W32)
 
 -- Word comparisons masquerading as more exotic things.
 
-translateOp SameMutVarOp           = Just mo_wordEq
-translateOp SameMVarOp             = Just mo_wordEq
-translateOp SameMutableArrayOp     = Just mo_wordEq
-translateOp SameMutableByteArrayOp = Just mo_wordEq
-translateOp SameMutableArrayArrayOp= Just mo_wordEq
-translateOp SameTVarOp             = Just mo_wordEq
-translateOp EqStablePtrOp          = Just mo_wordEq
+translateOp dflags SameMutVarOp           = Just (mo_wordEq dflags)
+translateOp dflags SameMVarOp             = Just (mo_wordEq dflags)
+translateOp dflags SameMutableArrayOp     = Just (mo_wordEq dflags)
+translateOp dflags SameMutableByteArrayOp = Just (mo_wordEq dflags)
+translateOp dflags SameMutableArrayArrayOp= Just (mo_wordEq dflags)
+translateOp dflags SameTVarOp             = Just (mo_wordEq dflags)
+translateOp dflags EqStablePtrOp          = Just (mo_wordEq dflags)
 
-translateOp _ = Nothing
+translateOp _      _ = Nothing
 
 -- These primops are implemented by CallishMachOps, because they sometimes
 -- turn into foreign calls depending on the backend.
@@ -913,8 +913,8 @@ doWritePtrArrayOp addr idx val
          cmmOffsetExpr dflags
           (cmmOffsetExprW dflags (cmmOffsetB dflags addr (arrPtrsHdrSize dflags))
                          (loadArrPtrsSize dflags addr))
-          (CmmMachOp mo_wordUShr [idx,
-                                  mkIntExpr mUT_ARR_PTRS_CARD_BITS])
+          (CmmMachOp (mo_wordUShr dflags) [idx,
+                                           mkIntExpr dflags mUT_ARR_PTRS_CARD_BITS])
          ) (CmmLit (CmmInt 1 W8))
        
 loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
@@ -967,7 +967,8 @@ doCopyByteArrayOp = emitCopyByteArray copy
     -- Copy data (we assume the arrays aren't overlapping since
     -- they're of different types)
     copy _src _dst dst_p src_p bytes =
-        emitMemcpyCall dst_p src_p bytes (mkIntExpr 1)
+        do dflags <- getDynFlags
+           emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags 1)
 
 -- | Takes a source 'MutableByteArray#', an offset in the source
 -- array, a destination 'MutableByteArray#', an offset into the
@@ -982,11 +983,12 @@ doCopyMutableByteArrayOp = emitCopyByteArray copy
     -- we were provided are the same array!
     -- TODO: Optimize branch for common case of no aliasing.
     copy src dst dst_p src_p bytes = do
+        dflags <- getDynFlags
         [moveCall, cpyCall] <- forkAlts [
-            getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr 1),
-            getCode $ emitMemcpyCall  dst_p src_p bytes (mkIntExpr 1)
+            getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr dflags 1),
+            getCode $ emitMemcpyCall  dst_p src_p bytes (mkIntExpr dflags 1)
             ]
-        emit =<< mkCmmIfThenElse (cmmEqWord src dst) moveCall cpyCall
+        emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
 
 emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                       -> FCode ())
@@ -1009,7 +1011,7 @@ doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
 doSetByteArrayOp ba off len c
     = do dflags <- getDynFlags
          p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off
-         emitMemsetCall p c len (mkIntExpr 1)
+         emitMemsetCall p c len (mkIntExpr dflags 1)
 
 -- ----------------------------------------------------------------------------
 -- Copying pointer arrays
@@ -1039,7 +1041,8 @@ doCopyArrayOp = emitCopyArray copy
     -- Copy data (we assume the arrays aren't overlapping since
     -- they're of different types)
     copy _src _dst dst_p src_p bytes =
-        emitMemcpyCall dst_p src_p bytes (mkIntExpr wORD_SIZE)
+        do dflags <- getDynFlags
+           emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags wORD_SIZE)
 
 
 -- | Takes a source 'MutableArray#', an offset in the source array, a
@@ -1054,11 +1057,12 @@ doCopyMutableArrayOp = emitCopyArray copy
     -- we were provided are the same array!
     -- TODO: Optimize branch for common case of no aliasing.
     copy src dst dst_p src_p bytes = do
+        dflags <- getDynFlags
         [moveCall, cpyCall] <- forkAlts [
-            getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr wORD_SIZE),
-            getCode $ emitMemcpyCall  dst_p src_p bytes (mkIntExpr wORD_SIZE)
+            getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr dflags wORD_SIZE),
+            getCode $ emitMemcpyCall  dst_p src_p bytes (mkIntExpr dflags wORD_SIZE)
             ]
-        emit =<< mkCmmIfThenElse (cmmEqWord src dst) moveCall cpyCall
+        emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
 
 emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                   -> FCode ())
@@ -1079,7 +1083,7 @@ emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 = do
     dst_elems_p <- assignTempE $ cmmOffsetB dflags dst (arrPtrsHdrSize dflags)
     dst_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p dst_off
     src_p <- assignTempE $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off
-    bytes <- assignTempE $ cmmMulWord n (mkIntExpr wORD_SIZE)
+    bytes <- assignTempE $ cmmMulWord dflags n (mkIntExpr dflags wORD_SIZE)
 
     copy src dst dst_p src_p bytes
 
@@ -1095,20 +1099,23 @@ emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 = do
 emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr
                -> FCode ()
 emitCloneArray info_p res_r src0 src_off0 n0 = do
+    dflags <- getDynFlags
+    let arrPtrsHdrSizeW dflags = mkIntExpr dflags (fixedHdrSize dflags +
+                                     (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE))
+        myCapability = cmmSubWord dflags (CmmReg baseReg) (mkIntExpr dflags oFFSET_Capability_r)
     -- Passed as arguments (be careful)
     src     <- assignTempE src0
     src_off <- assignTempE src_off0
     n       <- assignTempE n0
 
-    card_bytes <- assignTempE $ cardRoundUp n
-    size <- assignTempE $ n `cmmAddWord` bytesToWordsRoundUp card_bytes
-    dflags <- getDynFlags
-    words <- assignTempE $ arrPtrsHdrSizeW dflags `cmmAddWord` size
+    card_bytes <- assignTempE $ cardRoundUp dflags n
+    size <- assignTempE $ cmmAddWord dflags n (bytesToWordsRoundUp dflags card_bytes)
+    words <- assignTempE $ cmmAddWord dflags (arrPtrsHdrSizeW dflags) size
 
     arr_r <- newTemp (bWord dflags)
     emitAllocateCall arr_r myCapability words
-    tickyAllocPrim (mkIntExpr (arrPtrsHdrSize dflags)) (n `cmmMulWord` wordSize)
-                   zeroExpr
+    tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags)) (cmmMulWord dflags n (wordSize dflags))
+                   (zeroExpr dflags)
 
     let arr = CmmReg (CmmLocal arr_r)
     emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCS
@@ -1121,43 +1128,40 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do
     src_p <- assignTempE $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags))
              src_off
 
-    emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize) (mkIntExpr wORD_SIZE)
+    emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags)) (mkIntExpr dflags wORD_SIZE)
 
     emitMemsetCall (cmmOffsetExprW dflags dst_p n)
-        (mkIntExpr 1)
+        (mkIntExpr dflags 1)
         card_bytes
-        (mkIntExpr wORD_SIZE)
+        (mkIntExpr dflags wORD_SIZE)
     emit $ mkAssign (CmmLocal res_r) arr
-  where
-    arrPtrsHdrSizeW dflags = mkIntExpr (fixedHdrSize dflags +
-                                 (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE))
-    myCapability = CmmReg baseReg `cmmSubWord` mkIntExpr oFFSET_Capability_r
 
 -- | Takes and offset in the destination array, the base address of
 -- the card table, and the number of elements affected (*not* the
 -- number of cards).  Marks the relevant cards as dirty.
 emitSetCards :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
 emitSetCards dst_start dst_cards_start n = do
-    start_card <- assignTempE $ card dst_start
-    emitMemsetCall (dst_cards_start `cmmAddWord` start_card)
-        (mkIntExpr 1)
-        (cardRoundUp n)
-        (mkIntExpr 1) -- no alignment (1 byte)
+    dflags <- getDynFlags
+    start_card <- assignTempE $ card dflags dst_start
+    emitMemsetCall (cmmAddWord dflags dst_cards_start start_card)
+        (mkIntExpr dflags 1)
+        (cardRoundUp dflags n)
+        (mkIntExpr dflags 1) -- no alignment (1 byte)
 
 -- Convert an element index to a card index
-card :: CmmExpr -> CmmExpr
-card i = i `cmmUShrWord` mkIntExpr mUT_ARR_PTRS_CARD_BITS
+card :: DynFlags -> CmmExpr -> CmmExpr
+card dflags i = cmmUShrWord dflags i (mkIntExpr dflags mUT_ARR_PTRS_CARD_BITS)
 
 -- Convert a number of elements to a number of cards, rounding up
-cardRoundUp :: CmmExpr -> CmmExpr
-cardRoundUp i = card (i `cmmAddWord` (mkIntExpr ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS) - 1)))
+cardRoundUp :: DynFlags -> CmmExpr -> CmmExpr
+cardRoundUp dflags i = card dflags (cmmAddWord dflags i (mkIntExpr dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS) - 1)))
 
-bytesToWordsRoundUp :: CmmExpr -> CmmExpr
-bytesToWordsRoundUp e = (e `cmmAddWord` mkIntExpr (wORD_SIZE - 1))
-                        `cmmQuotWord` wordSize
+bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr
+bytesToWordsRoundUp dflags e = cmmQuotWord dflags (cmmAddWord dflags e (mkIntExpr dflags (wORD_SIZE - 1)))
+                                                  (wordSize dflags)
 
-wordSize :: CmmExpr
-wordSize = mkIntExpr wORD_SIZE
+wordSize :: DynFlags -> CmmExpr
+wordSize dflags = mkIntExpr dflags wORD_SIZE
 
 -- | Emit a call to @memcpy@.
 emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
index c980493..715bbb7 100644 (file)
@@ -94,11 +94,11 @@ staticProfHdr :: DynFlags -> CostCentreStack -> [CmmLit]
 -- The profiling header words in a static closure
 -- Was SET_STATIC_PROF_HDR
 staticProfHdr dflags ccs
- = ifProfilingL dflags [mkCCostCentreStack ccs, staticLdvInit]
+ = ifProfilingL dflags [mkCCostCentreStack ccs, staticLdvInit dflags]
 
 dynProfHdr :: DynFlags -> CmmExpr -> [CmmExpr]
 -- Profiling header words in a dynamic closure
-dynProfHdr dflags ccs = ifProfilingL dflags [ccs, dynLdvInit]
+dynProfHdr dflags ccs = ifProfilingL dflags [ccs, dynLdvInit dflags]
 
 initUpdFrameProf :: ByteOff -> FCode ()
 -- Initialise the profiling field of an update frame
@@ -164,7 +164,7 @@ profDynAlloc :: SMRep -> CmmExpr -> FCode ()
 profDynAlloc rep ccs
   = ifProfiling $
     do dflags <- getDynFlags
-       profAlloc (mkIntExpr (heapClosureSize dflags rep)) ccs
+       profAlloc (mkIntExpr dflags (heapClosureSize dflags rep)) ccs
 
 -- | Record the allocation of a closure (size is given by a CmmExpr)
 -- The size must be in words, because the allocation counter in a CCS counts
@@ -175,9 +175,9 @@ profAlloc words ccs
         do dflags <- getDynFlags
            emit (addToMemE alloc_rep
                        (cmmOffsetB dflags ccs oFFSET_CostCentreStack_mem_alloc)
-                       (CmmMachOp (MO_UU_Conv wordWidth (typeWidth alloc_rep)) $
-                         [CmmMachOp mo_wordSub [words, 
-                                                mkIntExpr (profHdrSize dflags)]]))
+                       (CmmMachOp (MO_UU_Conv (wordWidth dflags) (typeWidth alloc_rep)) $
+                         [CmmMachOp (mo_wordSub dflags) [words,
+                                                         mkIntExpr dflags (profHdrSize dflags)]]))
                        -- subtract the "profiling overhead", which is the
                        -- profiling header in a closure.
  where 
@@ -230,48 +230,48 @@ initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
 
 emitCostCentreDecl :: CostCentre -> FCode ()
 emitCostCentreDecl cc = do 
+  { dflags <- getDynFlags
+  ; let is_caf | isCafCC cc = mkIntCLit dflags (ord 'c') -- 'c' == is a CAF
+               | otherwise  = zero dflags
                         -- NB. bytesFS: we want the UTF-8 bytes here (#5559)
-  { label <- newByteStringCLit (bytesFS $ costCentreUserNameFS cc)
+  ; label <- newByteStringCLit (bytesFS $ costCentreUserNameFS cc)
   ; modl  <- newByteStringCLit (bytesFS $ Module.moduleNameFS
                                         $ Module.moduleName
                                         $ cc_mod cc)
-  ; dflags <- getDynFlags
   ; loc <- newByteStringCLit $ bytesFS $ mkFastString $
                    showPpr dflags (costCentreSrcSpan cc)
            -- XXX going via FastString to get UTF-8 encoding is silly
   ; let
-     lits = [ zero,    -- StgInt ccID,
+     lits = [ zero dflags,     -- StgInt ccID,
              label,    -- char *label,
              modl,     -- char *module,
               loc,      -- char *srcloc,
               zero64,   -- StgWord64 mem_alloc
-              zero,     -- StgWord time_ticks
+              zero dflags,     -- StgWord time_ticks
               is_caf,   -- StgInt is_caf
-              zero      -- struct _CostCentre *link
+              zero dflags      -- struct _CostCentre *link
            ] 
   ; emitDataLits (mkCCLabel cc) lits
   }
-  where
-     is_caf | isCafCC cc = mkIntCLit (ord 'c') -- 'c' == is a CAF
-            | otherwise  = zero
 
 emitCostCentreStackDecl :: CostCentreStack -> FCode ()
 emitCostCentreStackDecl ccs 
   = case maybeSingletonCCS ccs of
-       Just cc -> emitDataLits (mkCCSLabel ccs) (mk_lits cc)
-       Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)
-  where
-     mk_lits cc = zero : 
-                 mkCCostCentre cc : 
-                 replicate (sizeof_ccs_words - 2) zero
-       -- Note: to avoid making any assumptions about how the
-       -- C compiler (that compiles the RTS, in particular) does
-       -- layouts of structs containing long-longs, simply
-       -- pad out the struct with zero words until we hit the
-       -- size of the overall struct (which we get via DerivedConstants.h)
-
-zero :: CmmLit
-zero = mkIntCLit 0
+    Just cc ->
+        do dflags <- getDynFlags
+           let mk_lits cc = zero dflags :
+                            mkCCostCentre cc :
+                            replicate (sizeof_ccs_words - 2) (zero dflags)
+                -- Note: to avoid making any assumptions about how the
+                -- C compiler (that compiles the RTS, in particular) does
+                -- layouts of structs containing long-longs, simply
+                -- pad out the struct with zero words until we hit the
+                -- size of the overall struct (which we get via DerivedConstants.h)
+           emitDataLits (mkCCSLabel ccs) (mk_lits cc)
+    Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs)
+
+zero :: DynFlags -> CmmLit
+zero dflags = mkIntCLit dflags 0
 zero64 :: CmmLit
 zero64 = CmmInt 0 W64
 
@@ -318,17 +318,17 @@ bumpSccCount dflags ccs
 --
 -- Initial value for the LDV field in a static closure
 --
-staticLdvInit :: CmmLit
+staticLdvInit :: DynFlags -> CmmLit
 staticLdvInit = zeroCLit
 
 --
 -- Initial value of the LDV field in a dynamic closure
 --
-dynLdvInit :: CmmExpr
-dynLdvInit =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE  
-  CmmMachOp mo_wordOr [
-      CmmMachOp mo_wordShl [loadEra, mkIntExpr lDV_SHIFT ],
-      CmmLit (mkWordCLit lDV_STATE_CREATE)
+dynLdvInit :: DynFlags -> CmmExpr
+dynLdvInit dflags =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE  
+  CmmMachOp (mo_wordOr dflags) [
+      CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags lDV_SHIFT ],
+      CmmLit (mkWordCLit dflags lDV_STATE_CREATE)
   ]
         
 --
@@ -336,7 +336,7 @@ dynLdvInit =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE
 --
 ldvRecordCreate :: CmmExpr -> FCode ()
 ldvRecordCreate closure = do dflags <- getDynFlags
-                             emit $ mkStore (ldvWord dflags closure) dynLdvInit
+                             emit $ mkStore (ldvWord dflags closure) (dynLdvInit dflags)
 
 --
 -- Called when a closure is entered, marks the closure as having been "used".
@@ -356,19 +356,19 @@ ldvEnter cl_ptr = do
     dflags <- getDynFlags
     let -- don't forget to substract node's tag
         ldv_wd = ldvWord dflags cl_ptr
-        new_ldv_wd = cmmOrWord (cmmAndWord (CmmLoad ldv_wd (bWord dflags))
-                                           (CmmLit (mkWordCLit lDV_CREATE_MASK)))
-                     (cmmOrWord loadEra (CmmLit (mkWordCLit lDV_STATE_USE)))
+        new_ldv_wd = cmmOrWord dflags (cmmAndWord dflags (CmmLoad ldv_wd (bWord dflags))
+                                                         (CmmLit (mkWordCLit dflags lDV_CREATE_MASK)))
+                                      (cmmOrWord dflags (loadEra dflags) (CmmLit (mkWordCLit dflags lDV_STATE_USE)))
     ifProfiling $
          -- if (era > 0) {
          --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
          --                era | LDV_STATE_USE }
-        emit =<< mkCmmIfThenElse (CmmMachOp mo_wordUGt [loadEra, CmmLit zeroCLit])
+        emit =<< mkCmmIfThenElse (CmmMachOp (mo_wordUGt dflags) [loadEra dflags, CmmLit (zeroCLit dflags)])
                      (mkStore ldv_wd new_ldv_wd)
                      mkNop
 
-loadEra :: CmmExpr 
-loadEra = CmmMachOp (MO_UU_Conv cIntWidth wordWidth)
+loadEra :: DynFlags -> CmmExpr
+loadEra dflags = CmmMachOp (MO_UU_Conv cIntWidth (wordWidth dflags))
          [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "era"))) cInt]
 
 ldvWord :: DynFlags -> CmmExpr -> CmmExpr
index e6cb6ed..d86d84a 100644 (file)
@@ -106,14 +106,14 @@ emitTickyCounter cl_info args
 -- krc: note that all the fields are I32 now; some were I16 before, 
 -- but the code generator wasn't handling that properly and it led to chaos, 
 -- panic and disorder.
-           [ mkIntCLit 0,
-             mkIntCLit (length args),  -- Arity
-             mkIntCLit 0,              -- XXX: we no longer know this!  Words passed on stack
+           [ mkIntCLit dflags 0,
+             mkIntCLit dflags (length args),   -- Arity
+             mkIntCLit dflags 0,               -- XXX: we no longer know this!  Words passed on stack
              fun_descr_lit,
              arg_descr_lit,
-             zeroCLit,                 -- Entry count
-             zeroCLit,                 -- Allocs
-             zeroCLit                  -- Link
+             zeroCLit dflags,          -- Entry count
+             zeroCLit dflags,          -- Allocs
+             zeroCLit dflags                   -- Link
            ] }
 
 -- When printing the name of a thing in a ticky file, we want to
@@ -183,17 +183,17 @@ registerTickyCtr ctr_lbl = do
   dflags <- getDynFlags
   let
     -- krc: code generator doesn't handle Not, so we test for Eq 0 instead
-    test = CmmMachOp (MO_Eq wordWidth)
+    test = CmmMachOp (MO_Eq (wordWidth dflags))
               [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl
                                 oFFSET_StgEntCounter_registeredp)) (bWord dflags),
-               zeroExpr]
+               zeroExpr dflags]
     register_stmts
       = [ mkStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_link))
                    (CmmLoad ticky_entry_ctrs (bWord dflags))
         , mkStore ticky_entry_ctrs (mkLblExpr ctr_lbl)
         , mkStore (CmmLit (cmmLabelOffB ctr_lbl
                                 oFFSET_StgEntCounter_registeredp))
-                   (mkIntExpr 1) ]
+                   (mkIntExpr dflags 1) ]
     ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
   emit =<< mkCmmIfThen test (catAGraphs register_stmts)
 
index b402199..1b934df 100644 (file)
@@ -86,31 +86,32 @@ import Data.Maybe
 cgLit :: Literal -> FCode CmmLit
 cgLit (MachStr s) = newByteStringCLit (bytesFB s)
  -- not unpackFS; we want the UTF-8 byte stream.
-cgLit other_lit   = return (mkSimpleLit other_lit)
+cgLit other_lit   = do dflags <- getDynFlags
+                       return (mkSimpleLit dflags other_lit)
 
 mkLtOp :: DynFlags -> Literal -> MachOp
 -- On signed literals we must do a signed comparison
-mkLtOp _      (MachInt _)    = MO_S_Lt wordWidth
+mkLtOp dflags (MachInt _)    = MO_S_Lt (wordWidth dflags)
 mkLtOp _      (MachFloat _)  = MO_F_Lt W32
 mkLtOp _      (MachDouble _) = MO_F_Lt W64
-mkLtOp dflags lit            = MO_U_Lt (typeWidth (cmmLitType dflags (mkSimpleLit lit)))
+mkLtOp dflags lit            = MO_U_Lt (typeWidth (cmmLitType dflags (mkSimpleLit dflags lit)))
                                 -- ToDo: seems terribly indirect!
 
-mkSimpleLit :: Literal -> CmmLit
-mkSimpleLit (MachChar   c)    = CmmInt (fromIntegral (ord c)) wordWidth
-mkSimpleLit MachNullAddr      = zeroCLit
-mkSimpleLit (MachInt i)       = CmmInt i wordWidth
-mkSimpleLit (MachInt64 i)     = CmmInt i W64
-mkSimpleLit (MachWord i)      = CmmInt i wordWidth
-mkSimpleLit (MachWord64 i)    = CmmInt i W64
-mkSimpleLit (MachFloat r)     = CmmFloat r W32
-mkSimpleLit (MachDouble r)    = CmmFloat r W64
-mkSimpleLit (MachLabel fs ms fod)
+mkSimpleLit :: DynFlags -> Literal -> CmmLit
+mkSimpleLit dflags (MachChar   c)    = CmmInt (fromIntegral (ord c)) (wordWidth dflags)
+mkSimpleLit dflags MachNullAddr      = zeroCLit dflags
+mkSimpleLit dflags (MachInt i)       = CmmInt i (wordWidth dflags)
+mkSimpleLit _      (MachInt64 i)     = CmmInt i W64
+mkSimpleLit dflags (MachWord i)      = CmmInt i (wordWidth dflags)
+mkSimpleLit _      (MachWord64 i)    = CmmInt i W64
+mkSimpleLit _      (MachFloat r)     = CmmFloat r W32
+mkSimpleLit _      (MachDouble r)    = CmmFloat r W64
+mkSimpleLit _      (MachLabel fs ms fod)
         = CmmLabel (mkForeignLabel fs ms labelSrc fod)
         where
                 -- TODO: Literal labels might not actually be in the current package...
                 labelSrc = ForeignLabelInThisPackage
-mkSimpleLit other             = pprPanic "mkSimpleLit" (ppr other)
+mkSimpleLit other             = pprPanic "mkSimpleLit" (ppr other)
 
 --------------------------------------------------------------------------
 --
@@ -514,11 +515,11 @@ mk_switch _tag_expr [(_tag,lbl)] Nothing _ _ _
 
 -- SINGLETON BRANCH: one equality check to do
 mk_switch tag_expr [(tag,lbl)] (Just deflt) _ _ _
-  = return (mkCbranch cond deflt lbl)
-  where
-    cond =  cmmNeWord tag_expr (mkIntExpr tag)
-        -- We have lo_tag < hi_tag, but there's only one branch,
-        -- so there must be a default
+  = do dflags <- getDynFlags
+       let cond =  cmmNeWord dflags tag_expr (mkIntExpr dflags tag)
+            -- We have lo_tag < hi_tag, but there's only one branch,
+            -- so there must be a default
+       return (mkCbranch cond deflt lbl)
 
 -- ToDo: we might want to check for the two branch case, where one of
 -- the branches is the tag 0, because comparing '== 0' is likely to be
@@ -551,28 +552,31 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
 
   -- if we can knock off a bunch of default cases with one if, then do so
   | Just deflt <- mb_deflt, (lowest_branch - lo_tag) >= n_branches
-  = do stmts <- mk_switch tag_expr branches mb_deflt
+  = do dflags <- getDynFlags
+       stmts <- mk_switch tag_expr branches mb_deflt
                         lowest_branch hi_tag via_C
        mkCmmIfThenElse
-        (cmmULtWord tag_expr (mkIntExpr lowest_branch))
+        (cmmULtWord dflags tag_expr (mkIntExpr dflags lowest_branch))
         (mkBranch deflt)
         stmts
 
   | Just deflt <- mb_deflt, (hi_tag - highest_branch) >= n_branches
-  = do stmts <- mk_switch tag_expr branches mb_deflt
+  = do dflags <- getDynFlags
+       stmts <- mk_switch tag_expr branches mb_deflt
                         lo_tag highest_branch via_C
        mkCmmIfThenElse
-        (cmmUGtWord tag_expr (mkIntExpr highest_branch))
+        (cmmUGtWord dflags tag_expr (mkIntExpr dflags highest_branch))
         (mkBranch deflt)
         stmts
 
   | otherwise   -- Use an if-tree
-  = do lo_stmts <- mk_switch tag_expr lo_branches mb_deflt
+  = do dflags <- getDynFlags
+       lo_stmts <- mk_switch tag_expr lo_branches mb_deflt
                              lo_tag (mid_tag-1) via_C
        hi_stmts <- mk_switch tag_expr hi_branches mb_deflt
                              mid_tag hi_tag via_C
        mkCmmIfThenElse
-        (cmmUGeWord tag_expr (mkIntExpr mid_tag))
+        (cmmUGeWord dflags tag_expr (mkIntExpr dflags mid_tag))
         hi_stmts
         lo_stmts
         -- we test (e >= mid_tag) rather than (e < mid_tag), because
@@ -656,7 +660,7 @@ mk_lit_switch scrut deflt [(lit,blk)]
   = do
   dflags <- getDynFlags
   let
-    cmm_lit = mkSimpleLit lit
+    cmm_lit = mkSimpleLit dflags lit
     cmm_ty  = cmmLitType dflags cmm_lit
     rep     = typeWidth cmm_ty
     ne      = if isFloatType cmm_ty then MO_F_Ne rep else MO_Ne rep
@@ -676,7 +680,7 @@ mk_lit_switch scrut deflt_blk_id branches
     is_lo (t,_) = t < mid_lit
 
     cond dflags = CmmMachOp (mkLtOp dflags mid_lit)
-                            [scrut, CmmLit (mkSimpleLit mid_lit)]
+                            [scrut, CmmLit (mkSimpleLit dflags mid_lit)]
 
 
 --------------
index 1490360..1493a40 100644 (file)
@@ -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
index 2135020..af4bb9e 100644 (file)
@@ -161,7 +161,7 @@ cmmMakePicReference dflags lbl
 
 
        | (dopt Opt_PIC dflags || not (dopt Opt_Static dflags)) && absoluteLabel lbl 
-       = CmmMachOp (MO_Add wordWidth
+       = CmmMachOp (MO_Add (wordWidth dflags)
                [ CmmReg (CmmGlobal PicBaseReg)
                , CmmLit $ picRelative 
                                (platformArch   $ targetPlatform dflags)
@@ -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
index 307c65b..367c0fb 100644 (file)
@@ -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)
 
 
@@ -1197,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)
index 27dafb7..9d6aeaa 100644 (file)
@@ -165,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)
 
 
@@ -324,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
 
index 9e4dd24..5e51a87 100644 (file)
@@ -275,9 +275,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)
 
 
@@ -2075,7 +2075,7 @@ genCCall64' dflags 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)]
                )
@@ -2171,7 +2171,7 @@ genCCall64' dflags 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))]
              push_args rest code'
@@ -2292,7 +2292,7 @@ genSwitch dflags expr ids
 
         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
@@ -2305,7 +2305,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
                            ]
                       _ ->
@@ -2319,7 +2319,7 @@ 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
@@ -2343,12 +2343,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)
 
 -- -----------------------------------------------------------------------------