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