make the smp way RTS-only, normal libraries now work with -smp
[ghc-hetmet.git] / ghc / includes / Closures.h
index d546792..152213b 100644 (file)
@@ -21,8 +21,8 @@
 typedef struct {
   CostCentreStack *ccs;
   union {
-    struct _RetainerSet *rs;  // Retainer Set
-    StgWord ldvw;             // Lag/Drag/Void Word
+    struct _RetainerSet *rs;  /* Retainer Set */
+    StgWord ldvw;             /* Lag/Drag/Void Word */
   } hp;
 } StgProfHeader;
 
@@ -35,6 +35,23 @@ typedef struct {
 } StgGranHeader;
 
 /* -----------------------------------------------------------------------------
+   The SMP header
+   
+   A thunk has a padding word to take the updated value.  This is so
+   that the update doesn't overwrite the payload, so we can avoid
+   needing to lock the thunk during entry and update.
+   
+   Note: this doesn't apply to THUNK_STATICs, which have no payload.
+
+   Note: we leave this padding word in all ways, rather than just SMP,
+   so that we don't have to recompile all our libraries for SMP.
+   -------------------------------------------------------------------------- */
+
+typedef struct {
+    StgWord pad;
+} StgSMPThunkHeader;
+
+/* -----------------------------------------------------------------------------
    The full fixed-size closure header
 
    The size of the fixed header is the sum of the optional parts plus a single
@@ -42,15 +59,28 @@ typedef struct {
    -------------------------------------------------------------------------- */
 
 typedef struct {
-       const struct _StgInfoTable* info;
+    const struct _StgInfoTable* info;
 #ifdef PROFILING
-       StgProfHeader         prof;
+    StgProfHeader         prof;
 #endif
 #ifdef GRAN
-       StgGranHeader         gran;
+    StgGranHeader         gran;
 #endif
 } StgHeader;
 
+typedef struct {
+    const struct _StgInfoTable* info;
+#ifdef PROFILING
+    StgProfHeader         prof;
+#endif
+#ifdef GRAN
+    StgGranHeader         gran;
+#endif
+    StgSMPThunkHeader     smp;
+} StgThunkHeader;
+
+#define THUNK_EXTRA_HEADER_W (sizeofW(StgThunkHeader)-sizeofW(StgHeader))
+
 /* -----------------------------------------------------------------------------
    Closure Types
 
@@ -66,21 +96,13 @@ struct StgClosure_ {
     struct StgClosure_ *payload[FLEXIBLE_ARRAY];
 };
 
-/* What a stroke of luck - all our mutable closures follow the same
- * basic layout, with the mutable link field as the second field after
- * the header.  This means the following structure is the supertype of
- * mutable closures.
- */
-
-typedef struct StgMutClosure_ {
-    StgHeader   header;
-    StgWord     padding;
-    struct StgMutClosure_ *mut_link;
+typedef struct {
+    StgThunkHeader  header;
     struct StgClosure_ *payload[FLEXIBLE_ARRAY];
-} StgMutClosure;
+} StgThunk;
 
 typedef struct {
-    StgHeader   header;
+    StgThunkHeader   header;
     StgClosure *selectee;
 } StgSelector;
 
@@ -92,14 +114,19 @@ typedef struct {
     StgClosure *payload[FLEXIBLE_ARRAY];
 } StgPAP;
 
