Skip to content

GitLab

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

Pass DynFlags down to wordWidth

parent 44b5f471
Hide whitespace changes
Inline Side-by-side
compiler/cmm/CmmBuildInfoTables.hs
View file @ 2b7319a6
......@@ -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 )
......
compiler/cmm/CmmCallConv.hs
View file @ 2b7319a6
......@@ -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'
......
compiler/cmm/CmmInfo.hs
View file @ 2b7319a6
......@@ -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]) }
......
compiler/cmm/CmmLayoutStack.hs
View file @ 2b7319a6
......@@ -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 =
......
compiler/cmm/CmmLint.hs
View file @ 2b7319a6
......@@ -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))
......
compiler/cmm/CmmMachOp.hs
View file @ 2b7319a6
......@@ -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]
......
compiler/cmm/CmmOpt.hs
View file @ 2b7319a6
......@@ -183,8 +183,7 @@ cmmMiniInlineStmts dflags uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr)
-- not CmmLocal: that might invalidate the usage analysis results
isTiny _ = False
platform = targetPlatform dflags
foldExp (CmmMachOp op args) = cmmMachOpFold platform op args
foldExp (CmmMachOp op args) = cmmMachOpFold dflags op args
foldExp e = e
ncgDebugTrace str x = if ncgDebugIsOn then trace str x else x
......@@ -302,17 +301,17 @@ inlineExpr _ _ other_expr = other_expr
-- been optimized and folded.
cmmMachOpFold
:: Platform
:: DynFlags
-> MachOp -- The operation from an CmmMachOp
-> [CmmExpr] -- The optimized arguments
-> CmmExpr
cmmMachOpFold platform op args = fromMaybe (CmmMachOp op args) (cmmMachOpFoldM platform op args)
cmmMachOpFold dflags op args = fromMaybe (CmmMachOp op args) (cmmMachOpFoldM dflags op args)
-- Returns Nothing if no changes, useful for Hoopl, also reduces
-- allocation!
cmmMachOpFoldM
:: Platform
:: DynFlags
-> MachOp
-> [CmmExpr]
-> Maybe CmmExpr
......@@ -338,7 +337,7 @@ cmmMachOpFoldM _ (MO_SS_Conv rep1 rep2) [x] | rep1 == rep2 = Just x
cmmMachOpFoldM _ (MO_UU_Conv rep1 rep2) [x] | rep1 == rep2 = Just x
-- Eliminate nested conversions where possible
cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]]
cmmMachOpFoldM dflags conv_outer [CmmMachOp conv_inner [x]]
| Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
Just (_, rep3,signed2) <- isIntConversion conv_outer
= case () of
......@@ -348,13 +347,13 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]]
-- but remember to use the signedness from the widening, just in case
-- the final conversion is a widen.
| rep1 < rep2 && rep2 > rep3 ->
Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x]
Just $ cmmMachOpFold dflags (intconv signed1 rep1 rep3) [x]
-- Nested widenings: collapse if the signedness is the same
| rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
Just $ cmmMachOpFold platform (intconv signed1 rep1 rep3) [x]
Just $ cmmMachOpFold dflags (intconv signed1 rep1 rep3) [x]
-- Nested narrowings: collapse
| rep1 > rep2 && rep2 > rep3 ->
Just $ cmmMachOpFold platform (MO_UU_Conv rep1 rep3) [x]
Just $ cmmMachOpFold dflags (MO_UU_Conv rep1 rep3) [x]
| otherwise ->
Nothing
where
......@@ -371,22 +370,22 @@ cmmMachOpFoldM platform conv_outer [CmmMachOp conv_inner [x]]
-- but what if the architecture only supports word-sized loads, should
-- we do the transformation anyway?
cmmMachOpFoldM _ mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
cmmMachOpFoldM dflags mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
= case mop of
-- for comparisons: don't forget to narrow the arguments before
-- comparing, since they might be out of range.
MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) wordWidth)
MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) wordWidth)
MO_Eq _ -> Just $ CmmLit (CmmInt (if x_u == y_u then 1 else 0) (wordWidth dflags))
MO_Ne _ -> Just $ CmmLit (CmmInt (if x_u /= y_u then 1 else 0) (wordWidth dflags))
MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) wordWidth)
MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) wordWidth)
MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) wordWidth)
MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) wordWidth)
MO_U_Gt _ -> Just $ CmmLit (CmmInt (if x_u > y_u then 1 else 0) (wordWidth dflags))
MO_U_Ge _ -> Just $ CmmLit (CmmInt (if x_u >= y_u then 1 else 0) (wordWidth dflags))
MO_U_Lt _ -> Just $ CmmLit (CmmInt (if x_u < y_u then 1 else 0) (wordWidth dflags))
MO_U_Le _ -> Just $ CmmLit (CmmInt (if x_u <= y_u then 1 else 0) (wordWidth dflags))
MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) wordWidth)
MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) wordWidth)
MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) wordWidth)
MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) wordWidth)
MO_S_Gt _ -> Just $ CmmLit (CmmInt (if x_s > y_s then 1 else 0) (wordWidth dflags))
MO_S_Ge _ -> Just $ CmmLit (CmmInt (if x_s >= y_s then 1 else 0) (wordWidth dflags))
MO_S_Lt _ -> Just $ CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth dflags))
MO_S_Le _ -> Just $ CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth dflags))
MO_Add r -> Just $ CmmLit (CmmInt (x + y) r)
MO_Sub r -> Just $ CmmLit (CmmInt (x - y) r)
......@@ -418,9 +417,9 @@ cmmMachOpFoldM _ mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
-- also assume that constants have been shifted to the right when
-- possible.
cmmMachOpFoldM platform op [x@(CmmLit _), y]
cmmMachOpFoldM dflags op [x@(CmmLit _), y]
| not (isLit y) && isCommutableMachOp op
= Just (cmmMachOpFold platform op [y, x])
= Just (cmmMachOpFold dflags op [y, x])
-- Turn (a+b)+c into a+(b+c) where possible. Because literals are
-- moved to the right, it is more likely that we will find
......@@ -438,19 +437,19 @@ cmmMachOpFoldM platform op [x@(CmmLit _), y]
-- Also don't do it if arg1 is PicBaseReg, so that we don't separate the
-- PicBaseReg from the corresponding label (or label difference).
--
cmmMachOpFoldM platform mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
cmmMachOpFoldM dflags mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
| mop2 `associates_with` mop1