Move wORD_SIZE into platformConstants
authorIan Lynagh <ian@well-typed.com>
Sun, 16 Sep 2012 16:45:03 +0000 (17:45 +0100)
committerIan Lynagh <ian@well-typed.com>
Sun, 16 Sep 2012 16:45:03 +0000 (17:45 +0100)
63 files changed:
compiler/cmm/Bitmap.hs
compiler/cmm/CmmBuildInfoTables.hs
compiler/cmm/CmmCallConv.hs
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmLayoutStack.hs
compiler/cmm/CmmLint.hs
compiler/cmm/CmmParse.y
compiler/cmm/CmmPipeline.hs
compiler/cmm/CmmType.hs
compiler/cmm/CmmUtils.hs
compiler/cmm/OldCmmLint.hs
compiler/cmm/PprC.hs
compiler/cmm/SMRep.lhs
compiler/codeGen/CgBindery.lhs
compiler/codeGen/CgCallConv.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/CgStackery.lhs
compiler/codeGen/CgUtils.hs
compiler/codeGen/ClosureInfo.lhs
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmCon.hs
compiler/codeGen/StgCmmForeign.hs
compiler/codeGen/StgCmmHeap.hs
compiler/codeGen/StgCmmLayout.hs
compiler/codeGen/StgCmmPrim.hs
compiler/codeGen/StgCmmProf.hs
compiler/codeGen/StgCmmUtils.hs
compiler/deSugar/Coverage.lhs
compiler/deSugar/DsCCall.lhs
compiler/deSugar/DsForeign.lhs
compiler/ghci/ByteCodeAsm.lhs
compiler/ghci/ByteCodeGen.lhs
compiler/ghci/ByteCodeItbls.lhs
compiler/ghci/ByteCodeLink.lhs
compiler/ghci/DebuggerUtils.hs
compiler/ghci/LibFFI.hsc
compiler/ghci/Linker.lhs
compiler/ghci/RtClosureInspect.hs
compiler/iface/BinIface.hs
compiler/llvmGen/Llvm/Types.hs
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/llvmGen/LlvmCodeGen/Ppr.hs
compiler/main/BreakArray.hs
compiler/main/DynFlags.hs
compiler/main/InteractiveEval.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/PPC/Regs.hs
compiler/nativeGen/X86/CodeGen.hs
compiler/nativeGen/X86/Instr.hs
compiler/nativeGen/X86/Regs.hs
compiler/typecheck/TcDeriv.lhs
compiler/typecheck/TcGenDeriv.lhs
compiler/types/TyCon.lhs
ghc/InteractiveUI.hs
includes/HaskellConstants.hs
includes/mkDerivedConstants.c

index f4cfe3f..93217d5 100644 (file)
@@ -24,7 +24,6 @@ module Bitmap (
 #include "../includes/MachDeps.h"
 
 import SMRep
-import Constants
 import DynFlags
 import Util
 
@@ -84,9 +83,10 @@ possible, or fall back to an external pointer when the bitmap is too
 large.  This value represents the largest size of bitmap that can be
 packed into a single word.
 -}
-mAX_SMALL_BITMAP_SIZE :: Int
-mAX_SMALL_BITMAP_SIZE  | wORD_SIZE == 4 = 27
-                      | otherwise      = 58
+mAX_SMALL_BITMAP_SIZE :: DynFlags -> Int
+mAX_SMALL_BITMAP_SIZE dflags
+ | wORD_SIZE dflags == 4 = 27
+ | otherwise             = 58
 
 seqBitmap :: Bitmap -> a -> a
 seqBitmap = seqList
index 3735419..30e0add 100644 (file)
@@ -233,7 +233,7 @@ to_SRT dflags top_srt off len bmp
        let srt_desc_lbl = mkLargeSRTLabel id
            tbl = CmmData RelocatableReadOnlyData $
                    Statics srt_desc_lbl $ map CmmStaticLit
-                     ( cmmLabelOffW top_srt off
+                     ( cmmLabelOffW dflags top_srt off
                      : mkWordCLit dflags (fromIntegral len)
                      : map (mkWordCLit dflags) bmp)
        return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape)
index fb6c27c..235fe7f 100644 (file)
@@ -18,7 +18,6 @@ import SMRep
 import Cmm (Convention(..))
 import PprCmm ()
 
-import Constants
 import qualified Data.List as L
 import DynFlags
 import Outputable
@@ -92,7 +91,7 @@ assignArgumentsPos dflags conv arg_ty reps = assignments
       assign_stk _      assts [] = assts
       assign_stk offset assts (r:rs) = assign_stk off' ((r, StackParam off') : assts) rs
         where w    = typeWidth (arg_ty r)
-              size = (((widthInBytes w - 1) `div` wORD_SIZE) + 1) * wORD_SIZE
+              size = (((widthInBytes w - 1) `div` wORD_SIZE dflags) + 1) * wORD_SIZE dflags
               off' = offset + size
 
 -----------------------------------------------------------------------------
index 10e37bb..94e38ae 100644 (file)
@@ -173,7 +173,7 @@ mkInfoTableContents dflags
 
   | StackRep frame <- smrep
   = do { (prof_lits, prof_data) <- mkProfLits dflags prof
-       ; let (srt_label, srt_bitmap) = mkSRTLit srt
+       ; let (srt_label, srt_bitmap) = mkSRTLit dflags srt
        ; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame
        ; let
              std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
@@ -186,7 +186,7 @@ mkInfoTableContents dflags
   | HeapRep _ ptrs nonptrs closure_type <- smrep
   = do { let layout  = packHalfWordsCLit dflags ptrs nonptrs
        ; (prof_lits, prof_data) <- mkProfLits dflags prof
-       ; let (srt_label, srt_bitmap) = mkSRTLit srt
+       ; let (srt_label, srt_bitmap) = mkSRTLit dflags srt
        ; (mb_srt_field, mb_layout, extra_bits, ct_data)
                                 <- mk_pieces closure_type srt_label
        ; let std_info = mkStdInfoTable dflags prof_lits
@@ -233,11 +233,12 @@ mkInfoTableContents dflags
 
 mkInfoTableContents _ _ _ = panic "mkInfoTableContents"   -- NonInfoTable dealt with earlier
 
-mkSRTLit :: C_SRT
+mkSRTLit :: DynFlags
+         -> C_SRT
          -> ([CmmLit],    -- srt_label, if any
              StgHalfWord) -- srt_bitmap
-mkSRTLit NoC_SRT                = ([], 0)
-mkSRTLit (C_SRT lbl off bitmap) = ([cmmLabelOffW lbl off], bitmap)
+mkSRTLit _      NoC_SRT                = ([], 0)
+mkSRTLit dflags (C_SRT lbl off bitmap) = ([cmmLabelOffW dflags lbl off], bitmap)
 
 
 -------------------------------------------------------------------------
@@ -303,7 +304,7 @@ mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
               --   2. Large bitmap CmmData if needed
 
 mkLivenessBits dflags liveness
-  | n_bits > mAX_SMALL_BITMAP_SIZE    -- does not fit in one word
+  | n_bits > mAX_SMALL_BITMAP_SIZE dflags -- does not fit in one word
   = do { uniq <- getUniqueUs
        ; let bitmap_lbl = mkBitmapLabel uniq
        ; return (CmmLabel bitmap_lbl, 
index ea9a4bb..5505b92 100644 (file)
@@ -17,7 +17,6 @@ import CmmLive
 import CmmProcPoint
 import SMRep
 import Hoopl
-import Constants
 import UniqSupply
 import Maybes
 import UniqFM
@@ -345,7 +344,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
        return $ lastCall cont_lbl cml_args cml_ret_args cml_ret_off
 
     CmmForeignCall{ succ = cont_lbl, .. } -> do
-       return $ lastCall cont_lbl wORD_SIZE wORD_SIZE (sm_ret_off stack0)
+       return $ lastCall cont_lbl (wORD_SIZE dflags) (wORD_SIZE dflags) (sm_ret_off stack0)
             -- one word each for args and results: the return address
 
     CmmBranch{..}     ->  handleBranches
@@ -381,7 +380,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
        = (save_assignments, new_cont_stack)
        where
         (new_cont_stack, save_assignments)
-           = setupStackFrame lbl liveness cml_ret_off cml_ret_args stack0
+           = setupStackFrame dflags lbl liveness cml_ret_off cml_ret_args stack0
 
 
      -- For other last nodes (branches), if any of the targets is a
@@ -404,7 +403,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
              out = mapFromList [ (l', cont_stack)
                                | l' <- successors last ]
          return ( assigs
-                , spOffsetForCall sp0 cont_stack wORD_SIZE
+                , spOffsetForCall sp0 cont_stack (wORD_SIZE dflags)
                 , last
                 , []
                 , out)
@@ -440,7 +439,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
                  (stack2, assigs) =
                       --pprTrace "first visit to proc point"
                       --             (ppr l <+> ppr stack1) $
-                      setupStackFrame l liveness (sm_ret_off stack0)
+                      setupStackFrame dflags l liveness (sm_ret_off stack0)
                                                        cont_args stack0
              --
              (tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 assigs
@@ -496,14 +495,15 @@ fixupStack old_stack new_stack = concatMap move new_locs
 
 
 setupStackFrame
-             :: BlockId                 -- label of continuation
+             :: DynFlags
+             -> BlockId                 -- label of continuation
              -> BlockEnv CmmLive        -- liveness
              -> ByteOff      -- updfr
              -> ByteOff      -- bytes of return values on stack
              -> StackMap     -- current StackMap
              -> (StackMap, [CmmNode O O])
 
-setupStackFrame lbl liveness updfr_off ret_args stack0
+setupStackFrame dflags lbl liveness updfr_off ret_args stack0
   = (cont_stack, assignments)
   where
       -- get the set of LocalRegs live in the continuation
@@ -519,7 +519,7 @@ setupStackFrame lbl liveness updfr_off ret_args stack0
 
       -- everything up to updfr_off is off-limits
       -- stack1 contains updfr_off, plus everything we need to save
-      (stack1, assignments) = allocate updfr_off live stack0
+      (stack1, assignments) = allocate dflags updfr_off live stack0
 
       -- And the Sp at the continuation is:
       --   sm_sp stack1 + ret_args
@@ -600,9 +600,10 @@ futureContinuation middle = foldBlockNodesB f middle Nothing
 -- on the stack and return the new StackMap and the assignments to do
 -- the saving.
 --
-allocate :: ByteOff -> RegSet -> StackMap -> (StackMap, [CmmNode O O])
-allocate ret_off live stackmap@StackMap{ sm_sp = sp0
-                                       , sm_regs = regs0 }
+allocate :: DynFlags -> ByteOff -> RegSet -> StackMap
+         -> (StackMap, [CmmNode O O])
+allocate dflags ret_off live stackmap@StackMap{ sm_sp = sp0
+                                              , sm_regs = regs0 }
  =
   -- pprTrace "allocate" (ppr live $$ ppr stackmap) $
 
@@ -613,37 +614,37 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
 
    -- make a map of the stack
    let stack = reverse $ Array.elems $
-               accumArray (\_ x -> x) Empty (1, toWords (max sp0 ret_off)) $
+               accumArray (\_ x -> x) Empty (1, toWords dflags (max sp0 ret_off)) $
                  ret_words ++ live_words
             where ret_words =
                    [ (x, Occupied)
-                   | x <- [ 1 .. toWords ret_off] ]
+                   | x <- [ 1 .. toWords dflags ret_off] ]
                   live_words =
-                   [ (toWords x, Occupied)
+                   [ (toWords dflags x, Occupied)
                    | (r,off) <- eltsUFM regs1,
-                     let w = localRegBytes r,
-                     x <- [ off, off-wORD_SIZE .. off - w + 1] ]
+                     let w = localRegBytes dflags r,
+                     x <- [ off, off - wORD_SIZE dflags .. off - w + 1] ]
    in
 
    -- Pass over the stack: find slots to save all the new live variables,
    -- choosing the oldest slots first (hence a foldr).
    let
        save slot ([], stack, n, assigs, regs) -- no more regs to save
-          = ([], slot:stack, n `plusW` 1, assigs, regs)
+          = ([], slot:stack, plusW dflags n 1, assigs, regs)
        save slot (to_save, stack, n, assigs, regs)
           = case slot of
-               Occupied ->  (to_save, Occupied:stack, n `plusW` 1, assigs, regs)
+               Occupied ->  (to_save, Occupied:stack, plusW dflags n 1, assigs, regs)
                Empty
                  | Just (stack', r, to_save') <-
                        select_save to_save (slot:stack)
                  -> let assig = CmmStore (CmmStackSlot Old n')
                                          (CmmReg (CmmLocal r))
-                        n' = n `plusW` 1
+                        n' = plusW dflags n 1
                    in
                         (to_save', stack', n', assig : assigs, (r,(r,n')):regs)
 
                  | otherwise
-                 -> (to_save, slot:stack, n `plusW` 1, assigs, regs)
+                 -> (to_save, slot:stack, plusW dflags n 1, assigs, regs)
 
        -- we should do better here: right now we'll fit the smallest first,
        -- but it would make more sense to fit the biggest first.
@@ -656,7 +657,7 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
                  = Just (replicate words Occupied ++ rest, r, rs++no_fit)
                  | otherwise
                  = go rs (r:no_fit)
-                 where words = localRegWords r
+                 where words = localRegWords dflags r
 
        -- fill in empty slots as much as possible
        (still_to_save, save_stack, n, save_assigs, save_regs)
@@ -669,14 +670,14 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
               push r (n, assigs, regs)
                 = (n', assig : assigs, (r,(r,n')) : regs)
                 where
-                  n' = n + localRegBytes r
+                  n' = n + localRegBytes dflags r
                   assig = CmmStore (CmmStackSlot Old n')
                                    (CmmReg (CmmLocal r))
 
        trim_sp
           | not (null push_regs) = push_sp
           | otherwise
-          = n `plusW` (- length (takeWhile isEmpty save_stack))
+          = plusW dflags n (- length (takeWhile isEmpty save_stack))
 
        final_regs = regs1 `addListToUFM` push_regs
                           `addListToUFM` save_regs
@@ -685,7 +686,7 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
   -- XXX should be an assert
    if ( n /= max sp0 ret_off ) then pprPanic "allocate" (ppr n <+> ppr sp0 <+> ppr ret_off) else
 
-   if (trim_sp .&. (wORD_SIZE - 1)) /= 0  then pprPanic "allocate2" (ppr trim_sp <+> ppr final_regs <+> ppr push_sp) else
+   if (trim_sp .&. (wORD_SIZE dflags - 1)) /= 0  then pprPanic "allocate2" (ppr trim_sp <+> ppr final_regs <+> ppr push_sp) else
 
    ( stackmap { sm_regs = final_regs , sm_sp = trim_sp }
    , push_assigs ++ save_assigs )
@@ -843,8 +844,8 @@ elimStackStores stackmap stackmaps area_off nodes
 -- Update info tables to include stack liveness
 
 
-setInfoTableStackMap :: BlockEnv StackMap -> CmmDecl -> CmmDecl
-setInfoTableStackMap stackmaps (CmmProc top_info@TopInfo{..} l g)
+setInfoTableStackMap :: DynFlags -> BlockEnv StackMap -> CmmDecl -> CmmDecl
+setInfoTableStackMap dflags stackmaps (CmmProc top_info@TopInfo{..} l g)
   = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l g
   where
     fix_info lbl info_tbl@CmmInfoTable{ cit_rep = StackRep _ } =
@@ -855,18 +856,18 @@ setInfoTableStackMap stackmaps (CmmProc top_info@TopInfo{..} l g)
     get_liveness lbl
       = case mapLookup lbl stackmaps of
           Nothing -> pprPanic "setInfoTableStackMap" (ppr lbl <+> ppr info_tbls)
-          Just sm -> stackMapToLiveness sm
+          Just sm -> stackMapToLiveness dflags sm
 
-setInfoTableStackMap _ d = d
+setInfoTableStackMap _ d = d
 
 
-stackMapToLiveness :: StackMap -> Liveness
-stackMapToLiveness StackMap{..} =
+stackMapToLiveness :: DynFlags -> StackMap -> Liveness
+stackMapToLiveness dflags StackMap{..} =
    reverse $ Array.elems $
-        accumArray (\_ x -> x) True (toWords sm_ret_off + 1,
-                                     toWords (sm_sp - sm_args)) live_words
+        accumArray (\_ x -> x) True (toWords dflags sm_ret_off + 1,
+                                     toWords dflags (sm_sp - sm_args)) live_words
    where
-     live_words =  [ (toWords off, False)
+     live_words =  [ (toWords dflags off, False)
                    | (r,off) <- eltsUFM sm_regs, isGcPtrType (localRegType r) ]
 
 
@@ -982,8 +983,8 @@ callResumeThread new_base id =
 
 -- -----------------------------------------------------------------------------
 
-plusW :: ByteOff -> WordOff -> ByteOff
-plusW b w = b + w * wORD_SIZE
+plusW :: DynFlags -> ByteOff -> WordOff -> ByteOff
+plusW dflags b w = b + w * wORD_SIZE dflags
 
 dropEmpty :: WordOff -> [StackSlot] -> Maybe [StackSlot]
 dropEmpty 0 ss           = Just ss
@@ -994,14 +995,15 @@ isEmpty :: StackSlot -> Bool
 isEmpty Empty = True
 isEmpty _ = False
 
-localRegBytes :: LocalReg -> ByteOff
-localRegBytes r = roundUpToWords (widthInBytes (typeWidth (localRegType r)))
+localRegBytes :: DynFlags -> LocalReg -> ByteOff
+localRegBytes dflags r
+    = roundUpToWords dflags (widthInBytes (typeWidth (localRegType r)))
 
-localRegWords :: LocalReg -> WordOff
-localRegWords = toWords . localRegBytes
+localRegWords :: DynFlags -> LocalReg -> WordOff
+localRegWords dflags = toWords dflags . localRegBytes dflags
 
-toWords :: ByteOff -> WordOff
-toWords x = x `quot` wORD_SIZE
+toWords :: DynFlags -> ByteOff -> WordOff
+toWords dflags x = x `quot` wORD_SIZE dflags
 
 
 insertReloads :: StackMap -> [CmmNode O O]
index 0afe2a3..87a3ebf 100644 (file)
@@ -18,7 +18,6 @@ import PprCmm ()
 import BlockId
 import FastString
 import Outputable
-import Constants
 import DynFlags
 
 import Data.Maybe
@@ -108,6 +107,7 @@ cmmCheckMachOp op _ tys
   = do dflags <- getDynFlags
        return (machOpResultType dflags op tys)
 
+{-
 isOffsetOp :: MachOp -> Bool
 isOffsetOp (MO_Add _) = True
 isOffsetOp (MO_Sub _) = True
@@ -117,10 +117,10 @@ isOffsetOp _ = False
 -- check for funny-looking sub-word offsets.
 _cmmCheckWordAddress :: CmmExpr -> CmmLint ()
 _cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
-  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
+  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral (wORD_SIZE dflags) /= 0
   = cmmLintDubiousWordOffset e
 _cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
-  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
+  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral (wORD_SIZE dflags) /= 0
   = cmmLintDubiousWordOffset e
 _cmmCheckWordAddress _
   = return ()
@@ -130,6 +130,7 @@ _cmmCheckWordAddress _
 notNodeReg :: CmmExpr -> Bool
 notNodeReg (CmmReg reg) | reg == nodeReg = False
 notNodeReg _                             = True
+-}
 
 lintCmmMiddle :: CmmNode O O -> CmmLint ()
 lintCmmMiddle node = case node of
@@ -239,7 +240,10 @@ cmmLintAssignErr stmt e_ty r_ty
                               text "Rhs ty:" <+> ppr e_ty]))
 
 
+{-
 cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
 cmmLintDubiousWordOffset expr
    = cmmLintErr (text "offset is not a multiple of words: " $$
                  nest 2 (ppr expr))
+-}
+
index 7937b88..3061062 100644 (file)
@@ -340,9 +340,10 @@ info    :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
         | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')'
                 -- closure type, live regs
                 {% withThisPackage $ \pkg ->
-                   do live <- sequence (map (liftM Just) $7)
+                   do dflags <- getDynFlags
+                      live <- sequence (map (liftM Just) $7)
                       let prof = NoProfilingInfo
-                          bitmap = mkLiveness live
+                          bitmap = mkLiveness dflags live
                           rep  = mkRTSRep (fromIntegral $5) $ mkStackRep bitmap
                       return (mkCmmRetLabel pkg $3,
                               CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
@@ -888,7 +889,7 @@ adjCallTarget :: DynFlags -> CCallConv -> CmmExpr -> [CmmHinted CmmExpr]
 adjCallTarget dflags StdCallConv (CmmLit (CmmLabel lbl)) args
  | platformOS (targetPlatform dflags) == OSMinGW32
   = CmmLit (CmmLabel (addLabelSize lbl (sum (map size args))))
-  where size (CmmHinted e _) = max wORD_SIZE (widthInBytes (typeWidth (cmmExprType dflags e)))
+  where size (CmmHinted e _) = max (wORD_SIZE dflags) (widthInBytes (typeWidth (cmmExprType dflags e)))
                  -- c.f. CgForeignCall.emitForeignCall
 adjCallTarget _ _ expr _
   = expr
@@ -943,8 +944,8 @@ emitRetUT args = do
   emitSimultaneously stmts -- NB. the args might overlap with the stack slots
                            -- or regs that we assign to, so better use
                            -- simultaneous assignments here (#3546)
-  when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
-  stmtC $ CmmJump (entryCode dflags (CmmLoad (cmmRegOffW spReg sp) (bWord dflags))) (Just live)
+  when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW dflags spReg (-sp)))
+  stmtC $ CmmJump (entryCode dflags (CmmLoad (cmmRegOffW dflags spReg sp) (bWord dflags))) (Just live)
 
 -- -----------------------------------------------------------------------------
 -- If-then-else and boolean expressions
@@ -1053,7 +1054,7 @@ doSwitch mb_range scrut arms deflt
 initEnv :: DynFlags -> Env
 initEnv dflags = listToUFM [
   ( fsLit "SIZEOF_StgHeader",
-    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE)) (wordWidth dflags)) )),
+    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE dflags)) (wordWidth dflags)) )),
   ( fsLit "SIZEOF_StgInfoTable",
     VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) ))
   ]
