diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Parser/Header.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Platform.hs | 216 | ||||
| -rw-r--r-- | compiler/GHC/Settings.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Settings/IO.hs | 41 | ||||
| -rw-r--r-- | compiler/GHC/Unit/State.hs | 6 | ||||
| -rw-r--r-- | compiler/ghc.cabal.in | 9 |
9 files changed, 278 insertions, 22 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs index c7fac76828..22ce5fac18 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -1683,11 +1683,11 @@ interpretPackageEnv dflags = do where -- Loading environments (by name or by location) - platformArchOs = platformMini (targetPlatform dflags) + archOS = platformArchOS (targetPlatform dflags) namedEnvPath :: String -> MaybeT IO FilePath namedEnvPath name = do - appdir <- versionedAppDir (programName dflags) platformArchOs + appdir <- versionedAppDir (programName dflags) archOS return $ appdir </> "environments" </> name probeEnvName :: String -> MaybeT IO FilePath @@ -1724,7 +1724,7 @@ interpretPackageEnv dflags = do -- e.g. .ghc.environment.x86_64-linux-7.6.3 localEnvFileName :: FilePath - localEnvFileName = ".ghc.environment" <.> versionedFilePath platformArchOs + localEnvFileName = ".ghc.environment" <.> versionedFilePath archOS -- Search for an env file, starting in the current dir and looking upwards. -- Fail if we get to the users home dir or the filesystem root. That is, diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index 1603c38e71..36010a76af 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -42,6 +42,7 @@ import GHC.Prelude import GHC.Driver.Pipeline.Monad import GHC.Unit.State import GHC.Platform.Ways +import GHC.Platform.ArchOS import GHC.Parser.Header import GHC.Driver.Phases import GHC.SysTools diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 2c2c3db7c2..01555dff8f 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -1000,13 +1000,13 @@ opt_i dflags= toolSettings_opt_i $ toolSettings dflags -- | The directory for this version of ghc in the user's app directory -- (typically something like @~/.ghc/x86_64-linux-7.6.3@) -- -versionedAppDir :: String -> PlatformMini -> MaybeT IO FilePath +versionedAppDir :: String -> ArchOS -> MaybeT IO FilePath versionedAppDir appname platform = do -- Make sure we handle the case the HOME isn't set (see #11678) appdir <- tryMaybeT $ getAppUserDataDirectory appname return $ appdir </> versionedFilePath platform -versionedFilePath :: PlatformMini -> FilePath +versionedFilePath :: ArchOS -> FilePath versionedFilePath platform = uniqueSubdir platform -- | The 'GhcMode' tells us whether we're doing multi-module @@ -3633,8 +3633,8 @@ supportedLanguages = map (flagSpecName . snd) languageFlagsDeps supportedLanguageOverlays :: [String] supportedLanguageOverlays = map (flagSpecName . snd) safeHaskellFlagsDeps -supportedExtensions :: PlatformMini -> [String] -supportedExtensions targetPlatformMini = concatMap toFlagSpecNamePair xFlags +supportedExtensions :: ArchOS -> [String] +supportedExtensions (ArchOS _ os) = concatMap toFlagSpecNamePair xFlags where toFlagSpecNamePair flg -- IMPORTANT! Make sure that `ghc --supported-extensions` omits @@ -3645,13 +3645,13 @@ supportedExtensions targetPlatformMini = concatMap toFlagSpecNamePair xFlags | isAIX, flagSpecFlag flg == LangExt.QuasiQuotes = [noName] | otherwise = [name, noName] where - isAIX = platformMini_os targetPlatformMini == OSAIX + isAIX = os == OSAIX noName = "No" ++ name name = flagSpecName flg -supportedLanguagesAndExtensions :: PlatformMini -> [String] -supportedLanguagesAndExtensions targetPlatformMini = - supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions targetPlatformMini +supportedLanguagesAndExtensions :: ArchOS -> [String] +supportedLanguagesAndExtensions arch_os = + supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions arch_os -- | These -X<blah> flags cannot be reversed with -XNo<blah> languageFlagsDeps :: [(Deprecation, FlagSpec Language)] diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs index bfdeb71631..dfc7aec2ad 100644 --- a/compiler/GHC/Parser/Header.hs +++ b/compiler/GHC/Parser/Header.hs @@ -316,7 +316,7 @@ checkExtension dflags (L l ext) else unsupportedExtnError dflags l ext' where ext' = unpackFS ext - supported = supportedLanguagesAndExtensions $ platformMini $ targetPlatform dflags + supported = supportedLanguagesAndExtensions $ platformArchOS $ targetPlatform dflags languagePragParseError :: DynFlags -> SrcSpan -> a languagePragParseError dflags loc = @@ -332,7 +332,7 @@ unsupportedExtnError dflags loc unsup = text "Unsupported extension: " <> text unsup $$ if null suggestions then Outputable.empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions) where - supported = supportedLanguagesAndExtensions $ platformMini $ targetPlatform dflags + supported = supportedLanguagesAndExtensions $ platformArchOS $ targetPlatform dflags suggestions = fuzzyMatch unsup supported diff --git a/compiler/GHC/Platform.hs b/compiler/GHC/Platform.hs new file mode 100644 index 0000000000..56a18e9c88 --- /dev/null +++ b/compiler/GHC/Platform.hs @@ -0,0 +1,216 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Platform description +module GHC.Platform + ( Platform (..) + , PlatformWordSize(..) + , PlatformConstants(..) + , platformArch + , platformOS + , ArchOS(..) + , Arch(..) + , OS(..) + , ArmISA(..) + , ArmISAExt(..) + , ArmABI(..) + , PPC_64ABI(..) + , ByteOrder(..) + , target32Bit + , isARM + , osElfTarget + , osMachOTarget + , osSubsectionsViaSymbols + , platformUsesFrameworks + , platformWordSizeInBytes + , platformWordSizeInBits + , platformMinInt + , platformMaxInt + , platformMaxWord + , platformInIntRange + , platformInWordRange + , PlatformMisc(..) + , SseVersion (..) + , BmiVersion (..) + ) +where + +import Prelude -- See Note [Why do we import Prelude here?] + +import Data.Word +import Data.Int + +import GHC.Read +import GHC.ByteOrder (ByteOrder(..)) +import GHC.Platform.Constants +import GHC.Platform.ArchOS + +-- | Platform description +-- +-- This is used to describe platforms so that we can generate code for them. +data Platform = Platform + { platformArchOS :: !ArchOS -- ^ Architecture and OS + , platformWordSize :: !PlatformWordSize -- ^ Word size + , platformByteOrder :: !ByteOrder -- ^ Byte order (endianness) + , platformUnregisterised :: !Bool + , platformHasGnuNonexecStack :: !Bool + , platformHasIdentDirective :: !Bool + , platformHasSubsectionsViaSymbols :: !Bool + , platformIsCrossCompiling :: !Bool + , platformLeadingUnderscore :: !Bool -- ^ Symbols need underscore prefix + , platformTablesNextToCode :: !Bool + -- ^ Determines whether we will be compiling info tables that reside just + -- before the entry code, or with an indirection to the entry code. See + -- TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h. + , platformConstants :: !PlatformConstants + -- ^ Constants such as structure offsets, type sizes, etc. + } + 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 + +-- | Platform architecture +platformArch :: Platform -> Arch +platformArch platform = case platformArchOS platform of + ArchOS arch _ -> arch + +-- | Platform OS +platformOS :: Platform -> OS +platformOS platform = case platformArchOS platform of + ArchOS _ os -> os + +isARM :: Arch -> Bool +isARM (ArchARM {}) = True +isARM ArchARM64 = True +isARM _ = False + +-- | This predicate tells us whether the platform is 32-bit. +target32Bit :: Platform -> Bool +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 +osElfTarget OSLinux = True +osElfTarget OSFreeBSD = True +osElfTarget OSDragonFly = True +osElfTarget OSOpenBSD = True +osElfTarget OSNetBSD = True +osElfTarget OSSolaris2 = True +osElfTarget OSDarwin = False +osElfTarget OSMinGW32 = False +osElfTarget OSKFreeBSD = True +osElfTarget OSHaiku = True +osElfTarget OSQNXNTO = False +osElfTarget OSAIX = False +osElfTarget OSHurd = True +osElfTarget OSUnknown = False + -- Defaulting to False is safe; it means don't rely on any + -- ELF-specific functionality. It is important to have a default for + -- portability, otherwise we have to answer this question for every + -- new platform we compile on (even unreg). + +-- | This predicate tells us whether the OS support Mach-O shared libraries. +osMachOTarget :: OS -> Bool +osMachOTarget OSDarwin = True +osMachOTarget _ = False + +osUsesFrameworks :: OS -> Bool +osUsesFrameworks OSDarwin = True +osUsesFrameworks _ = False + +platformUsesFrameworks :: Platform -> Bool +platformUsesFrameworks = osUsesFrameworks . platformOS + +osSubsectionsViaSymbols :: OS -> Bool +osSubsectionsViaSymbols OSDarwin = True +osSubsectionsViaSymbols _ = False + +-- | Minimum representable Int value for the given platform +platformMinInt :: Platform -> Integer +platformMinInt p = case platformWordSize p of + PW4 -> toInteger (minBound :: Int32) + PW8 -> toInteger (minBound :: Int64) + +-- | Maximum representable Int value for the given platform +platformMaxInt :: Platform -> Integer +platformMaxInt p = case platformWordSize p of + PW4 -> toInteger (maxBound :: Int32) + PW8 -> toInteger (maxBound :: Int64) + +-- | Maximum representable Word value for the given platform +platformMaxWord :: Platform -> Integer +platformMaxWord p = case platformWordSize p of + PW4 -> toInteger (maxBound :: Word32) + PW8 -> toInteger (maxBound :: Word64) + +-- | Test if the given Integer is representable with a platform Int +platformInIntRange :: Platform -> Integer -> Bool +platformInIntRange platform x = x >= platformMinInt platform && x <= platformMaxInt platform + +-- | Test if the given Integer is representable with a platform Word +platformInWordRange :: Platform -> Integer -> Bool +platformInWordRange platform x = x >= 0 && x <= platformMaxWord platform + + +-------------------------------------------------- +-- Instruction sets +-------------------------------------------------- + +-- | x86 SSE instructions +data SseVersion + = SSE1 + | SSE2 + | SSE3 + | SSE4 + | SSE42 + deriving (Eq, Ord) + +-- | x86 BMI (bit manipulation) instructions +data BmiVersion + = BMI1 + | BMI2 + deriving (Eq, Ord) + + +-- | Platform-specific settings formerly hard-coded in Config.hs. +-- +-- These should probably be all be triaged whether they can be computed from +-- other settings or belong in another another place (like 'Platform' above). +data PlatformMisc = PlatformMisc + { -- TODO Recalculate string from richer info? + platformMisc_targetPlatformString :: String + , platformMisc_ghcWithInterpreter :: Bool + , platformMisc_ghcWithSMP :: Bool + , platformMisc_ghcRTSWays :: String + , platformMisc_libFFI :: Bool + , platformMisc_ghcThreaded :: Bool + , platformMisc_ghcDebugged :: Bool + , platformMisc_ghcRtsWithLibdw :: Bool + , platformMisc_llvmTarget :: String + } diff --git a/compiler/GHC/Settings.hs b/compiler/GHC/Settings.hs index 12ad3ce94b..49a2018252 100644 --- a/compiler/GHC/Settings.hs +++ b/compiler/GHC/Settings.hs @@ -8,7 +8,6 @@ module GHC.Settings , GhcNameVersion (..) , Platform (..) , PlatformMisc (..) - , PlatformMini (..) -- * Accessors , sProgramName , sProjectVersion diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs index c4e47618d2..d1ec388195 100644 --- a/compiler/GHC/Settings/IO.hs +++ b/compiler/GHC/Settings/IO.hs @@ -11,7 +11,6 @@ module GHC.Settings.IO import GHC.Prelude -import GHC.Settings.Platform import GHC.Settings.Utils import GHC.Settings.Config @@ -71,12 +70,12 @@ initSettings top_dir = do -- just partially applying those functions and throwing 'Left's; they're -- written in a very portable style to keep ghc-boot light. let getSetting key = either pgmError pure $ - getFilePathSetting0 top_dir settingsFile mySettings key + getRawFilePathSetting top_dir settingsFile mySettings key getToolSetting :: String -> ExceptT SettingsError m String getToolSetting key = expandToolDir mtool_dir <$> getSetting key getBooleanSetting :: String -> ExceptT SettingsError m Bool getBooleanSetting key = either pgmError pure $ - getBooleanSetting0 settingsFile mySettings key + getRawBooleanSetting settingsFile mySettings key targetPlatformString <- getSetting "target platform string" myExtraGccViaCFlags <- getSetting "GCC extra via C opts" -- On Windows, mingw is distributed with GHC, @@ -228,3 +227,39 @@ initSettings top_dir = do , sRawSettings = settingsList } + +getTargetPlatform + :: FilePath -- ^ Settings filepath (for error messages) + -> RawSettings -- ^ Raw settings file contents + -> PlatformConstants -- ^ Platform constants + -> Either String Platform +getTargetPlatform settingsFile settings constants = do + let + getBooleanSetting = getRawBooleanSetting settingsFile settings + readSetting :: (Show a, Read a) => String -> Either String a + readSetting = readRawSetting settingsFile settings + + targetArchOS <- getTargetArchOS settingsFile settings + targetWordSize <- readSetting "target word size" + targetWordBigEndian <- getBooleanSetting "target word big endian" + targetLeadingUnderscore <- getBooleanSetting "Leading underscore" + targetUnregisterised <- getBooleanSetting "Unregisterised" + targetHasGnuNonexecStack <- getBooleanSetting "target has GNU nonexec stack" + targetHasIdentDirective <- getBooleanSetting "target has .ident directive" + targetHasSubsectionsViaSymbols <- getBooleanSetting "target has subsections via symbols" + crossCompiling <- getBooleanSetting "cross compiling" + tablesNextToCode <- getBooleanSetting "Tables next to code" + + pure $ Platform + { platformArchOS = targetArchOS + , platformWordSize = targetWordSize + , platformByteOrder = if targetWordBigEndian then BigEndian else LittleEndian + , platformUnregisterised = targetUnregisterised + , platformHasGnuNonexecStack = targetHasGnuNonexecStack + , platformHasIdentDirective = targetHasIdentDirective + , platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols + , platformIsCrossCompiling = crossCompiling + , platformLeadingUnderscore = targetLeadingUnderscore + , platformTablesNextToCode = tablesNextToCode + , platformConstants = constants + } diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index fb50966195..93c0b86dc8 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -314,7 +314,7 @@ instance Monoid UnitVisibility where -- | Unit configuration data UnitConfig = UnitConfig - { unitConfigPlatformArchOs :: !PlatformMini -- ^ Platform + { unitConfigPlatformArchOS :: !ArchOS -- ^ Platform arch and OS , unitConfigWays :: !(Set Way) -- ^ Ways to use , unitConfigProgramName :: !String -- ^ Name of the compiler (e.g. "GHC", "GHCJS"). Used to fetch environment @@ -356,7 +356,7 @@ initUnitConfig dflags = | otherwise = filter (/= homeUnitId dflags) [baseUnitId, rtsUnitId] in UnitConfig - { unitConfigPlatformArchOs = platformMini (targetPlatform dflags) + { unitConfigPlatformArchOS = platformArchOS (targetPlatform dflags) , unitConfigProgramName = programName dflags , unitConfigWays = ways dflags @@ -646,7 +646,7 @@ getUnitDbRefs cfg = do resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe FilePath) resolveUnitDatabase cfg GlobalPkgDb = return $ Just (unitConfigGlobalDB cfg) resolveUnitDatabase cfg UserPkgDb = runMaybeT $ do - dir <- versionedAppDir (unitConfigProgramName cfg) (unitConfigPlatformArchOs cfg) + dir <- versionedAppDir (unitConfigProgramName cfg) (unitConfigPlatformArchOS cfg) let pkgconf = dir </> unitConfigDBName cfg exist <- tryMaybeT $ doesDirectoryExist pkgconf if exist then return pkgconf else mzero diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 5c153817e7..efa45c89e4 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -181,8 +181,6 @@ Library GHC.Driver.Monad GHC.Driver.Hooks GHC.Driver.Flags - GHC.Platform.Ways - GHC.Platform.Profile GHC.Types.Id GHC.Types.Id.Info GHC.Core.Predicate @@ -258,6 +256,9 @@ Library GHC.Cmm.Ppr.Decl GHC.Cmm.Ppr.Expr GHC.Data.Bitmap + GHC.Platform + GHC.Platform.Ways + GHC.Platform.Profile GHC.Platform.Regs GHC.Platform.ARM GHC.Platform.ARM64 @@ -566,6 +567,10 @@ Library GHC.Cmm.Dataflow.Graph GHC.Cmm.Dataflow.Label + reexported-modules: + GHC.Platform.ArchOS + GHC.Platform.Host + Exposed-Modules: GHC.CmmToAsm GHC.CmmToAsm.Reg.Target |