6 #include "gc-internal.h"
7 #include "gc-private.h"
8 #include "genesis/closure.h"
9 #include "genesis/cons.h"
10 #include "genesis/constants.h"
11 #include "genesis/gc-tables.h"
12 #include "genesis/instance.h"
13 #include "genesis/layout.h"
14 #include "genesis/package.h"
15 #include "genesis/vector.h"
16 #include "pseudo-atomic.h" // for get_alloc_pointer()
22 #ifndef LISP_FEATURE_WIN32
23 #define HAVE_GETRUSAGE 1
26 #include <sys/resource.h> // for getrusage()
29 int heap_trace_verbose
= 0;
31 extern generation_index_t gencgc_oldest_gen_to_gc
;
33 /// Each "layer" is a set of objects reachable by tracing one reverse pointer
34 /// from any object in the previously built layer.
35 /// An object will not appear in more than one layer.
37 struct __attribute((packed
)) node
{
38 lispobj object
; // With lowtag
39 // Which 0-relative word in this object points to any object
40 // in the next layer (closer to the intended target object).
47 /// memory in which to build the object lists comprising the
48 /// values in 'inverted_heap', the hashtable which maps each object
49 /// to a list of objects pointing to it.
51 char* base
, *free
, *end
;
60 // A hashtable mapping each object to a list of objects pointing to it
61 struct hopscotch_table inverted_heap
;
62 struct scratchpad scratchpad
;
65 static int gen_of(lispobj obj
) {
66 #ifdef LISP_FEATURE_IMMOBILE_SPACE
67 if (immobile_space_p(obj
))
68 return immobile_obj_gen_bits(native_pointer(obj
));
70 int page
= find_page_index((void*)obj
);
71 if (page
>= 0) return page_table
[page
].gen
;
75 const char* classify_obj(lispobj ptr
)
77 extern lispobj
* instance_classoid_name(lispobj
*);
79 lispobj
* name
; // a Lisp string
80 switch(lowtag_of(ptr
)) {
81 case INSTANCE_POINTER_LOWTAG
:
82 name
= instance_classoid_name(native_pointer(ptr
));
83 if (widetag_of(*name
) == SIMPLE_BASE_STRING_WIDETAG
)
84 return (char*)(name
+ 2);
85 case LIST_POINTER_LOWTAG
:
87 case FUN_POINTER_LOWTAG
:
88 case OTHER_POINTER_LOWTAG
:
89 return widetag_names
[widetag_of(*native_pointer(ptr
))>>2];
92 sprintf(buf
, "#x%x", widetag_of(*native_pointer(ptr
)));
96 static void add_to_layer(lispobj
* obj
, int wordindex
,
97 struct layer
* layer
, int* capacity
)
99 // Resurrect the containing object's lowtag
100 lispobj ptr
= compute_lispobj(obj
);
101 int staticp
= ptr
<= STATIC_SPACE_END
;
102 int gen
= staticp
? -1 : gen_of(ptr
);
103 if (heap_trace_verbose
>2)
104 // Show the containing object, its type and generation, and pointee
106 " add_to_layer(%p,%d) = %s,g%c -> %p\n",
107 (void*)ptr
, wordindex
, classify_obj(ptr
), (staticp
? 'S' : '0'+gen
),
108 (void*)obj
[wordindex
]);
109 int count
= layer
->count
;
110 if (count
>= *capacity
) {
111 *capacity
= *capacity
? 2 * *capacity
: 4;
112 layer
->nodes
= realloc(layer
->nodes
, *capacity
* sizeof (struct node
));
114 layer
->nodes
[count
].object
= ptr
;
115 layer
->nodes
[count
].wordindex
= wordindex
;
119 /// If 'obj' is a simple-fun, return its code component,
120 /// otherwise return obj directly.
121 static lispobj
canonical_obj(lispobj obj
)
123 if (lowtag_of(obj
) == FUN_POINTER_LOWTAG
&&
124 widetag_of(*native_pointer(obj
)) == SIMPLE_FUN_WIDETAG
)
125 return make_lispobj(fun_code_header(obj
-FUN_POINTER_LOWTAG
),
126 OTHER_POINTER_LOWTAG
);
130 /* Return the word index of the pointer in 'source' which references 'target'.
131 * Return -1 on failure. (This is an error if it happens)
133 #define check_ptr(index,ptr) if(canonical_obj(ptr)==target) return index;
134 static int find_ref(lispobj
* source
, lispobj target
)
136 lispobj layout
, bitmap
;
137 int scan_limit
, i
, j
;
139 lispobj header
= *source
;
140 if (is_cons_half(header
)) {
141 check_ptr(0, header
);
142 check_ptr(1, source
[1]);
145 int widetag
= widetag_of(header
);
146 scan_limit
= sizetab
[widetag
](source
);
148 case INSTANCE_WIDETAG
:
149 #ifdef LISP_FEATURE_COMPACT_INSTANCE_HEADER
150 case FUNCALLABLE_INSTANCE_WIDETAG
:
152 // mixed boxed/unboxed objects
153 // Unlike in scav_instance where the slot loop is unswitched for
154 // speed into three cases (no raw slots, fixnum bitmap, bignum bitmap),
155 // here we just go for clarity by abstracting out logbitp.
156 layout
= instance_layout(source
);
157 check_ptr(0, layout
);
158 bitmap
= layout
? LAYOUT(layout
)->bitmap
: make_fixnum(-1);
159 for(i
=1; i
<scan_limit
; ++i
)
160 if (layout_bitmap_logbitp(i
-1, bitmap
)) check_ptr(i
, source
[i
]);
162 #if FUN_SELF_FIXNUM_TAGGED
163 case CLOSURE_WIDETAG
:
164 check_ptr(1, ((struct closure
*)source
)->fun
- FUN_RAW_ADDR_OFFSET
);
167 case CODE_HEADER_WIDETAG
:
168 for_each_simple_fun(i
, function_ptr
, (struct code
*)source
, 0, {
169 int wordindex
= &function_ptr
->name
- source
;
170 for (j
=0; j
<4; ++j
) check_ptr(wordindex
+j
, source
[wordindex
+j
]);
172 scan_limit
= code_header_words(header
);
175 check_ptr(3, fdefn_callee_lispobj((struct fdefn
*)source
));
179 for(i
=1; i
<scan_limit
; ++i
) check_ptr(i
, source
[i
]);
184 enum ref_kind
{ HEAP
, CONTROL_STACK
, BINDING_STACK
, TLS
};
185 char *ref_kind_name
[4] = {"heap","C stack","bindings","TLS"};
187 /// This unfortunately entails a heap scan,
188 /// but it's quite fast if the symbol is found in immobile space.
189 #ifdef LISP_FEATURE_SB_THREAD
190 static lispobj
* find_sym_by_tls_index(lispobj tls_index
)
194 #ifdef LISP_FEATURE_IMMOBILE_SPACE
195 where
= (lispobj
*)IMMOBILE_SPACE_START
;
196 end
= immobile_fixedobj_free_pointer
;
199 while (where
< end
) {
200 lispobj header
= *where
;
201 int widetag
= widetag_of(header
);
202 if (widetag
== SYMBOL_WIDETAG
&&
203 tls_index_of(((struct symbol
*)where
)) == tls_index
)
205 where
+= OBJECT_SIZE(header
, where
);
207 if (where
>= (lispobj
*)DYNAMIC_SPACE_START
)
209 where
= (lispobj
*)DYNAMIC_SPACE_START
;
210 end
= (lispobj
*)get_alloc_pointer();
216 static inline int interestingp(lispobj ptr
, struct hopscotch_table
* targets
)
218 return is_lisp_pointer(ptr
) && hopscotch_containsp(targets
, ptr
);
221 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
222 /* Try to find the call frame that contains 'addr', which is the address
223 * in which a conservative root was seen.
224 * Return the program counter associated with that frame. */
225 static char* deduce_thread_pc(struct thread
* th
, void** addr
)
227 uword_t
* fp
= __builtin_frame_address(0);
230 if (th
!= arch_os_get_current_thread()) {
231 int i
= fixnum_value(read_TLS(FREE_INTERRUPT_CONTEXT_INDEX
,th
));
232 os_context_t
*c
= th
->interrupt_contexts
[i
-1];
233 fp
= (uword_t
*)*os_context_register_addr(c
,reg_FP
);
236 if ((uword_t
*)addr
< fp
)
238 uword_t prev_fp
= fp
[0];
239 if (prev_fp
== 0 || (uword_t
*)prev_fp
< fp
|| (lispobj
*)prev_fp
>= th
->control_stack_end
)
241 return_pc
= (void*)fp
[1];
242 fp
= (uword_t
*)prev_fp
;
246 static struct { void* pointer
; boolean found
; } pin_seek_state
;
247 static void compare_pointer(void *addr
) {
248 if (addr
== pin_seek_state
.pointer
)
249 pin_seek_state
.found
= 1;
252 /* Figure out which thread's control stack contains 'pointer'
253 * and the PC within the active function in the referencing frame */
254 static struct thread
* deduce_thread(void (*context_scanner
)(),
255 uword_t pointer
, char** pc
)
260 pin_seek_state
.found
= 0;
261 for_each_thread(th
) {
262 void **esp
=(void **)-1;
264 if (th
== arch_os_get_current_thread())
265 esp
= (void **)((void *)&pointer
);
268 free
= fixnum_value(read_TLS(FREE_INTERRUPT_CONTEXT_INDEX
,th
));
269 for(i
=free
-1;i
>=0;i
--) {
270 os_context_t
*c
=th
->interrupt_contexts
[i
];
271 esp1
= (void **) *os_context_register_addr(c
,reg_SP
);
272 if (esp1
>=(void **)th
->control_stack_start
&& esp1
<(void **)th
->control_stack_end
) {
273 if(esp1
<esp
) esp
=esp1
;
274 pin_seek_state
.pointer
= (void*)pointer
;
275 context_scanner(compare_pointer
, c
);
276 pin_seek_state
.pointer
= 0;
277 if (pin_seek_state
.found
) return th
;
281 if (!esp
|| esp
== (void*) -1)
282 lose("deduce_thread: no SP known for thread %x (OS %x)", th
, th
->os_thread
);
284 for (where
= ((void **)th
->control_stack_end
)-1; where
>= esp
; where
--)
285 if ((uword_t
)*where
== pointer
) {
286 *pc
= deduce_thread_pc(th
, where
);
294 /* KNOWN BUG: stack reference to pinned large object or immobile object
295 * won't be found in pins hashtable */
296 static lispobj
examine_stacks(struct hopscotch_table
* targets
,
297 void (*context_scanner
)(),
298 int n_pins
, lispobj
* pins
,
299 enum ref_kind
*root_kind
,
300 struct thread
** root_thread
,
306 for_each_thread(th
) {
307 lispobj
*where
, *end
;
308 #ifdef LISP_FEATURE_SB_THREAD
309 // Examine thread-local storage
311 where
= (lispobj
*)(th
+1);
312 end
= (lispobj
*)((char*)th
+ SymbolValue(FREE_TLS_INDEX
,0));
313 for( ; where
< end
; ++where
)
314 if (interestingp(*where
, targets
)) {
316 *tls_index
= (char*)where
- (char*)th
;
320 // Examine the binding stack
321 *root_kind
= BINDING_STACK
;
322 where
= (lispobj
*)th
->binding_stack_start
;
323 end
= (lispobj
*)get_binding_stack_pointer(th
);
324 for( ; where
< end
; where
+= 2)
325 if (interestingp(*where
, targets
)) {
327 *tls_index
= where
[1];
330 #ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
331 *root_kind
= CONTROL_STACK
;
332 // Examine the control stack
333 where
= th
->control_stack_start
;
334 end
= access_control_stack_pointer(th
);
335 for ( ; where
< end
; ++where
)
336 if (interestingp(*where
, targets
)) {
341 // Examine the explicit pin list
342 lispobj pin_list
= read_TLS(PINNED_OBJECTS
,th
);
343 while (pin_list
!= NIL
) {
344 uword_t pin
= CONS(pin_list
)->car
;
345 if (interestingp(pin
, targets
)) {
350 pin_list
= CONS(pin_list
)->cdr
;
354 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
355 // Look in the control stacks
356 *root_kind
= CONTROL_STACK
;
359 for (i
=n_pins
-1; i
>=0; --i
)
360 // Bypass interestingp() to avoid one test - pins are known pointers.
361 if (hopscotch_containsp(targets
, pin
= pins
[i
])) {
362 boolean world_stopped
= context_scanner
!= 0;
364 *root_thread
= deduce_thread(context_scanner
, pin
, thread_pc
);
368 // Scan just the current thread's stack
369 // (We don't know where the other stack pointers are)
370 th
= arch_os_get_current_thread();
371 void **esp
= __builtin_frame_address(0);
373 for (where
= ((void **)th
->control_stack_end
)-1; where
>= esp
; --where
)
374 if (*where
== (void*)pin
) {
376 *thread_pc
= deduce_thread_pc(th
, where
);
387 void free_graph(struct layer
* layer
)
391 struct layer
* next
= layer
->next
;
397 struct node
* find_node(struct layer
* layer
, lispobj ptr
)
400 for(i
=layer
->count
-1; i
>=0; --i
)
401 if (layer
->nodes
[i
].object
== ptr
)
402 return &layer
->nodes
[i
];
406 /// "Compressed" pointers are a huge win - they halve the amount
407 /// of space required to invert the heap.
408 static inline uint32_t encode_pointer(lispobj pointer
)
411 if (pointer
>= DYNAMIC_SPACE_START
) {
412 // A dynamic space pointer is stored as a count in doublewords
413 // from the heap base address. A 32GB range is representable.
414 encoding
= (pointer
- DYNAMIC_SPACE_START
) / (2*N_WORD_BYTES
);
415 gc_assert(encoding
<= 0x7FFFFFFF);
416 return (encoding
<<1) | 1; // Low bit signifies compressed ptr.
418 // Non-dynamic-space pointers are stored as-is.
419 gc_assert(pointer
<= 0xFFFFFFFF && !(pointer
& 1));
420 return pointer
; // Low bit 0 signifies literal pointer
424 static inline lispobj
decode_pointer(uint32_t encoding
)
426 if (encoding
& 1) // Compressed ptr
427 return (encoding
>>1)*(2*N_WORD_BYTES
) + DYNAMIC_SPACE_START
;
429 return encoding
; // Literal pointer
432 struct simple_fun
* simple_fun_from_pc(char* pc
)
434 struct code
* code
= (struct code
*)component_ptr_from_pc((lispobj
*)pc
);
436 struct simple_fun
* prev_fun
= (struct simple_fun
*)
437 ((char*)code
+ (code_header_words(code
->header
)<<WORD_SHIFT
)
438 + FIRST_SIMPLE_FUN_OFFSET(code
));
439 for_each_simple_fun(i
, fun
, code
, 1, {
440 if (pc
< (char*)fun
) break;
446 static void maybe_show_object_name(lispobj obj
, FILE* stream
)
448 extern void safely_show_lstring(lispobj
* string
, int quotes
, FILE *s
);
449 lispobj package
, package_name
;
450 if (lowtag_of(obj
)==OTHER_POINTER_LOWTAG
)
451 switch(widetag_of(*native_pointer(obj
))) {
453 package
= SYMBOL(obj
)->package
;
454 package_name
= ((struct package
*)native_pointer(package
))->_name
;
456 safely_show_lstring(native_pointer(package_name
), 0, stream
);
458 safely_show_lstring(native_pointer(SYMBOL(obj
)->name
), 0, stream
);
463 static boolean
root_p(lispobj ptr
, int criterion
)
465 if (ptr
<= STATIC_SPACE_END
) return 1; // always a root
466 // 0 to 2 are in order of weakest to strongest condition for stopping,
467 // i.e. criterion 0 implies that that largest number of objects
468 // are considered roots.
470 && (gen_of(ptr
) > (criterion
? HIGHEST_NORMAL_GENERATION
471 : gencgc_oldest_gen_to_gc
));
474 /// Find any shortest path to 'object' starting at a tenured object or a thread stack.
475 static void trace1(lispobj object
,
476 struct hopscotch_table
* targets
,
477 struct hopscotch_table
* visited
,
478 struct hopscotch_table
* inverted_heap
,
479 struct scratchpad
* scratchpad
,
480 int n_pins
, lispobj
* pins
, void (*context_scanner
)(),
483 struct node
* anchor
= 0;
485 enum ref_kind root_kind
;
486 struct thread
* root_thread
;
492 struct layer
* top_layer
= 0;
493 int layer_capacity
= 0;
495 hopscotch_put(targets
, object
, 1);
496 while ((thread_ref
= examine_stacks(targets
, context_scanner
, n_pins
, pins
,
497 &root_kind
, &root_thread
, &thread_pc
,
499 // TODO: preallocate layers to avoid possibility of malloc deadlock
500 struct layer
* layer
= (struct layer
*)malloc(sizeof (struct layer
));
503 layer
->next
= top_layer
;
506 if (heap_trace_verbose
)
507 printf("Next layer: Looking for %d object(s)\n", targets
->count
);
508 for_each_hopscotch_key(i
, target
, (*targets
)) {
509 uint32_t list
= hopscotch_get(inverted_heap
, target
, 0);
510 if (heap_trace_verbose
>1) {
511 uint32_t list1
= list
;
512 fprintf(stderr
, "target=%p srcs=", (void*)target
);
514 uint32_t* cell
= (uint32_t*)(scratchpad
->base
+ list1
);
515 lispobj
* ptr
= (lispobj
*)decode_pointer(cell
[0]);
516 if (hopscotch_containsp(visited
, (lispobj
)ptr
))
517 fprintf(stderr
, "%p ", ptr
);
520 int nwords
= OBJECT_SIZE(word
, ptr
);
521 fprintf(stderr
, "%p+%d ", ptr
, nwords
);
527 while (list
&& !anchor
) {
528 uint32_t* cell
= (uint32_t*)(scratchpad
->base
+ list
);
529 lispobj ptr
= decode_pointer(cell
[0]);
531 if (hopscotch_containsp(visited
, ptr
))
533 int wordindex
= find_ref((lispobj
*)ptr
, target
);
534 if (wordindex
== -1) {
535 fprintf(stderr
, "Strange: no ref from %p to %p\n",
536 (void*)ptr
, (void*)target
);
539 hopscotch_insert(visited
, ptr
, 1);
540 add_to_layer((lispobj
*)ptr
, wordindex
,
541 top_layer
, &layer_capacity
);
542 // Stop if the object at 'ptr' is tenured.
543 if (root_p(ptr
, criterion
)) {
544 fprintf(stderr
, "Stopping at %p: tenured\n", (void*)ptr
);
545 anchor
= &top_layer
->nodes
[top_layer
->count
-1];
549 if (!top_layer
->count
) {
550 fprintf(stderr
, "Failure tracing from %p. Current targets:\n", (void*)object
);
551 for_each_hopscotch_key(i
, target
, (*targets
))
552 fprintf(stderr
, "%p ", (void*)target
);
554 free_graph(top_layer
);
557 if (heap_trace_verbose
>1)
558 printf("Found %d object(s)\n", top_layer
->count
);
559 // The top layer's last object if static or tenured
560 // stops the scan. (And no more objects go in the top layer)
563 // Transfer the top layer objects into 'targets'
564 hopscotch_reset(targets
);
565 struct node
* nodes
= top_layer
->nodes
;
566 for (i
=top_layer
->count
-1 ; i
>=0 ; --i
) {
567 lispobj ptr
= nodes
[i
].object
;
568 hopscotch_put(targets
, ptr
, 1);
574 struct vector
* lisp_thread_name(os_thread_t os_thread
);
575 extern void show_lstring(struct vector
*, int, FILE*);
576 struct vector
* thread_name
;
579 "%s pointed to by %s: %p\n",
580 top_layer
? "Indirectly" : "Directly",
581 ref_kind_name
[root_kind
],
585 // The thread indirectly points to a target.
586 // The root object is whatever the thread pointed to,
587 // which must be an object in the top layer. Find that object.
588 anchor
= find_node(top_layer
, thread_ref
);
593 fprintf(file
, "(unknown-thread)");
594 else if ((thread_name
= lisp_thread_name(root_thread
->os_thread
)) != 0)
595 show_lstring(thread_name
, 1, file
);
597 fprintf(file
, "thread=%p", root_thread
);
598 fprintf(file
, ":%s:", ref_kind_name
[root_kind
]);
599 if (root_kind
==BINDING_STACK
|| root_kind
==TLS
) {
600 #ifdef LISP_FEATURE_SB_THREAD
601 lispobj
* symbol
= find_sym_by_tls_index(tls_index
);
603 lispobj
* symbol
= native_pointer(tls_index
);
606 show_lstring(symbol_name(symbol
), 0, file
);
608 fprintf(file
, "%"OBJ_FMTX
, tls_index
);
610 struct simple_fun
* fun
= simple_fun_from_pc(thread_pc
);
612 fprintf(file
, "fun=%p", (void*)make_lispobj(fun
, FUN_POINTER_LOWTAG
));
613 if (is_lisp_pointer(fun
->name
) &&
614 widetag_of(*native_pointer(fun
->name
)) == SYMBOL_WIDETAG
) {
616 show_lstring(VECTOR(SYMBOL(fun
->name
)->name
), 0, file
);
618 } else if (thread_pc
)
619 fprintf(file
, "pc=%p", thread_pc
);
621 fprintf(file
, "}->");
622 } else { // Stopped at (pseudo)static object
623 fprintf(stderr
, "Anchor object is @ %p. word[%d]\n",
624 native_pointer(anchor
->object
), anchor
->wordindex
);
629 struct node next
= *anchor
;
630 lispobj ptr
= next
.object
;
631 if (ptr
<= STATIC_SPACE_END
)
632 fprintf(file
, "(static,");
634 fprintf(file
, "(g%d,", gen_of(ptr
));
635 fputs(classify_obj(ptr
), file
);
636 maybe_show_object_name(ptr
, file
);
637 fprintf(file
, ")%p[%d]->", (void*)ptr
, next
.wordindex
);
638 target
= native_pointer(ptr
)[next
.wordindex
];
639 // Special-case a few combinations of <type,wordindex>
640 switch (next
.wordindex
) {
642 if (lowtag_of(ptr
) == INSTANCE_POINTER_LOWTAG
||
643 lowtag_of(ptr
) == FUN_POINTER_LOWTAG
)
644 target
= instance_layout(native_pointer(ptr
));
646 #if FUN_SELF_FIXNUM_TAGGED
648 if (lowtag_of(ptr
) == FUN_POINTER_LOWTAG
&&
649 widetag_of(*native_pointer(ptr
)) == CLOSURE_WIDETAG
)
650 target
-= FUN_RAW_ADDR_OFFSET
;
654 if (lowtag_of(ptr
) == OTHER_POINTER_LOWTAG
&&
655 widetag_of(FDEFN(ptr
)->header
) == FDEFN_WIDETAG
)
656 target
= fdefn_callee_lispobj((struct fdefn
*)native_pointer(ptr
));
659 target
= canonical_obj(target
);
660 struct layer
* next_layer
= top_layer
->next
;
661 free(top_layer
->nodes
);
663 top_layer
= next_layer
;
665 anchor
= find_node(top_layer
, target
);
668 gc_assert(object
== target
);
671 fprintf(file
, "%p.\n", (void*)target
);
675 static void record_ptr(lispobj
* source
, lispobj target
,
676 struct scan_state
* ss
)
678 // Add 'source' to the list of objects keyed by 'target' in the inverted heap.
679 // Note that 'source' has no lowtag, and 'target' does.
680 // Pointer compression occurs here as well: the linked list of source objects
681 // is built using offsets into the scratchpad rather than absolute addresses.
682 target
= canonical_obj(target
);
683 uint32_t* new_cell
= (uint32_t*)ss
->scratchpad
.free
;
684 uint32_t* next
= new_cell
+ 2;
685 gc_assert((char*)next
<= ss
->scratchpad
.end
);
686 ss
->scratchpad
.free
= (char*)next
;
687 new_cell
[0] = encode_pointer((lispobj
)source
);
688 new_cell
[1] = hopscotch_get(&ss
->inverted_heap
, target
, 0);
689 hopscotch_put(&ss
->inverted_heap
, target
,
690 (sword_t
)((char*)new_cell
- ss
->scratchpad
.base
));
693 #define relevant_ptr_p(x) find_page_index(x)>=0||immobile_space_p((lispobj)x)
695 #define check_ptr(ptr) { \
697 if (!is_lisp_pointer(ptr)) ++n_immediates; \
698 else if (relevant_ptr_p((void*)(ptr))) { \
700 if (record_ptrs) record_ptr(where,ptr,ss); \
703 static uword_t
build_refs(lispobj
* where
, lispobj
* end
,
704 struct scan_state
* ss
)
706 lispobj layout
, bitmap
;
707 sword_t nwords
, scan_limit
, i
, j
;
708 uword_t n_objects
= 0, n_scanned_words
= 0,
709 n_immediates
= 0, n_pointers
= 0;
711 boolean record_ptrs
= ss
->record_ptrs
;
712 for ( ; where
< end
; where
+= nwords
) {
714 lispobj header
= *where
;
715 if (is_cons_half(header
)) {
721 int widetag
= widetag_of(header
);
722 nwords
= scan_limit
= sizetab
[widetag
](where
);
724 case INSTANCE_WIDETAG
:
725 #ifdef LISP_FEATURE_COMPACT_INSTANCE_HEADER
726 case FUNCALLABLE_INSTANCE_WIDETAG
:
728 // mixed boxed/unboxed objects
729 layout
= instance_layout(where
);
731 // Partially initialized instance can't have nonzero words yet
732 bitmap
= layout
? LAYOUT(layout
)->bitmap
: make_fixnum(-1);
733 // If no raw slots, just scan without use of the bitmap.
734 if (bitmap
== make_fixnum(-1)) break;
735 for(i
=1; i
<scan_limit
; ++i
)
736 if (layout_bitmap_logbitp(i
-1, bitmap
)) check_ptr(where
[i
]);
738 #if FUN_SELF_FIXNUM_TAGGED
739 case CLOSURE_WIDETAG
:
740 check_ptr(((struct closure
*)where
)->fun
- FUN_RAW_ADDR_OFFSET
);
743 case CODE_HEADER_WIDETAG
:
744 for_each_simple_fun(i
, function_ptr
, (struct code
*)where
, 0, {
745 int wordindex
= &function_ptr
->name
- where
;
746 for (j
=0; j
<4; ++j
) check_ptr(where
[wordindex
+j
]);
748 scan_limit
= code_header_words(header
);
751 check_ptr(fdefn_callee_lispobj((struct fdefn
*)where
));
755 if (!(other_immediate_lowtag_p(widetag
) && lowtag_for_widetag
[widetag
>>2]))
756 lose("Unknown widetag %x\n", widetag
);
757 // Skip irrelevant objects.
758 if (unboxed_obj_widetag_p(widetag
) ||
759 (widetag
== WEAK_POINTER_WIDETAG
) || /* do not follow! */
760 // These numeric types contain pointers, but are uninteresting.
761 (widetag
== COMPLEX_WIDETAG
) ||
762 (widetag
== RATIO_WIDETAG
))
765 for(i
=1; i
<scan_limit
; ++i
) check_ptr(where
[i
]);
767 if (!record_ptrs
) { // just count them
768 ss
->n_objects
+= n_objects
;
769 ss
->n_scanned_words
+= n_scanned_words
;
770 ss
->n_immediates
+= n_immediates
;
771 ss
->n_pointers
+= n_pointers
;
777 static void scan_spaces(struct scan_state
* ss
)
779 build_refs((lispobj
*)STATIC_SPACE_START
, static_space_free_pointer
, ss
);
780 #ifdef LISP_FEATURE_IMMOBILE_SPACE
781 build_refs((lispobj
*)IMMOBILE_SPACE_START
, immobile_fixedobj_free_pointer
, ss
);
782 build_refs((lispobj
*)IMMOBILE_VARYOBJ_SUBSPACE_START
,
783 immobile_space_free_pointer
, ss
);
785 walk_generation((uword_t(*)(lispobj
*,lispobj
*,uword_t
))build_refs
,
789 #define HASH_FUNCTION HOPSCOTCH_HASH_FUN_MIX
791 static void compute_heap_inverse(struct hopscotch_table
* inverted_heap
,
792 struct scratchpad
* scratchpad
)
794 struct scan_state ss
;
795 memset(&ss
, 0, sizeof ss
);
796 fprintf(stderr
, "Pass 1: Counting heap objects... ");
798 fprintf(stderr
, "%ld objs, %ld ptrs, %ld immediates\n",
799 ss
.n_objects
, ss
.n_pointers
,
800 ss
.n_scanned_words
- ss
.n_pointers
);
801 // Guess at the initial size of ~ .5 million objects.
802 int size
= 1<<19; // flsl(tot_n_objects); this would work if you have it
803 while (ss
.n_objects
> size
) size
<<= 1;
804 fprintf(stderr
, "Pass 2: Inverting heap. Initial size=%d objects\n", size
);
805 hopscotch_create(&ss
.inverted_heap
, HASH_FUNCTION
,
806 4, // XXX: half the word size if 64-bit
807 size
/* initial size */, 0 /* default hop range */);
808 // Add one pointer due to inability to use the first
809 // two words of the scratchpad.
810 uword_t scratchpad_min_size
= (1 + ss
.n_pointers
) * 2 * sizeof (uint32_t);
811 int pagesize
= getpagesize();
812 uword_t scratchpad_size
= ALIGN_UP(scratchpad_min_size
, pagesize
);
813 ss
.scratchpad
.base
= os_allocate(scratchpad_size
);
814 gc_assert(ss
.scratchpad
.base
);
815 ss
.scratchpad
.free
= ss
.scratchpad
.base
+ 2 * sizeof(uint32_t);
816 ss
.scratchpad
.end
= ss
.scratchpad
.base
+ scratchpad_size
;
817 fprintf(stderr
, "Scratchpad: %lu bytes\n", (long unsigned)scratchpad_size
);
819 struct rusage before
, after
;
820 getrusage(RUSAGE_SELF
, &before
);
824 *inverted_heap
= ss
.inverted_heap
;
825 *scratchpad
= ss
.scratchpad
;
827 getrusage(RUSAGE_SELF
, &after
);
828 // We're done building the necessary structure. Show some memory stats.
829 #define timediff(b,a,field) \
830 ((a.field.tv_sec-b.field.tv_sec)*1000000+(a.field.tv_usec-b.field.tv_usec))
832 "Inverted heap: ct=%d, cap=%d, LF=%f ET=%ld+%ld sys+usr\n",
833 inverted_heap
->count
,
834 1+hopscotch_max_key_index(*inverted_heap
),
835 100*(float)inverted_heap
->count
/ (1+hopscotch_max_key_index(*inverted_heap
)),
836 timediff(before
, after
, ru_stime
),
837 timediff(before
, after
, ru_utime
));
841 /* Find any shortest path from a thread or tenured object
842 * to each of the specified objects.
844 static void trace_paths(void (*context_scanner
)(),
845 lispobj weak_pointers
, int n_pins
, lispobj
* pins
,
849 struct hopscotch_table inverted_heap
;
850 struct scratchpad scratchpad
;
851 // A hashset of all objects in the reverse reachability graph so far
852 struct hopscotch_table visited
; // *Without* lowtag
853 // A hashset of objects in the current graph layer
854 struct hopscotch_table targets
; // With lowtag
856 if (heap_trace_verbose
) {
857 fprintf(stderr
, "%d pins:\n", n_pins
);
858 for(i
=0;i
<n_pins
;++i
)
859 fprintf(stderr
, " %p%s", (void*)pins
[i
],
860 ((i
%8)==7||i
==n_pins
-1)?"\n":"");
862 compute_heap_inverse(&inverted_heap
, &scratchpad
);
863 hopscotch_create(&visited
, HASH_FUNCTION
, 0, 32, 0);
864 hopscotch_create(&targets
, HASH_FUNCTION
, 0, 32, 0);
866 lispobj car
= CONS(weak_pointers
)->car
;
867 lispobj value
= ((struct weak_pointer
*)native_pointer(car
))->value
;
868 weak_pointers
= CONS(weak_pointers
)->cdr
;
869 if (value
!= UNBOUND_MARKER_WIDETAG
) {
870 if (heap_trace_verbose
)
871 fprintf(stderr
, "Target=%p (%s)\n", (void*)value
, classify_obj(value
));
872 hopscotch_reset(&visited
);
873 hopscotch_reset(&targets
);
874 trace1(value
, &targets
, &visited
,
875 &inverted_heap
, &scratchpad
,
876 n_pins
, pins
, context_scanner
, criterion
);
878 } while (weak_pointers
!= NIL
);
879 os_invalidate(scratchpad
.base
, scratchpad
.end
-scratchpad
.base
);
880 hopscotch_destroy(&inverted_heap
);
881 hopscotch_destroy(&visited
);
882 hopscotch_destroy(&targets
);
885 void gc_prove_liveness(void(*context_scanner
)(),
887 int n_pins
, uword_t
* pins
,
890 int n_watched
= 0, n_live
= 0, n_bad
= 0;
892 for ( list
= objects
;
893 list
!= NIL
&& lowtag_of(list
) == LIST_POINTER_LOWTAG
;
894 list
= CONS(list
)->cdr
) {
896 lispobj car
= CONS(list
)->car
;
897 if ((lowtag_of(car
) != OTHER_POINTER_LOWTAG
||
898 widetag_of(*native_pointer(car
)) != WEAK_POINTER_WIDETAG
))
901 n_live
+= ((struct weak_pointer
*)native_pointer(car
))->value
902 != UNBOUND_MARKER_WIDETAG
;
904 if (lowtag_of(list
) != LIST_POINTER_LOWTAG
|| n_bad
) {
905 fprintf(stderr
, "; Bad value in liveness tracker\n");
908 fprintf(stderr
, "; Liveness tracking: %d/%d live watched objects\n",
912 // Put back lowtags on pinned objects, since wipe_nonpinned_words() removed
913 // them. But first test whether lowtags were already repaired
914 // in case prove_liveness() is called after gc_prove_liveness().
915 if (n_pins
>0 && !is_lisp_pointer(pins
[0])) {
917 for(i
=n_pins
-1; i
>=0; --i
) {
918 pins
[i
] = compute_lispobj((lispobj
*)pins
[i
]);
921 trace_paths(context_scanner
, objects
, n_pins
, (lispobj
*)pins
, criterion
);
924 /* This should be called inside WITHOUT-GCING so that the set
925 * of pins does not change out from underneath.
927 void prove_liveness(lispobj objects
, int criterion
)
929 extern struct hopscotch_table pinned_objects
;
930 extern int gc_n_stack_pins
;
931 gc_prove_liveness(0, objects
, gc_n_stack_pins
, pinned_objects
.keys
, criterion
);
934 // These are slot offsets in (DEFSTRUCT THREAD),
935 // not the C structure defined in genesis/thread.h
936 #define LISP_THREAD_NAME_SLOT INSTANCE_DATA_START+0
937 #define LISP_THREAD_OS_THREAD_SLOT INSTANCE_DATA_START+3
939 struct vector
* lisp_thread_name(os_thread_t os_thread
)
941 static unsigned int hint
;
942 lispobj
* sym
= find_symbol("*ALL-THREADS*", "SB-THREAD", &hint
);
943 lispobj list
= sym
? ((struct symbol
*)sym
)->value
: NIL
;
944 while (list
!= NIL
) {
945 struct instance
* lisp_thread
= (struct instance
*)native_pointer(CONS(list
)->car
);
946 list
= CONS(list
)->cdr
;
947 if ((os_thread_t
)lisp_thread
->slots
[LISP_THREAD_OS_THREAD_SLOT
]
949 return VECTOR(lisp_thread
->slots
[LISP_THREAD_NAME_SLOT
]);