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>.
32 #if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)
33 #include "pthreads_win32.h"
41 #include "interrupt.h"
46 #include "gc-internal.h"
48 #include "pseudo-atomic.h"
50 #include "genesis/vector.h"
51 #include "genesis/weak-pointer.h"
52 #include "genesis/fdefn.h"
53 #include "genesis/simple-fun.h"
55 #include "genesis/hash-table.h"
56 #include "genesis/instance.h"
57 #include "genesis/layout.h"
59 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
60 #include "genesis/cons.h"
62 #ifdef LISP_FEATURE_X86
63 #include "forwarding-ptr.h"
66 /* forward declarations */
67 page_index_t
gc_find_freeish_pages(page_index_t
*restart_page_ptr
, sword_t nbytes
,
75 /* As usually configured, generations 0-5 are normal collected generations,
76 6 is pseudo-static (the objects in which are never moved nor reclaimed),
77 and 7 is scratch space used when collecting a generation without promotion,
78 wherein it is moved to generation 7 and back again.
81 SCRATCH_GENERATION
= PSEUDO_STATIC_GENERATION
+1,
85 /* Should we use page protection to help avoid the scavenging of pages
86 * that don't have pointers to younger generations? */
87 boolean enable_page_protection
= 1;
89 /* Largest allocation seen since last GC. */
90 os_vm_size_t large_allocation
= 0;
97 /* the verbosity level. All non-error messages are disabled at level 0;
98 * and only a few rare messages are printed at level 1. */
100 boolean gencgc_verbose
= 1;
102 boolean gencgc_verbose
= 0;
105 /* FIXME: At some point enable the various error-checking things below
106 * and see what they say. */
108 /* We hunt for pointers to old-space, when GCing generations >= verify_gen.
109 * Set verify_gens to HIGHEST_NORMAL_GENERATION + 1 to disable this kind of
111 generation_index_t verify_gens
= HIGHEST_NORMAL_GENERATION
+ 1;
113 /* Should we do a pre-scan verify of generation 0 before it's GCed? */
114 boolean pre_verify_gen_0
= 0;
116 /* Should we print a note when code objects are found in the dynamic space
117 * during a heap verify? */
118 boolean verify_dynamic_code_check
= 0;
120 #ifdef LISP_FEATURE_X86
121 /* Should we check code objects for fixup errors after they are transported? */
122 boolean check_code_fixups
= 0;
125 /* Should we check that newly allocated regions are zero filled? */
126 boolean gencgc_zero_check
= 0;
128 /* Should we check that the free space is zero filled? */
129 boolean gencgc_enable_verify_zero_fill
= 0;
131 /* When loading a core, don't do a full scan of the memory for the
132 * memory region boundaries. (Set to true by coreparse.c if the core
133 * contained a pagetable entry).
135 boolean gencgc_partial_pickup
= 0;
137 /* If defined, free pages are read-protected to ensure that nothing
141 /* #define READ_PROTECT_FREE_PAGES */
145 * GC structures and variables
148 /* the total bytes allocated. These are seen by Lisp DYNAMIC-USAGE. */
149 os_vm_size_t bytes_allocated
= 0;
150 os_vm_size_t auto_gc_trigger
= 0;
152 /* the source and destination generations. These are set before a GC starts
154 generation_index_t from_space
;
155 generation_index_t new_space
;
157 /* Set to 1 when in GC */
158 boolean gc_active_p
= 0;
160 /* should the GC be conservative on stack. If false (only right before
161 * saving a core), don't scan the stack / mark pages dont_move. */
162 static boolean conservative_stack
= 1;
164 /* An array of page structures is allocated on gc initialization.
165 * This helps to quickly map between an address and its page structure.
166 * page_table_pages is set from the size of the dynamic space. */
167 page_index_t page_table_pages
;
168 struct page
*page_table
;
170 in_use_marker_t
*page_table_pinned_dwords
;
171 size_t pins_map_size_in_bytes
;
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 static inline boolean
page_allocated_p(page_index_t page
) {
180 return (page_table
[page
].allocated
!= FREE_PAGE_FLAG
);
183 static inline boolean
page_no_region_p(page_index_t page
) {
184 return !(page_table
[page
].allocated
& OPEN_REGION_PAGE_FLAG
);
187 static inline boolean
page_allocated_no_region_p(page_index_t page
) {
188 return ((page_table
[page
].allocated
& (UNBOXED_PAGE_FLAG
| BOXED_PAGE_FLAG
))
189 && page_no_region_p(page
));
192 static inline boolean
page_free_p(page_index_t page
) {
193 return (page_table
[page
].allocated
== FREE_PAGE_FLAG
);
196 static inline boolean
page_boxed_p(page_index_t page
) {
197 return (page_table
[page
].allocated
& BOXED_PAGE_FLAG
);
200 static inline boolean
page_boxed_no_region_p(page_index_t page
) {
201 return page_boxed_p(page
) && page_no_region_p(page
);
204 static inline boolean
page_unboxed_p(page_index_t page
) {
205 /* Both flags set == boxed code page */
206 return ((page_table
[page
].allocated
& UNBOXED_PAGE_FLAG
)
207 && !page_boxed_p(page
));
210 static inline boolean
protect_page_p(page_index_t page
, generation_index_t generation
) {
211 return (page_boxed_no_region_p(page
)
212 && (page_table
[page
].bytes_used
!= 0)
213 && !page_table
[page
].dont_move
214 && (page_table
[page
].gen
== generation
));
217 /* To map addresses to page structures the address of the first page
219 void *heap_base
= NULL
;
221 /* Calculate the start address for the given page number. */
223 page_address(page_index_t page_num
)
225 return (heap_base
+ (page_num
* GENCGC_CARD_BYTES
));
228 /* Calculate the address where the allocation region associated with
229 * the page starts. */
231 page_scan_start(page_index_t page_index
)
233 return page_address(page_index
)-page_table
[page_index
].scan_start_offset
;
236 /* True if the page starts a contiguous block. */
237 static inline boolean
238 page_starts_contiguous_block_p(page_index_t page_index
)
240 return page_table
[page_index
].scan_start_offset
== 0;
243 /* True if the page is the last page in a contiguous block. */
244 static inline boolean
245 page_ends_contiguous_block_p(page_index_t page_index
, generation_index_t gen
)
247 return (/* page doesn't fill block */
248 (page_table
[page_index
].bytes_used
< GENCGC_CARD_BYTES
)
249 /* page is last allocated page */
250 || ((page_index
+ 1) >= last_free_page
)
252 || page_free_p(page_index
+ 1)
253 /* next page contains no data */
254 || (page_table
[page_index
+ 1].bytes_used
== 0)
255 /* next page is in different generation */
256 || (page_table
[page_index
+ 1].gen
!= gen
)
257 /* next page starts its own contiguous block */
258 || (page_starts_contiguous_block_p(page_index
+ 1)));
261 /* Find the page index within the page_table for the given
262 * address. Return -1 on failure. */
264 find_page_index(void *addr
)
266 if (addr
>= heap_base
) {
267 page_index_t index
= ((pointer_sized_uint_t
)addr
-
268 (pointer_sized_uint_t
)heap_base
) / GENCGC_CARD_BYTES
;
269 if (index
< page_table_pages
)
276 npage_bytes(page_index_t npages
)
278 gc_assert(npages
>=0);
279 return ((os_vm_size_t
)npages
)*GENCGC_CARD_BYTES
;
282 /* Check that X is a higher address than Y and return offset from Y to
284 static inline os_vm_size_t
285 void_diff(void *x
, void *y
)
288 return (pointer_sized_uint_t
)x
- (pointer_sized_uint_t
)y
;
291 /* a structure to hold the state of a generation
293 * CAUTION: If you modify this, make sure to touch up the alien
294 * definition in src/code/gc.lisp accordingly. ...or better yes,
295 * deal with the FIXME there...
299 /* the first page that gc_alloc() checks on its next call */
300 page_index_t alloc_start_page
;
302 /* the first page that gc_alloc_unboxed() checks on its next call */
303 page_index_t alloc_unboxed_start_page
;
305 /* the first page that gc_alloc_large (boxed) considers on its next
306 * call. (Although it always allocates after the boxed_region.) */
307 page_index_t alloc_large_start_page
;
309 /* the first page that gc_alloc_large (unboxed) considers on its
310 * next call. (Although it always allocates after the
311 * current_unboxed_region.) */
312 page_index_t alloc_large_unboxed_start_page
;
314 /* the bytes allocated to this generation */
315 os_vm_size_t bytes_allocated
;
317 /* the number of bytes at which to trigger a GC */
318 os_vm_size_t gc_trigger
;
320 /* to calculate a new level for gc_trigger */
321 os_vm_size_t bytes_consed_between_gc
;
323 /* the number of GCs since the last raise */
326 /* the number of GCs to run on the generations before raising objects to the
328 int number_of_gcs_before_promotion
;
330 /* the cumulative sum of the bytes allocated to this generation. It is
331 * cleared after a GC on this generations, and update before new
332 * objects are added from a GC of a younger generation. Dividing by
333 * the bytes_allocated will give the average age of the memory in
334 * this generation since its last GC. */
335 os_vm_size_t cum_sum_bytes_allocated
;
337 /* a minimum average memory age before a GC will occur helps
338 * prevent a GC when a large number of new live objects have been
339 * added, in which case a GC could be a waste of time */
340 double minimum_age_before_gc
;
343 /* an array of generation structures. There needs to be one more
344 * generation structure than actual generations as the oldest
345 * generation is temporarily raised then lowered. */
346 struct generation generations
[NUM_GENERATIONS
];
348 /* the oldest generation that is will currently be GCed by default.
349 * Valid values are: 0, 1, ... HIGHEST_NORMAL_GENERATION
351 * The default of HIGHEST_NORMAL_GENERATION enables GC on all generations.
353 * Setting this to 0 effectively disables the generational nature of
354 * the GC. In some applications generational GC may not be useful
355 * because there are no long-lived objects.
357 * An intermediate value could be handy after moving long-lived data
358 * into an older generation so an unnecessary GC of this long-lived
359 * data can be avoided. */
360 generation_index_t gencgc_oldest_gen_to_gc
= HIGHEST_NORMAL_GENERATION
;
362 /* META: Is nobody aside from me bothered by this especially misleading
363 * use of the word "last"? It could mean either "ultimate" or "prior",
364 * but in fact means neither. It is the *FIRST* page that should be grabbed
365 * for more space, so it is min free page, or 1+ the max used page. */
366 /* The maximum free page in the heap is maintained and used to update
367 * ALLOCATION_POINTER which is used by the room function to limit its
368 * search of the heap. XX Gencgc obviously needs to be better
369 * integrated with the Lisp code. */
371 page_index_t last_free_page
;
373 #ifdef LISP_FEATURE_SB_THREAD
374 /* This lock is to prevent multiple threads from simultaneously
375 * allocating new regions which overlap each other. Note that the
376 * majority of GC is single-threaded, but alloc() may be called from
377 * >1 thread at a time and must be thread-safe. This lock must be
378 * seized before all accesses to generations[] or to parts of
379 * page_table[] that other threads may want to see */
380 static pthread_mutex_t free_pages_lock
= PTHREAD_MUTEX_INITIALIZER
;
381 /* This lock is used to protect non-thread-local allocation. */
382 static pthread_mutex_t allocation_lock
= PTHREAD_MUTEX_INITIALIZER
;
385 extern os_vm_size_t gencgc_release_granularity
;
386 os_vm_size_t gencgc_release_granularity
= GENCGC_RELEASE_GRANULARITY
;
388 extern os_vm_size_t gencgc_alloc_granularity
;
389 os_vm_size_t gencgc_alloc_granularity
= GENCGC_ALLOC_GRANULARITY
;
393 * miscellaneous heap functions
396 /* Count the number of pages which are write-protected within the
397 * given generation. */
399 count_write_protect_generation_pages(generation_index_t generation
)
401 page_index_t i
, count
= 0;
403 for (i
= 0; i
< last_free_page
; i
++)
404 if (page_allocated_p(i
)
405 && (page_table
[i
].gen
== generation
)
406 && (page_table
[i
].write_protected
== 1))
411 /* Count the number of pages within the given generation. */
413 count_generation_pages(generation_index_t generation
)
416 page_index_t count
= 0;
418 for (i
= 0; i
< last_free_page
; i
++)
419 if (page_allocated_p(i
)
420 && (page_table
[i
].gen
== generation
))
427 count_dont_move_pages(void)
430 page_index_t count
= 0;
431 for (i
= 0; i
< last_free_page
; i
++) {
432 if (page_allocated_p(i
)
433 && (page_table
[i
].dont_move
!= 0)) {
441 /* Work through the pages and add up the number of bytes used for the
442 * given generation. */
444 count_generation_bytes_allocated (generation_index_t gen
)
447 os_vm_size_t result
= 0;
448 for (i
= 0; i
< last_free_page
; i
++) {
449 if (page_allocated_p(i
)
450 && (page_table
[i
].gen
== gen
))
451 result
+= page_table
[i
].bytes_used
;
456 /* Return the average age of the memory in a generation. */
458 generation_average_age(generation_index_t gen
)
460 if (generations
[gen
].bytes_allocated
== 0)
464 ((double)generations
[gen
].cum_sum_bytes_allocated
)
465 / ((double)generations
[gen
].bytes_allocated
);
468 #ifdef LISP_FEATURE_X86
469 extern void fpu_save(void *);
470 extern void fpu_restore(void *);
474 write_generation_stats(FILE *file
)
476 generation_index_t i
;
478 #ifdef LISP_FEATURE_X86
481 /* Can end up here after calling alloc_tramp which doesn't prepare
482 * the x87 state, and the C ABI uses a different mode */
486 /* Print the heap stats. */
488 " Gen StaPg UbSta LaSta LUbSt Boxed Unboxed LB LUB !move Alloc Waste Trig WP GCs Mem-age\n");
490 for (i
= 0; i
< SCRATCH_GENERATION
; i
++) {
492 page_index_t boxed_cnt
= 0;
493 page_index_t unboxed_cnt
= 0;
494 page_index_t large_boxed_cnt
= 0;
495 page_index_t large_unboxed_cnt
= 0;
496 page_index_t pinned_cnt
=0;
498 for (j
= 0; j
< last_free_page
; j
++)
499 if (page_table
[j
].gen
== i
) {
501 /* Count the number of boxed pages within the given
503 if (page_boxed_p(j
)) {
504 if (page_table
[j
].large_object
)
509 if(page_table
[j
].dont_move
) pinned_cnt
++;
510 /* Count the number of unboxed pages within the given
512 if (page_unboxed_p(j
)) {
513 if (page_table
[j
].large_object
)
520 gc_assert(generations
[i
].bytes_allocated
521 == count_generation_bytes_allocated(i
));
523 " %1d: %5ld %5ld %5ld %5ld",
525 (long)generations
[i
].alloc_start_page
,
526 (long)generations
[i
].alloc_unboxed_start_page
,
527 (long)generations
[i
].alloc_large_start_page
,
528 (long)generations
[i
].alloc_large_unboxed_start_page
);
530 " %5"PAGE_INDEX_FMT
" %5"PAGE_INDEX_FMT
" %5"PAGE_INDEX_FMT
531 " %5"PAGE_INDEX_FMT
" %5"PAGE_INDEX_FMT
,
532 boxed_cnt
, unboxed_cnt
, large_boxed_cnt
,
533 large_unboxed_cnt
, pinned_cnt
);
538 " %4"PAGE_INDEX_FMT
" %3d %7.4f\n",
539 generations
[i
].bytes_allocated
,
540 (npage_bytes(count_generation_pages(i
)) - generations
[i
].bytes_allocated
),
541 generations
[i
].gc_trigger
,
542 count_write_protect_generation_pages(i
),
543 generations
[i
].num_gc
,
544 generation_average_age(i
));
546 fprintf(file
," Total bytes allocated = %"OS_VM_SIZE_FMT
"\n", bytes_allocated
);
547 fprintf(file
," Dynamic-space-size bytes = %"OS_VM_SIZE_FMT
"\n", dynamic_space_size
);
549 #ifdef LISP_FEATURE_X86
550 fpu_restore(fpu_state
);
555 write_heap_exhaustion_report(FILE *file
, long available
, long requested
,
556 struct thread
*thread
)
559 "Heap exhausted during %s: %ld bytes available, %ld requested.\n",
560 gc_active_p
? "garbage collection" : "allocation",
563 write_generation_stats(file
);
564 fprintf(file
, "GC control variables:\n");
565 fprintf(file
, " *GC-INHIBIT* = %s\n *GC-PENDING* = %s\n",
566 SymbolValue(GC_INHIBIT
,thread
)==NIL
? "false" : "true",
567 (SymbolValue(GC_PENDING
, thread
) == T
) ?
568 "true" : ((SymbolValue(GC_PENDING
, thread
) == NIL
) ?
569 "false" : "in progress"));
570 #ifdef LISP_FEATURE_SB_THREAD
571 fprintf(file
, " *STOP-FOR-GC-PENDING* = %s\n",
572 SymbolValue(STOP_FOR_GC_PENDING
,thread
)==NIL
? "false" : "true");
577 print_generation_stats(void)
579 write_generation_stats(stderr
);
582 extern char* gc_logfile
;
583 char * gc_logfile
= NULL
;
586 log_generation_stats(char *logfile
, char *header
)
589 FILE * log
= fopen(logfile
, "a");
591 fprintf(log
, "%s\n", header
);
592 write_generation_stats(log
);
595 fprintf(stderr
, "Could not open gc logfile: %s\n", logfile
);
602 report_heap_exhaustion(long available
, long requested
, struct thread
*th
)
605 FILE * log
= fopen(gc_logfile
, "a");
607 write_heap_exhaustion_report(log
, available
, requested
, th
);
610 fprintf(stderr
, "Could not open gc logfile: %s\n", gc_logfile
);
614 /* Always to stderr as well. */
615 write_heap_exhaustion_report(stderr
, available
, requested
, th
);
619 #if defined(LISP_FEATURE_X86)
620 void fast_bzero(void*, size_t); /* in <arch>-assem.S */
623 /* Zero the pages from START to END (inclusive), but use mmap/munmap instead
624 * if zeroing it ourselves, i.e. in practice give the memory back to the
625 * OS. Generally done after a large GC.
627 void zero_pages_with_mmap(page_index_t start
, page_index_t end
) {
629 void *addr
= page_address(start
), *new_addr
;
630 os_vm_size_t length
= npage_bytes(1+end
-start
);
635 gc_assert(length
>= gencgc_release_granularity
);
636 gc_assert((length
% gencgc_release_granularity
) == 0);
638 os_invalidate(addr
, length
);
639 new_addr
= os_validate(addr
, length
);
640 if (new_addr
== NULL
|| new_addr
!= addr
) {
641 lose("remap_free_pages: page moved, 0x%08x ==> 0x%08x",
645 for (i
= start
; i
<= end
; i
++) {
646 page_table
[i
].need_to_zero
= 0;
650 /* Zero the pages from START to END (inclusive). Generally done just after
651 * a new region has been allocated.
654 zero_pages(page_index_t start
, page_index_t end
) {
658 #if defined(LISP_FEATURE_X86)
659 fast_bzero(page_address(start
), npage_bytes(1+end
-start
));
661 bzero(page_address(start
), npage_bytes(1+end
-start
));
667 zero_and_mark_pages(page_index_t start
, page_index_t end
) {
670 zero_pages(start
, end
);
671 for (i
= start
; i
<= end
; i
++)
672 page_table
[i
].need_to_zero
= 0;
675 /* Zero the pages from START to END (inclusive), except for those
676 * pages that are known to already zeroed. Mark all pages in the
677 * ranges as non-zeroed.
680 zero_dirty_pages(page_index_t start
, page_index_t end
) {
683 for (i
= start
; i
<= end
; i
++) {
684 if (!page_table
[i
].need_to_zero
) continue;
685 for (j
= i
+1; (j
<= end
) && (page_table
[j
].need_to_zero
); j
++);
690 for (i
= start
; i
<= end
; i
++) {
691 page_table
[i
].need_to_zero
= 1;
697 * To support quick and inline allocation, regions of memory can be
698 * allocated and then allocated from with just a free pointer and a
699 * check against an end address.
701 * Since objects can be allocated to spaces with different properties
702 * e.g. boxed/unboxed, generation, ages; there may need to be many
703 * allocation regions.
705 * Each allocation region may start within a partly used page. Many
706 * features of memory use are noted on a page wise basis, e.g. the
707 * generation; so if a region starts within an existing allocated page
708 * it must be consistent with this page.
710 * During the scavenging of the newspace, objects will be transported
711 * into an allocation region, and pointers updated to point to this
712 * allocation region. It is possible that these pointers will be
713 * scavenged again before the allocation region is closed, e.g. due to
714 * trans_list which jumps all over the place to cleanup the list. It
715 * is important to be able to determine properties of all objects
716 * pointed to when scavenging, e.g to detect pointers to the oldspace.
717 * Thus it's important that the allocation regions have the correct
718 * properties set when allocated, and not just set when closed. The
719 * region allocation routines return regions with the specified
720 * properties, and grab all the pages, setting their properties
721 * appropriately, except that the amount used is not known.
723 * These regions are used to support quicker allocation using just a
724 * free pointer. The actual space used by the region is not reflected
725 * in the pages tables until it is closed. It can't be scavenged until
728 * When finished with the region it should be closed, which will
729 * update the page tables for the actual space used returning unused
730 * space. Further it may be noted in the new regions which is
731 * necessary when scavenging the newspace.
733 * Large objects may be allocated directly without an allocation
734 * region, the page tables are updated immediately.
736 * Unboxed objects don't contain pointers to other objects and so
737 * don't need scavenging. Further they can't contain pointers to
738 * younger generations so WP is not needed. By allocating pages to
739 * unboxed objects the whole page never needs scavenging or
740 * write-protecting. */
742 /* We are only using two regions at present. Both are for the current
743 * newspace generation. */
744 struct alloc_region boxed_region
;
745 struct alloc_region unboxed_region
;
747 /* The generation currently being allocated to. */
748 static generation_index_t gc_alloc_generation
;
750 static inline page_index_t
751 generation_alloc_start_page(generation_index_t generation
, int page_type_flag
, int large
)
754 if (UNBOXED_PAGE_FLAG
== page_type_flag
) {
755 return generations
[generation
].alloc_large_unboxed_start_page
;
756 } else if (BOXED_PAGE_FLAG
& page_type_flag
) {
757 /* Both code and data. */
758 return generations
[generation
].alloc_large_start_page
;
760 lose("bad page type flag: %d", page_type_flag
);
763 if (UNBOXED_PAGE_FLAG
== page_type_flag
) {
764 return generations
[generation
].alloc_unboxed_start_page
;
765 } else if (BOXED_PAGE_FLAG
& page_type_flag
) {
766 /* Both code and data. */
767 return generations
[generation
].alloc_start_page
;
769 lose("bad page_type_flag: %d", page_type_flag
);
775 set_generation_alloc_start_page(generation_index_t generation
, int page_type_flag
, int large
,
779 if (UNBOXED_PAGE_FLAG
== page_type_flag
) {
780 generations
[generation
].alloc_large_unboxed_start_page
= page
;
781 } else if (BOXED_PAGE_FLAG
& page_type_flag
) {
782 /* Both code and data. */
783 generations
[generation
].alloc_large_start_page
= page
;
785 lose("bad page type flag: %d", page_type_flag
);
788 if (UNBOXED_PAGE_FLAG
== page_type_flag
) {
789 generations
[generation
].alloc_unboxed_start_page
= page
;
790 } else if (BOXED_PAGE_FLAG
& page_type_flag
) {
791 /* Both code and data. */
792 generations
[generation
].alloc_start_page
= page
;
794 lose("bad page type flag: %d", page_type_flag
);
799 const int n_dwords_in_card
= GENCGC_CARD_BYTES
/ N_WORD_BYTES
/ 2;
801 pinned_dwords(page_index_t page
)
803 if (page_table
[page
].has_pin_map
)
804 return &page_table_pinned_dwords
[page
* (n_dwords_in_card
/N_WORD_BITS
)];
808 /* Find a new region with room for at least the given number of bytes.
810 * It starts looking at the current generation's alloc_start_page. So
811 * may pick up from the previous region if there is enough space. This
812 * keeps the allocation contiguous when scavenging the newspace.
814 * The alloc_region should have been closed by a call to
815 * gc_alloc_update_page_tables(), and will thus be in an empty state.
817 * To assist the scavenging functions write-protected pages are not
818 * used. Free pages should not be write-protected.
820 * It is critical to the conservative GC that the start of regions be
821 * known. To help achieve this only small regions are allocated at a
824 * During scavenging, pointers may be found to within the current
825 * region and the page generation must be set so that pointers to the
826 * from space can be recognized. Therefore the generation of pages in
827 * the region are set to gc_alloc_generation. To prevent another
828 * allocation call using the same pages, all the pages in the region
829 * are allocated, although they will initially be empty.
832 gc_alloc_new_region(sword_t nbytes
, int page_type_flag
, struct alloc_region
*alloc_region
)
834 page_index_t first_page
;
835 page_index_t last_page
;
836 os_vm_size_t bytes_found
;
842 "/alloc_new_region for %d bytes from gen %d\n",
843 nbytes, gc_alloc_generation));
846 /* Check that the region is in a reset state. */
847 gc_assert((alloc_region
->first_page
== 0)
848 && (alloc_region
->last_page
== -1)
849 && (alloc_region
->free_pointer
== alloc_region
->end_addr
));
850 ret
= thread_mutex_lock(&free_pages_lock
);
852 first_page
= generation_alloc_start_page(gc_alloc_generation
, page_type_flag
, 0);
853 last_page
=gc_find_freeish_pages(&first_page
, nbytes
, page_type_flag
);
854 bytes_found
=(GENCGC_CARD_BYTES
- page_table
[first_page
].bytes_used
)
855 + npage_bytes(last_page
-first_page
);
857 /* Set up the alloc_region. */
858 alloc_region
->first_page
= first_page
;
859 alloc_region
->last_page
= last_page
;
860 alloc_region
->start_addr
= page_table
[first_page
].bytes_used
861 + page_address(first_page
);
862 alloc_region
->free_pointer
= alloc_region
->start_addr
;
863 alloc_region
->end_addr
= alloc_region
->start_addr
+ bytes_found
;
865 /* Set up the pages. */
867 /* The first page may have already been in use. */
868 if (page_table
[first_page
].bytes_used
== 0) {
869 page_table
[first_page
].allocated
= page_type_flag
;
870 page_table
[first_page
].gen
= gc_alloc_generation
;
871 page_table
[first_page
].large_object
= 0;
872 page_table
[first_page
].scan_start_offset
= 0;
873 // wiping should have free()ed and :=NULL
874 gc_assert(pinned_dwords(first_page
) == NULL
);
877 gc_assert(page_table
[first_page
].allocated
== page_type_flag
);
878 page_table
[first_page
].allocated
|= OPEN_REGION_PAGE_FLAG
;
880 gc_assert(page_table
[first_page
].gen
== gc_alloc_generation
);
881 gc_assert(page_table
[first_page
].large_object
== 0);
883 for (i
= first_page
+1; i
<= last_page
; i
++) {
884 page_table
[i
].allocated
= page_type_flag
;
885 page_table
[i
].gen
= gc_alloc_generation
;
886 page_table
[i
].large_object
= 0;
887 /* This may not be necessary for unboxed regions (think it was
889 page_table
[i
].scan_start_offset
=
890 void_diff(page_address(i
),alloc_region
->start_addr
);
891 page_table
[i
].allocated
|= OPEN_REGION_PAGE_FLAG
;
893 /* Bump up last_free_page. */
894 if (last_page
+1 > last_free_page
) {
895 last_free_page
= last_page
+1;
896 /* do we only want to call this on special occasions? like for
898 set_alloc_pointer((lispobj
)page_address(last_free_page
));
900 ret
= thread_mutex_unlock(&free_pages_lock
);
903 #ifdef READ_PROTECT_FREE_PAGES
904 os_protect(page_address(first_page
),
905 npage_bytes(1+last_page
-first_page
),
909 /* If the first page was only partial, don't check whether it's
910 * zeroed (it won't be) and don't zero it (since the parts that
911 * we're interested in are guaranteed to be zeroed).
913 if (page_table
[first_page
].bytes_used
) {
917 zero_dirty_pages(first_page
, last_page
);
919 /* we can do this after releasing free_pages_lock */
920 if (gencgc_zero_check
) {
922 for (p
= (word_t
*)alloc_region
->start_addr
;
923 p
< (word_t
*)alloc_region
->end_addr
; p
++) {
925 lose("The new region is not zero at %p (start=%p, end=%p).\n",
926 p
, alloc_region
->start_addr
, alloc_region
->end_addr
);
932 /* If the record_new_objects flag is 2 then all new regions created
935 * If it's 1 then then it is only recorded if the first page of the
936 * current region is <= new_areas_ignore_page. This helps avoid
937 * unnecessary recording when doing full scavenge pass.
939 * The new_object structure holds the page, byte offset, and size of
940 * new regions of objects. Each new area is placed in the array of
941 * these structures pointer to by new_areas. new_areas_index holds the
942 * offset into new_areas.
944 * If new_area overflows NUM_NEW_AREAS then it stops adding them. The
945 * later code must detect this and handle it, probably by doing a full
946 * scavenge of a generation. */
947 #define NUM_NEW_AREAS 512
948 static int record_new_objects
= 0;
949 static page_index_t new_areas_ignore_page
;
955 static struct new_area (*new_areas
)[];
956 static size_t new_areas_index
;
957 size_t max_new_areas
;
959 /* Add a new area to new_areas. */
961 add_new_area(page_index_t first_page
, size_t offset
, size_t size
)
963 size_t new_area_start
, c
;
966 /* Ignore if full. */
967 if (new_areas_index
>= NUM_NEW_AREAS
)
970 switch (record_new_objects
) {
974 if (first_page
> new_areas_ignore_page
)
983 new_area_start
= npage_bytes(first_page
) + offset
;
985 /* Search backwards for a prior area that this follows from. If
986 found this will save adding a new area. */
987 for (i
= new_areas_index
-1, c
= 0; (i
>= 0) && (c
< 8); i
--, c
++) {
989 npage_bytes((*new_areas
)[i
].page
)
990 + (*new_areas
)[i
].offset
991 + (*new_areas
)[i
].size
;
993 "/add_new_area S1 %d %d %d %d\n",
994 i, c, new_area_start, area_end));*/
995 if (new_area_start
== area_end
) {
997 "/adding to [%d] %d %d %d with %d %d %d:\n",
999 (*new_areas)[i].page,
1000 (*new_areas)[i].offset,
1001 (*new_areas)[i].size,
1005 (*new_areas
)[i
].size
+= size
;
1010 (*new_areas
)[new_areas_index
].page
= first_page
;
1011 (*new_areas
)[new_areas_index
].offset
= offset
;
1012 (*new_areas
)[new_areas_index
].size
= size
;
1014 "/new_area %d page %d offset %d size %d\n",
1015 new_areas_index, first_page, offset, size));*/
1018 /* Note the max new_areas used. */
1019 if (new_areas_index
> max_new_areas
)
1020 max_new_areas
= new_areas_index
;
1023 /* Update the tables for the alloc_region. The region may be added to
1026 * When done the alloc_region is set up so that the next quick alloc
1027 * will fail safely and thus a new region will be allocated. Further
1028 * it is safe to try to re-update the page table of this reset
1031 gc_alloc_update_page_tables(int page_type_flag
, struct alloc_region
*alloc_region
)
1034 page_index_t first_page
;
1035 page_index_t next_page
;
1036 os_vm_size_t bytes_used
;
1037 os_vm_size_t region_size
;
1038 os_vm_size_t byte_cnt
;
1039 page_bytes_t orig_first_page_bytes_used
;
1043 first_page
= alloc_region
->first_page
;
1045 /* Catch an unused alloc_region. */
1046 if ((first_page
== 0) && (alloc_region
->last_page
== -1))
1049 next_page
= first_page
+1;
1051 ret
= thread_mutex_lock(&free_pages_lock
);
1052 gc_assert(ret
== 0);
1053 if (alloc_region
->free_pointer
!= alloc_region
->start_addr
) {
1054 /* some bytes were allocated in the region */
1055 orig_first_page_bytes_used
= page_table
[first_page
].bytes_used
;
1057 gc_assert(alloc_region
->start_addr
==
1058 (page_address(first_page
)
1059 + page_table
[first_page
].bytes_used
));
1061 /* All the pages used need to be updated */
1063 /* Update the first page. */
1065 /* If the page was free then set up the gen, and
1066 * scan_start_offset. */
1067 if (page_table
[first_page
].bytes_used
== 0)
1068 gc_assert(page_starts_contiguous_block_p(first_page
));
1069 page_table
[first_page
].allocated
&= ~(OPEN_REGION_PAGE_FLAG
);
1071 gc_assert(page_table
[first_page
].allocated
& page_type_flag
);
1072 gc_assert(page_table
[first_page
].gen
== gc_alloc_generation
);
1073 gc_assert(page_table
[first_page
].large_object
== 0);
1077 /* Calculate the number of bytes used in this page. This is not
1078 * always the number of new bytes, unless it was free. */
1080 if ((bytes_used
= void_diff(alloc_region
->free_pointer
,
1081 page_address(first_page
)))
1082 >GENCGC_CARD_BYTES
) {
1083 bytes_used
= GENCGC_CARD_BYTES
;
1086 page_table
[first_page
].bytes_used
= bytes_used
;
1087 byte_cnt
+= bytes_used
;
1090 /* All the rest of the pages should be free. We need to set
1091 * their scan_start_offset pointer to the start of the
1092 * region, and set the bytes_used. */
1094 page_table
[next_page
].allocated
&= ~(OPEN_REGION_PAGE_FLAG
);
1095 gc_assert(page_table
[next_page
].allocated
& page_type_flag
);
1096 gc_assert(page_table
[next_page
].bytes_used
== 0);
1097 gc_assert(page_table
[next_page
].gen
== gc_alloc_generation
);
1098 gc_assert(page_table
[next_page
].large_object
== 0);
1100 gc_assert(page_table
[next_page
].scan_start_offset
==
1101 void_diff(page_address(next_page
),
1102 alloc_region
->start_addr
));
1104 /* Calculate the number of bytes used in this page. */
1106 if ((bytes_used
= void_diff(alloc_region
->free_pointer
,
1107 page_address(next_page
)))>GENCGC_CARD_BYTES
) {
1108 bytes_used
= GENCGC_CARD_BYTES
;
1111 page_table
[next_page
].bytes_used
= bytes_used
;
1112 byte_cnt
+= bytes_used
;
1117 region_size
= void_diff(alloc_region
->free_pointer
,
1118 alloc_region
->start_addr
);
1119 bytes_allocated
+= region_size
;
1120 generations
[gc_alloc_generation
].bytes_allocated
+= region_size
;
1122 gc_assert((byte_cnt
- orig_first_page_bytes_used
) == region_size
);
1124 /* Set the generations alloc restart page to the last page of
1126 set_generation_alloc_start_page(gc_alloc_generation
, page_type_flag
, 0, next_page
-1);
1128 /* Add the region to the new_areas if requested. */
1129 if (BOXED_PAGE_FLAG
& page_type_flag
)
1130 add_new_area(first_page
,orig_first_page_bytes_used
, region_size
);
1134 "/gc_alloc_update_page_tables update %d bytes to gen %d\n",
1136 gc_alloc_generation));
1139 /* There are no bytes allocated. Unallocate the first_page if
1140 * there are 0 bytes_used. */
1141 page_table
[first_page
].allocated
&= ~(OPEN_REGION_PAGE_FLAG
);
1142 if (page_table
[first_page
].bytes_used
== 0)
1143 page_table
[first_page
].allocated
= FREE_PAGE_FLAG
;
1146 /* Unallocate any unused pages. */
1147 while (next_page
<= alloc_region
->last_page
) {
1148 gc_assert(page_table
[next_page
].bytes_used
== 0);
1149 page_table
[next_page
].allocated
= FREE_PAGE_FLAG
;
1152 ret
= thread_mutex_unlock(&free_pages_lock
);
1153 gc_assert(ret
== 0);
1155 /* alloc_region is per-thread, we're ok to do this unlocked */
1156 gc_set_region_empty(alloc_region
);
1159 /* Allocate a possibly large object. */
1161 gc_alloc_large(sword_t nbytes
, int page_type_flag
, struct alloc_region
*alloc_region
)
1164 page_index_t first_page
, next_page
, last_page
;
1165 page_bytes_t orig_first_page_bytes_used
;
1166 os_vm_size_t byte_cnt
;
1167 os_vm_size_t bytes_used
;
1170 ret
= thread_mutex_lock(&free_pages_lock
);
1171 gc_assert(ret
== 0);
1173 first_page
= generation_alloc_start_page(gc_alloc_generation
, page_type_flag
, 1);
1174 if (first_page
<= alloc_region
->last_page
) {
1175 first_page
= alloc_region
->last_page
+1;
1178 last_page
=gc_find_freeish_pages(&first_page
,nbytes
, page_type_flag
);
1180 gc_assert(first_page
> alloc_region
->last_page
);
1182 set_generation_alloc_start_page(gc_alloc_generation
, page_type_flag
, 1, last_page
);
1184 /* Set up the pages. */
1185 orig_first_page_bytes_used
= page_table
[first_page
].bytes_used
;
1187 /* If the first page was free then set up the gen, and
1188 * scan_start_offset. */
1189 if (page_table
[first_page
].bytes_used
== 0) {
1190 page_table
[first_page
].allocated
= page_type_flag
;
1191 page_table
[first_page
].gen
= gc_alloc_generation
;
1192 page_table
[first_page
].scan_start_offset
= 0;
1193 page_table
[first_page
].large_object
= 1;
1196 gc_assert(page_table
[first_page
].allocated
== page_type_flag
);
1197 gc_assert(page_table
[first_page
].gen
== gc_alloc_generation
);
1198 gc_assert(page_table
[first_page
].large_object
== 1);
1202 /* Calc. the number of bytes used in this page. This is not
1203 * always the number of new bytes, unless it was free. */
1205 if ((bytes_used
= nbytes
+orig_first_page_bytes_used
) > GENCGC_CARD_BYTES
) {
1206 bytes_used
= GENCGC_CARD_BYTES
;
1209 page_table
[first_page
].bytes_used
= bytes_used
;
1210 byte_cnt
+= bytes_used
;
1212 next_page
= first_page
+1;
1214 /* All the rest of the pages should be free. We need to set their
1215 * scan_start_offset pointer to the start of the region, and set
1216 * the bytes_used. */
1218 gc_assert(page_free_p(next_page
));
1219 gc_assert(page_table
[next_page
].bytes_used
== 0);
1220 page_table
[next_page
].allocated
= page_type_flag
;
1221 page_table
[next_page
].gen
= gc_alloc_generation
;
1222 page_table
[next_page
].large_object
= 1;
1224 page_table
[next_page
].scan_start_offset
=
1225 npage_bytes(next_page
-first_page
) - orig_first_page_bytes_used
;
1227 /* Calculate the number of bytes used in this page. */
1229 bytes_used
=(nbytes
+orig_first_page_bytes_used
)-byte_cnt
;
1230 if (bytes_used
> GENCGC_CARD_BYTES
) {
1231 bytes_used
= GENCGC_CARD_BYTES
;
1234 page_table
[next_page
].bytes_used
= bytes_used
;
1235 page_table
[next_page
].write_protected
=0;
1236 page_table
[next_page
].dont_move
=0;
1237 byte_cnt
+= bytes_used
;
1241 gc_assert((byte_cnt
-orig_first_page_bytes_used
) == (size_t)nbytes
);
1243 bytes_allocated
+= nbytes
;
1244 generations
[gc_alloc_generation
].bytes_allocated
+= nbytes
;
1246 /* Add the region to the new_areas if requested. */
1247 if (BOXED_PAGE_FLAG
& page_type_flag
)
1248 add_new_area(first_page
,orig_first_page_bytes_used
,nbytes
);
1250 /* Bump up last_free_page */
1251 if (last_page
+1 > last_free_page
) {
1252 last_free_page
= last_page
+1;
1253 set_alloc_pointer((lispobj
)(page_address(last_free_page
)));
1255 ret
= thread_mutex_unlock(&free_pages_lock
);
1256 gc_assert(ret
== 0);
1258 #ifdef READ_PROTECT_FREE_PAGES
1259 os_protect(page_address(first_page
),
1260 npage_bytes(1+last_page
-first_page
),
1264 zero_dirty_pages(first_page
, last_page
);
1266 return page_address(first_page
);
1269 static page_index_t gencgc_alloc_start_page
= -1;
1272 gc_heap_exhausted_error_or_lose (sword_t available
, sword_t requested
)
1274 struct thread
*thread
= arch_os_get_current_thread();
1275 /* Write basic information before doing anything else: if we don't
1276 * call to lisp this is a must, and even if we do there is always
1277 * the danger that we bounce back here before the error has been
1278 * handled, or indeed even printed.
1280 report_heap_exhaustion(available
, requested
, thread
);
1281 if (gc_active_p
|| (available
== 0)) {
1282 /* If we are in GC, or totally out of memory there is no way
1283 * to sanely transfer control to the lisp-side of things.
1285 lose("Heap exhausted, game over.");
1288 /* FIXME: assert free_pages_lock held */
1289 (void)thread_mutex_unlock(&free_pages_lock
);
1290 #if !(defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD))
1291 gc_assert(get_pseudo_atomic_atomic(thread
));
1292 clear_pseudo_atomic_atomic(thread
);
1293 if (get_pseudo_atomic_interrupted(thread
))
1294 do_pending_interrupt();
1296 /* Another issue is that signalling HEAP-EXHAUSTED error leads
1297 * to running user code at arbitrary places, even in a
1298 * WITHOUT-INTERRUPTS which may lead to a deadlock without
1299 * running out of the heap. So at this point all bets are
1301 if (SymbolValue(INTERRUPTS_ENABLED
,thread
) == NIL
)
1302 corruption_warning_and_maybe_lose
1303 ("Signalling HEAP-EXHAUSTED in a WITHOUT-INTERRUPTS.");
1304 /* available and requested should be double word aligned, thus
1305 they can passed as fixnums and shifted later. */
1306 funcall2(StaticSymbolFunction(HEAP_EXHAUSTED_ERROR
), available
, requested
);
1307 lose("HEAP-EXHAUSTED-ERROR fell through");
1312 gc_find_freeish_pages(page_index_t
*restart_page_ptr
, sword_t bytes
,
1315 page_index_t most_bytes_found_from
= 0, most_bytes_found_to
= 0;
1316 page_index_t first_page
, last_page
, restart_page
= *restart_page_ptr
;
1317 os_vm_size_t nbytes
= bytes
;
1318 os_vm_size_t nbytes_goal
= nbytes
;
1319 os_vm_size_t bytes_found
= 0;
1320 os_vm_size_t most_bytes_found
= 0;
1321 boolean small_object
= nbytes
< GENCGC_CARD_BYTES
;
1322 /* FIXME: assert(free_pages_lock is held); */
1324 if (nbytes_goal
< gencgc_alloc_granularity
)
1325 nbytes_goal
= gencgc_alloc_granularity
;
1327 /* Toggled by gc_and_save for heap compaction, normally -1. */
1328 if (gencgc_alloc_start_page
!= -1) {
1329 restart_page
= gencgc_alloc_start_page
;
1332 /* FIXME: This is on bytes instead of nbytes pending cleanup of
1333 * long from the interface. */
1334 gc_assert(bytes
>=0);
1335 /* Search for a page with at least nbytes of space. We prefer
1336 * not to split small objects on multiple pages, to reduce the
1337 * number of contiguous allocation regions spaning multiple
1338 * pages: this helps avoid excessive conservativism.
1340 * For other objects, we guarantee that they start on their own
1343 first_page
= restart_page
;
1344 while (first_page
< page_table_pages
) {
1346 if (page_free_p(first_page
)) {
1347 gc_assert(0 == page_table
[first_page
].bytes_used
);
1348 bytes_found
= GENCGC_CARD_BYTES
;
1349 } else if (small_object
&&
1350 (page_table
[first_page
].allocated
== page_type_flag
) &&
1351 (page_table
[first_page
].large_object
== 0) &&
1352 (page_table
[first_page
].gen
== gc_alloc_generation
) &&
1353 (page_table
[first_page
].write_protected
== 0) &&
1354 (page_table
[first_page
].dont_move
== 0)) {
1355 bytes_found
= GENCGC_CARD_BYTES
- page_table
[first_page
].bytes_used
;
1356 if (bytes_found
< nbytes
) {
1357 if (bytes_found
> most_bytes_found
)
1358 most_bytes_found
= bytes_found
;
1367 gc_assert(page_table
[first_page
].write_protected
== 0);
1368 for (last_page
= first_page
+1;
1369 ((last_page
< page_table_pages
) &&
1370 page_free_p(last_page
) &&
1371 (bytes_found
< nbytes_goal
));
1373 bytes_found
+= GENCGC_CARD_BYTES
;
1374 gc_assert(0 == page_table
[last_page
].bytes_used
);
1375 gc_assert(0 == page_table
[last_page
].write_protected
);
1378 if (bytes_found
> most_bytes_found
) {
1379 most_bytes_found
= bytes_found
;
1380 most_bytes_found_from
= first_page
;
1381 most_bytes_found_to
= last_page
;
1383 if (bytes_found
>= nbytes_goal
)
1386 first_page
= last_page
;
1389 bytes_found
= most_bytes_found
;
1390 restart_page
= first_page
+ 1;
1392 /* Check for a failure */
1393 if (bytes_found
< nbytes
) {
1394 gc_assert(restart_page
>= page_table_pages
);
1395 gc_heap_exhausted_error_or_lose(most_bytes_found
, nbytes
);
1398 gc_assert(most_bytes_found_to
);
1399 *restart_page_ptr
= most_bytes_found_from
;
1400 return most_bytes_found_to
-1;
1403 /* Allocate bytes. All the rest of the special-purpose allocation
1404 * functions will eventually call this */
1407 gc_alloc_with_region(sword_t nbytes
,int page_type_flag
, struct alloc_region
*my_region
,
1410 void *new_free_pointer
;
1412 if (nbytes
>=LARGE_OBJECT_SIZE
)
1413 return gc_alloc_large(nbytes
, page_type_flag
, my_region
);
1415 /* Check whether there is room in the current alloc region. */
1416 new_free_pointer
= my_region
->free_pointer
+ nbytes
;
1418 /* fprintf(stderr, "alloc %d bytes from %p to %p\n", nbytes,
1419 my_region->free_pointer, new_free_pointer); */
1421 if (new_free_pointer
<= my_region
->end_addr
) {
1422 /* If so then allocate from the current alloc region. */
1423 void *new_obj
= my_region
->free_pointer
;
1424 my_region
->free_pointer
= new_free_pointer
;
1426 /* Unless a `quick' alloc was requested, check whether the
1427 alloc region is almost empty. */
1429 void_diff(my_region
->end_addr
,my_region
->free_pointer
) <= 32) {
1430 /* If so, finished with the current region. */
1431 gc_alloc_update_page_tables(page_type_flag
, my_region
);
1432 /* Set up a new region. */
1433 gc_alloc_new_region(32 /*bytes*/, page_type_flag
, my_region
);
1436 return((void *)new_obj
);
1439 /* Else not enough free space in the current region: retry with a
1442 gc_alloc_update_page_tables(page_type_flag
, my_region
);
1443 gc_alloc_new_region(nbytes
, page_type_flag
, my_region
);
1444 return gc_alloc_with_region(nbytes
, page_type_flag
, my_region
,0);
1447 /* Copy a large object. If the object is in a large object region then
1448 * it is simply promoted, else it is copied. If it's large enough then
1449 * it's copied to a large object region.
1451 * Bignums and vectors may have shrunk. If the object is not copied
1452 * the space needs to be reclaimed, and the page_tables corrected. */
1454 general_copy_large_object(lispobj object
, word_t nwords
, boolean boxedp
)
1458 page_index_t first_page
;
1460 gc_assert(is_lisp_pointer(object
));
1461 gc_assert(from_space_p(object
));
1462 gc_assert((nwords
& 0x01) == 0);
1464 if ((nwords
> 1024*1024) && gencgc_verbose
) {
1465 FSHOW((stderr
, "/general_copy_large_object: %d bytes\n",
1466 nwords
*N_WORD_BYTES
));
1469 /* Check whether it's a large object. */
1470 first_page
= find_page_index((void *)object
);
1471 gc_assert(first_page
>= 0);
1473 if (page_table
[first_page
].large_object
) {
1474 /* Promote the object. Note: Unboxed objects may have been
1475 * allocated to a BOXED region so it may be necessary to
1476 * change the region to UNBOXED. */
1477 os_vm_size_t remaining_bytes
;
1478 os_vm_size_t bytes_freed
;
1479 page_index_t next_page
;
1480 page_bytes_t old_bytes_used
;
1482 /* FIXME: This comment is somewhat stale.
1484 * Note: Any page write-protection must be removed, else a
1485 * later scavenge_newspace may incorrectly not scavenge these
1486 * pages. This would not be necessary if they are added to the
1487 * new areas, but let's do it for them all (they'll probably
1488 * be written anyway?). */
1490 gc_assert(page_starts_contiguous_block_p(first_page
));
1491 next_page
= first_page
;
1492 remaining_bytes
= nwords
*N_WORD_BYTES
;
1494 while (remaining_bytes
> GENCGC_CARD_BYTES
) {
1495 gc_assert(page_table
[next_page
].gen
== from_space
);
1496 gc_assert(page_table
[next_page
].large_object
);
1497 gc_assert(page_table
[next_page
].scan_start_offset
==
1498 npage_bytes(next_page
-first_page
));
1499 gc_assert(page_table
[next_page
].bytes_used
== GENCGC_CARD_BYTES
);
1500 /* Should have been unprotected by unprotect_oldspace()
1501 * for boxed objects, and after promotion unboxed ones
1502 * should not be on protected pages at all. */
1503 gc_assert(!page_table
[next_page
].write_protected
);
1506 gc_assert(page_boxed_p(next_page
));
1508 gc_assert(page_allocated_no_region_p(next_page
));
1509 page_table
[next_page
].allocated
= UNBOXED_PAGE_FLAG
;
1511 page_table
[next_page
].gen
= new_space
;
1513 remaining_bytes
-= GENCGC_CARD_BYTES
;
1517 /* Now only one page remains, but the object may have shrunk so
1518 * there may be more unused pages which will be freed. */
1520 /* Object may have shrunk but shouldn't have grown - check. */
1521 gc_assert(page_table
[next_page
].bytes_used
>= remaining_bytes
);
1523 page_table
[next_page
].gen
= new_space
;
1526 gc_assert(page_boxed_p(next_page
));
1528 page_table
[next_page
].allocated
= UNBOXED_PAGE_FLAG
;
1530 /* Adjust the bytes_used. */
1531 old_bytes_used
= page_table
[next_page
].bytes_used
;
1532 page_table
[next_page
].bytes_used
= remaining_bytes
;
1534 bytes_freed
= old_bytes_used
- remaining_bytes
;
1536 /* Free any remaining pages; needs care. */
1538 while ((old_bytes_used
== GENCGC_CARD_BYTES
) &&
1539 (page_table
[next_page
].gen
== from_space
) &&
1540 /* FIXME: It is not obvious to me why this is necessary
1541 * as a loop condition: it seems to me that the
1542 * scan_start_offset test should be sufficient, but
1543 * experimentally that is not the case. --NS
1546 page_boxed_p(next_page
) :
1547 page_allocated_no_region_p(next_page
)) &&
1548 page_table
[next_page
].large_object
&&
1549 (page_table
[next_page
].scan_start_offset
==
1550 npage_bytes(next_page
- first_page
))) {
1551 /* Checks out OK, free the page. Don't need to both zeroing
1552 * pages as this should have been done before shrinking the
1553 * object. These pages shouldn't be write-protected, even if
1554 * boxed they should be zero filled. */
1555 gc_assert(page_table
[next_page
].write_protected
== 0);
1557 old_bytes_used
= page_table
[next_page
].bytes_used
;
1558 page_table
[next_page
].allocated
= FREE_PAGE_FLAG
;
1559 page_table
[next_page
].bytes_used
= 0;
1560 bytes_freed
+= old_bytes_used
;
1564 if ((bytes_freed
> 0) && gencgc_verbose
) {
1566 "/general_copy_large_object bytes_freed=%"OS_VM_SIZE_FMT
"\n",
1570 generations
[from_space
].bytes_allocated
-= nwords
*N_WORD_BYTES
1572 generations
[new_space
].bytes_allocated
+= nwords
*N_WORD_BYTES
;
1573 bytes_allocated
-= bytes_freed
;
1575 /* Add the region to the new_areas if requested. */
1577 add_new_area(first_page
,0,nwords
*N_WORD_BYTES
);
1582 /* Get tag of object. */
1583 tag
= lowtag_of(object
);
1585 /* Allocate space. */
1586 new = gc_general_alloc(nwords
*N_WORD_BYTES
,
1587 (boxedp
? BOXED_PAGE_FLAG
: UNBOXED_PAGE_FLAG
),
1590 /* Copy the object. */
1591 memcpy(new,native_pointer(object
),nwords
*N_WORD_BYTES
);
1593 /* Return Lisp pointer of new object. */
1594 return ((lispobj
) new) | tag
;
1599 copy_large_object(lispobj object
, sword_t nwords
)
1601 return general_copy_large_object(object
, nwords
, 1);
1605 copy_large_unboxed_object(lispobj object
, sword_t nwords
)
1607 return general_copy_large_object(object
, nwords
, 0);
1610 /* to copy unboxed objects */
1612 copy_unboxed_object(lispobj object
, sword_t nwords
)
1614 return gc_general_copy_object(object
, nwords
, UNBOXED_PAGE_FLAG
);
1619 * code and code-related objects
1622 static lispobj trans_fun_header(lispobj object);
1623 static lispobj trans_boxed(lispobj object);
1626 /* Scan a x86 compiled code object, looking for possible fixups that
1627 * have been missed after a move.
1629 * Two types of fixups are needed:
1630 * 1. Absolute fixups to within the code object.
1631 * 2. Relative fixups to outside the code object.
1633 * Currently only absolute fixups to the constant vector, or to the
1634 * code area are checked. */
1635 #ifdef LISP_FEATURE_X86
1637 sniff_code_object(struct code
*code
, os_vm_size_t displacement
)
1639 sword_t nheader_words
, ncode_words
, nwords
;
1640 os_vm_address_t constants_start_addr
= NULL
, constants_end_addr
, p
;
1641 os_vm_address_t code_start_addr
, code_end_addr
;
1642 os_vm_address_t code_addr
= (os_vm_address_t
)code
;
1643 int fixup_found
= 0;
1645 if (!check_code_fixups
)
1648 FSHOW((stderr
, "/sniffing code: %p, %lu\n", code
, displacement
));
1650 ncode_words
= code_instruction_words(code
->code_size
);
1651 nheader_words
= code_header_words(*(lispobj
*)code
);
1652 nwords
= ncode_words
+ nheader_words
;
1654 constants_start_addr
= code_addr
+ 5*N_WORD_BYTES
;
1655 constants_end_addr
= code_addr
+ nheader_words
*N_WORD_BYTES
;
1656 code_start_addr
= code_addr
+ nheader_words
*N_WORD_BYTES
;
1657 code_end_addr
= code_addr
+ nwords
*N_WORD_BYTES
;
1659 /* Work through the unboxed code. */
1660 for (p
= code_start_addr
; p
< code_end_addr
; p
++) {
1661 void *data
= *(void **)p
;
1662 unsigned d1
= *((unsigned char *)p
- 1);
1663 unsigned d2
= *((unsigned char *)p
- 2);
1664 unsigned d3
= *((unsigned char *)p
- 3);
1665 unsigned d4
= *((unsigned char *)p
- 4);
1667 unsigned d5
= *((unsigned char *)p
- 5);
1668 unsigned d6
= *((unsigned char *)p
- 6);
1671 /* Check for code references. */
1672 /* Check for a 32 bit word that looks like an absolute
1673 reference to within the code adea of the code object. */
1674 if ((data
>= (void*)(code_start_addr
-displacement
))
1675 && (data
< (void*)(code_end_addr
-displacement
))) {
1676 /* function header */
1678 && (((unsigned)p
- 4 - 4*HeaderValue(*((unsigned *)p
-1))) ==
1680 /* Skip the function header */
1684 /* the case of PUSH imm32 */
1688 "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1689 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1690 FSHOW((stderr
, "/PUSH $0x%.8x\n", data
));
1692 /* the case of MOV [reg-8],imm32 */
1694 && (d2
==0x40 || d2
==0x41 || d2
==0x42 || d2
==0x43
1695 || d2
==0x45 || d2
==0x46 || d2
==0x47)
1699 "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1700 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1701 FSHOW((stderr
, "/MOV [reg-8],$0x%.8x\n", data
));
1703 /* the case of LEA reg,[disp32] */
1704 if ((d2
== 0x8d) && ((d1
& 0xc7) == 5)) {
1707 "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1708 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1709 FSHOW((stderr
,"/LEA reg,[$0x%.8x]\n", data
));
1713 /* Check for constant references. */
1714 /* Check for a 32 bit word that looks like an absolute
1715 reference to within the constant vector. Constant references
1717 if ((data
>= (void*)(constants_start_addr
-displacement
))
1718 && (data
< (void*)(constants_end_addr
-displacement
))
1719 && (((unsigned)data
& 0x3) == 0)) {
1724 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1725 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1726 FSHOW((stderr
,"/MOV eax,0x%.8x\n", data
));
1729 /* the case of MOV m32,EAX */
1733 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1734 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1735 FSHOW((stderr
, "/MOV 0x%.8x,eax\n", data
));
1738 /* the case of CMP m32,imm32 */
1739 if ((d1
== 0x3d) && (d2
== 0x81)) {
1742 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1743 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1745 FSHOW((stderr
, "/CMP 0x%.8x,immed32\n", data
));
1748 /* Check for a mod=00, r/m=101 byte. */
1749 if ((d1
& 0xc7) == 5) {
1754 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1755 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1756 FSHOW((stderr
,"/CMP 0x%.8x,reg\n", data
));
1758 /* the case of CMP reg32,m32 */
1762 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1763 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1764 FSHOW((stderr
, "/CMP reg32,0x%.8x\n", data
));
1766 /* the case of MOV m32,reg32 */
1770 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1771 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1772 FSHOW((stderr
, "/MOV 0x%.8x,reg32\n", data
));
1774 /* the case of MOV reg32,m32 */
1778 "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1779 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1780 FSHOW((stderr
, "/MOV reg32,0x%.8x\n", data
));
1782 /* the case of LEA reg32,m32 */
1786 "abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1787 p
, d6
, d5
, d4
, d3
, d2
, d1
, data
));
1788 FSHOW((stderr
, "/LEA reg32,0x%.8x\n", data
));
1794 /* If anything was found, print some information on the code
1798 "/compiled code object at %x: header words = %d, code words = %d\n",
1799 code
, nheader_words
, ncode_words
));
1801 "/const start = %x, end = %x\n",
1802 constants_start_addr
, constants_end_addr
));
1804 "/code start = %x, end = %x\n",
1805 code_start_addr
, code_end_addr
));
1810 #ifdef LISP_FEATURE_X86
1812 gencgc_apply_code_fixups(struct code
*old_code
, struct code
*new_code
)
1814 sword_t nheader_words
, ncode_words
, nwords
;
1815 os_vm_address_t constants_start_addr
, constants_end_addr
;
1816 os_vm_address_t code_start_addr
, code_end_addr
;
1817 os_vm_address_t code_addr
= (os_vm_address_t
)new_code
;
1818 os_vm_address_t old_addr
= (os_vm_address_t
)old_code
;
1819 os_vm_size_t displacement
= code_addr
- old_addr
;
1820 lispobj fixups
= NIL
;
1821 struct vector
*fixups_vector
;
1823 ncode_words
= code_instruction_words(new_code
->code_size
);
1824 nheader_words
= code_header_words(*(lispobj
*)new_code
);
1825 nwords
= ncode_words
+ nheader_words
;
1827 "/compiled code object at %x: header words = %d, code words = %d\n",
1828 new_code, nheader_words, ncode_words)); */
1829 constants_start_addr
= code_addr
+ 5*N_WORD_BYTES
;
1830 constants_end_addr
= code_addr
+ nheader_words
*N_WORD_BYTES
;
1831 code_start_addr
= code_addr
+ nheader_words
*N_WORD_BYTES
;
1832 code_end_addr
= code_addr
+ nwords
*N_WORD_BYTES
;
1835 "/const start = %x, end = %x\n",
1836 constants_start_addr,constants_end_addr));
1838 "/code start = %x; end = %x\n",
1839 code_start_addr,code_end_addr));
1842 fixups
= new_code
->fixups
;
1843 /* It will be a Lisp vector if valid, or 0 if there are no fixups */
1844 if (fixups
== 0 || !is_lisp_pointer(fixups
)) {
1845 /* Check for possible errors. */
1846 if (check_code_fixups
)
1847 sniff_code_object(new_code
, displacement
);
1852 fixups_vector
= (struct vector
*)native_pointer(fixups
);
1854 /* Could be pointing to a forwarding pointer. */
1855 /* This is extremely unlikely, because the only referent of the fixups
1856 is usually the code itself; so scavenging the vector won't occur
1857 until after the code object is known to be live. As we're just now
1858 enlivening the code, the fixups shouldn't have been forwarded.
1859 Maybe the vector is on the special binding stack though ... */
1860 if (is_lisp_pointer(fixups
) &&
1861 (find_page_index((void*)fixups_vector
) != -1) &&
1862 forwarding_pointer_p((lispobj
*)fixups_vector
)) {
1863 /* If so, then follow it. */
1864 /*SHOW("following pointer to a forwarding pointer");*/
1865 fixups_vector
= (struct vector
*)
1866 native_pointer(forwarding_pointer_value((lispobj
*)fixups_vector
));
1869 /*SHOW("got fixups");*/
1871 if (widetag_of(fixups_vector
->header
) == SIMPLE_ARRAY_WORD_WIDETAG
) {
1872 /* Got the fixups for the code block. Now work through the vector,
1873 and apply a fixup at each address. */
1874 sword_t length
= fixnum_value(fixups_vector
->length
);
1876 for (i
= 0; i
< length
; i
++) {
1877 long offset
= fixups_vector
->data
[i
];
1878 /* Now check the current value of offset. */
1879 os_vm_address_t old_value
= *(os_vm_address_t
*)(code_start_addr
+ offset
);
1881 /* If it's within the old_code object then it must be an
1882 * absolute fixup (relative ones are not saved) */
1883 if ((old_value
>= old_addr
)
1884 && (old_value
< (old_addr
+ nwords
*N_WORD_BYTES
)))
1885 /* So add the dispacement. */
1886 *(os_vm_address_t
*)(code_start_addr
+ offset
) =
1887 old_value
+ displacement
;
1889 /* It is outside the old code object so it must be a
1890 * relative fixup (absolute fixups are not saved). So
1891 * subtract the displacement. */
1892 *(os_vm_address_t
*)(code_start_addr
+ offset
) =
1893 old_value
- displacement
;
1896 /* This used to just print a note to stderr, but a bogus fixup seems to
1897 * indicate real heap corruption, so a hard hailure is in order. */
1898 lose("fixup vector %p has a bad widetag: %d\n",
1899 fixups_vector
, widetag_of(fixups_vector
->header
));
1902 /* Check for possible errors. */
1903 if (check_code_fixups
) {
1904 sniff_code_object(new_code
,displacement
);
1910 trans_boxed_large(lispobj object
)
1915 gc_assert(is_lisp_pointer(object
));
1917 header
= *((lispobj
*) native_pointer(object
));
1918 length
= HeaderValue(header
) + 1;
1919 length
= CEILING(length
, 2);
1921 return copy_large_object(object
, length
);
1928 /* XX This is a hack adapted from cgc.c. These don't work too
1929 * efficiently with the gencgc as a list of the weak pointers is
1930 * maintained within the objects which causes writes to the pages. A
1931 * limited attempt is made to avoid unnecessary writes, but this needs
1933 #define WEAK_POINTER_NWORDS \
1934 CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1937 scav_weak_pointer(lispobj
*where
, lispobj object
)
1939 /* Since we overwrite the 'next' field, we have to make
1940 * sure not to do so for pointers already in the list.
1941 * Instead of searching the list of weak_pointers each
1942 * time, we ensure that next is always NULL when the weak
1943 * pointer isn't in the list, and not NULL otherwise.
1944 * Since we can't use NULL to denote end of list, we
1945 * use a pointer back to the same weak_pointer.
1947 struct weak_pointer
* wp
= (struct weak_pointer
*)where
;
1949 if (NULL
== wp
->next
) {
1950 wp
->next
= weak_pointers
;
1952 if (NULL
== wp
->next
)
1956 /* Do not let GC scavenge the value slot of the weak pointer.
1957 * (That is why it is a weak pointer.) */
1959 return WEAK_POINTER_NWORDS
;
1964 search_read_only_space(void *pointer
)
1966 lispobj
*start
= (lispobj
*) READ_ONLY_SPACE_START
;
1967 lispobj
*end
= (lispobj
*) SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0);
1968 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
1970 return (gc_search_space(start
,
1971 (((lispobj
*)pointer
)+2)-start
,
1972 (lispobj
*) pointer
));
1976 search_static_space(void *pointer
)
1978 lispobj
*start
= (lispobj
*)STATIC_SPACE_START
;
1979 lispobj
*end
= (lispobj
*)SymbolValue(STATIC_SPACE_FREE_POINTER
,0);
1980 if ((pointer
< (void *)start
) || (pointer
>= (void *)end
))
1982 return (gc_search_space(start
,
1983 (((lispobj
*)pointer
)+2)-start
,
1984 (lispobj
*) pointer
));
1987 /* a faster version for searching the dynamic space. This will work even
1988 * if the object is in a current allocation region. */
1990 search_dynamic_space(void *pointer
)
1992 page_index_t page_index
= find_page_index(pointer
);
1995 /* The address may be invalid, so do some checks. */
1996 if ((page_index
== -1) || page_free_p(page_index
))
1998 start
= (lispobj
*)page_scan_start(page_index
);
1999 return (gc_search_space(start
,
2000 (((lispobj
*)pointer
)+2)-start
,
2001 (lispobj
*)pointer
));
2004 // Return the starting address of the object containing 'addr'
2005 // if and only if the object is one which would be evacuated from 'from_space'
2006 // were it allowed to be either discarded as garbage or moved.
2007 // 'addr_page_index' is the page containing 'addr' and must not be -1.
2008 // Return 0 if there is no such object - that is, if addr is past the
2009 // end of the used bytes, or its pages are not in 'from_space' etc.
2011 conservative_root_p(void *addr
, page_index_t addr_page_index
)
2013 #ifdef GENCGC_IS_PRECISE
2014 /* If we're in precise gencgc (non-x86oid as of this writing) then
2015 * we are only called on valid object pointers in the first place,
2016 * so we just have to do a bounds-check against the heap, a
2017 * generation check, and the already-pinned check. */
2018 if ((page_table
[addr_page_index
].gen
!= from_space
)
2019 || (page_table
[addr_page_index
].dont_move
!= 0))
2023 /* quick check 1: Address is quite likely to have been invalid. */
2024 if (page_free_p(addr_page_index
)
2025 || (page_table
[addr_page_index
].bytes_used
== 0)
2026 || (page_table
[addr_page_index
].gen
!= from_space
))
2028 gc_assert(!(page_table
[addr_page_index
].allocated
&OPEN_REGION_PAGE_FLAG
));
2030 /* quick check 2: Check the offset within the page.
2033 if (((uword_t
)addr
& (GENCGC_CARD_BYTES
- 1)) >
2034 page_table
[addr_page_index
].bytes_used
)
2037 /* Filter out anything which can't be a pointer to a Lisp object
2038 * (or, as a special case which also requires dont_move, a return
2039 * address referring to something in a CodeObject). This is
2040 * expensive but important, since it vastly reduces the
2041 * probability that random garbage will be bogusly interpreted as
2042 * a pointer which prevents a page from moving. */
2043 lispobj
* object_start
= search_dynamic_space(addr
);
2044 if (!object_start
) return 0;
2046 /* If the containing object is a code object, presume that the
2047 * pointer is valid, simply because it could be an unboxed return
2049 * FIXME: only if the addr points to a simple-fun instruction area
2050 * should we skip the stronger tests. Otherwise, require a properly
2051 * tagged pointer to the code component or an embedded simple-fun
2052 * (or LRA?) just as with any other kind of object. */
2053 if (widetag_of(*object_start
) == CODE_HEADER_WIDETAG
)
2054 return object_start
;
2056 /* Large object pages only contain ONE object, and it will never
2057 * be a CONS. However, arrays and bignums can be allocated larger
2058 * than necessary and then shrunk to fit, leaving what look like
2059 * (0 . 0) CONSes at the end. These appear valid to
2060 * properly_tagged_descriptor_p(), so pick them off here. */
2061 if (((lowtag_of((lispobj
)addr
) == LIST_POINTER_LOWTAG
) &&
2062 page_table
[addr_page_index
].large_object
)
2063 || !properly_tagged_descriptor_p((lispobj
)addr
, object_start
))
2066 return object_start
;
2071 in_dontmove_nativeptr_p(page_index_t page_index
, lispobj
*native_ptr
)
2073 in_use_marker_t
*markers
= pinned_dwords(page_index
);
2075 lispobj
*begin
= page_address(page_index
);
2076 int dword_in_page
= (native_ptr
- begin
) / 2;
2077 return (markers
[dword_in_page
/ N_WORD_BITS
] >> (dword_in_page
% N_WORD_BITS
)) & 1;
2083 /* Adjust large bignum and vector objects. This will adjust the
2084 * allocated region if the size has shrunk, and move unboxed objects
2085 * into unboxed pages. The pages are not promoted here, and the
2086 * promoted region is not added to the new_regions; this is really
2087 * only designed to be called from preserve_pointer(). Shouldn't fail
2088 * if this is missed, just may delay the moving of objects to unboxed
2089 * pages, and the freeing of pages. */
2091 maybe_adjust_large_object(lispobj
*where
)
2093 page_index_t first_page
;
2094 page_index_t next_page
;
2097 uword_t remaining_bytes
;
2098 uword_t bytes_freed
;
2099 uword_t old_bytes_used
;
2103 /* Check whether it's a vector or bignum object. */
2104 switch (widetag_of(where
[0])) {
2105 case SIMPLE_VECTOR_WIDETAG
:
2106 boxed
= BOXED_PAGE_FLAG
;
2108 case BIGNUM_WIDETAG
:
2109 case SIMPLE_BASE_STRING_WIDETAG
:
2110 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
2111 case SIMPLE_CHARACTER_STRING_WIDETAG
:
2113 case SIMPLE_BIT_VECTOR_WIDETAG
:
2114 case SIMPLE_ARRAY_NIL_WIDETAG
:
2115 case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG
:
2116 case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG
:
2117 case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG
:
2118 case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG
:
2119 case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG
:
2120 case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG
:
2122 case SIMPLE_ARRAY_UNSIGNED_FIXNUM_WIDETAG
:
2124 case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG
:
2125 case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG
:
2126 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
2127 case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
:
2129 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
2130 case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
:
2132 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2133 case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
:
2135 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2136 case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
:
2139 case SIMPLE_ARRAY_FIXNUM_WIDETAG
:
2141 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2142 case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
:
2144 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
2145 case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
:
2147 case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG
:
2148 case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG
:
2149 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2150 case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
:
2152 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2153 case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
:
2155 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2156 case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
:
2158 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2159 case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
:
2161 boxed
= UNBOXED_PAGE_FLAG
;
2167 /* Find its current size. */
2168 nwords
= (sizetab
[widetag_of(where
[0])])(where
);
2170 first_page
= find_page_index((void *)where
);
2171 gc_assert(first_page
>= 0);
2173 /* Note: Any page write-protection must be removed, else a later
2174 * scavenge_newspace may incorrectly not scavenge these pages.
2175 * This would not be necessary if they are added to the new areas,
2176 * but lets do it for them all (they'll probably be written
2179 gc_assert(page_starts_contiguous_block_p(first_page
));
2181 next_page
= first_page
;
2182 remaining_bytes
= nwords
*N_WORD_BYTES
;
2183 while (remaining_bytes
> GENCGC_CARD_BYTES
) {
2184 gc_assert(page_table
[next_page
].gen
== from_space
);
2185 gc_assert(page_allocated_no_region_p(next_page
));
2186 gc_assert(page_table
[next_page
].large_object
);
2187 gc_assert(page_table
[next_page
].scan_start_offset
==
2188 npage_bytes(next_page
-first_page
));
2189 gc_assert(page_table
[next_page
].bytes_used
== GENCGC_CARD_BYTES
);
2191 page_table
[next_page
].allocated
= boxed
;
2193 /* Shouldn't be write-protected at this stage. Essential that the
2195 gc_assert(!page_table
[next_page
].write_protected
);
2196 remaining_bytes
-= GENCGC_CARD_BYTES
;
2200 /* Now only one page remains, but the object may have shrunk so
2201 * there may be more unused pages which will be freed. */
2203 /* Object may have shrunk but shouldn't have grown - check. */
2204 gc_assert(page_table
[next_page
].bytes_used
>= remaining_bytes
);
2206 page_table
[next_page
].allocated
= boxed
;
2207 gc_assert(page_table
[next_page
].allocated
==
2208 page_table
[first_page
].allocated
);
2210 /* Adjust the bytes_used. */
2211 old_bytes_used
= page_table
[next_page
].bytes_used
;
2212 page_table
[next_page
].bytes_used
= remaining_bytes
;
2214 bytes_freed
= old_bytes_used
- remaining_bytes
;
2216 /* Free any remaining pages; needs care. */
2218 while ((old_bytes_used
== GENCGC_CARD_BYTES
) &&
2219 (page_table
[next_page
].gen
== from_space
) &&
2220 page_allocated_no_region_p(next_page
) &&
2221 page_table
[next_page
].large_object
&&
2222 (page_table
[next_page
].scan_start_offset
==
2223 npage_bytes(next_page
- first_page
))) {
2224 /* It checks out OK, free the page. We don't need to both zeroing
2225 * pages as this should have been done before shrinking the
2226 * object. These pages shouldn't be write protected as they
2227 * should be zero filled. */
2228 gc_assert(page_table
[next_page
].write_protected
== 0);
2230 old_bytes_used
= page_table
[next_page
].bytes_used
;
2231 page_table
[next_page
].allocated
= FREE_PAGE_FLAG
;
2232 page_table
[next_page
].bytes_used
= 0;
2233 bytes_freed
+= old_bytes_used
;
2237 if ((bytes_freed
> 0) && gencgc_verbose
) {
2239 "/maybe_adjust_large_object() freed %d\n",
2243 generations
[from_space
].bytes_allocated
-= bytes_freed
;
2244 bytes_allocated
-= bytes_freed
;
2250 * Why is this restricted to protected objects only?
2251 * Because the rest of the page has been scavenged already,
2252 * and since that leaves forwarding pointers in the unprotected
2253 * areas you cannot scavenge it again until those are gone.
2256 scavenge_pinned_range(void* page_base
, int start
, int count
)
2258 // 'start' and 'count' are expressed in units of dwords
2259 scavenge((lispobj
*)page_base
+ 2*start
, 2*count
);
2263 scavenge_pinned_ranges()
2266 for (page
= 0; page
< last_free_page
; page
++) {
2267 in_use_marker_t
* bitmap
= pinned_dwords(page
);
2270 GENCGC_CARD_BYTES
/ (2*N_WORD_BYTES
) / N_WORD_BITS
,
2271 0, scavenge_pinned_range
, page_address(page
));
2275 static void wipe_range(void* page_base
, int start
, int count
)
2277 bzero((lispobj
*)page_base
+ 2*start
, count
*2*N_WORD_BYTES
);
2281 wipe_nonpinned_words()
2284 in_use_marker_t
* bitmap
;
2286 for (i
= 0; i
< last_free_page
; i
++) {
2287 if (page_table
[i
].dont_move
&& (bitmap
= pinned_dwords(i
)) != 0) {
2289 GENCGC_CARD_BYTES
/ (2*N_WORD_BYTES
) / N_WORD_BITS
,
2290 BIT_SCAN_INVERT
| BIT_SCAN_CLEAR
,
2291 wipe_range
, page_address(i
));
2292 page_table
[i
].has_pin_map
= 0;
2293 // move the page to newspace
2294 generations
[new_space
].bytes_allocated
+= page_table
[i
].bytes_used
;
2295 generations
[page_table
[i
].gen
].bytes_allocated
-= page_table
[i
].bytes_used
;
2296 page_table
[i
].gen
= new_space
;
2299 #ifndef LISP_FEATURE_WIN32
2300 madvise(page_table_pinned_dwords
, pins_map_size_in_bytes
, MADV_DONTNEED
);
2304 static void __attribute__((unused
))
2305 pin_words(page_index_t pageindex
, lispobj
*mark_which_pointer
)
2307 struct page
*page
= &page_table
[pageindex
];
2308 gc_assert(mark_which_pointer
);
2309 if (!page
->has_pin_map
) {
2310 page
->has_pin_map
= 1;
2314 in_use_marker_t
* map
= pinned_dwords(pageindex
);
2315 for (i
=0; i
<n_dwords_in_card
/N_WORD_BITS
; ++i
)
2316 gc_assert(map
[i
] == 0);
2320 lispobj
*page_base
= page_address(pageindex
);
2321 unsigned int begin_dword_index
= (mark_which_pointer
- page_base
) / 2;
2322 in_use_marker_t
*bitmap
= pinned_dwords(pageindex
);
2323 if (bitmap
[begin_dword_index
/N_WORD_BITS
]
2324 & ((uword_t
)1 << (begin_dword_index
% N_WORD_BITS
)))
2325 return; // already seen this object
2327 lispobj header
= *mark_which_pointer
;
2329 // Don't bother calling a sizing function for fixnums or pointers.
2330 // The object pointed to must be a cons.
2331 if (!fixnump(header
) && !is_lisp_pointer(header
)) {
2332 size
= (sizetab
[widetag_of(header
)])(mark_which_pointer
);
2333 if (size
== 1 && (lowtag_of(header
) == 9 || lowtag_of(header
) == 2))
2336 gc_assert(size
% 2 == 0);
2337 unsigned int end_dword_index
= begin_dword_index
+ size
/ 2;
2339 for (index
= begin_dword_index
; index
< end_dword_index
; index
++)
2340 bitmap
[index
/N_WORD_BITS
] |= (uword_t
)1 << (index
% N_WORD_BITS
);
2343 /* Take a possible pointer to a Lisp object and mark its page in the
2344 * page_table so that it will not be relocated during a GC.
2346 * This involves locating the page it points to, then backing up to
2347 * the start of its region, then marking all pages dont_move from there
2348 * up to the first page that's not full or has a different generation
2350 * It is assumed that all the page static flags have been cleared at
2351 * the start of a GC.
2353 * It is also assumed that the current gc_alloc() region has been
2354 * flushed and the tables updated. */
2356 // TODO: there's probably a way to be a little more efficient here.
2357 // As things are, we start by finding the object that encloses 'addr',
2358 // then we see if 'addr' was a "valid" Lisp pointer to that object
2359 // - meaning we expect the correct lowtag on the pointer - except
2360 // that for code objects we don't require a correct lowtag
2361 // and we allow a pointer to anywhere in the object.
2363 // It should be possible to avoid calling search_dynamic_space
2364 // more of the time. First, check if the page pointed to might hold code.
2365 // If it does, then we continue regardless of the pointer's lowtag
2366 // (because of the special allowance). If the page definitely does *not*
2367 // hold code, then we require up front that the lowtake make sense,
2368 // by doing the same checks that are in properly_tagged_descriptor_p.
2370 // Problem: when code is allocated from a per-thread region,
2371 // does it ensure that the occupied pages are flagged as having code?
2374 preserve_pointer(void *addr
)
2376 #ifdef LISP_FEATURE_IMMOBILE_SPACE
2377 /* Immobile space MUST be lower than dynamic space,
2378 or else this test needs to be revised */
2379 if (addr
< (void*)IMMOBILE_SPACE_END
) {
2380 extern void immobile_space_preserve_pointer(void*);
2381 immobile_space_preserve_pointer(addr
);
2385 page_index_t addr_page_index
= find_page_index(addr
);
2386 lispobj
*object_start
;
2388 if (addr_page_index
== -1
2389 || (object_start
= conservative_root_p(addr
, addr_page_index
)) == 0)
2392 /* (Now that we know that addr_page_index is in range, it's
2393 * safe to index into page_table[] with it.) */
2394 unsigned int region_allocation
= page_table
[addr_page_index
].allocated
;
2396 /* Find the beginning of the region. Note that there may be
2397 * objects in the region preceding the one that we were passed a
2398 * pointer to: if this is the case, we will write-protect all the
2399 * previous objects' pages too. */
2402 /* I think this'd work just as well, but without the assertions.
2403 * -dan 2004.01.01 */
2404 page_index_t first_page
= find_page_index(page_scan_start(addr_page_index
))
2406 page_index_t first_page
= addr_page_index
;
2407 while (!page_starts_contiguous_block_p(first_page
)) {
2409 /* Do some checks. */
2410 gc_assert(page_table
[first_page
].bytes_used
== GENCGC_CARD_BYTES
);
2411 gc_assert(page_table
[first_page
].gen
== from_space
);
2412 gc_assert(page_table
[first_page
].allocated
== region_allocation
);
2416 /* Adjust any large objects before promotion as they won't be
2417 * copied after promotion. */
2418 if (page_table
[first_page
].large_object
) {
2419 maybe_adjust_large_object(page_address(first_page
));
2420 /* It may have moved to unboxed pages. */
2421 region_allocation
= page_table
[first_page
].allocated
;
2424 /* Now work forward until the end of this contiguous area is found,
2425 * marking all pages as dont_move. */
2427 for (i
= first_page
; ;i
++) {
2428 gc_assert(page_table
[i
].allocated
== region_allocation
);
2430 /* Mark the page static. */
2431 page_table
[i
].dont_move
= 1;
2433 /* It is essential that the pages are not write protected as
2434 * they may have pointers into the old-space which need
2435 * scavenging. They shouldn't be write protected at this
2437 gc_assert(!page_table
[i
].write_protected
);
2439 /* Check whether this is the last page in this contiguous block.. */
2440 if (page_ends_contiguous_block_p(i
, from_space
))
2444 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
2445 /* Do not do this for multi-page objects. Those pages do not need
2446 * object wipeout anyway.
2448 if (do_wipe_p
&& i
== first_page
) // single-page object
2449 pin_words(first_page
, object_start
);
2452 /* Check that the page is now static. */
2453 gc_assert(page_table
[addr_page_index
].dont_move
!= 0);
2456 /* If the given page is not write-protected, then scan it for pointers
2457 * to younger generations or the top temp. generation, if no
2458 * suspicious pointers are found then the page is write-protected.
2460 * Care is taken to check for pointers to the current gc_alloc()
2461 * region if it is a younger generation or the temp. generation. This
2462 * frees the caller from doing a gc_alloc_update_page_tables(). Actually
2463 * the gc_alloc_generation does not need to be checked as this is only
2464 * called from scavenge_generation() when the gc_alloc generation is
2465 * younger, so it just checks if there is a pointer to the current
2468 * We return 1 if the page was write-protected, else 0. */
2470 update_page_write_prot(page_index_t page
)
2472 generation_index_t gen
= page_table
[page
].gen
;
2475 void **page_addr
= (void **)page_address(page
);
2476 sword_t num_words
= page_table
[page
].bytes_used
/ N_WORD_BYTES
;
2478 /* Shouldn't be a free page. */
2479 gc_assert(page_allocated_p(page
));
2480 gc_assert(page_table
[page
].bytes_used
!= 0);
2482 /* Skip if it's already write-protected, pinned, or unboxed */
2483 if (page_table
[page
].write_protected
2484 /* FIXME: What's the reason for not write-protecting pinned pages? */
2485 || page_table
[page
].dont_move
2486 || page_unboxed_p(page
))
2489 /* Scan the page for pointers to younger generations or the
2490 * top temp. generation. */
2492 /* This is conservative: any word satisfying is_lisp_pointer() is
2493 * assumed to be a pointer. To do otherwise would require a family
2494 * of scavenge-like functions. */
2495 for (j
= 0; j
< num_words
; j
++) {
2496 void *ptr
= *(page_addr
+j
);
2498 lispobj
__attribute__((unused
)) header
;
2500 if (!is_lisp_pointer((lispobj
)ptr
))
2502 /* Check that it's in the dynamic space */
2503 if ((index
= find_page_index(ptr
)) != -1) {
2504 if (/* Does it point to a younger or the temp. generation? */
2505 (page_allocated_p(index
)
2506 && (page_table
[index
].bytes_used
!= 0)
2507 && ((page_table
[index
].gen
< gen
)
2508 || (page_table
[index
].gen
== SCRATCH_GENERATION
)))
2510 /* Or does it point within a current gc_alloc() region? */
2511 || ((boxed_region
.start_addr
<= ptr
)
2512 && (ptr
<= boxed_region
.free_pointer
))
2513 || ((unboxed_region
.start_addr
<= ptr
)
2514 && (ptr
<= unboxed_region
.free_pointer
))) {
2519 #ifdef LISP_FEATURE_IMMOBILE_SPACE
2520 else if ((index
= find_immobile_page_index(ptr
)) >= 0 &&
2521 other_immediate_lowtag_p(header
= *native_pointer((lispobj
)ptr
))) {
2522 // This is *possibly* a pointer to an object in immobile space,
2523 // given that above two conditions were satisfied.
2524 // But unlike in the dynamic space case, we need to read a byte
2525 // from the object to determine its generation, which requires care.
2526 // Consider an unboxed word that looks like a pointer to a word that
2527 // looks like fun-header-widetag. We can't naively back up to the
2528 // underlying code object since the alleged header might not be one.
2529 int obj_gen
= gen
; // Make comparison fail if we fall through
2530 if (lowtag_of((lispobj
)ptr
) != FUN_POINTER_LOWTAG
) {
2531 obj_gen
= __immobile_obj_generation(native_pointer((lispobj
)ptr
));
2532 } else if (widetag_of(header
) == SIMPLE_FUN_HEADER_WIDETAG
) {
2534 code_obj_from_simple_fun((struct simple_fun
*)
2535 ((lispobj
)ptr
- FUN_POINTER_LOWTAG
));
2536 // This is a heuristic, since we're not actually looking for
2537 // an object boundary. Precise scanning of 'page' would obviate
2538 // the guard conditions here.
2539 if ((lispobj
)code
>= IMMOBILE_VARYOBJ_SUBSPACE_START
2540 && widetag_of(code
->header
) == CODE_HEADER_WIDETAG
)
2541 obj_gen
= __immobile_obj_generation((lispobj
*)code
);
2543 // A bogus generation number implies a not-really-pointer,
2544 // but it won't cause misbehavior.
2545 if (obj_gen
< gen
|| obj_gen
== SCRATCH_GENERATION
) {
2554 /* Write-protect the page. */
2555 /*FSHOW((stderr, "/write-protecting page %d gen %d\n", page, gen));*/
2557 os_protect((void *)page_addr
,
2559 OS_VM_PROT_READ
|OS_VM_PROT_EXECUTE
);
2561 /* Note the page as protected in the page tables. */
2562 page_table
[page
].write_protected
= 1;
2568 /* Scavenge all generations from FROM to TO, inclusive, except for
2569 * new_space which needs special handling, as new objects may be
2570 * added which are not checked here - use scavenge_newspace generation.
2572 * Write-protected pages should not have any pointers to the
2573 * from_space so do need scavenging; thus write-protected pages are
2574 * not always scavenged. There is some code to check that these pages
2575 * are not written; but to check fully the write-protected pages need
2576 * to be scavenged by disabling the code to skip them.
2578 * Under the current scheme when a generation is GCed the younger
2579 * generations will be empty. So, when a generation is being GCed it
2580 * is only necessary to scavenge the older generations for pointers
2581 * not the younger. So a page that does not have pointers to younger
2582 * generations does not need to be scavenged.
2584 * The write-protection can be used to note pages that don't have
2585 * pointers to younger pages. But pages can be written without having
2586 * pointers to younger generations. After the pages are scavenged here
2587 * they can be scanned for pointers to younger generations and if
2588 * there are none the page can be write-protected.
2590 * One complication is when the newspace is the top temp. generation.
2592 * Enabling SC_GEN_CK scavenges the write-protected pages and checks
2593 * that none were written, which they shouldn't be as they should have
2594 * no pointers to younger generations. This breaks down for weak
2595 * pointers as the objects contain a link to the next and are written
2596 * if a weak pointer is scavenged. Still it's a useful check. */
2598 scavenge_generations(generation_index_t from
, generation_index_t to
)
2601 page_index_t num_wp
= 0;
2605 /* Clear the write_protected_cleared flags on all pages. */
2606 for (i
= 0; i
< page_table_pages
; i
++)
2607 page_table
[i
].write_protected_cleared
= 0;
2610 for (i
= 0; i
< last_free_page
; i
++) {
2611 generation_index_t generation
= page_table
[i
].gen
;
2613 && (page_table
[i
].bytes_used
!= 0)
2614 && (generation
!= new_space
)
2615 && (generation
>= from
)
2616 && (generation
<= to
)) {
2617 page_index_t last_page
,j
;
2618 int write_protected
=1;
2620 /* This should be the start of a region */
2621 gc_assert(page_starts_contiguous_block_p(i
));
2623 /* Now work forward until the end of the region */
2624 for (last_page
= i
; ; last_page
++) {
2626 write_protected
&& page_table
[last_page
].write_protected
;
2627 if (page_ends_contiguous_block_p(last_page
, generation
))
2630 if (!write_protected
) {
2631 scavenge(page_address(i
),
2632 ((uword_t
)(page_table
[last_page
].bytes_used
2633 + npage_bytes(last_page
-i
)))
2636 /* Now scan the pages and write protect those that
2637 * don't have pointers to younger generations. */
2638 if (enable_page_protection
) {
2639 for (j
= i
; j
<= last_page
; j
++) {
2640 num_wp
+= update_page_write_prot(j
);
2643 if ((gencgc_verbose
> 1) && (num_wp
!= 0)) {
2645 "/write protected %d pages within generation %d\n",
2646 num_wp
, generation
));
2654 /* Check that none of the write_protected pages in this generation
2655 * have been written to. */
2656 for (i
= 0; i
< page_table_pages
; i
++) {
2657 if (page_allocated_p(i
)
2658 && (page_table
[i
].bytes_used
!= 0)
2659 && (page_table
[i
].gen
== generation
)
2660 && (page_table
[i
].write_protected_cleared
!= 0)) {
2661 FSHOW((stderr
, "/scavenge_generation() %d\n", generation
));
2663 "/page bytes_used=%d scan_start_offset=%lu dont_move=%d\n",
2664 page_table
[i
].bytes_used
,
2665 page_table
[i
].scan_start_offset
,
2666 page_table
[i
].dont_move
));
2667 lose("write to protected page %d in scavenge_generation()\n", i
);
2674 /* Scavenge a newspace generation. As it is scavenged new objects may
2675 * be allocated to it; these will also need to be scavenged. This
2676 * repeats until there are no more objects unscavenged in the
2677 * newspace generation.
2679 * To help improve the efficiency, areas written are recorded by
2680 * gc_alloc() and only these scavenged. Sometimes a little more will be
2681 * scavenged, but this causes no harm. An easy check is done that the
2682 * scavenged bytes equals the number allocated in the previous
2685 * Write-protected pages are not scanned except if they are marked
2686 * dont_move in which case they may have been promoted and still have
2687 * pointers to the from space.
2689 * Write-protected pages could potentially be written by alloc however
2690 * to avoid having to handle re-scavenging of write-protected pages
2691 * gc_alloc() does not write to write-protected pages.
2693 * New areas of objects allocated are recorded alternatively in the two
2694 * new_areas arrays below. */
2695 static struct new_area new_areas_1
[NUM_NEW_AREAS
];
2696 static struct new_area new_areas_2
[NUM_NEW_AREAS
];
2698 #ifdef LISP_FEATURE_IMMOBILE_SPACE
2699 extern unsigned int immobile_scav_queue_count
;
2702 update_immobile_nursery_bits(),
2703 scavenge_immobile_roots(generation_index_t
,generation_index_t
),
2704 scavenge_immobile_newspace(),
2705 sweep_immobile_space(int raise
),
2706 write_protect_immobile_space();
2708 #define immobile_scav_queue_count 0
2711 /* Do one full scan of the new space generation. This is not enough to
2712 * complete the job as new objects may be added to the generation in
2713 * the process which are not scavenged. */
2715 scavenge_newspace_generation_one_scan(generation_index_t generation
)
2720 "/starting one full scan of newspace generation %d\n",
2722 for (i
= 0; i
< last_free_page
; i
++) {
2723 /* Note that this skips over open regions when it encounters them. */
2725 && (page_table
[i
].bytes_used
!= 0)
2726 && (page_table
[i
].gen
== generation
)
2727 && ((page_table
[i
].write_protected
== 0)
2728 /* (This may be redundant as write_protected is now
2729 * cleared before promotion.) */
2730 || (page_table
[i
].dont_move
== 1))) {
2731 page_index_t last_page
;
2734 /* The scavenge will start at the scan_start_offset of
2737 * We need to find the full extent of this contiguous
2738 * block in case objects span pages.
2740 * Now work forward until the end of this contiguous area
2741 * is found. A small area is preferred as there is a
2742 * better chance of its pages being write-protected. */
2743 for (last_page
= i
; ;last_page
++) {
2744 /* If all pages are write-protected and movable,
2745 * then no need to scavenge */
2746 all_wp
=all_wp
&& page_table
[last_page
].write_protected
&&
2747 !page_table
[last_page
].dont_move
;
2749 /* Check whether this is the last page in this
2750 * contiguous block */
2751 if (page_ends_contiguous_block_p(last_page
, generation
))
2755 /* Do a limited check for write-protected pages. */
2757 sword_t nwords
= (((uword_t
)
2758 (page_table
[last_page
].bytes_used
2759 + npage_bytes(last_page
-i
)
2760 + page_table
[i
].scan_start_offset
))
2762 new_areas_ignore_page
= last_page
;
2764 scavenge(page_scan_start(i
), nwords
);
2771 "/done with one full scan of newspace generation %d\n",
2775 /* Do a complete scavenge of the newspace generation. */
2777 scavenge_newspace_generation(generation_index_t generation
)
2781 /* the new_areas array currently being written to by gc_alloc() */
2782 struct new_area (*current_new_areas
)[] = &new_areas_1
;
2783 size_t current_new_areas_index
;
2785 /* the new_areas created by the previous scavenge cycle */
2786 struct new_area (*previous_new_areas
)[] = NULL
;
2787 size_t previous_new_areas_index
;
2789 /* Flush the current regions updating the tables. */
2790 gc_alloc_update_all_page_tables(0);
2792 /* Turn on the recording of new areas by gc_alloc(). */
2793 new_areas
= current_new_areas
;
2794 new_areas_index
= 0;
2796 /* Don't need to record new areas that get scavenged anyway during
2797 * scavenge_newspace_generation_one_scan. */
2798 record_new_objects
= 1;
2800 /* Start with a full scavenge. */
2801 scavenge_newspace_generation_one_scan(generation
);
2803 /* Record all new areas now. */
2804 record_new_objects
= 2;
2806 /* Give a chance to weak hash tables to make other objects live.
2807 * FIXME: The algorithm implemented here for weak hash table gcing
2808 * is O(W^2+N) as Bruno Haible warns in
2809 * http://www.haible.de/bruno/papers/cs/weak/WeakDatastructures-writeup.html
2810 * see "Implementation 2". */
2811 scav_weak_hash_tables();
2813 /* Flush the current regions updating the tables. */
2814 gc_alloc_update_all_page_tables(0);
2816 /* Grab new_areas_index. */
2817 current_new_areas_index
= new_areas_index
;
2820 "The first scan is finished; current_new_areas_index=%d.\n",
2821 current_new_areas_index));*/
2823 while (current_new_areas_index
> 0 || immobile_scav_queue_count
) {
2824 /* Move the current to the previous new areas */
2825 previous_new_areas
= current_new_areas
;
2826 previous_new_areas_index
= current_new_areas_index
;
2828 /* Scavenge all the areas in previous new areas. Any new areas
2829 * allocated are saved in current_new_areas. */
2831 /* Allocate an array for current_new_areas; alternating between
2832 * new_areas_1 and 2 */
2833 if (previous_new_areas
== &new_areas_1
)
2834 current_new_areas
= &new_areas_2
;
2836 current_new_areas
= &new_areas_1
;
2838 /* Set up for gc_alloc(). */
2839 new_areas
= current_new_areas
;
2840 new_areas_index
= 0;
2842 #ifdef LISP_FEATURE_IMMOBILE_SPACE
2843 scavenge_immobile_newspace();
2845 /* Check whether previous_new_areas had overflowed. */
2846 if (previous_new_areas_index
>= NUM_NEW_AREAS
) {
2848 /* New areas of objects allocated have been lost so need to do a
2849 * full scan to be sure! If this becomes a problem try
2850 * increasing NUM_NEW_AREAS. */
2851 if (gencgc_verbose
) {
2852 SHOW("new_areas overflow, doing full scavenge");
2855 /* Don't need to record new areas that get scavenged
2856 * anyway during scavenge_newspace_generation_one_scan. */
2857 record_new_objects
= 1;
2859 scavenge_newspace_generation_one_scan(generation
);
2861 /* Record all new areas now. */
2862 record_new_objects
= 2;
2864 scav_weak_hash_tables();
2866 /* Flush the current regions updating the tables. */
2867 gc_alloc_update_all_page_tables(0);
2871 /* Work through previous_new_areas. */
2872 for (i
= 0; i
< previous_new_areas_index
; i
++) {
2873 page_index_t page
= (*previous_new_areas
)[i
].page
;
2874 size_t offset
= (*previous_new_areas
)[i
].offset
;
2875 size_t size
= (*previous_new_areas
)[i
].size
/ N_WORD_BYTES
;
2876 gc_assert((*previous_new_areas
)[i
].size
% N_WORD_BYTES
== 0);
2877 scavenge(page_address(page
)+offset
, size
);
2880 scav_weak_hash_tables();
2882 /* Flush the current regions updating the tables. */
2883 gc_alloc_update_all_page_tables(0);
2886 current_new_areas_index
= new_areas_index
;
2889 "The re-scan has finished; current_new_areas_index=%d.\n",
2890 current_new_areas_index));*/
2893 /* Turn off recording of areas allocated by gc_alloc(). */
2894 record_new_objects
= 0;
2899 /* Check that none of the write_protected pages in this generation
2900 * have been written to. */
2901 for (i
= 0; i
< page_table_pages
; i
++) {
2902 if (page_allocated_p(i
)
2903 && (page_table
[i
].bytes_used
!= 0)
2904 && (page_table
[i
].gen
== generation
)
2905 && (page_table
[i
].write_protected_cleared
!= 0)
2906 && (page_table
[i
].dont_move
== 0)) {
2907 lose("write protected page %d written to in scavenge_newspace_generation\ngeneration=%d dont_move=%d\n",
2908 i
, generation
, page_table
[i
].dont_move
);
2915 /* Un-write-protect all the pages in from_space. This is done at the
2916 * start of a GC else there may be many page faults while scavenging
2917 * the newspace (I've seen drive the system time to 99%). These pages
2918 * would need to be unprotected anyway before unmapping in
2919 * free_oldspace; not sure what effect this has on paging.. */
2921 unprotect_oldspace(void)
2924 void *region_addr
= 0;
2925 void *page_addr
= 0;
2926 uword_t region_bytes
= 0;
2928 for (i
= 0; i
< last_free_page
; i
++) {
2929 if (page_allocated_p(i
)
2930 && (page_table
[i
].bytes_used
!= 0)
2931 && (page_table
[i
].gen
== from_space
)) {
2933 /* Remove any write-protection. We should be able to rely
2934 * on the write-protect flag to avoid redundant calls. */
2935 if (page_table
[i
].write_protected
) {
2936 page_table
[i
].write_protected
= 0;
2937 page_addr
= page_address(i
);
2940 region_addr
= page_addr
;
2941 region_bytes
= GENCGC_CARD_BYTES
;
2942 } else if (region_addr
+ region_bytes
== page_addr
) {
2943 /* Region continue. */
2944 region_bytes
+= GENCGC_CARD_BYTES
;
2946 /* Unprotect previous region. */
2947 os_protect(region_addr
, region_bytes
, OS_VM_PROT_ALL
);
2948 /* First page in new region. */
2949 region_addr
= page_addr
;
2950 region_bytes
= GENCGC_CARD_BYTES
;
2956 /* Unprotect last region. */
2957 os_protect(region_addr
, region_bytes
, OS_VM_PROT_ALL
);
2961 /* Work through all the pages and free any in from_space. This
2962 * assumes that all objects have been copied or promoted to an older
2963 * generation. Bytes_allocated and the generation bytes_allocated
2964 * counter are updated. The number of bytes freed is returned. */
2968 uword_t bytes_freed
= 0;
2969 page_index_t first_page
, last_page
;
2974 /* Find a first page for the next region of pages. */
2975 while ((first_page
< last_free_page
)
2976 && (page_free_p(first_page
)
2977 || (page_table
[first_page
].bytes_used
== 0)
2978 || (page_table
[first_page
].gen
!= from_space
)))
2981 if (first_page
>= last_free_page
)
2984 /* Find the last page of this region. */
2985 last_page
= first_page
;
2988 /* Free the page. */
2989 bytes_freed
+= page_table
[last_page
].bytes_used
;
2990 generations
[page_table
[last_page
].gen
].bytes_allocated
-=
2991 page_table
[last_page
].bytes_used
;
2992 page_table
[last_page
].allocated
= FREE_PAGE_FLAG
;
2993 page_table
[last_page
].bytes_used
= 0;
2994 /* Should already be unprotected by unprotect_oldspace(). */
2995 gc_assert(!page_table
[last_page
].write_protected
);
2998 while ((last_page
< last_free_page
)
2999 && page_allocated_p(last_page
)
3000 && (page_table
[last_page
].bytes_used
!= 0)
3001 && (page_table
[last_page
].gen
== from_space
));
3003 #ifdef READ_PROTECT_FREE_PAGES
3004 os_protect(page_address(first_page
),
3005 npage_bytes(last_page
-first_page
),
3008 first_page
= last_page
;
3009 } while (first_page
< last_free_page
);
3011 bytes_allocated
-= bytes_freed
;
3016 /* Print some information about a pointer at the given address. */
3018 print_ptr(lispobj
*addr
)
3020 /* If addr is in the dynamic space then out the page information. */
3021 page_index_t pi1
= find_page_index((void*)addr
);
3024 fprintf(stderr
," %p: page %d alloc %d gen %d bytes_used %d offset %lu dont_move %d\n",
3027 page_table
[pi1
].allocated
,
3028 page_table
[pi1
].gen
,
3029 page_table
[pi1
].bytes_used
,
3030 page_table
[pi1
].scan_start_offset
,
3031 page_table
[pi1
].dont_move
);
3032 fprintf(stderr
," %x %x %x %x (%x) %x %x %x %x\n",
3046 is_in_stack_space(lispobj ptr
)
3048 /* For space verification: Pointers can be valid if they point
3049 * to a thread stack space. This would be faster if the thread
3050 * structures had page-table entries as if they were part of
3051 * the heap space. */
3053 for_each_thread(th
) {
3054 if ((th
->control_stack_start
<= (lispobj
*)ptr
) &&
3055 (th
->control_stack_end
>= (lispobj
*)ptr
)) {
3062 // NOTE: This function can produces false failure indications,
3063 // usually related to dynamic space pointing to the stack of a
3064 // dead thread, but there may be other reasons as well.
3066 verify_space(lispobj
*start
, size_t words
)
3068 extern int valid_lisp_pointer_p(lispobj
);
3069 int is_in_dynamic_space
= (find_page_index((void*)start
) != -1);
3070 int is_in_readonly_space
=
3071 (READ_ONLY_SPACE_START
<= (uword_t
)start
&&
3072 (uword_t
)start
< SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0));
3073 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3074 int is_in_immobile_space
=
3075 (IMMOBILE_SPACE_START
<= (uword_t
)start
&&
3076 (uword_t
)start
< SymbolValue(IMMOBILE_SPACE_FREE_POINTER
,0));
3081 lispobj thing
= *start
;
3083 if (is_lisp_pointer(thing
)) {
3084 page_index_t page_index
= find_page_index((void*)thing
);
3085 sword_t to_readonly_space
=
3086 (READ_ONLY_SPACE_START
<= thing
&&
3087 thing
< SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0));
3088 sword_t to_static_space
=
3089 (STATIC_SPACE_START
<= thing
&&
3090 thing
< SymbolValue(STATIC_SPACE_FREE_POINTER
,0));
3091 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3092 sword_t to_immobile_space
=
3093 (IMMOBILE_SPACE_START
<= thing
&&
3094 thing
< SymbolValue(IMMOBILE_FIXEDOBJ_FREE_POINTER
,0)) ||
3095 (IMMOBILE_VARYOBJ_SUBSPACE_START
<= thing
&&
3096 thing
< SymbolValue(IMMOBILE_SPACE_FREE_POINTER
,0));
3099 /* Does it point to the dynamic space? */
3100 if (page_index
!= -1) {
3101 /* If it's within the dynamic space it should point to a used page. */
3102 if (!page_allocated_p(page_index
))
3103 lose ("Ptr %p @ %p sees free page.\n", thing
, start
);
3104 if ((char*)thing
- (char*)page_address(page_index
)
3105 >= page_table
[page_index
].bytes_used
)
3106 lose ("Ptr %p @ %p sees unallocated space.\n", thing
, start
);
3107 /* Check that it doesn't point to a forwarding pointer! */
3108 if (*((lispobj
*)native_pointer(thing
)) == 0x01) {
3109 lose("Ptr %p @ %p sees forwarding ptr.\n", thing
, start
);
3111 /* Check that its not in the RO space as it would then be a
3112 * pointer from the RO to the dynamic space. */
3113 if (is_in_readonly_space
) {
3114 lose("ptr to dynamic space %p from RO space %x\n",
3117 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3118 // verify all immobile space -> dynamic space pointers
3119 if (is_in_immobile_space
&& !valid_lisp_pointer_p(thing
)) {
3120 lose("Ptr %p @ %p sees junk.\n", thing
, start
);
3123 /* Does it point to a plausible object? This check slows
3124 * it down a lot (so it's commented out).
3126 * "a lot" is serious: it ate 50 minutes cpu time on
3127 * my duron 950 before I came back from lunch and
3130 * FIXME: Add a variable to enable this
3133 if (!valid_lisp_pointer_p((lispobj *)thing) {
3134 lose("ptr %p to invalid object %p\n", thing, start);
3137 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3138 } else if (to_immobile_space
) {
3139 // the object pointed to must not have been discarded as garbage
3140 if (!other_immediate_lowtag_p(*native_pointer(thing
))
3141 || immobile_filler_p(native_pointer(thing
)))
3142 lose("Ptr %p @ %p sees trashed object.\n", (void*)thing
, start
);
3143 // verify all pointers to immobile space
3144 if (!valid_lisp_pointer_p(thing
))
3145 lose("Ptr %p @ %p sees junk.\n", thing
, start
);
3148 extern char __attribute__((unused
)) funcallable_instance_tramp
;
3149 /* Verify that it points to another valid space. */
3150 if (!to_readonly_space
&& !to_static_space
3151 && !is_in_stack_space(thing
)) {
3152 lose("Ptr %p @ %p sees junk.\n", thing
, start
);
3156 if (!(fixnump(thing
))) {
3158 switch(widetag_of(*start
)) {
3161 case SIMPLE_VECTOR_WIDETAG
:
3163 case COMPLEX_WIDETAG
:
3164 case SIMPLE_ARRAY_WIDETAG
:
3165 case COMPLEX_BASE_STRING_WIDETAG
:
3166 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
3167 case COMPLEX_CHARACTER_STRING_WIDETAG
:
3169 case COMPLEX_VECTOR_NIL_WIDETAG
:
3170 case COMPLEX_BIT_VECTOR_WIDETAG
:
3171 case COMPLEX_VECTOR_WIDETAG
:
3172 case COMPLEX_ARRAY_WIDETAG
:
3173 case CLOSURE_HEADER_WIDETAG
:
3174 case FUNCALLABLE_INSTANCE_HEADER_WIDETAG
:
3175 case VALUE_CELL_HEADER_WIDETAG
:
3176 case SYMBOL_HEADER_WIDETAG
:
3177 case CHARACTER_WIDETAG
:
3178 #if N_WORD_BITS == 64
3179 case SINGLE_FLOAT_WIDETAG
:
3181 case UNBOUND_MARKER_WIDETAG
:
3186 case INSTANCE_HEADER_WIDETAG
:
3188 lispobj layout
= instance_layout(start
);
3193 sword_t nslots
= instance_length(thing
) | 1;
3194 instance_scan_interleaved(verify_space
, start
+1, nslots
,
3195 native_pointer(layout
));
3199 case CODE_HEADER_WIDETAG
:
3201 /* Check that it's not in the dynamic space.
3202 * FIXME: Isn't is supposed to be OK for code
3203 * objects to be in the dynamic space these days? */
3204 /* It is for byte compiled code, but there's
3205 * no byte compilation in SBCL anymore. */
3206 if (is_in_dynamic_space
3207 /* Only when enabled */
3208 && verify_dynamic_code_check
) {
3210 "/code object at %p in the dynamic space\n",
3214 struct code
*code
= (struct code
*) start
;
3215 sword_t nheader_words
= code_header_words(code
->header
);
3216 /* Scavenge the boxed section of the code data block */
3217 verify_space(start
+ 1, nheader_words
- 1);
3219 /* Scavenge the boxed section of each function
3220 * object in the code data block. */
3221 for_each_simple_fun(i
, fheaderp
, code
, 1, {
3222 verify_space(SIMPLE_FUN_SCAV_START(fheaderp
),
3223 SIMPLE_FUN_SCAV_NWORDS(fheaderp
)); });
3224 count
= nheader_words
+ code_instruction_words(code
->code_size
);
3228 /* unboxed objects */
3229 case BIGNUM_WIDETAG
:
3230 #if N_WORD_BITS != 64
3231 case SINGLE_FLOAT_WIDETAG
:
3233 case DOUBLE_FLOAT_WIDETAG
:
3234 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
3235 case LONG_FLOAT_WIDETAG
:
3237 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
3238 case COMPLEX_SINGLE_FLOAT_WIDETAG
:
3240 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
3241 case COMPLEX_DOUBLE_FLOAT_WIDETAG
:
3243 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
3244 case COMPLEX_LONG_FLOAT_WIDETAG
:
3246 #ifdef SIMD_PACK_WIDETAG
3247 case SIMD_PACK_WIDETAG
:
3249 case SIMPLE_BASE_STRING_WIDETAG
:
3250 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
3251 case SIMPLE_CHARACTER_STRING_WIDETAG
:
3253 case SIMPLE_BIT_VECTOR_WIDETAG
:
3254 case SIMPLE_ARRAY_NIL_WIDETAG
:
3255 case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG
:
3256 case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG
:
3257 case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG
:
3258 case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG
:
3259 case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG
:
3260 case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG
:
3262 case SIMPLE_ARRAY_UNSIGNED_FIXNUM_WIDETAG
:
3264 case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG
:
3265 case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG
:
3266 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
3267 case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
:
3269 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
3270 case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
:
3272 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
3273 case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
:
3275 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
3276 case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
:
3279 case SIMPLE_ARRAY_FIXNUM_WIDETAG
:
3281 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
3282 case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
:
3284 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
3285 case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
:
3287 case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG
:
3288 case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG
:
3289 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
3290 case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
:
3292 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
3293 case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
:
3295 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
3296 case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
:
3298 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
3299 case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
:
3302 case WEAK_POINTER_WIDETAG
:
3303 #ifdef NO_TLS_VALUE_MARKER_WIDETAG
3304 case NO_TLS_VALUE_MARKER_WIDETAG
:
3306 count
= (sizetab
[widetag_of(*start
)])(start
);
3310 lose("Unhandled widetag %p at %p\n",
3311 widetag_of(*start
), start
);
3320 static void verify_dynamic_space();
3325 /* FIXME: It would be nice to make names consistent so that
3326 * foo_size meant size *in* *bytes* instead of size in some
3327 * arbitrary units. (Yes, this caused a bug, how did you guess?:-)
3328 * Some counts of lispobjs are called foo_count; it might be good
3329 * to grep for all foo_size and rename the appropriate ones to
3331 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3333 // Try this verification if marknsweep was compiled with extra debugging.
3334 // But weak symbols don't work on macOS.
3335 extern void __attribute__((weak
)) check_varyobj_pages();
3336 if (&check_varyobj_pages
) check_varyobj_pages();
3338 verify_space((lispobj
*)IMMOBILE_SPACE_START
,
3339 (lispobj
*)SymbolValue(IMMOBILE_FIXEDOBJ_FREE_POINTER
,0)
3340 - (lispobj
*)IMMOBILE_SPACE_START
);
3341 verify_space((lispobj
*)IMMOBILE_VARYOBJ_SUBSPACE_START
,
3342 (lispobj
*)SymbolValue(IMMOBILE_SPACE_FREE_POINTER
,0)
3343 - (lispobj
*)IMMOBILE_VARYOBJ_SUBSPACE_START
);
3345 sword_t read_only_space_size
=
3346 (lispobj
*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER
,0)
3347 - (lispobj
*)READ_ONLY_SPACE_START
;
3348 sword_t static_space_size
=
3349 (lispobj
*)SymbolValue(STATIC_SPACE_FREE_POINTER
,0)
3350 - (lispobj
*)STATIC_SPACE_START
;
3352 for_each_thread(th
) {
3353 sword_t binding_stack_size
=
3354 (lispobj
*)get_binding_stack_pointer(th
)
3355 - (lispobj
*)th
->binding_stack_start
;
3356 verify_space(th
->binding_stack_start
, binding_stack_size
);
3358 verify_space((lispobj
*)READ_ONLY_SPACE_START
, read_only_space_size
);
3359 verify_space((lispobj
*)STATIC_SPACE_START
, static_space_size
);
3360 verify_dynamic_space();
3364 walk_generation(void (*proc
)(lispobj
*,size_t),
3365 generation_index_t generation
)
3368 int genmask
= generation
>= 0 ? 1 << generation
: ~0;
3370 for (i
= 0; i
< last_free_page
; i
++) {
3371 if (page_allocated_p(i
)
3372 && (page_table
[i
].bytes_used
!= 0)
3373 && ((1 << page_table
[i
].gen
) & genmask
)) {
3374 page_index_t last_page
;
3376 /* This should be the start of a contiguous block */
3377 gc_assert(page_starts_contiguous_block_p(i
));
3379 /* Need to find the full extent of this contiguous block in case
3380 objects span pages. */
3382 /* Now work forward until the end of this contiguous area is
3384 for (last_page
= i
; ;last_page
++)
3385 /* Check whether this is the last page in this contiguous
3387 if (page_ends_contiguous_block_p(last_page
, page_table
[i
].gen
))
3390 proc(page_address(i
),
3391 ((uword_t
)(page_table
[last_page
].bytes_used
3392 + npage_bytes(last_page
-i
)))
3398 static void verify_generation(generation_index_t generation
)
3400 walk_generation(verify_space
, generation
);
3403 /* Check that all the free space is zero filled. */
3405 verify_zero_fill(void)
3409 for (page
= 0; page
< last_free_page
; page
++) {
3410 if (page_free_p(page
)) {
3411 /* The whole page should be zero filled. */
3412 sword_t
*start_addr
= (sword_t
*)page_address(page
);
3414 for (i
= 0; i
< (sword_t
)GENCGC_CARD_BYTES
/N_WORD_BYTES
; i
++) {
3415 if (start_addr
[i
] != 0) {
3416 lose("free page not zero at %x\n", start_addr
+ i
);
3420 sword_t free_bytes
= GENCGC_CARD_BYTES
- page_table
[page
].bytes_used
;
3421 if (free_bytes
> 0) {
3422 sword_t
*start_addr
= (sword_t
*)((uword_t
)page_address(page
)
3423 + page_table
[page
].bytes_used
);
3424 sword_t size
= free_bytes
/ N_WORD_BYTES
;
3426 for (i
= 0; i
< size
; i
++) {
3427 if (start_addr
[i
] != 0) {
3428 lose("free region not zero at %x\n", start_addr
+ i
);
3436 /* External entry point for verify_zero_fill */
3438 gencgc_verify_zero_fill(void)
3440 /* Flush the alloc regions updating the tables. */
3441 gc_alloc_update_all_page_tables(1);
3442 SHOW("verifying zero fill");
3447 verify_dynamic_space(void)
3449 verify_generation(-1);
3450 if (gencgc_enable_verify_zero_fill
)
3454 /* Write-protect all the dynamic boxed pages in the given generation. */
3456 write_protect_generation_pages(generation_index_t generation
)
3460 gc_assert(generation
< SCRATCH_GENERATION
);
3462 for (start
= 0; start
< last_free_page
; start
++) {
3463 if (protect_page_p(start
, generation
)) {
3467 /* Note the page as protected in the page tables. */
3468 page_table
[start
].write_protected
= 1;
3470 for (last
= start
+ 1; last
< last_free_page
; last
++) {
3471 if (!protect_page_p(last
, generation
))
3473 page_table
[last
].write_protected
= 1;
3476 page_start
= (void *)page_address(start
);
3478 os_protect(page_start
,
3479 npage_bytes(last
- start
),
3480 OS_VM_PROT_READ
| OS_VM_PROT_EXECUTE
);
3486 if (gencgc_verbose
> 1) {
3488 "/write protected %d of %d pages in generation %d\n",
3489 count_write_protect_generation_pages(generation
),
3490 count_generation_pages(generation
),
3495 #if defined(LISP_FEATURE_SB_THREAD) && (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
3497 preserve_context_registers (os_context_t
*c
)
3500 /* On Darwin the signal context isn't a contiguous block of memory,
3501 * so just preserve_pointering its contents won't be sufficient.
3503 #if defined(LISP_FEATURE_DARWIN)||defined(LISP_FEATURE_WIN32)
3504 #if defined LISP_FEATURE_X86
3505 preserve_pointer((void*)*os_context_register_addr(c
,reg_EAX
));
3506 preserve_pointer((void*)*os_context_register_addr(c
,reg_ECX
));
3507 preserve_pointer((void*)*os_context_register_addr(c
,reg_EDX
));
3508 preserve_pointer((void*)*os_context_register_addr(c
,reg_EBX
));
3509 preserve_pointer((void*)*os_context_register_addr(c
,reg_ESI
));
3510 preserve_pointer((void*)*os_context_register_addr(c
,reg_EDI
));
3511 preserve_pointer((void*)*os_context_pc_addr(c
));
3512 #elif defined LISP_FEATURE_X86_64
3513 preserve_pointer((void*)*os_context_register_addr(c
,reg_RAX
));
3514 preserve_pointer((void*)*os_context_register_addr(c
,reg_RCX
));
3515 preserve_pointer((void*)*os_context_register_addr(c
,reg_RDX
));
3516 preserve_pointer((void*)*os_context_register_addr(c
,reg_RBX
));
3517 preserve_pointer((void*)*os_context_register_addr(c
,reg_RSI
));
3518 preserve_pointer((void*)*os_context_register_addr(c
,reg_RDI
));
3519 preserve_pointer((void*)*os_context_register_addr(c
,reg_R8
));
3520 preserve_pointer((void*)*os_context_register_addr(c
,reg_R9
));
3521 preserve_pointer((void*)*os_context_register_addr(c
,reg_R10
));
3522 preserve_pointer((void*)*os_context_register_addr(c
,reg_R11
));
3523 preserve_pointer((void*)*os_context_register_addr(c
,reg_R12
));
3524 preserve_pointer((void*)*os_context_register_addr(c
,reg_R13
));
3525 preserve_pointer((void*)*os_context_register_addr(c
,reg_R14
));
3526 preserve_pointer((void*)*os_context_register_addr(c
,reg_R15
));
3527 preserve_pointer((void*)*os_context_pc_addr(c
));
3529 #error "preserve_context_registers needs to be tweaked for non-x86 Darwin"
3532 #if !defined(LISP_FEATURE_WIN32)
3533 for(ptr
= ((void **)(c
+1))-1; ptr
>=(void **)c
; ptr
--) {
3534 preserve_pointer(*ptr
);
3541 move_pinned_pages_to_newspace()
3545 /* scavenge() will evacuate all oldspace pages, but no newspace
3546 * pages. Pinned pages are precisely those pages which must not
3547 * be evacuated, so move them to newspace directly. */
3549 for (i
= 0; i
< last_free_page
; i
++) {
3550 if (page_table
[i
].dont_move
&&
3551 /* dont_move is cleared lazily, so validate the space as well. */
3552 page_table
[i
].gen
== from_space
) {
3553 if (pinned_dwords(i
) && do_wipe_p
) {
3554 // do not move to newspace after all, this will be word-wiped
3557 page_table
[i
].gen
= new_space
;
3558 /* And since we're moving the pages wholesale, also adjust
3559 * the generation allocation counters. */
3560 generations
[new_space
].bytes_allocated
+= page_table
[i
].bytes_used
;
3561 generations
[from_space
].bytes_allocated
-= page_table
[i
].bytes_used
;
3566 /* Garbage collect a generation. If raise is 0 then the remains of the
3567 * generation are not raised to the next generation. */
3569 garbage_collect_generation(generation_index_t generation
, int raise
)
3572 uword_t static_space_size
;
3575 gc_assert(generation
<= HIGHEST_NORMAL_GENERATION
);
3577 /* The oldest generation can't be raised. */
3578 gc_assert((generation
!= HIGHEST_NORMAL_GENERATION
) || (raise
== 0));
3580 /* Check if weak hash tables were processed in the previous GC. */
3581 gc_assert(weak_hash_tables
== NULL
);
3583 /* Initialize the weak pointer list. */
3584 weak_pointers
= NULL
;
3586 /* When a generation is not being raised it is transported to a
3587 * temporary generation (NUM_GENERATIONS), and lowered when
3588 * done. Set up this new generation. There should be no pages
3589 * allocated to it yet. */
3591 gc_assert(generations
[SCRATCH_GENERATION
].bytes_allocated
== 0);
3594 /* Set the global src and dest. generations */
3595 from_space
= generation
;
3597 new_space
= generation
+1;
3599 new_space
= SCRATCH_GENERATION
;
3601 /* Change to a new space for allocation, resetting the alloc_start_page */
3602 gc_alloc_generation
= new_space
;
3603 generations
[new_space
].alloc_start_page
= 0;
3604 generations
[new_space
].alloc_unboxed_start_page
= 0;
3605 generations
[new_space
].alloc_large_start_page
= 0;
3606 generations
[new_space
].alloc_large_unboxed_start_page
= 0;
3608 /* Before any pointers are preserved, the dont_move flags on the
3609 * pages need to be cleared. */
3610 for (i
= 0; i
< last_free_page
; i
++)
3611 if(page_table
[i
].gen
==from_space
) {
3612 page_table
[i
].dont_move
= 0;
3613 gc_assert(pinned_dwords(i
) == NULL
);
3616 /* Un-write-protect the old-space pages. This is essential for the
3617 * promoted pages as they may contain pointers into the old-space
3618 * which need to be scavenged. It also helps avoid unnecessary page
3619 * faults as forwarding pointers are written into them. They need to
3620 * be un-protected anyway before unmapping later. */
3621 unprotect_oldspace();
3623 /* Scavenge the stacks' conservative roots. */
3625 /* there are potentially two stacks for each thread: the main
3626 * stack, which may contain Lisp pointers, and the alternate stack.
3627 * We don't ever run Lisp code on the altstack, but it may
3628 * host a sigcontext with lisp objects in it */
3630 /* what we need to do: (1) find the stack pointer for the main
3631 * stack; scavenge it (2) find the interrupt context on the
3632 * alternate stack that might contain lisp values, and scavenge
3635 /* we assume that none of the preceding applies to the thread that
3636 * initiates GC. If you ever call GC from inside an altstack
3637 * handler, you will lose. */
3639 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
3640 /* And if we're saving a core, there's no point in being conservative. */
3641 if (conservative_stack
) {
3642 for_each_thread(th
) {
3644 void **esp
=(void **)-1;
3645 if (th
->state
== STATE_DEAD
)
3647 # if defined(LISP_FEATURE_SB_SAFEPOINT)
3648 /* Conservative collect_garbage is always invoked with a
3649 * foreign C call or an interrupt handler on top of every
3650 * existing thread, so the stored SP in each thread
3651 * structure is valid, no matter which thread we are looking
3652 * at. For threads that were running Lisp code, the pitstop
3653 * and edge functions maintain this value within the
3654 * interrupt or exception handler. */
3655 esp
= os_get_csp(th
);
3656 assert_on_stack(th
, esp
);
3658 /* In addition to pointers on the stack, also preserve the
3659 * return PC, the only value from the context that we need
3660 * in addition to the SP. The return PC gets saved by the
3661 * foreign call wrapper, and removed from the control stack
3662 * into a register. */
3663 preserve_pointer(th
->pc_around_foreign_call
);
3665 /* And on platforms with interrupts: scavenge ctx registers. */
3667 /* Disabled on Windows, because it does not have an explicit
3668 * stack of `interrupt_contexts'. The reported CSP has been
3669 * chosen so that the current context on the stack is
3670 * covered by the stack scan. See also set_csp_from_context(). */
3671 # ifndef LISP_FEATURE_WIN32
3672 if (th
!= arch_os_get_current_thread()) {
3673 long k
= fixnum_value(
3674 SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,th
));
3676 preserve_context_registers(th
->interrupt_contexts
[--k
]);
3679 # elif defined(LISP_FEATURE_SB_THREAD)
3681 if(th
==arch_os_get_current_thread()) {
3682 /* Somebody is going to burn in hell for this, but casting
3683 * it in two steps shuts gcc up about strict aliasing. */
3684 esp
= (void **)((void *)&raise
);
3687 free
=fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,th
));
3688 for(i
=free
-1;i
>=0;i
--) {
3689 os_context_t
*c
=th
->interrupt_contexts
[i
];
3690 esp1
= (void **) *os_context_register_addr(c
,reg_SP
);
3691 if (esp1
>=(void **)th
->control_stack_start
&&
3692 esp1
<(void **)th
->control_stack_end
) {
3693 if(esp1
<esp
) esp
=esp1
;
3694 preserve_context_registers(c
);
3699 esp
= (void **)((void *)&raise
);
3701 if (!esp
|| esp
== (void*) -1)
3702 lose("garbage_collect: no SP known for thread %x (OS %x)",
3704 for (ptr
= ((void **)th
->control_stack_end
)-1; ptr
>= esp
; ptr
--) {
3705 preserve_pointer(*ptr
);
3710 /* Non-x86oid systems don't have "conservative roots" as such, but
3711 * the same mechanism is used for objects pinned for use by alien
3713 for_each_thread(th
) {
3714 lispobj pin_list
= SymbolTlValue(PINNED_OBJECTS
,th
);
3715 while (pin_list
!= NIL
) {
3716 struct cons
*list_entry
=
3717 (struct cons
*)native_pointer(pin_list
);
3718 preserve_pointer((void*)list_entry
->car
);
3719 pin_list
= list_entry
->cdr
;
3725 if (gencgc_verbose
> 1) {
3726 sword_t num_dont_move_pages
= count_dont_move_pages();
3728 "/non-movable pages due to conservative pointers = %ld (%lu bytes)\n",
3729 num_dont_move_pages
,
3730 npage_bytes(num_dont_move_pages
));
3734 /* Now that all of the pinned (dont_move) pages are known, and
3735 * before we start to scavenge (and thus relocate) objects,
3736 * relocate the pinned pages to newspace, so that the scavenger
3737 * will not attempt to relocate their contents. */
3738 move_pinned_pages_to_newspace();
3740 /* Scavenge all the rest of the roots. */
3742 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
3744 * If not x86, we need to scavenge the interrupt context(s) and the
3749 for_each_thread(th
) {
3750 scavenge_interrupt_contexts(th
);
3751 scavenge_control_stack(th
);
3754 # ifdef LISP_FEATURE_SB_SAFEPOINT
3755 /* In this case, scrub all stacks right here from the GCing thread
3756 * instead of doing what the comment below says. Suboptimal, but
3759 scrub_thread_control_stack(th
);
3761 /* Scrub the unscavenged control stack space, so that we can't run
3762 * into any stale pointers in a later GC (this is done by the
3763 * stop-for-gc handler in the other threads). */
3764 scrub_control_stack();
3769 /* Scavenge the Lisp functions of the interrupt handlers, taking
3770 * care to avoid SIG_DFL and SIG_IGN. */
3771 for (i
= 0; i
< NSIG
; i
++) {
3772 union interrupt_handler handler
= interrupt_handlers
[i
];
3773 if (!ARE_SAME_HANDLER(handler
.c
, SIG_IGN
) &&
3774 !ARE_SAME_HANDLER(handler
.c
, SIG_DFL
)) {
3775 scavenge((lispobj
*)(interrupt_handlers
+ i
), 1);
3778 /* Scavenge the binding stacks. */
3781 for_each_thread(th
) {
3782 sword_t len
= (lispobj
*)get_binding_stack_pointer(th
) -
3783 th
->binding_stack_start
;
3784 scavenge((lispobj
*) th
->binding_stack_start
,len
);
3785 #ifdef LISP_FEATURE_SB_THREAD
3786 /* do the tls as well */
3787 len
=(SymbolValue(FREE_TLS_INDEX
,0) >> WORD_SHIFT
) -
3788 (sizeof (struct thread
))/(sizeof (lispobj
));
3789 scavenge((lispobj
*) (th
+1),len
);
3794 /* Scavenge static space. */
3796 (lispobj
*)SymbolValue(STATIC_SPACE_FREE_POINTER
,0) -
3797 (lispobj
*)STATIC_SPACE_START
;
3798 if (gencgc_verbose
> 1) {
3800 "/scavenge static space: %d bytes\n",
3801 static_space_size
* sizeof(lispobj
)));
3803 scavenge( (lispobj
*) STATIC_SPACE_START
, static_space_size
);
3805 /* All generations but the generation being GCed need to be
3806 * scavenged. The new_space generation needs special handling as
3807 * objects may be moved in - it is handled separately below. */
3808 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3809 scavenge_immobile_roots(generation
+1, SCRATCH_GENERATION
);
3811 scavenge_generations(generation
+1, PSEUDO_STATIC_GENERATION
);
3813 scavenge_pinned_ranges();
3815 /* Finally scavenge the new_space generation. Keep going until no
3816 * more objects are moved into the new generation */
3817 scavenge_newspace_generation(new_space
);
3819 /* FIXME: I tried reenabling this check when debugging unrelated
3820 * GC weirdness ca. sbcl-0.6.12.45, and it failed immediately.
3821 * Since the current GC code seems to work well, I'm guessing that
3822 * this debugging code is just stale, but I haven't tried to
3823 * figure it out. It should be figured out and then either made to
3824 * work or just deleted. */
3826 #define RESCAN_CHECK 0
3828 /* As a check re-scavenge the newspace once; no new objects should
3831 os_vm_size_t old_bytes_allocated
= bytes_allocated
;
3832 os_vm_size_t bytes_allocated
;
3834 /* Start with a full scavenge. */
3835 scavenge_newspace_generation_one_scan(new_space
);
3837 /* Flush the current regions, updating the tables. */
3838 gc_alloc_update_all_page_tables(1);
3840 bytes_allocated
= bytes_allocated
- old_bytes_allocated
;
3842 if (bytes_allocated
!= 0) {
3843 lose("Rescan of new_space allocated %d more bytes.\n",
3849 scan_weak_hash_tables();
3850 scan_weak_pointers();
3851 wipe_nonpinned_words();
3852 #ifdef LISP_FEATURE_IMMOBILE_SPACE
3853 // Do this last, because until wipe_nonpinned_words() happens,
3854 // not all page table entries have the 'gen' value updated,
3855 // which we need to correctly find all old->young pointers.
3856 sweep_immobile_space(raise
);
3859 /* Flush the current regions, updating the tables. */
3860 gc_alloc_update_all_page_tables(0);
3862 /* Free the pages in oldspace, but not those marked dont_move. */
3865 /* If the GC is not raising the age then lower the generation back
3866 * to its normal generation number */
3868 for (i
= 0; i
< last_free_page
; i
++)
3869 if ((page_table
[i
].bytes_used
!= 0)
3870 && (page_table
[i
].gen
== SCRATCH_GENERATION
))
3871 page_table
[i
].gen
= generation
;
3872 gc_assert(generations
[generation
].bytes_allocated
== 0);
3873 generations
[generation
].bytes_allocated
=
3874 generations
[SCRATCH_GENERATION
].bytes_allocated
;
3875 generations
[SCRATCH_GENERATION
].bytes_allocated
= 0;
3878 /* Reset the alloc_start_page for generation. */
3879 generations
[generation
].alloc_start_page
= 0;
3880 generations
[generation
].alloc_unboxed_start_page
= 0;
3881 generations
[generation
].alloc_large_start_page
= 0;
3882 generations
[generation
].alloc_large_unboxed_start_page
= 0;
3884 if (generation
>= verify_gens
) {
3885 if (gencgc_verbose
) {
3891 /* Set the new gc trigger for the GCed generation. */
3892 generations
[generation
].gc_trigger
=
3893 generations
[generation
].bytes_allocated
3894 + generations
[generation
].bytes_consed_between_gc
;
3897 generations
[generation
].num_gc
= 0;
3899 ++generations
[generation
].num_gc
;
3903 /* Update last_free_page, then SymbolValue(ALLOCATION_POINTER). */
3905 update_dynamic_space_free_pointer(void)
3907 page_index_t last_page
= -1, i
;
3909 for (i
= 0; i
< last_free_page
; i
++)
3910 if (page_allocated_p(i
) && (page_table
[i
].bytes_used
!= 0))
3913 last_free_page
= last_page
+1;
3915 set_alloc_pointer((lispobj
)(page_address(last_free_page
)));
3916 return 0; /* dummy value: return something ... */
3920 remap_page_range (page_index_t from
, page_index_t to
)
3922 /* There's a mysterious Solaris/x86 problem with using mmap
3923 * tricks for memory zeroing. See sbcl-devel thread
3924 * "Re: patch: standalone executable redux".
3926 #if defined(LISP_FEATURE_SUNOS)
3927 zero_and_mark_pages(from
, to
);
3930 release_granularity
= gencgc_release_granularity
/GENCGC_CARD_BYTES
,
3931 release_mask
= release_granularity
-1,
3933 aligned_from
= (from
+release_mask
)&~release_mask
,
3934 aligned_end
= (end
&~release_mask
);
3936 if (aligned_from
< aligned_end
) {
3937 zero_pages_with_mmap(aligned_from
, aligned_end
-1);
3938 if (aligned_from
!= from
)
3939 zero_and_mark_pages(from
, aligned_from
-1);
3940 if (aligned_end
!= end
)
3941 zero_and_mark_pages(aligned_end
, end
-1);
3943 zero_and_mark_pages(from
, to
);
3949 remap_free_pages (page_index_t from
, page_index_t to
, int forcibly
)
3951 page_index_t first_page
, last_page
;
3954 return remap_page_range(from
, to
);
3956 for (first_page
= from
; first_page
<= to
; first_page
++) {
3957 if (page_allocated_p(first_page
) ||
3958 (page_table
[first_page
].need_to_zero
== 0))
3961 last_page
= first_page
+ 1;
3962 while (page_free_p(last_page
) &&
3963 (last_page
<= to
) &&
3964 (page_table
[last_page
].need_to_zero
== 1))
3967 remap_page_range(first_page
, last_page
-1);
3969 first_page
= last_page
;
3973 generation_index_t small_generation_limit
= 1;
3975 /* GC all generations newer than last_gen, raising the objects in each
3976 * to the next older generation - we finish when all generations below
3977 * last_gen are empty. Then if last_gen is due for a GC, or if
3978 * last_gen==NUM_GENERATIONS (the scratch generation? eh?) we GC that
3979 * too. The valid range for last_gen is: 0,1,...,NUM_GENERATIONS.
3981 * We stop collecting at gencgc_oldest_gen_to_gc, even if this is less than
3982 * last_gen (oh, and note that by default it is NUM_GENERATIONS-1) */
3984 collect_garbage(generation_index_t last_gen
)
3986 generation_index_t gen
= 0, i
;
3987 int raise
, more
= 0;
3989 /* The largest value of last_free_page seen since the time
3990 * remap_free_pages was called. */
3991 static page_index_t high_water_mark
= 0;
3993 FSHOW((stderr
, "/entering collect_garbage(%d)\n", last_gen
));
3994 log_generation_stats(gc_logfile
, "=== GC Start ===");
3998 if (last_gen
> HIGHEST_NORMAL_GENERATION
+1) {
4000 "/collect_garbage: last_gen = %d, doing a level 0 GC\n",
4005 /* Flush the alloc regions updating the tables. */
4006 gc_alloc_update_all_page_tables(1);
4008 /* Verify the new objects created by Lisp code. */
4009 if (pre_verify_gen_0
) {
4010 FSHOW((stderr
, "pre-checking generation 0\n"));
4011 verify_generation(0);
4014 if (gencgc_verbose
> 1)
4015 print_generation_stats();
4017 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4018 /* Immobile space generation bits are lazily updated for gen0
4019 (not touched on every object allocation) so do it now */
4020 update_immobile_nursery_bits();
4024 /* Collect the generation. */
4026 if (more
|| (gen
>= gencgc_oldest_gen_to_gc
)) {
4027 /* Never raise the oldest generation. Never raise the extra generation
4028 * collected due to more-flag. */
4034 || (generations
[gen
].num_gc
>= generations
[gen
].number_of_gcs_before_promotion
);
4035 /* If we would not normally raise this one, but we're
4036 * running low on space in comparison to the object-sizes
4037 * we've been seeing, raise it and collect the next one
4039 if (!raise
&& gen
== last_gen
) {
4040 more
= (2*large_allocation
) >= (dynamic_space_size
- bytes_allocated
);
4045 if (gencgc_verbose
> 1) {
4047 "starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n",
4050 generations
[gen
].bytes_allocated
,
4051 generations
[gen
].gc_trigger
,
4052 generations
[gen
].num_gc
));
4055 /* If an older generation is being filled, then update its
4058 generations
[gen
+1].cum_sum_bytes_allocated
+=
4059 generations
[gen
+1].bytes_allocated
;
4062 garbage_collect_generation(gen
, raise
);
4064 /* Reset the memory age cum_sum. */
4065 generations
[gen
].cum_sum_bytes_allocated
= 0;
4067 if (gencgc_verbose
> 1) {
4068 FSHOW((stderr
, "GC of generation %d finished:\n", gen
));
4069 print_generation_stats();
4073 } while ((gen
<= gencgc_oldest_gen_to_gc
)
4074 && ((gen
< last_gen
)
4077 && (generations
[gen
].bytes_allocated
4078 > generations
[gen
].gc_trigger
)
4079 && (generation_average_age(gen
)
4080 > generations
[gen
].minimum_age_before_gc
))));
4082 /* Now if gen-1 was raised all generations before gen are empty.
4083 * If it wasn't raised then all generations before gen-1 are empty.
4085 * Now objects within this gen's pages cannot point to younger
4086 * generations unless they are written to. This can be exploited
4087 * by write-protecting the pages of gen; then when younger
4088 * generations are GCed only the pages which have been written
4093 gen_to_wp
= gen
- 1;
4095 /* There's not much point in WPing pages in generation 0 as it is
4096 * never scavenged (except promoted pages). */
4097 if ((gen_to_wp
> 0) && enable_page_protection
) {
4098 /* Check that they are all empty. */
4099 for (i
= 0; i
< gen_to_wp
; i
++) {
4100 if (generations
[i
].bytes_allocated
)
4101 lose("trying to write-protect gen. %d when gen. %d nonempty\n",
4104 write_protect_generation_pages(gen_to_wp
);
4106 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4107 write_protect_immobile_space();
4110 /* Set gc_alloc() back to generation 0. The current regions should
4111 * be flushed after the above GCs. */
4112 gc_assert((boxed_region
.free_pointer
- boxed_region
.start_addr
) == 0);
4113 gc_alloc_generation
= 0;
4115 /* Save the high-water mark before updating last_free_page */
4116 if (last_free_page
> high_water_mark
)
4117 high_water_mark
= last_free_page
;
4119 update_dynamic_space_free_pointer();
4121 /* Update auto_gc_trigger. Make sure we trigger the next GC before
4122 * running out of heap! */
4123 if (bytes_consed_between_gcs
<= (dynamic_space_size
- bytes_allocated
))
4124 auto_gc_trigger
= bytes_allocated
+ bytes_consed_between_gcs
;
4126 auto_gc_trigger
= bytes_allocated
+ (dynamic_space_size
- bytes_allocated
)/2;
4129 fprintf(stderr
,"Next gc when %"OS_VM_SIZE_FMT
" bytes have been consed\n",
4132 /* If we did a big GC (arbitrarily defined as gen > 1), release memory
4135 if (gen
> small_generation_limit
) {
4136 if (last_free_page
> high_water_mark
)
4137 high_water_mark
= last_free_page
;
4138 remap_free_pages(0, high_water_mark
, 0);
4139 high_water_mark
= 0;
4143 large_allocation
= 0;
4145 log_generation_stats(gc_logfile
, "=== GC End ===");
4146 SHOW("returning from collect_garbage");
4154 #if defined(LISP_FEATURE_SB_SAFEPOINT)
4158 /* Compute the number of pages needed for the dynamic space.
4159 * Dynamic space size should be aligned on page size. */
4160 page_table_pages
= dynamic_space_size
/GENCGC_CARD_BYTES
;
4161 gc_assert(dynamic_space_size
== npage_bytes(page_table_pages
));
4163 /* Default nursery size to 5% of the total dynamic space size,
4165 bytes_consed_between_gcs
= dynamic_space_size
/(os_vm_size_t
)20;
4166 if (bytes_consed_between_gcs
< (1024*1024))
4167 bytes_consed_between_gcs
= 1024*1024;
4169 /* The page_table must be allocated using "calloc" to initialize
4170 * the page structures correctly. There used to be a separate
4171 * initialization loop (now commented out; see below) but that was
4172 * unnecessary and did hurt startup time. */
4173 page_table
= calloc(page_table_pages
, sizeof(struct page
));
4174 gc_assert(page_table
);
4175 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4179 size_t pins_map_size_in_bytes
=
4180 (n_dwords_in_card
/ N_WORD_BITS
) * sizeof (uword_t
) * page_table_pages
;
4181 /* We use mmap directly here so that we can use a minimum of
4182 system calls per page during GC.
4183 All we need here now is a madvise(DONTNEED) at the end of GC. */
4184 page_table_pinned_dwords
4185 = (in_use_marker_t
*)os_validate(NULL
, pins_map_size_in_bytes
);
4186 /* We do not need to zero */
4187 gc_assert(page_table_pinned_dwords
);
4190 scavtab
[WEAK_POINTER_WIDETAG
] = scav_weak_pointer
;
4191 transother
[SIMPLE_ARRAY_WIDETAG
] = trans_boxed_large
;
4193 heap_base
= (void*)DYNAMIC_SPACE_START
;
4195 /* The page structures are initialized implicitly when page_table
4196 * is allocated with "calloc" above. Formerly we had the following
4197 * explicit initialization here (comments converted to C99 style
4198 * for readability as C's block comments don't nest):
4200 * // Initialize each page structure.
4201 * for (i = 0; i < page_table_pages; i++) {
4202 * // Initialize all pages as free.
4203 * page_table[i].allocated = FREE_PAGE_FLAG;
4204 * page_table[i].bytes_used = 0;
4206 * // Pages are not write-protected at startup.
4207 * page_table[i].write_protected = 0;
4210 * Without this loop the image starts up much faster when dynamic
4211 * space is large -- which it is on 64-bit platforms already by
4212 * default -- and when "calloc" for large arrays is implemented
4213 * using copy-on-write of a page of zeroes -- which it is at least
4214 * on Linux. In this case the pages that page_table_pages is stored
4215 * in are mapped and cleared not before the corresponding part of
4216 * dynamic space is used. For example, this saves clearing 16 MB of
4217 * memory at startup if the page size is 4 KB and the size of
4218 * dynamic space is 4 GB.
4219 * FREE_PAGE_FLAG must be 0 for this to work correctly which is
4220 * asserted below: */
4222 /* Compile time assertion: If triggered, declares an array
4223 * of dimension -1 forcing a syntax error. The intent of the
4224 * assignment is to avoid an "unused variable" warning. */
4225 char assert_free_page_flag_0
[(FREE_PAGE_FLAG
) ? -1 : 1];
4226 assert_free_page_flag_0
[0] = assert_free_page_flag_0
[0];
4229 bytes_allocated
= 0;
4231 /* Initialize the generations. */
4232 for (i
= 0; i
< NUM_GENERATIONS
; i
++) {
4233 generations
[i
].alloc_start_page
= 0;
4234 generations
[i
].alloc_unboxed_start_page
= 0;
4235 generations
[i
].alloc_large_start_page
= 0;
4236 generations
[i
].alloc_large_unboxed_start_page
= 0;
4237 generations
[i
].bytes_allocated
= 0;
4238 generations
[i
].gc_trigger
= 2000000;
4239 generations
[i
].num_gc
= 0;
4240 generations
[i
].cum_sum_bytes_allocated
= 0;
4241 /* the tune-able parameters */
4242 generations
[i
].bytes_consed_between_gc
4243 = bytes_consed_between_gcs
/(os_vm_size_t
)HIGHEST_NORMAL_GENERATION
;
4244 generations
[i
].number_of_gcs_before_promotion
= 1;
4245 generations
[i
].minimum_age_before_gc
= 0.75;
4248 /* Initialize gc_alloc. */
4249 gc_alloc_generation
= 0;
4250 gc_set_region_empty(&boxed_region
);
4251 gc_set_region_empty(&unboxed_region
);
4256 /* Pick up the dynamic space from after a core load.
4258 * The ALLOCATION_POINTER points to the end of the dynamic space.
4262 gencgc_pickup_dynamic(void)
4264 page_index_t page
= 0;
4265 void *alloc_ptr
= (void *)get_alloc_pointer();
4266 lispobj
*prev
=(lispobj
*)page_address(page
);
4267 generation_index_t gen
= PSEUDO_STATIC_GENERATION
;
4269 bytes_allocated
= 0;
4272 lispobj
*first
,*ptr
= (lispobj
*)page_address(page
);
4274 if (!gencgc_partial_pickup
|| page_allocated_p(page
)) {
4275 /* It is possible, though rare, for the saved page table
4276 * to contain free pages below alloc_ptr. */
4277 page_table
[page
].gen
= gen
;
4278 page_table
[page
].bytes_used
= GENCGC_CARD_BYTES
;
4279 page_table
[page
].large_object
= 0;
4280 page_table
[page
].write_protected
= 0;
4281 page_table
[page
].write_protected_cleared
= 0;
4282 page_table
[page
].dont_move
= 0;
4283 page_table
[page
].need_to_zero
= 1;
4285 bytes_allocated
+= GENCGC_CARD_BYTES
;
4288 if (!gencgc_partial_pickup
) {
4289 page_table
[page
].allocated
= BOXED_PAGE_FLAG
;
4290 first
=gc_search_space(prev
,(ptr
+2)-prev
,ptr
);
4293 page_table
[page
].scan_start_offset
=
4294 page_address(page
) - (void *)prev
;
4297 } while (page_address(page
) < alloc_ptr
);
4299 last_free_page
= page
;
4301 generations
[gen
].bytes_allocated
= bytes_allocated
;
4303 gc_alloc_update_all_page_tables(1);
4304 write_protect_generation_pages(gen
);
4308 gc_initialize_pointers(void)
4310 gencgc_pickup_dynamic();
4314 /* alloc(..) is the external interface for memory allocation. It
4315 * allocates to generation 0. It is not called from within the garbage
4316 * collector as it is only external uses that need the check for heap
4317 * size (GC trigger) and to disable the interrupts (interrupts are
4318 * always disabled during a GC).
4320 * The vops that call alloc(..) assume that the returned space is zero-filled.
4321 * (E.g. the most significant word of a 2-word bignum in MOVE-FROM-UNSIGNED.)
4323 * The check for a GC trigger is only performed when the current
4324 * region is full, so in most cases it's not needed. */
4326 static inline lispobj
*
4327 general_alloc_internal(sword_t nbytes
, int page_type_flag
, struct alloc_region
*region
,
4328 struct thread
*thread
)
4330 #ifndef LISP_FEATURE_WIN32
4331 lispobj alloc_signal
;
4334 void *new_free_pointer
;
4335 os_vm_size_t trigger_bytes
= 0;
4337 gc_assert(nbytes
> 0);
4339 /* Check for alignment allocation problems. */
4340 gc_assert((((uword_t
)region
->free_pointer
& LOWTAG_MASK
) == 0)
4341 && ((nbytes
& LOWTAG_MASK
) == 0));
4343 #if !(defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD))
4344 /* Must be inside a PA section. */
4345 gc_assert(get_pseudo_atomic_atomic(thread
));
4348 if ((os_vm_size_t
) nbytes
> large_allocation
)
4349 large_allocation
= nbytes
;
4351 /* maybe we can do this quickly ... */
4352 new_free_pointer
= region
->free_pointer
+ nbytes
;
4353 if (new_free_pointer
<= region
->end_addr
) {
4354 new_obj
= (void*)(region
->free_pointer
);
4355 region
->free_pointer
= new_free_pointer
;
4356 return(new_obj
); /* yup */
4359 /* We don't want to count nbytes against auto_gc_trigger unless we
4360 * have to: it speeds up the tenuring of objects and slows down
4361 * allocation. However, unless we do so when allocating _very_
4362 * large objects we are in danger of exhausting the heap without
4363 * running sufficient GCs.
4365 if ((os_vm_size_t
) nbytes
>= bytes_consed_between_gcs
)
4366 trigger_bytes
= nbytes
;
4368 /* we have to go the long way around, it seems. Check whether we
4369 * should GC in the near future
4371 if (auto_gc_trigger
&& (bytes_allocated
+trigger_bytes
> auto_gc_trigger
)) {
4372 /* Don't flood the system with interrupts if the need to gc is
4373 * already noted. This can happen for example when SUB-GC
4374 * allocates or after a gc triggered in a WITHOUT-GCING. */
4375 if (SymbolValue(GC_PENDING
,thread
) == NIL
) {
4376 /* set things up so that GC happens when we finish the PA
4378 SetSymbolValue(GC_PENDING
,T
,thread
);
4379 if (SymbolValue(GC_INHIBIT
,thread
) == NIL
) {
4380 #ifdef LISP_FEATURE_SB_SAFEPOINT
4381 thread_register_gc_trigger();
4383 set_pseudo_atomic_interrupted(thread
);
4384 #ifdef GENCGC_IS_PRECISE
4385 /* PPC calls alloc() from a trap
4386 * look up the most context if it's from a trap. */
4388 os_context_t
*context
=
4389 thread
->interrupt_data
->allocation_trap_context
;
4390 maybe_save_gc_mask_and_block_deferrables
4391 (context
? os_context_sigmask_addr(context
) : NULL
);
4394 maybe_save_gc_mask_and_block_deferrables(NULL
);
4400 new_obj
= gc_alloc_with_region(nbytes
, page_type_flag
, region
, 0);
4402 #ifndef LISP_FEATURE_WIN32
4403 /* for sb-prof, and not supported on Windows yet */
4404 alloc_signal
= SymbolValue(ALLOC_SIGNAL
,thread
);
4405 if ((alloc_signal
& FIXNUM_TAG_MASK
) == 0) {
4406 if ((sword_t
) alloc_signal
<= 0) {
4407 SetSymbolValue(ALLOC_SIGNAL
, T
, thread
);
4410 SetSymbolValue(ALLOC_SIGNAL
,
4411 alloc_signal
- (1 << N_FIXNUM_TAG_BITS
),
4421 general_alloc(sword_t nbytes
, int page_type_flag
)
4423 struct thread
*thread
= arch_os_get_current_thread();
4424 /* Select correct region, and call general_alloc_internal with it.
4425 * For other then boxed allocation we must lock first, since the
4426 * region is shared. */
4427 if (BOXED_PAGE_FLAG
& page_type_flag
) {
4428 #ifdef LISP_FEATURE_SB_THREAD
4429 struct alloc_region
*region
= (thread
? &(thread
->alloc_region
) : &boxed_region
);
4431 struct alloc_region
*region
= &boxed_region
;
4433 return general_alloc_internal(nbytes
, page_type_flag
, region
, thread
);
4434 } else if (UNBOXED_PAGE_FLAG
== page_type_flag
) {
4436 gc_assert(0 == thread_mutex_lock(&allocation_lock
));
4437 obj
= general_alloc_internal(nbytes
, page_type_flag
, &unboxed_region
, thread
);
4438 gc_assert(0 == thread_mutex_unlock(&allocation_lock
));
4441 lose("bad page type flag: %d", page_type_flag
);
4445 lispobj AMD64_SYSV_ABI
*
4446 alloc(sword_t nbytes
)
4448 #ifdef LISP_FEATURE_SB_SAFEPOINT_STRICTLY
4449 struct thread
*self
= arch_os_get_current_thread();
4450 int was_pseudo_atomic
= get_pseudo_atomic_atomic(self
);
4451 if (!was_pseudo_atomic
)
4452 set_pseudo_atomic_atomic(self
);
4454 gc_assert(get_pseudo_atomic_atomic(arch_os_get_current_thread()));
4457 lispobj
*result
= general_alloc(nbytes
, BOXED_PAGE_FLAG
);
4459 #ifdef LISP_FEATURE_SB_SAFEPOINT_STRICTLY
4460 if (!was_pseudo_atomic
)
4461 clear_pseudo_atomic_atomic(self
);
4468 * shared support for the OS-dependent signal handlers which
4469 * catch GENCGC-related write-protect violations
4471 void unhandled_sigmemoryfault(void* addr
);
4473 /* Depending on which OS we're running under, different signals might
4474 * be raised for a violation of write protection in the heap. This
4475 * function factors out the common generational GC magic which needs
4476 * to invoked in this case, and should be called from whatever signal
4477 * handler is appropriate for the OS we're running under.
4479 * Return true if this signal is a normal generational GC thing that
4480 * we were able to handle, or false if it was abnormal and control
4481 * should fall through to the general SIGSEGV/SIGBUS/whatever logic.
4483 * We have two control flags for this: one causes us to ignore faults
4484 * on unprotected pages completely, and the second complains to stderr
4485 * but allows us to continue without losing.
4487 extern boolean ignore_memoryfaults_on_unprotected_pages
;
4488 boolean ignore_memoryfaults_on_unprotected_pages
= 0;
4490 extern boolean continue_after_memoryfault_on_unprotected_pages
;
4491 boolean continue_after_memoryfault_on_unprotected_pages
= 0;
4494 gencgc_handle_wp_violation(void* fault_addr
)
4496 page_index_t page_index
= find_page_index(fault_addr
);
4500 "heap WP violation? fault_addr=%p, page_index=%"PAGE_INDEX_FMT
"\n",
4501 fault_addr
, page_index
));
4504 /* Check whether the fault is within the dynamic space. */
4505 if (page_index
== (-1)) {
4506 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4507 extern int immobile_space_handle_wp_violation(void*);
4508 if (immobile_space_handle_wp_violation(fault_addr
))
4512 /* It can be helpful to be able to put a breakpoint on this
4513 * case to help diagnose low-level problems. */
4514 unhandled_sigmemoryfault(fault_addr
);
4516 /* not within the dynamic space -- not our responsibility */
4521 ret
= thread_mutex_lock(&free_pages_lock
);
4522 gc_assert(ret
== 0);
4523 if (page_table
[page_index
].write_protected
) {
4524 /* Unprotect the page. */
4525 os_protect(page_address(page_index
), GENCGC_CARD_BYTES
, OS_VM_PROT_ALL
);
4526 page_table
[page_index
].write_protected_cleared
= 1;
4527 page_table
[page_index
].write_protected
= 0;
4528 } else if (!ignore_memoryfaults_on_unprotected_pages
) {
4529 /* The only acceptable reason for this signal on a heap
4530 * access is that GENCGC write-protected the page.
4531 * However, if two CPUs hit a wp page near-simultaneously,
4532 * we had better not have the second one lose here if it
4533 * does this test after the first one has already set wp=0
4535 if(page_table
[page_index
].write_protected_cleared
!= 1) {
4536 void lisp_backtrace(int frames
);
4539 "Fault @ %p, page %"PAGE_INDEX_FMT
" not marked as write-protected:\n"
4540 " boxed_region.first_page: %"PAGE_INDEX_FMT
","
4541 " boxed_region.last_page %"PAGE_INDEX_FMT
"\n"
4542 " page.scan_start_offset: %"OS_VM_SIZE_FMT
"\n"
4543 " page.bytes_used: %"PAGE_BYTES_FMT
"\n"
4544 " page.allocated: %d\n"
4545 " page.write_protected: %d\n"
4546 " page.write_protected_cleared: %d\n"
4547 " page.generation: %d\n",
4550 boxed_region
.first_page
,
4551 boxed_region
.last_page
,
4552 page_table
[page_index
].scan_start_offset
,
4553 page_table
[page_index
].bytes_used
,
4554 page_table
[page_index
].allocated
,
4555 page_table
[page_index
].write_protected
,
4556 page_table
[page_index
].write_protected_cleared
,
4557 page_table
[page_index
].gen
);
4558 if (!continue_after_memoryfault_on_unprotected_pages
)
4562 ret
= thread_mutex_unlock(&free_pages_lock
);
4563 gc_assert(ret
== 0);
4564 /* Don't worry, we can handle it. */
4568 /* This is to be called when we catch a SIGSEGV/SIGBUS, determine that
4569 * it's not just a case of the program hitting the write barrier, and
4570 * are about to let Lisp deal with it. It's basically just a
4571 * convenient place to set a gdb breakpoint. */
4573 unhandled_sigmemoryfault(void *addr
)
4577 update_thread_page_tables(struct thread
*th
)
4579 gc_alloc_update_page_tables(BOXED_PAGE_FLAG
, &th
->alloc_region
);
4580 #if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
4581 gc_alloc_update_page_tables(BOXED_PAGE_FLAG
, &th
->sprof_alloc_region
);
4585 /* GC is single-threaded and all memory allocations during a
4586 collection happen in the GC thread, so it is sufficient to update
4587 all the the page tables once at the beginning of a collection and
4588 update only page tables of the GC thread during the collection. */
4589 void gc_alloc_update_all_page_tables(int for_all_threads
)
4591 /* Flush the alloc regions updating the tables. */
4593 if (for_all_threads
) {
4594 for_each_thread(th
) {
4595 update_thread_page_tables(th
);
4599 th
= arch_os_get_current_thread();
4601 update_thread_page_tables(th
);
4604 gc_alloc_update_page_tables(UNBOXED_PAGE_FLAG
, &unboxed_region
);
4605 gc_alloc_update_page_tables(BOXED_PAGE_FLAG
, &boxed_region
);
4609 gc_set_region_empty(struct alloc_region
*region
)
4611 region
->first_page
= 0;
4612 region
->last_page
= -1;
4613 region
->start_addr
= page_address(0);
4614 region
->free_pointer
= page_address(0);
4615 region
->end_addr
= page_address(0);
4619 zero_all_free_pages()
4623 for (i
= 0; i
< last_free_page
; i
++) {
4624 if (page_free_p(i
)) {
4625 #ifdef READ_PROTECT_FREE_PAGES
4626 os_protect(page_address(i
),
4635 /* Things to do before doing a final GC before saving a core (without
4638 * + Pages in large_object pages aren't moved by the GC, so we need to
4639 * unset that flag from all pages.
4640 * + The pseudo-static generation isn't normally collected, but it seems
4641 * reasonable to collect it at least when saving a core. So move the
4642 * pages to a normal generation.
4645 prepare_for_final_gc ()
4649 #ifdef LISP_FEATURE_IMMOBILE_SPACE
4650 extern void prepare_immobile_space_for_final_gc();
4651 prepare_immobile_space_for_final_gc ();
4654 for (i
= 0; i
< last_free_page
; i
++) {
4655 page_table
[i
].large_object
= 0;
4656 if (page_table
[i
].gen
== PSEUDO_STATIC_GENERATION
) {
4657 int used
= page_table
[i
].bytes_used
;
4658 page_table
[i
].gen
= HIGHEST_NORMAL_GENERATION
;
4659 generations
[PSEUDO_STATIC_GENERATION
].bytes_allocated
-= used
;
4660 generations
[HIGHEST_NORMAL_GENERATION
].bytes_allocated
+= used
;
4666 /* Do a non-conservative GC, and then save a core with the initial
4667 * function being set to the value of the static symbol
4668 * SB!VM:RESTART-LISP-FUNCTION */
4670 gc_and_save(char *filename
, boolean prepend_runtime
,
4671 boolean save_runtime_options
, boolean compressed
,
4672 int compression_level
, int application_type
)
4675 void *runtime_bytes
= NULL
;
4676 size_t runtime_size
;
4678 file
= prepare_to_save(filename
, prepend_runtime
, &runtime_bytes
,
4683 conservative_stack
= 0;
4685 /* The filename might come from Lisp, and be moved by the now
4686 * non-conservative GC. */
4687 filename
= strdup(filename
);
4689 /* Collect twice: once into relatively high memory, and then back
4690 * into low memory. This compacts the retained data into the lower
4691 * pages, minimizing the size of the core file.
4693 prepare_for_final_gc();
4694 gencgc_alloc_start_page
= last_free_page
;
4695 collect_garbage(HIGHEST_NORMAL_GENERATION
+1);
4697 prepare_for_final_gc();
4698 gencgc_alloc_start_page
= -1;
4699 collect_garbage(HIGHEST_NORMAL_GENERATION
+1);
4701 if (prepend_runtime
)
4702 save_runtime_to_filehandle(file
, runtime_bytes
, runtime_size
,
4705 /* The dumper doesn't know that pages need to be zeroed before use. */
4706 zero_all_free_pages();
4707 save_to_filehandle(file
, filename
, SymbolValue(RESTART_LISP_FUNCTION
,0),
4708 prepend_runtime
, save_runtime_options
,
4709 compressed
? compression_level
: COMPRESSION_LEVEL_NONE
);
4710 /* Oops. Save still managed to fail. Since we've mangled the stack
4711 * beyond hope, there's not much we can do.
4712 * (beyond FUNCALLing RESTART_LISP_FUNCTION, but I suspect that's
4713 * going to be rather unsatisfactory too... */
4714 lose("Attempt to save core after non-conservative GC failed.\n");