ghc/runtime/storage/SMevac.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 SMevac.lc contains the evacuation routines ...
  10
  11 See SMscav.lhc for calling convention documentation.
  12
  13 %****************************************************************************
  14
  15 \begin{code}
  16 #define  SCAV_REG_MAP
  17 #include "SMinternal.h"
  18
  19 #if defined(_INFO_COPYING)
  20
  21 /* Moves ToHp to point at the info pointer of the new to-space closure */
  22 #define START_ALLOC(size)     ToHp += 1
  23
  24 /* Moves ToHp to point to the last word allocated in to-space */
  25 #define FINISH_ALLOC(size)    ToHp += (FIXED_HS-1) + (size)
  26
  27
  28 /* Copy the ith word (starting at 0) */
  29 #define COPY_WORD(position)    ToHp[position] = evac[position]
  30
  31 /* Copy the ith ptr (starting at 0), adjusting by offset */
  32 #define ADJUST_WORD(pos,off)   ((PP_)ToHp)[pos] = ((PP_)evac)[pos] + (off)
  33
  34 /* Copy the nth free var word in a SPEC closure (starting at 1) */
  35 #define SPEC_COPY_FREE_VAR(n)  COPY_WORD((SPEC_HS-1) + (n))
  36
  37 #if FIXED_HS == 1
  38 #define COPY_FIXED_HDR         COPY_WORD(0)
  39 #else
  40 #if FIXED_HS == 2
  41 #define COPY_FIXED_HDR         COPY_WORD(0);COPY_WORD(1)
  42 #else
  43 #if FIXED_HS == 3
  44 #define COPY_FIXED_HDR         COPY_WORD(0);COPY_WORD(1);COPY_WORD(2)
  45 #else
  46 /* I don't think this will be needed (ToDo: #error?) */
  47 #endif /* FIXED_HS != 1, 2, or 3 */
  48 #endif
  49 #endif
  50
  51
  52 /*** DEBUGGING MACROS ***/
  53
  54 #if defined(DEBUG)
  55
  56 #define DEBUG_EVAC(sizevar) \
  57     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  58         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, info 0x%lx, size %ld\n", \
  59                 evac, ToHp, INFO_PTR(evac), sizevar)
  60
  61 #define DEBUG_EVAC_DYN   \
  62     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  63         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Dyn info 0x%lx, size %lu\n", \
  64                 evac, ToHp, INFO_PTR(evac), DYN_CLOSURE_SIZE(evac))
  65
  66 #define DEBUG_EVAC_TUPLE \
  67     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  68         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Tuple info 0x%lx, size %lu\n", \
  69                 evac, ToHp, INFO_PTR(evac), TUPLE_CLOSURE_SIZE(evac))
  70
  71 #define DEBUG_EVAC_MUTUPLE \
  72     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  73         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, MuTuple info 0x%lx, size %lu\n", \
  74                 evac, ToHp, INFO_PTR(evac), MUTUPLE_CLOSURE_SIZE(evac))
  75
  76 #define DEBUG_EVAC_DATA  \
  77     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  78         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Data info 0x%lx, size %lu\n", \
  79                 evac, ToHp, INFO_PTR(evac), DATA_CLOSURE_SIZE(evac))
  80
  81 #define DEBUG_EVAC_BH(sizevar) \
  82     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  83         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BH info 0x%lx, size %ld\n", \
  84                 evac, ToHp, INFO_PTR(evac), sizevar)
  85
  86 #define DEBUG_EVAC_FORWARD \
  87     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  88         fprintf(stderr, "Evac: Forward 0x%lx -> 0x%lx, info 0x%lx\n", \
  89                 evac, FORWARD_ADDRESS(evac), INFO_PTR(evac))
  90
  91 #define DEBUG_EVAC_IND1 \
  92     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  93         fprintf(stderr, "Evac: Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
  94                 evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
  95
  96 #define DEBUG_EVAC_IND2 \
  97     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
  98         fprintf(stderr, "Evac: Indirection Done -> 0x%lx\n", evac)
  99
 100 #define DEBUG_EVAC_PERM_IND \
 101     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 102         fprintf(stderr, "Evac: Permanent Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
 103                 evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 104
 105 #define DEBUG_EVAC_CAF_EVAC1 \
 106     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 107         fprintf(stderr, "Evac: Caf 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
 108                 evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 109
 110 #define DEBUG_EVAC_CAF_EVAC2 \
 111     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 112         fprintf(stderr, "Evac: Caf Done -> 0x%lx\n", evac)
 113
 114 #define DEBUG_EVAC_CAF_RET \
 115     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 116         fprintf(stderr, "Evac: Caf 0x%lx -> 0x%lx, info 0x%lx\n", \
 117                 evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
 118
 119 #define DEBUG_EVAC_STAT \
 120     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 121         fprintf(stderr, "Evac: Static 0x%lx -> 0x%lx, info 0x%lx\n", \
 122                 evac, evac, INFO_PTR(evac))
 123
 124 #define DEBUG_EVAC_CONST \
 125     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 126         fprintf(stderr, "Evac: Const 0x%lx -> 0x%lx, info 0x%lx\n", \
 127                 evac, CONST_STATIC_CLOSURE(INFO_PTR(evac)), INFO_PTR(evac))
 128
 129 #define DEBUG_EVAC_CHARLIKE \
 130     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 131         fprintf(stderr, "Evac: CharLike (%lx) 0x%lx -> 0x%lx, info 0x%lx\n", \
 132                 evac, CHARLIKE_VALUE(evac), CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac)), INFO_PTR(evac))
 133
 134 #define DEBUG_EVAC_INTLIKE_TO_STATIC \
 135     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 136         fprintf(stderr, "Evac: IntLike to Static (%ld) 0x%lx -> 0x%lx, info 0x%lx\n", \
 137                 INTLIKE_VALUE(evac), evac, INTLIKE_CLOSURE(INTLIKE_VALUE(evac)), INFO_PTR(evac))
 138
 139 #define DEBUG_EVAC_TO_OLD \
 140     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 141         fprintf(stderr, "Old ")
 142
 143 #define DEBUG_EVAC_TO_NEW \
 144     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 145         fprintf(stderr, "New ")
 146
 147 #define DEBUG_EVAC_OLD_TO_NEW(oldind, evac, new) \
 148     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \
 149         fprintf(stderr, "  OldRoot: 0x%lx -> Old 0x%lx (-> New 0x%lx)\n", \
 150                          evac, oldind, newevac)
 151
 152 #define DEBUG_EVAC_OLDROOT_FORWARD \
 153     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) { \
 154         fprintf(stderr, "Evac: OldRoot Forward 0x%lx -> Old 0x%lx ", evac, FORWARD_ADDRESS(evac)); \
 155         if (! InOldGen(Scav)) fprintf(stderr, "-> New 0x%lx ", IND_CLOSURE_PTR(FORWARD_ADDRESS(evac))); \
 156         fprintf(stderr, "info 0x%lx\n", INFO_PTR(evac)); \
 157     }
 158
 159 #ifdef CONCURRENT
 160 #define DEBUG_EVAC_BQ \
 161     if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 162         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BQ info 0x%lx, size %lu\n", \
 163                 evac, ToHp, INFO_PTR(evac), BQ_CLOSURE_SIZE(evac))
 164
 165 #define DEBUG_EVAC_TSO(size) \
 166     if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 167         fprintf(stderr, "Evac TSO: 0x%lx -> 0x%lx, size %ld\n", \
 168                 evac, ToHp, size)
 169
 170 #define DEBUG_EVAC_STKO(a,b) \
 171     if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 172         fprintf(stderr, "Evac StkO: 0x%lx -> 0x%lx, size %ld (A), %ld (B)\n", \
 173                 evac, ToHp, a, b)
 174
 175 # ifdef PAR
 176 #  define DEBUG_EVAC_BF \
 177     if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \
 178         fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BF info 0x%lx, size %lu\n", \
 179                 evac, ToHp, INFO_PTR(evac), BF_CLOSURE_SIZE(dummy))
 180 # endif
 181
 182 #endif
 183
 184 #else
 185
 186 #define DEBUG_EVAC(size)
 187 #define DEBUG_EVAC_DYN
 188 #define DEBUG_EVAC_TUPLE
 189 #define DEBUG_EVAC_MUTUPLE
 190 #define DEBUG_EVAC_DATA
 191 #define DEBUG_EVAC_BH(size)
 192 #define DEBUG_EVAC_FORWARD
 193 #define DEBUG_EVAC_IND1
 194 #define DEBUG_EVAC_IND2
 195 #define DEBUG_EVAC_PERM_IND
 196 #define DEBUG_EVAC_CAF_EVAC1
 197 #define DEBUG_EVAC_CAF_EVAC2
 198 #define DEBUG_EVAC_CAF_RET
 199 #define DEBUG_EVAC_STAT
 200 #define DEBUG_EVAC_CONST
 201 #define DEBUG_EVAC_CHARLIKE
 202 #define DEBUG_EVAC_INTLIKE_TO_STATIC
 203 #define DEBUG_EVAC_TO_OLD
 204 #define DEBUG_EVAC_TO_NEW
 205 #define DEBUG_EVAC_OLDROOT_FORWARD
 206 #define DEBUG_EVAC_OLD_TO_NEW(oldind, evac, new)
 207
 208 #ifdef CONCURRENT
 209 # define DEBUG_EVAC_BQ
 210 # define DEBUG_EVAC_TSO(size)
 211 # define DEBUG_EVAC_STKO(s,size)
 212 # ifdef PAR
 213 #  define DEBUG_EVAC_BF
 214 # endif
 215 #endif
 216
 217 #endif /* not DEBUG */
 218
 219
 220 #if defined(GCgn)
 221
 222 /* Evacuation with Promotion -- Have to decide if we promote ! */
 223 /* This is done by fiddling the ToHp pointer before calling    */
 224 /* the real _do_Evacute code, passing reqd forward ref info    */
 225
 226 /* Is a heap ptr in the old generation ? */
 227 #define InOldGen(hpptr)    (((P_)(hpptr)) <= OldGen)
 228
 229 /* Should we promote to the old generation ? */
 230 #define ShouldPromote(evac) (((P_)(evac)) <  AllocGen)
 231
 232
 233 /*** Real Evac Code -- passed closure & forward ref info ***/
 234
 235 #define EVAC_FN(suffix) \
 236         P_ CAT2(_do_Evacuate_,suffix)(evac, forward_info) \
 237         P_ evac; P_ forward_info;
 238
 239
 240 /*** Evac Decision Code -- calls real evac code ***/
 241
 242 extern P_ _Evacuate_Old_to_New();
 243
 244 #define GEN_EVAC_CODE(suffix)                   \
 245     P_ CAT2(_Evacuate_,suffix)(evac)            \
 246         P_ evac;                                \
 247     {                                           \
 248         P_ newevac, tmp;                        \
 249         if (ShouldPromote(evac)) {              \
 250             DEBUG_EVAC_TO_OLD;                  \
 251             tmp = ToHp; ToHp = OldHp;           \
 252             newevac = CAT2(_do_Evacuate_,suffix)(evac, (P_)Forward_Ref_Old_info); \
 253             OldHp = ToHp; ToHp = tmp;           \
 254         } else {                                \
 255             DEBUG_EVAC_TO_NEW;                  \
 256             newevac = CAT2(_do_Evacuate_,suffix)(evac, (P_)Forward_Ref_New_info); \
 257                                                 \
 258             /* Check if new gen closure is scavenged from the old gen */ \
 259             if (InOldGen(Scav)) {               \
 260                 newevac = (P_) _Evacuate_Old_to_New(newevac, evac); \
 261             }                                   \
 262         }                                       \
 263         return newevac;                         \
 264     }
 265
 266
 267 /*** FORWARD REF STUFF ***/
 268
 269 /*** Setting Forward Ref: grab argument passed to evac code ***/
 270
 271 /* Note that writing in the forwarding address trashes part of the
 272    closure.  This is normally fine since, if we want the data, we'll
 273    have made a copy of it.
 274
 275    But, Foreign Object closures are special: we have to make sure that
 276    we don't damage either the linked list (which will include both
 277    copied and uncopied Foreign objs) or the data (which we must report
 278    to the outside world).  Foreign Objects closures are carefully designed
 279    to have a little extra space in them that can be safely
 280    overwritten. [ADR]
 281 */
 282
 283 #define SET_FORWARD_REF(closure, forw) \
 284             SET_INFO_PTR(closure,forward); /* arg passed to evac function */ \
 285             FORWARD_ADDRESS(closure) = (W_)(forw)
 286
 287
 288 EVAC_FN(Old_Forward_Ref)
 289 {
 290     /* Forward ref to old generation -- just return */
 291     DEBUG_EVAC_FORWARD;
 292
 293     evac = (P_) FORWARD_ADDRESS(evac);
 294     return(evac);
 295 }
 296
 297 EVAC_FN(New_Forward_Ref)
 298 {
 299     /* Forward ref to new generation -- check scavenged from the old gen */
 300     DEBUG_EVAC_FORWARD;
 301
 302     if (InOldGen(Scav)) {
 303         evac = (P_) _Evacuate_Old_to_New(FORWARD_ADDRESS(evac), evac);
 304     } else {
 305         evac = (P_) FORWARD_ADDRESS(evac);
 306     }
 307     return(evac);
 308 }
 309
 310 EVAC_FN(OldRoot_Forward)
 311 {
 312     /* Forward ref to old generation root -- return old root or new gen closure */
 313     DEBUG_EVAC_OLDROOT_FORWARD;
 314
 315     /* grab old generation root */
 316     evac = (P_) FORWARD_ADDRESS(evac);
 317
 318     /* if scavenging new generation return the new generation
 319        closure rather than the old generation root */
 320     if (! InOldGen(Scav)) {
 321         evac = (P_) IND_CLOSURE_PTR(evac);
 322     }
 323
 324     return(evac);
 325 }
 326
 327 EXTDATA_RO(Forward_Ref_New_info);
 328 EXTDATA_RO(Forward_Ref_Old_info);
 329 EXTDATA_RO(OldRoot_Forward_Ref_info);
 330
 331 /*** Old Gen Reference to New Gen Closure ***/
 332
 333 P_
 334 _Evacuate_Old_to_New(newevac, evac)
 335 P_ newevac, evac;
 336 {
 337     /* New generation closure referenced from the old generation           */
 338     /*    allocate old generation indirection to newevac                   */
 339     /*    reset forward reference in original allocation area to oldind    */
 340     /*      evacuating this should return the old root or the new gen      */
 341     /*      closure depending if referenced from the old generation        */
 342     /*    return oldind as evacuated location                              */
 343     /*      reference from oldgen will be to this oldind closure           */
 344
 345     P_ oldind = OldHp + 1;                     /* see START_ALLOC  */
 346     OldHp = oldind + (FIXED_HS-1) + MIN_UPD_SIZE;  /* see FINISH_ALLOC */
 347
 348     DEBUG_EVAC_OLD_TO_NEW(oldind, evac, newevac);
 349
 350     INFO_PTR(evac)           = (W_) OldRoot_Forward_Ref_info;
 351     FORWARD_ADDRESS(evac)    = (W_)oldind;
 352
 353     INFO_PTR(oldind)         = (W_) OldRoot_info;
 354     IND_CLOSURE_PTR(oldind)  = (W_) newevac;
 355     IND_CLOSURE_LINK(oldind) = (W_) genInfo.OldInNew;
 356     genInfo.OldInNew = oldind;
 357     genInfo.OldInNewno++;
 358
 359     return oldind;
 360 }
 361
 362 #define PROMOTE_MUTABLE(evac)                       \
 363     if (InOldGen(evac)) {                           \
 364         MUT_LINK(evac) = (W_) genInfo.PromMutables; \
 365         genInfo.PromMutables = (P_) evac;           \
 366     }
 367
 368 #else /* ! GCgn */
 369
 370 #if defined(GCap)
 371
 372 #define PROMOTE_MUTABLE(evac)                       \
 373     MUT_LINK(evac) = (W_) appelInfo.PromMutables;   \
 374     appelInfo.PromMutables = (P_) evac;
 375
 376 #else
 377
 378 #define PROMOTE_MUTABLE(evac)
 379
 380 #endif /* GCap */
 381
 382 /*** Real Evac Code -- simply passed closure ***/
 383
 384 #define EVAC_FN(suffix) P_ CAT2(_Evacuate_,suffix)(P_ evac)
 385
 386 /*** FORWARD REF STUFF ***/
 387
 388 #define SET_FORWARD_REF(closure, forw) \
 389             SET_INFO_PTR(closure, Forward_Ref_info); \
 390             FORWARD_ADDRESS(closure) = (W_) (forw)
 391
 392 P_
 393 _Evacuate_Forward_Ref(evac)
 394 P_ evac;
 395 {
 396     DEBUG_EVAC_FORWARD;
 397     evac = (P_) FORWARD_ADDRESS(evac);
 398     return(evac);
 399 }
 400
 401 EXTDATA_RO(Forward_Ref_info);
 402
 403 #endif /* ! GCgn */
 404
 405
 406 /*** SPECIALISED CODE ***/
 407
 408 /* Note: code for evacuating selectors is given near that for Ind(irections) */
 409
 410 EVAC_FN(1)
 411 {
 412     START_ALLOC(1);
 413
 414     DEBUG_EVAC(1);
 415     COPY_FIXED_HDR;
 416     SPEC_COPY_FREE_VAR(1);
 417     SET_FORWARD_REF(evac,ToHp);
 418     evac = ToHp;
 419     FINISH_ALLOC(1);
 420     return(evac);
 421 }
 422
 423 EVAC_FN(2)
 424 {
 425     START_ALLOC(2);
 426     DEBUG_EVAC(2);
 427     COPY_FIXED_HDR;
 428     SPEC_COPY_FREE_VAR(1);
 429     SPEC_COPY_FREE_VAR(2);
 430     SET_FORWARD_REF(evac,ToHp);
 431     evac = ToHp;
 432     FINISH_ALLOC(2);
 433     return(evac);
 434 }
 435
 436 EVAC_FN(3)
 437 {
 438     START_ALLOC(3);
 439     DEBUG_EVAC(3);
 440     COPY_FIXED_HDR;
 441     SPEC_COPY_FREE_VAR(1);
 442     SPEC_COPY_FREE_VAR(2);
 443     SPEC_COPY_FREE_VAR(3);
 444     SET_FORWARD_REF(evac,ToHp);
 445     evac = ToHp;
 446     FINISH_ALLOC(3);
 447     return(evac);
 448 }
 449
 450 EVAC_FN(4)
 451 {
 452     START_ALLOC(4);
 453     DEBUG_EVAC(4);
 454     COPY_FIXED_HDR;
 455     SPEC_COPY_FREE_VAR(1);
 456     SPEC_COPY_FREE_VAR(2);
 457     SPEC_COPY_FREE_VAR(3);
 458     SPEC_COPY_FREE_VAR(4);
 459     SET_FORWARD_REF(evac,ToHp);
 460     evac = ToHp;
 461     FINISH_ALLOC(4);
 462     return(evac);
 463 }
 464
 465 EVAC_FN(5)
 466 {
 467     START_ALLOC(5);
 468     DEBUG_EVAC(5);
 469     COPY_FIXED_HDR;
 470     SPEC_COPY_FREE_VAR(1);
 471     SPEC_COPY_FREE_VAR(2);
 472     SPEC_COPY_FREE_VAR(3);
 473     SPEC_COPY_FREE_VAR(4);
 474     SPEC_COPY_FREE_VAR(5);
 475     SET_FORWARD_REF(evac,ToHp);
 476     evac = ToHp;
 477     FINISH_ALLOC(5);
 478     return(evac);
 479 }
 480
 481 #define BIG_SPEC_EVAC_FN(n) \
 482 EVAC_FN(n) \
 483 { \
 484     int i; \
 485     START_ALLOC(n); \
 486     DEBUG_EVAC(n); \
 487     COPY_FIXED_HDR; \
 488     for (i = 1; i <= n; i++) { SPEC_COPY_FREE_VAR(i); } \
 489     SET_FORWARD_REF(evac,ToHp); \
 490     evac = ToHp; \
 491     FINISH_ALLOC(n); \
 492     return(evac); \
 493 }
 494
 495 /* instantiate for 6--12 */
 496 BIG_SPEC_EVAC_FN(6)
 497 BIG_SPEC_EVAC_FN(7)
 498 BIG_SPEC_EVAC_FN(8)
 499 BIG_SPEC_EVAC_FN(9)
 500 BIG_SPEC_EVAC_FN(10)
 501 BIG_SPEC_EVAC_FN(11)
 502 BIG_SPEC_EVAC_FN(12)
 503
 504 \end{code}
 505
 506 A @SPEC_RBH@ must be at least size @MIN_UPD_SIZE@ (Whom are we fooling?
 507 This means 2), and the first word after the fixed header is a
 508 @MUT_LINK@.  The second word is a pointer to a blocking queue.
 509 Remaining words are the same as the underlying @SPEC@ closure.  Unlike
 510 their @SPEC@ cousins, @SPEC_RBH@ closures require special handling for
 511 generational collectors, because the blocking queue is a mutable
 512 field.
 513
 514 We don't expect to have a lot of these, so I haven't unrolled the
 515 first five instantiations of the macro, but feel free to do so if it
 516 turns you on.
 517
 518 \begin{code}
 519
 520 #if defined(PAR) || defined(GRAN)
 521
 522 #define SPEC_RBH_EVAC_FN(n)                                     \
 523 EVAC_FN(CAT2(RBH_,n))                                           \
 524 {                                                               \
 525     I_ count = FIXED_HS - 1;                                    \
 526     I_ size  = SPEC_RBH_VHS + (n);                              \
 527     START_ALLOC(size);                                          \
 528     DEBUG_EVAC(size);                                           \
 529     COPY_FIXED_HDR;                                             \
 530     while (++count <= size + (FIXED_HS - 1)) {                  \
 531         COPY_WORD(count);                                       \
 532     }                                                           \
 533     SET_FORWARD_REF(evac,ToHp);                                 \
 534     evac = ToHp;                                                \
 535     FINISH_ALLOC(size);                                         \
 536                                                                 \
 537     PROMOTE_MUTABLE(evac);                                      \
 538                                                                 \
 539     return(evac);                                               \
 540 }
 541
 542 /* instantiate for 2--12 */
 543 SPEC_RBH_EVAC_FN(2)
 544 SPEC_RBH_EVAC_FN(3)
 545 SPEC_RBH_EVAC_FN(4)
 546 SPEC_RBH_EVAC_FN(5)
 547 SPEC_RBH_EVAC_FN(6)
 548 SPEC_RBH_EVAC_FN(7)
 549 SPEC_RBH_EVAC_FN(8)
 550 SPEC_RBH_EVAC_FN(9)
 551 SPEC_RBH_EVAC_FN(10)
 552 SPEC_RBH_EVAC_FN(11)
 553 SPEC_RBH_EVAC_FN(12)
 554
 555 #endif
 556
 557 #ifndef PAR
 558 EVAC_FN(ForeignObj)
 559 {
 560     I_ size = ForeignObj_SIZE;
 561     START_ALLOC(size);
 562     DEBUG_EVAC(size);
 563
 564 #if defined(DEBUG)
 565     if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
 566       fprintf(stderr,"DEBUG: Evacuating ForeignObj(%x)=<%x,_,%x,%x>", evac, evac[0], evac[2], evac[3]);
 567       fprintf(stderr," Data = %x, Finaliser= %x, Next = %x\n",
 568              ForeignObj_CLOSURE_DATA(evac),
 569              ForeignObj_CLOSURE_FINALISER(evac),
 570              ForeignObj_CLOSURE_LINK(evac) );
 571     }
 572 #endif
 573
 574     COPY_FIXED_HDR;
 575
 576     SET_FORWARD_REF(evac,ToHp);
 577     ForeignObj_CLOSURE_DATA(ToHp)      = ForeignObj_CLOSURE_DATA(evac);
 578     ForeignObj_CLOSURE_FINALISER(ToHp) = ForeignObj_CLOSURE_FINALISER(evac);
 579     ForeignObj_CLOSURE_LINK(ToHp)      = ForeignObj_CLOSURE_LINK(evac);
 580
 581 #if defined(DEBUG)
 582     if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
 583       fprintf(stderr,"DEBUG: Evacuated  ForeignObj(%x)=<%x,_,%x,%x>", ToHp, ToHp[0], ToHp[2], ToHp[3]);
 584       fprintf(stderr," Data = %x, Finaliser = %x, Next = %x\n",
 585              ForeignObj_CLOSURE_DATA(ToHp),
 586              ForeignObj_CLOSURE_FINALISER(ToHp),
 587              ForeignObj_CLOSURE_LINK(ToHp));
 588     }
 589 #endif
 590
 591     evac = ToHp;
 592     FINISH_ALLOC(size);
 593     return(evac);
 594 }
 595 #endif /* !PAR */
 596
 597 /*** GENERIC CASE CODE ***/
 598
 599 EVAC_FN(S)
 600 {
 601     I_ count = FIXED_HS - 1;
 602     I_ size = GEN_CLOSURE_SIZE(evac);
 603
 604     START_ALLOC(size);
 605     DEBUG_EVAC(size);
 606     COPY_FIXED_HDR;
 607     while (++count <= size + (FIXED_HS - 1)) {
 608         COPY_WORD(count);
 609     }
 610     SET_FORWARD_REF(evac,ToHp);
 611     evac = ToHp;
 612     FINISH_ALLOC(size);
 613     return(evac);
 614 }
 615
 616 \end{code}
 617
 618 Like a @SPEC_RBH@, a @GEN_RBH@ must be at least @MIN_UPD_SIZE@, and
 619 the first word after the fixed header is a @MUT_LINK@.  The second
 620 word is a pointer to a blocking queue.  Remaining words are the same
 621 as the underlying @GEN@ closure.
 622
 623 \begin{code}
 624
 625 #if defined(PAR) || defined(GRAN)
 626 EVAC_FN(RBH_S)
 627 {
 628     I_ count = GEN_RBH_HS - 1;
 629     I_ size = GEN_RBH_CLOSURE_SIZE(evac);
 630
 631     START_ALLOC(size);
 632     DEBUG_EVAC(size);
 633     COPY_FIXED_HDR;
 634     while (++count <= size + (FIXED_HS - 1)) {
 635         COPY_WORD(count);
 636     }
 637     SET_FORWARD_REF(evac,ToHp);
 638     evac = ToHp;
 639     FINISH_ALLOC(size);
 640
 641     PROMOTE_MUTABLE(evac);
 642
 643     return(evac);
 644 }
 645 #endif
 646
 647 /*** DYNAMIC CLOSURE -- SIZE & PTRS STORED IN CLOSURE ***/
 648
 649 EVAC_FN(Dyn)
 650 {
 651     I_ count = FIXED_HS - 1;
 652     I_ size = DYN_CLOSURE_SIZE(evac);  /* Includes size and no-of-ptrs fields */
 653
 654     START_ALLOC(size);
 655     DEBUG_EVAC_DYN;
 656     COPY_FIXED_HDR;
 657     while (++count <= size + (FIXED_HS - 1)) {
 658         COPY_WORD(count);
 659     }
 660     SET_FORWARD_REF(evac,ToHp);
 661     evac = ToHp;
 662     FINISH_ALLOC(size);
 663     return(evac);
 664 }
 665
 666 /*** TUPLE CLOSURE -- NO. OF PTRS STORED IN CLOSURE -- NO DATA ***/
 667
 668 EVAC_FN(Tuple)
 669 {
 670     I_ count = FIXED_HS - 1;
 671     I_ size = TUPLE_CLOSURE_SIZE(evac);
 672
 673     START_ALLOC(size);
 674     DEBUG_EVAC_TUPLE;
 675     COPY_FIXED_HDR;
 676     while (++count <= size + (FIXED_HS - 1)) {
 677         COPY_WORD(count);
 678     }
 679     SET_FORWARD_REF(evac,ToHp);
 680     evac = ToHp;
 681     FINISH_ALLOC(size);
 682     return(evac);
 683 }
 684
 685 /*** MUTUPLE CLOSURE -- NO. OF PTRS STORED IN CLOSURE -- NO DATA ***/
 686 /*               Only if special GC treatment required             */
 687
 688 #ifdef GC_MUT_REQUIRED
 689 EVAC_FN(MuTuple)
 690 {
 691     I_ count = FIXED_HS - 1;
 692     I_ size = MUTUPLE_CLOSURE_SIZE(evac);
 693
 694     START_ALLOC(size);
 695     DEBUG_EVAC_MUTUPLE;
 696
 697     COPY_FIXED_HDR;
 698     while (++count <= size + (FIXED_HS - 1)) {
 699         COPY_WORD(count);
 700     }
 701     SET_FORWARD_REF(evac,ToHp);
 702     evac = ToHp;
 703     FINISH_ALLOC(size);
 704
 705     /* Add to OldMutables list (if evacuated to old generation) */
 706     PROMOTE_MUTABLE(evac);
 707
 708     return(evac);
 709 }
 710 #endif /* GCgn or GCap */
 711
 712
 713 /*** DATA CLOSURE -- SIZE STORED IN CLOSURE -- NO POINTERS ***/
 714
 715 EVAC_FN(Data)
 716 {
 717     I_ count = FIXED_HS - 1;
 718     I_ size = DATA_CLOSURE_SIZE(evac);
 719
 720     START_ALLOC(size);
 721     DEBUG_EVAC_DATA;
 722     COPY_FIXED_HDR;
 723     while (++count <= size + (FIXED_HS - 1)) {
 724         COPY_WORD(count);
 725     }
 726     SET_FORWARD_REF(evac,ToHp);
 727     evac = ToHp;
 728     FINISH_ALLOC(size);
 729     return(evac);
 730 }
 731
 732
 733 /*** STATIC CLOSURE CODE ***/
 734
 735 /* Evacuation: Just return static address (no copying required)
 736                Evac already contains this address -- just return   */
 737 /* Scavenging: Static closures should never be scavenged */
 738
 739 EVAC_FN(Static)
 740 {
 741     DEBUG_EVAC_STAT;
 742     return(evac);
 743 }
 744
 745 /*** BLACK HOLE CODE ***/
 746
 747 EVAC_FN(BH_U)
 748 {
 749     START_ALLOC(BH_U_SIZE);
 750     DEBUG_EVAC_BH(BH_U_SIZE);
 751     COPY_FIXED_HDR;
 752     SET_FORWARD_REF(evac,ToHp);
 753     evac = ToHp;
 754     FINISH_ALLOC(BH_U_SIZE);
 755     return(evac);
 756 }
 757
 758 EVAC_FN(BH_N)
 759 {
 760     START_ALLOC(BH_N_SIZE);
 761     DEBUG_EVAC_BH(BH_N_SIZE);
 762     COPY_FIXED_HDR;
 763     SET_FORWARD_REF(evac,ToHp);
 764     evac = ToHp;
 765     FINISH_ALLOC(BH_N_SIZE);
 766     return(evac);
 767 }
 768
 769 /*** INDIRECTION CODE ***/
 770
 771 /* permanent indirections first */
 772 #if defined(PROFILING) || defined(TICKY_TICKY)
 773 #undef PI
 774
 775 EVAC_FN(PI) /* used for ticky in case just below... */
 776 {
 777 #ifdef TICKY_TICKY
 778     if (! AllFlags.doUpdEntryCounts) {
 779         DEBUG_EVAC_IND1;
 780         GC_SHORT_IND(); /* ticky: record that we shorted an indirection */
 781
 782         evac = (P_) IND_CLOSURE_PTR(evac);
 783
 784 # if defined(GCgn) || defined(GCap)
 785         if (evac > OldGen)  /* Only evacuate new gen with generational collector */
 786             evac = EVACUATE_CLOSURE(evac);
 787 # else
 788         evac = EVACUATE_CLOSURE(evac);
 789 # endif
 790
 791         DEBUG_EVAC_IND2;
 792     } else {
 793 #endif
 794
 795         /* *not* shorting one out... */
 796         START_ALLOC(IND_CLOSURE_SIZE(dummy));
 797         DEBUG_EVAC_PERM_IND;
 798         COPY_FIXED_HDR;
 799         COPY_WORD(IND_HS);
 800         SET_FORWARD_REF(evac,ToHp);
 801         evac = ToHp;
 802         FINISH_ALLOC(IND_CLOSURE_SIZE(dummy));
 803
 804 #ifdef TICKY_TICKY
 805     }
 806 #endif
 807     return(evac);
 808 }
 809 #endif /* PROFILING or TICKY */
 810
 811 EVAC_FN(Ind) /* Indirections are shorted-out; if doing weird ticky
 812                 stuff, we will have used *permanent* indirections
 813                 for overwriting updatees...
 814              */
 815 {
 816     DEBUG_EVAC_IND1;
 817     GC_SHORT_IND(); /* ticky: record that we shorted an indirection */
 818
 819     evac = (P_) IND_CLOSURE_PTR(evac);
 820
 821 # if defined(GCgn) || defined(GCap)
 822     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
 823         evac = EVACUATE_CLOSURE(evac);
 824 # else
 825     evac = EVACUATE_CLOSURE(evac);
 826 # endif
 827
 828     DEBUG_EVAC_IND2;
 829
 830     /* This will generate a stack of returns for a chain of indirections!
 831        However chains can only be 2 long.
 832     */
 833
 834     return(evac);
 835 }
 836
 837 /*** SELECTORS CODE (much like an indirection) ***/
 838
 839 /* Evacuate a thunk which is selector; it has one free variable which
 840    points to something which will evaluate to a constructor in a
 841    single-constructor data type.
 842
 843    If it is so evaluated at GC time, we want to simply select the n'th
 844    field.
 845
 846    This thunk is of course always a Spec thing, since it has only one
 847    free var.
 848
 849    The constructor is guaranteed to be a Spec thing, so we know where
 850    the n'th field is.
 851
 852    ToDo: what if the constructor is a Gen thing?
 853
 854    "selector_depth" stuff below: (WDP 95/12)
 855
 856       It is possible to have a *very* considerable number of selectors
 857       all chained together, which will cause the code here to chew up
 858       enormous C stack space (very deeply nested set of calls), which
 859       can crash the program.
 860
 861       Various solutions are possible, but we opt for a simple one --
 862       we run a "selector_depth" counter, and we stop doing the
 863       selections if we get beyond that depth.  The main nice property
 864       is that it doesn't affect (or slow down) any of the rest of the
 865       GC.
 866
 867       What should the depth be?  For SPARC friendliness, it should
 868       probably be very small (e.g., 8 or 16), to avoid register-window
 869       spillage.  However, that would increase the chances that
 870       selectors are left undone and lots of junk is promoted to the
 871       old generation.  So we set it quite a bit higher -- we'd like to
 872       do all the selections except in the most extreme circumstances.
 873 */
 874 static int selector_depth = 0;
 875 #define MAX_SELECTOR_DEPTH 100 /* reasonably arbitrary */
 876
 877 static P_
 878 _EvacuateSelector_n(P_ evac, I_ n)
 879 {
 880     P_ maybe_con = (P_) evac[_FHS];
 881
 882     /* must be a SPEC 2 1 closure */
 883     ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */
 884
 885 #ifdef TICKY_TICKY
 886     /* if a thunk, its update-entry count must be zero */
 887     ASSERT(TICKY_HDR(evac) == 0);
 888 #endif
 889
 890     selector_depth++; /* see story above */
 891
 892 #if defined(DEBUG)
 893     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC)
 894         fprintf(stderr, "Evac Selector (depth %ld): 0x%lx, info 0x%lx, maybe_con 0x%lx, info 0x%lx, tag %ld\n",
 895                 selector_depth, evac, INFO_PTR(evac), maybe_con,
 896                 INFO_PTR(maybe_con), INFO_TAG(INFO_PTR(maybe_con)));
 897 #endif
 898
 899     if (INFO_TAG(INFO_PTR(maybe_con)) < 0   /* not in WHNF */
 900 #if !defined(CONCURRENT)
 901         || (! RTSflags.GcFlags.lazyBlackHoling) /* see "price of laziness" paper */
 902 #endif
 903         || selector_depth > MAX_SELECTOR_DEPTH
 904         || (! RTSflags.GcFlags.doSelectorsAtGC)
 905        ) {
 906 #ifdef TICKY_TICKY
 907           if (INFO_TAG(INFO_PTR(maybe_con)) >= 0) { /* we *could* have done it */
 908              GC_SEL_ABANDONED();
 909           }
 910 #endif
 911           /* Evacuate as normal (it is size *2* because of MIN_UPD_SIZE) */
 912           return( _Evacuate_2(evac) );
 913     }
 914
 915 #if defined(DEBUG)
 916     if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC)
 917         fprintf(stderr, "Evac Selector:shorting: 0x%lx -> 0x%lx\n",
 918                 evac, maybe_con[_FHS + n]);
 919 #endif
 920
 921     /* Ha!  Short it out */
 922     evac = (P_) (maybe_con[_FHS + n]);  /* evac now has the result of the selection */
 923
 924     GC_SEL_MINOR(); /* ticky-ticky */
 925
 926 #if defined(GCgn) || defined(GCap)
 927     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
 928         evac = EVACUATE_CLOSURE(evac);
 929 #else
 930     evac = EVACUATE_CLOSURE(evac);
 931 #endif
 932
 933     selector_depth--; /* see story above */
 934
 935     return(evac);
 936 }
 937
 938 #define DEF_SEL_EVAC(n) \
 939 P_ CAT2(_EvacuateSelector_,n) (evac) P_ evac; \
 940 { return(_EvacuateSelector_n(evac,n)); }
 941
 942 /* all the entry points */
 943 DEF_SEL_EVAC(0)
 944 DEF_SEL_EVAC(1)
 945 DEF_SEL_EVAC(2)
 946 DEF_SEL_EVAC(3)
 947 DEF_SEL_EVAC(4)
 948 DEF_SEL_EVAC(5)
 949 DEF_SEL_EVAC(6)
 950 DEF_SEL_EVAC(7)
 951 DEF_SEL_EVAC(8)
 952 DEF_SEL_EVAC(9)
 953 DEF_SEL_EVAC(10)
 954 DEF_SEL_EVAC(11)
 955 DEF_SEL_EVAC(12)
 956
 957 #ifdef CONCURRENT
 958 EVAC_FN(BQ)
 959 {
 960     START_ALLOC(BQ_CLOSURE_SIZE(dummy));
 961     DEBUG_EVAC_BQ;
 962
 963     COPY_FIXED_HDR;
 964     COPY_WORD(BQ_HS);
 965
 966     SET_FORWARD_REF(evac,ToHp);
 967     evac = ToHp;
 968     FINISH_ALLOC(BQ_CLOSURE_SIZE(dummy));
 969
 970     /* Add to OldMutables list (if evacuated to old generation) */
 971     PROMOTE_MUTABLE(evac);
 972
 973     return(evac);
 974 }
 975
 976 EVAC_FN(TSO)
 977 {
 978     I_ count;
 979     I_ size = TSO_VHS + TSO_CTS_SIZE;
 980
 981     START_ALLOC(size);
 982     DEBUG_EVAC_TSO(size);
 983
 984     COPY_FIXED_HDR;
 985     for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) {
 986         COPY_WORD(count);
 987     }
 988
 989     *TSO_INTERNAL_PTR(ToHp) = *TSO_INTERNAL_PTR(evac);
 990
 991     SET_FORWARD_REF(evac, ToHp);
 992     evac = ToHp;
 993     FINISH_ALLOC(size);
 994
 995     /* Add to OldMutables list (if evacuated to old generation) */
 996     PROMOTE_MUTABLE(evac);
 997
 998     return evac;
 999 }
