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

Pass DynFlags down to wordWidth

parent 44b5f471
...@@ -33,6 +33,7 @@ import CLabel ...@@ -33,6 +33,7 @@ import CLabel
import Cmm import Cmm
import CmmUtils import CmmUtils
import Data.List import Data.List
import DynFlags
import Maybes import Maybes
import Module import Module
import Outputable import Outputable
...@@ -166,17 +167,17 @@ srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)] ...@@ -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, -- 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 -- 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. -- bitmap will be able to cover all of them.
buildSRT :: TopSRT -> CAFSet -> UniqSM (TopSRT, Maybe CmmDecl, C_SRT) buildSRT :: DynFlags -> TopSRT -> CAFSet -> UniqSM (TopSRT, Maybe CmmDecl, C_SRT)
buildSRT topSRT cafs = buildSRT dflags topSRT cafs =
do let do let
-- For each label referring to a function f without a static closure, -- For each label referring to a function f without a static closure,
-- replace it with the CAFs that are reachable from f. -- replace it with the CAFs that are reachable from f.
sub_srt topSRT localCafs = sub_srt topSRT localCafs =
let cafs = Set.elems localCafs let cafs = Set.elems localCafs
mkSRT topSRT = mkSRT topSRT =
do localSRTs <- procpointSRT (lbl topSRT) (elt_map topSRT) cafs do localSRTs <- procpointSRT dflags (lbl topSRT) (elt_map topSRT) cafs
return (topSRT, localSRTs) return (topSRT, localSRTs)
in if length cafs > maxBmpSize then in if length cafs > maxBmpSize dflags then
mkSRT (foldl add_if_missing topSRT cafs) mkSRT (foldl add_if_missing topSRT cafs)
else -- make sure all the cafs are near the bottom of the srt else -- make sure all the cafs are near the bottom of the srt
mkSRT (add_if_too_far topSRT cafs) mkSRT (add_if_too_far topSRT cafs)
...@@ -196,7 +197,7 @@ buildSRT topSRT cafs = ...@@ -196,7 +197,7 @@ buildSRT topSRT cafs =
add srt [] = srt add srt [] = srt
add srt@(TopSRT {next_elt = next}) (caf : rst) = add srt@(TopSRT {next_elt = next}) (caf : rst) =
case cafOffset srt caf of 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 add (addCAF caf srt) rst
else srt else srt
Nothing -> add (addCAF caf srt) rst Nothing -> add (addCAF caf srt) rst
...@@ -206,12 +207,12 @@ buildSRT topSRT cafs = ...@@ -206,12 +207,12 @@ buildSRT topSRT cafs =
-- Construct an SRT bitmap. -- Construct an SRT bitmap.
-- Adapted from simpleStg/SRT.lhs, which expects Id's. -- 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) UniqSM (Maybe CmmDecl, C_SRT)
procpointSRT _ _ [] = procpointSRT _ _ _ [] =
return (Nothing, NoC_SRT) return (Nothing, NoC_SRT)
procpointSRT top_srt top_table entries = procpointSRT dflags top_srt top_table entries =
do (top, srt) <- bitmap `seq` to_SRT top_srt offset len bitmap do (top, srt) <- bitmap `seq` to_SRT dflags top_srt offset len bitmap
return (top, srt) return (top, srt)
where where
ints = map (expectJust "constructSRT" . flip Map.lookup top_table) entries ints = map (expectJust "constructSRT" . flip Map.lookup top_table) entries
...@@ -221,20 +222,20 @@ procpointSRT top_srt top_table entries = ...@@ -221,20 +222,20 @@ procpointSRT top_srt top_table entries =
len = P.last bitmap_entries + 1 len = P.last bitmap_entries + 1
bitmap = intsToBitmap len bitmap_entries bitmap = intsToBitmap len bitmap_entries
maxBmpSize :: Int maxBmpSize :: DynFlags -> Int
maxBmpSize = widthInBits wordWidth `div` 2 maxBmpSize dflags = widthInBits (wordWidth dflags) `div` 2
-- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT. -- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT.
to_SRT :: CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT) to_SRT :: DynFlags -> CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT)
to_SRT top_srt off len bmp to_SRT dflags top_srt off len bmp
| len > maxBmpSize || bmp == [fromIntegral srt_escape] | len > maxBmpSize dflags || bmp == [fromIntegral srt_escape]
= do id <- getUniqueM = do id <- getUniqueM
let srt_desc_lbl = mkLargeSRTLabel id let srt_desc_lbl = mkLargeSRTLabel id
tbl = CmmData RelocatableReadOnlyData $ tbl = CmmData RelocatableReadOnlyData $
Statics srt_desc_lbl $ map CmmStaticLit Statics srt_desc_lbl $ map CmmStaticLit
( cmmLabelOffW top_srt off ( cmmLabelOffW top_srt off
: mkWordCLit (fromIntegral len) : mkWordCLit dflags (fromIntegral len)
: map mkWordCLit bmp) : map (mkWordCLit dflags) bmp)
return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape) return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape)
| otherwise | otherwise
= return (Nothing, C_SRT top_srt off (fromIntegral (head bmp))) = return (Nothing, C_SRT top_srt off (fromIntegral (head bmp)))
...@@ -318,11 +319,12 @@ flattenCAFSets cpsdecls = zipWith (bundle flatmap) zipped localCAFs ...@@ -318,11 +319,12 @@ flattenCAFSets cpsdecls = zipWith (bundle flatmap) zipped localCAFs
localCAFs = unzipWith localCAFInfo zipped localCAFs = unzipWith localCAFInfo zipped
flatmap = mkTopCAFInfo localCAFs -- transitive closure of localCAFs flatmap = mkTopCAFInfo localCAFs -- transitive closure of localCAFs
doSRTs :: TopSRT doSRTs :: DynFlags
-> TopSRT
-> [(CAFEnv, [CmmDecl])] -> [(CAFEnv, [CmmDecl])]
-> IO (TopSRT, [CmmDecl]) -> IO (TopSRT, [CmmDecl])
doSRTs topSRT tops doSRTs dflags topSRT tops
= do = do
let caf_decls = flattenCAFSets tops let caf_decls = flattenCAFSets tops
us <- mkSplitUniqSupply 'u' us <- mkSplitUniqSupply 'u'
...@@ -330,19 +332,19 @@ doSRTs topSRT tops ...@@ -330,19 +332,19 @@ doSRTs topSRT tops
return (topSRT', reverse gs' {- Note [reverse gs] -}) return (topSRT', reverse gs' {- Note [reverse gs] -})
where where
setSRT (topSRT, rst) (caf_map, decl@(CmmProc{})) = do 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 let decl' = updInfoSRTs srt_env decl
return (topSRT, decl': srt_tables ++ rst) return (topSRT, decl': srt_tables ++ rst)
setSRT (topSRT, rst) (_, decl) = setSRT (topSRT, rst) (_, decl) =
return (topSRT, decl : rst) return (topSRT, decl : rst)
buildSRTs :: TopSRT -> BlockEnv CAFSet buildSRTs :: DynFlags -> TopSRT -> BlockEnv CAFSet
-> UniqSM (TopSRT, [CmmDecl], BlockEnv C_SRT) -> 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) = foldM doOne (top_srt, [], mapEmpty) (mapToList caf_map)
where where
doOne (top_srt, decls, srt_env) (l, cafs) 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 return ( top_srt, maybeToList mb_decl ++ decls
, mapInsert l srt srt_env ) , mapInsert l srt srt_env )
......
...@@ -78,9 +78,9 @@ assignArgumentsPos dflags conv arg_ty reps = assignments ...@@ -78,9 +78,9 @@ assignArgumentsPos dflags conv arg_ty reps = assignments
_ -> (assts, (r:rs)) _ -> (assts, (r:rs))
int = case (w, regs) of int = case (w, regs) of
(W128, _) -> panic "W128 unsupported register type" (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)) -> 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)) -> k (RegisterParam l, (vs, fs, ds, ls))
_ -> (assts, (r:rs)) _ -> (assts, (r:rs))
k (asst, regs') = assign_regs ((r, asst) : assts) rs regs' k (asst, regs') = assign_regs ((r, asst) : assts) rs regs'
......
...@@ -114,8 +114,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks) ...@@ -114,8 +114,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
-- Use a zero place-holder in place of the -- Use a zero place-holder in place of the
-- entry-label in the info table -- entry-label in the info table
return (top_decls ++ return (top_decls ++
[mkRODataLits info_lbl (zeroCLit : rel_std_info ++ [mkRODataLits info_lbl (zeroCLit dflags : rel_std_info ++
rel_extra_bits)]) rel_extra_bits)])
_nonempty -> _nonempty ->
-- Separately emit info table (with the function entry -- Separately emit info table (with the function entry
-- point as first entry) and the entry code -- point as first entry) and the entry code
...@@ -172,9 +172,9 @@ mkInfoTableContents dflags ...@@ -172,9 +172,9 @@ mkInfoTableContents dflags
-- (which in turn came from a handwritten .cmm file) -- (which in turn came from a handwritten .cmm file)
| StackRep frame <- smrep | 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 ; let (srt_label, srt_bitmap) = mkSRTLit srt
; (liveness_lit, liveness_data) <- mkLivenessBits frame ; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame
; let ; let
std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
rts_tag | Just tag <- mb_rts_tag = tag rts_tag | Just tag <- mb_rts_tag = tag
...@@ -184,8 +184,8 @@ mkInfoTableContents dflags ...@@ -184,8 +184,8 @@ mkInfoTableContents dflags
; return (prof_data ++ liveness_data, (std_info, srt_label)) } ; return (prof_data ++ liveness_data, (std_info, srt_label)) }
| HeapRep _ ptrs nonptrs closure_type <- smrep | HeapRep _ ptrs nonptrs closure_type <- smrep
= do { let layout = packHalfWordsCLit ptrs nonptrs = do { let layout = packHalfWordsCLit dflags ptrs nonptrs
; (prof_lits, prof_data) <- mkProfLits prof ; (prof_lits, prof_data) <- mkProfLits dflags prof
; let (srt_label, srt_bitmap) = mkSRTLit srt ; let (srt_label, srt_bitmap) = mkSRTLit srt
; (mb_srt_field, mb_layout, extra_bits, ct_data) ; (mb_srt_field, mb_layout, extra_bits, ct_data)
<- mk_pieces closure_type srt_label <- mk_pieces closure_type srt_label
...@@ -208,24 +208,24 @@ mkInfoTableContents dflags ...@@ -208,24 +208,24 @@ mkInfoTableContents dflags
= return (Nothing, Nothing, srt_label, []) = return (Nothing, Nothing, srt_label, [])
mk_pieces (ThunkSelector offset) _no_srt 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 -- Layout known (one free var); we use the layout field for offset
mk_pieces (Fun arity (ArgSpec fun_type)) srt_label 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, []) } ; return (Nothing, Nothing, extra_bits, []) }
mk_pieces (Fun arity (ArgGen arg_bits)) srt_label 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 ; let fun_type | null liveness_data = aRG_GEN
| otherwise = aRG_GEN_BIG | otherwise = aRG_GEN_BIG
extra_bits = [ packHalfWordsCLit fun_type arity extra_bits = [ packHalfWordsCLit dflags fun_type arity
, srt_lit, liveness_lit, slow_entry ] , srt_lit, liveness_lit, slow_entry ]
; return (Nothing, Nothing, extra_bits, liveness_data) } ; return (Nothing, Nothing, extra_bits, liveness_data) }
where where
slow_entry = CmmLabel (toSlowEntryLbl info_lbl) slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
srt_lit = case srt_label of srt_lit = case srt_label of
[] -> mkIntCLit 0 [] -> mkIntCLit dflags 0
(lit:_rest) -> ASSERT( null _rest ) lit (lit:_rest) -> ASSERT( null _rest ) lit
mk_pieces BlackHole _ = panic "mk_pieces: BlackHole" mk_pieces BlackHole _ = panic "mk_pieces: BlackHole"
...@@ -297,12 +297,12 @@ makeRelativeRefTo _ _ lit = lit ...@@ -297,12 +297,12 @@ makeRelativeRefTo _ _ lit = lit
-- The head of the stack layout is the top of the stack and -- The head of the stack layout is the top of the stack and
-- the least-significant bit. -- the least-significant bit.
mkLivenessBits :: Liveness -> UniqSM (CmmLit, [RawCmmDecl]) mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
-- ^ Returns: -- ^ Returns:
-- 1. The bitmap (literal value or label) -- 1. The bitmap (literal value or label)
-- 2. Large bitmap CmmData if needed -- 2. Large bitmap CmmData if needed
mkLivenessBits liveness mkLivenessBits dflags liveness
| n_bits > mAX_SMALL_BITMAP_SIZE -- does not fit in one word | n_bits > mAX_SMALL_BITMAP_SIZE -- does not fit in one word
= do { uniq <- getUniqueUs = do { uniq <- getUniqueUs
; let bitmap_lbl = mkBitmapLabel uniq ; let bitmap_lbl = mkBitmapLabel uniq
...@@ -310,7 +310,7 @@ mkLivenessBits liveness ...@@ -310,7 +310,7 @@ mkLivenessBits liveness
[mkRODataLits bitmap_lbl lits]) } [mkRODataLits bitmap_lbl lits]) }
| otherwise -- Fits in one word | otherwise -- Fits in one word
= return (mkWordCLit bitmap_word, []) = return (mkWordCLit dflags bitmap_word, [])
where where
n_bits = length liveness n_bits = length liveness
...@@ -324,7 +324,7 @@ mkLivenessBits liveness ...@@ -324,7 +324,7 @@ mkLivenessBits liveness
bitmap_word = fromIntegral n_bits bitmap_word = fromIntegral n_bits
.|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT) .|. (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 -- The first word is the size. The structure must match
-- StgLargeBitmap in includes/rts/storage/InfoTable.h -- StgLargeBitmap in includes/rts/storage/InfoTable.h
...@@ -361,7 +361,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit ...@@ -361,7 +361,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit
| dopt Opt_SccProfilingOn dflags = [type_descr, closure_descr] | dopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
| otherwise = [] | 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 ...@@ -369,9 +369,9 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit
-- --
------------------------------------------------------------------------- -------------------------------------------------------------------------
mkProfLits :: ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl]) mkProfLits :: DynFlags -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
mkProfLits NoProfilingInfo = return ((zeroCLit, zeroCLit), []) mkProfLits dflags NoProfilingInfo = return ((zeroCLit dflags, zeroCLit dflags), [])
mkProfLits (ProfilingInfo td cd) mkProfLits _ (ProfilingInfo td cd)
= do { (td_lit, td_decl) <- newStringLit td = do { (td_lit, td_decl) <- newStringLit td
; (cd_lit, cd_decl) <- newStringLit cd ; (cd_lit, cd_decl) <- newStringLit cd
; return ((td_lit,cd_lit), [td_decl,cd_decl]) } ; return ((td_lit,cd_lit), [td_decl,cd_decl]) }
......
...@@ -776,12 +776,12 @@ arguments. ...@@ -776,12 +776,12 @@ arguments.
areaToSp :: DynFlags -> ByteOff -> ByteOff -> (Area -> StackLoc) -> CmmExpr -> CmmExpr areaToSp :: DynFlags -> ByteOff -> ByteOff -> (Area -> StackLoc) -> CmmExpr -> CmmExpr
areaToSp dflags sp_old _sp_hwm area_off (CmmStackSlot area n) = areaToSp dflags sp_old _sp_hwm area_off (CmmStackSlot area n) =
cmmOffset dflags (CmmReg spReg) (sp_old - area_off area - n) cmmOffset dflags (CmmReg spReg) (sp_old - area_off area - n)
areaToSp _ _ sp_hwm _ (CmmLit CmmHighStackMark) = mkIntExpr sp_hwm areaToSp dflags _ sp_hwm _ (CmmLit CmmHighStackMark) = mkIntExpr dflags sp_hwm
areaToSp _ _ _ _ (CmmMachOp (MO_U_Lt _) -- Note [null stack check] areaToSp dflags _ _ _ (CmmMachOp (MO_U_Lt _) -- Note [null stack check]
[CmmMachOp (MO_Sub _) [CmmMachOp (MO_Sub _)
[ CmmReg (CmmGlobal Sp) [ CmmReg (CmmGlobal Sp)
, CmmLit (CmmInt 0 _)], , CmmLit (CmmInt 0 _)],
CmmReg (CmmGlobal SpLim)]) = zeroExpr CmmReg (CmmGlobal SpLim)]) = zeroExpr dflags
areaToSp _ _ _ _ other = other areaToSp _ _ _ _ other = other
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
...@@ -920,7 +920,7 @@ lowerSafeForeignCall dflags block ...@@ -920,7 +920,7 @@ lowerSafeForeignCall dflags block
load_stack <- newTemp (gcWord dflags) load_stack <- newTemp (gcWord dflags)
let suspend = saveThreadState dflags <*> let suspend = saveThreadState dflags <*>
caller_save <*> caller_save <*>
mkMiddle (callSuspendThread id intrbl) mkMiddle (callSuspendThread dflags id intrbl)
midCall = mkUnsafeCall tgt res args midCall = mkUnsafeCall tgt res args
resume = mkMiddle (callResumeThread new_base id) <*> resume = mkMiddle (callResumeThread new_base id) <*>
-- Assign the result to BaseReg: we -- Assign the result to BaseReg: we
...@@ -941,7 +941,7 @@ lowerSafeForeignCall dflags block ...@@ -941,7 +941,7 @@ lowerSafeForeignCall dflags block
jump = CmmCall { cml_target = CmmLoad (CmmReg spReg) (bWord dflags) jump = CmmCall { cml_target = CmmLoad (CmmReg spReg) (bWord dflags)
, cml_cont = Just succ , cml_cont = Just succ
, cml_args_regs = regs , cml_args_regs = regs
, cml_args = widthInBytes wordWidth , cml_args = widthInBytes (wordWidth dflags)
, cml_ret_args = ret_args , cml_ret_args = ret_args
, cml_ret_off = updfr } , cml_ret_off = updfr }
...@@ -966,12 +966,12 @@ foreignLbl name = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name)) ...@@ -966,12 +966,12 @@ foreignLbl name = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
newTemp :: CmmType -> UniqSM LocalReg newTemp :: CmmType -> UniqSM LocalReg
newTemp rep = getUniqueM >>= \u -> return (LocalReg u rep) newTemp rep = getUniqueM >>= \u -> return (LocalReg u rep)
callSuspendThread :: LocalReg -> Bool -> CmmNode O O callSuspendThread :: DynFlags -> LocalReg -> Bool -> CmmNode O O
callSuspendThread id intrbl = callSuspendThread dflags id intrbl =
CmmUnsafeForeignCall CmmUnsafeForeignCall
(ForeignTarget (foreignLbl (fsLit "suspendThread")) (ForeignTarget (foreignLbl (fsLit "suspendThread"))
(ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint])) (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 :: LocalReg -> LocalReg -> CmmNode O O
callResumeThread new_base id = callResumeThread new_base id =
......
...@@ -88,9 +88,9 @@ lintCmmExpr (CmmLoad expr rep) = do ...@@ -88,9 +88,9 @@ lintCmmExpr (CmmLoad expr rep) = do
lintCmmExpr expr@(CmmMachOp op args) = do lintCmmExpr expr@(CmmMachOp op args) = do
dflags <- getDynFlags dflags <- getDynFlags
tys <- mapM lintCmmExpr args 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 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) lintCmmExpr (CmmRegOff reg offset)
= do dflags <- getDynFlags = do dflags <- getDynFlags
let rep = typeWidth (cmmRegType dflags reg) let rep = typeWidth (cmmRegType dflags reg)
...@@ -158,9 +158,10 @@ lintCmmLast labels node = case node of ...@@ -158,9 +158,10 @@ lintCmmLast labels node = case node of
CmmBranch id -> checkTarget id CmmBranch id -> checkTarget id
CmmCondBranch e t f -> do CmmCondBranch e t f -> do
dflags <- getDynFlags
mapM_ checkTarget [t,f] mapM_ checkTarget [t,f]
_ <- lintCmmExpr e _ <- lintCmmExpr e
checkCond e checkCond dflags e
CmmSwitch e branches -> do CmmSwitch e branches -> do
dflags <- getDynFlags dflags <- getDynFlags
...@@ -190,10 +191,10 @@ lintTarget (ForeignTarget e _) = lintCmmExpr e >> return () ...@@ -190,10 +191,10 @@ lintTarget (ForeignTarget e _) = lintCmmExpr e >> return ()
lintTarget (PrimTarget {}) = return () lintTarget (PrimTarget {}) = return ()
checkCond :: CmmExpr -> CmmLint () checkCond :: DynFlags -> CmmExpr -> CmmLint ()
checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return () checkCond _ (CmmMachOp mop _) | isComparisonMachOp mop = return ()
checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values checkCond dflags (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth dflags = return () -- constant values
checkCond expr checkCond _ expr
= cmmLintErr (hang (text "expression is not a conditional:") 2 = cmmLintErr (hang (text "expression is not a conditional:") 2
(ppr expr)) (ppr expr))
......
...@@ -123,59 +123,62 @@ mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot ...@@ -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_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe
, mo_wordULe, mo_wordUGt, mo_wordULt , mo_wordULe, mo_wordUGt, mo_wordULt
, mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr , 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_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 :: MachOp
mo_wordAdd = MO_Add wordWidth mo_wordAdd dflags = MO_Add (wordWidth dflags)
mo_wordSub = MO_Sub wordWidth mo_wordSub dflags = MO_Sub (wordWidth dflags)
mo_wordEq = MO_Eq wordWidth mo_wordEq dflags = MO_Eq (wordWidth dflags)
mo_wordNe = MO_Ne wordWidth mo_wordNe dflags = MO_Ne (wordWidth dflags)
mo_wordMul = MO_Mul wordWidth mo_wordMul dflags = MO_Mul (wordWidth dflags)
mo_wordSQuot = MO_S_Quot wordWidth mo_wordSQuot dflags = MO_S_Quot (wordWidth dflags)
mo_wordSRem = MO_S_Rem wordWidth mo_wordSRem dflags = MO_S_Rem (wordWidth dflags)
mo_wordSNeg = MO_S_Neg wordWidth mo_wordSNeg dflags = MO_S_Neg (wordWidth dflags)
mo_wordUQuot = MO_U_Quot wordWidth mo_wordUQuot dflags = MO_U_Quot (wordWidth dflags)
mo_wordURem = MO_U_Rem wordWidth mo_wordURem dflags = MO_U_Rem (wordWidth dflags)
mo_wordSGe = MO_S_Ge wordWidth mo_wordSGe dflags = MO_S_Ge (wordWidth dflags)
mo_wordSLe = MO_S_Le wordWidth mo_wordSLe dflags = MO_S_Le (wordWidth dflags)
mo_wordSGt = MO_S_Gt wordWidth mo_wordSGt dflags = MO_S_Gt (wordWidth dflags)
mo_wordSLt = MO_S_Lt wordWidth mo_wordSLt dflags = MO_S_Lt (wordWidth dflags)
mo_wordUGe = MO_U_Ge wordWidth mo_wordUGe dflags = MO_U_Ge (wordWidth dflags)
mo_wordULe = MO_U_Le wordWidth mo_wordULe dflags = MO_U_Le (wordWidth dflags)
mo_wordUGt = MO_U_Gt wordWidth mo_wordUGt dflags = MO_U_Gt (wordWidth dflags)
mo_wordULt = MO_U_Lt wordWidth mo_wordULt dflags = MO_U_Lt (wordWidth dflags)
mo_wordAnd = MO_And wordWidth mo_wordAnd dflags = MO_And (wordWidth dflags)
mo_wordOr = MO_Or wordWidth mo_wordOr dflags = MO_Or (wordWidth dflags)
mo_wordXor = MO_Xor wordWidth mo_wordXor dflags = MO_Xor (wordWidth dflags)
mo_wordNot = MO_Not wordWidth mo_wordNot dflags = MO_Not (wordWidth dflags)
mo_wordShl = MO_Shl wordWidth mo_wordShl dflags = MO_Shl (wordWidth dflags)
mo_wordSShr = MO_S_Shr wordWidth mo_wordSShr dflags = MO_S_Shr (wordWidth dflags)
mo_wordUShr = MO_U_Shr wordWidth mo_wordUShr dflags = MO_U_Shr (wordWidth dflags)
mo_u_8To32 = MO_UU_Conv W8 W32 mo_u_8To32 = MO_UU_Conv W8 W32
mo_s_8To32 = MO_SS_Conv W8 W32 mo_s_8To32 = MO_SS_Conv W8 W32
mo_u_16To32 = MO_UU_Conv W16 W32 mo_u_16To32 = MO_UU_Conv W16 W32
mo_s_16To32 = MO_SS_Conv W16 W32 mo_s_16To32 = MO_SS_Conv W16 W32
mo_u_8ToWord = MO_UU_Conv W8 wordWidth mo_u_8ToWord dflags = MO_UU_Conv W8 (wordWidth dflags)
mo_s_8ToWord = MO_SS_Conv W8 wordWidth mo_s_8ToWord dflags = MO_SS_Conv W8 (wordWidth dflags)
mo_u_16ToWord = MO_UU_Conv W16 wordWidth mo_u_16ToWord dflags = MO_UU_Conv W16 (wordWidth dflags)
mo_s_16ToWord = MO_SS_Conv W16 wordWidth mo_s_16ToWord dflags = MO_SS_Conv W16 (wordWidth dflags)
mo_s_32ToWord = MO_SS_Conv W32 wordWidth mo_s_32ToWord dflags = MO_SS_Conv W32 (wordWidth dflags)
mo_u_32ToWord = MO_UU_Conv W32 wordWidth