    module GHC.Toolchain.CheckArm ( findArmIsa ) where

    import Data.List (isInfixOf)
    import Data.Maybe (catMaybes)
    import Control.Monad.IO.Class
    import System.Process

    import GHC.Platform.ArchOS

    import GHC.Toolchain.Prelude
    import GHC.Toolchain.Tools.Cc

    -- | Awkwardly, ARM triples sometimes contain insufficient information about
    -- the platform. Consequently we instead extract this information from the
    -- toolchain.
    findArmIsa :: Cc -> M Arch
    findArmIsa :: Cc -> M Arch
    findArmIsa Cc
    cc = do
        isa <- M ArmISA
    checkIsa
        abi <- checkAbi
        exts <- catMaybes <$> mapM checkExtension extensions
        let arch = ArmISA -> [ArmISAExt] -> ArmABI -> Arch
    ArchARM ArmISA
    isa [ArmISAExt]
    exts ArmABI
    abi
        raspbianHack arch
      where
        checkIsa :: M ArmISA
    checkIsa = String -> M ArmISA -> M ArmISA
    forall a. Show a => String -> M a -> M a
    checking String
    "ARM ISA" (M ArmISA -> M ArmISA) -> M ArmISA -> M ArmISA
    forall a b. (a -> b) -> a -> b
    $ do
            arch <- String -> String
    lastLine (String -> String) -> M String -> M String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Cc -> String -> M String
    preprocess Cc
    cc String
    archTestProgram
            case arch of
              String
    _ | String
    arch String -> String -> Bool
    forall a. Ord a => a -> a -> Bool
    < String
    "6" -> String -> M ArmISA
    forall a. String -> M a
    throwE String
    "pre-ARMv6 is not supported"
              Char
    '6':String
    _ -> ArmISA -> M ArmISA
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArmISA
    ARMv6
              Char
    '7':String
    _ -> ArmISA -> M ArmISA
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArmISA
    ARMv7
              String
    _ -> String -> M ArmISA
    forall a. String -> M a
    throwE String
    "unknown ARM platform"

        checkAbi :: M ArmABI
    checkAbi = String -> M ArmABI -> M ArmABI
    forall a. Show a => String -> M a -> M a
    checking String
    "ARM ABI" (M ArmABI -> M ArmABI) -> M ArmABI -> M ArmABI
    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(__ARM_PCS_VFP)"
                , String
    "HARD"
                , String
    "#elif defined(__SOFTFP__)"
                , String
    "SOFTFP"
                , String
    "#else"
                , String
    "SOFT"
                , String
    "#endif"
                ]
            case out of
              String
    "HARD" -> ArmABI -> M ArmABI
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArmABI
    HARD
              String
    "SOFTFP" -> ArmABI -> M ArmABI
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArmABI
    SOFTFP
              String
    "SOFT" -> ArmABI -> M ArmABI
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArmABI
    SOFT
              String
    _ -> String -> M ArmABI
    forall a. String -> M a
    throwE (String -> M ArmABI) -> String -> M ArmABI
    forall a b. (a -> b) -> a -> b
    $ String
    "unexpected output from test program: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    out

        extensions :: [(ArmISAExt, String)]
        extensions :: [(ArmISAExt, String)]
    extensions =
            [ (ArmISAExt
    NEON, String
    "__ARM_NEON")
            , (ArmISAExt
    VFPv2, String
    "__VFP_FP__")
            , (ArmISAExt
    VFPv2, String
    "__ARM_VFPV2")
            , (ArmISAExt
    VFPv3, String
    "__ARM_VFPV3")
            ]

        checkExtension :: (ArmISAExt, String) -> M (Maybe ArmISAExt)
        checkExtension :: (ArmISAExt, String) -> M (Maybe ArmISAExt)
    checkExtension (ArmISAExt
    ext, String
    macro) = do
            supported <- String -> M Bool -> M Bool
    forall a. Show a => String -> M a -> M a
    checking (String
    "for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ArmISAExt -> String
    forall a. Show a => a -> String
    show ArmISAExt
    ext String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " support") (M Bool -> M Bool) -> M Bool -> M Bool
    forall a b. (a -> b) -> a -> b
    $ String -> M Bool
    testMacro String
    macro
            return $
                if supported
                  then Just ext
                  else Nothing

        testMacro :: String -> M Bool
        testMacro :: String -> M Bool
    testMacro String
    macro = 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(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    macro String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                , String
    "True"
                , String
    "#else"
                , String
    "False"
                , String
    "#endif"
                ]
            case out of
              String
    "True" -> Bool -> M Bool
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
              String
    "False" -> Bool -> M Bool
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
              String
    _ -> String -> M Bool
    forall a. String -> M a
    throwE (String -> M Bool) -> String -> M Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "unexpected output from test program: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    out

    lastLine :: String -> String
    lastLine :: String -> String
    lastLine String
    "" = String
    ""
    lastLine String
    s  = [String] -> String
    forall a. HasCallStack => [a] -> a
    last ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    s

    -- | Raspbian unfortunately makes some extremely questionable packaging
    -- decisions, configuring gcc to compile for ARMv6 despite the fact that the
    -- Raspberry Pi 4 is ARMv8. As ARMv8 doesn't support all instructions supported
    -- by ARMv6 this can break. Work around this by checking uname to verify that
    -- we aren't running on armv7.
    -- See #17856.
    --
    raspbianHack :: Arch -> M Arch
    raspbianHack :: Arch -> M Arch
    raspbianHack arch :: Arch
    arch@(ArchARM ArmISA
    ARMv6 [ArmISAExt]
    _ ArmABI
    abi) = do
        raspbian <- M Bool
    isRaspbian
        armv7 <- isARMv7Host
        if raspbian && armv7
          then do logInfo $ unlines [ "Found compiler which claims to target ARMv6 running in Raspbian on ARMv7."
                                    , "Assuming we should actually target ARMv7 (see GHC #17856)"
                                    ]
                  return $ ArchARM ARMv7 [VFPv2] abi
          else return arch
      where
        isRaspbian :: M Bool
    isRaspbian = String -> M Bool -> M Bool
    forall a. Show a => String -> M a -> M a
    checking String
    "whether this is Raspbian" (M Bool -> M Bool) -> M Bool -> M Bool
    forall a b. (a -> b) -> a -> b
    $ do
            issue <- String -> M String
    readFile String
    "/etc/issue" M String -> M String -> M String
    forall a. M a -> M a -> M a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> M String
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
            return $ "Raspbian" `isInfixOf` issue

        isARMv7Host :: M Bool
    isARMv7Host = String -> M Bool -> M Bool
    forall a. Show a => String -> M a -> M a
    checking String
    "whether the host is ARMv7" (M Bool -> M Bool) -> M Bool -> M Bool
    forall a b. (a -> b) -> a -> b
    $ do
            uname <- IO String -> M String
    forall a. IO a -> M a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> M String) -> IO String -> M String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String -> IO String
    readProcess String
    "uname" [String
    "-m"] String
    ""
            return $ "armv7" `isInfixOf` uname

    raspbianHack Arch
    arch = Arch -> M Arch
    forall a. a -> M a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Arch
    arch

    archTestProgram :: String
    archTestProgram :: String
    archTestProgram = [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
        [ String
    "#if defined(__ARM_ARCH)"
        , String
    "__ARM_ARCH"
        ] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
        [ String
    "#elif defined(__ARM_ARCH_"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    archString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "__)\n"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    arch
        | String
    arch <- [String]
    armArchs
        ] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
        [ String
    "#else"
        , String
    "#error \"unknown ARM platform\""
        , String
    "#endif"
        ]

    armArchs :: [String]
    armArchs :: [String]
    armArchs =
      [ String
    "2"
      , String
    "3", String
    "3M"
      , String
    "4", String
    "4T"
      , String
    "5", String
    "5T", String
    "5E", String
    "5TE"
      , String
    "6", String
    "6J", String
    "6T2", String
    "6Z", String
    "6ZK", String
    "6K", String
    "6KZ", String
    "6M"
      , String
    "7"
      ]