GHCi: Properly generate jump code for ARM (#8380)

This adds code for jumping to given addresses for ARM, written by Ben
Gamari.

However, when allocating new infotables for bytecode (which is where
this jump code occurs), we need to be sure to flush the cache on the
execute pointer returned from allocateExec() - on systems like ARM, the
processor won't reliably read back code or automatically cache flush,
where x86 will.

So we add a new flushExec primitive to call out to GCC's
__builtin___clear_cache primitive, which will properly generate the
correct code (nothing on x86, and a call to libgcc's __clear_cache on
ARM) and make sure we use it after writing the code out.

Authored-by: Ben Gamari <bgamari.foss@gmail.com>
Authored-by: Austin Seipp <austin@well-typed.com>
Signed-off-by: Austin Seipp <austin@well-typed.com>

1 files changed, 21 insertions, 2 deletions

diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index 0d07be5f67..2180f87091 100644
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -226,6 +226,20 @@ mkJumpToAddr dflags a = case platformArch (targetPlatform dflags) of
                  , 0x47ff041f      -- nop
                  , fromIntegral (w64 .&. 0x0000FFFF)
                  , fromIntegral ((w64 `shiftR` 32) .&. 0x0000FFFF) ]
+    
+    ArchARM { } ->
+        -- Generates Thumb sequence,
+        --      ldr r1, [pc, #0]
+        --      bx r1
+        -- 
+        -- which looks like:
+        --     00000000 <.addr-0x8>:
+        --     0:	4900        ldr    r1, [pc]      ; 8 <.addr>
+        --     4:	4708        bx     r1
+        let w32 = fromIntegral (ptrToInt a) :: Word32
+        in Left [ 0x49, 0x00
+                , 0x47, 0x08
+                , byte0 w32, byte1 w32, byte2 w32, byte3 w32]
 
     arch ->
         panic ("mkJumpToAddr not defined for " ++ show arch)
@@ -374,11 +388,16 @@ load = do addr <- advance
 newExecConItbl :: DynFlags -> StgConInfoTable -> IO (FunPtr ())
 newExecConItbl dflags obj
    = alloca $ \pcode -> do
-        wr_ptr <- _allocateExec (fromIntegral (sizeOfConItbl dflags obj)) pcode
+        let sz = fromIntegral (sizeOfConItbl dflags obj)
+        wr_ptr <- _allocateExec sz pcode
         ex_ptr <- peek pcode
         pokeConItbl dflags wr_ptr ex_ptr obj
+        _flushExec sz ex_ptr -- Cache flush (if needed)
         return (castPtrToFunPtr ex_ptr)
 
 foreign import ccall unsafe "allocateExec"
-  _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)  
+  _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)
+
+foreign import ccall unsafe "flushExec"
+  _flushExec :: CUInt -> Ptr a -> IO ()
 \end{code}