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

Index: ghc-8.10.7/aclocal.m4
===================================================================
--- ghc-8.10.7.orig/aclocal.m4
+++ ghc-8.10.7/aclocal.m4
@@ -231,7 +231,10 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_V
         mipsel)
             test -z "[$]2" || eval "[$]2=ArchMipsel"
             ;;
-        hppa|hppa1_1|ia64|m68k|nios2|riscv32|riscv64|rs6000|s390|sh4|vax)
+        riscv64)
+            test -z "[$]2" || eval "[$]2=ArchRISCV64"
+            ;;
+        hppa|hppa1_1|ia64|m68k|nios2|riscv32|rs6000|s390|sh4|vax)
             test -z "[$]2" || eval "[$]2=ArchUnknown"
             ;;
         *)
Index: ghc-8.10.7/compiler/GHC/Platform/RISCV64.hs
===================================================================
--- /dev/null
+++ ghc-8.10.7/compiler/GHC/Platform/RISCV64.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE CPP #-}
+
+module GHC.Platform.RISCV64 where
+
+import GhcPrelude
+
+#define MACHREGS_NO_REGS 0
+#define MACHREGS_riscv64 1
+#include "../../../includes/CodeGen.Platform.hs"
+
Index: ghc-8.10.7/compiler/GHC/Platform/Regs.hs
===================================================================
--- ghc-8.10.7.orig/compiler/GHC/Platform/Regs.hs
+++ ghc-8.10.7/compiler/GHC/Platform/Regs.hs
@@ -15,6 +15,7 @@ import qualified GHC.Platform.S390X
 import qualified GHC.Platform.SPARC      as SPARC
 import qualified GHC.Platform.X86        as X86
 import qualified GHC.Platform.X86_64     as X86_64
+import qualified GHC.Platform.RISCV64    as RISCV64
 import qualified GHC.Platform.NoRegs     as NoRegs
 
 -- | Returns 'True' if this global register is stored in a caller-saves
@@ -31,6 +32,7 @@ callerSaves platform
    ArchSPARC   -> SPARC.callerSaves
    ArchARM {}  -> ARM.callerSaves
    ArchAArch64 -> AArch64.callerSaves
+   ArchRISCV64 -> RISCV64.callerSaves
    arch
     | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
         PPC.callerSaves
@@ -53,6 +55,7 @@ activeStgRegs platform
    ArchSPARC   -> SPARC.activeStgRegs
    ArchARM {}  -> ARM.activeStgRegs
    ArchAArch64 -> AArch64.activeStgRegs
+   ArchRISCV64 -> RISCV64.activeStgRegs
    arch
     | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
         PPC.activeStgRegs
@@ -70,6 +73,7 @@ haveRegBase platform
    ArchSPARC   -> SPARC.haveRegBase
    ArchARM {}  -> ARM.haveRegBase
    ArchAArch64 -> AArch64.haveRegBase
+   ArchRISCV64 -> RISCV64.haveRegBase
    arch
     | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
         PPC.haveRegBase
@@ -87,6 +91,7 @@ globalRegMaybe platform
    ArchSPARC   -> SPARC.globalRegMaybe
    ArchARM {}  -> ARM.globalRegMaybe
    ArchAArch64 -> AArch64.globalRegMaybe
+   ArchRISCV64 -> RISCV64.globalRegMaybe
    arch
     | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
         PPC.globalRegMaybe
@@ -104,6 +109,7 @@ freeReg platform
    ArchSPARC   -> SPARC.freeReg
    ArchARM {}  -> ARM.freeReg
    ArchAArch64 -> AArch64.freeReg
+   ArchRISCV64 -> RISCV64.freeReg
    arch
     | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] ->
         PPC.freeReg
Index: ghc-8.10.7/compiler/ghc.cabal.in
===================================================================
--- ghc-8.10.7.orig/compiler/ghc.cabal.in
+++ ghc-8.10.7/compiler/ghc.cabal.in
@@ -294,6 +294,7 @@ Library
         GHC.Platform.AArch64
         GHC.Platform.NoRegs
         GHC.Platform.PPC
+        GHC.Platform.RISCV64
         GHC.Platform.S390X
         GHC.Platform.SPARC
         GHC.Platform.X86