index 6ee40d9..7692726 100644 (file)
@@ -119,7 +119,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
      
             ------------- Populate info tables with stack info -----------------
             gs <- {-# SCC "setInfoTableStackMap" #-}
-                  return $ map (setInfoTableStackMap stackmaps) gs
+                  return $ map (setInfoTableStackMap dflags stackmaps) gs
             dumps Opt_D_dump_cmmz_info "after setInfoTableStackMap" gs
      
             ----------- Control-flow optimisations -----------------------------
@@ -137,7 +137,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
 
             ------------- Populate info tables with stack info -----------------
             g <- {-# SCC "setInfoTableStackMap" #-}
-                  return $ setInfoTableStackMap stackmaps g
+                  return $ setInfoTableStackMap dflags stackmaps g
             dump' Opt_D_dump_cmmz_info "after setInfoTableStackMap" g
      
             ----------- Control-flow optimisations -----------------------------
index 66b4c83..c0ce9e3 100644 (file)
@@ -17,7 +17,6 @@ where
 
 #include "HsVersions.h"
 
-import Constants
 import DynFlags
 import FastString
 import Outputable
@@ -161,22 +160,22 @@ mrStr W80  = sLit("W80")
 
 -------- Common Widths  ------------
 wordWidth :: DynFlags -> Width
-wordWidth _
- | wORD_SIZE == 4 = W32
- | wORD_SIZE == 8 = W64
- | otherwise      = panic "MachOp.wordRep: Unknown word size"
+wordWidth dflags
+ | wORD_SIZE dflags == 4 = W32
+ | wORD_SIZE dflags == 8 = W64
+ | otherwise             = panic "MachOp.wordRep: Unknown word size"
 
 halfWordWidth :: DynFlags -> Width
-halfWordWidth _
- | wORD_SIZE == 4 = W16
- | wORD_SIZE == 8 = W32
- | otherwise      = panic "MachOp.halfWordRep: Unknown word size"
+halfWordWidth dflags
+ | wORD_SIZE dflags == 4 = W16
+ | wORD_SIZE dflags == 8 = W32
+ | otherwise             = panic "MachOp.halfWordRep: Unknown word size"
 
 halfWordMask :: DynFlags -> Integer
-halfWordMask _
- | wORD_SIZE == 4 = 0xFFFF
- | wORD_SIZE == 8 = 0xFFFFFFFF
- | otherwise      = panic "MachOp.halfWordMask: Unknown word size"
+halfWordMask dflags
+ | wORD_SIZE dflags == 4 = 0xFFFF
+ | wORD_SIZE dflags == 8 = 0xFFFFFFFF
+ | otherwise             = panic "MachOp.halfWordMask: Unknown word size"
 
 -- cIntRep is the Width for a C-language 'int'
 cIntWidth, cLongWidth :: Width
index 75bdf61..9a64531 100644 (file)
@@ -72,7 +72,7 @@ import CLabel
 import Outputable
 import Unique
 import UniqSupply
-import Constants( wORD_SIZE, tAG_MASK )
+import Constants( tAG_MASK )
 import DynFlags
 import Util
 
@@ -272,16 +272,16 @@ cmmOffsetExprW dflags  e (CmmLit (CmmInt n _)) = cmmOffsetW dflags e (fromIntege
 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)
+cmmOffsetW dflags e n = cmmOffsetB dflags e (wORD_SIZE dflags * n)
 
-cmmRegOffW :: CmmReg -> WordOff -> CmmExpr
-cmmRegOffW reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE)
+cmmRegOffW :: DynFlags -> CmmReg -> WordOff -> CmmExpr
+cmmRegOffW dflags reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE dflags)
 
-cmmOffsetLitW :: CmmLit -> WordOff -> CmmLit
-cmmOffsetLitW lit wd_off = cmmOffsetLitB lit (wORD_SIZE * wd_off)
+cmmOffsetLitW :: DynFlags -> CmmLit -> WordOff -> CmmLit
+cmmOffsetLitW dflags lit wd_off = cmmOffsetLitB lit (wORD_SIZE dflags * wd_off)
 
-cmmLabelOffW :: CLabel -> WordOff -> CmmLit
-cmmLabelOffW lbl wd_off = cmmLabelOffB lbl (wORD_SIZE * wd_off)
+cmmLabelOffW :: DynFlags -> CLabel -> WordOff -> CmmLit
+cmmLabelOffW dflags lbl wd_off = cmmLabelOffB lbl (wORD_SIZE dflags * wd_off)
 
 cmmLoadIndexW :: DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
 cmmLoadIndexW dflags base off ty = CmmLoad (cmmOffsetW dflags base off) ty
@@ -309,8 +309,8 @@ cmmNegate :: DynFlags -> CmmExpr -> CmmExpr
 cmmNegate _      (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
 cmmNegate dflags e                       = CmmMachOp (MO_S_Neg (cmmExprWidth dflags e)) [e]
 
-blankWord :: CmmStatic
-blankWord = CmmUninitialised wORD_SIZE
+blankWord :: DynFlags -> CmmStatic
+blankWord dflags = CmmUninitialised (wORD_SIZE dflags)
 
 ---------------------------------------------------
 --
@@ -371,15 +371,15 @@ cmmConstrTag1 dflags e = cmmAndWord dflags e (cmmTagMask dflags)
 --
 ---------------------------------------------
 
-mkLiveness :: [Maybe LocalReg] -> Liveness
-mkLiveness [] = []
-mkLiveness (reg:regs)
-  = take sizeW bits ++ mkLiveness regs
+mkLiveness :: DynFlags -> [Maybe LocalReg] -> Liveness
+mkLiveness _      [] = []
+mkLiveness dflags (reg:regs)
+  = take sizeW bits ++ mkLiveness dflags regs
   where
     sizeW = case reg of
               Nothing -> 1
-              Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE - 1)
-                        `quot` wORD_SIZE
+              Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE dflags - 1)
+                        `quot` wORD_SIZE dflags
                         -- number of words, rounded up
     bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
 
index 9146aa7..5dd3209 100644 (file)
@@ -22,7 +22,6 @@ import OldCmm
 import CLabel
 import Outputable
 import OldPprCmm()
-import Constants
 import FastString
 import DynFlags
 
@@ -97,6 +96,7 @@ cmmCheckMachOp dflags op [lit@(CmmLit (CmmInt { })), reg@(CmmReg _)] tys
 cmmCheckMachOp dflags op _ tys
   = return (machOpResultType dflags op tys)
 
+{-
 isOffsetOp :: MachOp -> Bool
 isOffsetOp (MO_Add _) = True
 isOffsetOp (MO_Sub _) = True
@@ -106,10 +106,10 @@ isOffsetOp _ = False
 -- check for funny-looking sub-word offsets.
 _cmmCheckWordAddress :: CmmExpr -> CmmLint ()
 _cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
-  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
+  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral (wORD_SIZE dflags) /= 0
   = cmmLintDubiousWordOffset e
 _cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
-  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
+  | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral (wORD_SIZE dflags) /= 0
   = cmmLintDubiousWordOffset e
 _cmmCheckWordAddress _
   = return ()
@@ -119,6 +119,7 @@ _cmmCheckWordAddress _
 notNodeReg :: CmmExpr -> Bool
 notNodeReg (CmmReg reg) | reg == nodeReg = False
 notNodeReg _                             = True
+-}
 
 lintCmmStmt :: DynFlags -> BlockSet -> CmmStmt -> CmmLint ()
 lintCmmStmt dflags labels = lint
@@ -204,7 +205,10 @@ cmmLintAssignErr stmt e_ty r_ty
                         
                                        
 
+{-
 cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
 cmmLintDubiousWordOffset expr
    = cmmLintErr (text "offset is not a multiple of words: " $$
                        nest 2 (ppr expr))
+-}
+
index b40b34a..e6c9ac3 100644 (file)
@@ -374,7 +374,7 @@ pprLoad dflags e ty
                       -> char '*' <> pprAsPtrReg r
 
         CmmRegOff r off | isPtrReg r && width == wordWidth dflags
-                        , off `rem` wORD_SIZE == 0 && not (isFloatType ty)
+                        , off `rem` wORD_SIZE dflags == 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 dflags))
@@ -480,9 +480,9 @@ 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
+  | wORD_SIZE dflags == 8, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
   = pprLit1 (floatToWord dflags f) : pprStatics dflags rest'
