/* 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);
}