Index: ghc-8.10.7/compiler/main/DriverPipeline.hs
===================================================================
--- ghc-8.10.7.orig/compiler/main/DriverPipeline.hs
+++ ghc-8.10.7/compiler/main/DriverPipeline.hs
@@ -937,6 +937,7 @@ llvmOptions dflags =
     ++ [("", "-mcpu=" ++ mcpu)   | not (null mcpu)
                                  , not (any (isInfixOf "-mcpu") (getOpts dflags opt_lc)) ]
     ++ [("", "-mattr=" ++ attrs) | not (null attrs) ]
+    ++ [("", "-target-abi=" ++ abi) | not (null abi) ]
 
   where target = platformMisc_llvmTarget $ platformMisc dflags
         Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets $ llvmConfig dflags)
@@ -966,6 +967,11 @@ llvmOptions dflags =
               ++ ["+bmi"     | isBmiEnabled dflags      ]
               ++ ["+bmi2"    | isBmi2Enabled dflags     ]
 
+        abi :: String
+        abi = case platformArch (targetPlatform dflags) of
+                ArchRISCV64 -> "lp64d"
+                _           -> ""
+
 -- -----------------------------------------------------------------------------
 -- | Each phase in the pipeline returns the next phase to execute, and the
 -- name of the file in which the output was placed.
Index: ghc-8.10.7/compiler/nativeGen/AsmCodeGen.hs
===================================================================
--- ghc-8.10.7.orig/compiler/nativeGen/AsmCodeGen.hs
+++ ghc-8.10.7/compiler/nativeGen/AsmCodeGen.hs
@@ -177,6 +177,7 @@ nativeCodeGen dflags this_mod modLoc h u
       ArchAlpha     -> panic "nativeCodeGen: No NCG for Alpha"
       ArchMipseb    -> panic "nativeCodeGen: No NCG for mipseb"
       ArchMipsel    -> panic "nativeCodeGen: No NCG for mipsel"
+      ArchRISCV64   -> panic "nativeCodeGen: No NCG for RISCV64"
       ArchUnknown   -> panic "nativeCodeGen: No NCG for unknown arch"
       ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
 
Index: ghc-8.10.7/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
===================================================================
--- ghc-8.10.7.orig/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
+++ ghc-8.10.7/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
@@ -120,6 +120,7 @@ trivColorable platform virtualRegSqueeze
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
                             ArchS390X     -> panic "trivColorable ArchS390X"
+                            ArchRISCV64   -> panic "trivColorable ArchRISCV64"
                             ArchJavaScript-> panic "trivColorable ArchJavaScript"
                             ArchUnknown   -> panic "trivColorable ArchUnknown")
         , count2        <- accSqueeze 0 cALLOCATABLE_REGS_INTEGER
@@ -151,6 +152,7 @@ trivColorable platform virtualRegSqueeze
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
                             ArchS390X     -> panic "trivColorable ArchS390X"
+                            ArchRISCV64   -> panic "trivColorable ArchRISCV64"
                             ArchJavaScript-> panic "trivColorable ArchJavaScript"
                             ArchUnknown   -> panic "trivColorable ArchUnknown")
         , count2        <- accSqueeze 0 cALLOCATABLE_REGS_FLOAT
@@ -184,6 +186,7 @@ trivColorable platform virtualRegSqueeze
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
                             ArchS390X     -> panic "trivColorable ArchS390X"
+                            ArchRISCV64   -> panic "trivColorable ArchRISCV64"
                             ArchJavaScript-> panic "trivColorable ArchJavaScript"
                             ArchUnknown   -> panic "trivColorable ArchUnknown")
         , count2        <- accSqueeze 0 cALLOCATABLE_REGS_DOUBLE
Index: ghc-8.10.7/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
===================================================================
--- ghc-8.10.7.orig/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
+++ ghc-8.10.7/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
@@ -84,5 +84,6 @@ maxSpillSlots dflags
                 ArchAlpha     -> panic "maxSpillSlots ArchAlpha"
                 ArchMipseb    -> panic "maxSpillSlots ArchMipseb"
                 ArchMipsel    -> panic "maxSpillSlots ArchMipsel"
+                ArchRISCV64   -> panic "maxSpillSlots ArchRISCV64"
                 ArchJavaScript-> panic "maxSpillSlots ArchJavaScript"
                 ArchUnknown   -> panic "maxSpillSlots ArchUnknown"
