[project @ 2001-01-29 17:23:40 by simonmar]

Remove the old Hugs CAF code, install our own (minimal, somewhat
cryptic, but better commented) CAF reversion story.  See
Storage.c:newCaf() for the details.

12 files changed, 220 insertions, 358 deletions

diff --git a/ghc/includes/ClosureTypes.h b/ghc/includes/ClosureTypes.h
index 0fea250669..d9f092d98c 100644
--- a/ghc/includes/ClosureTypes.h
+++ b/ghc/includes/ClosureTypes.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: ClosureTypes.h,v 1.13 2000/04/05 14:26:31 panne Exp $
+ * $Id: ClosureTypes.h,v 1.14 2001/01/29 17:23:41 simonmar Exp $
  * 
  * (c) The GHC Team, 1998-1999
  *
@@ -47,19 +47,17 @@
 #define IND_PERM	        31
 #define IND_OLDGEN_PERM	        32
 #define IND_STATIC	        33
-#define CAF_UNENTERED           34
-#define CAF_ENTERED		35
-#define CAF_BLACKHOLE		36
-#define RET_BCO                 37
-#define RET_SMALL	        38
-#define RET_VEC_SMALL	        39
-#define RET_BIG		        40
-#define RET_VEC_BIG	        41
-#define RET_DYN		        42
-#define UPDATE_FRAME	        43
-#define CATCH_FRAME	        44
-#define STOP_FRAME	        45
-#define SEQ_FRAME	        46
+#define RET_BCO                 36
+#define RET_SMALL	        37
+#define RET_VEC_SMALL	        38
+#define RET_BIG		        39
+#define RET_VEC_BIG	        40
+#define RET_DYN		        41
+#define UPDATE_FRAME	        42
+#define CATCH_FRAME	        43
+#define STOP_FRAME	        44
+#define SEQ_FRAME	        45
+#define CAF_BLACKHOLE		46
 #define BLACKHOLE	        47
 #define BLACKHOLE_BQ	        48
 #define SE_BLACKHOLE		49
diff --git a/ghc/includes/Closures.h b/ghc/includes/Closures.h
index 2c38541d6b..c4fcce92da 100644
--- a/ghc/includes/Closures.h
+++ b/ghc/includes/Closures.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: Closures.h,v 1.24 2000/12/19 16:48:58 sewardj Exp $
+ * $Id: Closures.h,v 1.25 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -186,18 +186,13 @@ typedef struct {
 } StgIndOldGen;
 
 typedef struct {
-    StgHeader   header;
-    StgClosure *indirectee;
-    StgClosure *static_link;
-} StgIndStatic;
-
-typedef struct StgCAF_ {
     StgHeader     header;
-    StgClosure    *body;
-    StgMutClosure *mut_link;
-    StgClosure    *value;
-    struct StgCAF_ *link;
-} StgCAF;
+    StgClosure   *indirectee;
+    StgClosure   *static_link;
+#ifdef GHCI
+    struct _StgInfoTable *saved_info;
+#endif
+} StgIndStatic;
 
 typedef struct {
     StgHeader  header;
diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index e92f4fe99f..385d1117b9 100644
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.32 2001/01/15 16:55:25 sewardj Exp $
+ * $Id: StgMiscClosures.h,v 1.33 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -21,8 +21,8 @@ STGFUN(stg_IND_OLDGEN_entry);
 STGFUN(stg_IND_OLDGEN_PERM_entry);
 STGFUN(stg_CAF_UNENTERED_entry);
 STGFUN(stg_CAF_ENTERED_entry);
-STGFUN(stg_CAF_BLACKHOLE_entry);
 STGFUN(stg_BLACKHOLE_entry);
+STGFUN(stg_CAF_BLACKHOLE_entry);
 STGFUN(stg_BLACKHOLE_BQ_entry);
 #ifdef SMP
 STGFUN(stg_WHITEHOLE_entry);
@@ -97,8 +97,8 @@ extern DLL_IMPORT_RTS const StgInfoTable stg_IND_OLDGEN_info;
 extern DLL_IMPORT_RTS const StgInfoTable stg_IND_OLDGEN_PERM_info;
 extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_UNENTERED_info;
 extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_ENTERED_info;
-extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_BLACKHOLE_info;
 extern DLL_IMPORT_RTS const StgInfoTable stg_BLACKHOLE_info;
+extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_BLACKHOLE_info;
 extern DLL_IMPORT_RTS const StgInfoTable stg_BLACKHOLE_BQ_info;
 #ifdef SMP
 extern DLL_IMPORT_RTS const StgInfoTable stg_WHITEHOLE_info;
diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h
index 77a18d1573..9c174660ed 100644
--- a/ghc/includes/Updates.h
+++ b/ghc/includes/Updates.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.21 2000/12/04 12:31:20 simonmar Exp $
+ * $Id: Updates.h,v 1.22 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -61,6 +61,16 @@
    }
 #endif
 
+#define UPD_STATIC_IND(updclosure, heapptr)			\
+   {								\
+	const StgInfoTable *info;				\
+	info = ((StgClosure *)updclosure)->header.info;		\
+        AWAKEN_STATIC_BQ(info,updclosure);			\
+	updateWithStaticIndirection(info,			\
+			            (StgClosure *)updclosure,	\
+  			            (StgClosure *)heapptr);	\
+   }
+
 #if defined(PROFILING) || defined(TICKY_TICKY)
 #define UPD_PERM_IND(updclosure, heapptr)			\
    {								\
@@ -160,6 +170,11 @@ extern void awakenBlockedQueue(StgTSO *q);
           DO_AWAKEN_BQ(closure);                                        \
 	}
 
+#define AWAKEN_STATIC_BQ(info,closure)					\
+     	if (info == &stg_BLACKHOLE_BQ_STATIC_info) {			\
+          DO_AWAKEN_BQ(closure);                                        \
+	}
+
 #endif /* GRAN || PAR */
 
 /* -------------------------------------------------------------------------
diff --git a/ghc/rts/ClosureFlags.c b/ghc/rts/ClosureFlags.c
index 89e98e4728..492eb39ef8 100644
--- a/ghc/rts/ClosureFlags.c
+++ b/ghc/rts/ClosureFlags.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ClosureFlags.c,v 1.6 2000/01/13 14:34:02 hwloidl Exp $
+ * $Id: ClosureFlags.c,v 1.7 2001/01/29 17:23:40 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -26,73 +26,69 @@ StgWord16 closure_flags[] = {
 /*                             0    1    2    3    4   5   6   7 */
 /*			     HNF  BTM   NS  STA  THU MUT UPT SRT */
 				                                    