-// AP closures have the same layout, for convenience
-typedef StgPAP StgAP;
+typedef struct {
+    StgThunkHeader   header;
+    StgHalfWord arity;         /* zero if it is an AP */
+    StgHalfWord n_args;
+    StgClosure *fun;           /* really points to a fun */
+    StgClosure *payload[FLEXIBLE_ARRAY];
+} StgAP;
 
 typedef struct {
-    StgHeader   header;
-    StgWord     size;                    // number of words in payload
+    StgThunkHeader   header;
+    StgWord     size;                    /* number of words in payload */
     StgClosure *fun;
-    StgClosure *payload[FLEXIBLE_ARRAY]; // contains a chunk of *stack*
+    StgClosure *payload[FLEXIBLE_ARRAY]; /* contains a chunk of *stack* */
 } StgAP_STACK;
 
 typedef struct {
@@ -108,12 +135,6 @@ typedef struct {
 } StgInd;
 
 typedef struct {
-    StgHeader   header;
-    StgClosure *indirectee;
-    StgMutClosure *mut_link;
-} StgIndOldGen;
-
-typedef struct {
     StgHeader     header;
     StgClosure   *indirectee;
     StgClosure   *static_link;
@@ -129,14 +150,12 @@ typedef struct {
 typedef struct {
     StgHeader   header;
     StgWord     ptrs;
-    StgMutClosure *mut_link;   /* mutable list */
     StgClosure *payload[FLEXIBLE_ARRAY];
 } StgMutArrPtrs;
 
 typedef struct {
     StgHeader   header;
     StgClosure *var;
-    StgMutClosure *mut_link;
 } StgMutVar;
 
 typedef struct _StgUpdateFrame {
@@ -169,11 +188,6 @@ typedef struct {
   StgHeader  header;
 } StgRetry;
 
-typedef struct _StgForeignObj {
-  StgHeader      header;
-  StgAddr        data;         /* pointer to data in non-haskell-land */
-} StgForeignObj;
-  
 typedef struct _StgStableName {
   StgHeader      header;
   StgWord        sn;
@@ -215,13 +229,13 @@ typedef struct _StgDeadWeak {     /* Weak v */
 
 typedef struct {
     StgHeader      header;
-    StgArrWords   *instrs;     // a pointer to an ArrWords
-    StgArrWords   *literals;   // a pointer to an ArrWords
-    StgMutArrPtrs *ptrs;       // a pointer to a  MutArrPtrs
-    StgArrWords   *itbls;      // a pointer to an ArrWords
-    StgHalfWord   arity;        // arity of this BCO
-    StgHalfWord   size;         // size of this BCO (in words)
-    StgWord       bitmap[FLEXIBLE_ARRAY];  // an StgLargeBitmap
+    StgArrWords   *instrs;     /* a pointer to an ArrWords */
+    StgArrWords   *literals;   /* a pointer to an ArrWords */
+    StgMutArrPtrs *ptrs;       /* a pointer to a  MutArrPtrs */
+    StgArrWords   *itbls;      /* a pointer to an ArrWords */
+    StgHalfWord   arity;        /* arity of this BCO */
+    StgHalfWord   size;         /* size of this BCO (in words) */
+    StgWord       bitmap[FLEXIBLE_ARRAY];  /* an StgLargeBitmap */
 } StgBCO;
 
 #define BCO_BITMAP(bco)      ((StgLargeBitmap *)((StgBCO *)(bco))->bitmap)
@@ -303,19 +317,110 @@ typedef struct {
 typedef struct {
   StgHeader       header;
   struct StgTSO_ *head;
-  StgMutClosure  *mut_link;
   struct StgTSO_ *tail;
   StgClosure*     value;
 } StgMVar;
 
+
+/* STM data structures
+ *
+ *  StgTVar defines the only type that can be updated through the STM
+ *  interface.
+ * 
+ *  Note that various optimisations may be possible in order to use less
+ *  space for these data structures at the cost of more complexity in the
+ *  implementation:
+ *
+ *   - In StgTVar, current_value and first_wait_queue_entry could be held in
+ *     the same field: if any thread is waiting then its expected_value for
+ *     the tvar is the current value.  
+ *
+ *   - In StgTRecHeader, it might be worthwhile having separate chunks
+ *     of read-only and read-write locations.  This would save a
+ *     new_value field in the read-only locations.
+ *
+ *   - In StgAtomicallyFrame, we could combine the waiting bit into
+ *     the header (maybe a different info tbl for a waiting transaction).
+ *     This means we can specialise the code for the atomically frame
+ *     (it immediately switches on frame->waiting anyway).
+ */
+
+typedef struct StgTVarWaitQueue_ {
+  StgHeader                  header;
+  struct StgTSO_            *waiting_tso;
+  struct StgTVarWaitQueue_  *next_queue_entry;
+  struct StgTVarWaitQueue_  *prev_queue_entry;
+} StgTVarWaitQueue;
+
+typedef struct {
+  StgHeader                  header;
+  StgClosure                *volatile current_value;
+  StgTVarWaitQueue          *volatile first_wait_queue_entry;
+#if defined(SMP)
+  StgInt                     volatile num_updates;
+#endif
+} StgTVar;
+
+/* new_value == expected_value for read-only accesses */
+/* new_value is a StgTVarWaitQueue entry when trec in state TREC_WAITING */
+typedef struct {
+  StgTVar                   *tvar;
+  StgClosure                *expected_value;
+  StgClosure                *new_value; 
+#if defined(SMP)
+  StgInt                     num_updates;
+#endif
+} TRecEntry;
+
+#define TREC_CHUNK_NUM_ENTRIES 16
+
+typedef struct StgTRecChunk_ {
+  StgHeader                  header;
+  struct StgTRecChunk_      *prev_chunk;
+  StgWord                    next_entry_idx;
+  TRecEntry                  entries[TREC_CHUNK_NUM_ENTRIES];
+} StgTRecChunk;
+
+typedef enum { 
+  TREC_ACTIVE,        /* Transaction in progress, outcome undecided */
+  TREC_CONDEMNED,     /* Transaction in progress, inconsistent / out of date reads */
+  TREC_COMMITTED,     /* Transaction has committed, now updating tvars */
+  TREC_ABORTED,       /* Transaction has aborted, now reverting tvars */
+  TREC_WAITING,       /* Transaction currently waiting */
+} TRecState;
+
+typedef struct StgTRecHeader_ {
+  StgHeader                  header;
+  TRecState                  state;
+  struct StgTRecHeader_     *enclosing_trec;
+  StgTRecChunk              *current_chunk;
+} StgTRecHeader;
+
+typedef struct {
+    StgHeader   header;
+    StgClosure *code;
+} StgAtomicallyFrame;
+
+typedef struct {
+    StgHeader   header;
+    StgClosure *handler;
+} StgCatchSTMFrame;
+
+typedef struct {
+    StgHeader      header;
+    StgBool        running_alt_code;
+    StgClosure    *first_code;
+    StgClosure    *alt_code;
+    StgTRecHeader *first_code_trec;
+} StgCatchRetryFrame;
+
 #if defined(PAR) || defined(GRAN)
 /*
   StgBlockingQueueElement is a ``collective type'' representing the types
   of closures that can be found on a blocking queue: StgTSO, StgRBHSave,
   StgBlockedFetch.  (StgRBHSave can only appear at the end of a blocking
   queue).  Logically, this is a union type, but defining another struct
-  with a common layout is easier to handle in the code (same as for
-  StgMutClosures).  
+  with a common layout is easier to handle in the code.  
   Note that in the standard setup only StgTSOs can be on a blocking queue.
   This is one of the main reasons for slightly different code in files
   such as Schedule.c.
@@ -323,7 +428,6 @@ typedef struct {
 typedef struct StgBlockingQueueElement_ {
   StgHeader                         header;
   struct StgBlockingQueueElement_  *link;      /* next elem in BQ */
-  StgMutClosure                    *mut_link;  /* next elem in mutable list */
   struct StgClosure_               *payload[FLEXIBLE_ARRAY];/* contents of the closure */
 } StgBlockingQueueElement;
 
@@ -331,7 +435,6 @@ typedef struct StgBlockingQueueElement_ {
 typedef struct StgBlockingQueue_ {
   StgHeader                 header;
   struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */
-  StgMutClosure            *mut_link;              /* next elem in mutable list */
 } StgBlockingQueue;
 
 /* this closure is hanging at the end of a blocking queue in (see RBH.c) */
@@ -343,17 +446,8 @@ typedef struct StgRBHSave_ {
 typedef struct StgRBH_ {
   StgHeader                         header;
   struct StgBlockingQueueElement_  *blocking_queue; /* start of the BQ */
-  StgMutClosure                    *mut_link;       /* next elem in mutable list */
 } StgRBH;
 
-#else
-
-typedef struct StgBlockingQueue_ {
-  StgHeader          header;
-  struct StgTSO_    *blocking_queue;
-  StgMutClosure     *mut_link;
-} StgBlockingQueue;
-
 #endif
 
 #if defined(PAR)
@@ -361,14 +455,12 @@ typedef struct StgBlockingQueue_ {
 typedef struct StgFetchMe_ {
   StgHeader              header;
   globalAddr            *ga;        /* ptr to unique id for a closure */
-  StgMutClosure         *mut_link;  /* next elem in mutable list */
 } StgFetchMe;
 
 /* same contents as an ordinary StgBlockingQueue */
 typedef struct StgFetchMeBlockingQueue_ {
   StgHeader                          header;
   struct StgBlockingQueueElement_   *blocking_queue; /* start of the BQ */
-  StgMutClosure                     *mut_link;       /* next elem in mutable list */
 } StgFetchMeBlockingQueue;
 
 /* This is an entry in a blocking queue. It indicates a fetch request from a 
@@ -380,7 +472,6 @@ typedef struct StgFetchMeBlockingQueue_ {
 typedef struct StgBlockedFetch_ {
   StgHeader                         header;
   struct StgBlockingQueueElement_  *link;     /* next elem in the BQ */
-  StgMutClosure                    *mut_link; /* next elem in mutable list */
   StgClosure                       *node;     /* node to fetch */
   globalAddr                        ga;       /* where to send the result to */
 } StgBlockedFetch;                            /* NB: not just a ptr to a GA */