1 %****************************************************************************
3 The files SMevac.lc and SMscav.lhc contain the basic routines required
4 for two-space copying garbage collection.
6 Two files are required as the evac routines are conventional call/return
7 routines while the scavenge routines are continuation routines.
9 This file SMevac.lc contains the evacuation routines ...
11 See SMscav.lhc for calling convention documentation.
13 %****************************************************************************
17 #include "SMinternal.h"
19 #if defined(_INFO_COPYING)
21 /* Moves ToHp to point at the info pointer of the new to-space closure */
22 #define START_ALLOC(size) ToHp += 1
24 /* Moves ToHp to point to the last word allocated in to-space */
25 #define FINISH_ALLOC(size) ToHp += (FIXED_HS-1) + (size)
28 /* Copy the ith word (starting at 0) */
29 #define COPY_WORD(position) ToHp[position] = evac[position]
31 /* Copy the ith ptr (starting at 0), adjusting by offset */
32 #define ADJUST_WORD(pos,off) ((PP_)ToHp)[pos] = ((PP_)evac)[pos] + (off)
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))
38 #define COPY_FIXED_HDR COPY_WORD(0)
41 #define COPY_FIXED_HDR COPY_WORD(0);COPY_WORD(1)
44 #define COPY_FIXED_HDR COPY_WORD(0);COPY_WORD(1);COPY_WORD(2)
46 /* I don't think this will be needed (ToDo: #error?) */
47 #endif /* FIXED_HS != 1, 2, or 3 */
52 /*** DEBUGGING MACROS ***/
54 #if defined(_GC_DEBUG)
56 #define DEBUG_EVAC(sizevar) \
58 fprintf(stderr, "Evac: 0x%lx -> 0x%lx, info 0x%lx, size %ld\n", \
59 evac, ToHp, INFO_PTR(evac), sizevar)
61 #define DEBUG_EVAC_DYN \
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))
66 #define DEBUG_EVAC_TUPLE \
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))
71 #define DEBUG_EVAC_MUTUPLE \
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))
76 #define DEBUG_EVAC_DATA \
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))
81 #define DEBUG_EVAC_BH(sizevar) \
83 fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BH info 0x%lx, size %ld\n", \
84 evac, ToHp, INFO_PTR(evac), sizevar)
86 #define DEBUG_EVAC_FORWARD \
88 fprintf(stderr, "Evac: Forward 0x%lx -> 0x%lx, info 0x%lx\n", \
89 evac, FORWARD_ADDRESS(evac), INFO_PTR(evac))
91 #define DEBUG_EVAC_IND1 \
93 fprintf(stderr, "Evac: Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
94 evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
96 #define DEBUG_EVAC_IND2 \
98 fprintf(stderr, "Evac: Indirection Done -> 0x%lx\n", evac)
100 #define DEBUG_EVAC_PERM_IND \
102 fprintf(stderr, "Evac: Permanent Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
103 evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
105 #define DEBUG_EVAC_CAF_EVAC1 \
107 fprintf(stderr, "Evac: Caf 0x%lx -> Evac(0x%lx), info 0x%lx\n", \
108 evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
110 #define DEBUG_EVAC_CAF_EVAC2 \
112 fprintf(stderr, "Evac: Caf Done -> 0x%lx\n", evac)
114 #define DEBUG_EVAC_CAF_RET \
116 fprintf(stderr, "Evac: Caf 0x%lx -> 0x%lx, info 0x%lx\n", \
117 evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac))
119 #define DEBUG_EVAC_STAT \
121 fprintf(stderr, "Evac: Static 0x%lx -> 0x%lx, info 0x%lx\n", \
122 evac, evac, INFO_PTR(evac))
124 #define DEBUG_EVAC_CONST \
126 fprintf(stderr, "Evac: Const 0x%lx -> 0x%lx, info 0x%lx\n", \
127 evac, CONST_STATIC_CLOSURE(INFO_PTR(evac)), INFO_PTR(evac))
129 #define DEBUG_EVAC_CHARLIKE \
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))
134 #define DEBUG_EVAC_INTLIKE_TO_STATIC \
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))
139 #define DEBUG_EVAC_TO_OLD \
141 fprintf(stderr, "Old ")
143 #define DEBUG_EVAC_TO_NEW \
145 fprintf(stderr, "New ")
147 #define DEBUG_EVAC_OLD_TO_NEW(oldind, evac, new) \
149 fprintf(stderr, " OldRoot: 0x%lx -> Old 0x%lx (-> New 0x%lx)\n", \
150 evac, oldind, newevac)
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)); \
160 #define DEBUG_EVAC_BQ \
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))
165 #define DEBUG_EVAC_TSO(size) \
167 fprintf(stderr, "Evac TSO: 0x%lx -> 0x%lx, size %ld\n", \
170 #define DEBUG_EVAC_STKO(a,b) \
172 fprintf(stderr, "Evac StkO: 0x%lx -> 0x%lx, size %ld (A), %ld (B)\n", \
176 # define DEBUG_EVAC_BF \
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))
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)
209 # define DEBUG_EVAC_BQ
210 # define DEBUG_EVAC_TSO(size)
211 # define DEBUG_EVAC_STKO(s,size)
213 # define DEBUG_EVAC_BF
217 #endif /* not _GC_DEBUG */
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 */
226 /* Is a heap ptr in the old generation ? */
227 #define InOldGen(hpptr) (((P_)(hpptr)) <= OldGen)
229 /* Should we promote to the old generation ? */
230 #define ShouldPromote(evac) (((P_)(evac)) < AllocGen)
233 /*** Real Evac Code -- passed closure & forward ref info ***/
235 #define EVAC_FN(suffix) \
236 P_ CAT2(_do_Evacuate_,suffix)(evac, forward_info) \
237 P_ evac; P_ forward_info;
240 /*** Evac Decision Code -- calls real evac code ***/
242 extern P_ _Evacuate_Old_to_New();
244 #define GEN_EVAC_CODE(suffix) \
245 P_ CAT2(_Evacuate_,suffix)(evac) \
249 if (ShouldPromote(evac)) { \
251 tmp = ToHp; ToHp = OldHp; \
252 newevac = CAT2(_do_Evacuate_,suffix)(evac, (P_)Forward_Ref_Old_info); \
253 OldHp = ToHp; ToHp = tmp; \
256 newevac = CAT2(_do_Evacuate_,suffix)(evac, (P_)Forward_Ref_New_info); \
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); \
267 /*** FORWARD REF STUFF ***/
269 /*** Setting Forward Ref: grab argument passed to evac code ***/
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.
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
283 #define SET_FORWARD_REF(closure, forw) \
284 SET_INFO_PTR(closure,forward); /* arg passed to evac function */ \
285 FORWARD_ADDRESS(closure) = (W_)(forw)
289 _Evacuate_Old_Forward_Ref(evac)
292 /* Forward ref to old generation -- just return */
295 evac = (P_) FORWARD_ADDRESS(evac);
300 _Evacuate_New_Forward_Ref(evac)
303 /* Forward ref to new generation -- check scavenged from the old gen */
306 if (InOldGen(Scav)) {
307 evac = (P_) _Evacuate_Old_to_New(FORWARD_ADDRESS(evac), evac);
309 evac = (P_) FORWARD_ADDRESS(evac);
315 _Evacuate_OldRoot_Forward(evac)
318 /* Forward ref to old generation root -- return old root or new gen closure */
319 DEBUG_EVAC_OLDROOT_FORWARD;
321 /* grab old generation root */
322 evac = (P_) FORWARD_ADDRESS(evac);
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);
333 EXTDATA_RO(Forward_Ref_New_info);
334 EXTDATA_RO(Forward_Ref_Old_info);
335 EXTDATA_RO(OldRoot_Forward_Ref_info);
337 /*** Old Gen Reference to New Gen Closure ***/
340 _Evacuate_Old_to_New(newevac, evac)
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 */
351 P_ oldind = OldHp + 1; /* see START_ALLOC */
352 OldHp = oldind + (FIXED_HS-1) + MIN_UPD_SIZE; /* see FINISH_ALLOC */
354 DEBUG_EVAC_OLD_TO_NEW(oldind, evac, newevac);
356 INFO_PTR(evac) = (W_) OldRoot_Forward_Ref_info;
357 FORWARD_ADDRESS(evac) = (W_)oldind;
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++;
368 #define PROMOTE_MUTABLE(evac) \
369 if (InOldGen(evac)) { \
370 MUT_LINK(evac) = (W_) genInfo.PromMutables; \
371 genInfo.PromMutables = (P_) evac; \
378 #define PROMOTE_MUTABLE(evac) \
379 MUT_LINK(evac) = (W_) appelInfo.PromMutables; \
380 appelInfo.PromMutables = (P_) evac;
384 #define PROMOTE_MUTABLE(evac)
388 /*** Real Evac Code -- simply passed closure ***/
390 #define EVAC_FN(suffix) \
391 P_ CAT2(_Evacuate_,suffix)(evac) \
394 /*** FORWARD REF STUFF ***/
396 #define SET_FORWARD_REF(closure, forw) \
397 SET_INFO_PTR(closure, Forward_Ref_info); \
398 FORWARD_ADDRESS(closure) = (W_) (forw)
401 _Evacuate_Forward_Ref(evac)
405 evac = (P_) FORWARD_ADDRESS(evac);
409 EXTDATA_RO(Forward_Ref_info);
414 /*** SPECIALISED CODE ***/
416 /* Note: code for evacuating selectors is given near that for Ind(irections) */
424 SPEC_COPY_FREE_VAR(1);
425 SET_FORWARD_REF(evac,ToHp);
436 SPEC_COPY_FREE_VAR(1);
437 SPEC_COPY_FREE_VAR(2);
438 SET_FORWARD_REF(evac,ToHp);
449 SPEC_COPY_FREE_VAR(1);
450 SPEC_COPY_FREE_VAR(2);
451 SPEC_COPY_FREE_VAR(3);
452 SET_FORWARD_REF(evac,ToHp);
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);
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);
489 #define BIG_SPEC_EVAC_FN(n) \
496 for (i = 1; i <= n; i++) { SPEC_COPY_FREE_VAR(i); } \
497 SET_FORWARD_REF(evac,ToHp); \
503 /* instantiate for 6--12 */
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
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
530 #define SPEC_RBH_EVAC_FN(n) \
531 EVAC_FN(CAT2(RBH_,n)) \
537 for (i = 0; i < n - 1; i++) { COPY_WORD(SPEC_RBH_HS + i); } \
538 SET_FORWARD_REF(evac,ToHp); \
541 PROMOTE_MUTABLE(evac);\
545 /* instantiate for 2--12 */
563 START_ALLOC(MallocPtr_SIZE);
564 DEBUG_EVAC(MallocPtr_SIZE);
566 #if defined(_GC_DEBUG)
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) );
576 SET_FORWARD_REF(evac,ToHp);
577 MallocPtr_CLOSURE_DATA(ToHp) = MallocPtr_CLOSURE_DATA(evac);
578 MallocPtr_CLOSURE_LINK(ToHp) = MallocPtr_CLOSURE_LINK(evac);
580 #if defined(_GC_DEBUG)
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) );
589 FINISH_ALLOC(MallocPtr_SIZE);
594 /*** GENERIC CASE CODE ***/
598 I_ count = FIXED_HS - 1;
599 I_ size = GEN_CLOSURE_SIZE(evac);
604 while (++count <= size + (FIXED_HS - 1)) {
607 SET_FORWARD_REF(evac,ToHp);
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.
625 I_ count = GEN_RBH_HS - 1;
626 I_ size = GEN_RBH_CLOSURE_SIZE(evac);
631 while (++count <= size + (FIXED_HS - 1)) {
634 SET_FORWARD_REF(evac,ToHp);
638 PROMOTE_MUTABLE(evac);
644 /*** DYNAMIC CLOSURE -- SIZE & PTRS STORED IN CLOSURE ***/
648 I_ count = FIXED_HS - 1;
649 I_ size = DYN_CLOSURE_SIZE(evac); /* Includes size and no-of-ptrs fields */
654 while (++count <= size + (FIXED_HS - 1)) {
657 SET_FORWARD_REF(evac,ToHp);
663 /*** TUPLE CLOSURE -- NO. OF PTRS STORED IN CLOSURE -- NO DATA ***/
667 I_ count = FIXED_HS - 1;
668 I_ size = TUPLE_CLOSURE_SIZE(evac);
673 while (++count <= size + (FIXED_HS - 1)) {
676 SET_FORWARD_REF(evac,ToHp);
682 /*** MUTUPLE CLOSURE -- NO. OF PTRS STORED IN CLOSURE -- NO DATA ***/
683 /* Only if special GC treatment required */
685 #ifdef GC_MUT_REQUIRED
688 I_ count = FIXED_HS - 1;
689 I_ size = MUTUPLE_CLOSURE_SIZE(evac);
695 while (++count <= size + (FIXED_HS - 1)) {
698 SET_FORWARD_REF(evac,ToHp);
702 /* Add to OldMutables list (if evacuated to old generation) */
703 PROMOTE_MUTABLE(evac);
707 #endif /* GCgn or GCap */
710 /*** DATA CLOSURE -- SIZE STORED IN CLOSURE -- NO POINTERS ***/
714 I_ count = FIXED_HS - 1;
715 I_ size = DATA_CLOSURE_SIZE(evac);
720 while (++count <= size + (FIXED_HS - 1)) {
723 SET_FORWARD_REF(evac,ToHp);
730 /*** STATIC CLOSURE CODE ***/
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 */
737 _Evacuate_Static(evac)
745 _Scavenge_Static(STG_NO_ARGS)
747 fprintf(stderr,"Called _Scavenge_Static: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
752 /*** BLACK HOLE CODE ***/
756 START_ALLOC(MIN_UPD_SIZE);
757 DEBUG_EVAC_BH(MIN_UPD_SIZE);
759 SET_FORWARD_REF(evac,ToHp);
761 FINISH_ALLOC(MIN_UPD_SIZE);
767 START_ALLOC(MIN_NONUPD_SIZE);
768 DEBUG_EVAC_BH(MIN_NONUPD_SIZE);
770 SET_FORWARD_REF(evac,ToHp);
772 FINISH_ALLOC(MIN_NONUPD_SIZE);
776 /*** INDIRECTION CODE ***/
778 /* Evacuation: Evacuate closure pointed to */
785 evac = (P_) IND_CLOSURE_PTR(evac);
787 #if defined(GCgn) || defined(GCap)
788 if (evac > OldGen) /* Only evacuate new gen with generational collector */
789 evac = EVACUATE_CLOSURE(evac);
791 evac = EVACUATE_CLOSURE(evac);
797 /* This will generate a stack of returns for a chain of indirections!
798 However chains can only be 2 long.
802 #ifdef USE_COST_CENTRES
806 START_ALLOC(MIN_UPD_SIZE);
810 SET_FORWARD_REF(evac,ToHp);
812 FINISH_ALLOC(MIN_UPD_SIZE);
817 /*** SELECTORS CODE (much like an indirection) ***/
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.
823 If it is so evaluated at GC time, we want to simply select the n'th
826 This thunk is of course always a Spec thing, since it has only one
829 The constructor is guaranteed to be a Spec thing, so we know where
832 ToDo: what if the constructor is a Gen thing?
835 _EvacuateSelector_n(evac, n)
839 P_ maybe_con = (P_) evac[_FHS];
841 /* must be a SPEC 2 1 closure */
842 ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */
844 #if defined(_GC_DEBUG)
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)));
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) );
855 #if defined(_GC_DEBUG)
857 fprintf(stderr, "Evac Selector:shorting: 0x%lx -> 0x%lx\n",
858 evac, maybe_con[_FHS + n]);
861 /* Ha! Short it out */
862 evac = (P_) (maybe_con[_FHS + n]); /* evac now has the result of the selection */
864 #if defined(GCgn) || defined(GCap)
865 if (evac > OldGen) /* Only evacuate new gen with generational collector */
866 evac = EVACUATE_CLOSURE(evac);
868 evac = EVACUATE_CLOSURE(evac);
874 #define DEF_SEL_EVAC(n) \
875 P_ CAT2(_EvacuateSelector_,n) (evac) P_ evac; \
876 { return(_EvacuateSelector_n(evac,n)); }
878 /* all the entry points */
896 START_ALLOC(MIN_UPD_SIZE);
902 SET_FORWARD_REF(evac,ToHp);
904 FINISH_ALLOC(MIN_UPD_SIZE);
906 /* Add to OldMutables list (if evacuated to old generation) */
907 PROMOTE_MUTABLE(evac);
916 START_ALLOC(TSO_VHS + TSO_CTS_SIZE);
917 DEBUG_EVAC_TSO(TSO_VHS + TSO_CTS_SIZE);
920 for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) {
924 *TSO_INTERNAL_PTR(ToHp) = *TSO_INTERNAL_PTR(evac);
926 SET_FORWARD_REF(evac, ToHp);
928 FINISH_ALLOC(TSO_VHS + TSO_CTS_SIZE);
930 /* Add to OldMutables list (if evacuated to old generation) */
931 PROMOTE_MUTABLE(evac);
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);
946 DEBUG_EVAC_STKO(STKO_CLOSURE_CTS_SIZE(evac) - spa_offset + 1, spb_offset);
949 #ifdef DO_REDN_COUNTING
950 COPY_WORD(STKO_ADEP_LOCN);
951 COPY_WORD(STKO_BDEP_LOCN);
953 COPY_WORD(STKO_SIZE_LOCN);
954 COPY_WORD(STKO_RETURN_LOCN);
955 COPY_WORD(STKO_LINK_LOCN);
957 /* Adjust the four stack pointers -- ORDER IS IMPORTANT!! */
958 offset = ToHp - evac;
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;
966 /* Slide the A stack */
967 for (count = spa_offset; count <= STKO_CLOSURE_CTS_SIZE(evac); count++) {
968 COPY_WORD((STKO_HS-1) + count);
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);
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;
989 SET_FORWARD_REF(evac, ToHp);
993 /* Add to OldMutables list (if evacuated to old generation) */
994 PROMOTE_MUTABLE(evac);
1005 COPY_WORD(FETCHME_GA_LOCN);
1006 ASSERT(GALAlookup(FETCHME_GA(evac)) != NULL);
1008 SET_FORWARD_REF(evac,ToHp);
1012 /* Add to OldMutables list (if evacuated to old generation) */
1013 PROMOTE_MUTABLE(evac);
1022 START_ALLOC(BF_CLOSURE_SIZE(evac));
1026 for (count = FIXED_HS; count < FIXED_HS + BF_VHS; count++) {
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);
1035 SET_FORWARD_REF(evac, ToHp);
1037 FINISH_ALLOC(BF_CLOSURE_SIZE(evac));
1039 /* Add to OldMutables list (if evacuated to old generation) */
1040 PROMOTE_MUTABLE(evac);
1045 #endif /* CONCURRENT */
1047 /*** SPECIAL CAF CODE ***/
1049 /* Evacuation: Return closure pointed to (already explicitly evacuated) */
1050 /* Scavenging: Should not be scavenged */
1057 evac = (P_) IND_CLOSURE_PTR(evac);
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.
1067 _Evacuate_Caf_Evac_Upd(evac)
1072 DEBUG_EVAC_CAF_EVAC1;
1073 INFO_PTR(evac) = (W_) Caf_info; /* Change to return CAF */
1075 evac = (P_) IND_CLOSURE_PTR(evac); /* Grab reference and evacuate */
1077 #if defined(GCgn) || defined(GCap)
1078 if (evac > OldGen) /* Only evacuate new gen with generational collector */
1079 evac = EVACUATE_CLOSURE(evac);
1081 evac = EVACUATE_CLOSURE(evac);
1084 IND_CLOSURE_PTR(closure) = (W_) evac; /* Update reference */
1086 DEBUG_EVAC_CAF_EVAC2;
1089 /* This will generate a stack of returns for a chain of indirections!
1090 However chains can only be 2 long.
1095 /*** CONST CLOSURE CODE ***/
1097 /* Evacuation: Just return address of the static closure stored in the info table */
1098 /* Scavenging: Const closures should never be scavenged */
1101 _Evacuate_Const(evac)
1105 evac = CONST_STATIC_CLOSURE(INFO_PTR(evac));
1110 _Scavenge_Const(STG_NO_ARGS)
1112 fprintf(stderr,"Called _Scavenge_Const: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
1117 /*** CHARLIKE CLOSURE CODE ***/
1119 /* Evacuation: Just return address of the static closure stored fixed array */
1120 /* Scavenging: CharLike closures should never be scavenged */
1123 _Evacuate_CharLike(evac)
1126 DEBUG_EVAC_CHARLIKE;
1127 evac = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac));
1132 _Scavenge_CharLike(STG_NO_ARGS)
1134 fprintf(stderr,"Called _Scavenge_CharLike: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav));
1139 --- INTLIKE CLOSURE CODE ---
1141 Evacuation: Return address of the static closure if available
1142 Otherwise evacuate converting to aux closure.
1144 Scavenging: IntLike closures should never be scavenged.
1146 There are some tricks here:
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.
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)
1159 I_ val = INTLIKE_VALUE(evac);
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 */
1166 START_ALLOC(1); /* evacuate closure of size 1 */
1169 SPEC_COPY_FREE_VAR(1);
1170 SET_FORWARD_REF(evac,ToHp);
1192 GEN_EVAC_CODE(Tuple)
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))
1200 #else /* ! _INFO_COPYING */
1201 This really really should not ever ever come up!
1202 #endif /* ! _INFO_COPYING */