Places: fix prefab serialization
This commit is contained in:
parent
60f0d0b69c
commit
bb72d26b93
|
@ -4669,6 +4669,53 @@ static int mark_alarm_FIXUP(void *p, struct NewGC *gc) {
|
|||
|
||||
#ifdef MARKS_FOR_STRUCT_C
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
static int mark_serialized_struct_val_SIZE(void *p, struct NewGC *gc) {
|
||||
Scheme_Serialized_Structure *s = (Scheme_Serialized_Structure *)p;
|
||||
int num_slots = s->num_slots;
|
||||
|
||||
return
|
||||
gcBYTES_TO_WORDS((sizeof(Scheme_Serialized_Structure)
|
||||
+ ((num_slots - 1) * sizeof(Scheme_Object *))));
|
||||
}
|
||||
|
||||
static int mark_serialized_struct_val_MARK(void *p, struct NewGC *gc) {
|
||||
Scheme_Serialized_Structure *s = (Scheme_Serialized_Structure *)p;
|
||||
int num_slots = s->num_slots;
|
||||
|
||||
int i;
|
||||
|
||||
gcMARK2(s->prefab_key, gc);
|
||||
|
||||
for(i = num_slots; i--; )
|
||||
gcMARK2(s->slots[i], gc);
|
||||
|
||||
return
|
||||
gcBYTES_TO_WORDS((sizeof(Scheme_Serialized_Structure)
|
||||
+ ((num_slots - 1) * sizeof(Scheme_Object *))));
|
||||
}
|
||||
|
||||
static int mark_serialized_struct_val_FIXUP(void *p, struct NewGC *gc) {
|
||||
Scheme_Serialized_Structure *s = (Scheme_Serialized_Structure *)p;
|
||||
int num_slots = s->num_slots;
|
||||
|
||||
int i;
|
||||
|
||||
gcFIXUP2(s->prefab_key, gc);
|
||||
|
||||
for(i = num_slots; i--; )
|
||||
gcFIXUP2(s->slots[i], gc);
|
||||
|
||||
return
|
||||
gcBYTES_TO_WORDS((sizeof(Scheme_Serialized_Structure)
|
||||
+ ((num_slots - 1) * sizeof(Scheme_Object *))));
|
||||
}
|
||||
|
||||
#define mark_serialized_struct_val_IS_ATOMIC 0
|
||||
#define mark_serialized_struct_val_IS_CONST_SIZE 0
|
||||
|
||||
#endif
|
||||
|
||||
static int mark_struct_val_SIZE(void *p, struct NewGC *gc) {
|
||||
Scheme_Structure *s = (Scheme_Structure *)p;
|
||||
int num_slots = ((Scheme_Struct_Type *)GC_resolve(s->stype))->num_slots;
|
||||
|
|
|
@ -1907,6 +1907,25 @@ END sema;
|
|||
|
||||
START struct;
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
mark_serialized_struct_val {
|
||||
Scheme_Serialized_Structure *s = (Scheme_Serialized_Structure *)p;
|
||||
int num_slots = s->num_slots;
|
||||
|
||||
mark:
|
||||
int i;
|
||||
|
||||
gcMARK2(s->prefab_key, gc);
|
||||
|
||||
for(i = num_slots; i--; )
|
||||
gcMARK2(s->slots[i], gc);
|
||||
|
||||
size:
|
||||
gcBYTES_TO_WORDS((sizeof(Scheme_Serialized_Structure)
|
||||
+ ((num_slots - 1) * sizeof(Scheme_Object *))));
|
||||
}
|
||||
#endif
|
||||
|
||||
mark_struct_val {
|
||||
Scheme_Structure *s = (Scheme_Structure *)p;
|
||||
int num_slots = ((Scheme_Struct_Type *)GC_resolve(s->stype))->num_slots;
|
||||
|
|
|
@ -791,22 +791,23 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
|
|||
new_so = vec;
|
||||
}
|
||||
break;
|
||||
|
||||
case scheme_structure_type:
|
||||
{
|
||||
Scheme_Structure *st = (Scheme_Structure*)so;
|
||||
Scheme_Structure *nst;
|
||||
Scheme_Serialized_Structure *nst;
|
||||
Scheme_Struct_Type *stype = st->stype;
|
||||
Scheme_Struct_Type *ptype = stype->parent_types[stype->name_pos - 1];
|
||||
long i;
|
||||
Scheme_Object *nprefab_key;
|
||||
long 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();
|
||||
}
|
||||
{
|
||||
int i = 0;
|
||||
for (i = 0; i < local_slots; i++) {
|
||||
if (!stype->immutables || stype->immutables[i] != 1) {
|
||||
scheme_log_abort("cannot copy mutable prefab structure");
|
||||
|
@ -814,7 +815,27 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
|
|||
}
|
||||
}
|
||||
}
|
||||
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;
|
||||
long 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;
|
||||
|
@ -824,6 +845,7 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
|
|||
new_so = (Scheme_Object*)nst;
|
||||
}
|
||||
break;
|
||||
|
||||
case scheme_resolved_module_path_type:
|
||||
default:
|
||||
scheme_log_abort("cannot copy object");
|
||||
|
@ -1093,6 +1115,9 @@ void force_hash_worker(Scheme_Object *so, Scheme_Hash_Table *ht)
|
|||
Scheme_Struct_Type *stype = st->stype;
|
||||
long i;
|
||||
long 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);
|
||||
|
|
|
@ -692,6 +692,16 @@ typedef struct Scheme_Structure
|
|||
Scheme_Object *slots[1];
|
||||
} Scheme_Structure;
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
typedef struct Scheme_Serialized_Structure
|
||||
{
|
||||
Scheme_Object so;
|
||||
Scheme_Object *prefab_key;
|
||||
int num_slots;
|
||||
Scheme_Object *slots[1];
|
||||
} Scheme_Serialized_Structure;
|
||||
#endif
|
||||
|
||||
typedef struct Struct_Proc_Info {
|
||||
MZTAG_IF_REQUIRED
|
||||
Scheme_Struct_Type *struct_type;
|
||||
|
@ -747,6 +757,9 @@ Scheme_Struct_Type *scheme_make_prefab_struct_type_raw(Scheme_Object *base,
|
|||
Scheme_Object *uninit_val,
|
||||
char *immutable_pos_list);
|
||||
Scheme_Object *scheme_prefab_struct_key(Scheme_Object *s);
|
||||
#ifdef MZ_USE_PLACES
|
||||
Scheme_Object *scheme_make_serialized_struct_instance(Scheme_Object *s, int num_slots);
|
||||
#endif
|
||||
|
||||
Scheme_Object *scheme_extract_checked_procedure(int argc, Scheme_Object **argv);
|
||||
|
||||
|
|
|
@ -2000,6 +2000,23 @@ Scheme_Object *scheme_make_blank_prefab_struct_instance(Scheme_Struct_Type *styp
|
|||
return (Scheme_Object *)inst;
|
||||
}
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
Scheme_Object *scheme_make_serialized_struct_instance(Scheme_Object *prefab_key, int num_slots)
|
||||
{
|
||||
Scheme_Serialized_Structure *inst;
|
||||
|
||||
inst = (Scheme_Serialized_Structure *)
|
||||
scheme_malloc_tagged(sizeof(Scheme_Serialized_Structure)
|
||||
+ ((num_slots - 1) * sizeof(Scheme_Object *)));
|
||||
|
||||
inst->so.type = scheme_serialized_structure_type;
|
||||
inst->num_slots = num_slots;
|
||||
inst->prefab_key = prefab_key;
|
||||
|
||||
return (Scheme_Object *)inst;
|
||||
}
|
||||
#endif
|
||||
|
||||
Scheme_Object *scheme_make_prefab_struct_instance(Scheme_Struct_Type *stype,
|
||||
Scheme_Object *vec)
|
||||
{
|
||||
|
@ -5209,6 +5226,9 @@ START_XFORM_SKIP;
|
|||
static void register_traversers(void)
|
||||
{
|
||||
GC_REG_TRAV(scheme_structure_type, mark_struct_val);
|
||||
#ifdef MZ_USE_PLACES
|
||||
GC_REG_TRAV(scheme_serialized_structure_type, mark_serialized_struct_val);
|
||||
#endif
|
||||
GC_REG_TRAV(scheme_proc_struct_type, mark_struct_val);
|
||||
GC_REG_TRAV(scheme_struct_type_type, mark_struct_type_val);
|
||||
GC_REG_TRAV(scheme_struct_property_type, mark_struct_property);
|
||||
|
|
|
@ -181,80 +181,81 @@ enum {
|
|||
scheme_place_bi_channel_type, /* 162 */
|
||||
scheme_once_used_type, /* 163 */
|
||||
scheme_serialized_symbol_type, /* 164 */
|
||||
scheme_serialized_structure_type, /* 165 */
|
||||
|
||||
#ifdef MZTAG_REQUIRED
|
||||
_scheme_last_normal_type_, /* 165 */
|
||||
_scheme_last_normal_type_, /* 166 */
|
||||
|
||||
scheme_rt_weak_array, /* 166 */
|
||||
scheme_rt_weak_array, /* 167 */
|
||||
|
||||
scheme_rt_comp_env, /* 167 */
|
||||
scheme_rt_constant_binding, /* 168 */
|
||||
scheme_rt_resolve_info, /* 169 */
|
||||
scheme_rt_optimize_info, /* 170 */
|
||||
scheme_rt_compile_info, /* 171 */
|
||||
scheme_rt_cont_mark, /* 172 */
|
||||
scheme_rt_saved_stack, /* 173 */
|
||||
scheme_rt_reply_item, /* 174 */
|
||||
scheme_rt_closure_info, /* 175 */
|
||||
scheme_rt_overflow, /* 176 */
|
||||
scheme_rt_overflow_jmp, /* 177 */
|
||||
scheme_rt_meta_cont, /* 178 */
|
||||
scheme_rt_dyn_wind_cell, /* 179 */
|
||||
scheme_rt_dyn_wind_info, /* 180 */
|
||||
scheme_rt_dyn_wind, /* 181 */
|
||||
scheme_rt_dup_check, /* 182 */
|
||||
scheme_rt_thread_memory, /* 183 */
|
||||
scheme_rt_input_file, /* 184 */
|
||||
scheme_rt_input_fd, /* 185 */
|
||||
scheme_rt_oskit_console_input, /* 186 */
|
||||
scheme_rt_tested_input_file, /* 187 */
|
||||
scheme_rt_tested_output_file, /* 188 */
|
||||
scheme_rt_indexed_string, /* 189 */
|
||||
scheme_rt_output_file, /* 190 */
|
||||
scheme_rt_load_handler_data, /* 191 */
|
||||
scheme_rt_pipe, /* 192 */
|
||||
scheme_rt_beos_process, /* 193 */
|
||||
scheme_rt_system_child, /* 194 */
|
||||
scheme_rt_tcp, /* 195 */
|
||||
scheme_rt_write_data, /* 196 */
|
||||
scheme_rt_tcp_select_info, /* 197 */
|
||||
scheme_rt_param_data, /* 198 */
|
||||
scheme_rt_will, /* 199 */
|
||||
scheme_rt_struct_proc_info, /* 200 */
|
||||
scheme_rt_linker_name, /* 201 */
|
||||
scheme_rt_param_map, /* 202 */
|
||||
scheme_rt_finalization, /* 203 */
|
||||
scheme_rt_finalizations, /* 204 */
|
||||
scheme_rt_cpp_object, /* 205 */
|
||||
scheme_rt_cpp_array_object, /* 206 */
|
||||
scheme_rt_stack_object, /* 207 */
|
||||
scheme_rt_preallocated_object, /* 208 */
|
||||
scheme_thread_hop_type, /* 209 */
|
||||
scheme_rt_srcloc, /* 210 */
|
||||
scheme_rt_evt, /* 211 */
|
||||
scheme_rt_syncing, /* 212 */
|
||||
scheme_rt_comp_prefix, /* 213 */
|
||||
scheme_rt_user_input, /* 214 */
|
||||
scheme_rt_user_output, /* 215 */
|
||||
scheme_rt_compact_port, /* 216 */
|
||||
scheme_rt_read_special_dw, /* 217 */
|
||||
scheme_rt_regwork, /* 218 */
|
||||
scheme_rt_buf_holder, /* 219 */
|
||||
scheme_rt_parameterization, /* 220 */
|
||||
scheme_rt_print_params, /* 221 */
|
||||
scheme_rt_read_params, /* 222 */
|
||||
scheme_rt_native_code, /* 223 */
|
||||
scheme_rt_native_code_plus_case, /* 224 */
|
||||
scheme_rt_jitter_data, /* 225 */
|
||||
scheme_rt_module_exports, /* 226 */
|
||||
scheme_rt_delay_load_info, /* 227 */
|
||||
scheme_rt_marshal_info, /* 228 */
|
||||
scheme_rt_unmarshal_info, /* 229 */
|
||||
scheme_rt_runstack, /* 230 */
|
||||
scheme_rt_sfs_info, /* 231 */
|
||||
scheme_rt_validate_clearing, /* 232 */
|
||||
scheme_rt_rb_node, /* 233 */
|
||||
scheme_rt_frozen_tramp, /* 234 */
|
||||
scheme_rt_comp_env, /* 168*/
|
||||
scheme_rt_constant_binding, /* 169 */
|
||||
scheme_rt_resolve_info, /* 170 */
|
||||
scheme_rt_optimize_info, /* 171 */
|
||||
scheme_rt_compile_info, /* 172 */
|
||||
scheme_rt_cont_mark, /* 173 */
|
||||
scheme_rt_saved_stack, /* 174 */
|
||||
scheme_rt_reply_item, /* 175 */
|
||||
scheme_rt_closure_info, /* 176 */
|
||||
scheme_rt_overflow, /* 177 */
|
||||
scheme_rt_overflow_jmp, /* 178 */
|
||||
scheme_rt_meta_cont, /* 179 */
|
||||
scheme_rt_dyn_wind_cell, /* 180 */
|
||||
scheme_rt_dyn_wind_info, /* 181 */
|
||||
scheme_rt_dyn_wind, /* 182 */
|
||||
scheme_rt_dup_check, /* 183 */
|
||||
scheme_rt_thread_memory, /* 184 */
|
||||
scheme_rt_input_file, /* 185 */
|
||||
scheme_rt_input_fd, /* 186 */
|
||||
scheme_rt_oskit_console_input, /* 187 */
|
||||
scheme_rt_tested_input_file, /* 188 */
|
||||
scheme_rt_tested_output_file, /* 189 */
|
||||
scheme_rt_indexed_string, /* 190 */
|
||||
scheme_rt_output_file, /* 191 */
|
||||
scheme_rt_load_handler_data, /* 192 */
|
||||
scheme_rt_pipe, /* 193 */
|
||||
scheme_rt_beos_process, /* 194 */
|
||||
scheme_rt_system_child, /* 195 */
|
||||
scheme_rt_tcp, /* 196 */
|
||||
scheme_rt_write_data, /* 197 */
|
||||
scheme_rt_tcp_select_info, /* 198 */
|
||||
scheme_rt_param_data, /* 199 */
|
||||
scheme_rt_will, /* 200 */
|
||||
scheme_rt_struct_proc_info, /* 201 */
|
||||
scheme_rt_linker_name, /* 202 */
|
||||
scheme_rt_param_map, /* 203 */
|
||||
scheme_rt_finalization, /* 204 */
|
||||
scheme_rt_finalizations, /* 205 */
|
||||
scheme_rt_cpp_object, /* 206 */
|
||||
scheme_rt_cpp_array_object, /* 207 */
|
||||
scheme_rt_stack_object, /* 208 */
|
||||
scheme_rt_preallocated_object, /* 209 */
|
||||
scheme_thread_hop_type, /* 210 */
|
||||
scheme_rt_srcloc, /* 211 */
|
||||
scheme_rt_evt, /* 212 */
|
||||
scheme_rt_syncing, /* 213 */
|
||||
scheme_rt_comp_prefix, /* 214 */
|
||||
scheme_rt_user_input, /* 215 */
|
||||
scheme_rt_user_output, /* 216 */
|
||||
scheme_rt_compact_port, /* 217 */
|
||||
scheme_rt_read_special_dw, /* 218 */
|
||||
scheme_rt_regwork, /* 219 */
|
||||
scheme_rt_buf_holder, /* 220 */
|
||||
scheme_rt_parameterization, /* 221 */
|
||||
scheme_rt_print_params, /* 222 */
|
||||
scheme_rt_read_params, /* 223 */
|
||||
scheme_rt_native_code, /* 224 */
|
||||
scheme_rt_native_code_plus_case, /* 225 */
|
||||
scheme_rt_jitter_data, /* 226 */
|
||||
scheme_rt_module_exports, /* 227 */
|
||||
scheme_rt_delay_load_info, /* 228 */
|
||||
scheme_rt_marshal_info, /* 229 */
|
||||
scheme_rt_unmarshal_info, /* 230 */
|
||||
scheme_rt_runstack, /* 231 */
|
||||
scheme_rt_sfs_info, /* 232 */
|
||||
scheme_rt_validate_clearing, /* 233 */
|
||||
scheme_rt_rb_node, /* 234 */
|
||||
scheme_rt_frozen_tramp, /* 235 */
|
||||
#endif
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user