Commit 9ff75d08 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-04-14 15:18:05 by sewardj]

Clean up the runtime heap before deleting modules (and, currently, after
every evaluation) so that the combined system can safely throw away
modules and info tables without creating dangling refs from the heap.
parent c5725b16
/* -----------------------------------------------------------------------------
* $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
/* -----------------------------------------------------------------------------
* $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
-------------------------------------------------------------------------- */
......
......@@ -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
}
......
......@@ -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
......
......@@ -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);
}
......
......@@ -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);
}
......
......@@ -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;
}
......
/* -----------------------------------------------------------------------------
* $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
......
/* -----------------------------------------------------------------------------
* $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;
}
......
/* -----------------------------------------------------------------------------
* $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;
}
......
/* ---------------------------------------------------------------------------
* $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)
{
......
/* -----------------------------------------------------------------------------
* $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)
......
/* -----------------------------------------------------------------------------
* $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 {
......
/* -----------------------------------------------------------------------------
* $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);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment