/**
* Given some kind of Scheme string value, convert it to a C string
* If scmval is not a string value, returns NULL.
*/
static char *
scheme_object_to_string (Scheme_Object *scmval)
{
char *str = NULL;
// Char strings are the normal Scheme strings. They need to be
// converted to byte strings.
if (SCHEME_CHAR_STRINGP (scmval))
{
scmval = scheme_char_string_to_byte_string_locale (scmval);
str = SCHEME_BYTE_STR_VAL (scmval);
} // if it's a char string
// Byte strings are easy, but not the typical Scheme strings.
else if (SCHEME_BYTE_STRINGP (scmval))
{
str = SCHEME_BYTE_STR_VAL (scmval);
} // if it's a byte string
// A design decision: We'll treat symbols as strings. (It certainly
// makes things easier for the client.)
else if (SCHEME_SYMBOLP (scmval))
{
str = SCHEME_SYM_VAL (scmval);
} // if it's a symbol
// Everything else is not a string
else
{
// Signal an error by setting the return value to NULL.
str = NULL;
} // if it's not a string
return str;
} // scheme_object_to_string
static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
Place_Start_Data *place_data;
Scheme_Object *place_main;
Scheme_Object *a[2], *channel;
mzrt_thread_id ptid;
intptr_t rc = 0;
ptid = mz_proc_thread_self();
place_data = (Place_Start_Data *) data_arg;
data_arg = NULL;
/* printf("Startin place: proc thread id%u\n", ptid); */
/* create pristine THREAD_LOCAL variables*/
null_out_runtime_globals();
/* scheme_make_thread behaves differently if the above global vars are not null */
scheme_place_instance_init(stack_base);
a[0] = scheme_places_deep_copy(place_data->current_library_collection_paths);
scheme_current_library_collection_paths(1, a);
a[0] = scheme_places_deep_copy(place_data->module);
a[1] = scheme_places_deep_copy(place_data->function);
a[1] = scheme_intern_exact_symbol(SCHEME_SYM_VAL(a[1]), SCHEME_SYM_LEN(a[1]));
if (!SAME_TYPE(SCHEME_TYPE(place_data->channel), scheme_place_bi_channel_type)) {
channel = scheme_places_deep_copy(place_data->channel);
}
else {
channel = place_data->channel;
}
mzrt_sema_post(place_data->ready);
place_data = NULL;
# ifdef MZ_PRECISE_GC
/* this prevents a master collection attempt from deadlocking with the
place_data->ready semaphore above */
GC_allow_master_gc_check();
# endif
/* at point point, don't refer to place_data or its content
anymore, because it's allocated in the other place */
scheme_set_root_param(MZCONFIG_EXIT_HANDLER, scheme_def_place_exit_proc);
{
Scheme_Thread * volatile p;
mz_jmp_buf * volatile saved_error_buf;
mz_jmp_buf new_error_buf;
p = scheme_get_current_thread();
saved_error_buf = p->error_buf;
p->error_buf = &new_error_buf;
if (!scheme_setjmp(new_error_buf)) {
Scheme_Object *dynamic_require;
dynamic_require = scheme_builtin_value("dynamic-require");
place_main = scheme_apply(dynamic_require, 2, a);
a[0] = channel;
scheme_apply(place_main, 1, a);
}
else {
rc = 1;
}
p->error_buf = saved_error_buf;
}
/*printf("Leavin place: proc thread id%u\n", ptid);*/
scheme_place_instance_destroy();
return (void*) rc;
}
void scheme_print_tagged_value(const char *prefix,
void *v, int xtagged, unsigned long diff, int max_w,
const char *suffix)
{
char *type, *sep, diffstr[30];
long len;
sep = "";
scheme_check_print_is_obj = check_home;
if (!xtagged) {
type = scheme_write_to_string_w_max((Scheme_Object *)v, &len, max_w);
if (!scheme_strncmp(type, "#<thread", 8)) {
char buffer[256];
char *run, *sus, *kill, *clean, *deq, *all, *t2;
int state = ((Scheme_Thread *)v)->running, len2;
run = (state & MZTHREAD_RUNNING) ? "+run" : "";
sus = (state & MZTHREAD_SUSPENDED) ? "+suspended" : "";
kill = (state & MZTHREAD_KILLED) ? "+killed" : "";
clean = (state & MZTHREAD_NEED_KILL_CLEANUP) ? "+cleanup" : "";
deq = (((Scheme_Thread *)v)->next || ((Scheme_Thread *)v)->prev) ? "" : "+deq";
all = !state ? "defunct" : "";
sprintf(buffer, "[%d=%s%s%s%s%s%s]",
state, run, sus, kill, clean, all, deq);
len2 = strlen(buffer);
t2 = (char *)scheme_malloc_atomic(len + len2 + 1);
memcpy(t2, type, len);
memcpy(t2 + len, buffer, len2 + 1);
len += len2;
type = t2;
} else if (!scheme_strncmp(type, "#<namespace", 11)) {
char buffer[256];
char *t2;
int len2;
sprintf(buffer, "[%ld:%.100s]",
((Scheme_Env *)v)->phase,
(((Scheme_Env *)v)->module
? SCHEME_SYM_VAL(((Scheme_Env *)v)->module->modname)
: "(toplevel)"));
len2 = strlen(buffer);
t2 = (char *)scheme_malloc_atomic(len + len2 + 1);
memcpy(t2, type, len);
memcpy(t2 + len, buffer, len2 + 1);
len += len2;
type = t2;
} else if (!scheme_strncmp(type, "#<global-variable-code", 22)) {
Scheme_Bucket *b = (Scheme_Bucket *)v;
Scheme_Object *bsym = (Scheme_Object *)b->key;
char *t2;
int len2;
len2 = SCHEME_SYM_LEN(bsym);
t2 = scheme_malloc_atomic(len + len2 + 3);
memcpy(t2, type, len);
memcpy(t2 + len + 1, SCHEME_SYM_VAL(bsym), len2);
t2[len] = '[';
t2[len + 1 + len2] = ']';
t2[len + 1 + len2 + 1] = 0;
len += len2;
type = t2;
} else if (!scheme_strncmp(type, "#<hash-table>", 13)
|| !scheme_strncmp(type, "#<hash-table:", 13)) {
char buffer[256];
char *t2;
int len2;
int htype, size, count;
if (SCHEME_HASHTP((Scheme_Object *)v)) {
htype = 'n';
size = ((Scheme_Hash_Table *)v)->size;
count = ((Scheme_Hash_Table *)v)->count;
} else {
htype = 'b';
size = ((Scheme_Bucket_Table *)v)->size;
count = ((Scheme_Bucket_Table *)v)->count;
}
sprintf(buffer, "[%c:%d:%d]", htype, count, size);
len2 = strlen(buffer);
t2 = scheme_malloc_atomic(len + len2 + 1);
memcpy(t2, type, len);
memcpy(t2 + len, buffer, len2 + 1);
len += len2;
type = t2;
} else if (!scheme_strncmp(type, "#<syntax", 8)) {
char *t2, *t3;
long len2, len3;
t2 = scheme_write_to_string_w_max(SCHEME_STX_VAL(v), &len2, 32);
len3 = len + len2 + 2;
t3 = (char *)scheme_malloc_atomic(len3);
memcpy(t3, type, len);
t3[len] = '=';
memcpy(t3 + len + 1, t2, len2);
t3[len + len2 + 1] = 0;
type = t3;
len = len3;
}
sep = "=";
} else if (scheme_external_dump_type) {
type = scheme_external_dump_type(v);
if (*type)
sep = ":";
} else
type = "";
if (diff)
sprintf(diffstr, "%lx", diff);
object_console_printf(stderr,
"%s%p%s%s%s%s%s",
prefix,
v,
sep,
type,
diff ? "+" : "",
diff ? diffstr : "",
suffix);
scheme_check_print_is_obj = NULL;
}
Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht)
{
Scheme_Object *new_so = so;
if (SCHEME_INTP(so)) {
return so;
}
if (ht) {
Scheme_Object *r;
if ((r = scheme_hash_get(ht, so))) {
return r;
}
}
switch (so->type) {
case scheme_true_type:
case scheme_false_type:
case scheme_null_type:
case scheme_void_type:
/* place_bi_channels are allocated in the master and can be passed along as is */
case scheme_place_bi_channel_type:
new_so = so;
break;
case scheme_place_type:
new_so = ((Scheme_Place *) so)->channel;
break;
case scheme_char_type:
new_so = scheme_make_char(SCHEME_CHAR_VAL(so));
break;
case scheme_rational_type:
{
Scheme_Object *n;
Scheme_Object *d;
n = scheme_rational_numerator(so);
d = scheme_rational_denominator(so);
n = scheme_places_deep_copy_worker(n, ht);
d = scheme_places_deep_copy_worker(d, ht);
new_so = scheme_make_rational(n, d);
}
break;
case scheme_float_type:
new_so = scheme_make_float(SCHEME_FLT_VAL(so));
break;
case scheme_double_type:
new_so = scheme_make_double(SCHEME_DBL_VAL(so));
break;
case scheme_complex_type:
{
Scheme_Object *r;
Scheme_Object *i;
r = scheme_complex_real_part(so);
i = scheme_complex_imaginary_part(so);
r = scheme_places_deep_copy_worker(r, ht);
i = scheme_places_deep_copy_worker(i, ht);
new_so = scheme_make_complex(r, i);
}
break;
case scheme_char_string_type:
new_so = scheme_make_sized_offset_char_string(SCHEME_CHAR_STR_VAL(so), 0, SCHEME_CHAR_STRLEN_VAL(so), 1);
break;
case scheme_byte_string_type:
if (SHARED_ALLOCATEDP(so)) {
new_so = so;
}
else {
new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
}
break;
case scheme_unix_path_type:
new_so = scheme_make_sized_offset_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
break;
case scheme_symbol_type:
if (SCHEME_SYM_UNINTERNEDP(so)) {
scheme_log_abort("cannot copy uninterned symbol");
abort();
} else {
new_so = scheme_make_sized_offset_byte_string(SCHEME_SYM_VAL(so), 0, SCHEME_SYM_LEN(so), 1);
new_so->type = scheme_serialized_symbol_type;
}
break;
case scheme_serialized_symbol_type:
new_so = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so));
break;
case scheme_pair_type:
{
Scheme_Object *car;
Scheme_Object *cdr;
Scheme_Object *pair;
car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht);
cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht);
pair = scheme_make_pair(car, cdr);
new_so = pair;
}
break;
case scheme_vector_type:
{
Scheme_Object *vec;
intptr_t i;
intptr_t size = SCHEME_VEC_SIZE(so);
vec = scheme_make_vector(size, 0);
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker(SCHEME_VEC_ELS(so)[i], ht);
SCHEME_VEC_ELS(vec)[i] = tmp;
}
SCHEME_SET_IMMUTABLE(vec);
new_so = vec;
}
break;
case scheme_fxvector_type:
if (SHARED_ALLOCATEDP(so)) {
new_so = so;
}
else {
Scheme_Vector *vec;
intptr_t i;
intptr_t size = SCHEME_FXVEC_SIZE(so);
vec = scheme_alloc_fxvector(size);
for (i = 0; i < size; i++) {
SCHEME_FXVEC_ELS(vec)[i] = SCHEME_FXVEC_ELS(so)[i];
}
new_so = (Scheme_Object *) vec;
}
break;
case scheme_flvector_type:
if (SHARED_ALLOCATEDP(so)) {
new_so = so;
}
else {
Scheme_Double_Vector *vec;
intptr_t i;
intptr_t size = SCHEME_FLVEC_SIZE(so);
vec = scheme_alloc_flvector(size);
for (i = 0; i < size; i++) {
SCHEME_FLVEC_ELS(vec)[i] = SCHEME_FLVEC_ELS(so)[i];
}
new_so = (Scheme_Object *) vec;
}
break;
case scheme_structure_type:
{
Scheme_Structure *st = (Scheme_Structure*)so;
Scheme_Serialized_Structure *nst;
Scheme_Struct_Type *stype = st->stype;
Scheme_Struct_Type *ptype = stype->parent_types[stype->name_pos - 1];
Scheme_Object *nprefab_key;
intptr_t size = stype->num_slots;
int local_slots = stype->num_slots - (ptype ? ptype->num_slots : 0);
int i = 0;
if (!stype->prefab_key) {
scheme_log_abort("cannot copy non prefab structure");
abort();
}
{
for (i = 0; i < local_slots; i++) {
if (!stype->immutables || stype->immutables[i] != 1) {
scheme_log_abort("cannot copy mutable prefab structure");
abort();
}
}
}
nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht);
nst = (Scheme_Serialized_Structure*) scheme_make_serialized_struct_instance(nprefab_key, size);
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
nst->slots[i] = tmp;
}
new_so = (Scheme_Object*) nst;
}
break;
case scheme_serialized_structure_type:
{
Scheme_Serialized_Structure *st = (Scheme_Serialized_Structure*)so;
Scheme_Struct_Type *stype;
Scheme_Structure *nst;
intptr_t size;
int i = 0;
size = st->num_slots;
stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size);
nst = (Scheme_Structure*) scheme_make_blank_prefab_struct_instance(stype);
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
nst->slots[i] = tmp;
}
new_so = (Scheme_Object*)nst;
}
break;
case scheme_resolved_module_path_type:
default:
printf("places deep copy cannot copy object of type %hi at %p\n", so->type, so);
scheme_log_abort("places deep copy cannot copy object");
abort();
break;
}
if (ht) {
scheme_hash_set(ht, so, new_so);
}
return new_so;
}
Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[])
{
Scheme_Object *result = scheme_void;
#ifdef USE_TAGGED_ALLOCATION
void *initial_trace_root = NULL;
int (*inital_root_skip)(void *, size_t) = NULL;
#endif
scheme_start_atomic();
scheme_console_printf("Begin Dump\n");
if (scheme_external_dump_arg)
scheme_external_dump_arg(c ? p[0] : NULL);
#ifdef USE_TAGGED_ALLOCATION
trace_path_type = -1;
obj_type = -1;
if (c && SCHEME_SYMBOLP(p[0])) {
Scheme_Object *sym;
char *s;
int i, maxpos, just_objects;
sym = p[0];
s = scheme_symbol_val(sym);
maxpos = scheme_num_types();
if (maxpos > NUM_TYPE_SLOTS-1)
maxpos = NUM_TYPE_SLOTS-1;
just_objects = ((c > 1)
&& SCHEME_SYMBOLP(p[1])
&& !strcmp(SCHEME_SYM_VAL(p[1]), "objects"));
for (i = 0; i < maxpos; i++) {
void *tn = scheme_get_type_name(i);
if (tn && !strcmp(tn, s)) {
if (just_objects)
obj_type = i;
else
trace_path_type = i;
break;
}
}
if (SAME_OBJ(p[0], scheme_intern_symbol("stack"))) {
trace_path_type = -2;
}
if ((c > 2)
&& SCHEME_SYMBOLP(p[1])
&& !strcmp(SCHEME_SYM_VAL(p[1]), "from")) {
initial_trace_root = p[2];
if (SCHEME_THREADP(p[2])) {
local_thread = p[2];
local_thread_size = 0;
inital_root_skip = skip_foreign_thread;
}
}
}
{
int i;
int stack_c, roots_c, uncollectable_c, final_c;
long total_count = 0, total_size = 0;
long total_actual_count = 0, total_actual_size = 0;
long traced;
int no_walk = 0;
no_walk = 1 /* (!c || !SAME_OBJ(p[0], scheme_true)) */;
for (i = 0; i < NUM_TYPE_SLOTS; i++) {
scheme_memory_count[i] = scheme_memory_size[i] = 0;
scheme_memory_actual_size[i] = scheme_memory_actual_count[i] = 0;
scheme_memory_hi[i] = scheme_memory_lo[i] = 0;
}
scheme_envunbox_count = scheme_envunbox_size = 0;
bad_seeds = 0;
for (i = 0; i <= NUM_RECORDED_APP_SIZES; i++) {
app_sizes[i] = 0;
}
{
int j, k;
for (i = 0; i < NUM_RECORDED_APP_SIZES; i++) {
for (j = 0; j <= i; j++) {
for (k = 0; k <= 4; k++) {
app_arg_kinds[i][j][k] = 0;
}
}
}
}
traced = GC_trace_count(&stack_c, &roots_c, &uncollectable_c, &final_c);
GC_dump();
scheme_console_printf("\ntraced: %ld\n", traced);
tagged = tagged_while_counting;
if (!no_walk)
smc_ht = scheme_make_hash_table(SCHEME_hash_ptr);
if (tagged)
GC_for_each_element(real_tagged, count_tagged, NULL);
if (tagged_eternal)
GC_for_each_element(tagged_eternal, count_tagged, NULL);
if (tagged_uncollectable)
GC_for_each_element(tagged_uncollectable, count_tagged, NULL);
if (tagged_atomic)
GC_for_each_element(tagged_atomic, count_tagged, NULL);
if (envunbox)
GC_for_each_element(envunbox, count_envunbox, NULL);
tagged = real_tagged;
scheme_console_printf("Begin MzScheme\n");
scheme_console_printf("%30.30s %10s %10s %10s %8s - %8s\n",
"TYPE", "COUNT", "ESTM-SIZE", "TRACE-SIZE",
"LO-LOC", "HI-LOC");
for (i = 0; i < NUM_TYPE_SLOTS; i++) {
if (scheme_memory_count[i] || scheme_memory_actual_count[i]) {
scheme_console_printf("%30.30s %10ld %10ld %10ld %8lx - %8lx\n",
(i < NUM_TYPE_SLOTS-1)
? scheme_get_type_name(i)
: "other",
scheme_memory_actual_count[i],
scheme_memory_size[i],
scheme_memory_actual_size[i],
scheme_memory_lo[i],
scheme_memory_hi[i]);
if (scheme_memory_actual_count[i] != scheme_memory_count[i]) {
scheme_console_printf("%30.30s reach count: %10ld\n",
"", scheme_memory_count[i]);
}
total_count += scheme_memory_count[i];
total_size += scheme_memory_size[i];
total_actual_count += scheme_memory_actual_count[i];
total_actual_size += scheme_memory_actual_size[i];
}
}
scheme_console_printf("%30.30s %10ld %10ld -\n",
"envunbox", scheme_envunbox_count, scheme_envunbox_size);
total_count += scheme_envunbox_count;
total_size += scheme_envunbox_size;
scheme_console_printf("%30.30s - %10ld -\n",
"miscellaneous",
scheme_misc_count + scheme_type_table_count);
total_size += scheme_misc_count + scheme_type_table_count;
scheme_console_printf("%30.30s - - %10ld\n",
"roots", roots_c);
total_actual_size += roots_c;
scheme_console_printf("%30.30s - - %10ld\n",
"stack", stack_c);
total_actual_size += stack_c;
scheme_console_printf("%30.30s - - %10ld\n",
"unreached-uncollectable", uncollectable_c);
total_actual_size += uncollectable_c;
scheme_console_printf("%30.30s - - %10ld\n",
"finalization", final_c);
total_actual_size += final_c;
scheme_console_printf("%30.30s %10ld %10ld %10ld\n",
"total", total_count, total_size,
total_actual_size);
scheme_console_printf("End MzScheme\n");
scheme_console_printf("Begin Apps\n");
for (i = 0; i < NUM_RECORDED_APP_SIZES; i++) {
int j, k;
scheme_console_printf(" %d%s: %d", i,
(i == NUM_RECORDED_APP_SIZES ? "+" : ""),
app_sizes[i]);
for (j = 0; j <= i; j++) {
scheme_console_printf(" (");
for (k = 0; k <= 4; k++) {
if (k)
scheme_console_printf(",");
scheme_console_printf("%d", app_arg_kinds[i][j][k]);
}
scheme_console_printf(")");
}
scheme_console_printf("\n");
}
scheme_console_printf("End Apps\n");
{
Scheme_Custodian *m = (Scheme_Custodian *)scheme_get_param(scheme_current_config(), MZCONFIG_CUSTODIAN);
int c = 0, a = 0, u = 0, t = 0, ipt = 0, opt = 0, th = 0;
while (*m->parent)
m = *m->parent;
count_managed(m, &c, &a, &u, &t, &ipt, &opt, &th);
scheme_console_printf("custodians: %d managed: actual: %d breadth: %d room: %d\n"
" input-ports: %d output-ports: %d threads: %d\n"
"stacks: %d\n",
t, u, c, a, ipt, opt, th,
scheme_num_copied_stacks);
}
if (bad_seeds)
scheme_console_printf("ERROR: %ld illegal tags found\n", bad_seeds);
smc_ht = NULL;
}
#else
# if MZ_PRECISE_GC_TRACE
GC_trace_for_tag = -1;
if (c && SCHEME_SYMBOLP(p[0])) {
Scheme_Object *sym;
char *s;
int i, maxpos;
sym = p[0];
s = scheme_symbol_val(sym);
maxpos = scheme_num_types();
for (i = 0; i < maxpos; i++) {
void *tn;
tn = scheme_get_type_name(i);
if (tn && !strcmp(tn, s)) {
GC_trace_for_tag = i;
break;
}
}
} else if (SCHEME_INTP(p[0])) {
GC_trace_for_tag = SCHEME_INT_VAL(p[0]);
}
if ((c > 1) && SCHEME_INTP(p[1]))
GC_path_length_limit = SCHEME_INT_VAL(p[1]);
else
GC_path_length_limit = 1000;
#endif
GC_dump();
#endif
if (scheme_external_dump_info)
scheme_external_dump_info();
#ifdef USE_TAGGED_ALLOCATION
{
void **ps = NULL;
int l;
int max_w;
Scheme_Object *w;
GC_inital_root_skip = inital_root_skip;
GC_initial_trace_root = initial_trace_root;
GC_trace_path();
GC_inital_root_skip = NULL;
GC_initial_trace_root = NULL;
w = scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_WIDTH);
if (SCHEME_INTP(w))
max_w = SCHEME_INT_VAL(w);
else
max_w = 10000;
scheme_console_printf("Begin Paths\n");
while ((ps = GC_get_next_path(ps, &l))) {
int i, j;
if (l)
scheme_console_printf("$%s", ps[0]);
for (i = 1, j = 2; i < l; i++, j += 2) {
void *v = ps[j];
unsigned long diff = (unsigned long)ps[j + 1];
struct GC_Set *home;
home = GC_set(v);
if (home
&& ((home == real_tagged)
|| (home == tagged_atomic)
|| (home == tagged_uncollectable)
|| (home == tagged_eternal))) {
scheme_print_tagged_value("\n ->", v, 0, diff, max_w, "");
} else
scheme_print_tagged_value("\n ->", v, 1, diff, max_w, "");
}
scheme_console_printf("\n");
}
GC_clear_paths();
scheme_console_printf("End Paths\n");
}
scheme_console_printf("Begin Help\n");
scheme_console_printf(" (dump-memory-stats sym) - prints paths to instances of type named by sym.\n");
scheme_console_printf(" Examples: (dump-memory-stats '<pair>), (dump-memory-stats 'frame).\n");
scheme_console_printf(" If sym is 'stack, prints paths to thread stacks.\n");
scheme_console_printf(" (dump-memory-stats sym 'objects) - prints all instances of type named by sym.\n");
scheme_console_printf(" (dump-memory-stats sym 'from from-v) - prints paths, paths through from-v first.\n");
scheme_console_printf("End Help\n");
if (obj_type >= 0) {
result = scheme_null;
while (obj_buffer_pos--) {
result = scheme_make_pair((Scheme_Object *)(obj_buffer[obj_buffer_pos]), result);
}
}
#endif
# if MZ_PRECISE_GC_TRACE
scheme_console_printf("Begin Help\n");
scheme_console_printf(" (dump-memory-stats sym) - prints paths to instances of type named by sym.\n");
scheme_console_printf(" Example: (dump-memory-stats '<pair>)\n");
scheme_console_printf(" (dump-memory-stats num) - prints paths to objects with tag num.\n");
scheme_console_printf(" (dump-memory-stats -num) - prints paths to objects of size num.\n");
scheme_console_printf(" (dump-memory-stats sym/num len) - limits path to size len.\n");
scheme_console_printf("End Help\n");
# endif
scheme_console_printf("End Dump\n");
scheme_end_atomic();
return result;
}
