rts/sm/Evac.c-inc

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