static Scheme_Object *make_immutable_hash_table(int argc, Scheme_Object *argv[]) { Scheme_Object *l = argv[0], *a; Scheme_Hash_Table *ht; if (scheme_proper_list_length(l) >= 0) { for (; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) { a = SCHEME_CAR(l); if (!SCHEME_PAIRP(a)) break; } } if (!SCHEME_NULLP(l)) scheme_wrong_type("make-immutable-hash-table", "list of pairs", 0, argc, argv); if (argc > 1) { if (!SAME_OBJ(equal_symbol, argv[1])) scheme_wrong_type("make-immutable-hash-table", "'equal", 1, argc, argv); ht = scheme_make_hash_table_equal(); } else ht = scheme_make_hash_table(SCHEME_hash_ptr); for (l = argv[0]; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) { a = SCHEME_CAR(l); scheme_hash_set(ht, SCHEME_CAR(a), SCHEME_CDR(a)); } SCHEME_SET_IMMUTABLE((Scheme_Object *)ht); return (Scheme_Object *)ht; }
long scheme_count_closure(Scheme_Object **o, mzshort len, Scheme_Hash_Table *ht) { #if 0 int i; int s = 0; for (i = 0; i < len; i++) { if (!scheme_lookup_in_table(ht, (const char *)o[i])) { scheme_hash_set(ht, o[i], scheme_true); if (GC_size(o[i]) == sizeof(Scheme_Object *)) { /* May be an environment box */ Scheme_Object *d = *(Scheme_Object **)o[i]; if (GC_size(d) >= sizeof(Scheme_Type)) { /* Ok - probably it is a box. */ s += sizeof(Scheme_Object *); s += scheme_count_memory(d, ht); } else { /* Not an environment box. */ s += scheme_count_memory(o[i], ht); } } else { s += scheme_count_memory(o[i], ht); } } } return s; #endif return 0; }
static Scheme_Object *hash_table_put(int argc, Scheme_Object *argv[]) { if (!(SCHEME_HASHTP(argv[0]) || SCHEME_BUCKTP(argv[0])) || SCHEME_IMMUTABLEP(argv[0])) scheme_wrong_type("hash-table-put!", "mutable hash-table", 0, argc, argv); if (SCHEME_BUCKTP(argv[0])) { Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)argv[0]; if (t->mutex) scheme_wait_sema(t->mutex,0); scheme_add_to_table(t, (char *)argv[1], (void *)argv[2], 0); if (t->mutex) scheme_post_sema(t->mutex); } else{ Scheme_Hash_Table *t = (Scheme_Hash_Table *)argv[0]; if (t->mutex) scheme_wait_sema(t->mutex, 0); scheme_hash_set(t, argv[1], argv[2]); if (t->mutex) scheme_post_sema(t->mutex); } return scheme_void; }
static Scheme_Object *union_find(Scheme_Object *obj1, Scheme_Hash_Table *ht) { Scheme_Object *v, *prev = obj1, *prev_prev = obj1; while (1) { v = scheme_hash_get(ht, prev); if (v) { prev_prev = prev; prev = v; } else break; } /* Point all items to prev */ while (obj1 != prev_prev) { v = scheme_hash_get(ht, obj1); scheme_hash_set(ht, obj1, prev); obj1 = v; } return prev; }
static int union_check(Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql) { if (eql->depth < 50) { if (!eql->next_next) eql->depth += 2; return 0; } else { Scheme_Hash_Table *ht = eql->ht; if (!ht) { ht = scheme_make_hash_table(SCHEME_hash_ptr); eql->ht = ht; } obj1 = union_find(obj1, ht); obj2 = union_find(obj2, ht); if (SAME_OBJ(obj1, obj2)) return 1; scheme_hash_set(ht, obj2, obj1); return 0; } }
static Scheme_Object *hash_table_remove(int argc, Scheme_Object *argv[]) { if (!(SCHEME_HASHTP(argv[0]) || SCHEME_BUCKTP(argv[0])) || SCHEME_IMMUTABLEP(argv[0])) scheme_wrong_type("hash-table-remove!", "mutable hash-table", 0, argc, argv); if (SCHEME_BUCKTP(argv[0])) { Scheme_Bucket *b; Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)argv[0]; if (t->mutex) scheme_wait_sema(t->mutex, 0); b = scheme_bucket_or_null_from_table((Scheme_Bucket_Table *)argv[0], (char *)argv[1], 0); if (b) { HT_EXTRACT_WEAK(b->key) = NULL; b->val = NULL; } if (t->mutex) scheme_post_sema(t->mutex); } else{ Scheme_Hash_Table *t = (Scheme_Hash_Table *)argv[0]; if (t->mutex) scheme_wait_sema(t->mutex, 0); scheme_hash_set(t, argv[1], NULL); if (t->mutex) scheme_post_sema(t->mutex); } return scheme_void; }
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; }
void force_hash_worker(Scheme_Object *so, Scheme_Hash_Table *ht) { if (SCHEME_INTP(so)) { return; } if (ht) { Scheme_Object *r; if ((r = scheme_hash_get(ht, so))) { return; } } switch (so->type) { case scheme_true_type: case scheme_false_type: case scheme_null_type: case scheme_char_type: case scheme_rational_type: case scheme_float_type: case scheme_double_type: case scheme_complex_type: case scheme_char_string_type: case scheme_byte_string_type: case scheme_unix_path_type: case scheme_symbol_type: case scheme_place_bi_channel_type: case scheme_flvector_type: break; case scheme_pair_type: { force_hash_worker(SCHEME_CAR(so), ht); force_hash_worker(SCHEME_CDR(so), ht); } break; case scheme_vector_type: { intptr_t i; intptr_t size = SCHEME_VEC_SIZE(so); for (i = 0; i <size ; i++) { force_hash_worker(SCHEME_VEC_ELS(so)[i], ht); } } break; case scheme_structure_type: { Scheme_Structure *st = (Scheme_Structure*)so; Scheme_Struct_Type *stype = st->stype; intptr_t i; intptr_t size = stype->num_slots; if (stype->prefab_key) force_hash_worker((Scheme_Object*)stype->prefab_key, ht); for (i = 0; i <size ; i++) { force_hash_worker((Scheme_Object*) st->slots[i], ht); } } break; case scheme_resolved_module_path_type: default: scheme_log_abort("cannot force hash"); abort(); break; } if (ht) { scheme_hash_set(ht, so, NULL); } return; }
long scheme_count_memory(Scheme_Object *root, Scheme_Hash_Table *ht) { Scheme_Type type; long s = sizeof(Scheme_Simple_Object), e = 0; int need_align = 0; struct GC_Set *home; if (!root || SCHEME_INTP(root)) return 0; type = SCHEME_TYPE(root); if (type >= _scheme_last_type_) return 0; if (ht && scheme_hash_get(ht, root)) return 0; home = GC_set(root); #if CAN_TRACE_HOME if ((home != real_tagged) && (home != tagged_atomic) && (home != tagged_uncollectable) && (home != tagged_eternal)) { scheme_console_printf("Bad Scheme object: %lx\n", (unsigned long)root); return 0; } #endif if (ht) scheme_hash_set(ht, root, scheme_true); #define COUNT(x) (ht ? scheme_count_memory((Scheme_Object *)x, ht) : 0) switch (type) { case scheme_variable_type: s = sizeof(Scheme_Bucket); #if FORCE_SUBPARTS e = COUNT(((Scheme_Bucket *)root)->key) + COUNT(((Scheme_Bucket *)root)->val); #endif break; case scheme_local_type: case scheme_local_unbox_type: s = sizeof(Scheme_Local); break; case scheme_syntax_type: #if FORCE_KNOWN_SUBPARTS e = COUNT(SCHEME_IPTR_VAL(root)); #endif break; case scheme_application_type: { Scheme_App_Rec *app = (Scheme_App_Rec *)root; int i; s = sizeof(Scheme_App_Rec) + (app->num_args * sizeof(Scheme_Object *)) + (app->num_args + 1); need_align = 1; #if FORCE_KNOWN_SUBPARTS e = COUNT(app->args[0]); for (i = 1; i <= app->num_args; i++) { e += COUNT(app->args[i]); } #endif } break; case scheme_sequence_type: case scheme_case_lambda_sequence_type: case scheme_begin0_sequence_type: { Scheme_Sequence *seq = (Scheme_Sequence *)root; int i; s = sizeof(Scheme_Sequence) + (seq->count - 1) * sizeof(Scheme_Object *); #if FORCE_KNOWN_SUBPARTS for (i = e = 0; i < seq->count; i++) { e += COUNT(seq->array[i]); } #endif } break; case scheme_branch_type: { Scheme_Branch_Rec *rec = (Scheme_Branch_Rec *)root; s = sizeof(Scheme_Branch_Rec); #if FORCE_KNOWN_SUBPARTS e = COUNT(rec->test) + COUNT(rec->tbranch) + COUNT(rec->fbranch); #endif } break; case scheme_unclosed_procedure_type: case scheme_compiled_unclosed_procedure_type: { Scheme_Closure_Data *data = (Scheme_Closure_Data *)root; s = sizeof(Scheme_Closure_Data); s += data->closure_size * sizeof(mzshort); #if FORCE_KNOWN_SUBPARTS e = COUNT(data->code); #endif } break; case scheme_let_value_type: { Scheme_Let_Value *let = (Scheme_Let_Value *)root; s = sizeof(Scheme_Let_Value); #if FORCE_KNOWN_SUBPARTS e = COUNT(let->value) + COUNT(let->body); #endif } break; case scheme_compiled_let_value_type: { Scheme_Compiled_Let_Value *let = (Scheme_Compiled_Let_Value *)root; s = sizeof(Scheme_Compiled_Let_Value); #if FORCE_KNOWN_SUBPARTS e = COUNT(let->value) + COUNT(let->body); #endif } break; case scheme_let_void_type: { Scheme_Let_Void *let = (Scheme_Let_Void *)root; s = sizeof(Scheme_Let_Void); #if FORCE_KNOWN_SUBPARTS e = COUNT(let->body); #endif } break; case scheme_compiled_let_void_type: { Scheme_Let_Header *let = (Scheme_Let_Header *)root; s = sizeof(Scheme_Let_Header); #if FORCE_KNOWN_SUBPARTS e = COUNT(let->body); #endif } break; case scheme_letrec_type: { Scheme_Letrec *let = (Scheme_Letrec *)root; int i; s = sizeof(Scheme_Letrec); s += let->count * sizeof(Scheme_Object *); #if FORCE_KNOWN_SUBPARTS e = COUNT(let->body); for (i = 0; i < let->count; i++) { e += COUNT(let->procs[i]); } #endif } break; case scheme_char_type: s = sizeof(Scheme_Small_Object); break; case scheme_integer_type: s = 0; break; case scheme_double_type: s = sizeof(Scheme_Double); break; case scheme_float_type: break; case scheme_char_string_type: s += (SCHEME_CHAR_STRTAG_VAL(root) + 1) * sizeof(mzchar); need_align = 1; break; case scheme_byte_string_type: s += SCHEME_BYTE_STRTAG_VAL(root) + 1; need_align = 1; break; case scheme_symbol_type: s = sizeof(Scheme_Symbol) + SCHEME_SYM_LEN(root) - 1; need_align = 1; break; case scheme_null_type: break; case scheme_pair_type: #if FORCE_KNOWN_SUBPARTS e = COUNT(SCHEME_CAR(root)) + COUNT(SCHEME_CDR(root)); #endif break; case scheme_vector_type: { int count = SCHEME_VEC_SIZE(root), i; Scheme_Object **array = SCHEME_VEC_ELS(root); s += count * sizeof(Scheme_Object*); #if FORCE_KNOWN_SUBPARTS for (i = e = 0; i < count; i++) { e += COUNT(array[i]); } #endif } break; case scheme_prim_type: { if (((Scheme_Primitive_Proc *)root)->pp.flags & SCHEME_PRIM_IS_MULTI_RESULT) s = sizeof(Scheme_Prim_W_Result_Arity); else s = sizeof(Scheme_Primitive_Proc); } break; case scheme_closure_type: { Scheme_Closure_Data *data; Scheme_Object **vals; data = SCHEME_COMPILED_CLOS_CODE(root); vals = SCHEME_COMPILED_CLOS_ENV(root); s += (data->closure_size * sizeof(Scheme_Object *)); #if FORCE_KNOWN_SUBPARTS e = COUNT(data) + scheme_count_closure(vals, data->closure_size, ht); #endif } break; case scheme_closed_prim_type: { if (((Scheme_Closed_Primitive_Proc *)root)->pp.flags & SCHEME_PRIM_IS_MULTI_RESULT) s = sizeof(Scheme_Closed_Prim_W_Result_Arity); else s = sizeof(Scheme_Closed_Primitive_Proc); } break; case scheme_cont_type: { Scheme_Cont *c = (Scheme_Cont *)root; Scheme_Saved_Stack *rs; s = sizeof(Scheme_Cont); #if FORCE_KNOWN_SUBPARTS e = COUNT(c->home); #endif for (rs = c->runstack_copied; rs; rs = rs->prev) { s += sizeof(Scheme_Saved_Stack); scheme_count_closure(rs->runstack, rs->runstack_size - (rs->runstack - rs->runstack_start), ht); } } break; case scheme_input_port_type: scheme_count_input_port(root, &s, &e, ht); break; case scheme_output_port_type: scheme_count_output_port(root, &s, &e, ht); break; case scheme_eof_type: case scheme_true_type: case scheme_false_type: case scheme_void_type: case scheme_undefined_type: /* Only one */ break; case scheme_syntax_compiler_type: break; case scheme_macro_type: case scheme_set_macro_type: s = sizeof(Scheme_Small_Object); #if FORCE_KNOWN_SUBPARTS e = COUNT(SCHEME_PTR_VAL(root)); #endif break; case scheme_box_type: s = sizeof(Scheme_Small_Object); #if FORCE_KNOWN_SUBPARTS e = COUNT(SCHEME_BOX_VAL(root)); #endif break; case scheme_will_executor_type: s = sizeof(Scheme_Simple_Object); break; case scheme_custodian_type: { Scheme_Custodian *m = (Scheme_Custodian *)root; s = sizeof(Scheme_Custodian); e = m->alloc * (sizeof(Scheme_Object **) + sizeof(Scheme_Custodian_Reference *) + sizeof(void *) + sizeof(void *)); } break; case scheme_thread_type: { Scheme_Thread *p = (Scheme_Thread *)root; Scheme_Saved_Stack *saved; s = sizeof(Scheme_Thread) + ((p->runstack_size + p->tail_buffer_size) * sizeof(Scheme_Object *)); #if FORCE_KNOWN_SUBPARTS e = COUNT(p->init_config); #endif /* Check stack: */ scheme_count_closure(p->runstack, /* p->runstack may be wrong, but count_closure is turned off */ p->runstack_size - (p->runstack - p->runstack_start), ht); for (saved = p->runstack_saved; saved; saved = saved->prev) { s += (saved->runstack_size * sizeof(Scheme_Object *)); scheme_count_closure(saved->runstack, saved->runstack_size - (saved->runstack - saved->runstack_start), ht); } } break; case scheme_namespace_type: { Scheme_Env *env = (Scheme_Env *)root; s = sizeof(Scheme_Env); #if FORCE_KNOWN_SUBPARTS e = COUNT(env->toplevel); #endif } break; case scheme_config_type: { s = sizeof(Scheme_Config) + (sizeof(Scheme_Object *) * __MZCONFIG_BUILTIN_COUNT__); #if FORCE_SUBPARTS { Scheme_Config *c = (Scheme_Config *)root; int i; e = COUNT(c->extensions) + COUNT(c->base); for (i = 0; i < __MZCONFIG_BUILTIN_COUNT__; i++) { e += COUNT(*c->configs[i]); } } #endif } break; case scheme_proc_struct_type: case scheme_structure_type: { Scheme_Object **slots = ((Scheme_Structure *)root)->slots; int i, count = SCHEME_STRUCT_NUM_SLOTS(root); s = sizeof(Scheme_Structure) + (count - 1) * sizeof(Scheme_Object *); #if FORCE_KNOWN_SUBPARTS for (i = e = 0; i < count; i++) { e += COUNT(slots[i]); } e += COUNT(((Scheme_Structure *)root)->stype); #endif } break; case scheme_bignum_type: { int count = SCHEME_BIGLEN(root); if (count < 0) count = -count; s = sizeof(Small_Bignum) + (count - 1) * sizeof(bigdig); } break; case scheme_escaping_cont_type: s = sizeof(Scheme_Escaping_Cont); break; case scheme_sema_type: s = sizeof(Scheme_Sema); break; case scheme_compilation_top_type: s = sizeof(Scheme_Compilation_Top); break; case scheme_hash_table_type: { Scheme_Hash_Table *ht = (Scheme_Hash_Table *)root; s = sizeof(Scheme_Hash_Table) + ht->size * sizeof(Scheme_Object *); #if FORCE_SUBPARTS { int i; for (i = e = 0; i < ht->size; i++) { if (ht->buckets[i]) { if (ht->by_address) e += COUNT(ht->buckets[i]); else e += COUNT(ht->buckets[i]->val); } } } #endif } break; case scheme_weak_box_type: s = sizeof(Scheme_Small_Object); e = COUNT(SCHEME_BOX_VAL(root)); break; case scheme_complex_type: case scheme_complex_izi_type: s = sizeof(Scheme_Complex); e = COUNT(((Scheme_Complex *)root)->r) + COUNT(((Scheme_Complex *)root)->i); break; case scheme_rational_type: s = sizeof(Scheme_Rational); #if FORCE_KNOWN_SUBPARTS e = COUNT(((Scheme_Rational *)root)->num) + COUNT(((Scheme_Rational *)root)->denom); #endif break; case scheme_struct_type_type: { Scheme_Struct_Type *st = (Scheme_Struct_Type *)root; s = sizeof(Scheme_Struct_Type) + st->name_pos * sizeof(Scheme_Object*); #if FORCE_KNOWN_SUBPARTS e = COUNT(st->name); if (st->name_pos) e += COUNT(st->parent_types[st->name_pos - 1]); #endif } break; case scheme_listener_type: s = sizeof(Scheme_Small_Object); break; case scheme_random_state_type: s = 130; /* wild guess */ break; case scheme_eval_waiting_type: case scheme_tail_call_waiting_type: /* Only one */ break; case scheme_multiple_values_type: /* Only one */ break; case scheme_placeholder_type: s = 0; /* Infrequent */ break; default: s = 0; break; } if (need_align) { /* Round up to sizeof(void*) boundary: */ if (s & (sizeof(void*) - 1)) s += sizeof(void*) - (s & (sizeof(void*) - 1)); } scheme_memory_count[type]++; scheme_memory_size[type] += s; return s; }