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(DEBUG)
 129
 130 #define DEBUG_SCAV(s,p) \
 131     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 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 (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 188         fprintf(stderr, "Scav TSO: 0x%lx\n", \
 189                 Scav)
 190
 191 #define DEBUG_SCAV_STKO  \
 192     if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 193         fprintf(stderr, "Scav StkO: 0x%lx\n", \
 194                 Scav)
 195
 196 # if defined(PAR) || defined(GRAN)
 197 #  define DEBUG_SCAV_RBH(s,p) \
 198     if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 199         fprintf(stderr, "Scav RBH: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \
 200                 Scav, INFO_PTR(Scav), s, p)
 201
 202 #  define DEBUG_SCAV_BF \
 203     if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 204         fprintf(stderr, "Scav: 0x%lx, BF info 0x%lx, size %ld, ptrs %ld\n", \
 205                 Scav, INFO_PTR(Scav), BF_CLOSURE_SIZE(dummy), 0)
 206 # endif
 207 #endif
 208
 209 #else
 210
 211 #define DEBUG_SCAV(s,p)
 212 #define DEBUG_SCAV_GEN(s,p)
 213 #define DEBUG_SCAV_DYN
 214 #define DEBUG_SCAV_TUPLE
 215 #define DEBUG_SCAV_MUTUPLE
 216 #define DEBUG_SCAV_DATA
 217 #define DEBUG_SCAV_BH(s)
 218 #define DEBUG_SCAV_IND
 219 #define DEBUG_SCAV_PERM_IND
 220 #define DEBUG_SCAV_OLDROOT(s)
 221
 222 #ifdef CONCURRENT
 223 # define DEBUG_SCAV_BQ
 224 # define DEBUG_SCAV_TSO
 225 # define DEBUG_SCAV_STKO
 226 # if defined(PAR) || defined(GRAN)
 227 #  define DEBUG_SCAV_RBH(s,p)
 228 #  define DEBUG_SCAV_BF
 229 # endif
 230 #endif
 231
 232 #endif
 233
 234 #define PROFILE_CLOSURE(closure,size) \
 235     HEAP_PROFILE_CLOSURE(closure,size)
 236
 237 /*** SPECIALISED CODE ***/
 238
 239 #ifdef TICKY_TICKY
 240 void
 241 _Scavenge_0_0(STG_NO_ARGS)
 242 {
 243     DEBUG_SCAV(0,0);
 244     PROFILE_CLOSURE(Scav,0);
 245     NEXT_Scav(0); /* because "size" is defined to be 0 (size SPEC_VHS == 0) */
 246     return;
 247 }
 248 #endif
 249
 250 void
 251 _Scavenge_1_0(STG_NO_ARGS)
 252 {
 253     DEBUG_SCAV(1,0);
 254     PROFILE_CLOSURE(Scav,1);
 255     NEXT_Scav(1); /* because "size" is defined to be 1 (size SPEC_VHS == 0) */
 256     return;
 257 }
 258 void
 259 _Scavenge_1_1(STG_NO_ARGS)
 260 {
 261     DEBUG_SCAV(1,1);
 262     PROFILE_CLOSURE(Scav,1);
 263     SPEC_DO_EVACUATE(1);
 264     NEXT_Scav(1);
 265     return;
 266 }
 267 void
 268 _Scavenge_2_0(STG_NO_ARGS)
 269 {
 270     DEBUG_SCAV(2,0);
 271     PROFILE_CLOSURE(Scav,2);
 272     NEXT_Scav(2);
 273     return;
 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 void
 285 _Scavenge_2_2(STG_NO_ARGS)
 286 {
 287     DEBUG_SCAV(2,2);
 288     PROFILE_CLOSURE(Scav,2);
 289     SPEC_DO_EVACUATE(1);
 290     SPEC_DO_EVACUATE(2);
 291     NEXT_Scav(2);
 292     return;
 293 }
 294 void
 295 _Scavenge_3_0(STG_NO_ARGS)
 296 {
 297     DEBUG_SCAV(3,0);
 298     PROFILE_CLOSURE(Scav,3);
 299     NEXT_Scav(3);
 300     return;
 301 }
 302 void
 303 _Scavenge_3_1(STG_NO_ARGS)
 304 {
 305     DEBUG_SCAV(3,1);
 306     PROFILE_CLOSURE(Scav,3);
 307     SPEC_DO_EVACUATE(1);
 308     NEXT_Scav(3);
 309     return;
 310 }
 311 void
 312 _Scavenge_3_2(STG_NO_ARGS)
 313 {
 314     DEBUG_SCAV(3,2);
 315     PROFILE_CLOSURE(Scav,3);
 316     SPEC_DO_EVACUATE(1);
 317     SPEC_DO_EVACUATE(2);
 318     NEXT_Scav(3);
 319     return;
 320 }
 321 void
 322 _Scavenge_3_3(STG_NO_ARGS)
 323 {
 324     DEBUG_SCAV(3,3);
 325     PROFILE_CLOSURE(Scav,3);
 326     SPEC_DO_EVACUATE(1);
 327     SPEC_DO_EVACUATE(2);
 328     SPEC_DO_EVACUATE(3);
 329     NEXT_Scav(3);
 330     return;
 331 }
 332 void
 333 _Scavenge_4_0(STG_NO_ARGS)
 334 {
 335     DEBUG_SCAV(4,0);
 336     PROFILE_CLOSURE(Scav,4);
 337     NEXT_Scav(4);
 338     return;
 339 }
 340 void
 341 _Scavenge_4_4(STG_NO_ARGS)
 342 {
 343     DEBUG_SCAV(4,4);
 344     PROFILE_CLOSURE(Scav,4);
 345     SPEC_DO_EVACUATE(1);
 346     SPEC_DO_EVACUATE(2);
 347     SPEC_DO_EVACUATE(3);
 348     SPEC_DO_EVACUATE(4);
 349     NEXT_Scav(4);
 350     return;
 351 }
 352 void
 353 _Scavenge_5_0(STG_NO_ARGS)
 354 {
 355     DEBUG_SCAV(5,0);
 356     PROFILE_CLOSURE(Scav,5);
 357     NEXT_Scav(5);
 358     return;
 359 }
 360 void
 361 _Scavenge_5_5(STG_NO_ARGS)
 362 {
 363     DEBUG_SCAV(5,5);
 364     PROFILE_CLOSURE(Scav,5);
 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     NEXT_Scav(5);
 371     return;
 372 }
 373 void
 374 _Scavenge_6_6(STG_NO_ARGS)
 375 {
 376     DEBUG_SCAV(6,6);
 377     PROFILE_CLOSURE(Scav,6);
 378     SPEC_DO_EVACUATE(1);
 379     SPEC_DO_EVACUATE(2);
 380     SPEC_DO_EVACUATE(3);
 381     SPEC_DO_EVACUATE(4);
 382     SPEC_DO_EVACUATE(5);
 383     SPEC_DO_EVACUATE(6);
 384     NEXT_Scav(6);
 385     return;
 386 }
 387 void
 388 _Scavenge_7_7(STG_NO_ARGS)
 389 {
 390     DEBUG_SCAV(7,7);
 391     PROFILE_CLOSURE(Scav,7);
 392     SPEC_DO_EVACUATE(1);
 393     SPEC_DO_EVACUATE(2);
 394     SPEC_DO_EVACUATE(3);
 395     SPEC_DO_EVACUATE(4);
 396     SPEC_DO_EVACUATE(5);
 397     SPEC_DO_EVACUATE(6);
 398     SPEC_DO_EVACUATE(7);
 399     NEXT_Scav(7);
 400     return;
 401 }
 402 void
 403 _Scavenge_8_8(STG_NO_ARGS)
 404 {
 405     DEBUG_SCAV(8,8);
 406     PROFILE_CLOSURE(Scav,8);
 407     SPEC_DO_EVACUATE(1);
 408     SPEC_DO_EVACUATE(2);
 409     SPEC_DO_EVACUATE(3);
 410     SPEC_DO_EVACUATE(4);
 411     SPEC_DO_EVACUATE(5);
 412     SPEC_DO_EVACUATE(6);
 413     SPEC_DO_EVACUATE(7);
 414     SPEC_DO_EVACUATE(8);
 415     NEXT_Scav(8);
 416     return;
 417 }
 418 void
 419 _Scavenge_9_9(STG_NO_ARGS)
 420 {
 421     DEBUG_SCAV(9,9);
 422     PROFILE_CLOSURE(Scav,9);
 423     SPEC_DO_EVACUATE(1);
 424     SPEC_DO_EVACUATE(2);
 425     SPEC_DO_EVACUATE(3);
 426     SPEC_DO_EVACUATE(4);
 427     SPEC_DO_EVACUATE(5);
 428     SPEC_DO_EVACUATE(6);
 429     SPEC_DO_EVACUATE(7);
 430     SPEC_DO_EVACUATE(8);
 431     SPEC_DO_EVACUATE(9);
 432     NEXT_Scav(9);
 433     return;
 434 }
 435 void
 436 _Scavenge_10_10(STG_NO_ARGS)
 437 {
 438     DEBUG_SCAV(10,10);
 439     PROFILE_CLOSURE(Scav,10);
 440     SPEC_DO_EVACUATE(1);
 441     SPEC_DO_EVACUATE(2);
 442     SPEC_DO_EVACUATE(3);
 443     SPEC_DO_EVACUATE(4);
 444     SPEC_DO_EVACUATE(5);
 445     SPEC_DO_EVACUATE(6);
 446     SPEC_DO_EVACUATE(7);
 447     SPEC_DO_EVACUATE(8);
 448     SPEC_DO_EVACUATE(9);
 449     SPEC_DO_EVACUATE(10);
 450     NEXT_Scav(10);
 451     return;
 452 }
 453 void
 454 _Scavenge_11_11(STG_NO_ARGS)
 455 {
 456     DEBUG_SCAV(11,11);
 457     PROFILE_CLOSURE(Scav,11);
 458     SPEC_DO_EVACUATE(1);
 459     SPEC_DO_EVACUATE(2);
 460     SPEC_DO_EVACUATE(3);
 461     SPEC_DO_EVACUATE(4);
 462     SPEC_DO_EVACUATE(5);
 463     SPEC_DO_EVACUATE(6);
 464     SPEC_DO_EVACUATE(7);
 465     SPEC_DO_EVACUATE(8);
 466     SPEC_DO_EVACUATE(9);
 467     SPEC_DO_EVACUATE(10);
 468     SPEC_DO_EVACUATE(11);
 469     NEXT_Scav(11);
 470     return;
 471 }
 472 void
 473 _Scavenge_12_12(STG_NO_ARGS)
 474 {
 475     DEBUG_SCAV(12,12);
 476     PROFILE_CLOSURE(Scav,12);
 477     SPEC_DO_EVACUATE(1);
 478     SPEC_DO_EVACUATE(2);
 479     SPEC_DO_EVACUATE(3);
 480     SPEC_DO_EVACUATE(4);
 481     SPEC_DO_EVACUATE(5);
 482     SPEC_DO_EVACUATE(6);
 483     SPEC_DO_EVACUATE(7);
 484     SPEC_DO_EVACUATE(8);
 485     SPEC_DO_EVACUATE(9);
 486     SPEC_DO_EVACUATE(10);
 487     SPEC_DO_EVACUATE(11);
 488     SPEC_DO_EVACUATE(12);
 489     NEXT_Scav(12);
 490     return;
 491 }
 492 \end{code}
 493
 494 The scavenge routines for revertible black holes with underlying @SPEC@
 495 closures.
 496
 497 \begin{code}
 498
 499 #if defined(PAR) || defined(GRAN)
 500
 501 # if defined(GCgn)
 502
 503 #  define SCAVENGE_SPEC_RBH_N_1(n)      \
 504 void                                    \
 505 CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS)  \
 506 {                                       \
 507     I_ size = n + SPEC_RBH_VHS;         \
 508     P_ save_Scav;                       \
 509     DEBUG_SCAV_RBH(size,1);             \
 510     save_Scav = Scav;                   \
 511     Scav = OldGen + 1;                  \
 512     DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN);   \
 513     Scav = save_Scav;                   \
 514     PROFILE_CLOSURE(Scav,size);         \
 515     NEXT_Scav(size);                    \
 516 }
 517
 518 #  define SCAVENGE_SPEC_RBH_N_N(n)      \
 519 void                                    \
 520 CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 521 {                                       \
 522     I_ size = n + SPEC_RBH_VHS;         \
 523     int i;                              \
 524     P_ save_Scav;                       \
 525     DEBUG_SCAV_RBH(size,size-1);        \
 526     save_Scav = Scav;                   \
 527     Scav = OldGen + 1;                  \
 528     for(i = 0; i < n - 1; i++) {        \
 529         DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN + i);   \
 530     }                                   \
 531     Scav = save_Scav;                   \
 532     PROFILE_CLOSURE(Scav,size);         \
 533     NEXT_Scav(size);                    \
 534 }
 535
 536 # else
 537
 538 #  define SCAVENGE_SPEC_RBH_N_1(n)      \
 539 void                                    \
 540 CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS)  \
 541 {                                       \
 542     I_ size = n + SPEC_RBH_VHS;         \
 543     DEBUG_SCAV_RBH(size,1);             \
 544     DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN);\
 545     PROFILE_CLOSURE(Scav,size);         \
 546     NEXT_Scav(size);                    \
 547 }
 548
 549 #  define SCAVENGE_SPEC_RBH_N_N(n)      \
 550 void                                    \
 551 CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \
 552 {                                       \
 553     I_ size = n + SPEC_RBH_VHS;         \
 554     int i;                              \
 555     DEBUG_SCAV_RBH(size,size-1);        \
 556     for(i = 0; i < n - 1; i++) {        \
 557         DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN + i);    \
 558     }                                   \
 559     PROFILE_CLOSURE(Scav,size);         \
 560     NEXT_Scav(size);                    \
 561 }
 562
 563 # endif
 564
 565 SCAVENGE_SPEC_RBH_N_1(2)
 566
 567 SCAVENGE_SPEC_RBH_N_1(3)
 568 SCAVENGE_SPEC_RBH_N_N(3)
 569
 570 SCAVENGE_SPEC_RBH_N_1(4)
 571 SCAVENGE_SPEC_RBH_N_N(4)
 572
 573 SCAVENGE_SPEC_RBH_N_1(5)
 574 SCAVENGE_SPEC_RBH_N_N(5)
 575
 576 SCAVENGE_SPEC_RBH_N_N(6)
 577 SCAVENGE_SPEC_RBH_N_N(7)
 578 SCAVENGE_SPEC_RBH_N_N(8)
 579 SCAVENGE_SPEC_RBH_N_N(9)
 580 SCAVENGE_SPEC_RBH_N_N(10)
 581 SCAVENGE_SPEC_RBH_N_N(11)
 582 SCAVENGE_SPEC_RBH_N_N(12)
 583
 584 #endif
 585
 586 \end{code}
 587
 588 \begin{code}
 589
 590 #ifndef PAR
 591 /*** Foreign Object -- NOTHING TO SCAVENGE ***/
 592
 593 /* (The ForeignObjList is updated at the end of GC and any unevacuated
 594     ForeignObjs are finalised)  [ADR][SOF]
 595 */
 596
 597 void
 598 _Scavenge_ForeignObj(STG_NO_ARGS)
 599 {
 600     I_ size = ForeignObj_SIZE;
 601     DEBUG_SCAV(size,0);
 602     PROFILE_CLOSURE(Scav,size);
 603     NEXT_Scav(size);
 604     return;
 605 }
 606 #endif /* !PAR */
 607
 608 /*** GENERAL CASE CODE ***/
 609
 610 void
 611 _Scavenge_S_N(STG_NO_ARGS)
 612 {
 613     I_ count = GEN_HS - 1;
 614                    /* Offset of first ptr word, less 1 */
 615     I_ ptrs = count + GEN_CLOSURE_NoPTRS(Scav);
 616                    /* Offset of last ptr word */
 617     I_ size = GEN_CLOSURE_SIZE(Scav);
 618
 619     DEBUG_SCAV_GEN(size, GEN_CLOSURE_NoPTRS(Scav));
 620
 621     while (++count <= ptrs) {
 622         DO_EVACUATE(Scav, count);
 623     }
 624     PROFILE_CLOSURE(Scav,size);
 625     NEXT_Scav(size);
 626     return;
 627 }
 628
 629 \end{code}
 630
 631 The scavenge code for revertible black holes with underlying @GEN@ closures
 632
 633 \begin{code}
 634
 635 #if defined(PAR) || defined(GRAN)
 636
 637 void
 638 _Scavenge_RBH_N(STG_NO_ARGS)
 639 {
 640 #if defined(GCgn)
 641     P_ save_Scav;
 642 #endif
 643
 644     I_ count = GEN_RBH_HS - 1;  /* Offset of first ptr word, less 1 */
 645     I_ ptrs = GEN_RBH_CLOSURE_NoPTRS(Scav);
 646     I_ size = GEN_RBH_CLOSURE_SIZE(Scav);
 647
 648     /*
 649      * Get pointer count from original closure and adjust for one pointer
 650      * in the first two words of the RBH.
 651      */
 652     if (ptrs < 2)
 653         ptrs = 1;
 654     else
 655         ptrs--;
 656
 657     ptrs += count;          /* Offset of last ptr word */
 658
 659     DEBUG_SCAV_GEN(size, ptrs);
 660
 661 #if defined(GCgn)
 662     /* No old generation roots should be created for mutable */
 663     /* pointer fields as they will be explicitly collected   */
 664     /* Ensure this by pointing Scav at the new generation    */
 665     save_Scav = Scav;
 666     Scav = OldGen + 1;
 667
 668     while (++count <= ptrs) {
 669         DO_EVACUATE(save_Scav, count);
 670     }
 671     Scav = save_Scav;
 672 #else
 673     while (++count <= ptrs) {
 674         DO_EVACUATE(Scav, count);
 675     }
 676 #endif
 677
 678     PROFILE_CLOSURE(Scav,size);
 679     NEXT_Scav(size);
 680     return;
 681 }
 682
 683 #endif
 684
 685 \end{code}
 686
 687 \begin{code}
 688
 689 /*** DYNAMIC CLOSURE -- SIZE & PTRS STORED IN CLOSURE ***/
 690
 691 void
 692 _Scavenge_Dyn(STG_NO_ARGS)
 693 {
 694     I_ count = DYN_HS - 1;
 695                    /* Offset of first ptr word, less 1 */
 696     I_ ptrs = count + DYN_CLOSURE_NoPTRS(Scav);
 697                    /* Offset of last ptr word */
 698     I_ size = DYN_CLOSURE_SIZE(Scav);
 699
 700     DEBUG_SCAV_DYN;
 701     while (++count <= ptrs) {
 702         DO_EVACUATE(Scav, count);
 703     }
 704     PROFILE_CLOSURE(Scav,size);
 705     NEXT_Scav(size);
 706     return;
 707 }
 708
 709 /*** TUPLE CLOSURE -- NO PTRS STORED IN CLOSURE -- NO DATA ***/
 710
 711 void
 712 _Scavenge_Tuple(STG_NO_ARGS)
 713 {
 714     I_ count = TUPLE_HS - 1;
 715                    /* Offset of first ptr word, less 1 */
 716     I_ ptrs  = count + TUPLE_CLOSURE_NoPTRS(Scav);
 717                    /* Offset of last ptr word */
 718     I_ size  = TUPLE_CLOSURE_SIZE(Scav);
 719
 720     DEBUG_SCAV_TUPLE;
 721     while (++count <= ptrs) {
 722         DO_EVACUATE(Scav, count);
 723     }
 724     PROFILE_CLOSURE(Scav,size);
 725     NEXT_Scav(size);
 726     return;
 727 }
 728
 729 /*** DATA CLOSURE -- SIZE STORED IN CLOSURE -- NO POINTERS ***/
 730
 731 void
 732 _Scavenge_Data(STG_NO_ARGS)
 733 {
 734     I_ size = DATA_CLOSURE_SIZE(Scav);
 735
 736     DEBUG_SCAV_DATA;
 737     PROFILE_CLOSURE(Scav,size);
 738     NEXT_Scav(size);
 739     return;
 740 }
 741
 742 /*** MUTUPLE CLOSURE -- ONLY PTRS STORED IN CLOSURE -- NO DATA ***/
 743 /*             Only if special GC treatment required           */
 744
 745 #ifdef GC_MUT_REQUIRED
 746 void
 747 _Scavenge_MuTuple(STG_NO_ARGS)
 748 {
 749 #if defined(GCgn)
 750     P_ save_Scav;
 751 #endif
 752     I_ count = MUTUPLE_HS - 1;
 753                    /* Offset of first ptr word, less 1 */
 754     I_ ptrs  = count + MUTUPLE_CLOSURE_NoPTRS(Scav);
 755                    /* Offset of last ptr word */
 756     I_ size  = MUTUPLE_CLOSURE_SIZE(Scav);
 757
 758     DEBUG_SCAV_MUTUPLE;
 759
 760 #if defined(GCgn)
 761     /* No old generation roots should be created for mutable */
 762     /* pointer fields as they will be explicitly collected   */
 763     /* Ensure this by pointing Scav at the new generation    */
 764     save_Scav = Scav;
 765     Scav = OldGen + 1;
 766     while (++count <= ptrs) {
 767         DO_EVACUATE(save_Scav, count);
 768     }
 769     Scav = save_Scav;
 770 #else  /* GCap */
 771     while (++count <= ptrs) {
 772         DO_EVACUATE(Scav, count);
 773     }
 774 #endif /* GCap */
 775
 776     PROFILE_CLOSURE(Scav,size);
 777     NEXT_Scav(size);
 778     return;
 779 }
 780 #endif /* something generational */
 781
 782 /*** BH CLOSURES -- NO POINTERS ***/
 783
 784 void
 785 _Scavenge_BH_U(STG_NO_ARGS)
 786 {
 787     I_ size = BH_U_SIZE;
 788     DEBUG_SCAV_BH(size);
 789     PROFILE_CLOSURE(Scav,size);
 790     NEXT_Scav(size);
 791     return;
 792 }
 793
 794 void
 795 _Scavenge_BH_N(STG_NO_ARGS)
 796 {
 797     I_ size = BH_N_SIZE;
 798     DEBUG_SCAV_BH(size);
 799     PROFILE_CLOSURE(Scav,size);
 800     NEXT_Scav(size);
 801     return;
 802 }
 803
 804 /* This is needed for scavenging indirections that "hang around";
 805     e.g., because they are on the OldMutables list, or
 806     because we have "turned off" shorting-out of indirections
 807     (in SMevac.lc).
 808 */
 809 void
 810 _Scavenge_Ind(STG_NO_ARGS)
 811 {
 812     I_ size = IND_CLOSURE_SIZE(dummy);
 813     DEBUG_SCAV_IND;
 814     PROFILE_CLOSURE(Scav,size);
 815     DO_EVACUATE(Scav, IND_HS);
 816     NEXT_Scav(size);
 817     return;
 818 }
 819
 820 void
 821 _Scavenge_Caf(STG_NO_ARGS)
 822 {
 823     I_ size = IND_CLOSURE_SIZE(dummy);
 824     DEBUG_SCAV_IND;
 825     PROFILE_CLOSURE(Scav,size);
 826     DO_EVACUATE(Scav, IND_HS);
 827     NEXT_Scav(size);
 828     return;
 829 }
 830
 831 #if defined(PROFILING) || defined(TICKY_TICKY)
 832
 833 /* Special permanent indirection for lexical scoping.
 834    As for _Scavenge_Ind but no PROFILE_CLOSURE.
 835 */
 836
 837 void
 838 _Scavenge_PI(STG_NO_ARGS)
 839 {
 840     I_ size = IND_CLOSURE_SIZE(dummy);
 841     DEBUG_SCAV_PERM_IND;
 842     /* PROFILE_CLOSURE(Scav,size); */
 843     DO_EVACUATE(Scav, IND_HS);
 844     NEXT_Scav(size);
 845     return;
 846 }
 847 #endif /* PROFILING or TICKY */
 848
 849 #ifdef CONCURRENT
 850
 851 void
 852 _Scavenge_BQ(STG_NO_ARGS)
 853 {
 854     I_ size = BQ_CLOSURE_SIZE(dummy);
 855 #if defined(GCgn)
 856     P_ save_Scav;
 857 #endif
 858
 859     DEBUG_SCAV_BQ;
 860
 861 #if defined(GCgn)
 862     /* No old generation roots should be created for mutable */
 863     /* pointer fields as they will be explicitly collected   */
 864     /* Ensure this by pointing Scav at the new generation    */
 865     save_Scav = Scav;
 866     Scav = OldGen + 1;
 867     DO_EVACUATE(save_Scav, BQ_HS);
 868     Scav = save_Scav;
 869 #else  /* !GCgn */
 870     DO_EVACUATE(Scav, BQ_HS);
 871 #endif /* GCgn */
 872
 873     PROFILE_CLOSURE(Scav,size);
 874     NEXT_Scav(size);
 875     return;
 876 }
 877
 878 void
 879 _Scavenge_TSO(STG_NO_ARGS)
 880 {
 881     I_ size = TSO_VHS + TSO_CTS_SIZE;
 882 #if defined(GCgn)
 883     P_ save_Scav;
 884 #endif
 885     STGRegisterTable *r = TSO_INTERNAL_PTR(Scav);
 886     W_ liveness = r->rLiveness;
 887     I_ i;
 888
 889     DEBUG_SCAV_TSO;
 890
 891 #if defined(GCgn)
 892     /* old and probably wrong -- deleted (WDP 95/12) */
 893 #else
 894     DO_EVACUATE(Scav, TSO_LINK_LOCN);
 895
 896     DO_EVACUATE(Scav, ((P_) &r->rStkO) - Scav);
 897
 898     for (i = 0; liveness != 0; liveness >>= 1, i++) {
 899         if (liveness & 1) {
 900             DO_EVACUATE(Scav, ((P_) &r->rR[i].p) - Scav)
 901         }
 902     }
 903 #endif
 904
 905     PROFILE_CLOSURE(Scav, size);
 906     NEXT_Scav(size);
 907     return;
 908 }
 909
 910 int /* ToDo: move? */
 911 sanityChk_StkO(P_ stko)
 912 {
 913     I_ size = STKO_CLOSURE_SIZE(stko);
 914     I_ cts_size = STKO_CLOSURE_CTS_SIZE(stko);
 915     I_ count;
 916     I_ sub = STKO_SuB_OFFSET(stko);     /* Offset of first update frame in B stack */
 917     I_ prev_sub;
 918     P_ begin_stko  = STKO_CLOSURE_ADDR(stko, 0);
 919     P_ beyond_stko = STKO_CLOSURE_ADDR(stko, cts_size+1);
 920
 921     /*fprintf(stderr, "stko=%lx; SpA offset=%ld; first SuB=%ld, size=%ld; next=%lx\n",stko,STKO_SpA_OFFSET(stko),sub,STKO_CLOSURE_CTS_SIZE(stko),STKO_LINK(stko));*/
 922
 923     /* Evacuate the locations in the A stack */
 924     for (count = STKO_SpA_OFFSET(stko); count <= cts_size; count++) {
 925         ASSERT(count >= 0);
 926     }
 927
 928     while(sub > 0) {
 929         P_  subptr;
 930         PP_ suaptr;
 931         P_  updptr;
 932         P_  retptr;
 933
 934         ASSERT(sub >= 1);
 935         ASSERT(sub <= cts_size);
 936
 937         retptr = GRAB_RET(STKO_CLOSURE_ADDR(stko,sub));
 938         subptr = GRAB_SuB(STKO_CLOSURE_ADDR(stko,sub));
 939         suaptr = GRAB_SuA(STKO_CLOSURE_ADDR(stko,sub));
 940         updptr = GRAB_UPDATEE(STKO_CLOSURE_ADDR(stko,sub));
 941
 942         ASSERT(subptr >= begin_stko);
 943         ASSERT(subptr <  beyond_stko);
 944
 945         ASSERT(suaptr >= begin_stko);
 946         ASSERT(suaptr <=  beyond_stko);
 947
 948         /* ToDo: would be nice to chk that retptr is in text space */
 949
 950         sub = STKO_CLOSURE_OFFSET(stko, subptr);
 951     }
 952
 953     return 1;
 954 }
 955
 956 void
 957 _Scavenge_StkO(STG_NO_ARGS)
 958 {
 959     I_ size = STKO_CLOSURE_SIZE(Scav);
 960 #if defined(GCgn)
 961     P_ save_Scav;
 962 #endif
 963     I_  count;
 964     I_  sub = STKO_SuB_OFFSET(Scav);    /* Offset of first update frame in B stack */
 965
 966     DEBUG_SCAV_STKO;
 967
 968 #if defined(GCgn)
 969     /* deleted; probably wrong */
 970 #else
 971     ASSERT(sanityChk_StkO(Scav));
 972
 973     /* Evacuate the link */
 974     DO_EVACUATE(Scav, STKO_LINK_LOCN);
 975
 976     /* Evacuate the locations in the A stack */
 977     for (count = STKO_SpA_OFFSET(Scav); count <= STKO_CLOSURE_CTS_SIZE(Scav); count++) {
 978         STKO_DO_EVACUATE(count);
 979     }
 980
 981     /* Now evacuate the updatees in the update stack */
 982     while(sub > 0) {
 983         P_ subptr;
 984
 985         STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE));
 986         subptr = GRAB_SuB(STKO_CLOSURE_ADDR(Scav,sub));
 987
 988         sub = STKO_CLOSURE_OFFSET(Scav, subptr);
 989     }
 990
 991 #endif
 992     PROFILE_CLOSURE(Scav, size);
 993     NEXT_Scav(size);
 994     return;
 995 }
 996
 997 #ifdef PAR
 998
 999 void
