[project @ 2005-04-22 09:32:39 by simonmar]

SMP: the rest of the changes to support safe thunk entry & updates.  I
thought the compiler changes were independent, but I ended up breaking
the HEAD, so I'll have to commit the rest.  non-SMP compilation should
not be affected.

ghc/includes/ClosureMacros.h

@@ -161,23 +161,28 @@
 
 /* -----------------------------------------------------------------------------
    How to get hold of the static link field for a static closure.
-   
-   Note that we have to use (*cast(T*,&e)) instead of cast(T,e)
-   because C won't let us take the address of a casted
-   expression. Huh?
    -------------------------------------------------------------------------- */
 
-#define STATIC_LINK(info,p)						\
-   (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +		\
-					info->layout.payload.nptrs])))
-
-/* These macros are optimised versions of the above for certain
- * closure types.  They *must* be equivalent to the generic
- * STATIC_LINK.
- */
-#define FUN_STATIC_LINK(p)   ((p)->payload[0])
-#define THUNK_STATIC_LINK(p) ((p)->payload[1])
-#define IND_STATIC_LINK(p)   ((p)->payload[1])
+/* These are hard-coded. */
+#define FUN_STATIC_LINK(p)   (&(p)->payload[0])
+#define THUNK_STATIC_LINK(p) (&(p)->payload[1])
+#define IND_STATIC_LINK(p)   (&(p)->payload[1])
+
+INLINE_HEADER StgClosure **
+STATIC_LINK(const StgInfoTable *info, StgClosure *p)
+{ 
+    switch (info->type) {
+    case THUNK_STATIC:
+	return THUNK_STATIC_LINK(p);
+    case FUN_STATIC:
+	return FUN_STATIC_LINK(p);
+    case IND_STATIC:
+	return IND_STATIC_LINK(p);
+    default:
+	return &(p)->payload[info->layout.payload.ptrs +
+			     info->layout.payload.nptrs];
+    }
+}
 
 #define STATIC_LINK2(info,p)							\
    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +			\

ghc/includes/Closures.h

@@ -34,6 +34,17 @@ typedef struct {
   StgWord procs; /* bitmask indicating on which PEs this closure resides */
 } StgGranHeader;
 
+/* -----------------------------------------------------------------------------
+   The SMP header
+
+   In SMP mode, we have an extra word of padding in a thunk's header.
+   (Note: thunks only; other closures do not have this padding word).
+   -------------------------------------------------------------------------- */
+
+typedef struct {
+    StgWord pad;
+} StgSMPThunkHeader;
+
 /* -----------------------------------------------------------------------------
    The full fixed-size closure header
 
@@ -42,15 +53,35 @@ 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;
 
+/*
+ * In SMP mode, 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.
+ */
+typedef struct {
+    const struct _StgInfoTable* info;
+#ifdef PROFILING
+    StgProfHeader         prof;
+#endif
+#ifdef GRAN
+    StgGranHeader         gran;
+#endif
+#ifdef SMP
+    StgSMPThunkHeader     smp;
+#endif
+} StgThunkHeader;
+
 /* -----------------------------------------------------------------------------
    Closure Types
 
@@ -67,7 +98,12 @@ struct StgClosure_ {
 };
 
 typedef struct {
-    StgHeader   header;
+    StgThunkHeader  header;
+    struct StgClosure_ *payload[FLEXIBLE_ARRAY];
+} StgThunk;
+
+typedef struct {
+    StgThunkHeader   header;
     StgClosure *selectee;
 } StgSelector;
 
@@ -79,11 +115,16 @@ 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;
+    StgThunkHeader   header;
     StgWord     size;                    /* number of words in payload */
     StgClosure *fun;
     StgClosure *payload[FLEXIBLE_ARRAY]; /* contains a chunk of *stack* */

ghc/includes/Cmm.h

@@ -324,6 +324,26 @@
         jump stg_gc_gen_hp;				\
    }
 
+/* -----------------------------------------------------------------------------
+   Closure headers
+   -------------------------------------------------------------------------- */
+
+/*
+ * This is really ugly, since we don't do the rest of StgHeader this
+ * way.  The problem is that values from DerivedConstants.h cannot be 
+ * dependent on the way (SMP, PROF etc.).  For SIZEOF_StgHeader we get
+ * the value from GHC, but it seems like too much trouble to do that
+ * for StgThunkHeader.
+ */
+#ifdef SMP
+#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
+#else
+#define SIZEOF_StgThunkHeader SIZEOF_StgHeader
+#endif
+
+#define StgThunk_payload(__ptr__,__ix__) \
+    W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
+
 /* -----------------------------------------------------------------------------
    Closures
    -------------------------------------------------------------------------- */

ghc/includes/StgTypes.h

@@ -48,7 +48,6 @@ typedef unsigned char            StgWord8;
 typedef signed   short           StgInt16;
 typedef unsigned short           StgWord16;
 
-
 #if SIZEOF_UNSIGNED_INT == 4
 typedef signed   int             StgInt32;
 typedef unsigned int             StgWord32;

ghc/includes/Storage.h

@@ -255,6 +255,9 @@ extern rtsBool keepCAFs;
 INLINE_HEADER StgOffset PAP_sizeW   ( nat n_args )
 { return sizeofW(StgPAP) + n_args; }
 
+INLINE_HEADER StgOffset AP_sizeW   ( nat n_args )
+{ return sizeofW(StgAP) + n_args; }
+
 INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size )
 { return sizeofW(StgAP_STACK) + size; }
 
@@ -276,9 +279,17 @@ INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs 
        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 
+INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl ) 
+{ return sizeofW(StgThunk) 
+       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs 
+       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
+
 INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x )
 { return AP_STACK_sizeW(x->size); }
 
+INLINE_HEADER StgOffset ap_sizeW( StgAP* x )
+{ return AP_sizeW(x->n_args); }
+
 INLINE_HEADER StgOffset pap_sizeW( StgPAP* x )
 { return PAP_sizeW(x->n_args); }
 

ghc/includes/mkDerivedConstants.c

@@ -232,6 +232,8 @@ main(int argc, char *argv[])
     struct_field_("StgHeader_ccs",  StgHeader, prof.ccs);
     struct_field_("StgHeader_ldvw", StgHeader, prof.hp.ldvw);
 
+    struct_size(StgSMPThunkHeader);
+
     closure_payload(StgClosure,payload);
 
     struct_field(StgEntCounter, allocs);