1 /* gc.c
2 * Copyright 1984-2017 Cisco Systems, Inc.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 */
16
17 #include "system.h"
18 #include "sort.h"
19 #ifndef WIN32
20 #include <sys/wait.h>
21 #endif /* WIN32 */
22 #include "popcount.h"
23 #include <assert.h>
24
25 /*
26 GC Implementation
27 -----------------
28
29 The copying, sweeping, and marking operations that depend on
30 object's shape are mostly implemented in "mkgc.ss". That script
31 generates "gc-ocd.inc" (for modes where object counting and
32 backpointers are disabled), "gc-oce.inc", and "gc-par.inc". The
33 rest of the implementation here can still depend on representatoin
34 details, though, especially for pairs, weak pairs, and ephemerons.
35
36 GC Copying versus Marking
37 -------------------------
38
39 Generations range from 0 to `S_G.max_nonstatic_generation` plus a
40 static generation. After an object moves to the static generation,
41 it doesn't move anymore. In the case of code objects, relocations
42 may be discarded when the code object moves into a static
43 generation.
44
45 For the most part, collecting generations 0 through MAX_CG (= max
46 copied generation) to MIN_TG to MAX_TG (= target generation) means
47 copying objects from old segments into fresh segments generations
48 MIN_TG through MAX_TG. Note that MAX_TG is either the same as or
49 one larger than MAX_CG. For objects in generation 0 through MAX_CG,
50 the target generation is either one more than the current
51 generation or it's MIN_TG.
52
53 Objects might be marked [and swept] instead of copied [and swept]
54 as triggered by two possibilities: one or more objects on the
55 source segment are immobile (subsumes locked) or MAX_CG == MAX_TG
56 and the object is on a MAX_CG segment that hasn't been disovered as
57 sparse by a previous marking (non-copying) pass. Segments with
58 marked objects are promoted to the target generation.
59
60 As a special case, locking on `space_new` does not mark all objects
61 on that segment, because dirty-write handling cannot deal with
62 `space_new`; only locked objects stay on the old segment in that
63 case, and they have to be marked by looking at a list of locked
64 objects.
65
66 During a collection, the `old_space` flag is set on a segment if
67 objects aree being copied out of it or marked on it; that is,
68 `old_space` is set if the segment starts out in one of the
69 generations 0 through mgc. If a segment is being marked instead of
70 copied, the `use_marks` bit is also set; note that the bit will not
71 be set for a `space_new` segment, and locked objects in that space
72 will be specially marked.
73
74 Marking an object means setting a bit in `marked_mask`, which is
75 allocated as needed. Any segments that ends up with a non-NULL
76 `marked_mask` is kept in its new generation at the end of
77 collection. If a marked object spans multiple segments, then
78 `masked_mask` is created across all of the segments. It's possible
79 for a segment to end up with `marked_mask` even though `use_marks`
80 was not set: an marked object spanned into the segment, or it's a
81 `space_new` segment with locked objects; in that case, other
82 objects will be copied out of the segment, because `use_marks` is
83 how relocation decides whether to copy or mark.
84
85 If an object is copied, then its first word is set to
86 `forward_marker` and its second word is set to the new address.
87 Obviously, that doesn't happen if an object is marked. So, to test
88 whether an object has been reached:
89
90 * the object must be in an `old_space` segment, otherwise it counts
91 as reached because it's in a generation older than MAX_CG;
92
93 * the object either starts with `forward_marker` or its mark bit is
94 set (and those are mutually exclusive).
95
96 Besides the one bit for the start of an object in the mark mask,
97 extra bits for the object content may be set as well. Those extra
98 bits tell the dirty-object sweeper which words in a previously
99 marked page should be swept and which should be skipped, so the
100 extra bits are only needed for impure objects in certain kinds of
101 spaces. Only every alternate word needs to be marked that way, so
102 half of the mark bits are usually irrelevant; the exception is that
103 flonums can be between normal object-start positions, so those mark
104 bits can matter, at least if we're preserving `eq?` on flonums (but
105 the bits are not relevant to dirty-object sweeping, since flonums
106 don't have pointer fields).
107
108 It's ok to sweep an object multiple times, but that's to be be
109 avoided if possible.
110
111 Pending Ephemerons and Guardians
112 --------------------------------
113
114 Ephemerons and guardians act as a kind of "and": an object stays
115 reachable only if some other object (besdies the the
116 ephemeron/guardian itself) is reachable or not. Instead of
117 rechecking all guardians and ephemerons constantly, the collector
118 queues pending guardians and ephemerons on the ssegment where the
119 relevant object lives. If any object on that segment is discovered
120 to be reachable (i.e., copied or marked), the guardian/ephemeron is
121 put into a list of things to check again.
122
123 Parallel Collection
124 -------------------
125
126 Parallel mode runs `sweep_generation` concurrently in multiple
127 sweeper threads. It relies on a number of invariants:
128
129 * There are no attempts to take tc_mutex during sweeping. To the
130 degree that locking is needed (e.g., to allocate new segments),
131 the allocation mutex is used. No other locks can be taken while
132 that one is held.
133
134 Along similar lines, get_thread_context() must not be used,
135 because the sweepers threads are not the same as Scheme threads,
136 and a sweeper thread may temporarily adapt a different Scheme
137 thread context.
138
139 * To copy from or mark on a segment, a sweeper must own the
140 segment. A sweeper during sweeping may encounter a "remote"
141 reference to a segment that it doesn't own; in that case, it
142 registers the object containing the remote reference to be
143 re-swept by the sweeeer that owns the target of the reference.
144
145 A segment is owned by the thread that originally allocated it.
146 When a GC starts, for old-space segments that are owned by
147 threads that do no have a corresponding sweeper, the segment is
148 moved to the main collecting thread's ownership.
149
150 Note that copying and marking are constrained so that they don't
151 have to recursively copy or mark. In some cases, this property
152 is achieved by not caring whether a reference goes to an old
153 copy or unmarked object; for example, a record type's size field
154 will be the same in both places, so either copy can be used to
155 determine a record size of copying. A record type's parent field
156 would not be available, however, since it can get overwritten
157 with forwarding information.
158
159 * An object that is marked does not count as "remote".
160
161 Sweepers might attempt to access marked-object information at
162 the same time that it is being updated by the owning sweeper.
163 It's ok if the non-owning sweepers get stale information;
164 they'll just send the referencing object to the owning thread
165 for re-sweeping. A write fence ensures that non-owning sweepers
166 do not inspect mark-bitmap bits that have not been initialized.
167
168 * Normally, a sweeper that encounters a remote reference can
169 continue sweeping and eventually register the remote re-sweep.
170 An object is swept by only one sweeper at a time; if multiple
171 remote references to different sweepers are discovered in an
172 object, it is sent to only one of the remote sweepers, and that
173 sweeper will eventually send on the object to the other sweeper.
174 At worst, each object is swept N times for N sweepers.
175
176 In rare cases, a sweeper cannot fully process an object, because
177 doing so would require inspecting a remote object. For example,
178 a record type's pointer mask or a stack frame's live-pointer
179 mask can be a bignum, and the bignum might be remote. In those
180 cases, the object might have to be sent back to the original
181 sweeper, and so on. In the owrst case, the object can be swept
182 more tha N times ---- but, again, this case rarely happens at
183 all, and sweeping more than N times is very unlikely.
184
185 * In counting/backtrace/measure mode, "parallel" collection can be
186 used to preserve object ownership, but no extra sweeper threads
187 are used. So, it is not really parallel, and counting and
188 backtrace operations do not need locks.
189
190 Counting needs to copy or mark a record-type or object-count
191 object as part of a copy or mark operation, which is otherwise
192 not allowed (but ok with counting, since it's not actually in
193 parallel). For that purpose, `relocate_pure_in_owner`
194 temporarily switches to the owning thread.
195
196 */
197
198 /* locally defined functions */
199 static IGEN copy PROTO((thread_gc *tgc, ptr pp, seginfo *si, ptr *dest));
200 static IGEN mark_object PROTO((thread_gc *tgc, ptr pp, seginfo *si));
201 static void sweep PROTO((thread_gc *tgc, ptr p, IGEN from_g));
202 static void sweep_in_old PROTO((thread_gc *tgc, ptr p));
203 static void sweep_object_in_old PROTO((thread_gc *tgc, ptr p));
204 static IBOOL object_directly_refers_to_self PROTO((ptr p));
205 static ptr copy_stack PROTO((thread_gc *tgc, ptr old, iptr *length, iptr clength));
206 static void resweep_weak_pairs PROTO((seginfo *oldweakspacesegments));
207 static void forward_or_bwp PROTO((ptr *pp, ptr p));
208 static void sweep_generation PROTO((thread_gc *tgc));
209 static iptr sweep_from_stack PROTO((thread_gc *tgc));
210 static void enlarge_stack PROTO((thread_gc *tgc, ptr *stack, ptr *stack_start, ptr *stack_limit, uptr grow_at_least));
211 static uptr size_object PROTO((ptr p));
212 static iptr sweep_typed_object PROTO((thread_gc *tgc, ptr p, IGEN from_g));
213 static void sweep_symbol PROTO((thread_gc *tgc, ptr p, IGEN from_g));
214 static void sweep_port PROTO((thread_gc *tgc, ptr p, IGEN from_g));
215 static void sweep_thread PROTO((thread_gc *tgc, ptr p));
216 static void sweep_continuation PROTO((thread_gc *tgc, ptr p, IGEN from_g));
217 static void sweep_record PROTO((thread_gc *tgc, ptr x, IGEN from_g));
218 static IGEN sweep_dirty_record PROTO((thread_gc *tgc, ptr x, IGEN youngest));
219 static IGEN sweep_dirty_port PROTO((thread_gc *tgc, ptr x, IGEN youngest));
220 static IGEN sweep_dirty_symbol PROTO((thread_gc *tgc, ptr x, IGEN youngest));
221 static void sweep_code_object PROTO((thread_gc *tgc, ptr co, IGEN from_g));
222 static void record_dirty_segment PROTO((IGEN from_g, IGEN to_g, seginfo *si));
223 static void setup_sweep_dirty PROTO((thread_gc *tgc));
224 static uptr sweep_dirty_segments PROTO((thread_gc *tgc, seginfo **dirty_segments));
225 static void resweep_dirty_weak_pairs PROTO((thread_gc *tgc));
226 static void mark_untyped_data_object PROTO((thread_gc *tgc, ptr p, uptr len, seginfo *si));
227 static void add_pending_guardian PROTO((ptr gdn, ptr tconc));
228 static void add_trigger_guardians_to_recheck PROTO((ptr ls));
229 static void add_ephemeron_to_pending PROTO((thread_gc *tgc, ptr p));
230 static void add_trigger_ephemerons_to_pending PROTO((thread_gc *tgc, ptr p));
231 static void check_triggers PROTO((thread_gc *tgc, seginfo *si));
232 static void check_ephemeron PROTO((thread_gc *tgc, ptr pe));
233 static void check_pending_ephemerons PROTO((thread_gc *tgc));
234 static int check_dirty_ephemeron PROTO((thread_gc *tgc, ptr pe, int youngest));
235 static void finish_pending_ephemerons PROTO((thread_gc *tgc, seginfo *si));
236 static void init_fully_marked_mask(thread_gc *tgc, IGEN g);
237 static void copy_and_clear_list_bits(thread_gc *tgc, seginfo *oldspacesegments);
238
239 #ifdef ENABLE_OBJECT_COUNTS
240 static uptr total_size_so_far();
241 static uptr list_length PROTO((ptr ls));
242 #endif
243 static uptr target_generation_space_so_far(thread_gc *tgc);
244
245 #ifdef ENABLE_MEASURE
246 static void init_measure(thread_gc *tgc, IGEN min_gen, IGEN max_gen);
247 static void finish_measure();
248 static void measure(thread_gc *tgc, ptr p);
249 static void flush_measure_stack(thread_gc *tgc);
250 static void init_measure_mask(thread_gc *tgc, seginfo *si);
251 static void init_counting_mask(thread_gc *tgc, seginfo *si);
252 static void push_measure(thread_gc *tgc, ptr p);
253 static void measure_add_stack_size(ptr stack, uptr size);
254 static void add_ephemeron_to_pending_measure(thread_gc *tgc, ptr pe);
255 static void add_trigger_ephemerons_to_pending_measure(ptr pe);
256 static void check_ephemeron_measure(thread_gc *tgc, ptr pe);
257 static void check_pending_measure_ephemerons(thread_gc *tgc);
258 #endif
259
260 #ifdef ENABLE_PARALLEL
261 /* # define ENABLE_TIMING */
262 #endif
263
264 #ifdef ENABLE_TIMING
265 #include <sys/time.h>
get_real_time()266 static uptr get_real_time () {
267 struct timeval now;
268 gettimeofday(&now, NULL);
269 return ((uptr) now.tv_sec) * 1000 + ((uptr) now.tv_usec) / 1000;
270 }
get_cpu_time()271 static uptr get_cpu_time () {
272 struct timespec now;
273 clock_gettime(CLOCK_THREAD_CPUTIME_ID, &now);
274 return ((uptr) now.tv_sec) * 1000 + ((uptr) now.tv_nsec) / 1000000;
275 }
276 # define GET_REAL_TIME(x) uptr x = get_real_time()
277 # define GET_CPU_TIME(x) uptr x = get_cpu_time()
278 # define ACCUM_REAL_TIME(a, y, x) uptr y = get_real_time() - x; a += y
279 # define ACCUM_CPU_TIME(a, y, x) uptr y = get_cpu_time() - x; a += y
280 # define REPORT_TIME(e) e
281 static uptr collect_accum, all_accum, par_accum;
282 # define COUNT_SWEPT_BYTES(start, end) num_swept_bytes += ((uptr)TO_PTR(end) - (uptr)TO_PTR(start))
283 # define ADJUST_COUNTER(e) e
284 #else
285 # define GET_REAL_TIME(x) do { } while (0)
286 # define GET_CPU_TIME(x) do { } while (0)
287 # define ACCUM_REAL_TIME(a, y, x) do { } while (0)
288 # define ACCUM_CPU_TIME(a, y, x) do { } while (0)
289 # define REPORT_TIME(e) do { } while (0)
290 # define COUNT_SWEPT_BYTES(start, end) do { } while (0)
291 # define ADJUST_COUNTER(e) do { } while (0)
292 #endif
293
294 #if defined(MIN_TG) && defined(MAX_TG)
295 # if MIN_TG == MAX_TG
296 # define NO_DIRTY_NEWSPACE_POINTERS
297 # endif
298 #endif
299
300 /* #define DEBUG */
301
302 /* initialized and used each gc cycle. any others should be defined in globals.h */
303 static ptr tlcs_to_rehash;
304 static ptr conts_to_promote;
305 static ptr recheck_guardians_ls;
306 static seginfo *resweep_weak_segments;
307
308 #ifdef ENABLE_OBJECT_COUNTS
309 static int measure_all_enabled;
310 static uptr count_root_bytes;
311 #endif
312
313 /* max_cg: maximum copied generation, i.e., maximum generation subject to collection. max_cg >= 0 && max_cg <= static_generation.
314 * min_tg: minimum target generation. max_tg == 0 ? min_tg == 0 : min_tg > 0 && min_tg <= max_tg;
315 * max_tg: maximum target generation. max_tg == max_cg || max_tg == max_cg + 1.
316 * Objects in generation g are collected into generation MIN(max_tg, MAX(min_tg, g+1)).
317 */
318 #if defined(MAX_CG) && defined(MIN_TG) && defined(MAX_TG)
319 #else
320 static IGEN MAX_CG, MIN_TG, MAX_TG;
321 #endif
322
323 #if defined(MIN_TG) && defined(MAX_TG) && (MIN_TG == MAX_TG)
324 # define TARGET_GENERATION(si) MIN_TG
325 # define compute_target_generation(g) MIN_TG
326 # define CONSTANT_TARGET_GENERATION
327 #else
328 # define TARGET_GENERATION(si) si->generation
compute_target_generation(IGEN g)329 FORCEINLINE IGEN compute_target_generation(IGEN g) {
330 return g == MAX_TG ? g : g < MIN_TG ? MIN_TG : g + 1;
331 }
332 #endif
333
334 static octet *fully_marked_mask[static_generation+1];
335
336 static const int sweep_stack_min_size = 256;
337
338 #define push_sweep(p) do { \
339 if (tgc->sweep_stack == tgc->sweep_stack_limit) \
340 enlarge_stack(tgc, &tgc->sweep_stack, &tgc->sweep_stack_start, &tgc->sweep_stack_limit, ptr_bytes); \
341 *(ptr *)TO_VOIDP(tgc->sweep_stack) = p; \
342 tgc->sweep_stack = (ptr)((uptr)tgc->sweep_stack + ptr_bytes); \
343 } while (0)
344
345 #ifdef ENABLE_MEASURE
346 static uptr measure_total; /* updated by `measure` */
347 static IGEN min_measure_generation, max_measure_generation;
348 static ptr *measure_stack_start, *measure_stack, *measure_stack_limit;
349 static ptr measured_seginfos;
350 static ptr pending_measure_ephemerons;
351 #endif
352
353 #ifdef ENABLE_BACKREFERENCE
354 static ptr sweep_from;
355 # define BACKREFERENCES_ENABLED S_G.enable_object_backreferences
356 # define SET_SWEEP_FROM(p) if (S_G.enable_object_backreferences) sweep_from = p
357 # define WITH_TOP_BACKREFERENCE(v, e) SET_SWEEP_FROM(v); e; SET_SWEEP_FROM(Sfalse)
358 # define SET_BACKREFERENCE(p) sweep_from = p
359 # define PUSH_BACKREFERENCE(p) ptr old_sweep_from = sweep_from; SET_SWEEP_FROM(p);
360 # define POP_BACKREFERENCE() SET_SWEEP_FROM(old_sweep_from);
361 # define ADD_BACKREFERENCE_FROM(p, from_p, tg) do { \
362 IGEN TG = tg; \
363 if ((S_G.enable_object_backreferences) && (TG < static_generation)) \
364 S_G.gcbackreference[TG] = S_cons_in(tgc->tc, space_impure, TG, \
365 S_cons_in(tgc->tc, space_impure, TG, p, from_p), \
366 S_G.gcbackreference[TG]); \
367 } while (0)
368 # define ADD_BACKREFERENCE(p, tg) ADD_BACKREFERENCE_FROM(p, sweep_from, tg)
369 #else
370 # define BACKREFERENCES_ENABLED 0
371 # define WITH_TOP_BACKREFERENCE(v, e) e
372 # define SET_BACKREFERENCE(p) do { } while (0)
373 # define PUSH_BACKREFERENCE(p)
374 # define POP_BACKREFERENCE()
375 # define ADD_BACKREFERENCE_FROM(p, from_p, from_g)
376 # define ADD_BACKREFERENCE(p, from_g)
377 #endif
378
379 #if !defined(PTHREADS)
380 # undef ENABLE_PARALLEL
381 #endif
382
383 #ifdef ENABLE_PARALLEL
384
385 static int in_parallel_sweepers = 0;
386
387 #define HAS_SWEEPER_WRT(t_tc, tc) 1
388
389 # define GC_MUTEX_ACQUIRE() alloc_mutex_acquire()
390 # define GC_MUTEX_RELEASE() alloc_mutex_release()
391
392 /* shadows `tgc` binding in context: */
393 # define BLOCK_SET_THREAD(a_tgc) thread_gc *tgc = a_tgc
394
395 # define SEGMENT_IS_LOCAL(si, p) (((si)->creator == tgc) || marked(si, p) || !in_parallel_sweepers)
396 # define FLUSH_REMOTE_BLOCK thread_gc *remote_tgc = NULL;
397 # define RECORD_REMOTE(si) remote_tgc = si->creator
398 # define FLUSH_REMOTE(tgc, p) do { \
399 if (remote_tgc != NULL) \
400 push_remote_sweep(tgc, p, remote_tgc); \
401 } while (0)
402 # define ASSERT_EMPTY_FLUSH_REMOTE() do { \
403 if (remote_tgc != NULL) S_error_abort("non-empty remote flush"); \
404 } while (0);
405
406 static void setup_sweepers(thread_gc *tgc);
407 static void run_sweepers(void);
408 static void teardown_sweepers(void);
409 # define parallel_sweep_generation(tgc) run_sweepers()
410 # define parallel_sweep_dirty_and_generation(tgc) run_sweepers()
411
412 static void push_remote_sweep(thread_gc *tgc, ptr p, thread_gc *remote_tgc);
413 static void send_and_receive_remote_sweeps(thread_gc *tgc);
414
415 #define SWEEPER_NONE 0
416 #define SWEEPER_READY 1
417 #define SWEEPER_SWEEPING 2
418 #define SWEEPER_WAITING_FOR_WORK 3
419
420 typedef struct {
421 int status;
422 s_thread_cond_t done_cond, work_cond;
423 thread_gc *first_tgc, *last_tgc;
424
425 iptr num_swept_bytes;
426
427 #ifdef ENABLE_TIMING
428 int remotes_sent, remotes_received;
429 uptr step, sweep_accum;
430 #endif
431 } gc_sweeper;
432
433 static gc_sweeper sweepers[maximum_parallel_collect_threads+1];
434 static int num_sweepers;
435
436 # define PARALLEL_UNUSED UNUSED
437 # define NO_PARALLEL_UNUSED /* empty */
438
439 #else
440
441 #define HAS_SWEEPER_WRT(t_tc, tc) (t_tc == tc)
442
443 # define GC_MUTEX_ACQUIRE() do { } while (0)
444 # define GC_MUTEX_RELEASE() do { } while (0)
445
446 # define BLOCK_SET_THREAD(a_tgc) do { } while (0)
447
448 # define SEGMENT_IS_LOCAL(si, p) 1
449 # define FLUSH_REMOTE_BLOCK /* empty */
450 # define RECORD_REMOTE(si) do { } while (0)
451 # define FLUSH_REMOTE(tgc, p) do { } while (0)
452 # define ASSERT_EMPTY_FLUSH_REMOTE() do { } while (0)
453
454 # define setup_sweepers(tgc) do { } while (0)
455 # define parallel_sweep_generation(tgc) do { sweep_generation(tgc); } while (0)
456 # define parallel_sweep_dirty_and_generation(tgc) do { sweep_dirty(tgc); sweep_generation(tgc); } while (0)
457 # define send_and_receive_remote_sweeps(tgc) do { } while (0)
458 # define teardown_sweepers() do { } while (0)
459 static void sweep_dirty PROTO((thread_gc *tgc));
460
461 # define PARALLEL_UNUSED /* empty */
462 # define NO_PARALLEL_UNUSED UNUSED
463
464 #endif
465
466 #define SWEEP_NO_CHANGE 0
467 #define SWEEP_CHANGE_PROGRESS 1
468
469 #if ptr_alignment == 2
470 # define record_full_marked_mask 0x55
471 # define record_high_marked_bit 0x40
472 # define mask_bits_to_list_bits_mask(m) ((m) | ((m) << 1))
473 #elif ptr_alignment == 1
474 # define record_full_marked_mask 0xFF
475 # define record_high_marked_bit 0x80
476 # define mask_bits_to_list_bits_mask(m) (m)
477 #endif
478
479 #define segment_sufficiently_compact_bytes ((bytes_per_segment * 3) / 4)
480 #define chunk_sufficiently_compact(nsegs) ((nsegs) >> 2)
481
482 /* Values for a guardian entry's `pending` field when it's added to a
483 seginfo's pending list: */
484 enum {
485 GUARDIAN_PENDING_HOLD,
486 GUARDIAN_PENDING_FINAL
487 };
488
489 #ifdef ENABLE_OBJECT_COUNTS
list_length(ptr ls)490 uptr list_length(ptr ls) {
491 uptr i = 0;
492 while (ls != Snil) { ls = Scdr(ls); i += 1; }
493 return i;
494 }
495 #endif
496
497 #define init_mask(tgc, dest, tg, init) do { \
498 octet *MASK; \
499 find_gc_room_voidp(tgc, space_data, tg, ptr_align(segment_bitmap_bytes), MASK); \
500 memset(MASK, init, segment_bitmap_bytes); \
501 STORE_FENCE(); \
502 dest = MASK; \
503 tgc->bitmask_overhead[tg] += ptr_align(segment_bitmap_bytes); \
504 } while (0)
505
506 #define marked(si, p) (si->marked_mask && (si->marked_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p)))
507
508 #ifdef NO_NEWSPACE_MARKS
509 # define new_marked(si, p) 0
510 # define CAN_MARK_AND(x) 0
511 #else
512 # define new_marked(si, p) marked(si, p)
513 # define CAN_MARK_AND(x) x
514 #endif
515
init_fully_marked_mask(thread_gc * tgc,IGEN g)516 static void init_fully_marked_mask(thread_gc *tgc, IGEN g) {
517 GC_MUTEX_ACQUIRE();
518 if (!fully_marked_mask[g]) {
519 init_mask(tgc, fully_marked_mask[g], g, 0xFF);
520 }
521 GC_MUTEX_RELEASE();
522 }
523
524 #ifdef PRESERVE_FLONUM_EQ
525
flonum_set_forwarded(thread_gc * tgc,ptr p,seginfo * si)526 static void flonum_set_forwarded(thread_gc *tgc, ptr p, seginfo *si) {
527 if (!si->forwarded_flonums)
528 init_mask(tgc, si->forwarded_flonums, 0, 0);
529 si->forwarded_flonums[segment_bitmap_byte(p)] |= segment_bitmap_bit(p);
530 }
531
flonum_is_forwarded_p(ptr p,seginfo * si)532 static int flonum_is_forwarded_p(ptr p, seginfo *si) {
533 if (!si->forwarded_flonums)
534 return 0;
535 else
536 return si->forwarded_flonums[segment_bitmap_byte(p)] & segment_bitmap_bit(p);
537 }
538
539 # define FLONUM_FWDADDRESS(p) *(ptr*)TO_VOIDP(UNTYPE(p, type_flonum))
540
541 # define FORWARDEDP(p, si) ((TYPEBITS(p) == type_flonum) ? flonum_is_forwarded_p(p, si) : (FWDMARKER(p) == forward_marker))
542 # define GET_FWDADDRESS(p) ((TYPEBITS(p) == type_flonum) ? FLONUM_FWDADDRESS(p) : FWDADDRESS(p))
543 #else
544 # define FORWARDEDP(p, si) (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum)
545 # define GET_FWDADDRESS(p) FWDADDRESS(p)
546 #endif
547
548 #ifdef ENABLE_OBJECT_COUNTS
549 # define ELSE_MEASURE_NONOLDSPACE(p) \
550 else if (measure_all_enabled) \
551 push_measure(tgc, p);
552 #else
553 # define ELSE_MEASURE_NONOLDSPACE(p) /* empty */
554 #endif
555
556 /* use relocate_pure for newspace fields that can't point to younger
557 objects or where there's no need to track generations */
558
559 #define relocate_pure(ppp) do { \
560 ptr* PPP = ppp; ptr PP = *PPP; \
561 relocate_pure_help(PPP, PP); \
562 } while (0)
563
564 #define relocate_pure_help(ppp, pp) do { \
565 seginfo *SI; \
566 if (!FIXMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \
567 if (SI->old_space) \
568 relocate_pure_help_help(ppp, pp, SI); \
569 ELSE_MEASURE_NONOLDSPACE(pp) \
570 } \
571 } while (0)
572
573 #define relocate_pure_help_help(ppp, pp, si) do { \
574 if (SEGMENT_IS_LOCAL(si, pp)) { \
575 if (FORWARDEDP(pp, si)) \
576 *ppp = GET_FWDADDRESS(pp); \
577 else if (!new_marked(si, pp)) \
578 mark_or_copy_pure(ppp, pp, si); \
579 } else \
580 RECORD_REMOTE(si); \
581 } while (0)
582
583 #define relocate_code(pp, si) do { \
584 if (si->old_space) { \
585 if (SEGMENT_IS_LOCAL(si, pp)) { \
586 if (FWDMARKER(pp) == forward_marker) \
587 pp = GET_FWDADDRESS(pp); \
588 else if (!new_marked(si, pp)) \
589 mark_or_copy_pure(&pp, pp, si); \
590 } else \
591 RECORD_REMOTE(si); \
592 } ELSE_MEASURE_NONOLDSPACE(pp) \
593 } while (0)
594
595 #define mark_or_copy_pure(dest, p, si) do { \
596 if (CAN_MARK_AND(si->use_marks)) \
597 (void)mark_object(tgc, p, si); \
598 else \
599 (void)copy(tgc, p, si, dest); \
600 } while (0)
601
602 #define relocate_pure_now(ppp) do { \
603 FLUSH_REMOTE_BLOCK \
604 relocate_pure(ppp); \
605 ASSERT_EMPTY_FLUSH_REMOTE(); \
606 } while (0)
607
608 #if defined(ENABLE_PARALLEL) && defined(ENABLE_OBJECT_COUNTS)
do_relocate_pure_in_owner(thread_gc * tgc,ptr * ppp)609 static void do_relocate_pure_in_owner(thread_gc *tgc, ptr *ppp) {
610 seginfo *si;
611 ptr pp = *ppp;
612 if (!FIXMEDIATE(pp)
613 && (si = MaybeSegInfo(ptr_get_segment(pp))) != NULL
614 && si->old_space) {
615 BLOCK_SET_THREAD(si->creator);
616 relocate_pure_now(ppp);
617 } else {
618 relocate_pure_now(ppp);
619 }
620 }
621 # define relocate_pure_in_owner(ppp) do_relocate_pure_in_owner(tgc, ppp)
622 #else
623 # define relocate_pure_in_owner(pp) relocate_pure(pp)
624 #endif
625
626 /* use relocate_impure for newspace fields that can point to younger objects */
627
628 #ifdef NO_DIRTY_NEWSPACE_POINTERS
629
630 # define relocate_impure_help(PPP, PP, FROM_G) do {(void)FROM_G; relocate_pure_help(PPP, PP);} while (0)
631 # define relocate_impure(PPP, FROM_G) do {(void)FROM_G; relocate_pure(PPP);} while (0)
632
633 #else /* !NO_DIRTY_NEWSPACE_POINTERS */
634
635 #define relocate_impure(ppp, from_g) do { \
636 ptr* PPP = ppp; ptr PP = *PPP; IGEN FROM_G = from_g; \
637 relocate_impure_help(PPP, PP, FROM_G); \
638 } while (0)
639
640 #define relocate_impure_help(ppp, pp, from_g) do { \
641 seginfo *SI; \
642 if (!FIXMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \
643 if (SI->old_space) \
644 relocate_impure_help_help(ppp, pp, from_g, SI); \
645 ELSE_MEASURE_NONOLDSPACE(pp) \
646 } \
647 } while (0)
648
649 #define relocate_impure_help_help(ppp, pp, from_g, si) do { \
650 IGEN __to_g; \
651 if (SEGMENT_IS_LOCAL(si, pp)) { \
652 if (FORWARDEDP(pp, si)) { \
653 *ppp = GET_FWDADDRESS(pp); \
654 __to_g = TARGET_GENERATION(si); \
655 } else if (!new_marked(si, pp)) { \
656 mark_or_copy_impure(__to_g, ppp, pp, from_g, si); \
657 } else { \
658 __to_g = TARGET_GENERATION(si); \
659 } \
660 if (__to_g < from_g) S_record_new_dirty_card(tgc, ppp, __to_g); \
661 } else \
662 RECORD_REMOTE(si); \
663 } while (0)
664
665 #define mark_or_copy_impure(to_g, dest, p, from_g, si) do { \
666 if (CAN_MARK_AND(si->use_marks)) \
667 to_g = mark_object(tgc, p, si); \
668 else \
669 to_g = copy(tgc, p, si, dest); \
670 } while (0)
671
672 #endif /* !NO_DIRTY_NEWSPACE_POINTERS */
673
674 #define relocate_dirty(PPP, YOUNGEST) do { \
675 seginfo *_si; ptr *_ppp = PPP, _pp = *_ppp; IGEN _pg; \
676 if (!FIXMEDIATE(_pp) && (_si = MaybeSegInfo(ptr_get_segment(_pp))) != NULL) { \
677 if (!_si->old_space) { \
678 _pg = _si->generation; \
679 } else { \
680 if (SEGMENT_IS_LOCAL(_si, _pp)) { \
681 if (FORWARDEDP(_pp, _si)) { \
682 *_ppp = GET_FWDADDRESS(_pp); \
683 _pg = TARGET_GENERATION(_si); \
684 } else if (new_marked(_si, _pp)) { \
685 _pg = TARGET_GENERATION(_si); \
686 } else if (CAN_MARK_AND(_si->use_marks)) { \
687 _pg = mark_object(tgc, _pp, _si); \
688 } else { \
689 _pg = copy(tgc, _pp, _si, _ppp); \
690 } \
691 } else { \
692 RECORD_REMOTE(_si); \
693 _pg = 0xff; \
694 } \
695 } \
696 if (_pg < YOUNGEST) YOUNGEST = _pg; \
697 } \
698 } while (0)
699
700 #define relocate_reference(ppp, from_g) do { \
701 ptr* rPPP = ppp; ptr rPP = *rPPP; \
702 if (!FOREIGN_REFERENCEP(rPP)) { \
703 *rPPP = S_reference_to_object(rPP); \
704 relocate_impure(rPPP, from_g); \
705 *rPPP = S_object_to_reference(*rPPP); \
706 } \
707 } while (0)
708
709 #define relocate_reference_dirty(ppp, YOUNGEST) do { \
710 ptr* rPPP = ppp; \
711 if (!FOREIGN_REFERENCEP(*rPPP)) { \
712 *rPPP = S_reference_to_object(*rPPP); \
713 relocate_dirty(rPPP, YOUNGEST); \
714 *rPPP = S_object_to_reference(*rPPP); \
715 } \
716 } while (0)
717
718 #ifdef ENABLE_OBJECT_COUNTS
719 # define is_counting_root(si, p) (si->counting_mask && (si->counting_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p)))
720 #endif
721
722 # define relocate_indirect(p) do { \
723 ptr _P = p; \
724 relocate_pure(&_P); \
725 } while (0)
726
727 # define relocate_reference_indirect(p) do { \
728 ptr _P = p; \
729 if (!FOREIGN_REFERENCEP(_P)) { \
730 _P = S_reference_to_object(_P); \
731 relocate_pure(&_P); \
732 } \
733 } while (0)
734
check_triggers(thread_gc * tgc,seginfo * si)735 FORCEINLINE void check_triggers(thread_gc *tgc, seginfo *si) {
736 /* Registering ephemerons and guardians to recheck at the
737 granularity of a segment means that the worst-case complexity of
738 GC is quadratic in the number of objects that fit into a segment
739 (but that only happens if the objects are ephemeron keys that are
740 reachable just through a chain via the value field of the same
741 ephemerons). */
742 if (si->has_triggers) {
743 if (si->trigger_ephemerons) {
744 add_trigger_ephemerons_to_pending(tgc, si->trigger_ephemerons);
745 si->trigger_ephemerons = 0;
746 }
747 if (si->trigger_guardians) {
748 add_trigger_guardians_to_recheck(si->trigger_guardians);
749 si->trigger_guardians = 0;
750 }
751 si->has_triggers = 0;
752 }
753 }
754
755 #if defined(ENABLE_OBJECT_COUNTS)
756 # include "gc-oce.inc"
757 #elif defined(ENABLE_PARALLEL)
758 # include "gc-par.inc"
759 #else
760 # include "gc-ocd.inc"
761 #endif
762
763 /* sweep_in_old() is like sweep(), but the goal is to sweep the
764 object's content without copying the object itself, so we're sweep
765 an object while it's still in old space. If an object refers back
766 to itself, naively sweeping might copy the object while we're
767 trying to sweep the old copy, which interacts badly with the words
768 set to a forwarding marker and pointer. To handle that problem,
769 sweep_in_old() is allowed to copy the object, since the object
770 is going to get copied anyway. */
sweep_in_old(thread_gc * tgc,ptr p)771 static void sweep_in_old(thread_gc *tgc, ptr p) {
772 /* Detect all the cases when we need to give up on in-place
773 sweeping: */
774 if (object_directly_refers_to_self(p)) {
775 relocate_pure_now(&p);
776 return;
777 }
778
779 /* We've determined that `p` won't refer immediately back to itself,
780 so it's ok to sweep(), but only update `p` for pure relocations;
781 impure oness must that will happen later, after `p` is
782 potentially copied, so the card updates will be right. */
783 sweep_object_in_old(tgc, p);
784 }
785
sweep_dirty_object_if_space_new(thread_gc * tgc,ptr p)786 static void sweep_dirty_object_if_space_new(thread_gc *tgc, ptr p) {
787 seginfo *si = SegInfo(ptr_get_segment(p));
788 if (si->space == space_new)
789 (void)sweep_dirty_object(tgc, p, 0);
790 }
791
copy_stack(thread_gc * tgc,ptr old,iptr * length,iptr clength)792 static ptr copy_stack(thread_gc *tgc, ptr old, iptr *length, iptr clength) {
793 iptr n, m; ptr new; IGEN newg;
794 seginfo *si = SegInfo(ptr_get_segment(old));
795
796 /* Don't copy non-oldspace stacks, since we may be sweeping a
797 continuation that is older than target_generation. Doing so would
798 be a waste of work anyway. */
799 if (!si->old_space) return old;
800
801 newg = TARGET_GENERATION(si);
802
803 n = *length;
804
805 #ifndef NO_NEWSPACE_MARKS
806 if (si->use_marks) {
807 if (!marked(si, old)) {
808 mark_untyped_data_object(tgc, old, n, si);
809
810 #ifdef ENABLE_OBJECT_COUNTS
811 S_G.countof[newg][countof_stack] += 1;
812 S_G.bytesof[newg][countof_stack] += n;
813 #endif
814 }
815
816 return old;
817 }
818 #endif
819
820 /* reduce headroom created for excessively large frames (typically resulting from apply with long lists) */
821 if (n != clength && n > default_stack_size && n > (m = clength + one_shot_headroom)) {
822 *length = n = m;
823 }
824
825 n = ptr_align(n);
826 #ifdef ENABLE_OBJECT_COUNTS
827 S_G.countof[newg][countof_stack] += 1;
828 S_G.bytesof[newg][countof_stack] += n;
829 #endif /* ENABLE_OBJECT_COUNTS */
830
831 if (n == 0) {
832 return (ptr)0;
833 } else {
834 find_gc_room(tgc, space_data, newg, type_untyped, n, new);
835 n = ptr_align(clength);
836 /* warning: stack may have been left non-double-aligned by split_and_resize */
837 memcpy_aligned(TO_VOIDP(new), TO_VOIDP(old), n);
838
839 /* also returning possibly updated value in *length */
840 return new;
841 }
842 }
843
844 #define NONSTATICINHEAP(si, x) (!FIXMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && si->generation != static_generation)
845 #define ALWAYSTRUE(si, x) (si = SegInfo(ptr_get_segment(x)), 1)
846 #define partition_guardians(LS, FILTER) do { \
847 ptr ls; seginfo *si; \
848 for (ls = LS; ls != Snil; ls = next) { \
849 obj = GUARDIANOBJ(ls); \
850 next = GUARDIANNEXT(ls); \
851 if (FILTER(si, obj)) { \
852 if (!si->old_space || new_marked(si, obj)) { \
853 INITGUARDIANNEXT(ls) = pend_hold_ls; \
854 pend_hold_ls = ls; \
855 } else if (FORWARDEDP(obj, si)) { \
856 INITGUARDIANOBJ(ls) = GET_FWDADDRESS(obj); \
857 INITGUARDIANNEXT(ls) = pend_hold_ls; \
858 pend_hold_ls = ls; \
859 } else { \
860 seginfo *t_si; \
861 tconc = GUARDIANTCONC(ls); \
862 t_si = SegInfo(ptr_get_segment(tconc)); \
863 if (!t_si->old_space || new_marked(t_si, tconc)) { \
864 INITGUARDIANNEXT(ls) = final_ls; \
865 final_ls = ls; \
866 } else if (FWDMARKER(tconc) == forward_marker) { \
867 INITGUARDIANTCONC(ls) = FWDADDRESS(tconc); \
868 INITGUARDIANNEXT(ls) = final_ls; \
869 final_ls = ls; \
870 } else { \
871 INITGUARDIANNEXT(ls) = pend_final_ls; \
872 pend_final_ls = ls; \
873 } \
874 } \
875 } \
876 } \
877 } while (0)
878
879 typedef struct count_root_t {
880 ptr p;
881 IBOOL weak;
882 } count_root_t;
883
GCENTRY(ptr tc,ptr count_roots_ls)884 ptr GCENTRY(ptr tc, ptr count_roots_ls) {
885 thread_gc *tgc = THREAD_GC(tc);
886 IGEN g; ISPC s;
887 seginfo *oldspacesegments, *oldweakspacesegments, *si, *nextsi;
888 ptr ls;
889 bucket_pointer_list *buckets_to_rebuild;
890 uptr pre_finalization_size, pre_phantom_bytes;
891 #ifdef ENABLE_OBJECT_COUNTS
892 ptr count_roots_counts = Snil;
893 iptr count_roots_len;
894 count_root_t *count_roots;
895 #endif
896
897 GET_REAL_TIME(astart);
898
899 S_thread_start_code_write(tc, MAX_TG, 0, NULL, 0);
900
901 /* flush instruction cache: effectively clear_code_mod but safer */
902 for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
903 ptr t_tc = (ptr)THREADTC(Scar(ls));
904 S_flush_instruction_cache(t_tc);
905 }
906
907 tlcs_to_rehash = Snil;
908 conts_to_promote = Snil;
909 #ifndef NO_DIRTY_NEWSPACE_POINTERS
910 S_G.new_dirty_cards = NULL;
911 #endif /* !NO_DIRTY_NEWSPACE_POINTERS */
912 S_G.must_mark_gen0 = 0;
913
914 setup_sweepers(tgc); /* maps threads to sweepers */
915
916 for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
917 ptr t_tc = (ptr)THREADTC(Scar(ls));
918 thread_gc *t_tgc = THREAD_GC(t_tc);
919 S_scan_dirty(TO_VOIDP(EAP(t_tc)), TO_VOIDP(REAL_EAP(t_tc)));
920 EAP(t_tc) = REAL_EAP(t_tc) = AP(t_tc) = (ptr)0;
921
922 /* clear thread-local allocation: */
923 for (g = 0; g <= MAX_CG; g++) {
924 for (s = 0; s <= max_real_space; s++) {
925 if (t_tgc->base_loc[g][s]) {
926 /* We close off, instead of just setting BASELOC to 0,
927 in case the page ends up getting marked, in which
928 case a terminator mark needed. */
929 S_close_off_thread_local_segment(t_tc, s, g);
930 }
931 }
932 }
933
934 if (!HAS_SWEEPER_WRT(t_tc, tc)) {
935 /* close off any current allocation in MAX_TG, and ensure that
936 end-of-segment markers are otherwise set (in case that's
937 needed for dirty-byte sweeping) */
938 for (s = 0; s <= max_real_space; s++) {
939 if (t_tgc->base_loc[MAX_TG][s])
940 S_close_off_thread_local_segment(t_tc, s, MAX_TG);
941 for (g = MAX_TG + 1; g <= static_generation; g++) {
942 ptr old = t_tgc->next_loc[g][s];
943 if (old != (ptr)0)
944 *(ptr*)TO_VOIDP(old) = forward_marker;
945 }
946 }
947 } else {
948 /* set up context for sweeping --- effectively remembering the current
949 allocation state so anything new is recognized as needing sweeping */
950 t_tgc->sweep_stack_start = t_tgc->sweep_stack = t_tgc->sweep_stack_limit = (ptr)0;
951 t_tgc->send_remote_sweep_stack_start = t_tgc->send_remote_sweep_stack = t_tgc->send_remote_sweep_stack_limit = (ptr)0;
952 t_tgc->receive_remote_sweep_stack_start = t_tgc->receive_remote_sweep_stack = t_tgc->receive_remote_sweep_stack_limit = (ptr)0;
953 t_tgc->bitmask_overhead[0] = 0;
954 for (g = MIN_TG; g <= MAX_TG; g++)
955 t_tgc->bitmask_overhead[g] = 0;
956 for (s = 0; s <= max_real_space; s++) {
957 /* need to save `next_loc` to ensure that dirty sweeping
958 doesn't overshoot into newly allocated objects */
959 t_tgc->orig_next_loc[s] = t_tgc->next_loc[MAX_TG][s];
960 t_tgc->sweep_loc[MAX_TG][s] = t_tgc->next_loc[MAX_TG][s];
961 for (g = MIN_TG; g <= MAX_TG; g++)
962 t_tgc->sweep_next[g][s] = NULL;
963 }
964 }
965 }
966
967 /* perform after ScanDirty */
968 if (S_checkheap) S_check_heap(0, MAX_CG);
969
970 #ifdef DEBUG
971 (void)printf("max_cg = %x; go? ", MAX_CG); (void)fflush(stdout); (void)getc(stdin);
972 #endif
973
974 resweep_weak_segments = NULL;
975 for (g = MIN_TG; g <= MAX_TG; g++) fully_marked_mask[g] = NULL;
976
977 /* set up generations to be copied */
978 for (g = 0; g <= MAX_CG; g++) {
979 S_G.bytes_of_generation[g] = 0;
980 for (s = 0; s <= max_real_space; s++) {
981 S_G.bytes_of_space[g][s] = 0;
982 S_G.bitmask_overhead[g] = 0;
983 }
984 }
985
986 /* reset phantom size in generations to be copied, even if counting is not otherwise enabled */
987 pre_phantom_bytes = 0;
988 for (g = 0; g <= MAX_CG; g++) {
989 pre_phantom_bytes += S_G.bytesof[g][countof_phantom];
990 S_G.bytesof[g][countof_phantom] = 0;
991 }
992 for (g = MIN_TG; g <= MAX_TG; g++) {
993 pre_phantom_bytes += S_G.bytesof[g][countof_phantom];
994 }
995
996 /* mark segments from which objects are to be copied or marked */
997 oldspacesegments = oldweakspacesegments = (seginfo *)NULL;
998 for (g = 0; g <= MAX_CG; g += 1) {
999 IBOOL maybe_mark = ((g >= S_G.min_mark_gen) && (g >= MIN_TG));
1000 for (s = 0; s <= max_real_space; s += 1) {
1001 seginfo *saved;
1002
1003 if (s == space_weakpair) {
1004 saved = oldspacesegments;
1005 oldspacesegments = oldweakspacesegments;
1006 } else
1007 saved = NULL;
1008
1009 for (si = S_G.occupied_segments[g][s]; si != NULL; si = nextsi) {
1010 nextsi = si->next;
1011 si->next = oldspacesegments;
1012 oldspacesegments = si;
1013 si->old_space = 1;
1014 /* update generation now, both to compute the target generation,<
1015 and so that any updated dirty references will record the correct
1016 new generation; also used for a check in S_dirty_set */
1017 si->generation = compute_target_generation(si->generation);
1018 if (si->must_mark
1019 || (maybe_mark
1020 && (!si->marked_mask
1021 || (si->marked_count >= segment_sufficiently_compact_bytes))
1022 && (si->chunk->nused_segs >= chunk_sufficiently_compact(si->chunk->segs)))) {
1023 if (s != space_new) /* only lock-based marking is allowed on space_new */
1024 si->use_marks = 1;
1025 }
1026 si->marked_mask = NULL; /* clear old mark bits, if any */
1027 si->marked_count = 0;
1028 si->min_dirty_byte = 0; /* prevent registering as dirty while GCing */
1029 #ifdef ENABLE_PARALLEL
1030 if (!si->creator->tc) si->creator = tgc;
1031 #endif
1032 }
1033 S_G.occupied_segments[g][s] = NULL;
1034
1035 if (s == space_weakpair) {
1036 oldweakspacesegments = oldspacesegments;
1037 oldspacesegments = saved;
1038 }
1039 }
1040 }
1041 if (oldweakspacesegments) {
1042 /* make oldweakspacesegments a prefix of weakspacesegments */
1043 seginfo *p;
1044 for (p = oldweakspacesegments; p->next; p = p->next);
1045 p->next = oldspacesegments;
1046 oldspacesegments = oldweakspacesegments;
1047 }
1048
1049 #ifdef ENABLE_OBJECT_COUNTS
1050 /* clear object counts & bytes for copied generations; bump timestamp */
1051 {INT i;
1052 for (g = 0; g <= MAX_CG; g += 1) {
1053 for (i = 0; i < countof_types; i += 1) {
1054 S_G.countof[g][i] = 0;
1055 S_G.bytesof[g][i] = 0;
1056 }
1057 if (g == 0) {
1058 S_G.gctimestamp[g] += 1;
1059 } else {
1060 S_G.gctimestamp[g] = S_G.gctimestamp[0];
1061 }
1062 }
1063 }
1064 #endif /* ENABLE_OBJECT_COUNTS */
1065
1066 /* Clear any backreference lists for copied generations */
1067 for (g = 0; g <= MAX_CG; g += 1) {
1068 S_G.gcbackreference[g] = Snil;
1069 }
1070
1071 SET_BACKREFERENCE(Sfalse); /* #f => root */
1072
1073 /* Set mark bit for any locked object in `space_new`. Don't sweep until
1074 after handling counting roots. Note that the segment won't have
1075 `use_marks` set, so non-locked objects will be copied out. */
1076 for (g = 0; g <= MAX_CG; g += 1) {
1077 IGEN tg = compute_target_generation(g);
1078 for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls)) {
1079 ptr p = Scar(ls);
1080 seginfo *si = SegInfo(ptr_get_segment(p));
1081 if (si->space == space_new) {
1082 if (!si->marked_mask)
1083 init_mask(tgc, si->marked_mask, tg, 0);
1084 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p);
1085 }
1086 }
1087 }
1088
1089 #ifdef ENABLE_OBJECT_COUNTS
1090 /* set flag on count_roots objects so they get copied to space_count_root */
1091 if (count_roots_ls != Sfalse) {
1092 iptr i;
1093
1094 count_roots_len = list_length(count_roots_ls);
1095 find_gc_room_voidp(tgc, space_data, 0, ptr_align(count_roots_len*sizeof(count_root_t)), count_roots);
1096
1097 for (ls = count_roots_ls, i = 0; ls != Snil; ls = Scdr(ls), i++) {
1098 ptr p = Scar(ls);
1099 if (FIXMEDIATE(p)) {
1100 count_roots[i].p = p;
1101 count_roots[i].weak = 0;
1102 } else {
1103 seginfo *ls_si = SegInfo(ptr_get_segment(ls));
1104 seginfo *si = SegInfo(ptr_get_segment(p));
1105
1106 if (!si->counting_mask)
1107 init_counting_mask(tgc, si);
1108
1109 si->counting_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p);
1110
1111 count_roots[i].p = p;
1112 count_roots[i].weak = ((ls_si->space == space_weakpair)
1113 || (ls_si->space == space_ephemeron));
1114 }
1115 }
1116 } else {
1117 count_roots_len = 0;
1118 count_roots = NULL;
1119 }
1120 #endif
1121
1122 #ifdef ENABLE_OBJECT_COUNTS
1123 /* sweep count_roots in order and accumulate counts */
1124 if (count_roots_len > 0) {
1125 ptr prev = 0; uptr prev_total = total_size_so_far();
1126 iptr i;
1127
1128 # ifdef ENABLE_MEASURE
1129 init_measure(tgc, MAX_TG+1, static_generation);
1130 # endif
1131
1132 for (i = 0; i < count_roots_len; i++) {
1133 uptr total;
1134 ptr p = count_roots[i].p;
1135 if (FIXMEDIATE(p)) {
1136 /* nothing to do */
1137 } else {
1138 seginfo *si = SegInfo(ptr_get_segment(p));
1139
1140 si->counting_mask[segment_bitmap_byte(p)] -= segment_bitmap_bit(p);
1141
1142 if (!si->old_space || FORWARDEDP(p, si) || marked(si, p)
1143 || !count_roots[i].weak) {
1144 /* reached or older; sweep transitively */
1145 #ifdef ENABLE_PARALLEL
1146 if (si->creator->tc == 0) si->creator = tgc;
1147 #endif
1148 {
1149 BLOCK_SET_THREAD(si->creator);
1150 relocate_pure_now(&p);
1151 push_sweep(p);
1152 }
1153 ADD_BACKREFERENCE(p, si->generation);
1154
1155 parallel_sweep_generation(tgc);
1156
1157 /* now count this object's size, if we have deferred it before */
1158 si = SegInfo(ptr_get_segment(p));
1159 if ((si->space == space_count_pure) || (si->space == space_count_impure))
1160 count_root_bytes -= size_object(p);
1161 }
1162 }
1163
1164 total = total_size_so_far();
1165 p = S_cons_in(tc, space_new, 0, FIX(total-prev_total), Snil);
1166 if (prev != 0)
1167 Scdr(prev) = p;
1168 else
1169 count_roots_counts = p;
1170 prev = p;
1171 prev_total = total;
1172 }
1173
1174 # ifdef ENABLE_MEASURE
1175 finish_measure();
1176 # endif
1177
1178 /* clear `counting_mask`s */
1179 for (i = 0; i < count_roots_len; i++) {
1180 ptr p = count_roots[i].p;
1181 if (!FIXMEDIATE(p)) {
1182 seginfo *si = SegInfo(ptr_get_segment(p));
1183 si->counting_mask = NULL;
1184 }
1185 }
1186 }
1187 #endif
1188
1189 /* Gather and mark all younger locked objects.
1190 Any object on a `space_new` segment is already marked, but still
1191 needs to be swept. */
1192 {
1193 for (g = MAX_CG; g >= 0; g -= 1) {
1194 ptr locked_objects;
1195 IGEN tg = compute_target_generation(g);
1196 ls = S_G.locked_objects[g];
1197 S_G.locked_objects[g] = Snil;
1198 S_G.unlocked_objects[g] = Snil;
1199 locked_objects = S_G.locked_objects[tg];
1200 for (; ls != Snil; ls = Scdr(ls)) {
1201 ptr p = Scar(ls);
1202 seginfo *si = SegInfo(ptr_get_segment(p));
1203 if (si->space == space_new) {
1204 /* Retract the mark bit and mark properly, so anything that needs
1205 to happen with marking will happen. */
1206 if (!marked(si, p))
1207 S_error_abort("space_new locked object should have a mark bit set");
1208 si->marked_mask[segment_bitmap_byte(p)] -= segment_bitmap_bit(p);
1209 mark_object(tgc, p, si);
1210 }
1211 /* non-`space_new` objects will be swept via new pair */
1212 locked_objects = S_cons_in(tc, space_impure, tg, p, locked_objects);
1213 #ifdef ENABLE_OBJECT_COUNTS
1214 S_G.countof[tg][countof_pair] += 1;
1215 S_G.countof[tg][countof_locked] += 1;
1216 S_G.bytesof[tg][countof_locked] += size_object(p);
1217 #endif /* ENABLE_OBJECT_COUNTS */
1218 }
1219 S_G.locked_objects[tg] = locked_objects;
1220 }
1221 }
1222
1223 /* for each thread with a sweeper, sweep in that thread's context to
1224 make sure the sweeper will perform that thread's work; otherwise,
1225 sweep non-oldspace threads, since any thread may have an active
1226 stack */
1227 for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
1228 ptr thread;
1229
1230 /* someone may have their paws on the list */
1231 if (FWDMARKER(ls) == forward_marker) ls = FWDADDRESS(ls);
1232
1233 thread = Scar(ls);
1234
1235 #ifdef ENABLE_PARALLEL
1236 {
1237 ptr t_tc = (ptr)THREADTC(thread);
1238 BLOCK_SET_THREAD(THREAD_GC(t_tc)); /* switches mark/sweep to thread */
1239 if (!OLDSPACE(thread)) {
1240 /* remember to sweep in sweeper thread */
1241 push_sweep(thread);
1242 } else {
1243 /* relocate now, then sweeping will happen in sweeper thread */
1244 relocate_pure_now(&thread);
1245 }
1246 }
1247 #else
1248 if (!OLDSPACE(thread))
1249 sweep_thread(tgc, thread);
1250 #endif
1251 }
1252
1253 relocate_pure_now(&S_threads);
1254
1255 GET_REAL_TIME(start);
1256
1257 /* relocate nonempty oldspace symbols and set up list of buckets to rebuild later */
1258 buckets_to_rebuild = NULL;
1259 for (g = 0; g <= MAX_CG; g += 1) {
1260 bucket_list *bl, *blnext; bucket *b; bucket_pointer_list *bpl; bucket **oblist_cell; ptr sym; iptr idx;
1261 for (bl = S_G.buckets_of_generation[g]; bl != NULL; bl = blnext) {
1262 blnext = bl->cdr;
1263 b = bl->car;
1264 /* mark this bucket old for the rebuilding loop */
1265 b->next = TO_VOIDP((uptr)TO_PTR(b->next) | 1);
1266 sym = b->sym;
1267 idx = UNFIX(SYMHASH(sym)) % S_G.oblist_length;
1268 oblist_cell = &S_G.oblist[idx];
1269 if (!((uptr)TO_PTR(*oblist_cell) & 1)) {
1270 /* mark this bucket in the set */
1271 *oblist_cell = TO_VOIDP((uptr)TO_PTR(*oblist_cell) | 1);
1272 /* repurpose the bucket list element for the list of buckets to rebuild later */
1273 /* idiot_checks verifies these have the same size */
1274 bpl = (bucket_pointer_list *)bl;
1275 bpl->car = oblist_cell;
1276 bpl->cdr = buckets_to_rebuild;
1277 buckets_to_rebuild = bpl;
1278 }
1279 if (FWDMARKER(sym) != forward_marker &&
1280 /* coordinate with alloc.c */
1281 (SYMVAL(sym) != sunbound || SYMPLIST(sym) != Snil || SYMSPLIST(sym) != Snil)) {
1282 seginfo *sym_si = SegInfo(ptr_get_segment(sym));
1283 BLOCK_SET_THREAD(sym_si->creator); /* use symbol's creator thread context */
1284 if (!new_marked(sym_si, sym))
1285 mark_or_copy_pure(&sym, sym, sym_si);
1286 }
1287 }
1288 S_G.buckets_of_generation[g] = NULL;
1289 }
1290
1291 /* relocate the protected C pointers */
1292 {uptr i;
1293 for (i = 0; i < S_G.protect_next; i++)
1294 relocate_pure_now(S_G.protected[i]);
1295 }
1296
1297 /* sweep older locked and unlocked objects that are on `space_new` segments,
1298 because we can't find dirty writes there */
1299 for (g = MAX_CG + 1; g <= static_generation; INCRGEN(g)) {
1300 for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls))
1301 sweep_dirty_object_if_space_new(tgc, Scar(ls));
1302 for (ls = S_G.unlocked_objects[g]; ls != Snil; ls = Scdr(ls))
1303 sweep_dirty_object_if_space_new(tgc, Scar(ls));
1304 }
1305
1306 /* prepare to sweep areas marked dirty by assignments into older generations */
1307 setup_sweep_dirty(tgc);
1308
1309 parallel_sweep_dirty_and_generation(tgc);
1310
1311 teardown_sweepers();
1312
1313 pre_finalization_size = target_generation_space_so_far(tgc);
1314
1315 /* handle guardians */
1316 { ptr pend_hold_ls, final_ls, pend_final_ls, maybe_final_ordered_ls;
1317 ptr obj, rep, tconc, next;
1318 IBOOL do_ordered = 0;
1319
1320 /* move each entry in guardian lists into one of:
1321 * pend_hold_ls if obj accessible
1322 * final_ls if obj not accessible and tconc accessible
1323 * pend_final_ls if obj not accessible and tconc not accessible
1324 * When a pend_hold_ls or pend_final_ls entry is tconc is
1325 * determined to be accessible, then it moves to hold_ls or
1326 * final_ls. When an entry in pend_hold_ls or pend_final_ls can't
1327 * be moved to final_ls or hold_ls, the entry moves into a
1328 * seginfo's trigger list (to avoid quadratic-time processing of
1329 * guardians). When the trigger fires, the entry is added to
1330 * recheck_guardians_ls, which is sorted back into pend_hold_ls
1331 * and pend_final_ls for another iteration.
1332 * Ordered and unordered guardian entries start out together;
1333 * when final_ls is processed, ordered entries are delayed by
1334 * moving them into maybe_final_ordered_ls, which is split back
1335 * into final_ls and pend_hold_ls after all unordered entries
1336 * have been handled. */
1337 pend_hold_ls = final_ls = pend_final_ls = maybe_final_ordered_ls = Snil;
1338 recheck_guardians_ls = Snil;
1339
1340 for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
1341 ptr tc = (ptr)THREADTC(Scar(ls));
1342 partition_guardians(GUARDIANENTRIES(tc), NONSTATICINHEAP);
1343 GUARDIANENTRIES(tc) = Snil;
1344 }
1345
1346 for (g = 0; g <= MAX_CG; g += 1) {
1347 partition_guardians(S_G.guardians[g], ALWAYSTRUE);
1348 S_G.guardians[g] = Snil;
1349 }
1350
1351 /* invariants after partition_guardians:
1352 * for entry in pend_hold_ls, obj is !OLDSPACE
1353 * for entry in final_ls, obj is OLDSPACE
1354 * for entry in final_ls, tconc is !OLDSPACE
1355 * for entry in pend_final_ls, obj and tconc are OLDSPACE
1356 */
1357
1358 while (1) {
1359 IBOOL relocate_rep = final_ls != Snil;
1360
1361 /* relocate & add the final objects to their tconcs */
1362 ls = final_ls; final_ls = Snil;
1363 for (; ls != Snil; ls = next) {
1364 ptr old_end, new_end;
1365
1366 next = GUARDIANNEXT(ls);
1367
1368 rep = GUARDIANREP(ls);
1369 /* ftype_guardian_rep is a marker for reference-counted ftype pointer */
1370 if (rep == ftype_guardian_rep) {
1371 INT b; iptr *addr;
1372 rep = GUARDIANOBJ(ls);
1373 if (FWDMARKER(rep) == forward_marker) rep = FWDADDRESS(rep);
1374 /* Caution: Building in assumption about shape of an ftype pointer */
1375 addr = TO_VOIDP(RECORDINSTIT(rep, 0));
1376 LOCKED_DECR(addr, b);
1377 if (!b) continue;
1378 }
1379
1380 if (!do_ordered && (GUARDIANORDERED(ls) == Strue)) {
1381 /* Sweep from the representative, but don't copy the
1382 representative itself; if the object stays uncopied by
1383 the end, then the entry is really final, and we copy the
1384 representative only at that point; crucially, the
1385 representative can't itself be a tconc, so we
1386 won't discover any new tconcs at that point. */
1387 ptr obj = GUARDIANOBJ(ls);
1388 seginfo *o_si = SegInfo(ptr_get_segment(obj));
1389 if (FORWARDEDP(obj, o_si) || new_marked(o_si, obj)) {
1390 /* Object is reachable, so we might as well move
1391 this one to the hold list --- via pend_hold_ls, which
1392 leads to a copy to move to hold_ls */
1393 INITGUARDIANNEXT(ls) = pend_hold_ls;
1394 pend_hold_ls = ls;
1395 } else {
1396 seginfo *si;
1397 if (!FIXMEDIATE(rep) && (si = MaybeSegInfo(ptr_get_segment(rep))) != NULL && si->old_space) {
1398 /* mark things reachable from `rep`, but not `rep` itself, unless
1399 `rep` is immediately reachable from itself */
1400 PUSH_BACKREFERENCE(ls)
1401 sweep_in_old(tgc, rep);
1402 POP_BACKREFERENCE()
1403 }
1404 INITGUARDIANNEXT(ls) = maybe_final_ordered_ls;
1405 maybe_final_ordered_ls = ls;
1406 }
1407 } else {
1408 /* if tconc was old it's been forwarded */
1409 tconc = GUARDIANTCONC(ls);
1410
1411 WITH_TOP_BACKREFERENCE(tconc, relocate_pure_now(&rep));
1412
1413 old_end = Scdr(tconc);
1414 new_end = S_cons_in(tc, space_impure, 0, FIX(0), FIX(0));
1415 #ifdef ENABLE_OBJECT_COUNTS
1416 S_G.countof[0][countof_pair] += 1;
1417 #endif /* ENABLE_OBJECT_COUNTS */
1418
1419 /* These assignments may trigger card marking or additions to `new_dirty_cards`: */
1420 SETCAR(old_end,rep);
1421 SETCDR(old_end,new_end);
1422 SETCDR(tconc,new_end);
1423 }
1424 }
1425
1426 /* copy each entry in pend_hold_ls into hold_ls if tconc accessible */
1427 ls = pend_hold_ls; pend_hold_ls = Snil;
1428 for ( ; ls != Snil; ls = next) {
1429 ptr p;
1430 seginfo *t_si;
1431 #ifdef CONSTANT_TARGET_GENERATION
1432 g = MAX_TG;
1433 #else
1434 seginfo *g_si;
1435 g_si = SegInfo(ptr_get_segment(ls));
1436 g = TARGET_GENERATION(g_si);
1437 #endif
1438
1439 next = GUARDIANNEXT(ls);
1440
1441 /* discard static pend_hold_ls entries */
1442 if (g == static_generation) continue;
1443
1444 tconc = GUARDIANTCONC(ls);
1445
1446 t_si = SegInfo(ptr_get_segment(tconc));
1447
1448 if (t_si->old_space && !new_marked(t_si, tconc)) {
1449 if (FWDMARKER(tconc) == forward_marker)
1450 tconc = FWDADDRESS(tconc);
1451 else {
1452 INITGUARDIANPENDING(ls) = FIX(GUARDIAN_PENDING_HOLD);
1453 add_pending_guardian(ls, tconc);
1454 continue;
1455 }
1456 }
1457
1458 rep = GUARDIANREP(ls);
1459 WITH_TOP_BACKREFERENCE(tconc, relocate_pure_now(&rep));
1460 relocate_rep = 1;
1461
1462 #ifdef ENABLE_OBJECT_COUNTS
1463 S_G.countof[g][countof_guardian] += 1;
1464 #endif /* ENABLE_OBJECT_COUNTS */
1465
1466 /* In backreference mode, we rely on sweep of the guardian
1467 entry not registering any backreferences. Otherwise,
1468 bogus pair pointers would get created. */
1469 find_gc_room(tgc, space_pure, g, type_untyped, size_guardian_entry, p);
1470 INITGUARDIANOBJ(p) = GUARDIANOBJ(ls);
1471 INITGUARDIANREP(p) = rep;
1472 INITGUARDIANTCONC(p) = tconc;
1473 INITGUARDIANNEXT(p) = S_G.guardians[g];
1474 INITGUARDIANORDERED(p) = GUARDIANORDERED(ls);
1475 INITGUARDIANPENDING(p) = FIX(0);
1476 S_G.guardians[g] = p;
1477 }
1478
1479 if (!relocate_rep && !do_ordered && maybe_final_ordered_ls != Snil) {
1480 /* Switch to finishing up ordered. Move all maybe-final
1481 ordered entries to final_ls and pend_hold_ls */
1482 do_ordered = relocate_rep = 1;
1483 ls = maybe_final_ordered_ls; maybe_final_ordered_ls = Snil;
1484 for (; ls != Snil; ls = next) {
1485 ptr obj = GUARDIANOBJ(ls);
1486 seginfo *o_si = SegInfo(ptr_get_segment(obj));
1487 next = GUARDIANNEXT(ls);
1488 if (FORWARDEDP(obj, o_si) || new_marked(o_si, obj)) {
1489 /* Will defintely move to hold_ls, but the entry
1490 must be copied to move from pend_hold_ls to
1491 hold_ls: */
1492 INITGUARDIANNEXT(ls) = pend_hold_ls;
1493 pend_hold_ls = ls;
1494 } else {
1495 INITGUARDIANNEXT(ls) = final_ls;
1496 final_ls = ls;
1497 }
1498 }
1499 }
1500
1501 if (!relocate_rep) break;
1502
1503 sweep_generation(tgc);
1504
1505 ls = recheck_guardians_ls; recheck_guardians_ls = Snil;
1506 for ( ; ls != Snil; ls = next) {
1507 next = GUARDIANNEXT(ls);
1508 if (GUARDIANPENDING(ls) == FIX(GUARDIAN_PENDING_HOLD)) {
1509 INITGUARDIANNEXT(ls) = pend_hold_ls;
1510 pend_hold_ls = ls;
1511 } else {
1512 INITGUARDIANNEXT(ls) = pend_final_ls;
1513 pend_final_ls = ls;
1514 }
1515 }
1516
1517 /* move each entry in pend_final_ls into one of:
1518 * final_ls if tconc forwarded or marked
1519 * pend_final_ls if tconc not forwarded or marked
1520 * where the output pend_final_ls coresponds to pending in a segment */
1521 ls = pend_final_ls; pend_final_ls = Snil;
1522 for ( ; ls != Snil; ls = next) {
1523 tconc = GUARDIANTCONC(ls); next = GUARDIANNEXT(ls);
1524
1525 if (FWDMARKER(tconc) == forward_marker) {
1526 INITGUARDIANTCONC(ls) = FWDADDRESS(tconc);
1527 INITGUARDIANNEXT(ls) = final_ls;
1528 final_ls = ls;
1529 } else {
1530 #ifndef NO_NEWSPACE_MARKS
1531 seginfo *t_si = SegInfo(ptr_get_segment(tconc));
1532 #endif
1533 if (new_marked(t_si, tconc)) {
1534 INITGUARDIANNEXT(ls) = final_ls;
1535 final_ls = ls;
1536 } else {
1537 INITGUARDIANPENDING(ls) = FIX(GUARDIAN_PENDING_FINAL);
1538 add_pending_guardian(ls, tconc);
1539 }
1540 }
1541 }
1542 }
1543 }
1544
1545 S_G.bytes_finalized = target_generation_space_so_far(tgc) - pre_finalization_size;
1546 {
1547 iptr post_phantom_bytes = 0;
1548 for (g = MIN_TG; g <= MAX_TG; g++) {
1549 post_phantom_bytes += S_G.bytesof[g][countof_phantom];
1550 }
1551 S_adjustmembytes(post_phantom_bytes - pre_phantom_bytes);
1552 }
1553
1554 /* handle weak pairs */
1555 resweep_dirty_weak_pairs(tgc);
1556 resweep_weak_pairs(oldweakspacesegments);
1557
1558 /* still-pending ephemerons all go to bwp */
1559 finish_pending_ephemerons(tgc, oldspacesegments);
1560
1561 ACCUM_REAL_TIME(collect_accum, step, start);
1562 REPORT_TIME(fprintf(stderr, "%d coll +%ld ms %ld ms [real time]\n",
1563 MAX_CG, step, collect_accum));
1564
1565 /* post-gc oblist handling. rebuild old buckets in the target generation, pruning unforwarded symbols */
1566 { bucket_list *bl; bucket *b, *bnext; bucket_pointer_list *bpl; bucket **pb; ptr sym;
1567 for (bpl = buckets_to_rebuild; bpl != NULL; bpl = bpl->cdr) {
1568 pb = bpl->car;
1569 for (b = TO_VOIDP((uptr)TO_PTR(*pb) - 1); b != NULL && ((uptr)TO_PTR(b->next) & 1); b = bnext) {
1570 bnext = TO_VOIDP((uptr)TO_PTR(b->next) - 1);
1571 sym = b->sym;
1572 si = SegInfo(ptr_get_segment(sym));
1573 if (new_marked(si, sym) || (FWDMARKER(sym) == forward_marker && ((sym = FWDADDRESS(sym)) || 1))) {
1574 IGEN g = si->generation;
1575 find_gc_room_voidp(tgc, space_data, g, ptr_align(sizeof(bucket)), b);
1576 #ifdef ENABLE_OBJECT_COUNTS
1577 S_G.countof[g][countof_oblist] += 1;
1578 S_G.bytesof[g][countof_oblist] += sizeof(bucket);
1579 #endif /* ENABLE_OBJECT_COUNTS */
1580 b->sym = sym;
1581 *pb = b;
1582 pb = &b->next;
1583 if (g != static_generation) {
1584 find_gc_room_voidp(tgc, space_data, g, ptr_align(sizeof(bucket_list)), bl);
1585 #ifdef ENABLE_OBJECT_COUNTS
1586 S_G.countof[g][countof_oblist] += 1;
1587 S_G.bytesof[g][countof_oblist] += sizeof(bucket_list);
1588 #endif /* ENABLE_OBJECT_COUNTS */
1589 bl->car = b;
1590 bl->cdr = S_G.buckets_of_generation[g];
1591 S_G.buckets_of_generation[g] = bl;
1592 }
1593 } else {
1594 S_G.oblist_count -= 1;
1595 }
1596 }
1597 *pb = b;
1598 }
1599 }
1600
1601 /* rebuild rtds_with_counts lists, dropping otherwise inaccessible rtds */
1602 { IGEN g, newg; ptr ls, p; seginfo *si;
1603 int count = 0;
1604 for (g = MAX_CG; g >= 0; g -= 1) {
1605 for (ls = S_G.rtds_with_counts[g], S_G.rtds_with_counts[g] = Snil; ls != Snil; ls = Scdr(ls)) {
1606 count++;
1607 p = Scar(ls);
1608 si = SegInfo(ptr_get_segment(p));
1609 if (!si->old_space || new_marked(si, p)) {
1610 newg = TARGET_GENERATION(si);
1611 S_G.rtds_with_counts[newg] = S_cons_in(tc, space_impure, newg, p, S_G.rtds_with_counts[newg]);
1612 #ifdef ENABLE_OBJECT_COUNTS
1613 S_G.countof[newg][countof_pair] += 1;
1614 #endif
1615 } else if (FWDMARKER(p) == forward_marker) {
1616 p = FWDADDRESS(p);
1617 newg = GENERATION(p);
1618 S_G.rtds_with_counts[newg] = S_cons_in(tc, space_impure, newg, p, S_G.rtds_with_counts[newg]);
1619 #ifdef ENABLE_OBJECT_COUNTS
1620 S_G.countof[newg][countof_pair] += 1;
1621 #endif
1622 }
1623 }
1624 }
1625 }
1626
1627 #ifndef WIN32
1628 /* rebuild child_process list, reaping any that have died and refusing
1629 to promote into the static generation. */
1630 { IGEN g, newg; ptr ls, newls;
1631 for (g = MAX_CG; g >= 0; g -= 1) {
1632 newg = compute_target_generation(g);
1633 if (newg == static_generation) newg = S_G.max_nonstatic_generation;
1634 newls = newg == g ? Snil : S_child_processes[newg];
1635 for (ls = S_child_processes[g], S_child_processes[g] = Snil; ls != Snil; ls = Scdr(ls)) {
1636 INT pid = UNFIX(Scar(ls)), status, retpid;
1637 retpid = waitpid(pid, &status, WNOHANG);
1638 if (retpid == 0 || (retpid == pid && !(WIFEXITED(status) || WIFSIGNALED(status)))) {
1639 newls = S_cons_in(tc, space_impure, newg, FIX(pid), newls);
1640 #ifdef ENABLE_OBJECT_COUNTS
1641 S_G.countof[newg][countof_pair] += 1;
1642 #endif /* ENABLE_OBJECT_COUNTS */
1643 }
1644 }
1645 S_child_processes[newg] = newls;
1646 }
1647 }
1648 #endif /* WIN32 */
1649
1650 copy_and_clear_list_bits(tgc, oldspacesegments);
1651
1652 /* move copied old space segments to empty space, and promote
1653 marked old space segments to the target generation */
1654 for (si = oldspacesegments; si != NULL; si = nextsi) {
1655 nextsi = si->next;
1656 si->old_space = 0;
1657 si->use_marks = 0;
1658 if (si->marked_mask != NULL) {
1659 IGEN tg;
1660 si->min_dirty_byte = 0xff;
1661 if (si->space != space_data) {
1662 int d;
1663 for (d = 0; d < cards_per_segment; d += sizeof(ptr)) {
1664 iptr *dp = (iptr *)(si->dirty_bytes + d);
1665 /* fill sizeof(iptr) bytes at a time with 0xff */
1666 *dp = -1;
1667 }
1668 }
1669 tg = si->generation;
1670 if (tg == static_generation) S_G.number_of_nonstatic_segments -= 1;
1671 s = si->space;
1672 si->next = S_G.occupied_segments[tg][s];
1673 S_G.occupied_segments[tg][s] = si;
1674 S_G.bytes_of_space[tg][s] += si->marked_count;
1675 si->trigger_guardians = 0;
1676 #ifdef PRESERVE_FLONUM_EQ
1677 si->forwarded_flonums = 0;
1678 #endif
1679 } else {
1680 chunkinfo *chunk = si->chunk, **chunks = ((si->space == space_code) ? S_code_chunks : S_chunks);
1681 S_G.number_of_nonstatic_segments -= 1;
1682 S_G.number_of_empty_segments += 1;
1683 si->space = space_empty;
1684 si->next = chunk->unused_segs;
1685 chunk->unused_segs = si;
1686 #ifdef WIPECLEAN
1687 memset((void *)build_ptr(si->number,0), 0xc7, bytes_per_segment);
1688 #endif
1689 if ((chunk->nused_segs -= 1) == 0) {
1690 if (chunk->bytes != (minimum_segment_request + 1) * bytes_per_segment) {
1691 /* release oversize chunks back to the O/S immediately to avoid allocating
1692 * small stuff into them and thereby invite fragmentation */
1693 S_free_chunk(chunk);
1694 } else {
1695 S_move_to_chunk_list(chunk, &chunks[PARTIAL_CHUNK_POOLS]);
1696 }
1697 } else {
1698 S_move_to_chunk_list(chunk, &chunks[PARTIAL_CHUNK_POOLS-1]);
1699 }
1700 }
1701 }
1702
1703 S_G.g0_bytes_after_last_gc = S_G.bytes_of_generation[0];
1704
1705 if (MAX_CG >= S_G.min_free_gen) S_free_chunks();
1706
1707 S_flush_instruction_cache(tc);
1708 S_thread_end_code_write(tc, MAX_TG, 0, NULL, 0);
1709
1710 #ifndef NO_DIRTY_NEWSPACE_POINTERS
1711 /* mark dirty those newspace cards to which we've added wrong-way pointers */
1712 { dirtycardinfo *ndc;
1713 for (ndc = S_G.new_dirty_cards; ndc != NULL; ndc = ndc->next)
1714 S_mark_card_dirty(ndc->card, ndc->youngest);
1715 }
1716 #endif /* !NO_DIRTY_NEWSPACE_POINTERS */
1717
1718 if (S_checkheap) S_check_heap(1, MAX_CG);
1719
1720 /* post-collection rehashing of tlcs.
1721 must come after any use of relocate.
1722 logically comes after gc is entirely complete */
1723 while (tlcs_to_rehash != Snil) {
1724 ptr b, next; uptr old_idx, new_idx;
1725 ptr tlc = Scar(tlcs_to_rehash);
1726 ptr ht = TLCHT(tlc);
1727 ptr vec = PTRFIELD(ht,eq_hashtable_vec_disp);
1728 uptr veclen = Svector_length(vec);
1729 ptr key = Scar(TLCKEYVAL(tlc));
1730
1731 /* scan to end of bucket to find the index */
1732 for (b = TLCNEXT(tlc); !Sfixnump(b); b = TLCNEXT(b));
1733 old_idx = UNFIX(b);
1734
1735 if (key == Sbwp_object && PTRFIELD(ht,eq_hashtable_subtype_disp) != FIX(eq_hashtable_subtype_normal)) {
1736 /* remove tlc */
1737 b = Svector_ref(vec, old_idx);
1738 if (b == tlc) {
1739 SETVECTIT(vec, old_idx, TLCNEXT(b));
1740 } else {
1741 for (;;) { next = TLCNEXT(b); if (next == tlc) break; b = next; }
1742 SETTLCNEXT(b,TLCNEXT(next));
1743 }
1744 INITTLCNEXT(tlc) = Sfalse;
1745 INITPTRFIELD(ht,eq_hashtable_size_disp) = FIX(UNFIX(PTRFIELD(ht,eq_hashtable_size_disp)) - 1);
1746 } else if ((new_idx = eq_hash(key) & (veclen - 1)) != old_idx) {
1747 /* remove tlc from old bucket */
1748 b = Svector_ref(vec, old_idx);
1749 if (b == tlc) {
1750 SETVECTIT(vec, old_idx, TLCNEXT(b));
1751 } else {
1752 for (;;) { next = TLCNEXT(b); if (next == tlc) break; b = next; }
1753 SETTLCNEXT(b,TLCNEXT(next));
1754 }
1755 /* and add to new bucket */
1756 SETTLCNEXT(tlc, Svector_ref(vec, new_idx));
1757 SETVECTIT(vec, new_idx, tlc);
1758 }
1759 tlcs_to_rehash = Scdr(tlcs_to_rehash);
1760 }
1761
1762 /* Promote opportunistic 1-shot continuations, because we can no
1763 longer cache one and we can no longer reliably fuse the stack
1764 back. */
1765 while (conts_to_promote != Snil) {
1766 S_promote_to_multishot(CONTLINK(Scar(conts_to_promote)));
1767 conts_to_promote = Scdr(conts_to_promote);
1768 }
1769
1770 S_resize_oblist();
1771
1772 /* tell profile_release_counters to look for bwp'd counters at least through max_tg */
1773 if (S_G.prcgeneration < MAX_TG) S_G.prcgeneration = MAX_TG;
1774
1775 if (tgc->sweep_stack_start != tgc->sweep_stack)
1776 S_error_abort("gc: sweep stack ended non-empty");
1777
1778 S_G.bitmask_overhead[0] += tgc->bitmask_overhead[0];
1779 tgc->bitmask_overhead[0] = 0;
1780 for (g = MIN_TG; g <= MAX_TG; g++)
1781 S_G.bitmask_overhead[g] += tgc->bitmask_overhead[g];
1782
1783 tgc->queued_fire = 0;
1784
1785 ACCUM_REAL_TIME(all_accum, astep, astart);
1786 REPORT_TIME(fprintf(stderr, "%d all +%ld ms %ld ms [real time]\n", MAX_CG, astep, all_accum));
1787
1788 if (count_roots_ls != Sfalse) {
1789 #ifdef ENABLE_OBJECT_COUNTS
1790 return count_roots_counts;
1791 #else
1792 return Snil;
1793 #endif
1794 } else
1795 return Svoid;
1796 }
1797
1798 #ifdef ENABLE_PARALLEL
1799
push_remote_sweep(thread_gc * tgc,ptr p,thread_gc * remote_tgc)1800 static void push_remote_sweep(thread_gc *tgc, ptr p, thread_gc *remote_tgc) {
1801 if (tgc->send_remote_sweep_stack == tgc->send_remote_sweep_stack_limit)
1802 enlarge_stack(tgc,
1803 &tgc->send_remote_sweep_stack,
1804 &tgc->send_remote_sweep_stack_start,
1805 &tgc->send_remote_sweep_stack_limit,
1806 2 * ptr_bytes);
1807 ((ptr *)TO_VOIDP(tgc->send_remote_sweep_stack))[0] = p;
1808 ((ptr *)TO_VOIDP(tgc->send_remote_sweep_stack))[1] = TO_PTR(remote_tgc);
1809 tgc->send_remote_sweep_stack = (ptr)((uptr)tgc->send_remote_sweep_stack + 2 * ptr_bytes);
1810 tgc->sweep_change = SWEEP_CHANGE_PROGRESS;
1811 }
1812
1813 #endif
1814
1815 #define sweep_space(s, from_g, body) do { \
1816 sweep_space_segments(s, from_g, body); \
1817 sweep_space_bump_range(s, from_g, body); \
1818 } while (0)
1819
1820 #define sweep_space_segments(s, from_g, body) do { \
1821 while ((si = (seginfo *)TO_VOIDP(tgc->sweep_next[from_g][s])) != NULL) { \
1822 tgc->sweep_next[from_g][s] = si->sweep_next; \
1823 pp = TO_VOIDP(si->sweep_start); \
1824 while ((p = *pp) != forward_marker) { \
1825 do body while (0); \
1826 } \
1827 COUNT_SWEPT_BYTES(si->sweep_start, pp); \
1828 save_resweep(s, si); \
1829 } \
1830 } while (0)
1831
1832 #define sweep_space_bump_range(s, from_g, body) do { \
1833 slp = &tgc->sweep_loc[from_g][s]; \
1834 nlp = &tgc->next_loc[from_g][s]; \
1835 while ((sl = TO_VOIDP(*slp)) != (nl = TO_VOIDP(*nlp))) { \
1836 *slp = TO_PTR(nl); \
1837 pp = sl; \
1838 while (pp != nl) { \
1839 p = *pp; \
1840 do body while (0); \
1841 } \
1842 COUNT_SWEPT_BYTES(sl, nl); \
1843 } \
1844 } while (0)
1845
1846 #define save_resweep(s, si) do { \
1847 if (s == space_weakpair) { \
1848 GC_MUTEX_ACQUIRE(); \
1849 si->sweep_next = resweep_weak_segments; \
1850 resweep_weak_segments = si; \
1851 GC_MUTEX_RELEASE(); \
1852 } \
1853 } while (0)
1854
resweep_weak_pairs(seginfo * oldweakspacesegments)1855 static void resweep_weak_pairs(seginfo *oldweakspacesegments) {
1856 IGEN from_g;
1857 ptr *pp, p, *nl, ls;
1858 seginfo *si;
1859
1860 for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
1861 thread_gc *s_tgc = THREAD_GC(THREADTC(Scar(ls)));
1862 for (from_g = MIN_TG; from_g <= MAX_TG; from_g += 1) {
1863 /* By starting from `base_loc`, we may needlessly sweep pairs in `MAX_TG`
1864 that were allocated before the GC, but that's ok. Could consult
1865 `orig_next_loc` to detect that case. */
1866 pp = TO_VOIDP(s_tgc->base_loc[from_g][space_weakpair]);
1867 nl = TO_VOIDP(s_tgc->next_loc[from_g][space_weakpair]);
1868 while (pp != nl) {
1869 p = *pp;
1870 forward_or_bwp(pp, p);
1871 pp += 2;
1872 }
1873 }
1874 }
1875
1876 for (si = resweep_weak_segments; si != NULL; si = si->sweep_next) {
1877 pp = TO_VOIDP(build_ptr(si->number, 0));
1878 while ((p = *pp) != forward_marker) {
1879 forward_or_bwp(pp, p);
1880 pp += 2;
1881 }
1882 }
1883
1884 for (si = oldweakspacesegments; si != NULL; si = si->next) {
1885 if (si->space != space_weakpair)
1886 break;
1887 if (si->marked_mask) {
1888 uptr i;
1889 for (i = 0; i < segment_bitmap_bytes; i++) {
1890 int mask = si->marked_mask[i];
1891 if (mask != 0) {
1892 /* Assuming 4 pairs per 8 words */
1893 pp = TO_VOIDP(build_ptr(si->number, (i << (log2_ptr_bytes+3))));
1894 if (mask & 0x1)
1895 forward_or_bwp(pp, *pp);
1896 pp += 2;
1897 if (mask & 0x4)
1898 forward_or_bwp(pp, *pp);
1899 pp += 2;
1900 if (mask & 0x10)
1901 forward_or_bwp(pp, *pp);
1902 pp += 2;
1903 if (mask & 0x40)
1904 forward_or_bwp(pp, *pp);
1905 }
1906 }
1907 }
1908 }
1909 }
1910
forward_or_bwp(pp,p)1911 static void forward_or_bwp(pp, p) ptr *pp; ptr p; {
1912 seginfo *si;
1913 /* adapted from relocate */
1914 if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space && !new_marked(si, p)) {
1915 if (FORWARDEDP(p, si)) {
1916 *pp = GET_FWDADDRESS(p);
1917 } else {
1918 *pp = Sbwp_object;
1919 }
1920 }
1921 }
1922
sweep_generation_pass(thread_gc * tgc)1923 static iptr sweep_generation_pass(thread_gc *tgc) {
1924 ptr *slp, *nlp; ptr *pp, *ppn, p, *nl, *sl; IGEN from_g;
1925 seginfo *si;
1926 iptr num_swept_bytes = 0;
1927
1928 do {
1929 tgc->sweep_change = SWEEP_NO_CHANGE;
1930
1931 num_swept_bytes += sweep_from_stack(tgc);
1932
1933 for (from_g = MIN_TG; from_g <= MAX_TG; from_g += 1) {
1934
1935 sweep_space(space_impure, from_g, {
1936 /* only pairs in these spaces in backreference mode */
1937 FLUSH_REMOTE_BLOCK
1938 SET_BACKREFERENCE(TYPE(TO_PTR(pp), type_pair));
1939 relocate_impure_help(pp, p, from_g);
1940 ppn = pp + 1;
1941 p = *ppn;
1942 relocate_impure_help(ppn, p, from_g);
1943 FLUSH_REMOTE(tgc, TYPE(TO_PTR(pp), type_pair)); /* can always treat as a pair to sweep words */
1944 pp = ppn + 1;
1945 });
1946 SET_BACKREFERENCE(Sfalse);
1947
1948 sweep_space(space_symbol, from_g, {
1949 p = TYPE(TO_PTR(pp), type_symbol);
1950 sweep_symbol(tgc, p, from_g);
1951 pp += size_symbol / sizeof(ptr);
1952 });
1953
1954 sweep_space(space_port, from_g, {
1955 p = TYPE(TO_PTR(pp), type_typed_object);
1956 sweep_port(tgc, p, from_g);
1957 pp += size_port / sizeof(ptr);
1958 });
1959
1960 sweep_space(space_weakpair, from_g, {
1961 FLUSH_REMOTE_BLOCK
1962 SET_BACKREFERENCE(TYPE(TO_PTR(pp), type_pair));
1963 ppn = pp + 1;
1964 p = *ppn;
1965 relocate_impure_help(ppn, p, from_g);
1966 FLUSH_REMOTE(tgc, TYPE(TO_PTR(pp), type_pair));
1967 pp = ppn + 1;
1968 });
1969 SET_BACKREFERENCE(Sfalse);
1970
1971 sweep_space(space_ephemeron, from_g, {
1972 p = TYPE(TO_PTR(pp), type_pair);
1973 add_ephemeron_to_pending(tgc, p);
1974 pp += size_ephemeron / sizeof(ptr);
1975 });
1976
1977 sweep_space(space_pure, from_g, {
1978 FLUSH_REMOTE_BLOCK
1979 SET_BACKREFERENCE(TYPE(TO_PTR(pp), type_pair)); /* only pairs put here in backreference mode */
1980 relocate_impure_help(pp, p, from_g);
1981 ppn = pp + 1;
1982 p = *ppn;
1983 relocate_impure_help(ppn, p, from_g);
1984 FLUSH_REMOTE(tgc, TYPE(TO_PTR(pp), type_pair));
1985 pp = ppn + 1;
1986 });
1987 SET_BACKREFERENCE(Sfalse);
1988
1989 sweep_space(space_continuation, from_g, {
1990 p = TYPE(TO_PTR(pp), type_closure);
1991 sweep_continuation(tgc, p, from_g);
1992 pp += size_continuation / sizeof(ptr);
1993 });
1994
1995 sweep_space(space_pure_typed_object, from_g, {
1996 p = TYPE(TO_PTR(pp), type_typed_object);
1997 pp = TO_VOIDP(((uptr)TO_PTR(pp) + sweep_typed_object(tgc, p, from_g)));
1998 });
1999
2000 sweep_space(space_code, from_g, {
2001 p = TYPE(TO_PTR(pp), type_typed_object);
2002 sweep_code_object(tgc, p, from_g);
2003 pp += size_code(CODELEN(p)) / sizeof(ptr);
2004 });
2005
2006 sweep_space(space_impure_record, from_g, {
2007 p = TYPE(TO_PTR(pp), type_typed_object);
2008 sweep_record(tgc, p, from_g);
2009 pp = TO_VOIDP((iptr)TO_PTR(pp) +
2010 size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p)))));
2011 });
2012
2013 /* space used only as needed for backreferences: */
2014 sweep_space(space_impure_typed_object, from_g, {
2015 p = TYPE(TO_PTR(pp), type_typed_object);
2016 pp = TO_VOIDP((uptr)TO_PTR(pp) + sweep_typed_object(tgc, p, from_g));
2017 });
2018
2019 /* space used only as needed for backreferences: */
2020 sweep_space(space_closure, from_g, {
2021 p = TYPE(TO_PTR(pp), type_closure);
2022 sweep(tgc, p, from_g);
2023 pp = TO_VOIDP((uptr)TO_PTR(pp) + size_object(p));
2024 });
2025
2026 sweep_space(space_reference_array, from_g, {
2027 p = TYPE(TO_PTR(pp), type_typed_object);
2028 pp = TO_VOIDP((uptr)TO_PTR(pp) + sweep_typed_object(tgc, p, from_g));
2029 });
2030
2031 }
2032
2033 /* May add to the sweep stack: */
2034 send_and_receive_remote_sweeps(tgc);
2035
2036 /* Waiting until sweeping doesn't trigger a change reduces the
2037 chance that an ephemeron must be reigistered as a
2038 segment-specific trigger or gets triggered for recheck, but
2039 it doesn't change the worst-case complexity. */
2040 if (tgc->sweep_change == SWEEP_NO_CHANGE)
2041 check_pending_ephemerons(tgc);
2042
2043 # ifdef ENABLE_MEASURE
2044 if ((tgc->sweep_change == SWEEP_NO_CHANGE)
2045 && measure_all_enabled) {
2046 flush_measure_stack(tgc);
2047 }
2048 # endif
2049 } while (tgc->sweep_change == SWEEP_CHANGE_PROGRESS);
2050
2051 return num_swept_bytes;
2052 }
2053
sweep_generation(thread_gc * tgc)2054 static void sweep_generation(thread_gc *tgc) {
2055 sweep_generation_pass(tgc);
2056 }
2057
enlarge_stack(thread_gc * tgc,ptr * stack,ptr * stack_start,ptr * stack_limit,uptr grow_at_least)2058 void enlarge_stack(thread_gc *tgc, ptr *stack, ptr *stack_start, ptr *stack_limit, uptr grow_at_least) {
2059 uptr sz = ((uptr)*stack - (uptr)*stack_start);
2060 uptr new_sz = 2 * ((sz == 0) ? (uptr)sweep_stack_min_size : sz);
2061 ptr new_stack;
2062 if (new_sz - sz < grow_at_least) new_sz += grow_at_least;
2063 find_gc_room(tgc, space_data, 0, type_untyped, ptr_align(new_sz), new_stack);
2064 if (sz != 0)
2065 memcpy(TO_VOIDP(new_stack), TO_VOIDP(*stack_start), sz);
2066 tgc->bitmask_overhead[0] += ptr_align(new_sz);
2067 *stack_start = new_stack;
2068 *stack_limit = (ptr)((uptr)new_stack + new_sz);
2069 *stack = (ptr)((uptr)new_stack + sz);
2070 }
2071
sweep_from_stack(thread_gc * tgc)2072 iptr sweep_from_stack(thread_gc *tgc) {
2073 iptr num_swept_bytes = 0;
2074
2075 if (tgc->sweep_stack > tgc->sweep_stack_start) {
2076 while (tgc->sweep_stack > tgc->sweep_stack_start) {
2077 ptr p;
2078 seginfo *si;
2079 tgc->sweep_stack = (ptr)((uptr)tgc->sweep_stack - ptr_bytes);
2080 p = *(ptr *)TO_VOIDP(tgc->sweep_stack);
2081 /* Room for improvement: `si->generation` is needed only for
2082 objects that have impure fields. */
2083 si = SegInfo(ptr_get_segment(p));
2084 sweep(tgc, p, si->generation);
2085 COUNT_SWEPT_BYTES(0, size_object(p));
2086 }
2087 }
2088
2089 return num_swept_bytes;
2090 }
2091
sweep_typed_object(thread_gc * tgc,ptr p,IGEN from_g)2092 static iptr sweep_typed_object(thread_gc *tgc, ptr p, IGEN from_g) {
2093 ptr tf = TYPEFIELD(p);
2094
2095 if (TYPEP(tf, mask_record, type_record)) {
2096 sweep_record(tgc, p, from_g);
2097 return size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p))));
2098 } else if (TYPEP(tf, mask_thread, type_thread)) {
2099 sweep_thread(tgc, p);
2100 return size_thread;
2101 } else {
2102 /* We get here only if backreference mode pushed other typed objects into
2103 a typed space or if an object is a counting root */
2104 sweep(tgc, p, from_g);
2105 return size_object(p);
2106 }
2107 }
2108
2109 typedef struct _weakseginfo {
2110 seginfo *si;
2111 IGEN youngest[cards_per_segment];
2112 struct _weakseginfo *next;
2113 } weakseginfo;
2114
2115 static weakseginfo *weaksegments_to_resweep;
2116
record_dirty_segment(IGEN from_g,IGEN to_g,seginfo * si)2117 static void record_dirty_segment(IGEN from_g, IGEN to_g, seginfo *si) {
2118 if (si->min_dirty_byte != 0xff) {
2119 S_error_abort("record_dirty(gc): unexpected mutation while sweeping");
2120 }
2121
2122 if (to_g < from_g) {
2123 seginfo *oldfirst;
2124 GC_MUTEX_ACQUIRE();
2125 oldfirst = DirtySegments(from_g, to_g);
2126 DirtySegments(from_g, to_g) = si;
2127 si->dirty_prev = &DirtySegments(from_g, to_g);
2128 si->dirty_next = oldfirst;
2129 if (oldfirst != NULL) oldfirst->dirty_prev = &si->dirty_next;
2130 si->min_dirty_byte = to_g;
2131 GC_MUTEX_RELEASE();
2132 }
2133 }
2134
add_weaksegments_to_resweep(weakseginfo * segs,weakseginfo * last_seg)2135 static void add_weaksegments_to_resweep(weakseginfo *segs, weakseginfo *last_seg) {
2136 if (segs != NULL) {
2137 GC_MUTEX_ACQUIRE();
2138 last_seg->next = weaksegments_to_resweep;
2139 weaksegments_to_resweep = segs;
2140 GC_MUTEX_RELEASE();
2141 }
2142 }
2143
setup_sweep_dirty(NO_PARALLEL_UNUSED thread_gc * tgc)2144 static void setup_sweep_dirty(NO_PARALLEL_UNUSED thread_gc *tgc) {
2145 IGEN from_g, to_g;
2146
2147 weaksegments_to_resweep = NULL;
2148
2149 /* clear dirty segment lists for copied generations */
2150 for (from_g = 1; from_g <= MAX_CG; from_g += 1) {
2151 for (to_g = 0; to_g < from_g; to_g += 1) {
2152 DirtySegments(from_g, to_g) = NULL;
2153 }
2154 }
2155
2156 #ifdef ENABLE_PARALLEL
2157 /* Move dirty-segment information to the right thread */
2158 for (from_g = MAX_CG + 1; from_g <= static_generation; INCRGEN(from_g)) {
2159 for (to_g = 0; to_g <= MAX_CG; to_g += 1) {
2160 seginfo *dirty_si, *nextsi;
2161 dirty_si = DirtySegments(from_g, to_g);
2162 DirtySegments(from_g, to_g) = NULL;
2163 for (; dirty_si != NULL; dirty_si = nextsi) {
2164 thread_gc *d_tgc;
2165 ISPC s;
2166
2167 nextsi = dirty_si->dirty_next;
2168 s = dirty_si->space;
2169
2170 if (s == space_new) {
2171 /* Must be a space that has only locked objects, which we sweeep every time */
2172 continue;
2173 }
2174
2175 d_tgc = dirty_si->creator;
2176 if (d_tgc->tc == (ptr)0) d_tgc = tgc;
2177
2178 dirty_si->dirty_next = DirtySegmentsAt(d_tgc->dirty_segments, from_g, to_g);
2179 DirtySegmentsAt(d_tgc->dirty_segments, from_g, to_g) = dirty_si;
2180 }
2181 }
2182 }
2183 #endif
2184 }
2185
sweep_dirty_segments(thread_gc * tgc,seginfo ** dirty_segments)2186 static uptr sweep_dirty_segments(thread_gc *tgc, seginfo **dirty_segments) {
2187 IGEN youngest, min_youngest;
2188 ptr *pp, *ppn, *ppend, *nl, start;
2189 uptr seg, d;
2190 ISPC s;
2191 IGEN from_g, to_g;
2192 seginfo *dirty_si, *nextsi;
2193 uptr num_swept_bytes = 0;
2194 weakseginfo *local_weaksegments_to_resweep = NULL, *last_local_weaksegments_to_resweep = NULL;
2195
2196 PUSH_BACKREFERENCE(Snil) /* '() => from unspecified old object */
2197
2198 /* no new dirty registrations should happen while sweeping */
2199 for (from_g = MAX_CG + 1; from_g <= static_generation; INCRGEN(from_g)) {
2200 for (to_g = 0; to_g <= MAX_CG; to_g += 1) {
2201 dirty_si = DirtySegmentsAt(dirty_segments, from_g, to_g);
2202 DirtySegmentsAt(dirty_segments, from_g, to_g) = NULL;
2203 for (; dirty_si != NULL; dirty_si = nextsi) {
2204 nextsi = dirty_si->dirty_next;
2205 seg = dirty_si->number;
2206 s = dirty_si->space;
2207
2208 /* reset min dirty byte so we can detect if byte is set while card is swept */
2209 dirty_si->min_dirty_byte = 0xff;
2210
2211 #ifndef ENABLE_PARALLEL
2212 if (s == space_new) {
2213 /* Must be a space that has only locked objects, which we sweeep every time */
2214 continue;
2215 }
2216 #endif
2217
2218 if (s == space_weakpair) {
2219 weakseginfo *next = local_weaksegments_to_resweep;
2220 find_gc_room_voidp(tgc, space_data, 0, ptr_align(sizeof(weakseginfo)), local_weaksegments_to_resweep);
2221 tgc->bitmask_overhead[0] += ptr_align(sizeof(weakseginfo));
2222 local_weaksegments_to_resweep->si = dirty_si;
2223 local_weaksegments_to_resweep->next = next;
2224 if (next == NULL)
2225 last_local_weaksegments_to_resweep = local_weaksegments_to_resweep;
2226 }
2227
2228 min_youngest = 0xff;
2229 start = build_ptr(seg, 0);
2230 ppend = TO_VOIDP(start);
2231
2232 /* The original allocation pointer may be relevant as the
2233 ending point. We assume that thread-local regions for all
2234 threads without a sweeper are terminated and won't get new
2235 allocations while dirty sweeping runs, while all
2236 allocations for a thread with a sweeper will be only using
2237 that tc, and no allocation happens for a non-target generation. */
2238 if (from_g == MAX_TG)
2239 nl = TO_VOIDP(tgc->orig_next_loc[s]);
2240 else
2241 nl = TO_VOIDP(tgc->next_loc[from_g][s]);
2242
2243 d = 0;
2244 while (d < cards_per_segment) {
2245 uptr dend = d + sizeof(iptr);
2246 iptr *dp = (iptr *)(dirty_si->dirty_bytes + d);
2247 /* check sizeof(iptr) bytes at a time for 0xff */
2248 if (*dp == -1) {
2249 pp = ppend;
2250 ppend += bytes_per_card;
2251 d = dend;
2252 } else {
2253 while (d < dend) {
2254 pp = ppend;
2255 ppend += bytes_per_card / sizeof(ptr);
2256 if (pp <= nl && nl < ppend) ppend = nl;
2257
2258 if (dirty_si->dirty_bytes[d] <= MAX_CG) {
2259 /* start out with assumption that we won't find any wrong-way pointers */
2260 youngest = 0xff;
2261
2262 COUNT_SWEPT_BYTES(pp, ppend);
2263
2264 if ((s == space_impure) || (s == space_immobile_impure)
2265 || (s == space_impure_typed_object) || (s == space_count_impure)
2266 || (s == space_closure)) {
2267 if (dirty_si->marked_mask) {
2268 while (pp < ppend) {
2269 /* handle two pointers at a time */
2270 if (marked(dirty_si, TO_PTR(pp))) {
2271 FLUSH_REMOTE_BLOCK
2272 relocate_dirty(pp, youngest);
2273 ppn = pp + 1;
2274 relocate_dirty(ppn, youngest);
2275 FLUSH_REMOTE(tgc, TYPE(TO_PTR(pp), type_pair));
2276 pp = ppn + 1;
2277 } else {
2278 pp += 2;
2279 }
2280 }
2281 } else {
2282 while (pp < ppend && *pp != forward_marker) {
2283 /* handle two pointers at a time */
2284 FLUSH_REMOTE_BLOCK
2285 relocate_dirty(pp, youngest);
2286 ppn = pp + 1;
2287 relocate_dirty(ppn, youngest);
2288 FLUSH_REMOTE(tgc, TYPE(TO_PTR(pp), type_pair));
2289 pp = ppn + 1;
2290 }
2291 }
2292 } else if (s == space_symbol) {
2293 /* old symbols cannot overlap segment boundaries
2294 since any object that spans multiple
2295 segments begins at the start of a segment,
2296 and symbols are much smaller (we assume)
2297 than the segment size. */
2298 pp = (ptr *)TO_VOIDP(build_ptr(seg,0)) +
2299 ((pp - (ptr *)TO_VOIDP(build_ptr(seg,0))) /
2300 (size_symbol / sizeof(ptr))) *
2301 (size_symbol / sizeof(ptr));
2302
2303 /* might overshoot card by part of a symbol. no harm. */
2304 while (pp < ppend && (dirty_si->marked_mask || (*pp != forward_marker))) {
2305 ptr p = TYPE(TO_PTR(pp), type_symbol);
2306
2307 if (!dirty_si->marked_mask || marked(dirty_si, p))
2308 youngest = sweep_dirty_symbol(tgc, p, youngest);
2309
2310 pp += size_symbol / sizeof(ptr);
2311 }
2312 } else if (s == space_port) {
2313 /* old ports cannot overlap segment boundaries
2314 since any object that spans multiple
2315 segments begins at the start of a segment,
2316 and ports are much smaller (we assume)
2317 than the segment size. */
2318 pp = (ptr *)TO_VOIDP(build_ptr(seg,0)) +
2319 ((pp - (ptr *)TO_VOIDP(build_ptr(seg,0))) /
2320 (size_port / sizeof(ptr))) *
2321 (size_port / sizeof(ptr));
2322
2323 /* might overshoot card by part of a port. no harm. */
2324 while (pp < ppend && (dirty_si->marked_mask || (*pp != forward_marker))) {
2325 ptr p = TYPE(TO_PTR(pp), type_typed_object);
2326
2327 if (!dirty_si->marked_mask || marked(dirty_si, p))
2328 youngest = sweep_dirty_port(tgc, p, youngest);
2329
2330 pp += size_port / sizeof(ptr);
2331 }
2332 } else if (s == space_impure_record) { /* abandon hope all ye who enter here */
2333 ptr p;
2334 if (dirty_si->marked_mask) {
2335 /* To get to the start of a record, move backward as long as bytes
2336 are marked and segment space+generation+marked is the same. */
2337 uptr byte = segment_bitmap_byte(TO_PTR(pp));
2338 uptr bit = segment_bitmap_bit(TO_PTR(pp));
2339 uptr at_seg = seg;
2340 seginfo *si = dirty_si;
2341
2342 while (si->marked_mask[byte] & (bit >> ptr_alignment))
2343 bit >>= ptr_alignment;
2344 if (bit == 1) {
2345 /* try previous byte(s) */
2346 while (1) {
2347 if (byte == 0) {
2348 seginfo *prev_si = MaybeSegInfo(at_seg-1);
2349 if (prev_si
2350 && (prev_si->space == si->space)
2351 && (prev_si->generation == si->generation)
2352 && prev_si->marked_mask
2353 /* object can only continue from the previous segment
2354 if that segment is fully marked (including last words) */
2355 && (prev_si->marked_mask[segment_bitmap_bytes-1] == record_full_marked_mask)) {
2356 /* maybe the object continues from the previous segment, although
2357 we don't really know... */
2358 at_seg -= 1;
2359 si = prev_si;
2360 byte = segment_bitmap_bytes-1;
2361 } else {
2362 /* object does not continue from the previous segment */
2363 break;
2364 }
2365 } else {
2366 if (si->marked_mask[byte-1] == record_full_marked_mask) {
2367 /* next byte is full, so keep looking */
2368 byte--;
2369 } else if (si->marked_mask[byte-1] & record_high_marked_bit) {
2370 /* next byte continues, but is not full, so we can start
2371 there */
2372 if (at_seg != seg) {
2373 /* in fact, we can start at the beginning of the
2374 next segment, because that segment's
2375 first object cannot start on this segment */
2376 at_seg++;
2377 byte = 0;
2378 si = SegInfo(at_seg);
2379 } else {
2380 byte--;
2381 bit = record_high_marked_bit;
2382 /* find bit contiguous with highest bit */
2383 while (si->marked_mask[byte] & (bit >> ptr_alignment))
2384 bit >>= ptr_alignment;
2385 }
2386 break;
2387 } else {
2388 /* next byte is empty, so don't go there */
2389 break;
2390 }
2391 }
2392 }
2393 }
2394
2395 /* `bit` and `byte` refer to a non-0 mark bit that must be
2396 the start of an object */
2397 p = build_ptr(at_seg, (byte << (log2_ptr_bytes+3)));
2398 while (bit > ptr_alignment) {
2399 p = (ptr)((uptr)p + byte_alignment);
2400 bit >>= ptr_alignment;
2401 }
2402 p = TYPE(p, type_typed_object);
2403
2404 /* now sweep, but watch out for unmarked holes in the dirty region */
2405 while ((ptr *)TO_VOIDP(UNTYPE(p, type_typed_object)) < ppend) {
2406 seginfo *si = SegInfo(ptr_get_segment(p));
2407 if (!marked(si, p)) {
2408 /* skip unmarked words */
2409 p = (ptr)((uptr)p + byte_alignment);
2410 } else {
2411 youngest = sweep_dirty_record(tgc, p, youngest);
2412 p = (ptr)((iptr)p +
2413 size_record_inst(UNFIX(RECORDDESCSIZE(
2414 RECORDINSTTYPE(p)))));
2415 }
2416 }
2417 } else {
2418 uptr j; ptr pnext; seginfo *si;
2419
2420 /* synchronize on first record that overlaps the dirty
2421 area, then relocate any mutable pointers in that
2422 record and those that follow within the dirty area. */
2423
2424 /* find first segment of group of like segments */
2425 j = seg - 1;
2426 while ((si = MaybeSegInfo(j)) != NULL &&
2427 si->space == s &&
2428 si->generation == from_g &&
2429 !si->marked_mask)
2430 j -= 1;
2431 j += 1;
2432
2433 /* now find first record in segment seg */
2434 /* we count on following fact: if an object spans two
2435 or more segments, then it starts at the beginning
2436 of a segment */
2437 for (;;) {
2438 p = TYPE(build_ptr(j,0),type_typed_object);
2439 pnext = (ptr)((iptr)p +
2440 size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p)))));
2441 if (ptr_get_segment(pnext) >= seg) break;
2442 j = ptr_get_segment(pnext) + 1;
2443 }
2444
2445 /* now find first within dirty area */
2446 while ((ptr *)TO_VOIDP(UNTYPE(pnext, type_typed_object)) <= pp) {
2447 p = pnext;
2448 pnext = (ptr)((iptr)p +
2449 size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p)))));
2450 }
2451
2452 /* now sweep */
2453 while ((ptr *)TO_VOIDP(UNTYPE(p, type_typed_object)) < ppend) {
2454 /* quit on end of segment */
2455 if (FWDMARKER(p) == forward_marker) break;
2456
2457 youngest = sweep_dirty_record(tgc, p, youngest);
2458 p = (ptr)((iptr)p +
2459 size_record_inst(UNFIX(RECORDDESCSIZE(
2460 RECORDINSTTYPE(p)))));
2461 }
2462 }
2463 } else if (s == space_weakpair) {
2464 while (pp < ppend && (dirty_si->marked_mask || (*pp != forward_marker))) {
2465 /* skip car field and handle cdr field */
2466 if (!dirty_si->marked_mask || marked(dirty_si, TO_PTR(pp))) {
2467 FLUSH_REMOTE_BLOCK
2468 ptr *ppn = pp + 1;
2469 relocate_dirty(ppn, youngest);
2470 FLUSH_REMOTE(tgc, TYPE(TO_PTR(pp), type_pair));
2471 pp = ppn + 1;
2472 } else {
2473 pp += 2;
2474 }
2475 }
2476 } else if (s == space_ephemeron) {
2477 while (pp < ppend && (dirty_si->marked_mask || (*pp != forward_marker))) {
2478 ptr p = TYPE(TO_PTR(pp), type_pair);
2479 if (!dirty_si->marked_mask || marked(dirty_si, p))
2480 youngest = check_dirty_ephemeron(tgc, p, youngest);
2481 pp += size_ephemeron / sizeof(ptr);
2482 }
2483 } else if (s == space_reference_array) {
2484 /* the same as space_impure and others above, but for object references */
2485 if (dirty_si->marked_mask) {
2486 while (pp < ppend) {
2487 /* handle two pointers at a time */
2488 if (marked(dirty_si, TO_PTR(pp))) {
2489 FLUSH_REMOTE_BLOCK
2490 relocate_reference_dirty(pp, youngest);
2491 ppn = pp + 1;
2492 relocate_reference_dirty(ppn, youngest);
2493 FLUSH_REMOTE(tgc, TYPE(TO_PTR(pp), type_pair)); /* can treat as a pair for resweep */
2494 pp = ppn + 1;
2495 } else {
2496 pp += 2;
2497 }
2498 }
2499 } else {
2500 while (pp < ppend && *pp != forward_marker) {
2501 /* handle two pointers at a time */
2502 FLUSH_REMOTE_BLOCK
2503 relocate_reference_dirty(pp, youngest);
2504 ppn = pp + 1;
2505 relocate_reference_dirty(ppn, youngest);
2506 FLUSH_REMOTE(tgc, TYPE(TO_PTR(pp), type_pair));
2507 pp = ppn + 1;
2508 }
2509 }
2510 } else {
2511 S_error_abort("sweep_dirty(gc): unexpected space");
2512 }
2513
2514 if (s == space_weakpair) {
2515 local_weaksegments_to_resweep->youngest[d] = youngest;
2516 } else {
2517 dirty_si->dirty_bytes[d] = youngest < from_g ? youngest : 0xff;
2518 }
2519 if (youngest < min_youngest) min_youngest = youngest;
2520 } else {
2521 if (dirty_si->dirty_bytes[d] < min_youngest) min_youngest = dirty_si->dirty_bytes[d];
2522 }
2523 d += 1;
2524 }
2525 }
2526 }
2527 if (s != space_weakpair) {
2528 record_dirty_segment(from_g, min_youngest, dirty_si);
2529 }
2530 }
2531 }
2532 }
2533
2534 add_weaksegments_to_resweep(local_weaksegments_to_resweep, last_local_weaksegments_to_resweep);
2535
2536 POP_BACKREFERENCE()
2537
2538 return num_swept_bytes;
2539 }
2540
2541 #ifndef ENABLE_PARALLEL
sweep_dirty(thread_gc * tgc)2542 static void sweep_dirty(thread_gc *tgc) {
2543 (void)sweep_dirty_segments(tgc, S_G.dirty_segments);
2544 }
2545 #endif
2546
resweep_dirty_weak_pairs(thread_gc * tgc)2547 static void resweep_dirty_weak_pairs(thread_gc *tgc) {
2548 weakseginfo *ls;
2549 ptr *pp, *ppend, p;
2550 IGEN from_g, min_youngest, youngest;
2551 uptr d;
2552
2553 /* Make sure terminator is in place for allocation areas relevant to this thread */
2554 for (from_g = MIN_TG; from_g <= static_generation; from_g++) {
2555 ptr old;
2556 old = tgc->next_loc[from_g][space_weakpair];
2557 if (old != (ptr)0)
2558 *(ptr*)TO_VOIDP(old) = forward_marker;
2559 }
2560
2561 for (ls = weaksegments_to_resweep; ls != NULL; ls = ls->next) {
2562 seginfo *dirty_si = ls->si;
2563 from_g = dirty_si->generation;
2564 ppend = TO_VOIDP(build_ptr(dirty_si->number, 0));
2565 min_youngest = 0xff;
2566 d = 0;
2567 while (d < cards_per_segment) {
2568 uptr dend = d + sizeof(iptr);
2569 iptr *dp = (iptr *)(dirty_si->dirty_bytes + d);
2570 /* check sizeof(iptr) bytes at a time for 0xff */
2571 if (*dp == -1) {
2572 d = dend;
2573 ppend += bytes_per_card;
2574 } else {
2575 while (d < dend) {
2576 pp = ppend;
2577 ppend += bytes_per_card / sizeof(ptr);
2578 if (dirty_si->dirty_bytes[d] <= MAX_CG) {
2579 youngest = ls->youngest[d];
2580 while (pp < ppend) {
2581 if (!dirty_si->marked_mask && *pp == forward_marker)
2582 break;
2583 if (!dirty_si->marked_mask || marked(dirty_si, TO_PTR(pp))) {
2584 p = *pp;
2585 seginfo *si;
2586
2587 /* handle car field */
2588 if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) {
2589 if (si->old_space) {
2590 if (new_marked(si, p)) {
2591 youngest = TARGET_GENERATION(si);
2592 } else if (FORWARDEDP(p, si)) {
2593 IGEN newpg;
2594 *pp = GET_FWDADDRESS(p);
2595 newpg = TARGET_GENERATION(si);
2596 if (newpg < youngest) youngest = newpg;
2597 } else {
2598 *pp = Sbwp_object;
2599 }
2600 } else {
2601 IGEN pg = si->generation;
2602 if (pg < youngest) youngest = pg;
2603 }
2604 }
2605 }
2606
2607 /* skip cdr field */
2608 pp += 2;
2609 }
2610
2611 dirty_si->dirty_bytes[d] = youngest < from_g ? youngest : 0xff;
2612 if (youngest < min_youngest) min_youngest = youngest;
2613 } else {
2614 if (dirty_si->dirty_bytes[d] < min_youngest) min_youngest = dirty_si->dirty_bytes[d];
2615 }
2616 d += 1;
2617 }
2618 }
2619 }
2620 record_dirty_segment(from_g, min_youngest, dirty_si);
2621 }
2622 }
2623
add_pending_guardian(ptr gdn,ptr tconc)2624 static void add_pending_guardian(ptr gdn, ptr tconc)
2625 {
2626 seginfo *si = SegInfo(ptr_get_segment(tconc));
2627 INITGUARDIANNEXT(gdn) = si->trigger_guardians;
2628 si->trigger_guardians = gdn;
2629 si->has_triggers = 1;
2630 }
2631
add_trigger_guardians_to_recheck(ptr ls)2632 static void add_trigger_guardians_to_recheck(ptr ls)
2633 {
2634 ptr last = ls, next;
2635
2636 GC_MUTEX_ACQUIRE();
2637
2638 next = GUARDIANNEXT(ls);
2639 while (next != 0) {
2640 last = next;
2641 next = GUARDIANNEXT(next);
2642 }
2643 INITGUARDIANNEXT(last) = recheck_guardians_ls;
2644 recheck_guardians_ls = ls;
2645
2646 GC_MUTEX_RELEASE();
2647 }
2648
ephemeron_remove(ptr pe)2649 static void ephemeron_remove(ptr pe) {
2650 ptr next = EPHEMERONNEXT(pe);
2651 *((ptr *)TO_VOIDP(EPHEMERONPREVREF(pe))) = next;
2652 if (next)
2653 EPHEMERONPREVREF(next) = EPHEMERONPREVREF(pe);
2654 EPHEMERONPREVREF(pe) = 0;
2655 EPHEMERONNEXT(pe) = 0;
2656 }
2657
ephemeron_add(ptr * first,ptr pe)2658 static void ephemeron_add(ptr *first, ptr pe) {
2659 ptr last_pe = pe, next_pe = EPHEMERONNEXT(pe), next;
2660 while (next_pe != 0) {
2661 last_pe = next_pe;
2662 next_pe = EPHEMERONNEXT(next_pe);
2663 }
2664 next = *first;
2665 *first = pe;
2666 EPHEMERONPREVREF(pe) = TO_PTR(first);
2667 EPHEMERONNEXT(last_pe) = next;
2668 if (next)
2669 EPHEMERONPREVREF(next) = TO_PTR(&EPHEMERONNEXT(last_pe));
2670 }
2671
add_ephemeron_to_pending(thread_gc * tgc,ptr pe)2672 static void add_ephemeron_to_pending(thread_gc *tgc, ptr pe) {
2673 /* We could call check_ephemeron directly here, but the indirection
2674 through `PENDINGEPHEMERONS` can dramatically decrease the number
2675 of times that we have to trigger re-checking, especially since
2676 check_pending_pehemerons() is run only after all other sweep
2677 opportunities are exhausted. */
2678 if (EPHEMERONPREVREF(pe)) ephemeron_remove(pe);
2679 ephemeron_add(&tgc->pending_ephemerons, pe);
2680 }
2681
add_trigger_ephemerons_to_pending(thread_gc * tgc,ptr pe)2682 static void add_trigger_ephemerons_to_pending(thread_gc *tgc, ptr pe) {
2683 ephemeron_add(&tgc->pending_ephemerons, pe);
2684 }
2685
check_ephemeron(thread_gc * tgc,ptr pe)2686 static void check_ephemeron(thread_gc *tgc, ptr pe) {
2687 FLUSH_REMOTE_BLOCK
2688 ptr p;
2689 seginfo *si;
2690 IGEN from_g;
2691 PUSH_BACKREFERENCE(pe);
2692
2693 EPHEMERONNEXT(pe) = 0;
2694 EPHEMERONPREVREF(pe) = 0;
2695
2696 from_g = GENERATION(pe);
2697
2698 p = Scar(pe);
2699 if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space) {
2700 if (SEGMENT_IS_LOCAL(si, p)) {
2701 if (new_marked(si, p)) {
2702 #ifndef NO_DIRTY_NEWSPACE_POINTERS
2703 IGEN tg = TARGET_GENERATION(si);
2704 if (tg < from_g) S_record_new_dirty_card(tgc, &INITCAR(pe), tg);
2705 #endif
2706 relocate_impure(&INITCDR(pe), from_g);
2707 } else if (FORWARDEDP(p, si)) {
2708 #ifndef NO_DIRTY_NEWSPACE_POINTERS
2709 IGEN tg = TARGET_GENERATION(si);
2710 if (tg < from_g) S_record_new_dirty_card(tgc, &INITCAR(pe), tg);
2711 #endif
2712 INITCAR(pe) = GET_FWDADDRESS(p);
2713 relocate_impure(&INITCDR(pe), from_g);
2714 } else {
2715 /* Not reached, so far; install as trigger */
2716 ephemeron_add(&si->trigger_ephemerons, pe);
2717 si->has_triggers = 1;
2718 }
2719 } else {
2720 RECORD_REMOTE(si);
2721 }
2722 } else {
2723 relocate_impure(&INITCDR(pe), from_g);
2724 }
2725
2726 FLUSH_REMOTE(tgc, pe);
2727
2728 POP_BACKREFERENCE();
2729 }
2730
check_pending_ephemerons(thread_gc * tgc)2731 static void check_pending_ephemerons(thread_gc *tgc) {
2732 ptr pe, next_pe;
2733
2734 pe = tgc->pending_ephemerons;
2735 tgc->pending_ephemerons = 0;
2736
2737 while (pe != 0) {
2738 next_pe = EPHEMERONNEXT(pe);
2739 check_ephemeron(tgc, pe);
2740 pe = next_pe;
2741 }
2742
2743
2744 }
2745
2746 /* Like check_ephemeron(), but for a dirty, old-generation
2747 ephemeron (that was not yet added to the pending list), so we can
2748 be less pessimistic than setting `youngest` to the target
2749 generation: */
check_dirty_ephemeron(thread_gc * tgc,ptr pe,IGEN youngest)2750 static IGEN check_dirty_ephemeron(thread_gc *tgc, ptr pe, IGEN youngest) {
2751 FLUSH_REMOTE_BLOCK
2752 ptr p;
2753 seginfo *si;
2754 IGEN pg;
2755 PUSH_BACKREFERENCE(pe);
2756
2757 p = Scar(pe);
2758 if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) {
2759 if (si->old_space) {
2760 if (SEGMENT_IS_LOCAL(si, p)) {
2761 if (new_marked(si, p)) {
2762 relocate_dirty(&INITCDR(pe), youngest);
2763 } else if (FORWARDEDP(p, si)) {
2764 INITCAR(pe) = GET_FWDADDRESS(p);
2765 relocate_dirty(&INITCDR(pe), youngest);
2766 } else {
2767 /* Not reached, so far; add to pending list */
2768 add_ephemeron_to_pending(tgc, pe);
2769
2770 /* Make the consistent (but pessimistic w.r.t. to wrong-way
2771 pointers) assumption that the key will stay live and move
2772 to the target generation. That assumption covers the value
2773 part, too, since it can't end up younger than the target
2774 generation. */
2775 if (youngest != MIN_TG && (pg = TARGET_GENERATION(si)) < youngest)
2776 youngest = pg;
2777 }
2778 } else {
2779 RECORD_REMOTE(si);
2780 FLUSH_REMOTE(tgc, pe);
2781 return youngest;
2782 }
2783 } else {
2784 if (youngest != MIN_TG && (pg = si->generation) < youngest)
2785 youngest = pg;
2786 relocate_dirty(&INITCDR(pe), youngest);
2787 }
2788 } else {
2789 /* Non-collectable key means that the value determines
2790 `youngest`: */
2791 relocate_dirty(&INITCDR(pe), youngest);
2792 }
2793
2794 FLUSH_REMOTE(tgc, pe);
2795
2796 POP_BACKREFERENCE()
2797
2798 return youngest;
2799 }
2800
finish_pending_ephemerons(thread_gc * tgc,seginfo * si)2801 static void finish_pending_ephemerons(thread_gc *tgc, seginfo *si) {
2802 /* Any ephemeron still in a trigger list is an ephemeron
2803 whose key was not reached. */
2804 if (tgc->pending_ephemerons != 0)
2805 S_error_abort("clear_trigger_ephemerons(gc): non-empty pending list");
2806
2807 for (; si != NULL; si = si->next) {
2808 if (si->trigger_ephemerons) {
2809 ptr pe, next_pe;
2810 for (pe = si->trigger_ephemerons; pe != 0; pe = next_pe) {
2811 INITCAR(pe) = Sbwp_object;
2812 INITCDR(pe) = Sbwp_object;
2813 next_pe = EPHEMERONNEXT(pe);
2814 EPHEMERONPREVREF(pe) = 0;
2815 EPHEMERONNEXT(pe) = 0;
2816 }
2817 si->trigger_ephemerons = 0;
2818 }
2819 }
2820 }
2821
2822 #ifdef ENABLE_OBJECT_COUNTS
total_size_so_far()2823 static uptr total_size_so_far() {
2824 IGEN g;
2825 int i;
2826 uptr total = 0;
2827
2828 for (g = 0; g <= static_generation; g += 1) {
2829 for (i = 0; i < countof_types; i += 1) {
2830 uptr bytes;
2831 bytes = S_G.bytesof[g][i];
2832 if (bytes == 0) bytes = S_G.countof[g][i] * S_G.countof_size[i];
2833 total += bytes;
2834 }
2835 }
2836
2837 return total - count_root_bytes;
2838 }
2839 #endif
2840
target_generation_space_so_far(thread_gc * tgc)2841 static uptr target_generation_space_so_far(thread_gc *tgc) {
2842 IGEN g;
2843 ISPC s;
2844 uptr sz = 0;
2845
2846 for (g = MIN_TG; g <= MAX_TG; g++) {
2847 sz += S_G.bytesof[g][countof_phantom];
2848
2849 for (s = 0; s <= max_real_space; s++) {
2850 sz += S_G.bytes_of_space[g][s];
2851 if (tgc->next_loc[g][s] != FIX(0))
2852 sz += (uptr)tgc->next_loc[g][s] - (uptr)tgc->base_loc[g][s];
2853 }
2854 }
2855
2856 return sz;
2857 }
2858
copy_and_clear_list_bits(thread_gc * tgc,seginfo * oldspacesegments)2859 void copy_and_clear_list_bits(thread_gc *tgc, seginfo *oldspacesegments) {
2860 seginfo *si;
2861 int i;
2862
2863 /* Update bits that are used by `list-assuming-immutable?`. */
2864
2865 for (si = oldspacesegments; si != NULL; si = si->next) {
2866 if (si->list_bits) {
2867 if ((si->generation == 1) && !si->marked_mask) {
2868 /* drop (former) generation-0 bits, because probably the relevant pairs
2869 were short-lived, and it's ok to recompute them if needed */
2870 } else {
2871 if (si->marked_mask) {
2872 /* Besides marking or copying `si->list_bits`, clear bits
2873 where there's no corresponding mark bit, so we don't try to
2874 check forwarding in a future GC */
2875 seginfo *bits_si = SegInfo(ptr_get_segment(TO_PTR(si->list_bits)));
2876
2877 if (bits_si->old_space) {
2878 if (bits_si->use_marks) {
2879 if (!bits_si->marked_mask)
2880 init_mask(tgc, bits_si->marked_mask, bits_si->generation, 0);
2881 bits_si->marked_mask[segment_bitmap_byte(TO_PTR(si->list_bits))] |= segment_bitmap_bit(TO_PTR(si->list_bits));
2882 } else {
2883 octet *copied_bits;
2884 find_gc_room_voidp(tgc, space_data, bits_si->generation, ptr_align(segment_bitmap_bytes), copied_bits);
2885 memcpy_aligned(copied_bits, si->list_bits, segment_bitmap_bytes);
2886 si->list_bits = copied_bits;
2887 S_G.bitmask_overhead[bits_si->generation] += ptr_align(segment_bitmap_bytes);
2888 }
2889 }
2890
2891 for (i = 0; i < segment_bitmap_bytes; i++) {
2892 int m = si->marked_mask[i];
2893 si->list_bits[i] &= mask_bits_to_list_bits_mask(m);
2894 }
2895 }
2896
2897 if (si->use_marks) {
2898 /* No forwarding possible from this segment */
2899 } else {
2900 /* For forwarded pointers, copy over list bits */
2901 for (i = 0; i < segment_bitmap_bytes; i++) {
2902 if (si->list_bits[i]) {
2903 int bitpos;
2904 for (bitpos = 0; bitpos < 8; bitpos += ptr_alignment) {
2905 int bits = si->list_bits[i] & (list_bits_mask << bitpos);
2906 if (bits != 0) {
2907 ptr p = build_ptr(si->number, ((i << (log2_ptr_bytes+3)) + (bitpos << log2_ptr_bytes)));
2908 if (FWDMARKER(p) == forward_marker) {
2909 ptr new_p = FWDADDRESS(p);
2910 seginfo *new_si = SegInfo(ptr_get_segment(new_p));
2911 if (!new_si->list_bits)
2912 init_mask(tgc, new_si->list_bits, new_si->generation, 0);
2913 bits >>= bitpos;
2914 new_si->list_bits[segment_bitmap_byte(new_p)] |= segment_bitmap_bits(new_p, bits);
2915 }
2916 }
2917 }
2918 }
2919 }
2920 }
2921 }
2922 }
2923 }
2924 }
2925
2926 /* **************************************** */
2927
2928 #ifdef ENABLE_PARALLEL
2929
2930 static int sweep_mutex_initialized = 0;
2931 static s_thread_mutex_t sweep_mutex;
2932 static s_thread_cond_t sweep_cond;
2933
2934 static int num_running_sweepers;
2935
2936 static IBOOL sweeper_started(int i, IBOOL start_new);
2937 static void run_sweeper(gc_sweeper *sweeper);
2938
assign_sweeper(int n,thread_gc * t_tgc)2939 static void assign_sweeper(int n, thread_gc *t_tgc) {
2940 if (sweepers[n].last_tgc == NULL) {
2941 sweepers[n].first_tgc = t_tgc;
2942 sweepers[n].last_tgc = t_tgc;
2943 } else {
2944 sweepers[n].last_tgc->next = t_tgc;
2945 sweepers[n].last_tgc = t_tgc;
2946 }
2947 t_tgc->next = NULL;
2948 t_tgc->sweeper = n;
2949 }
2950
2951 #if defined(ENABLE_OBJECT_COUNTS)
2952 # define MAX_SWEEPERS 0
2953 #else
2954 # define MAX_SWEEPERS maximum_parallel_collect_threads
2955 #endif
2956
setup_sweepers(thread_gc * tgc)2957 static void setup_sweepers(thread_gc *tgc) {
2958 int i, n, next = 0;
2959 ptr ls;
2960
2961 assign_sweeper(main_sweeper_index, tgc);
2962
2963 /* assign a tc for each sweeper to run in parallel */
2964 for (n = 0, i = 0; (n < MAX_SWEEPERS) && (i < S_collect_waiting_threads); i++) {
2965 if ((i < MAX_SWEEPERS) && (S_collect_waiting_tcs[i] != (ptr)0)) {
2966 if (sweeper_started(n, 1)) {
2967 assign_sweeper(n, THREAD_GC(S_collect_waiting_tcs[i]));
2968 n++;
2969 } else
2970 break;
2971 }
2972 }
2973
2974 next = n;
2975
2976 /* map remaining threads to existing sweepers */
2977 for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
2978 thread_gc *t_tgc = THREAD_GC(THREADTC(Scar(ls)));
2979 t_tgc->during_alloc += 1;
2980 if ((t_tgc != tgc) && (t_tgc->sweeper == main_sweeper_index)) {
2981 if ((n < MAX_SWEEPERS) && sweeper_started(n, 0)) {
2982 assign_sweeper(n, t_tgc);
2983 n++;
2984 next = n;
2985 } else {
2986 if (next == n)
2987 next = main_sweeper_index;
2988
2989 assign_sweeper(next, t_tgc);
2990
2991 if (next == main_sweeper_index)
2992 next = 0;
2993 else
2994 next++;
2995 }
2996 }
2997 }
2998
2999 num_sweepers = n;
3000
3001 for (i = 0; i <= num_sweepers; i++) {
3002 int idx = ((i == num_sweepers) ? main_sweeper_index : i);
3003 sweepers[idx].num_swept_bytes = 0;
3004 ADJUST_COUNTER(sweepers[idx].remotes_sent = 0);
3005 ADJUST_COUNTER(sweepers[idx].remotes_received = 0);
3006 }
3007 }
3008
start_sweeper(void * _sweeper)3009 static s_thread_rv_t start_sweeper(void *_sweeper) {
3010 gc_sweeper *sweeper = _sweeper;
3011
3012 #if !defined(WRITE_XOR_EXECUTE_CODE)
3013 S_thread_start_code_write((ptr)0, static_generation, 0, NULL, 0); /* never ended */
3014 #endif
3015
3016 (void)s_thread_mutex_lock(&sweep_mutex);
3017 while (1) {
3018 while (sweeper->status != SWEEPER_SWEEPING) {
3019 s_thread_cond_wait(&sweep_cond, &sweep_mutex);
3020 }
3021 (void)s_thread_mutex_unlock(&sweep_mutex);
3022
3023 run_sweeper(sweeper);
3024
3025 (void)s_thread_mutex_lock(&sweep_mutex);
3026
3027 s_thread_cond_signal(&sweeper->done_cond);
3028 sweeper->status = SWEEPER_READY;
3029 }
3030
3031 s_thread_return;
3032 }
3033
sweeper_started(int i,IBOOL start_new)3034 static IBOOL sweeper_started(int i, IBOOL start_new) {
3035 if (!sweep_mutex_initialized) {
3036 s_thread_mutex_init(&sweep_mutex);
3037 s_thread_cond_init(&sweep_cond);
3038 s_thread_cond_init(&sweepers[main_sweeper_index].work_cond);
3039 sweep_mutex_initialized = 1;
3040 }
3041
3042 if (sweepers[i].status == SWEEPER_NONE) {
3043 int status;
3044
3045 if (!start_new)
3046 return 0;
3047
3048 sweepers[i].status = SWEEPER_READY;
3049 s_thread_cond_init(&sweepers[i].done_cond);
3050 s_thread_cond_init(&sweepers[i].work_cond);
3051
3052 if ((status = s_thread_create(start_sweeper, &sweepers[i])) != 0) {
3053 /* eror creating a thread; just go with as many as we have */
3054 sweepers[i].status = SWEEPER_NONE;
3055 s_thread_cond_destroy(&sweepers[i].done_cond);
3056 return 0;
3057 }
3058 }
3059
3060 return 1;
3061 }
3062
run_sweepers(void)3063 static void run_sweepers(void) {
3064 int i;
3065
3066 in_parallel_sweepers = 1;
3067
3068 /* start other sweepers */
3069 (void)s_thread_mutex_lock(&sweep_mutex);
3070 for (i = 0; i < num_sweepers + 1; i++) {
3071 int idx = ((i == num_sweepers) ? main_sweeper_index : i);
3072 sweepers[idx].status = SWEEPER_SWEEPING;
3073 num_running_sweepers++;
3074 }
3075 s_thread_cond_broadcast(&sweep_cond);
3076 (void)s_thread_mutex_unlock(&sweep_mutex);
3077
3078 /* sweep in the main thread */
3079 run_sweeper(&sweepers[main_sweeper_index]);
3080
3081 /* wait for other sweepers and clean up each tgc */
3082 (void)s_thread_mutex_lock(&sweep_mutex);
3083 for (i = 0; i < num_sweepers; i++) {
3084 while (sweepers[i].status != SWEEPER_READY)
3085 s_thread_cond_wait(&sweepers[i].done_cond, &sweep_mutex);
3086 }
3087 (void)s_thread_mutex_unlock(&sweep_mutex);
3088
3089 in_parallel_sweepers = 0;
3090 }
3091
teardown_sweepers(void)3092 static void teardown_sweepers(void) {
3093 thread_gc *t_tgc;
3094 int i;
3095
3096 REPORT_TIME(fprintf(stderr, "------\n"));
3097 for (i = 0; i <= num_sweepers; i++) {
3098 int idx = ((i == num_sweepers) ? main_sweeper_index : i);
3099
3100 for (t_tgc = sweepers[idx].first_tgc; t_tgc != NULL; t_tgc = t_tgc->next) {
3101 IGEN g;
3102 S_G.bitmask_overhead[0] += t_tgc->bitmask_overhead[0];
3103 t_tgc->bitmask_overhead[0] = 0;
3104 for (g = MIN_TG; g <= MAX_TG; g++) {
3105 S_G.bitmask_overhead[g] += t_tgc->bitmask_overhead[g];
3106 t_tgc->bitmask_overhead[g] = 0; /* needed to avoid double add for main_sweeper_index */
3107 }
3108 S_flush_instruction_cache(t_tgc->tc);
3109 t_tgc->sweeper = main_sweeper_index;
3110 t_tgc->queued_fire = 0;
3111 t_tgc->during_alloc -= 1;
3112 }
3113
3114 REPORT_TIME(fprintf(stderr, "%d swpr +%ld ms %ld ms %ld bytes %d sent %d received\n",
3115 MAX_CG, sweepers[idx].step, sweepers[idx].sweep_accum, sweepers[idx].num_swept_bytes,
3116 sweepers[idx].remotes_sent,
3117 sweepers[idx].remotes_received));
3118
3119 sweepers[idx].first_tgc = sweepers[idx].last_tgc = NULL;
3120 }
3121 }
3122
run_sweeper(gc_sweeper * sweeper)3123 static void run_sweeper(gc_sweeper *sweeper) {
3124 iptr num_swept_bytes = 0;
3125 thread_gc *tgc;
3126
3127 GET_CPU_TIME(start);
3128
3129 for (tgc = sweeper->first_tgc; tgc != NULL; tgc = tgc->next) {
3130 num_swept_bytes += sweep_dirty_segments(tgc, tgc->dirty_segments);
3131 num_swept_bytes += sweep_generation_pass(tgc);
3132 }
3133
3134 (void)s_thread_mutex_lock(&sweep_mutex);
3135 --num_running_sweepers;
3136 while (1) {
3137 IBOOL any_ranges = 0;
3138 for (tgc = sweeper->first_tgc; tgc != NULL; tgc = tgc->next) {
3139 if (tgc->receive_remote_sweep_stack != tgc->receive_remote_sweep_stack_start) {
3140 any_ranges = 1;
3141 break;
3142 }
3143 }
3144
3145 if ((num_running_sweepers == 0) && !any_ranges) {
3146 /* everyone is done */
3147 int i, they = main_sweeper_index;
3148 for (i = -1; i < num_sweepers; i++) {
3149 s_thread_cond_signal(&sweepers[they].work_cond);
3150 they = i + 1;
3151 }
3152 (void)s_thread_mutex_unlock(&sweep_mutex);
3153 break;
3154 } else {
3155 /* wait for work */
3156 if (any_ranges) {
3157 /* some work appeared since we last checked */
3158 num_running_sweepers++;
3159 } else {
3160 sweeper->status = SWEEPER_WAITING_FOR_WORK;
3161 s_thread_cond_wait(&sweeper->work_cond, &sweep_mutex);
3162 }
3163 if (sweeper->status != SWEEPER_WAITING_FOR_WORK) {
3164 /* got work; num_running_sweepers was incremented, too */
3165 (void)s_thread_mutex_unlock(&sweep_mutex);
3166
3167 for (tgc = sweeper->first_tgc; tgc != NULL; tgc = tgc->next) {
3168 num_swept_bytes += sweep_generation_pass(tgc);
3169 }
3170
3171 (void)s_thread_mutex_lock(&sweep_mutex);
3172 --num_running_sweepers;
3173 } else if (num_running_sweepers == 0) {
3174 /* other sweeper noticed that everyone is done */
3175 (void)s_thread_mutex_unlock(&sweep_mutex);
3176 break;
3177 } else {
3178 /* not clear why we were awoken, so just go around again */
3179 }
3180 }
3181 }
3182
3183 ACCUM_CPU_TIME(sweeper->sweep_accum, step, start);
3184 ADJUST_COUNTER(sweeper->step = step);
3185
3186 sweeper->num_swept_bytes += num_swept_bytes;
3187 }
3188
send_and_receive_remote_sweeps(thread_gc * tgc)3189 static void send_and_receive_remote_sweeps(thread_gc *tgc) {
3190 (void)s_thread_mutex_lock(&sweep_mutex);
3191
3192 /* Send objects to remote sweepers */
3193 while (tgc->send_remote_sweep_stack > tgc->send_remote_sweep_stack_start) {
3194 thread_gc *r_tgc;
3195 ptr p;
3196
3197 tgc->send_remote_sweep_stack = (ptr)((uptr)tgc->send_remote_sweep_stack - (2 * ptr_bytes));
3198 p = ((ptr *)TO_VOIDP(tgc->send_remote_sweep_stack))[0];
3199 r_tgc = TO_VOIDP(((ptr *)TO_VOIDP(tgc->send_remote_sweep_stack))[1]);
3200
3201 if (r_tgc->receive_remote_sweep_stack == r_tgc->receive_remote_sweep_stack_limit)
3202 enlarge_stack(tgc,
3203 &r_tgc->receive_remote_sweep_stack,
3204 &r_tgc->receive_remote_sweep_stack_start,
3205 &r_tgc->receive_remote_sweep_stack_limit,
3206 ptr_bytes);
3207
3208 *(ptr *)TO_VOIDP(r_tgc->receive_remote_sweep_stack) = p;
3209 r_tgc->receive_remote_sweep_stack = (ptr)((uptr)r_tgc->receive_remote_sweep_stack + ptr_bytes);
3210
3211 if (sweepers[r_tgc->sweeper].status == SWEEPER_WAITING_FOR_WORK) {
3212 num_running_sweepers++;
3213 sweepers[r_tgc->sweeper].status = SWEEPER_SWEEPING;
3214 s_thread_cond_signal(&sweepers[r_tgc->sweeper].work_cond);
3215 }
3216
3217 ADJUST_COUNTER(sweepers[tgc->sweeper].remotes_sent++);
3218 }
3219
3220 /* Received objects from remote sweepers, moving to sweep stack: */
3221 if (tgc->receive_remote_sweep_stack != tgc->receive_remote_sweep_stack_start) {
3222 iptr len = (uptr)tgc->receive_remote_sweep_stack - (uptr)tgc->receive_remote_sweep_stack_start;
3223
3224 tgc->sweep_change = SWEEP_CHANGE_PROGRESS;
3225
3226 if (((uptr)tgc->sweep_stack + len) > (uptr)tgc->sweep_stack_limit)
3227 enlarge_stack(tgc, &tgc->sweep_stack, &tgc->sweep_stack_start, &tgc->sweep_stack_limit, len);
3228
3229 memcpy(tgc->sweep_stack, tgc->receive_remote_sweep_stack_start, len);
3230 tgc->sweep_stack = (ptr)((uptr)tgc->sweep_stack + len);
3231 if ((uptr)tgc->sweep_stack > (uptr)tgc->sweep_stack_limit)
3232 abort();
3233 tgc->receive_remote_sweep_stack = tgc->receive_remote_sweep_stack_start;
3234
3235 ADJUST_COUNTER(sweepers[tgc->sweeper].remotes_received += (len / ptr_bytes));
3236 }
3237
3238 (void)s_thread_mutex_unlock(&sweep_mutex);
3239 }
3240
3241 #endif
3242
3243 /* **************************************** */
3244
3245 #ifdef ENABLE_MEASURE
3246
init_measure(thread_gc * tgc,IGEN min_gen,IGEN max_gen)3247 static void init_measure(thread_gc *tgc, IGEN min_gen, IGEN max_gen) {
3248 uptr init_stack_len = 1024;
3249
3250 min_measure_generation = min_gen;
3251 max_measure_generation = max_gen;
3252
3253 find_gc_room_voidp(tgc, space_data, 0, ptr_align(init_stack_len), measure_stack_start);
3254 S_G.bitmask_overhead[0] += ptr_align(init_stack_len);
3255 measure_stack = TO_VOIDP(measure_stack_start);
3256 measure_stack_limit = TO_VOIDP((uptr)TO_PTR(measure_stack_start) + init_stack_len);
3257
3258 measured_seginfos = Snil;
3259
3260 measure_all_enabled = 1;
3261 }
3262
finish_measure()3263 static void finish_measure() {
3264 ptr ls;
3265
3266 for (ls = measured_seginfos; ls != Snil; ls = Scdr(ls)) {
3267 ptr pe, next_pe;
3268 seginfo *si = TO_VOIDP(Scar(ls));
3269 si->measured_mask = NULL;
3270 for (pe = si->trigger_ephemerons; pe != 0; pe = next_pe) {
3271 next_pe = EPHEMERONNEXT(pe);
3272 EPHEMERONPREVREF(pe) = 0;
3273 EPHEMERONNEXT(pe) = 0;
3274 }
3275 si->trigger_ephemerons = 0;
3276 }
3277
3278 measure_all_enabled = 0;
3279 }
3280
init_counting_mask(thread_gc * tgc,seginfo * si)3281 static void init_counting_mask(thread_gc *tgc, seginfo *si) {
3282 init_mask(tgc, si->counting_mask, 0, 0);
3283 }
3284
init_measure_mask(thread_gc * tgc,seginfo * si)3285 static void init_measure_mask(thread_gc *tgc, seginfo *si) {
3286 init_mask(tgc, si->measured_mask, 0, 0);
3287 measured_seginfos = S_cons_in(tgc->tc, space_new, 0, TO_PTR(si), measured_seginfos);
3288 }
3289
3290 #define measure_unreached(si, p) \
3291 (!si->measured_mask \
3292 || !(si->measured_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p)))
3293
3294 #define measure_mask_set(mm, si, p) \
3295 mm[segment_bitmap_byte(p)] |= segment_bitmap_bit(p)
3296 #define measure_mask_unset(mm, si, p) \
3297 mm[segment_bitmap_byte(p)] -= segment_bitmap_bit(p)
3298
push_measure(thread_gc * tgc,ptr p)3299 static void push_measure(thread_gc *tgc, ptr p)
3300 {
3301 seginfo *si = MaybeSegInfo(ptr_get_segment(p));
3302
3303 if (!si)
3304 return;
3305
3306 if (si->old_space) {
3307 /* We must be in a GC--measure fusion, so switch back to GC */
3308 FLUSH_REMOTE_BLOCK
3309 BLOCK_SET_THREAD(si->creator);
3310 relocate_pure_help_help(&p, p, si);
3311 ASSERT_EMPTY_FLUSH_REMOTE();
3312 return;
3313 }
3314
3315 if (si->generation > max_measure_generation)
3316 return;
3317 else if (si->generation < min_measure_generation) {
3318 /* this only happens in fusion mode, too; si must be a new segment */
3319 return;
3320 } else {
3321 uptr byte = segment_bitmap_byte(p);
3322 uptr bit = segment_bitmap_bit(p);
3323
3324 if (!si->measured_mask)
3325 init_measure_mask(tgc, si);
3326 else if (si->measured_mask[byte] & bit)
3327 return;
3328
3329 si->measured_mask[byte] |= bit;
3330 }
3331
3332 if (si->trigger_ephemerons) {
3333 add_trigger_ephemerons_to_pending_measure(si->trigger_ephemerons);
3334 si->trigger_ephemerons = 0;
3335 }
3336
3337 if (measure_stack == measure_stack_limit) {
3338 uptr sz = ptr_bytes * (measure_stack_limit - measure_stack_start);
3339 uptr new_sz = 2*sz;
3340 ptr *new_measure_stack;
3341 find_gc_room_voidp(tgc, space_data, 0, ptr_align(new_sz), new_measure_stack);
3342 S_G.bitmask_overhead[0] += ptr_align(new_sz);
3343 memcpy(new_measure_stack, measure_stack_start, sz);
3344 measure_stack_start = new_measure_stack;
3345 measure_stack_limit = TO_VOIDP((uptr)TO_PTR(new_measure_stack) + new_sz);
3346 measure_stack = TO_VOIDP((uptr)TO_PTR(new_measure_stack) + sz);
3347 }
3348
3349 *(measure_stack++) = p;
3350 }
3351
measure_add_stack_size(ptr stack,uptr size)3352 static void measure_add_stack_size(ptr stack, uptr size) {
3353 seginfo *si = SegInfo(ptr_get_segment(stack));
3354 if (!(si->old_space)
3355 && (si->generation <= max_measure_generation)
3356 && (si->generation >= min_measure_generation))
3357 measure_total += size;
3358 }
3359
add_ephemeron_to_pending_measure(thread_gc * tgc,ptr pe)3360 static void add_ephemeron_to_pending_measure(thread_gc *tgc, ptr pe) {
3361 /* If we're in hybrid mode and the key in `pe` is in the
3362 old space, then we need to use the regular pending list
3363 instead of the measure-specific one */
3364 seginfo *si;
3365 ptr p = Scar(pe);
3366
3367 if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space)
3368 add_ephemeron_to_pending(tgc, pe);
3369 else {
3370 if (EPHEMERONPREVREF(pe))
3371 S_error_abort("add_ephemeron_to_pending_measure: ephemeron is in some list");
3372 ephemeron_add(&pending_measure_ephemerons, pe);
3373 }
3374 }
3375
add_trigger_ephemerons_to_pending_measure(ptr pe)3376 static void add_trigger_ephemerons_to_pending_measure(ptr pe) {
3377 ephemeron_add(&pending_measure_ephemerons, pe);
3378 }
3379
check_ephemeron_measure(thread_gc * tgc,ptr pe)3380 static void check_ephemeron_measure(thread_gc *tgc, ptr pe) {
3381 ptr p;
3382 seginfo *si;
3383
3384 EPHEMERONPREVREF(pe) = 0;
3385 EPHEMERONNEXT(pe) = 0;
3386
3387 p = Scar(pe);
3388 if (!FIXMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL
3389 && (si->generation <= max_measure_generation)
3390 && (si->generation >= min_measure_generation)
3391 && (!(si->old_space) || !FORWARDEDP(p, si))
3392 && (measure_unreached(si, p)
3393 || (si->counting_mask
3394 && (si->counting_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p))))) {
3395 /* Not reached, so far; install as trigger */
3396 ephemeron_add(&si->trigger_ephemerons, pe);
3397 if (!si->measured_mask)
3398 init_measure_mask(tgc, si); /* so triggers are cleared at end */
3399 return;
3400 }
3401
3402 p = Scdr(pe);
3403 if (!FIXMEDIATE(p))
3404 push_measure(tgc, p);
3405 }
3406
check_pending_measure_ephemerons(thread_gc * tgc)3407 static void check_pending_measure_ephemerons(thread_gc *tgc) {
3408 ptr pe, next_pe;
3409
3410 pe = pending_measure_ephemerons;
3411 pending_measure_ephemerons = 0;
3412 while (pe != 0) {
3413 next_pe = EPHEMERONNEXT(pe);
3414 check_ephemeron_measure(tgc, pe);
3415 pe = next_pe;
3416 }
3417 }
3418
gc_measure_one(thread_gc * tgc,ptr p)3419 void gc_measure_one(thread_gc *tgc, ptr p) {
3420 seginfo *si = SegInfo(ptr_get_segment(p));
3421
3422 if (si->trigger_ephemerons) {
3423 add_trigger_ephemerons_to_pending_measure(si->trigger_ephemerons);
3424 si->trigger_ephemerons = 0;
3425 }
3426
3427 measure(tgc, p);
3428
3429 flush_measure_stack(tgc);
3430 }
3431
flush_measure_stack(thread_gc * tgc)3432 void flush_measure_stack(thread_gc *tgc) {
3433 if ((measure_stack <= measure_stack_start)
3434 && !pending_measure_ephemerons)
3435 return;
3436
3437 tgc->sweep_change = SWEEP_CHANGE_PROGRESS;
3438
3439 while (1) {
3440 while (measure_stack > measure_stack_start)
3441 measure(tgc, *(--measure_stack));
3442
3443 if (!pending_measure_ephemerons)
3444 break;
3445 check_pending_measure_ephemerons(tgc);
3446 }
3447 }
3448
S_count_size_increments(ptr ls,IGEN generation)3449 ptr S_count_size_increments(ptr ls, IGEN generation) {
3450 ptr l, totals = Snil, totals_prev = 0;
3451 ptr tc = get_thread_context();
3452 thread_gc *tgc = THREAD_GC(tc);
3453
3454 tc_mutex_acquire();
3455
3456 init_measure(tgc, 0, generation);
3457
3458 for (l = ls; l != Snil; l = Scdr(l)) {
3459 ptr p = Scar(l);
3460 if (!FIXMEDIATE(p)) {
3461 seginfo *si = SegInfo(ptr_get_segment(p));
3462
3463 if (!si->measured_mask)
3464 init_measure_mask(tgc, si);
3465 measure_mask_set(si->measured_mask, si, p);
3466
3467 if (!si->counting_mask)
3468 init_counting_mask(tgc, si);
3469 measure_mask_set(si->counting_mask, si, p);
3470 }
3471 }
3472
3473 for (l = ls; l != Snil; l = Scdr(l)) {
3474 ptr p = Scar(l);
3475
3476 measure_total = 0;
3477
3478 if (!FIXMEDIATE(p)) {
3479 seginfo *si = SegInfo(ptr_get_segment(p));
3480 measure_mask_unset(si->counting_mask, si, p);
3481 gc_measure_one(tgc, p);
3482 }
3483
3484 p = Scons(FIX(measure_total), Snil);
3485 if (totals_prev)
3486 Scdr(totals_prev) = p;
3487 else
3488 totals = p;
3489 totals_prev = p;
3490 }
3491
3492 for (l = ls; l != Snil; l = Scdr(l)) {
3493 ptr p = Scar(l);
3494 if (!FIXMEDIATE(p)) {
3495 seginfo *si = SegInfo(ptr_get_segment(p));
3496 si->counting_mask = NULL;
3497 }
3498 }
3499
3500 finish_measure();
3501
3502 tc_mutex_release();
3503
3504 return totals;
3505 }
3506
3507 #endif
3508