-  | wORD_SIZE == 4
+  | wORD_SIZE dflags == 4
   = pprLit1 (floatToWord dflags f) : pprStatics dflags rest
   | otherwise
   = pprPanic "pprStatics: float" (vcat (map ppr' rest))
@@ -721,7 +721,7 @@ pprAssign _ r1 (CmmReg r2)
 
 -- dest is a reg, rhs is a CmmRegOff
 pprAssign dflags r1 (CmmRegOff r2 off)
-   | isPtrReg r1 && isPtrReg r2 && (off `rem` wORD_SIZE == 0)
+   | isPtrReg r1 && isPtrReg r2 && (off `rem` wORD_SIZE dflags == 0)
    = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, op, int off', semi ]
   where
         off1 = off `shiftR` wordShift dflags
@@ -911,7 +911,7 @@ pprExternDecl _in_srt lbl
   -- add the @n suffix to the label (#2276)
   stdcall_decl sz = sdocWithDynFlags $ \dflags ->
         ptext (sLit "extern __attribute__((stdcall)) void ") <> ppr lbl
-        <> parens (commafy (replicate (sz `quot` wORD_SIZE) (machRep_U_CType (wordWidth dflags))))
+        <> parens (commafy (replicate (sz `quot` wORD_SIZE dflags) (machRep_U_CType (wordWidth dflags))))
         <> semi
 
 type TEState = (UniqSet LocalReg, Map CLabel ())
@@ -1059,10 +1059,10 @@ pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
 -- This is a hack to turn the floating point numbers into ints that we
 -- can safely initialise to static locations.
 
-big_doubles :: Bool
-big_doubles
-  | widthInBytes W64 == 2 * wORD_SIZE  = True
-  | widthInBytes W64 == wORD_SIZE      = False
+big_doubles :: DynFlags -> Bool
+big_doubles dflags
+  | widthInBytes W64 == 2 * wORD_SIZE dflags = True
+  | widthInBytes W64 == wORD_SIZE dflags     = False
   | otherwise = panic "big_doubles"
 
 castFloatToIntArray :: STUArray s Int Float -> ST s (STUArray s Int Int)
@@ -1084,7 +1084,7 @@ floatToWord dflags r
 
 doubleToWords :: DynFlags -> Rational -> [CmmLit]
 doubleToWords dflags r
-  | big_doubles                         -- doubles are 2 words
+  | big_doubles dflags                  -- doubles are 2 words
   = runST (do
         arr <- newArray_ ((0::Int),1)
         writeArray arr 0 (fromRational r)
index 79e1910..2c9cb32 100644 (file)
@@ -45,7 +45,6 @@ module SMRep (
 #include "../includes/MachDeps.h"
 
 import DynFlags
-import Constants
 import Outputable
 import FastString
 
@@ -65,8 +64,8 @@ import Data.Bits
 type WordOff = Int -- Word offset, or word count
 type ByteOff = Int -- Byte offset, or byte count
 
-roundUpToWords :: ByteOff -> ByteOff
-roundUpToWords n = (n + (wORD_SIZE - 1)) .&. (complement (wORD_SIZE - 1))
+roundUpToWords :: DynFlags -> ByteOff -> ByteOff
+roundUpToWords dflags n = (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))
 \end{code}
 
 StgWord is a type representing an StgWord on the target platform.
@@ -235,17 +234,17 @@ minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
 
 arrWordsHdrSize :: DynFlags -> ByteOff
 arrWordsHdrSize dflags
- = fixedHdrSize dflags * wORD_SIZE + sIZEOF_StgArrWords_NoHdr dflags
+ = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
 
 arrPtrsHdrSize :: DynFlags -> ByteOff
 arrPtrsHdrSize dflags
- = fixedHdrSize dflags * wORD_SIZE + sIZEOF_StgMutArrPtrs_NoHdr dflags
+ = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
 
 -- Thunks have an extra header word on SMP, so the update doesn't
 -- splat the payload.
 thunkHdrSize :: DynFlags -> WordOff
 thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
-        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE
+        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
 
 
 nonHdrSize :: SMRep -> WordOff
index 7fe7980..4cb12a8 100644 (file)
@@ -38,8 +38,8 @@ import CgStackery
 import CgUtils
 import CLabel
 import ClosureInfo
-import Constants
 
+import DynFlags
 import OldCmm
 import PprCmm           ( {- instance Outputable -} )
 import SMRep
@@ -184,8 +184,8 @@ letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_
 stackIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo
 stackIdInfo id sp       lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
 
-nodeIdInfo :: Id -> Int -> LambdaFormInfo -> CgIdInfo
-nodeIdInfo id offset    lf_info = mkCgIdInfo id (VirNodeLoc (wORD_SIZE*offset)) NoStableLoc lf_info
+nodeIdInfo :: DynFlags -> Id -> Int -> LambdaFormInfo -> CgIdInfo
+nodeIdInfo dflags id offset lf_info = mkCgIdInfo id (VirNodeLoc (wORD_SIZE dflags * offset)) NoStableLoc lf_info
 
 regIdInfo :: Id -> CmmReg -> LambdaFormInfo -> CgIdInfo
 regIdInfo id reg        lf_info = mkCgIdInfo id (RegLoc reg) NoStableLoc lf_info
@@ -199,9 +199,9 @@ taggedHeapIdInfo :: Id -> VirtualHpOffset -> LambdaFormInfo -> DataCon
 taggedHeapIdInfo id offset lf_info con
   = mkTaggedCgIdInfo id (VirHpLoc offset) NoStableLoc lf_info con
 
-untagNodeIdInfo :: Id -> Int -> LambdaFormInfo -> Int -> CgIdInfo
-untagNodeIdInfo id offset    lf_info tag
-  = mkCgIdInfo id (VirNodeLoc (wORD_SIZE*offset - tag)) NoStableLoc lf_info
+untagNodeIdInfo :: DynFlags -> Id -> Int -> LambdaFormInfo -> Int -> CgIdInfo
+untagNodeIdInfo dflags id offset lf_info tag
+  = mkCgIdInfo id (VirNodeLoc (wORD_SIZE dflags * offset - tag)) NoStableLoc lf_info
 
 
 idInfoToAmode :: CgIdInfo -> FCode CmmExpr
@@ -440,11 +440,13 @@ bindArgsToRegs args
 
 bindNewToNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Code
 bindNewToNode id offset lf_info
-  = addBindC id (nodeIdInfo id offset lf_info)
+  = do dflags <- getDynFlags
+       addBindC id (nodeIdInfo dflags id offset lf_info)
 
 bindNewToUntagNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Int -> Code
 bindNewToUntagNode id offset lf_info tag
-  = addBindC id (untagNodeIdInfo id offset lf_info tag)
+  = do dflags <- getDynFlags
+       addBindC id (untagNodeIdInfo dflags id offset lf_info tag)
 
 -- Create a new temporary whose unique is that in the id,
 -- bind the id to it, and return the addressing mode for the
@@ -497,9 +499,10 @@ Probably *naughty* to look inside monad...
 nukeDeadBindings :: StgLiveVars  -- All the *live* variables
                  -> Code
 nukeDeadBindings live_vars = do
+        dflags <- getDynFlags
         binds <- getBinds
         let (dead_stk_slots, bs') =
-                dead_slots live_vars 
+                dead_slots dflags live_vars
                         [] []
                         [ (cg_id b, b) | b <- varEnvElts binds ]
         setBinds $ mkVarEnv bs'
@@ -509,7 +512,8 @@ nukeDeadBindings live_vars = do
 Several boring auxiliary functions to do the dirty work.
 
 \begin{code}
-dead_slots :: StgLiveVars
+dead_slots :: DynFlags
+           -> StgLiveVars
            -> [(Id,CgIdInfo)]
            -> [VirtualSpOffset]
            -> [(Id,CgIdInfo)]
@@ -517,12 +521,12 @@ dead_slots :: StgLiveVars
 
 -- dead_slots carries accumulating parameters for
 --      filtered bindings, dead slots
-dead_slots _ fbs ds []
+dead_slots _ fbs ds []
   = (ds, reverse fbs) -- Finished; rm the dups, if any
 
-dead_slots live_vars fbs ds ((v,i):bs)
+dead_slots dflags live_vars fbs ds ((v,i):bs)
   | v `elementOfUniqSet` live_vars
-    = dead_slots live_vars ((v,i):fbs) ds bs
+    = dead_slots dflags live_vars ((v,i):fbs) ds bs
           -- Live, so don't record it in dead slots
           -- Instead keep it in the filtered bindings
 
@@ -530,12 +534,12 @@ dead_slots live_vars fbs ds ((v,i):bs)
     = case cg_stb i of
         VirStkLoc offset
          | size > 0
-         -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
+         -> dead_slots dflags live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
 
-        _ -> dead_slots live_vars fbs ds bs
+        _ -> dead_slots dflags live_vars fbs ds bs
   where
     size :: WordOff
-    size = cgRepSizeW (cg_rep i)
+    size = cgRepSizeW dflags (cg_rep i)
 
 getLiveStackSlots :: FCode [VirtualSpOffset]
 -- Return the offsets of slots in stack containig live pointers
index 2be5789..45edd64 100644 (file)
@@ -66,18 +66,18 @@ import Data.Bits
 -------------------------
 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
 mkArgDescr _nm args
-  = case stdPattern arg_reps of
-        Just spec_id -> return (ArgSpec spec_id)
-        Nothing      -> return (ArgGen arg_bits)
-  where
-    arg_bits = argBits arg_reps
-    arg_reps = filter nonVoidArg (map idCgRep args)
-        -- Getting rid of voids eases matching of standard patterns
-
-argBits :: [CgRep] -> [Bool]    -- True for non-ptr, False for ptr
-argBits []              = []
-argBits (PtrArg : args) = False : argBits args
-argBits (arg    : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
+  = do dflags <- getDynFlags
+       let arg_bits = argBits dflags arg_reps
+           arg_reps = filter nonVoidArg (map idCgRep args)
+           -- Getting rid of voids eases matching of standard patterns
+       case stdPattern arg_reps of
+           Just spec_id -> return (ArgSpec spec_id)
+           Nothing      -> return (ArgGen arg_bits)
+
+argBits :: DynFlags -> [CgRep] -> [Bool]    -- True for non-ptr, False for ptr
+argBits _      []              = []
+argBits dflags (PtrArg : args) = False : argBits dflags args
+argBits dflags (arg    : args) = take (cgRepSizeW dflags arg) (repeat True) ++ argBits dflags args
 
 stdPattern :: [CgRep] -> Maybe StgHalfWord
 stdPattern []          = Just ARG_NONE  -- just void args, probably
index fce9104..0ed8738 100644 (file)
@@ -279,7 +279,7 @@ closureCodeBody _binder_info cl_info cc args body
        -- eg. if we're compiling a let-no-escape).
   ; vSp <- getVirtSp
   ; let (reg_args, other_args) = assignCallRegs dflags (addIdReps args)
-       (sp_top, stk_args)     = mkVirtStkOffsets vSp other_args
+       (sp_top, stk_args)     = mkVirtStkOffsets dflags vSp other_args
 
        -- Allocate the global ticky counter
   ; let ticky_ctr_lbl = mkRednCountsLabel (closureName cl_info) (clHasCafRefs cl_info)
@@ -365,22 +365,22 @@ mkSlowEntryCode dflags cl_info reg_args
      reps_w_regs :: [(CgRep,GlobalReg)]
      reps_w_regs = [(idCgRep id, reg) | (id,reg) <- reverse reg_args]
      (final_stk_offset, stk_offsets)
-       = mapAccumL (\off (rep,_) -> (off + cgRepSizeW rep, off))
+       = mapAccumL (\off (rep,_) -> (off + cgRepSizeW dflags rep, off))
                    0 reps_w_regs
 
 
      load_assts = zipWithEqual "mk_load" mk_load reps_w_regs stk_offsets
      mk_load (rep,reg) offset = CmmAssign (CmmGlobal reg) 
-                                         (CmmLoad (cmmRegOffW spReg offset)
+                                         (CmmLoad (cmmRegOffW dflags spReg offset)
                                                   (argMachRep dflags rep))
 
      save_assts = zipWithEqual "mk_save" mk_save reps_w_regs stk_offsets
      mk_save (rep,reg) offset = ASSERT( argMachRep dflags rep `cmmEqType` globalRegType dflags reg )
-                               CmmStore (cmmRegOffW spReg offset)
+                               CmmStore (cmmRegOffW dflags spReg offset)
                                         (CmmReg (CmmGlobal reg))
 
-     stk_adj_pop   = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
-     stk_adj_push  = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
+     stk_adj_pop   = CmmAssign spReg (cmmRegOffW dflags spReg final_stk_offset)
+     stk_adj_push  = CmmAssign spReg (cmmRegOffW dflags spReg (- final_stk_offset))
      live_regs     = Just $ map snd reps_w_regs
      jump_to_entry = CmmJump (mkLblExpr (entryLabelFromCI dflags cl_info)) live_regs
 \end{code}
index 8afbc8f..c2d9954 100644 (file)
@@ -192,7 +192,7 @@ buildDynCon' dflags platform binder _ con [arg_amode]
   = do  { let intlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
               offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1)
                 -- INTLIKE closures consist of a header and one word payload
-              intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
+              intlike_amode = CmmLit (cmmLabelOffW dflags intlike_lbl offsetW)
         ; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
 
 buildDynCon' dflags platform binder _ con [arg_amode]
@@ -204,7 +204,7 @@ buildDynCon' dflags platform binder _ con [arg_amode]
   = do  { let charlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
               offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1)
                 -- CHARLIKE closures consist of a header and one word payload
-              charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
+              charlike_amode = CmmLit (cmmLabelOffW dflags charlike_lbl offsetW)
         ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
 
 \end{code}
@@ -284,8 +284,8 @@ bindUnboxedTupleComponents args
                 -- Allocate the rest on the stack
                 -- The real SP points to the return address, above which any
                 -- leftover unboxed-tuple components will be allocated
-              (ptr_sp,  ptr_offsets)  = mkVirtStkOffsets rsp    ptr_args
-              (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
+              (ptr_sp,  ptr_offsets)  = mkVirtStkOffsets dflags rsp    ptr_args
+              (nptr_sp, nptr_offsets) = mkVirtStkOffsets dflags ptr_sp nptr_args
               ptrs  = ptr_sp  - rsp
               nptrs = nptr_sp - ptr_sp
 
index 435fbb0..824a826 100644 (file)
@@ -30,7 +30,6 @@ import OldCmm
 import OldCmmUtils
 import SMRep
 import ForeignCall
-import Constants
 import DynFlags
 import Outputable
 import Module
@@ -103,7 +102,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live = do
         | otherwise            = Nothing
 
         -- ToDo: this might not be correct for 64-bit API
-      arg_size rep = max (widthInBytes (typeWidth rep)) wORD_SIZE
+      arg_size rep = max (widthInBytes (typeWidth rep)) (wORD_SIZE dflags)
   vols <- getVolatileRegs live
   srt <- getSRTInfo
   emitForeignCall' safety results
@@ -286,7 +285,7 @@ stack_STACK  dflags = closureField dflags (oFFSET_StgStack_stack dflags)
 stack_SP     dflags = closureField dflags (oFFSET_StgStack_sp dflags)
 
 closureField :: DynFlags -> ByteOff -> ByteOff
-closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE
+closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE dflags
 
 stgSp, stgHp, stgCurrentTSO, stgCurrentNursery :: CmmExpr
 stgSp             = CmmReg sp
index f3cb779..c7f6f29 100644 (file)
@@ -42,7 +42,6 @@ import TyCon
 import CostCentre
 import Util
 import Module
-import Constants
 import Outputable
 import DynFlags
 import FastString
@@ -103,8 +102,9 @@ setRealHp new_realHp
 
 getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
 getHpRelOffset virtual_offset
-  = do  { hp_usg <- getHpUsage
-        ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) }
+  = do  { dflags <- getDynFlags
+        ; hp_usg <- getHpUsage
+        ; return (cmmRegOffW dflags hpReg (hpRel (realHp hp_usg) virtual_offset)) }
 \end{code}
 
 
@@ -165,7 +165,7 @@ mkVirtHeapOffsets dflags is_thunk things
                 | otherwise  = fixedHdrSize dflags
 
     computeOffset wds_so_far (rep, thing)
-      = (wds_so_far + cgRepSizeW rep, (thing, hdr_size + wds_so_far))
+      = (wds_so_far + cgRepSizeW dflags rep, (thing, hdr_size + wds_so_far))
 \end{code}
 
 
@@ -244,7 +244,7 @@ mkStaticClosure dflags info_lbl ccs payload padding_wds static_link_field saved_
 padLitToWord :: DynFlags -> CmmLit -> [CmmLit]
 padLitToWord dflags lit = lit : padding pad_length
   where width = typeWidth (cmmLitType dflags lit)
-        pad_length = wORD_SIZE - widthInBytes width :: Int
+        pad_length = wORD_SIZE dflags - widthInBytes width :: Int
 
         padding n | n <= 0 = []
                   | n `rem` 2 /= 0 = CmmInt 0 W8  : padding (n-1)
@@ -461,8 +461,8 @@ do_checks stk hp reg_save_code rts_lbl live
                     "See: http://hackage.haskell.org/trac/ghc/ticket/4505",
                     "Suggestion: read data from a file instead of having large static data",
                     "structures in the code."])
-           else do_checks' (mkIntExpr dflags (stk * wORD_SIZE))
-                           (mkIntExpr dflags (hp * wORD_SIZE))
+           else do_checks' (mkIntExpr dflags (stk * wORD_SIZE dflags))
+                           (mkIntExpr dflags (hp * wORD_SIZE dflags))
                     (stk /= 0) (hp /= 0) reg_save_code rts_lbl live
 
 -- The offsets are now in *bytes*
index ce4228e..03c0edd 100644 (file)
@@ -43,7 +43,6 @@ import CLabel
 import Name
 import Unique
 
-import Constants
 import DynFlags
 import Util
 import Outputable
@@ -94,16 +93,17 @@ emitReturnTarget
    -> CgStmts                  -- The direct-return code (if any)
    -> FCode CLabel
 emitReturnTarget name stmts
-  = do { srt_info   <- getSRTInfo
-       ; blks <- cgStmtsToBlocks stmts
-        ; frame <- mkStackLayout
-        ; let smrep    = mkStackRep (mkLiveness frame)
-              info     = CmmInfoTable { cit_lbl  = info_lbl
-                                      , cit_prof = NoProfilingInfo
-                                      , cit_rep  = smrep
-                                      , cit_srt  = srt_info }
-        ; emitInfoTableAndCode entry_lbl info args blks
-       ; return info_lbl }
+  = do dflags <- getDynFlags
+       srt_info   <- getSRTInfo
+       blks <- cgStmtsToBlocks stmts
+       frame <- mkStackLayout
+       let smrep    = mkStackRep (mkLiveness dflags frame)
+           info     = CmmInfoTable { cit_lbl  = info_lbl
+                                   , cit_prof = NoProfilingInfo
+                                   , cit_rep  = smrep
+                                   , cit_srt  = srt_info }
+       emitInfoTableAndCode entry_lbl info args blks
+       return info_lbl
   where
     args      = {- trace "emitReturnTarget: missing args" -} []
     uniq      = getUnique name
@@ -173,7 +173,7 @@ stack_layout _ [] sizeW = replicate sizeW Nothing
 stack_layout dflags ((off, bind):binds) sizeW | off == sizeW - 1 =
   (Just stack_bind) : (stack_layout dflags binds (sizeW - rep_size))
   where
-    rep_size = cgRepSizeW (cgIdInfoArgRep bind)
+    rep_size = cgRepSizeW dflags (cgIdInfoArgRep bind)
     stack_bind = LocalReg unique machRep
     unique = getUnique (cgIdInfoId bind)
     machRep = argMachRep dflags (cgIdInfoArgRep bind)
@@ -258,7 +258,7 @@ stdInfoTableSizeW dflags
               | otherwise                      = 0
 
 stdInfoTableSizeB :: DynFlags -> ByteOff
-stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE
+stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags
 
 stdSrtBitmapOffset :: DynFlags -> ByteOff
 -- Byte offset of the SRT bitmap half-word which is 
@@ -267,11 +267,11 @@ stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE
 
 stdClosureTypeOffset :: DynFlags -> ByteOff
 -- Byte offset of the closure type half-word 
-stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE
+stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags
 
 stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff
-stdPtrsOffset    dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE
-stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE + hALF_WORD_SIZE
+stdPtrsOffset    dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags
+stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE
 
 -------------------------------------------------------------------------
 --
index 854a81a..98c7e21 100644 (file)
@@ -28,7 +28,6 @@ import OldCmmUtils
 import PrimOp
 import SMRep
 import Module
-import Constants
 import Outputable
 import DynFlags
 import FastString
@@ -851,7 +850,7 @@ doWritePtrArrayOp addr idx val
 
 loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
 loadArrPtrsSize dflags addr = CmmLoad (cmmOffsetB dflags addr off) (bWord dflags)
- where off = fixedHdrSize dflags * wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs dflags
+ where off = fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_ptrs dflags
 
 mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
                    -> LocalReg -> CmmExpr -> CmmExpr -> Code
@@ -967,7 +966,7 @@ doCopyArrayOp = emitCopyArray copy
     -- they're of different types)
     copy _src _dst dst_p src_p bytes live =
         do dflags <- getDynFlags
-           emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags wORD_SIZE)) live
+           emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live
 
 -- | Takes a source 'MutableArray#', an offset in the source array, a
 -- destination 'MutableArray#', an offset into the destination array,
@@ -983,8 +982,8 @@ doCopyMutableArrayOp = emitCopyArray copy
     copy src dst dst_p src_p bytes 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)
+               (emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live)
+               (emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live)
 
 emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                   -> StgLiveVars -> Code)
@@ -1007,7 +1006,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 dflags n (CmmLit (mkIntCLit dflags wORD_SIZE))
+    bytes <- assignTemp $ cmmMulWord dflags n (CmmLit (mkIntCLit dflags (wORD_SIZE dflags)))
 
     copy src dst dst_p src_p bytes live
 
@@ -1025,7 +1024,7 @@ emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr
 emitCloneArray info_p res_r src0 src_off0 n0 live = do
     dflags <- getDynFlags
     let arrPtrsHdrSizeW dflags = CmmLit $ mkIntCLit dflags $ fixedHdrSize dflags +
-                                     (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE)
+                                     (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE dflags)
         myCapability = cmmSubWord dflags (CmmReg baseReg)
                                          (CmmLit (mkIntCLit dflags (oFFSET_Capability_r dflags)))
     -- Assign the arguments to temporaries so the code generator can
@@ -1045,9 +1044,9 @@ emitCloneArray info_p res_r src0 src_off0 n0 live = do
 
     let arr = CmmReg (CmmLocal arr_r)
     emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCS
-    stmtC $ CmmStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE +
+    stmtC $ CmmStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags +
                                              oFFSET_StgMutArrPtrs_ptrs dflags)) n
-    stmtC $ CmmStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE +
+    stmtC $ CmmStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags +
                                              oFFSET_StgMutArrPtrs_size dflags)) size
 
     dst_p <- assignTemp $ cmmOffsetB dflags arr (arrPtrsHdrSize dflags)
@@ -1055,12 +1054,12 @@ emitCloneArray info_p res_r src0 src_off0 n0 live = do
              src_off
 
     emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags))
