Enable tables next to code for riscv64

This requires adding another rewrite to the mangler, to avoid generating
PLT entries.

3 files changed, 32 insertions, 2 deletions

diff --git a/compiler/GHC/CmmToLlvm/Mangler.hs b/compiler/GHC/CmmToLlvm/Mangler.hs
index 805f1b8074..4313294294 100644
--- a/compiler/GHC/CmmToLlvm/Mangler.hs
+++ b/compiler/GHC/CmmToLlvm/Mangler.hs
@@ -43,7 +43,7 @@ llvmFixupAsm logger dflags f1 f2 = {-# SCC "llvm_mangler" #-}
 
 -- | These are the rewrites that the mangler will perform
 rewrites :: [Rewrite]
-rewrites = [rewriteSymType, rewriteAVX]
+rewrites = [rewriteSymType, rewriteAVX, rewriteCall]
 
 type Rewrite = DynFlags -> B.ByteString -> Maybe B.ByteString
 
@@ -107,6 +107,27 @@ rewriteAVX dflags s
     isVmovdqa = B.isPrefixOf (B.pack "vmovdqa")
     isVmovap = B.isPrefixOf (B.pack "vmovap")
 
+-- | This rewrites (tail) calls to avoid creating PLT entries for
+-- functions on riscv64. The replacement will load the address from the
+-- GOT, which is resolved to point to the real address of the function.
+rewriteCall :: Rewrite
+rewriteCall dflags l
+  | not isRISCV64 = Nothing
+  | isCall l      = Just $ replaceCall "call" "jalr" "ra" l
+  | isTail l      = Just $ replaceCall "tail" "jr" "t1" l
+  | otherwise     = Nothing
+  where
+    isRISCV64 = platformArch (targetPlatform dflags) == ArchRISCV64
+    isCall = B.isPrefixOf (B.pack "call\t")
+    isTail = B.isPrefixOf (B.pack "tail\t")
+
+    replaceCall call jump reg l =
+        appendInsn (jump ++ "\t" ++ reg) $ removePlt $
+        replaceOnce (B.pack call) (B.pack ("la\t" ++ reg ++ ",")) l
+      where
+        removePlt = replaceOnce (B.pack "@plt") (B.pack "")
+        appendInsn i = (`B.append` B.pack ("\n\t" ++ i))
+
 -- | @replaceOnce match replace bs@ replaces the first occurrence of the
 -- substring @match@ in @bs@ with @replace@.
 replaceOnce :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
diff --git a/configure.ac b/configure.ac
index 1f524bdf54..f414308ae8 100644
--- a/configure.ac
+++ b/configure.ac
@@ -321,7 +321,7 @@ AC_MSG_CHECKING(whether target supports tables next to code)
 case "$Unregisterised" in
     NO)
         case "$TargetArch" in
-            ia64|powerpc64|powerpc64le|s390x|riscv64)
+            ia64|powerpc64|powerpc64le|s390x)
                 TablesNextToCodeDefault=NO
                 AC_MSG_RESULT([no])
                 ;;
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index fce2c653f2..c5dd4f0db8 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -241,6 +241,15 @@ mkJumpToAddr a = case hostPlatformArch of
                   0xC0, 0x19, byte3 w64, byte2 w64, byte1 w64, byte0 w64,
                   0x07, 0xF1 ]
 
+    ArchRISCV64 -> pure $
+        let w64 = fromIntegral (funPtrToInt a) :: Word64
+        in Right [ 0x00000297          -- auipc t0,0
+                 , 0x01053283          -- ld    t0,16(t0)
+                 , 0x00028067          -- jr    t0
+                 , 0x00000013          -- nop
+                 , fromIntegral w64
+                 , fromIntegral (w64 `shiftR` 32) ]
+
     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.