rts/sm/Evac.c-inc

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