Refactoring and tidy up
[ghc-hetmet.git] / rts / sm / Evac.c
index 9577b2d..fdb5477 100644 (file)
@@ -18,6 +18,7 @@
 #include "Storage.h"
 #include "GC.h"
 #include "GCThread.h"
+#include "GCTDecl.h"
 #include "GCUtils.h"
 #include "Compact.h"
 #include "MarkStack.h"
@@ -51,7 +52,7 @@ STATIC_INLINE void evacuate_large(StgPtr p);
    -------------------------------------------------------------------------- */
 
 STATIC_INLINE StgPtr
-alloc_for_copy (nat size, generation *gen)
+alloc_for_copy (nat size, nat gen_no)
 {
     StgPtr to;
     gen_workspace *ws;
@@ -61,17 +62,16 @@ alloc_for_copy (nat size, generation *gen)
      * evacuate to an older generation, adjust it here (see comment
      * by evacuate()).
      */
-    if (gen < gct->evac_gen) {
+    if (gen_no < gct->evac_gen_no) {
        if (gct->eager_promotion) {
-           gen = gct->evac_gen;
+            gen_no = gct->evac_gen_no;
        } else {
            gct->failed_to_evac = rtsTrue;
        }
     }
     
-    ws = &gct->gens[gen->no];
-    // this compiles to a single mem access to gen->abs_no only
-    
+    ws = &gct->gens[gen_no];  // zero memory references here
+
     /* chain a new block onto the to-space for the destination gen if
      * necessary.
      */
@@ -91,12 +91,12 @@ alloc_for_copy (nat size, generation *gen)
 
 STATIC_INLINE GNUC_ATTR_HOT void
 copy_tag(StgClosure **p, const StgInfoTable *info, 
-         StgClosure *src, nat size, generation *gen, StgWord tag)
+         StgClosure *src, nat size, nat gen_no, StgWord tag)
 {
     StgPtr to, from;
     nat i;
 
-    to = alloc_for_copy(size,gen);
+    to = alloc_for_copy(size,gen_no);
     
     from = (StgPtr)src;
     to[0] = (W_)info;
@@ -133,12 +133,12 @@ copy_tag(StgClosure **p, const StgInfoTable *info,
 #if defined(PARALLEL_GC)
 STATIC_INLINE void
 copy_tag_nolock(StgClosure **p, const StgInfoTable *info, 
-         StgClosure *src, nat size, generation *gen, StgWord tag)
+         StgClosure *src, nat size, nat gen_no, StgWord tag)
 {
     StgPtr to, from;
     nat i;
 
-    to = alloc_for_copy(size,gen);
+    to = alloc_for_copy(size,gen_no);
 
     from = (StgPtr)src;
     to[0] = (W_)info;
@@ -170,7 +170,7 @@ copy_tag_nolock(StgClosure **p, const StgInfoTable *info,
  */
 static rtsBool
 copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, 
-         nat size_to_copy, generation *gen)
+         nat size_to_copy, nat gen_no)
 {
     StgPtr to, from;
     nat i;
@@ -194,7 +194,7 @@ spin:
     info = (W_)src->header.info;
 #endif
 
-    to = alloc_for_copy(size_to_reserve, gen);
+    to = alloc_for_copy(size_to_reserve, gen_no);
 
     from = (StgPtr)src;
     to[0] = info;
@@ -222,9 +222,9 @@ spin:
 /* Copy wrappers that don't tag the closure after copying */
 STATIC_INLINE GNUC_ATTR_HOT void
 copy(StgClosure **p, const StgInfoTable *info, 
-     StgClosure *src, nat size, generation *gen)
+     StgClosure *src, nat size, nat gen_no)
 {
-    copy_tag(p,info,src,size,gen,0);
+    copy_tag(p,info,src,size,gen_no,0);
 }
 
 /* -----------------------------------------------------------------------------
@@ -243,22 +243,24 @@ evacuate_large(StgPtr p)
 {
   bdescr *bd;
   generation *gen, *new_gen;
+  nat gen_no, new_gen_no;
   gen_workspace *ws;
     
   bd = Bdescr(p);
   gen = bd->gen;
-  ACQUIRE_SPIN_LOCK(&gen->sync_large_objects);
+  gen_no = bd->gen_no;
+  ACQUIRE_SPIN_LOCK(&gen->sync);
 
   // already evacuated? 
   if (bd->flags & BF_EVACUATED) { 
     /* Don't forget to set the gct->failed_to_evac flag if we didn't get
      * the desired destination (see comments in evacuate()).
      */
-    if (gen < gct->evac_gen) {
+    if (gen_no < gct->evac_gen_no) {
        gct->failed_to_evac = rtsTrue;
        TICK_GC_FAILED_PROMOTION();
     }
-    RELEASE_SPIN_LOCK(&gen->sync_large_objects);
+    RELEASE_SPIN_LOCK(&gen->sync);
     return;
   }
 
@@ -274,16 +276,18 @@ evacuate_large(StgPtr p)
   
   /* link it on to the evacuated large object list of the destination gen
    */
-  new_gen = bd->dest;
-  if (new_gen < gct->evac_gen) {
+  new_gen_no = bd->dest_no;
+
+  if (new_gen_no < gct->evac_gen_no) {
       if (gct->eager_promotion) {
-         new_gen = gct->evac_gen;
+          new_gen_no = gct->evac_gen_no;
       } else {
          gct->failed_to_evac = rtsTrue;
       }
   }
 
-  ws = &gct->gens[new_gen->no];
+  ws = &gct->gens[new_gen_no];
+  new_gen = &generations[new_gen_no];
 
   bd->flags |= BF_EVACUATED;
   initBdescr(bd, new_gen, new_gen->to);
@@ -294,16 +298,16 @@ evacuate_large(StgPtr p)
   // them straight on the scavenged_large_objects list.
   if (bd->flags & BF_PINNED) {
       ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS);
-      if (new_gen != gen) { ACQUIRE_SPIN_LOCK(&new_gen->sync_large_objects); }
+      if (new_gen != gen) { ACQUIRE_SPIN_LOCK(&new_gen->sync); }
       dbl_link_onto(bd, &new_gen->scavenged_large_objects);
       new_gen->n_scavenged_large_blocks += bd->blocks;
-      if (new_gen != gen) { RELEASE_SPIN_LOCK(&new_gen->sync_large_objects); }
+      if (new_gen != gen) { RELEASE_SPIN_LOCK(&new_gen->sync); }
   } else {
       bd->link = ws->todo_large_objects;
       ws->todo_large_objects = bd;
   }
 
-  RELEASE_SPIN_LOCK(&gen->sync_large_objects);
+  RELEASE_SPIN_LOCK(&gen->sync);
 }
 
 /* ----------------------------------------------------------------------------
@@ -352,7 +356,7 @@ REGPARM1 GNUC_ATTR_HOT void
 evacuate(StgClosure **p)
 {
   bdescr *bd = NULL;
-  generation *gen;
+  nat gen_no;
   StgClosure *q;
   const StgInfoTable *info;
   StgWord tag;
@@ -475,7 +479,7 @@ loop:
           // We aren't copying this object, so we have to check
           // whether it is already in the target generation.  (this is
           // the write barrier).
-         if (bd->gen < gct->evac_gen) {
+          if (bd->gen_no < gct->evac_gen_no) {
              gct->failed_to_evac = rtsTrue;
              TICK_GC_FAILED_PROMOTION();
          }
@@ -485,14 +489,7 @@ loop:
       /* evacuate large objects by re-linking them onto a different list.
        */
       if (bd->flags & BF_LARGE) {
-         info = get_itbl(q);
-         if (info->type == TSO && 
-             ((StgTSO *)q)->what_next == ThreadRelocated) {
-             q = (StgClosure *)((StgTSO *)q)->_link;
-              *p = q;
-             goto loop;
-         }
-         evacuate_large((P_)q);
+          evacuate_large((P_)q);
          return;
       }
       
@@ -506,7 +503,7 @@ loop:
       return;
   }
       
