ghc/ghc-arm64.patch

commit c29bf984dd20431cd4344e8a5c444d7a5be08389
Author: Colin Watson <cjwatson@debian.org>
Date:   Mon Apr 21 22:26:56 2014 -0500
Bug: https://ghc.haskell.org/trac/ghc/ticket/7942

    ghc: initial AArch64 patches
    
    Signed-off-by: Austin Seipp <austin@well-typed.com>

Index: ghc-7.8.3/aclocal.m4
===================================================================
--- ghc-7.8.3.orig/aclocal.m4	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/aclocal.m4	2014-07-10 10:16:42.529187516 +0200
@@ -197,6 +197,9 @@
             GET_ARM_ISA()
             test -z "[$]2" || eval "[$]2=\"ArchARM {armISA = \$ARM_ISA, armISAExt = \$ARM_ISA_EXT, armABI = \$ARM_ABI}\""
             ;;
+        aarch64)
+            test -z "[$]2" || eval "[$]2=ArchARM64"
+            ;;
         alpha)
             test -z "[$]2" || eval "[$]2=ArchAlpha"
             ;;
@@ -1862,6 +1865,9 @@
 # converts cpu from gnu to ghc naming, and assigns the result to $target_var
 AC_DEFUN([GHC_CONVERT_CPU],[
 case "$1" in
+  aarch64*)
+    $2="aarch64"
+    ;;
   alpha*)
     $2="alpha"
     ;;
Index: ghc-7.8.3/compiler/nativeGen/AsmCodeGen.lhs
===================================================================
--- ghc-7.8.3.orig/compiler/nativeGen/AsmCodeGen.lhs	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/compiler/nativeGen/AsmCodeGen.lhs	2014-07-10 10:16:42.529187516 +0200
@@ -166,6 +166,7 @@
       ArchPPC     -> nCG' (ppcNcgImpl    dflags)
       ArchSPARC   -> nCG' (sparcNcgImpl  dflags)
       ArchARM {}  -> panic "nativeCodeGen: No NCG for ARM"
+      ArchARM64   -> panic "nativeCodeGen: No NCG for ARM64"
       ArchPPC_64  -> panic "nativeCodeGen: No NCG for PPC 64"
       ArchAlpha   -> panic "nativeCodeGen: No NCG for Alpha"
       ArchMipseb  -> panic "nativeCodeGen: No NCG for mipseb"
Index: ghc-7.8.3/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
===================================================================
--- ghc-7.8.3.orig/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs	2014-07-10 10:16:42.529187516 +0200
@@ -113,6 +113,7 @@
                             ArchSPARC     -> 14
                             ArchPPC_64    -> panic "trivColorable ArchPPC_64"
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
+                            ArchARM64     -> panic "trivColorable ArchARM64"
                             ArchAlpha     -> panic "trivColorable ArchAlpha"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
@@ -137,6 +138,7 @@
                             ArchSPARC     -> 22
                             ArchPPC_64    -> panic "trivColorable ArchPPC_64"
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
+                            ArchARM64     -> panic "trivColorable ArchARM64"
                             ArchAlpha     -> panic "trivColorable ArchAlpha"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
@@ -161,6 +163,7 @@
                             ArchSPARC     -> 11
                             ArchPPC_64    -> panic "trivColorable ArchPPC_64"
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
+                            ArchARM64     -> panic "trivColorable ArchARM64"
                             ArchAlpha     -> panic "trivColorable ArchAlpha"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
@@ -185,6 +188,7 @@
                             ArchSPARC     -> 0
                             ArchPPC_64    -> panic "trivColorable ArchPPC_64"
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
+                            ArchARM64     -> panic "trivColorable ArchARM64"
                             ArchAlpha     -> panic "trivColorable ArchAlpha"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
