Commit 0002db1b authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Kill wORDS_BIGENDIAN and replace it with platformByteOrder (#17957)

Metric Decrease:
    T13035
    T1969
parent 7627eab5
Pipeline #17407 passed with stages
in 717 minutes and 17 seconds
......@@ -206,7 +206,7 @@ mkInfoTableContents dflags
; return (prof_data ++ liveness_data, (std_info, srt_label)) }
| HeapRep _ ptrs nonptrs closure_type <- smrep
= do { let layout = packIntsCLit dflags ptrs nonptrs
= do { let layout = packIntsCLit platform ptrs nonptrs
; (prof_lits, prof_data) <- mkProfLits platform prof
; let (srt_label, srt_bitmap) = mkSRTLit dflags info_lbl srt
; (mb_srt_field, mb_layout, extra_bits, ct_data)
......@@ -238,14 +238,14 @@ mkInfoTableContents dflags
-- 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 = packIntsCLit dflags fun_type arity : srt_label
= do { let extra_bits = packIntsCLit platform 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 dflags arg_bits
; let fun_type | null liveness_data = aRG_GEN
| otherwise = aRG_GEN_BIG
extra_bits = [ packIntsCLit dflags fun_type arity ]
extra_bits = [ packIntsCLit platform fun_type arity ]
++ (if inlineSRT dflags then [] else [ srt_lit ])
++ [ liveness_lit, slow_entry ]
; return (Nothing, Nothing, extra_bits, liveness_data) }
......@@ -259,11 +259,10 @@ mkInfoTableContents dflags
mkInfoTableContents _ _ _ = panic "mkInfoTableContents" -- NonInfoTable dealt with earlier
packIntsCLit :: DynFlags -> Int -> Int -> CmmLit
packIntsCLit dflags a b = packHalfWordsCLit dflags
packIntsCLit :: Platform -> Int -> Int -> CmmLit
packIntsCLit platform a b = packHalfWordsCLit platform
(toStgHalfWord platform (fromIntegral a))
(toStgHalfWord platform (fromIntegral b))
where platform = targetPlatform dflags
mkSRTLit :: DynFlags
......
......@@ -225,19 +225,18 @@ mkRODataLits lbl lits
mkStgWordCLit :: Platform -> StgWord -> CmmLit
mkStgWordCLit platform wd = CmmInt (fromStgWord wd) (wordWidth platform)
packHalfWordsCLit :: DynFlags -> StgHalfWord -> StgHalfWord -> CmmLit
packHalfWordsCLit :: Platform -> StgHalfWord -> StgHalfWord -> CmmLit
-- Make a single word literal in which the lower_half_word is
-- at the lower address, and the upper_half_word is at the
-- higher address
-- ToDo: consider using half-word lits instead
-- but be careful: that's vulnerable when reversed
packHalfWordsCLit dflags lower_half_word upper_half_word
= if wORDS_BIGENDIAN dflags
then mkWordCLit platform ((l `shiftL` halfWordSizeInBits platform) .|. u)
else mkWordCLit platform (l .|. (u `shiftL` halfWordSizeInBits platform))
packHalfWordsCLit platform lower_half_word upper_half_word
= case platformByteOrder platform of
BigEndian -> mkWordCLit platform ((l `shiftL` halfWordSizeInBits platform) .|. u)
LittleEndian -> mkWordCLit platform (l .|. (u `shiftL` halfWordSizeInBits platform))
where l = fromStgHalfWord lower_half_word
u = fromStgHalfWord upper_half_word
platform = targetPlatform dflags
---------------------------------------------------
--
......
......@@ -520,41 +520,41 @@ pprStatics dflags = pprStatics'
(CmmStaticLit (CmmFloat f W32) : rest)
-- odd numbers of floats are padded to a word by mkVirtHeapOffsetsWithPadding
| wordWidth platform == W64, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
-> pprLit1 dflags (floatToWord dflags f) : pprStatics' rest'
-> pprLit1 dflags (floatToWord platform f) : pprStatics' rest'
-- adjacent floats aren't padded but combined into a single word
| wordWidth platform == W64, CmmStaticLit (CmmFloat g W32) : rest' <- rest
-> pprLit1 dflags (floatPairToWord dflags f g) : pprStatics' rest'
-> pprLit1 dflags (floatPairToWord platform f g) : pprStatics' rest'
| wordWidth platform == W32
-> pprLit1 dflags (floatToWord dflags f) : pprStatics' rest
-> pprLit1 dflags (floatToWord platform f) : pprStatics' rest
| otherwise
-> pprPanic "pprStatics: float" (vcat (map ppr' rest))
where ppr' (CmmStaticLit l) = ppr (cmmLitType platform l)
ppr' _other = text "bad static!"
(CmmStaticLit (CmmFloat f W64) : rest)
-> map (pprLit1 dflags) (doubleToWords dflags f) ++ pprStatics' rest
-> map (pprLit1 dflags) (doubleToWords platform f) ++ pprStatics' rest
(CmmStaticLit (CmmInt i W64) : rest)
| wordWidth platform == W32
-> if wORDS_BIGENDIAN dflags
then pprStatics' (CmmStaticLit (CmmInt q W32) :
CmmStaticLit (CmmInt r W32) : rest)
else pprStatics' (CmmStaticLit (CmmInt r W32) :
CmmStaticLit (CmmInt q W32) : rest)
-> case platformByteOrder platform of
BigEndian -> pprStatics' (CmmStaticLit (CmmInt q W32) :
CmmStaticLit (CmmInt r W32) : rest)
LittleEndian -> pprStatics' (CmmStaticLit (CmmInt r W32) :
CmmStaticLit (CmmInt q W32) : rest)
where r = i .&. 0xffffffff
q = i `shiftR` 32
(CmmStaticLit (CmmInt a W32) : CmmStaticLit (CmmInt b W32) : rest)
| wordWidth platform == W64
-> if wORDS_BIGENDIAN dflags
then pprStatics' (CmmStaticLit (CmmInt ((shiftL a 32) .|. b) W64) : rest)
else pprStatics' (CmmStaticLit (CmmInt ((shiftL b 32) .|. a) W64) : rest)
-> case platformByteOrder platform of
BigEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL a 32) .|. b) W64) : rest)
LittleEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL b 32) .|. a) W64) : rest)
(CmmStaticLit (CmmInt a W16) : CmmStaticLit (CmmInt b W16) : rest)
| wordWidth platform == W32
-> if wORDS_BIGENDIAN dflags
then pprStatics' (CmmStaticLit (CmmInt ((shiftL a 16) .|. b) W32) : rest)
else pprStatics' (CmmStaticLit (CmmInt ((shiftL b 16) .|. a) W32) : rest)
-> case platformByteOrder platform of
BigEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL a 16) .|. b) W32) : rest)
LittleEndian -> pprStatics' (CmmStaticLit (CmmInt ((shiftL b 16) .|. a) W32) : rest)
(CmmStaticLit (CmmInt _ w) : _)
| w /= wordWidth platform
......@@ -1271,8 +1271,8 @@ castFloatToWord32Array = U.castSTUArray
castDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)
castDoubleToWord64Array = U.castSTUArray
floatToWord :: DynFlags -> Rational -> CmmLit
floatToWord dflags r
floatToWord :: Platform -> Rational -> CmmLit
floatToWord platform r
= runST (do
arr <- newArray_ ((0::Int),0)
writeArray arr 0 (fromRational r)
......@@ -1281,12 +1281,13 @@ floatToWord dflags r
return (CmmInt (toInteger w32 `shiftL` wo) (wordWidth platform))
)
where wo | wordWidth platform == W64
, wORDS_BIGENDIAN dflags = 32
| otherwise = 0
platform = targetPlatform dflags
, BigEndian <- platformByteOrder platform
= 32
| otherwise
= 0
floatPairToWord :: DynFlags -> Rational -> Rational -> CmmLit
floatPairToWord dflags r1 r2
floatPairToWord :: Platform -> Rational -> Rational -> CmmLit
floatPairToWord platform r1 r2
= runST (do
arr <- newArray_ ((0::Int),1)
writeArray arr 0 (fromRational r1)
......@@ -1297,15 +1298,15 @@ floatPairToWord dflags r1 r2
return (pprWord32Pair w32_1 w32_2)
)
where pprWord32Pair w32_1 w32_2
| wORDS_BIGENDIAN dflags =
| BigEndian <- platformByteOrder platform =
CmmInt ((shiftL i1 32) .|. i2) W64
| otherwise =
CmmInt ((shiftL i2 32) .|. i1) W64
where i1 = toInteger w32_1
i2 = toInteger w32_2
doubleToWords :: DynFlags -> Rational -> [CmmLit]
doubleToWords dflags r
doubleToWords :: Platform -> Rational -> [CmmLit]
doubleToWords platform r
= runST (do
arr <- newArray_ ((0::Int),1)
writeArray arr 0 (fromRational r)
......@@ -1314,8 +1315,6 @@ doubleToWords dflags r
return (pprWord64 w64)
)
where targetWidth = wordWidth platform
platform = targetPlatform dflags
targetBE = wORDS_BIGENDIAN dflags
pprWord64 w64
| targetWidth == W64 =
[ CmmInt (toInteger w64) targetWidth ]
......@@ -1324,9 +1323,9 @@ doubleToWords dflags r
, CmmInt (toInteger targetW2) targetWidth
]
| otherwise = panic "doubleToWords.pprWord64"
where (targetW1, targetW2)
| targetBE = (wHi, wLo)
| otherwise = (wLo, wHi)
where (targetW1, targetW2) = case platformByteOrder platform of
BigEndian -> (wHi, wLo)
LittleEndian -> (wLo, wHi)
wHi = w64 `shiftR` 32
wLo = w64 .&. 0xFFFFffff
......
......@@ -225,26 +225,26 @@ ppPlainName (LMLitVar x ) = ppLit x
-- | Print a literal value. No type.
ppLit :: LlvmLit -> SDoc
ppLit (LMIntLit i (LMInt 32)) = ppr (fromInteger i :: Int32)
ppLit (LMIntLit i (LMInt 64)) = ppr (fromInteger i :: Int64)
ppLit (LMIntLit i _ ) = ppr ((fromInteger i)::Int)
ppLit (LMFloatLit r LMFloat ) = ppFloat $ narrowFp r
ppLit (LMFloatLit r LMDouble) = ppDouble r
ppLit f@(LMFloatLit _ _) = pprPanic "ppLit" (text "Can't print this float literal: " <> ppr f)
ppLit (LMVectorLit ls ) = char '<' <+> ppCommaJoin ls <+> char '>'
ppLit (LMNullLit _ ) = text "null"
-- #11487 was an issue where we passed undef for some arguments
-- that were actually live. By chance the registers holding those
-- arguments usually happened to have the right values anyways, but
-- that was not guaranteed. To find such bugs reliably, we set the
-- flag below when validating, which replaces undef literals (at
-- common types) with values that are likely to cause a crash or test
-- failure.
ppLit (LMUndefLit t ) = sdocWithDynFlags f
where f dflags
| gopt Opt_LlvmFillUndefWithGarbage dflags,
Just lit <- garbageLit t = ppLit lit
| otherwise = text "undef"
ppLit l = sdocWithDynFlags $ \dflags -> case l of
(LMIntLit i (LMInt 32)) -> ppr (fromInteger i :: Int32)
(LMIntLit i (LMInt 64)) -> ppr (fromInteger i :: Int64)
(LMIntLit i _ ) -> ppr ((fromInteger i)::Int)
(LMFloatLit r LMFloat ) -> ppFloat (targetPlatform dflags) $ narrowFp r
(LMFloatLit r LMDouble) -> ppDouble (targetPlatform dflags) r
f@(LMFloatLit _ _) -> pprPanic "ppLit" (text "Can't print this float literal: " <> ppr f)
(LMVectorLit ls ) -> char '<' <+> ppCommaJoin ls <+> char '>'
(LMNullLit _ ) -> text "null"
-- #11487 was an issue where we passed undef for some arguments
-- that were actually live. By chance the registers holding those
-- arguments usually happened to have the right values anyways, but
-- that was not guaranteed. To find such bugs reliably, we set the
-- flag below when validating, which replaces undef literals (at
-- common types) with values that are likely to cause a crash or test
-- failure.
(LMUndefLit t )
| gopt Opt_LlvmFillUndefWithGarbage dflags
, Just lit <- garbageLit t -> ppLit lit
| otherwise -> text "undef"
garbageLit :: LlvmType -> Maybe LlvmLit
garbageLit t@(LMInt w) = Just (LMIntLit (0xbbbbbbbbbbbbbbb0 `mod` (2^w)) t)
......@@ -836,19 +836,20 @@ instance Outputable LlvmCastOp where
-- regardless of underlying architecture.
--
-- See Note [LLVM Float Types].
ppDouble :: Double -> SDoc
ppDouble d
ppDouble :: Platform -> Double -> SDoc
ppDouble platform d
= let bs = doubleToBytes d
hex d' = case showHex d' "" of
[] -> error "dToStr: too few hex digits for float"
[x] -> ['0',x]
[x,y] -> [x,y]
_ -> error "dToStr: too many hex digits for float"
[] -> error "ppDouble: too few hex digits for float"
[x] -> ['0',x]
[x,y] -> [x,y]
_ -> error "ppDouble: too many hex digits for float"
in sdocWithDynFlags (\dflags ->
let fixEndian = if wORDS_BIGENDIAN dflags then id else reverse
str = map toUpper $ concat $ fixEndian $ map hex bs
in text "0x" <> text str)
fixEndian = case platformByteOrder platform of
BigEndian -> id
LittleEndian -> reverse
str = map toUpper $ concat $ fixEndian $ map hex bs
in text "0x" <> text str
-- Note [LLVM Float Types]
-- ~~~~~~~~~~~~~~~~~~~~~~~
......@@ -875,8 +876,8 @@ widenFp :: Float -> Double
{-# NOINLINE widenFp #-}
widenFp = float2Double
ppFloat :: Float -> SDoc
ppFloat = ppDouble . widenFp
ppFloat :: Platform -> Float -> SDoc
ppFloat platform = ppDouble platform . widenFp
--------------------------------------------------------------------------------
......
......@@ -865,10 +865,9 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
-- This is a bit involved since we allow packing multiple fields
-- within a single word. See also
-- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding
dflags <- getDynFlags
let platform = targetPlatform dflags
word_size = platformWordSizeInBytes platform
big_endian = wORDS_BIGENDIAN dflags
platform <- targetPlatform <$> getDynFlags
let word_size = platformWordSizeInBytes platform
endian = platformByteOrder platform
size_b = primRepSizeB platform rep
-- Align the start offset (eg, 2-byte value should be 2-byte
-- aligned). But not more than to a word. The offset calculation
......@@ -877,7 +876,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
!aligned_idx = roundUpTo arr_i (min word_size size_b)
!new_arr_i = aligned_idx + size_b
ws | size_b < word_size =
[index size_b aligned_idx word_size big_endian]
[index size_b aligned_idx word_size endian]
| otherwise =
let (q, r) = size_b `quotRem` word_size
in ASSERT( r == 0 )
......@@ -892,7 +891,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
(error "unboxedTupleTerm: no HValue for unboxed tuple") terms
-- Extract a sub-word sized field from a word
index item_size_b index_b word_size big_endian =
index item_size_b index_b word_size endian =
(word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes
where
mask :: Word
......@@ -903,9 +902,9 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
_ -> panic ("Weird byte-index: " ++ show index_b)
(q,r) = index_b `quotRem` word_size
word = array!!q
moveBytes = if big_endian
then word_size - (r + item_size_b) * 8
else r * 8
moveBytes = case endian of
BigEndian -> word_size - (r + item_size_b) * 8
LittleEndian -> r * 8
-- | Fast, breadth-first Type reconstruction
......
......@@ -952,6 +952,10 @@ else
AC_SUBST([Cabal64bit],[False])
fi
AC_SUBST(TargetWordSize)
AC_C_BIGENDIAN([TargetWordBigEndian=YES],[TargetWordBigEndian=NO])
AC_SUBST(TargetWordBigEndian)
FP_CHECK_FUNC([WinExec],
[@%:@include <windows.h>], [WinExec("",0)])
......
......@@ -177,6 +177,17 @@ fi
TargetWordSize=$ac_cv_sizeof_void_p
AC_SUBST(TargetWordSize)
dnl TargetWordBigEndian for settings file
AC_C_BIGENDIAN([TargetWordBigEndian=YES],[TargetWordBigEndian=NO])
dnl Check that the toolchain we have is consistent with what the compiler expects
if test "x$TargetWordBigEndian" != "x@TargetWordBigEndian@"; then
AC_MSG_ERROR([This binary distribution produces binaries for a target with
a different byte order than your target toolchain.
Are you sure your toolchain targets the intended target platform
of this compiler?])
fi
AC_SUBST(TargetWordBigEndian)
#
dnl ** how to invoke `ar' and `ranlib'
#
......
......@@ -146,6 +146,7 @@ settings-llc-command = @SettingsLlcCommand@
settings-opt-command = @SettingsOptCommand@
target-word-size = @TargetWordSize@
target-word-big-endian = @TargetWordBigEndian@
target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@
target-has-ident-directive = @TargetHasIdentDirective@
target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@
......
......@@ -301,6 +301,7 @@ generateSettings = do
, ("target os", getSetting TargetOsHaskell)
, ("target arch", getSetting TargetArchHaskell)
, ("target word size", expr $ lookupValueOrError configFile "target-word-size")
, ("target word big endian", expr $ lookupValueOrError configFile "target-word-big-endian")
, ("target has GNU nonexec stack", expr $ lookupValueOrError configFile "target-has-gnu-nonexec-stack")
, ("target has .ident directive", expr $ lookupValueOrError configFile "target-has-ident-directive")
, ("target has subsections via symbols", expr $ lookupValueOrError configFile "target-has-subsections-via-symbols")
......
......@@ -236,6 +236,7 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/.
@echo ',("target os", "$(HaskellTargetOs)")' >> $@
@echo ',("target arch", "$(HaskellTargetArch)")' >> $@
@echo ',("target word size", "$(TargetWordSize)")' >> $@
@echo ',("target word big endian", "$(TargetWordBigEndian)")' >> $@
@echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@
@echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@
@echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@
......
......@@ -12,6 +12,7 @@ module GHC.Platform (
ArmISAExt(..),
ArmABI(..),
PPC_64ABI(..),
ByteOrder(..),
target32Bit,
isARM,
......@@ -38,6 +39,7 @@ where
import Prelude -- See Note [Why do we import Prelude here?]
import GHC.Read
import GHC.ByteOrder (ByteOrder(..))
import Data.Word
import Data.Int
......@@ -53,19 +55,17 @@ data PlatformMini
-- | Contains enough information for the native code generator to emit
-- code for this platform.
data Platform
= Platform {
platformMini :: PlatformMini,
-- Word size in bytes (i.e. normally 4 or 8,
-- for 32bit and 64bit platforms respectively)
platformWordSize :: PlatformWordSize,
platformUnregisterised :: Bool,
platformHasGnuNonexecStack :: Bool,
platformHasIdentDirective :: Bool,
platformHasSubsectionsViaSymbols :: Bool,
platformIsCrossCompiling :: Bool
}
deriving (Read, Show, Eq)
data Platform = Platform
{ platformMini :: PlatformMini
, platformWordSize :: PlatformWordSize
, platformByteOrder :: ByteOrder
, platformUnregisterised :: Bool
, platformHasGnuNonexecStack :: Bool
, platformHasIdentDirective :: Bool
, platformHasSubsectionsViaSymbols :: Bool
, platformIsCrossCompiling :: Bool
}
deriving (Read, Show, Eq)
data PlatformWordSize
= PW4 -- ^ A 32-bit platform
......
......@@ -36,6 +36,7 @@ getTargetPlatform settingsFile mySettings = do
targetArch <- readSetting "target arch"
targetOS <- readSetting "target os"
targetWordSize <- readSetting "target word size"
targetWordBigEndian <- getBooleanSetting "target word big endian"
targetUnregisterised <- getBooleanSetting "Unregisterised"
targetHasGnuNonexecStack <- getBooleanSetting "target has GNU nonexec stack"
targetHasIdentDirective <- getBooleanSetting "target has .ident directive"
......@@ -48,6 +49,7 @@ getTargetPlatform settingsFile mySettings = do
, platformMini_os = targetOS
}
, platformWordSize = targetWordSize
, platformByteOrder = if targetWordBigEndian then BigEndian else LittleEndian
, platformUnregisterised = targetUnregisterised
, platformHasGnuNonexecStack = targetHasGnuNonexecStack
, platformHasIdentDirective = targetHasIdentDirective
......
......@@ -494,6 +494,7 @@ HaskellHostArch = @HaskellHostArch@
HaskellTargetOs = @HaskellTargetOs@
HaskellTargetArch = @HaskellTargetArch@
TargetWordSize = @TargetWordSize@
TargetWordBigEndian = @TargetWordBigEndian@
TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@
TargetHasIdentDirective = @TargetHasIdentDirective@
TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@
......
......@@ -672,7 +672,6 @@ wanteds os = concat
-- Amount of pointer bits used for semi-tagging constructor closures
,constantWord Haskell "TAG_BITS" "TAG_BITS"
,constantBool Haskell "WORDS_BIGENDIAN" "defined(WORDS_BIGENDIAN)"
,constantBool Haskell "DYNAMIC_BY_DEFAULT" "defined(DYNAMIC_BY_DEFAULT)"
,constantWord Haskell "LDV_SHIFT" "LDV_SHIFT"
......
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