{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}

-- | Platform description
module GHC.Platform
   ( Platform (..)
   , PlatformWordSize(..)
   , platformArch
   , platformOS
   , ArchOS(..)
   , Arch(..)
   , OS(..)
   , ArmISA(..)
   , ArmISAExt(..)
   , ArmABI(..)
   , PPC_64ABI(..)
   , ByteOrder(..)
   , target32Bit
   , isARM
   , osElfTarget
   , osMachOTarget
   , osSubsectionsViaSymbols
   , platformUsesFrameworks
   , platformWordSizeInBytes
   , platformWordSizeInBits
   , platformMinInt
   , platformMaxInt
   , platformMaxWord
   , platformInIntRange
   , platformInWordRange
   , platformCConvNeedsExtension
   , PlatformMisc(..)
   , SseVersion (..)
   , BmiVersion (..)
   -- * Platform constants
   , PlatformConstants(..)
   , lookupPlatformConstants
   , platformConstants
   -- * Shared libraries
   , platformSOName
   , platformHsSOName
   , platformSOExt
   , genericPlatform
   )
where

import Prelude -- See Note [Why do we import Prelude here?]

import GHC.Read
import GHC.ByteOrder (ByteOrder(..))
import GHC.Platform.Constants
import GHC.Platform.ArchOS
import GHC.Utils.Panic.Plain

import Data.Word
import Data.Int
import System.FilePath
import System.Directory

-- | Platform description
--
-- This is used to describe platforms so that we can generate code for them.
data Platform = Platform
   { Platform -> ArchOS
platformArchOS                   :: !ArchOS           -- ^ Architecture and OS
   , Platform -> PlatformWordSize
platformWordSize                 :: !PlatformWordSize -- ^ Word size
   , Platform -> ByteOrder
platformByteOrder                :: !ByteOrder        -- ^ Byte order (endianness)
   , Platform -> Bool
platformUnregisterised           :: !Bool
   , Platform -> Bool
platformHasGnuNonexecStack       :: !Bool
   , Platform -> Bool
platformHasIdentDirective        :: !Bool
   , Platform -> Bool
platformHasSubsectionsViaSymbols :: !Bool
   , Platform -> Bool
platformIsCrossCompiling         :: !Bool
   , Platform -> Bool
platformLeadingUnderscore        :: !Bool             -- ^ Symbols need underscore prefix
   , Platform -> Bool
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.
   , Platform -> Maybe PlatformConstants
platform_constants               :: !(Maybe PlatformConstants)
      -- ^ Constants such as structure offsets, type sizes, etc.
   }
   deriving (ReadPrec [Platform]
ReadPrec Platform
Int -> ReadS Platform
ReadS [Platform]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Platform]
$creadListPrec :: ReadPrec [Platform]
readPrec :: ReadPrec Platform
$creadPrec :: ReadPrec Platform
readList :: ReadS [Platform]
$creadList :: ReadS [Platform]
readsPrec :: Int -> ReadS Platform
$creadsPrec :: Int -> ReadS Platform
Read, Int -> Platform -> ShowS
[Platform] -> ShowS
Platform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Platform] -> ShowS
$cshowList :: [Platform] -> ShowS
show :: Platform -> String
$cshow :: Platform -> String
showsPrec :: Int -> Platform -> ShowS
$cshowsPrec :: Int -> Platform -> ShowS
Show, Platform -> Platform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Platform -> Platform -> Bool
$c/= :: Platform -> Platform -> Bool
== :: Platform -> Platform -> Bool
$c== :: Platform -> Platform -> Bool
Eq)

platformConstants :: Platform -> PlatformConstants
platformConstants :: Platform -> PlatformConstants
platformConstants Platform
platform = case Platform -> Maybe PlatformConstants
platform_constants Platform
platform of
  Maybe PlatformConstants
Nothing -> forall a. String -> a
panic String
"Platform constants not available!"
  Just PlatformConstants
c  -> PlatformConstants
c