-  gen = bd->dest;
+  gen_no = bd->dest_no;
 
   info = q->header.info;
   if (IS_FORWARDING_PTR(info))
@@ -529,8 +526,8 @@ loop:
      */
       StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info);
       *p = TAG_CLOSURE(tag,e);
-      if (gen < gct->evac_gen) {  // optimisation 
-         if (Bdescr((P_)e)->gen < gct->evac_gen) {
+      if (gen_no < gct->evac_gen_no) {  // optimisation
+          if (Bdescr((P_)e)->gen_no < gct->evac_gen_no) {
              gct->failed_to_evac = rtsTrue;
              TICK_GC_FAILED_PROMOTION();
          }
@@ -547,7 +544,7 @@ loop:
   case MUT_VAR_DIRTY:
   case MVAR_CLEAN:
   case MVAR_DIRTY:
-      copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen);
+      copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no);
       return;
 
   // For ints and chars of low value, save space by replacing references to
@@ -559,7 +556,7 @@ loop:
   case CONSTR_0_1:
   {   
 #if defined(__PIC__) && defined(mingw32_HOST_OS) 
-      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen,tag);
+      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag);
 #else
       StgWord w = (StgWord)q->payload[0];
       if (info == Czh_con_info &&
@@ -576,7 +573,7 @@ loop:
                             );
       }
       else {
-          copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen,tag);
+          copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag);
       }
 #endif
       return;
