diff options
| -rw-r--r-- | compiler/GHC/CmmToLlvm/Mangler.hs | 23 | ||||
| -rw-r--r-- | configure.ac | 2 | ||||
| -rw-r--r-- | libraries/ghci/GHCi/InfoTable.hsc | 9 |
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. |