OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [boehm-gc/] [dbg_mlc.c] - Blame information for rev 721

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 721 jeremybenn
/*
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
 * Copyright (C) 2007 Free Software Foundation, Inc
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
 */
17
 
18
#include "private/dbg_mlc.h"
19
 
20
void GC_default_print_heap_obj_proc();
21
GC_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));
24
 
25
 
26
#ifndef SHORT_DBG_HDRS
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.                                                 */
30
/* This excludes the check as to whether the back pointer is    */
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.                                                    */
36
GC_bool GC_has_other_debug_info(p)
37
ptr_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)
44
        || sz < DEBUG_BYTES + EXTRA_BYTES) {
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
}
57
#endif
58
 
59
#ifdef KEEP_BACK_PTRS
60
 
61
# include <stdlib.h>
62
 
63
# if defined(LINUX) || defined(SUNOS4) || defined(SUNOS5) \
64
     || defined(HPUX) || defined(IRIX5) || defined(OSF1)
65
#   define RANDOM() random()
66
# else
67
#   define RANDOM() (long)rand()
68
# endif
69
 
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
  {
78
    if (GC_HAS_DEBUG_INFO(dest)) {
79
      ((oh *)dest) -> oh_back_ptr = HIDE_BACK_PTR(source);
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.                                                     */
89
  /*   source is root ==> *base_p = address, *offset_p = 0              */
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;
98
    if (!GC_HAS_DEBUG_INFO((ptr_t) hdr)) return GC_NO_SPACE;
99
    bp = REVEAL_POINTER(hdr -> oh_back_ptr);
100
    if (MARKED_FOR_FINALIZATION == bp) return GC_FINALIZER_REFD;
101
    if (MARKED_FROM_REGISTER == bp) return GC_REFD_FROM_REG;
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
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 {
125
      if (GC_HAS_DEBUG_INFO(bp_base)) bp_base += sizeof(oh);
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;
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.                                            */
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
 
174
  /* Print back trace for p */
175
  void GC_print_backtrace(void *p)
176
  {
177
    void *current = p;
178
    int i;
179
    GC_ref_kind source;
180
    size_t offset;
181
    void *base;
182
 
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:
199
          GC_err_printf1("root at 0x%lx\n\n", (unsigned long)base);
200
          goto out;
201
        case GC_REFD_FROM_REG:
202
          GC_err_printf0("root in register\n\n");
203
          goto out;
204
        case GC_FINALIZER_REFD:
205
          GC_err_printf0("list of finalizable objects\n\n");
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
  }
218
 
219
  /* Force a garbage collection and generate a backtrace from a */
220
  /* random heap address.                                       */
221
  void GC_generate_random_backtrace_no_gc(void)
222
  {
223
    void * current;
224
    current = GC_generate_random_valid_address();
225
    GC_printf1("\n****Chose address 0x%lx in object\n", (unsigned long)current);
226
    GC_print_backtrace(current);
227
  }
228
 
229
  void GC_generate_random_backtrace(void)
230
  {
231
    GC_gcollect();
232
    GC_generate_random_backtrace_no_gc();
233
  }
234
 
235
#endif /* KEEP_BACK_PTRS */
236
 
237
# define CROSSES_HBLK(p, sz) \
238
        (((word)(p + sizeof(oh) + sz - 1) ^ (word)p) >= HBLKSIZE)
239
/* Store debugging info into p.  Return displaced pointer. */
240
/* Assumes we don't hold allocation lock.                  */
241
ptr_t GC_store_debug_info(p, sz, string, integer)
242
register ptr_t p;       /* base pointer */
243
word sz;        /* bytes */
244
GC_CONST char * string;
245
word 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();
254
    GC_ASSERT(GC_size(p) >= sizeof(oh) + sz);
255
    GC_ASSERT(!(SMALL_OBJ(sz) && CROSSES_HBLK(p, sz)));
256
#   ifdef KEEP_BACK_PTRS
257
      ((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED);
258
#   endif
259
#   ifdef MAKE_BACK_GRAPH
260
      ((oh *)p) -> oh_bg_ptr = HIDE_BACK_PTR((ptr_t)0);
261
#   endif
262
    ((oh *)p) -> oh_string = string;
263
    ((oh *)p) -> oh_int = integer;
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] =
268
         result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
269
#   endif
270
    UNLOCK();
271
    return((ptr_t)result);
272
}
273
 
274
#ifdef DBG_HDRS_ALL
275
/* Store debugging info into p.  Return displaced pointer.         */
276
/* This version assumes we do hold the allocation lock.            */
277
ptr_t GC_store_debug_info_inner(p, sz, string, integer)
278
register ptr_t p;       /* base pointer */
279
word sz;        /* bytes */
280
char * string;
281
word 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.                         */
288
    GC_ASSERT(GC_size(p) >= sizeof(oh) + sz);
289
    GC_ASSERT(!(SMALL_OBJ(sz) && CROSSES_HBLK(p, sz)));
290
#   ifdef KEEP_BACK_PTRS
291
      ((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED);
292
#   endif
293
#   ifdef MAKE_BACK_GRAPH
294
      ((oh *)p) -> oh_bg_ptr = HIDE_BACK_PTR((ptr_t)0);
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] =
302
         result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
303
#   endif
304
    return((ptr_t)result);
305
}
306
#endif
307
 
308
#ifndef SHORT_DBG_HDRS
309
/* Check the object with debugging info at ohdr         */
310
/* return NIL if it's OK.  Else return clobbered        */
311
/* address.                                             */
312
ptr_t GC_check_annotated_obj(ohdr)
313
register 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
    }
