ghci: reuse Arch from ghc-boot

2 files changed, 22 insertions, 63 deletions

diff --git a/libraries/ghc-boot/GHC/Platform/ArchOS.hs b/libraries/ghc-boot/GHC/Platform/ArchOS.hs
index 3e42143435..2f641739bd 100644
--- a/libraries/ghc-boot/GHC/Platform/ArchOS.hs
+++ b/libraries/ghc-boot/GHC/Platform/ArchOS.hs
@@ -73,8 +73,8 @@ data ArmABI
 
 -- | PowerPC 64-bit ABI
 data PPC_64ABI
-   = ELF_V1
-   | ELF_V2
+   = ELF_V1 -- ^ PowerPC64
+   | ELF_V2 -- ^ PowerPC64 LE
    deriving (Read, Show, Eq)
 
 -- | Operating systems.
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index 3495403183..2fe35ee927 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -23,6 +23,8 @@ import GHC.Exts.Heap
 import Data.ByteString (ByteString)
 import Control.Monad.Fail
 import qualified Data.ByteString as BS
+import GHC.Platform.Host (hostPlatformArch)
+import GHC.Platform.ArchOS
 
 -- NOTE: Must return a pointer acceptable for use in the header of a closure.
 -- If tables_next_to_code is enabled, then it must point the 'code' field.
@@ -63,59 +65,9 @@ mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc =
 funPtrToInt :: FunPtr a -> Int
 funPtrToInt (FunPtr a) = I## (addr2Int## a)
 
-data Arch = ArchSPARC
-          | ArchPPC
-          | ArchX86
-          | ArchX86_64
-          | ArchAlpha
-          | ArchARM
-          | ArchAArch64
-          | ArchPPC64
-          | ArchPPC64LE
-          | ArchS390X
- deriving Show
-
 mkJumpToAddr :: MonadFail m => EntryFunPtr-> m ItblCodes
-mkJumpToAddr ptr = do
-  arch <- case mArch of
-    Just a -> pure a
-    Nothing ->
-      -- This code must not be called. You either need to add your
-      -- architecture as a distinct case to 'Arch' and 'mArch', or use
-      -- non-TABLES_NEXT_TO_CODE mode.
-      fail "mkJumpToAddr: Unknown obscure arch is not supported with TABLES_NEXT_TO_CODE"
-  pure $ mkJumpToAddr' arch ptr
-
--- | 'Just' if it's a known OS, or 'Nothing' otherwise.
-mArch :: Maybe Arch
-mArch =
-#if defined(sparc_HOST_ARCH)
-       Just ArchSPARC
-#elif defined(powerpc_HOST_ARCH)
-       Just ArchPPC
-#elif defined(i386_HOST_ARCH)
-       Just ArchX86
-#elif defined(x86_64_HOST_ARCH)
-       Just ArchX86_64
-#elif defined(alpha_HOST_ARCH)
-       Just ArchAlpha
-#elif defined(arm_HOST_ARCH)
-       Just ArchARM
-#elif defined(aarch64_HOST_ARCH)
-       Just ArchAArch64
-#elif defined(powerpc64_HOST_ARCH)
-       Just ArchPPC64
-#elif defined(powerpc64le_HOST_ARCH)
-       Just ArchPPC64LE
-#elif defined(s390x_HOST_ARCH)
-       Just ArchS390X
-#else
-       Nothing
-#endif
-
-mkJumpToAddr' :: Arch -> EntryFunPtr -> ItblCodes
-mkJumpToAddr' platform a = case platform of
-    ArchSPARC ->
+mkJumpToAddr a = case hostPlatformArch of
+    ArchSPARC -> pure $
         -- After some consideration, we'll try this, where
         -- 0x55555555 stands in for the address to jump to.
         -- According to includes/rts/MachRegs.h, %g3 is very
@@ -137,7 +89,7 @@ mkJumpToAddr' platform a = case platform of
                    0x81C0C000,
                    0x01000000 ]
 
