diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2019-08-05 20:44:33 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-08-06 20:26:32 -0400 |
commit | 6f116005a144b3f09381e0a5967a364eb57a5aa5 (patch) | |
tree | e6fa10c5f1f37790d15dff2b9dce7c700b26366a | |
parent | c83e39bf91cfeb17a54ccfd5d01bfdfa1b4a72c9 (diff) | |
download | haskell-6f116005a144b3f09381e0a5967a364eb57a5aa5.tar.gz |
Introduce a type for "platform word size", use it instead of Int
We introduce a PlatformWordSize type and use it in platformWordSize
field.
This removes to panic/error calls called when platform word size is not
32 or 64. We now check for this when reading the platform config.
-rw-r--r-- | compiler/basicTypes/Literal.hs | 10 | ||||
-rw-r--r-- | compiler/cmm/CmmInfo.hs | 4 | ||||
-rw-r--r-- | compiler/cmm/CmmUtils.hs | 4 | ||||
-rw-r--r-- | compiler/cmm/SMRep.hs | 22 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs | 15 | ||||
-rw-r--r-- | compiler/main/StaticPtrTable.hs | 7 | ||||
-rw-r--r-- | compiler/nativeGen/Dwarf.hs | 2 | ||||
-rw-r--r-- | compiler/nativeGen/Dwarf/Types.hs | 21 | ||||
-rw-r--r-- | compiler/nativeGen/PPC/Instr.hs | 2 | ||||
-rw-r--r-- | compiler/prelude/PrelRules.hs | 21 | ||||
-rw-r--r-- | libraries/ghc-boot/GHC/Platform.hs | 38 |
11 files changed, 86 insertions, 60 deletions
diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs index abf74a7cbd..527435bfb2 100644 --- a/compiler/basicTypes/Literal.hs +++ b/compiler/basicTypes/Literal.hs @@ -309,13 +309,11 @@ Int/Word range. wrapLitNumber :: DynFlags -> Literal -> Literal wrapLitNumber dflags v@(LitNumber nt i t) = case nt of LitNumInt -> case platformWordSize (targetPlatform dflags) of - 4 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) t - 8 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t - w -> panic ("wrapLitNumber: Unknown platformWordSize: " ++ show w) + PW4 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) t + PW8 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t LitNumWord -> case platformWordSize (targetPlatform dflags) of - 4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) t - 8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t - w -> panic ("wrapLitNumber: Unknown platformWordSize: " ++ show w) + PW4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) t + PW8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t LitNumInt64 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t LitNumWord64 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t LitNumInteger -> v diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 2f54aca74e..138e7aa8d8 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -577,7 +577,7 @@ stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags stdSrtBitmapOffset :: DynFlags -> ByteOff -- Byte offset of the SRT bitmap half-word which is -- in the *higher-addressed* part of the type_lit -stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE dflags +stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - halfWordSize dflags stdClosureTypeOffset :: DynFlags -> ByteOff -- Byte offset of the closure type half-word @@ -585,7 +585,7 @@ stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags -stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE dflags +stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + halfWordSize dflags conInfoTableSizeB :: DynFlags -> Int conInfoTableSizeB dflags = stdInfoTableSizeB dflags + wORD_SIZE dflags diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 8b4947de69..3381fbfcfd 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -227,8 +227,8 @@ 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` hALF_WORD_SIZE_IN_BITS dflags) .|. u) - else mkWordCLit dflags (l .|. (u `shiftL` hALF_WORD_SIZE_IN_BITS dflags)) + then mkWordCLit dflags ((l `shiftL` halfWordSizeInBits dflags) .|. u) + else mkWordCLit dflags (l .|. (u `shiftL` halfWordSizeInBits dflags)) where l = fromStgHalfWord lower_half_word u = fromStgHalfWord upper_half_word diff --git a/compiler/cmm/SMRep.hs b/compiler/cmm/SMRep.hs index 57d5354cca..49137eff25 100644 --- a/compiler/cmm/SMRep.hs +++ b/compiler/cmm/SMRep.hs @@ -13,7 +13,7 @@ module SMRep ( StgWord, fromStgWord, toStgWord, StgHalfWord, fromStgHalfWord, toStgHalfWord, - hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS, + halfWordSize, halfWordSizeInBits, -- * Closure repesentation SMRep(..), -- CmmInfo sees the rep; no one else does @@ -107,9 +107,8 @@ toStgWord dflags i = case platformWordSize (targetPlatform dflags) of -- These conversions mean that things like toStgWord (-1) -- do the right thing - 4 -> StgWord (fromIntegral (fromInteger i :: Word32)) - 8 -> StgWord (fromInteger i :: Word64) - w -> panic ("toStgWord: Unknown platformWordSize: " ++ show w) + PW4 -> StgWord (fromIntegral (fromInteger i :: Word32)) + PW8 -> StgWord (fromInteger i) instance Outputable StgWord where ppr (StgWord i) = integer (toInteger i) @@ -129,17 +128,18 @@ toStgHalfWord dflags i = case platformWordSize (targetPlatform dflags) of -- These conversions mean that things like toStgHalfWord (-1) -- do the right thing - 4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16)) - 8 -> StgHalfWord (fromInteger i :: Word32) - w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w) + PW4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16)) + PW8 -> StgHalfWord (fromInteger i :: Word32) instance Outputable StgHalfWord where ppr (StgHalfWord w) = integer (toInteger w) -hALF_WORD_SIZE :: DynFlags -> ByteOff -hALF_WORD_SIZE dflags = platformWordSize (targetPlatform dflags) `shiftR` 1 -hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int -hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2 +-- | Half word size in bytes +halfWordSize :: DynFlags -> ByteOff +halfWordSize dflags = platformWordSizeInBytes (targetPlatform dflags) `div` 2 + +halfWordSizeInBits :: DynFlags -> Int +halfWordSizeInBits dflags = platformWordSizeInBits (targetPlatform dflags) `div` 2 {- ************************************************************************ diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5d0b09a602..d7f6a2be06 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -5596,19 +5596,16 @@ mAX_PTR_TAG = tAG_MASK tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: DynFlags -> Integer tARGET_MIN_INT dflags = case platformWordSize (targetPlatform dflags) of - 4 -> toInteger (minBound :: Int32) - 8 -> toInteger (minBound :: Int64) - w -> panic ("tARGET_MIN_INT: Unknown platformWordSize: " ++ show w) + PW4 -> toInteger (minBound :: Int32) + PW8 -> toInteger (minBound :: Int64) tARGET_MAX_INT dflags = case platformWordSize (targetPlatform dflags) of - 4 -> toInteger (maxBound :: Int32) - 8 -> toInteger (maxBound :: Int64) - w -> panic ("tARGET_MAX_INT: Unknown platformWordSize: " ++ show w) + PW4 -> toInteger (maxBound :: Int32) + PW8 -> toInteger (maxBound :: Int64) tARGET_MAX_WORD dflags = case platformWordSize (targetPlatform dflags) of - 4 -> toInteger (maxBound :: Word32) - 8 -> toInteger (maxBound :: Word64) - w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w) + PW4 -> toInteger (maxBound :: Word32) + PW8 -> toInteger (maxBound :: Word64) {- ----------------------------------------------------------------------------- diff --git a/compiler/main/StaticPtrTable.hs b/compiler/main/StaticPtrTable.hs index 9f327c90d9..4f67ba0190 100644 --- a/compiler/main/StaticPtrTable.hs +++ b/compiler/main/StaticPtrTable.hs @@ -233,9 +233,10 @@ sptCreateStaticBinds hsc_env this_mod binds -- Choose either 'Word64#' or 'Word#' to represent the arguments of the -- 'Fingerprint' data constructor. - mkWord64LitWordRep dflags - | platformWordSize (targetPlatform dflags) < 8 = mkWord64LitWord64 - | otherwise = mkWordLit dflags . toInteger + mkWord64LitWordRep dflags = + case platformWordSize (targetPlatform dflags) of + PW4 -> mkWord64LitWord64 + PW8 -> mkWordLit dflags . toInteger lookupIdHscEnv :: Name -> IO Id lookupIdHscEnv n = lookupTypeHscEnv hsc_env n >>= diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs index b64b4efc33..33f1c5b2f7 100644 --- a/compiler/nativeGen/Dwarf.hs +++ b/compiler/nativeGen/Dwarf.hs @@ -116,7 +116,7 @@ compileUnitHeader unitU = sdocWithPlatform $ \plat -> , pprHalf 3 -- DWARF version , sectionOffset (ptext dwarfAbbrevLabel) (ptext dwarfAbbrevLabel) -- abbrevs offset - , text "\t.byte " <> ppr (platformWordSize plat) -- word size + , text "\t.byte " <> ppr (platformWordSizeInBytes plat) -- word size ] -- | Compilation unit footer, mainly establishing size of debug sections diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs index 01253544e6..a646f0bdfa 100644 --- a/compiler/nativeGen/Dwarf/Types.hs +++ b/compiler/nativeGen/Dwarf/Types.hs @@ -224,7 +224,7 @@ data DwarfARange -- address table entry. pprDwarfARanges :: [DwarfARange] -> Unique -> SDoc pprDwarfARanges arngs unitU = sdocWithPlatform $ \plat -> - let wordSize = platformWordSize plat + let wordSize = platformWordSizeInBytes plat paddingSize = 4 :: Int -- header is 12 bytes long. -- entry is 8 bytes (32-bit platform) or 16 bytes (64-bit platform). @@ -293,7 +293,7 @@ pprDwarfFrame DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCieProcs=procs} length = ppr cieEndLabel <> char '-' <> ppr cieStartLabel spReg = dwarfGlobalRegNo plat Sp retReg = dwarfReturnRegNo plat - wordSize = platformWordSize plat + wordSize = platformWordSizeInBytes plat pprInit :: (GlobalReg, Maybe UnwindExpr) -> SDoc pprInit (g, uw) = pprSetUnwind plat g (Nothing, uw) @@ -454,9 +454,9 @@ pprSetUnwind plat Sp (_, Just (UwReg s' o')) pprSetUnwind _ Sp (_, Just uw) = pprByte dW_CFA_def_cfa_expression $$ pprUnwindExpr False uw pprSetUnwind plat g (_, Just (UwDeref (UwReg Sp o))) - | o < 0 && ((-o) `mod` platformWordSize plat) == 0 -- expected case + | o < 0 && ((-o) `mod` platformWordSizeInBytes plat) == 0 -- expected case = pprByte (dW_CFA_offset + dwarfGlobalRegNo plat g) $$ - pprLEBWord (fromIntegral ((-o) `div` platformWordSize plat)) + pprLEBWord (fromIntegral ((-o) `div` platformWordSizeInBytes plat)) | otherwise = pprByte dW_CFA_offset_extended_sf $$ pprLEBRegNo plat g $$ @@ -517,10 +517,9 @@ wordAlign :: SDoc wordAlign = sdocWithPlatform $ \plat -> text "\t.align " <> case platformOS plat of OSDarwin -> case platformWordSize plat of - 8 -> text "3" - 4 -> text "2" - _other -> error "wordAlign: Unsupported word size!" - _other -> ppr (platformWordSize plat) + PW8 -> char '3' + PW4 -> char '2' + _other -> ppr (platformWordSizeInBytes plat) -- | Assembly for a single byte of constant DWARF data pprByte :: Word8 -> SDoc @@ -552,10 +551,8 @@ pprDwWord = pprData4' pprWord :: SDoc -> SDoc pprWord s = (<> s) . sdocWithPlatform $ \plat -> case platformWordSize plat of - 4 -> text "\t.long " - 8 -> text "\t.quad " - n -> panic $ "pprWord: Unsupported target platform word length " ++ - show n ++ "!" + PW4 -> text "\t.long " + PW8 -> text "\t.quad " -- | Prints a number in "little endian base 128" format. The idea is -- to optimize for small numbers by stopping once all further bytes diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index b17ea32f01..ee8edd86fd 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -98,7 +98,7 @@ ppc_mkStackAllocInstr' platform amount , STU fmt r0 (AddrRegReg sp tmp) ] where - fmt = intFormat $ widthFromBytes (platformWordSize platform) + fmt = intFormat $ widthFromBytes (platformWordSizeInBytes platform) zero = ImmInt 0 tmp = tmpReg platform immAmount = ImmInt amount diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 8a1876506d..83313a3ca9 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -433,10 +433,10 @@ shiftRightLogical :: DynFlags -> Integer -> Int -> Integer -- Shift right, putting zeros in rather than sign-propagating as Bits.shiftR would do -- Do this by converting to Word and back. Obviously this won't work for big -- values, but its ok as we use it here -shiftRightLogical dflags x n - | wordSizeInBits dflags == 32 = fromIntegral (fromInteger x `shiftR` n :: Word32) - | wordSizeInBits dflags == 64 = fromIntegral (fromInteger x `shiftR` n :: Word64) - | otherwise = panic "shiftRightLogical: unsupported word size" +shiftRightLogical dflags x n = + case platformWordSize (targetPlatform dflags) of + PW4 -> fromIntegral (fromInteger x `shiftR` n :: Word32) + PW8 -> fromIntegral (fromInteger x `shiftR` n :: Word64) -------------------------- retLit :: (DynFlags -> Literal) -> RuleM CoreExpr @@ -489,7 +489,7 @@ shiftRule shift_op _ -> mzero } wordSizeInBits :: DynFlags -> Integer -wordSizeInBits dflags = toInteger (platformWordSize (targetPlatform dflags) `shiftL` 3) +wordSizeInBits dflags = toInteger (platformWordSizeInBits (targetPlatform dflags)) -------------------------- floatOp2 :: (Rational -> Rational -> Rational) @@ -802,11 +802,12 @@ liftLitDynFlags f = do removeOp32 :: RuleM CoreExpr removeOp32 = do dflags <- getDynFlags - if wordSizeInBits dflags == 32 - then do - [e] <- getArgs - return e - else mzero + case platformWordSize (targetPlatform dflags) of + PW4 -> do + [e] <- getArgs + return e + PW8 -> + mzero getArgs :: RuleM [CoreExpr] getArgs = RuleM $ \_ _ args -> Just args diff --git a/libraries/ghc-boot/GHC/Platform.hs b/libraries/ghc-boot/GHC/Platform.hs index 01d709a199..ea1aa5e323 100644 --- a/libraries/ghc-boot/GHC/Platform.hs +++ b/libraries/ghc-boot/GHC/Platform.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase, ScopedTypeVariables #-} -- | A description of the platform we're compiling for. -- module GHC.Platform ( Platform(..), + PlatformWordSize(..), Arch(..), OS(..), ArmISA(..), @@ -17,6 +18,8 @@ module GHC.Platform ( osMachOTarget, osSubsectionsViaSymbols, platformUsesFrameworks, + platformWordSizeInBytes, + platformWordSizeInBits, PlatformMisc(..), IntegerLibrary(..), @@ -28,6 +31,7 @@ module GHC.Platform ( where import Prelude -- See Note [Why do we import Prelude here?] +import GHC.Read -- | Contains enough information for the native code generator to emit -- code for this platform. @@ -37,7 +41,7 @@ data Platform platformOS :: OS, -- Word size in bytes (i.e. normally 4 or 8, -- for 32bit and 64bit platforms respectively) - platformWordSize :: {-# UNPACK #-} !Int, + platformWordSize :: PlatformWordSize, platformUnregisterised :: Bool, platformHasGnuNonexecStack :: Bool, platformHasIdentDirective :: Bool, @@ -46,6 +50,31 @@ data Platform } deriving (Read, Show, Eq) +data PlatformWordSize + = PW4 -- ^ A 32-bit platform + | PW8 -- ^ A 64-bit platform + deriving (Eq) + +instance Show PlatformWordSize where + show PW4 = "4" + show PW8 = "8" + +instance Read PlatformWordSize where + readPrec = do + i :: Int <- readPrec + case i of + 4 -> return PW4 + 8 -> return PW8 + other -> fail ("Invalid PlatformWordSize: " ++ show other) + +platformWordSizeInBytes :: Platform -> Int +platformWordSizeInBytes p = + case platformWordSize p of + PW4 -> 4 + PW8 -> 8 + +platformWordSizeInBits :: Platform -> Int +platformWordSizeInBits p = platformWordSizeInBytes p * 8 -- | Architectures that the native code generator knows about. -- TODO: It might be nice to extend these constructors with information @@ -185,7 +214,10 @@ data PPC_64ABI -- | This predicate tells us whether the platform is 32-bit. target32Bit :: Platform -> Bool -target32Bit p = platformWordSize p == 4 +target32Bit p = + case platformWordSize p of + PW4 -> True + PW8 -> False -- | This predicate tells us whether the OS supports ELF-like shared libraries. osElfTarget :: OS -> Bool |