Index: ghc-8.10.7/compiler/nativeGen/RegAlloc/Linear/Main.hs
===================================================================
--- ghc-8.10.7.orig/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ ghc-8.10.7/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -221,6 +221,7 @@ linearRegAlloc dflags entry_ids block_li
       ArchAlpha      -> panic "linearRegAlloc ArchAlpha"
       ArchMipseb     -> panic "linearRegAlloc ArchMipseb"
       ArchMipsel     -> panic "linearRegAlloc ArchMipsel"
+      ArchRISCV64    -> panic "linearRegAlloc ArchRISCV64"
       ArchJavaScript -> panic "linearRegAlloc ArchJavaScript"
       ArchUnknown    -> panic "linearRegAlloc ArchUnknown"
  where
Index: ghc-8.10.7/compiler/nativeGen/TargetReg.hs
===================================================================
--- ghc-8.10.7.orig/compiler/nativeGen/TargetReg.hs
+++ ghc-8.10.7/compiler/nativeGen/TargetReg.hs
@@ -53,6 +53,7 @@ targetVirtualRegSqueeze platform
       ArchAlpha     -> panic "targetVirtualRegSqueeze ArchAlpha"
       ArchMipseb    -> panic "targetVirtualRegSqueeze ArchMipseb"
       ArchMipsel    -> panic "targetVirtualRegSqueeze ArchMipsel"
+      ArchRISCV64   -> panic "targetVirtualRegSqueeze ArchRISCV64"
       ArchJavaScript-> panic "targetVirtualRegSqueeze ArchJavaScript"
       ArchUnknown   -> panic "targetVirtualRegSqueeze ArchUnknown"
 
@@ -72,6 +73,7 @@ targetRealRegSqueeze platform
       ArchAlpha     -> panic "targetRealRegSqueeze ArchAlpha"
       ArchMipseb    -> panic "targetRealRegSqueeze ArchMipseb"
       ArchMipsel    -> panic "targetRealRegSqueeze ArchMipsel"
+      ArchRISCV64   -> panic "targetRealRegSqueeze ArchRISCV64"
       ArchJavaScript-> panic "targetRealRegSqueeze ArchJavaScript"
       ArchUnknown   -> panic "targetRealRegSqueeze ArchUnknown"
 
@@ -90,6 +92,7 @@ targetClassOfRealReg platform
       ArchAlpha     -> panic "targetClassOfRealReg ArchAlpha"
       ArchMipseb    -> panic "targetClassOfRealReg ArchMipseb"
       ArchMipsel    -> panic "targetClassOfRealReg ArchMipsel"
+      ArchRISCV64   -> panic "targetClassOfRealReg ArchRISCV64"
       ArchJavaScript-> panic "targetClassOfRealReg ArchJavaScript"
       ArchUnknown   -> panic "targetClassOfRealReg ArchUnknown"
 
@@ -108,6 +111,7 @@ targetMkVirtualReg platform
       ArchAlpha     -> panic "targetMkVirtualReg ArchAlpha"
       ArchMipseb    -> panic "targetMkVirtualReg ArchMipseb"
       ArchMipsel    -> panic "targetMkVirtualReg ArchMipsel"
+      ArchRISCV64   -> panic "targetMkVirtualReg ArchRISCV64"
       ArchJavaScript-> panic "targetMkVirtualReg ArchJavaScript"
       ArchUnknown   -> panic "targetMkVirtualReg ArchUnknown"
 
@@ -126,6 +130,7 @@ targetRegDotColor platform
       ArchAlpha     -> panic "targetRegDotColor ArchAlpha"
       ArchMipseb    -> panic "targetRegDotColor ArchMipseb"
       ArchMipsel    -> panic "targetRegDotColor ArchMipsel"
+      ArchRISCV64   -> panic "targetRegDotColor ArchRISCV64"
       ArchJavaScript-> panic "targetRegDotColor ArchJavaScript"
       ArchUnknown   -> panic "targetRegDotColor ArchUnknown"
 
Index: ghc-8.10.7/configure
===================================================================
--- ghc-8.10.7.orig/configure
+++ ghc-8.10.7/configure
@@ -4921,7 +4921,7 @@ esac
 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether target supports a registerised ABI" >&5
 printf %s "checking whether target supports a registerised ABI... " >&6; }
 case "$TargetArch" in
-    i386|x86_64|powerpc|powerpc64|powerpc64le|s390x|arm|aarch64)
+    i386|x86_64|powerpc|powerpc64|powerpc64le|s390x|arm|aarch64|riscv64)
         UnregisterisedDefault=NO
         { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
 printf "%s\n" "yes" >&6; }
@@ -4972,7 +4972,7 @@ printf %s "checking whether target suppo
 case "$Unregisterised" in
     NO)
         case "$TargetArch" in
-            ia64|powerpc64|powerpc64le|s390x)
+            ia64|powerpc64|powerpc64le|s390x|riscv64)
                 TablesNextToCodeDefault=NO
                 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
 printf "%s\n" "no" >&6; }
@@ -5030,7 +5030,7 @@ fi
 
 
 case "$target" in
-    powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux)
+    powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*)
         TargetHasRTSLinker=NO
         ;;
     *)
@@ -10565,7 +10565,10 @@ rm -f core conftest.err conftest.$ac_obj
         mipsel)
             test -z "$2" || eval "$2=ArchMipsel"
             ;;
-        hppa|hppa1_1|ia64|m68k|nios2|riscv32|riscv64|rs6000|s390|sh4|vax)
+        riscv64)
+            test -z "$2" || eval "$2=ArchRISCV64"
+            ;;
+        hppa|hppa1_1|ia64|m68k|nios2|riscv32|rs6000|s390|sh4|vax)
             test -z "$2" || eval "$2=ArchUnknown"
             ;;
         *)
Index: ghc-8.10.7/configure.ac
===================================================================
--- ghc-8.10.7.orig/configure.ac
+++ ghc-8.10.7/configure.ac
@@ -262,7 +262,7 @@ dnl ------------------------------------
 
 AC_MSG_CHECKING(whether target supports a registerised ABI)
 case "$TargetArch" in
-    i386|x86_64|powerpc|powerpc64|powerpc64le|s390x|arm|aarch64)
+    i386|x86_64|powerpc|powerpc64|powerpc64le|s390x|arm|aarch64|riscv64)
         UnregisterisedDefault=NO
         AC_MSG_RESULT([yes])
         ;;
@@ -297,7 +297,7 @@ AC_MSG_CHECKING(whether target supports
 case "$Unregisterised" in
     NO)
         case "$TargetArch" in
-            ia64|powerpc64|powerpc64le|s390x)
+            ia64|powerpc64|powerpc64le|s390x|riscv64)
                 TablesNextToCodeDefault=NO
                 AC_MSG_RESULT([no])
                 ;;
@@ -326,7 +326,7 @@ AC_SUBST(TablesNextToCode)
 dnl ** Does target have runtime linker support?
 dnl --------------------------------------------------------------
 case "$target" in
-    powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux)
+    powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*)
         TargetHasRTSLinker=NO
         ;;
     *)
Index: ghc-8.10.7/includes/CodeGen.Platform.hs
===================================================================
--- ghc-8.10.7.orig/includes/CodeGen.Platform.hs
+++ ghc-8.10.7/includes/CodeGen.Platform.hs
@@ -380,6 +380,74 @@ import Reg
 # define f14 30
 # define f15 31
 
+#elif defined(MACHREGS_riscv64)
+
+# define zero 0
+# define ra   1
+# define sp   2
+# define gp   3
+# define tp   4
+# define t0   5
+# define t1   6
+# define t2   7
+# define s0   8
+# define s1   9
+# define a0  10
+# define a1  11
+# define a2  12
+# define a3  13
+# define a4  14
+# define a5  15
+# define a6  16
+# define a7  17
+# define s2  18
+# define s3  19
+# define s4  20
+# define s5  21
+# define s6  22
+# define s7  23
+# define s8  24
+# define s9  25
+# define s10 26
+# define s11 27
+# define t3  28
+# define t4  29
+# define t5  30
+# define t6  31
+
+# define ft0  32
+# define ft1  33
+# define ft2  34
+# define ft3  35
+# define ft4  36
+# define ft5  37
+# define ft6  38
+# define ft7  39
+# define fs0  40
+# define fs1  41
+# define fa0  42
+# define fa1  43
+# define fa2  44
+# define fa3  45
+# define fa4  46
+# define fa5  47
+# define fa6  48
+# define fa7  49
+# define fs2  50
+# define fs3  51
+# define fs4  52
+# define fs5  53
+# define fs6  54
+# define fs7  55
+# define fs8  56
+# define fs9  57
+# define fs10 58
+# define fs11 59
+# define ft8  60
+# define ft9  61
+# define ft10 62
+# define ft11 63
+
 #endif
 
 callerSaves :: GlobalReg -> Bool