-    ArchPPC ->
+    ArchPPC -> pure $
         -- We'll use r12, for no particular reason.
         -- 0xDEADBEEF stands for the address:
         -- 3D80DEAD lis r12,0xDEAD
@@ -152,7 +104,7 @@ mkJumpToAddr' platform a = case platform of
                    0x618C0000 .|. lo16 w32,
                    0x7D8903A6, 0x4E800420 ]
 
-    ArchX86 ->
+    ArchX86 -> pure $
         -- Let the address to jump to be 0xWWXXYYZZ.
         -- Generate   movl $0xWWXXYYZZ,%eax  ;  jmp *%eax
         -- which is
@@ -167,7 +119,7 @@ mkJumpToAddr' platform a = case platform of
         in
             Left insnBytes
 
-    ArchX86_64 ->
+    ArchX86_64 -> pure $
         -- Generates:
         --      jmpq *.L1(%rip)
         --      .align 8
@@ -191,7 +143,7 @@ mkJumpToAddr' platform a = case platform of
         in
             Left insnBytes
 
-    ArchAlpha ->
+    ArchAlpha -> pure $
         let w64 = fromIntegral (funPtrToInt a) :: Word64
         in Right [ 0xc3800000      -- br   at, .+4
                  , 0xa79c000c      -- ldq  at, 12(at)
@@ -200,7 +152,7 @@ mkJumpToAddr' platform a = case platform of
                  , fromIntegral (w64 .&. 0x0000FFFF)
                  , fromIntegral ((w64 `shiftR` 32) .&. 0x0000FFFF) ]
 
-    ArchARM { } ->
+    ArchARM {} -> pure $
         -- Generates Arm sequence,
         --      ldr r1, [pc, #0]
         --      bx r1
@@ -214,7 +166,7 @@ mkJumpToAddr' platform a = case platform of
                 , 0x11, 0xff, 0x2f, 0xe1
                 , byte0 w32, byte1 w32, byte2 w32, byte3 w32]
 
-    ArchAArch64 { } ->
+    ArchAArch64 {} -> pure $
         -- Generates:
         --
         --      ldr     x1, label
@@ -230,7 +182,8 @@ mkJumpToAddr' platform a = case platform of
                 , 0xd61f0020
                 , fromIntegral w64
                 , fromIntegral (w64 `shiftR` 32) ]
-    ArchPPC64 ->
+
+    ArchPPC_64 ELF_V1 -> pure $
         -- We use the compiler's register r12 to read the function
         -- descriptor and the linker's register r11 as a temporary
         -- register to hold the function entry point.
@@ -256,7 +209,7 @@ mkJumpToAddr' platform a = case platform of
                   0xE96C0010,
                   0x4E800420]
 
-    ArchPPC64LE ->
+    ArchPPC_64 ELF_V2 -> pure $
         -- The ABI requires r12 to point to the function's entry point.
         -- We use the medium code model where code resides in the first
         -- two gigabytes, so loading a non-negative32 bit address
@@ -274,7 +227,7 @@ mkJumpToAddr' platform a = case platform of
                    0x618C0000 .|. lo16 w32,
                    0x7D8903A6, 0x4E800420 ]
 
-    ArchS390X ->
+    ArchS390X -> pure $
         -- Let 0xAABBCCDDEEFFGGHH be the address to jump to.
         -- The following code loads the address into scratch
         -- register r1 and jumps to it.
@@ -288,6 +241,12 @@ mkJumpToAddr' platform a = case platform of
                   0xC0, 0x19, byte3 w64, byte2 w64, byte1 w64, byte0 w64,
                   0x07, 0xF1 ]
 
+    arch ->
+      -- The arch isn't supported. You either need to add your architecture as a
+      -- distinct case, or use non-TABLES_NEXT_TO_CODE mode.
+      fail $ "mkJumpToAddr: arch is not supported with TABLES_NEXT_TO_CODE ("
+             ++ show arch ++ ")"
+
 byte0 :: (Integral w) => w -> Word8
 byte0 w = fromIntegral w