1000 _Scavenge_FetchMe(STG_NO_ARGS)
1001 {
1002     I_ size = FETCHME_CLOSURE_SIZE(dummy);
1003     DEBUG_SCAV(size,0);
1004     PROFILE_CLOSURE(Scav,size);
1005     NEXT_Scav(size);
1006     return;
1007 }
1008
1009 void
1010 _Scavenge_BF(STG_NO_ARGS)
1011 {
1012     I_ size = BF_CLOSURE_SIZE(dummy);
1013 #if defined(GCgn)
1014     P_ save_Scav;
1015 #endif
1016
1017     DEBUG_SCAV_BF;
1018
1019 #if defined(GCgn)
1020     /* No old generation roots should be created for mutable */
1021     /* pointer fields as they will be explicitly collected   */
1022     /* Ensure this by pointing Scav at the new generation    */
1023     save_Scav = Scav;
1024     Scav = OldGen + 1;
1025
1026     DO_EVACUATE(save_Scav, BF_LINK_LOCN);
1027     DO_EVACUATE(save_Scav, BF_NODE_LOCN);
1028     Scav = save_Scav;
1029 #else
1030     DO_EVACUATE(Scav, BF_LINK_LOCN);
1031     DO_EVACUATE(Scav, BF_NODE_LOCN);
1032 #endif
1033
1034     PROFILE_CLOSURE(Scav, size);
1035     NEXT_Scav(size);
1036     return;
1037 }
1038
1039 #endif  /* PAR */
1040 #endif  /* CONCURRENT */
1041
1042 #if defined(GCgn)
1043
1044 /* Recently allocated old roots for promoted objects refernecing
1045    the new generation will be scavenged -- Just move to the next
1046 */
1047
1048 void
1049 _Scavenge_OldRoot(STG_NO_ARGS)
1050 {
1051     I_ size = ?????
1052     DEBUG_SCAV_OLDROOT(size);
1053     NEXT_Scav(size);
1054     return;
1055 }
1056
1057 P_
1058 _Evacuate_OldRoot(evac)
1059 P_ evac;
1060 {
1061     fprintf(stderr,"Called _Evacuate_OldRoot: Closure %lx Info %lx\nShould never occur!\n",
1062             (W_) evac, (W_) INFO_PTR(evac));
1063     abort();
1064 }
1065
1066 #endif /* GCgn */
1067
1068 void
1069 _Scavenge_Forward_Ref(STG_NO_ARGS)
1070 {
1071     fprintf(stderr,"Called _Scavenge_Forward_Ref: Closure %lx Info %lx\nShould never occur!\n",
1072             (W_) Scav, (W_) INFO_PTR(Scav));
1073     abort();
1074 }
1075
1076
1077 #endif /* _INFO_COPYING */
1078
1079 \end{code}