diff --git a/ghc/includes/SchedAPI.h b/ghc/includes/SchedAPI.h
index 18c48f5f9cf6c5c8155593d12cdacbfcf00947a1..05d3ca859966923383a2651ba872420b04ac3523 100644
--- a/ghc/includes/SchedAPI.h
+++ b/ghc/includes/SchedAPI.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: SchedAPI.h,v 1.9 2000/01/13 14:34:01 hwloidl Exp $
+ * $Id: SchedAPI.h,v 1.10 2000/04/14 15:18:05 sewardj Exp $
*
* (c) The GHC Team 1998
*
@@ -90,14 +90,17 @@ createStrictIOThread(nat stack_size, StgClosure *closure) {
/*
* Killing threads
*/
-
-void deleteThread(StgTSO *tso);
-void deleteAllThreads ( void );
+extern void deleteThread(StgTSO *tso);
+extern void deleteAllThreads ( void );
+extern int howManyThreadsAvail ( void );
+/*
+ * Run until there are no more threads.
+ */
+extern void finishAllThreads ( void );
/*
* Reverting CAFs
*/
-
-void RevertCAFs(void);
+extern void RevertCAFs ( void );
#endif
diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h
index 5378b6c8711d0b102ed49b6b98c74d45282e08ca..0c2f38507995f63c90ac92ded17ac11ab5e25a7a 100644
--- a/ghc/includes/Updates.h
+++ b/ghc/includes/Updates.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.16 2000/01/13 14:34:01 hwloidl Exp $
+ * $Id: Updates.h,v 1.17 2000/04/14 15:18:05 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -212,14 +212,22 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable Upd_frame_info;
extern void newCAF(StgClosure*);
+/* newCAF must be called before the itbl ptr is overwritten, since
+ newCAF records the old itbl ptr in order to do CAF reverting
+ (which Hugs needs to do in order that combined mode works right.)
+*/
#define UPD_CAF(cafptr, bhptr) \
{ \
LOCK_CLOSURE(cafptr); \
+ STGCALL1(newCAF,(StgClosure *)cafptr); \
((StgInd *)cafptr)->indirectee = (StgClosure *)(bhptr); \
SET_INFO((StgInd *)cafptr,(const StgInfoTable*)&IND_STATIC_info); \
- STGCALL1(newCAF,(StgClosure *)cafptr); \
}
+#ifdef INTERPRETER
+extern void newCAF_made_by_Hugs(StgCAF*);
+#endif
+
/* -----------------------------------------------------------------------------
Update-related prototypes
-------------------------------------------------------------------------- */
diff --git a/ghc/interpreter/compiler.c b/ghc/interpreter/compiler.c
index c6b1cce8f0e1b1cb6d0cab12187e66e792d3df1f..20bc336014454b5f76d1dfcf50d5a3422532493c 100644
--- a/ghc/interpreter/compiler.c
+++ b/ghc/interpreter/compiler.c
@@ -11,8 +11,8 @@
* included in the distribution.
*
* $RCSfile: compiler.c,v $
- * $Revision: 1.27 $
- * $Date: 2000/04/11 16:36:53 $
+ * $Revision: 1.28 $
+ * $Date: 2000/04/14 15:18:06 $
* ------------------------------------------------------------------------*/
#include "hugsbasictypes.h"
@@ -1528,29 +1528,44 @@ Void evalExp ( void ) { /* compile and run input expression */
switch (status) {
case Deadlock:
printf("{Deadlock or Blackhole}");
- if (doRevertCAFs) RevertCAFs();
break;
case Interrupted:
printf("{Interrupted}");
- if (doRevertCAFs) RevertCAFs();
break;
case Killed:
printf("{Interrupted or Killed}");
- if (doRevertCAFs) RevertCAFs();
break;
case Success:
- if (doRevertCAFs) RevertCAFs();
break;
default:
internal("evalExp: Unrecognised SchedulerStatus");
}
- deleteAllThreads();
+
+ /* Begin heap cleanup sequence */
+ do {
+ /* fprintf ( stderr, "finalisation loop START\n" ); */
+ finishAllThreads();
+ finalizeWeakPointersNow();
+ /* fprintf ( stderr, "finalisation loop END %d\n",
+ howManyThreadsAvail() ); */
+ }
+ while (howManyThreadsAvail() > 0);
+
+ RevertCAFs();
+ performMajorGC();
+ if (combined && SPT_size != 0) {
+ FPrintf ( stderr,
+ "hugs: fatal: stable pointers are not yet allowed in combined mode" );
+ internal("evalExp");
+ }
+ /* End heap cleanup sequence */
+
fflush(stdout);
fflush(stderr);
}
-#ifdef CRUDE_PROFILING
+# ifdef CRUDE_PROFILING
cp_show();
-#endif
+# endif
}
diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index b70105f554f1ed533ab142bdf3cfd667df70fb81..d4719d6deed4bebc36470b277842b8e1fd2709d9 100644
--- a/ghc/interpreter/interface.c
+++ b/ghc/interpreter/interface.c
@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: interface.c,v $
- * $Revision: 1.53 $
- * $Date: 2000/04/12 09:43:10 $
+ * $Revision: 1.54 $
+ * $Date: 2000/04/14 15:18:06 $
* ------------------------------------------------------------------------*/
#include "hugsbasictypes.h"
@@ -19,7 +19,6 @@
#include "Assembler.h" /* for wrapping GHC objects */
-
/*#define DEBUG_IFACE*/
#define VERBOSE FALSE
diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 696e117f597c4eb8d7e5a0342e116a9637823923..637c15bc6ca4b9f06eed3f66f2fa55c83a73a17b 100644
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.70 $
- * $Date: 2000/04/12 09:37:19 $
+ * $Revision: 1.71 $
+ * $Date: 2000/04/14 15:18:06 $
* ------------------------------------------------------------------------*/
#include "hugsbasictypes.h"
@@ -1640,11 +1640,13 @@ void nukeModule ( Module m )
if (!isModule(m)) internal("nukeModule");
+ /* fprintf ( stderr, "NUKE MODULE %s\n", textToStr(module(m).text) ); */
+
/* see comment in compiler.c about this,
and interaction with info tables */
if (nukeModule_needs_major_gc) {
/* fprintf ( stderr, "doing major GC in nukeModule\n"); */
- performMajorGC();
+ /* performMajorGC(); */
nukeModule_needs_major_gc = FALSE;
}
@@ -1663,14 +1665,20 @@ void nukeModule ( Module m )
for (i = NAME_BASE_ADDR; i < NAME_BASE_ADDR+tabNameSz; i++)
if (tabName[i-NAME_BASE_ADDR].inUse && name(i).mod == m) {
- if (name(i).itbl) free(name(i).itbl);
+ if (name(i).itbl &&
+ module(name(i).mod).mode == FM_SOURCE) {
+ free(name(i).itbl);
+ }
name(i).itbl = NULL;
freeName(i);
}
for (i = TYCON_BASE_ADDR; i < TYCON_BASE_ADDR+tabTyconSz; i++)
if (tabTycon[i-TYCON_BASE_ADDR].inUse && tycon(i).mod == m) {
- if (tycon(i).itbl) free(tycon(i).itbl);
+ if (tycon(i).itbl &&
+ module(tycon(i).mod).mode == FM_SOURCE) {
+ free(tycon(i).itbl);
+ }
tycon(i).itbl = NULL;
freeTycon(i);
}
diff --git a/ghc/rts/Assembler.c b/ghc/rts/Assembler.c
index 5b6d9dacdad1edb919b5fd962e67020b887baf85..a382920b7784c00f76e083964416f5ba4391d73d 100644
--- a/ghc/rts/Assembler.c
+++ b/ghc/rts/Assembler.c
@@ -5,8 +5,8 @@
* Copyright (c) 1994-1998.
*
* $RCSfile: Assembler.c,v $
- * $Revision: 1.25 $
- * $Date: 2000/04/11 20:44:19 $
+ * $Revision: 1.26 $
+ * $Date: 2000/04/14 15:18:06 $
*
* This module provides functions to construct BCOs and other closures
* required by the bytecode compiler.
@@ -191,7 +191,7 @@ static void asmResolveRef( AsmObject obj, AsmNat i, AsmClosure reference )
ap->fun = reference;
} else {
ASSERT(ap->payload[i-1] == NULL);
- ap->payload[i-1] = reference;
+ ap->payload[i-1] = (StgPtr)reference;
}
break;
}
@@ -1430,7 +1430,9 @@ AsmPrim ccall_stdcall_IO
= { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_stdcall_IO };
#ifdef DEBUG
-void checkBytecodeCount( void ) {
+void checkBytecodeCount( void );
+void checkBytecodeCount( void )
+{
if (MAX_Primop1 >= 255) {
printf("Too many Primop1 bytecodes (%d)\n",MAX_Primop1);
}
diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c
index 82603e0cd5ab982eb86675b8b6983bfef5d01725..ac0c986b3d91af8ac2031488cf42a2cb1a7417eb 100644
--- a/ghc/rts/Evaluator.c
+++ b/ghc/rts/Evaluator.c
@@ -5,8 +5,8 @@
* Copyright (c) 1994-1998.
*
* $RCSfile: Evaluator.c,v $
- * $Revision: 1.47 $
- * $Date: 2000/04/11 20:44:19 $
+ * $Revision: 1.48 $
+ * $Date: 2000/04/14 15:18:06 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
@@ -1356,22 +1356,19 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
xPushCPtr(obj); /* code to restart with */
RETURN(StackOverflow);
}
- /* ToDo: look for xSp==xSu && stackInt(0) == UPD_FRAME
- and insert an indirection immediately */
SSS; bh = (StgBlockingQueue*)grabHpUpd(BLACKHOLE_sizeW()); LLL;
SET_INFO(bh,&CAF_BLACKHOLE_info);
bh->blocking_queue = EndTSOQueue;
IF_DEBUG(gccafs,
- fprintf(stderr,"Created CAF_BLACKHOLE %p for CAF %p in evaluator\n",bh,caf));
+ fprintf(stderr,"Created CAF_BLACKHOLE %p for CAF %p"
+ " in evaluator\n",bh,caf));
SET_INFO(caf,&CAF_ENTERED_info);
caf->value = (StgClosure*)bh;
- if (caf->mut_link == NULL) {
- SSS; recordOldToNewPtrs((StgMutClosure*)caf); LLL;
- }
+
+ SSS; newCAF_made_by_Hugs(caf); LLL;
+
xPushUpdateFrame(bh,0);
xSp -= sizeofW(StgUpdateFrame);
- caf->link = enteredCAFs;
- enteredCAFs = caf;
obj = caf->body;
goto enterLoop;
}
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index f4308141ae83fdc38a2a317913afe7726faa4632..d3056b67306351675ed0e3d169bc1ea07f32102b 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.78 2000/04/11 16:36:53 sewardj Exp $
+ * $Id: GC.c,v 1.79 2000/04/14 15:18:06 sewardj Exp $
*
* (c) The GHC Team 1998-1999
*
@@ -53,8 +53,6 @@
# endif
#endif
-StgCAF* enteredCAFs;
-
//@node STATIC OBJECT LIST, Static function declarations, Includes
//@subsection STATIC OBJECT LIST
@@ -486,9 +484,11 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
*/
gcStablePtrTable(major_gc);
+#if 0
/* revert dead CAFs and update enteredCAFs list */
revert_dead_CAFs();
-
+#endif
+
#if defined(PAR)
/* Reconstruct the Global Address tables used in GUM */
rebuildGAtables(major_gc);
@@ -2757,7 +2757,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
const StgInfoTable* info;
StgWord32 bitmap;
- IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end));
+ //IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end));
/*
* Each time around this loop, we are looking at a chunk of stack
@@ -3086,18 +3086,32 @@ zero_mutable_list( StgMutClosure *first )
void RevertCAFs(void)
{
- while (enteredCAFs != END_CAF_LIST) {
- StgCAF* caf = enteredCAFs;
-
- enteredCAFs = caf->link;
- ASSERT(get_itbl(caf)->type == CAF_ENTERED);
- SET_INFO(caf,&CAF_UNENTERED_info);
- caf->value = (StgClosure *)0xdeadbeef;
- caf->link = (StgCAF *)0xdeadbeef;
- }
- enteredCAFs = END_CAF_LIST;
+#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
}
+#if 0
//@cindex revert_dead_CAFs
void revert_dead_CAFs(void)
@@ -3120,6 +3134,7 @@ void revert_dead_CAFs(void)
caf = next;
}
}
+#endif
//@node Sanity code for CAF garbage collection, Lazy black holing, Reverting CAFs
//@subsection Sanity code for CAF garbage collection
diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index 82ce1355537e55111bf5fe306572521c26f6e254..541b7c2a7789e5bdb780ffaec014531e62829956 100644
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.24 2000/04/12 09:37:19 sewardj Exp $
+ * $Id: Printer.c,v 1.25 2000/04/14 15:18:06 sewardj Exp $
*
* (c) The GHC Team, 1994-2000.
*
@@ -152,7 +152,7 @@ void printClosure( StgClosure *obj )
fprintf(stderr,", ");
printPtr((StgPtr)caf->value); /* should be null */
fprintf(stderr,", ");
- printPtr((StgPtr)caf->link); /* should be null */
+ printPtr((StgPtr)caf->link);
fprintf(stderr,")\n");
break;
}
diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
index 2285c416c913a8319bc17a4c4fbf30239b898b2b..a80efb257598f2080ad1adb0a8c79fabbcd1cdd3 100644
--- a/ghc/rts/Sanity.c
+++ b/ghc/rts/Sanity.c
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.20 2000/04/12 09:34:46 sewardj Exp $
+ * $Id: Sanity.c,v 1.21 2000/04/14 15:18:06 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -482,7 +482,7 @@ checkHeap(bdescr *bd, StgPtr start)
nat xxx = 0; // tmp -- HWL
if (start == NULL) {
- p = bd->start;
+ if (bd != NULL) p = bd->start;
} else {
p = start;
}
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 50009f272120814e9783ff2bbcc34d9f54c6a1c3..1fde2f083978fe35b96ba5dc900001d6fc637960 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.66 2000/04/11 16:36:53 sewardj Exp $
+ * $Id: Schedule.c,v 1.67 2000/04/14 15:18:07 sewardj Exp $
*
* (c) The GHC Team, 1998-2000
*
@@ -1066,7 +1066,7 @@ schedule( void )
break;
default:
- barf("doneThread: invalid thread return code");
+ barf("schedule: invalid thread return code %d", (int)ret);
}
#ifdef SMP
@@ -1572,7 +1572,10 @@ initScheduler(void)
context_switch = 0;
interrupted = 0;
- enteredCAFs = END_CAF_LIST;
+ ecafList = END_ECAF_LIST;
+#ifdef INTERPRETER
+ clearECafTable();
+#endif
/* Install the SIGHUP handler */
#ifdef SMP
@@ -1702,6 +1705,33 @@ exitScheduler( void )
* will be in the main_thread struct.
* -------------------------------------------------------------------------- */
+int
+howManyThreadsAvail ( void )
+{
+ int i = 0;
+ StgTSO* q;
+ for (q = run_queue_hd; q != END_TSO_QUEUE; q = q->link)
+ i++;
+ for (q = blocked_queue_hd; q != END_TSO_QUEUE; q = q->link)
+ i++;
+ return i;
+}
+
+void
+finishAllThreads ( void )
+{
+ do {
+ while (run_queue_hd != END_TSO_QUEUE) {
+ waitThread ( run_queue_hd, NULL );
+ }
+ while (blocked_queue_hd != END_TSO_QUEUE) {
+ waitThread ( blocked_queue_hd, NULL );
+ }
+ } while
+ (blocked_queue_hd != END_TSO_QUEUE ||
+ run_queue_hd != END_TSO_QUEUE);
+}
+
SchedulerStatus
waitThread(StgTSO *tso, /*out*/StgClosure **ret)
{
diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h
index 78b7a60bc79f7b9c14d82ad3c01f07b03fbf8dd1..d0c3f9923dc5d9f4e2db873205a674eda5a6cac4 100644
--- a/ghc/rts/Schedule.h
+++ b/ghc/rts/Schedule.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: Schedule.h,v 1.17 2000/03/31 03:09:36 hwloidl Exp $
+ * $Id: Schedule.h,v 1.18 2000/04/14 15:18:07 sewardj Exp $
*
* (c) The GHC Team 1998-1999
*
@@ -32,6 +32,7 @@ void exitScheduler( void );
void startTasks( void );
#endif
+
//@cindex awakenBlockedQueue
/* awakenBlockedQueue()
*
@@ -193,7 +194,7 @@ void print_bq (StgClosure *node);
/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */
#define END_TSO_QUEUE ((StgTSO *)(void*)&END_TSO_QUEUE_closure)
/* this is the NIL ptr for a list CAFs */
-#define END_CAF_LIST ((StgCAF *)(void*)&END_TSO_QUEUE_closure)
+#define END_ECAF_LIST ((StgCAF *)(void*)&END_TSO_QUEUE_closure)
#if defined(PAR) || defined(GRAN)
/* this is the NIL ptr for a blocking queue */
# define END_BQ_QUEUE ((StgBlockingQueueElement *)(void*)&END_TSO_QUEUE_closure)
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 3dd36f7df506a36e69c8f4bd2dc2cbd7017184a0..39a6a5fff977e5ed60abc8df6d33872165b97e46 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.23 2000/02/14 10:58:05 sewardj Exp $
+ * $Id: Storage.c,v 1.24 2000/04/14 15:18:07 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -195,6 +195,11 @@ exitStorage (void)
stat_exit(calcAllocated());
}
+
+/* -----------------------------------------------------------------------------
+ CAF management.
+ -------------------------------------------------------------------------- */
+
void
newCAF(StgClosure* caf)
{
@@ -206,24 +211,78 @@ newCAF(StgClosure* caf)
* any more and can use it as a STATIC_LINK.
*/
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 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
- }
+#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) );
#endif
+
RELEASE_LOCK(&sm_mutex);
}
+#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.
-------------------------------------------------------------------------- */
@@ -653,8 +712,8 @@ extern void
checkSanity(nat N)
{
nat g, s;
-
- if (RtsFlags.GcFlags.generations == 1) {
+fprintf(stderr, "--- checkSanity %d\n", N );
+ if (0&&RtsFlags.GcFlags.generations == 1) {
checkHeap(g0s0->to_space, NULL);
checkChain(g0s0->large_objects);
} else {
diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h
index 53f76f862c275723723f22432f14726086b23eb7..a9c6a095a30930a7bd0f5f977f159406f73727c2 100644
--- a/ghc/rts/Storage.h
+++ b/ghc/rts/Storage.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.15 2000/04/11 16:36:54 sewardj Exp $
+ * $Id: Storage.h,v 1.16 2000/04/14 15:18:07 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -172,11 +172,24 @@ updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *
#endif
/* -----------------------------------------------------------------------------
- The CAF list - used to let us revert CAFs
+ The CAF table - used to let us revert CAFs
-------------------------------------------------------------------------- */
-extern StgCAF* enteredCAFs;
+#if defined(INTERPRETER)
+typedef struct StgCAFTabEntry_ {
+ StgClosure* closure;
+ StgInfoTable* origItbl;
+} StgCAFTabEntry;
+
+extern void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl );
+extern void clearECafTable ( void );
+
+extern StgCAF* ecafList;
+extern StgCAFTabEntry* ecafTable;
+extern StgInt usedECafTable;
+extern StgInt sizeECafTable;
+#endif
#if defined(DEBUG)
void printMutOnceList(generation *gen);