[project @ 2005-04-22 12:28:00 by simonmar]

- Now that labels are always prefixed with '&' in .hc code, we have to
  fix some sloppiness in the RTS .cmm code.  Fortunately it's not too
  painful.

- SMP: acquire/release the storage manager lock around
  atomicModifyMutVar#.  This is a hack: atomicModifyMutVar# isn't
  atomic under SMP otherwise, but the SM lock is a large sledgehammer.
  I think I'll apply the sledgehammer to the MVar primitives too, for
  the time being.

ghc/includes/Cmm.h

@@ -505,4 +505,10 @@
     TICK_BUMP(ALLOC_HEAP_ctr);			\
     TICK_BUMP_BY(ALLOC_HEAP_tot,n)
 
+/* -----------------------------------------------------------------------------
+   Misc junk
+   -------------------------------------------------------------------------- */
+
+#define TICK_MILLISECS   (1000/TICK_FREQUENCY)   /* ms per tick */
+
 #endif /* CMM_H */

ghc/includes/Constants.h

@@ -266,4 +266,10 @@
 #error RESERVED_STACK_WORDS may be wrong!
 #endif
 
+/* -----------------------------------------------------------------------------
+   How often our context-switch timer ticks
+   -------------------------------------------------------------------------- */
+
+#define TICK_FREQUENCY   50                      /* ticks per second */
+
 #endif /* CONSTANTS_H */

ghc/includes/STM.h

@@ -227,7 +227,12 @@ extern void stmWriteTVar(StgTRecHeader *trec,
 
 #define END_STM_WAIT_QUEUE ((StgTVarWaitQueue *)(void *)&stg_END_STM_WAIT_QUEUE_closure)
 #define END_STM_CHUNK_LIST ((StgTRecChunk *)(void *)&stg_END_STM_CHUNK_LIST_closure)
+
+#if IN_STG_CODE
+#define NO_TREC (stg_NO_TREC_closure)
+#else
 #define NO_TREC ((StgTRecHeader *)(void *)&stg_NO_TREC_closure)
+#endif
 
 /*----------------------------------------------------------------------*/
 

ghc/includes/TSO.h

@@ -240,7 +240,11 @@ extern StgTSO dummy_tso;
 
 
 /* this is the NIL ptr for a TSO queue (e.g. runnable queue) */
+#if IN_STG_CODE
+#define END_TSO_QUEUE  (stg_END_TSO_QUEUE_closure)
+#else
 #define END_TSO_QUEUE  ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure)
+#endif
 
 #if defined(PAR) || defined(GRAN)
 /* this is the NIL ptr for a blocking queue */

ghc/rts/Makefile

@@ -318,6 +318,8 @@ SRC_HC_OPTS += \
   -\#include ProfHeap.h \
   -\#include LdvProfile.h \
   -\#include Profiling.h \
+  -\#include StoragePriv.h \
+  -\#include OSThreads.h \
   -\#include Apply.h
 
 ifeq "$(Windows)" "YES"

ghc/rts/PrimOps.cmm

@@ -166,6 +166,10 @@ atomicModifyMutVarzh_fast
     W_ mv, z, x, y, r;
     /* Args: R1 :: MutVar#,  R2 :: a -> (a,b) */
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sm_mutex "ptr");
+#endif
+
     /* If x is the current contents of the MutVar#, then 
        We want to make the new contents point to
 
@@ -183,18 +187,18 @@ atomicModifyMutVarzh_fast
     */
 
 #if MIN_UPD_SIZE > 1
-#define THUNK_1_SIZE (SIZEOF_StgHeader + WDS(MIN_UPD_SIZE))
+#define THUNK_1_SIZE (SIZEOF_StgThunkHeader + WDS(MIN_UPD_SIZE))
 #define TICK_ALLOC_THUNK_1() TICK_ALLOC_UP_THK(WDS(1),WDS(MIN_UPD_SIZE-1))
 #else
-#define THUNK_1_SIZE (SIZEOF_StgHeader + WDS(1))
+#define THUNK_1_SIZE (SIZEOF_StgThunkHeader + WDS(1))
 #define TICK_ALLOC_THUNK_1() TICK_ALLOC_UP_THK(WDS(1),0)
 #endif
 
 #if MIN_UPD_SIZE > 2
