ghc/rts/LdvProfile.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: LdvProfile.c,v 1.1 2001/11/22 14:25:12 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 2001
   5  * Author: Sungwoo Park
   6  *
   7  * Lag/Drag/Void profiling.
   8  *
   9  * ---------------------------------------------------------------------------*/
  10
  11 #ifdef PROFILING
  12
  13 #include "Stg.h"
  14 #include "Rts.h"
  15 #include "LdvProfile.h"
  16 #include "RtsFlags.h"
  17 #include "Itimer.h"
  18 #include "Proftimer.h"
  19 #include "Profiling.h"
  20 #include "Stats.h"
  21 #include "Storage.h"
  22 #include "RtsUtils.h"
  23 #include "Schedule.h"
  24
  25 /*
  26   ldvTime stores the current LDV time, that is, the current era.  It
  27   is one larger than the number of times LDV profiling has been
  28   performed, i.e.,
  29   ldvTime - 1 == the number of time LDV profiling was executed
  30               == the number of censuses made so far.
  31   RESTRICTION:
  32     ldvTime must be no longer than LDV_SHIFT (15 or 30) bits.
  33   Invariants:
  34     LDV profiling is turned off if ldvTime is 0.
  35     LDV profiling is turned on if ldvTime is > 0.
  36     ldvTime is initialized to 1 in initLdvProfiling().
  37     If LDV profiling is not performed, ldvTime must remain 0 (e.g., when we
  38     are doing retainer profiling).
  39   ldvTime is set to 1 in initLdvProfiling().
  40   ldvTime is set back to 0 in shutdownHaskell().
  41   In the meanwhile, ldvTime increments.
  42 */
  43 nat ldvTime = 0;
  44 #
  45 // ldvTimeSave is set in LdvCensusKillAll(), and stores the final number of
  46 // times that LDV profiling was proformed.
  47 static nat ldvTimeSave;
  48
  49 // gi[] stores the statistics obtained at each heap census.
  50 // gi[0] is not used. See initLdvProfiling().
  51 LdvGenInfo *gi;
  52
  53 #define giINCREMENT   32      // allocation unit for gi[]
  54 static nat giLength;          // current length of gi[]
  55
  56 // giMax is initialized to 2^LDV_SHIFT in initLdvProfiling().
  57 // When ldvTime reaches giMax, the profiling stops because a closure can
  58 // store only up to (giMax - 1) as its creation or last use time.
  59 static nat giMax;
  60
  61 /* --------------------------------------------------------------------------
  62  * Fills in the slop when a *dynamic* closure changes its type.
  63  * First calls LDV_recordDead() to declare the closure is dead, and then
  64  * fills in the slop.
  65  *
  66  *  Invoked when:
  67  *    1) blackholing, UPD_BH_UPDATABLE() and UPD_BH_SINGLE_ENTRY (in
  68  *       includes/StgMacros.h), threadLazyBlackHole() and
  69  *       threadSqueezeStack() (in GC.c).
  70  *    2) updating with indirection closures, updateWithIndirection()
  71  *       and updateWithPermIndirection() (in Storage.h).
  72  *
  73  *  LDV_recordDead_FILL_SLOP_DYNAMIC() is not called on 'inherently used'
  74  *  closures such as TSO. It is not called on PAP because PAP is not updatable.
  75  *  ----------------------------------------------------------------------- */
  76 void
  77 LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
  78 {
  79     if (ldvTime > 0) {
  80         StgInfoTable *inf = get_itbl((p));
  81         nat nw, i;
  82         switch (inf->type) {
  83         case THUNK_1_0:
  84         case THUNK_0_1:
  85         case THUNK_2_0:
  86         case THUNK_1_1:
  87         case THUNK_0_2:
  88         case THUNK_SELECTOR:
  89             nw = MIN_UPD_SIZE;
  90             break;
  91         case THUNK:
  92             nw = inf->layout.payload.ptrs + inf->layout.payload.nptrs;
  93             if (nw < MIN_UPD_SIZE)
  94                 nw = MIN_UPD_SIZE;
  95             break;
  96         case AP_UPD:
  97             nw = sizeofW(StgPAP) - sizeofW(StgHeader) + ((StgPAP *)p)->n_args;
  98             break;
  99         case CAF_BLACKHOLE:
 100         case BLACKHOLE:
 101         case SE_BLACKHOLE:
 102         case SE_CAF_BLACKHOLE:
 103             nw = inf->layout.payload.ptrs + inf->layout.payload.nptrs;
 104             break;
 105         default:
 106             barf("Unexpected closure type %u in LDV_recordDead_FILL_SLOP_DYNAMIC()", inf->type);
 107             break;
 108         }
 109         LDV_recordDead((StgClosure *)(p), nw + sizeofW(StgHeader));
 110         for (i = 0; i < nw; i++) {
 111             ((StgClosure *)(p))->payload[i] = 0;
 112         }
 113     }
 114 }
 115
 116 /* --------------------------------------------------------------------------
 117  * Initialize gi[ldvTime].
 118  * ----------------------------------------------------------------------- */
 119 static inline void
 120 giInitForCurrentEra(void)
 121 {
 122     gi[ldvTime].notUsed = 0;
 123     gi[ldvTime].inherentlyUsed = 0;
 124     gi[ldvTime].used = 0;
 125
 126     gi[ldvTime].voidNew = 0;
 127     gi[ldvTime].dragNew = 0;
 128 }
 129
 130 /* --------------------------------------------------------------------------
 131  * Increases ldvTime by 1 and initialize gi[ldvTime].
 132  * Reallocates gi[] and increases its size if needed.
 133  * ----------------------------------------------------------------------- */
 134 static void
 135 incrementLdvTime( void )
 136 {
 137     ldvTime++;
 138
 139     if (ldvTime == giMax) {
 140         fprintf(stderr,
 141                 "Lag/Drag/Void profiling limit %u reached. "
 142                 "Please increase the profiling interval with -L option.\n",
 143                 giLength);
 144         barf("Current profiling interval = %f seconds",
 145              (float)RtsFlags.ProfFlags.profileInterval / 1000.0 );
 146     }
 147
 148     if (ldvTime % giINCREMENT == 0) {
 149         gi = stgReallocBytes(gi, sizeof(LdvGenInfo) * (giLength + giINCREMENT),
 150                              "incrementLdvTime");
 151         giLength += giINCREMENT;
 152     }
 153
 154     // What a stupid bug I struggled against for such a long time! I
 155     // placed giInitForCurrentEra() before the above rellocation part,
 156     // and it cost me three hours!
 157     giInitForCurrentEra();
 158 }
 159
 160 /* --------------------------------------------------------------------------
 161  * Initialization code for LDV profiling.
 162  * ----------------------------------------------------------------------- */
 163 void
 164 initLdvProfiling( void )
 165 {
 166     nat p;
 167
 168     gi = stgMallocBytes(sizeof(LdvGenInfo) * giINCREMENT, "initLdvProfiling");
 169     giLength = giINCREMENT;
 170
 171     ldvTime = 1;              // turn on LDV profiling.
 172     giInitForCurrentEra();
 173
 174     // giMax = 2^LDV_SHIFT
 175     giMax = 1;
 176     for (p = 0; p < LDV_SHIFT; p++)
 177         giMax *= 2;
 178 }
 179
 180 /* --------------------------------------------------------------------------
 181  * This function must be called before f-closing prof_file.
 182  * Still hp_file is open; see endHeapProfiling() in ProfHeap.c.
 183  * ----------------------------------------------------------------------- */
 184 void
 185 endLdvProfiling( void )
 186 {
 187     nat t;
 188     int sumVoidNew, sumDragNew;
 189
 190     // Now we compute voidTotal and dragTotal of each LdvGenInfo structure.
 191     sumVoidNew = 0;
 192     sumDragNew = 0;
 193     for (t = 0; t < ldvTimeSave; t++) {
 194         sumVoidNew += gi[t].voidNew;
 195         sumDragNew += gi[t].dragNew;
 196         gi[t].voidTotal = sumVoidNew;
 197         gi[t].dragTotal = sumDragNew;
 198     }
 199
 200     // t = 0 is wrong (because ldvTime == 0 indicates LDV profiling is
 201     // turned off.
 202     for (t = 1;t < ldvTimeSave; t++) {
 203         fprintf(hp_file, "MARK %f\n", gi[t].time);
 204         fprintf(hp_file, "BEGIN_SAMPLE %f\n", gi[t].time);
 205         fprintf(hp_file, "VOID\t%u\n", gi[t].voidTotal * sizeof(StgWord));
 206         fprintf(hp_file, "LAG\t%u\n", (gi[t].notUsed - gi[t].voidTotal) * sizeof(StgWord));
 207         fprintf(hp_file, "USE\t%u\n", (gi[t].used - gi[t].dragTotal) * sizeof(StgWord));
 208         fprintf(hp_file, "INHERENT_USE\t%u\n", gi[t].inherentlyUsed * sizeof(StgWord));
 209         fprintf(hp_file, "DRAG\t%u\n", gi[t].dragTotal * sizeof(StgWord));
 210         fprintf(hp_file, "END_SAMPLE %f\n", gi[t].time);
 211     }
 212 }
 213
 214 /* --------------------------------------------------------------------------
 215  * Print the statistics.
 216  * This function is called after each retainer profiling.
 217  * ----------------------------------------------------------------------- */
 218 static void
 219 outputLdvSet( void )
 220 {
 221 }
 222
 223 /* --------------------------------------------------------------------------
 224  * This function is eventually called on every object in the heap
 225  * during a census.  Any census is initiated immediately after a major
 226  * garbage collection, and we exploit this fact in the implementation.
 227  * If c is an 'inherently used' closure, gi[ldvTime].inherentlyUsed is
 228  * updated.  If c is an ordinary closure, either gi[ldvTime].notUsed or
 229  * gi[ldvTime].used is updated.
 230  * ----------------------------------------------------------------------- */
 231 static inline nat
 232 processHeapClosure(StgClosure *c)
 233 {
 234     nat size;
 235     StgInfoTable *info;
 236
 237     info = get_itbl(c);
 238
 239     ASSERT(
 240         ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= ldvTime &&
 241         ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0
 242         );
 243     ASSERT(
 244         ((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
 245         (
 246             (LDVW(c) & LDV_LAST_MASK) <= ldvTime &&
 247             (LDVW(c) & LDV_LAST_MASK) > 0
 248             )
 249         );
 250
 251     switch (info->type) {
 252         /*
 253           'inherently used' cases: add to gi[ldvTime].inherentlyUsed
 254         */
 255
 256     case TSO:
 257         size = tso_sizeW((StgTSO *)c);
 258         goto inherently_used;
 259
 260     case MVAR:
 261         size = sizeofW(StgMVar);
 262         goto inherently_used;
 263
 264     case MUT_ARR_PTRS:
 265     case MUT_ARR_PTRS_FROZEN:
 266         size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
 267         goto inherently_used;
 268
 269     case ARR_WORDS:
 270         size = arr_words_sizeW((StgArrWords *)c);
 271         goto inherently_used;
 272
 273     case WEAK:
 274     case MUT_VAR:
 275     case MUT_CONS:
 276     case FOREIGN:
 277     case BCO:
 278     case STABLE_NAME:
 279         size = sizeW_fromITBL(info);
 280         goto inherently_used;
 281
 282         /*
 283           ordinary cases: add to gi[ldvTime].notUsed if c is not being used.
 284           add to gi[ldvTime].used if c is being used.
 285         */
 286     case THUNK:
 287         size = stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
 288         break;
 289
 290     case THUNK_1_0:
 291     case THUNK_0_1:
 292     case THUNK_2_0:
 293     case THUNK_1_1:
 294     case THUNK_0_2:
 295     case THUNK_SELECTOR:
 296         size = sizeofW(StgHeader) + MIN_UPD_SIZE;
 297         break;
 298
 299     case AP_UPD:
 300     case PAP:
 301         size = pap_sizeW((StgPAP *)c);
 302         break;
 303
 304     case CONSTR:
 305     case CONSTR_1_0:
 306     case CONSTR_0_1:
 307     case CONSTR_2_0:
 308     case CONSTR_1_1:
 309     case CONSTR_0_2:
 310
 311     case FUN:
 312     case FUN_1_0:
 313     case FUN_0_1:
 314     case FUN_2_0:
 315     case FUN_1_1:
 316     case FUN_0_2:
 317
 318     case BLACKHOLE_BQ:
 319     case BLACKHOLE:
 320     case SE_BLACKHOLE:
 321     case CAF_BLACKHOLE:
 322     case SE_CAF_BLACKHOLE:
 323         size = sizeW_fromITBL(info);
 324         break;
 325
 326     case IND_PERM:
 327         size = sizeofW(StgInd);
 328         break;
 329
 330     case IND_OLDGEN_PERM:
 331         size = sizeofW(StgIndOldGen);
 332         break;
 333
 334         /*
 335           Error case
 336         */
 337     case IND:           // IND cannot appear after major GCs.
 338     case IND_OLDGEN:    // IND_OLDGEN cannot appear major GCs.
 339     case EVACUATED:     // EVACUATED is encountered only during GCs.
 340         // static objects
 341     case IND_STATIC:
 342     case CONSTR_STATIC:
 343     case FUN_STATIC:
 344     case THUNK_STATIC:
 345     case CONSTR_INTLIKE:
 346     case CONSTR_CHARLIKE:
 347     case CONSTR_NOCAF_STATIC:
 348         // stack objects
 349     case UPDATE_FRAME:
 350     case CATCH_FRAME:
 351     case STOP_FRAME:
 352     case SEQ_FRAME:
 353     case RET_DYN:
 354     case RET_BCO:
 355     case RET_SMALL:
 356     case RET_VEC_SMALL:
 357     case RET_BIG:
 358     case RET_VEC_BIG:
 359         // others
 360     case BLOCKED_FETCH:
 361     case FETCH_ME:
 362     case FETCH_ME_BQ:
 363     case RBH:
 364     case REMOTE_REF:
 365     case INVALID_OBJECT:
 366     default:
 367         barf("Invalid object in processHeapClosure(): %d", info->type);
 368         return 0;
 369     }
 370
 371     /*
 372        ordinary cases:
 373        We can compute either gi[ldvTime].notUsed or gi[ldvTime].used; the other
 374        can be computed from the total sum of costs.
 375        At the moment, we choose to compute gi[ldvTime].notUsed, which seems to
 376        be smaller than gi[ldvTime].used.
 377     */
 378
 379     // ignore closures that don't satisfy our constraints.
 380     if (closureSatisfiesConstraints(c)) {
 381         if ((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE)
 382             gi[ldvTime].notUsed += size - sizeofW(StgProfHeader);
 383         else
 384             gi[ldvTime].used += size - sizeofW(StgProfHeader);
 385     }
 386     return size;
 387
 388 inherently_used:
 389     // ignore closures that don't satisfy our constraints.
 390     if (closureSatisfiesConstraints(c)) {
 391         gi[ldvTime].inherentlyUsed += size - sizeofW(StgProfHeader);
 392     }
 393     return size;
 394 }
 395
 396 /* --------------------------------------------------------------------------
 397  * Calls processHeapClosure() on every closure in the heap blocks
 398  * begining at bd during a census.
 399  * ----------------------------------------------------------------------- */
 400 static void
 401 processHeap( bdescr *bd )
 402 {
 403     StgPtr p;
 404     nat size;
 405
 406     while (bd != NULL) {
 407         p = bd->start;
 408         while (p < bd->free) {
 409             size = processHeapClosure((StgClosure *)p);
 410             p += size;
 411             while (p < bd->free && !*p)   // skip slop
 412                 p++;
 413         }
 414         ASSERT(p == bd->free);
 415         bd = bd->link;
 416     }
 417 }
 418
 419 /* --------------------------------------------------------------------------
 420  * Calls processHeapClosure() on every closure in the small object pool
 421  * during a census.
 422  * ----------------------------------------------------------------------- */
 423 static void
 424 processSmallObjectPool( void )
 425 {
 426     bdescr *bd;
 427     StgPtr p;
 428     nat size;
 429
 430     bd = small_alloc_list;
 431
 432     // first block
 433     if (bd == NULL)
 434         return;
 435
 436     p = bd->start;
 437     while (p < alloc_Hp) {
 438         size = processHeapClosure((StgClosure *)p);
 439         p += size;
 440         while (p < alloc_Hp && !*p)     // skip slop
 441             p++;
 442     }
 443     ASSERT(p == alloc_Hp);
 444
 445     bd = bd->link;
 446     while (bd != NULL) {
 447         p = bd->start;
 448         while (p < bd->free) {
 449             size = processHeapClosure((StgClosure *)p);
 450             p += size;
 451             while (p < bd->free && !*p)    // skip slop
 452                 p++;
 453         }
 454         ASSERT(p == bd->free);
 455         bd = bd->link;
 456     }
 457 }
 458
 459 /* --------------------------------------------------------------------------
 460  * Calls processHeapClosure() on every (large) closure in the object
 461  * chain beginning at bd during a census.
 462  * ----------------------------------------------------------------------- */
 463 static void
 464 processChain( bdescr *bd )
 465 {
 466     while (bd != NULL) {
 467         // bd->free - bd->start is not an accurate measurement of the
 468         // object size.  Actually it is always zero, so we compute its
 469         // size explicitly.
 470         processHeapClosure((StgClosure *)bd->start);
 471         bd = bd->link;
 472   }
 473 }
 474
 475 /* --------------------------------------------------------------------------
 476  * Starts a census for LDV profiling.
 477  * Invariants:
 478  *   Any call to LdvCensus() is preceded by a major garbage collection.
 479  * ----------------------------------------------------------------------- */
 480 void
 481 LdvCensus( void )
 482 {
 483     nat g, s;
 484
 485     // ldvTime == 0 means that LDV profiling is currently turned off.
 486     if (ldvTime == 0)
 487         return;
 488
 489     stat_startLDV();
 490     //
 491     // Todo: when we perform LDV profiling, the Haskell mutator time seems to
 492     //       be affected by -S or -s runtime option. For instance, the
 493     //       following two options should result in nearly same
 494     //       profiling outputs, but the second run (without -Sstderr
 495     //       option) spends almost twice as long in the Haskell
 496     //       mutator as the first run:
 497     //
 498     //       1) +RTS -Sstderr -hL -RTS
 499     //       2) +RTS -hL -RTS
 500     //
 501     //       This is quite a subtle bug because this wierd phenomenon is not
 502     //       observed in retainer profiling, yet mut_user_time_during_LDV() is
 503     //       completely orthogonal to mut_user_time_during_RP(). However, the
 504     //       overall shapes of the resultant graphs are almost the same.
 505     //
 506     gi[ldvTime].time = mut_user_time_during_LDV();
 507     if (RtsFlags.GcFlags.generations == 1) {
 508         //
 509         // Todo: support LDV for two-space garbage collection.
 510         //
 511         barf("Lag/Drag/Void profiling not supported with -G1");
 512     } else {
 513         for (g = 0; g < RtsFlags.GcFlags.generations; g++)
 514             for (s = 0; s < generations[g].n_steps; s++) {
 515                 if (g == 0 && s == 0) {
 516                     // after a major GC, the nursery must be empty,
 517                     // and no need to call processNursery().
 518                     ASSERT(MainCapability.r.rNursery->start ==
 519                            MainCapability.r.rNursery->free);
 520                     processSmallObjectPool();
 521                     processChain(generations[g].steps[s].large_objects);
 522                 } else{
 523                     processHeap(generations[g].steps[s].blocks);
 524                     processChain(generations[g].steps[s].large_objects);
 525                 }
 526             }
 527     }
 528     outputLdvSet();   // output to hp_file
 529     stat_endLDV();    // output to prof_file
 530
 531     incrementLdvTime();
 532 }
 533
 534 /* --------------------------------------------------------------------------
 535  * This function is called eventually on every object destroyed during
 536  * a garbage collection, whether it is a major garbage collection or
 537  * not.  If c is an 'inherently used' closure, nothing happens.  If c
 538  * is an ordinary closure, LDV_recordDead() is called on c with its
 539  * proper size which excludes the profiling header portion in the
 540  * closure.  Returns the size of the closure, including the profiling
 541  * header portion, so that the caller can find the next closure.
 542  * ----------------------------------------------------------------------- */
 543 static inline nat
 544 processHeapClosureForDead( StgClosure *c )
 545 {
 546     nat size;
 547     StgInfoTable *info;
 548
 549     info = get_itbl(c);
 550
 551     if (info->type != EVACUATED) {
 552         ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= ldvTime &&
 553                ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
 554         ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
 555                (
 556                    (LDVW(c) & LDV_LAST_MASK) <= ldvTime &&
 557                    (LDVW(c) & LDV_LAST_MASK) > 0
 558                    ));
 559     }
 560
 561     switch (info->type) {
 562         /*
 563           'inherently used' cases: do nothing.
 564         */
 565
 566     case TSO:
 567         size = tso_sizeW((StgTSO *)c);
 568         return size;
 569
 570     case MVAR:
 571         size = sizeofW(StgMVar);
 572         return size;
 573
 574     case MUT_ARR_PTRS:
 575     case MUT_ARR_PTRS_FROZEN:
 576         size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
 577         return size;
 578
 579     case ARR_WORDS:
 580         size = arr_words_sizeW((StgArrWords *)c);
 581         return size;
 582
 583     case WEAK:
 584     case MUT_VAR:
 585     case MUT_CONS:
 586     case FOREIGN:
 587     case BCO:
 588     case STABLE_NAME:
 589         size = sizeW_fromITBL(info);
 590         return size;
 591
 592         /*
 593           ordinary cases: call LDV_recordDead().
 594         */
 595
 596     case THUNK:
 597         size = stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
 598         break;
 599
 600     case THUNK_1_0:
 601     case THUNK_0_1:
 602     case THUNK_2_0:
 603     case THUNK_1_1:
 604     case THUNK_0_2:
 605     case THUNK_SELECTOR:
 606         size = sizeofW(StgHeader) + MIN_UPD_SIZE;
 607         break;
 608
 609     case AP_UPD:
 610     case PAP:
 611         size = pap_sizeW((StgPAP *)c);
 612         break;
 613
 614     case CONSTR:
 615     case CONSTR_1_0:
 616     case CONSTR_0_1:
 617     case CONSTR_2_0:
 618     case CONSTR_1_1:
 619     case CONSTR_0_2:
 620
 621     case FUN:
 622     case FUN_1_0:
 623     case FUN_0_1:
 624     case FUN_2_0:
 625     case FUN_1_1:
 626     case FUN_0_2:
 627
 628     case BLACKHOLE_BQ:
 629     case BLACKHOLE:
 630     case SE_BLACKHOLE:
 631     case CAF_BLACKHOLE:
 632     case SE_CAF_BLACKHOLE:
 633         size = sizeW_fromITBL(info);
 634         break;
 635
 636     case IND_PERM:
 637         size = sizeofW(StgInd);
 638         break;
 639
 640     case IND_OLDGEN_PERM:
 641         size = sizeofW(StgIndOldGen);
 642         break;
 643
 644         /*
 645           'Ingore' cases
 646         */
 647         // Why can we ignore IND/IND_OLDGEN closures? We assume that
 648         // any census is preceded by a major garbage collection, which
 649         // IND/IND_OLDGEN closures cannot survive. Therefore, it is no
 650         // use considering IND/IND_OLDGEN closures in the meanwhile
 651         // because they will perish before the next census at any
 652         // rate.
 653     case IND:
 654         size = sizeofW(StgInd);
 655         return size;
 656
 657     case IND_OLDGEN:
 658         size = sizeofW(StgIndOldGen);
 659         return size;
 660
 661     case EVACUATED:
 662         // The size of the evacuated closure is currently stored in
 663         // the LDV field.  See SET_EVACUAEE_FOR_LDV() in
 664         // includes/StgLdvProf.h.
 665         return LDVW(c);
 666
 667         /*
 668           Error case
 669         */
 670         // static objects
 671     case IND_STATIC:
 672     case CONSTR_STATIC:
 673     case FUN_STATIC:
 674     case THUNK_STATIC:
 675     case CONSTR_INTLIKE:
 676     case CONSTR_CHARLIKE:
 677     case CONSTR_NOCAF_STATIC:
 678         // stack objects
 679     case UPDATE_FRAME:
 680     case CATCH_FRAME:
 681     case STOP_FRAME:
 682     case SEQ_FRAME:
 683     case RET_DYN:
 684     case RET_BCO:
 685     case RET_SMALL:
 686     case RET_VEC_SMALL:
 687     case RET_BIG:
 688     case RET_VEC_BIG:
 689         // others
 690     case BLOCKED_FETCH:
 691     case FETCH_ME:
 692     case FETCH_ME_BQ:
 693     case RBH:
 694     case REMOTE_REF:
 695     case INVALID_OBJECT:
 696     default:
 697         barf("Invalid object in processHeapClosureForDead(): %d", info->type);
 698         return 0;
 699     }
 700
 701     // Found a dead closure: record its size
 702     LDV_recordDead(c, size);
 703     return size;
 704 }
 705
 706 /* --------------------------------------------------------------------------
 707  * Calls processHeapClosureForDead() on every *dead* closures in the
 708  * heap blocks starting at bd.
 709  * ----------------------------------------------------------------------- */
 710 static void
 711 processHeapForDead( bdescr *bd )
 712 {
 713     StgPtr p;
 714
 715     while (bd != NULL) {
 716         p = bd->start;
 717         while (p < bd->free) {
 718             p += processHeapClosureForDead((StgClosure *)p);
 719             while (p < bd->free && !*p)   // skip slop
 720                 p++;
 721         }
 722         ASSERT(p == bd->free);
 723         bd = bd->link;
 724     }
 725 }
 726
 727 /* --------------------------------------------------------------------------
 728  * Calls processHeapClosureForDead() on every *dead* closures in the nursery.
 729  * ----------------------------------------------------------------------- */
 730 static void
 731 processNurseryForDead( void )
 732 {
 733     StgPtr p, bdLimit;
 734     bdescr *bd;
 735
 736     bd = MainCapability.r.rNursery;
 737     while (bd->start < bd->free) {
 738         p = bd->start;
 739         bdLimit = bd->start + BLOCK_SIZE_W;
 740         while (p < bd->free && p < bdLimit) {
 741             p += processHeapClosureForDead((StgClosure *)p);
 742             while (p < bd->free && p < bdLimit && !*p)  // skip slop
 743                 p++;
 744         }
 745         bd = bd->link;
 746         if (bd == NULL)
 747             break;
 748     }
 749 }
 750
 751 /* --------------------------------------------------------------------------
 752  * Calls processHeapClosureForDead() on every *dead* closures in the
 753  * small object pool.
 754  * ----------------------------------------------------------------------- */
 755 static void
 756 processSmallObjectPoolForDead( void )
 757 {
 758     bdescr *bd;
 759     StgPtr p;
 760
 761     bd = small_alloc_list;
 762
 763     // first block
 764     if (bd == NULL)
 765         return;
 766
 767     p = bd->start;
 768     while (p < alloc_Hp) {
 769         p += processHeapClosureForDead((StgClosure *)p);
 770         while (p < alloc_Hp && !*p)     // skip slop
 771             p++;
 772     }
 773     ASSERT(p == alloc_Hp);
 774
 775     bd = bd->link;
 776     while (bd != NULL) {
 777         p = bd->start;
 778         while (p < bd->free) {
 779             p += processHeapClosureForDead((StgClosure *)p);
 780             while (p < bd->free && !*p)    // skip slop
 781                 p++;
 782         }
 783         ASSERT(p == bd->free);
 784         bd = bd->link;
 785     }
 786 }
 787
 788 /* --------------------------------------------------------------------------
 789  * Calls processHeapClosureForDead() on every *dead* closures in the closure
 790  * chain.
 791  * ----------------------------------------------------------------------- */
 792 static void
 793 processChainForDead( bdescr *bd )
 794 {
 795     // Any object still in the chain is dead!
 796     while (bd != NULL) {
 797         processHeapClosureForDead((StgClosure *)bd->start);
 798         bd = bd->link;
 799     }
 800 }
 801
 802 /* --------------------------------------------------------------------------
 803  * Start a census for *dead* closures, and calls
 804  * processHeapClosureForDead() on every closure which died in the
 805  * current garbage collection.  This function is called from a garbage
 806  * collector right before tidying up, when all dead closures are still
 807  * stored in the heap and easy to identify.  Generations 0 through N
 808  * have just beed garbage collected.
 809  * ----------------------------------------------------------------------- */
 810 void
 811 LdvCensusForDead( nat N )
 812 {
 813     nat g, s;
 814
 815     // ldvTime == 0 means that LDV profiling is currently turned off.
 816     if (ldvTime == 0)
 817         return;
 818
 819     if (RtsFlags.GcFlags.generations == 1) {
 820         //
 821         // Todo: support LDV for two-space garbage collection.
 822         //
 823         barf("Lag/Drag/Void profiling not supported with -G1");
 824     } else {
 825         for (g = 0; g <= N; g++)
 826             for (s = 0; s < generations[g].n_steps; s++) {
 827                 if (g == 0 && s == 0) {
 828                     processSmallObjectPoolForDead();
 829                     processNurseryForDead();
 830                     processChainForDead(generations[g].steps[s].large_objects);
 831                 } else{
 832                     processHeapForDead(generations[g].steps[s].blocks);
 833                     processChainForDead(generations[g].steps[s].large_objects);
 834                 }
 835             }
 836     }
 837 }
 838
 839 /* --------------------------------------------------------------------------
 840  * Regard any closure in the current heap as dead or moribund and update
 841  * LDV statistics accordingly.
 842  * Called from shutdownHaskell() in RtsStartup.c.
 843  * Also, stops LDV profiling by resetting ldvTime to 0.
 844  * ----------------------------------------------------------------------- */
 845 void
 846 LdvCensusKillAll( void )
 847 {
 848     LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
 849
 850     // record the time when LDV profiling stops.
 851     ldvTimeSave = ldvTime;
 852
 853     // and, stops LDV profiling.
 854     ldvTime = 0;
 855 }
 856
 857 #endif /* PROFILING */