@@ -667,7 +735,7 @@ globalRegMaybe :: GlobalReg -> Maybe Rea
 #if defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \
     || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc) \
     || defined(MACHREGS_arm) || defined(MACHREGS_aarch64) \
-    || defined(MACHREGS_s390x)
+    || defined(MACHREGS_s390x) || defined(MACHREGS_riscv64)
 # if defined(REG_Base)
 globalRegMaybe BaseReg                  = Just (RealRegSingle REG_Base)
 # endif
Index: ghc-8.10.7/includes/stg/MachRegs.h
===================================================================
--- ghc-8.10.7.orig/includes/stg/MachRegs.h
+++ ghc-8.10.7/includes/stg/MachRegs.h
@@ -661,6 +661,68 @@ the stack. See Note [Overlapping global
 #define CALLER_SAVES_D5
 #define CALLER_SAVES_D6
 
+/* -----------------------------------------------------------------------------
+   The riscv64 register mapping
+
+   Register    | Role(s)                                 | Call effect
+   ------------+-----------------------------------------+-------------
+   zero        | Hard-wired zero                         | -
+   ra          | Return address                          | caller-saved
+   sp          | Stack pointer                           | callee-saved
+   gp          | Global pointer                          | callee-saved
+   tp          | Thread pointer                          | callee-saved
+   t0,t1,t2    | -                                       | caller-saved
+   s0          | Frame pointer                           | callee-saved
+   s1          | -                                       | callee-saved
+   a0,a1       | Arguments / return values               | caller-saved
+   a2..a7      | Arguments                               | caller-saved
+   s2..s11     | -                                       | callee-saved
+   t3..t6      | -                                       | caller-saved
+   ft0..ft7    | -                                       | caller-saved
+   fs0,fs1     | -                                       | callee-saved
+   fa0,fa1     | Arguments / return values               | caller-saved
+   fa2..fa7    | Arguments                               | caller-saved
+   fs2..fs11   | -                                       | callee-saved
+   ft8..ft11   | -                                       | caller-saved
+
+   Each general purpose register as well as each floating-point
+   register is 64 bits wide.
+
+   -------------------------------------------------------------------------- */
+
+#elif defined(MACHREGS_riscv64)
+
+#define REG(x) __asm__(#x)
+
+#define REG_Base        s1
+#define REG_Sp          s2
+#define REG_Hp          s3
+#define REG_R1          s4
+#define REG_R2          s5
+#define REG_R3          s6
+#define REG_R4          s7
+#define REG_R5          s8
+#define REG_R6          s9
+#define REG_R7          s10
+#define REG_SpLim       s11
+
+#define REG_F1          fs0
+#define REG_F2          fs1
+#define REG_F3          fs2
+#define REG_F4          fs3
+#define REG_F5          fs4
+#define REG_F6          fs5
+
+#define REG_D1          fs6
+#define REG_D2          fs7
+#define REG_D3          fs8
+#define REG_D4          fs9
+#define REG_D5          fs10
+#define REG_D6          fs11
+
+#define MAX_REAL_FLOAT_REG   6
+#define MAX_REAL_DOUBLE_REG  6
+
 #else
 
 #error Cannot find platform to give register info for
Index: ghc-8.10.7/includes/stg/MachRegsForHost.h
===================================================================
--- ghc-8.10.7.orig/includes/stg/MachRegsForHost.h
+++ ghc-8.10.7/includes/stg/MachRegsForHost.h
@@ -71,6 +71,10 @@
 #define MACHREGS_s390x    1
 #endif
 
+#if defined(riscv64_HOST_ARCH)
+#define MACHREGS_riscv64  1
+#endif
+
 #endif
 
 #include "MachRegs.h"
Index: ghc-8.10.7/includes/stg/SMP.h
===================================================================
--- ghc-8.10.7.orig/includes/stg/SMP.h
+++ ghc-8.10.7/includes/stg/SMP.h
@@ -377,6 +377,8 @@ write_barrier(void) {
     __asm__ __volatile__ ("" : : : "memory");
 #elif defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)
     __asm__ __volatile__ ("dmb  st" : : : "memory");
+#elif defined(riscv64_HOST_ARCH)
+    __asm__ __volatile__ ("fence w,w" : : : "memory");
 #else
 #error memory barriers unimplemented on this architecture
 #endif
@@ -401,6 +403,8 @@ store_load_barrier(void) {
     __asm__ __volatile__ ("dmb" : : : "memory");
 #elif defined(aarch64_HOST_ARCH)
     __asm__ __volatile__ ("dmb sy" : : : "memory");
+#elif defined(riscv64_HOST_ARCH)
+    __asm__ __volatile__ ("fence w,r" : : : "memory");
 #else
 #error memory barriers unimplemented on this architecture
 #endif
@@ -426,6 +430,8 @@ load_load_barrier(void) {
     __asm__ __volatile__ ("dmb" : : : "memory");
 #elif defined(aarch64_HOST_ARCH)
     __asm__ __volatile__ ("dmb sy" : : : "memory");
+#elif defined(riscv64_HOST_ARCH)
+    __asm__ __volatile__ ("fence w,r" : : : "memory");
 #else
 #error memory barriers unimplemented on this architecture
 #endif
Index: ghc-8.10.7/libraries/ghc-boot/GHC/Platform.hs
===================================================================
--- ghc-8.10.7.orig/libraries/ghc-boot/GHC/Platform.hs
+++ ghc-8.10.7/libraries/ghc-boot/GHC/Platform.hs
@@ -118,6 +118,7 @@ data Arch
         | ArchAlpha
         | ArchMipseb
         | ArchMipsel
+        | ArchRISCV64
         | ArchJavaScript
         deriving (Read, Show, Eq)
 
@@ -159,6 +160,7 @@ stringEncodeArch = \case
   ArchAlpha -> "alpha"
   ArchMipseb -> "mipseb"
   ArchMipsel -> "mipsel"
+  ArchRISCV64 -> "riscv64"
   ArchJavaScript -> "js"
 
 isARM :: Arch -> Bool
Index: ghc-8.10.7/llvm-targets
===================================================================
--- ghc-8.10.7.orig/llvm-targets
+++ ghc-8.10.7/llvm-targets
@@ -34,6 +34,8 @@
 ,("powerpc64le-unknown-linux-musl", ("e-m:e-i64:64-n32:64", "ppc64le", "+secure-plt"))
 ,("powerpc64le-unknown-linux", ("e-m:e-i64:64-n32:64", "ppc64le", ""))
 ,("s390x-ibm-linux", ("E-m:e-i1:8:16-i8:8:16-i64:64-f128:64-a:8:16-n32:64", "z10", ""))
+,("riscv64-unknown-linux-gnu", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+m +a +f +d +c +relax"))
+,("riscv64-unknown-linux", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+m +a +f +d +c +relax"))
 ,("i386-apple-darwin", ("e-m:o-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:128-n8:16:32-S128", "yonah", ""))
 ,("x86_64-apple-darwin", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "core2", ""))
 ,("arm64-apple-darwin", ("e-m:o-i64:64-i128:128-n32:64-S128", "apple-a7", "+fp-armv8 +neon +crypto +zcm +zcz +sha2 +aes"))
Index: ghc-8.10.7/mk/config.mk.in
===================================================================
--- ghc-8.10.7.orig/mk/config.mk.in
+++ ghc-8.10.7/mk/config.mk.in
@@ -192,7 +192,7 @@ ifeq "$(TargetArch_CPP)" "arm"
 # We don't support load/store barriers pre-ARMv7. See #10433.
 ArchSupportsSMP=$(if $(filter $(ARM_ISA),ARMv5 ARMv6),NO,YES)
 else
-ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le s390x aarch64)))
+ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le s390x aarch64 riscv64)))
 endif
 
 # The THREADED_RTS requires `BaseReg` to be in a register and the