-        (CmmLit (mkIntCLit dflags wORD_SIZE)) live
+        (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live
 
     emitMemsetCall (cmmOffsetExprW dflags dst_p n)
         (CmmLit (mkIntCLit dflags 1))
         card_bytes
-        (CmmLit (mkIntCLit dflags wORD_SIZE))
+        (CmmLit (mkIntCLit dflags (wORD_SIZE dflags)))
         live
     stmtC $ CmmAssign (CmmLocal res_r) arr
 
@@ -1088,11 +1087,11 @@ cardRoundUp dflags i = card dflags (cmmAddWord dflags i (CmmLit (mkIntCLit dflag
 bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr
 bytesToWordsRoundUp dflags e
     = cmmQuotWord dflags
-          (cmmAddWord dflags e (CmmLit (mkIntCLit dflags (wORD_SIZE - 1))))
+          (cmmAddWord dflags e (CmmLit (mkIntCLit dflags (wORD_SIZE dflags - 1))))
           (wordSize dflags)
 
 wordSize :: DynFlags -> CmmExpr
-wordSize dflags = CmmLit (mkIntCLit dflags wORD_SIZE)
+wordSize dflags = CmmLit (mkIntCLit dflags (wORD_SIZE dflags))
 
 -- | Emit a call to @memcpy@.
 emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars
index 19376b9..4a611d1 100644 (file)
@@ -45,7 +45,6 @@ import CostCentre
 import DynFlags
 import FastString
 import Module
-import Constants        -- Lots of field offsets
 import Outputable
 
 import Data.Char
@@ -203,7 +202,9 @@ emitCostCentreStackDecl ccs
         -- pad out the struct with zero words until we hit the
         -- size of the overall struct (which we get via DerivedConstants.h)
         --
-     lits = zero dflags : mkCCostCentre cc : replicate (sizeof_ccs_words - 2) (zero dflags)
+     lits = zero dflags
+          : mkCCostCentre cc
+          : replicate (sizeof_ccs_words dflags - 2) (zero dflags)
   ; emitDataLits (mkCCSLabel ccs) lits
   }
   | otherwise = pprPanic "emitCostCentreStackDecl" (ppr ccs)
@@ -213,13 +214,13 @@ zero dflags = mkIntCLit dflags 0
 zero64 :: CmmLit
 zero64 = CmmInt 0 W64
 
-sizeof_ccs_words :: Int
-sizeof_ccs_words
+sizeof_ccs_words :: DynFlags -> Int
+sizeof_ccs_words dflags
     -- round up to the next word.
   | ms == 0   = ws
   | otherwise = ws + 1
   where
-   (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
+   (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE dflags
 
 -- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
index 7c4caf4..2f7bdfc 100644 (file)
@@ -37,7 +37,6 @@ import SMRep
 import OldCmm
 import OldCmmUtils
 import CLabel
-import Constants
 import DynFlags
 import Util
 import OrdList
@@ -101,8 +100,9 @@ setRealSp new_real_sp
 
 getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
 getSpRelOffset virtual_offset
-  = do { real_sp <- getRealSp
-       ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
+  = do dflags <- getDynFlags
+       real_sp <- getRealSp
+       return (cmmRegOffW dflags spReg (spRel real_sp virtual_offset))
 \end{code}
 
 
@@ -118,12 +118,13 @@ increase towards the top of stack).
 
 \begin{code}
 mkVirtStkOffsets
-         :: VirtualSpOffset    -- Offset of the last allocated thing
+         :: DynFlags
+         -> VirtualSpOffset    -- Offset of the last allocated thing
          -> [(CgRep,a)]                -- things to make offsets for
          -> (VirtualSpOffset,          -- OUTPUTS: Topmost allocated word
              [(a, VirtualSpOffset)])   -- things with offsets (voids filtered out)
 
-mkVirtStkOffsets init_Sp_offset things
+mkVirtStkOffsets dflags init_Sp_offset things
     = loop init_Sp_offset [] (reverse things)
   where
     loop offset offs [] = (offset,offs)
@@ -132,7 +133,7 @@ mkVirtStkOffsets init_Sp_offset things
     loop offset offs ((rep,t):things)
        = loop thing_slot ((t,thing_slot):offs) things
        where
-         thing_slot = offset + cgRepSizeW rep
+         thing_slot = offset + cgRepSizeW dflags rep
            -- offset of thing is offset+size, because we're 
            -- growing the stack *downwards* as the offsets increase.
 
@@ -149,12 +150,13 @@ mkStkAmodes
                  CmmStmts)         -- Assignments to appropriate stk slots
 
 mkStkAmodes tail_Sp things
-  = do { rSp <- getRealSp
-       ; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things
-             abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode
-                      | (amode, offset) <- offsets
-                      ]
-       ; returnFC (last_Sp_offset, toOL abs_cs) }
+  = do dflags <- getDynFlags
+       rSp <- getRealSp
+       let (last_Sp_offset, offsets) = mkVirtStkOffsets dflags tail_Sp things
+           abs_cs = [ CmmStore (cmmRegOffW dflags spReg (spRel rSp offset)) amode
+                    | (amode, offset) <- offsets
+                    ]
+       returnFC (last_Sp_offset, toOL abs_cs)
 \end{code}
 
 %************************************************************************
@@ -167,7 +169,11 @@ Allocate a virtual offset for something.
 
 \begin{code}
 allocPrimStack :: CgRep -> FCode VirtualSpOffset
-allocPrimStack rep
+allocPrimStack rep = do dflags <- getDynFlags
+                        allocPrimStack' dflags rep
+
+allocPrimStack' :: DynFlags -> CgRep -> FCode VirtualSpOffset
+allocPrimStack' dflags rep
   = do { stk_usg <- getStkUsage
        ; let free_stk = freeStk stk_usg
        ; case find_block free_stk of
@@ -183,7 +189,7 @@ allocPrimStack rep
        }
   where
     size :: WordOff
-    size = cgRepSizeW rep
+    size = cgRepSizeW dflags rep
 
        -- Find_block looks for a contiguous chunk of free slots
        -- returning the offset of its topmost word
@@ -289,7 +295,7 @@ pushSpecUpdateFrame lbl updatee code
        ; MASSERT(case sequel of { OnStack -> True; _ -> False}) }
        ; dflags <- getDynFlags
        ; allocStackTop (fixedHdrSize dflags + 
-                          sIZEOF_StgUpdateFrame_NoHdr dflags `quot` wORD_SIZE)
+                          sIZEOF_StgUpdateFrame_NoHdr dflags `quot` wORD_SIZE dflags)
        ; vsp <- getVirtSp
        ; setStackFrame vsp
        ; frame_addr <- getSpRelOffset vsp
@@ -322,7 +328,7 @@ emitSpecPushUpdateFrame lbl frame_addr updatee = do
 
 off_updatee :: DynFlags -> ByteOff
 off_updatee dflags
-    = fixedHdrSize dflags * wORD_SIZE + (oFFSET_StgUpdateFrame_updatee dflags)
+    = fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgUpdateFrame_updatee dflags
 \end{code}
 
 
index 228c5bd..ab64f56 100644 (file)
@@ -800,7 +800,7 @@ getSRTInfo = do
       -> do id <- newUnique
             let srt_desc_lbl = mkLargeSRTLabel id
             emitRODataLits "getSRTInfo" srt_desc_lbl
-             ( cmmLabelOffW srt_lbl off
+             ( cmmLabelOffW dflags srt_lbl off
                : mkWordCLit dflags (fromIntegral len)
                : map (mkWordCLit dflags) bmp)
             return (C_SRT srt_desc_lbl 0 srt_escape)
index 1b1c360..6b6bd8b 100644 (file)
@@ -342,17 +342,17 @@ separateByPtrFollowness things
 \end{code}
 
 \begin{code}
-cgRepSizeB :: CgRep -> ByteOff
-cgRepSizeB DoubleArg = dOUBLE_SIZE
-cgRepSizeB LongArg   = wORD64_SIZE
-cgRepSizeB VoidArg   = 0
-cgRepSizeB _         = wORD_SIZE
-
-cgRepSizeW :: CgRep -> ByteOff
-cgRepSizeW DoubleArg = dOUBLE_SIZE `quot` wORD_SIZE
-cgRepSizeW LongArg   = wORD64_SIZE `quot` wORD_SIZE
-cgRepSizeW VoidArg   = 0
-cgRepSizeW _         = 1
+cgRepSizeB :: DynFlags -> CgRep -> ByteOff
+cgRepSizeB _      DoubleArg = dOUBLE_SIZE
+cgRepSizeB _      LongArg   = wORD64_SIZE
+cgRepSizeB _      VoidArg   = 0
+cgRepSizeB dflags _         = wORD_SIZE dflags
+
+cgRepSizeW :: DynFlags -> CgRep -> ByteOff
+cgRepSizeW dflags DoubleArg = dOUBLE_SIZE `quot` wORD_SIZE dflags
+cgRepSizeW dflags LongArg   = wORD64_SIZE `quot` wORD_SIZE dflags
+cgRepSizeW _      VoidArg   = 0
+cgRepSizeW _      _         = 1
 
 retAddrSizeW :: WordOff
 retAddrSizeW = 1       -- One word
index aac1abf..8f93303 100644 (file)
@@ -43,7 +43,6 @@ import Module
 import ListSetOps
 import Util
 import BasicTypes
-import Constants
 import Outputable
 import FastString
 import Maybes
@@ -634,7 +633,7 @@ pushUpdateFrame lbl updatee body
        updfr  <- getUpdFrameOff
        dflags <- getDynFlags
        let
-           hdr         = fixedHdrSize dflags * wORD_SIZE
+           hdr         = fixedHdrSize dflags * wORD_SIZE dflags
            frame       = updfr + hdr + sIZEOF_StgUpdateFrame_NoHdr dflags
            off_updatee = hdr + oFFSET_StgUpdateFrame_updatee dflags
        --
index 0e0f2f1..124e0cd 100644 (file)
@@ -189,7 +189,7 @@ buildDynCon' dflags platform binder _cc con [arg]
               val_int = fromIntegral val :: Int
               offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1)
                 -- INTLIKE closures consist of a header and one word payload
-              intlike_amode = cmmLabelOffW intlike_lbl offsetW
+              intlike_amode = cmmLabelOffW dflags intlike_lbl offsetW
         ; return ( litIdInfo dflags binder (mkConLFInfo con) intlike_amode
                  , return mkNop) }
 
@@ -203,7 +203,7 @@ buildDynCon' dflags platform binder _cc con [arg]
   = do  { let charlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
               offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1)
                 -- CHARLIKE closures consist of a header and one word payload
-              charlike_amode = cmmLabelOffW charlike_lbl offsetW
+              charlike_amode = cmmLabelOffW dflags charlike_lbl offsetW
         ; return ( litIdInfo dflags binder (mkConLFInfo con) charlike_amode
                  , return mkNop) }
 
index ca5f497..9e4db9c 100644 (file)
@@ -34,7 +34,6 @@ import TysPrim
 import CLabel
 import SMRep
 import ForeignCall
-import Constants
 import DynFlags
 import Maybes
 import Outputable
@@ -66,7 +65,7 @@ cgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty
 
               -- ToDo: this might not be correct for 64-bit API
             arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType dflags arg)
-                                     wORD_SIZE
+                                     (wORD_SIZE dflags)
         ; cmm_args <- getFCallArgs stg_args
         ; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty
         ; let ((call_args, arg_hints), cmm_target)
@@ -363,7 +362,7 @@ stack_SP     dflags = closureField dflags (oFFSET_StgStack_sp dflags)
 
 
 closureField :: DynFlags -> ByteOff -> ByteOff
-closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE
+closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE dflags
 
 stgSp, stgHp, stgCurrentTSO, stgCurrentNursery :: CmmExpr
 stgSp             = CmmReg sp
index a19810b..fb37391 100644 (file)
@@ -44,7 +44,6 @@ import IdInfo( CafInfo(..), mayHaveCafRefs )
 import Module
 import DynFlags
 import FastString( mkFastString, fsLit )
-import Constants
 import Util
 
 import Control.Monad (when)
@@ -222,7 +221,7 @@ mkStaticClosure dflags info_lbl ccs payload padding static_link_field saved_info
 padLitToWord :: DynFlags -> CmmLit -> [CmmLit]
 padLitToWord dflags lit = lit : padding pad_length
   where width = typeWidth (cmmLitType dflags lit)
-        pad_length = wORD_SIZE - widthInBytes width :: Int
+        pad_length = wORD_SIZE dflags - widthInBytes width :: Int
 
         padding n | n <= 0 = []
                   | n `rem` 2 /= 0 = CmmInt 0 W8  : padding (n-1)
@@ -543,7 +542,7 @@ do_checks :: Bool       -- Should we check the stack?
 do_checks checkStack alloc do_gc = do
   dflags <- getDynFlags
   let
-    alloc_lit = mkIntExpr dflags (alloc*wORD_SIZE) -- Bytes
+    alloc_lit = mkIntExpr dflags (alloc * wORD_SIZE dflags) -- Bytes
     bump_hp = cmmOffsetExprB dflags (CmmReg hpReg) alloc_lit
 
     -- Sp overflow if (Sp - CmmHighStack < SpLim)
index a742628..8e4d21e 100644 (file)
@@ -219,7 +219,7 @@ direct_call caller call_conv lbl arity args
        emitCallWithExtraStack (call_conv, NativeReturn)
                               target
                               (nonVArgs fast_args)
-                              (mkStkOffsets (stack_args dflags))
+                              (mkStkOffsets dflags (stack_args dflags))
   where
     target = CmmLit (CmmLabel lbl)
     (fast_args, rest_args) = splitAt real_arity args
@@ -329,10 +329,11 @@ slowCallPattern []                      = (fsLit "stg_ap_0", 0)
 -- See Note [over-saturated calls].
 
 mkStkOffsets
-  :: [(ArgRep, Maybe CmmExpr)]    -- things to make offsets for
+  :: DynFlags
+  -> [(ArgRep, Maybe CmmExpr)]    -- things to make offsets for
   -> ( ByteOff                    -- OUTPUTS: Topmost allocated word
      , [(CmmExpr, ByteOff)] )     -- things with offsets (voids filtered out)
-mkStkOffsets things
+mkStkOffsets dflags things
     = loop 0 [] (reverse things)
   where
     loop offset offs [] = (offset,offs)
@@ -341,7 +342,7 @@ mkStkOffsets things
     loop offset offs ((rep,Just thing):things)
         = loop thing_off ((thing, thing_off):offs) things
        where
-          thing_off = offset + argRepSizeW rep * wORD_SIZE
+          thing_off = offset + argRepSizeW dflags rep * wORD_SIZE dflags
            -- offset of thing is offset+size, because we're 
            -- growing the stack *downwards* as the offsets increase.
 
@@ -382,13 +383,13 @@ isNonV :: ArgRep -> Bool
 isNonV V = False
 isNonV _ = True
 
-argRepSizeW :: ArgRep -> WordOff                -- Size in words
-argRepSizeW N = 1
-argRepSizeW P = 1
-argRepSizeW F = 1
-argRepSizeW L = wORD64_SIZE `quot` wORD_SIZE
-argRepSizeW D = dOUBLE_SIZE `quot` wORD_SIZE
-argRepSizeW V = 0
+argRepSizeW :: DynFlags -> ArgRep -> WordOff                -- Size in words
+argRepSizeW _      N = 1
+argRepSizeW _      P = 1
+argRepSizeW _      F = 1
+argRepSizeW dflags L = wORD64_SIZE `quot` wORD_SIZE dflags
+argRepSizeW dflags D = dOUBLE_SIZE `quot` wORD_SIZE dflags
+argRepSizeW _      V = 0
 
 idArgRep :: Id -> ArgRep
 idArgRep = toArgRep . idPrimRep
@@ -405,8 +406,9 @@ hpRel hp off = off - hp
 
 getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
 getHpRelOffset virtual_offset
-  = do { hp_usg <- getHpUsage
-       ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) }
+  = do dflags <- getDynFlags
+       hp_usg <- getHpUsage
+       return (cmmRegOffW dflags hpReg (hpRel (realHp hp_usg) virtual_offset))
 
 mkVirtHeapOffsets
   :: DynFlags
@@ -438,7 +440,7 @@ mkVirtHeapOffsets dflags is_thunk things
              | otherwise  = fixedHdrSize dflags
 
     computeOffset wds_so_far (rep, thing)
-      = (wds_so_far + argRepSizeW (toArgRep rep), 
+      = (wds_so_far + argRepSizeW dflags (toArgRep rep), 
         (NonVoid thing, hdr_size + wds_so_far))
 
 mkVirtConstrOffsets :: DynFlags -> [(PrimRep,a)] -> (WordOff, WordOff, [(NonVoid a, VirtualHpOffset)])
@@ -462,19 +464,20 @@ mkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags False
 #include "../includes/rts/storage/FunTypes.h"
 
 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
-mkArgDescr _nm args 
-  = case stdPattern arg_reps of
-       Just spec_id -> return (ArgSpec spec_id)
-       Nothing      -> return (ArgGen arg_bits)
-  where
-    arg_bits = argBits arg_reps
-    arg_reps = filter isNonV (map idArgRep args)
-       -- Getting rid of voids eases matching of standard patterns
-
-argBits :: [ArgRep] -> [Bool]  -- True for non-ptr, False for ptr
-argBits []             = []
-argBits (P   : args) = False : argBits args
-argBits (arg : args) = take (argRepSizeW arg) (repeat True) ++ argBits args
+mkArgDescr _nm args
+  = do dflags <- getDynFlags
+       let arg_bits = argBits dflags arg_reps
+           arg_reps = filter isNonV (map idArgRep args)
+           -- Getting rid of voids eases matching of standard patterns
+       case stdPattern arg_reps of
+           Just spec_id -> return (ArgSpec spec_id)
+           Nothing      -> return (ArgGen arg_bits)
+
+argBits :: DynFlags -> [ArgRep] -> [Bool]      -- True for non-ptr, False for ptr
+argBits _      []           = []
+argBits dflags (P   : args) = False : argBits dflags args
+argBits dflags (arg : args) = take (argRepSizeW dflags arg) (repeat True)
+                    ++ argBits dflags args
 
 ----------------------
 stdPattern :: [ArgRep] -> Maybe StgHalfWord
@@ -570,7 +573,7 @@ stdInfoTableSizeW dflags
              | otherwise          = 0
 
 stdInfoTableSizeB  :: DynFlags -> ByteOff
-stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE :: ByteOff
+stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags
 
 stdSrtBitmapOffset :: DynFlags -> ByteOff
 -- Byte offset of the SRT bitmap half-word which is 
@@ -579,11 +582,11 @@ stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE
 
 stdClosureTypeOffset :: DynFlags -> ByteOff
 -- Byte offset of the closure type half-word 
-stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE
+stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags
 
 stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff
-stdPtrsOffset    dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE
-stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE + hALF_WORD_SIZE
+stdPtrsOffset    dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags
+stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE
 
 -------------------------------------------------------------------------
 --
index 0d5e377..cbb2aa7 100644 (file)
@@ -42,7 +42,6 @@ import CLabel
 import CmmUtils
 import PrimOp
 import SMRep
-import Constants
 import Module
 import FastString
 import Outputable
@@ -919,7 +918,7 @@ doWritePtrArrayOp addr idx val
        
 loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
 loadArrPtrsSize dflags addr = CmmLoad (cmmOffsetB dflags addr off) (bWord dflags)
- where off = fixedHdrSize dflags * wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs dflags
+ where off = fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_ptrs dflags
 
 mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
                   -> LocalReg -> CmmExpr -> CmmExpr -> FCode ()
@@ -1042,7 +1041,7 @@ doCopyArrayOp = emitCopyArray copy
     -- they're of different types)
     copy _src _dst dst_p src_p bytes =
         do dflags <- getDynFlags
-           emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags wORD_SIZE)
+           emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags))
 
 
 -- | Takes a source 'MutableArray#', an offset in the source array, a
