Merge branch 'master' of http://darcs.haskell.org/ghc

11 files changed, 67 insertions, 37 deletions

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index c7bc823823..112dac0439 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1440,7 +1440,10 @@ mkExtraObjToLinkIntoBinary dflags dep_packages = do
       | isWindowsTarget = empty
       | otherwise = hcat [
           text "__asm__(\"\\t.section ", text ghcLinkInfoSectionName,
-                                    text ",\\\"\\\",@note\\n",
+                                    text ",\\\"\\\",",
+                                    text elfSectionNote,
+                                    text "\\n",
+
                     text "\\t.ascii \\\"", info', text "\\\"\\n\");" ]
           where
             -- we need to escape twice: once because we're inside a C string,
@@ -1450,6 +1453,16 @@ mkExtraObjToLinkIntoBinary dflags dep_packages = do
             escape :: String -> String
             escape = concatMap (charToC.fromIntegral.ord)
 
+            elfSectionNote :: String
+            elfSectionNote = case platformArch defaultTargetPlatform of
+                               ArchX86    -> "@note"
+                               ArchX86_64 -> "@note"
+                               ArchPPC    -> "@note"
+                               ArchPPC_64 -> "@note"
+                               ArchSPARC  -> "@note"
+                               ArchARM    -> "%note"
+                               ArchUnknown -> panic "elfSectionNote ArchUnknown"
+
 -- The "link info" is a string representing the parameters of the
 -- link.  We save this information in the binary, and the next time we
 -- link, if nothing else has changed, we use the link info stored in
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 1ea83e8e88..ff18615b1a 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -197,6 +197,8 @@ nativeCodeGen dflags h us cmms
                          ,ncgExpandTop              = map SPARC.CodeGen.Expand.expandTop
                          ,ncgMakeFarBranches        = id
                      }
+                 ArchARM ->
+                     panic "nativeCodeGen: No NCG for ARM"
                  ArchPPC_64 ->
                      panic "nativeCodeGen: No NCG for PPC 64"
                  ArchUnknown ->
diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
index 848b266116..802f847f11 100644
--- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
@@ -115,6 +115,7 @@ trivColorable virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions
                             ArchPPC     -> 16
                             ArchSPARC   -> 14
                             ArchPPC_64  -> panic "trivColorable ArchPPC_64"
+                            ArchARM     -> panic "trivColorable ArchARM"
                             ArchUnknown -> panic "trivColorable ArchUnknown")
         , count2        <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_INTEGER
                                 (virtualRegSqueeze RcInteger)
@@ -134,6 +135,7 @@ trivColorable virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions
                             ArchPPC     -> 0
                             ArchSPARC   -> 22
                             ArchPPC_64  -> panic "trivColorable ArchPPC_64"
+                            ArchARM     -> panic "trivColorable ArchARM"
                             ArchUnknown -> panic "trivColorable ArchUnknown")
         , count2        <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_FLOAT
                                 (virtualRegSqueeze RcFloat)
@@ -153,6 +155,7 @@ trivColorable virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions
                             ArchPPC     -> 26
                             ArchSPARC   -> 11
                             ArchPPC_64  -> panic "trivColorable ArchPPC_64"
+                            ArchARM     -> panic "trivColorable ArchARM"
                             ArchUnknown -> panic "trivColorable ArchUnknown")
         , count2        <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_DOUBLE
                                 (virtualRegSqueeze RcDouble)
@@ -172,6 +175,7 @@ trivColorable virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts exclusions
                             ArchPPC     -> 0
                             ArchSPARC   -> 0
                             ArchPPC_64  -> panic "trivColorable ArchPPC_64"
+                            ArchARM     -> panic "trivColorable ArchARM"
                             ArchUnknown -> panic "trivColorable ArchUnknown")
         , count2        <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_SSE
                                 (virtualRegSqueeze RcDoubleSSE)
diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
index b442d069a4..07cfc0f825 100644
--- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
@@ -68,6 +68,7 @@ maxSpillSlots = case platformArch defaultTargetPlatform of
                 ArchX86_64  -> X86.Instr.maxSpillSlots
                 ArchPPC     -> PPC.Instr.maxSpillSlots
                 ArchSPARC   -> SPARC.Instr.maxSpillSlots
+                ArchARM     -> panic "maxSpillSlots ArchARM"
                 ArchPPC_64  -> panic "maxSpillSlots ArchPPC_64"
                 ArchUnknown -> panic "maxSpillSlots ArchUnknown"
 
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index b91c2d0269..3682ffbe1d 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -183,6 +183,7 @@ linearRegAlloc dflags first_id block_live sccs
    ArchX86_64  -> linearRegAlloc' (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
    ArchSPARC   -> linearRegAlloc' (frInitFreeRegs :: SPARC.FreeRegs) first_id block_live sccs
    ArchPPC     -> linearRegAlloc' (frInitFreeRegs :: PPC.FreeRegs)   first_id block_live sccs
+   ArchARM     -> panic "linearRegAlloc ArchARM"
    ArchPPC_64  -> panic "linearRegAlloc ArchPPC_64"
    ArchUnknown -> panic "linearRegAlloc ArchUnknown"
 
diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs
index b357675eeb..e6427ed499 100644
--- a/compiler/nativeGen/TargetReg.hs
+++ b/compiler/nativeGen/TargetReg.hs
@@ -52,6 +52,7 @@ targetVirtualRegSqueeze
       ArchPPC     -> PPC.virtualRegSqueeze
       ArchSPARC   -> SPARC.virtualRegSqueeze
       ArchPPC_64  -> panic "targetVirtualRegSqueeze ArchPPC_64"
+      ArchARM     -> panic "targetVirtualRegSqueeze ArchARM"
       ArchUnknown -> panic "targetVirtualRegSqueeze ArchUnknown"
 
 targetRealRegSqueeze :: RegClass -> RealReg -> FastInt
@@ -62,6 +63,7 @@ targetRealRegSqueeze
       ArchPPC     -> PPC.realRegSqueeze
       ArchSPARC   -> SPARC.realRegSqueeze
       ArchPPC_64  -> panic "targetRealRegSqueeze ArchPPC_64"
+      ArchARM     -> panic "targetRealRegSqueeze ArchARM"
       ArchUnknown -> panic "targetRealRegSqueeze ArchUnknown"
 
 targetClassOfRealReg :: RealReg -> RegClass
@@ -72,6 +74,7 @@ targetClassOfRealReg
       ArchPPC     -> PPC.classOfRealReg
       ArchSPARC   -> SPARC.classOfRealReg
       ArchPPC_64  -> panic "targetClassOfRealReg ArchPPC_64"
+      ArchARM     -> panic "targetClassOfRealReg ArchARM"
       ArchUnknown -> panic "targetClassOfRealReg ArchUnknown"
 
 -- TODO: This should look at targetPlatform too
@@ -86,6 +89,7 @@ targetMkVirtualReg
       ArchPPC     -> PPC.mkVirtualReg
       ArchSPARC   -> SPARC.mkVirtualReg
       ArchPPC_64  -> panic "targetMkVirtualReg ArchPPC_64"
+      ArchARM     -> panic "targetMkVirtualReg ArchARM"
       ArchUnknown -> panic "targetMkVirtualReg ArchUnknown"
 
 targetRegDotColor :: RealReg -> SDoc
@@ -96,6 +100,7 @@ targetRegDotColor
       ArchPPC     -> PPC.regDotColor
       ArchSPARC   -> SPARC.regDotColor
       ArchPPC_64  -> panic "targetRegDotColor ArchPPC_64"
+      ArchARM     -> panic "targetRegDotColor ArchARM"
       ArchUnknown -> panic "targetRegDotColor ArchUnknown"
 
 
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index a667c51532..d191733af1 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1620,10 +1620,10 @@ genCCall target dest_regs args =
                     let
                         sizes               = map (arg_size . cmmExprType . hintlessCmm) (reverse args)
                         raw_arg_size        = sum sizes