326
    if (((word *)body)[SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)]
327
        != (END_FLAG ^ (word)body)) {
328
        return((ptr_t)((word *)body + SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)));
329
    }
330
    return(0);
331
}
332
#endif /* !SHORT_DBG_HDRS */
333
 
334
static GC_describe_type_fn GC_describe_type_fns[MAXOBJKINDS] = {0};
335
 
336
void GC_register_describe_type_fn(kind, fn)
337
int kind;
338
GC_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.                                                                */
345
void GC_print_type(p)
346
ptr_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
 
386
void GC_print_obj(p)
387
ptr_t p;
388
{
389
    register oh * ohdr = (oh *)GC_base(p);
390
 
391
    GC_ASSERT(!I_HOLD_LOCK());
392
    GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh)));
393
    GC_err_puts(ohdr -> oh_string);
394
#   ifdef SHORT_DBG_HDRS
395
      GC_err_printf1(":%ld, ", (unsigned long)(ohdr -> oh_int));
396
#   else
397
      GC_err_printf2(":%ld, sz=%ld, ", (unsigned long)(ohdr -> oh_int),
398
                                        (unsigned long)(ohdr -> oh_sz));
399
#   endif
400
    GC_print_type((ptr_t)(ohdr + 1));
401
    GC_err_puts(")\n");
402
    PRINT_CALL_CHAIN(ohdr);
403
}
404
 
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
411
{
412
    GC_ASSERT(!I_HOLD_LOCK());
413
    if (GC_HAS_DEBUG_INFO(p)) {
414
        GC_print_obj(p);
415
    } else {
416
        GC_default_print_heap_obj_proc(p);
417
    }
418
}
419
 
420
#ifndef SHORT_DBG_HDRS
421
void GC_print_smashed_obj(p, clobbered_addr)
422
ptr_t p, clobbered_addr;
423
{
424
    register oh * ohdr = (oh *)GC_base(p);
425
 
426
    GC_ASSERT(!I_HOLD_LOCK());
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",
432
                       (GC_size((ptr_t)ohdr) - DEBUG_BYTES));
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
}
444
#endif
445
 
446
void GC_check_heap_proc GC_PROTO((void));
447
 
448
void GC_print_all_smashed_proc GC_PROTO((void));
449
 
450
void GC_do_nothing() {}
451
 