@@ -1059,8 +1058,8 @@ doCopyMutableArrayOp = emitCopyArray copy
     copy src dst dst_p src_p bytes = do
         dflags <- getDynFlags
         [moveCall, cpyCall] <- forkAlts [
-            getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr dflags wORD_SIZE),
-            getCode $ emitMemcpyCall  dst_p src_p bytes (mkIntExpr dflags wORD_SIZE)
+            getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags)),
+            getCode $ emitMemcpyCall  dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags))
             ]
         emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
 
@@ -1083,7 +1082,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 dflags n (mkIntExpr dflags wORD_SIZE)
+    bytes <- assignTempE $ cmmMulWord dflags n (mkIntExpr dflags (wORD_SIZE dflags))
 
     copy src dst dst_p src_p bytes
 
@@ -1101,7 +1100,7 @@ emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr
 emitCloneArray info_p res_r src0 src_off0 n0 = do
     dflags <- getDynFlags
     let arrPtrsHdrSizeW dflags = mkIntExpr dflags (fixedHdrSize dflags +
-                                     (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE))
+                                     (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE dflags))
         myCapability = cmmSubWord dflags (CmmReg baseReg) (mkIntExpr dflags (oFFSET_Capability_r dflags))
     -- Passed as arguments (be careful)
     src     <- assignTempE src0
@@ -1119,21 +1118,21 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do
 
     let arr = CmmReg (CmmLocal arr_r)
     emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCS
-    emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE +
+    emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags +
                                            oFFSET_StgMutArrPtrs_ptrs dflags)) n
-    emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE +
+    emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags +
                                            oFFSET_StgMutArrPtrs_size dflags)) size
 
     dst_p <- assignTempE $ cmmOffsetB dflags arr (arrPtrsHdrSize dflags)
     src_p <- assignTempE $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags))
              src_off
 
-    emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags)) (mkIntExpr dflags wORD_SIZE)
+    emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags)) (mkIntExpr dflags (wORD_SIZE dflags))
 
     emitMemsetCall (cmmOffsetExprW dflags dst_p n)
         (mkIntExpr dflags 1)
         card_bytes
-        (mkIntExpr dflags wORD_SIZE)
+        (mkIntExpr dflags (wORD_SIZE dflags))
     emit $ mkAssign (CmmLocal res_r) arr
 
 -- | Takes and offset in the destination array, the base address of
@@ -1157,11 +1156,11 @@ cardRoundUp :: DynFlags -> CmmExpr -> CmmExpr
 cardRoundUp dflags i = card dflags (cmmAddWord dflags i (mkIntExpr dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1)))
 
 bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr
-bytesToWordsRoundUp dflags e = cmmQuotWord dflags (cmmAddWord dflags e (mkIntExpr dflags (wORD_SIZE - 1)))
+bytesToWordsRoundUp dflags e = cmmQuotWord dflags (cmmAddWord dflags e (mkIntExpr dflags (wORD_SIZE dflags - 1)))
                                                   (wordSize dflags)
 
 wordSize :: DynFlags -> CmmExpr
-wordSize dflags = mkIntExpr dflags wORD_SIZE
+wordSize dflags = mkIntExpr dflags (wORD_SIZE dflags)
 
 -- | Emit a call to @memcpy@.
 emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
index d5fa9d7..9eee38f 100644 (file)
@@ -54,7 +54,6 @@ import CostCentre
 import DynFlags
 import FastString
 import Module
-import Constants        -- Lots of field offsets
 import Outputable
 
 import Control.Monad
@@ -263,7 +262,7 @@ emitCostCentreStackDecl ccs
         do dflags <- getDynFlags
            let mk_lits cc = zero dflags :
                             mkCCostCentre cc :
