6 #include "gc-internal.h"
7 #include "genesis/closure.h"
8 #include "genesis/cons.h"
9 #include "genesis/constants.h"
10 #include "genesis/gc-tables.h"
11 #include "genesis/layout.h"
12 #include "genesis/package.h"
13 #include "pseudo-atomic.h" // for get_alloc_pointer()
18 #ifndef LISP_FEATURE_WIN32
19 #define HAVE_GETRUSAGE 1
22 #include <sys/resource.h> // for getrusage()
25 int heap_trace_verbose
= 0;
27 extern generation_index_t gencgc_oldest_gen_to_gc
;
29 /// Each "layer" is a set of objects reachable by tracing one reverse pointer
30 /// from any object in the previously built layer.
31 /// An object will not appear in more than one layer.
33 struct __attribute((packed
)) node
{
34 lispobj object
; // With lowtag
35 // Which 0-relative word in this object points to any object
36 // in the next layer (closer to the intended target object).
43 /// memory in which to build the object lists comprising the
44 /// values in 'inverted_heap', the hashtable which maps each object
45 /// to a list of objects pointing to it.
47 char* base
, *free
, *end
;
56 // A hashtable mapping each object to a list of objects pointing to it
57 struct hopscotch_table inverted_heap
;
58 struct scratchpad scratchpad
;
61 static int gen_of(lispobj obj
) {
62 #ifdef LISP_FEATURE_IMMOBILE_SPACE
63 if (immobile_space_p(obj
))
64 return immobile_obj_gen_bits(native_pointer(obj
));
66 int page
= find_page_index((void*)obj
);
67 if (page
>= 0) return page_table
[page
].gen
;
71 const char* classify_obj(lispobj ptr
)
73 extern lispobj
* instance_classoid_name(lispobj
*);
74 extern char *widetag_names
[];
76 lispobj
* name
; // a Lisp string
77 switch(lowtag_of(ptr
)) {
78 case INSTANCE_POINTER_LOWTAG
:
79 name
= instance_classoid_name(native_pointer(ptr
));
80 if (widetag_of(*name
) == SIMPLE_BASE_STRING_WIDETAG
)
81 return (char*)(name
+ 2);
82 case LIST_POINTER_LOWTAG
:
84 case FUN_POINTER_LOWTAG
:
85 case OTHER_POINTER_LOWTAG
:
86 return widetag_names
[widetag_of(*native_pointer(ptr
))>>2];
89 sprintf(buf
, "#x%x", widetag_of(*native_pointer(ptr
)));
93 static void add_to_layer(lispobj
* obj
, int wordindex
,
94 struct layer
* layer
, int* capacity
)
96 // Resurrect the containing object's lowtag
98 int lowtag
= is_cons_half(word
) ?
99 LIST_POINTER_LOWTAG
: lowtag_for_widetag
[widetag_of(word
)>>2];
100 lispobj ptr
= make_lispobj(obj
, lowtag
);
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
= ((struct layout
*)native_pointer(layout
))->bitmap
;
159 for(i
=1; i
<scan_limit
; ++i
)
160 if (layout_bitmap_logbitp(i
-1, bitmap
)) check_ptr(i
, source
[i
]);
162 case CLOSURE_WIDETAG
:
163 check_ptr(1, ((struct closure
*)source
)->fun
- FUN_RAW_ADDR_OFFSET
);
165 case CODE_HEADER_WIDETAG
:
166 for_each_simple_fun(i
, function_ptr
, (struct code
*)source
, 0, {
167 int wordindex
= &function_ptr
->name
- source
;
168 for (j
=0; j
<4; ++j
) check_ptr(wordindex
+j
, source
[wordindex
+j
]);
170 scan_limit
= code_header_words(header
);
172 #ifdef LISP_FEATURE_IMMOBILE_CODE
174 check_ptr(3, fdefn_raw_referent((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 static lispobj
* find_sym_by_tls_index(unsigned int tls_index
)
193 #ifdef LISP_FEATURE_IMMOBILE_SPACE
194 where
= (lispobj
*)IMMOBILE_SPACE_START
;
195 end
= (lispobj
*)SYMBOL(IMMOBILE_FIXEDOBJ_FREE_POINTER
)->value
;
198 while (where
< end
) {
199 lispobj header
= *where
;
200 int widetag
= widetag_of(header
);
201 if (widetag
== SYMBOL_WIDETAG
&&
202 tls_index_of(((struct symbol
*)where
)) == tls_index
)
204 where
+= OBJECT_SIZE(header
, where
);
206 if (where
>= (lispobj
*)DYNAMIC_SPACE_START
)
208 where
= (lispobj
*)DYNAMIC_SPACE_START
;
209 end
= (lispobj
*)get_alloc_pointer();
214 static inline int interestingp(lispobj ptr
, struct hopscotch_table
* targets
)
216 return is_lisp_pointer(ptr
) && hopscotch_containsp(targets
, ptr
);
219 /* Try to find the call frame that contains 'addr', which is the address
220 * in which a conservative root was seen.
221 * Return the program counter associated with that frame. */
222 static char* deduce_thread_pc(struct thread
* th
, void** addr
)
224 uword_t
* fp
= __builtin_frame_address(0);
227 if (th
!= arch_os_get_current_thread()) {
228 int i
= fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,th
));
229 os_context_t
*c
= th
->interrupt_contexts
[i
-1];
230 #ifdef LISP_FEATURE_64_BIT
231 fp
= (uword_t
*)*os_context_register_addr(c
,reg_RBP
);
233 fp
= (uword_t
*)*os_context_register_addr(c
,reg_EBP
);
237 if ((uword_t
*)addr
< fp
)
239 uword_t prev_fp
= fp
[0];
240 if (prev_fp
== 0 || (uword_t
*)prev_fp
< fp
|| (lispobj
*)prev_fp
>= th
->control_stack_end
)
242 return_pc
= (void*)fp
[1];
243 fp
= (uword_t
*)prev_fp
;
247 static struct { void* pointer
; boolean found
; } pin_seek_state
;
248 static void compare_pointer(void *addr
) {
249 if (addr
== pin_seek_state
.pointer
)
250 pin_seek_state
.found
= 1;
253 /* Figure out which thread's control stack contains 'pointer'
254 * and the PC within the active function in the referencing frame */
255 static struct thread
* deduce_thread(void (*context_scanner
)(),
256 uword_t pointer
, char** pc
)
261 pin_seek_state
.found
= 0;
262 for_each_thread(th
) {
263 void **esp
=(void **)-1;
265 if (th
== arch_os_get_current_thread())
266 esp
= (void **)((void *)&pointer
);
269 free
= fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX
,th
));
270 for(i
=free
-1;i
>=0;i
--) {
271 os_context_t
*c
=th
->interrupt_contexts
[i
];
272 esp1
= (void **) *os_context_register_addr(c
,reg_SP
);
273 if (esp1
>=(void **)th
->control_stack_start
&& esp1
<(void **)th
->control_stack_end
) {
274 if(esp1
<esp
) esp
=esp1
;
275 pin_seek_state
.pointer
= (void*)pointer
;
276 context_scanner(compare_pointer
, c
);
277 pin_seek_state
.pointer
= 0;
278 if (pin_seek_state
.found
) return th
;
282 if (!esp
|| esp
== (void*) -1)
283 lose("deduce_thread: no SP known for thread %x (OS %x)", th
, th
->os_thread
);
285 for (where
= ((void **)th
->control_stack_end
)-1; where
>= esp
; where
--)
286 if ((uword_t
)*where
== pointer
) {
287 *pc
= deduce_thread_pc(th
, where
);
294 static lispobj
examine_stacks(struct hopscotch_table
* targets
,
295 void (*context_scanner
)(),
296 int n_pins
, lispobj
* pins
,
297 enum ref_kind
*root_kind
,
298 struct thread
** root_thread
,
300 unsigned int *tls_index
)
302 boolean world_stopped
= context_scanner
!= 0;
305 for_each_thread(th
) {
306 lispobj
*where
, *end
;
307 #ifdef LISP_FEATURE_SB_THREAD
308 // Examine thread-local storage
310 where
= (lispobj
*)(th
+1);
311 end
= (lispobj
*)((char*)th
+ SymbolValue(FREE_TLS_INDEX
,0));
312 for( ; where
< end
; ++where
)
313 if (interestingp(*where
, targets
)) {
315 *tls_index
= (char*)where
- (char*)th
;
319 // Examine the binding stack
320 *root_kind
= BINDING_STACK
;
321 where
= (lispobj
*)th
->binding_stack_start
;
322 end
= (lispobj
*)get_binding_stack_pointer(th
);
323 for( ; where
< end
; where
+= 2)
324 if (interestingp(*where
, targets
)) {
326 *tls_index
= where
[1];
330 // Look in the control stacks
331 *root_kind
= CONTROL_STACK
;
334 for (i
=n_pins
-1; i
>=0; --i
)
335 // Bypass interestingp() to avoid one test - pins are known pointers.
336 if (hopscotch_containsp(targets
, pin
= pins
[i
])) {
338 *root_thread
= deduce_thread(context_scanner
, pin
, thread_pc
);
342 // Scan just the current thread's stack
343 // (We don't know where the other stack pointers are)
344 th
= arch_os_get_current_thread();
345 void **esp
= __builtin_frame_address(0);
347 for (where
= ((void **)th
->control_stack_end
)-1; where
>= esp
; --where
)
348 if (*where
== (void*)pin
) {
350 *thread_pc
= deduce_thread_pc(th
, where
);
360 void free_graph(struct layer
* layer
)
364 struct layer
* next
= layer
->next
;
370 struct node
* find_node(struct layer
* layer
, lispobj ptr
)
373 for(i
=layer
->count
-1; i
>=0; --i
)
374 if (layer
->nodes
[i
].object
== ptr
)
375 return &layer
->nodes
[i
];
379 /// "Compressed" pointers are a huge win - they halve the amount
380 /// of space required to invert the heap.
381 static inline uint32_t encode_pointer(lispobj pointer
)
384 if (pointer
>= DYNAMIC_SPACE_START
) {
385 // A dynamic space pointer is stored as a count in doublewords
386 // from the heap base address. A 32GB range is representable.
387 encoding
= (pointer
- DYNAMIC_SPACE_START
) / (2*N_WORD_BYTES
);
388 gc_assert(encoding
<= 0x7FFFFFFF);
389 return (encoding
<<1) | 1; // Low bit signifies compressed ptr.
391 // Non-dynamic-space pointers are stored as-is.
392 gc_assert(pointer
<= 0xFFFFFFFF && !(pointer
& 1));
393 return pointer
; // Low bit 0 signifies literal pointer
397 static inline lispobj
decode_pointer(uint32_t encoding
)
399 if (encoding
& 1) // Compressed ptr
400 return (encoding
>>1)*(2*N_WORD_BYTES
) + DYNAMIC_SPACE_START
;
402 return encoding
; // Literal pointer
405 struct simple_fun
* simple_fun_from_pc(char* pc
)
407 struct code
* code
= (struct code
*)component_ptr_from_pc((lispobj
*)pc
);
409 struct simple_fun
* prev_fun
= (struct simple_fun
*)
410 ((char*)code
+ (code_header_words(code
->header
)<<WORD_SHIFT
)
411 + FIRST_SIMPLE_FUN_OFFSET(code
));
412 for_each_simple_fun(i
, fun
, code
, 1, {
413 if (pc
< (char*)fun
) break;
419 static void maybe_show_object_name(lispobj obj
, FILE* stream
)
421 extern void safely_show_lstring(lispobj
* string
, int quotes
, FILE *s
);
422 lispobj package
, package_name
;
423 if (lowtag_of(obj
)==OTHER_POINTER_LOWTAG
)
424 switch(widetag_of(*native_pointer(obj
))) {
426 package
= SYMBOL(obj
)->package
;
427 package_name
= ((struct package
*)native_pointer(package
))->_name
;
429 safely_show_lstring(native_pointer(package_name
), 0, stream
);
431 safely_show_lstring(native_pointer(SYMBOL(obj
)->name
), 0, stream
);
436 static boolean
root_p(lispobj ptr
, int criterion
)
438 if (ptr
<= STATIC_SPACE_END
) return 1; // always a root
439 // 0 to 2 are in order of weakest to strongest condition for stopping,
440 // i.e. criterion 0 implies that that largest number of objects
441 // are considered roots.
443 && (gen_of(ptr
) > (criterion
? HIGHEST_NORMAL_GENERATION
444 : gencgc_oldest_gen_to_gc
));
447 /// Find any shortest path to 'object' starting at a tenured object or a thread stack.
448 static void trace1(lispobj object
,
449 struct hopscotch_table
* targets
,
450 struct hopscotch_table
* visited
,
451 struct hopscotch_table
* inverted_heap
,
452 struct scratchpad
* scratchpad
,
453 int n_pins
, lispobj
* pins
, void (*context_scanner
)(),
456 struct node
* anchor
= 0;
458 enum ref_kind root_kind
;
459 struct thread
* root_thread
;
461 unsigned int tls_index
;
465 struct layer
* top_layer
= 0;
466 int layer_capacity
= 0;
468 hopscotch_put(targets
, object
, 1);
469 while ((thread_ref
= examine_stacks(targets
, context_scanner
, n_pins
, pins
,
470 &root_kind
, &root_thread
, &thread_pc
,
472 // TODO: preallocate layers to avoid possibility of malloc deadlock
473 struct layer
* layer
= (struct layer
*)malloc(sizeof (struct layer
));
476 layer
->next
= top_layer
;
479 if (heap_trace_verbose
)
480 printf("Next layer: Looking for %d object(s)\n", targets
->count
);
481 for_each_hopscotch_key(i
, target
, (*targets
)) {
482 uint32_t list
= hopscotch_get(inverted_heap
, target
, 0);
483 if (heap_trace_verbose
>1) {
484 uint32_t list1
= list
;
485 fprintf(stderr
, "target=%p srcs=", (void*)target
);
487 uint32_t* cell
= (uint32_t*)(scratchpad
->base
+ list1
);
488 lispobj
* ptr
= (lispobj
*)decode_pointer(cell
[0]);
489 if (hopscotch_containsp(visited
, (lispobj
)ptr
))
490 fprintf(stderr
, "%p ", ptr
);
493 int nwords
= OBJECT_SIZE(word
, ptr
);
494 fprintf(stderr
, "%p+%d ", ptr
, nwords
);
500 while (list
&& !anchor
) {
501 uint32_t* cell
= (uint32_t*)(scratchpad
->base
+ list
);
502 lispobj ptr
= decode_pointer(cell
[0]);
504 if (hopscotch_containsp(visited
, ptr
))
506 int wordindex
= find_ref((lispobj
*)ptr
, target
);
507 if (wordindex
== -1) {
508 fprintf(stderr
, "Strange: no ref from %p to %p\n",
509 (void*)ptr
, (void*)target
);
512 hopscotch_insert(visited
, ptr
, 1);
513 add_to_layer((lispobj
*)ptr
, wordindex
,
514 top_layer
, &layer_capacity
);
515 // Stop if the object at 'ptr' is tenured.
516 if (root_p(ptr
, criterion
)) {
517 fprintf(stderr
, "Stopping at %p: tenured\n", (void*)ptr
);
518 anchor
= &top_layer
->nodes
[top_layer
->count
-1];
522 if (!top_layer
->count
) {
523 fprintf(stderr
, "Failure tracing from %p. Current targets:\n", (void*)object
);
524 for_each_hopscotch_key(i
, target
, (*targets
))
525 fprintf(stderr
, "%p ", (void*)target
);
527 free_graph(top_layer
);
530 if (heap_trace_verbose
>1)
531 printf("Found %d object(s)\n", top_layer
->count
);
532 // The top layer's last object if static or tenured
533 // stops the scan. (And no more objects go in the top layer)
536 // Transfer the top layer objects into 'targets'
537 hopscotch_reset(targets
);
538 struct node
* nodes
= top_layer
->nodes
;
539 for (i
=top_layer
->count
-1 ; i
>=0 ; --i
) {
540 lispobj ptr
= nodes
[i
].object
;
541 hopscotch_put(targets
, ptr
, 1);
547 struct vector
* lisp_thread_name(os_thread_t os_thread
);
548 extern void show_lstring(struct vector
*, int, FILE*);
549 struct vector
* thread_name
;
552 "%s pointed to by %s: %p\n",
553 top_layer
? "Indirectly" : "Directly",
554 ref_kind_name
[root_kind
],
558 // The thread indirectly points to a target.
559 // The root object is whatever the thread pointed to,
560 // which must be an object in the top layer. Find that object.
561 anchor
= find_node(top_layer
, thread_ref
);
566 fprintf(file
, "(unknown-thread)");
567 else if ((thread_name
= lisp_thread_name(root_thread
->os_thread
)) != 0)
568 show_lstring(thread_name
, 1, file
);
570 fprintf(file
, "thread=%p", root_thread
);
571 fprintf(file
, ":%s:", ref_kind_name
[root_kind
]);
572 if (root_kind
==BINDING_STACK
|| root_kind
==TLS
) {
573 lispobj
* symbol
= find_sym_by_tls_index(tls_index
);
575 show_lstring(symbol_name(symbol
), 0, file
);
577 fprintf(file
, "%x", tls_index
);
579 struct simple_fun
* fun
= simple_fun_from_pc(thread_pc
);
581 fprintf(file
, "fun=%p", (void*)make_lispobj(fun
, FUN_POINTER_LOWTAG
));
582 if (is_lisp_pointer(fun
->name
) &&
583 widetag_of(*native_pointer(fun
->name
)) == SYMBOL_WIDETAG
) {
585 show_lstring(VECTOR(SYMBOL(fun
->name
)->name
), 0, file
);
587 } else if (thread_pc
)
588 fprintf(file
, "pc=%p", thread_pc
);
590 fprintf(file
, "}->");
591 } else { // Stopped at (pseudo)static object
592 fprintf(stderr
, "Anchor object is @ %p. word[%d]\n",
593 native_pointer(anchor
->object
), anchor
->wordindex
);
598 struct node next
= *anchor
;
599 lispobj ptr
= next
.object
;
600 if (ptr
<= STATIC_SPACE_END
)
601 fprintf(file
, "(static,");
603 fprintf(file
, "(g%d,", gen_of(ptr
));
604 fputs(classify_obj(ptr
), file
);
605 maybe_show_object_name(ptr
, file
);
606 fprintf(file
, ")%p[%d]->", (void*)ptr
, next
.wordindex
);
607 target
= native_pointer(ptr
)[next
.wordindex
];
608 // Special-case a few combinations of <type,wordindex>
609 switch (next
.wordindex
) {
611 if (lowtag_of(ptr
) == INSTANCE_POINTER_LOWTAG
||
612 lowtag_of(ptr
) == FUN_POINTER_LOWTAG
)
613 target
= instance_layout(native_pointer(ptr
));
616 if (lowtag_of(ptr
) == FUN_POINTER_LOWTAG
&&
617 widetag_of(*native_pointer(ptr
)) == CLOSURE_WIDETAG
)
618 target
-= FUN_RAW_ADDR_OFFSET
;
620 #ifdef LISP_FEATURE_IMMOBILE_CODE
622 if (lowtag_of(ptr
) == OTHER_POINTER_LOWTAG
&&
623 widetag_of(FDEFN(ptr
)->header
) == FDEFN_WIDETAG
)
624 target
= fdefn_raw_referent((struct fdefn
*)native_pointer(ptr
));
628 target
= canonical_obj(target
);
629 struct layer
* next_layer
= top_layer
->next
;
630 free(top_layer
->nodes
);
632 top_layer
= next_layer
;
634 anchor
= find_node(top_layer
, target
);
637 gc_assert(object
== target
);
640 fprintf(file
, "%p.\n", (void*)target
);
643 static void record_ptr(lispobj
* source
, lispobj target
,
644 struct scan_state
* ss
)
646 // Add 'source' to the list of objects keyed by 'target' in the inverted heap.
647 // Note that 'source' has no lowtag, and 'target' does.
648 // Pointer compression occurs here as well: the linked list of source objects
649 // is built using offsets into the scratchpad rather than absolute addresses.
650 target
= canonical_obj(target
);
651 uint32_t* new_cell
= (uint32_t*)ss
->scratchpad
.free
;
652 uint32_t* next
= new_cell
+ 2;
653 gc_assert((char*)next
<= ss
->scratchpad
.end
);
654 ss
->scratchpad
.free
= (char*)next
;
655 new_cell
[0] = encode_pointer((lispobj
)source
);
656 new_cell
[1] = hopscotch_get(&ss
->inverted_heap
, target
, 0);
657 hopscotch_put(&ss
->inverted_heap
, target
,
658 (sword_t
)((char*)new_cell
- ss
->scratchpad
.base
));
661 #ifdef LISP_FEATURE_IMMOBILE_SPACE
662 #define relevant_ptr_p(x) find_page_index(x)>=0||find_immobile_page_index(x)>=0
664 #define relevant_ptr_p(x) find_page_index(x)>=0
667 #define check_ptr(ptr) { \
669 if (!is_lisp_pointer(ptr)) ++n_immediates; \
670 else if (relevant_ptr_p((void*)ptr)) { \
672 if (record_ptrs) record_ptr(where,ptr,ss); \
675 static uword_t
build_refs(lispobj
* where
, lispobj
* end
,
676 struct scan_state
* ss
)
678 lispobj layout
, bitmap
, fun
;
679 sword_t nwords
, scan_limit
, i
, j
;
680 uword_t n_objects
= 0, n_scanned_words
= 0,
681 n_immediates
= 0, n_pointers
= 0;
683 boolean record_ptrs
= ss
->record_ptrs
;
684 for ( ; where
< end
; where
+= nwords
) {
686 lispobj header
= *where
;
687 if (is_cons_half(header
)) {
693 int widetag
= widetag_of(header
);
694 nwords
= scan_limit
= sizetab
[widetag
](where
);
696 case INSTANCE_WIDETAG
:
697 #ifdef LISP_FEATURE_COMPACT_INSTANCE_HEADER
698 case FUNCALLABLE_INSTANCE_WIDETAG
:
700 // mixed boxed/unboxed objects
701 layout
= instance_layout(where
);
703 bitmap
= ((struct layout
*)native_pointer(layout
))->bitmap
;
704 // If no raw slots, just scan without use of the bitmap.
705 if (bitmap
== make_fixnum(-1)) break;
706 for(i
=1; i
<scan_limit
; ++i
)
707 if (layout_bitmap_logbitp(i
-1, bitmap
)) check_ptr(where
[i
]);
709 case CLOSURE_WIDETAG
:
710 fun
= ((struct closure
*)where
)->fun
- FUN_RAW_ADDR_OFFSET
;
713 case CODE_HEADER_WIDETAG
:
714 for_each_simple_fun(i
, function_ptr
, (struct code
*)where
, 0, {
715 int wordindex
= &function_ptr
->name
- where
;
716 for (j
=0; j
<4; ++j
) check_ptr(where
[wordindex
+j
]);
718 scan_limit
= code_header_words(header
);
720 #ifdef LISP_FEATURE_IMMOBILE_CODE
722 check_ptr(fdefn_raw_referent((struct fdefn
*)where
));
727 if (!(other_immediate_lowtag_p(widetag
) && lowtag_for_widetag
[widetag
>>2]))
728 lose("Unknown widetag %x\n", widetag
);
729 // Skip irrelevant objects.
730 if (unboxed_obj_widetag_p(widetag
) ||
731 (widetag
== WEAK_POINTER_WIDETAG
) || /* do not follow! */
732 // These numeric types contain pointers, but are uninteresting.
733 (widetag
== COMPLEX_WIDETAG
) ||
734 (widetag
== RATIO_WIDETAG
))
737 for(i
=1; i
<scan_limit
; ++i
) check_ptr(where
[i
]);
739 if (!record_ptrs
) { // just count them
740 ss
->n_objects
+= n_objects
;
741 ss
->n_scanned_words
+= n_scanned_words
;
742 ss
->n_immediates
+= n_immediates
;
743 ss
->n_pointers
+= n_pointers
;
749 static void scan_spaces(struct scan_state
* ss
)
751 build_refs((lispobj
*)STATIC_SPACE_START
,
752 (lispobj
*)SYMBOL(STATIC_SPACE_FREE_POINTER
)->value
,
754 #ifdef LISP_FEATURE_IMMOBILE_SPACE
755 build_refs((lispobj
*)IMMOBILE_SPACE_START
,
756 (lispobj
*)SYMBOL(IMMOBILE_FIXEDOBJ_FREE_POINTER
)->value
,
758 build_refs((lispobj
*)IMMOBILE_VARYOBJ_SUBSPACE_START
,
759 (lispobj
*)SYMBOL(IMMOBILE_SPACE_FREE_POINTER
)->value
,
762 walk_generation((uword_t(*)(lispobj
*,lispobj
*,uword_t
))build_refs
,
766 #define HASH_FUNCTION HOPSCOTCH_HASH_FUN_MIX
768 static void compute_heap_inverse(struct hopscotch_table
* inverted_heap
,
769 struct scratchpad
* scratchpad
)
771 struct scan_state ss
;
772 memset(&ss
, 0, sizeof ss
);
773 fprintf(stderr
, "Pass 1: Counting heap objects... ");
775 fprintf(stderr
, "%ld objs, %ld ptrs, %ld immediates\n",
776 ss
.n_objects
, ss
.n_pointers
,
777 ss
.n_scanned_words
- ss
.n_pointers
);
778 // Guess at the initial size of ~ .5 million objects.
779 int size
= 1<<19; // flsl(tot_n_objects); this would work if you have it
780 while (ss
.n_objects
> size
) size
<<= 1;
781 fprintf(stderr
, "Pass 2: Inverting heap. Initial size=%d objects\n", size
);
782 hopscotch_create(&ss
.inverted_heap
, HASH_FUNCTION
,
783 4, // XXX: half the word size if 64-bit
784 size
/* initial size */, 0 /* default hop range */);
785 // Add one pointer due to inability to use the first
786 // two words of the scratchpad.
787 uword_t scratchpad_min_size
= (1 + ss
.n_pointers
) * 2 * sizeof (uint32_t);
788 int pagesize
= getpagesize();
789 uword_t scratchpad_size
= CEILING(scratchpad_min_size
, pagesize
);
790 ss
.scratchpad
.base
= os_allocate(scratchpad_size
);
791 gc_assert(ss
.scratchpad
.base
);
792 ss
.scratchpad
.free
= ss
.scratchpad
.base
+ 2 * sizeof(uint32_t);
793 ss
.scratchpad
.end
= ss
.scratchpad
.base
+ scratchpad_size
;
794 fprintf(stderr
, "Scratchpad: %lu bytes\n", (long unsigned)scratchpad_size
);
796 struct rusage before
, after
;
797 getrusage(RUSAGE_SELF
, &before
);
801 *inverted_heap
= ss
.inverted_heap
;
802 *scratchpad
= ss
.scratchpad
;
804 getrusage(RUSAGE_SELF
, &after
);
805 // We're done building the necessary structure. Show some memory stats.
806 #define timediff(b,a,field) \
807 ((a.field.tv_sec-b.field.tv_sec)*1000000+(a.field.tv_usec-b.field.tv_usec))
809 "Inverted heap: ct=%d, cap=%d, LF=%f ET=%ld+%ld sys+usr\n",
810 inverted_heap
->count
,
811 1+hopscotch_max_key_index(*inverted_heap
),
812 100*(float)inverted_heap
->count
/ (1+hopscotch_max_key_index(*inverted_heap
)),
813 timediff(before
, after
, ru_stime
),
814 timediff(before
, after
, ru_utime
));
818 /* Find any shortest path from a thread or tenured object
819 * to each of the specified objects.
821 static void trace_paths(void (*context_scanner
)(),
822 lispobj weak_pointers
, int n_pins
, lispobj
* pins
,
826 struct hopscotch_table inverted_heap
;
827 struct scratchpad scratchpad
;
828 // A hashset of all objects in the reverse reachability graph so far
829 struct hopscotch_table visited
; // *Without* lowtag
830 // A hashset of objects in the current graph layer
831 struct hopscotch_table targets
; // With lowtag
833 if (heap_trace_verbose
) {
834 fprintf(stderr
, "%d pins:\n", n_pins
);
835 for(i
=0;i
<n_pins
;++i
)
836 fprintf(stderr
, " %p%s", (void*)pins
[i
],
837 ((i
%8)==7||i
==n_pins
-1)?"\n":"");
839 compute_heap_inverse(&inverted_heap
, &scratchpad
);
840 hopscotch_create(&visited
, HASH_FUNCTION
, 0, 32, 0);
841 hopscotch_create(&targets
, HASH_FUNCTION
, 0, 32, 0);
843 lispobj car
= CONS(weak_pointers
)->car
;
844 lispobj value
= ((struct weak_pointer
*)native_pointer(car
))->value
;
845 weak_pointers
= CONS(weak_pointers
)->cdr
;
846 if (value
!= UNBOUND_MARKER_WIDETAG
) {
847 if (heap_trace_verbose
)
848 fprintf(stderr
, "Target=%p (%s)\n", (void*)value
, classify_obj(value
));
849 hopscotch_reset(&visited
);
850 hopscotch_reset(&targets
);
851 trace1(value
, &targets
, &visited
,
852 &inverted_heap
, &scratchpad
,
853 n_pins
, pins
, context_scanner
, criterion
);
855 } while (weak_pointers
!= NIL
);
856 os_invalidate(scratchpad
.base
, scratchpad
.end
-scratchpad
.base
);
857 hopscotch_destroy(&inverted_heap
);
858 hopscotch_destroy(&visited
);
859 hopscotch_destroy(&targets
);
862 void gc_prove_liveness(void(*context_scanner
)(),
864 int n_pins
, uword_t
* pins
,
867 int n_watched
= 0, n_live
= 0, n_bad
= 0;
869 for ( list
= objects
;
870 list
!= NIL
&& lowtag_of(list
) == LIST_POINTER_LOWTAG
;
871 list
= CONS(list
)->cdr
) {
873 lispobj car
= CONS(list
)->car
;
874 if ((lowtag_of(car
) != OTHER_POINTER_LOWTAG
||
875 widetag_of(*native_pointer(car
)) != WEAK_POINTER_WIDETAG
))
878 n_live
+= ((struct weak_pointer
*)native_pointer(car
))->value
879 != UNBOUND_MARKER_WIDETAG
;
881 if (lowtag_of(list
) != LIST_POINTER_LOWTAG
|| n_bad
) {
882 fprintf(stderr
, "; Bad value in liveness tracker\n");
885 fprintf(stderr
, "; Liveness tracking: %d/%d live watched objects\n",
889 // Put back lowtags on pinned objects, since wipe_nonpinned_words() removed
890 // them. But first test whether lowtags were already repaired
891 // in case prove_liveness() is called after gc_prove_liveness().
892 if (n_pins
>0 && !is_lisp_pointer(pins
[0])) {
894 for(i
=n_pins
-1; i
>=0; --i
) {
895 lispobj
* obj
= (lispobj
*)pins
[i
];
896 lispobj header
= *obj
;
897 int lowtag
= is_cons_half(header
) ? LIST_POINTER_LOWTAG
898 : lowtag_for_widetag
[widetag_of(header
)>>2];
899 pins
[i
] = make_lispobj(obj
, lowtag
);
902 trace_paths(context_scanner
, objects
, n_pins
, (lispobj
*)pins
, criterion
);
905 /* This should be called inside WITHOUT-GCING so that the set
906 * of pins does not change out from underneath.
908 void prove_liveness(lispobj objects
, int criterion
)
910 extern struct hopscotch_table pinned_objects
;
911 extern int gc_n_stack_pins
;
912 gc_prove_liveness(0, objects
, gc_n_stack_pins
, pinned_objects
.keys
, criterion
);
915 #include "genesis/package.h"
916 #include "genesis/instance.h"
917 #include "genesis/vector.h"
919 static boolean
__attribute__((unused
)) sym_stringeq(lispobj sym
, const char *string
, int len
)
921 struct vector
* name
= (struct vector
*)native_pointer(SYMBOL(sym
)->name
);
922 return widetag_of(name
->header
) == SIMPLE_BASE_STRING_WIDETAG
923 && fixnum_value(name
->length
) == len
924 && !strcmp((char*)name
->data
, string
);
927 /* Return the value of SB-THREAD::*ALL-THREADS*
928 * This does not need to be particularly efficient.
930 static const char __attribute__((unused
)) all_threads_sym
[] = "*ALL-THREADS*";
931 static lispobj
all_lisp_threads()
933 #ifdef ENTER_FOREIGN_CALLBACK
934 // Starting with a known static symbol in SB-THREAD::, get the SB-THREAD package
935 // and find *ALL-THREADS* (which isn't static). Fewer static symbols is better.
936 struct symbol
* sym
= SYMBOL(ENTER_FOREIGN_CALLBACK
);
937 struct package
* pkg
= (struct package
*)native_pointer(sym
->package
);
938 struct instance
* internals
= (struct instance
*)native_pointer(pkg
->internal_symbols
);
939 struct vector
* cells
= (struct vector
*)
940 native_pointer(internals
->slots
[INSTANCE_DATA_START
]);
941 int cells_length
= fixnum_value(cells
->length
);
942 static int index
= 0;
943 int initial_index
= index
;
945 lispobj thing
= cells
->data
[index
];
946 if (lowtag_of(thing
) == OTHER_POINTER_LOWTAG
947 && widetag_of(SYMBOL(thing
)->header
) == SYMBOL_WIDETAG
948 && sym_stringeq(thing
, all_threads_sym
, strlen(all_threads_sym
)))
949 return SYMBOL(thing
)->value
;
950 index
= (index
+ 1) % cells_length
;
951 } while (index
!= initial_index
);
952 lose("Can't find *ALL-THREADS*");
957 // These are slot offsets in (DEFSTRUCT THREAD),
958 // not the C structure defined in genesis/thread.h
959 #define LISP_THREAD_NAME_SLOT INSTANCE_DATA_START+0
960 #define LISP_THREAD_OS_THREAD_SLOT INSTANCE_DATA_START+3
962 struct vector
* lisp_thread_name(os_thread_t os_thread
)
964 lispobj list
= all_lisp_threads();
965 while (list
!= NIL
) {
966 struct instance
* lisp_thread
= (struct instance
*)native_pointer(CONS(list
)->car
);
967 list
= CONS(list
)->cdr
;
968 if ((os_thread_t
)lisp_thread
->slots
[LISP_THREAD_OS_THREAD_SLOT
]
970 return VECTOR(lisp_thread
->slots
[LISP_THREAD_NAME_SLOT
]);