module GHC.Toolchain.CheckPower ( checkPowerAbi ) where

import GHC.Platform.ArchOS

import GHC.Toolchain.Prelude
import GHC.Toolchain.Utils (lastLine)
import GHC.Toolchain.Tools.Cc

-- 64-Bit ELF V2 ABI Specification, Power Architecture, Revision 1.5 says:
-- A C preprocessor that conforms to this ABI shall predefine the macro
-- _CALL_ELF to have a value of 2 (Section 5.1.4 Predifined Macros).
-- The 64-bit PowerPC ELF Application Binary Interface Supplement 1.9
-- does not define any macro to identify the ABI.
-- So we check for ABI version 2 and default to ABI version 1.

checkPowerAbi :: Cc -> M Arch
checkPowerAbi :: Cc -> M Arch
checkPowerAbi Cc
cc = do
  String -> M Arch -> M Arch
forall a. Show a => String -> M a -> M a
checking String
"POWER ELF ABI" (M Arch -> M Arch) -> M Arch -> M Arch
forall a b. (a -> b) -> a -> b
$ do
    out <- (String -> String) -> M String -> M String
forall a b. (a -> b) -> M a -> M b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
lastLine (M String -> M String) -> M String -> M String
forall a b. (a -> b) -> a -> b
$ Cc -> String -> M String
preprocess Cc
cc (String -> M String) -> String -> M String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        [ String
"#if defined(_CALL_ELF) && _CALL_ELF == 2"
        , String
"ELFv2"
        , String
"#else"
        , String
"ELFv1"
        , String
"#endif"
        ]
    case out of
      String
"ELFv1" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arch -> M Arch) -> Arch -> M Arch
forall a b. (a -> b) -> a -> b
$ PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1
      String
"ELFv2" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arch -> M Arch) -> Arch -> M Arch
forall a b. (a -> b) -> a -> b
$ PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
      String
_       -> String -> M Arch
forall a. String -> M a
throwE (String -> M Arch) -> String -> M Arch
forall a b. (a -> b) -> a -> b
$ String
"unexpected output from test program: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
out