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