summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Cmm/Info.hs11
-rw-r--r--compiler/GHC/Cmm/Utils.hs11
-rw-r--r--compiler/GHC/CmmToC.hs59
-rw-r--r--compiler/GHC/Llvm/Types.hs65
-rw-r--r--compiler/GHC/Runtime/Heap/Inspect.hs17
-rw-r--r--configure.ac4
-rw-r--r--distrib/configure.ac.in11
-rw-r--r--hadrian/cfg/system.config.in1
-rw-r--r--hadrian/src/Rules/Generate.hs1
-rw-r--r--includes/ghc.mk1
-rw-r--r--libraries/ghc-boot/GHC/Platform.hs26
-rw-r--r--libraries/ghc-boot/GHC/Settings.hs2
-rw-r--r--mk/config.mk.in1
-rw-r--r--utils/deriveConstants/Main.hs1
14 files changed, 114 insertions, 97 deletions
diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index 6da996ad45..88fc145b17 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -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
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index 82cb75a904..00600c2d67 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -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
---------------------------------------------------
--
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index 8b130afc7c..21659c2a91 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -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
diff --git a/compiler/GHC/Llvm/Types.hs b/compiler/GHC/Llvm/Types.hs
index a52e05faac..0452e6177c 100644
--- a/compiler/GHC/Llvm/Types.hs
+++ b/compiler/GHC/Llvm/Types.hs
@@ -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
--------------------------------------------------------------------------------
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 5f34e9d2d2..b176c4bfc2 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -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
diff --git a/configure.ac b/configure.ac
index 3718d272c6..a621814700 100644
--- a/configure.ac
+++ b/configure.ac
@@ -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)])
diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in
index bfff387ee8..b19f9c78a5 100644
--- a/distrib/configure.ac.in
+++ b/distrib/configure.ac.in
@@ -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'
#
diff --git a/hadrian/cfg/system.config.in b/hadrian/cfg/system.config.in
index 3a67bffbe0..016b5bc7bb 100644
--- a/hadrian/cfg/system.config.in
+++ b/hadrian/cfg/system.config.in
@@ -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@
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index 7106f0cb8b..33322c8129 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -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")
diff --git a/includes/ghc.mk b/includes/ghc.mk
index f8da99abb6..737e66cdea 100644
--- a/includes/ghc.mk
+++ b/includes/ghc.mk
@@ -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)")' >> $@
diff --git a/libraries/ghc-boot/GHC/Platform.hs b/libraries/ghc-boot/GHC/Platform.hs
index f6a7060b3f..b5091ae8e8 100644
--- a/libraries/ghc-boot/GHC/Platform.hs
+++ b/libraries/ghc-boot/GHC/Platform.hs
@@ -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
diff --git a/libraries/ghc-boot/GHC/Settings.hs b/libraries/ghc-boot/GHC/Settings.hs
index 96680dc58e..fd0a0ef3ad 100644
--- a/libraries/ghc-boot/GHC/Settings.hs
+++ b/libraries/ghc-boot/GHC/Settings.hs
@@ -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
diff --git a/mk/config.mk.in b/mk/config.mk.in
index dffd00d57b..791dc5acc0 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -494,6 +494,7 @@ HaskellHostArch = @HaskellHostArch@
HaskellTargetOs = @HaskellTargetOs@
HaskellTargetArch = @HaskellTargetArch@
TargetWordSize = @TargetWordSize@
+TargetWordBigEndian = @TargetWordBigEndian@
TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@
TargetHasIdentDirective = @TargetHasIdentDirective@
TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@
diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs
index d4143e988a..1867d824b6 100644
--- a/utils/deriveConstants/Main.hs
+++ b/utils/deriveConstants/Main.hs
@@ -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"
View Lorry Controller Status