-                            replicate (sizeof_ccs_words - 2) (zero dflags)
+                            replicate (sizeof_ccs_words dflags - 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
@@ -277,13 +276,13 @@ zero dflags = mkIntCLit dflags 0
 zero64 :: CmmLit
 zero64 = CmmInt 0 W64
 
-sizeof_ccs_words :: Int
-sizeof_ccs_words 
+sizeof_ccs_words :: DynFlags -> Int
+sizeof_ccs_words dflags
     -- round up to the next word.
   | ms == 0   = ws
   | otherwise = ws + 1
   where
-   (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
+   (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE dflags
 
 -- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
index 52bd114..4471b78 100644 (file)
@@ -57,7 +57,6 @@ import ForeignCall
 import IdInfo
 import Type
 import TyCon
-import Constants
 import SMRep
 import Module
 import Literal
@@ -150,7 +149,7 @@ mkTaggedObjectLoad dflags reg base offset tag
   = mkAssign (CmmLocal reg)
              (CmmLoad (cmmOffsetB dflags
                                   (CmmReg (CmmLocal base))
-                                  (wORD_SIZE*offset - tag))
+                                  (wORD_SIZE dflags * offset - tag))
                       (localRegType reg))
 
 -------------------------------------------------------------------------
index d93f856..493ff0c 100644 (file)
@@ -104,7 +104,7 @@ addTicksToBinds dflags mod mod_loc exports tyCons binds =
 
      let count = tickBoxCount st
      hashNo <- writeMixEntries dflags mod count entries orig_file2
-     modBreaks <- mkModBreaks count entries
+     modBreaks <- mkModBreaks dflags count entries
 
      doIfSet_dyn dflags Opt_D_dump_ticked $
          log_action dflags dflags SevDump noSrcSpan defaultDumpStyle
@@ -126,9 +126,9 @@ guessSourceFile binds orig_file =
         _ -> orig_file
 
 
-mkModBreaks :: Int -> [MixEntry_] -> IO ModBreaks
-mkModBreaks count entries = do
-  breakArray <- newBreakArray $ length entries
+mkModBreaks :: DynFlags -> Int -> [MixEntry_] -> IO ModBreaks
+mkModBreaks dflags count entries = do
+  breakArray <- newBreakArray dflags $ length entries
   let
          locsTicks = listArray (0,count-1) [ span  | (span,_,_,_)  <- entries ]
          varsTicks = listArray (0,count-1) [ vars  | (_,_,vars,_)  <- entries ]
index a2459f5..e02ef7b 100644 (file)
@@ -47,7 +47,6 @@ import BasicTypes
 import Literal
 import PrelNames
 import VarSet
-import Constants
 import DynFlags
 import Outputable
 import Util
@@ -357,9 +356,10 @@ resultWrapper result_ty
   -- This includes types like Ptr and ForeignPtr
   | Just (tycon, tycon_arg_tys, data_con, data_con_arg_tys) <- splitProductType_maybe result_ty,
     dataConSourceArity data_con == 1
-  = do let
+  = do dflags <- getDynFlags
+       let
            (unwrapped_res_ty : _) = data_con_arg_tys
-           narrow_wrapper         = maybeNarrow tycon
+           narrow_wrapper         = maybeNarrow dflags tycon
        (maybe_ty, wrapper) <- resultWrapper unwrapped_res_ty
        return
          (maybe_ty, \e -> mkApps (Var (dataConWrapId data_con)) 
@@ -375,16 +375,16 @@ resultWrapper result_ty
 -- standard appears to say that this is the responsibility of the
 -- caller, not the callee.
 
-maybeNarrow :: TyCon -> (CoreExpr -> CoreExpr)
-maybeNarrow tycon
+maybeNarrow :: DynFlags -> TyCon -> (CoreExpr -> CoreExpr)
+maybeNarrow dflags tycon
   | tycon `hasKey` int8TyConKey   = \e -> App (Var (mkPrimOpId Narrow8IntOp)) e
   | tycon `hasKey` int16TyConKey  = \e -> App (Var (mkPrimOpId Narrow16IntOp)) e
   | tycon `hasKey` int32TyConKey
-        && wORD_SIZE > 4         = \e -> App (Var (mkPrimOpId Narrow32IntOp)) e
+        && wORD_SIZE dflags > 4         = \e -> App (Var (mkPrimOpId Narrow32IntOp)) e
 
   | tycon `hasKey` word8TyConKey  = \e -> App (Var (mkPrimOpId Narrow8WordOp)) e
   | tycon `hasKey` word16TyConKey = \e -> App (Var (mkPrimOpId Narrow16WordOp)) e
   | tycon `hasKey` word32TyConKey
-        && wORD_SIZE > 4         = \e -> App (Var (mkPrimOpId Narrow32WordOp)) e
+        && wORD_SIZE dflags > 4         = \e -> App (Var (mkPrimOpId Narrow32WordOp)) e
   | otherwise                    = id
 \end{code}
index 478c598..cc6b6af 100644 (file)
@@ -44,7 +44,6 @@ import FastString
 import DynFlags
 import Platform
 import Config
-import Constants
 import OrdList
 import Pair
 import Util
@@ -533,10 +532,10 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
 
   type_string
       -- libffi needs to know the result type too:
-      | libffi    = primTyDescChar res_hty : arg_type_string
+      | libffi    = primTyDescChar dflags res_hty : arg_type_string
       | otherwise = arg_type_string
 
-  arg_type_string = [primTyDescChar ty | (_,_,ty,_) <- arg_info]
+  arg_type_string = [primTyDescChar dflags ty | (_,_,ty,_) <- arg_info]
                 -- just the real args
 
   -- add some auxiliary args; the stable ptr in the wrapper case, and
@@ -782,8 +781,8 @@ getPrimTyOf ty
 -- represent a primitive type as a Char, for building a string that
 -- described the foreign function type.  The types are size-dependent,
 -- e.g. 'W' is a signed 32-bit integer.
-primTyDescChar :: Type -> Char
-primTyDescChar ty
+primTyDescChar :: DynFlags -> Type -> Char
+primTyDescChar dflags ty
  | ty `eqType` unitTy = 'v'
  | otherwise
  = case typePrimRep (getPrimTyOf ty) of
@@ -797,7 +796,7 @@ primTyDescChar ty
      _           -> pprPanic "primTyDescChar" (ppr ty)
   where
     (signed_word, unsigned_word)
-       | wORD_SIZE == 4  = ('W','w')
-       | wORD_SIZE == 8  = ('L','l')
-       | otherwise       = panic "primTyDescChar"
+       | wORD_SIZE dflags == 4  = ('W','w')
+       | wORD_SIZE dflags == 8  = ('L','l')
+       | otherwise              = panic "primTyDescChar"
 \end{code}
index e9dc7d1..15c41d0 100644 (file)
@@ -27,7 +27,6 @@ import NameSet
 import Literal
 import TyCon
 import PrimOp
-import Constants
 import FastString
 import SMRep
 import ClosureInfo -- CgRep stuff
@@ -432,9 +431,9 @@ assembleI dflags i = case i of
     litlabel fs = lit [BCONPtrLbl fs]
     addr = words . mkLitPtr
     float = words . mkLitF
-    double = words . mkLitD
+    double = words . mkLitD dflags
     int = words . mkLitI
-    int64 = words . mkLitI64
+    int64 = words . mkLitI64 dflags
     words ws = lit (map BCONPtrWord ws)
     word w = words [w]
 
@@ -460,11 +459,11 @@ return_ubx PtrArg    = bci_RETURN_P
 -- Make lists of host-sized words for literals, so that when the
 -- words are placed in memory at increasing addresses, the
 -- bit pattern is correct for the host's word size and endianness.
-mkLitI   :: Int    -> [Word]
-mkLitF   :: Float  -> [Word]
-mkLitD   :: Double -> [Word]
-mkLitPtr :: Ptr () -> [Word]
-mkLitI64 :: Int64  -> [Word]
+mkLitI   ::             Int    -> [Word]
+mkLitF   ::             Float  -> [Word]
+mkLitD   :: DynFlags -> Double -> [Word]
+mkLitPtr ::             Ptr () -> [Word]
+mkLitI64 :: DynFlags -> Int64  -> [Word]
 
 mkLitF f
    = runST (do
@@ -475,8 +474,8 @@ mkLitF f
         return [w0 :: Word]
      )
 
-mkLitD d
-   | wORD_SIZE == 4
+mkLitD dflags d
+   | wORD_SIZE dflags == 4
    = runST (do
         arr <- newArray_ ((0::Int),1)
         writeArray arr 0 d
@@ -485,7 +484,7 @@ mkLitD d
         w1 <- readArray d_arr 1
         return [w0 :: Word, w1]
      )
-   | wORD_SIZE == 8
+   | wORD_SIZE dflags == 8
    = runST (do
         arr <- newArray_ ((0::Int),0)
         writeArray arr 0 d
@@ -496,8 +495,8 @@ mkLitD d
    | otherwise
    = panic "mkLitD: Bad wORD_SIZE"
 
-mkLitI64 ii
-   | wORD_SIZE == 4
+mkLitI64 dflags ii
+   | wORD_SIZE dflags == 4
    = runST (do
         arr <- newArray_ ((0::Int),1)
         writeArray arr 0 ii
@@ -506,7 +505,7 @@ mkLitI64 ii
         w1 <- readArray d_arr 1
         return [w0 :: Word,w1]
      )
-   | wORD_SIZE == 8
+   | wORD_SIZE dflags == 8
    = runST (do
         arr <- newArray_ ((0::Int),0)
         writeArray arr 0 ii
index e400d7a..af7a068 100644 (file)
@@ -22,7 +22,6 @@ import ByteCodeAsm
 import ByteCodeLink
 import LibFFI
 
-import Constants
 import DynFlags
 import Outputable
 import Platform
@@ -166,7 +165,7 @@ mkProtoBCO
 mkProtoBCO dflags nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_blocks
    = ProtoBCO {
         protoBCOName = nm,
-        protoBCOInstrs = maybe_with_stack_check dflags,
+        protoBCOInstrs = maybe_with_stack_check,
         protoBCOBitmap = bitmap,
         protoBCOBitmapSize = bitmap_size,
         protoBCOArity = arity,
@@ -181,7 +180,7 @@ mkProtoBCO dflags nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallo
         -- BCO anyway, so we only need to add an explicit one in the
         -- (hopefully rare) cases when the (overestimated) stack use
         -- exceeds iNTERP_STACK_CHECK_THRESH.
-        maybe_with_stack_check dflags
+        maybe_with_stack_check
            | is_ret && stack_usage < fromIntegral (aP_STACK_SPLIM dflags) = peep_d
                 -- don't do stack checks at return points,
                 -- everything is aggregated up to the top BCO
@@ -208,11 +207,11 @@ mkProtoBCO dflags nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallo
         peep []
            = []
 
-argBits :: [CgRep] -> [Bool]
-argBits [] = []
-argBits (rep : args)
-  | isFollowableArg rep = False : argBits args
-  | otherwise = take (cgRepSizeW rep) (repeat True) ++ argBits args
+argBits :: DynFlags -> [CgRep] -> [Bool]
+argBits _      [] = []
+argBits dflags (rep : args)
+  | isFollowableArg rep = False : argBits dflags args
+  | otherwise = take (cgRepSizeW dflags rep) (repeat True) ++ argBits dflags args
 
 -- -----------------------------------------------------------------------------
 -- schemeTopBind
@@ -293,12 +292,12 @@ schemeR_wrk fvs nm original_body (args, body)
          -- \fv1..fvn x1..xn -> e
          -- i.e. the fvs come first
 
-         szsw_args = map (fromIntegral . idSizeW) all_args
+         szsw_args = map (fromIntegral . idSizeW dflags) all_args
          szw_args  = sum szsw_args
          p_init    = Map.fromList (zip all_args (mkStackOffsets 0 szsw_args))
 
          -- make the arg bitmap
-         bits = argBits (reverse (map idCgRep all_args))
+         bits = argBits dflags (reverse (map idCgRep all_args))
          bitmap_size = genericLength bits
          bitmap = mkBitmap dflags bits
      body_code <- schemeER_wrk szw_args p_init body
@@ -400,15 +399,16 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body))
 
 -- General case for let.  Generates correct, if inefficient, code in
 -- all situations.
-schemeE d s p (AnnLet binds (_,body))
-   = let (xs,rhss) = case binds of AnnNonRec x rhs  -> ([x],[rhs])
+schemeE d s p (AnnLet binds (_,body)) = do
+     dflags <- getDynFlags
+     let (xs,rhss) = case binds of AnnNonRec x rhs  -> ([x],[rhs])
                                    AnnRec xs_n_rhss -> unzip xs_n_rhss
          n_binds = genericLength xs
 
          fvss  = map (fvsToEnv p' . fst) rhss
 
          -- Sizes of free vars
-         sizes = map (\rhs_fvs -> sum (map (fromIntegral . idSizeW) rhs_fvs)) fvss
+         sizes = map (\rhs_fvs -> sum (map (fromIntegral . idSizeW dflags) rhs_fvs)) fvss
 
          -- the arity of each rhs
          arities = map (genericLength . fst . collect) rhss
@@ -451,7 +451,6 @@ schemeE d s p (AnnLet binds (_,body))
             | (fvs, x, rhs, size, arity, n) <-
                 zip6 fvss xs rhss sizes arities [n_binds, n_binds-1 .. 1]
             ]
-     in do
      body_code <- schemeE d' s p' body
      thunk_codes <- sequence compile_binds
      return (alloc_code `appOL` concatOL thunk_codes `appOL` body_code)
@@ -793,7 +792,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
                             | otherwise = 1
 
         -- depth of stack after the return value has been pushed
-        d_bndr = d + ret_frame_sizeW + fromIntegral (idSizeW bndr)
+        d_bndr = d + ret_frame_sizeW + fromIntegral (idSizeW dflags bndr)
 
         -- depth of stack after the extra info table for an unboxed return
         -- has been pushed, if any.  This is the stack depth at the
@@ -827,8 +826,8 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
            | otherwise =
              let
                  (ptrs,nptrs) = partition (isFollowableArg.idCgRep) real_bndrs
-                 ptr_sizes    = map (fromIntegral . idSizeW) ptrs
-                 nptrs_sizes  = map (fromIntegral . idSizeW) nptrs
+                 ptr_sizes    = map (fromIntegral . idSizeW dflags) ptrs
+                 nptrs_sizes  = map (fromIntegral . idSizeW dflags) nptrs
                  bind_sizes   = ptr_sizes ++ nptrs_sizes
                  size         = sum ptr_sizes + sum nptrs_sizes
                  -- the UNPACK instruction unpacks in reverse order...
@@ -928,10 +927,13 @@ generateCCall :: Word -> Sequel         -- stack and sequel depths
               -> BcM BCInstrList
 
 generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
-   = let
+ = do
+     dflags <- getDynFlags
+
+     let
          -- useful constants
          addr_sizeW :: Word16
-         addr_sizeW = fromIntegral (cgRepSizeW NonPtrArg)
+         addr_sizeW = fromIntegral (cgRepSizeW dflags NonPtrArg)
 
          -- Get the args on the stack, with tags and suitably
          -- dereferenced for the CCall.  For each arg, return the
@@ -947,14 +949,12 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
                     -- contains.
                     Just t
                      | t == arrayPrimTyCon || t == mutableArrayPrimTyCon
-                       -> do dflags <- getDynFlags
-                             rest <- pargs (d + fromIntegral addr_sizeW) az
+                       -> do rest <- pargs (d + fromIntegral addr_sizeW) az
                              code <- parg_ArrayishRep (fromIntegral (arrPtrsHdrSize dflags)) d p a
                              return ((code,AddrRep):rest)
 
                      | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon
-                       -> do dflags <- getDynFlags
-                             rest <- pargs (d + fromIntegral addr_sizeW) az
+                       -> do rest <- pargs (d + fromIntegral addr_sizeW) az
                              code <- parg_ArrayishRep (fromIntegral (arrWordsHdrSize dflags)) d p a
                              return ((code,AddrRep):rest)
 
@@ -975,11 +975,10 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
                  -- header and then pretend this is an Addr#.
                  return (push_fo `snocOL` SWIZZLE 0 hdrSize)
 
-     in do
      code_n_reps <- pargs d0 args_r_to_l
      let
          (pushs_arg, a_reps_pushed_r_to_l) = unzip code_n_reps
-         a_reps_sizeW = fromIntegral (sum (map primRepSizeW a_reps_pushed_r_to_l))
+         a_reps_sizeW = fromIntegral (sum (map (primRepSizeW dflags) a_reps_pushed_r_to_l))
 
          push_args    = concatOL pushs_arg
          d_after_args = d0 + a_reps_sizeW
@@ -1035,7 +1034,6 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
          -}
          -- resolve static address
          get_target_info = do
-             dflags <- getDynFlags
              case target of
                  DynamicTarget
                     -> return (False, panic "ByteCodeGen.generateCCall(dyn)")
@@ -1049,7 +1047,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
                       stdcall_adj_target
                           | OSMinGW32 <- platformOS (targetPlatform dflags)
                           , StdCallConv <- cconv
-                          = let size = fromIntegral a_reps_sizeW * wORD_SIZE in
+                          = let size = fromIntegral a_reps_sizeW * wORD_SIZE dflags in
                             mkFastString (unpackFS target ++ '@':show size)
                           | otherwise
                           = target
@@ -1074,7 +1072,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
 
          -- Push the return placeholder.  For a call returning nothing,
          -- this is a VoidArg (tag).
-         r_sizeW   = fromIntegral (primRepSizeW r_rep)
+         r_sizeW   = fromIntegral (primRepSizeW dflags r_rep)
          d_after_r = d_after_Addr + fromIntegral r_sizeW
          r_lit     = mkDummyLiteral r_rep
          push_r    = (if   returns_void
@@ -1092,7 +1090,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
      -- the only difference in libffi mode is that we prepare a cif
      -- describing the call type by calling libffi, and we attach the
      -- address of this to the CCALL instruction.
-     token <- ioToBc $ prepForeignCall cconv a_reps r_rep
+     token <- ioToBc $ prepForeignCall dflags cconv a_reps r_rep
      let addr_of_marshaller = castPtrToFunPtr token
 
      recordItblMallocBc (ItblPtr (castFunPtrToPtr addr_of_marshaller))
@@ -1219,8 +1217,11 @@ pushAtom d p (AnnVar v)
    = return (unitOL (PUSH_PRIMOP primop), 1)
 
    | Just d_v <- lookupBCEnv_maybe v p  -- v is a local variable
-   = let l = trunc16 $ d - d_v + fromIntegral sz - 2
-     in return (toOL (genericReplicate sz (PUSH_L l)), sz)
+   = do dflags <- getDynFlags
+        let sz :: Word16
+            sz = fromIntegral (idSizeW dflags v)
+            l = trunc16 $ d - d_v + fromIntegral sz - 2
+        return (toOL (genericReplicate sz (PUSH_L l)), sz)
          -- d - d_v                 the number of words between the TOS
          --                         and the 1st slot of the object
          --
@@ -1232,17 +1233,22 @@ pushAtom d p (AnnVar v)
          -- Having found the last slot, we proceed to copy the right number of
          -- slots on to the top of the stack.
 
-    | otherwise  -- v must be a global variable
-    = ASSERT(sz == 1)
-      return (unitOL (PUSH_G (getName v)), sz)
+   | otherwise  -- v must be a global variable
+   = do dflags <- getDynFlags
+        let sz :: Word16
+            sz = fromIntegral (idSizeW dflags v)
+        MASSERT(sz == 1)
+        return (unitOL (PUSH_G (getName v)), sz)
 
-    where
-         sz :: Word16
-         sz = fromIntegral (idSizeW v)
 
+pushAtom _ _ (AnnLit lit) = do
+     dflags <- getDynFlags
+     let code rep
+             = let size_host_words = fromIntegral (cgRepSizeW dflags rep)
+               in  return (unitOL (PUSH_UBX (Left lit) size_host_words),
+                           size_host_words)
 
-pushAtom _ _ (AnnLit lit)
-   = case lit of
+     case lit of
         MachLabel _ _ _ -> code NonPtrArg
         MachWord _    -> code NonPtrArg
         MachInt _     -> code NonPtrArg
@@ -1258,11 +1264,6 @@ pushAtom _ _ (AnnLit lit)
         -- representation.
         LitInteger {} -> panic "pushAtom: LitInteger"
      where
-        code rep
-           = let size_host_words = fromIntegral (cgRepSizeW rep)
-             in  return (unitOL (PUSH_UBX (Left lit) size_host_words),
-                           size_host_words)
-
         pushStr s
            = let getMallocvilleAddr
                     = case s of
@@ -1435,8 +1436,8 @@ instance Outputable Discr where
 lookupBCEnv_maybe :: Id -> BCEnv -> Maybe Word
 lookupBCEnv_maybe = Map.lookup
 
-idSizeW :: Id -> Int
-idSizeW = cgRepSizeW . bcIdCgRep
+idSizeW :: DynFlags -> Id -> Int
+idSizeW dflags = cgRepSizeW dflags . bcIdCgRep
 
 bcIdCgRep :: Id -> CgRep
 bcIdCgRep = primRepToCgRep . bcIdPrimRep
index b88c812..2564d4b 100644 (file)
@@ -27,7 +27,6 @@ import ClosureInfo
 import DataCon          ( DataCon, dataConRepArgTys, dataConIdentity )
 import TyCon            ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
 import Type             ( flattenRepType, repType )
-import Constants        ( wORD_SIZE )
 import CgHeapery        ( mkVirtHeapOffsets )
 import Util
 
@@ -49,14 +48,14 @@ import GHC.Ptr          ( Ptr(..) )
 \begin{code}
 newtype ItblPtr = ItblPtr (Ptr ()) deriving Show
 
-itblCode :: ItblPtr -> Ptr ()
-itblCode (ItblPtr ptr)
- | ghciTablesNextToCode = castPtr ptr `plusPtr` conInfoTableSizeB
+itblCode :: DynFlags -> ItblPtr -> Ptr ()
+itblCode dflags (ItblPtr ptr)
+ | ghciTablesNextToCode = castPtr ptr `plusPtr` conInfoTableSizeB dflags
  | otherwise            = castPtr ptr
 
 -- XXX bogus
-conInfoTableSizeB :: Int
-conInfoTableSizeB = 3 * wORD_SIZE
+conInfoTableSizeB :: DynFlags -> Int
+conInfoTableSizeB dflags = 3 * wORD_SIZE dflags
 
 type ItblEnv = NameEnv (Name, ItblPtr)
         -- We need the Name in the range so we know which
@@ -128,7 +127,7 @@ make_constr_itbls dflags cons
                             }
                -- Make a piece of code to jump to "entry_label".
                -- This is the only arch-dependent bit.
-           addrCon <- newExec pokeConItbl conInfoTbl
+           addrCon <- newExecConItbl dflags conInfoTbl
                     --putStrLn ("SIZE of itbl is " ++ show (sizeOf itbl))
                     --putStrLn ("# ptrs  of itbl is " ++ show ptrs)
                     --putStrLn ("# nptrs of itbl is " ++ show nptrs_really)
@@ -285,39 +284,17 @@ data StgConInfoTable = StgConInfoTable {
    infoTable :: StgInfoTable
 }
 
-instance Storable StgConInfoTable where
-   sizeOf conInfoTable    
+sizeOfConItbl :: StgConInfoTable -> Int
+sizeOfConItbl conInfoTable
       = sum [ sizeOf (conDesc conInfoTable)
             , sizeOf (infoTable conInfoTable) ]
-   alignment _ = SIZEOF_VOID_P
-   peek ptr 
-      = evalState (castPtr ptr) $ do
-#ifdef GHCI_TABLES_NEXT_TO_CODE
-           desc <- load
-#endif
-           itbl <- load
-#ifndef GHCI_TABLES_NEXT_TO_CODE
-           desc <- load
-#endif
-           return  
-              StgConInfoTable 
-              { 
-#ifdef GHCI_TABLES_NEXT_TO_CODE
-                conDesc   = castPtr $ ptr `plusPtr` conInfoTableSizeB `plusPtr` desc
-#else
-                conDesc   = desc
-#endif
-              , infoTable = itbl
-              }
-   poke = error "poke(StgConInfoTable): use pokeConItbl instead"
-
 
-pokeConItbl :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
+pokeConItbl :: DynFlags -> Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
             -> IO ()
-pokeConItbl wr_ptr ex_ptr itbl 
+pokeConItbl dflags wr_ptr ex_ptr itbl
       = evalState (castPtr wr_ptr) $ do
 #ifdef GHCI_TABLES_NEXT_TO_CODE
-           store (conDesc itbl `minusPtr` (ex_ptr `plusPtr` conInfoTableSizeB))
+           store (conDesc itbl `minusPtr` (ex_ptr `plusPtr` conInfoTableSizeB dflags))
 #endif
            store (infoTable itbl)
 #ifndef GHCI_TABLES_NEXT_TO_CODE
@@ -443,12 +420,12 @@ load = do addr <- advance
           lift (peek addr)
 
 
-newExec :: Storable a => (Ptr a -> Ptr a -> a -> IO ()) -> a -> IO (FunPtr ())
-newExec poke_fn obj
+newExecConItbl :: DynFlags -> StgConInfoTable -> IO (FunPtr ())
+newExecConItbl dflags obj
    = alloca $ \pcode -> do
-        wr_ptr <- _allocateExec (fromIntegral (sizeOf obj)) pcode
+        wr_ptr <- _allocateExec (fromIntegral (sizeOfConItbl obj)) pcode
         ex_ptr <- peek pcode
-        poke_fn wr_ptr ex_ptr obj
+        pokeConItbl dflags wr_ptr ex_ptr obj
         return (castPtrToFunPtr ex_ptr)
 
 foreign import ccall unsafe "allocateExec"
index 8ceb91c..8938bfe 100644 (file)
@@ -20,6 +20,7 @@ import ByteCodeItbls
 import ByteCodeAsm
 import ObjLink
 
+import DynFlags
 import Name
 import NameEnv
 import PrimOp
@@ -76,9 +77,9 @@ data BCO# = BCO# ByteArray#             -- instrs   :: Array Word16#
                  ByteArray#             -- itbls    :: Array Addr#
 -}
 
-linkBCO :: ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO HValue
-linkBCO ie ce ul_bco
-   = do BCO bco# <- linkBCO' ie ce ul_bco
+linkBCO :: DynFlags -> ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO HValue
+linkBCO dflags ie ce ul_bco
+   = do BCO bco# <- linkBCO' dflags ie ce ul_bco
         -- SDM: Why do we need mkApUpd0 here?  I *think* it's because
         -- otherwise top-level interpreted CAFs don't get updated
         -- after evaluation.   A top-level BCO will evaluate itself and
@@ -97,18 +98,18 @@ linkBCO ie ce ul_bco
            else case mkApUpd0# bco# of { (# final_bco #) -> return (HValue final_bco) }
 
 
-linkBCO' :: ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO BCO
-linkBCO' ie ce (UnlinkedBCO _ arity insns_barr bitmap literalsSS ptrsSS)
+linkBCO' :: DynFlags -> ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO BCO
+linkBCO' dflags ie ce (UnlinkedBCO _ arity insns_barr bitmap literalsSS ptrsSS)
    -- Raises an IO exception on failure
    = do let literals = ssElts literalsSS
             ptrs     = ssElts ptrsSS
 
-        linked_literals <- mapM (lookupLiteral ie) literals
+        linked_literals <- mapM (lookupLiteral dflags ie) literals
 
         let n_literals = sizeSS literalsSS
             n_ptrs     = sizeSS ptrsSS
 
-        ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
+        ptrs_arr <- mkPtrsArray dflags ie ce n_ptrs ptrs
 
         let
             !ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
@@ -126,8 +127,8 @@ linkBCO' ie ce (UnlinkedBCO _ arity insns_barr bitmap literalsSS ptrsSS)
 
 
 -- we recursively link any sub-BCOs while making the ptrs array
-mkPtrsArray :: ItblEnv -> ClosureEnv -> Word -> [BCOPtr] -> IO (Array Word HValue)
-mkPtrsArray ie ce n_ptrs ptrs = do
+mkPtrsArray :: DynFlags -> ItblEnv -> ClosureEnv -> Word -> [BCOPtr] -> IO (Array Word HValue)
+mkPtrsArray dflags ie ce n_ptrs ptrs = do
   let ptrRange = if n_ptrs > 0 then (0, n_ptrs-1) else (1, 0)
   marr <- newArray_ ptrRange
   let
@@ -138,7 +139,7 @@ mkPtrsArray ie ce n_ptrs ptrs = do
         ptr <- lookupPrimOp op
         unsafeWrite marr i ptr
     fill (BCOPtrBCO ul_bco) i = do
-        BCO bco# <- linkBCO' ie ce ul_bco
+        BCO bco# <- linkBCO' dflags ie ce ul_bco
         writeArrayBCO marr i bco#
     fill (BCOPtrBreakInfo brkInfo) i =
         unsafeWrite marr i (HValue (unsafeCoerce# brkInfo))
@@ -180,12 +181,12 @@ newBCO instrs lits ptrs arity bitmap
                   (# s1, bco #) -> (# s1, BCO bco #)
 
 
-lookupLiteral :: ItblEnv -> BCONPtr -> IO Word
-lookupLiteral _  (BCONPtrWord lit) = return lit
-lookupLiteral _  (BCONPtrLbl  sym) = do Ptr a# <- lookupStaticPtr sym
-                                        return (W# (int2Word# (addr2Int# a#)))
-lookupLiteral ie (BCONPtrItbl nm)  = do Ptr a# <- lookupIE ie nm
-                                        return (W# (int2Word# (addr2Int# a#)))
+lookupLiteral :: DynFlags -> ItblEnv -> BCONPtr -> IO Word
+lookupLiteral _      _  (BCONPtrWord lit) = return lit
+lookupLiteral _      _  (BCONPtrLbl  sym) = do Ptr a# <- lookupStaticPtr sym
+                                               return (W# (int2Word# (addr2Int# a#)))
+lookupLiteral dflags ie (BCONPtrItbl nm)  = do Ptr a# <- lookupIE dflags ie nm
+                                               return (W# (int2Word# (addr2Int# a#)))
 
 lookupStaticPtr :: FastString -> IO (Ptr ())
 lookupStaticPtr addr_of_label_string
@@ -218,10 +219,10 @@ lookupName ce nm
                                           (# a #) -> return (HValue a)
                     Nothing         -> linkFail "ByteCodeLink.lookupCE" sym_to_find
 
-lookupIE :: ItblEnv -> Name -> IO (Ptr a)
-lookupIE ie con_nm
+lookupIE :: DynFlags -> ItblEnv -> Name -> IO (Ptr a)
+lookupIE dflags ie con_nm
    = case lookupNameEnv ie con_nm of
-        Just (_, a) -> return (castPtr (itblCode a))
+        Just (_, a) -> return (castPtr (itblCode dflags a))
         Nothing
            -> do -- try looking up in the object files.
                  let sym_to_find1 = nameToCLabel con_nm "con_info"
index 19a3cbb..cd46ec3 100644 (file)
@@ -14,7 +14,6 @@ import Module
 import OccName
 import Name
 import Outputable
-import Constants
 import MonadUtils ()
 import Util
 
@@ -95,7 +94,7 @@ dataConInfoPtrToName x = do
    getConDescAddress :: DynFlags -> Ptr StgInfoTable -> IO (Ptr Word8)
    getConDescAddress dflags ptr
     | ghciTablesNextToCode = do
-       offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE)
+       offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE dflags)
        return $ (ptr `plusPtr` stdInfoTableSizeB dflags) `plusPtr` (fromIntegral (offsetToString :: StgWord))
     | otherwise =
        peek $ intPtrToPtr $ ptrToIntPtr ptr + fromIntegral (stdInfoTableSizeB dflags)
index 9bdabda..1281971 100644 (file)
@@ -24,7 +24,7 @@ import TyCon
 import ForeignCall
 import Panic
 -- import Outputable
-import Constants
+import DynFlags
 
 import Foreign
 import Foreign.C
@@ -35,20 +35,21 @@ import Text.Printf
 type ForeignCallToken = C_ffi_cif
 
 prepForeignCall
-    :: CCallConv
+    :: DynFlags
+    -> CCallConv
     -> [PrimRep]                        -- arg types
     -> PrimRep                          -- result type
     -> IO (Ptr ForeignCallToken)        -- token for making calls
                                         -- (must be freed by caller)
-prepForeignCall cconv arg_types result_type
+prepForeignCall dflags cconv arg_types result_type
   = do
     let n_args = length arg_types
     arg_arr <- mallocArray n_args
-    let init_arg (ty,n) = pokeElemOff arg_arr n (primRepToFFIType ty)
+    let init_arg (ty,n) = pokeElemOff arg_arr n (primRepToFFIType dflags ty)
     mapM_ init_arg (zip arg_types [0..])
     cif <- mallocBytes (#const sizeof(ffi_cif))
     let abi = convToABI cconv
-    let res_ty = primRepToFFIType result_type
+    let res_ty = primRepToFFIType dflags result_type
     r <- ffi_prep_cif cif abi (fromIntegral n_args) res_ty arg_arr
     if (r /= fFI_OK)
        then ghcError (InstallationError 
@@ -64,8 +65,8 @@ convToABI StdCallConv = fFI_STDCALL
 convToABI _           = fFI_DEFAULT_ABI
 
 -- c.f. DsForeign.primTyDescChar
-primRepToFFIType :: PrimRep -> Ptr C_ffi_type
-primRepToFFIType r
+primRepToFFIType :: DynFlags -> PrimRep -> Ptr C_ffi_type
+primRepToFFIType dflags r
   = case r of
      VoidRep     -> ffi_type_void
      IntRep     -> signed_word
@@ -78,9 +79,9 @@ primRepToFFIType r
      _           -> panic "primRepToFFIType"
   where
     (signed_word, unsigned_word)
-       | wORD_SIZE == 4  = (ffi_type_sint32, ffi_type_uint32)
-       | wORD_SIZE == 8  = (ffi_type_sint64, ffi_type_uint64)
-       | otherwise       = panic "primTyDescChar"
+       | wORD_SIZE dflags == 4  = (ffi_type_sint32, ffi_type_uint32)
+       | wORD_SIZE dflags == 8  = (ffi_type_sint64, ffi_type_uint64)
+       | otherwise              = panic "primTyDescChar"
 
 
 data C_ffi_type
index 2607ca0..565cf0b 100644 (file)
@@ -457,7 +457,7 @@ linkExpr hsc_env span root_ul_bco
          ce = closure_env pls
 
      -- Link the necessary packages and linkables
-   ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce [root_ul_bco]
+   ; (_, (root_hval:_)) <- linkSomeBCOs dflags False ie ce [root_ul_bco]
    ; return (pls, root_hval)
    }}}
    where
@@ -665,7 +665,7 @@ linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
         ce = closure_env pls
 
     -- Link the necessary packages and linkables
-    (final_gce, _) <- linkSomeBCOs False ie ce unlinkedBCOs
+    (final_gce, _) <- linkSomeBCOs dflags False ie ce unlinkedBCOs
     let pls2 = pls { closure_env = final_gce,
                      itbl_env    = ie }
     return (pls2, ()) --hvals)
@@ -724,7 +724,7 @@ linkModules dflags pls linkables
         if failed ok_flag then
                 return (pls1, Failed)
           else do
-                pls2 <- dynLinkBCOs pls1 bcos
+                pls2 <- dynLinkBCOs dflags pls1 bcos
                 return (pls2, Succeeded)
 
 
@@ -804,8 +804,9 @@ rmDupLinkables already ls
 %************************************************************************
 
 \begin{code}
-dynLinkBCOs :: PersistentLinkerState -> [Linkable] -> IO PersistentLinkerState
-dynLinkBCOs pls bcos = do
+dynLinkBCOs :: DynFlags -> PersistentLinkerState -> [Linkable]
+            -> IO PersistentLinkerState
+dynLinkBCOs dflags pls bcos = do
 
         let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
             pls1                     = pls { bcos_loaded = bcos_loaded' }
@@ -821,7 +822,7 @@ dynLinkBCOs pls bcos = do
             gce       = closure_env pls
             final_ie  = foldr plusNameEnv (itbl_env pls) ies
 
-        (final_gce, _linked_bcos) <- linkSomeBCOs True final_ie gce ul_bcos
+        (final_gce, _linked_bcos) <- linkSomeBCOs dflags True final_ie gce ul_bcos
                 -- XXX What happens to these linked_bcos?
 
         let pls2 = pls1 { closure_env = final_gce,
@@ -830,7 +831,8 @@ dynLinkBCOs pls bcos = do
         return pls2
 
 -- Link a bunch of BCOs and return them + updated closure env.
-linkSomeBCOs :: Bool    -- False <=> add _all_ BCOs to returned closure env
+linkSomeBCOs :: DynFlags
+             -> Bool    -- False <=> add _all_ BCOs to returned closure env
                         -- True  <=> add only toplevel BCOs to closure env
              -> ItblEnv
              -> ClosureEnv
@@ -840,11 +842,11 @@ linkSomeBCOs :: Bool    -- False <=> add _all_ BCOs to returned closure env
                         -- the incoming unlinked BCOs.  Each gives the
                         -- value of the corresponding unlinked BCO
 
-linkSomeBCOs toplevs_only ie ce_in ul_bcos
+linkSomeBCOs dflags toplevs_only ie ce_in ul_bcos
    = do let nms = map unlinkedBCOName ul_bcos
         hvals <- fixIO
                     ( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
-                               in  mapM (linkBCO ie ce_out) ul_bcos )
+                               in  mapM (linkBCO dflags ie ce_out) ul_bcos )
         let ce_all_additions = zip nms hvals
             ce_top_additions = filter (isExternalName.fst) ce_all_additions
             ce_additions     = if toplevs_only then ce_top_additions
index f06d120..bf49a98 100644 (file)
@@ -60,7 +60,6 @@ import PrelNames
 import TysWiredIn
 import DynFlags
 import Outputable as Ppr
-import Constants        ( wORD_SIZE )
 import GHC.Arr          ( Array(..) )
 import GHC.Exts
 import GHC.IO ( IO(..) )
@@ -172,8 +171,8 @@ pAP_CODE = PAP
 #undef AP
 #undef PAP
 
-getClosureData :: a -> IO Closure
-getClosureData a =
+getClosureData :: DynFlags -> a -> IO Closure
+getClosureData dflags a =
    case unpackClosure# a of 
      (# iptr, ptrs, nptrs #) -> do
            let iptr'
@@ -185,7 +184,7 @@ getClosureData a =
                    -- but the Storable instance for info tables takes
                    -- into account the extra entry pointer when
                    -- !ghciTablesNextToCode, so we must adjust here:
-                   Ptr iptr `plusPtr` negate wORD_SIZE
+                   Ptr iptr `plusPtr` negate (wORD_SIZE dflags)
            itbl <- peek iptr'
            let tipe = readCType (BCI.tipe itbl)
                elems = fromIntegral (BCI.ptrs itbl)
@@ -224,11 +223,11 @@ isThunk ThunkSelector = True
 isThunk AP            = True
 isThunk _             = False
 
-isFullyEvaluated :: a -> IO Bool
-isFullyEvaluated a = do 
-  closure <- getClosureData 
+isFullyEvaluated :: DynFlags -> a -> IO Bool
+isFullyEvaluated dflags a = do
+  closure <- getClosureData dflags a
   case tipe closure of
-    Constr -> do are_subs_evaluated <- amapM isFullyEvaluated (ptrs closure)
+    Constr -> do are_subs_evaluated <- amapM (isFullyEvaluated dflags) (ptrs closure)
                  return$ and are_subs_evaluated
     _      -> return False
   where amapM f = sequence . amap' f
@@ -691,6 +690,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
             text "Type obtained: " <> ppr (termType term))
    return term
     where 
+  dflags = hsc_dflags hsc_env
 
   go :: Int -> Type -> Type -> HValue -> TcM Term
    -- [SPJ May 11] I don't understand the difference between my_ty and old_ty
@@ -699,13 +699,13 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
   go 0 my_ty _old_ty a = do
     traceTR (text "Gave up reconstructing a term after" <>
                   int max_depth <> text " steps")
-    clos <- trIO $ getClosureData a
+    clos <- trIO $ getClosureData dflags a
     return (Suspension (tipe clos) my_ty a Nothing)
   go max_depth my_ty old_ty a = do
     let monomorphic = not(isTyVarTy my_ty)   
     -- This ^^^ is a convention. The ancestor tests for
     -- monomorphism and passes a type instead of a tv
-    clos <- trIO $ getClosureData a
+    clos <- trIO $ getClosureData dflags a
     case tipe clos of
 -- Thunks we may want to force
       t | isThunk t && force -> traceTR (text "Forcing a " <> text (show t)) >>
@@ -818,7 +818,8 @@ extractSubTerms recurse clos = liftM thirdOf3 . go 0 (nonPtrs clos)
         t <- appArr (recurse ty) (ptrs clos) ptr_i
         return (ptr_i + 1, ws, t)
       _ -> do
-        let (ws0, ws1) = splitAt (primRepSizeW rep) ws
+        dflags <- getDynFlags
+        let (ws0, ws1) = splitAt (primRepSizeW dflags rep) ws
         return (ptr_i, ws1, Prim ty ws0)
 
     unboxedTupleTerm ty terms = Term ty (Right (tupleCon UnboxedTuple (length terms)))
@@ -855,6 +856,8 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
    traceTR (text "RTTI completed. Type obtained:" <+> ppr new_ty)
    return new_ty
     where
+  dflags = hsc_dflags hsc_env
+
 --  search :: m Bool -> ([a] -> [a] -> [a]) -> [a] -> m ()
   search _ _ _ 0 = traceTR (text "Failed to reconstruct a type after " <>
                                 int max_depth <> text " steps")
@@ -869,7 +872,7 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
   go :: Type -> HValue -> TR [(Type, HValue)]
   go my_ty a = do
     traceTR (text "go" <+> ppr my_ty)
-    clos <- trIO $ getClosureData a
+    clos <- trIO $ getClosureData dflags a
     case tipe clos of
       Blackhole -> appArr (go my_ty) (ptrs clos) 0 -- carefully, don't eval the TSO
       Indirection _ -> go my_ty $! (ptrs clos ! 0)
index 965b1a9..a319f6e 100644 (file)
@@ -117,7 +117,7 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
     -- should be).  Also, the serialisation of value of type "Bin
     -- a" used to depend on the word size of the machine, now they
     -- are always 32 bits.
-    if wORD_SIZE == 4
+    if wORD_SIZE dflags == 4
         then do _ <- Binary.get bh :: IO Word32; return ()
         else do _ <- Binary.get bh :: IO Word64; return ()
 
@@ -168,7 +168,7 @@ writeBinIface dflags hi_path mod_iface = do
    -- dummy 32/64-bit field before the version/way for
    -- compatibility with older interface file formats.
    -- See Note [dummy iface field] above.
-    if wORD_SIZE == 4
+    if wORD_SIZE dflags == 4
         then Binary.put_ bh (0 :: Word32)
         else Binary.put_ bh (0 :: Word64)
 
index 6414501..9e77990 100644 (file)
@@ -11,7 +11,6 @@ import Data.Int
 import Data.List (intercalate)
 import Numeric
 
-import Constants
 import DynFlags
 import FastString
 import Unique
@@ -358,7 +357,7 @@ i8Ptr = pLift i8
 
 -- | The target architectures word size
 llvmWord, llvmWordPtr :: DynFlags -> LlvmType
-llvmWord    _      = LMInt (wORD_SIZE * 8)
+llvmWord    dflags = LMInt (wORD_SIZE dflags * 8)
 llvmWordPtr dflags = pLift (llvmWord dflags)
 
 -- -----------------------------------------------------------------------------
index 6996ea8..5b944b7 100644 (file)
@@ -31,7 +31,6 @@ import LlvmCodeGen.Regs
 
 import CLabel
 import CgUtils ( activeStgRegs )
-import Constants
 import DynFlags
 import FastString
 import OldCmm
@@ -103,7 +102,7 @@ llvmFunSig' dflags lbl link
                    | otherwise   = (x, [])
     in LlvmFunctionDecl lbl link (llvmGhcCC dflags) LMVoid FixedArgs
                         (map (toParams . getVarType) (llvmFunArgs dflags))
-                        llvmFunAlign
+                        (llvmFunAlign dflags)
 
 -- | Create a Haskell function in LLVM.
 mkLlvmFunc :: LlvmEnv -> CLabel -> LlvmLinkageType -> LMSection -> LlvmBlocks
@@ -115,12 +114,12 @@ mkLlvmFunc env lbl link sec blks
     in LlvmFunction funDec funArgs llvmStdFunAttrs sec blks
 
 -- | Alignment to use for functions
-llvmFunAlign :: LMAlign
-llvmFunAlign = Just wORD_SIZE
+llvmFunAlign :: DynFlags -> LMAlign
+llvmFunAlign dflags = Just (wORD_SIZE dflags)
 
 -- | Alignment to use for into tables
-llvmInfAlign :: LMAlign
-llvmInfAlign = Just wORD_SIZE
+llvmInfAlign :: DynFlags -> LMAlign
+llvmInfAlign dflags = Just (wORD_SIZE dflags)
 
 -- | A Function's arguments
 llvmFunArgs :: DynFlags -> [LlvmVar]
index b8f41f3..448bd4d 100644 (file)
@@ -148,9 +148,10 @@ barrier env = do
 -- | Memory barrier instruction for LLVM < 3.0
 oldBarrier :: LlvmEnv -> UniqSM StmtData
 oldBarrier env = do
+    let dflags = getDflags env
     let fname = fsLit "llvm.memory.barrier"
     let funSig = LlvmFunctionDecl fname ExternallyVisible CC_Ccc LMVoid
-                    FixedArgs (tysToParams [i1, i1, i1, i1, i1]) llvmFunAlign
+                    FixedArgs (tysToParams [i1, i1, i1, i1, i1]) (llvmFunAlign dflags)
     let fty = LMFunction funSig
 
     let fv   = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing False
@@ -292,7 +293,7 @@ genCall env target res args ret = do
     let retTy = ret_type res
     let argTy = tysToParams $ map arg_type args
     let funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible
-                             lmconv retTy FixedArgs argTy llvmFunAlign
+                             lmconv retTy FixedArgs argTy (llvmFunAlign dflags)
 
 
     (env1, argVars, stmts1, top1) <- arg_vars env args ([], nilOL, [])
index d73b2eb..c791e85 100644 (file)
@@ -106,14 +106,15 @@ pprLlvmCmmDecl env count (CmmProc mb_info entry_lbl (ListGraph blks))
 -- | Pretty print CmmStatic
 pprInfoTable :: LlvmEnv -> Int -> CLabel -> CmmStatics -> (SDoc, [LlvmVar])
 pprInfoTable env count info_lbl stat
-  = let unres = genLlvmData env (Text, stat)
+  = let dflags = getDflags env
+        unres = genLlvmData env (Text, stat)
         (_, (ldata, ltypes)) = resolveLlvmData env unres
 
         setSection ((LMGlobalVar _ ty l _ _ c), d)
             = let sec = mkLayoutSection count
                   ilabel = strCLabel_llvm env info_lbl
                               `appendFS` fsLit iTableSuf
-                  gv = LMGlobalVar ilabel ty l sec llvmInfAlign c
+                  gv = LMGlobalVar ilabel ty l sec (llvmInfAlign dflags) c
                   v = if l == Internal then [gv] else []
               in ((gv, d), v)
         setSection v = (v,[])
index 91e4c96..4d3145f 100644 (file)
@@ -25,62 +25,62 @@ module BreakArray
 #endif
     ) where
 
+import DynFlags
+
 #ifdef GHCI
 import Control.Monad
 
 import GHC.Exts
 import GHC.IO ( IO(..) )
 
-import Constants
-
 data BreakArray = BA (MutableByteArray# RealWorld)
 
 breakOff, breakOn :: Word
 breakOn  = 1
 breakOff = 0
 
-showBreakArray :: BreakArray -> IO ()
-showBreakArray array = do
-    forM_ [0..(size array - 1)] $ \i -> do
+showBreakArray :: DynFlags -> BreakArray -> IO ()
+showBreakArray dflags array = do
+    forM_ [0 .. (size dflags array - 1)] $ \i -> do
         val <- readBreakArray array i
         putStr $ ' ' : show val
     putStr "\n"
 
-setBreakOn :: BreakArray -> Int -> IO Bool 
-setBreakOn array index
-    | safeIndex array index = do 
+setBreakOn :: DynFlags -> BreakArray -> Int -> IO Bool
+setBreakOn dflags array index
+    | safeIndex dflags array index = do
           writeBreakArray array index breakOn 
           return True
     | otherwise = return False 
 
-setBreakOff :: BreakArray -> Int -> IO Bool 
-setBreakOff array index
-    | safeIndex array index = do
+setBreakOff :: DynFlags -> BreakArray -> Int -> IO Bool
+setBreakOff dflags array index
+    | safeIndex dflags array index = do
           writeBreakArray array index breakOff
           return True
     | otherwise = return False 
 
-getBreak :: BreakArray -> Int -> IO (Maybe Word)
-getBreak array index 
-    | safeIndex array index = do
+getBreak :: DynFlags -> BreakArray -> Int -> IO (Maybe Word)
+getBreak dflags array index
+    | safeIndex dflags array index = do
           val <- readBreakArray array index 
           return $ Just val 
     | otherwise = return Nothing
 
-safeIndex :: BreakArray -> Int -> Bool
-safeIndex array index = index < size array && index >= 0
+safeIndex :: DynFlags -> BreakArray -> Int -> Bool
+safeIndex dflags array index = index < size dflags array && index >= 0
 
-size :: BreakArray -> Int
-size (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE
+size :: DynFlags -> BreakArray -> Int
+size dflags (BA array) = (I# (sizeofMutableByteArray# array)) `div` wORD_SIZE dflags
 
 allocBA :: Int -> IO BreakArray 
 allocBA (I# sz) = IO $ \s1 ->
     case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
 
 -- create a new break array and initialise elements to zero
-newBreakArray :: Int -> IO BreakArray
-newBreakArray entries@(I# sz) = do
-    BA array <- allocBA (entries * wORD_SIZE
+newBreakArray :: DynFlags -> Int -> IO BreakArray
+newBreakArray dflags entries@(I# sz) = do
+    BA array <- allocBA (entries * wORD_SIZE dflags)
     case breakOff of 
         W# off -> do    -- Todo: there must be a better way to write zero as a Word!
             let loop n | n ==# sz = return ()
@@ -112,8 +112,8 @@ readBreakArray (BA array) (I# i) = readBA# array i
 -- presumably have a different representation.
 data BreakArray = Unspecified
 
-newBreakArray :: Int -> IO BreakArray
-newBreakArray _ = return Unspecified
+newBreakArray :: DynFlags -> Int -> IO BreakArray
+newBreakArray _ = return Unspecified
 
 #endif /* GHCI */
 
index d07977c..cf1ce81 100644 (file)
@@ -3148,8 +3148,8 @@ compilerInfo dflags
 #include "../includes/dist-derivedconstants/header/GHCConstantsHaskellWrappers.hs"
 
 bLOCK_SIZE_W :: DynFlags -> Int
-bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE
+bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE dflags
 
 wORD_SIZE_IN_BITS :: DynFlags -> Int
-wORD_SIZE_IN_BITS _ = wORD_SIZE * 8
+wORD_SIZE_IN_BITS dflags = wORD_SIZE dflags * 8
 
index a797329..806f835 100644 (file)
@@ -347,7 +347,8 @@ isBreakEnabled :: HscEnv -> BreakInfo -> IO Bool
 isBreakEnabled hsc_env inf =
    case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
        Just hmi -> do
-         w <- getBreak (modBreaks_flags (getModBreaks hmi))
+         w <- getBreak (hsc_dflags hsc_env)
+                       (modBreaks_flags (getModBreaks hmi))
                        (breakInfo_number inf)
          case w of Just n -> return (n /= 0); _other -> return False
        _ ->
index 367c0fb..1f036aa 100644 (file)
@@ -1379,10 +1379,10 @@ coerceInt2FP fromRep toRep x = do
                                  [CmmStaticLit (CmmInt 0x43300000 W32),
                                   CmmStaticLit (CmmInt 0x80000000 W32)],
                 XORIS itmp src (ImmInt 0x8000),
-                ST II32 itmp (spRel 3),
+                ST II32 itmp (spRel dflags 3),
                 LIS itmp (ImmInt 0x4330),
-                ST II32 itmp (spRel 2),
-                LD FF64 ftmp (spRel 2)
+                ST II32 itmp (spRel dflags 2),
+                LD FF64 ftmp (spRel dflags 2)
             ] `appOL` addr_code `appOL` toOL [
                 LD FF64 dst addr,
                 FSUB FF64 dst ftmp dst
@@ -1404,6 +1404,7 @@ coerceInt2FP fromRep toRep x = do
 
 coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
 coerceFP2Int _ toRep x = do
+    dflags <- getDynFlags
     -- the reps don't really matter: F*->FF64 and II32->I* are no-ops
     (src, code) <- getSomeReg x
     tmp <- getNewRegNat FF64
@@ -1412,7 +1413,7 @@ coerceFP2Int _ toRep x = do
                 -- convert to int in FP reg
             FCTIWZ tmp src,
                 -- store value (64bit) from FP to stack
-            ST FF64 tmp (spRel 2),
+            ST FF64 tmp (spRel dflags 2),
                 -- read low word of value (high word is undefined)
-            LD II32 dst (spRel 3)]
+            LD II32 dst (spRel dflags 3)]
     return (Any (intSize toRep) code')
index 7dccb60..d4123ac 100644 (file)
@@ -55,8 +55,8 @@ import CLabel           ( CLabel )
 import Unique
 
 import CodeGen.Platform
+import DynFlags
 import Outputable
-import Constants
 import FastBool
 import FastTypes
 import Platform
@@ -194,10 +194,11 @@ addrOffset addr off
 -- temporaries and for excess call arguments.  @fpRel@, where
 -- applicable, is the same but for the frame pointer.
 
-spRel :: Int    -- desired stack offset in words, positive or negative
+spRel :: DynFlags
+      -> Int    -- desired stack offset in words, positive or negative
       -> AddrMode
 
-spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE))
+spRel dflags n = AddrRegImm sp (ImmInt (n * wORD_SIZE dflags))
 
 
 -- argRegs is the set of regs which are read for an n-argument call to C.
index 66ebf75..b83ede8 100644 (file)
@@ -52,7 +52,6 @@ import Outputable
 import Unique
 import FastString
 import FastBool         ( isFastTrue )
-import Constants        ( wORD_SIZE )
 import DynFlags
 import Util
 
@@ -1766,9 +1765,9 @@ genCCall32' dflags target dest_regs args = do
             -- alignment of 16n - word_size on procedure entry. Which we
             -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
             sizes               = map (arg_size . cmmExprType dflags . hintlessCmm) (reverse args)
-            raw_arg_size        = sum sizes + wORD_SIZE
+            raw_arg_size        = sum sizes + wORD_SIZE dflags
             arg_pad_size        = (roundTo 16 $ raw_arg_size) - raw_arg_size
-            tot_arg_size        = raw_arg_size + arg_pad_size - wORD_SIZE
+            tot_arg_size        = raw_arg_size + arg_pad_size - wORD_SIZE dflags
         delta0 <- getDeltaNat
         setDeltaNat (delta0 - arg_pad_size)
 
@@ -2026,14 +2025,14 @@ genCCall64' dflags target dest_regs args = do
     -- alignment of 16n - word_size on procedure entry. Which we
     -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
     (real_size, adjust_rsp) <-
-        if (tot_arg_size + wORD_SIZE) `rem` 16 == 0
+        if (tot_arg_size + wORD_SIZE dflags) `rem` 16 == 0
             then return (tot_arg_size, nilOL)
             else do -- we need to adjust...
                 delta <- getDeltaNat
-                setDeltaNat (delta - wORD_SIZE)
-                return (tot_arg_size + wORD_SIZE, toOL [
-                                SUB II64 (OpImm (ImmInt wORD_SIZE)) (OpReg rsp),
-                                DELTA (delta - wORD_SIZE) ])
+                setDeltaNat (delta - wORD_SIZE dflags)
+                return (tot_arg_size + wORD_SIZE dflags, toOL [
+                                SUB II64 (OpImm (ImmInt (wORD_SIZE dflags))) (OpReg rsp),
+                                DELTA (delta - wORD_SIZE dflags) ])
 
     -- push the stack args, right to left
     push_code <- push_args (reverse stack_args) nilOL
@@ -2173,7 +2172,7 @@ genCCall64' dflags target dest_regs args = do
              let code' = code `appOL` arg_code `appOL` toOL [
                             SUB (intSize (wordWidth dflags)) (OpImm (ImmInt arg_size)) (OpReg rsp) ,
                             DELTA (delta-arg_size),
-                            MOV (floatSize width) (OpReg arg_reg) (OpAddr  (spRel platform 0))]
+                            MOV (floatSize width) (OpReg arg_reg) (OpAddr (spRel dflags 0))]
              push_args rest code'
 
            | otherwise = do
@@ -2196,7 +2195,7 @@ genCCall64' dflags target dest_regs args = do
              delta <- getDeltaNat
              setDeltaNat (delta - n * arg_size)
              return $ toOL [
-                         SUB II64 (OpImm (ImmInt (n * wORD_SIZE))) (OpReg rsp),
+                         SUB II64 (OpImm (ImmInt (n * wORD_SIZE dflags))) (OpReg rsp),
                          DELTA (delta - n * arg_size)]
 
 -- | We're willing to inline and unroll memcpy/memset calls that touch
@@ -2288,7 +2287,7 @@ genSwitch dflags expr ids
         dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
-                                       (EAIndex reg wORD_SIZE) (ImmInt 0))
+                                       (EAIndex reg (wORD_SIZE dflags)) (ImmInt 0))
 
         return $ if target32Bit (targetPlatform dflags)
                  then e_code `appOL` t_code `appOL` toOL [
@@ -2326,7 +2325,7 @@ genSwitch dflags expr ids
   = do
         (reg,e_code) <- getSomeReg expr
         lbl <- getNewLabelNat
-        let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl))
+        let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (wORD_SIZE dflags)) (ImmCLbl lbl))
             code = e_code `appOL` toOL [
                     JMP_TBL op ids ReadOnlyData lbl
                  ]
index 50f5b4c..7f0e48e 100644 (file)
@@ -625,9 +625,9 @@ x86_mkSpillInstr dflags reg delta slot
     let off_w = (off - delta) `div` (if is32Bit then 4 else 8)
     in case targetClassOfReg platform reg of
            RcInteger   -> MOV (archWordSize is32Bit)
-                              (OpReg reg) (OpAddr (spRel platform off_w))
-           RcDouble    -> GST FF80 reg (spRel platform off_w) {- RcFloat/RcDouble -}
-           RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel platform off_w))
+                              (OpReg reg) (OpAddr (spRel dflags off_w))
+           RcDouble    -> GST FF80 reg (spRel dflags off_w) {- RcFloat/RcDouble -}
+           RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel dflags off_w))
            _         -> panic "X86.mkSpillInstr: no match"
     where platform = targetPlatform dflags
           is32Bit = target32Bit platform
