rts/sm/Evac.c-inc

   1 /* -----------------------------------------------------------------------*-c-*-
   2  *
   3  * (c) The GHC Team 1998-2008
   4  *
   5  * Generational garbage collector: evacuation functions
   6  *
   7  * ---------------------------------------------------------------------------*/
   8
   9 // We have two versions of evacuate(): one for minor GC, and one for
  10 // non-minor, parallel, GC.  This file contains the code for both,
  11 // controllled by the CPP symbol MINOR_GC.
  12
  13 #if defined(THREADED_RTS)
  14 #  if !defined(PARALLEL_GC)
  15 #    define copy(a,b,c,d,e) copy1(a,b,c,d,e)
  16 #    define copy_tag(a,b,c,d,e,f) copy_tag1(a,b,c,d,e,f)
  17 #    define copy_tag_nolock(a,b,c,d,e,f) copy_tag1(a,b,c,d,e,f)
  18 #    define copyPart(a,b,c,d,e) copyPart1(a,b,c,d,e)
  19 #    define evacuate(a) evacuate1(a)
  20 #  endif
  21 #else
  22 #  define copy_tag_nolock(a,b,c,d,e,f) copy_tag(a,b,c,d,e,f)
  23 #endif
  24
  25 STATIC_INLINE void
  26 copy_tag(StgClosure **p, const StgInfoTable *info,
  27          StgClosure *src, nat size, step *stp, StgWord tag)
  28 {
  29     StgPtr to, from;
  30     nat i;
  31
  32     to = alloc_for_copy(size,stp);
  33
  34     TICK_GC_WORDS_COPIED(size);
  35
  36     from = (StgPtr)src;
  37     to[0] = (W_)info;
  38     for (i = 1; i < size; i++) { // unroll for small i
  39         to[i] = from[i];
  40     }
  41
  42 //  if (to+size+2 < bd->start + BLOCK_SIZE_W) {
  43 //      __builtin_prefetch(to + size + 2, 1);
  44 //  }
  45
  46 #if defined(PARALLEL_GC)
  47     {
  48         const StgInfoTable *new_info;
  49         new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info, (W_)info, MK_FORWARDING_PTR(to));
  50         if (new_info != info) {
  51             return evacuate(p); // does the failed_to_evac stuff
  52         } else {
  53             *p = TAG_CLOSURE(tag,(StgClosure*)to);
  54         }
  55     }
  56 #else
  57     src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);
  58     *p = TAG_CLOSURE(tag,(StgClosure*)to);
  59 #endif
  60
  61 #ifdef PROFILING
  62     // We store the size of the just evacuated object in the LDV word so that
  63     // the profiler can guess the position of the next object later.
  64     SET_EVACUAEE_FOR_LDV(from, size);
  65 #endif
  66 }
  67
  68 #if defined(PARALLEL_GC)
  69 STATIC_INLINE void
  70 copy_tag_nolock(StgClosure **p, const StgInfoTable *info,
  71          StgClosure *src, nat size, step *stp, StgWord tag)
  72 {
  73     StgPtr to, from;
  74     nat i;
  75
  76     to = alloc_for_copy(size,stp);
  77     *p = TAG_CLOSURE(tag,(StgClosure*)to);
  78     src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);
  79
  80     TICK_GC_WORDS_COPIED(size);
  81
  82     from = (StgPtr)src;
  83     to[0] = (W_)info;
  84     for (i = 1; i < size; i++) { // unroll for small i
  85         to[i] = from[i];
  86     }
  87
  88 //  if (to+size+2 < bd->start + BLOCK_SIZE_W) {
  89 //      __builtin_prefetch(to + size + 2, 1);
  90 //  }
  91
  92 #ifdef PROFILING
  93     // We store the size of the just evacuated object in the LDV word so that
  94     // the profiler can guess the position of the next object later.
  95     SET_EVACUAEE_FOR_LDV(from, size);
  96 #endif
  97 }
  98 #endif
  99
 100 /* Special version of copy() for when we only want to copy the info
 101  * pointer of an object, but reserve some padding after it.  This is
 102  * used to optimise evacuation of BLACKHOLEs.
 103  */
 104 static void
 105 copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
 106 {
 107     StgPtr to, from;
 108     nat i;
 109     StgWord info;
 110
 111 #if defined(PARALLEL_GC)
 112 spin:
 113         info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
 114         if (info == (W_)&stg_WHITEHOLE_info) {
 115 #ifdef PROF_SPIN
 116             whitehole_spin++;
 117 #endif
 118             goto spin;
 119         }
 120     if (IS_FORWARDING_PTR(info)) {
 121         src->header.info = (const StgInfoTable *)info;
 122         evacuate(p); // does the failed_to_evac stuff
 123         return ;
 124     }
 125 #else
 126     info = (W_)src->header.info;
 127 #endif
 128
 129     to = alloc_for_copy(size_to_reserve, stp);
 130     *p = (StgClosure *)to;
 131
 132     TICK_GC_WORDS_COPIED(size_to_copy);
 133
 134     from = (StgPtr)src;
 135     to[0] = info;
 136     for (i = 1; i < size_to_copy; i++) { // unroll for small i
 137         to[i] = from[i];
 138     }
 139
 140 #if defined(PARALLEL_GC)
 141     write_barrier();
 142 #endif
 143     src->header.info = (const StgInfoTable*)MK_FORWARDING_PTR(to);
 144
 145 #ifdef PROFILING
 146     // We store the size of the just evacuated object in the LDV word so that
 147     // the profiler can guess the position of the next object later.
 148     SET_EVACUAEE_FOR_LDV(from, size_to_reserve);
 149     // fill the slop
 150     if (size_to_reserve - size_to_copy > 0)
 151         LDV_FILL_SLOP(to + size_to_copy - 1, (int)(size_to_reserve - size_to_copy));
 152 #endif
 153 }
 154
 155
 156 /* Copy wrappers that don't tag the closure after copying */
 157 STATIC_INLINE void
 158 copy(StgClosure **p, const StgInfoTable *info,
 159      StgClosure *src, nat size, step *stp)
 160 {
 161     copy_tag(p,info,src,size,stp,0);
 162 }
 163
 164 /* ----------------------------------------------------------------------------
 165    Evacuate
 166
 167    This is called (eventually) for every live object in the system.
 168
 169    The caller to evacuate specifies a desired generation in the
 170    gct->evac_step thread-local variable.  The following conditions apply to
 171    evacuating an object which resides in generation M when we're
 172    collecting up to generation N
 173
 174    if  M >= gct->evac_step
 175            if  M > N     do nothing
 176            else          evac to step->to
 177
 178    if  M < gct->evac_step      evac to gct->evac_step, step 0
 179
 180    if the object is already evacuated, then we check which generation
 181    it now resides in.
 182
 183    if  M >= gct->evac_step     do nothing
 184    if  M <  gct->evac_step     set gct->failed_to_evac flag to indicate that we
 185                          didn't manage to evacuate this object into gct->evac_step.
 186
 187
 188    OPTIMISATION NOTES:
 189
 190    evacuate() is the single most important function performance-wise
 191    in the GC.  Various things have been tried to speed it up, but as
 192    far as I can tell the code generated by gcc 3.2 with -O2 is about
 193    as good as it's going to get.  We pass the argument to evacuate()
 194    in a register using the 'regparm' attribute (see the prototype for
 195    evacuate() near the top of this file).
 196
 197    Changing evacuate() to take an (StgClosure **) rather than
 198    returning the new pointer seems attractive, because we can avoid
 199    writing back the pointer when it hasn't changed (eg. for a static
 200    object, or an object in a generation > N).  However, I tried it and
 201    it doesn't help.  One reason is that the (StgClosure **) pointer
 202    gets spilled to the stack inside evacuate(), resulting in far more
 203    extra reads/writes than we save.
 204    ------------------------------------------------------------------------- */
 205
 206 REGPARM1 void
 207 evacuate(StgClosure **p)
 208 {
 209   bdescr *bd = NULL;
 210   step *stp;
 211   StgClosure *q;
 212   const StgInfoTable *info;
 213   StgWord tag;
 214
 215   q = *p;
 216
 217 loop:
 218   /* The tag and the pointer are split, to be merged after evacing */
 219   tag = GET_CLOSURE_TAG(q);
 220   q = UNTAG_CLOSURE(q);
 221
 222   ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
 223
 224   if (!HEAP_ALLOCED(q)) {
 225
 226       if (!major_gc) return;
 227
 228       info = get_itbl(q);
 229       switch (info->type) {
 230
 231       case THUNK_STATIC:
 232           if (info->srt_bitmap != 0) {
 233               if (*THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
 234 #ifndef THREADED_RTS
 235                   *THUNK_STATIC_LINK((StgClosure *)q) = gct->static_objects;
 236                   gct->static_objects = (StgClosure *)q;
 237 #else
 238                   StgPtr link;
 239                   link = (StgPtr)cas((StgPtr)THUNK_STATIC_LINK((StgClosure *)q),
 240                                      (StgWord)NULL,
 241                                      (StgWord)gct->static_objects);
 242                   if (link == NULL) {
 243                       gct->static_objects = (StgClosure *)q;
 244                   }
 245 #endif
 246               }
 247           }
 248           return;
 249
 250       case FUN_STATIC:
 251           if (info->srt_bitmap != 0 &&
 252               *FUN_STATIC_LINK((StgClosure *)q) == NULL) {
 253 #ifndef THREADED_RTS
 254               *FUN_STATIC_LINK((StgClosure *)q) = gct->static_objects;
 255               gct->static_objects = (StgClosure *)q;
 256 #else
 257               StgPtr link;
 258               link = (StgPtr)cas((StgPtr)FUN_STATIC_LINK((StgClosure *)q),
 259                                  (StgWord)NULL,
 260                                  (StgWord)gct->static_objects);
 261               if (link == NULL) {
 262                   gct->static_objects = (StgClosure *)q;
 263               }
 264 #endif
 265           }
 266           return;
 267
 268       case IND_STATIC:
 269           /* If q->saved_info != NULL, then it's a revertible CAF - it'll be
 270            * on the CAF list, so don't do anything with it here (we'll
 271            * scavenge it later).
 272            */
 273           if (((StgIndStatic *)q)->saved_info == NULL) {
 274               if (*IND_STATIC_LINK((StgClosure *)q) == NULL) {
 275 #ifndef THREADED_RTS
 276                   *IND_STATIC_LINK((StgClosure *)q) = gct->static_objects;
 277                   gct->static_objects = (StgClosure *)q;
 278 #else
 279                   StgPtr link;
 280                   link = (StgPtr)cas((StgPtr)IND_STATIC_LINK((StgClosure *)q),
 281                                      (StgWord)NULL,
 282                                      (StgWord)gct->static_objects);
 283                   if (link == NULL) {
 284                       gct->static_objects = (StgClosure *)q;
 285                   }
 286 #endif
 287               }
 288           }
 289           return;
 290
 291       case CONSTR_STATIC:
 292           if (*STATIC_LINK(info,(StgClosure *)q) == NULL) {
 293 #ifndef THREADED_RTS
 294               *STATIC_LINK(info,(StgClosure *)q) = gct->static_objects;
 295               gct->static_objects = (StgClosure *)q;
 296 #else
 297               StgPtr link;
 298               link = (StgPtr)cas((StgPtr)STATIC_LINK(info,(StgClosure *)q),
 299                                  (StgWord)NULL,
 300                                  (StgWord)gct->static_objects);
 301               if (link == NULL) {
 302                   gct->static_objects = (StgClosure *)q;
 303               }
 304 #endif
 305           }
 306           /* I am assuming that static_objects pointers are not
 307            * written to other objects, and thus, no need to retag. */
 308           return;
 309
 310       case CONSTR_NOCAF_STATIC:
 311           /* no need to put these on the static linked list, they don't need
 312            * to be scavenged.
 313            */
 314           return;
 315
 316       default:
 317           barf("evacuate(static): strange closure type %d", (int)(info->type));
 318       }
 319   }
 320
 321   bd = Bdescr((P_)q);
 322
 323   if ((bd->flags & (BF_LARGE | BF_COMPACTED | BF_EVACUATED)) != 0) {
 324
 325       // pointer into to-space: just return it.  It might be a pointer
 326       // into a generation that we aren't collecting (> N), or it
 327       // might just be a pointer into to-space.  The latter doesn't
 328       // happen often, but allowing it makes certain things a bit
 329       // easier; e.g. scavenging an object is idempotent, so it's OK to
 330       // have an object on the mutable list multiple times.
 331       if (bd->flags & BF_EVACUATED) {
 332           // We aren't copying this object, so we have to check
 333           // whether it is already in the target generation.  (this is
 334           // the write barrier).
 335           if (bd->step < gct->evac_step) {
 336               gct->failed_to_evac = rtsTrue;
 337               TICK_GC_FAILED_PROMOTION();
 338           }
 339           return;
 340       }
 341
 342       /* evacuate large objects by re-linking them onto a different list.
 343        */
 344       if (bd->flags & BF_LARGE) {
 345           info = get_itbl(q);
 346           if (info->type == TSO &&
 347               ((StgTSO *)q)->what_next == ThreadRelocated) {
 348               q = (StgClosure *)((StgTSO *)q)->_link;
 349               *p = q;
 350               goto loop;
 351           }
 352           evacuate_large((P_)q);
 353           return;
 354       }
 355
 356       /* If the object is in a step that we're compacting, then we
 357        * need to use an alternative evacuate procedure.
 358        */
 359       if (bd->flags & BF_COMPACTED) {
 360           if (!is_marked((P_)q,bd)) {
 361               mark((P_)q,bd);
 362               if (mark_stack_full()) {
 363                   mark_stack_overflowed = rtsTrue;
 364                   reset_mark_stack();
 365               }
 366               push_mark_stack((P_)q);
 367           }
 368           return;
 369       }
 370   }
 371
 372   stp = bd->step->to;
 373
 374   info = q->header.info;
 375   if (IS_FORWARDING_PTR(info))
 376   {
 377     /* Already evacuated, just return the forwarding address.
 378      * HOWEVER: if the requested destination generation (gct->evac_step) is
 379      * older than the actual generation (because the object was
 380      * already evacuated to a younger generation) then we have to
 381      * set the gct->failed_to_evac flag to indicate that we couldn't
 382      * manage to promote the object to the desired generation.
 383      */
 384     /*
 385      * Optimisation: the check is fairly expensive, but we can often
 386      * shortcut it if either the required generation is 0, or the
 387      * current object (the EVACUATED) is in a high enough generation.
 388      * We know that an EVACUATED always points to an object in the
 389      * same or an older generation.  stp is the lowest step that the
 390      * current object would be evacuated to, so we only do the full
 391      * check if stp is too low.
 392      */
 393       StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info);
 394       *p = TAG_CLOSURE(tag,e);
 395       if (stp < gct->evac_step) {  // optimisation
 396           if (Bdescr((P_)e)->step < gct->evac_step) {
 397               gct->failed_to_evac = rtsTrue;
 398               TICK_GC_FAILED_PROMOTION();
 399           }
 400       }
 401       return;
 402   }
 403
 404   switch (INFO_PTR_TO_STRUCT(info)->type) {
 405
 406   case WHITEHOLE:
 407       goto loop;
 408
 409   case MUT_VAR_CLEAN:
 410   case MUT_VAR_DIRTY:
 411   case MVAR_CLEAN:
 412   case MVAR_DIRTY:
 413       copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp);
 414       return;
 415
 416   case CONSTR_0_1:
 417   {
 418       StgWord w = (StgWord)q->payload[0];
 419       if (info == Czh_con_info &&
 420           // unsigned, so always true:  (StgChar)w >= MIN_CHARLIKE &&
 421           (StgChar)w <= MAX_CHARLIKE) {
 422           *p =  TAG_CLOSURE(tag,
 423                             (StgClosure *)CHARLIKE_CLOSURE((StgChar)w)
 424                            );
 425       }
 426       else if (info == Izh_con_info &&
 427           (StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) {
 428           *p = TAG_CLOSURE(tag,
 429                              (StgClosure *)INTLIKE_CLOSURE((StgInt)w)
 430                              );
 431       }
 432       else {
 433           copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag);
 434       }
 435       return;
 436   }
 437
 438   case FUN_0_1:
 439   case FUN_1_0:
 440   case CONSTR_1_0:
 441       copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag);
 442       return;
 443
 444   case THUNK_1_0:
 445   case THUNK_0_1:
 446       copy(p,info,q,sizeofW(StgThunk)+1,stp);
 447       return;
 448
 449   case THUNK_1_1:
 450   case THUNK_2_0:
 451   case THUNK_0_2:
 452 #ifdef NO_PROMOTE_THUNKS
 453     if (bd->gen_no == 0 &&
 454         bd->step->no != 0 &&
 455         bd->step->no == generations[bd->gen_no].n_steps-1) {
 456       stp = bd->step;
 457     }
 458 #endif
 459     copy(p,info,q,sizeofW(StgThunk)+2,stp);
 460     return;
 461
 462   case FUN_1_1:
 463   case FUN_2_0:
 464   case FUN_0_2:
 465   case CONSTR_1_1:
 466   case CONSTR_2_0:
 467       copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag);
 468       return;
 469
 470   case CONSTR_0_2:
 471       copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag);
 472       return;
 473
 474   case THUNK:
 475       copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp);
 476       return;
 477
 478   case FUN:
 479   case IND_PERM:
 480   case IND_OLDGEN_PERM:
 481   case CONSTR:
 482       copy_tag_nolock(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag);
 483       return;
 484
 485   case WEAK:
 486   case STABLE_NAME:
 487       copy_tag(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag);
 488       return;
 489
 490   case BCO:
 491       copy(p,info,q,bco_sizeW((StgBCO *)q),stp);
 492       return;
 493
 494   case CAF_BLACKHOLE:
 495   case SE_CAF_BLACKHOLE:
 496   case SE_BLACKHOLE:
 497   case BLACKHOLE:
 498       copyPart(p,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp);
 499       return;
 500
 501   case THUNK_SELECTOR:
 502       eval_thunk_selector(p, (StgSelector *)q, rtsTrue);
 503       return;
 504
 505   case IND:
 506   case IND_OLDGEN:
 507     // follow chains of indirections, don't evacuate them
 508     q = ((StgInd*)q)->indirectee;
 509     *p = q;
 510     goto loop;
 511
 512   case RET_BCO:
 513   case RET_SMALL:
 514   case RET_BIG:
 515   case RET_DYN:
 516   case UPDATE_FRAME:
 517   case STOP_FRAME:
 518   case CATCH_FRAME:
 519   case CATCH_STM_FRAME:
 520   case CATCH_RETRY_FRAME:
 521   case ATOMICALLY_FRAME:
 522     // shouldn't see these
 523     barf("evacuate: stack frame at %p\n", q);
 524
 525   case PAP:
 526       copy(p,info,q,pap_sizeW((StgPAP*)q),stp);
 527       return;
 528
 529   case AP:
 530       copy(p,info,q,ap_sizeW((StgAP*)q),stp);
 531       return;
 532
 533   case AP_STACK:
 534       copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),stp);
 535       return;
 536
 537   case ARR_WORDS:
 538       // just copy the block
 539       copy(p,info,q,arr_words_sizeW((StgArrWords *)q),stp);
 540       return;
 541
 542   case MUT_ARR_PTRS_CLEAN:
 543   case MUT_ARR_PTRS_DIRTY:
 544   case MUT_ARR_PTRS_FROZEN:
 545   case MUT_ARR_PTRS_FROZEN0:
 546       // just copy the block
 547       copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp);
 548       return;
 549
 550   case TSO:
 551     {
 552       StgTSO *tso = (StgTSO *)q;
 553
 554       /* Deal with redirected TSOs (a TSO that's had its stack enlarged).
 555        */
 556       if (tso->what_next == ThreadRelocated) {
 557         q = (StgClosure *)tso->_link;
 558         *p = q;
 559         goto loop;
 560       }
 561
 562       /* To evacuate a small TSO, we need to relocate the update frame
 563        * list it contains.
 564        */
 565       {
 566           StgTSO *new_tso;
 567           StgPtr r, s;
 568
 569           copyPart(p,(StgClosure *)tso, tso_sizeW(tso), sizeofW(StgTSO), stp);
 570           new_tso = (StgTSO *)*p;
 571           move_TSO(tso, new_tso);
 572           for (r = tso->sp, s = new_tso->sp;
 573                r < tso->stack+tso->stack_size;) {
 574               *s++ = *r++;
 575           }
 576           return;
 577       }
 578     }
 579
 580   case TREC_HEADER:
 581       copy(p,info,q,sizeofW(StgTRecHeader),stp);
 582       return;
 583
 584   case TVAR_WATCH_QUEUE:
 585       copy(p,info,q,sizeofW(StgTVarWatchQueue),stp);
 586       return;
 587
 588   case TVAR:
 589       copy(p,info,q,sizeofW(StgTVar),stp);
 590       return;
 591
 592   case TREC_CHUNK:
 593       copy(p,info,q,sizeofW(StgTRecChunk),stp);
 594       return;
 595
 596   case ATOMIC_INVARIANT:
 597       copy(p,info,q,sizeofW(StgAtomicInvariant),stp);
 598       return;
 599
 600   case INVARIANT_CHECK_QUEUE:
 601       copy(p,info,q,sizeofW(StgInvariantCheckQueue),stp);
 602       return;
 603
 604   default:
 605     barf("evacuate: strange closure type %d", (int)(INFO_PTR_TO_STRUCT(info)->type));
 606   }
 607
 608   barf("evacuate");
 609 }
 610
 611 #undef copy
 612 #undef copy_tag
 613 #undef copy_tag_nolock
 614 #undef copyPart
 615 #undef evacuate