diff options
Diffstat (limited to 'compiler/GHC/Cmm/Utils.hs')
| -rw-r--r-- | compiler/GHC/Cmm/Utils.hs | 259 |
1 files changed, 133 insertions, 126 deletions
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs index 53a1f095f8..4071bda9d5 100644 --- a/compiler/GHC/Cmm/Utils.hs +++ b/compiler/GHC/Cmm/Utils.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs, RankNTypes #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -75,6 +76,7 @@ import GhcPrelude import GHC.Core.TyCon ( PrimRep(..), PrimElemRep(..) ) import GHC.Types.RepType ( UnaryType, SlotTy (..), typePrimRep1 ) +import GHC.Platform import GHC.Runtime.Heap.Layout import GHC.Cmm import GHC.Cmm.BlockId @@ -98,31 +100,33 @@ import GHC.Cmm.Dataflow.Collections -- --------------------------------------------------- -primRepCmmType :: DynFlags -> PrimRep -> CmmType -primRepCmmType _ VoidRep = panic "primRepCmmType:VoidRep" -primRepCmmType dflags LiftedRep = gcWord dflags -primRepCmmType dflags UnliftedRep = gcWord dflags -primRepCmmType dflags IntRep = bWord dflags -primRepCmmType dflags WordRep = bWord dflags -primRepCmmType _ Int8Rep = b8 -primRepCmmType _ Word8Rep = b8 -primRepCmmType _ Int16Rep = b16 -primRepCmmType _ Word16Rep = b16 -primRepCmmType _ Int32Rep = b32 -primRepCmmType _ Word32Rep = b32 -primRepCmmType _ Int64Rep = b64 -primRepCmmType _ Word64Rep = b64 -primRepCmmType dflags AddrRep = bWord dflags -primRepCmmType _ FloatRep = f32 -primRepCmmType _ DoubleRep = f64 -primRepCmmType _ (VecRep len rep) = vec len (primElemRepCmmType rep) - -slotCmmType :: DynFlags -> SlotTy -> CmmType -slotCmmType dflags PtrSlot = gcWord dflags -slotCmmType dflags WordSlot = bWord dflags -slotCmmType _ Word64Slot = b64 -slotCmmType _ FloatSlot = f32 -slotCmmType _ DoubleSlot = f64 +primRepCmmType :: Platform -> PrimRep -> CmmType +primRepCmmType platform = \case + VoidRep -> panic "primRepCmmType:VoidRep" + LiftedRep -> gcWord platform + UnliftedRep -> gcWord platform + IntRep -> bWord platform + WordRep -> bWord platform + Int8Rep -> b8 + Word8Rep -> b8 + Int16Rep -> b16 + Word16Rep -> b16 + Int32Rep -> b32 + Word32Rep -> b32 + Int64Rep -> b64 + Word64Rep -> b64 + AddrRep -> bWord platform + FloatRep -> f32 + DoubleRep -> f64 + (VecRep len rep) -> vec len (primElemRepCmmType rep) + +slotCmmType :: Platform -> SlotTy -> CmmType +slotCmmType platform = \case + PtrSlot -> gcWord platform + WordSlot -> bWord platform + Word64Slot -> b64 + FloatSlot -> f32 + DoubleSlot -> f64 primElemRepCmmType :: PrimElemRep -> CmmType primElemRepCmmType Int8ElemRep = b8 @@ -136,8 +140,8 @@ primElemRepCmmType Word64ElemRep = b64 primElemRepCmmType FloatElemRep = f32 primElemRepCmmType DoubleElemRep = f64 -typeCmmType :: DynFlags -> UnaryType -> CmmType -typeCmmType dflags ty = primRepCmmType dflags (typePrimRep1 ty) +typeCmmType :: Platform -> UnaryType -> CmmType +typeCmmType platform ty = primRepCmmType platform (typePrimRep1 ty) primRepForeignHint :: PrimRep -> ForeignHint primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep" @@ -176,20 +180,20 @@ typeForeignHint = primRepForeignHint . typePrimRep1 -- XXX: should really be Integer, since Int doesn't necessarily cover -- the full range of target Ints. -mkIntCLit :: DynFlags -> Int -> CmmLit -mkIntCLit dflags i = CmmInt (toInteger i) (wordWidth dflags) +mkIntCLit :: Platform -> Int -> CmmLit +mkIntCLit platform i = CmmInt (toInteger i) (wordWidth platform) -mkIntExpr :: DynFlags -> Int -> CmmExpr -mkIntExpr dflags i = CmmLit $! mkIntCLit dflags i +mkIntExpr :: Platform -> Int -> CmmExpr +mkIntExpr platform i = CmmLit $! mkIntCLit platform i -zeroCLit :: DynFlags -> CmmLit -zeroCLit dflags = CmmInt 0 (wordWidth dflags) +zeroCLit :: Platform -> CmmLit +zeroCLit platform = CmmInt 0 (wordWidth platform) -zeroExpr :: DynFlags -> CmmExpr -zeroExpr dflags = CmmLit (zeroCLit dflags) +zeroExpr :: Platform -> CmmExpr +zeroExpr platform = CmmLit (zeroCLit platform) -mkWordCLit :: DynFlags -> Integer -> CmmLit -mkWordCLit dflags wd = CmmInt wd (wordWidth dflags) +mkWordCLit :: Platform -> Integer -> CmmLit +mkWordCLit platform wd = CmmInt wd (wordWidth platform) mkByteStringCLit :: CLabel -> ByteString -> (CmmLit, GenCmmDecl RawCmmStatics info stmt) @@ -218,8 +222,8 @@ mkRODataLits lbl lits needsRelocation (CmmLabelOff _ _) = True needsRelocation _ = False -mkStgWordCLit :: DynFlags -> StgWord -> CmmLit -mkStgWordCLit dflags wd = CmmInt (fromStgWord wd) (wordWidth dflags) +mkStgWordCLit :: Platform -> StgWord -> CmmLit +mkStgWordCLit platform wd = CmmInt (fromStgWord wd) (wordWidth platform) packHalfWordsCLit :: DynFlags -> StgHalfWord -> StgHalfWord -> CmmLit -- Make a single word literal in which the lower_half_word is @@ -229,10 +233,11 @@ packHalfWordsCLit :: DynFlags -> StgHalfWord -> StgHalfWord -> CmmLit -- but be careful: that's vulnerable when reversed packHalfWordsCLit dflags lower_half_word upper_half_word = if wORDS_BIGENDIAN dflags - then mkWordCLit dflags ((l `shiftL` halfWordSizeInBits dflags) .|. u) - else mkWordCLit dflags (l .|. (u `shiftL` halfWordSizeInBits dflags)) + then mkWordCLit platform ((l `shiftL` halfWordSizeInBits platform) .|. u) + else mkWordCLit platform (l .|. (u `shiftL` halfWordSizeInBits platform)) where l = fromStgHalfWord lower_half_word u = fromStgHalfWord upper_half_word + platform = targetPlatform dflags --------------------------------------------------- -- @@ -243,26 +248,23 @@ packHalfWordsCLit dflags lower_half_word upper_half_word mkLblExpr :: CLabel -> CmmExpr mkLblExpr lbl = CmmLit (CmmLabel lbl) -cmmOffsetExpr :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr +cmmOffsetExpr :: Platform -> CmmExpr -> CmmExpr -> CmmExpr -- assumes base and offset have the same CmmType -cmmOffsetExpr dflags e (CmmLit (CmmInt n _)) = cmmOffset dflags e (fromInteger n) -cmmOffsetExpr dflags e byte_off = CmmMachOp (MO_Add (cmmExprWidth dflags e)) [e, byte_off] - -cmmOffset :: DynFlags -> CmmExpr -> Int -> CmmExpr -cmmOffset _ e 0 = e -cmmOffset _ (CmmReg reg) byte_off = cmmRegOff reg byte_off -cmmOffset _ (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off) -cmmOffset _ (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off) -cmmOffset _ (CmmStackSlot area off) byte_off - = CmmStackSlot area (off - byte_off) +cmmOffsetExpr platform e (CmmLit (CmmInt n _)) = cmmOffset platform e (fromInteger n) +cmmOffsetExpr platform e byte_off = CmmMachOp (MO_Add (cmmExprWidth platform e)) [e, byte_off] + +cmmOffset :: Platform -> CmmExpr -> Int -> CmmExpr +cmmOffset _platform e 0 = e +cmmOffset platform e byte_off = case e of + CmmReg reg -> cmmRegOff reg byte_off + CmmRegOff reg m -> cmmRegOff reg (m+byte_off) + CmmLit lit -> CmmLit (cmmOffsetLit lit byte_off) + CmmStackSlot area off -> CmmStackSlot area (off - byte_off) -- note stack area offsets increase towards lower addresses -cmmOffset _ (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2 - = CmmMachOp (MO_Add rep) - [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)] -cmmOffset dflags expr byte_off - = CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)] - where - width = cmmExprWidth dflags expr + CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)] + -> CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off) rep)] + _ -> CmmMachOp (MO_Add width) [e, CmmLit (CmmInt (toInteger byte_off) width)] + where width = cmmExprWidth platform e -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above. cmmRegOff :: CmmReg -> Int -> CmmExpr @@ -284,37 +286,37 @@ cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off -- | Useful for creating an index into an array, with a statically known offset. -- The type is the element type; used for making the multiplier -cmmIndex :: DynFlags +cmmIndex :: Platform -> Width -- Width w -> CmmExpr -- Address of vector of items of width w -> Int -- Which element of the vector (0 based) -> CmmExpr -- Address of i'th element -cmmIndex dflags width base idx = cmmOffset dflags base (idx * widthInBytes width) +cmmIndex platform width base idx = cmmOffset platform base (idx * widthInBytes width) -- | Useful for creating an index into an array, with an unknown offset. -cmmIndexExpr :: DynFlags +cmmIndexExpr :: Platform -> Width -- Width w -> CmmExpr -- Address of vector of items of width w -> CmmExpr -- Which element of the vector (0 based) -> CmmExpr -- Address of i'th element -cmmIndexExpr dflags width base (CmmLit (CmmInt n _)) = cmmIndex dflags width base (fromInteger n) -cmmIndexExpr dflags width base idx = - cmmOffsetExpr dflags base byte_off +cmmIndexExpr platform width base (CmmLit (CmmInt n _)) = cmmIndex platform width base (fromInteger n) +cmmIndexExpr platform width base idx = + cmmOffsetExpr platform base byte_off where - idx_w = cmmExprWidth dflags idx - byte_off = CmmMachOp (MO_Shl idx_w) [idx, mkIntExpr dflags (widthInLog width)] + idx_w = cmmExprWidth platform idx + byte_off = CmmMachOp (MO_Shl idx_w) [idx, mkIntExpr platform (widthInLog width)] -cmmLoadIndex :: DynFlags -> CmmType -> CmmExpr -> Int -> CmmExpr -cmmLoadIndex dflags ty expr ix = CmmLoad (cmmIndex dflags (typeWidth ty) expr ix) ty +cmmLoadIndex :: Platform -> CmmType -> CmmExpr -> Int -> CmmExpr +cmmLoadIndex platform ty expr ix = CmmLoad (cmmIndex platform (typeWidth ty) expr ix) ty -- The "B" variants take byte offsets cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr cmmRegOffB = cmmRegOff -cmmOffsetB :: DynFlags -> CmmExpr -> ByteOff -> CmmExpr +cmmOffsetB :: Platform -> CmmExpr -> ByteOff -> CmmExpr cmmOffsetB = cmmOffset -cmmOffsetExprB :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr +cmmOffsetExprB :: Platform -> CmmExpr -> CmmExpr -> CmmExpr cmmOffsetExprB = cmmOffsetExpr cmmLabelOffB :: CLabel -> ByteOff -> CmmLit @@ -326,25 +328,25 @@ cmmOffsetLitB = cmmOffsetLit ----------------------- -- The "W" variants take word offsets -cmmOffsetExprW :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr +cmmOffsetExprW :: Platform -> CmmExpr -> CmmExpr -> CmmExpr -- The second arg is a *word* offset; need to change it to bytes -cmmOffsetExprW dflags e (CmmLit (CmmInt n _)) = cmmOffsetW dflags e (fromInteger n) -cmmOffsetExprW dflags e wd_off = cmmIndexExpr dflags (wordWidth dflags) e wd_off +cmmOffsetExprW platform e (CmmLit (CmmInt n _)) = cmmOffsetW platform e (fromInteger n) +cmmOffsetExprW platform e wd_off = cmmIndexExpr platform (wordWidth platform) e wd_off -cmmOffsetW :: DynFlags -> CmmExpr -> WordOff -> CmmExpr -cmmOffsetW dflags e n = cmmOffsetB dflags e (wordsToBytes dflags n) +cmmOffsetW :: Platform -> CmmExpr -> WordOff -> CmmExpr +cmmOffsetW platform e n = cmmOffsetB platform e (wordsToBytes platform n) -cmmRegOffW :: DynFlags -> CmmReg -> WordOff -> CmmExpr -cmmRegOffW dflags reg wd_off = cmmRegOffB reg (wordsToBytes dflags wd_off) +cmmRegOffW :: Platform -> CmmReg -> WordOff -> CmmExpr +cmmRegOffW platform reg wd_off = cmmRegOffB reg (wordsToBytes platform wd_off) -cmmOffsetLitW :: DynFlags -> CmmLit -> WordOff -> CmmLit -cmmOffsetLitW dflags lit wd_off = cmmOffsetLitB lit (wordsToBytes dflags wd_off) +cmmOffsetLitW :: Platform -> CmmLit -> WordOff -> CmmLit +cmmOffsetLitW platform lit wd_off = cmmOffsetLitB lit (wordsToBytes platform wd_off) -cmmLabelOffW :: DynFlags -> CLabel -> WordOff -> CmmLit -cmmLabelOffW dflags lbl wd_off = cmmLabelOffB lbl (wordsToBytes dflags wd_off) +cmmLabelOffW :: Platform -> CLabel -> WordOff -> CmmLit +cmmLabelOffW platform lbl wd_off = cmmLabelOffB lbl (wordsToBytes platform wd_off) -cmmLoadIndexW :: DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr -cmmLoadIndexW dflags base off ty = CmmLoad (cmmOffsetW dflags base off) ty +cmmLoadIndexW :: Platform -> CmmExpr -> Int -> CmmType -> CmmExpr +cmmLoadIndexW platform base off ty = CmmLoad (cmmOffsetW platform base off) ty ----------------------- cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord, @@ -352,39 +354,41 @@ cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord, cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord, cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord - :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr -cmmOrWord dflags e1 e2 = CmmMachOp (mo_wordOr dflags) [e1, e2] -cmmAndWord dflags e1 e2 = CmmMachOp (mo_wordAnd dflags) [e1, e2] -cmmNeWord dflags e1 e2 = CmmMachOp (mo_wordNe dflags) [e1, e2] -cmmEqWord dflags e1 e2 = CmmMachOp (mo_wordEq dflags) [e1, e2] -cmmULtWord dflags e1 e2 = CmmMachOp (mo_wordULt dflags) [e1, e2] -cmmUGeWord dflags e1 e2 = CmmMachOp (mo_wordUGe dflags) [e1, e2] -cmmUGtWord dflags e1 e2 = CmmMachOp (mo_wordUGt dflags) [e1, e2] -cmmSLtWord dflags e1 e2 = CmmMachOp (mo_wordSLt dflags) [e1, e2] -cmmUShrWord dflags e1 e2 = CmmMachOp (mo_wordUShr dflags) [e1, e2] -cmmAddWord dflags e1 e2 = CmmMachOp (mo_wordAdd dflags) [e1, e2] -cmmSubWord dflags e1 e2 = CmmMachOp (mo_wordSub dflags) [e1, e2] -cmmMulWord dflags e1 e2 = CmmMachOp (mo_wordMul dflags) [e1, e2] -cmmQuotWord dflags e1 e2 = CmmMachOp (mo_wordUQuot dflags) [e1, e2] - -cmmNegate :: DynFlags -> CmmExpr -> CmmExpr -cmmNegate _ (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep) -cmmNegate dflags e = CmmMachOp (MO_S_Neg (cmmExprWidth dflags e)) [e] - -blankWord :: DynFlags -> CmmStatic -blankWord dflags = CmmUninitialised (wORD_SIZE dflags) - -cmmToWord :: DynFlags -> CmmExpr -> CmmExpr -cmmToWord dflags e + :: Platform -> CmmExpr -> CmmExpr -> CmmExpr +cmmOrWord platform e1 e2 = CmmMachOp (mo_wordOr platform) [e1, e2] +cmmAndWord platform e1 e2 = CmmMachOp (mo_wordAnd platform) [e1, e2] +cmmNeWord platform e1 e2 = CmmMachOp (mo_wordNe platform) [e1, e2] +cmmEqWord platform e1 e2 = CmmMachOp (mo_wordEq platform) [e1, e2] +cmmULtWord platform e1 e2 = CmmMachOp (mo_wordULt platform) [e1, e2] +cmmUGeWord platform e1 e2 = CmmMachOp (mo_wordUGe platform) [e1, e2] +cmmUGtWord platform e1 e2 = CmmMachOp (mo_wordUGt platform) [e1, e2] +cmmSLtWord platform e1 e2 = CmmMachOp (mo_wordSLt platform) [e1, e2] +cmmUShrWord platform e1 e2 = CmmMachOp (mo_wordUShr platform) [e1, e2] +cmmAddWord platform e1 e2 = CmmMachOp (mo_wordAdd platform) [e1, e2] +cmmSubWord platform e1 e2 = CmmMachOp (mo_wordSub platform) [e1, e2] +cmmMulWord platform e1 e2 = CmmMachOp (mo_wordMul platform) [e1, e2] +cmmQuotWord platform e1 e2 = CmmMachOp (mo_wordUQuot platform) [e1, e2] + +cmmNegate :: Platform -> CmmExpr -> CmmExpr +cmmNegate platform = \case + (CmmLit (CmmInt n rep)) + -> CmmLit (CmmInt (-n) rep) + e -> CmmMachOp (MO_S_Neg (cmmExprWidth platform e)) [e] + +blankWord :: Platform -> CmmStatic +blankWord platform = CmmUninitialised (platformWordSizeInBytes platform) + +cmmToWord :: Platform -> CmmExpr -> CmmExpr +cmmToWord platform e | w == word = e | otherwise = CmmMachOp (MO_UU_Conv w word) [e] where - w = cmmExprWidth dflags e - word = wordWidth dflags + w = cmmExprWidth platform e + word = wordWidth platform -cmmMkAssign :: DynFlags -> CmmExpr -> Unique -> (CmmNode O O, CmmExpr) -cmmMkAssign dflags expr uq = - let !ty = cmmExprType dflags expr +cmmMkAssign :: Platform -> CmmExpr -> Unique -> (CmmNode O O, CmmExpr) +cmmMkAssign platform expr uq = + let !ty = cmmExprType platform expr reg = (CmmLocal (LocalReg uq ty)) in (CmmAssign reg expr, CmmReg reg) @@ -427,21 +431,24 @@ isComparisonExpr _ = False -- Tag bits mask cmmTagMask, cmmPointerMask :: DynFlags -> CmmExpr -cmmTagMask dflags = mkIntExpr dflags (tAG_MASK dflags) -cmmPointerMask dflags = mkIntExpr dflags (complement (tAG_MASK dflags)) +cmmTagMask dflags = mkIntExpr (targetPlatform dflags) (tAG_MASK dflags) +cmmPointerMask dflags = mkIntExpr (targetPlatform dflags) (complement (tAG_MASK dflags)) -- Used to untag a possibly tagged pointer -- A static label need not be untagged cmmUntag, cmmIsTagged, cmmConstrTag1 :: DynFlags -> CmmExpr -> CmmExpr cmmUntag _ e@(CmmLit (CmmLabel _)) = e -- Default case -cmmUntag dflags e = cmmAndWord dflags e (cmmPointerMask dflags) +cmmUntag dflags e = cmmAndWord platform e (cmmPointerMask dflags) + where platform = targetPlatform dflags -- Test if a closure pointer is untagged -cmmIsTagged dflags e = cmmNeWord dflags (cmmAndWord dflags e (cmmTagMask dflags)) (zeroExpr dflags) +cmmIsTagged dflags e = cmmNeWord platform (cmmAndWord platform e (cmmTagMask dflags)) (zeroExpr platform) + where platform = targetPlatform dflags -- Get constructor tag, but one based. -cmmConstrTag1 dflags e = cmmAndWord dflags e (cmmTagMask dflags) +cmmConstrTag1 dflags e = cmmAndWord platform e (cmmTagMask dflags) + where platform = targetPlatform dflags ----------------------------------------------------------------------------- @@ -451,10 +458,10 @@ cmmConstrTag1 dflags e = cmmAndWord dflags e (cmmTagMask dflags) -- platform, in the sense that writing to one will clobber the -- other. This includes the case that the two registers are the same -- STG register. See Note [Overlapping global registers] for details. -regsOverlap :: DynFlags -> CmmReg -> CmmReg -> Bool -regsOverlap dflags (CmmGlobal g) (CmmGlobal g') - | Just real <- globalRegMaybe (targetPlatform dflags) g, - Just real' <- globalRegMaybe (targetPlatform dflags) g', +regsOverlap :: Platform -> CmmReg -> CmmReg -> Bool +regsOverlap platform (CmmGlobal g) (CmmGlobal g') + | Just real <- globalRegMaybe platform g, + Just real' <- globalRegMaybe platform g', real == real' = True regsOverlap _ reg reg' = reg == reg' @@ -467,12 +474,12 @@ regsOverlap _ reg reg' = reg == reg' -- registers here, otherwise CmmSink may incorrectly reorder -- assignments that conflict due to overlap. See #10521 and Note -- [Overlapping global registers]. -regUsedIn :: DynFlags -> CmmReg -> CmmExpr -> Bool -regUsedIn dflags = regUsedIn_ where +regUsedIn :: Platform -> CmmReg -> CmmExpr -> Bool +regUsedIn platform = regUsedIn_ where _ `regUsedIn_` CmmLit _ = False reg `regUsedIn_` CmmLoad e _ = reg `regUsedIn_` e - reg `regUsedIn_` CmmReg reg' = regsOverlap dflags reg reg' - reg `regUsedIn_` CmmRegOff reg' _ = regsOverlap dflags reg reg' + reg `regUsedIn_` CmmReg reg' = regsOverlap platform reg reg' + reg `regUsedIn_` CmmRegOff reg' _ = regsOverlap platform reg reg' reg `regUsedIn_` CmmMachOp _ es = any (reg `regUsedIn_`) es _ `regUsedIn_` CmmStackSlot _ _ = False |