@@ -646,9 +646,9 @@ x86_mkLoadInstr dflags reg delta slot
         let off_w = (off-delta) `div` (if is32Bit then 4 else 8)
         in case targetClassOfReg platform reg of
               RcInteger -> MOV (archWordSize is32Bit)
-                               (OpAddr (spRel platform off_w)) (OpReg reg)
-              RcDouble  -> GLD FF80 (spRel platform off_w) reg {- RcFloat/RcDouble -}
-              RcDoubleSSE -> MOV FF64 (OpAddr (spRel platform off_w)) (OpReg reg)
+                               (OpAddr (spRel dflags off_w)) (OpReg reg)
+              RcDouble  -> GLD FF80 (spRel dflags off_w) reg {- RcFloat/RcDouble -}
+              RcDoubleSSE -> MOV FF64 (OpAddr (spRel dflags off_w)) (OpReg reg)
               _           -> panic "X86.x86_mkLoadInstr"
     where platform = targetPlatform dflags
           is32Bit = target32Bit platform
index c88ea98..4eec96f 100644 (file)
@@ -59,7 +59,6 @@ import Outputable
 import Platform
 import FastTypes
 import FastBool
-import Constants
 
 
 -- | regSqueeze_class reg
@@ -196,14 +195,14 @@ addrModeRegs _ = []
 -- applicable, is the same but for the frame pointer.
 
 
