X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fruntime%2Fstorage%2FSMextn.lc;fp=ghc%2Fruntime%2Fstorage%2FSMextn.lc;h=0000000000000000000000000000000000000000;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=40c0bf866938f18134512cea990fbd7b00d7034a;hpb=967cc47f37cb93a5e2b6df7822c9a646f0428247;p=ghc-hetmet.git diff --git a/ghc/runtime/storage/SMextn.lc b/ghc/runtime/storage/SMextn.lc deleted file mode 100644 index 40c0bf8..0000000 --- a/ghc/runtime/storage/SMextn.lc +++ /dev/null @@ -1,445 +0,0 @@ -\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}