Index: ghc-8.10.7/rts/StgCRunAsm.S
===================================================================
--- ghc-8.10.7.orig/rts/StgCRunAsm.S
+++ ghc-8.10.7/rts/StgCRunAsm.S
@@ -276,6 +276,150 @@ StgReturn:
 	.size StgReturn, .-StgReturn
 
 	.section	.note.GNU-stack,"",@progbits
+
+#elif defined(riscv64_HOST_ARCH)
+# define STACK_FRAME_SIZE (RESERVED_C_STACK_BYTES+208)
+	.text
+	.align 1
+	.globl StgRun
+	.type StgRun, @function
+StgRun:
+	.cfi_startproc
+	addi	sp,sp,-208
+	.cfi_def_cfa_offset 208
+	/* save callee-saved registers */
+	sd ra,200(sp)
+	sd s0,192(sp)
+	sd s1,184(sp)
+	sd s2,176(sp)
+	sd s3,168(sp)
+	sd s4,160(sp)
+	sd s5,152(sp)
+	sd s6,144(sp)
+	sd s7,136(sp)
+	sd s8,128(sp)
+	sd s9,120(sp)
+	sd s10,112(sp)
+	sd s11,104(sp)
+	fsd fs0,88(sp)
+	fsd fs1,80(sp)
+	fsd fs2,72(sp)
+	fsd fs3,64(sp)
+	fsd fs4,56(sp)
+	fsd fs5,48(sp)
+	fsd fs6,40(sp)
+	fsd fs7,32(sp)
+	fsd fs8,24(sp)
+	fsd fs9,16(sp)
+	fsd fs10,8(sp)
+	fsd fs11,0(sp)
+	/* allocate stack frame */
+	li t0,RESERVED_C_STACK_BYTES
+	sub sp,sp,t0
+	.cfi_def_cfa_offset STACK_FRAME_SIZE
+	.cfi_offset 1, -8
+	.cfi_offset 8, -16
+	.cfi_offset 9, -24
+	.cfi_offset 18, -32
+	.cfi_offset 19, -40
+	.cfi_offset 20, -48
+	.cfi_offset 21, -56
+	.cfi_offset 22, -64
+	.cfi_offset 23, -72
+	.cfi_offset 24, -80
+	.cfi_offset 25, -88
+	.cfi_offset 26, -96
+	.cfi_offset 27, -104
+	.cfi_offset 40, -120
+	.cfi_offset 41, -128
+	.cfi_offset 50, -136
+	.cfi_offset 51, -144
+	.cfi_offset 52, -152
+	.cfi_offset 53, -160
+	.cfi_offset 54, -168
+	.cfi_offset 55, -176
+	.cfi_offset 56, -184
+	.cfi_offset 57, -192
+	.cfi_offset 58, -200
+	.cfi_offset 59, -208
+	/* set STGs BaseReg from RISCV a1 */
+        mv s1,a1
+	/* jump to STG function */
+        jr a0
+	.cfi_endproc
+	.size StgRun, .-StgRun
+
+	.text
+	.align 1
+	.globl StgReturn
+	.type StgReturn, @function
+StgReturn:
+	.cfi_startproc
+	/* set return value from STGs R1 (RISCV s4) */
+	mv a0,s4
+	/* deallocate stack frame */
+	li t0,RESERVED_C_STACK_BYTES
+	add sp,sp,t0
+	.cfi_def_cfa_offset 208
+	/* restore callee-saved registers */
+	ld	ra,200(sp)
+	.cfi_restore 1
+	ld	s0,192(sp)
+	.cfi_restore 8
+	ld	s1,184(sp)
+	.cfi_restore 9
+	ld	s2,176(sp)
+	.cfi_restore 18
+	ld	s3,168(sp)
+	.cfi_restore 19
+	ld	s4,160(sp)
+	.cfi_restore 20
+	ld	s5,152(sp)
+	.cfi_restore 21
+	ld	s6,144(sp)
+	.cfi_restore 22
+	ld	s7,136(sp)
+	.cfi_restore 23
+	ld	s8,128(sp)
+	.cfi_restore 24
+	ld	s9,120(sp)
+	.cfi_restore 25
+	ld	s10,112(sp)
+	.cfi_restore 26
+	ld	s11,104(sp)
+	.cfi_restore 27
+	fld	fs0,88(sp)
+	.cfi_restore 40
+	fld	fs1,80(sp)
+	.cfi_restore 41
+	fld	fs2,72(sp)
+	.cfi_restore 50
+	fld	fs3,64(sp)
+	.cfi_restore 51
+	fld	fs4,56(sp)
+	.cfi_restore 52
+	fld	fs5,48(sp)
+	.cfi_restore 53
+	fld	fs6,40(sp)
+	.cfi_restore 54
+	fld	fs7,32(sp)
+	.cfi_restore 55
+	fld	fs8,24(sp)
+	.cfi_restore 56
+	fld	fs9,16(sp)
+	.cfi_restore 57
+	fld	fs10,8(sp)
+	.cfi_restore 58
+	fld	fs11,0(sp)
+	.cfi_restore 59
+	addi	sp,sp,208
+	.cfi_def_cfa_offset 0
+	/* jump back to caller of StgRun() */
+	ret
+	.cfi_endproc
+	.size StgReturn, .-StgReturn
+
+	.section	.note.GNU-stack,"",@progbits
 #endif
 
 #endif /* !USE_MINIINTERPRETER */
Index: ghc-8.10.7/rts/ghc.mk
===================================================================
--- ghc-8.10.7.orig/rts/ghc.mk
+++ ghc-8.10.7/rts/ghc.mk
@@ -58,7 +58,7 @@ ifneq "$(findstring $(TargetArch_CPP), i
 rts_S_SRCS += rts/AdjustorAsm.S
 endif
 # this matches substrings of powerpc64le, including "powerpc" and "powerpc64"
-ifneq "$(findstring $(TargetArch_CPP), powerpc64le s390x)" ""
+ifneq "$(findstring $(TargetArch_CPP), powerpc64le s390x riscv64)" ""
 # unregisterised builds use the mini interpreter
 ifneq "$(GhcUnregisterised)" "YES"
 rts_S_SRCS += rts/StgCRunAsm.S
Index: ghc-8.10.7/rts/linker/Elf.c
===================================================================
--- ghc-8.10.7.orig/rts/linker/Elf.c
+++ ghc-8.10.7/rts/linker/Elf.c
@@ -406,6 +406,12 @@ ocVerifyImage_ELF ( ObjectCode* oc )
 #if defined(EM_AARCH64)
       case EM_AARCH64: IF_DEBUG(linker,debugBelch( "aarch64" )); break;
 #endif
+#if defined(EM_RISCV)
+      case EM_RISCV:  IF_DEBUG(linker,debugBelch( "riscv" ));
+          errorBelch("%s: RTS linker not implemented on riscv",
+                     oc->fileName);
+          return 0;
+#endif
        default:       IF_DEBUG(linker,debugBelch( "unknown" ));
                      errorBelch("%s: unknown architecture (e_machine == %d)"
                                 , oc->fileName, ehdr->e_machine);
