75 lines
3.1 KiB
Diff
75 lines
3.1 KiB
Diff
|
Index: ghc-9.2.1/compiler/GHC/CmmToLlvm/Mangler.hs
|
||
|
|
===================================================================
|
||
|
|
--- ghc-9.2.1.orig/compiler/GHC/CmmToLlvm/Mangler.hs
|
||
|
|
+++ ghc-9.2.1/compiler/GHC/CmmToLlvm/Mangler.hs
|
||
|
|
@@ -43,7 +43,7 @@ llvmFixupAsm logger dflags f1 f2 = {-# S
|
||
|
|
|
||
|
|
-- | 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
|
||
|
|
Index: ghc-9.2.1/configure.ac
|
||
|
|
===================================================================
|
||
|
|
--- ghc-9.2.1.orig/configure.ac
|
||
|
|
+++ ghc-9.2.1/configure.ac
|
||
|
|
@@ -322,7 +322,7 @@ AC_MSG_CHECKING(whether target supports
|
||
|
|
case "$Unregisterised" in
|
||
|
|
NO)
|
||
|
|
case "$TargetArch" in
|
||
|
|
- ia64|powerpc64|powerpc64le|s390x|riscv64)
|
||
|
|
+ ia64|powerpc64|powerpc64le|s390x)
|
||
|
|
TablesNextToCodeDefault=NO
|
||
|
|
AC_MSG_RESULT([no])
|
||
|
|
;;
|
||
|
|
Index: ghc-9.2.1/libraries/ghci/GHCi/InfoTable.hsc
|
||
|
|
===================================================================
|
||
|
|
--- ghc-9.2.1.orig/libraries/ghci/GHCi/InfoTable.hsc
|
||
|
|
+++ ghc-9.2.1/libraries/ghci/GHCi/InfoTable.hsc
|
||
|
|
@@ -241,6 +241,15 @@ mkJumpToAddr a = case hostPlatformArch o
|
||
|
|
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.
|