source: trunk/gc6.8/dbg_mlc.c

Last change on this file was 132, checked in by cinc, 19 years ago

Boehm-Demers-Weiser garbage collector. Single-threaded for OS/2.
File size: 33.4 KB
Line 
1/*
2 * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
3 * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
4 * Copyright (c) 1997 by Silicon Graphics. All rights reserved.
5 * Copyright (c) 1999-2004 Hewlett-Packard Development Company, L.P.
6 *
7 * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
8 * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
9 *
10 * Permission is hereby granted to use or copy this program
11 * for any purpose, provided the above notices are retained on all copies.
12 * Permission to modify the code and to distribute modified code is granted,
13 * provided the above notices are retained, and a notice that the code was
14 * modified is included with the above copyright notice.
15 */
16
17#include <errno.h>
18#include <string.h>
19#include "private/dbg_mlc.h"
20
21void GC_default_print_heap_obj_proc();
22GC_API void GC_register_finalizer_no_order
23 GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
24 GC_finalization_proc *ofn, GC_PTR *ocd));
25
26
27#ifndef SHORT_DBG_HDRS
28/* Check whether object with base pointer p has debugging info */
29/* p is assumed to point to a legitimate object in our part */
30/* of the heap. */
31/* This excludes the check as to whether the back pointer is */
32/* odd, which is added by the GC_HAS_DEBUG_INFO macro. */
33/* Note that if DBG_HDRS_ALL is set, uncollectable objects */
34/* on free lists may not have debug information set. Thus it's */
35/* not always safe to return TRUE, even if the client does */
36/* its part. */
37GC_bool GC_has_other_debug_info(p)
38ptr_t p;
39{
40 register oh * ohdr = (oh *)p;
41 register ptr_t body = (ptr_t)(ohdr + 1);
42 register word sz = GC_size((ptr_t) ohdr);
43
44 if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body)
45 || sz < DEBUG_BYTES + EXTRA_BYTES) {
46 return(FALSE);
47 }
48 if (ohdr -> oh_sz == sz) {
49 /* Object may have had debug info, but has been deallocated */
50 return(FALSE);
51 }
52 if (ohdr -> oh_sf == (START_FLAG ^ (word)body)) return(TRUE);
53 if (((word *)ohdr)[BYTES_TO_WORDS(sz)-1] == (END_FLAG ^ (word)body)) {
54 return(TRUE);
55 }
56 return(FALSE);
57}
58#endif
59
60#ifdef KEEP_BACK_PTRS
61
62# include <stdlib.h>
63
64# if defined(LINUX) || defined(SUNOS4) || defined(SUNOS5) \
65 || defined(HPUX) || defined(IRIX5) || defined(OSF1)
66# define RANDOM() random()
67# else
68# define RANDOM() (long)rand()
69# endif
70
71 /* Store back pointer to source in dest, if that appears to be possible. */
72 /* This is not completely safe, since we may mistakenly conclude that */
73 /* dest has a debugging wrapper. But the error probability is very */
74 /* small, and this shouldn't be used in production code. */
75 /* We assume that dest is the real base pointer. Source will usually */
76 /* be a pointer to the interior of an object. */
77 void GC_store_back_pointer(ptr_t source, ptr_t dest)
78 {
79 if (GC_HAS_DEBUG_INFO(dest)) {
80 ((oh *)dest) -> oh_back_ptr = HIDE_BACK_PTR(source);
81 }
82 }
83
84 void GC_marked_for_finalization(ptr_t dest) {
85 GC_store_back_pointer(MARKED_FOR_FINALIZATION, dest);
86 }
87
88 /* Store information about the object referencing dest in *base_p */
89 /* and *offset_p. */
90 /* source is root ==> *base_p = address, *offset_p = 0 */
91 /* source is heap object ==> *base_p != 0, *offset_p = offset */
92 /* Returns 1 on success, 0 if source couldn't be determined. */
93 /* Dest can be any address within a heap object. */
94 GC_ref_kind GC_get_back_ptr_info(void *dest, void **base_p, size_t *offset_p)
95 {
96 oh * hdr = (oh *)GC_base(dest);
97 ptr_t bp;
98 ptr_t bp_base;
99 if (!GC_HAS_DEBUG_INFO((ptr_t) hdr)) return GC_NO_SPACE;
100 bp = REVEAL_POINTER(hdr -> oh_back_ptr);
101 if (MARKED_FOR_FINALIZATION == bp) return GC_FINALIZER_REFD;
102 if (MARKED_FROM_REGISTER == bp) return GC_REFD_FROM_REG;
103 if (NOT_MARKED == bp) return GC_UNREFERENCED;
104# if ALIGNMENT == 1
105 /* Heuristically try to fix off by 1 errors we introduced by */
106 /* insisting on even addresses. */
107 {
108 ptr_t alternate_ptr = bp + 1;
109 ptr_t target = *(ptr_t *)bp;
110 ptr_t alternate_target = *(ptr_t *)alternate_ptr;
111
112 if (alternate_target >= GC_least_plausible_heap_addr
113 && alternate_target <= GC_greatest_plausible_heap_addr
114 && (target < GC_least_plausible_heap_addr
115 || target > GC_greatest_plausible_heap_addr)) {
116 bp = alternate_ptr;
117 }
118 }
119# endif
120 bp_base = GC_base(bp);
121 if (0 == bp_base) {
122 *base_p = bp;
123 *offset_p = 0;
124 return GC_REFD_FROM_ROOT;
125 } else {
126 if (GC_HAS_DEBUG_INFO(bp_base)) bp_base += sizeof(oh);
127 *base_p = bp_base;
128 *offset_p = bp - bp_base;
129 return GC_REFD_FROM_HEAP;
130 }
131 }
132
133 /* Generate a random heap address. */
134 /* The resulting address is in the heap, but */
135 /* not necessarily inside a valid object. */
136 void *GC_generate_random_heap_address(void)
137 {
138 int i;
139 long heap_offset = RANDOM();
140 if (GC_heapsize > RAND_MAX) {
141 heap_offset *= RAND_MAX;
142 heap_offset += RANDOM();
143 }
144 heap_offset %= GC_heapsize;
145 /* This doesn't yield a uniform distribution, especially if */
146 /* e.g. RAND_MAX = 1.5* GC_heapsize. But for typical cases, */
147 /* it's not too bad. */
148 for (i = 0; i < GC_n_heap_sects; ++ i) {
149 int size = GC_heap_sects[i].hs_bytes;
150 if (heap_offset < size) {
151 return GC_heap_sects[i].hs_start + heap_offset;
152 } else {
153 heap_offset -= size;
154 }
155 }
156 ABORT("GC_generate_random_heap_address: size inconsistency");
157 /*NOTREACHED*/
158 return 0;
159 }
160
161 /* Generate a random address inside a valid marked heap object. */
162 void *GC_generate_random_valid_address(void)
163 {
164 ptr_t result;
165 ptr_t base;
166 for (;;) {
167 result = GC_generate_random_heap_address();
168 base = GC_base(result);
169 if (0 == base) continue;
170 if (!GC_is_marked(base)) continue;
171 return result;
172 }
173 }
174
175 /* Print back trace for p */
176 void GC_print_backtrace(void *p)
177 {
178 void *current = p;
179 int i;
180 GC_ref_kind source;
181 size_t offset;
182 void *base;
183
184 GC_print_heap_obj(GC_base(current));
185 GC_err_printf0("\n");
186 for (i = 0; ; ++i) {
187 source = GC_get_back_ptr_info(current, &base, &offset);
188 if (GC_UNREFERENCED == source) {
189 GC_err_printf0("Reference could not be found\n");
190 goto out;
191 }
192 if (GC_NO_SPACE == source) {
193 GC_err_printf0("No debug info in object: Can't find reference\n");
194 goto out;
195 }
196 GC_err_printf1("Reachable via %d levels of pointers from ",
197 (unsigned long)i);
198 switch(source) {
199 case GC_REFD_FROM_ROOT:
200 GC_err_printf1("root at 0x%lx\n\n", (unsigned long)base);
201 goto out;
202 case GC_REFD_FROM_REG:
203 GC_err_printf0("root in register\n\n");
204 goto out;
205 case GC_FINALIZER_REFD:
206 GC_err_printf0("list of finalizable objects\n\n");
207 goto out;
208 case GC_REFD_FROM_HEAP:
209 GC_err_printf1("offset %ld in object:\n", (unsigned long)offset);
210 /* Take GC_base(base) to get real base, i.e. header. */
211 GC_print_heap_obj(GC_base(base));
212 GC_err_printf0("\n");
213 break;
214 }
215 current = base;
216 }
217 out:;
218 }
219
220 /* Force a garbage collection and generate a backtrace from a */
221 /* random heap address. */
222 void GC_generate_random_backtrace_no_gc(void)
223 {
224 void * current;
225 current = GC_generate_random_valid_address();
226 GC_printf1("\n****Chose address 0x%lx in object\n", (unsigned long)current);
227 GC_print_backtrace(current);
228 }
229
230 void GC_generate_random_backtrace(void)
231 {
232 GC_gcollect();
233 GC_generate_random_backtrace_no_gc();
234 }
235
236#endif /* KEEP_BACK_PTRS */
237
238# define CROSSES_HBLK(p, sz) \
239 (((word)(p + sizeof(oh) + sz - 1) ^ (word)p) >= HBLKSIZE)
240/* Store debugging info into p. Return displaced pointer. */
241/* Assumes we don't hold allocation lock. */
242ptr_t GC_store_debug_info(p, sz, string, integer)
243register ptr_t p; /* base pointer */
244word sz; /* bytes */
245GC_CONST char * string;
246word integer;
247{
248 register word * result = (word *)((oh *)p + 1);
249 DCL_LOCK_STATE;
250
251 /* There is some argument that we should dissble signals here. */
252 /* But that's expensive. And this way things should only appear */
253 /* inconsistent while we're in the handler. */
254 LOCK();
255 GC_ASSERT(GC_size(p) >= sizeof(oh) + sz);
256 GC_ASSERT(!(SMALL_OBJ(sz) && CROSSES_HBLK(p, sz)));
257# ifdef KEEP_BACK_PTRS
258 ((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED);
259# endif
260# ifdef MAKE_BACK_GRAPH
261 ((oh *)p) -> oh_bg_ptr = HIDE_BACK_PTR((ptr_t)0);
262# endif
263 ((oh *)p) -> oh_string = string;
264 ((oh *)p) -> oh_int = integer;
265# ifndef SHORT_DBG_HDRS
266 ((oh *)p) -> oh_sz = sz;
267 ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
268 ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
269 result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
270# endif
271 UNLOCK();
272 return((ptr_t)result);
273}
274
275#ifdef DBG_HDRS_ALL
276/* Store debugging info into p. Return displaced pointer. */
277/* This version assumes we do hold the allocation lock. */
278ptr_t GC_store_debug_info_inner(p, sz, string, integer)
279register ptr_t p; /* base pointer */
280word sz; /* bytes */
281char * string;
282word integer;
283{
284 register word * result = (word *)((oh *)p + 1);
285
286 /* There is some argument that we should disable signals here. */
287 /* But that's expensive. And this way things should only appear */
288 /* inconsistent while we're in the handler. */
289 GC_ASSERT(GC_size(p) >= sizeof(oh) + sz);
290 GC_ASSERT(!(SMALL_OBJ(sz) && CROSSES_HBLK(p, sz)));
291# ifdef KEEP_BACK_PTRS
292 ((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED);
293# endif
294# ifdef MAKE_BACK_GRAPH
295 ((oh *)p) -> oh_bg_ptr = HIDE_BACK_PTR((ptr_t)0);
296# endif
297 ((oh *)p) -> oh_string = string;
298 ((oh *)p) -> oh_int = integer;
299# ifndef SHORT_DBG_HDRS
300 ((oh *)p) -> oh_sz = sz;
301 ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
302 ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
303 result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
304# endif
305 return((ptr_t)result);
306}
307#endif
308
309#ifndef SHORT_DBG_HDRS
310/* Check the object with debugging info at ohdr */
311/* return NIL if it's OK. Else return clobbered */
312/* address. */
313ptr_t GC_check_annotated_obj(ohdr)
314register oh * ohdr;
315{
316 register ptr_t body = (ptr_t)(ohdr + 1);
317 register word gc_sz = GC_size((ptr_t)ohdr);
318 if (ohdr -> oh_sz + DEBUG_BYTES > gc_sz) {
319 return((ptr_t)(&(ohdr -> oh_sz)));
320 }
321 if (ohdr -> oh_sf != (START_FLAG ^ (word)body)) {
322 return((ptr_t)(&(ohdr -> oh_sf)));
323 }
324 if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) {
325 return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1));
326 }
327 if (((word *)body)[SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)]
328 != (END_FLAG ^ (word)body)) {
329 return((ptr_t)((word *)body + SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)));
330 }
331 return(0);
332}
333#endif /* !SHORT_DBG_HDRS */
334
335static GC_describe_type_fn GC_describe_type_fns[MAXOBJKINDS] = {0};
336
337void GC_register_describe_type_fn(kind, fn)
338int kind;
339GC_describe_type_fn fn;
340{
341 GC_describe_type_fns[kind] = fn;
342}
343
344/* Print a type description for the object whose client-visible address */
345/* is p. */
346void GC_print_type(p)
347ptr_t p;
348{
349 hdr * hhdr = GC_find_header(p);
350 char buffer[GC_TYPE_DESCR_LEN + 1];
351 int kind = hhdr -> hb_obj_kind;
352
353 if (0 != GC_describe_type_fns[kind] && GC_is_marked(GC_base(p))) {
354 /* This should preclude free list objects except with */
355 /* thread-local allocation. */
356 buffer[GC_TYPE_DESCR_LEN] = 0;
357 (GC_describe_type_fns[kind])(p, buffer);
358 GC_ASSERT(buffer[GC_TYPE_DESCR_LEN] == 0);
359 GC_err_puts(buffer);
360 } else {
361 switch(kind) {
362 case PTRFREE:
363 GC_err_puts("PTRFREE");
364 break;
365 case NORMAL:
366 GC_err_puts("NORMAL");
367 break;
368 case UNCOLLECTABLE:
369 GC_err_puts("UNCOLLECTABLE");
370 break;
371# ifdef ATOMIC_UNCOLLECTABLE
372 case AUNCOLLECTABLE:
373 GC_err_puts("ATOMIC UNCOLLECTABLE");
374 break;
375# endif
376 case STUBBORN:
377 GC_err_puts("STUBBORN");
378 break;
379 default:
380 GC_err_printf2("kind %ld, descr 0x%lx", kind, hhdr -> hb_descr);
381 }
382 }
383}
384
385
386
387void GC_print_obj(p)
388ptr_t p;
389{
390 register oh * ohdr = (oh *)GC_base(p);
391
392 GC_ASSERT(!I_HOLD_LOCK());
393 GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh)));
394 GC_err_puts(ohdr -> oh_string);
395# ifdef SHORT_DBG_HDRS
396 GC_err_printf1(":%ld, ", (unsigned long)(ohdr -> oh_int));
397# else
398 GC_err_printf2(":%ld, sz=%ld, ", (unsigned long)(ohdr -> oh_int),
399 (unsigned long)(ohdr -> oh_sz));
400# endif
401 GC_print_type((ptr_t)(ohdr + 1));
402 GC_err_puts(")\n");
403 PRINT_CALL_CHAIN(ohdr);
404}
405
406# if defined(__STDC__) || defined(__cplusplus)
407 void GC_debug_print_heap_obj_proc(ptr_t p)
408# else
409 void GC_debug_print_heap_obj_proc(p)
410 ptr_t p;
411# endif
412{
413 GC_ASSERT(!I_HOLD_LOCK());
414 if (GC_HAS_DEBUG_INFO(p)) {
415 GC_print_obj(p);
416 } else {
417 GC_default_print_heap_obj_proc(p);
418 }
419}
420
421#ifndef SHORT_DBG_HDRS
422void GC_print_smashed_obj(p, clobbered_addr)
423ptr_t p, clobbered_addr;
424{
425 register oh * ohdr = (oh *)GC_base(p);
426
427 GC_ASSERT(!I_HOLD_LOCK());
428 GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
429 (unsigned long)p);
430 if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
431 || ohdr -> oh_string == 0) {
432 GC_err_printf1("<smashed>, appr. sz = %ld)\n",
433 (GC_size((ptr_t)ohdr) - DEBUG_BYTES));
434 } else {
435 if (ohdr -> oh_string[0] == '\0') {
436 GC_err_puts("EMPTY(smashed?)");
437 } else {
438 GC_err_puts(ohdr -> oh_string);
439 }
440 GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
441 (unsigned long)(ohdr -> oh_sz));
442 PRINT_CALL_CHAIN(ohdr);
443 }
444}
445#endif
446
447void GC_check_heap_proc GC_PROTO((void));
448
449void GC_print_all_smashed_proc GC_PROTO((void));
450
451void GC_do_nothing() {}
452
453void GC_start_debugging()
454{
455# ifndef SHORT_DBG_HDRS
456 GC_check_heap = GC_check_heap_proc;
457 GC_print_all_smashed = GC_print_all_smashed_proc;
458# else
459 GC_check_heap = GC_do_nothing;
460 GC_print_all_smashed = GC_do_nothing;
461# endif
462 GC_print_heap_obj = GC_debug_print_heap_obj_proc;
463 GC_debugging_started = TRUE;
464 GC_register_displacement((word)sizeof(oh));
465}
466
467size_t GC_debug_header_size = sizeof(oh);
468
469# if defined(__STDC__) || defined(__cplusplus)
470 void GC_debug_register_displacement(GC_word offset)
471# else
472 void GC_debug_register_displacement(offset)
473 GC_word offset;
474# endif
475{
476 GC_register_displacement(offset);
477 GC_register_displacement((word)sizeof(oh) + offset);
478}
479
480# ifdef __STDC__
481 GC_PTR GC_debug_malloc(size_t lb, GC_EXTRA_PARAMS)
482# else
483 GC_PTR GC_debug_malloc(lb, s, i)
484 size_t lb;
485 char * s;
486 int i;
487# ifdef GC_ADD_CALLER
488 --> GC_ADD_CALLER not implemented for K&R C
489# endif
490# endif
491{
492 GC_PTR result = GC_malloc(lb + DEBUG_BYTES);
493
494 if (result == 0) {
495 GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
496 (unsigned long) lb);
497 GC_err_puts(s);
498 GC_err_printf1(":%ld)\n", (unsigned long)i);
499 return(0);
500 }
501 if (!GC_debugging_started) {
502 GC_start_debugging();
503 }
504 ADD_CALL_CHAIN(result, ra);
505 return (GC_store_debug_info(result, (word)lb, s, (word)i));
506}
507
508# ifdef __STDC__
509 GC_PTR GC_debug_malloc_ignore_off_page(size_t lb, GC_EXTRA_PARAMS)
510# else
511 GC_PTR GC_debug_malloc_ignore_off_page(lb, s, i)
512 size_t lb;
513 char * s;
514 int i;
515# ifdef GC_ADD_CALLER
516 --> GC_ADD_CALLER not implemented for K&R C
517# endif
518# endif
519{
520 GC_PTR result = GC_malloc_ignore_off_page(lb + DEBUG_BYTES);
521
522 if (result == 0) {
523 GC_err_printf1("GC_debug_malloc_ignore_off_page(%ld) returning NIL (",
524 (unsigned long) lb);
525 GC_err_puts(s);
526 GC_err_printf1(":%ld)\n", (unsigned long)i);
527 return(0);
528 }
529 if (!GC_debugging_started) {
530 GC_start_debugging();
531 }
532 ADD_CALL_CHAIN(result, ra);
533 return (GC_store_debug_info(result, (word)lb, s, (word)i));
534}
535
536# ifdef __STDC__
537 GC_PTR GC_debug_malloc_atomic_ignore_off_page(size_t lb, GC_EXTRA_PARAMS)
538# else
539 GC_PTR GC_debug_malloc_atomic_ignore_off_page(lb, s, i)
540 size_t lb;
541 char * s;
542 int i;
543# ifdef GC_ADD_CALLER
544 --> GC_ADD_CALLER not implemented for K&R C
545# endif
546# endif
547{
548 GC_PTR result = GC_malloc_atomic_ignore_off_page(lb + DEBUG_BYTES);
549
550 if (result == 0) {
551 GC_err_printf1("GC_debug_malloc_atomic_ignore_off_page(%ld)"
552 " returning NIL (", (unsigned long) lb);
553 GC_err_puts(s);
554 GC_err_printf1(":%ld)\n", (unsigned long)i);
555 return(0);
556 }
557 if (!GC_debugging_started) {
558 GC_start_debugging();
559 }
560 ADD_CALL_CHAIN(result, ra);
561 return (GC_store_debug_info(result, (word)lb, s, (word)i));
562}
563
564# ifdef DBG_HDRS_ALL
565/*
566 * An allocation function for internal use.
567 * Normally internally allocated objects do not have debug information.
568 * But in this case, we need to make sure that all objects have debug
569 * headers.
570 * We assume debugging was started in collector initialization,
571 * and we already hold the GC lock.
572 */
573 GC_PTR GC_debug_generic_malloc_inner(size_t lb, int k)
574 {
575 GC_PTR result = GC_generic_malloc_inner(lb + DEBUG_BYTES, k);
576
577 if (result == 0) {
578 GC_err_printf1("GC internal allocation (%ld bytes) returning NIL\n",
579 (unsigned long) lb);
580 return(0);
581 }
582 ADD_CALL_CHAIN(result, GC_RETURN_ADDR);
583 return (GC_store_debug_info_inner(result, (word)lb, "INTERNAL", (word)0));
584 }
585
586 GC_PTR GC_debug_generic_malloc_inner_ignore_off_page(size_t lb, int k)
587 {
588 GC_PTR result = GC_generic_malloc_inner_ignore_off_page(
589 lb + DEBUG_BYTES, k);
590
591 if (result == 0) {
592 GC_err_printf1("GC internal allocation (%ld bytes) returning NIL\n",
593 (unsigned long) lb);
594 return(0);
595 }
596 ADD_CALL_CHAIN(result, GC_RETURN_ADDR);
597 return (GC_store_debug_info_inner(result, (word)lb, "INTERNAL", (word)0));
598 }
599# endif
600
601#ifdef STUBBORN_ALLOC
602# ifdef __STDC__
603 GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
604# else
605 GC_PTR GC_debug_malloc_stubborn(lb, s, i)
606 size_t lb;
607 char * s;
608 int i;
609# endif
610{
611 GC_PTR result = GC_malloc_stubborn(lb + DEBUG_BYTES);
612
613 if (result == 0) {
614 GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
615 (unsigned long) lb);
616 GC_err_puts(s);
617 GC_err_printf1(":%ld)\n", (unsigned long)i);
618 return(0);
619 }
620 if (!GC_debugging_started) {
621 GC_start_debugging();
622 }
623 ADD_CALL_CHAIN(result, ra);
624 return (GC_store_debug_info(result, (word)lb, s, (word)i));
625}
626
627void GC_debug_change_stubborn(p)
628GC_PTR p;
629{
630 register GC_PTR q = GC_base(p);
631 register hdr * hhdr;
632
633 if (q == 0) {
634 GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
635 (unsigned long) p);
636 ABORT("GC_debug_change_stubborn: bad arg");
637 }
638 hhdr = HDR(q);
639 if (hhdr -> hb_obj_kind != STUBBORN) {
640 GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
641 (unsigned long) p);
642 ABORT("GC_debug_change_stubborn: arg not stubborn");
643 }
644 GC_change_stubborn(q);
645}
646
647void GC_debug_end_stubborn_change(p)
648GC_PTR p;
649{
650 register GC_PTR q = GC_base(p);
651 register hdr * hhdr;
652
653 if (q == 0) {
654 GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
655 (unsigned long) p);
656 ABORT("GC_debug_end_stubborn_change: bad arg");
657 }
658 hhdr = HDR(q);
659 if (hhdr -> hb_obj_kind != STUBBORN) {
660 GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
661 (unsigned long) p);
662 ABORT("GC_debug_end_stubborn_change: arg not stubborn");
663 }
664 GC_end_stubborn_change(q);
665}
666
667#else /* !STUBBORN_ALLOC */
668
669# ifdef __STDC__
670 GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
671# else
672 GC_PTR GC_debug_malloc_stubborn(lb, s, i)
673 size_t lb;
674 char * s;
675 int i;
676# endif
677{
678 return GC_debug_malloc(lb, OPT_RA s, i);
679}
680
681void GC_debug_change_stubborn(p)
682GC_PTR p;
683{
684}
685
686void GC_debug_end_stubborn_change(p)
687GC_PTR p;
688{
689}
690
691#endif /* !STUBBORN_ALLOC */
692
693# ifdef __STDC__
694 GC_PTR GC_debug_malloc_atomic(size_t lb, GC_EXTRA_PARAMS)
695# else
696 GC_PTR GC_debug_malloc_atomic(lb, s, i)
697 size_t lb;
698 char * s;
699 int i;
700# endif
701{
702 GC_PTR result = GC_malloc_atomic(lb + DEBUG_BYTES);
703
704 if (result == 0) {
705 GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
706 (unsigned long) lb);
707 GC_err_puts(s);
708 GC_err_printf1(":%ld)\n", (unsigned long)i);
709 return(0);
710 }
711 if (!GC_debugging_started) {
712 GC_start_debugging();
713 }
714 ADD_CALL_CHAIN(result, ra);
715 return (GC_store_debug_info(result, (word)lb, s, (word)i));
716}
717
718# ifdef __STDC__
719 char *GC_debug_strdup(const char *str, GC_EXTRA_PARAMS)
720#else
721 char *GC_debug_strdup(str, s, i)
722 char *str;
723 char *s;
724 int i;
725#endif
726{
727 char *copy;
728 if (str == NULL) return NULL;
729 copy = GC_debug_malloc_atomic(strlen(str) + 1, OPT_RA s, i);
730 if (copy == NULL) {
731 errno = ENOMEM;
732 return NULL;
733 }
734 strcpy(copy, str);
735 return copy;
736}
737
738# ifdef __STDC__
739 GC_PTR GC_debug_malloc_uncollectable(size_t lb, GC_EXTRA_PARAMS)
740# else
741 GC_PTR GC_debug_malloc_uncollectable(lb, s, i)
742 size_t lb;
743 char * s;
744 int i;
745# endif
746{
747 GC_PTR result = GC_malloc_uncollectable(lb + UNCOLLECTABLE_DEBUG_BYTES);
748
749 if (result == 0) {
750 GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
751 (unsigned long) lb);
752 GC_err_puts(s);
753 GC_err_printf1(":%ld)\n", (unsigned long)i);
754 return(0);
755 }
756 if (!GC_debugging_started) {
757 GC_start_debugging();
758 }
759 ADD_CALL_CHAIN(result, ra);
760 return (GC_store_debug_info(result, (word)lb, s, (word)i));
761}
762
763#ifdef ATOMIC_UNCOLLECTABLE
764# ifdef __STDC__
765 GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, GC_EXTRA_PARAMS)
766# else
767 GC_PTR GC_debug_malloc_atomic_uncollectable(lb, s, i)
768 size_t lb;
769 char * s;
770 int i;
771# endif
772{
773 GC_PTR result =
774 GC_malloc_atomic_uncollectable(lb + UNCOLLECTABLE_DEBUG_BYTES);
775
776 if (result == 0) {
777 GC_err_printf1(
778 "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
779 (unsigned long) lb);
780 GC_err_puts(s);
781 GC_err_printf1(":%ld)\n", (unsigned long)i);
782 return(0);
783 }
784 if (!GC_debugging_started) {
785 GC_start_debugging();
786 }
787 ADD_CALL_CHAIN(result, ra);
788 return (GC_store_debug_info(result, (word)lb, s, (word)i));
789}
790#endif /* ATOMIC_UNCOLLECTABLE */
791
792# ifdef __STDC__
793 void GC_debug_free(GC_PTR p)
794# else
795 void GC_debug_free(p)
796 GC_PTR p;
797# endif
798{
799 register GC_PTR base;
800 register ptr_t clobbered;
801
802 if (0 == p) return;
803 base = GC_base(p);
804 if (base == 0) {
805 GC_err_printf1("Attempt to free invalid pointer %lx\n",
806 (unsigned long)p);
807 ABORT("free(invalid pointer)");
808 }
809 if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
810 GC_err_printf1(
811 "GC_debug_free called on pointer %lx wo debugging info\n",
812 (unsigned long)p);
813 } else {
814# ifndef SHORT_DBG_HDRS
815 clobbered = GC_check_annotated_obj((oh *)base);
816 if (clobbered != 0) {
817 if (((oh *)base) -> oh_sz == GC_size(base)) {
818 GC_err_printf0(
819 "GC_debug_free: found previously deallocated (?) object at ");
820 } else {
821 GC_err_printf0("GC_debug_free: found smashed location at ");
822 }
823 GC_print_smashed_obj(p, clobbered);
824 }
825 /* Invalidate size */
826 ((oh *)base) -> oh_sz = GC_size(base);
827# endif /* SHORT_DBG_HDRS */
828 }
829 if (GC_find_leak) {
830 GC_free(base);
831 } else {
832 register hdr * hhdr = HDR(p);
833 GC_bool uncollectable = FALSE;
834
835 if (hhdr -> hb_obj_kind == UNCOLLECTABLE) {
836 uncollectable = TRUE;
837 }
838# ifdef ATOMIC_UNCOLLECTABLE
839 if (hhdr -> hb_obj_kind == AUNCOLLECTABLE) {
840 uncollectable = TRUE;
841 }
842# endif
843 if (uncollectable) {
844 GC_free(base);
845 } else {
846 size_t i;
847 size_t obj_sz = hhdr -> hb_sz - BYTES_TO_WORDS(sizeof(oh));
848
849 for (i = 0; i < obj_sz; ++i) ((word *)p)[i] = 0xdeadbeef;
850 GC_ASSERT((word *)p + i == (word *)base + hhdr -> hb_sz);
851 }
852 } /* !GC_find_leak */
853}
854
855#ifdef THREADS
856
857extern void GC_free_inner(GC_PTR p);
858
859/* Used internally; we assume it's called correctly. */
860void GC_debug_free_inner(GC_PTR p)
861{
862 GC_free_inner(GC_base(p));
863}
864#endif
865
866# ifdef __STDC__
867 GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, GC_EXTRA_PARAMS)
868# else
869 GC_PTR GC_debug_realloc(p, lb, s, i)
870 GC_PTR p;
871 size_t lb;
872 char *s;
873 int i;
874# endif
875{
876 register GC_PTR base = GC_base(p);
877 register ptr_t clobbered;
878 register GC_PTR result;
879 register size_t copy_sz = lb;
880 register size_t old_sz;
881 register hdr * hhdr;
882
883 if (p == 0) return(GC_debug_malloc(lb, OPT_RA s, i));
884 if (base == 0) {
885 GC_err_printf1(
886 "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p);
887 ABORT("realloc(invalid pointer)");
888 }
889 if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
890 GC_err_printf1(
891 "GC_debug_realloc called on pointer %lx wo debugging info\n",
892 (unsigned long)p);
893 return(GC_realloc(p, lb));
894 }
895 hhdr = HDR(base);
896 switch (hhdr -> hb_obj_kind) {
897# ifdef STUBBORN_ALLOC
898 case STUBBORN:
899 result = GC_debug_malloc_stubborn(lb, OPT_RA s, i);
900 break;
901# endif
902 case NORMAL:
903 result = GC_debug_malloc(lb, OPT_RA s, i);
904 break;
905 case PTRFREE:
906 result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
907 break;
908 case UNCOLLECTABLE:
909 result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
910 break;
911# ifdef ATOMIC_UNCOLLECTABLE
912 case AUNCOLLECTABLE:
913 result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
914 break;
915# endif
916 default:
917 GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
918 ABORT("bad kind");
919 }
920# ifdef SHORT_DBG_HDRS
921 old_sz = GC_size(base) - sizeof(oh);
922# else
923 clobbered = GC_check_annotated_obj((oh *)base);
924 if (clobbered != 0) {
925 GC_err_printf0("GC_debug_realloc: found smashed location at ");
926 GC_print_smashed_obj(p, clobbered);
927 }
928 old_sz = ((oh *)base) -> oh_sz;
929# endif
930 if (old_sz < copy_sz) copy_sz = old_sz;
931 if (result == 0) return(0);
932 BCOPY(p, result, copy_sz);
933 GC_debug_free(p);
934 return(result);
935}
936
937#ifndef SHORT_DBG_HDRS
938
939/* List of smashed objects. We defer printing these, since we can't */
940/* always print them nicely with the allocation lock held. */
941/* We put them here instead of in GC_arrays, since it may be useful to */
942/* be able to look at them with the debugger. */
943#define MAX_SMASHED 20
944ptr_t GC_smashed[MAX_SMASHED];
945unsigned GC_n_smashed = 0;
946
947# if defined(__STDC__) || defined(__cplusplus)
948 void GC_add_smashed(ptr_t smashed)
949# else
950 void GC_add_smashed(smashed)
951 ptr_t smashed;
952#endif
953{
954 GC_ASSERT(GC_is_marked(GC_base(smashed)));
955 GC_smashed[GC_n_smashed] = smashed;
956 if (GC_n_smashed < MAX_SMASHED - 1) ++GC_n_smashed;
957 /* In case of overflow, we keep the first MAX_SMASHED-1 */
958 /* entries plus the last one. */
959 GC_have_errors = TRUE;
960}
961
962/* Print all objects on the list. Clear the list. */
963void GC_print_all_smashed_proc ()
964{
965 unsigned i;
966
967 GC_ASSERT(!I_HOLD_LOCK());
968 if (GC_n_smashed == 0) return;
969 GC_err_printf0("GC_check_heap_block: found smashed heap objects:\n");
970 for (i = 0; i < GC_n_smashed; ++i) {
971 GC_print_smashed_obj(GC_base(GC_smashed[i]), GC_smashed[i]);
972 GC_smashed[i] = 0;
973 }
974 GC_n_smashed = 0;
975}
976
977/* Check all marked objects in the given block for validity */
978/*ARGSUSED*/
979# if defined(__STDC__) || defined(__cplusplus)
980 void GC_check_heap_block(register struct hblk *hbp, word dummy)
981# else
982 void GC_check_heap_block(hbp, dummy)
983 register struct hblk *hbp; /* ptr to current heap block */
984 word dummy;
985# endif
986{
987 register struct hblkhdr * hhdr = HDR(hbp);
988 register word sz = hhdr -> hb_sz;
989 register int word_no;
990 register word *p, *plim;
991
992 p = (word *)(hbp->hb_body);
993 word_no = 0;
994 if (sz > MAXOBJSZ) {
995 plim = p;
996 } else {
997 plim = (word *)((((word)hbp) + HBLKSIZE) - WORDS_TO_BYTES(sz));
998 }
999 /* go through all words in block */
1000 while( p <= plim ) {
1001 if( mark_bit_from_hdr(hhdr, word_no)
1002 && GC_HAS_DEBUG_INFO((ptr_t)p)) {
1003 ptr_t clobbered = GC_check_annotated_obj((oh *)p);
1004
1005 if (clobbered != 0) GC_add_smashed(clobbered);
1006 }
1007 word_no += sz;
1008 p += sz;
1009 }
1010}
1011
1012
1013/* This assumes that all accessible objects are marked, and that */
1014/* I hold the allocation lock. Normally called by collector. */
1015void GC_check_heap_proc()
1016{
1017# ifndef SMALL_CONFIG
1018# ifdef ALIGN_DOUBLE
1019 GC_STATIC_ASSERT((sizeof(oh) & (2 * sizeof(word) - 1)) == 0);
1020# else
1021 GC_STATIC_ASSERT((sizeof(oh) & (sizeof(word) - 1)) == 0);
1022# endif
1023# endif
1024 GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
1025}
1026
1027#endif /* !SHORT_DBG_HDRS */
1028
1029struct closure {
1030 GC_finalization_proc cl_fn;
1031 GC_PTR cl_data;
1032};
1033
1034# ifdef __STDC__
1035 void * GC_make_closure(GC_finalization_proc fn, void * data)
1036# else
1037 GC_PTR GC_make_closure(fn, data)
1038 GC_finalization_proc fn;
1039 GC_PTR data;
1040# endif
1041{
1042 struct closure * result =
1043# ifdef DBG_HDRS_ALL
1044 (struct closure *) GC_debug_malloc(sizeof (struct closure),
1045 GC_EXTRAS);
1046# else
1047 (struct closure *) GC_malloc(sizeof (struct closure));
1048# endif
1049
1050 result -> cl_fn = fn;
1051 result -> cl_data = data;
1052 return((GC_PTR)result);
1053}
1054
1055# ifdef __STDC__
1056 void GC_debug_invoke_finalizer(void * obj, void * data)
1057# else
1058 void GC_debug_invoke_finalizer(obj, data)
1059 char * obj;
1060 char * data;
1061# endif
1062{
1063 register struct closure * cl = (struct closure *) data;
1064
1065 (*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data);
1066}
1067
1068/* Set ofn and ocd to reflect the values we got back. */
1069static void store_old (obj, my_old_fn, my_old_cd, ofn, ocd)
1070GC_PTR obj;
1071GC_finalization_proc my_old_fn;
1072struct closure * my_old_cd;
1073GC_finalization_proc *ofn;
1074GC_PTR *ocd;
1075{
1076 if (0 != my_old_fn) {
1077 if (my_old_fn != GC_debug_invoke_finalizer) {
1078 GC_err_printf1("Debuggable object at 0x%lx had non-debug finalizer.\n",
1079 obj);
1080 /* This should probably be fatal. */
1081 } else {
1082 if (ofn) *ofn = my_old_cd -> cl_fn;
1083 if (ocd) *ocd = my_old_cd -> cl_data;
1084 }
1085 } else {
1086 if (ofn) *ofn = 0;
1087 if (ocd) *ocd = 0;
1088 }
1089}
1090
1091# ifdef __STDC__
1092 void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn,
1093 GC_PTR cd, GC_finalization_proc *ofn,
1094 GC_PTR *ocd)
1095# else
1096 void GC_debug_register_finalizer(obj, fn, cd, ofn, ocd)
1097 GC_PTR obj;
1098 GC_finalization_proc fn;
1099 GC_PTR cd;
1100 GC_finalization_proc *ofn;
1101 GC_PTR *ocd;
1102# endif
1103{
1104 GC_finalization_proc my_old_fn;
1105 GC_PTR my_old_cd;
1106 ptr_t base = GC_base(obj);
1107 if (0 == base) return;
1108 if ((ptr_t)obj - base != sizeof(oh)) {
1109 GC_err_printf1(
1110 "GC_debug_register_finalizer called with non-base-pointer 0x%lx\n",
1111 obj);
1112 }
1113 if (0 == fn) {
1114 GC_register_finalizer(base, 0, 0, &my_old_fn, &my_old_cd);
1115 } else {
1116 GC_register_finalizer(base, GC_debug_invoke_finalizer,
1117 GC_make_closure(fn,cd), &my_old_fn, &my_old_cd);
1118 }
1119 store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd);
1120}
1121
1122# ifdef __STDC__
1123 void GC_debug_register_finalizer_no_order
1124 (GC_PTR obj, GC_finalization_proc fn,
1125 GC_PTR cd, GC_finalization_proc *ofn,
1126 GC_PTR *ocd)
1127# else
1128 void GC_debug_register_finalizer_no_order
1129 (obj, fn, cd, ofn, ocd)
1130 GC_PTR obj;
1131 GC_finalization_proc fn;
1132 GC_PTR cd;
1133 GC_finalization_proc *ofn;
1134 GC_PTR *ocd;
1135# endif
1136{
1137 GC_finalization_proc my_old_fn;
1138 GC_PTR my_old_cd;
1139 ptr_t base = GC_base(obj);
1140 if (0 == base) return;
1141 if ((ptr_t)obj - base != sizeof(oh)) {
1142 GC_err_printf1(
1143 "GC_debug_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
1144 obj);
1145 }
1146 if (0 == fn) {
1147 GC_register_finalizer_no_order(base, 0, 0, &my_old_fn, &my_old_cd);
1148 } else {
1149 GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer,
1150 GC_make_closure(fn,cd), &my_old_fn,
1151 &my_old_cd);
1152 }
1153 store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd);
1154 }
1155
1156# ifdef __STDC__
1157 void GC_debug_register_finalizer_ignore_self
1158 (GC_PTR obj, GC_finalization_proc fn,
1159 GC_PTR cd, GC_finalization_proc *ofn,
1160 GC_PTR *ocd)
1161# else
1162 void GC_debug_register_finalizer_ignore_self
1163 (obj, fn, cd, ofn, ocd)
1164 GC_PTR obj;
1165 GC_finalization_proc fn;
1166 GC_PTR cd;
1167 GC_finalization_proc *ofn;
1168 GC_PTR *ocd;
1169# endif
1170{
1171 GC_finalization_proc my_old_fn;
1172 GC_PTR my_old_cd;
1173 ptr_t base = GC_base(obj);
1174 if (0 == base) return;
1175 if ((ptr_t)obj - base != sizeof(oh)) {
1176 GC_err_printf1(
1177 "GC_debug_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
1178 obj);
1179 }
1180 if (0 == fn) {
1181 GC_register_finalizer_ignore_self(base, 0, 0, &my_old_fn, &my_old_cd);
1182 } else {
1183 GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer,
1184 GC_make_closure(fn,cd), &my_old_fn,
1185 &my_old_cd);
1186 }
1187 store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd);
1188}
1189
1190#ifdef GC_ADD_CALLER
1191# define RA GC_RETURN_ADDR,
1192#else
1193# define RA
1194#endif
1195
1196GC_PTR GC_debug_malloc_replacement(lb)
1197size_t lb;
1198{
1199 return GC_debug_malloc(lb, RA "unknown", 0);
1200}
1201
1202GC_PTR GC_debug_realloc_replacement(p, lb)
1203GC_PTR p;
1204size_t lb;
1205{
1206 return GC_debug_realloc(p, lb, RA "unknown", 0);
1207}
Note: See TracBrowser for help on using the repository browser.