Index: ghc-7.8.3/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
===================================================================
--- ghc-7.8.3.orig/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs	2014-07-10 10:16:42.529187516 +0200
@@ -74,6 +74,7 @@
                 ArchPPC       -> PPC.Instr.maxSpillSlots dflags
                 ArchSPARC     -> SPARC.Instr.maxSpillSlots dflags
                 ArchARM _ _ _ -> panic "maxSpillSlots ArchARM"
+                ArchARM64     -> panic "maxSpillSlots ArchARM64"
                 ArchPPC_64    -> panic "maxSpillSlots ArchPPC_64"
                 ArchAlpha     -> panic "maxSpillSlots ArchAlpha"
                 ArchMipseb    -> panic "maxSpillSlots ArchMipseb"
Index: ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/Main.hs
===================================================================
--- ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/Main.hs.orig	2015-02-07 18:19:27.364827776 +0100
+++ ghc-7.8.4/compiler/nativeGen/RegAlloc/Linear/Main.hs	2015-02-07 18:20:46.813771354 +0100
@@ -207,6 +207,7 @@
       ArchSPARC     -> linearRegAlloc' dflags (frInitFreeRegs platform :: SPARC.FreeRegs)  entry_ids block_live sccs
       ArchPPC       -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs)    entry_ids block_live sccs
       ArchARM _ _ _ -> panic "linearRegAlloc ArchARM"
+      ArchARM64     -> panic "linearRegAlloc ArchARM64"
       ArchPPC_64    -> panic "linearRegAlloc ArchPPC_64"
       ArchAlpha     -> panic "linearRegAlloc ArchAlpha"
       ArchMipseb    -> panic "linearRegAlloc ArchMipseb"
Index: ghc-7.8.3/compiler/nativeGen/TargetReg.hs
===================================================================
--- ghc-7.8.3.orig/compiler/nativeGen/TargetReg.hs	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/compiler/nativeGen/TargetReg.hs	2014-07-10 10:16:42.529187516 +0200
@@ -54,6 +54,7 @@
       ArchSPARC     -> SPARC.virtualRegSqueeze
       ArchPPC_64    -> panic "targetVirtualRegSqueeze ArchPPC_64"
       ArchARM _ _ _ -> panic "targetVirtualRegSqueeze ArchARM"
+      ArchARM64     -> panic "targetVirtualRegSqueeze ArchARM64"
       ArchAlpha     -> panic "targetVirtualRegSqueeze ArchAlpha"
       ArchMipseb    -> panic "targetVirtualRegSqueeze ArchMipseb"
       ArchMipsel    -> panic "targetVirtualRegSqueeze ArchMipsel"
@@ -70,6 +71,7 @@
       ArchSPARC     -> SPARC.realRegSqueeze
       ArchPPC_64    -> panic "targetRealRegSqueeze ArchPPC_64"
       ArchARM _ _ _ -> panic "targetRealRegSqueeze ArchARM"
+      ArchARM64     -> panic "targetRealRegSqueeze ArchARM64"
       ArchAlpha     -> panic "targetRealRegSqueeze ArchAlpha"
       ArchMipseb    -> panic "targetRealRegSqueeze ArchMipseb"
       ArchMipsel    -> panic "targetRealRegSqueeze ArchMipsel"
@@ -85,6 +87,7 @@
       ArchSPARC     -> SPARC.classOfRealReg
       ArchPPC_64    -> panic "targetClassOfRealReg ArchPPC_64"
       ArchARM _ _ _ -> panic "targetClassOfRealReg ArchARM"
+      ArchARM64     -> panic "targetClassOfRealReg ArchARM64"
       ArchAlpha     -> panic "targetClassOfRealReg ArchAlpha"
       ArchMipseb    -> panic "targetClassOfRealReg ArchMipseb"
       ArchMipsel    -> panic "targetClassOfRealReg ArchMipsel"
@@ -100,6 +103,7 @@
       ArchSPARC     -> SPARC.mkVirtualReg
       ArchPPC_64    -> panic "targetMkVirtualReg ArchPPC_64"
       ArchARM _ _ _ -> panic "targetMkVirtualReg ArchARM"
+      ArchARM64     -> panic "targetMkVirtualReg ArchARM64"
       ArchAlpha     -> panic "targetMkVirtualReg ArchAlpha"
       ArchMipseb    -> panic "targetMkVirtualReg ArchMipseb"
       ArchMipsel    -> panic "targetMkVirtualReg ArchMipsel"
@@ -115,6 +119,7 @@
       ArchSPARC     -> SPARC.regDotColor
       ArchPPC_64    -> panic "targetRegDotColor ArchPPC_64"
       ArchARM _ _ _ -> panic "targetRegDotColor ArchARM"
+      ArchARM64     -> panic "targetRegDotColor ArchARM64"
       ArchAlpha     -> panic "targetRegDotColor ArchAlpha"
       ArchMipseb    -> panic "targetRegDotColor ArchMipseb"
       ArchMipsel    -> panic "targetRegDotColor ArchMipsel"
Index: ghc-7.8.3/compiler/utils/Platform.hs
===================================================================
--- ghc-7.8.3.orig/compiler/utils/Platform.hs	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/compiler/utils/Platform.hs	2014-07-10 10:16:42.529187516 +0200
@@ -52,6 +52,7 @@
           , armISAExt :: [ArmISAExt]
           , armABI    :: ArmABI
           }
+        | ArchARM64
         | ArchAlpha
         | ArchMipseb
         | ArchMipsel
Index: ghc-7.8.3/includes/stg/HaskellMachRegs.h
===================================================================
--- ghc-7.8.3.orig/includes/stg/HaskellMachRegs.h	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/includes/stg/HaskellMachRegs.h	2014-07-10 10:16:42.533187516 +0200
@@ -38,6 +38,7 @@
 #define MACHREGS_powerpc  (powerpc_TARGET_ARCH || powerpc64_TARGET_ARCH || rs6000_TARGET_ARCH)
 #define MACHREGS_sparc    sparc_TARGET_ARCH
 #define MACHREGS_arm      arm_TARGET_ARCH
+#define MACHREGS_aarch64  aarch64_TARGET_ARCH
 #define MACHREGS_darwin   darwin_TARGET_OS
 
 #endif
Index: ghc-7.8.3/includes/stg/MachRegs.h
===================================================================
--- ghc-7.8.3.orig/includes/stg/MachRegs.h	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/includes/stg/MachRegs.h	2014-07-10 10:16:42.533187516 +0200
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 1998-2011
+ * (c) The GHC Team, 1998-2014
  *
  * Registers used in STG code.  Might or might not correspond to
  * actual machine registers.
@@ -531,6 +531,61 @@
 #define REG_D2    d11
 #endif
 
+/* -----------------------------------------------------------------------------
+   The ARMv8/AArch64 ABI register mapping
+
+   The AArch64 provides 31 64-bit general purpose registers
+   and 32 128-bit SIMD/floating point registers.
+
+   General purpose registers (see Chapter 5.1.1 in ARM IHI 0055B)
+
+   Register | Special | Role in the procedure call standard
+   ---------+---------+------------------------------------
+     SP     |         | The Stack Pointer
+     r30    |  LR     | The Link Register
+     r29    |  FP     | The Frame Pointer
+   r19-r28  |         | Callee-saved registers
+     r18    |         | The Platform Register, if needed; 
+            |         | or temporary register
+     r17    |  IP1    | The second intra-procedure-call temporary register
+     r16    |  IP0    | The first intra-procedure-call scratch register
+    r9-r15  |         | Temporary registers
+     r8     |         | Indirect result location register
+    r0-r7   |         | Parameter/result registers
+
+
+   FPU/SIMD registers
+
+   s/d/q/v0-v7    Argument / result/ scratch registers
+   s/d/q/v8-v15   callee-saved registers (must be preserved across subrutine calls,
+                  but only bottom 64-bit value needs to be preserved)
+   s/d/q/v16-v31  temporary registers
+
+   ----------------------------------------------------------------------------- */
+
+#elif MACHREGS_aarch64
+
+#define REG(x) __asm__(#x)
+
+#define REG_Base        r19
+#define REG_Sp          r20
+#define REG_Hp          r21
+#define REG_R1          r22
+#define REG_R2          r23
+#define REG_R3          r24
+#define REG_R4          r25
+#define REG_R5          r26
+#define REG_R6          r27
+#define REG_SpLim       r28
+
+#define REG_F1          s8
+#define REG_F2          s9
+#define REG_F3          s10
+#define REG_F4          s11
+
+#define REG_D1          d12
+#define REG_D2          d13
+
 #else
 
 #error Cannot find platform to give register info for