-#define THUNK_2_SIZE (SIZEOF_StgHeader + WDS(MIN_UPD_SIZE))
+#define THUNK_2_SIZE (SIZEOF_StgThunkHeader + WDS(MIN_UPD_SIZE))
 #define TICK_ALLOC_THUNK_2() TICK_ALLOC_UP_THK(WDS(2),WDS(MIN_UPD_SIZE-2))
 #else
-#define THUNK_2_SIZE (SIZEOF_StgHeader + WDS(2))
+#define THUNK_2_SIZE (SIZEOF_StgThunkHeader + WDS(2))
 #define TICK_ALLOC_THUNK_2() TICK_ALLOC_UP_THK(WDS(2),0)
 #endif
 
@@ -209,15 +213,15 @@ atomicModifyMutVarzh_fast
    z = Hp - THUNK_2_SIZE + WDS(1);
    SET_HDR(z, stg_ap_2_upd_info, W_[CCCS]);
    LDV_RECORD_CREATE(z);
-   StgClosure_payload(z,0) = R2;
-   StgClosure_payload(z,1) = x;
+   StgThunk_payload(z,0) = R2;
+   StgThunk_payload(z,1) = x;
 
    TICK_ALLOC_THUNK_1();
    CCCS_ALLOC(THUNK_1_SIZE);
    y = z - THUNK_1_SIZE;
    SET_HDR(y, stg_sel_0_upd_info, W_[CCCS]);
    LDV_RECORD_CREATE(y);
-   StgClosure_payload(y,0) = z;
+   StgThunk_payload(y,0) = z;
 
    StgMutVar_var(R1) = y;
 
@@ -226,7 +230,11 @@ atomicModifyMutVarzh_fast
    r = y - THUNK_1_SIZE;
    SET_HDR(r, stg_sel_1_upd_info, W_[CCCS]);
    LDV_RECORD_CREATE(r);
-   StgClosure_payload(r,0) = z;
+   StgThunk_payload(r,0) = z;
+
+#if defined(SMP)
+    foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
 
    RET_P(r);
 }

ghc/rts/Storage.c

@@ -22,6 +22,7 @@
 #include "Storage.h"
 #include "Schedule.h"
 #include "RetainerProfile.h"	// for counting memory blocks (memInventory)
+#include "StoragePriv.h"
 
 #include <stdlib.h>
 #include <string.h>
@@ -63,18 +64,6 @@ static void *stgAllocForGMP   (size_t size_in_bytes);
 static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
 static void  stgDeallocForGMP (void *ptr, size_t size);
 
-/*
- * Storage manager mutex
- */
-#if defined(SMP)
-extern Mutex sm_mutex;
-#define ACQUIRE_SM_LOCK   ACQUIRE_LOCK(&sm_mutex)
-#define RELEASE_SM_LOCK   RELEASE_LOCK(&sm_mutex)
-#else
-#define ACQUIRE_SM_LOCK
-#define RELEASE_SM_LOCK
-#endif
-
 static void
 initStep (step *stp, int g, int s)
 {

ghc/rts/StoragePriv.h

+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2005
+ *
+ * Storage manager bits visible to the rest of the RTS only
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef STORAGEPRIV_H
+#define STORAGEPRIV_H
+
+/*
+ * Storage manager mutex
+ */
+#if defined(SMP)
+extern Mutex sm_mutex;
+#define ACQUIRE_SM_LOCK   ACQUIRE_LOCK(&sm_mutex)
+#define RELEASE_SM_LOCK   RELEASE_LOCK(&sm_mutex)
+#else
+#define ACQUIRE_SM_LOCK
+#define RELEASE_SM_LOCK
+#endif
+
+#endif /* STORAGEPRIV_H */

ghc/rts/Timer.h

@@ -8,7 +8,6 @@
 #ifndef __TIMER_H__
 #define __TIMER_H__
 
-# define TICK_FREQUENCY   50                      /* ticks per second */
 # define TICK_MILLISECS   (1000/TICK_FREQUENCY)   /* ms per tick */
 
 /* Context switch timing constants. Context switches happen after a