never executed always true always false
    1 {-# LANGUAGE ScopedTypeVariables #-}
    2 {-# LANGUAGE LambdaCase #-}
    3 
    4 -- | Platform description
    5 module GHC.Platform
    6    ( Platform (..)
    7    , PlatformWordSize(..)
    8    , platformArch
    9    , platformOS
   10    , ArchOS(..)
   11    , Arch(..)
   12    , OS(..)
   13    , ArmISA(..)
   14    , ArmISAExt(..)
   15    , ArmABI(..)
   16    , PPC_64ABI(..)
   17    , ByteOrder(..)
   18    , target32Bit
   19    , isARM
   20    , osElfTarget
   21    , osMachOTarget
   22    , osSubsectionsViaSymbols
   23    , platformUsesFrameworks
   24    , platformWordSizeInBytes
   25    , platformWordSizeInBits
   26    , platformMinInt
   27    , platformMaxInt
   28    , platformMaxWord
   29    , platformInIntRange
   30    , platformInWordRange
   31    , platformCConvNeedsExtension
   32    , PlatformMisc(..)
   33    , SseVersion (..)
   34    , BmiVersion (..)
   35    -- * Platform constants
   36    , PlatformConstants(..)
   37    , lookupPlatformConstants
   38    , platformConstants
   39    -- * Shared libraries
   40    , platformSOName
   41    , platformHsSOName
   42    , platformSOExt
   43    , genericPlatform
   44    )
   45 where
   46 
   47 import Prelude -- See Note [Why do we import Prelude here?]
   48 
   49 import GHC.Read
   50 import GHC.ByteOrder (ByteOrder(..))
   51 import GHC.Platform.Constants
   52 import GHC.Platform.ArchOS
   53 import GHC.Utils.Panic.Plain
   54 
   55 import Data.Word
   56 import Data.Int
   57 import System.FilePath
   58 import System.Directory
   59 
   60 -- | Platform description
   61 --
   62 -- This is used to describe platforms so that we can generate code for them.
   63 data Platform = Platform
   64    { platformArchOS                   :: !ArchOS           -- ^ Architecture and OS
   65    , platformWordSize                 :: !PlatformWordSize -- ^ Word size
   66    , platformByteOrder                :: !ByteOrder        -- ^ Byte order (endianness)
   67    , platformUnregisterised           :: !Bool
   68    , platformHasGnuNonexecStack       :: !Bool
   69    , platformHasIdentDirective        :: !Bool
   70    , platformHasSubsectionsViaSymbols :: !Bool
   71    , platformIsCrossCompiling         :: !Bool
   72    , platformLeadingUnderscore        :: !Bool             -- ^ Symbols need underscore prefix
   73    , platformTablesNextToCode         :: !Bool
   74       -- ^ Determines whether we will be compiling info tables that reside just
   75       --   before the entry code, or with an indirection to the entry code. See
   76       --   TABLES_NEXT_TO_CODE in rts/include/rts/storage/InfoTables.h.
   77    , platformHasLibm                  :: !Bool
   78       -- ^ Some platforms require that we explicitly link against @libm@ if any
   79       -- math-y things are used (which we assume to include all programs). See
   80       -- #14022.
   81 
   82    , platform_constants               :: !(Maybe PlatformConstants)
   83       -- ^ Constants such as structure offsets, type sizes, etc.
   84    }
   85    deriving (Read, Show, Eq)
   86 
   87 platformConstants :: Platform -> PlatformConstants
   88 platformConstants platform = case platform_constants platform of
   89   Nothing -> panic "Platform constants not available!"
   90   Just c  -> c
   91 
   92 genericPlatform :: Platform
   93 genericPlatform = Platform
   94    { platformArchOS                  = ArchOS ArchX86_64 OSLinux
   95    , platformWordSize                = PW8
   96    , platformByteOrder               = LittleEndian
   97    , platformUnregisterised          = False
   98    , platformHasGnuNonexecStack      = False
   99    , platformHasIdentDirective       = False
  100    , platformHasSubsectionsViaSymbols= False
  101    , platformHasLibm                 = False
  102    , platformIsCrossCompiling        = False
  103    , platformLeadingUnderscore       = False
  104    , platformTablesNextToCode        = True
  105    , platform_constants               = Nothing
  106    }
  107 
  108 data PlatformWordSize
  109   = PW4 -- ^ A 32-bit platform
  110   | PW8 -- ^ A 64-bit platform
  111   deriving (Eq, Ord)
  112 
  113 instance Show PlatformWordSize where
  114   show PW4 = "4"
  115   show PW8 = "8"
  116 
  117 instance Read PlatformWordSize where
  118   readPrec = do
  119     i :: Int <- readPrec
  120     case i of
  121       4 -> return PW4
  122       8 -> return PW8
  123       other -> fail ("Invalid PlatformWordSize: " ++ show other)
  124 
  125 platformWordSizeInBytes :: Platform -> Int
  126 platformWordSizeInBytes p =
  127     case platformWordSize p of
  128       PW4 -> 4
  129       PW8 -> 8
  130 
  131 platformWordSizeInBits :: Platform -> Int
  132 platformWordSizeInBits p = platformWordSizeInBytes p * 8
  133 
  134 -- | Platform architecture
  135 platformArch :: Platform -> Arch
  136 platformArch platform = case platformArchOS platform of
  137    ArchOS arch _ -> arch
  138 
  139 -- | Platform OS
  140 platformOS :: Platform -> OS
  141 platformOS platform = case platformArchOS platform of
  142    ArchOS _ os -> os
  143 
  144 isARM :: Arch -> Bool
  145 isARM (ArchARM {}) = True
  146 isARM ArchAArch64  = True
  147 isARM _ = False
  148 
  149 -- | This predicate tells us whether the platform is 32-bit.
  150 target32Bit :: Platform -> Bool
  151 target32Bit p =
  152     case platformWordSize p of
  153       PW4 -> True
  154       PW8 -> False
  155 
  156 -- | This predicate tells us whether the OS supports ELF-like shared libraries.
  157 osElfTarget :: OS -> Bool
  158 osElfTarget OSLinux     = True
  159 osElfTarget OSFreeBSD   = True
  160 osElfTarget OSDragonFly = True
  161 osElfTarget OSOpenBSD   = True
  162 osElfTarget OSNetBSD    = True
  163 osElfTarget OSSolaris2  = True
  164 osElfTarget OSDarwin    = False
  165 osElfTarget OSMinGW32   = False
  166 osElfTarget OSKFreeBSD  = True
  167 osElfTarget OSHaiku     = True
  168 osElfTarget OSQNXNTO    = False
  169 osElfTarget OSAIX       = False
  170 osElfTarget OSHurd      = True
  171 osElfTarget OSUnknown   = False
  172  -- Defaulting to False is safe; it means don't rely on any
  173  -- ELF-specific functionality.  It is important to have a default for
  174  -- portability, otherwise we have to answer this question for every
  175  -- new platform we compile on (even unreg).
  176 
  177 -- | This predicate tells us whether the OS support Mach-O shared libraries.
  178 osMachOTarget :: OS -> Bool
  179 osMachOTarget OSDarwin = True
  180 osMachOTarget _ = False
  181 
  182 osUsesFrameworks :: OS -> Bool
  183 osUsesFrameworks OSDarwin = True
  184 osUsesFrameworks _        = False
  185 
  186 platformUsesFrameworks :: Platform -> Bool
  187 platformUsesFrameworks = osUsesFrameworks . platformOS
  188 
  189 osSubsectionsViaSymbols :: OS -> Bool
  190 osSubsectionsViaSymbols OSDarwin = True
  191 osSubsectionsViaSymbols _        = False
  192 
  193 -- | Minimum representable Int value for the given platform
  194 platformMinInt :: Platform -> Integer
  195 platformMinInt p = case platformWordSize p of
  196    PW4 -> toInteger (minBound :: Int32)
  197    PW8 -> toInteger (minBound :: Int64)
  198 
  199 -- | Maximum representable Int value for the given platform
  200 platformMaxInt :: Platform -> Integer
  201 platformMaxInt p = case platformWordSize p of
  202    PW4 -> toInteger (maxBound :: Int32)
  203    PW8 -> toInteger (maxBound :: Int64)
  204 
  205 -- | Maximum representable Word value for the given platform
  206 platformMaxWord :: Platform -> Integer
  207 platformMaxWord p = case platformWordSize p of
  208    PW4 -> toInteger (maxBound :: Word32)
  209    PW8 -> toInteger (maxBound :: Word64)
  210 
  211 -- | Test if the given Integer is representable with a platform Int
  212 platformInIntRange :: Platform -> Integer -> Bool
  213 platformInIntRange platform x = x >= platformMinInt platform && x <= platformMaxInt platform
  214 
  215 -- | Test if the given Integer is representable with a platform Word
  216 platformInWordRange :: Platform -> Integer -> Bool
  217 platformInWordRange platform x = x >= 0 && x <= platformMaxWord platform
  218 
  219 -- | For some architectures the C calling convention is that any
  220 -- integer shorter than 64 bits is replaced by its 64 bits
  221 -- representation using sign or zero extension.
  222 platformCConvNeedsExtension :: Platform -> Bool
  223 platformCConvNeedsExtension platform = case platformArch platform of
  224   ArchPPC_64 _ -> True
  225   ArchS390X    -> True
  226   ArchRISCV64  -> True
  227   _            -> False
  228 
  229 
  230 --------------------------------------------------
  231 -- Instruction sets
  232 --------------------------------------------------
  233 
  234 -- | x86 SSE instructions
  235 data SseVersion
  236    = SSE1
  237    | SSE2
  238    | SSE3
  239    | SSE4
  240    | SSE42
  241    deriving (Eq, Ord)
  242 
  243 -- | x86 BMI (bit manipulation) instructions
  244 data BmiVersion
  245    = BMI1
  246    | BMI2
  247    deriving (Eq, Ord)
  248 
  249 -- | Platform-specific settings formerly hard-coded in Config.hs.
  250 --
  251 -- These should probably be all be triaged whether they can be computed from
  252 -- other settings or belong in another another place (like 'Platform' above).
  253 data PlatformMisc = PlatformMisc
  254   { -- TODO Recalculate string from richer info?
  255     platformMisc_targetPlatformString :: String
  256   , platformMisc_ghcWithInterpreter   :: Bool
  257   , platformMisc_libFFI               :: Bool
  258   , platformMisc_llvmTarget           :: String
  259   }
  260 
  261 platformSOName :: Platform -> FilePath -> FilePath
  262 platformSOName platform root = case platformOS platform of
  263    OSMinGW32 ->           root  <.> platformSOExt platform
  264    _         -> ("lib" ++ root) <.> platformSOExt platform
  265 
  266 platformHsSOName :: Platform -> FilePath -> FilePath
  267 platformHsSOName platform root = ("lib" ++ root) <.> platformSOExt platform
  268 
  269 platformSOExt :: Platform -> FilePath
  270 platformSOExt platform
  271     = case platformOS platform of
  272       OSDarwin  -> "dylib"
  273       OSMinGW32 -> "dll"
  274       _         -> "so"
  275 
  276 -- Note [Platform constants]
  277 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
  278 --
  279 -- The RTS is partly written in C, hence we use an external C compiler to build
  280 -- it. Thus GHC must somehow retrieve some information about the produced code
  281 -- (sizes of types, offsets of struct fields, etc.) to produce compatible code.
  282 --
  283 -- This is the role of utils/deriveConstants utility: it produces a C
  284 -- source, compiles it with the same toolchain that will be used to build the
  285 -- RTS, and finally retrieves the constants from the built artefact. We can't
  286 -- directly run the produced program because we may be cross-compiling.
  287 --
  288 -- These constants are then stored in DerivedConstants.h header file that is
  289 -- bundled with the RTS unit. This file is directly imported by Cmm codes and it
  290 -- is also read by GHC. deriveConstants also produces the Haskell definition of
  291 -- the PlatformConstants datatype and the Haskell parser for the
  292 -- DerivedConstants.h file.
  293 --
  294 -- For quite some time, constants used by GHC were globally installed in
  295 -- ${libdir}/platformConstants but now GHC reads the DerivedConstants.h header
  296 -- bundled with the RTS unit. GHC detects when it builds the RTS unit itself and
  297 -- in this case it loads the header from the include-dirs passed on the
  298 -- command-line.
  299 --
  300 -- Note that GHC doesn't parse every "#define SOME_CONSTANT 123" individually.
  301 -- Instead there is a single #define that contains all the constants useful to
  302 -- GHC in a comma separated list:
  303 --
  304 --    #define HS_CONSTANTS "123,45,..."
  305 --
  306 -- Note that GHC mustn't directly import DerivedConstants.h as these constants
  307 -- are only valid for a specific target platform and we want GHC to be target
  308 -- agnostic.
  309 --
  310 
  311 
  312 -- | Try to locate "DerivedConstants.h" file in the given dirs and to parse the
  313 -- PlatformConstants from it.
  314 --
  315 -- See Note [Platform constants]
  316 lookupPlatformConstants :: [FilePath] -> IO (Maybe PlatformConstants)
  317 lookupPlatformConstants include_dirs = find_constants include_dirs
  318   where
  319     try_parse d = do
  320         let p = d </> "DerivedConstants.h"
  321         doesFileExist p >>= \case
  322           True  -> Just <$> parseConstantsHeader p
  323           False -> return Nothing
  324 
  325     find_constants []     = return Nothing
  326     find_constants (x:xs) = try_parse x >>= \case
  327         Nothing -> find_constants xs
  328         Just c  -> return (Just c)