[project @ 1999-11-02 15:05:38 by simonmar]

This commit adds in the current state of our SMP support.  Notably,
this allows the new way 's' to be built, providing support for running
multiple Haskell threads simultaneously on top of any pthreads
implementation, the idea being to take advantage of commodity SMP
boxes.

Don't expect to get much of a speedup yet; due to the excessive
locking required to synchronise access to mutable heap objects, you'll
see a slowdown in most cases, even on a UP machine.  The best I've
seen is a 1.6-1.7 speedup on an example that did no locking (two
optimised nfibs in parallel).

	- new RTS -N flag specifies how many pthreads to start.

	- new driver -smp flag, tells the driver to use way 's'.

	- new compiler -fsmp option (not for user comsumption)
	  tells the compiler not to generate direct jumps to
	  thunk entry code.

	- largely rewritten scheduler

	- _ccall_GC is now done by handing back a "token" to the
	  RTS before executing the ccall; it should now be possible
	  to execute blocking ccalls in the current thread while
	  allowing the RTS to continue running Haskell threads as
	  normal.

	- you can only call thread-safe C libraries from a way 's'
	  build, of course.

Pthread support is still incomplete, and weird things (including
deadlocks) are likely to happen.

1 files changed, 179 insertions, 57 deletions

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index fc3c409af6..0bf3e21555 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.19 1999/10/13 16:39:23 simonmar Exp $
+ * $Id: Storage.c,v 1.20 1999/11/02 15:06:04 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -19,10 +19,12 @@
 #include "Sanity.h"
 
 #include "Storage.h"
+#include "Schedule.h"
 #include "StoragePriv.h"
 
-bdescr *current_nursery;	/* next available nursery block, or NULL */
+#ifndef SMP
 nat nursery_blocks;		/* number of blocks in the nursery */
+#endif
 
 StgClosure    *caf_list         = NULL;
 
@@ -40,6 +42,14 @@ generation *oldest_gen;		/* oldest generation, for convenience */
 step *g0s0;			/* generation 0, step 0, for convenience */
 
 /*
+ * Storage manager mutex:  protects all the above state from
+ * simultaneous access by two STG threads.
+ */
+#ifdef SMP
+pthread_mutex_t sm_mutex = PTHREAD_MUTEX_INITIALIZER;
+#endif
+
+/*
  * Forward references
  */
 static void *stgAllocForGMP   (size_t size_in_bytes);
@@ -156,14 +166,9 @@ initStorage (void)
    * don't want it to be a big one.  This vague idea is borne out by 
    * rigorous experimental evidence.
    */
-  step = &generations[0].steps[0];
-  g0s0 = step;
-  nursery_blocks = RtsFlags.GcFlags.minAllocAreaSize;
-  step->blocks   = allocNursery(NULL, nursery_blocks);
-  step->n_blocks = nursery_blocks;
-  current_nursery = step->blocks;
-  g0s0->to_space = NULL;
-  /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
+  g0s0 = &generations[0].steps[0];
+
+  allocNurseries();
 
   weak_ptr_list = NULL;
   caf_list = NULL;
@@ -179,10 +184,109 @@ initStorage (void)
   mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
 #endif
 
+#ifdef SMP
+  pthread_mutex_init(&sm_mutex, NULL);
+#endif
+
   IF_DEBUG(gc, stat_describe_gens());
 }
 
-extern bdescr *
+void
+exitStorage (void)
+{
+  stat_exit(calcAllocated());
+}
+
+void
+newCAF(StgClosure* caf)
+{
+  /* Put this CAF on the mutable list for the old generation.
+   * This is a HACK - the IND_STATIC closure doesn't really have
+   * a mut_link field, but we pretend it has - in fact we re-use
+   * the STATIC_LINK field for the time being, because when we
+   * come to do a major GC we won't need the mut_link field
+   * any more and can use it as a STATIC_LINK.
+   */
+  ACQUIRE_LOCK(&sm_mutex);
+  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
+  oldest_gen->mut_once_list = (StgMutClosure *)caf;
+
+#ifdef DEBUG
+  { 
+    const StgInfoTable *info;
+    
+    info = get_itbl(caf);
+    ASSERT(info->type == IND_STATIC);
+#if 0
+    STATIC_LINK2(info,caf) = caf_list;
+    caf_list = caf;
+#endif
+  }
+#endif
+  RELEASE_LOCK(&sm_mutex);
+}
+
+/* -----------------------------------------------------------------------------
+   Nursery management.
+   -------------------------------------------------------------------------- */
+
+void
+allocNurseries( void )
+{ 
+#ifdef SMP
+  {
+    Capability *cap;
+    
+    g0s0->blocks = NULL;
+    g0s0->n_blocks = 0;
+    for (cap = free_capabilities; cap != NULL; cap = cap->link) {
+      cap->rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
+      cap->rCurrentNursery = cap->rNursery;
+    }
+  }
+#else /* SMP */
+  nursery_blocks  = RtsFlags.GcFlags.minAllocAreaSize;
+  g0s0->blocks    = allocNursery(NULL, nursery_blocks);
+  g0s0->n_blocks  = nursery_blocks;
+  g0s0->to_space  = NULL;
+  MainRegTable.rNursery        = g0s0->blocks;
+  MainRegTable.rCurrentNursery = g0s0->blocks;
+  /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
+#endif
+}
+      
+void
+resetNurseries( void )
+{
+  bdescr *bd;
+#ifdef SMP
+  Capability *cap;
+  
+  /* All tasks must be stopped */
+  ASSERT(n_free_capabilities == RtsFlags.ConcFlags.nNodes);
+
+  for (cap = free_capabilities; cap != NULL; cap = cap->link) {
+    for (bd = cap->rNursery; bd; bd = bd->link) {
+      bd->free = bd->start;
+      ASSERT(bd->gen == g0);
+      ASSERT(bd->step == g0s0);
+      IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
+    }
+    cap->rCurrentNursery = cap->rNursery;
+  }
+#else
+  for (bd = g0s0->blocks; bd; bd = bd->link) {
+    bd->free = bd->start;
+    ASSERT(bd->gen == g0);
+    ASSERT(bd->step == g0s0);
+    IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
+  }
+  MainRegTable.rNursery = g0s0->blocks;
+  MainRegTable.rCurrentNursery = g0s0->blocks;
+#endif
+}
+
+bdescr *
 allocNursery (bdescr *last_bd, nat blocks)
 {
   bdescr *bd;
@@ -201,11 +305,15 @@ allocNursery (bdescr *last_bd, nat blocks)
   return last_bd;
 }
 