-/* INVALID_OBJECT       */ ( 0                                   ),
-/* CONSTR  		*/ (_HNF|     _NS                        ),
-/* CONSTR_1_0	   	*/ (_HNF|     _NS                        ),
-/* CONSTR_0_1	   	*/ (_HNF|     _NS                        ),
-/* CONSTR_2_0	   	*/ (_HNF|     _NS                        ),
-/* CONSTR_1_1	   	*/ (_HNF|     _NS                        ),
-/* CONSTR_0_2	   	*/ (_HNF|     _NS                        ),
-/* CONSTR_INTLIKE 	*/ (_HNF|     _NS|_STA                   ),
-/* CONSTR_CHARLIKE  	*/ (_HNF|     _NS|_STA                   ),
-/* CONSTR_STATIC	*/ (_HNF|     _NS|_STA                   ),
-/* CONSTR_NOCAF_STATIC  */ (_HNF|     _NS|_STA                   ),
-/* FUN		   	*/ (_HNF|     _NS|                  _SRT ),
-/* FUN_1_0		*/ (_HNF|     _NS                        ),
-/* FUN_0_1		*/ (_HNF|     _NS                        ),
-/* FUN_2_0		*/ (_HNF|     _NS                        ),
-/* FUN_1_1		*/ (_HNF|     _NS                        ),
-/* FUN_0_2		*/ (_HNF|     _NS                        ),
-/* FUN_STATIC	   	*/ (_HNF|     _NS|_STA|             _SRT ),
-/* THUNK		*/ (     _BTM|         _THU|        _SRT ),
-/* THUNK_1_0		*/ (     _BTM|         _THU|        _SRT ),
-/* THUNK_0_1		*/ (     _BTM|         _THU|        _SRT ),
-/* THUNK_2_0		*/ (     _BTM|         _THU|        _SRT ),
-/* THUNK_1_1		*/ (     _BTM|         _THU|        _SRT ),
-/* THUNK_0_2		*/ (     _BTM|         _THU|        _SRT ),
-/* THUNK_STATIC	   	*/ (     _BTM|    _STA|_THU|        _SRT ),
-/* THUNK_SELECTOR	*/ (     _BTM|         _THU|        _SRT ),
-/* BCO		   	*/ (_HNF|     _NS                        ),
-/* AP_UPD		*/ (     _BTM|         _THU              ),
-/* PAP		   	*/ (_HNF|     _NS                        ),
-/* IND		   	*/ (          _NS                        ),
-/* IND_OLDGEN	   	*/ (          _NS                        ),
-/* IND_PERM		*/ (          _NS                        ),
-/* IND_OLDGEN_PERM	*/ (          _NS                        ),
-/* IND_STATIC	   	*/ (          _NS|_STA                   ),
-/* CAF_UNENTERED        */ ( 0                                   ),
-/* CAF_ENTERED          */ ( 0                                   ),
-/* CAF_BLACKHOLE   	*/ ( 	 _BTM|_NS|         _MUT|_UPT     ),
-/* RET_BCO		*/ (     _BTM                            ),
-/* RET_SMALL		*/ (     _BTM|                       _SRT),
-/* RET_VEC_SMALL	*/ (     _BTM|                       _SRT),
-/* RET_BIG		*/ (                                 _SRT),
-/* RET_VEC_BIG	   	*/ (                                 _SRT),
-/* RET_DYN		*/ (                                 _SRT),
-/* UPDATE_FRAME         */ (     _BTM                            ),
-/* CATCH_FRAME	   	*/ (     _BTM                            ),
-/* STOP_FRAME	   	*/ (     _BTM                            ),
-/* SEQ_FRAME 	   	*/ (     _BTM                            ),
-/* BLACKHOLE		*/ ( 	      _NS|         _MUT|_UPT     ),
-/* BLACKHOLE_BQ	   	*/ ( 	      _NS|         _MUT|_UPT     ),
-/* SE_BLACKHOLE		*/ ( 	      _NS|              _UPT     ),
-/* SE_CAF_BLACKHOLE	*/ ( 	      _NS|              _UPT     ),
-/* MVAR		   	*/ (_HNF|     _NS|         _MUT|_UPT     ),
-/* ARR_WORDS		*/ (_HNF|     _NS|              _UPT     ),
-/* MUT_ARR_PTRS	   	*/ (_HNF|     _NS|         _MUT|_UPT     ),
-/* MUT_ARR_PTRS_FROZEN  */ (_HNF|     _NS|         _MUT|_UPT     ),
-/* MUT_VAR		*/ (_HNF|     _NS|         _MUT|_UPT     ),
-/* WEAK		   	*/ (_HNF|     _NS|              _UPT     ),
-/* FOREIGN		*/ (_HNF|     _NS|              _UPT     ),
-/* STABLE_NAME	   	*/ (_HNF|     _NS|              _UPT     ),
+[INVALID_OBJECT         ] = ( 0                                   ),
+[CONSTR  		] = (_HNF|     _NS                        ),
+[CONSTR_1_0	   	] = (_HNF|     _NS                        ),
+[CONSTR_0_1	   	] = (_HNF|     _NS                        ),
+[CONSTR_2_0	   	] = (_HNF|     _NS                        ),
+[CONSTR_1_1	   	] = (_HNF|     _NS                        ),
+[CONSTR_0_2	   	] = (_HNF|     _NS                        ),
+[CONSTR_INTLIKE 	] = (_HNF|     _NS|_STA                   ),
+[CONSTR_CHARLIKE  	] = (_HNF|     _NS|_STA                   ),
+[CONSTR_STATIC	        ] = (_HNF|     _NS|_STA                   ),
+[CONSTR_NOCAF_STATIC    ] = (_HNF|     _NS|_STA                   ),
+[FUN		   	] = (_HNF|     _NS|                  _SRT ),
+[FUN_1_0		] = (_HNF|     _NS                        ),
+[FUN_0_1		] = (_HNF|     _NS                        ),
+[FUN_2_0		] = (_HNF|     _NS                        ),
+[FUN_1_1		] = (_HNF|     _NS                        ),
+[FUN_0_2		] = (_HNF|     _NS                        ),
+[FUN_STATIC	   	] = (_HNF|     _NS|_STA|             _SRT ),
+[THUNK			] = (     _BTM|         _THU|        _SRT ),
+[THUNK_1_0		] = (     _BTM|         _THU|        _SRT ),
+[THUNK_0_1		] = (     _BTM|         _THU|        _SRT ),
+[THUNK_2_0		] = (     _BTM|         _THU|        _SRT ),
+[THUNK_1_1		] = (     _BTM|         _THU|        _SRT ),
+[THUNK_0_2		] = (     _BTM|         _THU|        _SRT ),
+[THUNK_STATIC	   	] = (     _BTM|    _STA|_THU|        _SRT ),
+[THUNK_SELECTOR		] = (     _BTM|         _THU|        _SRT ),
+[BCO		   	] = (_HNF|     _NS                        ),
+[AP_UPD			] = (     _BTM|         _THU              ),
+[PAP		   	] = (_HNF|     _NS                        ),
+[IND		   	] = (          _NS                        ),
+[IND_OLDGEN	   	] = (          _NS                        ),
+[IND_PERM		] = (          _NS                        ),
+[IND_OLDGEN_PERM	] = (          _NS                        ),
+[IND_STATIC	   	] = (          _NS|_STA                   ),
+[CAF_BLACKHOLE   	] = ( 	  _BTM|_NS|         _MUT|_UPT     ),
+[RET_BCO		] = (     _BTM                            ),
+[RET_SMALL		] = (     _BTM|                       _SRT),
+[RET_VEC_SMALL		] = (     _BTM|                       _SRT),
+[RET_BIG		] = (                                 _SRT),
+[RET_VEC_BIG	   	] = (                                 _SRT),
+[RET_DYN		] = (                                 _SRT),
+[UPDATE_FRAME         	] = (     _BTM                            ),
+[CATCH_FRAME	   	] = (     _BTM                            ),
+[STOP_FRAME	   	] = (     _BTM                            ),
+[SEQ_FRAME 	   	] = (     _BTM                            ),
+[BLACKHOLE		] = ( 	       _NS|         _MUT|_UPT     ),
+[BLACKHOLE_BQ	   	] = ( 	       _NS|         _MUT|_UPT     ),
+[SE_BLACKHOLE		] = ( 	       _NS|              _UPT     ),
+[SE_CAF_BLACKHOLE	] = ( 	       _NS|              _UPT     ),
+[MVAR		   	] = (_HNF|     _NS|         _MUT|_UPT     ),
+[ARR_WORDS		] = (_HNF|     _NS|              _UPT     ),
+[MUT_ARR_PTRS	   	] = (_HNF|     _NS|         _MUT|_UPT     ),
+[MUT_ARR_PTRS_FROZEN  	] = (_HNF|     _NS|         _MUT|_UPT     ),
+[MUT_VAR		] = (_HNF|     _NS|         _MUT|_UPT     ),
+[WEAK		   	] = (_HNF|     _NS|              _UPT     ),
+[FOREIGN		] = (_HNF|     _NS|              _UPT     ),
+[STABLE_NAME	   	] = (_HNF|     _NS|              _UPT     ),
+[TSO                  	] = (_HNF|     _NS|         _MUT|_UPT     ),
+[BLOCKED_FETCH		] = (_HNF|     _NS|         _MUT|_UPT     ),
+[FETCH_ME		] = (_HNF|     _NS|         _MUT|_UPT     ),
+[FETCH_ME_BQ          	] = ( 	       _NS|         _MUT|_UPT     ),
+[RBH                  	] = ( 	       _NS|         _MUT|_UPT     ),
+[EVACUATED		] = ( 0                                   ),
 
-/* TSO                  */ (_HNF|     _NS|         _MUT|_UPT     ),
-/* BLOCKED_FETCH	*/ (_HNF|     _NS|         _MUT|_UPT     ),
-/* FETCH_ME		*/ (_HNF|     _NS|         _MUT|_UPT     ),
-/* FETCH_ME_BQ          */ ( 	      _NS|         _MUT|_UPT     ),
-/* RBH                  */ ( 	      _NS|         _MUT|_UPT     ),
-
-/* EVACUATED		*/ ( 0                                   ),
-
-/* N_CLOSURE_TYPES      */ ( 0                                   )
+[N_CLOSURE_TYPES        ] = ( 0                                   )
 };
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index f4493ca7bc..073dc2c61f 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.92 2001/01/16 11:50:30 simonmar Exp $
+ * $Id: GC.c,v 1.93 2001/01/29 17:23:40 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -164,6 +164,11 @@ static void         scavenge_mut_once_list  ( generation *g );
 static void         gcCAFs                  ( void );
 #endif
 
+#ifdef GHCI
+void revertCAFs   ( void );
+void scavengeCAFs ( void );
+#endif
+
 //@node Garbage Collect, Weak Pointers, Static function declarations
 //@subsection Garbage Collect
 
@@ -385,6 +390,10 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
     }
   }
 
+#ifdef GHCI
+  scavengeCAFs();
+#endif
+
   /* follow all the roots that the application knows about.
    */
   evac_gen = 0;
@@ -773,8 +782,8 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
   /* check for memory leaks if sanity checking is on */
   IF_DEBUG(sanity, memInventory());
 
-#ifdef RTS_GTK_VISUALS
-  if (RtsFlags.GcFlags.visuals) {
+#ifdef RTS_GTK_FRONTPANEL
+  if (RtsFlags.GcFlags.frontpanel) {
       updateFrontPanelAfterGC( N, live );
   }
 #endif
@@ -1392,8 +1401,6 @@ loop:
   case CONSTR:
   case IND_PERM:
   case IND_OLDGEN_PERM:
-  case CAF_UNENTERED:
-  case CAF_ENTERED:
   case WEAK:
   case FOREIGN:
   case STABLE_NAME:
@@ -1466,10 +1473,6 @@ loop:
 	selectee = ((StgInd *)selectee)->indirectee;
 	goto selector_loop;
 
-      case CAF_ENTERED:
-	selectee = ((StgCAF *)selectee)->value;
-	goto selector_loop;
-
       case EVACUATED:
 	selectee = ((StgEvacuated *)selectee)->evacuee;
 	goto selector_loop;
@@ -1484,7 +1487,6 @@ loop:
       case THUNK_STATIC:
       case THUNK_SELECTOR:
 	/* aargh - do recursively???? */
-      case CAF_UNENTERED:
       case CAF_BLACKHOLE:
       case SE_CAF_BLACKHOLE:
       case SE_BLACKHOLE:
@@ -1523,9 +1525,17 @@ loop:
     return q;
 
   case IND_STATIC:
+#ifdef GHCI
+    /* a revertible CAF - it'll be on the CAF list, so don't do
+     * anything with it here (we'll scavenge it later).
+     */
+    if (((StgIndStatic *)q)->saved_info != NULL) {
+       return q;
+    }
+#endif
     if (major_gc && IND_STATIC_LINK((StgClosure *)q) == NULL) {
-      IND_STATIC_LINK((StgClosure *)q) = static_objects;
-      static_objects = (StgClosure *)q;
+       IND_STATIC_LINK((StgClosure *)q) = static_objects;
+       static_objects = (StgClosure *)q;
     }
     return q;
 
@@ -1979,37 +1989,6 @@ scavenge(step *stp)
       p += sizeofW(StgIndOldGen);
       break;
 
-    case CAF_UNENTERED:
-      {
-	StgCAF *caf = (StgCAF *)p;
-
-	caf->body = evacuate(caf->body);
-	if (failed_to_evac) {
-	  failed_to_evac = rtsFalse;
-	  recordOldToNewPtrs((StgMutClosure *)p);
-	} else {
-	  caf->mut_link = NULL;
-	}
-        p += sizeofW(StgCAF);
-	break;
-      }
-
-    case CAF_ENTERED:
-      {
-	StgCAF *caf = (StgCAF *)p;
-
-	caf->body = evacuate(caf->body);
-	caf->value = evacuate(caf->value);
-	if (failed_to_evac) {
-	  failed_to_evac = rtsFalse;
-	  recordOldToNewPtrs((StgMutClosure *)p);
-	} else {
-	  caf->mut_link = NULL;
-	}
-        p += sizeofW(StgCAF);
-	break;
-      }
-
     case MUT_VAR:
       /* ignore MUT_CONSs */
       if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
@@ -2273,7 +2252,6 @@ scavenge_one(StgClosure *p)
   case FOREIGN:
   case IND_PERM:
   case IND_OLDGEN_PERM:
-  case CAF_UNENTERED:
     {
       StgPtr q, end;
       
@@ -2434,35 +2412,6 @@ scavenge_mut_once_list(generation *gen)
       } 
       continue;
       
-    case CAF_ENTERED:
-      { 
-	StgCAF *caf = (StgCAF *)p;
-	caf->body  = evacuate(caf->body);
-	caf->value = evacuate(caf->value);
-	if (failed_to_evac) {
-	  failed_to_evac = rtsFalse;
-	  p->mut_link = new_list;
-	  new_list = p;
-	} else {
-	  p->mut_link = NULL;
-	}
-      }
-      continue;
-
-    case CAF_UNENTERED:
-      { 
-	StgCAF *caf = (StgCAF *)p;
-	caf->body  = evacuate(caf->body);
-	if (failed_to_evac) {
-	  failed_to_evac = rtsFalse;
-	  p->mut_link = new_list;
-	  new_list = p;
-	} else {
-          p->mut_link = NULL;
-        }
-      }
-      continue;
-
     default:
       /* shouldn't have anything else on the mutables list */
       barf("scavenge_mut_once_list: strange object? %d", (int)(info->type));
@@ -3057,7 +3006,6 @@ zero_static_object_list(StgClosure* first_static)
  * It doesn't do any harm to zero all the mutable link fields on the
  * mutable list.
  */
-//@cindex zero_mutable_list
 
 static void
 zero_mutable_list( StgMutClosure *first )
@@ -3070,43 +3018,37 @@ zero_mutable_list( StgMutClosure *first )
   }
 }
 
-//@node Reverting CAFs, Sanity code for CAF garbage collection, Scavenging
-//@subsection Reverting CAFs
-
 /* -----------------------------------------------------------------------------
    Reverting CAFs
    -------------------------------------------------------------------------- */
-//@cindex RevertCAFs
 
-void RevertCAFs(void)
+#ifdef GHCI
+
+void
+revertCAFs( void )
 {
-#ifdef INTERPRETER
-   StgInt i;
-
-   /* Deal with CAFs created by compiled code. */
-   for (i = 0; i < usedECafTable; i++) {
-      SET_INFO( (StgInd*)(ecafTable[i].closure), ecafTable[i].origItbl );
-      ((StgInd*)(ecafTable[i].closure))->indirectee = 0;
-   }
-
-   /* Deal with CAFs created by the interpreter. */
-   while (ecafList != END_ECAF_LIST) {
-      StgCAF* caf  = ecafList;
-      ecafList     = caf->link;
-      ASSERT(get_itbl(caf)->type == CAF_ENTERED);
-      SET_INFO(caf,&CAF_UNENTERED_info);
-      caf->value   = (StgClosure *)0xdeadbeef;
-      caf->link    = (StgCAF *)0xdeadbeef;
-   }
-
-   /* Empty out both the table and the list. */
-   clearECafTable();
-   ecafList = END_ECAF_LIST;
-#endif
+    StgIndStatic *c;
+
+    for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) {
+	c->header.info = c->saved_info;
+	c->saved_info = NULL;
+	/* could, but not necessary: c->static_link = NULL; */
+    }
+    caf_list = NULL;
+}
+
+void
+scavengeCAFs( void )
+{
+    StgIndStatic *c;
+
+    evac_gen = 0;
+    for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) {
+	c->indirectee = evacuate(c->indirectee);
+    }
 }
 
-//@node Sanity code for CAF garbage collection, Lazy black holing, Reverting CAFs
-//@subsection Sanity code for CAF garbage collection
+#endif /* GHCI */
 
 /* -----------------------------------------------------------------------------
    Sanity code for CAF garbage collection.
@@ -3288,16 +3230,20 @@ threadSqueezeStack(StgTSO *tso)
 		    frame, prev_frame);
 	     })
     switch (get_itbl(frame)->type) {
-    case UPDATE_FRAME: upd_frames++;
-                       if (frame->updatee->header.info == &stg_BLACKHOLE_info)
-			 bhs++;
-                       break;
-    case STOP_FRAME:  stop_frames++;
-                      break;
-    case CATCH_FRAME: catch_frames++;
-                      break;
-    case SEQ_FRAME: seq_frames++;
-                    break;
+    case UPDATE_FRAME:
+	upd_frames++;
+	if (frame->updatee->header.info == &stg_BLACKHOLE_info)
+	    bhs++;
+	break;
+    case STOP_FRAME:
+	stop_frames++;
+	break;
+    case CATCH_FRAME:
+	catch_frames++;
+	break;
+    case SEQ_FRAME:
+	seq_frames++;
+	break;
     default:
       barf("Found non-frame during stack squeezing at %p (prev frame was %p)\n",
 	   frame, prev_frame);
diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c
index 07924a08ad..bbfdc370b6 100644
--- a/ghc/rts/Linker.c
+++ b/ghc/rts/Linker.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.14 2001/01/28 20:53:38 qrczak Exp $
+ * $Id: Linker.c,v 1.15 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 2000
  *
@@ -151,7 +151,6 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
       SymX(stg_WEAK_info)                       \
       SymX(stg_CHARLIKE_closure)		\
       SymX(stg_INTLIKE_closure)			\
-      SymX(stg_CAF_UNENTERED_entry)		\
       SymX(newCAF)				\
       SymX(newBCOzh_fast)			\
       SymX(mkApUpd0zh_fast)			\
diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index 389dd801e8..b163389b05 100644
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.33 2001/01/15 16:55:25 sewardj Exp $
+ * $Id: Printer.c,v 1.34 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 1994-2000.
  *
@@ -145,32 +145,6 @@ void printClosure( StgClosure *obj )
             fprintf(stderr,")\n"); 
             break;
 
-    case CAF_UNENTERED:
-        {
-	    StgCAF* caf = stgCast(StgCAF*,obj);
-            fprintf(stderr,"CAF_UNENTERED("); 
-            printPtr((StgPtr)caf->body);
-            fprintf(stderr,", ");
-            printPtr((StgPtr)caf->value); /* should be null */
-            fprintf(stderr,", ");
-            printPtr((StgPtr)caf->link);
-            fprintf(stderr,")\n"); 
-            break;
-        }
-
-    case CAF_ENTERED:
-        {
-	    StgCAF* caf = stgCast(StgCAF*,obj);
-            fprintf(stderr,"CAF_ENTERED("); 
-            printPtr((StgPtr)caf->body);
-            fprintf(stderr,", ");
-            printPtr((StgPtr)caf->value);
-            fprintf(stderr,", ");
-            printPtr((StgPtr)caf->link);
-            fprintf(stderr,")\n"); 
-            break;
-        }
-
     case CAF_BLACKHOLE:
             fprintf(stderr,"CAF_BH("); 
             printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
@@ -563,8 +537,6 @@ static char *closure_type_names[] = {
   "IND_PERM",	        	/* 31 */
   "IND_OLDGEN_PERM",	        /* 32 */
   "IND_STATIC",	        	/* 33 */
-  "CAF_UNENTERED",           	/* 34 */
-  "CAF_ENTERED",		/* 35 */
   "CAF_BLACKHOLE",		/* 36 */
   "RET_BCO",                 	/* 37 */
   "RET_SMALL",	        	/* 38 */
diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index cf0a8fdbe8..bd5d96aff4 100644
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.24 2000/12/11 12:37:00 simonmar Exp $
+ * $Id: Sanity.c,v 1.25 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -282,14 +282,12 @@ checkClosure( StgClosure* p )
     case IND_PERM:
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
-    case CAF_UNENTERED:
-    case CAF_ENTERED:
-    case CAF_BLACKHOLE:
 #ifdef TICKY_TICKY
-    case SE_CAF_BLACKHOLE:
     case SE_BLACKHOLE:
+    case SE_CAF_BLACKHOLE:
 #endif
     case BLACKHOLE:
+    case CAF_BLACKHOLE:
     case FOREIGN:
     case BCO:
     case STABLE_NAME:
diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 27e881b234..23a0caf342 100644
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.60 2001/01/16 12:44:34 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.61 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -228,7 +228,6 @@ STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_7_entry);
 
 VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
 
-
 /* The other way round: when the interpreter returns a value to
    compiled code.  The stack looks like this:
 
@@ -370,34 +369,6 @@ STGFUN(stg_IND_OLDGEN_PERM_entry)
 }
 
 /* -----------------------------------------------------------------------------
-   Entry code for CAFs
-
-   This code assumes R1 is in a register for now.
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_CAF_UNENTERED_info,stg_CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
-STGFUN(stg_CAF_UNENTERED_entry)
-{
-    FB_
-    /* ToDo: implement directly in GHC */
-    Sp -= 1;
-    Sp[0] = R1.w;
-    JMP_(stg_yield_to_interpreter);
-    FE_
-}
-
-/* 0,4 is entirely bogus; _do not_ rely on this info */
-INFO_TABLE(stg_CAF_ENTERED_info,stg_CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
-STGFUN(stg_CAF_ENTERED_entry)
-{
-    FB_
-    R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
-    TICK_ENT_VIA_NODE();
-    JMP_(GET_ENTRY(R1.cl));
-    FE_
-}
-
-/* -----------------------------------------------------------------------------
    Entry code for a black hole.
 
    Entering a black hole normally causes a cyclic data dependency, but
@@ -592,7 +563,7 @@ STGFUN(stg_CAF_BLACKHOLE_entry)
     CurrentTSO->block_info.closure = R1.cl;
     /* closure is mutable since something has just been added to its BQ */
     recordMutable((StgMutClosure *)R1.cl);
-    /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
+    /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC */
     ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
 
     /* PAR: dumping of event now done in blockThread -- HWL */
@@ -843,7 +814,7 @@ STGFUN(stg_forceIO_ret_entry)
 }
 #else
 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
