Commit bd2de4f0 authored by Artem Pyanykh's avatar Artem Pyanykh Committed by Marge Bot

codegen: use newtype for Alignment in BasicTypes

parent af4cea7f
...@@ -26,7 +26,7 @@ module BasicTypes( ...@@ -26,7 +26,7 @@ module BasicTypes(
Arity, RepArity, JoinArity, Arity, RepArity, JoinArity,
Alignment, Alignment, mkAlignment, alignmentOf, alignmentBytes,
PromotionFlag(..), isPromoted, PromotionFlag(..), isPromoted,
FunctionOrData(..), FunctionOrData(..),
...@@ -116,6 +116,7 @@ import Outputable ...@@ -116,6 +116,7 @@ import Outputable
import SrcLoc ( Located,unLoc ) import SrcLoc ( Located,unLoc )
import Data.Data hiding (Fixity, Prefix, Infix) import Data.Data hiding (Fixity, Prefix, Infix)
import Data.Function (on) import Data.Function (on)
import Data.Bits
{- {-
************************************************************************ ************************************************************************
...@@ -196,8 +197,39 @@ fIRST_TAG = 1 ...@@ -196,8 +197,39 @@ fIRST_TAG = 1
************************************************************************ ************************************************************************
-} -}
type Alignment = Int -- align to next N-byte boundary (N must be a power of 2). -- | A power-of-two alignment
newtype Alignment = Alignment { alignmentBytes :: Int } deriving (Eq, Ord)
-- Builds an alignment, throws on non power of 2 input. This is not
-- ideal, but convenient for internal use and better then silently
-- passing incorrect data.
mkAlignment :: Int -> Alignment
mkAlignment n
| n == 1 = Alignment 1
| n == 2 = Alignment 2
| n == 4 = Alignment 4
| n == 8 = Alignment 8
| n == 16 = Alignment 16
| n == 32 = Alignment 32
| n == 64 = Alignment 64
| n == 128 = Alignment 128
| n == 256 = Alignment 256
| n == 512 = Alignment 512
| otherwise = panic "mkAlignment: received either a non power of 2 argument or > 512"
-- Calculates an alignment of a number. x is aligned at N bytes means
-- the remainder from x / N is zero. Currently, interested in N <= 8,
-- but can be expanded to N <= 16 or N <= 32 if used within SSE or AVX
-- context.
alignmentOf :: Int -> Alignment
alignmentOf x = case x .&. 7 of
0 -> Alignment 8
4 -> Alignment 4
2 -> Alignment 2
_ -> Alignment 1
instance Outputable Alignment where
ppr (Alignment m) = ppr m
{- {-
************************************************************************ ************************************************************************
* * * *
......
...@@ -2075,16 +2075,15 @@ doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr ...@@ -2075,16 +2075,15 @@ doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-> FCode () -> FCode ()
doSetByteArrayOp ba off len c = do doSetByteArrayOp ba off len c = do
dflags <- getDynFlags dflags <- getDynFlags
let maxAlign = wORD_SIZE dflags
align = minimum [maxAlign, possibleAlign]
p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off let byteArrayAlignment = wordAlignment dflags -- known since BA is allocated on heap
offsetAlignment = case off of
CmmLit (CmmInt intOff _) -> alignmentOf (fromInteger intOff)
_ -> mkAlignment 1
align = min byteArrayAlignment offsetAlignment
p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off
emitMemsetCall p c len align emitMemsetCall p c len align
where
possibleAlign = case off of
CmmLit (CmmInt intOff _) -> fromIntegral $ byteAlignment (fromIntegral intOff)
_ -> 1
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
-- Allocating arrays -- Allocating arrays
...@@ -2355,7 +2354,7 @@ emitSetCards dst_start dst_cards_start n = do ...@@ -2355,7 +2354,7 @@ emitSetCards dst_start dst_cards_start n = do
emitMemsetCall (cmmAddWord dflags dst_cards_start start_card) emitMemsetCall (cmmAddWord dflags dst_cards_start start_card)
(mkIntExpr dflags 1) (mkIntExpr dflags 1)
(cmmAddWord dflags (cmmSubWord dflags end_card start_card) (mkIntExpr dflags 1)) (cmmAddWord dflags (cmmSubWord dflags end_card start_card) (mkIntExpr dflags 1))
1 -- no alignment (1 byte) (mkAlignment 1) -- no alignment (1 byte)
-- Convert an element index to a card index -- Convert an element index to a card index
cardCmm :: DynFlags -> CmmExpr -> CmmExpr cardCmm :: DynFlags -> CmmExpr -> CmmExpr
...@@ -2481,11 +2480,11 @@ emitMemmoveCall dst src n align = do ...@@ -2481,11 +2480,11 @@ emitMemmoveCall dst src n align = do
-- | Emit a call to @memset@. The second argument must fit inside an -- | Emit a call to @memset@. The second argument must fit inside an
-- unsigned char. -- unsigned char.
emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode () emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemsetCall dst c n align = do emitMemsetCall dst c n align = do
emitPrimCall emitPrimCall
[ {- no results -} ] [ {- no results -} ]
(MO_Memset align) (MO_Memset (alignmentBytes align))
[ dst, c, n ] [ dst, c, n ]
emitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode () emitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
......
...@@ -147,6 +147,7 @@ module DynFlags ( ...@@ -147,6 +147,7 @@ module DynFlags (
#include "GHCConstantsHaskellExports.hs" #include "GHCConstantsHaskellExports.hs"
bLOCK_SIZE_W, bLOCK_SIZE_W,
wORD_SIZE_IN_BITS, wORD_SIZE_IN_BITS,
wordAlignment,
tAG_MASK, tAG_MASK,
mAX_PTR_TAG, mAX_PTR_TAG,
tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD, tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,
...@@ -205,7 +206,7 @@ import Maybes ...@@ -205,7 +206,7 @@ import Maybes
import MonadUtils import MonadUtils
import qualified Pretty import qualified Pretty
import SrcLoc import SrcLoc
import BasicTypes ( IntWithInf, treatZeroAsInf ) import BasicTypes ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
import FastString import FastString
import Fingerprint import Fingerprint
import Outputable import Outputable
...@@ -5661,6 +5662,9 @@ bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE dflags ...@@ -5661,6 +5662,9 @@ bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE dflags
wORD_SIZE_IN_BITS :: DynFlags -> Int wORD_SIZE_IN_BITS :: DynFlags -> Int
wORD_SIZE_IN_BITS dflags = wORD_SIZE dflags * 8 wORD_SIZE_IN_BITS dflags = wORD_SIZE dflags * 8
wordAlignment :: DynFlags -> Alignment
wordAlignment dflags = alignmentOf (wORD_SIZE dflags)
tAG_MASK :: DynFlags -> Int tAG_MASK :: DynFlags -> Int
tAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) - 1 tAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) - 1
......
...@@ -128,7 +128,7 @@ cmmTopCodeGen (CmmProc info lab live graph) = do ...@@ -128,7 +128,7 @@ cmmTopCodeGen (CmmProc info lab live graph) = do
Nothing -> return tops Nothing -> return tops
cmmTopCodeGen (CmmData sec dat) = do cmmTopCodeGen (CmmData sec dat) = do
return [CmmData sec (1, dat)] -- no translation, we just use CmmStatic return [CmmData sec (mkAlignment 1, dat)] -- no translation, we just use CmmStatic
basicBlockCodeGen basicBlockCodeGen
...@@ -569,7 +569,7 @@ getRegister' _ _ (CmmLit lit@(CmmFloat f w)) = ...@@ -569,7 +569,7 @@ getRegister' _ _ (CmmLit lit@(CmmFloat f w)) =
return (Any format code) return (Any format code)
| otherwise = do | otherwise = do
Amode addr code <- memConstant (widthInBytes w) lit Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
loadFloatAmode True w addr code loadFloatAmode True w addr code
float_const_x87 = case w of float_const_x87 = case w of
...@@ -583,7 +583,7 @@ getRegister' _ _ (CmmLit lit@(CmmFloat f w)) = ...@@ -583,7 +583,7 @@ getRegister' _ _ (CmmLit lit@(CmmFloat f w)) =
in return (Any FF80 code) in return (Any FF80 code)
_otherwise -> do _otherwise -> do
Amode addr code <- memConstant (widthInBytes w) lit Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
loadFloatAmode False w addr code loadFloatAmode False w addr code
-- catch simple cases of zero- or sign-extended load -- catch simple cases of zero- or sign-extended load
...@@ -1247,7 +1247,7 @@ getNonClobberedOperand (CmmLit lit) = do ...@@ -1247,7 +1247,7 @@ getNonClobberedOperand (CmmLit lit) = do
if use_sse2 && isSuitableFloatingPointLit lit if use_sse2 && isSuitableFloatingPointLit lit
then do then do
let CmmFloat _ w = lit let CmmFloat _ w = lit
Amode addr code <- memConstant (widthInBytes w) lit Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
return (OpAddr addr, code) return (OpAddr addr, code)
else do else do
...@@ -1303,7 +1303,7 @@ getOperand (CmmLit lit) = do ...@@ -1303,7 +1303,7 @@ getOperand (CmmLit lit) = do
if (use_sse2 && isSuitableFloatingPointLit lit) if (use_sse2 && isSuitableFloatingPointLit lit)
then do then do
let CmmFloat _ w = lit let CmmFloat _ w = lit
Amode addr code <- memConstant (widthInBytes w) lit Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
return (OpAddr addr, code) return (OpAddr addr, code)
else do else do
...@@ -1351,7 +1351,7 @@ addAlignmentCheck align reg = ...@@ -1351,7 +1351,7 @@ addAlignmentCheck align reg =
, JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel , JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel
] ]
memConstant :: Int -> CmmLit -> NatM Amode memConstant :: Alignment -> CmmLit -> NatM Amode
memConstant align lit = do memConstant align lit = do
lbl <- getNewLabelNat lbl <- getNewLabelNat
let rosection = Section ReadOnlyData lbl let rosection = Section ReadOnlyData lbl
...@@ -1843,7 +1843,7 @@ genCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _ ...@@ -1843,7 +1843,7 @@ genCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _
dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
(ImmInteger (n - i)) (ImmInteger (n - i))
genCCall dflags is32Bit (PrimTarget (MO_Memset align)) _ genCCall dflags _ (PrimTarget (MO_Memset align)) _
[dst, [dst,
CmmLit (CmmInt c _), CmmLit (CmmInt c _),
CmmLit (CmmInt n _)] CmmLit (CmmInt n _)]
...@@ -1861,11 +1861,9 @@ genCCall dflags is32Bit (PrimTarget (MO_Memset align)) _ ...@@ -1861,11 +1861,9 @@ genCCall dflags is32Bit (PrimTarget (MO_Memset align)) _
return $ code_dst dst_r `appOL` return $ code_dst dst_r `appOL`
go4 dst_r (fromInteger n) go4 dst_r (fromInteger n)
where where
format = case byteAlignment (fromIntegral align) of maxAlignment = wordAlignment dflags -- only machine word wide MOVs are supported
8 -> if is32Bit then II32 else II64 effectiveAlignment = min (alignmentOf align) maxAlignment
4 -> II32 format = intFormat . widthFromBytes $ alignmentBytes effectiveAlignment
2 -> II16
_ -> II8
c2 = c `shiftL` 8 .|. c c2 = c `shiftL` 8 .|. c
c4 = c2 `shiftL` 16 .|. c2 c4 = c2 `shiftL` 16 .|. c2
c8 = c4 `shiftL` 32 .|. c4 c8 = c4 `shiftL` 32 .|. c4
...@@ -2352,7 +2350,7 @@ genCCall _ is32Bit target dest_regs args bid = do ...@@ -2352,7 +2350,7 @@ genCCall _ is32Bit target dest_regs args bid = do
let let
const | FF32 <- fmt = CmmInt 0x7fffffff W32 const | FF32 <- fmt = CmmInt 0x7fffffff W32
| otherwise = CmmInt 0x7fffffffffffffff W64 | otherwise = CmmInt 0x7fffffffffffffff W64
Amode amode amode_code <- memConstant (widthInBytes w) const Amode amode amode_code <- memConstant (mkAlignment $ widthInBytes w) const
tmp <- getNewRegNat fmt tmp <- getNewRegNat fmt
let let
code dst = x_code dst `appOL` amode_code `appOL` toOL [ code dst = x_code dst `appOL` amode_code `appOL` toOL [
...@@ -3081,7 +3079,7 @@ createJumpTable dflags ids section lbl ...@@ -3081,7 +3079,7 @@ createJumpTable dflags ids section lbl
where blockLabel = blockLbl blockid where blockLabel = blockLbl blockid
in map jumpTableEntryRel ids in map jumpTableEntryRel ids
| otherwise = map (jumpTableEntry dflags) ids | otherwise = map (jumpTableEntry dflags) ids
in CmmData section (1, Statics lbl jumpTable) in CmmData section (mkAlignment 1, Statics lbl jumpTable)
extractUnwindPoints :: [Instr] -> [UnwindPoint] extractUnwindPoints :: [Instr] -> [UnwindPoint]
extractUnwindPoints instrs = extractUnwindPoints instrs =
...@@ -3448,7 +3446,7 @@ sse2NegCode w x = do ...@@ -3448,7 +3446,7 @@ sse2NegCode w x = do
x@FF80 -> wrongFmt x x@FF80 -> wrongFmt x
where where
wrongFmt x = panic $ "sse2NegCode: " ++ show x wrongFmt x = panic $ "sse2NegCode: " ++ show x
Amode amode amode_code <- memConstant (widthInBytes w) const Amode amode amode_code <- memConstant (mkAlignment $ widthInBytes w) const
tmp <- getNewRegNat fmt tmp <- getNewRegNat fmt
let let
code dst = x_code dst `appOL` amode_code `appOL` toOL [ code dst = x_code dst `appOL` amode_code `appOL` toOL [
......
...@@ -36,7 +36,7 @@ import PprBase ...@@ -36,7 +36,7 @@ import PprBase
import Hoopl.Collections import Hoopl.Collections
import Hoopl.Label import Hoopl.Label
import BasicTypes (Alignment) import BasicTypes (Alignment, mkAlignment, alignmentBytes)
import DynFlags import DynFlags
import Cmm hiding (topInfoTable) import Cmm hiding (topInfoTable)
import BlockId import BlockId
...@@ -72,7 +72,7 @@ import Data.Bits ...@@ -72,7 +72,7 @@ import Data.Bits
pprProcAlignment :: SDoc pprProcAlignment :: SDoc
pprProcAlignment = sdocWithDynFlags $ \dflags -> pprProcAlignment = sdocWithDynFlags $ \dflags ->
(maybe empty pprAlign . cmmProcAlignment $ dflags) (maybe empty (pprAlign . mkAlignment) (cmmProcAlignment dflags))
pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
pprNatCmmDecl (CmmData section dats) = pprNatCmmDecl (CmmData section dats) =
...@@ -236,14 +236,15 @@ pprLabel lbl = pprGloblDecl lbl ...@@ -236,14 +236,15 @@ pprLabel lbl = pprGloblDecl lbl
$$ pprTypeDecl lbl $$ pprTypeDecl lbl
$$ (ppr lbl <> char ':') $$ (ppr lbl <> char ':')
pprAlign :: Int -> SDoc pprAlign :: Alignment -> SDoc
pprAlign bytes pprAlign alignment
= sdocWithPlatform $ \platform -> = sdocWithPlatform $ \platform ->
text ".align " <> int (alignment platform) text ".align " <> int (alignmentOn platform)
where where
alignment platform = if platformOS platform == OSDarwin bytes = alignmentBytes alignment
then log2 bytes alignmentOn platform = if platformOS platform == OSDarwin
else bytes then log2 bytes
else bytes
log2 :: Int -> Int -- cache the common ones log2 :: Int -> Int -- cache the common ones
log2 1 = 0 log2 1 = 0
......
...@@ -87,7 +87,6 @@ module Util ( ...@@ -87,7 +87,6 @@ module Util (
-- * Integers -- * Integers
exactLog2, exactLog2,
byteAlignment,
-- * Floating point -- * Floating point
readRational, readRational,
...@@ -1150,16 +1149,6 @@ exactLog2 x ...@@ -1150,16 +1149,6 @@ exactLog2 x
pow2 x | x == 1 = 0 pow2 x | x == 1 = 0
| otherwise = 1 + pow2 (x `shiftR` 1) | otherwise = 1 + pow2 (x `shiftR` 1)
-- x is aligned at N bytes means the remainder from x / N is zero.
-- Currently, interested in N <= 8, but can be expanded to N <= 16 or
-- N <= 32 if used within SSE or AVX context.
byteAlignment :: Integer -> Integer
byteAlignment x = case x .&. 7 of
0 -> 8
4 -> 4
2 -> 2
_ -> 1
{- {-
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Floats -- Floats
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment