+++ /dev/null
-\section[SM-extensions]{Storage Manager Extensions}
-
-ToDo ADR: Maybe this should be split between SMcopying.lc and
-SMcompacting.lc?
-
-
-This is a collection of C functions use in implementing the stable
-pointer and foreign object extensions.
-
-The motivation for making this a separate file/section is twofold:
-
-1) It let's us focus on one thing.
-
-2) If we don't do this, there will be a huge amount of repetition
- between the various GC schemes --- a maintenance nightmare.
-
-The second is the major motivation.
-
-There are three main parts to this file:
-
-1) Code which is common to all GC schemes.
-
-2) Code for use in a compacting collector used in the 1-space, dual
- mode and for collecting old generations in generational collectors.
-
-3) Code for use in a copying collector used in the 2-space, dual mode
- and for collecting young generations in generational collectors.
-
-When debugging, it is incredibly helpful to trash part of the heap
-(say) once you're done with it.
-
-Remembering that @sm->hp@ points to the next word to be allocated, a
-typical use is
-
-\begin{pseudocode}
-#ifdef DEBUG
- TrashMem(sm->hp+1, sm->hplim);
-#endif
-\end{pseudocode}
-
-\begin{code}
-
-#if defined(GC1s)
-
-#define SCAN_REG_DUMP
-#include "SMinternal.h"
-REGDUMP(ScanRegDump);
-
-#else /* GC2s, GCdu, GCap, GCgn */
-
-#define SCAV_REG_MAP
-#include "SMinternal.h"
-REGDUMP(ScavRegDump);
-
-#endif
-#include "SMextn.h"
-
-#ifdef DEBUG
-
-void
-TrashMem(from, to)
- P_ from, to;
-{
-/* assertion overly strong - if free_mem == 0, sm->hp == sm->hplim */
-/* ASSERT( from <= to ); */
- if (RTSflags.GcFlags.trace)
- fprintf(stderr,"Trashing from 0x%lx to 0x%lx inclusive\n", (W_) from, (W_) to);
- while (from <= to) {
- *from++ = DEALLOCATED_TRASH;
- }
-}
-
-#endif /* DEBUG */
-\end{code}
-
-\begin{code}
-
-#if !defined(PAR) /* To end of the file */
-
-\end{code}
-
-\downsection
-\section[SM-extensions-common-code]{Code common to all GC schemes}
-
-\begin{code}
-EXTDATA(EmptySPTable_closure);
-
-void initExtensions( sm )
- smInfo *sm;
-{
- sm->ForeignObjList = NULL;
-#if defined(GCap) || defined(GCgn)
- sm->OldForeignObjList = NULL;
-#endif
-
- sm->StablePointerTable = (P_) EmptySPTable_closure;
-}
-
-\end{code}
-
-\begin{code}
-#if defined(DEBUG)
-\end{code}
-
-When a Foreign Object is released, there should be absolutely no
-references to it. To encourage and dangling references to show
-themselves, we'll trash its contents when we're done with it.
-
-\begin{code}
-#define TRASH_ForeignObj_CLOSURE( mptr ) Trash_ForeignObj_Closure(mptr)
-
-void
-Trash_ForeignObj_Closure(mptr)
- P_ mptr;
-{
- int i;
- for( i = 0; i < ForeignObj_SIZE + _FHS; i++ ) {
- mptr[ i ] = DEALLOCATED_TRASH;
- }
-}
-\end{code}
-
-Also, every time we fiddle with the ForeignObj list, we should check it
-still makes sense. This function returns @0@ if the list is sensible.
-
-(Would maintaining a separate Foreign Obj count allow better testing?)
-
-\begin{code}
-void
-Validate_ForeignObjList( ForeignObjList )
- P_ ForeignObjList;
-{
- P_ FOptr;
-
- for(FOptr = ForeignObjList;
- FOptr != NULL;
- FOptr = ForeignObj_CLOSURE_LINK(FOptr) ) {
- CHECK_ForeignObj_CLOSURE(FOptr);
- }
-}
-\end{code}
-
-\begin{code}
-#else /* !DEBUG */
-
-#define TRASH_ForeignObj_CLOSURE( mp ) /* nothing */
-
-#endif /* !DEBUG */
-\end{code}
-
-\begin{code}
-#ifdef DEBUG
-
-#define TRACE_ForeignObj(FOptr) Trace_ForeignObj( FOptr )
-#define TRACE_FOdies(FOptr) Trace_FOdies()
-#define TRACE_FOlives(FOptr) Trace_FOlives()
-#define TRACE_FOforwarded(FOptr, newAddress) Trace_FOforwarded( FOptr, newAddress )
-
-void
-Trace_ForeignObj( FOptr )
- P_ FOptr;
-{
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
- fprintf(stderr,"DEBUG: ForeignObj(%0x)=<%0x,%0x,%0x,%0x>\n", (W_) FOptr, (W_) FOptr[0], (W_) FOptr[1], (W_) FOptr[2], (W_) FOptr[3]);
- fprintf(stderr," Data = %0x, Finaliser = %0x, Next = %0x\n",
- (W_) ForeignObj_CLOSURE_DATA(FOptr),
- (W_) ForeignObj_CLOSURE_FINALISER(FOptr),
- (W_) ForeignObj_CLOSURE_LINK(FOptr) );
- }
-}
-
-void
-Trace_FOdies()
-{
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
- fprintf(stderr, " dying\n");
- }
-}
-
-void
-Trace_FOlives()
-{
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
- fprintf(stderr," lived to tell the tale\n");
- }
-}
-
-void
-Trace_FOforwarded( FOPtr, newAddress )
- P_ FOPtr, newAddress;
-{
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
- fprintf(stderr, " forwarded to %lx\n", (W_) newAddress);
- }
-}
-
-#else
-
-#define TRACE_ForeignObj(FOptr) /* nothing */
-#define TRACE_FOdies(FOptr) /* nothing */
-#define TRACE_FOlives(FOptr) /* nothing */
-#define TRACE_FOforwarded(FOptr, newAddress) /* nothing */
-
-#endif /* DEBUG */
-\end{code}
-
-
-\section[SM-extensions-compacting-code]{Compacting Collector Code}
-
-
-\begin{code}
-#if defined(_INFO_COMPACTING)
-
-/* Sweep up the dead ForeignObjs */
-
-/* Note that this has to happen before the linking phase trashes
- the stable pointer table so that the finaliser functions can
- safely call freeStablePointer.
-*/
-
-void
-sweepUpDeadForeignObjs( ForeignObjList, base, bits )
- P_ ForeignObjList;
- P_ base;
- BitWord *bits;
-{
- P_ FOptr, temp;
- I_ ForeignObj_deaths = 0;
- long _hp_word, bit_index, bit;
-
- /* At this point, the ForeignObjList is in an invalid state (since
- some info ptrs will have been mangled) so we can't validate
- it. ADR */
-
- DEBUG_STRING("Reporting Dead Foreign objects:");
- FOptr = ForeignObjList;
- while ( FOptr != NULL ) {
-
- TRACE_ForeignObj(FOptr);
-
- _hp_word = FOptr - base;
- bit_index = _hp_word / BITS_IN(BitWord);
- bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1));
- if ( !( bits[bit_index] & bit ) ) { /* dead */
-
- TRACE_FOdies( FOptr );
- if (ForeignObj_CLOSURE_FINALISER(FOptr) != NULL) {
- (*(void (*)(StgAddr))(ForeignObj_CLOSURE_FINALISER(FOptr)))((StgAddr)ForeignObj_CLOSURE_DATA(FOptr));
- ForeignObj_deaths++;
- }
-
- temp = FOptr;
- FOptr = ForeignObj_CLOSURE_LINK(FOptr);
- /* Now trash the closure to encourage bugs to show themselves */
- TRASH_ForeignObj_CLOSURE( temp );
-
- } else {
-
- TRACE_FOlives(FOptr);
- FOptr = ForeignObj_CLOSURE_LINK(FOptr);
- }
- }
-}
-
-#endif /* _INFO_COMPACTING */
-\end{code}
-
-\section[SM-extensions-copying-code]{Copying Collector Code}
-
-\begin{code}
-#if defined(_INFO_COPYING)
-
-/* ToDo: a possible optimisation would be to maintain a flag that
- told us whether the SPTable had been updated (with new
- pointers) and so needs to be GC'd. A simple way of doing this
- might be to generalise the MUTUPLE closures to MUGEN closures.
-*/
-void evacSPTable( sm )
-smInfo *sm;
-{
- DEBUG_STRING("Evacuate Stable Pointer Table:");
- {
- P_ evac = sm->StablePointerTable;
- sm->StablePointerTable = EVACUATE_CLOSURE(evac);
- }
-}
-
-
-
-/* First attempt at Foreign Obj hackery... Later versions might
- do something useful with the two counters. [ADR] */
-
-#if defined(DEBUG)
-#if defined(GCgn)
-
-EXTDATA_RO(Forward_Ref_New_info);
-EXTDATA_RO(Forward_Ref_Old_info);
-EXTDATA_RO(OldRoot_Forward_Ref_info);
-
-#else
-
-EXTDATA_RO(Forward_Ref_info);
-
-#endif
-#endif
-
-/*
- Call ForeignObj finalising routine on any dead FOs in oldFOList,
- add the remainder to new sticking the result into newFOList.
-*/
-void
-reportDeadForeignObjs(oldFOList, new, newFOList)
- P_ oldFOList;
- P_ new;
- P_ *newFOList;
-{
- P_ FOptr, temp;
- I_ FO_no = 0, FO_deaths = 0;
-
- /* At this point, the ForeignObjList is in an invalid state (since
- some info ptrs will have been mangled) so we can't validate
- it. ADR */
-
- DEBUG_STRING("Updating Foreign Objects List and reporting casualties:");
- FOptr = oldFOList;
- while ( FOptr != NULL ) {
- TRACE_ForeignObj(FOptr);
-
- if ((P_) INFO_PTR(FOptr) == ForeignObj_info ) {
- /* can't have been forwarded - must be dead */
-
- TRACE_FOdies(FOptr);
- if (ForeignObj_CLOSURE_FINALISER(FOptr) != NULL) {
- (*(void (*)(StgAddr))(ForeignObj_CLOSURE_FINALISER(FOptr)))((StgAddr)ForeignObj_CLOSURE_DATA(FOptr));
- FO_deaths++;
- }
-
- temp = FOptr;
- FOptr = ForeignObj_CLOSURE_LINK(FOptr);
-
- /* Now trash the closure to encourage bugs to show themselves */
- TRASH_ForeignObj_CLOSURE( temp );
- } else { /* Must have been forwarded - so it must be live */
-
- P_ newAddress = (P_) FORWARD_ADDRESS(FOptr);
-
-#if defined(GCgn)
- ASSERT( ( (P_) INFO_PTR(FOptr) == Forward_Ref_New_info ) ||
- ( (P_) INFO_PTR(FOptr) == Forward_Ref_Old_info ) ||
- ( (P_) INFO_PTR(FOptr) == OldRoot_Forward_Ref_info ) );
-#else
- ASSERT( (P_) INFO_PTR(FOptr) == Forward_Ref_info );
-#endif
-
- TRACE_FOforwarded( FOptr, newAddress );
- ForeignObj_CLOSURE_LINK(newAddress) = new;
- new = newAddress;
- FO_no++;
- FOptr = ForeignObj_CLOSURE_LINK(FOptr);
- }
- }
-
- VALIDATE_ForeignObjList( new );
- *newFOList = new;
-}
-#endif /* _INFO_COPYING */
-\end{code}
-
-@freeForeigns@ summarily calls the finaliser routines for
-all live foreign objects, done when closing down.
-(code is just a rip off of the above).
-
-\begin{code}
-#if defined(_INFO_COPYING)
-
-#if defined(DEBUG)
-# if defined(GCgn)
-
-EXTDATA_RO(Forward_Ref_New_info);
-EXTDATA_RO(Forward_Ref_Old_info);
-EXTDATA_RO(OldRoot_Forward_Ref_info);
-
-# else
-
-EXTDATA_RO(Forward_Ref_info);
-
-# endif
-#endif
-
-/*
- Call the ForeignObj finalising routine on all the live FOs,
- used when shutting down.
-*/
-int
-freeForeigns(foList)
- P_ foList;
-{
- P_ FOptr, temp;
- I_ FO_deaths = 0;
-
- /* At this point, exitSM() has been called, the ForeignObjList is in an invalid state (since
- some info ptrs will have been mangled) so we can't validate
- it. ADR */
-
- DEBUG_STRING("Freeing all live Foreign Objects:");
- FOptr = foList;
- while ( FOptr != NULL ) {
-
- /* I'm not convinced that the situation of having
- indirections linked into the FO list can ever occur,
- but chasing indirections doesn't hurt. */
- while(IS_INDIRECTION(INFO_PTR(FOptr))) {
- FOptr = (P_) IND_CLOSURE_PTR(FOptr);
- }
- if ((P_) INFO_PTR(FOptr) == ForeignObj_info ) {
- TRACE_ForeignObj(FOptr);
- TRACE_FOdies(FOptr);
- /* ForeignObjs can have a zapped-out finaliser field, in which
- case we'll just drop the object silently.
- */
- if (ForeignObj_CLOSURE_FINALISER(FOptr) != NULL) {
- (*(void (*)(StgAddr))(ForeignObj_CLOSURE_FINALISER(FOptr)))((StgAddr)ForeignObj_CLOSURE_DATA(FOptr));
- FO_deaths++;
- }
-
- temp = FOptr;
- FOptr = ForeignObj_CLOSURE_LINK(FOptr);
-
- /* Now trash the closure to encourage bugs to show themselves */
- TRASH_ForeignObj_CLOSURE( temp );
- } else {
- fprintf(stderr, "Warning: Foreign object list contained unexpected element, bailing out of FO cleanup.\n");
- return 1;
- }
- }
- return 0;
-}
-#endif /* _INFO_COPYING */
-\end{code}
-
-\upsection
-
-\begin{code}
-#endif /* !PAR */
-\end{code}
projects / ghc-hetmet.git / blobdiff