genericPlatform :: Platform
genericPlatform :: Platform
genericPlatform = Platform
   { platformArchOS :: ArchOS
platformArchOS                  = Arch -> OS -> ArchOS
ArchOS Arch
ArchX86_64 OS
OSLinux
   , platformWordSize :: PlatformWordSize
platformWordSize                = PlatformWordSize
PW8
   , platformByteOrder :: ByteOrder
platformByteOrder               = ByteOrder
LittleEndian
   , platformUnregisterised :: Bool
platformUnregisterised          = Bool
False
   , platformHasGnuNonexecStack :: Bool
platformHasGnuNonexecStack      = Bool
False
   , platformHasIdentDirective :: Bool
platformHasIdentDirective       = Bool
False
   , platformHasSubsectionsViaSymbols :: Bool
platformHasSubsectionsViaSymbols= Bool
False
   , platformIsCrossCompiling :: Bool
platformIsCrossCompiling        = Bool
False
   , platformLeadingUnderscore :: Bool
platformLeadingUnderscore       = Bool
False
   , platformTablesNextToCode :: Bool
platformTablesNextToCode        = Bool
True
   , platform_constants :: Maybe PlatformConstants
platform_constants               = forall a. Maybe a
Nothing
   }

data PlatformWordSize
  = PW4 -- ^ A 32-bit platform
  | PW8 -- ^ A 64-bit platform
  deriving (PlatformWordSize -> PlatformWordSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlatformWordSize -> PlatformWordSize -> Bool
$c/= :: PlatformWordSize -> PlatformWordSize -> Bool
== :: PlatformWordSize -> PlatformWordSize -> Bool
$c== :: PlatformWordSize -> PlatformWordSize -> Bool
Eq, Eq PlatformWordSize
PlatformWordSize -> PlatformWordSize -> Bool
PlatformWordSize -> PlatformWordSize -> Ordering
PlatformWordSize -> PlatformWordSize -> PlatformWordSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PlatformWordSize -> PlatformWordSize -> PlatformWordSize
$cmin :: PlatformWordSize -> PlatformWordSize -> PlatformWordSize
max :: PlatformWordSize -> PlatformWordSize -> PlatformWordSize
$cmax :: PlatformWordSize -> PlatformWordSize -> PlatformWordSize
>= :: PlatformWordSize -> PlatformWordSize -> Bool
$c>= :: PlatformWordSize -> PlatformWordSize -> Bool
> :: PlatformWordSize -> PlatformWordSize -> Bool
$c> :: PlatformWordSize -> PlatformWordSize -> Bool
<= :: PlatformWordSize -> PlatformWordSize -> Bool
$c<= :: PlatformWordSize -> PlatformWordSize -> Bool
< :: PlatformWordSize -> PlatformWordSize -> Bool
$c< :: PlatformWordSize -> PlatformWordSize -> Bool
compare :: PlatformWordSize -> PlatformWordSize -> Ordering
$ccompare :: PlatformWordSize -> PlatformWordSize -> Ordering
Ord)

instance Show PlatformWordSize where
  show :: PlatformWordSize -> String
show PlatformWordSize
PW4 = String
"4"
  show PlatformWordSize
PW8 = String
"8"

instance Read PlatformWordSize where
  readPrec :: ReadPrec PlatformWordSize
readPrec = do
    Int
i :: Int <- forall a. Read a => ReadPrec a
readPrec
    case Int
i of
      Int
4 -> forall (m :: * -> *) a. Monad m => a -> m a
return PlatformWordSize
PW4
      Int
8 -> forall (m :: * -> *) a. Monad m => a -> m a
return PlatformWordSize
PW8
      Int
other -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid PlatformWordSize: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
other)

platformWordSizeInBytes :: Platform -> Int
platformWordSizeInBytes :: Platform -> Int
platformWordSizeInBytes Platform
p =
    case Platform -> PlatformWordSize
platformWordSize Platform
p of
      PlatformWordSize
PW4 -> Int
4
      PlatformWordSize
PW8 -> Int
8

platformWordSizeInBits :: Platform -> Int
platformWordSizeInBits :: Platform -> Int
platformWordSizeInBits Platform
p = Platform -> Int
platformWordSizeInBytes Platform
p forall a. Num a => a -> a -> a
* Int
8

-- | Platform architecture
platformArch :: Platform -> Arch
platformArch :: Platform -> Arch
platformArch Platform
platform = case Platform -> ArchOS
platformArchOS Platform
platform of
   ArchOS Arch
arch OS
_ -> Arch
arch

-- | Platform OS
platformOS :: Platform -> OS
platformOS :: Platform -> OS
platformOS Platform
platform = case Platform -> ArchOS
platformArchOS Platform
platform of
   ArchOS Arch
_ OS
os -> OS
os

isARM :: Arch -> Bool
isARM :: Arch -> Bool
isARM (ArchARM {}) = Bool
True
isARM Arch
ArchAArch64  = Bool
True
isARM Arch
_ = Bool
False

-- | This predicate tells us whether the platform is 32-bit.
target32Bit :: Platform -> Bool
target32Bit :: Platform -> Bool
target32Bit Platform
p =
    case Platform -> PlatformWordSize
platformWordSize Platform
p of
      PlatformWordSize
PW4 -> Bool
True
      PlatformWordSize
PW8 -> Bool
False

-- | This predicate tells us whether the OS supports ELF-like shared libraries.
osElfTarget :: OS -> Bool
osElfTarget :: OS -> Bool
osElfTarget OS
OSLinux     = Bool
True
osElfTarget OS
OSFreeBSD   = Bool
True
osElfTarget OS
OSDragonFly = Bool
True
osElfTarget OS
OSOpenBSD   = Bool
True
osElfTarget OS
OSNetBSD    = Bool
True
osElfTarget OS
OSSolaris2  = Bool
True
osElfTarget OS
OSDarwin    = Bool
False
osElfTarget OS
OSMinGW32   = Bool
False
osElfTarget OS
OSKFreeBSD  = Bool
True
osElfTarget OS
OSHaiku     = Bool
True
osElfTarget OS
OSQNXNTO    = Bool
False
osElfTarget OS
OSAIX       = Bool
False
osElfTarget OS
OSHurd      = Bool
True
osElfTarget OS
OSUnknown   = Bool
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 :: OS -> Bool
osMachOTarget OS
OSDarwin = Bool
True
osMachOTarget OS
_ = Bool
False

osUsesFrameworks :: OS -> Bool
osUsesFrameworks :: OS -> Bool
osUsesFrameworks OS
OSDarwin = Bool
True
osUsesFrameworks OS
_        = Bool
False

platformUsesFrameworks :: Platform -> Bool
platformUsesFrameworks :: Platform -> Bool
platformUsesFrameworks = OS -> Bool
osUsesFrameworks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> OS
platformOS

osSubsectionsViaSymbols :: OS -> Bool
osSubsectionsViaSymbols :: OS -> Bool
osSubsectionsViaSymbols OS
OSDarwin = Bool
True
osSubsectionsViaSymbols OS
_        = Bool
False

-- | Minimum representable Int value for the given platform
platformMinInt :: Platform -> Integer
platformMinInt :: Platform -> Integer
platformMinInt Platform
p = case Platform -> PlatformWordSize
platformWordSize Platform
p of
   PlatformWordSize
PW4 -> forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int32)
   PlatformWordSize
PW8 -> forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int64)

-- | Maximum representable Int value for the given platform
platformMaxInt :: Platform -> Integer
platformMaxInt :: Platform -> Integer
platformMaxInt Platform
p = case Platform -> PlatformWordSize
platformWordSize Platform
p of
   PlatformWordSize
PW4 -> forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int32)
   PlatformWordSize
PW8 -> forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int64)

-- | Maximum representable Word value for the given platform
platformMaxWord :: Platform -> Integer
platformMaxWord :: Platform -> Integer
platformMaxWord Platform
p = case Platform -> PlatformWordSize
platformWordSize Platform
p of
   PlatformWordSize
PW4 -> forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word32)
   PlatformWordSize
PW8 -> forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word64)

-- | Test if the given Integer is representable with a platform Int
platformInIntRange :: Platform -> Integer -> Bool
platformInIntRange :: Platform -> Integer -> Bool
platformInIntRange Platform
platform Integer
x = Integer
x forall a. Ord a => a -> a -> Bool
>= Platform -> Integer
platformMinInt Platform
platform Bool -> Bool -> Bool
&& Integer
x forall a. Ord a => a -> a -> Bool
<= Platform -> Integer
platformMaxInt Platform
platform

