2 * GENerational Conservative Garbage Collector for SBCL
6 * This software is part of the SBCL system. See the README file for
9 * This software is derived from the CMU CL system, which was
10 * written at Carnegie Mellon University and released into the
11 * public domain. The software is in the public domain and is
12 * provided with absolutely no warranty. See the COPYING and CREDITS
13 * files for more information.
17 * For a review of garbage collection techniques (e.g. generational
18 * GC) and terminology (e.g. "scavenging") see Paul R. Wilson,
19 * "Uniprocessor Garbage Collection Techniques". As of 20000618, this
20 * had been accepted for _ACM Computing Surveys_ and was available
21 * as a PostScript preprint through
22 * <http://www.cs.utexas.edu/users/oops/papers.html>
24 * <ftp://ftp.cs.utexas.edu/pub/garbage/bigsurv.ps>.
33 #if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)
34 #include "pthreads_win32.h"
42 #include "interrupt.h"
47 #include "gc-internal.h"
49 #include "pseudo-atomic.h"
51 #include "genesis/gc-tables.h"
52 #include "genesis/vector.h"
53 #include "genesis/weak-pointer.h"
54 #include "genesis/fdefn.h"
55 #include "genesis/simple-fun.h"
57 #include "genesis/hash-table.h"
58 #include "genesis/instance.h"
59 #include "genesis/layout.h"
61 #include "hopscotch.h"
62 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
63 #include "genesis/cons.h"
65 #include "forwarding-ptr.h"
67 /* forward declarations */
68 page_index_t
gc_find_freeish_pages(page_index_t
*restart_page_ptr
, sword_t nbytes
,
76 /* As usually configured, generations 0-5 are normal collected generations,
77 6 is pseudo-static (the objects in which are never moved nor reclaimed),
78 and 7 is scratch space used when collecting a generation without promotion,
79 wherein it is moved to generation 7 and back again.
82 SCRATCH_GENERATION
= PSEUDO_STATIC_GENERATION
+1,
86 /* Should we use page protection to help avoid the scavenging of pages
87 * that don't have pointers to younger generations? */
88 boolean enable_page_protection
= 1;
90 /* Largest allocation seen since last GC. */
91 os_vm_size_t large_allocation
= 0;
98 /* the verbosity level. All non-error messages are disabled at level 0;
99 * and only a few rare messages are printed at level 1. */
101 boolean gencgc_verbose
= 1;
103 boolean gencgc_verbose
= 0;
106 /* FIXME: At some point enable the various error-checking things below
107 * and see what they say. */
109 /* We hunt for pointers to old-space, when GCing generations >= verify_gen.
110 * Set verify_gens to HIGHEST_NORMAL_GENERATION + 1 to disable this kind of
112 generation_index_t verify_gens
= HIGHEST_NORMAL_GENERATION
+ 1;
114 /* Should we do a pre-scan verify of generation 0 before it's GCed? */
115 boolean pre_verify_gen_0
= 0;
117 #ifdef LISP_FEATURE_X86
118 /* Should we check code objects for fixup errors after they are transported? */
119 boolean check_code_fixups
= 0;
122 /* Should we check that newly allocated regions are zero filled? */
123 boolean gencgc_zero_check
= 0;
125 /* Should we check that the free space is zero filled? */
126 boolean gencgc_enable_verify_zero_fill
= 0;
128 /* When loading a core, don't do a full scan of the memory for the
129 * memory region boundaries. (Set to true by coreparse.c if the core
130 * contained a pagetable entry).
132 boolean gencgc_partial_pickup
= 0;
134 /* If defined, free pages are read-protected to ensure that nothing
138 /* #define READ_PROTECT_FREE_PAGES */
142 * GC structures and variables
145 /* the total bytes allocated. These are seen by Lisp DYNAMIC-USAGE. */
146 os_vm_size_t bytes_allocated
= 0;
147 os_vm_size_t auto_gc_trigger
= 0;
149 /* the source and destination generations. These are set before a GC starts
151 generation_index_t from_space
;
152 generation_index_t new_space
;
154 /* Set to 1 when in GC */
155 boolean gc_active_p
= 0;
157 /* should the GC be conservative on stack. If false (only right before
158 * saving a core), don't scan the stack / mark pages dont_move. */
159 static boolean conservative_stack
= 1;
161 /* An array of page structures is allocated on gc initialization.
162 * This helps to quickly map between an address and its page structure.
163 * page_table_pages is set from the size of the dynamic space. */
164 page_index_t page_table_pages
;
165 struct page
*page_table
;
166 #ifndef GENCGC_IS_PRECISE
167 struct hopscotch_table pinned_objects
;
168 lispobj gc_object_watcher
;
169 int gc_traceroot_criterion
;
173 /* In GC cards that have conservative pointers to them, should we wipe out
174 * dwords in there that are not used, so that they do not act as false
175 * root to other things in the heap from then on? This is a new feature
176 * but in testing it is both reliable and no noticeable slowdown. */
179 /// Constants defined in gc-internal:
180 /// #define BOXED_PAGE_FLAG 1
181 /// #define UNBOXED_PAGE_FLAG 2
182 /// #define OPEN_REGION_PAGE_FLAG 4
184 /// Return true if 'allocated' bits are: {001, 010, 011}, false if 1zz or 000.
185 static inline boolean
page_allocated_no_region_p(page_index_t page
) {
186 return (page_table
[page
].allocated
^ OPEN_REGION_PAGE_FLAG
) > OPEN_REGION_PAGE_FLAG
;
189 static inline boolean
page_free_p(page_index_t page
) {
190 return (page_table
[page
].allocated
== FREE_PAGE_FLAG
);
193 static inline boolean
page_boxed_p(page_index_t page
) {
194 return (page_table
[page
].allocated
& BOXED_PAGE_FLAG
);
197 /// Return true if 'allocated' bits are: {001, 011}, false otherwise.
198 /// i.e. true of pages which could hold boxed or partially boxed objects.
199 static inline boolean
page_boxed_no_region_p(page_index_t page
) {
200 return (page_table
[page
].allocated
& 5) == BOXED_PAGE_FLAG
;
203 /// Return true if page MUST NOT hold boxed objects (including code).
204 static inline boolean
page_unboxed_p(page_index_t page
) {
205 /* Both flags set == boxed code page */
206 return (page_table
[page
].allocated
& 3) == UNBOXED_PAGE_FLAG
;
209 static inline boolean
protect_page_p(page_index_t page
, generation_index_t generation
) {
210 return (page_boxed_no_region_p(page
)
211 && (page_bytes_used(page
) != 0)
212 && !page_table
[page
].dont_move
213 && (page_table
[page
].gen
== generation
));
216 /* Calculate the start address for the given page number. */
218 page_address(page_index_t page_num
)
220 return (void*)(DYNAMIC_SPACE_START
+ (page_num
* GENCGC_CARD_BYTES
));
223 /* Calculate the address where the allocation region associated with
224 * the page starts. */
226 page_scan_start(page_index_t page_index
)
228 return page_address(page_index
)-page_scan_start_offset(page_index
);
231 /* True if the page starts a contiguous block. */
232 static inline boolean
233 page_starts_contiguous_block_p(page_index_t page_index
)
235 // Don't use the preprocessor macro: 0 means 0.
236 return page_table
[page_index
].scan_start_offset_
== 0;
239 /* True if the page is the last page in a contiguous block. */
240 static inline boolean
241 page_ends_contiguous_block_p(page_index_t page_index
, generation_index_t gen
)
243 return (/* page doesn't fill block */
244 (page_bytes_used(page_index
) < GENCGC_CARD_BYTES
)
245 /* page is last allocated page */
246 || ((page_index
+ 1) >= last_free_page
)
248 || page_free_p(page_index
+ 1)
249 /* next page contains no data */
250 || (page_bytes_used(page_index
+ 1) == 0)
251 /* next page is in different generation */
252 || (page_table
[page_index
+ 1].gen
!= gen
)
253 /* next page starts its own contiguous block */
254 || (page_starts_contiguous_block_p(page_index
+ 1)));
257 /// External function for calling from Lisp.
258 page_index_t
ext_find_page_index(void *addr
) { return find_page_index(addr
); }
261 npage_bytes(page_index_t npages
)
263 gc_assert(npages
>=0);
264 return ((os_vm_size_t
)npages
)*GENCGC_CARD_BYTES
;
267 /* Check that X is a higher address than Y and return offset from Y to
269 static inline os_vm_size_t
270 addr_diff(void *x
, void *y
)
273 return (uintptr_t)x
- (uintptr_t)y
;
276 /* a structure to hold the state of a generation
278 * CAUTION: If you modify this, make sure to touch up the alien
279 * definition in src/code/gc.lisp accordingly. ...or better yes,
280 * deal with the FIXME there...
284 #ifdef LISP_FEATURE_SEGREGATED_CODE
285 // A distinct start page per nonzero value of 'page_type_flag'.
286 // The zeroth index is the large object start page.
287 page_index_t alloc_start_page_
[4];
288 #define alloc_large_start_page alloc_start_page_[0]
289 #define alloc_start_page alloc_start_page_[BOXED_PAGE_FLAG]
290 #define alloc_unboxed_start_page alloc_start_page_[UNBOXED_PAGE_FLAG]
292 /* the first page that gc_alloc() checks on its next call */
293 page_index_t alloc_start_page
;
295 /* the first page that gc_alloc_unboxed() checks on its next call */
296 page_index_t alloc_unboxed_start_page
;
298 /* the first page that gc_alloc_large (boxed) considers on its next
299 * call. (Although it always allocates after the boxed_region.) */
300 page_index_t alloc_large_start_page
;
303 /* the bytes allocated to this generation */
304 os_vm_size_t bytes_allocated
;
306 /* the number of bytes at which to trigger a GC */
307 os_vm_size_t gc_trigger
;
309 /* to calculate a new level for gc_trigger */
310 os_vm_size_t bytes_consed_between_gc
;
312 /* the number of GCs since the last raise */
315 /* the number of GCs to run on the generations before raising objects to the
317 int number_of_gcs_before_promotion
;
319 /* the cumulative sum of the bytes allocated to this generation. It is
320 * cleared after a GC on this generations, and update before new
321 * objects are added from a GC of a younger generation. Dividing by
322 * the bytes_allocated will give the average age of the memory in
323 * this generation since its last GC. */
324 os_vm_size_t cum_sum_bytes_allocated
;
326 /* a minimum average memory age before a GC will occur helps
327 * prevent a GC when a large number of new live objects have been
328 * added, in which case a GC could be a waste of time */
329 double minimum_age_before_gc
;
332 /* an array of generation structures. There needs to be one more
333 * generation structure than actual generations as the oldest
334 * generation is temporarily raised then lowered. */
335 struct generation generations
[NUM_GENERATIONS
];
337 /* the oldest generation that is will currently be GCed by default.
338 * Valid values are: 0, 1, ... HIGHEST_NORMAL_GENERATION
340 * The default of HIGHEST_NORMAL_GENERATION enables GC on all generations.
342 * Setting this to 0 effectively disables the generational nature of
343 * the GC. In some applications generational GC may not be useful
344 * because there are no long-lived objects.
346 * An intermediate value could be handy after moving long-lived data
347 * into an older generation so an unnecessary GC of this long-lived
348 * data can be avoided. */
349 generation_index_t gencgc_oldest_gen_to_gc
= HIGHEST_NORMAL_GENERATION
;
351 /* META: Is nobody aside from me bothered by this especially misleading
352 * use of the word "last"? It could mean either "ultimate" or "prior",
353 * but in fact means neither. It is the *FIRST* page that should be grabbed
354 * for more space, so it is min free page, or 1+ the max used page. */
355 /* The maximum free page in the heap is maintained and used to update
356 * ALLOCATION_POINTER which is used by the room function to limit its
357 * search of the heap. XX Gencgc obviously needs to be better
358 * integrated with the Lisp code. */
360 page_index_t last_free_page
;
362 #ifdef LISP_FEATURE_SB_THREAD
363 /* This lock is to prevent multiple threads from simultaneously
364 * allocating new regions which overlap each other. Note that the
365 * majority of GC is single-threaded, but alloc() may be called from
366 * >1 thread at a time and must be thread-safe. This lock must be
367 * seized before all accesses to generations[] or to parts of
368 * page_table[] that other threads may want to see */
369 static pthread_mutex_t free_pages_lock
= PTHREAD_MUTEX_INITIALIZER
;
370 /* This lock is used to protect non-thread-local allocation. */
371 static pthread_mutex_t allocation_lock
= PTHREAD_MUTEX_INITIALIZER
;
374 extern os_vm_size_t gencgc_release_granularity
;
375 os_vm_size_t gencgc_release_granularity
= GENCGC_RELEASE_GRANULARITY
;
377 extern os_vm_size_t gencgc_alloc_granularity
;
378 os_vm_size_t gencgc_alloc_granularity
= GENCGC_ALLOC_GRANULARITY
;
382 * miscellaneous heap functions
385 /* Count the number of pages which are write-protected within the
386 * given generation. */
388 count_write_protect_generation_pages(generation_index_t generation
)
390 page_index_t i
, count
= 0;
392 for (i
= 0; i
< last_free_page
; i
++)
394 && (page_table
[i
].gen
== generation
)
395 && (page_table
[i
].write_protected
== 1))
400 /* Count the number of pages within the given generation. */
402 count_generation_pages(generation_index_t generation
)
405 page_index_t count
= 0;
407 for (i
= 0; i
< last_free_page
; i
++)
409 && (page_table
[i
].gen
== generation
))
416 count_dont_move_pages(void)
419 page_index_t count
= 0;
420 for (i
= 0; i
< last_free_page
; i
++) {
422 && (page_table
[i
].dont_move
!= 0)) {
430 /* Work through the pages and add up the number of bytes used for the
431 * given generation. */
432 static __attribute__((unused
)) os_vm_size_t
433 count_generation_bytes_allocated (generation_index_t gen
)
436 os_vm_size_t result
= 0;
437 for (i
= 0; i
< last_free_page
; i
++) {
439 && (page_table
[i
].gen
== gen
))
440 result
+= page_bytes_used(i
);
445 /* Return the average age of the memory in a generation. */
447 generation_average_age(generation_index_t gen
)
449 if (generations
[gen
].bytes_allocated
== 0)
453 ((double)generations
[gen
].cum_sum_bytes_allocated
)
454 / ((double)generations
[gen
].bytes_allocated
);
457 #ifdef LISP_FEATURE_X86
458 extern void fpu_save(void *);
459 extern void fpu_restore(void *);
462 #define PAGE_INDEX_FMT PRIdPTR
465 write_generation_stats(FILE *file
)
467 generation_index_t i
;
469 #ifdef LISP_FEATURE_X86
472 /* Can end up here after calling alloc_tramp which doesn't prepare
473 * the x87 state, and the C ABI uses a different mode */
477 /* Print the heap stats. */
479 " Gen StaPg UbSta LaSta Boxed Unbox LB LUB !move Alloc Waste Trig WP GCs Mem-age\n");
481 for (i
= 0; i
<= SCRATCH_GENERATION
; i
++) {
483 page_index_t boxed_cnt
= 0;
484 page_index_t unboxed_cnt
= 0;
485 page_index_t large_boxed_cnt
= 0;
486 page_index_t large_unboxed_cnt
= 0;
487 page_index_t pinned_cnt
=0;
489 for (j
= 0; j
< last_free_page
; j
++)
490 if (page_table
[j
].gen
== i
) {
492 /* Count the number of boxed pages within the given
494 if (page_boxed_p(j
)) {
495 if (page_table
[j
].large_object
)
500 if(page_table
[j
].dont_move
) pinned_cnt
++;
501 /* Count the number of unboxed pages within the given
503 if (page_unboxed_p(j
)) {
504 if (page_table
[j
].large_object
)
511 gc_assert(generations
[i
].bytes_allocated
512 == count_generation_bytes_allocated(i
));
514 " %1d: %5ld %5ld %5ld",
516 (long)generations
[i
].alloc_start_page
,
517 (long)generations
[i
].alloc_unboxed_start_page
,
518 (long)generations
[i
].alloc_large_start_page
);
520 " %5"PAGE_INDEX_FMT
" %5"PAGE_INDEX_FMT
" %5"PAGE_INDEX_FMT
521 " %5"PAGE_INDEX_FMT
" %5"PAGE_INDEX_FMT
,
522 boxed_cnt
, unboxed_cnt
, large_boxed_cnt
,
523 large_unboxed_cnt
, pinned_cnt
);
528 " %4"PAGE_INDEX_FMT
" %3d %7.4f\n",
529 generations
[i
].bytes_allocated
,
530 (npage_bytes(count_generation_pages(i
)) - generations
[i
].bytes_allocated
),
531 generations
[i
].gc_trigger
,
532 count_write_protect_generation_pages(i
),
533 generations
[i
].num_gc
,
534 generation_average_age(i
));
536 fprintf(file
," Total bytes allocated = %"OS_VM_SIZE_FMT
"\n", bytes_allocated
);
537 fprintf(file
," Dynamic-space-size bytes = %"OS_VM_SIZE_FMT
"\n", dynamic_space_size
);
539 #ifdef LISP_FEATURE_X86
540 fpu_restore(fpu_state
);
545 write_heap_exhaustion_report(FILE *file
, long available
, long requested
,
546 struct thread
*thread
)
549 "Heap exhausted during %s: %ld bytes available, %ld requested.\n",
550 gc_active_p
? "garbage collection" : "allocation",
553 write_generation_stats(file
);
554 fprintf(file
, "GC control variables:\n");
555 fprintf(file
, " *GC-INHIBIT* = %s\n *GC-PENDING* = %s\n",
556 SymbolValue(GC_INHIBIT
,thread
)==NIL
? "false" : "true",
557 (SymbolValue(GC_PENDING
, thread
) == T
) ?
558 "true" : ((SymbolValue(GC_PENDING
, thread
) == NIL
) ?
559 "false" : "in progress"));
560 #ifdef LISP_FEATURE_SB_THREAD
561 fprintf(file
, " *STOP-FOR-GC-PENDING* = %s\n",
562 SymbolValue(STOP_FOR_GC_PENDING
,thread
)==NIL
? "false" : "true");
567 print_generation_stats(void)
569 write_generation_stats(stderr
);
572 extern char* gc_logfile
;
573 char * gc_logfile
= NULL
;
576 log_generation_stats(char *logfile
, char *header
)
579 FILE * log
= fopen(logfile
, "a");
581 fprintf(log
, "%s\n", header
);
582 write_generation_stats(log
);
585 fprintf(stderr
, "Could not open gc logfile: %s\n", logfile
);
592 report_heap_exhaustion(long available
, long requested
, struct thread
*th
)
595 FILE * log
= fopen(gc_logfile
, "a");
597 write_heap_exhaustion_report(log
, available
, requested
, th
);
600 fprintf(stderr
, "Could not open gc logfile: %s\n", gc_logfile
);
604 /* Always to stderr as well. */
605 write_heap_exhaustion_report(stderr
, available
, requested
, th
);
609 #if defined(LISP_FEATURE_X86)
610 void fast_bzero(void*, size_t); /* in <arch>-assem.S */
613 /* Zero the pages from START to END (inclusive), but use mmap/munmap instead
614 * if zeroing it ourselves, i.e. in practice give the memory back to the
615 * OS. Generally done after a large GC.
617 void zero_pages_with_mmap(page_index_t start
, page_index_t end
) {
619 void *addr
= page_address(start
), *new_addr
;
620 os_vm_size_t length
= npage_bytes(1+end
-start
);
625 gc_assert(length
>= gencgc_release_granularity
);
626 gc_assert((length
% gencgc_release_granularity
) == 0);
628 #ifdef LISP_FEATURE_LINUX
629 extern os_vm_address_t anon_dynamic_space_start
;
630 // We use MADV_DONTNEED only on Linux due to differing semantics from BSD.
631 // Linux treats it as a demand that the memory be 0-filled, or refreshed
632 // from a file that backs the range. BSD takes it as a hint that you don't
633 // care if the memory has to brought in from swap when next accessed,
634 // i.e. it's not a request to make a user-visible alteration to memory.
635 // So in theory this can bring a page in from the core file, if we happen
636 // to hit a page that resides in the portion of memory mapped by coreparse.
637 // In practice this should not happen because objects from a core file can't
638 // become garbage. Except in save-lisp-and-die they can, and we must be
639 // cautious not to resurrect bytes that originally came from the file.
640 if ((os_vm_address_t
)addr
>= anon_dynamic_space_start
) {
641 if (madvise(addr
, length
, MADV_DONTNEED
) != 0)
642 lose("madvise failed\n");
646 os_invalidate(addr
, length
);
647 new_addr
= os_validate(addr
, length
);
648 if (new_addr
== NULL
|| new_addr
!= addr
) {
649 lose("remap_free_pages: page moved, 0x%08x ==> 0x%08x",
654 for (i
= start
; i
<= end
; i
++)
655 set_page_need_to_zero(i
, 0);
658 /* Zero the pages from START to END (inclusive). Generally done just after
659 * a new region has been allocated.
662 zero_pages(page_index_t start
, page_index_t end
) {
666 #if defined(LISP_FEATURE_X86)
667 fast_bzero(page_address(start
), npage_bytes(1+end
-start
));
669 bzero(page_address(start
), npage_bytes(1+end
-start
));
675 zero_and_mark_pages(page_index_t start
, page_index_t end
) {
678 zero_pages(start
, end
);
679 for (i
= start
; i
<= end
; i
++)
680 set_page_need_to_zero(i
, 0);
683 /* Zero the pages from START to END (inclusive), except for those
684 * pages that are known to already zeroed. Mark all pages in the
685 * ranges as non-zeroed.
688 zero_dirty_pages(page_index_t start
, page_index_t end
) {
691 for (i
= start
; i
<= end
; i
++) {
692 if (!page_need_to_zero(i
)) continue;
693 for (j
= i
+1; (j
<= end
) && page_need_to_zero(j
) ; j
++)
699 for (i
= start
; i
<= end
; i
++) {
700 set_page_need_to_zero(i
, 1);
706 * To support quick and inline allocation, regions of memory can be
707 * allocated and then allocated from with just a free pointer and a
708 * check against an end address.
710 * Since objects can be allocated to spaces with different properties
711 * e.g. boxed/unboxed, generation, ages; there may need to be many
712 * allocation regions.
714 * Each allocation region may start within a partly used page. Many
715 * features of memory use are noted on a page wise basis, e.g. the
716 * generation; so if a region starts within an existing allocated page
717 * it must be consistent with this page.
719 * During the scavenging of the newspace, objects will be transported
720 * into an allocation region, and pointers updated to point to this
721 * allocation region. It is possible that these pointers will be
722 * scavenged again before the allocation region is closed, e.g. due to
723 * trans_list which jumps all over the place to cleanup the list. It
724 * is important to be able to determine properties of all objects
725 * pointed to when scavenging, e.g to detect pointers to the oldspace.
726 * Thus it's important that the allocation regions have the correct
727 * properties set when allocated, and not just set when closed. The
728 * region allocation routines return regions with the specified
729 * properties, and grab all the pages, setting their properties
730 * appropriately, except that the amount used is not known.
732 * These regions are used to support quicker allocation using just a
733 * free pointer. The actual space used by the region is not reflected
734 * in the pages tables until it is closed. It can't be scavenged until
737 * When finished with the region it should be closed, which will
738 * update the page tables for the actual space used returning unused
739 * space. Further it may be noted in the new regions which is
740 * necessary when scavenging the newspace.
742 * Large objects may be allocated directly without an allocation
743 * region, the page tables are updated immediately.
745 * Unboxed objects don't contain pointers to other objects and so
746 * don't need scavenging. Further they can't contain pointers to
747 * younger generations so WP is not needed. By allocating pages to
748 * unboxed objects the whole page never needs scavenging or
749 * write-protecting. */
751 /* We use either two or three regions for the current newspace generation. */
752 #ifdef LISP_FEATURE_SEGREGATED_CODE
753 struct alloc_region gc_alloc_regions
[3];
754 #define boxed_region gc_alloc_regions[BOXED_PAGE_FLAG-1]
755 #define unboxed_region gc_alloc_regions[UNBOXED_PAGE_FLAG-1]
756 #define code_region gc_alloc_regions[CODE_PAGE_FLAG-1]
758 struct alloc_region boxed_region
;
759 struct alloc_region unboxed_region
;
762 /* The generation currently being allocated to. */
763 static generation_index_t gc_alloc_generation
;
765 static inline page_index_t
766 generation_alloc_start_page(generation_index_t generation
, int page_type_flag
, int large
)
768 if (!(page_type_flag
>= 1 && page_type_flag
<= 3))
769 lose("bad page_type_flag: %d", page_type_flag
);
771 return generations
[generation
].alloc_large_start_page
;
772 #ifdef LISP_FEATURE_SEGREGATED_CODE
773 return generations
[generation
].alloc_start_page_
[page_type_flag
];
775 if (UNBOXED_PAGE_FLAG
== page_type_flag
)
776 return generations
[generation
].alloc_unboxed_start_page
;
777 /* Both code and data. */
778 return generations
[generation
].alloc_start_page
;
783 set_generation_alloc_start_page(generation_index_t generation
, int page_type_flag
, int large
,
786 if (!(page_type_flag
>= 1 && page_type_flag
<= 3))
787 lose("bad page_type_flag: %d", page_type_flag
);
789 generations
[generation
].alloc_large_start_page
= page
;
790 #ifdef LISP_FEATURE_SEGREGATED_CODE
792 generations
[generation
].alloc_start_page_
[page_type_flag
] = page
;
794 else if (UNBOXED_PAGE_FLAG
== page_type_flag
)
795 generations
[generation
].alloc_unboxed_start_page
= page
;
796 else /* Both code and data. */
797 generations
[generation
].alloc_start_page
= page
;
801 /* Find a new region with room for at least the given number of bytes.
803 * It starts looking at the current generation's alloc_start_page. So
804 * may pick up from the previous region if there is enough space. This
805 * keeps the allocation contiguous when scavenging the newspace.
807 * The alloc_region should have been closed by a call to
808 * gc_alloc_update_page_tables(), and will thus be in an empty state.
810 * To assist the scavenging functions write-protected pages are not
811 * used. Free pages should not be write-protected.
813 * It is critical to the conservative GC that the start of regions be
814 * known. To help achieve this only small regions are allocated at a
817 * During scavenging, pointers may be found to within the current
818 * region and the page generation must be set so that pointers to the
819 * from space can be recognized. Therefore the generation of pages in
820 * the region are set to gc_alloc_generation. To prevent another
821 * allocation call using the same pages, all the pages in the region
822 * are allocated, although they will initially be empty.
825 gc_alloc_new_region(sword_t nbytes
, int page_type_flag
, struct alloc_region
*alloc_region
)
827 page_index_t first_page
;
828 page_index_t last_page
;
834 "/alloc_new_region for %d bytes from gen %d\n",
835 nbytes, gc_alloc_generation));
838 /* Check that the region is in a reset state. */
839 gc_assert((alloc_region
->first_page
== 0)
840 && (alloc_region
->last_page
== -1)
841 && (alloc_region
->free_pointer
== alloc_region
->end_addr
));
842 ret
= thread_mutex_lock(&free_pages_lock
);
844 first_page
= generation_alloc_start_page(gc_alloc_generation
, page_type_flag
, 0);
845 last_page
=gc_find_freeish_pages(&first_page
, nbytes
, page_type_flag
);
847 /* Set up the alloc_region. */
848 alloc_region
->first_page
= first_page
;
849 alloc_region
->last_page
= last_page
;
850 alloc_region
->start_addr
= page_address(first_page
) + page_bytes_used(first_page
);
851 alloc_region
->free_pointer
= alloc_region
->start_addr
;
852 alloc_region
->end_addr
= page_address(last_page
+1);
854 /* Set up the pages. */
856 /* The first page may have already been in use. */
857 /* If so, just assert that it's consistent, otherwise, set it up. */
858 if (page_bytes_used(first_page
)) {
859 gc_assert(page_table
[first_page
].allocated
== page_type_flag
);
860 gc_assert(page_table
[first_page
].gen
== gc_alloc_generation
);
861 gc_assert(page_table
[first_page
].large_object
== 0);
863 page_table
[first_page
].allocated
= page_type_flag
;
864 page_table
[first_page
].gen
= gc_alloc_generation
;
865 page_table
[first_page
].large_object
= 0;
866 set_page_scan_start_offset(first_page
, 0);
868 page_table
[first_page
].allocated
|= OPEN_REGION_PAGE_FLAG
;
870 for (i
= first_page
+1; i
<= last_page
; i
++) {
871 page_table
[i
].allocated
= page_type_flag
;
872 page_table
[i
].gen
= gc_alloc_generation
;
873 page_table
[i
].large_object
= 0;
874 /* This may not be necessary for unboxed regions (think it was
876 set_page_scan_start_offset(i
,
877 addr_diff(page_address(i
), alloc_region
->start_addr
));
878 page_table
[i
].allocated
|= OPEN_REGION_PAGE_FLAG
;
880 /* Bump up last_free_page. */
881 if (last_page
+1 > last_free_page
) {
882 last_free_page
= last_page
+1;
883 /* do we only want to call this on special occasions? like for
885 set_alloc_pointer((lispobj
)page_address(last_free_page
));
887 ret
= thread_mutex_unlock(&free_pages_lock
);
890 #ifdef READ_PROTECT_FREE_PAGES
891 os_protect(page_address(first_page
),
892 npage_bytes(1+last_page
-first_page
),
896 /* If the first page was only partial, don't check whether it's
897 * zeroed (it won't be) and don't zero it (since the parts that
898 * we're interested in are guaranteed to be zeroed).
900 if (page_bytes_used(first_page
)) {
904 zero_dirty_pages(first_page
, last_page
);
906 /* we can do this after releasing free_pages_lock */
907 if (gencgc_zero_check
) {
909 for (p
= (word_t
*)alloc_region
->start_addr
;
910 p
< (word_t
*)alloc_region
->end_addr
; p
++) {
912 lose("The new region is not zero at %p (start=%p, end=%p).\n",
913 p
, alloc_region
->start_addr
, alloc_region
->end_addr
);
919 /* If the record_new_objects flag is 2 then all new regions created
922 * If it's 1 then then it is only recorded if the first page of the
923 * current region is <= new_areas_ignore_page. This helps avoid
924 * unnecessary recording when doing full scavenge pass.
926 * The new_object structure holds the page, byte offset, and size of
927 * new regions of objects. Each new area is placed in the array of
928 * these structures pointer to by new_areas. new_areas_index holds the
929 * offset into new_areas.
931 * If new_area overflows NUM_NEW_AREAS then it stops adding them. The
932 * later code must detect this and handle it, probably by doing a full
933 * scavenge of a generation. */
934 #define NUM_NEW_AREAS 512
935 static int record_new_objects
= 0;
936 static page_index_t new_areas_ignore_page
;
942 static struct new_area (*new_areas
)[];
943 static size_t new_areas_index
;
944 size_t max_new_areas
;
946 /* Add a new area to new_areas. */
948 add_new_area(page_index_t first_page
, size_t offset
, size_t size
)
950 size_t new_area_start
, c
;
953 /* Ignore if full. */
954 if (new_areas_index
>= NUM_NEW_AREAS
)
957 switch (record_new_objects
) {
961 if (first_page
> new_areas_ignore_page
)
970 new_area_start
= npage_bytes(first_page
) + offset
;
972 /* Search backwards for a prior area that this follows from. If
973 found this will save adding a new area. */
974 for (i
= new_areas_index
-1, c
= 0; (i
>= 0) && (c
< 8); i
--, c
++) {
976 npage_bytes((*new_areas
)[i
].page
)
977 + (*new_areas
)[i
].offset
978 + (*new_areas
)[i
].size
;
980 "/add_new_area S1 %d %d %d %d\n",
981 i, c, new_area_start, area_end));*/
982 if (new_area_start
== area_end
) {
984 "/adding to [%d] %d %d %d with %d %d %d:\n",
986 (*new_areas)[i].page,
987 (*new_areas)[i].offset,
988 (*new_areas)[i].size,
992 (*new_areas
)[i
].size
+= size
;
997 (*new_areas
)[new_areas_index
].page
= first_page
;
998 (*new_areas
)[new_areas_index
].offset
= offset
;
999 (*new_areas
)[new_areas_index
].size
= size
;
1001 "/new_area %d page %d offset %d size %d\n",
1002 new_areas_index, first_page, offset, size));*/
1005 /* Note the max new_areas used. */
1006 if (new_areas_index
> max_new_areas
)
1007 max_new_areas
= new_areas_index
;
1010 /* Update the tables for the alloc_region. The region may be added to
1013 * When done the alloc_region is set up so that the next quick alloc
1014 * will fail safely and thus a new region will be allocated. Further
1015 * it is safe to try to re-update the page table of this reset
1018 gc_alloc_update_page_tables(int page_type_flag
, struct alloc_region
*alloc_region
)
1021 page_index_t first_page
;
1022 page_index_t next_page
;
1023 os_vm_size_t bytes_used
;
1024 os_vm_size_t region_size
;
1025 os_vm_size_t byte_cnt
;
1026 page_bytes_t orig_first_page_bytes_used
;
1030 first_page
= alloc_region
->first_page
;
1032 /* Catch an unused alloc_region. */
1033 if ((first_page
== 0) && (alloc_region
->last_page
== -1))
1036 next_page
= first_page
+1;
1038 ret
= thread_mutex_lock(&free_pages_lock
);
1039 gc_assert(ret
== 0);
1040 if (alloc_region
->free_pointer
!= alloc_region
->start_addr
) {
1041 /* some bytes were allocated in the region */
1042 orig_first_page_bytes_used
= page_bytes_used(first_page
);
1044 gc_assert(alloc_region
->start_addr
==
1045 (page_address(first_page
) + page_bytes_used(first_page
)));
1047 /* All the pages used need to be updated */
1049 /* Update the first page. */
1051 /* If the page was free then set up the gen, and
1052 * scan_start_offset. */
1053 if (page_bytes_used(first_page
) == 0)
1054 gc_assert(page_starts_contiguous_block_p(first_page
));
1055 page_table
[first_page
].allocated
&= ~(OPEN_REGION_PAGE_FLAG
);
1057 #ifdef LISP_FEATURE_SEGREGATED_CODE
1058 gc_assert(page_table
[first_page
].allocated
== page_type_flag
);
1060 gc_assert(page_table
[first_page
].allocated
& page_type_flag
);
1062 gc_assert(page_table
[first_page
].gen
== gc_alloc_generation
);
1063 gc_assert(page_table
[first_page
].large_object
== 0);
1067 /* Calculate the number of bytes used in this page. This is not
1068 * always the number of new bytes, unless it was free. */
1070 if ((bytes_used
= addr_diff(alloc_region
->free_pointer
,
1071 page_address(first_page
)))
1072 >GENCGC_CARD_BYTES
) {
1073 bytes_used
= GENCGC_CARD_BYTES
;
1076 set_page_bytes_used(first_page
, bytes_used
);
1077 byte_cnt
+= bytes_used
;
1080 /* All the rest of the pages should be free. We need to set
1081 * their scan_start_offset pointer to the start of the
1082 * region, and set the bytes_used. */
1084 page_table
[next_page
].allocated
&= ~(OPEN_REGION_PAGE_FLAG
);
1085 #ifdef LISP_FEATURE_SEGREGATED_CODE
1086 gc_assert(page_table
[next_page
].allocated
== page_type_flag
);
1088 gc_assert(page_table
[next_page
].allocated
& page_type_flag
);
1090 gc_assert(page_bytes_used(next_page
) == 0);
1091 gc_assert(page_table
[next_page
].gen
== gc_alloc_generation
);
1092 gc_assert(page_table
[next_page
].large_object
== 0);
1093 gc_assert(page_scan_start_offset(next_page
) ==
1094 addr_diff(page_address(next_page
),
1095 alloc_region
->start_addr
));
1097 /* Calculate the number of bytes used in this page. */
1099 if ((bytes_used
= addr_diff(alloc_region
->free_pointer
,
1100 page_address(next_page
)))>GENCGC_CARD_BYTES
) {
1101 bytes_used
= GENCGC_CARD_BYTES
;
1104 set_page_bytes_used(next_page
, bytes_used
);
1105 byte_cnt
+= bytes_used
;
1110 region_size
= addr_diff(alloc_region
->free_pointer
,
1111 alloc_region
->start_addr
);
1112 bytes_allocated
+= region_size
;
1113 generations
[gc_alloc_generation
].bytes_allocated
+= region_size
;
1115 gc_assert((byte_cnt
- orig_first_page_bytes_used
) == region_size
);
1117 /* Set the generations alloc restart page to the last page of
1119 set_generation_alloc_start_page(gc_alloc_generation
, page_type_flag
, 0, next_page
-1);
1121 /* Add the region to the new_areas if requested. */
1122 if (BOXED_PAGE_FLAG
& page_type_flag
)
1123 add_new_area(first_page
,orig_first_page_bytes_used
, region_size
);
1127 "/gc_alloc_update_page_tables update %d bytes to gen %d\n",
1129 gc_alloc_generation));
1132 /* There are no bytes allocated. Unallocate the first_page if
1133 * there are 0 bytes_used. */
1134 page_table
[first_page
].allocated
&= ~(OPEN_REGION_PAGE_FLAG
);
1135 if (page_bytes_used(first_page
) == 0)
1136 page_table
[first_page
].allocated
= FREE_PAGE_FLAG
;
1139 /* Unallocate any unused pages. */
1140 while (next_page
<= alloc_region
->last_page
) {
1141 gc_assert(page_bytes_used(next_page
) == 0);
1142 page_table
[next_page
].allocated
= FREE_PAGE_FLAG
;
1145 ret
= thread_mutex_unlock(&free_pages_lock
);
1146 gc_assert(ret
== 0);
1148 /* alloc_region is per-thread, we're ok to do this unlocked */
1149 gc_set_region_empty(alloc_region
);
1152 /* Allocate a possibly large object. */
1154 gc_alloc_large(sword_t nbytes
, int page_type_flag
, struct alloc_region
*alloc_region
)
1157 page_index_t first_page
, next_page
, last_page
;
1158 os_vm_size_t byte_cnt
;
1159 os_vm_size_t bytes_used
;
1162 ret
= thread_mutex_lock(&free_pages_lock
);
1163 gc_assert(ret
== 0);
1165 first_page
= generation_alloc_start_page(gc_alloc_generation
, page_type_flag
, 1);
1166 // FIXME: really we want to try looking for space following the highest of
1167 // the last page of all other small object regions. That's impossible - there's
1168 // not enough information. At best we can skip some work in only the case where
1169 // the supplied region was the one most recently created. To do this right
1170 // would entail a malloc-like allocator at the page granularity.
1171 if (first_page
<= alloc_region
->last_page
) {
1172 first_page
= alloc_region
->last_page
+1;
1175 last_page
=gc_find_freeish_pages(&first_page
,nbytes
, page_type_flag
);
1177 gc_assert(first_page
> alloc_region
->last_page
);
1179 set_generation_alloc_start_page(gc_alloc_generation
, page_type_flag
, 1, last_page
);
1181 /* Large objects don't share pages with other objects. */
1182 gc_assert(page_bytes_used(first_page
) == 0);
1184 /* Set up the pages. */
1185 page_table
[first_page
].allocated
= page_type_flag
;
1186 page_table
[first_page
].gen
= gc_alloc_generation
;
1187 page_table
[first_page
].large_object
= 1;
1188 set_page_scan_start_offset(first_page
, 0);
1192 /* Calc. the number of bytes used in this page. This is not
1193 * always the number of new bytes, unless it was free. */
1195 if ((bytes_used
= nbytes
) > GENCGC_CARD_BYTES
) {
1196 bytes_used
= GENCGC_CARD_BYTES
;
1199 set_page_bytes_used(first_page
, bytes_used
);
1200 byte_cnt
+= bytes_used
;
1202 next_page
= first_page
+1;
1204 /* All the rest of the pages should be free. We need to set their
1205 * scan_start_offset pointer to the start of the region, and set
1206 * the bytes_used. */
1208 gc_assert(page_free_p(next_page
));
1209 gc_assert(page_bytes_used(next_page
) == 0);
1210 page_table
[next_page
].allocated
= page_type_flag
;
1211 page_table
[next_page
].gen
= gc_alloc_generation
;
1212 page_table
[next_page
].large_object
= 1;
1214 set_page_scan_start_offset(next_page
, npage_bytes(next_page
-first_page
));
1216 /* Calculate the number of bytes used in this page. */
1218 bytes_used
= nbytes
- byte_cnt
;
1219 if (bytes_used
> GENCGC_CARD_BYTES
) {
1220 bytes_used
= GENCGC_CARD_BYTES
;
1223 set_page_bytes_used(next_page
, bytes_used
);
1224 page_table
[next_page
].write_protected
=0;
1225 page_table
[next_page
].dont_move
=0;
1226 byte_cnt
+= bytes_used
;
1230 gc_assert(byte_cnt
== (size_t)nbytes
);
1232 bytes_allocated
+= nbytes
;
1233 generations
[gc_alloc_generation
].bytes_allocated
+= nbytes
;
1235 /* Add the region to the new_areas if requested. */
1236 if (BOXED_PAGE_FLAG
& page_type_flag
)
1237 add_new_area(first_page
, 0, nbytes
);
1239 /* Bump up last_free_page */
1240 if (last_page
+1 > last_free_page
) {
1241 last_free_page
= last_page
+1;
1242 set_alloc_pointer((lispobj
)(page_address(last_free_page
)));
1244 ret
= thread_mutex_unlock(&free_pages_lock
);
1245 gc_assert(ret
== 0);
1247 #ifdef READ_PROTECT_FREE_PAGES
1248 os_protect(page_address(first_page
),
1249 npage_bytes(1+last_page
-first_page
),
1253 zero_dirty_pages(first_page
, last_page
);
1255 return page_address(first_page
);
1258 static page_index_t gencgc_alloc_start_page
= -1;
1261 gc_heap_exhausted_error_or_lose (sword_t available
, sword_t requested
)
1263 struct thread
*thread
= arch_os_get_current_thread();
1264 /* Write basic information before doing anything else: if we don't
1265 * call to lisp this is a must, and even if we do there is always
1266 * the danger that we bounce back here before the error has been
1267 * handled, or indeed even printed.
1269 report_heap_exhaustion(available
, requested
, thread
);
1270 if (gc_active_p
|| (available
== 0)) {
1271 /* If we are in GC, or totally out of memory there is no way
1272 * to sanely transfer control to the lisp-side of things.
1274 lose("Heap exhausted, game over.");
1277 /* FIXME: assert free_pages_lock held */
1278 (void)thread_mutex_unlock(&free_pages_lock
);
1279 #if !(defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD))
1280 gc_assert(get_pseudo_atomic_atomic(thread
));
1281 clear_pseudo_atomic_atomic(thread
);
1282 if (get_pseudo_atomic_interrupted(thread
))
1283 do_pending_interrupt();
1285 /* Another issue is that signalling HEAP-EXHAUSTED error leads
1286 * to running user code at arbitrary places, even in a
1287 * WITHOUT-INTERRUPTS which may lead to a deadlock without
1288 * running out of the heap. So at this point all bets are
1290 if (SymbolValue(INTERRUPTS_ENABLED
,thread
) == NIL
)
1291 corruption_warning_and_maybe_lose
1292 ("Signalling HEAP-EXHAUSTED in a WITHOUT-INTERRUPTS.");
1293 /* available and requested should be double word aligned, thus
1294 they can passed as fixnums and shifted later. */
1295 funcall2(StaticSymbolFunction(HEAP_EXHAUSTED_ERROR
), available
, requested
);
1296 lose("HEAP-EXHAUSTED-ERROR fell through");
1301 gc_find_freeish_pages(page_index_t
*restart_page_ptr
, sword_t bytes
,
1304 page_index_t most_bytes_found_from
= 0, most_bytes_found_to
= 0;
1305 page_index_t first_page
, last_page
, restart_page
= *restart_page_ptr
;
1306 os_vm_size_t nbytes
= bytes
;
1307 os_vm_size_t nbytes_goal
= nbytes
;
1308 os_vm_size_t bytes_found
= 0;
1309 os_vm_size_t most_bytes_found
= 0;
1310 boolean small_object
= nbytes
< GENCGC_CARD_BYTES
;
1311 /* FIXME: assert(free_pages_lock is held); */
1313 if (nbytes_goal
< gencgc_alloc_granularity
)
1314 nbytes_goal
= gencgc_alloc_granularity
;
1316 /* Toggled by gc_and_save for heap compaction, normally -1. */
1317 if (gencgc_alloc_start_page
!= -1) {
1318 restart_page
= gencgc_alloc_start_page
;
1321 /* FIXME: This is on bytes instead of nbytes pending cleanup of
1322 * long from the interface. */
1323 gc_assert(bytes
>=0);
1324 /* Search for a page with at least nbytes of space. We prefer
1325 * not to split small objects on multiple pages, to reduce the
1326 * number of contiguous allocation regions spaning multiple
1327 * pages: this helps avoid excessive conservativism.
1329 * For other objects, we guarantee that they start on their own
1332 first_page
= restart_page
;
1333 while (first_page
< page_table_pages
) {
1335 if (page_free_p(first_page
)) {
1336 gc_assert(0 == page_bytes_used(first_page
));
1337 bytes_found
= GENCGC_CARD_BYTES
;
1338 } else if (small_object
&&
1339 (page_table
[first_page
].allocated
== page_type_flag
) &&
1340 (page_table
[first_page
].large_object
== 0) &&
1341 (page_table
[first_page
].gen
== gc_alloc_generation
) &&
1342 (page_table
[first_page
].write_protected
== 0) &&
1343 (page_table
[first_page
].dont_move
== 0)) {
1344 bytes_found
= GENCGC_CARD_BYTES
- page_bytes_used(first_page
);
1345 if (bytes_found
< nbytes
) {
1346 if (bytes_found
> most_bytes_found
)
1347 most_bytes_found
= bytes_found
;
1356 gc_assert(page_table
[first_page
].write_protected
== 0);
1357 for (last_page
= first_page
+1;
1358 ((last_page
< page_table_pages
) &&
1359 page_free_p(last_page
) &&
1360 (bytes_found
< nbytes_goal
));
1362 bytes_found
+= GENCGC_CARD_BYTES
;
1363 gc_assert(0 == page_bytes_used(last_page
));
1364 gc_assert(0 == page_table
[last_page
].write_protected
);
1367 if (bytes_found
> most_bytes_found
) {
1368 most_bytes_found
= bytes_found
;
1369 most_bytes_found_from
= first_page
;
1370 most_bytes_found_to
= last_page
;
1372 if (bytes_found
>= nbytes_goal
)
1375 first_page
= last_page
;
1378 bytes_found
= most_bytes_found
;
1379 restart_page
= first_page
+ 1;
1381 /* Check for a failure */
1382 if (bytes_found
< nbytes
) {
1383 gc_assert(restart_page
>= page_table_pages
);
1384 gc_heap_exhausted_error_or_lose(most_bytes_found
, nbytes
);
1387 gc_assert(most_bytes_found_to
);
1388 *restart_page_ptr
= most_bytes_found_from
;
1389 return most_bytes_found_to
-1;
1392 /* Allocate bytes. All the rest of the special-purpose allocation
1393 * functions will eventually call this */
1396 gc_alloc_with_region(sword_t nbytes
,int page_type_flag
, struct alloc_region
*my_region
,
1399 void *new_free_pointer
;
1401 if (nbytes
>=LARGE_OBJECT_SIZE
)
1402 return gc_alloc_large(nbytes
, page_type_flag
, my_region
);
1404 /* Check whether there is room in the current alloc region. */
1405 new_free_pointer
= (char*)my_region
->free_pointer
+ nbytes
;
1407 /* fprintf(stderr, "alloc %d bytes from %p to %p\n", nbytes,
1408 my_region->free_pointer, new_free_pointer); */
1410 if (new_free_pointer
<= my_region
->end_addr
) {
1411 /* If so then allocate from the current alloc region. */
1412 void *new_obj
= my_region
->free_pointer
;
1413 my_region
->free_pointer
= new_free_pointer
;
1415 /* Unless a `quick' alloc was requested, check whether the
1416 alloc region is almost empty. */
1418 addr_diff(my_region
->end_addr
,my_region
->free_pointer
) <= 32) {
1419 /* If so, finished with the current region. */
1420 gc_alloc_update_page_tables(page_type_flag
, my_region
);
1421 /* Set up a new region. */
1422 gc_alloc_new_region(32 /*bytes*/, page_type_flag
, my_region
);
1425 return((void *)new_obj
);
1428 /* Else not enough free space in the current region: retry with a
1431 gc_alloc_update_page_tables(page_type_flag
, my_region
);
1432 gc_alloc_new_region(nbytes
, page_type_flag
, my_region
);
1433 return gc_alloc_with_region(nbytes
, page_type_flag
, my_region
,0);
1436 /* Copy a large object. If the object is in a large object region then
1437 * it is simply promoted, else it is copied. If it's large enough then
1438 * it's copied to a large object region.
1440 * Bignums and vectors may have shrunk. If the object is not copied
1441 * the space needs to be reclaimed, and the page_tables corrected. */
1443 general_copy_large_object(lispobj object
, word_t nwords
, boolean boxedp
)
1446 page_index_t first_page
;
1448 CHECK_COPY_PRECONDITIONS(object
, nwords
);
1450 if ((nwords
> 1024*1024) && gencgc_verbose
) {
1451 FSHOW((stderr
, "/general_copy_large_object: %d bytes\n",
1452 nwords
*N_WORD_BYTES
));
1455 /* Check whether it's a large object. */
1456 first_page
= find_page_index((void *)object
);
1457 gc_assert(first_page
>= 0);
1459 if (page_table
[first_page
].large_object
) {
1460 /* Promote the object. Note: Unboxed objects may have been
1461 * allocated to a BOXED region so it may be necessary to
1462 * change the region to UNBOXED. */
1463 os_vm_size_t remaining_bytes
;
1464 os_vm_size_t bytes_freed
;
1465 page_index_t next_page
;
1466 page_bytes_t old_bytes_used
;
1468 /* FIXME: This comment is somewhat stale.
1470 * Note: Any page write-protection must be removed, else a
1471 * later scavenge_newspace may incorrectly not scavenge these
1472 * pages. This would not be necessary if they are added to the
1473 * new areas, but let's do it for them all (they'll probably
1474 * be written anyway?). */
1476 gc_assert(page_starts_contiguous_block_p(first_page
));
1477 next_page
= first_page
;
1478 remaining_bytes
= nwords
*N_WORD_BYTES
;
1480 while (remaining_bytes
> GENCGC_CARD_BYTES
) {
1481 gc_assert(page_table
[next_page
].gen
== from_space
);
1482 gc_assert(page_table
[next_page
].large_object
);
1483 gc_assert(page_scan_start_offset(next_page
) ==
1484 npage_bytes(next_page
-first_page
));
1485 gc_assert(page_bytes_used(next_page
) == GENCGC_CARD_BYTES
);
1486 /* Should have been unprotected by unprotect_oldspace()
1487 * for boxed objects, and after promotion unboxed ones
1488 * should not be on protected pages at all. */
1489 gc_assert(!page_table
[next_page
].write_protected
);
1492 gc_assert(page_boxed_p(next_page
));
1494 gc_assert(page_allocated_no_region_p(next_page
));
1495 page_table
[next_page
].allocated
= UNBOXED_PAGE_FLAG
;
1497 page_table
[next_page
].gen
= new_space
;
1499 remaining_bytes
-= GENCGC_CARD_BYTES
;
1503 /* Now only one page remains, but the object may have shrunk so
1504 * there may be more unused pages which will be freed. */
1506 /* Object may have shrunk but shouldn't have grown - check. */
1507 gc_assert(page_bytes_used(next_page
) >= remaining_bytes
);
1509 page_table
[next_page
].gen
= new_space
;
1512 gc_assert(page_boxed_p(next_page
));
1514 page_table
[next_page
].allocated
= UNBOXED_PAGE_FLAG
;
1516 /* Adjust the bytes_used. */
1517 old_bytes_used
= page_bytes_used(next_page
);
1518 set_page_bytes_used(next_page
, remaining_bytes
);
1520 bytes_freed
= old_bytes_used
- remaining_bytes
;
1522 /* Free any remaining pages; needs care. */
1524 while ((old_bytes_used
== GENCGC_CARD_BYTES
) &&
1525 (page_table
[next_page
].gen
== from_space
) &&
1526 /* FIXME: It is not obvious to me why this is necessary
1527 * as a loop condition: it seems to me that the
1528 * scan_start_offset test should be sufficient, but
1529 * experimentally that is not the case. --NS
1532 page_boxed_p(next_page
) :
1533 page_allocated_no_region_p(next_page
)) &&
1534 page_table
[next_page
].large_object
&&
1535 (page_scan_start_offset(next_page
) ==
1536 npage_bytes(next_page
- first_page
))) {
1537 /* Checks out OK, free the page. Don't need to both zeroing
1538 * pages as this should have been done before shrinking the
1539 * object. These pages shouldn't be write-protected, even if
1540 * boxed they should be zero filled. */
1541 gc_assert(page_table
[next_page
].write_protected
== 0);
1543 old_bytes_used
= page_bytes_used(next_page
);
1544 page_table
[next_page
].allocated
= FREE_PAGE_FLAG
;
1545 set_page_bytes_used(next_page
, 0);
1546 bytes_freed
+= old_bytes_used
;
1550 if ((bytes_freed
> 0) && gencgc_verbose
) {
1552 "/general_copy_large_object bytes_freed=%"OS_VM_SIZE_FMT
"\n",
1556 generations
[from_space
].bytes_allocated
-= nwords
*N_WORD_BYTES
1558 generations
[new_space
].bytes_allocated
+= nwords
*N_WORD_BYTES
;
1559 bytes_allocated
-= bytes_freed
;
1561 /* Add the region to the new_areas if requested. */
1563 add_new_area(first_page
,0,nwords
*N_WORD_BYTES
);
1568 /* Allocate space. */
1569 new = gc_general_alloc(nwords
*N_WORD_BYTES
,
1570 (boxedp
? BOXED_PAGE_FLAG
: UNBOXED_PAGE_FLAG
),
1573 /* Copy the object. */
1574 memcpy(new,native_pointer(object
),nwords
*N_WORD_BYTES
);
1576 /* Return Lisp pointer of new object. */
1577 return make_lispobj(new, lowtag_of(object
));
1582 copy_large_object(lispobj object
, sword_t nwords
)
1584 return general_copy_large_object(object
, nwords
, 1);
1588 copy_large_unboxed_object(lispobj object
, sword_t nwords
)
1590 return general_copy_large_object(object
, nwords
, 0);
1593 /* to copy unboxed objects */
1595 copy_unboxed_object(lispobj object
, sword_t nwords
)
1597 return gc_general_copy_object(object
, nwords
, UNBOXED_PAGE_FLAG
);
1602 * code and code-related objects
1605 static lispobj trans_fun_header(lispobj object);
1606 static lispobj trans_boxed(lispobj object);
1609 /* Scan a x86 compiled code object, looking for possible fixups that
1610 * have been missed after a move.
1612 * Two types of fixups are needed:
1613 * 1. Absolute fixups to within the code object.
1614 * 2. Relative fixups to outside the code object.
1616 * Currently only absolute fixups to the constant vector, or to the
1617 * code area are checked. */
1618 #ifdef LISP_FEATURE_X86
1620 sniff_code_object(struct code
*code
, os_vm_size_t displacement
)
1622 sword_t nheader_words
, ncode_words
, nwords
;
1623 os_vm_address_t constants_start_addr
= NULL
, constants_end_addr
, p
;
1624 os_vm_address_t code_start_addr
, code_end_addr
;
1625 os_vm_address_t code_addr
= (os_vm_address_t
)code
;
1626 int fixup_found
= 0;
1628 if (!check_code_fixups
)
1631 FSHOW((stderr
, "/sniffing code: %p, %lu\n", code
, displacement
));
1633 ncode_words
= code_instruction_words(code
->code_size
);
1634 nheader_words
= code_header_words(*(lispobj
*)code
);
1635 nwords
= ncode_words
+ nheader_words
;
1637 constants_start_addr
= code_addr
+ 5*N_WORD_BYTES
;
1638 constants_end_addr
= code_addr
+ nheader_words
*N_WORD_BYTES
;
1639 code_start_addr
= code_addr
+ nheader_words
*N_WORD_BYTES
;
1640 code_end_addr
= code_addr
+ nwords
*N_WORD_BYTES
;
1642 /* Work through the unboxed code. */
1643 for (p
= code_start_addr
; p
< code_end_addr
; p
++) {
1644 void *data
= *(void **)p
;
1645 unsigned d1
= *((unsigned char *)p
- 1);
1646 unsigned d2
= *((unsigned char *)p
- 2);
1647 unsigned d3
= *((unsigned char *)p
- 3);
1648 unsigned d4
= *((unsigned char *)p
- 4);
1650 unsigned d5
= *((unsigned char *)p
- 5);
1651 unsigned d6
= *((unsigned char *)p
- 6);
1654 /* Check for code references. */
1655 /* Check for a 32 bit word that looks like an absolute
1656 reference to within the code adea of the code object. */
1657 if ((data
>= (void*)(code_start_addr
-displacement
))
1658 && (data
< (void*)(code_end_addr
-displacement
))) {
1659 /* function header */
1661 && (((unsigned)p
- 4 - 4*HeaderValue(*((unsigned *)p
-1))) ==
1663 /* Skip the function header */
1667 /* the case of PUSH imm32 */
1671 "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1672 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1673 FSHOW((stderr
, "/PUSH $0x%.8x\n", data
));
1675 /* the case of MOV [reg-8],imm32 */
1677 && (d2
==0x40 || d2
==0x41 || d2
==0x42 || d2
==0x43
1678 || d2
==0x45 || d2
==0x46 || d2
==0x47)
1682 "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1683 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1684 FSHOW((stderr
, "/MOV [reg-8],$0x%.8x\n", data
));
1686 /* the case of LEA reg,[disp32] */
1687 if ((d2
== 0x8d) && ((d1
& 0xc7) == 5)) {
1690 "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1691 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1692 FSHOW((stderr
,"/LEA reg,[$0x%.8x]\n", data
));
1696 /* Check for constant references. */
1697 /* Check for a 32 bit word that looks like an absolute
1698 reference to within the constant vector. Constant references
1700 if ((data
>= (void*)(constants_start_addr
-displacement
))
1701 && (data
< (void*)(constants_end_addr
-displacement
))
1702 && (((unsigned)data
& 0x3) == 0)) {
1707 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1708 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1709 FSHOW((stderr
,"/MOV eax,0x%.8x\n", data
));
1712 /* the case of MOV m32,EAX */
1716 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1717 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1718 FSHOW((stderr
, "/MOV 0x%.8x,eax\n", data
));
1721 /* the case of CMP m32,imm32 */
1722 if ((d1
== 0x3d) && (d2
== 0x81)) {
1725 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1726 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1728 FSHOW((stderr
, "/CMP 0x%.8x,immed32\n", data
));
1731 /* Check for a mod=00, r/m=101 byte. */
1732 if ((d1
& 0xc7) == 5) {
1737 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1738 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1739 FSHOW((stderr
,"/CMP 0x%.8x,reg\n", data
));
1741 /* the case of CMP reg32,m32 */
1745 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1746 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1747 FSHOW((stderr
, "/CMP reg32,0x%.8x\n", data
));
1749 /* the case of MOV m32,reg32 */
1753 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1754 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1755 FSHOW((stderr
, "/MOV 0x%.8x,reg32\n", data
));
1757 /* the case of MOV reg32,m32 */
1761 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1762 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1763 FSHOW((stderr
, "/MOV reg32,0x%.8x\n", data
));
1765 /* the case of LEA reg32,m32 */
1769 "abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1770 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1771 FSHOW((stderr
, "/LEA reg32,0x%.8x\n", data
));
1777 /* If anything was found, print some information on the code
1781 "/compiled code object at %x: header words = %d, code words = %d\n",
1782 code
, nheader_words
, ncode_words
));
1784 "/const start = %x, end = %x\n",
1785 constants_start_addr
, constants_end_addr
));
1787 "/code start = %x, end = %x\n",
1788 code_start_addr
, code_end_addr
));
1793 #ifdef LISP_FEATURE_X86
1795 gencgc_apply_code_fixups(struct code
*old_code
, struct code
*new_code
)
1797 sword_t nheader_words
, ncode_words
, nwords
;
1798 os_vm_address_t
__attribute__((unused
)) constants_start_addr
, constants_end_addr
;
1799 os_vm_address_t
__attribute__((unused
)) code_start_addr
, code_end_addr
;
1800 os_vm_address_t code_addr
= (os_vm_address_t
)new_code
;
1801 os_vm_address_t old_addr
= (os_vm_address_t
)old_code
;
1802 os_vm_size_t displacement
= code_addr
- old_addr
;
1803 lispobj fixups
= NIL
;
1804 struct vector
*fixups_vector
;
1806 ncode_words
= code_instruction_words(new_code
->code_size
);
1807 nheader_words
= code_header_words(*(lispobj
*)new_code
);
1808 nwords
= ncode_words
+ nheader_words
;
1810 "/compiled code object at %x: header words = %d, code words = %d\n",
1811 new_code, nheader_words, ncode_words)); */
1812 constants_start_addr
= code_addr
+ 5*N_WORD_BYTES
;
1813 constants_end_addr
= code_addr
+ nheader_words
*N_WORD_BYTES
;
1814 code_start_addr
= code_addr
+ nheader_words
*N_WORD_BYTES
;
1815 code_end_addr
= code_addr
+ nwords
*N_WORD_BYTES
;
1818 "/const start = %x, end = %x\n",
1819 constants_start_addr,constants_end_addr));
1821 "/code start = %x; end = %x\n",
1822 code_start_addr,code_end_addr));
1825 fixups
= new_code
->fixups
;
1826 /* It will be a Lisp vector if valid, or 0 if there are no fixups */
1827 if (fixups
== 0 || !is_lisp_pointer(fixups
)) {
1828 /* Check for possible errors. */
1829 if (check_code_fixups
)
1830 sniff_code_object(new_code
, displacement
);
1835 fixups_vector
= (struct vector
*)native_pointer(fixups
);
1837 /* Could be pointing to a forwarding pointer. */
1838 /* This is extremely unlikely, because the only referent of the fixups
1839 is usually the code itself; so scavenging the vector won't occur
1840 until after the code object is known to be live. As we're just now
1841 enlivening the code, the fixups shouldn't have been forwarded.
1842 Maybe the vector is on the special binding stack though ... */
1843 if (is_lisp_pointer(fixups
) &&
1844 (find_page_index((void*)fixups_vector
) != -1) &&
1845 forwarding_pointer_p((lispobj
*)fixups_vector
)) {
1846 /* If so, then follow it. */
1847 /*SHOW("following pointer to a forwarding pointer");*/
1848 fixups_vector
= (struct vector
*)
1849 native_pointer(forwarding_pointer_value((lispobj
*)fixups_vector
));
1852 /*SHOW("got fixups");*/
1854 if (widetag_of(fixups_vector
->header
) == SIMPLE_ARRAY_WORD_WIDETAG
) {
1855 /* Got the fixups for the code block. Now work through the vector,
1856 and apply a fixup at each address. */
1857 sword_t length
= fixnum_value(fixups_vector
->length
);
1859 for (i
= 0; i
< length
; i
++) {
1860 long offset
= fixups_vector
->data
[i
];
1861 /* Now check the current value of offset. */
1862 os_vm_address_t old_value
= *(os_vm_address_t
*)(code_start_addr
+ offset
);
1864 /* If it's within the old_code object then it must be an
1865 * absolute fixup (relative ones are not saved) */
1866 if ((old_value
>= old_addr
)
1867 && (old_value
< (old_addr
+ nwords
*N_WORD_BYTES
)))
1868 /* So add the dispacement. */
1869 *(os_vm_address_t
*)(code_start_addr
+ offset
) =
1870 old_value
+ displacement
;
1872 /* It is outside the old code object so it must be a
1873 * relative fixup (absolute fixups are not saved). So
1874 * subtract the displacement. */
1875 *(os_vm_address_t
*)(code_start_addr
+ offset
) =
1876 old_value
- displacement
;
1879 /* This used to just print a note to stderr, but a bogus fixup seems to
1880 * indicate real heap corruption, so a hard hailure is in order. */
1881 lose("fixup vector %p has a bad widetag: %d\n",
1882 fixups_vector
, widetag_of(fixups_vector
->header
));
1885 /* Check for possible errors. */
1886 if (check_code_fixups
) {
1887 sniff_code_object(new_code
,displacement
);
1893 trans_boxed_large(lispobj object
)
1895 gc_assert(is_lisp_pointer(object
));
1896 return copy_large_object(object
,
1897 (HeaderValue(*native_pointer(object
)) | 1) + 1);
1904 /* XX This is a hack adapted from cgc.c. These don't work too
1905 * efficiently with the gencgc as a list of the weak pointers is
1906 * maintained within the objects which causes writes to the pages. A
1907 * limited attempt is made to avoid unnecessary writes, but this needs
1909 /* FIXME: now that we have non-Lisp hashtables in the GC, it might make sense
1910 * to stop chaining weak pointers through a slot in the object, as a remedy to
1911 * the above concern. It would also shorten the object by 2 words. */
1913 scav_weak_pointer(lispobj
*where
, lispobj object
)
1915 /* Since we overwrite the 'next' field, we have to make
1916 * sure not to do so for pointers already in the list.
1917 * Instead of searching the list of weak_pointers each
1918 * time, we ensure that next is always NULL when the weak
1919 * pointer isn't in the list, and not NULL otherwise.
1920 * Since we can't use NULL to denote end of list, we
1921 * use a pointer back to the same weak_pointer.
1923 struct weak_pointer
* wp
= (struct weak_pointer
*)where
;
1925 if (NULL
== wp
->next
&& weak_pointer_breakable_p(wp
)) {
1926 wp
->next
= weak_pointers
;
1928 if (NULL
== wp
->next
)
1932 /* Do not let GC scavenge the value slot of the weak pointer.
1933 * (That is why it is a weak pointer.) */
1935 return WEAK_POINTER_NWORDS
;
1940 search_read_only_space(void *pointer
)
1942 lispobj
*start
= (lispobj
*) READ_ONLY_SPACE_START
;
1943 lispobj
*end
= (lispobj
*) SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0);
1944 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
1946 return gc_search_space(start
, pointer
);
1950 search_static_space(void *pointer
)
1952 lispobj
*start
= (lispobj
*)STATIC_SPACE_START
;
1953 lispobj
*end
= (lispobj
*)SymbolValue(STATIC_SPACE_FREE_POINTER
,0);
1954 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
1956 return gc_search_space(start
, pointer
);
1959 /* a faster version for searching the dynamic space. This will work even
1960 * if the object is in a current allocation region. */
1962 search_dynamic_space(void *pointer
)
1964 page_index_t page_index
= find_page_index(pointer
);
1967 /* The address may be invalid, so do some checks. */
1968 if ((page_index
== -1) || page_free_p(page_index
))
1970 start
= (lispobj
*)page_scan_start(page_index
);
1971 return gc_search_space(start
, pointer
);
1974 #ifndef GENCGC_IS_PRECISE
1975 // Return the starting address of the object containing 'addr'
1976 // if and only if the object is one which would be evacuated from 'from_space'
1977 // were it allowed to be either discarded as garbage or moved.
1978 // 'addr_page_index' is the page containing 'addr' and must not be -1.
1979 // Return 0 if there is no such object - that is, if addr is past the
1980 // end of the used bytes, or its pages are not in 'from_space' etc.
1982 conservative_root_p(void *addr
, page_index_t addr_page_index
)
1984 /* quick check 1: Address is quite likely to have been invalid. */
1985 struct page
* page
= &page_table
[addr_page_index
];
1986 if (page
->gen
!= from_space
||
1987 ((uword_t
)addr
& (GENCGC_CARD_BYTES
- 1)) > page_bytes_used(addr_page_index
) ||
1988 (page
->large_object
&& page
->dont_move
))
1990 gc_assert(!(page
->allocated
& OPEN_REGION_PAGE_FLAG
));
1992 /* Filter out anything which can't be a pointer to a Lisp object
1993 * (or, as a special case which also requires dont_move, a return
1994 * address referring to something in a CodeObject). This is
1995 * expensive but important, since it vastly reduces the
1996 * probability that random garbage will be bogusly interpreted as
1997 * a pointer which prevents a page from moving. */
1998 lispobj
* object_start
= search_dynamic_space(addr
);
1999 if (!object_start
) return 0;
2001 /* If the containing object is a code object and 'addr' points
2002 * anywhere beyond the boxed words,
2003 * presume it to be a valid unboxed return address. */
2004 if (instruction_ptr_p(addr
, object_start
))
2005 return object_start
;
2007 /* Large object pages only contain ONE object, and it will never
2008 * be a CONS. However, arrays and bignums can be allocated larger
2009 * than necessary and then shrunk to fit, leaving what look like
2010 * (0 . 0) CONSes at the end. These appear valid to
2011 * properly_tagged_descriptor_p(), so pick them off here. */
2012 if (((lowtag_of((lispobj
)addr
) == LIST_POINTER_LOWTAG
) &&
2013 page_table
[addr_page_index
].large_object
)
2014 || !properly_tagged_descriptor_p(addr
, object_start
))
2017 return object_start
;
2021 /* Adjust large bignum and vector objects. This will adjust the
2022 * allocated region if the size has shrunk, and move unboxed objects
2023 * into unboxed pages. The pages are not promoted here, and the
2024 * promoted region is not added to the new_regions; this is really
2025 * only designed to be called from preserve_pointer(). Shouldn't fail
2026 * if this is missed, just may delay the moving of objects to unboxed
2027 * pages, and the freeing of pages. */
2029 maybe_adjust_large_object(page_index_t first_page
)
2031 lispobj
* where
= (lispobj
*)page_address(first_page
);
2032 page_index_t next_page
;
2034 uword_t remaining_bytes
;
2035 uword_t bytes_freed
;
2036 uword_t old_bytes_used
;
2040 /* Check whether it's a vector or bignum object. */
2041 lispobj widetag
= widetag_of(where
[0]);
2042 if (widetag
== SIMPLE_VECTOR_WIDETAG
)
2043 page_type_flag
= BOXED_PAGE_FLAG
;
2044 else if (specialized_vector_widetag_p(widetag
) || widetag
== BIGNUM_WIDETAG
)
2045 page_type_flag
= UNBOXED_PAGE_FLAG
;
2049 /* Find its current size. */
2050 sword_t nwords
= sizetab
[widetag
](where
);
2052 /* Note: Any page write-protection must be removed, else a later
2053 * scavenge_newspace may incorrectly not scavenge these pages.
2054 * This would not be necessary if they are added to the new areas,
2055 * but lets do it for them all (they'll probably be written
2058 gc_assert(page_starts_contiguous_block_p(first_page
));
2060 next_page
= first_page
;
2061 remaining_bytes
= nwords
*N_WORD_BYTES
;
2062 while (remaining_bytes
> GENCGC_CARD_BYTES
) {
2063 gc_assert(page_table
[next_page
].gen
== from_space
);
2064 // We can't assert that page_table[next_page].allocated is correct,
2065 // because unboxed objects are initially allocated on boxed pages.
2066 gc_assert(page_allocated_no_region_p(next_page
));
2067 gc_assert(page_table
[next_page
].large_object
);
2068 gc_assert(page_scan_start_offset(next_page
) ==
2069 npage_bytes(next_page
-first_page
));
2070 gc_assert(page_bytes_used(next_page
) == GENCGC_CARD_BYTES
);
2072 // This affects only one object, since large objects don't share pages.
2073 page_table
[next_page
].allocated
= page_type_flag
;
2075 /* Shouldn't be write-protected at this stage. Essential that the
2077 gc_assert(!page_table
[next_page
].write_protected
);
2078 remaining_bytes
-= GENCGC_CARD_BYTES
;
2082 /* Now only one page remains, but the object may have shrunk so
2083 * there may be more unused pages which will be freed. */
2085 /* Object may have shrunk but shouldn't have grown - check. */
2086 gc_assert(page_bytes_used(next_page
) >= remaining_bytes
);
2088 page_table
[next_page
].allocated
= page_type_flag
;
2090 /* Adjust the bytes_used. */
2091 old_bytes_used
= page_bytes_used(next_page
);
2092 set_page_bytes_used(next_page
, remaining_bytes
);
2094 bytes_freed
= old_bytes_used
- remaining_bytes
;
2096 /* Free any remaining pages; needs care. */
2098 while ((old_bytes_used
== GENCGC_CARD_BYTES
) &&
2099 (page_table
[next_page
].gen
== from_space
) &&
2100 page_allocated_no_region_p(next_page
) &&
2101 page_table
[next_page
].large_object
&&
2102 (page_scan_start_offset(next_page
) ==
2103 npage_bytes(next_page
- first_page
))) {
2104 /* It checks out OK, free the page. We don't need to bother zeroing
2105 * pages as this should have been done before shrinking the
2106 * object. These pages shouldn't be write protected as they
2107 * should be zero filled. */
2108 gc_assert(page_table
[next_page
].write_protected
== 0);
2110 old_bytes_used
= page_bytes_used(next_page
);
2111 page_table
[next_page
].allocated
= FREE_PAGE_FLAG
;
2112 set_page_bytes_used(next_page
, 0);
2113 bytes_freed
+= old_bytes_used
;
2117 if ((bytes_freed
> 0) && gencgc_verbose
) {
2119 "/maybe_adjust_large_object() freed %d\n",
2123 generations
[from_space
].bytes_allocated
-= bytes_freed
;
2124 bytes_allocated
-= bytes_freed
;
2129 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
2130 # define scavenge_pinned_ranges()
2131 # define wipe_nonpinned_words()
2132 /* After scavenging of the roots is done, we go back to the pinned objects
2133 * and look within them for pointers. While heap_scavenge() could certainly
2134 * do this, it would potentially lead to extra work, since we can't know
2135 * whether any given object has been examined at least once, since there is
2136 * no telltale forwarding-pointer. The easiest thing to do is defer all
2137 * pinned objects to a subsequent pass, as is done here.
2141 scavenge_pinned_ranges()
2145 for_each_hopscotch_key(i
, key
, pinned_objects
) {
2146 lispobj
* obj
= native_pointer(key
);
2147 lispobj header
= *obj
;
2148 // Never invoke scavenger on a simple-fun, just code components.
2149 if (is_cons_half(header
))
2151 else if (widetag_of(header
) != SIMPLE_FUN_WIDETAG
)
2152 scavtab
[widetag_of(header
)](obj
, header
);
2156 /* Create an array of fixnum to consume the space between 'from' and 'to' */
2157 static void deposit_filler(uword_t from
, uword_t to
)
2160 lispobj
* where
= (lispobj
*)from
;
2161 sword_t nwords
= (to
- from
) >> WORD_SHIFT
;
2162 where
[0] = SIMPLE_ARRAY_WORD_WIDETAG
;
2163 where
[1] = make_fixnum(nwords
- 2);
2167 /* Zero out the byte ranges on small object pages marked dont_move,
2168 * carefully skipping over objects in the pin hashtable.
2169 * TODO: by recording an additional bit per page indicating whether
2170 * there is more than one pinned object on it, we could avoid qsort()
2171 * except in the case where there is more than one. */
2173 wipe_nonpinned_words()
2175 void gc_heapsort_uwords(uword_t
*, int);
2176 // Loop over the keys in pinned_objects and pack them densely into
2177 // the same array - pinned_objects.keys[] - but skip any simple-funs.
2178 // Admittedly this is abstraction breakage.
2179 int limit
= hopscotch_max_key_index(pinned_objects
);
2181 for (i
= 0; i
<= limit
; ++i
) {
2182 lispobj key
= pinned_objects
.keys
[i
];
2184 lispobj
* obj
= native_pointer(key
);
2185 // No need to check for is_cons_half() - it will be false
2186 // on a simple-fun header, and that's the correct answer.
2187 if (widetag_of(*obj
) != SIMPLE_FUN_WIDETAG
)
2188 pinned_objects
.keys
[n_pins
++] = (uword_t
)obj
;
2191 // Store a sentinel at the end. Even if n_pins = table capacity (unlikely),
2192 // it is safe to write one more word, because the hops[] array immediately
2193 // follows the keys[] array in memory. At worst, 2 elements of hops[]
2194 // are clobbered, which is irrelevant since the table has already been
2195 // rendered unusable by stealing its key array for a different purpose.
2196 pinned_objects
.keys
[n_pins
] = 0;
2197 // Don't touch pinned_objects.count in case the reset function uses it
2198 // to decide how to resize for next use (which it doesn't, but could).
2199 gc_n_stack_pins
= n_pins
;
2200 // Order by ascending address, stopping short of the sentinel.
2201 gc_heapsort_uwords(pinned_objects
.keys
, n_pins
);
2203 printf("Sorted pin list:\n");
2204 for (i
= 0; i
< n_pins
; ++i
) {
2205 lispobj
* obj
= (lispobj
*)pinned_objects
.keys
[i
];
2206 if (!is_cons_half(*obj
))
2207 printf("%p: %5d words\n", obj
, (int)sizetab
[widetag_of(*obj
)](obj
));
2208 else printf("%p: CONS\n", obj
);
2211 // Each entry in the pinned objects demarcates two ranges to be cleared:
2212 // - the range preceding it back to either the page start, or prior object.
2213 // - the range after it, up to the lesser of page bytes used or next object.
2214 uword_t preceding_object
= 0;
2215 uword_t this_page_end
= 0;
2216 #define page_base_address(x) (x&~(GENCGC_CARD_BYTES-1))
2217 for (i
= 0; i
< n_pins
; ++i
) {
2218 // Handle the preceding range. If this object is on the same page as
2219 // its predecessor, then intervening bytes were already zeroed.
2220 // If not, then start a new page and do some bookkeeping.
2221 lispobj
* obj
= (lispobj
*)pinned_objects
.keys
[i
];
2222 uword_t this_page_base
= page_base_address((uword_t
)obj
);
2223 /* printf("i=%d obj=%p base=%p\n", i, obj, (void*)this_page_base); */
2224 if (this_page_base
> page_base_address(preceding_object
)) {
2225 deposit_filler(this_page_base
, (lispobj
)obj
);
2226 // Move the page to newspace
2227 page_index_t page
= find_page_index(obj
);
2228 int used
= page_bytes_used(page
);
2229 this_page_end
= this_page_base
+ used
;
2230 /* printf(" Clearing %p .. %p (limit=%p)\n",
2231 (void*)this_page_base, obj, (void*)this_page_end); */
2232 generations
[new_space
].bytes_allocated
+= used
;
2233 generations
[page_table
[page
].gen
].bytes_allocated
-= used
;
2234 page_table
[page
].gen
= new_space
;
2235 page_table
[page
].has_pins
= 0;
2237 // Handle the following range.
2238 lispobj word
= *obj
;
2239 size_t nwords
= is_cons_half(word
) ? 2 : sizetab
[widetag_of(word
)](obj
);
2240 uword_t range_start
= (uword_t
)(obj
+ nwords
);
2241 uword_t range_end
= this_page_end
;
2242 // There is always an i+1'th key due to the sentinel value.
2243 if (page_base_address(pinned_objects
.keys
[i
+1]) == this_page_base
)
2244 range_end
= pinned_objects
.keys
[i
+1];
2245 /* printf(" Clearing %p .. %p\n", (void*)range_start, (void*)range_end); */
2246 deposit_filler(range_start
, range_end
);
2247 preceding_object
= (uword_t
)obj
;
2251 /* Add 'object' to the hashtable, and if the object is a code component,
2252 * then also add all of the embedded simple-funs.
2253 * The rationale for the extra work on code components is that without it,
2254 * every test of pinned_p() on an object would have to check if the pointer
2255 * is to a simple-fun - entailing an extra read of the header - and mapping
2256 * to its code component if so. Since more calls to pinned_p occur than to
2257 * pin_object, the extra burden should be on this function.
2258 * Experimentation bears out that this is the better technique.
2259 * Also, we wouldn't often expect code components in the collected generation
2260 * so the extra work here is quite minimal, even if it can generally add to
2261 * the number of keys in the hashtable.
2264 pin_object(lispobj object
)
2266 if (!hopscotch_containsp(&pinned_objects
, object
)) {
2267 hopscotch_insert(&pinned_objects
, object
, 1);
2268 struct code
* maybe_code
= (struct code
*)native_pointer(object
);
2269 if (widetag_of(maybe_code
->header
) == CODE_HEADER_WIDETAG
) {
2270 for_each_simple_fun(i
, fun
, maybe_code
, 0, {
2271 hopscotch_insert(&pinned_objects
,
2272 make_lispobj(fun
, FUN_POINTER_LOWTAG
),
2280 /* Take a possible pointer to a Lisp object and mark its page in the
2281 * page_table so that it will not be relocated during a GC.
2283 * This involves locating the page it points to, then backing up to
2284 * the start of its region, then marking all pages dont_move from there
2285 * up to the first page that's not full or has a different generation
2287 * It is assumed that all the page static flags have been cleared at
2288 * the start of a GC.
2290 * It is also assumed that the current gc_alloc() region has been
2291 * flushed and the tables updated. */
2293 // TODO: there's probably a way to be a little more efficient here.
2294 // As things are, we start by finding the object that encloses 'addr',
2295 // then we see if 'addr' was a "valid" Lisp pointer to that object
2296 // - meaning we expect the correct lowtag on the pointer - except
2297 // that for code objects we don't require a correct lowtag
2298 // and we allow a pointer to anywhere in the object.
2300 // It should be possible to avoid calling search_dynamic_space
2301 // more of the time. First, check if the page pointed to might hold code.
2302 // If it does, then we continue regardless of the pointer's lowtag
2303 // (because of the special allowance). If the page definitely does *not*
2304 // hold code, then we require up front that the lowtake make sense,
2305 // by doing the same checks that are in properly_tagged_descriptor_p.
2307 // Problem: when code is allocated from a per-thread region,
2308 // does it ensure that the occupied pages are flagged as having code?
2311 preserve_pointer(void *addr
)
2313 #ifdef LISP_FEATURE_IMMOBILE_SPACE
2314 /* Immobile space MUST be lower than dynamic space,
2315 or else this test needs to be revised */
2316 if (addr
< (void*)IMMOBILE_SPACE_END
) {
2317 extern void immobile_space_preserve_pointer(void*);
2318 immobile_space_preserve_pointer(addr
);
2322 page_index_t addr_page_index
= find_page_index(addr
);
2324 #ifdef GENCGC_IS_PRECISE
2325 /* If we're in precise gencgc (non-x86oid as of this writing) then
2326 * we are only called on valid object pointers in the first place,
2327 * so we just have to do a bounds-check against the heap, a
2328 * generation check, and the already-pinned check. */
2329 if (addr_page_index
== -1
2330 || (page_table
[addr_page_index
].gen
!= from_space
)
2331 || page_table
[addr_page_index
].dont_move
)
2334 lispobj
*object_start
;
2335 if (addr_page_index
== -1
2336 || (object_start
= conservative_root_p(addr
, addr_page_index
)) == 0)
2340 /* (Now that we know that addr_page_index is in range, it's
2341 * safe to index into page_table[] with it.) */
2342 unsigned int region_allocation
= page_table
[addr_page_index
].allocated
;
2344 /* Find the beginning of the region. Note that there may be
2345 * objects in the region preceding the one that we were passed a
2346 * pointer to: if this is the case, we will write-protect all the
2347 * previous objects' pages too. */
2350 /* I think this'd work just as well, but without the assertions.
2351 * -dan 2004.01.01 */
2352 page_index_t first_page
= find_page_index(page_scan_start(addr_page_index
))
2354 page_index_t first_page
= addr_page_index
;
2355 while (!page_starts_contiguous_block_p(first_page
)) {
2357 /* Do some checks. */
2358 gc_assert(page_bytes_used(first_page
) == GENCGC_CARD_BYTES
);
2359 gc_assert(page_table
[first_page
].gen
== from_space
);
2360 gc_assert(page_table
[first_page
].allocated
== region_allocation
);
2364 /* Adjust any large objects before promotion as they won't be
2365 * copied after promotion. */
2366 if (page_table
[first_page
].large_object
) {
2367 maybe_adjust_large_object(first_page
);
2368 /* It may have moved to unboxed pages. */
2369 region_allocation
= page_table
[first_page
].allocated
;
2372 /* Now work forward until the end of this contiguous area is found,
2373 * marking all pages as dont_move. */
2375 for (i
= first_page
; ;i
++) {
2376 gc_assert(page_table
[i
].allocated
== region_allocation
);
2378 /* Mark the page static. */
2379 page_table
[i
].dont_move
= 1;
2381 /* It is essential that the pages are not write protected as
2382 * they may have pointers into the old-space which need
2383 * scavenging. They shouldn't be write protected at this
2385 gc_assert(!page_table
[i
].write_protected
);
2387 /* Check whether this is the last page in this contiguous block.. */
2388 if (page_ends_contiguous_block_p(i
, from_space
))
2392 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
2393 /* Do not do this for multi-page objects. Those pages do not need
2394 * object wipeout anyway.
2396 if (do_wipe_p
&& i
== first_page
) { // single-page object
2397 lispobj word
= *object_start
;
2398 int lowtag
= is_cons_half(word
) ?
2399 LIST_POINTER_LOWTAG
: lowtag_for_widetag
[widetag_of(word
)>>2];
2400 pin_object(make_lispobj(object_start
, lowtag
));
2401 page_table
[i
].has_pins
= 1;
2405 /* Check that the page is now static. */
2406 gc_assert(page_table
[addr_page_index
].dont_move
!= 0);
2410 #define IN_REGION_P(a,kind) (kind##_region.start_addr<=a && a<=kind##_region.free_pointer)
2411 #ifdef LISP_FEATURE_SEGREGATED_CODE
2412 #define IN_BOXED_REGION_P(a) IN_REGION_P(a,boxed)||IN_REGION_P(a,code)
2414 #define IN_BOXED_REGION_P(a) IN_REGION_P(a,boxed)
2417 /* If the given page is not write-protected, then scan it for pointers
2418 * to younger generations or the top temp. generation, if no
2419 * suspicious pointers are found then the page is write-protected.
2421 * Care is taken to check for pointers to the current gc_alloc()
2422 * region if it is a younger generation or the temp. generation. This
2423 * frees the caller from doing a gc_alloc_update_page_tables(). Actually
2424 * the gc_alloc_generation does not need to be checked as this is only
2425 * called from scavenge_generation() when the gc_alloc generation is
2426 * younger, so it just checks if there is a pointer to the current
2429 * We return 1 if the page was write-protected, else 0. */
2431 update_page_write_prot(page_index_t page
)
2433 generation_index_t gen
= page_table
[page
].gen
;
2436 void **page_addr
= (void **)page_address(page
);
2437 sword_t num_words
= page_bytes_used(page
) / N_WORD_BYTES
;
2439 /* Shouldn't be a free page. */
2440 gc_assert(!page_free_p(page
));
2441 gc_assert(page_bytes_used(page
) != 0);
2443 /* Skip if it's already write-protected, pinned, or unboxed */
2444 if (page_table
[page
].write_protected
2445 /* FIXME: What's the reason for not write-protecting pinned pages? */
2446 || page_table
[page
].dont_move
2447 || page_unboxed_p(page
))
2450 /* Scan the page for pointers to younger generations or the
2451 * top temp. generation. */
2453 /* This is conservative: any word satisfying is_lisp_pointer() is
2454 * assumed to be a pointer. To do otherwise would require a family
2455 * of scavenge-like functions. */
2456 for (j
= 0; j
< num_words
; j
++) {
2457 void *ptr
= *(page_addr
+j
);
2459 lispobj
__attribute__((unused
)) header
;
2461 if (!is_lisp_pointer((lispobj
)ptr
))
2463 /* Check that it's in the dynamic space */
2464 if ((index
= find_page_index(ptr
)) != -1) {
2465 if (/* Does it point to a younger or the temp. generation? */
2466 (!page_free_p(index
)
2467 && (page_bytes_used(index
) != 0)
2468 && ((page_table
[index
].gen
< gen
)
2469 || (page_table
[index
].gen
== SCRATCH_GENERATION
)))
2471 /* Or does it point within a current gc_alloc() region? */
2472 || (IN_BOXED_REGION_P(ptr
) || IN_REGION_P(ptr
,unboxed
))) {
2477 #ifdef LISP_FEATURE_IMMOBILE_SPACE
2478 else if ((index
= find_immobile_page_index(ptr
)) >= 0 &&
2479 other_immediate_lowtag_p(header
= *native_pointer((lispobj
)ptr
))) {
2480 // This is *possibly* a pointer to an object in immobile space,
2481 // given that above two conditions were satisfied.
2482 // But unlike in the dynamic space case, we need to read a byte
2483 // from the object to determine its generation, which requires care.
2484 // Consider an unboxed word that looks like a pointer to a word that
2485 // looks like fun-header-widetag. We can't naively back up to the
2486 // underlying code object since the alleged header might not be one.
2487 int obj_gen
= gen
; // Make comparison fail if we fall through
2488 if (lowtag_of((lispobj
)ptr
) != FUN_POINTER_LOWTAG
) {
2489 obj_gen
= __immobile_obj_generation(native_pointer((lispobj
)ptr
));
2490 } else if (widetag_of(header
) == SIMPLE_FUN_WIDETAG
) {
2491 lispobj
* code
= fun_code_header((lispobj
)ptr
- FUN_POINTER_LOWTAG
);
2492 // This is a heuristic, since we're not actually looking for
2493 // an object boundary. Precise scanning of 'page' would obviate
2494 // the guard conditions here.
2495 if ((lispobj
)code
>= IMMOBILE_VARYOBJ_SUBSPACE_START
2496 && widetag_of(*code
) == CODE_HEADER_WIDETAG
)
2497 obj_gen
= __immobile_obj_generation(code
);
2499 // A bogus generation number implies a not-really-pointer,
2500 // but it won't cause misbehavior.
2501 if (obj_gen
< gen
|| obj_gen
== SCRATCH_GENERATION
) {
2510 /* Write-protect the page. */
2511 /*FSHOW((stderr, "/write-protecting page %d gen %d\n", page, gen));*/
2513 os_protect((void *)page_addr
,
2515 OS_VM_PROT_READ
|OS_VM_PROT_EXECUTE
);
2517 /* Note the page as protected in the page tables. */
2518 page_table
[page
].write_protected
= 1;
2524 /* Is this page holding a normal (non-hashtable) large-object
2526 static inline boolean
large_simple_vector_p(page_index_t page
) {
2527 if (!page_table
[page
].large_object
)
2529 lispobj object
= *(lispobj
*)page_address(page
);
2530 return widetag_of(object
) == SIMPLE_VECTOR_WIDETAG
&&
2531 (HeaderValue(object
) & 0xFF) == subtype_VectorNormal
;
2535 /* Scavenge all generations from FROM to TO, inclusive, except for
2536 * new_space which needs special handling, as new objects may be
2537 * added which are not checked here - use scavenge_newspace generation.
2539 * Write-protected pages should not have any pointers to the
2540 * from_space so do need scavenging; thus write-protected pages are
2541 * not always scavenged. There is some code to check that these pages
2542 * are not written; but to check fully the write-protected pages need
2543 * to be scavenged by disabling the code to skip them.
2545 * Under the current scheme when a generation is GCed the younger
2546 * generations will be empty. So, when a generation is being GCed it
2547 * is only necessary to scavenge the older generations for pointers
2548 * not the younger. So a page that does not have pointers to younger
2549 * generations does not need to be scavenged.
2551 * The write-protection can be used to note pages that don't have
2552 * pointers to younger pages. But pages can be written without having
2553 * pointers to younger generations. After the pages are scavenged here
2554 * they can be scanned for pointers to younger generations and if
2555 * there are none the page can be write-protected.
2557 * One complication is when the newspace is the top temp. generation.
2559 * Enabling SC_GEN_CK scavenges the write-protected pages and checks
2560 * that none were written, which they shouldn't be as they should have
2561 * no pointers to younger generations. This breaks down for weak
2562 * pointers as the objects contain a link to the next and are written
2563 * if a weak pointer is scavenged. Still it's a useful check. */
2565 scavenge_generations(generation_index_t from
, generation_index_t to
)
2568 page_index_t num_wp
= 0;
2572 /* Clear the write_protected_cleared flags on all pages. */
2573 for (i
= 0; i
< page_table_pages
; i
++)
2574 page_table
[i
].write_protected_cleared
= 0;
2577 for (i
= 0; i
< last_free_page
; i
++) {
2578 generation_index_t generation
= page_table
[i
].gen
;
2580 && (page_bytes_used(i
) != 0)
2581 && (generation
!= new_space
)
2582 && (generation
>= from
)
2583 && (generation
<= to
)) {
2584 page_index_t last_page
,j
;
2585 int write_protected
=1;
2587 /* This should be the start of a region */
2588 gc_assert(page_starts_contiguous_block_p(i
));
2590 if (large_simple_vector_p(i
)) {
2591 /* Scavenge only the unprotected pages of a
2592 * large-object vector, other large objects could be
2593 * handled as well, but vectors are easier to deal
2594 * with and are more likely to grow to very large
2595 * sizes where avoiding scavenging the whole thing is
2597 if (!page_table
[i
].write_protected
) {
2598 scavenge((lispobj
*)page_address(i
) + 2,
2599 GENCGC_CARD_BYTES
/ N_WORD_BYTES
- 2);
2600 update_page_write_prot(i
);
2602 for (last_page
= i
+ 1; ; last_page
++) {
2603 lispobj
* start
= (lispobj
*)page_address(last_page
);
2604 write_protected
= page_table
[last_page
].write_protected
;
2605 if (page_ends_contiguous_block_p(last_page
, generation
)) {
2606 if (!write_protected
) {
2607 scavenge(start
, page_bytes_used(last_page
) / N_WORD_BYTES
);
2608 update_page_write_prot(last_page
);
2612 if (!write_protected
) {
2613 scavenge(start
, GENCGC_CARD_BYTES
/ N_WORD_BYTES
);
2614 update_page_write_prot(last_page
);
2618 /* Now work forward until the end of the region */
2619 for (last_page
= i
; ; last_page
++) {
2621 write_protected
&& page_table
[last_page
].write_protected
;
2622 if (page_ends_contiguous_block_p(last_page
, generation
))
2625 if (!write_protected
) {
2626 heap_scavenge((lispobj
*)page_address(i
),
2627 (lispobj
*)(page_address(last_page
)
2628 + page_bytes_used(last_page
)));
2630 /* Now scan the pages and write protect those that
2631 * don't have pointers to younger generations. */
2632 if (enable_page_protection
) {
2633 for (j
= i
; j
<= last_page
; j
++) {
2634 num_wp
+= update_page_write_prot(j
);
2637 if ((gencgc_verbose
> 1) && (num_wp
!= 0)) {
2639 "/write protected %d pages within generation %d\n",
2640 num_wp
, generation
));
2649 /* Check that none of the write_protected pages in this generation
2650 * have been written to. */
2651 for (i
= 0; i
< page_table_pages
; i
++) {
2653 && (page_bytes_used(i
) != 0)
2654 && (page_table
[i
].gen
== generation
)
2655 && (page_table
[i
].write_protected_cleared
!= 0)) {
2656 FSHOW((stderr
, "/scavenge_generation() %d\n", generation
));
2658 "/page bytes_used=%d scan_start_offset=%lu dont_move=%d\n",
2660 scan_start_offset(page_table
[i
]),
2661 page_table
[i
].dont_move
));
2662 lose("write to protected page %d in scavenge_generation()\n", i
);
2669 /* Scavenge a newspace generation. As it is scavenged new objects may
2670 * be allocated to it; these will also need to be scavenged. This
2671 * repeats until there are no more objects unscavenged in the
2672 * newspace generation.
2674 * To help improve the efficiency, areas written are recorded by
2675 * gc_alloc() and only these scavenged. Sometimes a little more will be
2676 * scavenged, but this causes no harm. An easy check is done that the
2677 * scavenged bytes equals the number allocated in the previous
2680 * Write-protected pages are not scanned except if they are marked
2681 * dont_move in which case they may have been promoted and still have
2682 * pointers to the from space.
2684 * Write-protected pages could potentially be written by alloc however
2685 * to avoid having to handle re-scavenging of write-protected pages
2686 * gc_alloc() does not write to write-protected pages.
2688 * New areas of objects allocated are recorded alternatively in the two
2689 * new_areas arrays below. */
2690 static struct new_area new_areas_1
[NUM_NEW_AREAS
];
2691 static struct new_area new_areas_2
[NUM_NEW_AREAS
];
2693 #ifdef LISP_FEATURE_IMMOBILE_SPACE
2694 extern unsigned int immobile_scav_queue_count
;
2697 update_immobile_nursery_bits(),
2698 scavenge_immobile_roots(generation_index_t
,generation_index_t
),
2699 scavenge_immobile_newspace(),
2700 sweep_immobile_space(int raise
),
2701 write_protect_immobile_space();
2703 #define immobile_scav_queue_count 0
2706 /* Do one full scan of the new space generation. This is not enough to
2707 * complete the job as new objects may be added to the generation in
2708 * the process which are not scavenged. */
2710 scavenge_newspace_generation_one_scan(generation_index_t generation
)
2715 "/starting one full scan of newspace generation %d\n",
2717 for (i
= 0; i
< last_free_page
; i
++) {
2718 /* Note that this skips over open regions when it encounters them. */
2720 && (page_bytes_used(i
) != 0)
2721 && (page_table
[i
].gen
== generation
)
2722 && ((page_table
[i
].write_protected
== 0)
2723 /* (This may be redundant as write_protected is now
2724 * cleared before promotion.) */
2725 || (page_table
[i
].dont_move
== 1))) {
2726 page_index_t last_page
;
2729 /* The scavenge will start at the scan_start_offset of
2732 * We need to find the full extent of this contiguous
2733 * block in case objects span pages.
2735 * Now work forward until the end of this contiguous area
2736 * is found. A small area is preferred as there is a
2737 * better chance of its pages being write-protected. */
2738 for (last_page
= i
; ;last_page
++) {
2739 /* If all pages are write-protected and movable,
2740 * then no need to scavenge */
2741 all_wp
=all_wp
&& page_table
[last_page
].write_protected
&&
2742 !page_table
[last_page
].dont_move
;
2744 /* Check whether this is the last page in this
2745 * contiguous block */
2746 if (page_ends_contiguous_block_p(last_page
, generation
))
2750 /* Do a limited check for write-protected pages. */
2752 new_areas_ignore_page
= last_page
;
2753 heap_scavenge(page_scan_start(i
),
2754 (lispobj
*)(page_address(last_page
)
2755 + page_bytes_used(last_page
)));
2761 "/done with one full scan of newspace generation %d\n",
2765 /* Do a complete scavenge of the newspace generation. */
2767 scavenge_newspace_generation(generation_index_t generation
)
2771 /* the new_areas array currently being written to by gc_alloc() */
2772 struct new_area (*current_new_areas
)[] = &new_areas_1
;
2773 size_t current_new_areas_index
;
2775 /* the new_areas created by the previous scavenge cycle */
2776 struct new_area (*previous_new_areas
)[] = NULL
;
2777 size_t previous_new_areas_index
;
2779 /* Flush the current regions updating the tables. */
2780 gc_alloc_update_all_page_tables(0);
2782 /* Turn on the recording of new areas by gc_alloc(). */
2783 new_areas
= current_new_areas
;
2784 new_areas_index
= 0;
2786 /* Don't need to record new areas that get scavenged anyway during
2787 * scavenge_newspace_generation_one_scan. */
2788 record_new_objects
= 1;
2790 /* Start with a full scavenge. */
2791 scavenge_newspace_generation_one_scan(generation
);
2793 /* Record all new areas now. */
2794 record_new_objects
= 2;
2796 /* Give a chance to weak hash tables to make other objects live.
2797 * FIXME: The algorithm implemented here for weak hash table gcing
2798 * is O(W^2+N) as Bruno Haible warns in
2799 * http://www.haible.de/bruno/papers/cs/weak/WeakDatastructures-writeup.html
2800 * see "Implementation 2". */
2801 scav_weak_hash_tables();
2803 /* Flush the current regions updating the tables. */
2804 gc_alloc_update_all_page_tables(0);
2806 /* Grab new_areas_index. */
2807 current_new_areas_index
= new_areas_index
;
2810 "The first scan is finished; current_new_areas_index=%d.\n",
2811 current_new_areas_index));*/
2813 while (current_new_areas_index
> 0 || immobile_scav_queue_count
) {
2814 /* Move the current to the previous new areas */
2815 previous_new_areas
= current_new_areas
;
2816 previous_new_areas_index
= current_new_areas_index
;
2818 /* Scavenge all the areas in previous new areas. Any new areas
2819 * allocated are saved in current_new_areas. */
2821 /* Allocate an array for current_new_areas; alternating between
2822 * new_areas_1 and 2 */
2823 if (previous_new_areas
== &new_areas_1
)
2824 current_new_areas
= &new_areas_2
;
2826 current_new_areas
= &new_areas_1
;
2828 /* Set up for gc_alloc(). */
2829 new_areas
= current_new_areas
;
2830 new_areas_index
= 0;
2832 #ifdef LISP_FEATURE_IMMOBILE_SPACE
2833 scavenge_immobile_newspace();
2835 /* Check whether previous_new_areas had overflowed. */
2836 if (previous_new_areas_index
>= NUM_NEW_AREAS
) {
2838 /* New areas of objects allocated have been lost so need to do a
2839 * full scan to be sure! If this becomes a problem try
2840 * increasing NUM_NEW_AREAS. */
2841 if (gencgc_verbose
) {
2842 SHOW("new_areas overflow, doing full scavenge");
2845 /* Don't need to record new areas that get scavenged
2846 * anyway during scavenge_newspace_generation_one_scan. */
2847 record_new_objects
= 1;
2849 scavenge_newspace_generation_one_scan(generation
);
2851 /* Record all new areas now. */
2852 record_new_objects
= 2;
2854 scav_weak_hash_tables();
2856 /* Flush the current regions updating the tables. */
2857 gc_alloc_update_all_page_tables(0);
2861 /* Work through previous_new_areas. */
2862 for (i
= 0; i
< previous_new_areas_index
; i
++) {
2863 page_index_t page
= (*previous_new_areas
)[i
].page
;
2864 size_t offset
= (*previous_new_areas
)[i
].offset
;
2865 size_t size
= (*previous_new_areas
)[i
].size
;
2866 gc_assert(size
% N_WORD_BYTES
== 0);
2867 lispobj
*start
= (lispobj
*)(page_address(page
) + offset
);
2868 heap_scavenge(start
, (lispobj
*)((char*)start
+ size
));
2871 scav_weak_hash_tables();
2873 /* Flush the current regions updating the tables. */
2874 gc_alloc_update_all_page_tables(0);
2877 current_new_areas_index
= new_areas_index
;
2880 "The re-scan has finished; current_new_areas_index=%d.\n",
2881 current_new_areas_index));*/
2884 /* Turn off recording of areas allocated by gc_alloc(). */
2885 record_new_objects
= 0;
2890 /* Check that none of the write_protected pages in this generation
2891 * have been written to. */
2892 for (i
= 0; i
< page_table_pages
; i
++) {
2894 && (page_bytes_used(i
) != 0)
2895 && (page_table
[i
].gen
== generation
)
2896 && (page_table
[i
].write_protected_cleared
!= 0)
2897 && (page_table
[i
].dont_move
== 0)) {
2898 lose("write protected page %d written to in scavenge_newspace_generation\ngeneration=%d dont_move=%d\n",
2899 i
, generation
, page_table
[i
].dont_move
);
2906 /* Un-write-protect all the pages in from_space. This is done at the
2907 * start of a GC else there may be many page faults while scavenging
2908 * the newspace (I've seen drive the system time to 99%). These pages
2909 * would need to be unprotected anyway before unmapping in
2910 * free_oldspace; not sure what effect this has on paging.. */
2912 unprotect_oldspace(void)
2915 char *region_addr
= 0;
2916 char *page_addr
= 0;
2917 uword_t region_bytes
= 0;
2919 for (i
= 0; i
< last_free_page
; i
++) {
2921 && (page_bytes_used(i
) != 0)
2922 && (page_table
[i
].gen
== from_space
)) {
2924 /* Remove any write-protection. We should be able to rely
2925 * on the write-protect flag to avoid redundant calls. */
2926 if (page_table
[i
].write_protected
) {
2927 page_table
[i
].write_protected
= 0;
2928 page_addr
= page_address(i
);
2931 region_addr
= page_addr
;
2932 region_bytes
= GENCGC_CARD_BYTES
;
2933 } else if (region_addr
+ region_bytes
== page_addr
) {
2934 /* Region continue. */
2935 region_bytes
+= GENCGC_CARD_BYTES
;
2937 /* Unprotect previous region. */
2938 os_protect(region_addr
, region_bytes
, OS_VM_PROT_ALL
);
2939 /* First page in new region. */
2940 region_addr
= page_addr
;
2941 region_bytes
= GENCGC_CARD_BYTES
;
2947 /* Unprotect last region. */
2948 os_protect(region_addr
, region_bytes
, OS_VM_PROT_ALL
);
2952 /* Work through all the pages and free any in from_space. This
2953 * assumes that all objects have been copied or promoted to an older
2954 * generation. Bytes_allocated and the generation bytes_allocated
2955 * counter are updated. The number of bytes freed is returned. */
2959 uword_t bytes_freed
= 0;
2960 page_index_t first_page
, last_page
;
2965 /* Find a first page for the next region of pages. */
2966 while ((first_page
< last_free_page
)
2967 && (page_free_p(first_page
)
2968 || (page_bytes_used(first_page
) == 0)
2969 || (page_table
[first_page
].gen
!= from_space
)))
2972 if (first_page
>= last_free_page
)
2975 /* Find the last page of this region. */
2976 last_page
= first_page
;
2979 /* Free the page. */
2980 bytes_freed
+= page_bytes_used(last_page
);
2981 generations
[page_table
[last_page
].gen
].bytes_allocated
-=
2982 page_bytes_used(last_page
);
2983 page_table
[last_page
].allocated
= FREE_PAGE_FLAG
;
2984 set_page_bytes_used(last_page
, 0);
2985 /* Should already be unprotected by unprotect_oldspace(). */
2986 gc_assert(!page_table
[last_page
].write_protected
);
2989 while ((last_page
< last_free_page
)
2990 && !page_free_p(last_page
)
2991 && (page_bytes_used(last_page
) != 0)
2992 && (page_table
[last_page
].gen
== from_space
));
2994 #ifdef READ_PROTECT_FREE_PAGES
2995 os_protect(page_address(first_page
),
2996 npage_bytes(last_page
-first_page
),
2999 first_page
= last_page
;
3000 } while (first_page
< last_free_page
);
3002 bytes_allocated
-= bytes_freed
;
3007 /* Print some information about a pointer at the given address. */
3009 print_ptr(lispobj
*addr
)
3011 /* If addr is in the dynamic space then out the page information. */
3012 page_index_t pi1
= find_page_index((void*)addr
);
3015 fprintf(stderr
," %p: page %d alloc %d gen %d bytes_used %d offset %lu dont_move %d\n",
3018 page_table
[pi1
].allocated
,
3019 page_table
[pi1
].gen
,
3020 page_bytes_used(pi1
),
3021 scan_start_offset(page_table
[pi1
]),
3022 page_table
[pi1
].dont_move
);
3023 fprintf(stderr
," %x %x %x %x (%x) %x %x %x %x\n",
3037 is_in_stack_space(lispobj ptr
)
3039 /* For space verification: Pointers can be valid if they point
3040 * to a thread stack space. This would be faster if the thread
3041 * structures had page-table entries as if they were part of
3042 * the heap space. */
3044 for_each_thread(th
) {
3045 if ((th
->control_stack_start
<= (lispobj
*)ptr
) &&
3046 (th
->control_stack_end
>= (lispobj
*)ptr
)) {
3053 // NOTE: This function can produces false failure indications,
3054 // usually related to dynamic space pointing to the stack of a
3055 // dead thread, but there may be other reasons as well.
3057 verify_range(lispobj
*start
, size_t words
)
3059 extern int valid_lisp_pointer_p(lispobj
);
3060 int is_in_readonly_space
=
3061 (READ_ONLY_SPACE_START
<= (uword_t
)start
&&
3062 (uword_t
)start
< SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0));
3063 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3064 int is_in_immobile_space
=
3065 (IMMOBILE_SPACE_START
<= (uword_t
)start
&&
3066 (uword_t
)start
< SymbolValue(IMMOBILE_SPACE_FREE_POINTER
,0));
3069 lispobj
*end
= start
+ words
;
3071 for ( ; start
< end
; start
+= count
) {
3073 lispobj thing
= *start
;
3074 lispobj
__attribute__((unused
)) pointee
;
3076 if (is_lisp_pointer(thing
)) {
3077 page_index_t page_index
= find_page_index((void*)thing
);
3078 sword_t to_readonly_space
=
3079 (READ_ONLY_SPACE_START
<= thing
&&
3080 thing
< SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0));
3081 sword_t to_static_space
=
3082 (STATIC_SPACE_START
<= thing
&&
3083 thing
< SymbolValue(STATIC_SPACE_FREE_POINTER
,0));
3084 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3085 sword_t to_immobile_space
=
3086 (IMMOBILE_SPACE_START
<= thing
&&
3087 thing
< SymbolValue(IMMOBILE_FIXEDOBJ_FREE_POINTER
,0)) ||
3088 (IMMOBILE_VARYOBJ_SUBSPACE_START
<= thing
&&
3089 thing
< SymbolValue(IMMOBILE_SPACE_FREE_POINTER
,0));
3092 /* Does it point to the dynamic space? */
3093 if (page_index
!= -1) {
3094 /* If it's within the dynamic space it should point to a used page. */
3095 if (page_free_p(page_index
))
3096 lose ("Ptr %p @ %p sees free page.\n", thing
, start
);
3097 if ((thing
& (GENCGC_CARD_BYTES
-1)) >= page_bytes_used(page_index
))
3098 lose ("Ptr %p @ %p sees unallocated space.\n", thing
, start
);
3099 /* Check that it doesn't point to a forwarding pointer! */
3100 if (*native_pointer(thing
) == 0x01) {
3101 lose("Ptr %p @ %p sees forwarding ptr.\n", thing
, start
);
3103 /* Check that its not in the RO space as it would then be a
3104 * pointer from the RO to the dynamic space. */
3105 if (is_in_readonly_space
) {
3106 lose("ptr to dynamic space %p from RO space %x\n",
3109 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3110 // verify all immobile space -> dynamic space pointers
3111 if (is_in_immobile_space
&& !valid_lisp_pointer_p(thing
)) {
3112 lose("Ptr %p @ %p sees junk.\n", thing
, start
);
3115 /* Does it point to a plausible object? This check slows
3116 * it down a lot (so it's commented out).
3118 * "a lot" is serious: it ate 50 minutes cpu time on
3119 * my duron 950 before I came back from lunch and
3122 * FIXME: Add a variable to enable this
3125 if (!valid_lisp_pointer_p((lispobj *)thing) {
3126 lose("ptr %p to invalid object %p\n", thing, start);
3129 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3130 } else if (to_immobile_space
) {
3131 // the object pointed to must not have been discarded as garbage
3132 if (!other_immediate_lowtag_p(*native_pointer(thing
))
3133 || immobile_filler_p(native_pointer(thing
)))
3134 lose("Ptr %p @ %p sees trashed object.\n", (void*)thing
, start
);
3135 // verify all pointers to immobile space
3136 if (!valid_lisp_pointer_p(thing
))
3137 lose("Ptr %p @ %p sees junk.\n", thing
, start
);
3140 extern char __attribute__((unused
)) funcallable_instance_tramp
;
3141 /* Verify that it points to another valid space. */
3142 if (!to_readonly_space
&& !to_static_space
3143 && !is_in_stack_space(thing
)) {
3144 lose("Ptr %p @ %p sees junk.\n", thing
, start
);
3149 int widetag
= widetag_of(thing
);
3150 if (is_lisp_immediate(thing
) || widetag
== NO_TLS_VALUE_MARKER_WIDETAG
) {
3151 /* skip immediates */
3152 } else if (!(other_immediate_lowtag_p(widetag
)
3153 && lowtag_for_widetag
[widetag
>>2])) {
3154 lose("Unhandled widetag %p at %p\n", widetag
, start
);
3155 } else if (unboxed_obj_widetag_p(widetag
)) {
3156 count
= sizetab
[widetag
](start
);
3157 } else switch(widetag
) {
3158 /* boxed or partially boxed objects */
3159 // FIXME: x86-64 can have partially unboxed FINs. The raw words
3160 // are at the moment valid fixnums by blind luck.
3161 case INSTANCE_WIDETAG
:
3162 if (instance_layout(start
)) {
3163 sword_t nslots
= instance_length(thing
) | 1;
3164 instance_scan(verify_range
, start
+1, nslots
,
3166 native_pointer(instance_layout(start
)))->bitmap
);
3170 case CODE_HEADER_WIDETAG
:
3172 struct code
*code
= (struct code
*) start
;
3173 sword_t nheader_words
= code_header_words(code
->header
);
3174 /* Scavenge the boxed section of the code data block */
3175 verify_range(start
+ 1, nheader_words
- 1);
3177 /* Scavenge the boxed section of each function
3178 * object in the code data block. */
3179 for_each_simple_fun(i
, fheaderp
, code
, 1, {
3180 verify_range(SIMPLE_FUN_SCAV_START(fheaderp
),
3181 SIMPLE_FUN_SCAV_NWORDS(fheaderp
)); });
3182 count
= nheader_words
+ code_instruction_words(code
->code_size
);
3185 #ifdef LISP_FEATURE_IMMOBILE_CODE
3187 verify_range(start
+ 1, 2);
3188 pointee
= fdefn_raw_referent((struct fdefn
*)start
);
3189 verify_range(&pointee
, 1);
3190 count
= CEILING(sizeof (struct fdefn
)/sizeof(lispobj
), 2);
3196 static uword_t
verify_space(lispobj start
, lispobj end
) {
3197 verify_range((lispobj
*)start
, (end
-start
)>>WORD_SHIFT
);
3201 static void verify_dynamic_space();
3206 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3208 // Try this verification if marknsweep was compiled with extra debugging.
3209 // But weak symbols don't work on macOS.
3210 extern void __attribute__((weak
)) check_varyobj_pages();
3211 if (&check_varyobj_pages
) check_varyobj_pages();
3213 verify_space(IMMOBILE_SPACE_START
,
3214 SymbolValue(IMMOBILE_FIXEDOBJ_FREE_POINTER
,0));
3215 verify_space(IMMOBILE_VARYOBJ_SUBSPACE_START
,
3216 SymbolValue(IMMOBILE_SPACE_FREE_POINTER
,0));
3219 for_each_thread(th
) {
3220 verify_space((lispobj
)th
->binding_stack_start
,
3221 (lispobj
)get_binding_stack_pointer(th
));
3223 verify_space(READ_ONLY_SPACE_START
,
3224 SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0));
3225 verify_space(STATIC_SPACE_START
,
3226 SymbolValue(STATIC_SPACE_FREE_POINTER
,0));
3227 verify_dynamic_space();
3230 /* Call 'proc' with pairs of addresses demarcating ranges in the
3231 * specified generation.
3232 * Stop if any invocation returns non-zero, and return that value */
3234 walk_generation(uword_t (*proc
)(lispobj
*,lispobj
*,uword_t
),
3235 generation_index_t generation
, uword_t extra
)
3238 int genmask
= generation
>= 0 ? 1 << generation
: ~0;
3240 for (i
= 0; i
< last_free_page
; i
++) {
3242 && (page_bytes_used(i
) != 0)
3243 && ((1 << page_table
[i
].gen
) & genmask
)) {
3244 page_index_t last_page
;
3246 /* This should be the start of a contiguous block */
3247 gc_assert(page_starts_contiguous_block_p(i
));
3249 /* Need to find the full extent of this contiguous block in case
3250 objects span pages. */
3252 /* Now work forward until the end of this contiguous area is
3254 for (last_page
= i
; ;last_page
++)
3255 /* Check whether this is the last page in this contiguous
3257 if (page_ends_contiguous_block_p(last_page
, page_table
[i
].gen
))
3261 proc((lispobj
*)page_address(i
),
3262 (lispobj
*)(page_bytes_used(last_page
) + page_address(last_page
)),
3264 if (result
) return result
;
3271 static void verify_generation(generation_index_t generation
)
3273 walk_generation((uword_t(*)(lispobj
*,lispobj
*,uword_t
))verify_space
,
3277 /* Check that all the free space is zero filled. */
3279 verify_zero_fill(void)
3283 for (page
= 0; page
< last_free_page
; page
++) {
3284 if (page_free_p(page
)) {
3285 /* The whole page should be zero filled. */
3286 sword_t
*start_addr
= (sword_t
*)page_address(page
);
3288 for (i
= 0; i
< (sword_t
)GENCGC_CARD_BYTES
/N_WORD_BYTES
; i
++) {
3289 if (start_addr
[i
] != 0) {
3290 lose("free page not zero at %x\n", start_addr
+ i
);
3294 sword_t free_bytes
= GENCGC_CARD_BYTES
- page_bytes_used(page
);
3295 if (free_bytes
> 0) {
3296 sword_t
*start_addr
=
3297 (sword_t
*)(page_address(page
) + page_bytes_used(page
));
3298 sword_t size
= free_bytes
/ N_WORD_BYTES
;
3300 for (i
= 0; i
< size
; i
++) {
3301 if (start_addr
[i
] != 0) {
3302 lose("free region not zero at %x\n", start_addr
+ i
);
3310 /* External entry point for verify_zero_fill */
3312 gencgc_verify_zero_fill(void)
3314 /* Flush the alloc regions updating the tables. */
3315 gc_alloc_update_all_page_tables(1);
3316 SHOW("verifying zero fill");
3321 verify_dynamic_space(void)
3323 verify_generation(-1);
3324 if (gencgc_enable_verify_zero_fill
)
3328 /* Write-protect all the dynamic boxed pages in the given generation. */
3330 write_protect_generation_pages(generation_index_t generation
)
3334 gc_assert(generation
< SCRATCH_GENERATION
);
3336 for (start
= 0; start
< last_free_page
; start
++) {
3337 if (protect_page_p(start
, generation
)) {
3341 /* Note the page as protected in the page tables. */
3342 page_table
[start
].write_protected
= 1;
3344 for (last
= start
+ 1; last
< last_free_page
; last
++) {
3345 if (!protect_page_p(last
, generation
))
3347 page_table
[last
].write_protected
= 1;
3350 page_start
= page_address(start
);
3352 os_protect(page_start
,
3353 npage_bytes(last
- start
),
3354 OS_VM_PROT_READ
| OS_VM_PROT_EXECUTE
);
3360 if (gencgc_verbose
> 1) {
3362 "/write protected %d of %d pages in generation %d\n",
3363 count_write_protect_generation_pages(generation
),
3364 count_generation_pages(generation
),
3369 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
3371 preserve_context_registers (void (*proc
)(os_context_register_t
), os_context_t
*c
)
3373 #ifdef LISP_FEATURE_SB_THREAD
3375 /* On Darwin the signal context isn't a contiguous block of memory,
3376 * so just preserve_pointering its contents won't be sufficient.
3378 #if defined(LISP_FEATURE_DARWIN)||defined(LISP_FEATURE_WIN32)
3379 #if defined LISP_FEATURE_X86
3380 proc(*os_context_register_addr(c
,reg_EAX
));
3381 proc(*os_context_register_addr(c
,reg_ECX
));
3382 proc(*os_context_register_addr(c
,reg_EDX
));
3383 proc(*os_context_register_addr(c
,reg_EBX
));
3384 proc(*os_context_register_addr(c
,reg_ESI
));
3385 proc(*os_context_register_addr(c
,reg_EDI
));
3386 proc(*os_context_pc_addr(c
));
3387 #elif defined LISP_FEATURE_X86_64
3388 proc(*os_context_register_addr(c
,reg_RAX
));
3389 proc(*os_context_register_addr(c
,reg_RCX
));
3390 proc(*os_context_register_addr(c
,reg_RDX
));
3391 proc(*os_context_register_addr(c
,reg_RBX
));
3392 proc(*os_context_register_addr(c
,reg_RSI
));
3393 proc(*os_context_register_addr(c
,reg_RDI
));
3394 proc(*os_context_register_addr(c
,reg_R8
));
3395 proc(*os_context_register_addr(c
,reg_R9
));
3396 proc(*os_context_register_addr(c
,reg_R10
));
3397 proc(*os_context_register_addr(c
,reg_R11
));
3398 proc(*os_context_register_addr(c
,reg_R12
));
3399 proc(*os_context_register_addr(c
,reg_R13
));
3400 proc(*os_context_register_addr(c
,reg_R14
));
3401 proc(*os_context_register_addr(c
,reg_R15
));
3402 proc(*os_context_pc_addr(c
));
3404 #error "preserve_context_registers needs to be tweaked for non-x86 Darwin"
3407 #if !defined(LISP_FEATURE_WIN32)
3408 for(ptr
= ((void **)(c
+1))-1; ptr
>=(void **)c
; ptr
--) {
3409 proc((os_context_register_t
)*ptr
);
3412 #endif // LISP_FEATURE_SB_THREAD
3417 move_pinned_pages_to_newspace()
3421 /* scavenge() will evacuate all oldspace pages, but no newspace
3422 * pages. Pinned pages are precisely those pages which must not
3423 * be evacuated, so move them to newspace directly. */
3425 for (i
= 0; i
< last_free_page
; i
++) {
3426 if (page_table
[i
].dont_move
&&
3427 /* dont_move is cleared lazily, so validate the space as well. */
3428 page_table
[i
].gen
== from_space
) {
3429 if (do_wipe_p
&& page_table
[i
].has_pins
) {
3430 // do not move to newspace after all, this will be word-wiped
3433 page_table
[i
].gen
= new_space
;
3434 /* And since we're moving the pages wholesale, also adjust
3435 * the generation allocation counters. */
3436 int used
= page_bytes_used(i
);
3437 generations
[new_space
].bytes_allocated
+= used
;
3438 generations
[from_space
].bytes_allocated
-= used
;
3443 /* Garbage collect a generation. If raise is 0 then the remains of the
3444 * generation are not raised to the next generation. */
3446 garbage_collect_generation(generation_index_t generation
, int raise
)
3451 gc_assert(generation
<= HIGHEST_NORMAL_GENERATION
);
3453 /* The oldest generation can't be raised. */
3454 gc_assert((generation
!= HIGHEST_NORMAL_GENERATION
) || (raise
== 0));
3456 /* Check if weak hash tables were processed in the previous GC. */
3457 gc_assert(weak_hash_tables
== NULL
);
3459 /* Initialize the weak pointer list. */
3460 weak_pointers
= NULL
;
3462 /* When a generation is not being raised it is transported to a
3463 * temporary generation (NUM_GENERATIONS), and lowered when
3464 * done. Set up this new generation. There should be no pages
3465 * allocated to it yet. */
3467 gc_assert(generations
[SCRATCH_GENERATION
].bytes_allocated
== 0);
3470 /* Set the global src and dest. generations */
3471 from_space
= generation
;
3473 new_space
= generation
+1;
3475 new_space
= SCRATCH_GENERATION
;
3477 /* Change to a new space for allocation, resetting the alloc_start_page */
3478 gc_alloc_generation
= new_space
;
3479 #ifdef LISP_FEATURE_SEGREGATED_CODE
3480 bzero(generations
[new_space
].alloc_start_page_
,
3481 sizeof generations
[new_space
].alloc_start_page_
);
3483 generations
[new_space
].alloc_start_page
= 0;
3484 generations
[new_space
].alloc_unboxed_start_page
= 0;
3485 generations
[new_space
].alloc_large_start_page
= 0;
3488 #ifndef GENCGC_IS_PRECISE
3489 hopscotch_reset(&pinned_objects
);
3491 /* Before any pointers are preserved, the dont_move flags on the
3492 * pages need to be cleared. */
3493 /* FIXME: consider moving this bitmap into its own range of words,
3494 * out of the page table. Then we can just bzero() it.
3495 * This will also obviate the extra test at the comment
3496 * "dont_move is cleared lazily" in move_pinned_pages_to_newspace().
3498 for (i
= 0; i
< last_free_page
; i
++)
3499 if(page_table
[i
].gen
==from_space
) {
3500 page_table
[i
].dont_move
= 0;
3503 /* Un-write-protect the old-space pages. This is essential for the
3504 * promoted pages as they may contain pointers into the old-space
3505 * which need to be scavenged. It also helps avoid unnecessary page
3506 * faults as forwarding pointers are written into them. They need to
3507 * be un-protected anyway before unmapping later. */
3508 unprotect_oldspace();
3510 /* Scavenge the stacks' conservative roots. */
3512 /* there are potentially two stacks for each thread: the main
3513 * stack, which may contain Lisp pointers, and the alternate stack.
3514 * We don't ever run Lisp code on the altstack, but it may
3515 * host a sigcontext with lisp objects in it */
3517 /* what we need to do: (1) find the stack pointer for the main
3518 * stack; scavenge it (2) find the interrupt context on the
3519 * alternate stack that might contain lisp values, and scavenge
3522 /* we assume that none of the preceding applies to the thread that
3523 * initiates GC. If you ever call GC from inside an altstack
3524 * handler, you will lose. */
3526 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
3527 /* And if we're saving a core, there's no point in being conservative. */
3528 if (conservative_stack
) {
3529 for_each_thread(th
) {
3531 void **esp
=(void **)-1;
3532 if (th
->state
== STATE_DEAD
)
3534 # if defined(LISP_FEATURE_SB_SAFEPOINT)
3535 /* Conservative collect_garbage is always invoked with a
3536 * foreign C call or an interrupt handler on top of every
3537 * existing thread, so the stored SP in each thread
3538 * structure is valid, no matter which thread we are looking
3539 * at. For threads that were running Lisp code, the pitstop
3540 * and edge functions maintain this value within the
3541 * interrupt or exception handler. */
3542 esp
= os_get_csp(th
);
3543 assert_on_stack(th
, esp
);
3545 /* In addition to pointers on the stack, also preserve the
3546 * return PC, the only value from the context that we need
3547 * in addition to the SP. The return PC gets saved by the
3548 * foreign call wrapper, and removed from the control stack
3549 * into a register. */
3550 preserve_pointer(th
->pc_around_foreign_call
);
3552 /* And on platforms with interrupts: scavenge ctx registers. */
3554 /* Disabled on Windows, because it does not have an explicit
3555 * stack of `interrupt_contexts'. The reported CSP has been
3556 * chosen so that the current context on the stack is
3557 * covered by the stack scan. See also set_csp_from_context(). */
3558 # ifndef LISP_FEATURE_WIN32
3559 if (th
!= arch_os_get_current_thread()) {
3560 long k
= fixnum_value(
3561 SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,th
));
3563 preserve_context_registers((void(*)(os_context_register_t
))preserve_pointer
,
3564 th
->interrupt_contexts
[--k
]);
3567 # elif defined(LISP_FEATURE_SB_THREAD)
3569 if(th
==arch_os_get_current_thread()) {
3570 /* Somebody is going to burn in hell for this, but casting
3571 * it in two steps shuts gcc up about strict aliasing. */
3572 esp
= (void **)((void *)&raise
);
3575 free
=fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,th
));
3576 for(i
=free
-1;i
>=0;i
--) {
3577 os_context_t
*c
=th
->interrupt_contexts
[i
];
3578 esp1
= (void **) *os_context_register_addr(c
,reg_SP
);
3579 if (esp1
>=(void **)th
->control_stack_start
&&
3580 esp1
<(void **)th
->control_stack_end
) {
3581 if(esp1
<esp
) esp
=esp1
;
3582 preserve_context_registers((void(*)(os_context_register_t
))preserve_pointer
,
3588 esp
= (void **)((void *)&raise
);
3590 if (!esp
|| esp
== (void*) -1)
3591 lose("garbage_collect: no SP known for thread %x (OS %x)",
3593 for (ptr
= ((void **)th
->control_stack_end
)-1; ptr
>= esp
; ptr
--) {
3594 preserve_pointer(*ptr
);
3599 /* Non-x86oid systems don't have "conservative roots" as such, but
3600 * the same mechanism is used for objects pinned for use by alien
3602 for_each_thread(th
) {
3603 lispobj pin_list
= SymbolTlValue(PINNED_OBJECTS
,th
);
3604 while (pin_list
!= NIL
) {
3605 struct cons
*list_entry
=
3606 (struct cons
*)native_pointer(pin_list
);
3607 preserve_pointer((void*)list_entry
->car
);
3608 pin_list
= list_entry
->cdr
;
3614 if (gencgc_verbose
> 1) {
3615 sword_t num_dont_move_pages
= count_dont_move_pages();
3617 "/non-movable pages due to conservative pointers = %ld (%lu bytes)\n",
3618 num_dont_move_pages
,
3619 npage_bytes(num_dont_move_pages
));
3623 /* Now that all of the pinned (dont_move) pages are known, and
3624 * before we start to scavenge (and thus relocate) objects,
3625 * relocate the pinned pages to newspace, so that the scavenger
3626 * will not attempt to relocate their contents. */
3627 move_pinned_pages_to_newspace();
3629 /* Scavenge all the rest of the roots. */
3631 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
3633 * If not x86, we need to scavenge the interrupt context(s) and the
3638 for_each_thread(th
) {
3639 scavenge_interrupt_contexts(th
);
3640 scavenge_control_stack(th
);
3643 # ifdef LISP_FEATURE_SB_SAFEPOINT
3644 /* In this case, scrub all stacks right here from the GCing thread
3645 * instead of doing what the comment below says. Suboptimal, but
3648 scrub_thread_control_stack(th
);
3650 /* Scrub the unscavenged control stack space, so that we can't run
3651 * into any stale pointers in a later GC (this is done by the
3652 * stop-for-gc handler in the other threads). */
3653 scrub_control_stack();
3658 /* Scavenge the Lisp functions of the interrupt handlers, taking
3659 * care to avoid SIG_DFL and SIG_IGN. */
3660 for (i
= 0; i
< NSIG
; i
++) {
3661 union interrupt_handler handler
= interrupt_handlers
[i
];
3662 if (!ARE_SAME_HANDLER(handler
.c
, SIG_IGN
) &&
3663 !ARE_SAME_HANDLER(handler
.c
, SIG_DFL
)) {
3664 scavenge((lispobj
*)(interrupt_handlers
+ i
), 1);
3667 /* Scavenge the binding stacks. */
3670 for_each_thread(th
) {
3671 sword_t len
= (lispobj
*)get_binding_stack_pointer(th
) -
3672 th
->binding_stack_start
;
3673 scavenge((lispobj
*) th
->binding_stack_start
,len
);
3674 #ifdef LISP_FEATURE_SB_THREAD
3675 /* do the tls as well */
3676 len
=(SymbolValue(FREE_TLS_INDEX
,0) >> WORD_SHIFT
) -
3677 (sizeof (struct thread
))/(sizeof (lispobj
));
3678 scavenge((lispobj
*) (th
+1),len
);
3683 /* Scavenge static space. */
3684 if (gencgc_verbose
> 1) {
3686 "/scavenge static space: %d bytes\n",
3687 SymbolValue(STATIC_SPACE_FREE_POINTER
,0) - STATIC_SPACE_START
));
3689 heap_scavenge((lispobj
*)STATIC_SPACE_START
,
3690 (lispobj
*)SymbolValue(STATIC_SPACE_FREE_POINTER
,0));
3692 /* All generations but the generation being GCed need to be
3693 * scavenged. The new_space generation needs special handling as
3694 * objects may be moved in - it is handled separately below. */
3695 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3696 scavenge_immobile_roots(generation
+1, SCRATCH_GENERATION
);
3698 scavenge_generations(generation
+1, PSEUDO_STATIC_GENERATION
);
3700 #ifdef LISP_FEATURE_SB_TRACEROOT
3701 scavenge(&gc_object_watcher
, 1);
3703 scavenge_pinned_ranges();
3705 /* Finally scavenge the new_space generation. Keep going until no
3706 * more objects are moved into the new generation */
3707 scavenge_newspace_generation(new_space
);
3709 /* FIXME: I tried reenabling this check when debugging unrelated
3710 * GC weirdness ca. sbcl-0.6.12.45, and it failed immediately.
3711 * Since the current GC code seems to work well, I'm guessing that
3712 * this debugging code is just stale, but I haven't tried to
3713 * figure it out. It should be figured out and then either made to
3714 * work or just deleted. */
3716 #define RESCAN_CHECK 0
3718 /* As a check re-scavenge the newspace once; no new objects should
3721 os_vm_size_t old_bytes_allocated
= bytes_allocated
;
3722 os_vm_size_t bytes_allocated
;
3724 /* Start with a full scavenge. */
3725 scavenge_newspace_generation_one_scan(new_space
);
3727 /* Flush the current regions, updating the tables. */
3728 gc_alloc_update_all_page_tables(1);
3730 bytes_allocated
= bytes_allocated
- old_bytes_allocated
;
3732 if (bytes_allocated
!= 0) {
3733 lose("Rescan of new_space allocated %d more bytes.\n",
3739 scan_weak_hash_tables();
3740 scan_weak_pointers();
3741 wipe_nonpinned_words();
3742 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3743 // Do this last, because until wipe_nonpinned_words() happens,
3744 // not all page table entries have the 'gen' value updated,
3745 // which we need to correctly find all old->young pointers.
3746 sweep_immobile_space(raise
);
3749 /* Flush the current regions, updating the tables. */
3750 gc_alloc_update_all_page_tables(0);
3751 #ifndef GENCGC_IS_PRECISE
3752 hopscotch_log_stats(&pinned_objects
, "pins");
3755 /* Free the pages in oldspace, but not those marked dont_move. */
3758 /* If the GC is not raising the age then lower the generation back
3759 * to its normal generation number */
3761 for (i
= 0; i
< last_free_page
; i
++)
3762 if ((page_bytes_used(i
) != 0)
3763 && (page_table
[i
].gen
== SCRATCH_GENERATION
))
3764 page_table
[i
].gen
= generation
;
3765 gc_assert(generations
[generation
].bytes_allocated
== 0);
3766 generations
[generation
].bytes_allocated
=
3767 generations
[SCRATCH_GENERATION
].bytes_allocated
;
3768 generations
[SCRATCH_GENERATION
].bytes_allocated
= 0;
3771 /* Reset the alloc_start_page for generation. */
3772 #ifdef LISP_FEATURE_SEGREGATED_CODE
3773 bzero(generations
[generation
].alloc_start_page_
,
3774 sizeof generations
[generation
].alloc_start_page_
);
3776 generations
[generation
].alloc_start_page
= 0;
3777 generations
[generation
].alloc_unboxed_start_page
= 0;
3778 generations
[generation
].alloc_large_start_page
= 0;
3781 if (generation
>= verify_gens
) {
3782 if (gencgc_verbose
) {
3788 /* Set the new gc trigger for the GCed generation. */
3789 generations
[generation
].gc_trigger
=
3790 generations
[generation
].bytes_allocated
3791 + generations
[generation
].bytes_consed_between_gc
;
3794 generations
[generation
].num_gc
= 0;
3796 ++generations
[generation
].num_gc
;
3800 /* Update last_free_page, then SymbolValue(ALLOCATION_POINTER). */
3802 update_dynamic_space_free_pointer(void)
3804 page_index_t last_page
= -1, i
;
3806 for (i
= 0; i
< last_free_page
; i
++)
3807 if (!page_free_p(i
) && (page_bytes_used(i
) != 0))
3810 last_free_page
= last_page
+1;
3812 set_alloc_pointer((lispobj
)(page_address(last_free_page
)));
3813 return 0; /* dummy value: return something ... */
3817 remap_page_range (page_index_t from
, page_index_t to
)
3819 /* There's a mysterious Solaris/x86 problem with using mmap
3820 * tricks for memory zeroing. See sbcl-devel thread
3821 * "Re: patch: standalone executable redux".
3823 #if defined(LISP_FEATURE_SUNOS)
3824 zero_and_mark_pages(from
, to
);
3827 release_granularity
= gencgc_release_granularity
/GENCGC_CARD_BYTES
,
3828 release_mask
= release_granularity
-1,
3830 aligned_from
= (from
+release_mask
)&~release_mask
,
3831 aligned_end
= (end
&~release_mask
);
3833 if (aligned_from
< aligned_end
) {
3834 zero_pages_with_mmap(aligned_from
, aligned_end
-1);
3835 if (aligned_from
!= from
)
3836 zero_and_mark_pages(from
, aligned_from
-1);
3837 if (aligned_end
!= end
)
3838 zero_and_mark_pages(aligned_end
, end
-1);
3840 zero_and_mark_pages(from
, to
);
3846 remap_free_pages (page_index_t from
, page_index_t to
, int forcibly
)
3848 page_index_t first_page
, last_page
;
3851 return remap_page_range(from
, to
);
3853 for (first_page
= from
; first_page
<= to
; first_page
++) {
3854 if (!page_free_p(first_page
) || !page_need_to_zero(first_page
))
3857 last_page
= first_page
+ 1;
3858 while (page_free_p(last_page
) &&
3859 (last_page
<= to
) &&
3860 (page_need_to_zero(last_page
)))
3863 remap_page_range(first_page
, last_page
-1);
3865 first_page
= last_page
;
3869 generation_index_t small_generation_limit
= 1;
3871 /* GC all generations newer than last_gen, raising the objects in each
3872 * to the next older generation - we finish when all generations below
3873 * last_gen are empty. Then if last_gen is due for a GC, or if
3874 * last_gen==NUM_GENERATIONS (the scratch generation? eh?) we GC that
3875 * too. The valid range for last_gen is: 0,1,...,NUM_GENERATIONS.
3877 * We stop collecting at gencgc_oldest_gen_to_gc, even if this is less than
3878 * last_gen (oh, and note that by default it is NUM_GENERATIONS-1) */
3880 collect_garbage(generation_index_t last_gen
)
3882 generation_index_t gen
= 0, i
;
3883 int raise
, more
= 0;
3885 /* The largest value of last_free_page seen since the time
3886 * remap_free_pages was called. */
3887 static page_index_t high_water_mark
= 0;
3889 FSHOW((stderr
, "/entering collect_garbage(%d)\n", last_gen
));
3890 log_generation_stats(gc_logfile
, "=== GC Start ===");
3894 if (last_gen
> HIGHEST_NORMAL_GENERATION
+1) {
3896 "/collect_garbage: last_gen = %d, doing a level 0 GC\n",
3901 /* Flush the alloc regions updating the tables. */
3902 gc_alloc_update_all_page_tables(1);
3904 /* Verify the new objects created by Lisp code. */
3905 if (pre_verify_gen_0
) {
3906 FSHOW((stderr
, "pre-checking generation 0\n"));
3907 verify_generation(0);
3910 if (gencgc_verbose
> 1)
3911 print_generation_stats();
3913 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3914 /* Immobile space generation bits are lazily updated for gen0
3915 (not touched on every object allocation) so do it now */
3916 update_immobile_nursery_bits();
3920 /* Collect the generation. */
3922 if (more
|| (gen
>= gencgc_oldest_gen_to_gc
)) {
3923 /* Never raise the oldest generation. Never raise the extra generation
3924 * collected due to more-flag. */
3930 || (generations
[gen
].num_gc
>= generations
[gen
].number_of_gcs_before_promotion
);
3931 /* If we would not normally raise this one, but we're
3932 * running low on space in comparison to the object-sizes
3933 * we've been seeing, raise it and collect the next one
3935 if (!raise
&& gen
== last_gen
) {
3936 more
= (2*large_allocation
) >= (dynamic_space_size
- bytes_allocated
);
3941 if (gencgc_verbose
> 1) {
3943 "starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n",
3946 generations
[gen
].bytes_allocated
,
3947 generations
[gen
].gc_trigger
,
3948 generations
[gen
].num_gc
));
3951 /* If an older generation is being filled, then update its
3954 generations
[gen
+1].cum_sum_bytes_allocated
+=
3955 generations
[gen
+1].bytes_allocated
;
3958 garbage_collect_generation(gen
, raise
);
3960 /* Reset the memory age cum_sum. */
3961 generations
[gen
].cum_sum_bytes_allocated
= 0;
3963 if (gencgc_verbose
> 1) {
3964 FSHOW((stderr
, "GC of generation %d finished:\n", gen
));
3965 print_generation_stats();
3969 } while ((gen
<= gencgc_oldest_gen_to_gc
)
3970 && ((gen
< last_gen
)
3973 && (generations
[gen
].bytes_allocated
3974 > generations
[gen
].gc_trigger
)
3975 && (generation_average_age(gen
)
3976 > generations
[gen
].minimum_age_before_gc
))));
3978 /* Now if gen-1 was raised all generations before gen are empty.
3979 * If it wasn't raised then all generations before gen-1 are empty.
3981 * Now objects within this gen's pages cannot point to younger
3982 * generations unless they are written to. This can be exploited
3983 * by write-protecting the pages of gen; then when younger
3984 * generations are GCed only the pages which have been written
3989 gen_to_wp
= gen
- 1;
3991 /* There's not much point in WPing pages in generation 0 as it is
3992 * never scavenged (except promoted pages). */
3993 if ((gen_to_wp
> 0) && enable_page_protection
) {
3994 /* Check that they are all empty. */
3995 for (i
= 0; i
< gen_to_wp
; i
++) {
3996 if (generations
[i
].bytes_allocated
)
3997 lose("trying to write-protect gen. %d when gen. %d nonempty\n",
4000 write_protect_generation_pages(gen_to_wp
);
4002 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4003 write_protect_immobile_space();
4006 /* Set gc_alloc() back to generation 0. The current regions should
4007 * be flushed after the above GCs. */
4008 gc_assert(boxed_region
.free_pointer
== boxed_region
.start_addr
);
4009 gc_alloc_generation
= 0;
4011 /* Save the high-water mark before updating last_free_page */
4012 if (last_free_page
> high_water_mark
)
4013 high_water_mark
= last_free_page
;
4015 update_dynamic_space_free_pointer();
4017 /* Update auto_gc_trigger. Make sure we trigger the next GC before
4018 * running out of heap! */
4019 if (bytes_consed_between_gcs
<= (dynamic_space_size
- bytes_allocated
))
4020 auto_gc_trigger
= bytes_allocated
+ bytes_consed_between_gcs
;
4022 auto_gc_trigger
= bytes_allocated
+ (dynamic_space_size
- bytes_allocated
)/2;
4025 fprintf(stderr
,"Next gc when %"OS_VM_SIZE_FMT
" bytes have been consed\n",
4028 /* If we did a big GC (arbitrarily defined as gen > 1), release memory
4031 if (gen
> small_generation_limit
) {
4032 if (last_free_page
> high_water_mark
)
4033 high_water_mark
= last_free_page
;
4034 remap_free_pages(0, high_water_mark
, 0);
4035 high_water_mark
= 0;
4039 large_allocation
= 0;
4041 #ifdef LISP_FEATURE_SB_TRACEROOT
4042 if (gc_object_watcher
) {
4043 extern void gc_prove_liveness(void(*)(), lispobj
, int, uword_t
*, int);
4044 gc_prove_liveness(preserve_context_registers
,
4046 gc_n_stack_pins
, pinned_objects
.keys
,
4047 gc_traceroot_criterion
);
4051 log_generation_stats(gc_logfile
, "=== GC End ===");
4052 SHOW("returning from collect_garbage");
4060 #if defined(LISP_FEATURE_SB_SAFEPOINT)
4064 /* Compute the number of pages needed for the dynamic space.
4065 * Dynamic space size should be aligned on page size. */
4066 page_table_pages
= dynamic_space_size
/GENCGC_CARD_BYTES
;
4067 gc_assert(dynamic_space_size
== npage_bytes(page_table_pages
));
4069 /* Default nursery size to 5% of the total dynamic space size,
4071 bytes_consed_between_gcs
= dynamic_space_size
/(os_vm_size_t
)20;
4072 if (bytes_consed_between_gcs
< (1024*1024))
4073 bytes_consed_between_gcs
= 1024*1024;
4075 /* The page_table must be allocated using "calloc" to initialize
4076 * the page structures correctly. There used to be a separate
4077 * initialization loop (now commented out; see below) but that was
4078 * unnecessary and did hurt startup time. */
4079 page_table
= calloc(page_table_pages
, sizeof(struct page
));
4080 gc_assert(page_table
);
4081 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4086 #ifndef GENCGC_IS_PRECISE
4087 hopscotch_create(&pinned_objects
, HOPSCOTCH_HASH_FUN_DEFAULT
, 0 /* hashset */,
4088 32 /* logical bin count */, 0 /* default range */);
4091 scavtab
[WEAK_POINTER_WIDETAG
] = scav_weak_pointer
;
4092 transother
[SIMPLE_ARRAY_WIDETAG
] = trans_boxed_large
;
4094 /* The page structures are initialized implicitly when page_table
4095 * is allocated with "calloc" above. Formerly we had the following
4096 * explicit initialization here (comments converted to C99 style
4097 * for readability as C's block comments don't nest):
4099 * // Initialize each page structure.
4100 * for (i = 0; i < page_table_pages; i++) {
4101 * // Initialize all pages as free.
4102 * page_table[i].allocated = FREE_PAGE_FLAG;
4103 * page_table[i].bytes_used = 0;
4105 * // Pages are not write-protected at startup.
4106 * page_table[i].write_protected = 0;
4109 * Without this loop the image starts up much faster when dynamic
4110 * space is large -- which it is on 64-bit platforms already by
4111 * default -- and when "calloc" for large arrays is implemented
4112 * using copy-on-write of a page of zeroes -- which it is at least
4113 * on Linux. In this case the pages that page_table_pages is stored
4114 * in are mapped and cleared not before the corresponding part of
4115 * dynamic space is used. For example, this saves clearing 16 MB of
4116 * memory at startup if the page size is 4 KB and the size of
4117 * dynamic space is 4 GB.
4118 * FREE_PAGE_FLAG must be 0 for this to work correctly which is
4119 * asserted below: */
4121 /* Compile time assertion: If triggered, declares an array
4122 * of dimension -1 forcing a syntax error. The intent of the
4123 * assignment is to avoid an "unused variable" warning. */
4124 char assert_free_page_flag_0
[(FREE_PAGE_FLAG
) ? -1 : 1];
4125 assert_free_page_flag_0
[0] = assert_free_page_flag_0
[0];
4128 bytes_allocated
= 0;
4130 /* Initialize the generations. */
4131 for (i
= 0; i
< NUM_GENERATIONS
; i
++) {
4132 generations
[i
].alloc_start_page
= 0;
4133 generations
[i
].alloc_unboxed_start_page
= 0;
4134 generations
[i
].alloc_large_start_page
= 0;
4135 generations
[i
].bytes_allocated
= 0;
4136 generations
[i
].gc_trigger
= 2000000;
4137 generations
[i
].num_gc
= 0;
4138 generations
[i
].cum_sum_bytes_allocated
= 0;
4139 /* the tune-able parameters */
4140 generations
[i
].bytes_consed_between_gc
4141 = bytes_consed_between_gcs
/(os_vm_size_t
)HIGHEST_NORMAL_GENERATION
;
4142 generations
[i
].number_of_gcs_before_promotion
= 1;
4143 generations
[i
].minimum_age_before_gc
= 0.75;
4146 /* Initialize gc_alloc. */
4147 gc_alloc_generation
= 0;
4148 gc_set_region_empty(&boxed_region
);
4149 gc_set_region_empty(&unboxed_region
);
4150 #ifdef LISP_FEATURE_SEGREGATED_CODE
4151 gc_set_region_empty(&code_region
);
4157 /* Pick up the dynamic space from after a core load.
4159 * The ALLOCATION_POINTER points to the end of the dynamic space.
4163 gencgc_pickup_dynamic(void)
4165 page_index_t page
= 0;
4166 char *alloc_ptr
= (char *)get_alloc_pointer();
4167 lispobj
*prev
=(lispobj
*)page_address(page
);
4168 generation_index_t gen
= PSEUDO_STATIC_GENERATION
;
4170 bytes_allocated
= 0;
4173 lispobj
*first
,*ptr
= (lispobj
*)page_address(page
);
4175 if (!gencgc_partial_pickup
|| !page_free_p(page
)) {
4176 /* It is possible, though rare, for the saved page table
4177 * to contain free pages below alloc_ptr. */
4178 page_table
[page
].gen
= gen
;
4179 set_page_bytes_used(page
, GENCGC_CARD_BYTES
);
4180 page_table
[page
].large_object
= 0;
4181 page_table
[page
].write_protected
= 0;
4182 page_table
[page
].write_protected_cleared
= 0;
4183 page_table
[page
].dont_move
= 0;
4184 set_page_need_to_zero(page
, 1);
4186 bytes_allocated
+= GENCGC_CARD_BYTES
;
4189 if (!gencgc_partial_pickup
) {
4190 #ifdef LISP_FEATURE_SEGREGATED_CODE
4191 // Make the most general assumption: any page *might* contain code.
4192 page_table
[page
].allocated
= CODE_PAGE_FLAG
;
4194 page_table
[page
].allocated
= BOXED_PAGE_FLAG
;
4196 first
= gc_search_space3(ptr
, prev
, (ptr
+2));
4199 set_page_scan_start_offset(page
, page_address(page
) - (char*)prev
);
4202 } while (page_address(page
) < alloc_ptr
);
4204 last_free_page
= page
;
4206 generations
[gen
].bytes_allocated
= bytes_allocated
;
4208 gc_alloc_update_all_page_tables(1);
4209 write_protect_generation_pages(gen
);
4213 gc_initialize_pointers(void)
4215 gencgc_pickup_dynamic();
4219 /* alloc(..) is the external interface for memory allocation. It
4220 * allocates to generation 0. It is not called from within the garbage
4221 * collector as it is only external uses that need the check for heap
4222 * size (GC trigger) and to disable the interrupts (interrupts are
4223 * always disabled during a GC).
4225 * The vops that call alloc(..) assume that the returned space is zero-filled.
4226 * (E.g. the most significant word of a 2-word bignum in MOVE-FROM-UNSIGNED.)
4228 * The check for a GC trigger is only performed when the current
4229 * region is full, so in most cases it's not needed. */
4231 static inline lispobj
*
4232 general_alloc_internal(sword_t nbytes
, int page_type_flag
, struct alloc_region
*region
,
4233 struct thread
*thread
)
4235 #ifndef LISP_FEATURE_WIN32
4236 lispobj alloc_signal
;
4239 void *new_free_pointer
;
4240 os_vm_size_t trigger_bytes
= 0;
4242 gc_assert(nbytes
> 0);
4244 /* Check for alignment allocation problems. */
4245 gc_assert((((uword_t
)region
->free_pointer
& LOWTAG_MASK
) == 0)
4246 && ((nbytes
& LOWTAG_MASK
) == 0));
4248 #if !(defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD))
4249 /* Must be inside a PA section. */
4250 gc_assert(get_pseudo_atomic_atomic(thread
));
4253 if ((os_vm_size_t
) nbytes
> large_allocation
)
4254 large_allocation
= nbytes
;
4256 /* maybe we can do this quickly ... */
4257 new_free_pointer
= (char*)region
->free_pointer
+ nbytes
;
4258 if (new_free_pointer
<= region
->end_addr
) {
4259 new_obj
= (void*)(region
->free_pointer
);
4260 region
->free_pointer
= new_free_pointer
;
4261 return(new_obj
); /* yup */
4264 /* We don't want to count nbytes against auto_gc_trigger unless we
4265 * have to: it speeds up the tenuring of objects and slows down
4266 * allocation. However, unless we do so when allocating _very_
4267 * large objects we are in danger of exhausting the heap without
4268 * running sufficient GCs.
4270 if ((os_vm_size_t
) nbytes
>= bytes_consed_between_gcs
)
4271 trigger_bytes
= nbytes
;
4273 /* we have to go the long way around, it seems. Check whether we
4274 * should GC in the near future
4276 if (auto_gc_trigger
&& (bytes_allocated
+trigger_bytes
> auto_gc_trigger
)) {
4277 /* Don't flood the system with interrupts if the need to gc is
4278 * already noted. This can happen for example when SUB-GC
4279 * allocates or after a gc triggered in a WITHOUT-GCING. */
4280 if (SymbolValue(GC_PENDING
,thread
) == NIL
) {
4281 /* set things up so that GC happens when we finish the PA
4283 SetSymbolValue(GC_PENDING
,T
,thread
);
4284 if (SymbolValue(GC_INHIBIT
,thread
) == NIL
) {
4285 #ifdef LISP_FEATURE_SB_SAFEPOINT
4286 thread_register_gc_trigger();
4288 set_pseudo_atomic_interrupted(thread
);
4289 #ifdef GENCGC_IS_PRECISE
4290 /* PPC calls alloc() from a trap
4291 * look up the most context if it's from a trap. */
4293 os_context_t
*context
=
4294 thread
->interrupt_data
->allocation_trap_context
;
4295 maybe_save_gc_mask_and_block_deferrables
4296 (context
? os_context_sigmask_addr(context
) : NULL
);
4299 maybe_save_gc_mask_and_block_deferrables(NULL
);
4305 new_obj
= gc_alloc_with_region(nbytes
, page_type_flag
, region
, 0);
4307 #ifndef LISP_FEATURE_WIN32
4308 /* for sb-prof, and not supported on Windows yet */
4309 alloc_signal
= SymbolValue(ALLOC_SIGNAL
,thread
);
4310 if ((alloc_signal
& FIXNUM_TAG_MASK
) == 0) {
4311 if ((sword_t
) alloc_signal
<= 0) {
4312 SetSymbolValue(ALLOC_SIGNAL
, T
, thread
);
4315 SetSymbolValue(ALLOC_SIGNAL
,
4316 alloc_signal
- (1 << N_FIXNUM_TAG_BITS
),
4326 general_alloc(sword_t nbytes
, int page_type_flag
)
4328 struct thread
*thread
= arch_os_get_current_thread();
4329 /* Select correct region, and call general_alloc_internal with it.
4330 * For other then boxed allocation we must lock first, since the
4331 * region is shared. */
4332 #ifdef LISP_FEATURE_SEGREGATED_CODE
4333 if (page_type_flag
== BOXED_PAGE_FLAG
) {
4335 if (BOXED_PAGE_FLAG
& page_type_flag
) {
4337 #ifdef LISP_FEATURE_SB_THREAD
4338 struct alloc_region
*region
= (thread
? &(thread
->alloc_region
) : &boxed_region
);
4340 struct alloc_region
*region
= &boxed_region
;
4342 return general_alloc_internal(nbytes
, page_type_flag
, region
, thread
);
4343 #ifdef LISP_FEATURE_SEGREGATED_CODE
4344 } else if (page_type_flag
== UNBOXED_PAGE_FLAG
||
4345 page_type_flag
== CODE_PAGE_FLAG
) {
4346 struct alloc_region
*region
=
4347 page_type_flag
== CODE_PAGE_FLAG
? &code_region
: &unboxed_region
;
4349 } else if (UNBOXED_PAGE_FLAG
== page_type_flag
) {
4350 struct alloc_region
*region
= &unboxed_region
;
4354 result
= thread_mutex_lock(&allocation_lock
);
4356 obj
= general_alloc_internal(nbytes
, page_type_flag
, region
, thread
);
4357 result
= thread_mutex_unlock(&allocation_lock
);
4361 lose("bad page type flag: %d", page_type_flag
);
4365 lispobj AMD64_SYSV_ABI
*
4366 alloc(sword_t nbytes
)
4368 #ifdef LISP_FEATURE_SB_SAFEPOINT_STRICTLY
4369 struct thread
*self
= arch_os_get_current_thread();
4370 int was_pseudo_atomic
= get_pseudo_atomic_atomic(self
);
4371 if (!was_pseudo_atomic
)
4372 set_pseudo_atomic_atomic(self
);
4374 gc_assert(get_pseudo_atomic_atomic(arch_os_get_current_thread()));
4377 lispobj
*result
= general_alloc(nbytes
, BOXED_PAGE_FLAG
);
4379 #ifdef LISP_FEATURE_SB_SAFEPOINT_STRICTLY
4380 if (!was_pseudo_atomic
)
4381 clear_pseudo_atomic_atomic(self
);
4388 * shared support for the OS-dependent signal handlers which
4389 * catch GENCGC-related write-protect violations
4391 void unhandled_sigmemoryfault(void* addr
);
4393 /* Depending on which OS we're running under, different signals might
4394 * be raised for a violation of write protection in the heap. This
4395 * function factors out the common generational GC magic which needs
4396 * to invoked in this case, and should be called from whatever signal
4397 * handler is appropriate for the OS we're running under.
4399 * Return true if this signal is a normal generational GC thing that
4400 * we were able to handle, or false if it was abnormal and control
4401 * should fall through to the general SIGSEGV/SIGBUS/whatever logic.
4403 * We have two control flags for this: one causes us to ignore faults
4404 * on unprotected pages completely, and the second complains to stderr
4405 * but allows us to continue without losing.
4407 extern boolean ignore_memoryfaults_on_unprotected_pages
;
4408 boolean ignore_memoryfaults_on_unprotected_pages
= 0;
4410 extern boolean continue_after_memoryfault_on_unprotected_pages
;
4411 boolean continue_after_memoryfault_on_unprotected_pages
= 0;
4414 gencgc_handle_wp_violation(void* fault_addr
)
4416 page_index_t page_index
= find_page_index(fault_addr
);
4420 "heap WP violation? fault_addr=%p, page_index=%"PAGE_INDEX_FMT
"\n",
4421 fault_addr
, page_index
));
4424 /* Check whether the fault is within the dynamic space. */
4425 if (page_index
== (-1)) {
4426 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4427 extern int immobile_space_handle_wp_violation(void*);
4428 if (immobile_space_handle_wp_violation(fault_addr
))
4432 /* It can be helpful to be able to put a breakpoint on this
4433 * case to help diagnose low-level problems. */
4434 unhandled_sigmemoryfault(fault_addr
);
4436 /* not within the dynamic space -- not our responsibility */
4441 ret
= thread_mutex_lock(&free_pages_lock
);
4442 gc_assert(ret
== 0);
4443 if (page_table
[page_index
].write_protected
) {
4444 /* Unprotect the page. */
4445 os_protect(page_address(page_index
), GENCGC_CARD_BYTES
, OS_VM_PROT_ALL
);
4446 page_table
[page_index
].write_protected_cleared
= 1;
4447 page_table
[page_index
].write_protected
= 0;
4448 } else if (!ignore_memoryfaults_on_unprotected_pages
) {
4449 /* The only acceptable reason for this signal on a heap
4450 * access is that GENCGC write-protected the page.
4451 * However, if two CPUs hit a wp page near-simultaneously,
4452 * we had better not have the second one lose here if it
4453 * does this test after the first one has already set wp=0
4455 if(page_table
[page_index
].write_protected_cleared
!= 1) {
4456 void lisp_backtrace(int frames
);
4459 "Fault @ %p, page %"PAGE_INDEX_FMT
" not marked as write-protected:\n"
4460 " boxed_region.first_page: %"PAGE_INDEX_FMT
","
4461 " boxed_region.last_page %"PAGE_INDEX_FMT
"\n"
4462 " page.scan_start_offset: %"OS_VM_SIZE_FMT
"\n"
4463 " page.bytes_used: %u\n"
4464 " page.allocated: %d\n"
4465 " page.write_protected: %d\n"
4466 " page.write_protected_cleared: %d\n"
4467 " page.generation: %d\n",
4470 boxed_region
.first_page
,
4471 boxed_region
.last_page
,
4472 page_scan_start_offset(page_index
),
4473 page_bytes_used(page_index
),
4474 page_table
[page_index
].allocated
,
4475 page_table
[page_index
].write_protected
,
4476 page_table
[page_index
].write_protected_cleared
,
4477 page_table
[page_index
].gen
);
4478 if (!continue_after_memoryfault_on_unprotected_pages
)
4482 ret
= thread_mutex_unlock(&free_pages_lock
);
4483 gc_assert(ret
== 0);
4484 /* Don't worry, we can handle it. */
4488 /* This is to be called when we catch a SIGSEGV/SIGBUS, determine that
4489 * it's not just a case of the program hitting the write barrier, and
4490 * are about to let Lisp deal with it. It's basically just a
4491 * convenient place to set a gdb breakpoint. */
4493 unhandled_sigmemoryfault(void *addr
)
4497 update_thread_page_tables(struct thread
*th
)
4499 gc_alloc_update_page_tables(BOXED_PAGE_FLAG
, &th
->alloc_region
);
4500 #if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
4501 gc_alloc_update_page_tables(BOXED_PAGE_FLAG
, &th
->sprof_alloc_region
);
4505 /* GC is single-threaded and all memory allocations during a
4506 collection happen in the GC thread, so it is sufficient to update
4507 all the the page tables once at the beginning of a collection and
4508 update only page tables of the GC thread during the collection. */
4509 void gc_alloc_update_all_page_tables(int for_all_threads
)
4511 /* Flush the alloc regions updating the tables. */
4513 if (for_all_threads
) {
4514 for_each_thread(th
) {
4515 update_thread_page_tables(th
);
4519 th
= arch_os_get_current_thread();
4521 update_thread_page_tables(th
);
4524 #ifdef LISP_FEATURE_SEGREGATED_CODE
4525 gc_alloc_update_page_tables(CODE_PAGE_FLAG
, &code_region
);
4527 gc_alloc_update_page_tables(UNBOXED_PAGE_FLAG
, &unboxed_region
);
4528 gc_alloc_update_page_tables(BOXED_PAGE_FLAG
, &boxed_region
);
4532 gc_set_region_empty(struct alloc_region
*region
)
4534 region
->first_page
= 0;
4535 region
->last_page
= -1;
4536 region
->start_addr
= page_address(0);
4537 region
->free_pointer
= page_address(0);
4538 region
->end_addr
= page_address(0);
4542 zero_all_free_pages()
4546 for (i
= 0; i
< last_free_page
; i
++) {
4547 if (page_free_p(i
)) {
4548 #ifdef READ_PROTECT_FREE_PAGES
4549 os_protect(page_address(i
),
4558 /* Things to do before doing a final GC before saving a core (without
4561 * + Pages in large_object pages aren't moved by the GC, so we need to
4562 * unset that flag from all pages.
4563 * + The pseudo-static generation isn't normally collected, but it seems
4564 * reasonable to collect it at least when saving a core. So move the
4565 * pages to a normal generation.
4568 prepare_for_final_gc ()
4572 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4573 extern void prepare_immobile_space_for_final_gc();
4574 prepare_immobile_space_for_final_gc ();
4577 for (i
= 0; i
< last_free_page
; i
++) {
4578 page_table
[i
].large_object
= 0;
4579 if (page_table
[i
].gen
== PSEUDO_STATIC_GENERATION
) {
4580 int used
= page_bytes_used(i
);
4581 page_table
[i
].gen
= HIGHEST_NORMAL_GENERATION
;
4582 generations
[PSEUDO_STATIC_GENERATION
].bytes_allocated
-= used
;
4583 generations
[HIGHEST_NORMAL_GENERATION
].bytes_allocated
+= used
;
4588 /* Set this switch to 1 for coalescing of strings dumped to fasl,
4589 * or 2 for coalescing of those,
4590 * plus literal strings in code compiled to memory. */
4591 char gc_coalesce_string_literals
= 0;
4593 /* Do a non-conservative GC, and then save a core with the initial
4594 * function being set to the value of the static symbol
4595 * SB!VM:RESTART-LISP-FUNCTION */
4597 gc_and_save(char *filename
, boolean prepend_runtime
,
4598 boolean save_runtime_options
, boolean compressed
,
4599 int compression_level
, int application_type
)
4602 void *runtime_bytes
= NULL
;
4603 size_t runtime_size
;
4605 file
= prepare_to_save(filename
, prepend_runtime
, &runtime_bytes
,
4610 conservative_stack
= 0;
4612 /* The filename might come from Lisp, and be moved by the now
4613 * non-conservative GC. */
4614 filename
= strdup(filename
);
4616 /* Collect twice: once into relatively high memory, and then back
4617 * into low memory. This compacts the retained data into the lower
4618 * pages, minimizing the size of the core file.
4620 prepare_for_final_gc();
4621 gencgc_alloc_start_page
= last_free_page
;
4622 collect_garbage(HIGHEST_NORMAL_GENERATION
+1);
4624 if (gc_coalesce_string_literals
) {
4625 extern struct lisp_startup_options lisp_startup_options
;
4626 extern void coalesce_strings();
4627 boolean verbose
= !lisp_startup_options
.noinform
;
4629 printf("[coalescing similar strings... ");
4637 prepare_for_final_gc();
4638 gencgc_alloc_start_page
= -1;
4639 collect_garbage(HIGHEST_NORMAL_GENERATION
+1);
4641 if (prepend_runtime
)
4642 save_runtime_to_filehandle(file
, runtime_bytes
, runtime_size
,
4645 /* The dumper doesn't know that pages need to be zeroed before use. */
4646 zero_all_free_pages();
4647 save_to_filehandle(file
, filename
, SymbolValue(RESTART_LISP_FUNCTION
,0),
4648 prepend_runtime
, save_runtime_options
,
4649 compressed
? compression_level
: COMPRESSION_LEVEL_NONE
);
4650 /* Oops. Save still managed to fail. Since we've mangled the stack
4651 * beyond hope, there's not much we can do.
4652 * (beyond FUNCALLing RESTART_LISP_FUNCTION, but I suspect that's
4653 * going to be rather unsatisfactory too... */
4654 lose("Attempt to save core after non-conservative GC failed.\n");