-extern void
+void
 resizeNursery ( nat blocks )
 {
   bdescr *bd;
 
+#ifdef SMP
+  barf("resizeNursery: can't resize in SMP mode");
+#endif
+
   if (nursery_blocks == blocks) {
     ASSERT(g0s0->n_blocks == blocks);
     return;
@@ -233,48 +341,6 @@ resizeNursery ( nat blocks )
   g0s0->n_blocks = nursery_blocks = blocks;
 }
 
-void
-exitStorage (void)
-{
-  lnat allocated;
-  bdescr *bd;
-
-  /* Return code ignored for now */
-  /* ToDo: allocation figure is slightly wrong (see also GarbageCollect()) */
-  allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
-  for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
-    allocated -= BLOCK_SIZE_W;
-  }
-  stat_exit(allocated);
-}
-
-void
-newCAF(StgClosure* caf)
-{
-  /* Put this CAF on the mutable list for the old generation.
-   * This is a HACK - the IND_STATIC closure doesn't really have
-   * a mut_link field, but we pretend it has - in fact we re-use
-   * the STATIC_LINK field for the time being, because when we
-   * come to do a major GC we won't need the mut_link field
-   * any more and can use it as a STATIC_LINK.
-   */
-  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
-  oldest_gen->mut_once_list = (StgMutClosure *)caf;
-
-#ifdef DEBUG
-  { 
-    const StgInfoTable *info;
-    
-    info = get_itbl(caf);
-    ASSERT(info->type == IND_STATIC);
-#if 0
-    STATIC_LINK2(info,caf) = caf_list;
-    caf_list = caf;
-#endif
-  }
-#endif
-}
-
 /* -----------------------------------------------------------------------------
    The allocate() interface
 
@@ -289,6 +355,8 @@ allocate(nat n)
   bdescr *bd;
   StgPtr p;
 
+  ACQUIRE_LOCK(&sm_mutex);
+
   TICK_ALLOC_HEAP_NOCTR(n);
   CCS_ALLOC(CCCS,n);
 
@@ -307,6 +375,7 @@ allocate(nat n)
      * (eg. running threads), so garbage collecting early won't make
      * much difference.
      */
+    RELEASE_LOCK(&sm_mutex);
     return bd->start;
 
   /* small allocation (<LARGE_OBJECT_THRESHOLD) */
@@ -327,6 +396,7 @@ allocate(nat n)
   
   p = alloc_Hp;
   alloc_Hp += n;
+  RELEASE_LOCK(&sm_mutex);
   return p;
 }
 
@@ -389,8 +459,60 @@ stgDeallocForGMP (void *ptr STG_UNUSED,
 }
 
 /* -----------------------------------------------------------------------------
-   Stats and stuff
-   -------------------------------------------------------------------------- */
+ * Stats and stuff
+ * -------------------------------------------------------------------------- */
+
+/* -----------------------------------------------------------------------------
+ * calcAllocated()
+ *
+ * Approximate how much we've allocated: number of blocks in the
+ * nursery + blocks allocated via allocate() - unused nusery blocks.
+ * This leaves a little slop at the end of each block, and doesn't
+ * take into account large objects (ToDo).
+ * -------------------------------------------------------------------------- */
+
+lnat
+calcAllocated( void )
+{
+  nat allocated;
+  bdescr *bd;
+
+#ifdef SMP
+  Capability *cap;
+
+  /* All tasks must be stopped */
+  ASSERT(n_free_capabilities == RtsFlags.ConcFlags.nNodes);
+
+  allocated = 
+    n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W
+    + allocated_bytes();
+
+  for (cap = free_capabilities; cap != NULL; cap = cap->link) {
+    for ( bd = cap->rCurrentNursery->link; bd != NULL; bd = bd->link ) {
+      allocated -= BLOCK_SIZE_W;
+    }
+    if (cap->rCurrentNursery->free < cap->rCurrentNursery->start 
+	+ BLOCK_SIZE_W) {
+      allocated -= (cap->rCurrentNursery->start + BLOCK_SIZE_W)
+	- cap->rCurrentNursery->free;
+    }
+  }
+
+#else /* !SMP */
+  bdescr *current_nursery = MainRegTable.rCurrentNursery;
+
+  allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
+  for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
+    allocated -= BLOCK_SIZE_W;
+  }
+  if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) {
+    allocated -= (current_nursery->start + BLOCK_SIZE_W)
+      - current_nursery->free;
+  }
+#endif
+
+  return allocated;
+}  
 
 /* Approximate the amount of live data in the heap.  To be called just
  * after garbage collection (see GarbageCollect()).
@@ -488,7 +610,7 @@ memInventory(void)
 	*/
 	if (bd->blocks > BLOCKS_PER_MBLOCK) {
 	  total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
-	                  * bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE);
+	                  * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
 	}
       }
     }