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