@@ -585,12 +582,12 @@ loop:
   case FUN_0_1:
   case FUN_1_0:
   case CONSTR_1_0:
-      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen,tag);
+      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,gen_no,tag);
       return;
 
   case THUNK_1_0:
   case THUNK_0_1:
-      copy(p,info,q,sizeofW(StgThunk)+1,gen);
+      copy(p,info,q,sizeofW(StgThunk)+1,gen_no);
       return;
 
   case THUNK_1_1:
@@ -599,7 +596,7 @@ loop:
 #ifdef NO_PROMOTE_THUNKS
 #error bitrotted
 #endif
-    copy(p,info,q,sizeofW(StgThunk)+2,gen);
+    copy(p,info,q,sizeofW(StgThunk)+2,gen_no);
     return;
 
   case FUN_1_1:
@@ -607,22 +604,21 @@ loop:
   case FUN_0_2:
   case CONSTR_1_1:
   case CONSTR_2_0:
-      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen,tag);
+      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen_no,tag);
       return;
 
   case CONSTR_0_2:
-      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen,tag);
+      copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,gen_no,tag);
       return;
 
   case THUNK:
-      copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen);
+      copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no);
       return;
 
   case FUN:
   case IND_PERM:
-  case IND_OLDGEN_PERM:
   case CONSTR:
-      copy_tag_nolock(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen,tag);
+      copy_tag_nolock(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no,tag);
       return;
 
   case BLACKHOLE:
@@ -640,7 +636,7 @@ loop:
               || i == &stg_WHITEHOLE_info 
               || i == &stg_BLOCKING_QUEUE_CLEAN_info
               || i == &stg_BLOCKING_QUEUE_DIRTY_info) {
-              copy(p,info,q,sizeofW(StgInd),gen);
+              copy(p,info,q,sizeofW(StgInd),gen_no);
               return;
           }
           ASSERT(i != &stg_IND_info);
@@ -654,11 +650,11 @@ loop:
   case WEAK:
   case PRIM:
   case MUT_PRIM:
-      copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen);
+      copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),gen_no);
       return;
 
   case BCO:
-      copy(p,info,q,bco_sizeW((StgBCO *)q),gen);
+      copy(p,info,q,bco_sizeW((StgBCO *)q),gen_no);
       return;
 
   case THUNK_SELECTOR:
@@ -666,7 +662,6 @@ loop:
       return;
 
   case IND:
-  case IND_OLDGEN:
     // follow chains of indirections, don't evacuate them 
     q = ((StgInd*)q)->indirectee;
     *p = q;
@@ -677,6 +672,7 @@ loop:
   case RET_BIG:
   case RET_DYN:
   case UPDATE_FRAME:
+  case UNDERFLOW_FRAME:
   case STOP_FRAME:
   case CATCH_FRAME:
   case CATCH_STM_FRAME:
@@ -686,20 +682,20 @@ loop:
     barf("evacuate: stack frame at %p\n", q);
 
   case PAP:
-      copy(p,info,q,pap_sizeW((StgPAP*)q),gen);
+      copy(p,info,q,pap_sizeW((StgPAP*)q),gen_no);
       return;
 
   case AP:
-      copy(p,info,q,ap_sizeW((StgAP*)q),gen);
+      copy(p,info,q,ap_sizeW((StgAP*)q),gen_no);
       return;
 
   case AP_STACK:
