[commit: ghc] master: libraries/ghci: Implement mkJumpToAddr for ppc64 (e8672e5)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e8672e5e6cd4db6bbe3a1183f4fbf5496292621c/ghc

>---------------------------------------------------------------

commit e8672e5e6cd4db6bbe3a1183f4fbf5496292621c
Author: Peter Trommler <ptrommler at acm.org>
Date:   Sun Dec 27 01:12:51 2015 +0100

    libraries/ghci: Implement mkJumpToAddr for ppc64
    
    Test Plan: validated on powerpc64 and powerpc64le
    
    Reviewers: austin, erikd, simonmar, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1680
    
    GHC Trac Issues: #11257


>---------------------------------------------------------------

e8672e5e6cd4db6bbe3a1183f4fbf5496292621c
 libraries/ghci/GHCi/InfoTable.hsc | 49 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 48 insertions(+), 1 deletion(-)

diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index 34604ea..14e1698 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -57,7 +57,7 @@ funPtrToInt :: FunPtr a -> Int
 funPtrToInt (FunPtr a) = I## (addr2Int## a)
 
 data Arch = ArchSPARC | ArchPPC | ArchX86 | ArchX86_64 | ArchAlpha | ArchARM
-          | ArchARM64
+          | ArchARM64 | ArchPPC64 | ArchPPC64LE
  deriving Show
 
 platform :: Arch
@@ -76,6 +76,10 @@ platform =
        ArchARM
 #elif defined(aarch64_HOST_ARCH)
        ArchARM64
+#elif defined(powerpc64_HOST_ARCH)
+       ArchPPC64
+#elif defined(powerpc64le_HOST_ARCH)
+       ArchPPC64LE
 #else
 #error Unknown architecture
 #endif
@@ -197,6 +201,49 @@ mkJumpToAddr a = case platform of
                 , 0xd61f0020
                 , fromIntegral w64
                 , fromIntegral (w64 `shiftR` 32) ]
+    ArchPPC64 ->
+        -- 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.
+        -- In the medium code model the function descriptor
+        -- is located in the first two gigabytes, i.e. the address
+        -- of the function pointer is a non-negative 32 bit number.
+        -- 0x0EADBEEF stands for the address of the function pointer:
+        --    0:   3d 80 0e ad     lis     r12,0x0EAD
+        --    4:   61 8c be ef     ori     r12,r12,0xBEEF
+        --    8:   e9 6c 00 00     ld      r11,0(r12)
+        --    c:   e8 4c 00 08     ld      r2,8(r12)
+        --   10:   7d 69 03 a6     mtctr   r11
+        --   14:   e9 6c 00 10     ld      r11,16(r12)
+        --   18:   4e 80 04 20     bctr
+       let  w32 = fromIntegral (funPtrToInt a)
+            hi16 x = (x `shiftR` 16) .&. 0xFFFF
+            lo16 x = x .&. 0xFFFF
+       in Right [ 0x3D800000 .|. hi16 w32,
+                  0x618C0000 .|. lo16 w32,
+                  0xE96C0000,
+                  0xE84C0008,
+                  0x7D6903A6,
+                  0xE96C0010,
+                  0x4E800420]
+
+    ArchPPC64LE ->
+        -- 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
+        -- with lis followed by ori is fine.
+        -- 0x0EADBEEF stands for the address:
+        -- 3D800EAD lis r12,0x0EAD
+        -- 618CBEEF ori r12,r12,0xBEEF
+        -- 7D8903A6 mtctr r12
+        -- 4E800420 bctr
+
+        let w32 = fromIntegral (funPtrToInt a)
+            hi16 x = (x `shiftR` 16) .&. 0xFFFF
+            lo16 x = x .&. 0xFFFF
+        in Right [ 0x3D800000 .|. hi16 w32,
+                   0x618C0000 .|. lo16 w32,
+                   0x7D8903A6, 0x4E800420 ]
 
 byte0 :: (Integral w) => w -> Word8
 byte0 w = fromIntegral w