fix for the unregisterised way

We always assign to BaseReg on return from resumeThread(), but in
cases where BaseReg is not an lvalue (eg. unreg) we need to disable
this assigment.  See comments for more details.

diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
index 15dba69..d085ce0 100644 (file)
--- a/ghc/compiler/cmm/PprC.hs
+++ b/ghc/compiler/cmm/PprC.hs
@@ -702,19 +702,23 @@ pprCall ppr_fn cconv results args vols
   | otherwise
   = save vols $$
     ptext SLIT("CALLER_SAVE_SYSTEM") $$
-    hcat [ ppr_results results, ppr_fn, 
-          parens (commafy (map pprArg args)), semi ] $$
+    ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi $$
     ptext SLIT("CALLER_RESTORE_SYSTEM") $$
     restore vols
   where 
-     ppr_results []     = empty
-     ppr_results [(one,hint)] 
+     ppr_assign []           rhs = rhs
+     ppr_assign [(reg@(CmmGlobal BaseReg), hint)] rhs
+        | Just ty <- strangeRegType reg
+        = ptext SLIT("ASSIGN_BaseReg") <> parens (parens ty <> rhs)
+        -- BaseReg is special, sometimes it isn't an lvalue and we
+        -- can't assign to it.
+     ppr_assign [(one,hint)] rhs
         | Just ty <- strangeRegType one
-        = pprReg one <> ptext SLIT(" = ") <> parens ty
+        = pprReg one <> ptext SLIT(" = ") <> parens ty <> rhs
         | otherwise
         = pprReg one <> ptext SLIT(" = ")
-                <> pprUnHint hint (cmmRegRep one)
-     ppr_results _other = panic "pprCall: multiple results"
+                <> pprUnHint hint (cmmRegRep one) <> rhs
+     ppr_assign _other _rhs = panic "pprCall: multiple results"
 
      pprArg (expr, PtrHint)
        = cCast (ptext SLIT("void *")) expr

diff --git a/ghc/includes/Regs.h b/ghc/includes/Regs.h
index def36c3..626a62a 100644 (file)
--- a/ghc/includes/Regs.h
+++ b/ghc/includes/Regs.h
@@ -337,13 +337,23 @@ struct PartCapability_ {
 extern W_ MainCapability[];
 #endif
 
+/*
+ * Assigning to BaseReg (the ASSIGN_BaseReg macro): this happens on
+ * return from a "safe" foreign call, when the thread might be running
+ * on a new Capability.  Obviously if BaseReg is not a register, then
+ * we are restricted to a single Capability (this invariant is enforced
+ * in Capability.c:initCapabilities), and assigning to BaseReg can be omitted.
+ */
+
 #if defined(REG_Base) && !defined(NO_GLOBAL_REG_DECLS)
 GLOBAL_REG_DECL(StgRegTable *,BaseReg,REG_Base)
+#define ASSIGN_BaseReg(e) (BaseReg = (e))
 #else
 #ifdef SMP
 #error BaseReg must be in a register for SMP
 #endif
 #define BaseReg (&((struct PartCapability_ *)MainCapability)->r)
+#define ASSIGN_BaseReg(e) /*nothing*/
 #endif
 
 #if defined(REG_Sp) && !defined(NO_GLOBAL_REG_DECLS)

diff --git a/ghc/rts/Capability.c b/ghc/rts/Capability.c
index f3bbefe..764357c 100644 (file)
--- a/ghc/rts/Capability.c
+++ b/ghc/rts/Capability.c
@@ -163,6 +163,14 @@ initCapabilities( void )
 #if defined(SMP)
     nat i,n;
 
+#ifndef REG_BaseReg
+    // We can't support multiple CPUs if BaseReg is not a register
+    if (RtsFlags.ParFlags.nNodes > 1) {
+       errorBelch("warning: multiple CPUs not supported in this build, reverting to 1");
+       RtsFlags.ParFlags.nNodes = 1;
+    }
+#endif
+
     n_capabilities = n = RtsFlags.ParFlags.nNodes;
     capabilities = stgMallocBytes(n * sizeof(Capability), "initCapabilities");