    module GHC.Toolchain.PlatformDetails
        ( checkWordSize
        , checkEndianness
        , checkLeadingUnderscore
        , checkSubsectionsViaSymbols
        , checkIdentDirective
        , checkGnuNonexecStack
        ) where

    import Data.List (isInfixOf)
    import System.FilePath

    import GHC.Platform.ArchOS

    import GHC.Toolchain.Prelude
    import GHC.Toolchain.Utils
    import GHC.Toolchain.Target
    import GHC.Toolchain.Program
    import GHC.Toolchain.Tools.Cc
    import GHC.Toolchain.Tools.Nm

    checkWordSize :: Cc -> M WordSize
    checkWordSize :: Cc -> M WordSize
    checkWordSize Cc
    cc = [Char] -> M WordSize -> M WordSize
    forall a. Show a => [Char] -> M a -> M a
    checking [Char]
    "word size" (M WordSize -> M WordSize) -> M WordSize -> M WordSize
    forall a b. (a -> b) -> a -> b
    $ do
        -- N.B. this is a surprisingly hard thing to check when cross-compiling.
        -- See https://stackoverflow.com/questions/4374379.
        -- To side-step this, we assume that the __SIZEOF_POINTER__ macro is
        -- available. It's technically not standard although should be available in
        -- any sane C implementation.
        output <- Cc -> [Char] -> M [Char]
    preprocess Cc
    cc [Char]
    program
        case reverse $ lines output of
          []            -> [Char] -> M WordSize
    forall a. [Char] -> M a
    throwE [Char]
    "test program produced no output"
          [Char]
    "undefined":[[Char]]
    _ -> [Char] -> M WordSize
    forall a. [Char] -> M a
    throwE [Char]
    "__SIZEOF_POINTER__ is undefined"
          [Char]
    "8":[[Char]]
    _         -> WordSize -> M WordSize
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return WordSize
    WS8
          [Char]
    "4":[[Char]]
    _         -> WordSize -> M WordSize
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return WordSize
    WS4
          [[Char]]
    _             -> [Char] -> M WordSize
    forall a. [Char] -> M a
    throwE ([Char] -> M WordSize) -> [Char] -> M WordSize
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "unexpected output:\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    output
      where
        program :: [Char]
    program = [[Char]] -> [Char]
    unlines
            [ [Char]
    "#include <stddef.h>"
            , [Char]
    "#include <inttypes.h>"
            , [Char]
    "#if !defined(__SIZEOF_POINTER__)"
            , [Char]
    "undefined"
            , [Char]
    "#else"
            , [Char]
    "__SIZEOF_POINTER__"
            , [Char]
    "#endif"
            ]

    checkEndianness :: Cc -> M Endianness
    checkEndianness :: Cc -> M Endianness
    checkEndianness Cc
    cc = do
        Cc -> M Endianness
    checkEndiannessParamH Cc
    cc M Endianness -> M Endianness -> M Endianness
    forall a. M a -> M a -> M a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Cc -> M Endianness
    checkEndiannessLimitsH Cc
    cc M Endianness -> M Endianness -> M Endianness
    forall a. M a -> M a -> M a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Cc -> M Endianness
    checkEndianness__BYTE_ORDER__ Cc
    cc

    checkEndiannessParamH :: Cc -> M Endianness
    checkEndiannessParamH :: Cc -> M Endianness
    checkEndiannessParamH Cc
    cc = [Char] -> M Endianness -> M Endianness
    forall a. Show a => [Char] -> M a -> M a
    checking [Char]
    "endianness (param.h)" (M Endianness -> M Endianness) -> M Endianness -> M Endianness
    forall a b. (a -> b) -> a -> b
    $ do
        output <- Cc -> [Char] -> M [Char]
    preprocess Cc
    cc [Char]
    prog
        case reverse $ lines output of
          [Char]
    "big":[[Char]]
    _ -> Endianness -> M Endianness
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Endianness
    BigEndian
          [Char]
    "little":[[Char]]
    _ -> Endianness -> M Endianness
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Endianness
    LittleEndian
          [Char]
    "unknown":[[Char]]
    _ -> [Char] -> M Endianness
    forall a. [Char] -> M a
    throwE [Char]
    "unknown endianness"
          [[Char]]
    _ -> [Char] -> M Endianness
    forall a. [Char] -> M a
    throwE [Char]
    "unrecognized output"
      where
        prog :: [Char]
    prog = [[Char]] -> [Char]
    unlines
            [ [Char]
    "#include <sys/param.h>"
            , [Char]
    "#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \\"
            , [Char]
    "   && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \\"
            , [Char]
    "   && LITTLE_ENDIAN)"
            , [Char]
    "bogus"
            , [Char]
    "#elif BYTE_ORDER == BIG_ENDIAN"
            , [Char]
    "big"
            , [Char]
    "#elif BYTE_ORDER == LITTLE_ENDIAN"
            , [Char]
    "little"
            , [Char]
    "#else"
            , [Char]
    "unknown"
            , [Char]
    "#endif"
            ]

    checkEndiannessLimitsH :: Cc -> M Endianness
    checkEndiannessLimitsH :: Cc -> M Endianness
    checkEndiannessLimitsH Cc
    cc = [Char] -> M Endianness -> M Endianness
    forall a. Show a => [Char] -> M a -> M a
    checking [Char]
    "endianness (limits.h)" (M Endianness -> M Endianness) -> M Endianness -> M Endianness
    forall a b. (a -> b) -> a -> b
    $ do
        out <- Cc -> [Char] -> M [Char]
    preprocess Cc
    cc [Char]
    prog
        case reverse $ lines out of
          [Char]
    "big":[[Char]]
    _ -> Endianness -> M Endianness
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Endianness
    BigEndian
          [Char]
    "little":[[Char]]
    _ -> Endianness -> M Endianness
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Endianness
    LittleEndian
          [Char]
    "unknown":[[Char]]
    _ -> [Char] -> M Endianness
    forall a. [Char] -> M a
    throwE [Char]
    "unknown endianness"
          [[Char]]
    _ -> [Char] -> M Endianness
    forall a. [Char] -> M a
    throwE [Char]
    "unrecognized output"
      where
        prog :: [Char]
    prog = [[Char]] -> [Char]
    unlines
            [ [Char]
    "#include <limits.h>"
            , [Char]
    "#if defined(_LITTLE_ENDIAN)"
            , [Char]
    "little"
            , [Char]
    "#elif defined(_BIG_ENDIAN)"
            , [Char]
    "big"
            , [Char]
    "#else"
            , [Char]
    "unknown"
            , [Char]
    "#endif"
            ]

    checkEndianness__BYTE_ORDER__ :: Cc -> M Endianness
    checkEndianness__BYTE_ORDER__ :: Cc -> M Endianness
    checkEndianness__BYTE_ORDER__ Cc
    cc = [Char] -> M Endianness -> M Endianness
    forall a. Show a => [Char] -> M a -> M a
    checking [Char]
    "endianness (__BYTE_ORDER__)" (M Endianness -> M Endianness) -> M Endianness -> M Endianness
    forall a b. (a -> b) -> a -> b
    $ do
        out <- Cc -> [Char] -> M [Char]
    preprocess Cc
    cc [Char]
    prog
        case reverse $ lines out of
          [Char]
    "big":[[Char]]
    _ -> Endianness -> M Endianness
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Endianness
    BigEndian
          [Char]
    "little":[[Char]]
    _ -> Endianness -> M Endianness
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Endianness
    LittleEndian
          [Char]
    "unknown":[[Char]]
    _ -> [Char] -> M Endianness
    forall a. [Char] -> M a
    throwE [Char]
    "unknown endianness"
          [[Char]]
    _ -> [Char] -> M Endianness
    forall a. [Char] -> M a
    throwE [Char]
    "unrecognized output"
      where
        prog :: [Char]
    prog = [[Char]] -> [Char]
    unlines
            [ [Char]
    "#include <sys/param.h>"
            , [Char]
    "#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__"
            , [Char]
    "little"
            , [Char]
    "#elif __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__"
            , [Char]
    "big"
            , [Char]
    "#else"
            , [Char]
    "unknown"
            , [Char]
    "#endif"
            ]

    checkLeadingUnderscore :: Cc -> Nm -> M Bool
    checkLeadingUnderscore :: Cc -> Nm -> M Bool
    checkLeadingUnderscore Cc
    cc Nm
    nm = [Char] -> M Bool -> M Bool
    forall a. Show a => [Char] -> M a -> M a
    checking [Char]
    ctxt (M Bool -> M Bool) -> M Bool -> M Bool
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> M Bool) -> M Bool
    forall a. ([Char] -> M a) -> M a
    withTempDir (([Char] -> M Bool) -> M Bool) -> ([Char] -> M Bool) -> M Bool
    forall a b. (a -> b) -> a -> b
    $ \[Char]
    dir -> do
        let test_o :: [Char]
    test_o = [Char]
    dir [Char] -> [Char] -> [Char]
    </> [Char]
    "test.o"
        Cc -> [Char] -> [Char] -> M ()
    compileC Cc
    cc [Char]
    test_o [Char]
    prog
        out <- Program -> [[Char]] -> M [Char]
    readProgramStdout (Nm -> Program
    nmProgram Nm
    nm) [[Char]
    test_o]
        return $ "_func" `isInfixOf` out
      where
        prog :: [Char]
    prog = [Char]
    "int func(void) { return 0; }"
        ctxt :: [Char]
    ctxt = [Char]
    "whether symbols have leading underscores"

    checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool
    checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool
    checkSubsectionsViaSymbols ArchOS
    archos Cc
    cc =
      case ArchOS -> Arch
    archOS_arch ArchOS
    archos of
        Arch
    ArchAArch64 ->
          -- subsections via symbols is busted on arm64
          -- TODO: ^ is this comment up to date?
          Bool -> M Bool
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        Arch
    _ ->
          [Char] -> [Char] -> Cc -> M Bool
    testCompile
            [Char]
    "whether .subsections-via-symbols directive is supported"
            ([Char] -> [Char]
    asmStmt [Char]
    ".subsections_via_symbols") Cc
    cc

    checkIdentDirective :: Cc -> M Bool
    checkIdentDirective :: Cc -> M Bool
    checkIdentDirective =
        [Char] -> [Char] -> Cc -> M Bool
    testCompile
          [Char]
    "whether the .ident directive is supported"
          ([Char] -> [Char]
    asmStmt [Char]
    ".ident \"GHC x.y.z\"")

    checkGnuNonexecStack :: ArchOS -> Cc -> M Bool
    checkGnuNonexecStack :: ArchOS -> Cc -> M Bool
    checkGnuNonexecStack ArchOS
    archOs =
        [Char] -> [Char] -> Cc -> M Bool
    testCompile
          [Char]
    "whether GNU non-executable stack directives are supported"
          [Char]
    prog
      where
        progbits :: [Char]
    progbits = case ArchOS -> Arch
    archOS_arch ArchOS
    archOs of
                     ArchARM{} -> [Char]
    "%progbits" -- See #13937
                     Arch
    _         -> [Char]
    "@progbits"

        prog :: [Char]
    prog = [[Char]] -> [Char]
    unlines [ [Char] -> [Char]
    asmStmt ([Char]
    ".section .note.GNU-stack,\"\","[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    progbits)
                       , [Char] -> [Char]
    asmStmt [Char]
    ".section .text"
                       ]

    asmStmt :: String -> String
    asmStmt :: [Char] -> [Char]
    asmStmt [Char]
    s = [Char]
    "__asm__(\"" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Char -> [Char]) -> [Char] -> [Char]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Char -> [Char]
    escape [Char]
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\");"
      where
        escape :: Char -> [Char]
    escape Char
    '"' = [Char]
    "\\\""
        escape Char
    c   = [Char
    c]

    -- | Try compiling a program, returning 'True' if successful.
    testCompile :: String -> String -> Cc -> M Bool
    testCompile :: [Char] -> [Char] -> Cc -> M Bool
    testCompile [Char]
    what [Char]
    program Cc
    cc = [Char] -> M Bool -> M Bool
    forall a. Show a => [Char] -> M a -> M a
    checking [Char]
    what (M Bool -> M Bool) -> M Bool -> M Bool
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> M Bool) -> M Bool
    forall a. ([Char] -> M a) -> M a
    withTempDir (([Char] -> M Bool) -> M Bool) -> ([Char] -> M Bool) -> M Bool
    forall a b. (a -> b) -> a -> b
    $ \[Char]
    dir -> do
        let test_o :: [Char]
    test_o = [Char]
    dir [Char] -> [Char] -> [Char]
    </> [Char]
    "test.o"
        (Bool
    True Bool -> M () -> M Bool
    forall a b. a -> M b -> M a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Cc -> [Char] -> [Char] -> M ()
    compileC Cc
    cc [Char]
    test_o [Char]
    program) M Bool -> M Bool -> M Bool
    forall a. M a -> M a -> M a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Bool -> M Bool
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False