-      copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),gen);
+      copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),gen_no);
       return;
 
   case ARR_WORDS:
       // just copy the block 
-      copy(p,info,q,arr_words_sizeW((StgArrWords *)q),gen);
+      copy(p,info,q,arr_words_sizeW((StgArrWords *)q),gen_no);
       return;
 
   case MUT_ARR_PTRS_CLEAN:
@@ -707,35 +703,31 @@ loop:
   case MUT_ARR_PTRS_FROZEN:
   case MUT_ARR_PTRS_FROZEN0:
       // just copy the block 
-      copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),gen);
+      copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),gen_no);
       return;
 
   case TSO:
-    {
-      StgTSO *tso = (StgTSO *)q;
+      copy(p,info,q,sizeofW(StgTSO),gen_no);
+      return;
 
-      /* Deal with redirected TSOs (a TSO that's had its stack enlarged).
-       */
-      if (tso->what_next == ThreadRelocated) {
-       q = (StgClosure *)tso->_link;
-       *p = q;
-       goto loop;
-      }
+  case STACK:
+    {
+      StgStack *stack = (StgStack *)q;
 
-      /* To evacuate a small TSO, we need to adjust the stack pointer
+      /* To evacuate a small STACK, we need to adjust the stack pointer
        */
       {
-         StgTSO *new_tso;
+          StgStack *new_stack;
          StgPtr r, s;
           rtsBool mine;
 
-         mine = copyPart(p,(StgClosure *)tso, tso_sizeW(tso), 
-                          sizeofW(StgTSO), gen);
+          mine = copyPart(p,(StgClosure *)stack, stack_sizeW(stack),
+                          sizeofW(StgStack), gen_no);
           if (mine) {
-              new_tso = (StgTSO *)*p;
-              move_TSO(tso, new_tso);
-              for (r = tso->sp, s = new_tso->sp;
-                   r < tso->stack+tso->stack_size;) {
+              new_stack = (StgStack *)*p;
+              move_STACK(stack, new_stack);
+              for (r = stack->sp, s = new_stack->sp;
+                   r < stack->stack + stack->stack_size;) {
                   *s++ = *r++;
               }
           }
@@ -744,7 +736,7 @@ loop:
     }
 
   case TREC_CHUNK:
-      copy(p,info,q,sizeofW(StgTRecChunk),gen);
+      copy(p,info,q,sizeofW(StgTRecChunk),gen_no);
       return;
 
   default:
@@ -848,7 +840,7 @@ selector_chain:
             unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p);
             *q = (StgClosure *)p;
             // shortcut, behave as for:  if (evac) evacuate(q);
-            if (evac && bd->gen < gct->evac_gen) {
+            if (evac && bd->gen_no < gct->evac_gen_no) {
                 gct->failed_to_evac = rtsTrue;
                 TICK_GC_FAILED_PROMOTION();
             }
@@ -954,7 +946,7 @@ selector_loop:
               // For the purposes of LDV profiling, we have destroyed
               // the original selector thunk, p.
               SET_INFO(p, (StgInfoTable *)info_ptr);
-              LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC((StgClosure *)p);
+              OVERWRITING_CLOSURE((StgClosure*)p);
               SET_INFO(p, &stg_WHITEHOLE_info);
 #endif
 
@@ -971,8 +963,6 @@ selector_loop:
                   switch (info->type) {
                   case IND:
                   case IND_PERM:
-                  case IND_OLDGEN:
-                  case IND_OLDGEN_PERM:
                   case IND_STATIC:
                       val = ((StgInd *)val)->indirectee;
                       goto val_loop;
@@ -1006,8 +996,6 @@ selector_loop:
 
       case IND:
       case IND_PERM:
-      case IND_OLDGEN:
-      case IND_OLDGEN_PERM:
       case IND_STATIC:
           // Again, we might need to untag a constructor.
           selectee = UNTAG_CLOSURE( ((StgInd *)selectee)->indirectee );
@@ -1091,7 +1079,7 @@ bale_out:
     // check whether it was updated in the meantime.
     *q = (StgClosure *)p;
     if (evac) {
-        copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest);
+        copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest_no);
     }
     unchain_thunk_selectors(prev_thunk_selector, *q);
     return;