-                        tot_arg_size        = if isDarwin then roundTo 16 raw_arg_size else raw_arg_size
+                        tot_arg_size        = roundTo 16 raw_arg_size
                         arg_pad_size        = tot_arg_size - raw_arg_size
                     delta0 <- getDeltaNat
-                    when isDarwin $ setDeltaNat (delta0 - arg_pad_size)
+                    setDeltaNat (delta0 - arg_pad_size)
 
                     use_sse2 <- sse2Enabled
                     push_codes <- mapM (push_arg use_sse2) (reverse args)
@@ -1646,7 +1646,7 @@ genCCall target dest_regs args =
                                         ++ "probably because too many return values."
 
                     let push_code
-                            | isDarwin && (arg_pad_size /= 0)
+                            | arg_pad_size /= 0
                             = toOL [SUB II32 (OpImm (ImmInt arg_pad_size)) (OpReg esp),
                                     DELTA (delta0 - arg_pad_size)]
                               `appOL` concatOL push_codes
@@ -1657,10 +1657,9 @@ genCCall target dest_regs args =
                           -- but not for stdcall (callee does it)
                           --
                           -- We have to pop any stack padding we added
-                          -- on Darwin even if we are doing stdcall, though (#5052)
+                          -- even if we are doing stdcall, though (#5052)
                         pop_size | cconv /= StdCallConv = tot_arg_size
-                                 | isDarwin = arg_pad_size
-                                 | otherwise = 0
+                                 | otherwise = arg_pad_size
 
                         call = callinsns `appOL`
                                toOL (
@@ -1703,10 +1702,6 @@ genCCall target dest_regs args =
                             assign_code dest_regs)
 
                   where
-                    isDarwin = case platformOS (targetPlatform dflags) of
-                               OSDarwin -> True
-                               _        -> False
-
                     arg_size :: CmmType -> Int  -- Width in bytes
                     arg_size ty = widthInBytes (typeWidth ty)
 
diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs
index 140ff57ae9..0f6613d00d 100644
--- a/compiler/nativeGen/X86/RegInfo.hs
+++ b/compiler/nativeGen/X86/RegInfo.hs
@@ -61,6 +61,7 @@ normalRegColors = case platformArch defaultTargetPlatform of
                   ArchPPC     -> panic "X86 normalRegColors ArchPPC"
                   ArchPPC_64  -> panic "X86 normalRegColors ArchPPC_64"
                   ArchSPARC   -> panic "X86 normalRegColors ArchSPARC"
+                  ArchARM     -> panic "X86 normalRegColors ArchARM"
                   ArchUnknown -> panic "X86 normalRegColors ArchUnknown"
 
 fpRegColors :: [(Reg,String)]
diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs
index f3749ca09c..40e4a015df 100644
--- a/compiler/utils/Platform.hs
+++ b/compiler/utils/Platform.hs
@@ -39,6 +39,7 @@ data Arch
         | ArchPPC
         | ArchPPC_64
         | ArchSPARC
+        | ArchARM
         deriving (Show, Eq)
 
 
@@ -63,6 +64,7 @@ target32Bit p = case platformArch p of
                 ArchPPC     -> True
                 ArchPPC_64  -> False
                 ArchSPARC   -> True
+                ArchARM     -> True
 
 
 -- | This predicates tells us whether the OS supports ELF-like shared libraries.
@@ -95,6 +97,8 @@ defaultTargetArch       = ArchPPC
 defaultTargetArch       = ArchPPC_64
 #elif sparc_TARGET_ARCH
 defaultTargetArch       = ArchSPARC
+#elif arm_TARGET_ARCH
+defaultTargetArch       = ArchARM
 #else
 defaultTargetArch       = ArchUnknown
 #endif
diff --git a/rts/StgCRun.c b/rts/StgCRun.c
index e28353c353..54ac04151c 100644
--- a/rts/StgCRun.c
+++ b/rts/StgCRun.c
@@ -128,18 +128,29 @@ StgFunPtr StgReturn(void)
 #define STG_GLOBAL ".global "
 #endif
 
-StgRegTable *
-StgRun(StgFunPtr f, StgRegTable *basereg) {
+static void GNUC3_ATTRIBUTE(used)
+StgRunIsImplementedInAssembler(void)
+{
+    __asm__ volatile (
+        STG_GLOBAL STG_RUN "\n"
+	STG_RUN ":\n\t"
 
-    unsigned char space[ RESERVED_C_STACK_BYTES + 4*sizeof(void *) ];
-    StgRegTable * r;
+	/*
+         * move %esp down to reserve an area for temporary storage
+         * during the execution of STG code.
+         *
+         * The stack pointer has to be aligned to a multiple of 16
+         * bytes from here - this is a requirement of the C ABI, so
+         * that C code can assign SSE2 registers directly to/from
+         * stack locations.
+	 */
+        "subl %0, %%esp\n\t"
 
-    __asm__ volatile (
 	/*
 	 * save callee-saves registers on behalf of the STG code.
 	 */
-	"movl %%esp, %%eax\n\t"
-	"addl %4, %%eax\n\t"
+        "movl %%esp, %%eax\n\t"
+        "addl %0-16, %%eax\n\t"
         "movl %%ebx,0(%%eax)\n\t"
         "movl %%esi,4(%%eax)\n\t"
         "movl %%edi,8(%%eax)\n\t"
@@ -147,25 +158,17 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
 	/*
 	 * Set BaseReg
 	 */
-	"movl %3,%%ebx\n\t"
+        "movl 24(%%eax),%%ebx\n\t"
 	/*
 	 * grab the function argument from the stack
 	 */
-        "movl %2,%%eax\n\t"
-        
-	/*
-	 * Darwin note:
-	 * The stack pointer has to be aligned to a multiple of 16 bytes at
-	 * this point. This works out correctly with gcc 4.0.1, but it might
-	 * break at any time in the future. TODO: Make this future-proof.
-	 */
-
-	/*
+        "movl 20(%%eax),%%eax\n\t"
+        /*
 	 * jump to it
 	 */
         "jmp *%%eax\n\t"
 
-	STG_GLOBAL STG_RETURN "\n"
+        STG_GLOBAL STG_RETURN "\n"
        	STG_RETURN ":\n\t"
 
 	"movl %%esi, %%eax\n\t"   /* Return value in R1  */
@@ -174,18 +177,19 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
 	 * restore callee-saves registers.  (Don't stomp on %%eax!)
 	 */
 	"movl %%esp, %%edx\n\t"
-	"addl %4, %%edx\n\t"
+        "addl %0-16, %%edx\n\t"
         "movl 0(%%edx),%%ebx\n\t"	/* restore the registers saved above */
         "movl 4(%%edx),%%esi\n\t"
         "movl 8(%%edx),%%edi\n\t"
         "movl 12(%%edx),%%ebp\n\t"
 
-      : "=&a" (r), "=m" (space)
-      : "m" (f), "m" (basereg), "i" (RESERVED_C_STACK_BYTES)
-      : "edx" /* stomps on %edx */
-    );
+        "addl %0, %%esp\n\t"
+        "ret"
 
-    return r;
+      : : "i" (RESERVED_C_STACK_BYTES + 16 + 12)
+        // + 16 to make room for the 4 registers we have to save
+        // + 12 because we need to align %esp to a 16-byte boundary (#5250)
+    );
 }
 
 #endif
diff --git a/utils/fingerprint/fingerprint.py b/utils/fingerprint/fingerprint.py
index f04b98ecd4..5a753279e6 100755
--- a/utils/fingerprint/fingerprint.py
+++ b/utils/fingerprint/fingerprint.py
@@ -159,7 +159,7 @@ def validate(opts, args, parser):
   if opts.dir:
     fname = opts.output
     if fname is None:
-      fname = datetime.today().strftime("%Y-%m%-%d_%H-%M-%S") + ".fp"
+      fname = datetime.today().strftime("%Y-%m-%d_%H-%M-%S") + ".fp"
     path = os.path.join(opts.dir, fname)
     opts.output_file = path
     opts.output = file(path, "w")