summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/llvmGen/LlvmMangler.hs6
-rw-r--r--includes/stg/MachRegs.h21
-rw-r--r--includes/stg/SMP.h43
-rw-r--r--mk/config.mk.in4
-rw-r--r--rts/OldARMAtomic.c47
-rw-r--r--rts/StgCRun.c50
6 files changed, 168 insertions, 3 deletions
diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/llvmGen/LlvmMangler.hs
index ae3ef9fd81..866f49f442 100644
--- a/compiler/llvmGen/LlvmMangler.hs
+++ b/compiler/llvmGen/LlvmMangler.hs
@@ -33,6 +33,7 @@ newLine = B.pack "\n"
jmpInst = B.pack "\n\tjmp"
textStmt = B.pack "\t.text"
dataStmt = B.pack "\t.data"
+syntaxUnified = B.pack "\t.syntax unified"
infoLen, labelStart, spFix :: Int
infoLen = B.length infoSec
@@ -90,7 +91,10 @@ readSections r w = go B.empty [] []
writeSection w (hdr, fixupStack cts B.empty) >> return ss
case e_l of
- Right l | any (`B.isPrefixOf` l) [secStmt, textStmt, dataStmt]
+ Right l | l == syntaxUnified
+ -> finishSection >>= \ss' -> writeSection w (l, B.empty)
+ >> go B.empty ss' tys
+ | any (`B.isPrefixOf` l) [secStmt, textStmt, dataStmt]
-> finishSection >>= \ss' -> go l ss' tys
| otherwise
-> go hdr ss (l:ls)
diff --git a/includes/stg/MachRegs.h b/includes/stg/MachRegs.h
index 6b1d31986b..4b75c50417 100644
--- a/includes/stg/MachRegs.h
+++ b/includes/stg/MachRegs.h
@@ -47,6 +47,7 @@
#define powerpc_REGS (powerpc_TARGET_ARCH || powerpc64_TARGET_ARCH || rs6000_TARGET_ARCH)
#define ia64_REGS ia64_TARGET_ARCH
#define sparc_REGS sparc_TARGET_ARCH
+#define arm_REGS arm_TARGET_ARCH
#define darwin_REGS darwin_TARGET_OS
#else
#define alpha_REGS alpha_HOST_ARCH
@@ -58,6 +59,7 @@
#define powerpc_REGS (powerpc_HOST_ARCH || powerpc64_HOST_ARCH || rs6000_HOST_ARCH)
#define ia64_REGS ia64_HOST_ARCH
#define sparc_REGS sparc_HOST_ARCH
+#define arm_REGS arm_HOST_ARCH
#define darwin_REGS darwin_HOST_OS
#endif
@@ -695,6 +697,25 @@
#endif /* sparc */
+/* -----------------------------------------------------------------------------
+ The ARM EABI register mapping
+ -------------------------------------------------------------------------- */
+
+#if arm_REGS
+
+#define REG(x) __asm__(#x)
+
+#define REG_Base r4
+#define REG_Sp r5
+#define REG_Hp r6
+#define REG_R1 r7
+#define REG_R2 r8
+#define REG_R3 r9
+#define REG_R4 r10
+#define REG_SpLim r11
+
+#endif /* arm */
+
#endif /* NO_REGS */
/* -----------------------------------------------------------------------------
diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h
index 87ec4fb242..d093439182 100644
--- a/includes/stg/SMP.h
+++ b/includes/stg/SMP.h
@@ -14,8 +14,19 @@
#ifndef SMP_H
#define SMP_H
+#if defined(__ARM_ARCH_2__) || defined(__ARM_ARCH_3__) || defined(__ARM_ARCH_3M__) || \
+ defined(__ARM_ARCH_4__) || defined(__ARM_ARCH_4T__) || defined(__ARM_ARCH_5__) || \
+ defined(__ARM_ARCH_5T__) || defined(__ARM_ARCH_5E__) || defined(__ARM_ARCH_5TE__)
+#define PRE_ARMv6
+#endif
+
#if defined(THREADED_RTS)
+#if arm_HOST_ARCH && defined(PRE_ARMv6)
+void arm_atomic_spin_lock(void);
+void arm_atomic_spin_unlock(void);
+#endif
+
/* ----------------------------------------------------------------------------
Atomic operations
------------------------------------------------------------------------- */
@@ -125,7 +136,12 @@ xchg(StgPtr p, StgWord w)
: "+r" (result), "+m" (*p)
: /* no input-only operands */
);
+#elif arm_HOST_ARCH
+ __asm__ __volatile__ ("swp %0, %1, [%2]"
+ : "=&r" (result)
+ : "r" (w), "r" (p) : "memory");
#elif !defined(WITHSMP)
+#error xchg() unimplemented on this architecture
result = *p;
*p = w;
#else
@@ -169,7 +185,32 @@ cas(StgVolatilePtr p, StgWord o, StgWord n)
: "memory"
);
return n;
+#elif arm_HOST_ARCH
+#if defined(PRE_ARMv6)
+ StgWord r;
+ arm_atomic_spin_lock();
+ r = *p;
+ if (r == o) { *p = n; }
+ arm_atomic_spin_unlock();
+ return r;
+#else
+ StgWord result,tmp;
+
+ __asm__ __volatile__(
+ "1: ldrex %1, [%2]\n"
+ " mov %0, #0\n"
+ " teq %1, %3\n"
+ " strexeq %0, %4, [%2]\n"
+ " teq %0, #1\n"
+ " beq 1b\n"
+ : "=&r"(tmp), "=&r"(result)
+ : "r"(p), "r"(o), "r"(n)
+ : "cc","memory");
+
+ return result;
+#endif
#elif !defined(WITHSMP)
+#error cas() unimplemented on this architecture
StgWord result;
result = *p;
if (result == o) {
@@ -251,6 +292,8 @@ write_barrier(void) {
#elif sparc_HOST_ARCH
/* Sparc in TSO mode does not require store/store barriers. */
__asm__ __volatile__ ("" : : : "memory");
+#elif arm_HOST_ARCH
+ __asm__ __volatile__ ("" : : : "memory");
#elif !defined(WITHSMP)
return;
#else
diff --git a/mk/config.mk.in b/mk/config.mk.in
index 0adaf69222..e8ded399cc 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -165,7 +165,7 @@ HaveLibDL = @HaveLibDL@
# ArchSupportsSMP should be set iff there is support for that arch in
# includes/stg/SMP.h
-ArchSupportsSMP=$(strip $(patsubst $(HostArch_CPP), YES, $(findstring $(HostArch_CPP), i386 x86_64 sparc powerpc)))
+ArchSupportsSMP=$(strip $(patsubst $(HostArch_CPP), YES, $(findstring $(HostArch_CPP), i386 x86_64 sparc powerpc arm)))
# lazy test, because $(GhcUnregisterised) might be set in build.mk later.
GhcWithSMP=$(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO))
@@ -174,7 +174,7 @@ GhcWithSMP=$(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),
# has support for this OS/ARCH combination.
OsSupportsGHCi=$(strip $(patsubst $(HostOS_CPP), YES, $(findstring $(HostOS_CPP), mingw32 cygwin32 linux solaris2 freebsd dragonfly netbsd openbsd darwin)))
-ArchSupportsGHCi=$(strip $(patsubst $(HostArch_CPP), YES, $(findstring $(HostArch_CPP), i386 x86_64 powerpc sparc sparc64)))
+ArchSupportsGHCi=$(strip $(patsubst $(HostArch_CPP), YES, $(findstring $(HostArch_CPP), i386 x86_64 powerpc sparc sparc64 arm)))
ifeq "$(OsSupportsGHCi)$(ArchSupportsGHCi)" "YESYES"
GhcWithInterpreter=YES
diff --git a/rts/OldARMAtomic.c b/rts/OldARMAtomic.c
new file mode 100644
index 0000000000..2a3c6c6655
--- /dev/null
+++ b/rts/OldARMAtomic.c
@@ -0,0 +1,47 @@
+#include "PosixSource.h"
+#include "Stg.h"
+
+#if defined(HAVE_SCHED_H)
+#include <sched.h>
+#endif
+
+#if defined(THREADED_RTS)
+
+#if arm_HOST_ARCH && defined(PRE_ARMv6)
+
+static volatile int atomic_spin = 0;
+
+static int arm_atomic_spin_trylock (void)
+{
+ int result;
+
+ asm volatile (
+ "swp %0, %1, [%2]\n"
+ : "=&r,&r" (result)
+ : "r,0" (1), "r,r" (&atomic_spin)
+ : "memory");
+ if (result == 0)
+ return 0;
+ else
+ return -1;
+}
+
+void arm_atomic_spin_lock()
+{
+ while (arm_atomic_spin_trylock())
+#if defined(HAVE_SCHED_H)
+ sched_yield();
+#else
+ ; // inefficient on non-POSIX.
+#endif
+}
+
+void arm_atomic_spin_unlock()
+{
+ atomic_spin = 0;
+}
+
+#endif /* arm_HOST_ARCH && defined(PRE_ARMv6) */
+
+#endif /* defined(THREADED_RTS) */
+
diff --git a/rts/StgCRun.c b/rts/StgCRun.c
index 69d9549f6e..9e976ef660 100644
--- a/rts/StgCRun.c
+++ b/rts/StgCRun.c
@@ -977,4 +977,54 @@ StgRun(StgFunPtr f, StgRegTable *basereg)
#endif /* mips_HOST_ARCH */
+/* -----------------------------------------------------------------------------
+ ARM architecture
+ -------------------------------------------------------------------------- */
+
+#ifdef arm_HOST_ARCH
+StgRegTable *
+StgRun(StgFunPtr f, StgRegTable *basereg) {
+ StgRegTable * r;
+ __asm__ volatile (
+ /*
+ * save callee-saves registers on behalf of the STG code.
+ */
+ "stmfd sp!, {r4-r10, fp, ip, lr}\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.
+ */
+ "sub sp, sp, %3\n\t"
+ /*
+ * Set BaseReg
+ */
+ "mov r4, %2\n\t"
+ /*
+ * Jump to function argument.
+ */
+ "mov pc, %1\n\t"
+
+ ".global " STG_RETURN "\n"
+ STG_RETURN ":\n\t"
+ /*
+ * Free the space we allocated
+ */
+ "add sp, sp, %3\n\t"
+ /*
+ * Return the new register table, taking it from Stg's R1 (ARM's R7).
+ */
+ "mov %0, r7\n\t"
+ /*
+ * restore callee-saves registers.
+ */
+ "ldmfd sp!, {r4-r10, fp, ip, lr}\n\t"
+ : "=r" (r)
+ : "r" (f), "r" (basereg), "i" (RESERVED_C_STACK_BYTES)
+ :
+ );
+ return r;
+}
+#endif
+
#endif /* !USE_MINIINTERPRETER */