452
void GC_start_debugging()
453
{
454
#   ifndef SHORT_DBG_HDRS
455
      GC_check_heap = GC_check_heap_proc;
456
      GC_print_all_smashed = GC_print_all_smashed_proc;
457
#   else
458
      GC_check_heap = GC_do_nothing;
459
      GC_print_all_smashed = GC_do_nothing;
460
#   endif
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
 
466
size_t GC_debug_header_size = sizeof(oh);
467
 
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
 
479
# ifdef __STDC__
480
    GC_PTR GC_debug_malloc(size_t lb, GC_EXTRA_PARAMS)
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
 
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
 
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
    }
581
    ADD_CALL_CHAIN(result, GC_RETURN_ADDR);
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
    }
595
    ADD_CALL_CHAIN(result, GC_RETURN_ADDR);
596
    return (GC_store_debug_info_inner(result, (word)lb, "INTERNAL", (word)0));
597
  }
598
# endif
599
 
600
#ifdef STUBBORN_ALLOC
601
# ifdef __STDC__
602
    GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
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
 
626
void GC_debug_change_stubborn(p)
627
GC_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
 
646
void GC_debug_end_stubborn_change(p)
647
GC_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
 
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
 
680
void GC_debug_change_stubborn(p)
681
GC_PTR p;
682
{
683
}
684
 
685
void GC_debug_end_stubborn_change(p)
686
GC_PTR p;
687
{
688
}
689
 
690
#endif /* !STUBBORN_ALLOC */
691
 
692
# ifdef __STDC__
693
    GC_PTR GC_debug_malloc_atomic(size_t lb, GC_EXTRA_PARAMS)
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__
718
    GC_PTR GC_debug_malloc_uncollectable(size_t lb, GC_EXTRA_PARAMS)
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
{
726
    GC_PTR result = GC_malloc_uncollectable(lb + UNCOLLECTABLE_DEBUG_BYTES);
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__
744
    GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, GC_EXTRA_PARAMS)
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
{
752
    GC_PTR result =
753
        GC_malloc_atomic_uncollectable(lb + UNCOLLECTABLE_DEBUG_BYTES);
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
{
778
    register GC_PTR base;
779
    register ptr_t clobbered;
780
 
781
    if (0 == p) return;
782
    base = GC_base(p);
783
    if (base == 0) {
784
        GC_err_printf1("Attempt to free invalid pointer %lx\n",
785
                       (unsigned long)p);
786
        ABORT("free(invalid pointer)");
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 {
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)) {
797
            GC_err_printf0(
798
                  "GC_debug_free: found previously deallocated (?) object at ");
799
          } else {
800
            GC_err_printf0("GC_debug_free: found smashed location at ");
801
          }
802
          GC_print_smashed_obj(p, clobbered);
803
        }
804
        /* Invalidate size */
805
        ((oh *)base) -> oh_sz = GC_size(base);
806
#     endif /* SHORT_DBG_HDRS */
807
    }
808
    if (GC_find_leak) {
809
        GC_free(base);
810
    } else {
811
        register hdr * hhdr = HDR(p);
812
        GC_bool uncollectable = FALSE;
813
 
814
        if (hhdr ->  hb_obj_kind == UNCOLLECTABLE) {
815
            uncollectable = TRUE;
816
        }
817
#       ifdef ATOMIC_UNCOLLECTABLE
818
            if (hhdr ->  hb_obj_kind == AUNCOLLECTABLE) {
819
                    uncollectable = TRUE;
820
            }
821
#       endif
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
        }
831
    } /* !GC_find_leak */
832
}
833
 
834
#ifdef THREADS
835
 
836
extern void GC_free_inner(GC_PTR p);
837
 
838
/* Used internally; we assume it's called correctly.    */
839
void GC_debug_free_inner(GC_PTR p)
840
{
841
    GC_free_inner(GC_base(p));
842
}
843
#endif
844
 
845
# ifdef __STDC__
846
    GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, GC_EXTRA_PARAMS)
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
    }
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) {
904
        GC_err_printf0("GC_debug_realloc: found smashed location at ");
905
        GC_print_smashed_obj(p, clobbered);
906
      }
