static QUEUE_ENTRY*
dup_entry(QUEUE_ENTRY* entry)
{
parrot_event *event;
QUEUE_ENTRY *new_entry;
new_entry = mem_sys_allocate(sizeof(QUEUE_ENTRY));
new_entry->next = NULL;
new_entry->type = entry->type;
event = new_entry->data = mem_sys_allocate(sizeof(parrot_event));
mem_sys_memcopy(event, entry->data, sizeof(parrot_event));
return new_entry;
}
/*
=item C<static void add_to_cache(PARROT_INTERP, NQP_md_cache *cache, PMC *capture, INTVAL num_args)>
Adds an entry to the multi-dispatch cache.
=cut
*/
void add_to_cache(PARROT_INTERP, NQP_md_cache *cache, PMC *capture, INTVAL num_args, PMC *result) {
INTVAL arg_tup[MD_CACHE_MAX_ARITY];
INTVAL i, entries, ins_type;
struct Pcc_cell * pc_positionals;
/* Make sure 6model type ID is set. */
if (!smo_id)
smo_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "SixModelObject", 0));
/* If it's zero arity, just stick it in that slot. */
if (num_args == 0) {
cache->zero_arity = result;
return;
}
/* If the cache is saturated, don't do anything (we could instead do a random
* replacement). */
entries = cache->arity_caches[num_args - 1].num_entries;
if (entries == MD_CACHE_MAX_ENTRIES)
return;
/* Create arg tuple. */
if (capture->vtable->base_type == enum_class_CallContext)
GETATTR_CallContext_positionals(interp, capture, pc_positionals);
else
return;
for (i = 0; i < num_args; i++) {
if (pc_positionals[i].type == BIND_VAL_OBJ) {
PMC *arg = pc_positionals[i].u.p;
if (arg->vtable->base_type != smo_id)
return;
arg_tup[i] = STABLE(arg)->type_cache_id | (IS_CONCRETE(arg) ? 1 : 0);
}
else {
arg_tup[i] = (pc_positionals[i].type << 1) | 1;
}
}
/* If there's no entries yet, need to do some allocation. */
if (entries == 0) {
cache->arity_caches[num_args - 1].type_ids = mem_sys_allocate(num_args * sizeof(INTVAL) * MD_CACHE_MAX_ENTRIES);
cache->arity_caches[num_args - 1].results = mem_sys_allocate(sizeof(PMC *) * MD_CACHE_MAX_ENTRIES);
}
/* Add entry. */
ins_type = entries * num_args;
for (i = 0; i < num_args; i++)
cache->arity_caches[num_args - 1].type_ids[ins_type + i] = arg_tup[i];
cache->arity_caches[num_args - 1].results[entries] = result;
cache->arity_caches[num_args - 1].num_entries = entries + 1;
}
/* Deserializes the data. */
static void deserialize(PARROT_INTERP, STable *st, void *data, SerializationReader *reader) {
NFABody *body = (NFABody *)data;
INTVAL i, j;
/* Read fates. */
body->fates = reader->read_ref(interp, reader);
/* Read number of states. */
body->num_states = reader->read_int(interp, reader);
if (body->num_states > 0) {
/* Read state edge list counts. */
body->num_state_edges = mem_sys_allocate(body->num_states * sizeof(INTVAL));
for (i = 0; i < body->num_states; i++)
body->num_state_edges[i] = reader->read_int(interp, reader);
/* Read state graph. */
body->states = mem_sys_allocate(body->num_states * sizeof(NFAStateInfo *));
for (i = 0; i < body->num_states; i++) {
INTVAL edges = body->num_state_edges[i];
if (edges > 0)
body->states[i] = mem_sys_allocate(edges * sizeof(NFAStateInfo));
for (j = 0; j < edges; j++) {
body->states[i][j].act = reader->read_int(interp, reader);
body->states[i][j].to = reader->read_int(interp, reader);
switch (body->states[i][j].act) {
case EDGE_FATE:
case EDGE_CODEPOINT:
case EDGE_CODEPOINT_NEG:
case EDGE_CHARCLASS:
case EDGE_CHARCLASS_NEG:
body->states[i][j].arg.i = reader->read_int(interp, reader);
break;
case EDGE_CHARLIST:
case EDGE_CHARLIST_NEG:
body->states[i][j].arg.s = reader->read_str(interp, reader);
break;
case EDGE_CODEPOINT_I:
case EDGE_CODEPOINT_I_NEG:
case EDGE_CHARRANGE:
case EDGE_CHARRANGE_NEG: {
body->states[i][j].arg.uclc.lc = reader->read_int(interp, reader);
body->states[i][j].arg.uclc.uc = reader->read_int(interp, reader);
break;
}
}
}
}
}
}
/*
* create and schedule a signal event
*/
static void
schedule_signal_event(int signum)
{
parrot_event* ev = mem_sys_allocate(sizeof(parrot_event));
QUEUE_ENTRY *entry;
entry = mem_sys_allocate(sizeof(QUEUE_ENTRY));
entry->next = NULL;
entry->type = QUEUE_ENTRY_TYPE_EVENT;
ev->type = EVENT_TYPE_SIGNAL;
ev->u.signal = signum;
entry->data = ev;
/*
* deliver to all intrepreters
*/
Parrot_schedule_broadcast_qentry(entry);
}
void
Parrot_new_terminate_event(Parrot_Interp interpreter)
{
parrot_event* ev = mem_sys_allocate(sizeof(parrot_event));
ev->type = EVENT_TYPE_TERMINATE;
ev->data = NULL;
Parrot_schedule_event(interpreter, ev);
}
void
Parrot_kill_event_loop(void)
{
parrot_event* ev = mem_sys_allocate(sizeof(parrot_event));
ev->type = EVENT_TYPE_EVENT_TERMINATE;
ev->data = NULL;
Parrot_schedule_event(NULL, ev);
}
void
chartype_init()
{
chartype_count = enum_chartype_MAX;
chartype_array = mem_sys_allocate(sizeof(CHARTYPE*) * chartype_count);
chartype_register(&unicode_chartype);
chartype_register(&usascii_chartype);
}
static char *
malloc_and_strcpy(const char *in)
{
size_t len = strlen(in);
char *out = mem_sys_allocate(len+1);
strcpy(out, in);
return out;
}
void
Parrot_new_cb_event(Parrot_Interp interpreter, PMC* cbi, void* ext)
{
parrot_event* ev = mem_sys_allocate(sizeof(parrot_event));
ev->type = EVENT_TYPE_CALL_BACK;
ev->u.call_back.cbi = cbi;
ev->u.call_back.external_data = ext;
Parrot_schedule_event(interpreter, ev);
}
INTVAL
Parrot_Run_OS_Command_Argv(PARROT_INTERP, PMC *cmdargs)
{
DWORD status = 0;
STARTUPINFO si;
PROCESS_INFORMATION pi;
int pmclen;
int cmdlinelen = 1000;
int cmdlinepos = 0;
char *cmdline = (char *)mem_sys_allocate(cmdlinelen);
int i;
/* Ensure there's something in the PMC array. */
pmclen = VTABLE_elements(interp, cmdargs);
if (pmclen == 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Empty argument array for spawnw");
/* Now build command line. */
for (i = 0; i < pmclen; i++) {
STRING * const s = VTABLE_get_string_keyed_int(interp, cmdargs, i);
char * const cs = Parrot_str_to_cstring(interp, s);
if (cmdlinepos + (int)s->strlen + 3 > cmdlinelen) {
cmdlinelen += s->strlen + 4;
cmdline = (char *)mem_sys_realloc(cmdline, cmdlinelen);
}
strcpy(cmdline + cmdlinepos, "\"");
strcpy(cmdline + cmdlinepos + 1, cs);
strcpy(cmdline + cmdlinepos + 1 + s->strlen, "\" ");
cmdlinepos += s->strlen + 3;
}
/* Start the child process. */
memset(&si, 0, sizeof (si));
si.cb = sizeof (si);
memset(&pi, 0, sizeof (pi));
if (!CreateProcess(NULL, cmdline, NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Can't spawn child process");
WaitForSingleObject(pi.hProcess, INFINITE);
/* Get exit code. */
if (!GetExitCodeProcess(pi.hProcess, &status)) {
Parrot_warn(interp, PARROT_WARNINGS_PLATFORM_FLAG,
"Process completed: Failed to get exit code.");
}
/* Clean up. */
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
mem_sys_free(cmdline);
/* Return exit code left shifted by 8 for POSIX emulation. */
return status << 8;
}
/* Registers a representation. It this is ever made public, it should first be
* made thread-safe. */
static void register_repr(PARROT_INTERP, STRING *name, REPROps *repr) {
INTVAL ID = num_reprs;
num_reprs++;
if (repr_registry)
repr_registry = mem_sys_realloc(repr_registry, num_reprs * sizeof(REPROps *));
else
repr_registry = mem_sys_allocate(num_reprs * sizeof(REPROps *));
repr_registry[ID] = repr;
VTABLE_set_integer_keyed_str(interp, repr_name_to_id_map, name, ID);
}
void
mem_setup_allocator(struct Parrot_Interp *interpreter)
{
interpreter->arena_base = mem_sys_allocate(sizeof(struct Arenas));
interpreter->arena_base->sized_header_pools = NULL;
interpreter->arena_base->num_sized = 0;
Parrot_initialize_memory_pools(interpreter);
Parrot_initialize_header_pools(interpreter);
}
/* Serializes the data. */
static void serialize(PARROT_INTERP, STable *st, void *data, SerializationWriter *writer) {
mp_int *i = &((P6bigintBody *)data)->i;
int len;
char *buf;
mp_radix_size(i, 10, &len);
buf = (char *) mem_sys_allocate(len);
mp_toradix_n(i, buf, 10, len);
/* len - 1 because buf is \0-terminated */
writer->write_str(interp, writer, Parrot_str_new(interp, buf, len - 1));
mem_sys_free(buf);
}
/* Copies to the body of one object to another. */
static void copy_to(PARROT_INTERP, STable *st, void *src, void *dest) {
NativeCallBody *src_body = (NativeCallBody *)src;
NativeCallBody *dest_body = (NativeCallBody *)dest;
/* Need a fresh handle for resource management purposes. */
if (src_body->lib_name) {
dest_body->lib_name = mem_sys_allocate(strlen(src_body->lib_name) + 1);
strcpy(dest_body->lib_name, src_body->lib_name);
dest_body->lib_handle = dlLoadLibrary(dest_body->lib_name);
}
/* Rest is just simple copying. */
dest_body->entry_point = src_body->entry_point;
dest_body->convention = src_body->convention;
dest_body->num_args = src_body->num_args;
if (src_body->arg_types) {
dest_body->arg_types = mem_sys_allocate(src_body->num_args * sizeof(INTVAL));
memcpy(dest_body->arg_types, src_body->arg_types, src_body->num_args * sizeof(INTVAL));
}
dest_body->ret_type = src_body->ret_type;
}
int
Parrot_on_exit(void (*function)(int , void *), void *arg) {
/* XXX we might want locking around the list access. I'm sure this
* will be the least of the threading issues. */
handler_node_t* new_node = mem_sys_allocate(sizeof(handler_node_t));
new_node->function = function;
new_node->arg = arg;
new_node->next = exit_handler_list;
exit_handler_list = new_node;
return 0;
}
/* Composes the meta-object. */
static void compose(PARROT_INTERP, PMC *nci) {
PMC * unused;
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0);
PMC *obj = VTABLE_get_pmc_keyed_int(interp, capture, 1);
STABLE(obj)->method_cache = ((KnowHOWREPRInstance *)PMC_data(self))->body.methods;
STABLE(obj)->mode_flags = METHOD_CACHE_AUTHORITATIVE;
STABLE(obj)->type_check_cache_length = 1;
STABLE(obj)->type_check_cache = (PMC **)mem_sys_allocate(sizeof(PMC *));
STABLE(obj)->type_check_cache[0] = obj;
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", obj);
}
/* Copies to the body of one object to another. */
static void copy_to(PARROT_INTERP, STable *st, void *src, void *dest) {
NFABody *src_body = (NFABody *)src;
NFABody *dest_body = (NFABody *)dest;
INTVAL i;
dest_body->fates = src_body->fates;
dest_body->num_states = src_body->num_states;
if (dest_body->num_state_edges > 0)
dest_body->num_state_edges = mem_sys_allocate(dest_body->num_states * sizeof(INTVAL));
for (i = 0; i < dest_body->num_states; i++)
dest_body->num_state_edges[i] = src_body->num_state_edges[i];
dest_body->states = mem_sys_allocate(dest_body->num_states * sizeof(NFAStateInfo *));
for (i = 0; i < dest_body->num_states; i++) {
INTVAL size = dest_body->num_state_edges[i] * sizeof(NFAStateInfo);
if (size > 0) {
dest_body->states[i] = mem_sys_allocate(size);
memcpy(dest_body->states[i], src_body->states[i], size);
}
}
}
char *
PF_fetch_cstring(struct PackFile *pf, opcode_t **cursor)
{
size_t str_len = strlen ((char *)(*cursor)) + 1;
char *p = mem_sys_allocate(str_len);
if (p) {
int wordsize = pf->header->wordsize;
strcpy(p, (char*) (*cursor));
*((unsigned char **) (cursor)) += ROUND_UP_B(str_len, wordsize);
}
return p;
}
void
Parrot_new_timer_event(Parrot_Interp interpreter, PMC* timer, FLOATVAL diff,
FLOATVAL interval, int repeat, PMC* sub, parrot_event_type_enum typ)
{
parrot_event* ev = mem_sys_allocate(sizeof(parrot_event));
FLOATVAL now = Parrot_floatval_time();
ev->type = typ;
ev->data = timer;
ev->u.timer_event.abs_time = now + diff;
ev->u.timer_event.interval = interval;
ev->u.timer_event.repeat = repeat;
if (repeat && !interval)
ev->u.timer_event.interval = diff;
ev->u.timer_event.sub = sub;
Parrot_schedule_event(interpreter, ev);
}
/* Initialize a new instance. */
static void initialize(PARROT_INTERP, STable *st, void *data) {
CStructREPRData * repr_data = (CStructREPRData *) st->REPR_data;
/* Allocate object body. */
CStructBody *body = (CStructBody *)data;
body->cstruct = mem_sys_allocate(repr_data->struct_size > 0 ? repr_data->struct_size : 1);
memset(body->cstruct, 0, repr_data->struct_size);
/* Initialize the slots. */
if (repr_data->initialize_slots) {
INTVAL i;
for (i = 0; repr_data->initialize_slots[i] >= 0; i++) {
INTVAL offset = repr_data->struct_offsets[repr_data->initialize_slots[i]];
STable *st = repr_data->flattened_stables[repr_data->initialize_slots[i]];
st->REPR->initialize(interp, st, (char *)body->cstruct + offset);
}
}
}
/* Registers a representation. It this is ever made public, it should first be
* made thread-safe. */
static void register_repr(PARROT_INTERP, STRING *name, REPROps *repr) {
INTVAL ID = num_reprs;
num_reprs++;
if (repr_registry)
repr_registry = mem_sys_realloc(repr_registry, num_reprs * sizeof(REPROps *));
else
repr_registry = mem_sys_allocate(num_reprs * sizeof(REPROps *));
repr_registry[ID] = repr;
VTABLE_set_integer_keyed_str(interp, repr_name_to_id_map, name, ID);
repr->ID = ID;
repr->name = name;
if (!repr->attr_funcs)
add_default_attr_funcs(interp, repr);
if (!repr->box_funcs)
add_default_box_funcs(interp, repr);
if (!repr->idx_funcs)
add_default_idx_funcs(interp, repr);
}
STRING *
Parrot_getenv(PARROT_INTERP, ARGIN(STRING *str_name))
{
char * const name = Parrot_str_to_cstring(interp, str_name);
const DWORD size = GetEnvironmentVariable(name, NULL, 0);
char *buffer = NULL;
STRING *retv;
if (size == 0) {
Parrot_str_free_cstring(name);
return NULL;
}
buffer = (char *)mem_sys_allocate(size);
GetEnvironmentVariable(name, buffer, size);
Parrot_str_free_cstring(name);
retv = Parrot_str_from_platform_cstring(interp, buffer);
mem_sys_free(buffer);
return retv;
}
static char*
argv_join(char ** argv)
{
char* command;
char* p;
int space = 0;
int i;
for (i = 0; argv[i]; i++)
space += strlen(argv[i]) + 1;
command = (char*) mem_sys_allocate(space == 0 ? 1 : space);
p = command;
for (i = 0; argv[i]; i++) {
strcpy(p, argv[i]);
p += strlen(argv[i]);
*(p++) = ' ';
}
if (p > command) p--;
*p = '\0';
return command;
}
INTVAL
Parrot_Run_OS_Command(PARROT_INTERP, STRING *command)
{
DWORD status = 0;
STARTUPINFO si;
PROCESS_INFORMATION pi;
char* const cmd = (char *)mem_sys_allocate(command->strlen + 4);
char* const shell = Parrot_getenv(interp, Parrot_str_new(interp, "ComSpec", strlen("ComSpec")));
char* const cmdin = Parrot_str_to_cstring(interp, command);
strcpy(cmd, "/c ");
strcat(cmd, cmdin);
Parrot_str_free_cstring(cmdin);
memset(&si, 0, sizeof (si));
si.cb = sizeof (si);
memset(&pi, 0, sizeof (pi));
/* Start the child process. */
if (!CreateProcess(shell, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Can't spawn child process");
WaitForSingleObject(pi.hProcess, INFINITE);
if (!GetExitCodeProcess(pi.hProcess, &status)) {
Parrot_warn(interp, PARROT_WARNINGS_PLATFORM_FLAG,
"Process completed: Failed to get exit code.");
}
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
Parrot_str_free_cstring(shell);
mem_sys_free(cmd);
/* Return exit code left shifted by 8 for POSIX emulation. */
return status << 8;
}
/* Composes the meta-object. */
static void compose(PARROT_INTERP, PMC *nci) {
PMC *repr_info_hash, *repr_info, *type_info, *attr_list, *attr_iter, *unused;
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0);
PMC *obj = VTABLE_get_pmc_keyed_int(interp, capture, 1);
UNUSED(nci);
/* Do REPR composition. */
repr_info = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
type_info = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
VTABLE_push_pmc(interp, repr_info, type_info);
VTABLE_push_pmc(interp, type_info, obj);
attr_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
attr_iter = VTABLE_get_iter(interp, ((KnowHOWREPRInstance *)PMC_data(self))->body.attributes);
while (VTABLE_get_bool(interp, attr_iter)) {
PMC *attr = VTABLE_shift_pmc(interp, attr_iter);
PMC *attr_hash = Parrot_pmc_new(interp, enum_class_Hash);;
VTABLE_set_string_keyed_str(interp, attr_hash, name_str,
REPR(attr)->box_funcs->get_str(interp, STABLE(attr), OBJECT_BODY(attr)));
VTABLE_push_pmc(interp, attr_list, attr_hash);
}
VTABLE_push_pmc(interp, type_info, attr_list);
VTABLE_push_pmc(interp, type_info, Parrot_pmc_new(interp, enum_class_ResizablePMCArray));
repr_info_hash = Parrot_pmc_new(interp, enum_class_Hash);
VTABLE_set_pmc_keyed_str(interp, repr_info_hash, attribute_str, repr_info);
REPR(obj)->compose(interp, STABLE(obj), repr_info_hash);
/* Set up method and type caches. */
STABLE(obj)->method_cache = ((KnowHOWREPRInstance *)PMC_data(self))->body.methods;
STABLE(obj)->mode_flags = METHOD_CACHE_AUTHORITATIVE;
STABLE(obj)->type_check_cache_length = 1;
STABLE(obj)->type_check_cache = (PMC **)mem_sys_allocate(sizeof(PMC *));
STABLE(obj)->type_check_cache[0] = obj;
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", obj);
}
void
Parrot_schedule_event(Parrot_Interp interpreter, parrot_event* ev)
{
QUEUE_ENTRY* entry = mem_sys_allocate(sizeof(QUEUE_ENTRY));
entry->next = NULL;
ev->interp = interpreter;
entry->data = ev;
switch (ev->type) {
case EVENT_TYPE_TIMER:
case EVENT_TYPE_SLEEP:
entry->type = QUEUE_ENTRY_TYPE_TIMED_EVENT;
insert_entry(event_queue, entry);
break;
case EVENT_TYPE_CALL_BACK:
case EVENT_TYPE_SIGNAL:
entry->type = QUEUE_ENTRY_TYPE_EVENT;
unshift_entry(event_queue, entry);
break;
default:
entry->type = QUEUE_ENTRY_TYPE_EVENT;
push_entry(event_queue, entry);
break;
}
}
struct PackFile *
Parrot_readbc(struct Parrot_Interp *interpreter, const char *filename)
{
#if PARROT_HAS_HEADER_UNISTD
off_t program_size, wanted;
#else
size_t program_size, wanted;
#endif
char *program_code;
struct PackFile *pf;
PMC * io = NULL;
INTVAL is_mapped = 0;
#ifdef PARROT_HAS_HEADER_SYSSTAT
struct stat file_stat;
#endif
#ifdef PARROT_HAS_HEADER_SYSMMAN
int fd = -1;
#endif
if (filename == NULL || strcmp(filename, "-") == 0) {
/* read from STDIN */
io = PIO_STDIN(interpreter);
/* read 1k at a time */
program_size = 0;
}
else {
#ifdef PARROT_HAS_HEADER_SYSSTAT
/* if we have stat(), get the actual file size so we can read it
* in one chunk. */
if (stat(filename, &file_stat)) {
PIO_eprintf(interpreter, "Parrot VM: Can't stat %s, code %i.\n",
filename, errno);
return NULL;
}
# ifndef PARROT_HAS_BROKEN_ISREG
/* S_ISREG is strangely broken my lcc/linux install (though it did
* once work */
if (!S_ISREG(file_stat.st_mode)) {
PIO_eprintf(interpreter, "Parrot VM: %s is not a normal file.\n",
filename);
return NULL;
}
# endif /* PARROT_HAS_BROKEN_ISREG */
program_size = file_stat.st_size;
#else /* PARROT_HAS_HEADER_SYSSTAT */
/* otherwise, we will read it 1k at a time */
program_size = 0;
#endif /* PARROT_HAS_HEADER_SYSSTAT */
#ifndef PARROT_HAS_HEADER_SYSMMAN
io = PIO_open(interpreter, NULL, filename, "<");
if (!io) {
PIO_eprintf(interpreter, "Parrot VM: Can't open %s, code %i.\n",
filename, errno);
return NULL;
}
#else /* PARROT_HAS_HEADER_SYSMMAN */
/* the file wasn't from stdin, and we have mmap available- use it */
io = NULL;
#endif /* PARROT_HAS_HEADER_SYSMMAN */
interpreter->current_file = string_make(interpreter, filename,
strlen(filename), NULL, 0, NULL);
}
#ifdef PARROT_HAS_HEADER_SYSMMAN
again:
#endif
/* if we've opened a file (or stdin) with PIO, read it in */
if (io != NULL) {
size_t chunk_size;
char *cursor;
INTVAL read_result;
chunk_size = program_size > 0 ? program_size : 1024;
program_code = (char *)mem_sys_allocate(chunk_size);
wanted = program_size;
program_size = 0;
if (!program_code) {
/* Whoops, out of memory. */
PIO_eprintf(interpreter,
"Parrot VM: Could not allocate buffer to read packfile from PIO.\n");
return NULL;
}
cursor = (char *)program_code;
while ((read_result =
PIO_read(interpreter, io, cursor, chunk_size)) > 0) {
program_size += read_result;
if (program_size == wanted)
break;
chunk_size = 1024;
program_code =
mem_sys_realloc(program_code, program_size + chunk_size);
if (!program_code) {
PIO_eprintf(interpreter,
"Parrot VM: Could not reallocate buffer while reading packfile from PIO.\n");
return NULL;
}
cursor = (char *)program_code + program_size;
}
if (read_result < 0) {
PIO_eprintf(interpreter,
"Parrot VM: Problem reading packfile from PIO.\n");
return NULL;
}
PIO_close(interpreter, io);
}
else {
/* if we've gotten here, we opted not to use PIO to read the file.
* use mmap */
#ifdef PARROT_HAS_HEADER_SYSMMAN
fd = open(filename, O_RDONLY | O_BINARY);
if (!fd) {
PIO_eprintf(interpreter, "Parrot VM: Can't open %s, code %i.\n",
filename, errno);
return NULL;
}
program_code =
mmap(0, program_size, PROT_READ, MAP_SHARED, fd, (off_t)0);
if (program_code == (void *)MAP_FAILED) {
Parrot_warn(interpreter, PARROT_WARNINGS_IO_FLAG,
"Parrot VM: Can't mmap file %s, code %i.\n",
filename, errno);
/* try again, now with IO reading the file */
io = PIO_open(interpreter, NULL, filename, "<");
if (!io) {
PIO_eprintf(interpreter,
"Parrot VM: Can't open %s, code %i.\n",
filename, errno);
return NULL;
}
goto again;
}
is_mapped = 1;
#else /* PARROT_HAS_HEADER_SYSMMAN */
PIO_eprintf(interpreter, "Parrot VM: uncaught error occurred reading "
"file or mmap not available.\n");
return NULL;
#endif /* PARROT_HAS_HEADER_SYSMMAN */
}
/* Now that we have the bytecode, let's unpack it. */
pf = PackFile_new(is_mapped);
if (!PackFile_unpack
(interpreter, pf, (opcode_t *)program_code, program_size)) {
PIO_eprintf(interpreter, "Parrot VM: Can't unpack packfile %s.\n",
filename);
return NULL;
}
#ifdef PARROT_HAS_HEADER_SYSMMAN
if (fd >= 0) {
close(fd); /* the man page states, it's ok to close a mmaped file */
}
#else
/* XXX Parrot_exec uses this
mem_sys_free(program_code); */
#endif
return pf;
}
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static STRING *
to_encoding(PARROT_INTERP, ARGIN(STRING *src), ARGIN_NULLOK(STRING *dest))
{
ASSERT_ARGS(to_encoding)
#if PARROT_HAS_ICU
UErrorCode err;
int dest_len;
UChar *p;
#endif
int src_len;
int in_place = dest == NULL;
STRING *result;
if (src->encoding == Parrot_utf16_encoding_ptr ||
src->encoding == Parrot_ucs2_encoding_ptr)
return in_place ? src : Parrot_str_copy(interp, src);
/*
* TODO adapt string creation functions
*/
src_len = src->strlen;
if (in_place) {
result = src;
}
else {
result = dest;
}
if (!src_len) {
result->charset = Parrot_unicode_charset_ptr;
result->encoding = Parrot_ucs2_encoding_ptr;
result->strlen = result->bufused = 0;
return result;
}
/*
u_strFromUTF8(UChar *dest,
int32_t destCapacity,
int32_t *pDestLength,
const char *src,
int32_t srcLength,
UErrorCode *pErrorCode);
*/
#if PARROT_HAS_ICU
if (in_place) {
/* need intermediate memory */
p = (UChar *)mem_sys_allocate(src_len * sizeof (UChar));
}
else {
Parrot_gc_reallocate_string_storage(interp, dest, sizeof (UChar) * src_len);
p = (UChar *)dest->strstart;
}
if (src->charset == Parrot_iso_8859_1_charset_ptr ||
src->charset == Parrot_ascii_charset_ptr) {
for (dest_len = 0; dest_len < (int)src->strlen; ++dest_len) {
p[dest_len] = (UChar)((unsigned char*)src->strstart)[dest_len];
}
}
else {
err = U_ZERO_ERROR;
u_strFromUTF8(p, src_len,
&dest_len, src->strstart, src->bufused, &err);
if (!U_SUCCESS(err)) {
/*
* have to resize - required len in UChars is in dest_len
*/
if (in_place)
p = (UChar *)mem_sys_realloc(p, dest_len * sizeof (UChar));
else {
result->bufused = dest_len * sizeof (UChar);
Parrot_gc_reallocate_string_storage(interp, dest,
sizeof (UChar) * dest_len);
p = (UChar *)dest->strstart;
}
u_strFromUTF8(p, dest_len,
&dest_len, src->strstart, src->bufused, &err);
PARROT_ASSERT(U_SUCCESS(err));
}
}
result->bufused = dest_len * sizeof (UChar);
if (in_place) {
Parrot_gc_reallocate_string_storage(interp, src, src->bufused);
memcpy(src->strstart, p, src->bufused);
mem_sys_free(p);
}
result->charset = Parrot_unicode_charset_ptr;
result->encoding = Parrot_utf16_encoding_ptr;
result->strlen = src_len;
/* downgrade if possible */
if (dest_len == (int)src->strlen)
result->encoding = Parrot_ucs2_encoding_ptr;
return result;
#else
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
"no ICU lib loaded");
#endif
}
/* 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);
}
/* Deserializes the data. */
static void deserialize_repr_data(PARROT_INTERP, STable *st, SerializationReader *reader) {
P6opaqueREPRData *repr_data = (P6opaqueREPRData *) (st->REPR_data = mem_sys_allocate_zeroed(sizeof(P6opaqueREPRData)));
INTVAL i, num_classes, cur_offset, cur_initialize_slot, cur_gc_mark_slot, cur_gc_cleanup_slot;
repr_data->num_attributes = reader->read_int(interp, reader);
repr_data->flattened_stables = (STable **)mem_sys_allocate(MAX(repr_data->num_attributes, 1) * sizeof(STable *));
for (i = 0; i < repr_data->num_attributes; i++)
if (reader->read_int(interp, reader))
repr_data->flattened_stables[i] = reader->read_stable_ref(interp, reader);
else
repr_data->flattened_stables[i] = NULL;
repr_data->mi = reader->read_int(interp, reader);
if (reader->read_int(interp, reader)) {
repr_data->auto_viv_values = (PMC **)mem_sys_allocate(MAX(repr_data->num_attributes, 1) * sizeof(PMC *));
for (i = 0; i < repr_data->num_attributes; i++)
repr_data->auto_viv_values[i] = reader->read_ref(interp, reader);
}
repr_data->unbox_int_slot = reader->read_int(interp, reader);
repr_data->unbox_num_slot = reader->read_int(interp, reader);
repr_data->unbox_str_slot = reader->read_int(interp, reader);
if (reader->read_int(interp, reader)) {
repr_data->unbox_slots = (P6opaqueBoxedTypeMap *)mem_sys_allocate(MAX(repr_data->num_attributes, 1) * sizeof(P6opaqueBoxedTypeMap));
for (i = 0; i < repr_data->num_attributes; i++) {
repr_data->unbox_slots[i].repr_id = reader->read_int(interp, reader);
repr_data->unbox_slots[i].slot = reader->read_int(interp, reader);
}
}
num_classes = reader->read_int(interp, reader);
repr_data->name_to_index_mapping = (P6opaqueNameMap *)mem_sys_allocate_zeroed((num_classes + 1) * sizeof(P6opaqueNameMap));
for (i = 0; i < num_classes; i++) {
repr_data->name_to_index_mapping[i].class_key = reader->read_ref(interp, reader);
repr_data->name_to_index_mapping[i].name_map = reader->read_ref(interp, reader);
}
/* Re-calculate the remaining info, which is platform specific or
* derived information. */
repr_data->attribute_offsets = (INTVAL *)mem_sys_allocate(MAX(repr_data->num_attributes, 1) * sizeof(INTVAL));
repr_data->gc_pmc_mark_offsets = (INTVAL *)mem_sys_allocate(MAX(repr_data->num_attributes, 1) * sizeof(INTVAL));
repr_data->initialize_slots = (INTVAL *)mem_sys_allocate((repr_data->num_attributes + 1) * sizeof(INTVAL));
repr_data->gc_mark_slots = (INTVAL *)mem_sys_allocate((repr_data->num_attributes + 1) * sizeof(INTVAL));
repr_data->gc_cleanup_slots = (INTVAL *)mem_sys_allocate((repr_data->num_attributes + 1) * sizeof(INTVAL));
repr_data->gc_pmc_mark_offsets_count = 0;
cur_offset = 0;
cur_initialize_slot = 0;
cur_gc_mark_slot = 0;
cur_gc_cleanup_slot = 0;
for (i = 0; i < repr_data->num_attributes; i++) {
repr_data->attribute_offsets[i] = cur_offset;
if (repr_data->flattened_stables[i] == NULL) {
/* Reference type. Needs marking. */
repr_data->gc_pmc_mark_offsets[repr_data->gc_pmc_mark_offsets_count] = cur_offset;
repr_data->gc_pmc_mark_offsets_count++;
/* Increment by pointer size. */
cur_offset += sizeof(PMC *);
}
else {
/* Set up flags for initialization and GC. */
STable *cur_st = repr_data->flattened_stables[i];
if (cur_st->REPR->initialize)
repr_data->initialize_slots[cur_initialize_slot++] = i;
if (cur_st->REPR->gc_mark)
repr_data->gc_mark_slots[cur_gc_mark_slot++] = i;
if (cur_st->REPR->gc_cleanup)
repr_data->gc_cleanup_slots[cur_gc_cleanup_slot++] = i;
/* Increment by size reported by representation. */
cur_offset += cur_st->REPR->get_storage_spec(interp, st).bits / 8;
}
}
repr_data->initialize_slots[cur_initialize_slot] = -1;
repr_data->gc_mark_slots[cur_gc_mark_slot] = -1;
repr_data->gc_cleanup_slots[cur_gc_cleanup_slot] = -1;
repr_data->allocation_size = sizeof(P6opaqueInstance) + cur_offset;
}
