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(
Arity, RepArity, JoinArity,
Alignment,
Alignment, mkAlignment, alignmentOf, alignmentBytes,
PromotionFlag(..), isPromoted,
FunctionOrData(..),
......@@ -116,6 +116,7 @@ import Outputable
import SrcLoc ( Located,unLoc )
import Data.Data hiding (Fixity, Prefix, Infix)
import Data.Function (on)
import Data.Bits
{-
************************************************************************
......@@ -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
-> FCode ()
doSetByteArrayOp ba off len c = do
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
where
possibleAlign = case off of
CmmLit (CmmInt intOff _) -> fromIntegral $ byteAlignment (fromIntegral intOff)
_ -> 1
-- ----------------------------------------------------------------------------
-- Allocating arrays
......@@ -2355,7 +2354,7 @@ emitSetCards dst_start dst_cards_start n = do
emitMemsetCall (cmmAddWord dflags dst_cards_start 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
cardCmm :: DynFlags -> CmmExpr -> CmmExpr
......@@ -2481,11 +2480,11 @@ emitMemmoveCall dst src n align = do
-- | Emit a call to @memset@. The second argument must fit inside an
-- unsigned char.
emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemsetCall dst c n align = do
emitPrimCall
[ {- no results -} ]
(MO_Memset align)
(MO_Memset (alignmentBytes align))
[ dst, c, n ]
emitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
......
......@@ -147,6 +147,7 @@ module DynFlags (
#include "GHCConstantsHaskellExports.hs"
bLOCK_SIZE_W,
wORD_SIZE_IN_BITS,
wordAlignment,
tAG_MASK,
mAX_PTR_TAG,
tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,
......@@ -205,7 +206,7 @@ import Maybes
import MonadUtils
import qualified Pretty
import SrcLoc
import BasicTypes ( IntWithInf, treatZeroAsInf )
import BasicTypes ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
import FastString
import Fingerprint
import Outputable
......@@ -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 dflags = wORD_SIZE dflags * 8
wordAlignment :: DynFlags -> Alignment
wordAlignment dflags = alignmentOf (wORD_SIZE dflags)
tAG_MASK :: DynFlags -> Int
tAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) - 1
......
......@@ -128,7 +128,7 @@ cmmTopCodeGen (CmmProc info lab live graph) = do
Nothing -> return tops
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
......@@ -569,7 +569,7 @@ getRegister' _ _ (CmmLit lit@(CmmFloat f w)) =
return (Any format code)
| otherwise = do
Amode addr code <- memConstant (widthInBytes w) lit
Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
loadFloatAmode True w addr code
float_const_x87 = case w of
......@@ -583,7 +583,7 @@ getRegister' _ _ (CmmLit lit@(CmmFloat f w)) =
in return (Any FF80 code)
_otherwise -> do
Amode addr code <- memConstant (widthInBytes w) lit
Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
loadFloatAmode False w addr code
-- catch simple cases of zero- or sign-extended load
......@@ -1247,7 +1247,7 @@ getNonClobberedOperand (CmmLit lit) = do
if use_sse2 && isSuitableFloatingPointLit lit
then do
let CmmFloat _ w = lit
Amode addr code <- memConstant (widthInBytes w) lit
Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
return (OpAddr addr, code)
else do
......@@ -1303,7 +1303,7 @@ getOperand (CmmLit lit) = do
if (use_sse2 && isSuitableFloatingPointLit lit)
then do
let CmmFloat _ w = lit
Amode addr code <- memConstant (widthInBytes w) lit
Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
return (OpAddr addr, code)
else do
......@@ -1351,7 +1351,7 @@ addAlignmentCheck align reg =
, JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel
]
memConstant :: Int -> CmmLit -> NatM Amode
memConstant :: Alignment -> CmmLit -> NatM Amode
memConstant align lit = do
lbl <- getNewLabelNat
let rosection = Section ReadOnlyData lbl
......@@ -1843,7 +1843,7 @@ genCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _
dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
(ImmInteger (n - i))
genCCall dflags is32Bit (PrimTarget (MO_Memset align)) _
genCCall dflags _ (PrimTarget (MO_Memset align)) _
[dst,
CmmLit (CmmInt c _),
CmmLit (CmmInt n _)]
......@@ -1861,11 +1861,9 @@ genCCall dflags is32Bit (PrimTarget (MO_Memset align)) _
return $ code_dst dst_r `appOL`
go4 dst_r (fromInteger n)
where
format = case byteAlignment (fromIntegral align) of
8 -> if is32Bit then II32 else II64
4 -> II32
2 -> II16
_ -> II8
maxAlignment = wordAlignment dflags -- only machine word wide MOVs are supported
effectiveAlignment = min (alignmentOf align) maxAlignment
format = intFormat . widthFromBytes $ alignmentBytes effectiveAlignment
c2 = c `shiftL` 8 .|. c
c4 = c2 `shiftL` 16 .|. c2
c8 = c4 `shiftL` 32 .|. c4
......@@ -2352,7 +2350,7 @@ genCCall _ is32Bit target dest_regs args bid = do
let
const | FF32 <- fmt = CmmInt 0x7fffffff W32
| otherwise = CmmInt 0x7fffffffffffffff W64
Amode amode amode_code <- memConstant (widthInBytes w) const
Amode amode amode_code <- memConstant (mkAlignment $ widthInBytes w) const
tmp <- getNewRegNat fmt
let
code dst = x_code dst `appOL` amode_code `appOL` toOL [
......@@ -3081,7 +3079,7 @@ createJumpTable dflags ids section lbl
where blockLabel = blockLbl blockid
in map jumpTableEntryRel 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 instrs =
......@@ -3448,7 +3446,7 @@ sse2NegCode w x = do
x@FF80 -> wrongFmt x
where
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
let
code dst = x_code dst `appOL` amode_code `appOL` toOL [
......
......@@ -36,7 +36,7 @@ import PprBase
import Hoopl.Collections
import Hoopl.Label
import BasicTypes (Alignment)
import BasicTypes (Alignment, mkAlignment, alignmentBytes)
import DynFlags
import Cmm hiding (topInfoTable)
import BlockId
......@@ -72,7 +72,7 @@ import Data.Bits
pprProcAlignment :: SDoc
pprProcAlignment = sdocWithDynFlags $ \dflags ->
(maybe empty pprAlign . cmmProcAlignment $ dflags)
(maybe empty (pprAlign . mkAlignment) (cmmProcAlignment dflags))
pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
pprNatCmmDecl (CmmData section dats) =
......@@ -236,14 +236,15 @@ pprLabel lbl = pprGloblDecl lbl
$$ pprTypeDecl lbl
$$ (ppr lbl <> char ':')
pprAlign :: Int -> SDoc
pprAlign bytes
pprAlign :: Alignment -> SDoc
pprAlign alignment
= sdocWithPlatform $ \platform ->
text ".align " <> int (alignment platform)
text ".align " <> int (alignmentOn platform)
where
alignment platform = if platformOS platform == OSDarwin
then log2 bytes
else bytes
bytes = alignmentBytes alignment
alignmentOn platform = if platformOS platform == OSDarwin
then log2 bytes
else bytes
log2 :: Int -> Int -- cache the common ones
log2 1 = 0
......
......@@ -87,7 +87,6 @@ module Util (
-- * Integers
exactLog2,
byteAlignment,
-- * Floating point
readRational,
......@@ -1150,16 +1149,6 @@ exactLog2 x
pow2 x | x == 1 = 0
| 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
......
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