-spRel :: Platform
+spRel :: DynFlags
       -> Int -- ^ desired stack offset in words, positive or negative
       -> AddrMode
-spRel platform n
- | target32Bit platform
-    = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt (n * wORD_SIZE))
+spRel dflags n
+ | target32Bit (targetPlatform dflags)
+    = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt (n * wORD_SIZE dflags))
  | otherwise
-    = AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt (n * wORD_SIZE))
+    = AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt (n * wORD_SIZE dflags))
 
 -- The register numbers must fit into 32 bits on x86, so that we can
 -- use a Word32 to represent the set of free registers in the register
index 8d79e89..64ef9d9 100644 (file)
@@ -1554,7 +1554,8 @@ genDerivStuff :: SrcSpan -> FixityEnv -> Class -> Name -> TyCon
               -> TcM (LHsBinds RdrName, BagDerivStuff)
 genDerivStuff loc fix_env clas name tycon comaux_maybe
   | className clas `elem` typeableClassNames
-  = return (gen_Typeable_binds loc tycon, emptyBag)
+  = do dflags <- getDynFlags
+       return (gen_Typeable_binds dflags loc tycon, emptyBag)
 
   | ck `elem` [genClassKey, gen1ClassKey]   -- Special case because monadic
   = let gk =  if ck == genClassKey then Gen0 else Gen1 -- TODO NSF: correctly identify when we're building Both instead of One
index 0566192..e5baaec 100644 (file)
@@ -72,7 +72,6 @@ import Outputable
 import FastString
 import Bag
 import Fingerprint
-import Constants
 import TcEnv (InstInfo)
 
 import Data.List        ( partition, intersperse )
@@ -1192,8 +1191,8 @@ we generate
 We are passed the Typeable2 class as well as T
 
 \begin{code}
-gen_Typeable_binds :: SrcSpan -> TyCon -> LHsBinds RdrName
-gen_Typeable_binds loc tycon
+gen_Typeable_binds :: DynFlags -> SrcSpan -> TyCon -> LHsBinds RdrName
+gen_Typeable_binds dflags loc tycon
   = unitBag $
        mk_easy_FunBind loc 
                (mk_typeOf_RDR tycon)   -- Name of appropriate type0f function
@@ -1219,8 +1218,8 @@ gen_Typeable_binds loc tycon
     Fingerprint high low = fingerprintString hashThis
 
     int64
-      | wORD_SIZE == 4 = HsWord64Prim . fromIntegral
-      | otherwise      = HsWordPrim . fromIntegral
+      | wORD_SIZE dflags == 4 = HsWord64Prim . fromIntegral
+      | otherwise             = HsWordPrim . fromIntegral
 
 
 mk_typeOf_RDR :: TyCon -> RdrName
index 147e16d..05c0ae5 100644 (file)
@@ -93,6 +93,7 @@ import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
 import Var
 import Class
 import BasicTypes
+import DynFlags
 import ForeignCall
 import Name
 import PrelNames
@@ -777,16 +778,16 @@ instance Outputable PrimRep where
   ppr r = text (show r)
 
 -- | Find the size of a 'PrimRep', in words
-primRepSizeW :: PrimRep -> Int
-primRepSizeW IntRep   = 1
-primRepSizeW WordRep  = 1
-primRepSizeW Int64Rep = wORD64_SIZE `quot` wORD_SIZE
-primRepSizeW Word64Rep= wORD64_SIZE `quot` wORD_SIZE
-primRepSizeW FloatRep = 1    -- NB. might not take a full word
-primRepSizeW DoubleRep= dOUBLE_SIZE `quot` wORD_SIZE
-primRepSizeW AddrRep  = 1
-primRepSizeW PtrRep   = 1
-primRepSizeW VoidRep  = 0
+primRepSizeW :: DynFlags -> PrimRep -> Int
+primRepSizeW _      IntRep   = 1
+primRepSizeW _      WordRep  = 1
+primRepSizeW dflags Int64Rep = wORD64_SIZE `quot` wORD_SIZE dflags
+primRepSizeW dflags Word64Rep= wORD64_SIZE `quot` wORD_SIZE dflags
+primRepSizeW _      FloatRep = 1    -- NB. might not take a full word
+primRepSizeW dflags DoubleRep= dOUBLE_SIZE `quot` wORD_SIZE dflags
+primRepSizeW _      AddrRep  = 1
+primRepSizeW _      PtrRep   = 1
+primRepSizeW _      VoidRep  = 0
 \end{code}
 
 %************************************************************************
index 60748ba..85fe889 100644 (file)
@@ -2589,12 +2589,13 @@ breakSyntax = ghcError (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
 findBreakAndSet md lookupTickTree = do
+   dflags <- getDynFlags
    tickArray <- getTickArray md
    (breakArray, _) <- getModBreak md
    case lookupTickTree tickArray of
       Nothing  -> liftIO $ putStrLn $ "No breakpoints found at that location."
       Just (tick, pan) -> do
-         success <- liftIO $ setBreakFlag True breakArray tick
+         success <- liftIO $ setBreakFlag dflags True breakArray tick
          if success
             then do
                (alreadySet, nm) <-
@@ -2877,8 +2878,9 @@ deleteBreak identity = do
 
 turnOffBreak :: BreakLocation -> GHCi Bool
 turnOffBreak loc = do
+  dflags <- getDynFlags
   (arr, _) <- getModBreak (breakModule loc)
-  liftIO $ setBreakFlag False arr (breakTick loc)
+  liftIO $ setBreakFlag dflags False arr (breakTick loc)
 
 getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)
 getModBreak m = do
@@ -2888,10 +2890,10 @@ getModBreak m = do
    let ticks      = GHC.modBreaks_locs  modBreaks
    return (arr, ticks)
 
-setBreakFlag :: Bool -> GHC.BreakArray -> Int -> IO Bool
-setBreakFlag toggle arr i
-   | toggle    = GHC.setBreakOn arr i
-   | otherwise = GHC.setBreakOff arr i
+setBreakFlag :: DynFlags -> Bool -> GHC.BreakArray -> Int -> IO Bool
+setBreakFlag dflags toggle arr i
+   | toggle    = GHC.setBreakOn  dflags arr i
+   | otherwise = GHC.setBreakOff dflags arr i
 
 
 -- ---------------------------------------------------------------------------
index 33108f2..5b9a5ba 100644 (file)
@@ -42,11 +42,6 @@ dOUBLE_SIZE = SIZEOF_DOUBLE
 wORD64_SIZE :: Int
 wORD64_SIZE = 8
 
--- Size of a word, in bytes
-
-wORD_SIZE :: Int
-wORD_SIZE = SIZEOF_HSWORD
-
 -- Define a fixed-range integral type equivalent to the target Int/Word
 
 #if SIZEOF_HSWORD == 4
index 609c7ae..a6d2230 100644 (file)
@@ -683,6 +683,9 @@ main(int argc, char *argv[])
     // own stack check (see bug #1466).
     constantInt("aP_STACK_SPLIM", AP_STACK_SPLIM);
 
+    // Size of a word, in bytes
+    constantInt("wORD_SIZE", SIZEOF_HSWORD);
+
     switch (mode) {
     case Gen_Haskell_Type:
         printf("  } deriving (Read, Show)\n");