/* -----------------------------------------------------------------------------
- * $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
*
/*
* 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
/* -----------------------------------------------------------------------------
- * $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
*
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
-------------------------------------------------------------------------- */
* 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"
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
}
* 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"
#include "Assembler.h" /* for wrapping GHC objects */
-
/*#define DEBUG_IFACE*/
#define VERBOSE FALSE
* 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"
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;
}
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);
}
* 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.
ap->fun = reference;
} else {
ASSERT(ap->payload[i-1] == NULL);
- ap->payload[i-1] = reference;
+ ap->payload[i-1] = (StgPtr)reference;
}
break;
}
= { "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);
}
* 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"
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;
}
/* -----------------------------------------------------------------------------
- * $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
*
# endif
#endif
-StgCAF* enteredCAFs;
-
//@node STATIC OBJECT LIST, Static function declarations, Includes
//@subsection STATIC OBJECT LIST
*/
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);
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
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)
caf = next;
}
}
+#endif
//@node Sanity code for CAF garbage collection, Lazy black holing, Reverting CAFs
//@subsection Sanity code for CAF garbage collection
/* -----------------------------------------------------------------------------
- * $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.
*
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;
}
/* -----------------------------------------------------------------------------
- * $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
*
nat xxx = 0; // tmp -- HWL
if (start == NULL) {
- p = bd->start;
+ if (bd != NULL) p = bd->start;
} else {
p = start;
}
/* ---------------------------------------------------------------------------
- * $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
*
break;
default:
- barf("doneThread: invalid thread return code");
+ barf("schedule: invalid thread return code %d", (int)ret);
}
#ifdef SMP
context_switch = 0;
interrupted = 0;
- enteredCAFs = END_CAF_LIST;
+ ecafList = END_ECAF_LIST;
+#ifdef INTERPRETER
+ clearECafTable();
+#endif
/* Install the SIGHUP handler */
#ifdef SMP
* 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)
{
/* -----------------------------------------------------------------------------
- * $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
*
void startTasks( void );
#endif
+
//@cindex awakenBlockedQueue
/* awakenBlockedQueue()
*
/* 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)
/* -----------------------------------------------------------------------------
- * $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
*
stat_exit(calcAllocated());
}
+
+/* -----------------------------------------------------------------------------
+ CAF management.
+ -------------------------------------------------------------------------- */
+
void
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.
-------------------------------------------------------------------------- */
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 {
/* -----------------------------------------------------------------------------
- * $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
*
#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);
projects / ghc-hetmet.git / commitdiff