+++ /dev/null
-****************************************************************************
-
-The files SMevac.lc and SMscav.lhc contain the basic routines required
-for two-space copying garbage collection.
-
-Two files are required as the evac routines are conventional call/return
-routines while the scavenge routines are continuation routines.
-
-This file SMscav.lhc contains the scavenging routines ...
-
-****************************************************************************
-
-
-All the routines are placed in the info tables of the appropriate closures.
-
-
-Evacuation code: _Evacuate_...
-
-USE: new = EVACUATE_CLOSURE(evac)
-
-Evacuates a closure of size S words. Note the size excludes the info
-and any other preceding fields (eg global address in Grip implementation)
-Returns the address of the closures new location via the Evac register.
-
- Calling Conventions:
- arg -- points to the closure
- ToHp -- points to the last allocated word in to-space
- Return Conventions:
- ret -- points to the new address of the closure
- ToHp -- points to the last allocated word in to-space
-
- Example: Cons cell requires _Evacuate_2
-
-Scavenging code: _Scavenge_S_N
-
- Retrieved using SCAV_CODE(infoptr)
-
-Scavenges a closure of size S words, with N pointers and returns.
-If more closures are required to be scavenged the code to
-scan the next closure can be called.
-
- Calling Conventions:
- Scav -- points to the current closure
- ToHp -- points to the last allocated word in to-space
-
- OldGen -- Points to end of old generation (Appels collector only)
-
- Return Conventions:
- Scav -- points to the next closure
- ToHp -- points to the (possibly new) location of the last allocated word
-
- Example: Cons cell requires _Scavenge_2_2
-
-
-The following registers are used by a two-space collection:
-
-Scav -- Points to the current closure being scavenged
- (PS paper = Hscav)
-
-ToHp -- Points to the last word allocated in two-space
- (PS paper = Hnext)
-
-A copying pass is started by:
- -- Setting ToHp to 1 before the start of to-space
- -- Evacuating the roots pointing into from-space
- -- root = EVACUATE_CLOSURE(root)
- -- Setting Scav to point to the first closure in to-space
- -- Execute while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
-
-When Done ToHp will point to the last word allocated in to-space
-
-
-\begin{code}
-/* The #define and #include come before the test because SMinternal.h
- will suck in includes/SMinterface whcih defines (or doesn't)
- _INFO_COPYING [ADR] */
-
-#define SCAV_REG_MAP
-#include "SMinternal.h"
-
-#if defined(_INFO_COPYING)
-
-RegisterTable ScavRegTable;
-
-/* Moves Scav to point at the info pointer of the next closure to Scavenge */
-#define NEXT_Scav(size) Scav += (size) + FIXED_HS
-
-/*
- When doing a new generation copy collection for Appel's collector
- only evacuate references that point to the new generation.
- OldGen must be set to point to the end of old space.
-*/
-
-#if defined(GCgn)
-
-#define DO_EVACUATE(closure, pos) \
- { P_ evac = (P_) *(((P_)(closure))+(pos)); \
- if (evac > OldGen) { \
- *(((P_)(closure))+(pos)) = (W_) EVACUATE_CLOSURE(evac); \
- }}
-
-#else
-#if defined(GCap)
-
-#define DO_EVACUATE(closure, pos) \
- { P_ evac = (P_) *(((P_)(closure))+(pos)); \
- if (evac > OldGen) { \
- *(((P_)(closure))+(pos)) = (W_) EVACUATE_CLOSURE(evac); \
- }}
-
-#else /* ! GCgn && ! GCap */
-
-#define DO_EVACUATE(closure, pos) \
- { P_ evac = (P_) *(((P_)(closure))+(pos)); \
- *(((P_)(closure))+(pos)) = (W_) EVACUATE_CLOSURE(evac); }
-
-#endif /* ! GCgn && ! GCap */
-#endif
-
-
-/* Evacuate nth pointer in SPEC closure (starting at 1) */
-#define SPEC_DO_EVACUATE(ptr) DO_EVACUATE(Scav, (SPEC_HS-1) + (ptr))
-#define STKO_DO_EVACUATE(ptr) DO_EVACUATE(Scav, (STKO_HS-1) + (ptr))
-
-
-/*** DEBUGGING MACROS ***/
-
-#if defined(DEBUG)
-
-#define DEBUG_SCAV(s,p) \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
- Scav, INFO_PTR(Scav), s, p)
-
-#define DEBUG_SCAV_GEN(s,p) \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, Gen info 0x%lx, size %ld, ptrs %ld\n", \
- Scav, INFO_PTR(Scav), s, p)
-
-#define DEBUG_SCAV_DYN \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, Dyn info 0x%lx, size %ld, ptrs %ld\n", \
- Scav, INFO_PTR(Scav), DYN_CLOSURE_SIZE(Scav), DYN_CLOSURE_NoPTRS(Scav))
-
-#define DEBUG_SCAV_TUPLE \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, Tuple info 0x%lx, size %ld, ptrs %ld\n", \
- Scav, INFO_PTR(Scav), TUPLE_CLOSURE_SIZE(Scav), TUPLE_CLOSURE_NoPTRS(Scav))
-
-#define DEBUG_SCAV_MUTUPLE \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, MuTuple info 0x%lx, size %ld, ptrs %ld\n", \
- Scav, INFO_PTR(Scav), MUTUPLE_CLOSURE_SIZE(Scav), MUTUPLE_CLOSURE_NoPTRS(Scav))
-
-#define DEBUG_SCAV_DATA \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, Data info 0x%lx, size %ld\n", \
- Scav, INFO_PTR(Scav), DATA_CLOSURE_SIZE(Scav))
-
-#define DEBUG_SCAV_BH(s) \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, BH info 0x%lx, size %ld\n", \
- Scav, INFO_PTR(Scav), s)
-
-#define DEBUG_SCAV_IND \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, IND info 0x%lx, size %ld\n", \
- Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav))
-
-#define DEBUG_SCAV_PERM_IND \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: 0x%lx, PI info 0x%lx, size %ld\n", \
- Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav))
-
-#define DEBUG_SCAV_OLDROOT(s) \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
- fprintf(stderr, "Scav: OLDROOT 0x%lx, info 0x%lx, size %ld\n", \
- Scav, INFO_PTR(Scav), s)
-
-#ifdef CONCURRENT
-#define DEBUG_SCAV_BQ \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
- fprintf(stderr, "Scav: 0x%lx, BQ info 0x%lx, size %ld, ptrs %ld\n", \
- Scav, INFO_PTR(Scav), BQ_CLOSURE_SIZE(Scav), BQ_CLOSURE_NoPTRS(Scav))
-
-#define DEBUG_SCAV_TSO \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
- fprintf(stderr, "Scav TSO: 0x%lx\n", \
- Scav)
-
-#define DEBUG_SCAV_STKO \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
- fprintf(stderr, "Scav StkO: 0x%lx\n", \
- Scav)
-
-# if defined(PAR) || defined(GRAN)
-# define DEBUG_SCAV_RBH(s,p) \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
- fprintf(stderr, "Scav RBH: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
- Scav, INFO_PTR(Scav), s, p)
-
-# define DEBUG_SCAV_BF \
- if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
- fprintf(stderr, "Scav: 0x%lx, BF info 0x%lx, size %ld, ptrs %ld\n", \
- Scav, INFO_PTR(Scav), BF_CLOSURE_SIZE(dummy), 0)
-# endif
-#endif
-
-#else
-
-#define DEBUG_SCAV(s,p)
-#define DEBUG_SCAV_GEN(s,p)
-#define DEBUG_SCAV_DYN
-#define DEBUG_SCAV_TUPLE
-#define DEBUG_SCAV_MUTUPLE
-#define DEBUG_SCAV_DATA
-#define DEBUG_SCAV_BH(s)
-#define DEBUG_SCAV_IND
-#define DEBUG_SCAV_PERM_IND
-#define DEBUG_SCAV_OLDROOT(s)
-
-#ifdef CONCURRENT
-# define DEBUG_SCAV_BQ
-# define DEBUG_SCAV_TSO
-# define DEBUG_SCAV_STKO
-# if defined(PAR) || defined(GRAN)
-# define DEBUG_SCAV_RBH(s,p)
-# define DEBUG_SCAV_BF
-# endif
-#endif
-
-#endif
-
-#define PROFILE_CLOSURE(closure,size) \
- HEAP_PROFILE_CLOSURE(closure,size)
-
-/*** SPECIALISED CODE ***/
-
-#ifdef TICKY_TICKY
-void
-_Scavenge_0_0(STG_NO_ARGS)
-{
- DEBUG_SCAV(0,0);
- PROFILE_CLOSURE(Scav,0);
- NEXT_Scav(0); /* because "size" is defined to be 0 (size SPEC_VHS == 0) */
- return;
-}
-#endif
-
-void
-_Scavenge_1_0(STG_NO_ARGS)
-{
- DEBUG_SCAV(1,0);
- PROFILE_CLOSURE(Scav,1);
- NEXT_Scav(1); /* because "size" is defined to be 1 (size SPEC_VHS == 0) */
- return;
-}
-void
-_Scavenge_1_1(STG_NO_ARGS)
-{
- DEBUG_SCAV(1,1);
- PROFILE_CLOSURE(Scav,1);
- SPEC_DO_EVACUATE(1);
- NEXT_Scav(1);
- return;
-}
-void
-_Scavenge_2_0(STG_NO_ARGS)
-{
- DEBUG_SCAV(2,0);
- PROFILE_CLOSURE(Scav,2);
- NEXT_Scav(2);
- return;
-}
-void
-_Scavenge_2_1(STG_NO_ARGS)
-{
- DEBUG_SCAV(2,1);
- PROFILE_CLOSURE(Scav,2);
- SPEC_DO_EVACUATE(1);
- NEXT_Scav(2);
- return;
-}
-void
-_Scavenge_2_2(STG_NO_ARGS)
-{
- DEBUG_SCAV(2,2);
- PROFILE_CLOSURE(Scav,2);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- NEXT_Scav(2);
- return;
-}
-void
-_Scavenge_3_0(STG_NO_ARGS)
-{
- DEBUG_SCAV(3,0);
- PROFILE_CLOSURE(Scav,3);
- NEXT_Scav(3);
- return;
-}
-void
-_Scavenge_3_1(STG_NO_ARGS)
-{
- DEBUG_SCAV(3,1);
- PROFILE_CLOSURE(Scav,3);
- SPEC_DO_EVACUATE(1);
- NEXT_Scav(3);
- return;
-}
-void
-_Scavenge_3_2(STG_NO_ARGS)
-{
- DEBUG_SCAV(3,2);
- PROFILE_CLOSURE(Scav,3);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- NEXT_Scav(3);
- return;
-}
-void
-_Scavenge_3_3(STG_NO_ARGS)
-{
- DEBUG_SCAV(3,3);
- PROFILE_CLOSURE(Scav,3);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- NEXT_Scav(3);
- return;
-}
-void
-_Scavenge_4_0(STG_NO_ARGS)
-{
- DEBUG_SCAV(4,0);
- PROFILE_CLOSURE(Scav,4);
- NEXT_Scav(4);
- return;
-}
-void
-_Scavenge_4_4(STG_NO_ARGS)
-{
- DEBUG_SCAV(4,4);
- PROFILE_CLOSURE(Scav,4);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- NEXT_Scav(4);
- return;
-}
-void
-_Scavenge_5_0(STG_NO_ARGS)
-{
- DEBUG_SCAV(5,0);
- PROFILE_CLOSURE(Scav,5);
- NEXT_Scav(5);
- return;
-}
-void
-_Scavenge_5_5(STG_NO_ARGS)
-{
- DEBUG_SCAV(5,5);
- PROFILE_CLOSURE(Scav,5);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- SPEC_DO_EVACUATE(5);
- NEXT_Scav(5);
- return;
-}
-void
-_Scavenge_6_6(STG_NO_ARGS)
-{
- DEBUG_SCAV(6,6);
- PROFILE_CLOSURE(Scav,6);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- SPEC_DO_EVACUATE(5);
- SPEC_DO_EVACUATE(6);
- NEXT_Scav(6);
- return;
-}
-void
-_Scavenge_7_7(STG_NO_ARGS)
-{
- DEBUG_SCAV(7,7);
- PROFILE_CLOSURE(Scav,7);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- SPEC_DO_EVACUATE(5);
- SPEC_DO_EVACUATE(6);
- SPEC_DO_EVACUATE(7);
- NEXT_Scav(7);
- return;
-}
-void
-_Scavenge_8_8(STG_NO_ARGS)
-{
- DEBUG_SCAV(8,8);
- PROFILE_CLOSURE(Scav,8);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- SPEC_DO_EVACUATE(5);
- SPEC_DO_EVACUATE(6);
- SPEC_DO_EVACUATE(7);
- SPEC_DO_EVACUATE(8);
- NEXT_Scav(8);
- return;
-}
-void
-_Scavenge_9_9(STG_NO_ARGS)
-{
- DEBUG_SCAV(9,9);
- PROFILE_CLOSURE(Scav,9);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- SPEC_DO_EVACUATE(5);
- SPEC_DO_EVACUATE(6);
- SPEC_DO_EVACUATE(7);
- SPEC_DO_EVACUATE(8);
- SPEC_DO_EVACUATE(9);
- NEXT_Scav(9);
- return;
-}
-void
-_Scavenge_10_10(STG_NO_ARGS)
-{
- DEBUG_SCAV(10,10);
- PROFILE_CLOSURE(Scav,10);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- SPEC_DO_EVACUATE(5);
- SPEC_DO_EVACUATE(6);
- SPEC_DO_EVACUATE(7);
- SPEC_DO_EVACUATE(8);
- SPEC_DO_EVACUATE(9);
- SPEC_DO_EVACUATE(10);
- NEXT_Scav(10);
- return;
-}
-void
-_Scavenge_11_11(STG_NO_ARGS)
-{
- DEBUG_SCAV(11,11);
- PROFILE_CLOSURE(Scav,11);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- SPEC_DO_EVACUATE(5);
- SPEC_DO_EVACUATE(6);
- SPEC_DO_EVACUATE(7);
- SPEC_DO_EVACUATE(8);
- SPEC_DO_EVACUATE(9);
- SPEC_DO_EVACUATE(10);
- SPEC_DO_EVACUATE(11);
- NEXT_Scav(11);
- return;
-}
-void
-_Scavenge_12_12(STG_NO_ARGS)
-{
- DEBUG_SCAV(12,12);
- PROFILE_CLOSURE(Scav,12);
- SPEC_DO_EVACUATE(1);
- SPEC_DO_EVACUATE(2);
- SPEC_DO_EVACUATE(3);
- SPEC_DO_EVACUATE(4);
- SPEC_DO_EVACUATE(5);
- SPEC_DO_EVACUATE(6);
- SPEC_DO_EVACUATE(7);
- SPEC_DO_EVACUATE(8);
- SPEC_DO_EVACUATE(9);
- SPEC_DO_EVACUATE(10);
- SPEC_DO_EVACUATE(11);
- SPEC_DO_EVACUATE(12);
- NEXT_Scav(12);
- return;
-}
-\end{code}
-
-The scavenge routines for revertible black holes with underlying @SPEC@
-closures.
-
-\begin{code}
-
-#if defined(PAR) || defined(GRAN)
-
-# if defined(GCgn)
-
-# define SCAVENGE_SPEC_RBH_N_1(n) \
-void \
-CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS) \
-{ \
- I_ size = n + SPEC_RBH_VHS; \
- P_ save_Scav; \
- DEBUG_SCAV_RBH(size,1); \
- save_Scav = Scav; \
- Scav = OldGen + 1; \
- DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN); \
- Scav = save_Scav; \
- PROFILE_CLOSURE(Scav,size); \
- NEXT_Scav(size); \
-}
-
-# define SCAVENGE_SPEC_RBH_N_N(n) \
-void \
-CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
-{ \
- I_ size = n + SPEC_RBH_VHS; \
- int i; \
- P_ save_Scav; \
- DEBUG_SCAV_RBH(size,size-1); \
- save_Scav = Scav; \
- Scav = OldGen + 1; \
- for(i = 0; i < n - 1; i++) { \
- DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN + i); \
- } \
- Scav = save_Scav; \
- PROFILE_CLOSURE(Scav,size); \
- NEXT_Scav(size); \
-}
-
-# else
-
-# define SCAVENGE_SPEC_RBH_N_1(n) \
-void \
-CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS) \
-{ \
- I_ size = n + SPEC_RBH_VHS; \
- DEBUG_SCAV_RBH(size,1); \
- DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN);\
- PROFILE_CLOSURE(Scav,size); \
- NEXT_Scav(size); \
-}
-
-# define SCAVENGE_SPEC_RBH_N_N(n) \
-void \
-CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
-{ \
- I_ size = n + SPEC_RBH_VHS; \
- int i; \
- DEBUG_SCAV_RBH(size,size-1); \
- for(i = 0; i < n - 1; i++) { \
- DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN + i); \
- } \
- PROFILE_CLOSURE(Scav,size); \
- NEXT_Scav(size); \
-}
-
-# endif
-
-SCAVENGE_SPEC_RBH_N_1(2)
-
-SCAVENGE_SPEC_RBH_N_1(3)
-SCAVENGE_SPEC_RBH_N_N(3)
-
-SCAVENGE_SPEC_RBH_N_1(4)
-SCAVENGE_SPEC_RBH_N_N(4)
-
-SCAVENGE_SPEC_RBH_N_1(5)
-SCAVENGE_SPEC_RBH_N_N(5)
-
-SCAVENGE_SPEC_RBH_N_N(6)
-SCAVENGE_SPEC_RBH_N_N(7)
-SCAVENGE_SPEC_RBH_N_N(8)
-SCAVENGE_SPEC_RBH_N_N(9)
-SCAVENGE_SPEC_RBH_N_N(10)
-SCAVENGE_SPEC_RBH_N_N(11)
-SCAVENGE_SPEC_RBH_N_N(12)
-
-#endif
-
-\end{code}
-
-\begin{code}
-
-#ifndef PAR
-/*** Foreign Object -- NOTHING TO SCAVENGE ***/
-
-/* (The ForeignObjList is updated at the end of GC and any unevacuated
- ForeignObjs are finalised) [ADR][SOF]
-*/
-
-void
-_Scavenge_ForeignObj(STG_NO_ARGS)
-{
- I_ size = ForeignObj_SIZE;
- DEBUG_SCAV(size,0);
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-#endif /* !PAR */
-
-/*** GENERAL CASE CODE ***/
-
-void
-_Scavenge_S_N(STG_NO_ARGS)
-{
- I_ count = GEN_HS - 1;
- /* Offset of first ptr word, less 1 */
- I_ ptrs = count + GEN_CLOSURE_NoPTRS(Scav);
- /* Offset of last ptr word */
- I_ size = GEN_CLOSURE_SIZE(Scav);
-
- DEBUG_SCAV_GEN(size, GEN_CLOSURE_NoPTRS(Scav));
-
- while (++count <= ptrs) {
- DO_EVACUATE(Scav, count);
- }
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-\end{code}
-
-The scavenge code for revertible black holes with underlying @GEN@ closures
-
-\begin{code}
-
-#if defined(PAR) || defined(GRAN)
-
-void
-_Scavenge_RBH_N(STG_NO_ARGS)
-{
-#if defined(GCgn)
- P_ save_Scav;
-#endif
-
- I_ count = GEN_RBH_HS - 1; /* Offset of first ptr word, less 1 */
- I_ ptrs = GEN_RBH_CLOSURE_NoPTRS(Scav);
- I_ size = GEN_RBH_CLOSURE_SIZE(Scav);
-
- /*
- * Get pointer count from original closure and adjust for one pointer
- * in the first two words of the RBH.
- */
- if (ptrs < 2)
- ptrs = 1;
- else
- ptrs--;
-
- ptrs += count; /* Offset of last ptr word */
-
- DEBUG_SCAV_GEN(size, ptrs);
-
-#if defined(GCgn)
- /* No old generation roots should be created for mutable */
- /* pointer fields as they will be explicitly collected */
- /* Ensure this by pointing Scav at the new generation */
- save_Scav = Scav;
- Scav = OldGen + 1;
-
- while (++count <= ptrs) {
- DO_EVACUATE(save_Scav, count);
- }
- Scav = save_Scav;
-#else
- while (++count <= ptrs) {
- DO_EVACUATE(Scav, count);
- }
-#endif
-
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-#endif
-
-\end{code}
-
-\begin{code}
-
-/*** DYNAMIC CLOSURE -- SIZE & PTRS STORED IN CLOSURE ***/
-
-void
-_Scavenge_Dyn(STG_NO_ARGS)
-{
- I_ count = DYN_HS - 1;
- /* Offset of first ptr word, less 1 */
- I_ ptrs = count + DYN_CLOSURE_NoPTRS(Scav);
- /* Offset of last ptr word */
- I_ size = DYN_CLOSURE_SIZE(Scav);
-
- DEBUG_SCAV_DYN;
- while (++count <= ptrs) {
- DO_EVACUATE(Scav, count);
- }
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-/*** TUPLE CLOSURE -- NO PTRS STORED IN CLOSURE -- NO DATA ***/
-
-void
-_Scavenge_Tuple(STG_NO_ARGS)
-{
- I_ count = TUPLE_HS - 1;
- /* Offset of first ptr word, less 1 */
- I_ ptrs = count + TUPLE_CLOSURE_NoPTRS(Scav);
- /* Offset of last ptr word */
- I_ size = TUPLE_CLOSURE_SIZE(Scav);
-
- DEBUG_SCAV_TUPLE;
- while (++count <= ptrs) {
- DO_EVACUATE(Scav, count);
- }
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-/*** DATA CLOSURE -- SIZE STORED IN CLOSURE -- NO POINTERS ***/
-
-void
-_Scavenge_Data(STG_NO_ARGS)
-{
- I_ size = DATA_CLOSURE_SIZE(Scav);
-
- DEBUG_SCAV_DATA;
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-/*** MUTUPLE CLOSURE -- ONLY PTRS STORED IN CLOSURE -- NO DATA ***/
-/* Only if special GC treatment required */
-
-#ifdef GC_MUT_REQUIRED
-void
-_Scavenge_MuTuple(STG_NO_ARGS)
-{
-#if defined(GCgn)
- P_ save_Scav;
-#endif
- I_ count = MUTUPLE_HS - 1;
- /* Offset of first ptr word, less 1 */
- I_ ptrs = count + MUTUPLE_CLOSURE_NoPTRS(Scav);
- /* Offset of last ptr word */
- I_ size = MUTUPLE_CLOSURE_SIZE(Scav);
-
- DEBUG_SCAV_MUTUPLE;
-
-#if defined(GCgn)
- /* No old generation roots should be created for mutable */
- /* pointer fields as they will be explicitly collected */
- /* Ensure this by pointing Scav at the new generation */
- save_Scav = Scav;
- Scav = OldGen + 1;
- while (++count <= ptrs) {
- DO_EVACUATE(save_Scav, count);
- }
- Scav = save_Scav;
-#else /* GCap */
- while (++count <= ptrs) {
- DO_EVACUATE(Scav, count);
- }
-#endif /* GCap */
-
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-#endif /* something generational */
-
-/*** BH CLOSURES -- NO POINTERS ***/
-
-void
-_Scavenge_BH_U(STG_NO_ARGS)
-{
- I_ size = BH_U_SIZE;
- DEBUG_SCAV_BH(size);
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-void
-_Scavenge_BH_N(STG_NO_ARGS)
-{
- I_ size = BH_N_SIZE;
- DEBUG_SCAV_BH(size);
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-/* This is needed for scavenging indirections that "hang around";
- e.g., because they are on the OldMutables list, or
- because we have "turned off" shorting-out of indirections
- (in SMevac.lc).
-*/
-void
-_Scavenge_Ind(STG_NO_ARGS)
-{
- I_ size = IND_CLOSURE_SIZE(dummy);
- DEBUG_SCAV_IND;
- PROFILE_CLOSURE(Scav,size);
- DO_EVACUATE(Scav, IND_HS);
- NEXT_Scav(size);
- return;
-}
-
-void
-_Scavenge_Caf(STG_NO_ARGS)
-{
- I_ size = IND_CLOSURE_SIZE(dummy);
- DEBUG_SCAV_IND;
- PROFILE_CLOSURE(Scav,size);
- DO_EVACUATE(Scav, IND_HS);
- NEXT_Scav(size);
- return;
-}
-
-#if defined(PROFILING) || defined(TICKY_TICKY)
-
-/* Special permanent indirection for lexical scoping.
- As for _Scavenge_Ind but no PROFILE_CLOSURE.
-*/
-
-void
-_Scavenge_PI(STG_NO_ARGS)
-{
- I_ size = IND_CLOSURE_SIZE(dummy);
- DEBUG_SCAV_PERM_IND;
- /* PROFILE_CLOSURE(Scav,size); */
- DO_EVACUATE(Scav, IND_HS);
- NEXT_Scav(size);
- return;
-}
-#endif /* PROFILING or TICKY */
-
-#ifdef CONCURRENT
-
-void
-_Scavenge_BQ(STG_NO_ARGS)
-{
- I_ size = BQ_CLOSURE_SIZE(dummy);
-#if defined(GCgn)
- P_ save_Scav;
-#endif
-
- DEBUG_SCAV_BQ;
-
-#if defined(GCgn)
- /* No old generation roots should be created for mutable */
- /* pointer fields as they will be explicitly collected */
- /* Ensure this by pointing Scav at the new generation */
- save_Scav = Scav;
- Scav = OldGen + 1;
- DO_EVACUATE(save_Scav, BQ_HS);
- Scav = save_Scav;
-#else /* !GCgn */
- DO_EVACUATE(Scav, BQ_HS);
-#endif /* GCgn */
-
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-void
-_Scavenge_TSO(STG_NO_ARGS)
-{
- I_ size = TSO_VHS + TSO_CTS_SIZE;
-#if defined(GCgn)
- P_ save_Scav;
-#endif
- STGRegisterTable *r = TSO_INTERNAL_PTR(Scav);
- W_ liveness = r->rLiveness;
- I_ i;
-
- DEBUG_SCAV_TSO;
-
-#if defined(GCgn)
- /* old and probably wrong -- deleted (WDP 95/12) */
-#else
- DO_EVACUATE(Scav, TSO_LINK_LOCN);
-
- DO_EVACUATE(Scav, ((P_) &r->rStkO) - Scav);
-
- for (i = 0; liveness != 0; liveness >>= 1, i++) {
- if (liveness & 1) {
- DO_EVACUATE(Scav, ((P_) &r->rR[i].p) - Scav)
- }
- }
-#endif
-
- PROFILE_CLOSURE(Scav, size);
- NEXT_Scav(size);
- return;
-}
-
-int /* ToDo: move? */
-sanityChk_StkO(P_ stko)
-{
- I_ size = STKO_CLOSURE_SIZE(stko);
- I_ cts_size = STKO_CLOSURE_CTS_SIZE(stko);
- I_ count;
- I_ sub = STKO_SuB_OFFSET(stko); /* Offset of first update frame in B stack */
- I_ prev_sub;
- P_ begin_stko = STKO_CLOSURE_ADDR(stko, 0);
- P_ beyond_stko = STKO_CLOSURE_ADDR(stko, cts_size+1);
-
- /*fprintf(stderr, "stko=%lx; SpA offset=%ld; first SuB=%ld, size=%ld; next=%lx\n",stko,STKO_SpA_OFFSET(stko),sub,STKO_CLOSURE_CTS_SIZE(stko),STKO_LINK(stko));*/
-
- /* Evacuate the locations in the A stack */
- for (count = STKO_SpA_OFFSET(stko); count <= cts_size; count++) {
- ASSERT(count >= 0);
- }
-
- while(sub > 0) {
- P_ subptr;
- PP_ suaptr;
- P_ updptr;
- P_ retptr;
-
- ASSERT(sub >= 1);
- ASSERT(sub <= cts_size);
-
- retptr = GRAB_RET(STKO_CLOSURE_ADDR(stko,sub));
- subptr = GRAB_SuB(STKO_CLOSURE_ADDR(stko,sub));
- suaptr = GRAB_SuA(STKO_CLOSURE_ADDR(stko,sub));
- updptr = GRAB_UPDATEE(STKO_CLOSURE_ADDR(stko,sub));
-
- ASSERT(subptr >= begin_stko);
- ASSERT(subptr < beyond_stko);
-
- ASSERT(suaptr >= begin_stko);
- ASSERT(suaptr <= beyond_stko);
-
- /* ToDo: would be nice to chk that retptr is in text space */
-
- sub = STKO_CLOSURE_OFFSET(stko, subptr);
- }
-
- return 1;
-}
-
-void
-_Scavenge_StkO(STG_NO_ARGS)
-{
- I_ size = STKO_CLOSURE_SIZE(Scav);
-#if defined(GCgn)
- P_ save_Scav;
-#endif
- I_ count;
- I_ sub = STKO_SuB_OFFSET(Scav); /* Offset of first update frame in B stack */
-
- DEBUG_SCAV_STKO;
-
-#if defined(GCgn)
- /* deleted; probably wrong */
-#else
- ASSERT(sanityChk_StkO(Scav));
-
- /* Evacuate the link */
- DO_EVACUATE(Scav, STKO_LINK_LOCN);
-
- /* Evacuate the locations in the A stack */
- for (count = STKO_SpA_OFFSET(Scav); count <= STKO_CLOSURE_CTS_SIZE(Scav); count++) {
- STKO_DO_EVACUATE(count);
- }
-
- /* Now evacuate the updatees in the update stack */
- while(sub > 0) {
- P_ subptr;
-
- STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE));
- subptr = GRAB_SuB(STKO_CLOSURE_ADDR(Scav,sub));
-
- sub = STKO_CLOSURE_OFFSET(Scav, subptr);
- }
-
-#endif
- PROFILE_CLOSURE(Scav, size);
- NEXT_Scav(size);
- return;
-}
-
-#ifdef PAR
-
-void
-_Scavenge_FetchMe(STG_NO_ARGS)
-{
- I_ size = FETCHME_CLOSURE_SIZE(dummy);
- DEBUG_SCAV(size,0);
- PROFILE_CLOSURE(Scav,size);
- NEXT_Scav(size);
- return;
-}
-
-void
-_Scavenge_BF(STG_NO_ARGS)
-{
- I_ size = BF_CLOSURE_SIZE(dummy);
-#if defined(GCgn)
- P_ save_Scav;
-#endif
-
- DEBUG_SCAV_BF;
-
-#if defined(GCgn)
- /* No old generation roots should be created for mutable */
- /* pointer fields as they will be explicitly collected */
- /* Ensure this by pointing Scav at the new generation */
- save_Scav = Scav;
- Scav = OldGen + 1;
-
- DO_EVACUATE(save_Scav, BF_LINK_LOCN);
- DO_EVACUATE(save_Scav, BF_NODE_LOCN);
- Scav = save_Scav;
-#else
- DO_EVACUATE(Scav, BF_LINK_LOCN);
- DO_EVACUATE(Scav, BF_NODE_LOCN);
-#endif
-
- PROFILE_CLOSURE(Scav, size);
- NEXT_Scav(size);
- return;
-}
-
-#endif /* PAR */
-#endif /* CONCURRENT */
-
-#if defined(GCgn)
-
-/* Recently allocated old roots for promoted objects refernecing
- the new generation will be scavenged -- Just move to the next
-*/
-
-void
-_Scavenge_OldRoot(STG_NO_ARGS)
-{
- I_ size = ?????
- DEBUG_SCAV_OLDROOT(size);
- NEXT_Scav(size);
- return;
-}
-
-P_
-_Evacuate_OldRoot(evac)
-P_ evac;
-{
- fprintf(stderr,"Called _Evacuate_OldRoot: Closure %lx Info %lx\nShould never occur!\n",
- (W_) evac, (W_) INFO_PTR(evac));
- abort();
-}
-
-#endif /* GCgn */
-
-void
-_Scavenge_Forward_Ref(STG_NO_ARGS)
-{
- fprintf(stderr,"Called _Scavenge_Forward_Ref: Closure %lx Info %lx\nShould never occur!\n",
- (W_) Scav, (W_) INFO_PTR(Scav));
- abort();
-}
-
-
-#endif /* _INFO_COPYING */
-
-\end{code}
projects / ghc-hetmet.git / blobdiff