module GHC.Toolchain.PlatformDetails
    ( checkWordSize
    , checkEndianness
    , checkLeadingUnderscore
    , checkSubsectionsViaSymbols
    , checkIdentDirective
    , checkGnuNonexecStack
    , checkTargetHasLibm
    , checkTargetHasLibdw
    ) 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.Library
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 ByteOrder
checkEndianness :: Cc -> M ByteOrder
checkEndianness Cc
cc = do
    Cc -> M ByteOrder
checkEndiannessParamH Cc
cc M ByteOrder -> M ByteOrder -> M ByteOrder
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cc -> M ByteOrder
checkEndiannessLimitsH Cc
cc M ByteOrder -> M ByteOrder -> M ByteOrder
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cc -> M ByteOrder
checkEndianness__BYTE_ORDER__ Cc
cc

checkEndiannessParamH :: Cc -> M ByteOrder
checkEndiannessParamH :: Cc -> M ByteOrder
checkEndiannessParamH Cc
cc = [Char] -> M ByteOrder -> M ByteOrder
forall a. Show a => [Char] -> M a -> M a
checking [Char]
"endianness (param.h)" (M ByteOrder -> M ByteOrder) -> M ByteOrder -> M ByteOrder
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]]
_ -> ByteOrder -> M ByteOrder
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteOrder
BigEndian
      [Char]
"little":[[Char]]
_ -> ByteOrder -> M ByteOrder
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteOrder
LittleEndian
      [Char]
"unknown":[[Char]]
_ -> [Char] -> M ByteOrder
forall a. [Char] -> M a
throwE [Char]
"unknown endianness"
      [[Char]]
_ -> [Char] -> M ByteOrder
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 ByteOrder
checkEndiannessLimitsH :: Cc -> M ByteOrder
checkEndiannessLimitsH Cc
cc = [Char] -> M ByteOrder -> M ByteOrder
forall a. Show a => [Char] -> M a -> M a
checking [Char]
"endianness (limits.h)" (M ByteOrder -> M ByteOrder) -> M ByteOrder -> M ByteOrder
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]]
_ -> ByteOrder -> M ByteOrder
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteOrder
BigEndian
      [Char]
"little":[[Char]]
_ -> ByteOrder -> M ByteOrder
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteOrder
LittleEndian
      [Char]
"unknown":[[Char]]
_ -> [Char] -> M ByteOrder
forall a. [Char] -> M a
throwE [Char]
"unknown endianness"
      [[Char]]
_ -> [Char] -> M ByteOrder
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 ByteOrder
checkEndianness__BYTE_ORDER__ :: Cc -> M ByteOrder
checkEndianness__BYTE_ORDER__ Cc
cc = [Char] -> M ByteOrder -> M ByteOrder
forall a. Show a => [Char] -> M a -> M a
checking [Char]
"endianness (__BYTE_ORDER__)" (M ByteOrder -> M ByteOrder) -> M ByteOrder -> M ByteOrder
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]]
_ -> ByteOrder -> M ByteOrder
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteOrder
BigEndian
      [Char]
"little":[[Char]]
_ -> ByteOrder -> M ByteOrder
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteOrder
LittleEndian
      [Char]
"unknown":[[Char]]
_ -> [Char] -> M ByteOrder
forall a. [Char] -> M a
throwE [Char]
"unknown endianness"
      [[Char]]
_ -> [Char] -> M ByteOrder
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"
                   ]

checkTargetHasLibm :: Cc -> M Bool
checkTargetHasLibm :: Cc -> M Bool
checkTargetHasLibm Cc
cc = Cc -> [Char] -> [Char] -> Maybe [Char] -> M Bool
testLib Cc
cc [Char]
"m" [Char]
"atan" Maybe [Char]
forall a. Maybe a
Nothing

checkTargetHasLibdw :: Cc -> Maybe FilePath -> Maybe FilePath -> M (Maybe Library)
checkTargetHasLibdw :: Cc -> Maybe [Char] -> Maybe [Char] -> M (Maybe Library)
checkTargetHasLibdw Cc
cc Maybe [Char]
mincludeDir Maybe [Char]
mlibDir = do
  b1 <- Cc -> [Char] -> Maybe [Char] -> M Bool
testHeader Cc
cc [Char]
"elfutils/libdwfl.h" Maybe [Char]
mincludeDir
  b2 <- testLib cc "dw" "dwfl_attach_state" mlibDir
  return $
    if b1 && b2
    then Just
      Library{ libName = "dw"
             , includePath = mincludeDir, libraryPath = mlibDir}
    else Nothing


--------------------------------------------------------------------------------
-- Utilities
--------------------------------------------------------------------------------

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]

-- | Check whether a lib is found and can be linked against.
-- Like @AC_CHECK_LIB@.
testLib :: Cc
        -> String         -- ^ Lib name
        -> String         -- ^ Lib symbol
        -> Maybe FilePath -- ^ Library dir (-L)
        -> M Bool
testLib :: Cc -> [Char] -> [Char] -> Maybe [Char] -> M Bool
testLib Cc
cc0 [Char]
libname [Char]
symbol Maybe [Char]
mlibDir = [Char] -> [Char] -> Cc -> M Bool
testCompile ([Char]
"whether target has lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
libname) [Char]
prog Cc
cc2
  where
    cc1 :: Cc
cc1 = Cc
cc0 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc Program
_ccProgram Lens Cc Program -> Lens Program [[Char]] -> Lens Cc [[Char]]
forall a b c. Lens a b -> Lens b c -> Lens a c
% Lens Program [[Char]]
_prgFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ ([Char]
"-l" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
libname)
    cc2 :: Cc
cc2 | Just [Char]
libDir <- Maybe [Char]
mlibDir
        = Cc
cc1 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc Program
_ccProgram Lens Cc Program -> Lens Program [[Char]] -> Lens Cc [[Char]]
forall a b c. Lens a b -> Lens b c -> Lens a c
% Lens Program [[Char]]
_prgFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ ([Char]
"-L" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
libDir)
        | Bool
otherwise = Cc
cc1
    prog :: [Char]
prog = [[Char]] -> [Char]
unlines
        [ [Char]
"char " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
symbol [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (void);"
        , [Char]
"int"
        , [Char]
"main (void)"
        , [Char]
"{"
        , [Char]
"return " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
symbol [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ();"
        , [Char]
"  ;"
        , [Char]
"  return 0;"
        , [Char]
"}"
        ]

-- | Like @AC_CHECK_HEADER@
testHeader :: Cc
           -> String         -- ^ Header to check for
           -> Maybe FilePath -- ^ Extra path
           -> M Bool
testHeader :: Cc -> [Char] -> Maybe [Char] -> M Bool
testHeader Cc
cc0 [Char]
header Maybe [Char]
mincludeDir = [Char] -> [Char] -> Cc -> M Bool
testCompile ([Char]
"whether target has <" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
header [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">") [Char]
prog Cc
cc1
  where
    cc1 :: Cc
cc1 | Just [Char]
includeDir <- Maybe [Char]
mincludeDir
        = Cc
cc0 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc Program
_ccProgram Lens Cc Program -> Lens Program [[Char]] -> Lens Cc [[Char]]
forall a b c. Lens a b -> Lens b c -> Lens a c
% Lens Program [[Char]]
_prgFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ ([Char]
"-I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
includeDir)
        | Bool
otherwise = Cc
cc0
    prog :: [Char]
prog = [[Char]] -> [Char]
unlines
        [ [Char]
"#include <" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
header [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">" ]

-- | 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