/* This works out an allocation strategy for the object. It takes care of * "inlining" storage of attributes that are natively typed, as well as * noting unbox targets. */ static void compute_allocation_strategy(PARROT_INTERP, PMC *WHAT, P6opaqueREPRData *repr_data) { STRING *type_str = Parrot_str_new_constant(interp, "type"); STRING *box_target_str = Parrot_str_new_constant(interp, "box_target"); STRING *avcont_str = Parrot_str_new_constant(interp, "auto_viv_container"); PMC *flat_list; /* * We have to block GC mark here. Because "repr" is assotiated with some * PMC which is not accessible in this function. And we have to write * barrier this PMC because we are poking inside it guts directly. We * do have WB in caller function, but it can be triggered too late is * any of allocation will cause GC run. * * This is kind of minor evil until after I'll find better solution. */ Parrot_block_GC_mark(interp); /* Compute index mapping table and get flat list of attributes. */ flat_list = index_mapping_and_flat_list(interp, WHAT, repr_data); /* If we have no attributes in the index mapping, then just the header. */ if (repr_data->name_to_index_mapping[0].class_key == NULL) { repr_data->allocation_size = sizeof(P6opaqueInstance); } /* Otherwise, we need to compute the allocation strategy. */ else { /* We track the size of the body part, since that's what we want offsets into. */ INTVAL cur_size = 0; /* Get number of attributes and set up various counters. */ INTVAL num_attrs = VTABLE_elements(interp, flat_list); INTVAL info_alloc = num_attrs == 0 ? 1 : num_attrs; INTVAL cur_pmc_attr = 0; INTVAL cur_init_slot = 0; INTVAL cur_mark_slot = 0; INTVAL cur_cleanup_slot = 0; INTVAL cur_unbox_slot = 0; INTVAL i; /* Allocate offset array and GC mark info arrays. */ repr_data->num_attributes = num_attrs; repr_data->attribute_offsets = (INTVAL *) mem_sys_allocate(info_alloc * sizeof(INTVAL)); repr_data->flattened_stables = (STable **) mem_sys_allocate_zeroed(info_alloc * sizeof(PMC *)); repr_data->unbox_int_slot = -1; repr_data->unbox_num_slot = -1; repr_data->unbox_str_slot = -1; /* Go over the attributes and arrange their allocation. */ for (i = 0; i < num_attrs; i++) { PMC *attr = VTABLE_get_pmc_keyed_int(interp, flat_list, i); /* Fetch its type and box target flag, if available. */ PMC *type = accessor_call(interp, attr, type_str); PMC *box_target = accessor_call(interp, attr, box_target_str); PMC *av_cont = accessor_call(interp, attr, avcont_str); /* Work out what unboxed type it is, if any. Default to a boxed. */ INTVAL unboxed_type = STORAGE_SPEC_BP_NONE; INTVAL bits = sizeof(PMC *) * 8; if (!PMC_IS_NULL(type)) { /* Get the storage spec of the type and see what it wants. */ storage_spec spec = REPR(type)->get_storage_spec(interp, STABLE(type)); if (spec.inlineable == STORAGE_SPEC_INLINED) { /* Yes, it's something we'll flatten. */ unboxed_type = spec.boxed_primitive; bits = spec.bits; repr_data->flattened_stables[i] = STABLE(type); /* Does it need special initialization? */ if (REPR(type)->initialize) { if (!repr_data->initialize_slots) repr_data->initialize_slots = (INTVAL *) mem_sys_allocate_zeroed((info_alloc + 1) * sizeof(INTVAL)); repr_data->initialize_slots[cur_init_slot] = i; cur_init_slot++; } /* Does it have special GC needs? */ if (REPR(type)->gc_mark) { if (!repr_data->gc_mark_slots) repr_data->gc_mark_slots = (INTVAL *) mem_sys_allocate_zeroed((info_alloc + 1) * sizeof(INTVAL)); repr_data->gc_mark_slots[cur_mark_slot] = i; cur_mark_slot++; } if (REPR(type)->gc_cleanup) { if (!repr_data->gc_cleanup_slots) repr_data->gc_cleanup_slots = (INTVAL *) mem_sys_allocate_zeroed((info_alloc + 1) * sizeof(INTVAL)); repr_data->gc_cleanup_slots[cur_cleanup_slot] = i; cur_cleanup_slot++; } /* Is it a target for box/unbox operations? */ if (!PMC_IS_NULL(box_target) && VTABLE_get_bool(interp, box_target)) { /* If it boxes a primitive, note that. */ switch (unboxed_type) { case STORAGE_SPEC_BP_INT: if (repr_data->unbox_int_slot >= 0) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Duplicate box_target for native int"); repr_data->unbox_int_slot = i; break; case STORAGE_SPEC_BP_NUM: if (repr_data->unbox_num_slot >= 0) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Duplicate box_target for native num"); repr_data->unbox_num_slot = i; break; case STORAGE_SPEC_BP_STR: if (repr_data->unbox_str_slot >= 0) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Duplicate box_target for native str"); repr_data->unbox_str_slot = i; break; default: /* nothing, just suppress 'missing default' warning */ break; } /* Also list in the by-repr unbox list. */ if (repr_data->unbox_slots == NULL) repr_data->unbox_slots = (P6opaqueBoxedTypeMap *) mem_sys_allocate_zeroed(info_alloc * sizeof(P6opaqueBoxedTypeMap)); repr_data->unbox_slots[cur_unbox_slot].repr_id = REPR(type)->ID; repr_data->unbox_slots[cur_unbox_slot].slot = i; cur_unbox_slot++; } } } /* Handle PMC attributes, which need marking and may have auto-viv needs. */ if (unboxed_type == STORAGE_SPEC_BP_NONE) { if (!repr_data->gc_pmc_mark_offsets) repr_data->gc_pmc_mark_offsets = (INTVAL *) mem_sys_allocate_zeroed(info_alloc * sizeof(INTVAL)); repr_data->gc_pmc_mark_offsets[cur_pmc_attr] = cur_size; cur_pmc_attr++; if (!PMC_IS_NULL(av_cont)) { if (!repr_data->auto_viv_values) repr_data->auto_viv_values = (PMC **) mem_sys_allocate_zeroed(info_alloc * sizeof(PMC *)); repr_data->auto_viv_values[i] = av_cont; } } /* Do allocation. */ /* XXX TODO Alignment! Important when we get int1, int8, etc. */ repr_data->attribute_offsets[i] = cur_size; cur_size += bits / 8; } /* Finally, put computed allocation size in place; it's body size plus * header size. Also number of markables and sentinels. */ repr_data->allocation_size = cur_size + sizeof(P6opaqueInstance); repr_data->gc_pmc_mark_offsets_count = cur_pmc_attr; if (repr_data->initialize_slots) repr_data->initialize_slots[cur_init_slot] = -1; if (repr_data->gc_mark_slots) repr_data->gc_mark_slots[cur_mark_slot] = -1; if (repr_data->gc_cleanup_slots) repr_data->gc_cleanup_slots[cur_cleanup_slot] = -1; } Parrot_unblock_GC_mark(interp); }
int main(int argc, const char *argv[]) { int nextarg; Parrot_Interp interp; PDB_t *pdb; const char *scriptname = NULL; const unsigned char * configbytes = Parrot_get_config_hash_bytes(); const int configlength = Parrot_get_config_hash_length(); interp = Parrot_new(NULL); Parrot_set_executable_name(interp, Parrot_str_new(interp, argv[0], 0)); Parrot_set_configuration_hash_legacy(interp, configlength, configbytes); Parrot_debugger_init(interp); pdb = interp->pdb; pdb->state = PDB_ENTER; Parrot_block_GC_mark(interp); Parrot_block_GC_sweep(interp); nextarg = 1; if (argv[nextarg] && strcmp(argv[nextarg], "--script") == 0) { scriptname = argv [++nextarg]; ++nextarg; } if (argv[nextarg]) { const char *filename = argv[nextarg]; const char *ext = strrchr(filename, '.'); if (ext && STREQ(ext, ".pbc")) { Parrot_PackFile pf = Parrot_pbc_read(interp, filename, 0); if (!pf) return 1; Parrot_pbc_load(interp, pf); PackFile_fixup_subs(interp, PBC_MAIN, NULL); } else { STRING *errmsg = NULL; Parrot_PackFile pf = PackFile_new(interp, 0); Parrot_pbc_load(interp, pf); Parrot_compile_file(interp, filename, &errmsg); if (errmsg) Parrot_ex_throw_from_c_args(interp, NULL, 1, "%S", errmsg); PackFile_fixup_subs(interp, PBC_POSTCOMP, NULL); /* load the source for debugger list */ PDB_load_source(interp, filename); PackFile_fixup_subs(interp, PBC_MAIN, NULL); } } else { /* Generate some code to be able to enter into runloop */ STRING *compiler = Parrot_str_new_constant(interp, "PIR"); STRING *errstr = NULL; const char source []= ".sub aux :main\nexit 0\n.end\n"; Parrot_compile_string(interp, compiler, source, &errstr); if (!STRING_IS_NULL(errstr)) Parrot_io_eprintf(interp, "%Ss\n", errstr); } Parrot_unblock_GC_mark(interp); Parrot_unblock_GC_sweep(interp); if (scriptname) PDB_script_file(interp, scriptname); else PDB_printwelcome(); Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "debugger")); PDB_run_code(interp, argc - nextarg, argv + nextarg); Parrot_x_exit(interp, 0); }
/* This works out an allocation strategy for the object. It takes care of * "inlining" storage of attributes that are natively typed, as well as * noting unbox targets. */ static void compute_allocation_strategy(PARROT_INTERP, PMC *repr_info, CStructREPRData *repr_data) { STRING *type_str = Parrot_str_new_constant(interp, "type"); PMC *flat_list; /* * We have to block GC mark here. Because "repr" is assotiated with some * PMC which is not accessible in this function. And we have to write * barrier this PMC because we are poking inside it guts directly. We * do have WB in caller function, but it can be triggered too late is * any of allocation will cause GC run. * * This is kind of minor evil until after I'll find better solution. */ Parrot_block_GC_mark(interp); /* Compute index mapping table and get flat list of attributes. */ flat_list = index_mapping_and_flat_list(interp, repr_info, repr_data); /* If we have no attributes in the index mapping, then just the header. */ if (repr_data->name_to_index_mapping[0].class_key == NULL) { repr_data->struct_size = 1; /* avoid 0-byte malloc */ } /* Otherwise, we need to compute the allocation strategy. */ else { /* We track the size of the struct, which is what we'll want offsets into. */ INTVAL cur_size = 0; /* Get number of attributes and set up various counters. */ INTVAL num_attrs = VTABLE_elements(interp, flat_list); INTVAL info_alloc = num_attrs == 0 ? 1 : num_attrs; INTVAL cur_obj_attr = 0; INTVAL cur_str_attr = 0; INTVAL cur_init_slot = 0; INTVAL i; /* Allocate location/offset arrays and GC mark info arrays. */ repr_data->num_attributes = num_attrs; repr_data->attribute_locations = (INTVAL *) mem_sys_allocate(info_alloc * sizeof(INTVAL)); repr_data->struct_offsets = (INTVAL *) mem_sys_allocate(info_alloc * sizeof(INTVAL)); repr_data->flattened_stables = (STable **) mem_sys_allocate_zeroed(info_alloc * sizeof(PMC *)); repr_data->member_types = (PMC** ) mem_sys_allocate_zeroed(info_alloc * sizeof(PMC *)); /* Go over the attributes and arrange their allocation. */ for (i = 0; i < num_attrs; i++) { /* Fetch its type; see if it's some kind of unboxed type. */ PMC *attr = VTABLE_get_pmc_keyed_int(interp, flat_list, i); PMC *type = VTABLE_get_pmc_keyed_str(interp, attr, type_str); INTVAL type_id = REPR(type)->ID; INTVAL bits = sizeof(void *) * 8; INTVAL align = ALIGNOF1(void *); if (!PMC_IS_NULL(type)) { /* See if it's a type that we know how to handle in a C struct. */ storage_spec spec = REPR(type)->get_storage_spec(interp, STABLE(type)); if (spec.inlineable == STORAGE_SPEC_INLINED && (spec.boxed_primitive == STORAGE_SPEC_BP_INT || spec.boxed_primitive == STORAGE_SPEC_BP_NUM)) { /* It's a boxed int or num; pretty easy. It'll just live in the * body of the struct. Instead of masking in i here (which * would be the parallel to how we handle boxed types) we * repurpose it to store the bit-width of the type, so * that get_attribute_ref can find it later. */ bits = spec.bits; align = spec.align; if (bits % 8) { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "CStruct only supports native types that are a multiple of 8 bits wide (was passed: %ld)", bits); } repr_data->attribute_locations[i] = (bits << CSTRUCT_ATTR_SHIFT) | CSTRUCT_ATTR_IN_STRUCT; repr_data->flattened_stables[i] = STABLE(type); if (REPR(type)->initialize) { if (!repr_data->initialize_slots) repr_data->initialize_slots = (INTVAL *) mem_sys_allocate_zeroed((info_alloc + 1) * sizeof(INTVAL)); repr_data->initialize_slots[cur_init_slot] = i; cur_init_slot++; } } else if(spec.can_box & STORAGE_SPEC_CAN_BOX_STR) { /* It's a string of some kind. */ repr_data->num_child_objs++; repr_data->attribute_locations[i] = (cur_obj_attr++ << CSTRUCT_ATTR_SHIFT) | CSTRUCT_ATTR_STRING; repr_data->member_types[i] = type; } else if(type_id == get_ca_repr_id()) { /* It's a CArray of some kind. */ repr_data->num_child_objs++; repr_data->attribute_locations[i] = (cur_obj_attr++ << CSTRUCT_ATTR_SHIFT) | CSTRUCT_ATTR_CARRAY; repr_data->member_types[i] = type; } else if(type_id == get_cs_repr_id()) { /* It's a CStruct. */ repr_data->num_child_objs++; repr_data->attribute_locations[i] = (cur_obj_attr++ << CSTRUCT_ATTR_SHIFT) | CSTRUCT_ATTR_CSTRUCT; repr_data->member_types[i] = type; } else if(type_id == get_cp_repr_id()) { /* It's a CPointer. */ repr_data->num_child_objs++; repr_data->attribute_locations[i] = (cur_obj_attr++ << CSTRUCT_ATTR_SHIFT) | CSTRUCT_ATTR_CPTR; repr_data->member_types[i] = type; } else { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "CStruct representation only implements native int and float members so far"); } } else { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "CStruct representation requires the types of all attributes to be specified"); } /* Do allocation. */ /* C structure needs careful alignment. If cur_size is not aligned * to align bytes (cur_size % align), make sure it is before we * add the next element. */ if (cur_size % align) { cur_size += align - cur_size % align; } repr_data->struct_offsets[i] = cur_size; cur_size += bits / 8; } /* Finally, put computed allocation size in place; it's body size plus * header size. Also number of markables and sentinels. */ repr_data->struct_size = cur_size; if (repr_data->initialize_slots) repr_data->initialize_slots[cur_init_slot] = -1; } Parrot_unblock_GC_mark(interp); }
int main(int argc, const char *argv[]) { int nextarg; Parrot_Interp interp; PDB_t *pdb; const char *scriptname = NULL; interp = Parrot_interp_new(NULL); Parrot_debugger_init(interp); pdb = interp->pdb; pdb->state = PDB_ENTER; Parrot_block_GC_mark(interp); Parrot_block_GC_sweep(interp); nextarg = 1; if (argv[nextarg] && strcmp(argv[nextarg], "--script") == 0) { scriptname = argv [++nextarg]; ++nextarg; } if (argv[nextarg]) { const char * const filename = argv[nextarg]; if (*filename == '-') { fprintf(stderr, "parrot_debugger takes no -x or --xxxx flag arguments\n"); exit(1); } else { STRING * const filename_str = Parrot_str_new(interp, filename, 0); PackFile * const pfraw = Parrot_pf_read_pbc_file(interp, filename_str); Parrot_PackFile pf; if (pfraw == NULL) return 1; pf = Parrot_pf_get_packfile_pmc(interp, pfraw, filename_str); if (pf == NULL) return 1; Parrot_pf_set_current_packfile(interp, pf); Parrot_pf_prepare_packfile_init(interp, pf); } } else { /* Generate some code to be able to enter into runloop */ STRING * const compiler_s = Parrot_str_new_constant(interp, "PIR"); PMC * const compiler = Parrot_interp_get_compiler(interp, compiler_s); STRING * const source = Parrot_str_new_constant(interp, ".sub aux :main\nexit 0\n.end\n"); PMC * const code = Parrot_interp_compile_string(interp, compiler, source); if (PMC_IS_NULL(code)) Parrot_warn(interp, PARROT_WARNINGS_NONE_FLAG, "Unexpected compiler problem at debugger start"); } Parrot_unblock_GC_mark(interp); Parrot_unblock_GC_sweep(interp); if (scriptname) PDB_script_file(interp, scriptname); else PDB_printwelcome(); Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "debugger")); PDB_run_code(interp, argc - nextarg, argv + nextarg); Parrot_x_exit(interp, 0); }