Commit 2b7319a6 authored by ian@well-typed.com's avatar ian@well-typed.com

Pass DynFlags down to wordWidth

parent 44b5f471
......@@ -33,6 +33,7 @@ import CLabel
import Cmm
import CmmUtils
import Data.List
import DynFlags
import Maybes
import Module
import Outputable
......@@ -166,17 +167,17 @@ srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
-- in the SRT. Then, if the number of CAFs is small enough to fit in a bitmap,
-- we make sure they're all close enough to the bottom of the table that the
-- bitmap will be able to cover all of them.
buildSRT :: TopSRT -> CAFSet -> UniqSM (TopSRT, Maybe CmmDecl, C_SRT)
buildSRT topSRT cafs =
buildSRT :: DynFlags -> TopSRT -> CAFSet -> UniqSM (TopSRT, Maybe CmmDecl, C_SRT)
buildSRT dflags topSRT cafs =
do let
-- For each label referring to a function f without a static closure,
-- replace it with the CAFs that are reachable from f.
sub_srt topSRT localCafs =
let cafs = Set.elems localCafs
mkSRT topSRT =
do localSRTs <- procpointSRT (lbl topSRT) (elt_map topSRT) cafs
do localSRTs <- procpointSRT dflags (lbl topSRT) (elt_map topSRT) cafs
return (topSRT, localSRTs)
in if length cafs > maxBmpSize then
in if length cafs > maxBmpSize dflags then
mkSRT (foldl add_if_missing topSRT cafs)
else -- make sure all the cafs are near the bottom of the srt
mkSRT (add_if_too_far topSRT cafs)
......@@ -196,7 +197,7 @@ buildSRT topSRT cafs =
add srt [] = srt
add srt@(TopSRT {next_elt = next}) (caf : rst) =
case cafOffset srt caf of
Just ix -> if next - ix > maxBmpSize then
Just ix -> if next - ix > maxBmpSize dflags then
add (addCAF caf srt) rst
else srt
Nothing -> add (addCAF caf srt) rst
......@@ -206,12 +207,12 @@ buildSRT topSRT cafs =
-- Construct an SRT bitmap.
-- Adapted from simpleStg/SRT.lhs, which expects Id's.
procpointSRT :: CLabel -> Map CLabel Int -> [CLabel] ->
procpointSRT :: DynFlags -> CLabel -> Map CLabel Int -> [CLabel] ->
UniqSM (Maybe CmmDecl, C_SRT)
procpointSRT _ _ [] =
procpointSRT _ _ _ [] =
return (Nothing, NoC_SRT)
procpointSRT top_srt top_table entries =
do (top, srt) <- bitmap `seq` to_SRT top_srt offset len bitmap
procpointSRT dflags top_srt top_table entries =
do (top, srt) <- bitmap `seq` to_SRT dflags top_srt offset len bitmap
return (top, srt)
where
ints = map (expectJust "constructSRT" . flip Map.lookup top_table) entries
......@@ -221,20 +222,20 @@ procpointSRT top_srt top_table entries =
len = P.last bitmap_entries + 1
bitmap = intsToBitmap len bitmap_entries
maxBmpSize :: Int
maxBmpSize = widthInBits wordWidth `div` 2
maxBmpSize :: DynFlags -> Int
maxBmpSize dflags = widthInBits (wordWidth dflags) `div` 2
-- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT.
to_SRT :: CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT)
to_SRT top_srt off len bmp
| len > maxBmpSize || bmp == [fromIntegral srt_escape]
to_SRT :: DynFlags -> CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT)
to_SRT dflags top_srt off len bmp
| len > maxBmpSize dflags || bmp == [fromIntegral srt_escape]
= do id <- getUniqueM
let srt_desc_lbl = mkLargeSRTLabel id
tbl = CmmData RelocatableReadOnlyData $
Statics srt_desc_lbl $ map CmmStaticLit
( cmmLabelOffW top_srt off
: mkWordCLit (fromIntegral len)
: map mkWordCLit bmp)
: mkWordCLit dflags (fromIntegral len)
: map (mkWordCLit dflags) bmp)
return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape)
| otherwise
= return (Nothing, C_SRT top_srt off (fromIntegral (head bmp)))
......@@ -318,11 +319,12 @@ flattenCAFSets cpsdecls = zipWith (bundle flatmap) zipped localCAFs
localCAFs = unzipWith localCAFInfo zipped
flatmap = mkTopCAFInfo localCAFs -- transitive closure of localCAFs
doSRTs :: TopSRT
doSRTs :: DynFlags
-> TopSRT
-> [(CAFEnv, [CmmDecl])]
-> IO (TopSRT, [CmmDecl])
doSRTs topSRT tops
doSRTs dflags topSRT tops
= do
let caf_decls = flattenCAFSets tops
us <- mkSplitUniqSupply 'u'
......@@ -330,19 +332,19 @@ doSRTs topSRT tops
return (topSRT', reverse gs' {- Note [reverse gs] -})
where
setSRT (topSRT, rst) (caf_map, decl@(CmmProc{})) = do
(topSRT, srt_tables, srt_env) <- buildSRTs topSRT caf_map
(topSRT, srt_tables, srt_env) <- buildSRTs dflags topSRT caf_map
let decl' = updInfoSRTs srt_env decl
return (topSRT, decl': srt_tables ++ rst)
setSRT (topSRT, rst) (_, decl) =
return (topSRT, decl : rst)
buildSRTs :: TopSRT -> BlockEnv CAFSet
buildSRTs :: DynFlags -> TopSRT -> BlockEnv CAFSet
-> UniqSM (TopSRT, [CmmDecl], BlockEnv C_SRT)
buildSRTs top_srt caf_map
buildSRTs dflags top_srt caf_map
= foldM doOne (top_srt, [], mapEmpty) (mapToList caf_map)
where
doOne (top_srt, decls, srt_env) (l, cafs)
= do (top_srt, mb_decl, srt) <- buildSRT top_srt cafs
= do (top_srt, mb_decl, srt) <- buildSRT dflags top_srt cafs
return ( top_srt, maybeToList mb_decl ++ decls
, mapInsert l srt srt_env )
......
......@@ -78,9 +78,9 @@ assignArgumentsPos dflags conv arg_ty reps = assignments
_ -> (assts, (r:rs))
int = case (w, regs) of
(W128, _) -> panic "W128 unsupported register type"
(_, (v:vs, fs, ds, ls)) | widthInBits w <= widthInBits wordWidth
(_, (v:vs, fs, ds, ls)) | widthInBits w <= widthInBits (wordWidth dflags)
-> k (RegisterParam (v gcp), (vs, fs, ds, ls))
(_, (vs, fs, ds, l:ls)) | widthInBits w > widthInBits wordWidth
(_, (vs, fs, ds, l:ls)) | widthInBits w > widthInBits (wordWidth dflags)
-> k (RegisterParam l, (vs, fs, ds, ls))
_ -> (assts, (r:rs))
k (asst, regs') = assign_regs ((r, asst) : assts) rs regs'
......
......@@ -114,8 +114,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
-- Use a zero place-holder in place of the
-- entry-label in the info table
return (top_decls ++
[mkRODataLits info_lbl (zeroCLit : rel_std_info ++
rel_extra_bits)])
[mkRODataLits info_lbl (zeroCLit dflags : rel_std_info ++
rel_extra_bits)])
_nonempty ->
-- Separately emit info table (with the function entry
-- point as first entry) and the entry code
......@@ -172,9 +172,9 @@ mkInfoTableContents dflags
-- (which in turn came from a handwritten .cmm file)
| StackRep frame <- smrep
= do { (prof_lits, prof_data) <- mkProfLits prof
= do { (prof_lits, prof_data) <- mkProfLits dflags prof
; let (srt_label, srt_bitmap) = mkSRTLit srt
; (liveness_lit, liveness_data) <- mkLivenessBits frame
; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame
; let
std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
rts_tag | Just tag <- mb_rts_tag = tag
......@@ -184,8 +184,8 @@ mkInfoTableContents dflags
; return (prof_data ++ liveness_data, (std_info, srt_label)) }
| HeapRep _ ptrs nonptrs closure_type <- smrep
= do { let layout = packHalfWordsCLit ptrs nonptrs
; (prof_lits, prof_data) <- mkProfLits prof
= do { let layout = packHalfWordsCLit dflags ptrs nonptrs
; (prof_lits, prof_data) <- mkProfLits dflags prof
; let (srt_label, srt_bitmap) = mkSRTLit srt
; (mb_srt_field, mb_layout, extra_bits, ct_data)
<- mk_pieces closure_type srt_label
......@@ -208,24 +208,24 @@ mkInfoTableContents dflags
= return (Nothing, Nothing, srt_label, [])
mk_pieces (ThunkSelector offset) _no_srt
= return (Just 0, Just (mkWordCLit offset), [], [])
= return (Just 0, Just (mkWordCLit dflags offset), [], [])
-- Layout known (one free var); we use the layout field for offset
mk_pieces (Fun arity (ArgSpec fun_type)) srt_label
= do { let extra_bits = packHalfWordsCLit fun_type arity : srt_label
= do { let extra_bits = packHalfWordsCLit dflags fun_type arity : srt_label
; return (Nothing, Nothing, extra_bits, []) }
mk_pieces (Fun arity (ArgGen arg_bits)) srt_label
= do { (liveness_lit, liveness_data) <- mkLivenessBits arg_bits
= do { (liveness_lit, liveness_data) <- mkLivenessBits dflags arg_bits
; let fun_type | null liveness_data = aRG_GEN
| otherwise = aRG_GEN_BIG
extra_bits = [ packHalfWordsCLit fun_type arity
extra_bits = [ packHalfWordsCLit dflags fun_type arity
, srt_lit, liveness_lit, slow_entry ]
; return (Nothing, Nothing, extra_bits, liveness_data) }
where
slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
srt_lit = case srt_label of
[] -> mkIntCLit 0
[] -> mkIntCLit dflags 0
(lit:_rest) -> ASSERT( null _rest ) lit
mk_pieces BlackHole _ = panic "mk_pieces: BlackHole"
......@@ -297,12 +297,12 @@ makeRelativeRefTo _ _ lit = lit
-- The head of the stack layout is the top of the stack and
-- the least-significant bit.
mkLivenessBits :: Liveness -> UniqSM (CmmLit, [RawCmmDecl])
mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
-- ^ Returns:
-- 1. The bitmap (literal value or label)
-- 2. Large bitmap CmmData if needed
mkLivenessBits liveness
mkLivenessBits dflags liveness
| n_bits > mAX_SMALL_BITMAP_SIZE -- does not fit in one word
= do { uniq <- getUniqueUs
; let bitmap_lbl = mkBitmapLabel uniq
......@@ -310,7 +310,7 @@ mkLivenessBits liveness
[mkRODataLits bitmap_lbl lits]) }
| otherwise -- Fits in one word
= return (mkWordCLit bitmap_word, [])
= return (mkWordCLit dflags bitmap_word, [])
where
n_bits = length liveness
......@@ -324,7 +324,7 @@ mkLivenessBits liveness
bitmap_word = fromIntegral n_bits
.|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
lits = mkWordCLit (fromIntegral n_bits) : map mkWordCLit bitmap
lits = mkWordCLit dflags (fromIntegral n_bits) : map (mkWordCLit dflags) bitmap
-- The first word is the size. The structure must match
-- StgLargeBitmap in includes/rts/storage/InfoTable.h
......@@ -361,7 +361,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit
| dopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
| otherwise = []
type_lit = packHalfWordsCLit cl_type srt_len
type_lit = packHalfWordsCLit dflags cl_type srt_len
-------------------------------------------------------------------------
--
......@@ -369,9 +369,9 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit
--
-------------------------------------------------------------------------
mkProfLits :: ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
mkProfLits NoProfilingInfo = return ((zeroCLit, zeroCLit), [])
mkProfLits (ProfilingInfo td cd)
mkProfLits :: DynFlags -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
mkProfLits dflags NoProfilingInfo = return ((zeroCLit dflags, zeroCLit dflags), [])
mkProfLits _ (ProfilingInfo td cd)
= do { (td_lit, td_decl) <- newStringLit td
; (cd_lit, cd_decl) <- newStringLit cd
; return ((td_lit,cd_lit), [td_decl,cd_decl]) }
......
......@@ -776,12 +776,12 @@ arguments.
areaToSp :: DynFlags -> ByteOff -> ByteOff -> (Area -> StackLoc) -> CmmExpr -> CmmExpr
areaToSp dflags sp_old _sp_hwm area_off (CmmStackSlot area n) =
cmmOffset dflags (CmmReg spReg) (sp_old - area_off area - n)
areaToSp _ _ sp_hwm _ (CmmLit CmmHighStackMark) = mkIntExpr sp_hwm
areaToSp _ _ _ _ (CmmMachOp (MO_U_Lt _) -- Note [null stack check]
[CmmMachOp (MO_Sub _)
[ CmmReg (CmmGlobal Sp)
, CmmLit (CmmInt 0 _)],
CmmReg (CmmGlobal SpLim)]) = zeroExpr
areaToSp dflags _ sp_hwm _ (CmmLit CmmHighStackMark) = mkIntExpr dflags sp_hwm
areaToSp dflags _ _ _ (CmmMachOp (MO_U_Lt _) -- Note [null stack check]
[CmmMachOp (MO_Sub _)
[ CmmReg (CmmGlobal Sp)
, CmmLit (CmmInt 0 _)],
CmmReg (CmmGlobal SpLim)]) = zeroExpr dflags
areaToSp _ _ _ _ other = other
-- -----------------------------------------------------------------------------
......@@ -920,7 +920,7 @@ lowerSafeForeignCall dflags block
load_stack <- newTemp (gcWord dflags)
let suspend = saveThreadState dflags <*>
caller_save <*>
mkMiddle (callSuspendThread id intrbl)
mkMiddle (callSuspendThread dflags id intrbl)
midCall = mkUnsafeCall tgt res args
resume = mkMiddle (callResumeThread new_base id) <*>
-- Assign the result to BaseReg: we
......@@ -941,7 +941,7 @@ lowerSafeForeignCall dflags block
jump = CmmCall { cml_target = CmmLoad (CmmReg spReg) (bWord dflags)
, cml_cont = Just succ
, cml_args_regs = regs
, cml_args = widthInBytes wordWidth
, cml_args = widthInBytes (wordWidth dflags)
, cml_ret_args = ret_args
, cml_ret_off = updfr }
......@@ -966,12 +966,12 @@ foreignLbl name = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
newTemp :: CmmType -> UniqSM LocalReg
newTemp rep = getUniqueM >>= \u -> return (LocalReg u rep)
callSuspendThread :: LocalReg -> Bool -> CmmNode O O
callSuspendThread id intrbl =
callSuspendThread :: DynFlags -> LocalReg -> Bool -> CmmNode O O
callSuspendThread dflags id intrbl =
CmmUnsafeForeignCall
(ForeignTarget (foreignLbl (fsLit "suspendThread"))
(ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint]))
[id] [CmmReg (CmmGlobal BaseReg), mkIntExpr (fromEnum intrbl)]
[id] [CmmReg (CmmGlobal BaseReg), mkIntExpr dflags (fromEnum intrbl)]
callResumeThread :: LocalReg -> LocalReg -> CmmNode O O
callResumeThread new_base id =
......
......@@ -88,9 +88,9 @@ lintCmmExpr (CmmLoad expr rep) = do
lintCmmExpr expr@(CmmMachOp op args) = do
dflags <- getDynFlags
tys <- mapM lintCmmExpr args
if map (typeWidth . cmmExprType dflags) args == machOpArgReps op
if map (typeWidth . cmmExprType dflags) args == machOpArgReps dflags op
then cmmCheckMachOp op args tys
else cmmLintMachOpErr expr (map (cmmExprType dflags) args) (machOpArgReps op)
else cmmLintMachOpErr expr (map (cmmExprType dflags) args) (machOpArgReps dflags op)
lintCmmExpr (CmmRegOff reg offset)
= do dflags <- getDynFlags
let rep = typeWidth (cmmRegType dflags reg)
......@@ -158,9 +158,10 @@ lintCmmLast labels node = case node of
CmmBranch id -> checkTarget id
CmmCondBranch e t f -> do
dflags <- getDynFlags
mapM_ checkTarget [t,f]
_ <- lintCmmExpr e
checkCond e
checkCond dflags e
CmmSwitch e branches -> do
dflags <- getDynFlags
......@@ -190,10 +191,10 @@ lintTarget (ForeignTarget e _) = lintCmmExpr e >> return ()
lintTarget (PrimTarget {}) = return ()
checkCond :: CmmExpr -> CmmLint ()
checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
checkCond expr
checkCond :: DynFlags -> CmmExpr -> CmmLint ()
checkCond _ (CmmMachOp mop _) | isComparisonMachOp mop = return ()
checkCond dflags (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth dflags = return () -- constant values
checkCond _ expr
= cmmLintErr (hang (text "expression is not a conditional:") 2
(ppr expr))
......
......@@ -123,59 +123,62 @@ mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot
, mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe
, mo_wordULe, mo_wordUGt, mo_wordULt
, mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr
, mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
, mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord, mo_u_32ToWord, mo_s_32ToWord
, mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64
, mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64
:: DynFlags -> MachOp
mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
, mo_32To8, mo_32To16
:: MachOp
mo_wordAdd = MO_Add wordWidth
mo_wordSub = MO_Sub wordWidth
mo_wordEq = MO_Eq wordWidth
mo_wordNe = MO_Ne wordWidth
mo_wordMul = MO_Mul wordWidth
mo_wordSQuot = MO_S_Quot wordWidth
mo_wordSRem = MO_S_Rem wordWidth
mo_wordSNeg = MO_S_Neg wordWidth
mo_wordUQuot = MO_U_Quot wordWidth
mo_wordURem = MO_U_Rem wordWidth
mo_wordSGe = MO_S_Ge wordWidth
mo_wordSLe = MO_S_Le wordWidth
mo_wordSGt = MO_S_Gt wordWidth
mo_wordSLt = MO_S_Lt wordWidth
mo_wordUGe = MO_U_Ge wordWidth
mo_wordULe = MO_U_Le wordWidth
mo_wordUGt = MO_U_Gt wordWidth
mo_wordULt = MO_U_Lt wordWidth
mo_wordAnd = MO_And wordWidth
mo_wordOr = MO_Or wordWidth
mo_wordXor = MO_Xor wordWidth
mo_wordNot = MO_Not wordWidth
mo_wordShl = MO_Shl wordWidth
mo_wordSShr = MO_S_Shr wordWidth
mo_wordUShr = MO_U_Shr wordWidth
mo_u_8To32 = MO_UU_Conv W8 W32
mo_s_8To32 = MO_SS_Conv W8 W32
mo_u_16To32 = MO_UU_Conv W16 W32
mo_s_16To32 = MO_SS_Conv W16 W32
mo_u_8ToWord = MO_UU_Conv W8 wordWidth
mo_s_8ToWord = MO_SS_Conv W8 wordWidth
mo_u_16ToWord = MO_UU_Conv W16 wordWidth
mo_s_16ToWord = MO_SS_Conv W16 wordWidth
mo_s_32ToWord = MO_SS_Conv W32 wordWidth
mo_u_32ToWord = MO_UU_Conv W32 wordWidth
mo_WordTo8 = MO_UU_Conv wordWidth W8
mo_WordTo16 = MO_UU_Conv wordWidth W16
mo_WordTo32 = MO_UU_Conv wordWidth W32
mo_WordTo64 = MO_UU_Conv wordWidth W64
mo_32To8 = MO_UU_Conv W32 W8
mo_32To16 = MO_UU_Conv W32 W16
mo_wordAdd dflags = MO_Add (wordWidth dflags)
mo_wordSub dflags = MO_Sub (wordWidth dflags)
mo_wordEq dflags = MO_Eq (wordWidth dflags)
mo_wordNe dflags = MO_Ne (wordWidth dflags)
mo_wordMul dflags = MO_Mul (wordWidth dflags)
mo_wordSQuot dflags = MO_S_Quot (wordWidth dflags)
mo_wordSRem dflags = MO_S_Rem (wordWidth dflags)
mo_wordSNeg dflags = MO_S_Neg (wordWidth dflags)
mo_wordUQuot dflags = MO_U_Quot (wordWidth dflags)
mo_wordURem dflags = MO_U_Rem (wordWidth dflags)
mo_wordSGe dflags = MO_S_Ge (wordWidth dflags)
mo_wordSLe dflags = MO_S_Le (wordWidth dflags)
mo_wordSGt dflags = MO_S_Gt (wordWidth dflags)
mo_wordSLt dflags = MO_S_Lt (wordWidth dflags)
mo_wordUGe dflags = MO_U_Ge (wordWidth dflags)
mo_wordULe dflags = MO_U_Le (wordWidth dflags)
mo_wordUGt dflags = MO_U_Gt (wordWidth dflags)
mo_wordULt dflags = MO_U_Lt (wordWidth dflags)
mo_wordAnd dflags = MO_And (wordWidth dflags)
mo_wordOr dflags = MO_Or (wordWidth dflags)
mo_wordXor dflags = MO_Xor (wordWidth dflags)
mo_wordNot dflags = MO_Not (wordWidth dflags)
mo_wordShl dflags = MO_Shl (wordWidth dflags)
mo_wordSShr dflags = MO_S_Shr (wordWidth dflags)
mo_wordUShr dflags = MO_U_Shr (wordWidth dflags)
mo_u_8To32 = MO_UU_Conv W8 W32
mo_s_8To32 = MO_SS_Conv W8 W32
mo_u_16To32 = MO_UU_Conv W16 W32
mo_s_16To32 = MO_SS_Conv W16 W32
mo_u_8ToWord dflags = MO_UU_Conv W8 (wordWidth dflags)
mo_s_8ToWord dflags = MO_SS_Conv W8 (wordWidth dflags)
mo_u_16ToWord dflags = MO_UU_Conv W16 (wordWidth dflags)
mo_s_16ToWord dflags = MO_SS_Conv W16 (wordWidth dflags)
mo_s_32ToWord dflags = MO_SS_Conv W32 (wordWidth dflags)
mo_u_32ToWord dflags = MO_UU_Conv W32 (wordWidth dflags)
mo_WordTo8 dflags = MO_UU_Conv (wordWidth dflags) W8
mo_WordTo16 dflags = MO_UU_Conv (wordWidth dflags) W16
mo_WordTo32 dflags = MO_UU_Conv (wordWidth dflags) W32
mo_WordTo64 dflags = MO_UU_Conv (wordWidth dflags) W64
mo_32To8 = MO_UU_Conv W32 W8
mo_32To16 = MO_UU_Conv W32 W16
-- ----------------------------------------------------------------------------
......@@ -350,8 +353,8 @@ comparisonResultRep = bWord -- is it?
-- its arguments are the same as the MachOp expects. This is used when
-- linting a CmmExpr.
machOpArgReps :: MachOp -> [Width]
machOpArgReps op =
machOpArgReps :: DynFlags -> MachOp -> [Width]
machOpArgReps dflags op =
case op of
MO_Add r -> [r,r]
MO_Sub r -> [r,r]
......@@ -392,9 +395,9 @@ machOpArgReps op =
MO_Or r -> [r,r]
MO_Xor r -> [r,r]
MO_Not r -> [r]
MO_Shl r -> [r,wordWidth]
MO_U_Shr r -> [r,wordWidth]
MO_S_Shr r -> [r,wordWidth]
MO_Shl r -> [r, wordWidth dflags]
MO_U_Shr r -> [r, wordWidth dflags]
MO_S_Shr r -> [r, wordWidth dflags]
MO_SS_Conv from _ -> [from]
MO_UU_Conv from _ -> [from]
......
This diff is collapsed.
......@@ -1053,9 +1053,9 @@ doSwitch mb_range scrut arms deflt
initEnv :: DynFlags -> Env
initEnv dflags = listToUFM [
( fsLit "SIZEOF_StgHeader",
VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE)) wordWidth) )),
VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE)) (wordWidth dflags)) )),
( fsLit "SIZEOF_StgInfoTable",
VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) wordWidth) ))
VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) ))
]
parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe CmmGroup)
......
......@@ -43,7 +43,7 @@ cmmPipeline hsc_env topSRT prog =
tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
(topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs topSRT tops
(topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops
dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
return (topSRT, cmms)
......
......@@ -22,7 +22,6 @@ import StgCmmUtils
import DynFlags
import UniqSupply
import Platform
import UniqFM
import Unique
import BlockId
......@@ -38,7 +37,6 @@ import Prelude hiding (succ, zip)
rewriteAssignments :: DynFlags -> CmmGraph -> UniqSM CmmGraph
rewriteAssignments dflags g = do
let platform = targetPlatform dflags
-- Because we need to act on forwards and backwards information, we
-- first perform usage analysis and bake this information into the
-- graph (backwards transform), and then do a forwards transform
......@@ -47,7 +45,7 @@ rewriteAssignments dflags g = do
g'' <- liftM fst $ dataflowPassFwd g' [(g_entry g, fact_bot assignmentLattice)] $
analRewFwd assignmentLattice
(assignmentTransfer dflags)
(assignmentRewrite `thenFwdRw` machOpFoldRewrite platform)
(assignmentRewrite `thenFwdRw` machOpFoldRewrite dflags)
return (modifyGraph eraseRegUsage g'')
----------------------------------------------------------------
......@@ -615,8 +613,8 @@ assignmentRewrite = mkFRewrite3 first middle last
-- in literals, which we can inline more aggressively, and inlining
-- gives us opportunities for more folding. However, we don't need any
-- facts to do MachOp folding.
machOpFoldRewrite :: Platform -> FwdRewrite UniqSM (WithRegUsage CmmNode) a
machOpFoldRewrite platform = mkFRewrite3 first middle last
machOpFoldRewrite :: DynFlags -> FwdRewrite UniqSM (WithRegUsage CmmNode) a
machOpFoldRewrite dflags = mkFRewrite3 first middle last
where first _ _ = return Nothing
middle :: WithRegUsage CmmNode O O -> a -> GenCmmReplGraph (WithRegUsage CmmNode) O O
middle (Plain m) _ = return (fmap (mkMiddle . Plain) (foldNode m))
......@@ -626,7 +624,7 @@ machOpFoldRewrite platform = mkFRewrite3 first middle last
last (Plain l) _ = return (fmap (mkLast . Plain) (foldNode l))
foldNode :: CmmNode e x -> Maybe (CmmNode e x)
foldNode n = mapExpDeepM foldExp n
foldExp (CmmMachOp op args) = cmmMachOpFoldM platform op args
foldExp (CmmMachOp op args) = cmmMachOpFoldM dflags op args
foldExp _ = Nothing
-- ToDo: Outputable instance for UsageMap and AssignmentMap
......@@ -97,13 +97,13 @@ f64 = cmmFloat W64
-- CmmTypes of native word widths
bWord :: DynFlags -> CmmType
bWord _ = cmmBits wordWidth
bWord dflags = cmmBits (wordWidth dflags)
bHalfWord :: DynFlags -> CmmType
bHalfWord dflags = cmmBits (halfWordWidth dflags)
gcWord :: DynFlags -> CmmType
gcWord _ = CmmType GcPtrCat wordWidth
gcWord dflags = CmmType GcPtrCat (wordWidth dflags)
cInt, cLong :: CmmType
cInt = cmmBits cIntWidth
......@@ -160,10 +160,11 @@ mrStr W80 = sLit("W80")
-------- Common Widths ------------
wordWidth :: Width
wordWidth | wORD_SIZE == 4 = W32
| wORD_SIZE == 8 = W64
| otherwise = panic "MachOp.wordRep: Unknown word size"
wordWidth :: DynFlags -> Width
wordWidth _
| wORD_SIZE == 4 = W32
| wORD_SIZE == 8 = W64
| otherwise = panic "MachOp.wordRep: Unknown word size"
halfWordWidth :: DynFlags -> Width
halfWordWidth _
......
......@@ -121,17 +121,17 @@ typeForeignHint = primRepForeignHint . typePrimRep
--
---------------------------------------------------
mkIntCLit :: Int -> CmmLit
mkIntCLit i = CmmInt (toInteger i) wordWidth
mkIntCLit :: DynFlags -> Int -> CmmLit
mkIntCLit dflags i = CmmInt (toInteger i) (wordWidth dflags)
mkIntExpr :: Int -> CmmExpr
mkIntExpr i = CmmLit $! mkIntCLit i
mkIntExpr :: DynFlags -> Int -> CmmExpr
mkIntExpr dflags i = CmmLit $! mkIntCLit dflags i
zeroCLit :: CmmLit
zeroCLit = CmmInt 0 wordWidth
zeroCLit :: DynFlags -> CmmLit
zeroCLit dflags = CmmInt 0 (wordWidth dflags)