ghc/runtime/storage/SMscav.lc

   1 ****************************************************************************
   2
   3 The files SMevac.lc and SMscav.lhc contain the basic routines required
   4 for two-space copying garbage collection.
   5
   6 Two files are required as the evac routines are conventional call/return
   7 routines while the scavenge routines are continuation routines.
   8
   9 This file SMscav.lhc contains the scavenging routines ...
  10
  11 ****************************************************************************
  12
  13
  14 All the routines are placed in the info tables of the appropriate closures.
  15
  16
  17 Evacuation code:  _Evacuate_...
  18
  19 USE:  new = EVACUATE_CLOSURE(evac)
  20
  21 Evacuates a closure of size S words. Note the size excludes the info
  22 and any other preceding fields (eg global address in Grip implementation)
  23 Returns the address of the closures new location via the Evac register.
  24
  25   Calling Conventions:
  26     arg   -- points to the closure
  27     ToHp  -- points to the last allocated word in to-space
  28   Return Conventions:
  29     ret   -- points to the new address of the closure
  30     ToHp  -- points to the last allocated word in to-space
  31
  32   Example: Cons cell requires _Evacuate_2
  33
  34 Scavenging code:  _Scavenge_S_N
  35
  36   Retrieved using SCAV_CODE(infoptr)
  37
  38 Scavenges a closure of size S words, with N pointers and returns.
  39 If more closures are required to be scavenged the code to
  40 scan the next closure can be called.
  41
  42   Calling Conventions:
  43     Scav  -- points to the current closure
  44     ToHp  -- points to the last allocated word in to-space
  45
  46     OldGen -- Points to end of old generation (Appels collector only)
  47
  48   Return Conventions:
  49     Scav -- points to the next closure
  50     ToHp -- points to the (possibly new) location of the last allocated word
  51
  52   Example: Cons cell requires _Scavenge_2_2
  53
  54
  55 The following registers are used by a two-space collection:
  56
  57 Scav    -- Points to the current closure being scavenged
  58            (PS paper = Hscav)
  59
  60 ToHp     -- Points to the last word allocated in two-space
  61            (PS paper = Hnext)
  62
  63 A copying pass is started by:
  64     -- Setting ToHp to 1 before the start of to-space
  65     -- Evacuating the roots pointing into from-space
  66          -- root = EVACUATE_CLOSURE(root)
  67     -- Setting Scav to point to the first closure in to-space
  68     -- Execute  while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))();
  69
  70 When Done ToHp will point to the last word allocated in to-space
  71
  72
  73 \begin{code}
  74 /* The #define and #include come before the test because SMinternal.h
  75    will suck in includes/SMinterface whcih defines (or doesn't)
  76    _INFO_COPYING [ADR] */
  77
  78 #define SCAV_REG_MAP
  79 #include "SMinternal.h"
  80
  81 #if defined(_INFO_COPYING)
  82
  83 RegisterTable ScavRegTable;
  84
  85 /* Moves Scav to point at the info pointer of the next closure to Scavenge */
  86 #define NEXT_Scav(size)    Scav += (size) + FIXED_HS
  87
  88 /*
  89    When doing a new generation copy collection for Appel's collector
  90    only evacuate references that point to the new generation.
  91    OldGen must be set to point to the end of old space.
  92 */
  93
  94 #if defined(GCgn)
  95
  96 #define DO_EVACUATE(closure, pos) \
  97             { P_ evac = (P_) *(((P_)(closure))+(pos)); \
  98               if (evac > OldGen) {                \
  99                 *(((P_)(closure))+(pos)) = (W_) EVACUATE_CLOSURE(evac); \
 100             }}
 101
 102 #else
 103 #if defined(GCap)
 104
 105 #define DO_EVACUATE(closure, pos) \
 106             { P_ evac = (P_) *(((P_)(closure))+(pos)); \
 107               if (evac > OldGen) {                \
 108                 *(((P_)(closure))+(pos)) = (W_) EVACUATE_CLOSURE(evac); \
 109             }}
 110
 111 #else /* ! GCgn && ! GCap */
 112
 113 #define DO_EVACUATE(closure, pos) \
 114             { P_ evac = (P_) *(((P_)(closure))+(pos));  \
 115               *(((P_)(closure))+(pos)) = (W_) EVACUATE_CLOSURE(evac); }
 116
 117 #endif /* ! GCgn && ! GCap */
 118 #endif
 119
 120
 121 /* Evacuate nth pointer in SPEC closure (starting at 1) */
 122 #define SPEC_DO_EVACUATE(ptr) DO_EVACUATE(Scav, (SPEC_HS-1) + (ptr))
 123 #define STKO_DO_EVACUATE(ptr) DO_EVACUATE(Scav, (STKO_HS-1) + (ptr))
 124
 125
 126 /*** DEBUGGING MACROS ***/
 127
 128 #if defined(_GC_DEBUG)
 129
 130 #define DEBUG_SCAV(s,p) \
 131     if (SM_trace & 2) \
 132         fprintf(stderr, "Scav: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
 133                 Scav, INFO_PTR(Scav), s, p)
 134
 135 #define DEBUG_SCAV_GEN(s,p) \
 136     if (SM_trace & 2) \
 137         fprintf(stderr, "Scav: 0x%lx, Gen info 0x%lx, size %ld, ptrs %ld\n", \
 138                 Scav, INFO_PTR(Scav), s, p)
 139
 140 #define DEBUG_SCAV_DYN   \
 141     if (SM_trace & 2) \
 142         fprintf(stderr, "Scav: 0x%lx, Dyn info 0x%lx, size %ld, ptrs %ld\n", \
 143                 Scav, INFO_PTR(Scav), DYN_CLOSURE_SIZE(Scav), DYN_CLOSURE_NoPTRS(Scav))
 144
 145 #define DEBUG_SCAV_TUPLE \
 146     if (SM_trace & 2) \
 147         fprintf(stderr, "Scav: 0x%lx, Tuple info 0x%lx, size %ld, ptrs %ld\n", \
 148                 Scav, INFO_PTR(Scav), TUPLE_CLOSURE_SIZE(Scav), TUPLE_CLOSURE_NoPTRS(Scav))
 149
 150 #define DEBUG_SCAV_MUTUPLE \
 151     if (SM_trace & 2) \
 152         fprintf(stderr, "Scav: 0x%lx, MuTuple info 0x%lx, size %ld, ptrs %ld\n", \
 153                 Scav, INFO_PTR(Scav), MUTUPLE_CLOSURE_SIZE(Scav), MUTUPLE_CLOSURE_NoPTRS(Scav))
 154
 155 #define DEBUG_SCAV_DATA  \
 156     if (SM_trace & 2) \
 157         fprintf(stderr, "Scav: 0x%lx, Data info 0x%lx, size %ld\n", \
 158                 Scav, INFO_PTR(Scav), DATA_CLOSURE_SIZE(Scav))
 159
 160 #define DEBUG_SCAV_BH(s)  \
 161     if (SM_trace & 2) \
 162         fprintf(stderr, "Scav: 0x%lx, BH info 0x%lx, size %ld\n", \
 163                 Scav, INFO_PTR(Scav), s)
 164
 165 #define DEBUG_SCAV_IND \
 166     if (SM_trace & 2) \
 167         fprintf(stderr, "Scav: 0x%lx, IND info 0x%lx, size %ld\n", \
 168                 Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav))
 169
 170 #define DEBUG_SCAV_PERM_IND \
 171     if (SM_trace & 2) \
 172         fprintf(stderr, "Scav: 0x%lx, PI info 0x%lx, size %ld\n", \
 173                 Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav))
 174
 175 #define DEBUG_SCAV_OLDROOT(s) \
 176     if (SM_trace & 2) \
 177         fprintf(stderr, "Scav: OLDROOT 0x%lx, info 0x%lx, size %ld\n", \
 178                 Scav, INFO_PTR(Scav), s)
 179
 180 #ifdef CONCURRENT
 181 #define DEBUG_SCAV_BQ \
 182     if (SM_trace & 2) \
 183         fprintf(stderr, "Scav: 0x%lx, BQ info 0x%lx, size %ld, ptrs %ld\n", \
 184                 Scav, INFO_PTR(Scav), BQ_CLOSURE_SIZE(Scav), BQ_CLOSURE_NoPTRS(Scav))
 185
 186 #define DEBUG_SCAV_TSO  \
 187     if (SM_trace & 2) \
 188         fprintf(stderr, "Scav TSO: 0x%lx\n", \
 189                 Scav)
 190
 191 #define DEBUG_SCAV_STKO  \
 192     if (SM_trace & 2) \
 193         fprintf(stderr, "Scav StkO: 0x%lx\n", \
 194                 Scav)
 195
 196 # ifdef PAR
 197 #  define DEBUG_SCAV_BF \
 198     if (SM_trace & 2) \
 199         fprintf(stderr, "Scav: 0x%lx, BF info 0x%lx, size %ld, ptrs %ld\n", \
 200                 Scav, INFO_PTR(Scav), BF_CLOSURE_SIZE(dummy), 0)
 201 # endif
 202 #endif
 203
 204 #else
 205
 206 #define DEBUG_SCAV(s,p)
 207 #define DEBUG_SCAV_GEN(s,p)
 208 #define DEBUG_SCAV_DYN
 209 #define DEBUG_SCAV_TUPLE
 210 #define DEBUG_SCAV_MUTUPLE
 211 #define DEBUG_SCAV_DATA
 212 #define DEBUG_SCAV_BH(s)
 213 #define DEBUG_SCAV_IND
 214 #define DEBUG_SCAV_PERM_IND
 215 #define DEBUG_SCAV_OLDROOT(s)
 216
 217 #ifdef CONCURRENT
 218 # define DEBUG_SCAV_BQ
 219 # define DEBUG_SCAV_TSO
 220 # define DEBUG_SCAV_STKO
 221 # ifdef PAR
 222 #  define DEBUG_SCAV_BF
 223 # endif
 224 #endif
 225
 226 #endif
 227
 228 #define PROFILE_CLOSURE(closure,size) \
 229     HEAP_PROFILE_CLOSURE(closure,size); \
 230     LIFE_PROFILE_CLOSURE(closure,size)
 231
 232 /*** SPECIALISED CODE ***/
 233
 234 void
 235 _Scavenge_1_0(STG_NO_ARGS)
 236 {
 237     DEBUG_SCAV(1,0);
 238     PROFILE_CLOSURE(Scav,1);
 239     NEXT_Scav(1); /* because "size" is defined to be 1 (size SPEC_VHS == 0) */
 240     return;
 241 }
 242 void
 243 _Scavenge_2_0(STG_NO_ARGS)
 244 {
 245     DEBUG_SCAV(2,0);
 246     PROFILE_CLOSURE(Scav,2);
 247     NEXT_Scav(2);
 248     return;
 249 }
 250 void
 251 _Scavenge_3_0(STG_NO_ARGS)
 252 {
 253     DEBUG_SCAV(3,0);
 254     PROFILE_CLOSURE(Scav,3);
 255     NEXT_Scav(3);
 256     return;
 257 }
 258 void
 259 _Scavenge_4_0(STG_NO_ARGS)
 260 {
 261     DEBUG_SCAV(4,0);
 262     PROFILE_CLOSURE(Scav,4);
 263     NEXT_Scav(4);
 264     return;
 265 }
 266 void
 267 _Scavenge_5_0(STG_NO_ARGS)
 268 {
 269     DEBUG_SCAV(5,0);
 270     PROFILE_CLOSURE(Scav,5);
 271     NEXT_Scav(5);
 272     return;
 273 }
 274
 275 void
 276 _Scavenge_2_1(STG_NO_ARGS)
 277 {
 278     DEBUG_SCAV(2,1);
 279     PROFILE_CLOSURE(Scav,2);
 280     SPEC_DO_EVACUATE(1);
 281     NEXT_Scav(2);
 282     return;
 283 }
 284
 285 void
 286 _Scavenge_3_1(STG_NO_ARGS)
 287 {
 288     DEBUG_SCAV(3,1);
 289     PROFILE_CLOSURE(Scav,3);
 290     SPEC_DO_EVACUATE(1);
 291     NEXT_Scav(3);
 292     return;
 293 }
 294 void
 295 _Scavenge_3_2(STG_NO_ARGS)
 296 {
 297     DEBUG_SCAV(3,2);
 298     PROFILE_CLOSURE(Scav,3);
 299     SPEC_DO_EVACUATE(1);
 300     SPEC_DO_EVACUATE(2);
 301     NEXT_Scav(3);
 302     return;
 303 }
 304
 305 void
 306 _Scavenge_1_1(STG_NO_ARGS)
 307 {
 308     DEBUG_SCAV(1,1);
 309     PROFILE_CLOSURE(Scav,1);
 310     SPEC_DO_EVACUATE(1);
 311     NEXT_Scav(1);
 312     return;
 313 }
 314 void
 315 _Scavenge_2_2(STG_NO_ARGS)
 316 {
 317     DEBUG_SCAV(2,2);
 318     PROFILE_CLOSURE(Scav,2);
 319     SPEC_DO_EVACUATE(1);
 320     SPEC_DO_EVACUATE(2);
 321     NEXT_Scav(2);
 322     return;
 323 }
 324 void
 325 _Scavenge_3_3(STG_NO_ARGS)
 326 {
 327     DEBUG_SCAV(3,3);
 328     PROFILE_CLOSURE(Scav,3);
 329     SPEC_DO_EVACUATE(1);
 330     SPEC_DO_EVACUATE(2);
 331     SPEC_DO_EVACUATE(3);
 332     NEXT_Scav(3);
 333     return;
 334 }
 335 void
 336 _Scavenge_4_4(STG_NO_ARGS)
 337 {
 338     DEBUG_SCAV(4,4);
 339     PROFILE_CLOSURE(Scav,4);
 340     SPEC_DO_EVACUATE(1);
 341     SPEC_DO_EVACUATE(2);
 342     SPEC_DO_EVACUATE(3);
 343     SPEC_DO_EVACUATE(4);
 344     NEXT_Scav(4);
 345     return;
 346 }
 347 void
 348 _Scavenge_5_5(STG_NO_ARGS)
 349 {
 350     DEBUG_SCAV(5,5);
 351     PROFILE_CLOSURE(Scav,5);
 352     SPEC_DO_EVACUATE(1);
 353     SPEC_DO_EVACUATE(2);
 354     SPEC_DO_EVACUATE(3);
 355     SPEC_DO_EVACUATE(4);
 356     SPEC_DO_EVACUATE(5);
 357     NEXT_Scav(5);
 358     return;
 359 }
 360 void
 361 _Scavenge_6_6(STG_NO_ARGS)
 362 {
 363     DEBUG_SCAV(6,6);
 364     PROFILE_CLOSURE(Scav,6);
 365     SPEC_DO_EVACUATE(1);
 366     SPEC_DO_EVACUATE(2);
 367     SPEC_DO_EVACUATE(3);
 368     SPEC_DO_EVACUATE(4);
 369     SPEC_DO_EVACUATE(5);
 370     SPEC_DO_EVACUATE(6);
 371     NEXT_Scav(6);
 372     return;
 373 }
 374 void
 375 _Scavenge_7_7(STG_NO_ARGS)
 376 {
 377     DEBUG_SCAV(7,7);
 378     PROFILE_CLOSURE(Scav,7);
 379     SPEC_DO_EVACUATE(1);
 380     SPEC_DO_EVACUATE(2);
 381     SPEC_DO_EVACUATE(3);
 382     SPEC_DO_EVACUATE(4);
 383     SPEC_DO_EVACUATE(5);
 384     SPEC_DO_EVACUATE(6);
 385     SPEC_DO_EVACUATE(7);
 386     NEXT_Scav(7);
 387     return;
 388 }
 389 void
 390 _Scavenge_8_8(STG_NO_ARGS)
 391 {
 392     DEBUG_SCAV(8,8);
 393     PROFILE_CLOSURE(Scav,8);
 394     SPEC_DO_EVACUATE(1);
 395     SPEC_DO_EVACUATE(2);
 396     SPEC_DO_EVACUATE(3);
 397     SPEC_DO_EVACUATE(4);
 398     SPEC_DO_EVACUATE(5);
 399     SPEC_DO_EVACUATE(6);
 400     SPEC_DO_EVACUATE(7);
 401     SPEC_DO_EVACUATE(8);
 402     NEXT_Scav(8);
 403     return;
 404 }
 405 void
 406 _Scavenge_9_9(STG_NO_ARGS)
 407 {
 408     DEBUG_SCAV(9,9);
 409     PROFILE_CLOSURE(Scav,9);
 410     SPEC_DO_EVACUATE(1);
 411     SPEC_DO_EVACUATE(2);
 412     SPEC_DO_EVACUATE(3);
 413     SPEC_DO_EVACUATE(4);
 414     SPEC_DO_EVACUATE(5);
 415     SPEC_DO_EVACUATE(6);
 416     SPEC_DO_EVACUATE(7);
 417     SPEC_DO_EVACUATE(8);
 418     SPEC_DO_EVACUATE(9);
 419     NEXT_Scav(9);
 420     return;
 421 }
 422 void
 423 _Scavenge_10_10(STG_NO_ARGS)
 424 {
 425     DEBUG_SCAV(10,10);
 426     PROFILE_CLOSURE(Scav,10);
 427     SPEC_DO_EVACUATE(1);
 428     SPEC_DO_EVACUATE(2);
 429     SPEC_DO_EVACUATE(3);
 430     SPEC_DO_EVACUATE(4);
 431     SPEC_DO_EVACUATE(5);
 432     SPEC_DO_EVACUATE(6);
 433     SPEC_DO_EVACUATE(7);
 434     SPEC_DO_EVACUATE(8);
 435     SPEC_DO_EVACUATE(9);
 436     SPEC_DO_EVACUATE(10);
 437     NEXT_Scav(10);
 438     return;
 439 }
 440 void
 441 _Scavenge_11_11(STG_NO_ARGS)
 442 {
 443     DEBUG_SCAV(11,11);
 444     PROFILE_CLOSURE(Scav,11);
 445     SPEC_DO_EVACUATE(1);
 446     SPEC_DO_EVACUATE(2);
 447     SPEC_DO_EVACUATE(3);
 448     SPEC_DO_EVACUATE(4);
 449     SPEC_DO_EVACUATE(5);
 450     SPEC_DO_EVACUATE(6);
 451     SPEC_DO_EVACUATE(7);
 452     SPEC_DO_EVACUATE(8);
 453     SPEC_DO_EVACUATE(9);
 454     SPEC_DO_EVACUATE(10);
 455     SPEC_DO_EVACUATE(11);
 456     NEXT_Scav(11);
 457     return;
 458 }
 459 void
 460 _Scavenge_12_12(STG_NO_ARGS)
 461 {
 462     DEBUG_SCAV(12,12);
 463     PROFILE_CLOSURE(Scav,12);
 464     SPEC_DO_EVACUATE(1);
 465     SPEC_DO_EVACUATE(2);
 466     SPEC_DO_EVACUATE(3);
 467     SPEC_DO_EVACUATE(4);
 468     SPEC_DO_EVACUATE(5);
 469     SPEC_DO_EVACUATE(6);
 470     SPEC_DO_EVACUATE(7);
 471     SPEC_DO_EVACUATE(8);
 472     SPEC_DO_EVACUATE(9);
 473     SPEC_DO_EVACUATE(10);
 474     SPEC_DO_EVACUATE(11);
 475     SPEC_DO_EVACUATE(12);
 476     NEXT_Scav(12);
 477     return;
 478 }
 479 \end{code}
 480
 481 The scavenge routines for revertible black holes with underlying @SPEC@
 482 closures.
 483
 484 \begin{code}
 485
 486 #ifdef PAR
 487
 488 # if defined(GCgn)
 489
 490 #  define SCAVENGE_SPEC_RBH_N_1(n)      \
 491 void                                    \
 492 CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS)  \
 493 {                                       \
 494     P_ save_Scav;                       \
 495     DEBUG_SCAV(n,1);                    \
 496     save_Scav = Scav;                   \
 497     Scav = OldGen + 1;                  \
 498     DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN);   \
 499     Scav = save_Scav;                   \
 500     PROFILE_CLOSURE(Scav,n);            \
 501     NEXT_Scav(n); /* ToDo: dodgy size WDP 95/07 */                      \
 502 }
 503
 504 #  define SCAVENGE_SPEC_RBH_N_N(n)      \
 505 void                                    \
 506 CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 507 {                                       \
 508     int i;                              \
 509     P_ save_Scav;                       \
 510     DEBUG_SCAV(n,n-1);                  \
 511     save_Scav = Scav;                   \
 512     Scav = OldGen + 1;                  \
 513     for(i = 0; i < n - 1; i++) {        \
 514         DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN + i);   \
 515     }                                   \
 516     Scav = save_Scav;                   \
 517     PROFILE_CLOSURE(Scav,n);            \
 518     NEXT_Scav(n);                       \
 519 }
 520
 521 # else
 522
 523 #  define SCAVENGE_SPEC_RBH_N_1(n)      \
 524 void                                    \
 525 CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS)  \
 526 {                                       \
 527     DEBUG_SCAV(n,1);                    \
 528     DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN);\
 529     PROFILE_CLOSURE(Scav,n);            \
 530     NEXT_Scav(n);                       \
 531 }
 532
 533 #  define SCAVENGE_SPEC_RBH_N_N(n)      \
 534 void                                    \
 535 CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 536 {                                       \
 537     int i;                              \
 538     DEBUG_SCAV(n,n-1);                  \
 539     for(i = 0; i < n - 1; i++) {        \
 540         DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN + i);    \
 541     }                                   \
 542     PROFILE_CLOSURE(Scav,n);            \
 543     NEXT_Scav(n);                       \
 544 }
 545
 546 # endif
 547
 548 SCAVENGE_SPEC_RBH_N_1(2)
 549
 550 SCAVENGE_SPEC_RBH_N_1(3)
 551 SCAVENGE_SPEC_RBH_N_N(3)
 552
 553 SCAVENGE_SPEC_RBH_N_1(4)
 554 SCAVENGE_SPEC_RBH_N_N(4)
 555
 556 SCAVENGE_SPEC_RBH_N_1(5)
 557 SCAVENGE_SPEC_RBH_N_N(5)
 558
 559 SCAVENGE_SPEC_RBH_N_N(6)
 560 SCAVENGE_SPEC_RBH_N_N(7)
 561 SCAVENGE_SPEC_RBH_N_N(8)
 562 SCAVENGE_SPEC_RBH_N_N(9)
 563 SCAVENGE_SPEC_RBH_N_N(10)
 564 SCAVENGE_SPEC_RBH_N_N(11)
 565 SCAVENGE_SPEC_RBH_N_N(12)
 566
 567 #endif
 568
 569 \end{code}
 570
 571 \begin{code}
 572
 573 #ifndef PAR
 574 /*** Malloc POINTER -- NOTHING TO SCAVENGE ***/
 575
 576 /* (The MallocPtrList is updated at the end of GC and any unevacuated
 577     MallocPtrs reported to C World)  [ADR]
 578 */
 579
 580 void
 581 _Scavenge_MallocPtr(STG_NO_ARGS)
 582 {
 583     DEBUG_SCAV(MallocPtr_SIZE,0);
 584     PROFILE_CLOSURE(Scav,MallocPtr_SIZE);
 585     NEXT_Scav(MallocPtr_SIZE);
 586     return;
 587 }
 588 #endif /* !PAR */
 589
 590 /*** GENERAL CASE CODE ***/
 591
 592 void
 593 _Scavenge_S_N(STG_NO_ARGS)
 594 {
 595     I_ count = GEN_HS - 1;
 596                    /* Offset of first ptr word, less 1 */
 597     I_ ptrs = count + GEN_CLOSURE_NoPTRS(Scav);
 598                    /* Offset of last ptr word */
 599     I_ size = GEN_CLOSURE_SIZE(Scav);
 600
 601     DEBUG_SCAV_GEN(size, GEN_CLOSURE_NoPTRS(Scav));
 602
 603     while (++count <= ptrs) {
 604         DO_EVACUATE(Scav, count);
 605     }
 606     PROFILE_CLOSURE(Scav,size);
 607     NEXT_Scav(size);
 608     return;
 609 }
 610
 611 \end{code}
 612
 613 The scavenge code for revertible black holes with underlying @GEN@ closures
 614
 615 \begin{code}
 616
 617 #ifdef PAR
 618
 619 void
 620 _Scavenge_RBH_N(STG_NO_ARGS)
 621 {
 622 #if defined(GCgn)
 623     P_ save_Scav;
 624 #endif
 625
 626     I_ count = GEN_RBH_HS - 1;  /* Offset of first ptr word, less 1 */
 627     I_ ptrs = GEN_RBH_CLOSURE_NoPTRS(Scav);
 628     I_ size = GEN_RBH_CLOSURE_SIZE(Scav);
 629
 630     /*
 631      * Get pointer count from original closure and adjust for one pointer
 632      * in the first two words of the RBH.
 633      */
 634     if (ptrs < 2)
 635         ptrs = 1;
 636     else
 637         ptrs--;
 638
 639     ptrs += count;          /* Offset of last ptr word */
 640
 641     DEBUG_SCAV_GEN(size, ptrs);
 642
 643 #if defined(GCgn)
 644     /* No old generation roots should be created for mutable */
 645     /* pointer fields as they will be explicitly collected   */
 646     /* Ensure this by pointing Scav at the new generation    */
 647     save_Scav = Scav;
 648     Scav = OldGen + 1;
 649
 650     while (++count <= ptrs) {
 651         DO_EVACUATE(save_Scav, count);
 652     }
 653     Scav = save_Scav;
 654 #else
 655     while (++count <= ptrs) {
 656         DO_EVACUATE(Scav, count);
 657     }
 658 #endif
 659
 660     PROFILE_CLOSURE(Scav,size);
 661     NEXT_Scav(size);
 662     return;
 663 }
 664
 665 #endif
 666
 667 \end{code}
 668
 669 \begin{code}
 670
 671 /*** DYNAMIC CLOSURE -- SIZE & PTRS STORED IN CLOSURE ***/
 672
 673 void
 674 _Scavenge_Dyn(STG_NO_ARGS)
 675 {
 676     I_ count = DYN_HS - 1;
 677                    /* Offset of first ptr word, less 1 */
 678     I_ ptrs = count + DYN_CLOSURE_NoPTRS(Scav);
 679                    /* Offset of last ptr word */
 680     I_ size = DYN_CLOSURE_SIZE(Scav);
 681
 682     DEBUG_SCAV_DYN;
 683     while (++count <= ptrs) {
 684         DO_EVACUATE(Scav, count);
 685     }
 686     PROFILE_CLOSURE(Scav,size);
 687     NEXT_Scav(size);
 688     return;
 689 }
 690
 691 /*** TUPLE CLOSURE -- NO PTRS STORED IN CLOSURE -- NO DATA ***/
 692
 693 void
 694 _Scavenge_Tuple(STG_NO_ARGS)
 695 {
 696     I_ count = TUPLE_HS - 1;
 697                    /* Offset of first ptr word, less 1 */
 698     I_ ptrs  = count + TUPLE_CLOSURE_NoPTRS(Scav);
 699                    /* Offset of last ptr word */
 700     I_ size  = TUPLE_CLOSURE_SIZE(Scav);
 701
 702     DEBUG_SCAV_TUPLE;
 703     while (++count <= ptrs) {
 704         DO_EVACUATE(Scav, count);
 705     }
 706     PROFILE_CLOSURE(Scav,size);
 707     NEXT_Scav(size);
 708     return;
 709 }
 710
 711 /*** DATA CLOSURE -- SIZE STORED IN CLOSURE -- NO POINTERS ***/
 712
 713 void
 714 _Scavenge_Data(STG_NO_ARGS)
 715 {
 716     I_ size = DATA_CLOSURE_SIZE(Scav);
 717
 718     DEBUG_SCAV_DATA;
 719     PROFILE_CLOSURE(Scav,size);
 720     NEXT_Scav(size);
 721     return;
 722 }
 723
 724 /*** MUTUPLE CLOSURE -- ONLY PTRS STORED IN CLOSURE -- NO DATA ***/
 725 /*             Only if special GC treatment required           */
 726
 727 #ifdef GC_MUT_REQUIRED
 728 void
 729 _Scavenge_MuTuple(STG_NO_ARGS)
 730 {
 731 #if defined(GCgn)
 732     P_ save_Scav;
 733 #endif
 734     I_ count = MUTUPLE_HS - 1;
 735                    /* Offset of first ptr word, less 1 */
 736     I_ ptrs  = count + MUTUPLE_CLOSURE_NoPTRS(Scav);
 737                    /* Offset of last ptr word */
 738     I_ size  = MUTUPLE_CLOSURE_SIZE(Scav);
 739
 740     DEBUG_SCAV_MUTUPLE;
 741
 742 #if defined(GCgn)
 743     /* No old generation roots should be created for mutable */
 744     /* pointer fields as they will be explicitly collected   */
 745     /* Ensure this by pointing Scav at the new generation    */
 746     save_Scav = Scav;
 747     Scav = OldGen + 1;
 748     while (++count <= ptrs) {
 749         DO_EVACUATE(save_Scav, count);
 750     }
 751     Scav = save_Scav;
 752 #else  /* GCap */
 753     while (++count <= ptrs) {
 754         DO_EVACUATE(Scav, count);
 755     }
 756 #endif /* GCap */
 757
 758     PROFILE_CLOSURE(Scav,size);
 759     NEXT_Scav(size);
 760     return;
 761 }
 762 #endif /* something generational */
 763
 764 /*** BH CLOSURES -- NO POINTERS ***/
 765
 766 void
 767 _Scavenge_BH_U(STG_NO_ARGS)
 768 {
 769     DEBUG_SCAV_BH(BH_U_SIZE);
 770     PROFILE_CLOSURE(Scav,BH_U_SIZE);
 771     NEXT_Scav(BH_U_SIZE);
 772     return;
 773 }
 774
 775 void
 776 _Scavenge_BH_N(STG_NO_ARGS)
 777 {
 778     DEBUG_SCAV_BH(BH_N_SIZE);
 779     PROFILE_CLOSURE(Scav,BH_N_SIZE);
 780     NEXT_Scav(BH_N_SIZE);
 781     return;
 782 }
 783
 784 /* This is needed for scavenging the indirections on the OldMutables list */
 785
 786 void
 787 _Scavenge_Ind(STG_NO_ARGS)
 788 {
 789     DEBUG_SCAV_IND;
 790     PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy));
 791     DO_EVACUATE(Scav, IND_HS);
 792     NEXT_Scav(IND_CLOSURE_SIZE(dummy));
 793     return;
 794 }
 795
 796 void
 797 _Scavenge_Caf(STG_NO_ARGS)
 798 {
 799     DEBUG_SCAV_IND;
 800     PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy));
 801     DO_EVACUATE(Scav, IND_HS);
 802     NEXT_Scav(IND_CLOSURE_SIZE(dummy));
 803     return;
 804 }
 805
 806 #if defined(USE_COST_CENTRES)
 807
 808 /* Special permanent indirection for lexical scoping.
 809    As for _Scavenge_Ind but no PROFILE_CLOSURE.
 810 */
 811
 812 void
 813 _Scavenge_PI(STG_NO_ARGS)
 814 {
 815     DEBUG_SCAV_PERM_IND;
 816     /* PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy)); */
 817     DO_EVACUATE(Scav, IND_HS);
 818     NEXT_Scav(IND_CLOSURE_SIZE(dummy));
 819     return;
 820 }
 821 #endif /* USE_COST_CENTRES */
 822
 823 #ifdef CONCURRENT
 824
 825 void
 826 _Scavenge_BQ(STG_NO_ARGS)
 827 {
 828 #if defined(GCgn)
 829     P_ save_Scav;
 830 #endif
 831
 832     DEBUG_SCAV_BQ;
 833
 834 #if defined(GCgn)
 835     /* No old generation roots should be created for mutable */
 836     /* pointer fields as they will be explicitly collected   */
 837     /* Ensure this by pointing Scav at the new generation    */
 838     save_Scav = Scav;
 839     Scav = OldGen + 1;
 840     DO_EVACUATE(save_Scav, BQ_HS);
 841     Scav = save_Scav;
 842 #else  /* !GCgn */
 843     DO_EVACUATE(Scav, BQ_HS);
 844 #endif /* GCgn */
 845
 846     PROFILE_CLOSURE(Scav,BQ_CLOSURE_SIZE(dummy));
 847     NEXT_Scav(BQ_CLOSURE_SIZE(dummy));
 848     return;
 849 }
 850
 851 void
 852 _Scavenge_TSO(STG_NO_ARGS)
 853 {
 854 #if defined(GCgn)
 855     P_ save_Scav;
 856 #endif
 857     STGRegisterTable *r = TSO_INTERNAL_PTR(Scav);
 858     W_ liveness = r->rLiveness;
 859     I_ i;
 860
 861     DEBUG_SCAV_TSO;
 862
 863 #if defined(GCgn)
 864     /* No old generation roots should be created for mutable */
 865     /* pointer fields as they will be explicitly collected   */
 866     /* Ensure this by pointing Scav at the new generation    */
 867     save_Scav = Scav;
 868     Scav = OldGen + 1;
 869
 870     DO_EVACUATE(save_Scav, TSO_LINK_LOCN);
 871     DO_EVACUATE(save_Scav, ((P_) &r->rStkO) - save_Scav);
 872     for(i = 0; liveness != 0; liveness >>= 1, i++) {
 873         if (liveness & 1) {
 874             DO_EVACUATE(save_Scav, ((P_) &r->rR[i].p) - save_Scav)
 875         }
 876     }
 877     Scav = save_Scav;
 878 #else
 879     DO_EVACUATE(Scav, TSO_LINK_LOCN);
 880     DO_EVACUATE(Scav, ((P_) &r->rStkO) - Scav);
 881     for(i = 0; liveness != 0; liveness >>= 1, i++) {
 882         if (liveness & 1) {
 883             DO_EVACUATE(Scav, ((P_) &r->rR[i].p) - Scav)
 884         }
 885     }
 886 #endif
 887
 888     PROFILE_CLOSURE(Scav, TSO_VHS + TSO_CTS_SIZE)
 889     NEXT_Scav(TSO_VHS + TSO_CTS_SIZE);
 890     return;
 891 }
 892
 893 void
 894 _Scavenge_StkO(STG_NO_ARGS)
 895 {
 896 #if defined(GCgn)
 897     P_ save_Scav;
 898 #endif
 899     I_  count;
 900     I_  sub = STKO_SuB_OFFSET(Scav);    /* Offset of first update frame in B stack */
 901
 902     DEBUG_SCAV_STKO;
 903
 904 #if defined(GCgn)
 905     /* No old generation roots should be created for mutable */
 906     /* pointer fields as they will be explicitly collected   */
 907     /* Ensure this by pointing Scav at the new generation    */
 908     save_Scav = Scav;
 909     Scav = OldGen + 1;
 910
 911     /* Evacuate the link */
 912     DO_EVACUATE(save_Scav, STKO_LINK_LOCN);
 913
 914     /* Evacuate the locations in the A stack */
 915     for (count = STKO_SpA_OFFSET(save_Scav);
 916       count <= STKO_CLOSURE_CTS_SIZE(save_Scav); count++) {
 917         STKO_DO_EVACUATE(count);
 918     }
 919
 920     /* Now evacuate the updatees in the update stack */
 921     while(sub > 0) {
 922         P_ subptr;
 923
 924         STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE));
 925         subptr = GRAB_SuB(STKO_CLOSURE_ADDR(save_Scav,sub));
 926         sub = STKO_CLOSURE_OFFSET(save_Scav, subptr);
 927     }
 928     Scav = save_Scav;
 929 #else
 930     /* Evacuate the link */
 931     DO_EVACUATE(Scav, STKO_LINK_LOCN);
 932
 933     /* Evacuate the locations in the A stack */
 934     for (count = STKO_SpA_OFFSET(Scav); count <= STKO_CLOSURE_CTS_SIZE(Scav); count++) {
 935         STKO_DO_EVACUATE(count);
 936     }
 937
 938     /* Now evacuate the updatees in the update stack */
 939     while(sub > 0) {
 940         P_ subptr;
 941
 942         STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE));
 943         subptr = GRAB_SuB(STKO_CLOSURE_ADDR(Scav,sub));
 944         sub = STKO_CLOSURE_OFFSET(Scav, subptr);
 945     }
 946 #endif
 947     PROFILE_CLOSURE(Scav, STKO_CLOSURE_SIZE(Scav))
 948     NEXT_Scav(STKO_CLOSURE_SIZE(Scav));
 949     return;
 950 }
 951
 952 #ifdef PAR
 953
 954 void
 955 _Scavenge_FetchMe(STG_NO_ARGS)
 956 {
 957     DEBUG_SCAV(2,0);
 958     PROFILE_CLOSURE(Scav,2);
 959     NEXT_Scav(2);
 960     return;
 961 }
 962
 963 void
 964 _Scavenge_BF(STG_NO_ARGS)
 965 {
 966 #if defined(GCgn)
 967     P_ save_Scav;
 968 #endif
 969
 970     DEBUG_SCAV_BF;
 971
 972 #if defined(GCgn)
 973     /* No old generation roots should be created for mutable */
 974     /* pointer fields as they will be explicitly collected   */
 975     /* Ensure this by pointing Scav at the new generation    */
 976     save_Scav = Scav;
 977     Scav = OldGen + 1;
 978
 979     DO_EVACUATE(save_Scav, BF_LINK_LOCN);
 980     DO_EVACUATE(save_Scav, BF_NODE_LOCN);
 981     Scav = save_Scav;
 982 #else
 983     DO_EVACUATE(Scav, BF_LINK_LOCN);
 984     DO_EVACUATE(Scav, BF_NODE_LOCN);
 985 #endif
 986
 987     PROFILE_CLOSURE(Scav, BF_CLOSURE_SIZE(dummy))
 988     NEXT_Scav(BF_CLOSURE_SIZE(dummy));
 989     return;
 990 }
 991
 992 #endif  /* PAR */
 993 #endif  /* CONCURRENT */
 994
 995 #if defined(GCgn)
 996
 997 /* Recently allocated old roots for promoted objects refernecing
 998    the new generation will be scavenged -- Just move to the next
 999 */
1000
1001 void
1002 _Scavenge_OldRoot(STG_NO_ARGS)
1003 {
1004     DEBUG_SCAV_OLDROOT(MIN_UPD_SIZE); /* dodgy size (WDP 95/07) */
1005     NEXT_Scav(MIN_UPD_SIZE);
1006     return;
1007 }
1008
1009 P_
1010 _Evacuate_OldRoot(evac)
1011 P_ evac;
1012 {
1013     fprintf(stderr,"Called _Evacuate_OldRoot: Closure %lx Info %lx\nShould never occur!\n",
1014             (W_) evac, (W_) INFO_PTR(evac));
1015     abort();
1016 }
1017
1018 #endif /* GCgn */
1019
1020 void
1021 _Scavenge_Forward_Ref(STG_NO_ARGS)
1022 {
1023     fprintf(stderr,"Called _Scavenge_Forward_Ref: Closure %lx Info %lx\nShould never occur!\n",
1024             (W_) Scav, (W_) INFO_PTR(Scav));
1025     abort();
1026 }
1027
1028
1029 #endif /* _INFO_COPYING */
1030
1031 \end{code}