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(_GC_DEBUG)
  55
  56 #define DEBUG_EVAC(sizevar) \
  57     if (SM_trace & 2) \
  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 (SM_trace & 2) \
  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 (SM_trace & 2) \
  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 (SM_trace & 2) \
  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 (SM_trace & 2) \
  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 (SM_trace & 2) \
  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 (SM_trace & 2) \
  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 (SM_trace & 2) \
  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 (SM_trace & 2) \
  98         fprintf(stderr, "Evac: Indirection Done -> 0x%lx\n", evac)
  99
 100 #define DEBUG_EVAC_PERM_IND \
 101     if (SM_trace & 2) \
 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 (SM_trace & 2) \
 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 (SM_trace & 2) \
 112         fprintf(stderr, "Evac: Caf Done -> 0x%lx\n", evac)
 113
 114 #define DEBUG_EVAC_CAF_RET \
 115     if (SM_trace & 2) \
 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 (SM_trace & 2) \
 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 (SM_trace & 2) \
 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 (SM_trace & 2) \
 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 (SM_trace & 2) \
 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 (SM_trace & 2) \
 141         fprintf(stderr, "Old ")
 142
 143 #define DEBUG_EVAC_TO_NEW \
 144     if (SM_trace & 2) \
 145         fprintf(stderr, "New ")
 146
 147 #define DEBUG_EVAC_OLD_TO_NEW(oldind, evac, new) \
 148     if (SM_trace & 2) \
 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 (SM_trace & 2) { \
 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 (SM_trace & 2) \
 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 (SM_trace & 2) \
 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 (SM_trace & 2) \
 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 (SM_trace & 2) \
 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 _GC_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, Malloc Pointer 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 Malloc ptrs) or the data (which we must report
 278    to the outside world).  Malloc Ptr 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 P_
 289 _Evacuate_Old_Forward_Ref(evac)
 290 P_ evac;
 291 {
 292     /* Forward ref to old generation -- just return */
 293     DEBUG_EVAC_FORWARD;
 294
 295     evac = (P_) FORWARD_ADDRESS(evac);
 296     return(evac);
 297 }
 298
 299 P_
 300 _Evacuate_New_Forward_Ref(evac)
 301 P_ evac;
 302 {
 303     /* Forward ref to new generation -- check scavenged from the old gen */
 304     DEBUG_EVAC_FORWARD;
 305
 306     if (InOldGen(Scav)) {
 307         evac = (P_) _Evacuate_Old_to_New(FORWARD_ADDRESS(evac), evac);
 308     } else {
 309         evac = (P_) FORWARD_ADDRESS(evac);
 310     }
 311     return(evac);
 312 }
 313
 314 P_
 315 _Evacuate_OldRoot_Forward(evac)
 316 P_ evac;
 317 {
 318     /* Forward ref to old generation root -- return old root or new gen closure */
 319     DEBUG_EVAC_OLDROOT_FORWARD;
 320
 321     /* grab old generation root */
 322     evac = (P_) FORWARD_ADDRESS(evac);
 323
 324     /* if scavenging new generation return the new generation
 325        closure rather than the old generation root */
 326     if (! InOldGen(Scav)) {
 327         evac = (P_) IND_CLOSURE_PTR(evac);
 328     }
 329
 330     return(evac);
 331 }
 332
 333 EXTDATA_RO(Forward_Ref_New_info);
 334 EXTDATA_RO(Forward_Ref_Old_info);
 335 EXTDATA_RO(OldRoot_Forward_Ref_info);
 336
 337 /*** Old Gen Reference to New Gen Closure ***/
 338
 339 P_
 340 _Evacuate_Old_to_New(newevac, evac)
 341 P_ newevac, evac;
 342 {
 343     /* New generation closure referenced from the old generation           */
 344     /*    allocate old generation indirection to newevac                   */
 345     /*    reset forward reference in original allocation area to oldind    */
 346     /*      evacuating this should return the old root or the new gen      */
 347     /*      closure depending if referenced from the old generation        */
 348     /*    return oldind as evacuated location                              */
 349     /*      reference from oldgen will be to this oldind closure           */
 350
 351     P_ oldind = OldHp + 1;                     /* see START_ALLOC  */
 352     OldHp = oldind + (FIXED_HS-1) + MIN_UPD_SIZE;  /* see FINISH_ALLOC */
 353
 354     DEBUG_EVAC_OLD_TO_NEW(oldind, evac, newevac);
 355
 356     INFO_PTR(evac) = (W_) OldRoot_Forward_Ref_info;
 357     FORWARD_ADDRESS(evac) = (W_)oldind;
 358
 359     INFO_PTR(oldind) = (W_) OldRoot_info;
 360     IND_CLOSURE_PTR(oldind) = (W_) newevac;
 361     IND_CLOSURE_LINK(oldind) = (W_) genInfo.OldInNew;
 362     genInfo.OldInNew = oldind;
 363     genInfo.OldInNewno++;
 364
 365     return oldind;
 366 }
 367
 368 #define PROMOTE_MUTABLE(evac)                       \
 369     if (InOldGen(evac)) {                           \
 370         MUT_LINK(evac) = (W_) genInfo.PromMutables; \
 371         genInfo.PromMutables = (P_) evac;           \
 372     }
 373
 374 #else /* ! GCgn */
 375
 376 #if defined(GCap)
 377
 378 #define PROMOTE_MUTABLE(evac)                       \
 379     MUT_LINK(evac) = (W_) appelInfo.PromMutables;   \
 380     appelInfo.PromMutables = (P_) evac;
 381
 382 #else
 383
 384 #define PROMOTE_MUTABLE(evac)
 385
 386 #endif /* GCap */
 387
 388 /*** Real Evac Code -- simply passed closure ***/
 389
 390 #define EVAC_FN(suffix) \
 391         P_ CAT2(_Evacuate_,suffix)(evac) \
 392         P_ evac;
 393
 394 /*** FORWARD REF STUFF ***/
 395
 396 #define SET_FORWARD_REF(closure, forw) \
 397             SET_INFO_PTR(closure, Forward_Ref_info); \
 398             FORWARD_ADDRESS(closure) = (W_) (forw)
 399
 400 P_
 401 _Evacuate_Forward_Ref(evac)
 402 P_ evac;
 403 {
 404     DEBUG_EVAC_FORWARD;
 405     evac = (P_) FORWARD_ADDRESS(evac);
 406     return(evac);
 407 }
 408
 409 EXTDATA_RO(Forward_Ref_info);
 410
 411 #endif /* ! GCgn */
 412
 413
 414 /*** SPECIALISED CODE ***/
 415
 416 /* Note: code for evacuating selectors is given near that for Ind(irections) */
 417
 418 EVAC_FN(1)
 419 {
 420     START_ALLOC(1);
 421
 422     DEBUG_EVAC(1);
 423     COPY_FIXED_HDR;
 424     SPEC_COPY_FREE_VAR(1);
 425     SET_FORWARD_REF(evac,ToHp);
 426     evac = ToHp;
 427     FINISH_ALLOC(1);
 428     return(evac);
 429 }
 430
 431 EVAC_FN(2)
 432 {
 433     START_ALLOC(2);
 434     DEBUG_EVAC(2);
 435     COPY_FIXED_HDR;
 436     SPEC_COPY_FREE_VAR(1);
 437     SPEC_COPY_FREE_VAR(2);
 438     SET_FORWARD_REF(evac,ToHp);
 439     evac = ToHp;
 440     FINISH_ALLOC(2);
 441     return(evac);
 442 }
 443
 444 EVAC_FN(3)
 445 {
 446     START_ALLOC(3);
 447     DEBUG_EVAC(3);
 448     COPY_FIXED_HDR;
 449     SPEC_COPY_FREE_VAR(1);
 450     SPEC_COPY_FREE_VAR(2);
 451     SPEC_COPY_FREE_VAR(3);
 452     SET_FORWARD_REF(evac,ToHp);
 453     evac = ToHp;
 454     FINISH_ALLOC(3);
 455     return(evac);
 456 }
 457
 458 EVAC_FN(4)
 459 {
 460     START_ALLOC(4);
 461     DEBUG_EVAC(4);
 462     COPY_FIXED_HDR;
 463     SPEC_COPY_FREE_VAR(1);
 464     SPEC_COPY_FREE_VAR(2);
 465     SPEC_COPY_FREE_VAR(3);
 466     SPEC_COPY_FREE_VAR(4);
 467     SET_FORWARD_REF(evac,ToHp);
 468     evac = ToHp;
 469     FINISH_ALLOC(4);
 470     return(evac);
 471 }
 472
 473 EVAC_FN(5)
 474 {
 475     START_ALLOC(5);
 476     DEBUG_EVAC(5);
 477     COPY_FIXED_HDR;
 478     SPEC_COPY_FREE_VAR(1);
 479     SPEC_COPY_FREE_VAR(2);
 480     SPEC_COPY_FREE_VAR(3);
 481     SPEC_COPY_FREE_VAR(4);
 482     SPEC_COPY_FREE_VAR(5);
 483     SET_FORWARD_REF(evac,ToHp);
 484     evac = ToHp;
 485     FINISH_ALLOC(5);
 486     return(evac);
 487 }
 488
 489 #define BIG_SPEC_EVAC_FN(n) \
 490 EVAC_FN(n) \
 491 { \
 492     int i; \
 493     START_ALLOC(n); \
 494     DEBUG_EVAC(n); \
 495     COPY_FIXED_HDR; \
 496     for (i = 1; i <= n; i++) { SPEC_COPY_FREE_VAR(i); } \
 497     SET_FORWARD_REF(evac,ToHp); \
 498     evac = ToHp; \
 499     FINISH_ALLOC(n); \
 500     return(evac); \
 501 }
 502
 503 /* instantiate for 6--12 */
 504 BIG_SPEC_EVAC_FN(6)
 505 BIG_SPEC_EVAC_FN(7)
 506 BIG_SPEC_EVAC_FN(8)
 507 BIG_SPEC_EVAC_FN(9)
 508 BIG_SPEC_EVAC_FN(10)
 509 BIG_SPEC_EVAC_FN(11)
 510 BIG_SPEC_EVAC_FN(12)
 511
 512 \end{code}
 513
 514 A @SPEC_RBH@ must be at least size @MIN_UPD_SIZE@ (Who are we fooling?
 515 This means 2), and the first word after the fixed header is a
 516 @MUT_LINK@.  The second word is a pointer to a blocking queue.
 517 Remaining words are the same as the underlying @SPEC@ closure.  Unlike
 518 their @SPEC@ cousins, @SPEC_RBH@ closures require special handling for
 519 generational collectors, because the blocking queue is a mutable
 520 field.
 521
 522 We don't expect to have a lot of these, so I haven't unrolled the
 523 first five instantiations of the macro, but feel free to do so if it
 524 turns you on.
 525
 526 \begin{code}
 527
 528 #ifdef PAR
 529
 530 #define SPEC_RBH_EVAC_FN(n) \
 531 EVAC_FN(CAT2(RBH_,n)) \
 532 { \
 533     int i; \
 534     START_ALLOC(n); \
 535     DEBUG_EVAC(n); \
 536     COPY_FIXED_HDR; \
 537     for (i = 0; i < n - 1; i++) { COPY_WORD(SPEC_RBH_HS + i); } \
 538     SET_FORWARD_REF(evac,ToHp); \
 539     evac = ToHp; \
 540     FINISH_ALLOC(n); \
 541     PROMOTE_MUTABLE(evac);\
 542     return(evac); \
 543 }
 544
 545 /* instantiate for 2--12 */
 546 SPEC_RBH_EVAC_FN(2)
 547 SPEC_RBH_EVAC_FN(3)
 548 SPEC_RBH_EVAC_FN(4)
 549 SPEC_RBH_EVAC_FN(5)
 550 SPEC_RBH_EVAC_FN(6)
 551 SPEC_RBH_EVAC_FN(7)
 552 SPEC_RBH_EVAC_FN(8)
 553 SPEC_RBH_EVAC_FN(9)
 554 SPEC_RBH_EVAC_FN(10)
 555 SPEC_RBH_EVAC_FN(11)
 556 SPEC_RBH_EVAC_FN(12)
 557
 558 #endif
 559
 560 #ifndef PAR
 561 EVAC_FN(MallocPtr)
 562 {
 563     START_ALLOC(MallocPtr_SIZE);
 564     DEBUG_EVAC(MallocPtr_SIZE);
 565
 566 #if defined(_GC_DEBUG)
 567     if (SM_trace & 16) {
 568       printf("DEBUG: Evacuating MallocPtr(%x)=<%x,_,%x,%x>", evac, evac[0], evac[2], evac[3]);
 569       printf(" Data = %x, Next = %x\n",
 570              MallocPtr_CLOSURE_DATA(evac), MallocPtr_CLOSURE_LINK(evac) );
 571     }
 572 #endif
 573
 574     COPY_FIXED_HDR;
 575
 576     SET_FORWARD_REF(evac,ToHp);
 577     MallocPtr_CLOSURE_DATA(ToHp) = MallocPtr_CLOSURE_DATA(evac);
 578     MallocPtr_CLOSURE_LINK(ToHp) = MallocPtr_CLOSURE_LINK(evac);
 579
 580 #if defined(_GC_DEBUG)
 581     if (SM_trace & 16) {
 582       printf("DEBUG: Evacuated  MallocPtr(%x)=<%x,_,%x,%x>", ToHp, ToHp[0], ToHp[2], ToHp[3]);
 583       printf(" Data = %x, Next = %x\n",
 584              MallocPtr_CLOSURE_DATA(ToHp), MallocPtr_CLOSURE_LINK(ToHp) );
 585     }
 586 #endif
 587
 588     evac = ToHp;
 589     FINISH_ALLOC(MallocPtr_SIZE);
 590     return(evac);
 591 }
 592 #endif /* !PAR */
 593
 594 /*** GENERIC CASE CODE ***/
 595
 596 EVAC_FN(S)
 597 {
 598     I_ count = FIXED_HS - 1;
 599     I_ size = GEN_CLOSURE_SIZE(evac);
 600
 601     START_ALLOC(size);
 602     DEBUG_EVAC(size);
 603     COPY_FIXED_HDR;
 604     while (++count <= size + (FIXED_HS - 1)) {
 605         COPY_WORD(count);
 606     }
 607     SET_FORWARD_REF(evac,ToHp);
 608     evac = ToHp;
 609     FINISH_ALLOC(size);
 610     return(evac);
 611 }
 612
 613 \end{code}
 614
 615 Like a @SPEC_RBH@, a @GEN_RBH@ must be at least @MIN_UPD_SIZE@, and
 616 the first word after the fixed header is a @MUT_LINK@.  The second
 617 word is a pointer to a blocking queue.  Remaining words are the same
 618 as the underlying @GEN@ closure.
 619
 620 \begin{code}
 621
 622 #ifdef PAR
 623 EVAC_FN(RBH_S)
 624 {
 625     I_ count = GEN_RBH_HS - 1;
 626     I_ size = GEN_RBH_CLOSURE_SIZE(evac);
 627
 628     START_ALLOC(size);
 629     DEBUG_EVAC(size);
 630     COPY_FIXED_HDR;
 631     while (++count <= size + (FIXED_HS - 1)) {
 632         COPY_WORD(count);
 633     }
 634     SET_FORWARD_REF(evac,ToHp);
 635     evac = ToHp;
 636     FINISH_ALLOC(size);
 637
 638     PROMOTE_MUTABLE(evac);
 639
 640     return(evac);
 641 }
 642 #endif
 643
 644 /*** DYNAMIC CLOSURE -- SIZE & PTRS STORED IN CLOSURE ***/
 645
 646 EVAC_FN(Dyn)
 647 {
 648     I_ count = FIXED_HS - 1;
 649     I_ size = DYN_CLOSURE_SIZE(evac);  /* Includes size and no-of-ptrs fields */
 650
 651     START_ALLOC(size);
 652     DEBUG_EVAC_DYN;
 653     COPY_FIXED_HDR;
 654     while (++count <= size + (FIXED_HS - 1)) {
 655         COPY_WORD(count);
 656     }
 657     SET_FORWARD_REF(evac,ToHp);
 658     evac = ToHp;
 659     FINISH_ALLOC(size);
 660     return(evac);
 661 }
 662
 663 /*** TUPLE CLOSURE -- NO. OF PTRS STORED IN CLOSURE -- NO DATA ***/
 664
 665 EVAC_FN(Tuple)
 666 {
 667     I_ count = FIXED_HS - 1;
 668     I_ size = TUPLE_CLOSURE_SIZE(evac);
 669
 670     START_ALLOC(size);
 671     DEBUG_EVAC_TUPLE;
 672     COPY_FIXED_HDR;
 673     while (++count <= size + (FIXED_HS - 1)) {
 674         COPY_WORD(count);
 675     }
 676     SET_FORWARD_REF(evac,ToHp);
 677     evac = ToHp;
 678     FINISH_ALLOC(size);
 679     return(evac);
 680 }
 681
 682 /*** MUTUPLE CLOSURE -- NO. OF PTRS STORED IN CLOSURE -- NO DATA ***/
 683 /*               Only if special GC treatment required             */
 684
 685 #ifdef GC_MUT_REQUIRED
 686 EVAC_FN(MuTuple)
 687 {
 688     I_ count = FIXED_HS - 1;
 689     I_ size = MUTUPLE_CLOSURE_SIZE(evac);
 690
 691     START_ALLOC(size);
 692     DEBUG_EVAC_MUTUPLE;
 693
 694     COPY_FIXED_HDR;
 695     while (++count <= size + (FIXED_HS - 1)) {
 696         COPY_WORD(count);
 697     }
 698     SET_FORWARD_REF(evac,ToHp);
 699     evac = ToHp;
 700     FINISH_ALLOC(size);
 701
 702     /* Add to OldMutables list (if evacuated to old generation) */
 703     PROMOTE_MUTABLE(evac);
 704
 705     return(evac);
 706 }
 707 #endif /* GCgn or GCap */
 708
 709
 710 /*** DATA CLOSURE -- SIZE STORED IN CLOSURE -- NO POINTERS ***/
 711
 712 EVAC_FN(Data)
 713 {
 714     I_ count = FIXED_HS - 1;
 715     I_ size = DATA_CLOSURE_SIZE(evac);
 716
 717     START_ALLOC(size);
 718     DEBUG_EVAC_DATA;
 719     COPY_FIXED_HDR;
 720     while (++count <= size + (FIXED_HS - 1)) {
 721         COPY_WORD(count);
 722     }
 723     SET_FORWARD_REF(evac,ToHp);
 724     evac = ToHp;
 725     FINISH_ALLOC(size);
 726     return(evac);
 727 }
 728
 729
 730 /*** STATIC CLOSURE CODE ***/
 731
 732 /* Evacuation: Just return static address (no copying required)
 733                Evac already contains this address -- just return   */
 734 /* Scavenging: Static closures should never be scavenged */
 735
 736 P_
 737 _Evacuate_Static(evac)
 738 P_ evac;
 739 {
 740     DEBUG_EVAC_STAT;
 741     return(evac);
 742 }
 743
 744 void
 745 _Scavenge_Static(STG_NO_ARGS)
 746 {
 747     fprintf(stderr,"Called _Scavenge_Static: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
 748     abort();
 749 }
 750
 751
 752 /*** BLACK HOLE CODE ***/
 753
 754 EVAC_FN(BH_U)
 755 {
 756     START_ALLOC(MIN_UPD_SIZE);
 757     DEBUG_EVAC_BH(MIN_UPD_SIZE);
 758     COPY_FIXED_HDR;
 759     SET_FORWARD_REF(evac,ToHp);
 760     evac = ToHp;
 761     FINISH_ALLOC(MIN_UPD_SIZE);
 762     return(evac);
 763 }
 764
 765 EVAC_FN(BH_N)
 766 {
 767     START_ALLOC(MIN_NONUPD_SIZE);
 768     DEBUG_EVAC_BH(MIN_NONUPD_SIZE);
 769     COPY_FIXED_HDR;
 770     SET_FORWARD_REF(evac,ToHp);
 771     evac = ToHp;
 772     FINISH_ALLOC(MIN_NONUPD_SIZE);
 773     return(evac);
 774 }
 775
 776 /*** INDIRECTION CODE ***/
 777
 778 /* Evacuation: Evacuate closure pointed to */
 779
 780 P_
 781 _Evacuate_Ind(evac)
 782 P_ evac;
 783 {
 784     DEBUG_EVAC_IND1;
 785     evac = (P_) IND_CLOSURE_PTR(evac);
 786
 787 #if defined(GCgn) || defined(GCap)
 788     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
 789         evac = EVACUATE_CLOSURE(evac);
 790 #else
 791     evac = EVACUATE_CLOSURE(evac);
 792 #endif
 793
 794     DEBUG_EVAC_IND2;
 795     return(evac);
 796
 797     /* This will generate a stack of returns for a chain of indirections!
 798        However chains can only be 2 long.
 799    */
 800 }
 801
 802 #ifdef USE_COST_CENTRES
 803 #undef PI
 804 EVAC_FN(PI)
 805 {
 806     START_ALLOC(MIN_UPD_SIZE);
 807     DEBUG_EVAC_PERM_IND;
 808     COPY_FIXED_HDR;
 809     COPY_WORD(IND_HS);
 810     SET_FORWARD_REF(evac,ToHp);
 811     evac = ToHp;
 812     FINISH_ALLOC(MIN_UPD_SIZE);
 813     return(evac);
 814 }
 815 #endif
 816
 817 /*** SELECTORS CODE (much like an indirection) ***/
 818
 819 /* Evacuate a thunk which is selector; it has one free variable which
 820    points to something which will evaluate to a constructor in a
 821    single-constructor data type.
 822
 823    If it is so evaluated at GC time, we want to simply select the n'th
 824    field.
 825
 826    This thunk is of course always a Spec thing, since it has only one
 827    free var.
 828
 829    The constructor is guaranteed to be a Spec thing, so we know where
 830    the n'th field is.
 831
 832    ToDo: what if the constructor is a Gen thing?
 833 */
 834 static P_
 835 _EvacuateSelector_n(evac, n)
 836   P_ evac;
 837   I_ n;
 838 {
 839     P_ maybe_con = (P_) evac[_FHS];
 840
 841     /* must be a SPEC 2 1 closure */
 842     ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */
 843
 844 #if defined(_GC_DEBUG)
 845     if (SM_trace & 2)
 846         fprintf(stderr, "Evac Selector: 0x%lx, info 0x%lx, maybe_con 0x%lx, info 0x%lx, tag %ld\n",
 847                 evac, INFO_PTR(evac), maybe_con,
 848                 INFO_PTR(maybe_con), INFO_TAG(INFO_PTR(maybe_con)));
 849 #endif
 850
 851     if (INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */
 852           /* Evacuate as normal (it is size *2* because of MIN_UPD_SIZE) */
 853           return( _Evacuate_2(evac) );
 854
 855 #if defined(_GC_DEBUG)
 856     if (SM_trace & 2)
 857         fprintf(stderr, "Evac Selector:shorting: 0x%lx -> 0x%lx\n",
 858                 evac, maybe_con[_FHS + n]);
 859 #endif
 860
 861     /* Ha!  Short it out */
 862     evac = (P_) (maybe_con[_FHS + n]);  /* evac now has the result of the selection */
 863
 864 #if defined(GCgn) || defined(GCap)
 865     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
 866         evac = EVACUATE_CLOSURE(evac);
 867 #else
 868     evac = EVACUATE_CLOSURE(evac);
 869 #endif
 870
 871     return(evac);
 872 }
 873
 874 #define DEF_SEL_EVAC(n) \
 875 P_ CAT2(_EvacuateSelector_,n) (evac) P_ evac; \
 876 { return(_EvacuateSelector_n(evac,n)); }
 877
 878 /* all the entry points */
 879 DEF_SEL_EVAC(0)
 880 DEF_SEL_EVAC(1)
 881 DEF_SEL_EVAC(2)
 882 DEF_SEL_EVAC(3)
 883 DEF_SEL_EVAC(4)
 884 DEF_SEL_EVAC(5)
 885 DEF_SEL_EVAC(6)
 886 DEF_SEL_EVAC(7)
 887 DEF_SEL_EVAC(8)
 888 DEF_SEL_EVAC(9)
 889 DEF_SEL_EVAC(10)
 890 DEF_SEL_EVAC(11)
 891 DEF_SEL_EVAC(12)
 892
 893 #ifdef CONCURRENT
 894 EVAC_FN(BQ)
 895 {
 896     START_ALLOC(MIN_UPD_SIZE);
 897     DEBUG_EVAC_BQ;
 898
 899     COPY_FIXED_HDR;
 900     COPY_WORD(BQ_HS);
 901
 902     SET_FORWARD_REF(evac,ToHp);
 903     evac = ToHp;
 904     FINISH_ALLOC(MIN_UPD_SIZE);
 905
 906     /* Add to OldMutables list (if evacuated to old generation) */
 907     PROMOTE_MUTABLE(evac);
 908
 909     return(evac);
 910 }
 911
 912 EVAC_FN(TSO)
 913 {
 914     I_ count;
 915
 916     START_ALLOC(TSO_VHS + TSO_CTS_SIZE);
 917     DEBUG_EVAC_TSO(TSO_VHS + TSO_CTS_SIZE);
 918
 919     COPY_FIXED_HDR;
 920     for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) {
 921         COPY_WORD(count);
 922     }
 923
 924     *TSO_INTERNAL_PTR(ToHp) = *TSO_INTERNAL_PTR(evac);
 925
 926     SET_FORWARD_REF(evac, ToHp);
 927     evac = ToHp;
 928     FINISH_ALLOC(TSO_VHS + TSO_CTS_SIZE);
 929
 930     /* Add to OldMutables list (if evacuated to old generation) */
 931     PROMOTE_MUTABLE(evac);
 932
 933     return evac;
 934 }
 935
 936 EVAC_FN(StkO)
 937 {
 938     I_ count;
 939     I_ size  = STKO_CLOSURE_SIZE(evac);
 940     I_ spa_offset = STKO_SpA_OFFSET(evac);
 941     I_ spb_offset = STKO_SpB_OFFSET(evac);
 942     I_ sub_offset = STKO_SuB_OFFSET(evac);
 943     I_ offset;
 944
 945     START_ALLOC(size);
 946     DEBUG_EVAC_STKO(STKO_CLOSURE_CTS_SIZE(evac) - spa_offset + 1, spb_offset);
 947
 948     COPY_FIXED_HDR;
 949 #ifdef DO_REDN_COUNTING
 950     COPY_WORD(STKO_ADEP_LOCN);
 951     COPY_WORD(STKO_BDEP_LOCN);
 952 #endif
 953     COPY_WORD(STKO_SIZE_LOCN);
 954     COPY_WORD(STKO_RETURN_LOCN);
 955     COPY_WORD(STKO_LINK_LOCN);
 956
 957     /* Adjust the four stack pointers -- ORDER IS IMPORTANT!! */
 958     offset = ToHp - evac;
 959
 960     STKO_SuB(ToHp) = STKO_SuB(evac) + offset;
 961     STKO_SpB(ToHp) = STKO_SpB(evac) + offset;
 962     STKO_SpA(ToHp) = STKO_SpA(evac) + offset;
 963     STKO_SuA(ToHp) = STKO_SuA(evac) + offset;
 964
 965
 966     /* Slide the A stack */
 967     for (count = spa_offset; count <= STKO_CLOSURE_CTS_SIZE(evac); count++) {
 968         COPY_WORD((STKO_HS-1) + count);
 969     }
 970
 971     /* Slide the B stack, repairing internal pointers */
 972     for (count = spb_offset; count >= 1;) {
 973         if (count > sub_offset) {
 974             COPY_WORD((STKO_HS-1) + count);
 975             count--;
 976         } else {
 977             P_ subptr;
 978             /* Repair the internal pointers in the update frame */
 979             COPY_WORD((STKO_HS-1) + count + BREL(UF_RET));
 980             COPY_WORD((STKO_HS-1) + count + BREL(UF_UPDATEE));
 981             ADJUST_WORD((STKO_HS-1) + count + BREL(UF_SUA),offset);
 982             ADJUST_WORD((STKO_HS-1) + count + BREL(UF_SUB),offset);
 983             subptr = GRAB_SuB(STKO_CLOSURE_ADDR(ToHp,sub_offset));
 984             sub_offset = STKO_CLOSURE_OFFSET(ToHp,subptr);
 985             count -= STD_UF_SIZE;
 986         }
 987     }
 988
 989     SET_FORWARD_REF(evac, ToHp);
 990     evac = ToHp;
 991     FINISH_ALLOC(size);
 992
 993     /* Add to OldMutables list (if evacuated to old generation) */
 994     PROMOTE_MUTABLE(evac);
 995
 996     return evac;
 997 }
 998
 999 #ifdef PAR
1000 EVAC_FN(FetchMe)
1001 {
1002     START_ALLOC(2);
1003     DEBUG_EVAC(2);
1004     COPY_FIXED_HDR;
1005     COPY_WORD(FETCHME_GA_LOCN);
1006     ASSERT(GALAlookup(FETCHME_GA(evac)) != NULL);
1007
1008     SET_FORWARD_REF(evac,ToHp);
1009     evac = ToHp;
1010     FINISH_ALLOC(2);
1011
1012     /* Add to OldMutables list (if evacuated to old generation) */
1013     PROMOTE_MUTABLE(evac);
1014
1015     return(evac);
1016 }
1017
1018 EVAC_FN(BF)
1019 {
1020     I_ count;
1021
1022     START_ALLOC(BF_CLOSURE_SIZE(evac));
1023     DEBUG_EVAC_BF;
1024
1025     COPY_FIXED_HDR;
1026     for (count = FIXED_HS; count < FIXED_HS + BF_VHS; count++) {
1027         COPY_WORD(count);
1028     }
1029     COPY_WORD(BF_LINK_LOCN);
1030     COPY_WORD(BF_NODE_LOCN);
1031     COPY_WORD(BF_GTID_LOCN);
1032     COPY_WORD(BF_SLOT_LOCN);
1033     COPY_WORD(BF_WEIGHT_LOCN);
1034
1035     SET_FORWARD_REF(evac, ToHp);
1036     evac = ToHp;
1037     FINISH_ALLOC(BF_CLOSURE_SIZE(evac));
1038
1039     /* Add to OldMutables list (if evacuated to old generation) */
1040     PROMOTE_MUTABLE(evac);
1041
1042     return evac;
1043 }
1044 #endif  /* PAR */
1045 #endif  /* CONCURRENT */
1046
1047 /*** SPECIAL CAF CODE ***/
1048
1049 /* Evacuation: Return closure pointed to (already explicitly evacuated) */
1050 /* Scavenging: Should not be scavenged */
1051
1052 P_
1053 _Evacuate_Caf(evac)
1054 P_ evac;
1055 {
1056     DEBUG_EVAC_CAF_RET;
1057     evac = (P_) IND_CLOSURE_PTR(evac);
1058     return(evac);
1059 }
1060
1061 /* In addition we need an internal Caf indirection which evacuates,
1062    updates and returns the indirection. Before GC is started the
1063    @CAFlist@ must be traversed and the info tables set to this.
1064 */
1065
1066 P_
1067 _Evacuate_Caf_Evac_Upd(evac)
1068   P_ evac;
1069 {
1070     P_ closure = evac;
1071
1072     DEBUG_EVAC_CAF_EVAC1;
1073     INFO_PTR(evac) = (W_) Caf_info;             /* Change to return CAF */
1074
1075     evac = (P_) IND_CLOSURE_PTR(evac);          /* Grab reference and evacuate */
1076
1077 #if defined(GCgn) || defined(GCap)
1078     if (evac > OldGen)  /* Only evacuate new gen with generational collector */
1079         evac = EVACUATE_CLOSURE(evac);
1080 #else
1081     evac = EVACUATE_CLOSURE(evac);
1082 #endif
1083
1084     IND_CLOSURE_PTR(closure) = (W_) evac;       /* Update reference */
1085
1086     DEBUG_EVAC_CAF_EVAC2;
1087     return(evac);
1088
1089     /* This will generate a stack of returns for a chain of indirections!
1090        However chains can only be 2 long.
1091    */
1092 }
1093
1094
1095 /*** CONST CLOSURE CODE ***/
1096
1097 /* Evacuation: Just return address of the static closure stored in the info table */
1098 /* Scavenging: Const closures should never be scavenged */
1099
1100 P_
1101 _Evacuate_Const(evac)
1102 P_ evac;
1103 {
1104     DEBUG_EVAC_CONST;
1105     evac = CONST_STATIC_CLOSURE(INFO_PTR(evac));
1106     return(evac);
1107 }
1108
1109 void
1110 _Scavenge_Const(STG_NO_ARGS)
1111 {
1112     fprintf(stderr,"Called _Scavenge_Const: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
1113     abort();
1114 }
1115
1116
1117 /*** CHARLIKE CLOSURE CODE ***/
1118
1119 /* Evacuation: Just return address of the static closure stored fixed array */
1120 /* Scavenging: CharLike closures should never be scavenged */
1121
1122 P_
1123 _Evacuate_CharLike(evac)
1124 P_ evac;
1125 {
1126     DEBUG_EVAC_CHARLIKE;
1127     evac = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac));
1128     return(evac);
1129 }
1130
1131 void
1132 _Scavenge_CharLike(STG_NO_ARGS)
1133 {
1134     fprintf(stderr,"Called _Scavenge_CharLike: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
1135     abort();
1136 }
1137 \end{code}
1138
1139 --- INTLIKE CLOSURE CODE ---
1140
1141 Evacuation: Return address of the static closure if available
1142 Otherwise evacuate converting to aux closure.
1143
1144 Scavenging: IntLike closures should never be scavenged.
1145
1146 There are some tricks here:
1147 \begin{enumerate}
1148 \item
1149 The main trick is that if the integer is in a certain range, we
1150 replace it by a pointer to a statically allocated integer.
1151 \end{enumerate}
1152
1153 (Would it not be more efficient to update the copy directly since
1154 we're about to set a forwarding reference in the original? ADR)
1155
1156 \begin{code}
1157 EVAC_FN(IntLike)
1158 {
1159     I_ val = INTLIKE_VALUE(evac);
1160
1161     if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) {   /* in range of static closures */
1162         DEBUG_EVAC_INTLIKE_TO_STATIC;
1163         evac = (P_) INTLIKE_CLOSURE(val);             /* return appropriate static closure */
1164     }
1165     else {
1166         START_ALLOC(1);                                   /* evacuate closure of size 1 */
1167         DEBUG_EVAC(1);
1168         COPY_FIXED_HDR;
1169         SPEC_COPY_FREE_VAR(1);
1170         SET_FORWARD_REF(evac,ToHp);
1171         evac = ToHp;
1172         FINISH_ALLOC(1);
1173     }
1174     return(evac);
1175 }
1176
1177 #if defined (GCgn)
1178 GEN_EVAC_CODE(1)
1179 GEN_EVAC_CODE(2)
1180 GEN_EVAC_CODE(3)
1181 GEN_EVAC_CODE(4)
1182 GEN_EVAC_CODE(5)
1183 GEN_EVAC_CODE(6)
1184 GEN_EVAC_CODE(7)
1185 GEN_EVAC_CODE(8)
1186 GEN_EVAC_CODE(9)
1187 GEN_EVAC_CODE(10)
1188 GEN_EVAC_CODE(11)
1189 GEN_EVAC_CODE(12)
1190 GEN_EVAC_CODE(S)
1191 GEN_EVAC_CODE(Dyn)
1192 GEN_EVAC_CODE(Tuple)
1193 GEN_EVAC_CODE(Data)
1194 GEN_EVAC_CODE(MuTuple)
1195 GEN_EVAC_CODE(IntLike)  /* ToDo: may create oldgen roots referencing static ints */
1196 GEN_EVAC_CODE(CAT2(BH_,MIN_UPD_SIZE))
1197 GEN_EVAC_CODE(CAT2(BH_,MIN_NONUPD_SIZE))
1198 #endif /* GCgn */
1199
1200 #else  /* ! _INFO_COPYING */
1201 This really really should not ever ever come up!
1202 #endif /* ! _INFO_COPYING */
1203 \end{code}