/* onto the mark stack. Return 0 if the mark stack overflowed. */
STATIC mse * GC_push_complex_descriptor(word *addr, complex_descriptor *d,
mse *msp, mse *msl)
{
ptr_t current = (ptr_t)addr;
word nelements;
word sz;
word i;
switch(d -> TAG) {
case LEAF_TAG:
{
GC_descr descr = d -> ld.ld_descriptor;
nelements = d -> ld.ld_nelements;
if (msl - msp <= (ptrdiff_t)nelements) return(0);
sz = d -> ld.ld_size;
for (i = 0; i < nelements; i++) {
msp++;
msp -> mse_start = current;
msp -> mse_descr.w = descr;
current += sz;
}
return(msp);
}
case ARRAY_TAG:
{
complex_descriptor *descr = d -> ad.ad_element_descr;
nelements = d -> ad.ad_nelements;
sz = GC_descr_obj_size(descr);
for (i = 0; i < nelements; i++) {
msp = GC_push_complex_descriptor((word *)current, descr,
msp, msl);
if (msp == 0) return(0);
current += sz;
}
return(msp);
}
case SEQUENCE_TAG:
{
sz = GC_descr_obj_size(d -> sd.sd_first);
msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_first,
msp, msl);
if (msp == 0) return(0);
current += sz;
msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_second,
msp, msl);
return(msp);
}
default:
ABORT_RET("Bad complex descriptor");
return 0;
}
}
/* GC_push_complex_descriptor, but hopefully it doesn't matter. */
STATIC word GC_descr_obj_size(complex_descriptor *d)
{
switch(d -> TAG) {
case LEAF_TAG:
return(d -> ld.ld_nelements * d -> ld.ld_size);
case ARRAY_TAG:
return(d -> ad.ad_nelements
* GC_descr_obj_size(d -> ad.ad_element_descr));
case SEQUENCE_TAG:
return(GC_descr_obj_size(d -> sd.sd_first)
+ GC_descr_obj_size(d -> sd.sd_second));
default:
ABORT_RET("Bad complex descriptor");
return 0;
}
}
GC_API void * GC_CALL GC_debug_realloc(void * p, size_t lb, GC_EXTRA_PARAMS)
{
void * base;
void * result;
hdr * hhdr;
if (p == 0) {
return GC_debug_malloc(lb, OPT_RA s, i);
}
if (0 == lb) /* and p != NULL */ {
GC_debug_free(p);
return NULL;
}
# ifdef GC_ADD_CALLER
if (s == NULL) {
GC_caller_func_offset(ra, &s, &i);
}
# endif
base = GC_base(p);
if (base == 0) {
ABORT_ARG1("Invalid pointer passed to realloc()", ": %p", p);
}
if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
GC_err_printf(
"GC_debug_realloc called on pointer %p w/o debugging info\n", p);
return(GC_realloc(p, lb));
}
hhdr = HDR(base);
switch (hhdr -> hb_obj_kind) {
case NORMAL:
result = GC_debug_malloc(lb, OPT_RA s, i);
break;
case PTRFREE:
result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
break;
case UNCOLLECTABLE:
result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
break;
# ifdef GC_ATOMIC_UNCOLLECTABLE
case AUNCOLLECTABLE:
result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
break;
# endif
default:
result = NULL; /* initialized to prevent warning. */
ABORT_RET("GC_debug_realloc: encountered bad kind");
}
if (result != NULL) {
size_t old_sz;
# ifdef SHORT_DBG_HDRS
old_sz = GC_size(base) - sizeof(oh);
# else
old_sz = ((oh *)base) -> oh_sz;
# endif
if (old_sz > 0)
BCOPY(p, result, old_sz < lb ? old_sz : lb);
GC_debug_free(p);
}
return(result);
}