907
      old_sz = ((oh *)base) -> oh_sz;
908
#   endif
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
 
916
#ifndef SHORT_DBG_HDRS
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
923
ptr_t GC_smashed[MAX_SMASHED];
924
unsigned 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.      */
942
void 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
 
956
/* Check all marked objects in the given block for validity */
957
/*ARGSUSED*/
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
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);
972
    word_no = 0;
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)
981
                && GC_HAS_DEBUG_INFO((ptr_t)p)) {
982
                ptr_t clobbered = GC_check_annotated_obj((oh *)p);
983
 
984
                if (clobbered != 0) GC_add_smashed(clobbered);
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.           */
994
void GC_check_heap_proc()
995
{
996
#   ifndef SMALL_CONFIG
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
1002
#   endif
1003
    GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
1004
}
1005
 
1006
#endif /* !SHORT_DBG_HDRS */
1007
 
1008
struct 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 =
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
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
 
1047
/* Set ofn and ocd to reflect the values we got back.   */
1048
static void store_old (obj, my_old_fn, my_old_cd, ofn, ocd)
1049
GC_PTR obj;
1050
GC_finalization_proc my_old_fn;
1051
struct closure * my_old_cd;
1052
GC_finalization_proc *ofn;
1053
GC_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
}
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
{
1083
    GC_finalization_proc my_old_fn;
1084
    GC_PTR my_old_cd;
1085
    ptr_t base = GC_base(obj);
1086
    if (0 == base) return;
1087
    if ((ptr_t)obj - base != sizeof(oh)) {
1088
        GC_err_printf1(
1089
            "GC_debug_register_finalizer called with non-base-pointer 0x%lx\n",
1090
            obj);
1091
    }
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);
1099
}
1100
 
1101
# ifdef __STDC__
1102
    void GC_debug_register_finalizer_no_order
1103
                                    (GC_PTR obj, GC_finalization_proc fn,
1104
                                     GC_PTR cd, GC_finalization_proc *ofn,
1105
                                     GC_PTR *ocd)
1106
# else
1107
    void GC_debug_register_finalizer_no_order
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
{
1116
    GC_finalization_proc my_old_fn;
1117
    GC_PTR my_old_cd;
1118
    ptr_t base = GC_base(obj);
1119
    if (0 == base) return;
1120
    if ((ptr_t)obj - base != sizeof(oh)) {
1121
        GC_err_printf1(
1122
            "GC_debug_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
1123
            obj);
1124
    }
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);
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
}
1168
 
1169
# ifdef __STDC__
1170
    void GC_debug_register_finalizer_ignore_self
1171
                                    (GC_PTR obj, GC_finalization_proc fn,
1172
                                     GC_PTR cd, GC_finalization_proc *ofn,
1173
                                     GC_PTR *ocd)
1174
# else
1175
    void GC_debug_register_finalizer_ignore_self
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
{
1184
    GC_finalization_proc my_old_fn;
1185
    GC_PTR my_old_cd;
1186
    ptr_t base = GC_base(obj);
1187
    if (0 == base) return;
1188
    if ((ptr_t)obj - base != sizeof(oh)) {
1189
        GC_err_printf1(
1190
            "GC_debug_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
1191
            obj);
1192
    }
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);
1201
}
1202
 
1203
#ifdef GC_ADD_CALLER
1204
# define RA GC_RETURN_ADDR,
1205
#else
1206
# define RA
1207
#endif
1208
 
1209
GC_PTR GC_debug_malloc_replacement(lb)
1210
size_t lb;
1211
{
1212
    return GC_debug_malloc(lb, RA "unknown", 0);
1213
}
1214
 
1215
GC_PTR GC_debug_realloc_replacement(p, lb)
1216
GC_PTR p;
1217
size_t lb;
1218
{
1219
    return GC_debug_realloc(p, lb, RA "unknown", 0);
1220
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.