1000
1001 EVAC_FN(StkO)
1002 {
1003     I_ count;
1004     I_ size       = STKO_CLOSURE_SIZE(evac);
1005     I_ spa_offset = STKO_SpA_OFFSET(evac);
1006     I_ spb_offset = STKO_SpB_OFFSET(evac);
1007     I_ sub_offset = STKO_SuB_OFFSET(evac);
1008     I_ offset;
1009
1010     ASSERT(sanityChk_StkO(evac));
1011
1012     START_ALLOC(size);
1013     DEBUG_EVAC_STKO(STKO_CLOSURE_CTS_SIZE(evac) - spa_offset + 1, spb_offset);
1014
1015     COPY_FIXED_HDR;
1016 #ifdef TICKY_TICKY
1017     COPY_WORD(STKO_ADEP_LOCN);
1018     COPY_WORD(STKO_BDEP_LOCN);
1019 #endif
1020     COPY_WORD(STKO_SIZE_LOCN);
1021     COPY_WORD(STKO_RETURN_LOCN);
1022     COPY_WORD(STKO_LINK_LOCN);
1023
1024     /* Adjust the four stack pointers -- ORDER IS IMPORTANT!! */
1025     offset = ToHp - evac;
1026
1027     STKO_SuB(ToHp) = STKO_SuB(evac) + offset;
1028     STKO_SpB(ToHp) = STKO_SpB(evac) + offset;
1029     STKO_SpA(ToHp) = STKO_SpA(evac) + offset;
1030     STKO_SuA(ToHp) = STKO_SuA(evac) + offset;
1031
1032
1033     /* Slide the A stack */
1034     for (count = spa_offset; count <= STKO_CLOSURE_CTS_SIZE(evac); count++) {
1035         COPY_WORD((STKO_HS-1) + count);
1036     }
1037
1038     /* Slide the B stack, repairing internal pointers */
1039     for (count = spb_offset; count >= 1;) {
1040         if (count > sub_offset) {
1041             COPY_WORD((STKO_HS-1) + count);
1042             count--;
1043         } else {
1044             P_ subptr;
1045             /* Repair the internal pointers in the update frame */
1046             COPY_WORD((STKO_HS-1) + count + BREL(UF_RET));
1047             COPY_WORD((STKO_HS-1) + count + BREL(UF_UPDATEE));
1048             ADJUST_WORD((STKO_HS-1) + count + BREL(UF_SUA),offset);
1049             ADJUST_WORD((STKO_HS-1) + count + BREL(UF_SUB),offset);
1050             subptr = GRAB_SuB(STKO_CLOSURE_ADDR(ToHp,sub_offset));
1051             sub_offset = STKO_CLOSURE_OFFSET(ToHp,subptr);
1052             count -= STD_UF_SIZE;
1053         }
1054     }
1055
1056     SET_FORWARD_REF(evac, ToHp);
1057     evac = ToHp;
1058     FINISH_ALLOC(size);
1059
1060     /* Add to OldMutables list (if evacuated to old generation) */
1061     PROMOTE_MUTABLE(evac);
1062
1063     return evac;
1064 }
1065
1066 #ifdef PAR
1067 EVAC_FN(FetchMe)
1068 {
1069     START_ALLOC(2);
1070     DEBUG_EVAC(2);
1071     COPY_FIXED_HDR;
1072     COPY_WORD(FETCHME_GA_LOCN);
1073     ASSERT(GALAlookup(FETCHME_GA(evac)) != NULL);
1074
1075     SET_FORWARD_REF(evac,ToHp);
1076     evac = ToHp;
1077     FINISH_ALLOC(2);
1078
1079     /* Add to OldMutables list (if evacuated to old generation) */
1080     PROMOTE_MUTABLE(evac);
1081
1082     return(evac);
1083 }
1084
1085 EVAC_FN(BF)
1086 {
1087     I_ count;
1088     I_ size = BF_CLOSURE_SIZE(evac);
1089
1090     START_ALLOC(size);
1091     DEBUG_EVAC_BF;
1092
1093     COPY_FIXED_HDR;
1094     for (count = FIXED_HS; count < FIXED_HS + BF_VHS; count++) {
1095         COPY_WORD(count);
1096     }
1097     COPY_WORD(BF_LINK_LOCN);
1098     COPY_WORD(BF_NODE_LOCN);
1099     COPY_WORD(BF_GTID_LOCN);
1100     COPY_WORD(BF_SLOT_LOCN);
1101     COPY_WORD(BF_WEIGHT_LOCN);
1102
1103     SET_FORWARD_REF(evac, ToHp);
1104     evac = ToHp;
1105     FINISH_ALLOC(size);
1106
1107     /* Add to OldMutables list (if evacuated to old generation) */
1108     PROMOTE_MUTABLE(evac);
1109
1110     return evac;
1111 }
1112 #endif  /* PAR */
1113 #endif  /* CONCURRENT */
1114
1115 /*** SPECIAL CAF CODE ***/
1116
1117 /* Evacuation: Return closure pointed to (already explicitly evacuated) */
1118
1119 EVAC_FN(Caf)
1120 {
1121     DEBUG_EVAC_CAF_RET;
1122     GC_SHORT_CAF(); /* ticky: record that we shorted an indirection */
1123
1124     evac = (P_) IND_CLOSURE_PTR(evac);
1125     return(evac);
1126 }
1127
1128 /* In addition we need an internal Caf indirection which evacuates,
1129    updates and returns the indirection. Before GC is started, the
1130    @CAFlist@ must be traversed and the info tables set to this.
1131 */
1132
1133 EVAC_FN(Caf_Evac_Upd)
1134 {
1135     P_ closure = evac;
1136
1137     DEBUG_EVAC_CAF_EVAC1;
1138
1139     INFO_PTR(evac) = (W_) Caf_info;     /* Change back to Caf_info */
1140
1141     evac = (P_) IND_CLOSURE_PTR(evac);          /* Grab reference and evacuate */
1142
1143 #if defined(GCgn) || defined(GCap)
1144     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
1145         evac = EVACUATE_CLOSURE(evac);
1146 #else
1147     evac = EVACUATE_CLOSURE(evac);
1148 #endif
1149
1150     IND_CLOSURE_PTR(closure) = (W_) evac;       /* Update reference */
1151
1152     DEBUG_EVAC_CAF_EVAC2;
1153     return(evac);
1154
1155     /* This will generate a stack of returns for a chain of indirections!
1156        However chains can only be 2 long.
1157    */
1158 }
1159
1160
1161 /*** CONST CLOSURE CODE ***/
1162
1163 /* Evacuation: Just return address of the static closure stored in the info table */
1164
1165 EVAC_FN(Const)
1166 {
1167 #ifdef TICKY_TICKY
1168      if (AllFlags.doUpdEntryCounts) {
1169         /* evacuate as if a closure of size 0
1170            (there is no _Evacuate_0 to call)
1171         */
1172         START_ALLOC(0);
1173         DEBUG_EVAC(0);
1174         COPY_FIXED_HDR;
1175         SET_FORWARD_REF(evac,ToHp);
1176         evac = ToHp;
1177         FINISH_ALLOC(0);
1178
1179      } else {
1180 #endif
1181
1182     DEBUG_EVAC_CONST;
1183     GC_COMMON_CONST(); /* ticky */
1184
1185     evac = CONST_STATIC_CLOSURE(INFO_PTR(evac));
1186
1187 #ifdef TICKY_TICKY
1188     }
1189 #endif
1190     return(evac);
1191 }
1192
1193 /*** CHARLIKE CLOSURE CODE ***/
1194
1195 /* Evacuation: Just return address of the static closure stored fixed array */
1196
1197 EVAC_FN(CharLike)
1198 {
1199 #ifdef TICKY_TICKY
1200      if (AllFlags.doUpdEntryCounts) {
1201         evac = _Evacuate_1(evac);  /* evacuate closure of size 1 */
1202      } else {
1203 #endif
1204
1205     DEBUG_EVAC_CHARLIKE;
1206     GC_COMMON_CHARLIKE(); /* ticky */
1207
1208     evac = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac));
1209
1210 #ifdef TICKY_TICKY
1211     }
1212 #endif
1213     return(evac);
1214 }
1215 \end{code}
1216
1217 --- INTLIKE CLOSURE CODE ---
1218
1219 Evacuation: Return address of the static closure if available
1220 Otherwise evacuate converting to aux closure.
1221
1222 There are some tricks here:
1223 \begin{enumerate}
1224 \item
1225 The main trick is that if the integer is in a certain range, we
1226 replace it by a pointer to a statically allocated integer.
1227 \end{enumerate}
1228
1229 (Would it not be more efficient to update the copy directly since
1230 we're about to set a forwarding reference in the original? ADR)
1231
1232 \begin{code}
1233 EVAC_FN(IntLike)
1234 {
1235     I_ val = INTLIKE_VALUE(evac);
1236
1237     if (val >= MIN_INTLIKE   /* in range of static closures */
1238      && val <= MAX_INTLIKE
1239 #ifdef TICKY_TICKY
1240      && !AllFlags.doUpdEntryCounts
1241 #endif
1242        ) {
1243         DEBUG_EVAC_INTLIKE_TO_STATIC;
1244         GC_COMMON_INTLIKE(); /* ticky */
1245
1246         evac = (P_) INTLIKE_CLOSURE(val); /* return appropriate static closure */
1247     }
1248     else {
1249         evac = _Evacuate_1(evac); /* evacuate closure of size 1 */
1250
1251 #ifdef TICKY_TICKY
1252         if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL();
1253 #endif
1254     }
1255
1256     return(evac);
1257 }
1258
1259 #if defined (GCgn)
1260 GEN_EVAC_CODE(1)
1261 GEN_EVAC_CODE(2)
1262 GEN_EVAC_CODE(3)
1263 GEN_EVAC_CODE(4)
1264 GEN_EVAC_CODE(5)
1265 GEN_EVAC_CODE(6)
1266 GEN_EVAC_CODE(7)
1267 GEN_EVAC_CODE(8)
1268 GEN_EVAC_CODE(9)
1269 GEN_EVAC_CODE(10)
1270 GEN_EVAC_CODE(11)
1271 GEN_EVAC_CODE(12)
1272 GEN_EVAC_CODE(S)
1273 GEN_EVAC_CODE(Dyn)
1274 GEN_EVAC_CODE(Tuple)
1275 GEN_EVAC_CODE(Data)
1276 GEN_EVAC_CODE(MuTuple)
1277 GEN_EVAC_CODE(IntLike)  /* ToDo: may create oldgen roots referencing static ints */
1278 GEN_EVAC_CODE(CAT2(BH_,MIN_UPD_SIZE))
1279 GEN_EVAC_CODE(CAT2(BH_,MIN_NONUPD_SIZE))
1280 #endif /* GCgn */
1281
1282 #else  /* ! _INFO_COPYING */
1283 This really really should not ever ever come up!
1284 #endif /* ! _INFO_COPYING */
1285 \end{code}