Index: ghc-8.10.7/rts/rts.cabal.in
===================================================================
--- ghc-8.10.7.orig/rts/rts.cabal.in
+++ ghc-8.10.7/rts/rts.cabal.in
@@ -387,7 +387,7 @@ library
 
     if arch(i386) || arch(powerpc) || arch(powerpc64)
        asm-sources: AdjustorAsm.S
-    if arch(powerpc) || arch(powerpc64) || arch(powerpc64le) || arch(s390x)
+    if arch(powerpc) || arch(powerpc64) || arch(powerpc64le) || arch(s390x) || arch(riscv64)
        asm-sources: StgCRunAsm.S
 
     c-sources: Adjustor.c
Index: ghc-8.10.7/utils/genapply/Main.hs
===================================================================
--- ghc-8.10.7.orig/utils/genapply/Main.hs
+++ ghc-8.10.7/utils/genapply/Main.hs
@@ -17,6 +17,8 @@ module Main(main) where
 -- We improperly include *HOST* macros for our target...
 #include "../../includes/ghcconfig.h"
 
+#undef UnregisterisedCompiler
+
 -- ...so that this header defines the right stuff.  It is the RTS's host, but
 -- our target, as we are generating code that uses that RTS.
 #include "../../includes/stg/MachRegsForHost.h"
Index: ghc-8.10.7/utils/llvm-targets/gen-data-layout.sh
===================================================================
--- ghc-8.10.7.orig/utils/llvm-targets/gen-data-layout.sh
+++ ghc-8.10.7/utils/llvm-targets/gen-data-layout.sh
@@ -72,6 +72,9 @@ TARGETS=(
     "powerpc64le-unknown-linux"
     # Linux s390x
     "s390x-ibm-linux"
+    # Linux riscv64
+    "riscv64-unknown-linux-gnu"
+    "riscv64-unknown-linux"
 
     #########################
     # Darwin
openSUSE Build Service is sponsored by