File riscv-tntc.patch of Package ghc-prepare-binary-distributions

Overview Repositories Revisions Requests Users Attributes Meta

File riscv-tntc.patch of Package ghc-prepare-binary-distributions (Revision 6cdcdf3b84a3e6dbcf1d5d72646248b8)

Currently displaying revision 6cdcdf3b84a3e6dbcf1d5d72646248b8 , Show latest

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.

Places

File riscv-tntc.patch of Package ghc-prepare-binary-distributions (Revision 6cdcdf3b84a3e6dbcf1d5d72646248b8)

Places