Index: ghc-7.8.3/rts/StgCRun.c
===================================================================
--- ghc-7.8.3.orig/rts/StgCRun.c	2014-07-10 10:16:42.533187516 +0200
+++ ghc-7.8.3/rts/StgCRun.c	2014-07-10 10:16:42.533187516 +0200
@@ -748,4 +748,70 @@
 }
 #endif
 
+#ifdef aarch64_HOST_ARCH
+
+StgRegTable *
+StgRun(StgFunPtr f, StgRegTable *basereg) {
+    StgRegTable * r;
+    __asm__ volatile (
+        /*
+         * save callee-saves registers on behalf of the STG code.
+         */
+        "stp x19, x20, [sp, #-16]!\n\t"
+        "stp x21, x22, [sp, #-16]!\n\t"
+        "stp x23, x24, [sp, #-16]!\n\t"
+        "stp x25, x26, [sp, #-16]!\n\t"
+        "stp x27, x28, [sp, #-16]!\n\t" 
+        "stp ip0, ip1, [sp, #-16]!\n\t"
+        "str lr, [sp, #-8]!\n\t"
+
+        /*
+         * allocate some space for Stg machine's temporary storage.
+         * Note: RESERVER_C_STACK_BYTES has to be a round number here or
+         * the assembler can't assemble it.
+         */
+        "str lr, [sp, %3]"
+        /* "sub sp, sp, %3\n\t" */
+        /*
+         * Set BaseReg
+         */
+        "mov x19, %2\n\t"
+        /*
+         * Jump to function argument.
+         */
+        "bx %1\n\t"
+
+        ".globl " STG_RETURN "\n\t"
+        ".type " STG_RETURN ", %%function\n"
+        STG_RETURN ":\n\t"
+        /*
+         * Free the space we allocated
+         */
+        "ldr lr, [sp], %3\n\t"
+        /* "add sp, sp, %3\n\t" */
+        /*
+         * Return the new register table, taking it from Stg's R1 (ARM64's R22).
+         */
+        "mov %0, x22\n\t"
+        /*
+         * restore callee-saves registers.
+         */
+        "ldr lr, [sp], #8\n\t"
+        "ldp ip0, ip1, [sp], #16\n\t"
+        "ldp x27, x28, [sp], #16\n\t"
+        "ldp x25, x26, [sp], #16\n\t"
+        "ldp x23, x24, [sp], #16\n\t"
+        "ldp x21, x22, [sp], #16\n\t"
+        "ldp x19, x20, [sp], #16\n\t"
+
+      : "=r" (r)
+      : "r" (f), "r" (basereg), "i" (RESERVED_C_STACK_BYTES)
+        : "%x19", "%x20", "%x21", "%x22", "%x23", "%x24", "%x25", "%x26", "%x27", "%x28",
+          "%ip0", "%ip1", "%lr"
+    );
+    return r;
+}
+
+#endif
+
 #endif /* !USE_MINIINTERPRETER */