-- | Test if the given Integer is representable with a platform Word
platformInWordRange :: Platform -> Integer -> Bool
platformInWordRange :: Platform -> Integer -> Bool
platformInWordRange Platform
platform Integer
x = Integer
x forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
x forall a. Ord a => a -> a -> Bool
<= Platform -> Integer
platformMaxWord Platform
platform

-- | For some architectures the C calling convention is that any
-- integer shorter than 64 bits is replaced by its 64 bits
-- representation using sign or zero extension.
platformCConvNeedsExtension :: Platform -> Bool
platformCConvNeedsExtension :: Platform -> Bool
platformCConvNeedsExtension Platform
platform = case Platform -> Arch
platformArch Platform
platform of
  ArchPPC_64 PPC_64ABI
_ -> Bool
True
  Arch
ArchS390X    -> Bool
True
  Arch
ArchRISCV64  -> Bool
True
  Arch
ArchAArch64
      -- Apple's AArch64 ABI requires that the caller sign-extend
      -- small integer arguments. See
      -- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms
    | OS
OSDarwin <- Platform -> OS
platformOS Platform
platform -> Bool
True
  Arch
_            -> Bool
False


--------------------------------------------------
-- Instruction sets
--------------------------------------------------

-- | x86 SSE instructions
data SseVersion
   = SSE1
   | SSE2
   | SSE3
   | SSE4
   | SSE42
   deriving (SseVersion -> SseVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SseVersion -> SseVersion -> Bool
$c/= :: SseVersion -> SseVersion -> Bool
== :: SseVersion -> SseVersion -> Bool
$c== :: SseVersion -> SseVersion -> Bool
Eq, Eq SseVersion
SseVersion -> SseVersion -> Bool
SseVersion -> SseVersion -> Ordering
SseVersion -> SseVersion -> SseVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SseVersion -> SseVersion -> SseVersion
$cmin :: SseVersion -> SseVersion -> SseVersion
max :: SseVersion -> SseVersion -> SseVersion
$cmax :: SseVersion -> SseVersion -> SseVersion
>= :: SseVersion -> SseVersion -> Bool
$c>= :: SseVersion -> SseVersion -> Bool
> :: SseVersion -> SseVersion -> Bool
$c> :: SseVersion -> SseVersion -> Bool
<= :: SseVersion -> SseVersion -> Bool
$c<= :: SseVersion -> SseVersion -> Bool
< :: SseVersion -> SseVersion -> Bool
$c< :: SseVersion -> SseVersion -> Bool
compare :: SseVersion -> SseVersion -> Ordering
$ccompare :: SseVersion -> SseVersion -> Ordering
Ord)

-- | x86 BMI (bit manipulation) instructions
data BmiVersion
   = BMI1
   | BMI2
   deriving (BmiVersion -> BmiVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BmiVersion -> BmiVersion -> Bool
$c/= :: BmiVersion -> BmiVersion -> Bool
== :: BmiVersion -> BmiVersion -> Bool
$c== :: BmiVersion -> BmiVersion -> Bool
Eq, Eq BmiVersion
BmiVersion -> BmiVersion -> Bool
BmiVersion -> BmiVersion -> Ordering
BmiVersion -> BmiVersion -> BmiVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BmiVersion -> BmiVersion -> BmiVersion
$cmin :: BmiVersion -> BmiVersion -> BmiVersion
max :: BmiVersion -> BmiVersion -> BmiVersion
$cmax :: BmiVersion -> BmiVersion -> BmiVersion
>= :: BmiVersion -> BmiVersion -> Bool
$c>= :: BmiVersion -> BmiVersion -> Bool
> :: BmiVersion -> BmiVersion -> Bool
$c> :: BmiVersion -> BmiVersion -> Bool
<= :: BmiVersion -> BmiVersion -> Bool
$c<= :: BmiVersion -> BmiVersion -> Bool
< :: BmiVersion -> BmiVersion -> Bool
$c< :: BmiVersion -> BmiVersion -> Bool
compare :: BmiVersion -> BmiVersion -> Ordering
$ccompare :: BmiVersion -> BmiVersion -> Ordering
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 -> String
platformMisc_targetPlatformString :: String
  , PlatformMisc -> Bool
platformMisc_ghcWithInterpreter   :: Bool
  , PlatformMisc -> Bool
platformMisc_ghcWithSMP           :: Bool
  , PlatformMisc -> String
platformMisc_ghcRTSWays           :: String
  , PlatformMisc -> Bool
platformMisc_libFFI               :: Bool
  , PlatformMisc -> Bool
platformMisc_ghcRtsWithLibdw      :: Bool
  , PlatformMisc -> String
platformMisc_llvmTarget           :: String
  }