-STGFUN(forceIO_ret_entry)
+STGFUN(stg_forceIO_ret_entry)
 {
   StgClosure *rval;
   FB_
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 1119519e42..caca81c239 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.33 2001/01/24 15:46:19 simonmar Exp $
+ * $Id: Storage.c,v 1.34 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -198,6 +198,43 @@ exitStorage (void)
 
 /* -----------------------------------------------------------------------------
    CAF management.
+
+   The entry code for every CAF does the following:
+     
+      - builds a CAF_BLACKHOLE in the heap
+      - pushes an update frame pointing to the CAF_BLACKHOLE
+      - invokes UPD_CAF(), which:
+          - calls newCaf, below
+	  - updates the CAF with a static indirection to the CAF_BLACKHOLE
+      
+   Why do we build a BLACKHOLE in the heap rather than just updating
+   the thunk directly?  It's so that we only need one kind of update
+   frame - otherwise we'd need a static version of the update frame too.
+
+   newCaf() does the following:
+       
+      - it puts the CAF on the oldest generation's mut-once list.
+        This is so that we can treat the CAF as a root when collecting
+	younger generations.
+
+   For GHCI, we have additional requirements when dealing with CAFs:
+
+      - we must *retain* all dynamically-loaded CAFs ever entered,
+        just in case we need them again.
+      - we must be able to *revert* CAFs that have been evaluated, to
+        their pre-evaluated form.
+
+      To do this, we use an additional CAF list.  When newCaf() is
+      called on a dynamically-loaded CAF, we add it to the CAF list
+      instead of the old-generation mutable list, and save away its
+      old info pointer (in caf->saved_info) for later reversion.
+
+      To revert all the CAFs, we traverse the CAF list and reset the
+      info pointer to caf->saved_info, then throw away the CAF list.
+      (see GC.c:revertCAFs()).
+
+      -- SDM 29/1/01
+
    -------------------------------------------------------------------------- */
 
 void
@@ -212,30 +249,20 @@ newCAF(StgClosure* caf)
    */
   ACQUIRE_LOCK(&sm_mutex);
 
-  ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
-  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
-  oldest_gen->mut_once_list = (StgMutClosure *)caf;
-
 #ifdef GHCI
-  /* For dynamically-loaded code, we retain all the CAFs.  There is no
-   * way of knowing which ones we'll need in the future.
-   */
   if (is_dynamically_loaded_rwdata_ptr((StgPtr)caf)) {
-      caf->payload[2] = caf_list; /* IND_STATIC_LINK2() */
+      ((StgIndStatic *)caf)->saved_info  = (StgInfoTable *)caf->header.info;
+      ((StgIndStatic *)caf)->static_link = caf_list;
       caf_list = caf;
+  } else {
+      ((StgIndStatic *)caf)->saved_info = NULL;
+      ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
+      oldest_gen->mut_once_list = (StgMutClosure *)caf;
   }
-#endif
-
-#ifdef INTERPRETER
-  /* If we're Hugs, we also have to put it in the CAF table, so that
-     the CAF can be reverted.  When reverting, CAFs created by compiled
-     code are recorded in the CAF table, which lives outside the
-     heap, in mallocville.  CAFs created by interpreted code are
-     chained together via the link fields in StgCAFs, and are not
-     recorded in the CAF table.
-  */
-  ASSERT( get_itbl(caf)->type == THUNK_STATIC );
-  addToECafTable ( caf, get_itbl(caf) );
+#else
+  ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
+  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
+  oldest_gen->mut_once_list = (StgMutClosure *)caf;
 #endif
 
   RELEASE_LOCK(&sm_mutex);
@@ -253,58 +280,6 @@ markCafs( void )
 }
 #endif /* GHCI */
 
-#ifdef INTERPRETER
-void
-newCAF_made_by_Hugs(StgCAF* caf)
-{
-  ACQUIRE_LOCK(&sm_mutex);
-
-  ASSERT( get_itbl(caf)->type == CAF_ENTERED );
-  recordOldToNewPtrs((StgMutClosure*)caf);
-  caf->link = ecafList;
-  ecafList = caf->link;
-
-  RELEASE_LOCK(&sm_mutex);
-}
-#endif
-
-#ifdef INTERPRETER
-/* These initialisations are critical for correct operation
-   on the first call of addToECafTable. 
-*/
-StgCAF*         ecafList      = END_ECAF_LIST;
-StgCAFTabEntry* ecafTable     = NULL;
-StgInt          usedECafTable = 0;
-StgInt          sizeECafTable = 0;
-
-
-void clearECafTable ( void )
-{
-   usedECafTable = 0;
-}
-
-void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl )
-{
-   StgInt          i;
-   StgCAFTabEntry* et2;
-   if (usedECafTable == sizeECafTable) {
-      /* Make the initial table size be 8 */
-      sizeECafTable *= 2;
-      if (sizeECafTable == 0) sizeECafTable = 8;
-      et2 = stgMallocBytes ( 
-               sizeECafTable * sizeof(StgCAFTabEntry),
-               "addToECafTable" );
-      for (i = 0; i < usedECafTable; i++) 
-         et2[i] = ecafTable[i];
-      if (ecafTable) free(ecafTable);
-      ecafTable = et2;
-   }
-   ecafTable[usedECafTable].closure  = closure;
-   ecafTable[usedECafTable].origItbl = origItbl;
-   usedECafTable++;
-}
-#endif
-
 /* -----------------------------------------------------------------------------
    Nursery management.
    -------------------------------------------------------------------------- */
diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h
index e32e9ada7c..b834df4895 100644
--- a/ghc/rts/Storage.h
+++ b/ghc/rts/Storage.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.24 2001/01/26 14:36:40 simonpj Exp $
+ * $Id: Storage.h,v 1.25 2001/01/29 17:23:41 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -534,9 +534,6 @@ static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )
 static __inline__ StgOffset BLACKHOLE_sizeW ( void )                    
 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 
-static __inline__ StgOffset CAF_sizeW ( void )                    
-{ return sizeofW(StgCAF); }
-
 /* --------------------------------------------------------------------------
  * Sizes of closures
  * ------------------------------------------------------------------------*/