platformSOName :: Platform -> FilePath -> FilePath
platformSOName :: Platform -> ShowS
platformSOName Platform
platform String
root = case Platform -> OS
platformOS Platform
platform of
   OS
OSMinGW32 ->           String
root  String -> ShowS
<.> Platform -> String
platformSOExt Platform
platform
   OS
_         -> (String
"lib" forall a. [a] -> [a] -> [a]
++ String
root) String -> ShowS
<.> Platform -> String
platformSOExt Platform
platform

platformHsSOName :: Platform -> FilePath -> FilePath
platformHsSOName :: Platform -> ShowS
platformHsSOName Platform
platform String
root = (String
"lib" forall a. [a] -> [a] -> [a]
++ String
root) String -> ShowS
<.> Platform -> String
platformSOExt Platform
platform

platformSOExt :: Platform -> FilePath
platformSOExt :: Platform -> String
platformSOExt Platform
platform
    = case Platform -> OS
platformOS Platform
platform of
      OS
OSDarwin  -> String
"dylib"
      OS
OSMinGW32 -> String
"dll"
      OS
_         -> String
"so"

-- Note [Platform constants]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- The RTS is partly written in C, hence we use an external C compiler to build
-- it. Thus GHC must somehow retrieve some information about the produced code
-- (sizes of types, offsets of struct fields, etc.) to produce compatible code.
--
-- This is the role of utils/deriveConstants utility: it produces a C
-- source, compiles it with the same toolchain that will be used to build the
-- RTS, and finally retrieves the constants from the built artefact. We can't
-- directly run the produced program because we may be cross-compiling.
--
-- These constants are then stored in DerivedConstants.h header file that is
-- bundled with the RTS unit. This file is directly imported by Cmm codes and it
-- is also read by GHC. deriveConstants also produces the Haskell definition of
-- the PlatformConstants datatype and the Haskell parser for the
-- DerivedConstants.h file.
--
-- For quite some time, constants used by GHC were globally installed in
-- ${libdir}/platformConstants but now GHC reads the DerivedConstants.h header
-- bundled with the RTS unit. GHC detects when it builds the RTS unit itself and
-- in this case it loads the header from the include-dirs passed on the
-- command-line.
--
-- Note that GHC doesn't parse every "#define SOME_CONSTANT 123" individually.
-- Instead there is a single #define that contains all the constants useful to
-- GHC in a comma separated list:
--
--    #define HS_CONSTANTS "123,45,..."
--
-- Note that GHC mustn't directly import DerivedConstants.h as these constants
-- are only valid for a specific target platform and we want GHC to be target
-- agnostic.
--


-- | Try to locate "DerivedConstants.h" file in the given dirs and to parse the
-- PlatformConstants from it.
--
-- See Note [Platform constants]
lookupPlatformConstants :: [FilePath] -> IO (Maybe PlatformConstants)
lookupPlatformConstants :: [String] -> IO (Maybe PlatformConstants)
lookupPlatformConstants [String]
include_dirs = [String] -> IO (Maybe PlatformConstants)
find_constants [String]
include_dirs
  where
    try_parse :: String -> IO (Maybe PlatformConstants)
try_parse String
d = do
        let p :: String
p = String
d String -> ShowS
</> String
"DerivedConstants.h"
        String -> IO Bool
doesFileExist String
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True  -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO PlatformConstants
parseConstantsHeader String
p
          Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    find_constants :: [String] -> IO (Maybe PlatformConstants)
find_constants []     = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    find_constants (String
x:[String]
xs) = String -> IO (Maybe PlatformConstants)
try_parse String
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe PlatformConstants
Nothing -> [String] -> IO (Maybe PlatformConstants)
find_constants [String]
xs
        Just PlatformConstants
c  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just PlatformConstants
c)