PARROT_EXPORT
void
string_set_data_directory(PARROT_INTERP, ARGIN(const char *dir))
{
    ASSERT_ARGS(string_set_data_directory)
#if PARROT_HAS_ICU
    u_setDataDirectory(dir);

    /* Since u_setDataDirectory doesn't have a result code, we'll spot
       check that everything is okay by making sure that '9' had decimal
       value 9. Using 57 rather than '9' so that the encoding of this
       source code file isn't an issue.... (Don't want to get bitten by
       EBCDIC.) */

    if (!u_isdigit(57) || (u_charDigitValue(57) != 9))
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ICU_ERROR,
            "string_set_data_directory: ICU data files not found"
            "(apparently) for directory [%s]", dir);
#else
    UNUSED(dir);

    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ICU_ERROR,
        "string_set_data_directory: parrot compiled without ICU support");
#endif
}

static INTVAL
utf16_partial_scan(PARROT_INTERP, ARGIN(const char *buf),
        ARGMOD(Parrot_String_Bounds *bounds))
{
    ASSERT_ARGS(utf16_partial_scan)
    const utf16_t * const p         = (const utf16_t *)buf;
    UINTVAL               len       = bounds->bytes >> 1;
    INTVAL                max_chars = bounds->chars;
    const INTVAL          delim     = bounds->delim;
    INTVAL                c         = -1;
    INTVAL                chars     = 0;
    INTVAL                res       = 0;
    UINTVAL               i;

    if (max_chars < 0)
        max_chars = len;

    for (i = 0; i < len && chars < max_chars; ++i) {
        c = p[i];

        if (UNICODE_IS_HIGH_SURROGATE(c)) {
            if (i + 1 >= len) {
                /* Two more bytes needed */
                res = 2;
                break;
            }

            ++i;

            if (!UNICODE_IS_LOW_SURROGATE(p[i]))
                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_UTF16,
                    "Malformed UTF-16 string\n");

            c = UNICODE_DECODE_SURROGATE(c, p[i]);
        }
        else {
            if (UNICODE_IS_LOW_SURROGATE(c))
                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_UTF16,
                    "Malformed UTF-16 string\n");
        }

        if (UNICODE_IS_NON_CHARACTER(c))
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_CHARACTER,
                "Non-character in UTF-16 string\n");

        ++chars;

        if (c == delim) {
            i += 1;
            break;
        }
    }

    bounds->bytes = i << 1;
    bounds->chars = chars;
    bounds->delim = c;

    return res;
}

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;
}

static UINTVAL
utf8_scan(PARROT_INTERP, ARGIN(const STRING *src))
{
    ASSERT_ARGS(utf8_scan)
    const utf8_t *u8ptr = (const utf8_t *)src->strstart;
    const utf8_t *u8end = (const utf8_t *)(src->strstart + src->bufused);
    UINTVAL characters = 0;

    while (u8ptr < u8end) {
        UINTVAL c = *u8ptr;

        if (UTF8_IS_START(c)) {
            size_t len = UTF8SKIP(u8ptr);
            size_t count;

            if (u8ptr + len > u8end)
                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_UTF8,
                    "Unaligned end in UTF-8 string\n");

            /* Check for overlong forms */
            if (UTF8_IS_OVERLONG(c, u8ptr[1]))
                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_UTF8,
                    "Overlong form in UTF-8 string\n");

            c &= UTF8_START_MASK(len);

            for (count = 1; count < len; ++count) {
                ++u8ptr;

                if (!UTF8_IS_CONTINUATION(*u8ptr))
                    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_UTF8,
                        "Malformed UTF-8 string\n");

                c = UTF8_ACCUMULATE(c, *u8ptr);
            }

            if (UNICODE_IS_INVALID(c))
                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_CHARACTER,
                    "Invalid character in UTF-8 string\n");
        }
        else if (!UNICODE_IS_INVARIANT(c)) {
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_UTF8,
                "Malformed UTF-8 string\n");
        }

        ++u8ptr;
        ++characters;
    }

    return characters;
}

/* Used with boxing. Gets a string value, for representations that can hold
 * one. */
static STRING * get_str(PARROT_INTERP, PMC *obj) {
    P6opaqueInstance *instance  = (P6opaqueInstance *)PMC_data(obj);
    P6opaqueREPRData *repr_data = (P6opaqueREPRData *)STABLE(obj)->REPR_data;
    if (repr_data->unbox_str_offset) {
        if (!instance->spill) {
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                "Cannot unbox type object to a native string");
        }
        return get_str_at_offset(instance, repr_data->unbox_str_offset);
    }
    else {
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "This type cannot unbox to a native string");
    }
}

INTVAL
Parrot_io_internal_send(PARROT_INTERP, PIOHANDLE os_handle, ARGIN(const char *buf),
        size_t len)
{
    int error, byteswrote;

    byteswrote = 0;
AGAIN:
    if ((error = send((PIOSOCKET)os_handle, buf + byteswrote, len, 0)) >= 0) {
        byteswrote += error;
        len        -= error;
        if (!len) {
            return byteswrote;
        }
        goto AGAIN;
    }
    else {
        switch (PIO_SOCK_ERRNO) {
          case PIO_SOCK_EINTR:
          case PIO_SOCK_EWOULDBLOCK:
            goto AGAIN;
          default:
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
                    "send failed: %Ss",
                    Parrot_platform_strerror(interp, PIO_SOCK_ERRNO));
        }
    }
}

PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
PIOHANDLE
Parrot_io_internal_accept(PARROT_INTERP, PIOHANDLE os_handle, ARGOUT(PMC * remote_addr))
{
    Parrot_Socklen_t addr_len = sizeof (struct sockaddr_storage);
    struct sockaddr_storage *addr =
        (struct sockaddr_storage *)Parrot_gc_allocate_memory_chunk(interp,
                                        addr_len);
    Parrot_Sockaddr_attributes *sa_attrs = PARROT_SOCKADDR(remote_addr);
    PIOSOCKET newsock;

    newsock = accept((PIOSOCKET)os_handle, (struct sockaddr *)addr, &addr_len);

    if (newsock == PIO_INVALID_SOCKET)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
                "accept failed: %Ss",
                Parrot_platform_strerror(interp, PIO_SOCK_ERRNO));

    sa_attrs->len     = addr_len;
    sa_attrs->pointer = addr;

    /* XXX FIXME: Need to do a getsockname and getpeername here to
     * fill in the sockaddr_in structs for local and peer */

    /* Optionally do a gethostbyaddr() to resolve remote IP address.
     * This should be based on an option set in the master socket */

    return (PIOHANDLE)newsock;
}

/* Used with boxing. Sets a floating point value, for representations that can
 * hold one. */
static void set_num(PARROT_INTERP, STable *st, void *data, FLOATVAL value) {
    UNUSED(st);
    UNUSED(data);
    UNUSED(value);
    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "CPointer cannot box a native num");
}

PARROT_CANNOT_RETURN_NULL
static STRING *
to_iso_8859_1(PARROT_INTERP, ARGIN(STRING *src), ARGMOD_NULLOK(STRING *dest))
{
    ASSERT_ARGS(to_iso_8859_1)
    UINTVAL offs, src_len;
    String_iter iter;

    ENCODING_ITER_INIT(interp, src, &iter);
    src_len = src->strlen;
    if (dest) {
        Parrot_gc_reallocate_string_storage(interp, dest, src_len);
        dest->strlen  = src_len;
    }
    else {
        /* iso-8859-1 is never bigger then source */
        dest = src;
    }
    dest->bufused = src_len;
    dest->charset = Parrot_iso_8859_1_charset_ptr;
    dest->encoding = Parrot_fixed_8_encoding_ptr;
    for (offs = 0; offs < src_len; ++offs) {
        const UINTVAL c = iter.get_and_advance(interp, &iter);
        if (c >= 0x100)
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LOSSY_CONVERSION,
                "lossy conversion to iso-8559-1");

        ENCODING_SET_BYTE(interp, dest, offs, c);
    }
    return dest;
}

static INTVAL
ucs4_partial_scan(PARROT_INTERP, ARGIN(const char *buf),
        ARGMOD(Parrot_String_Bounds *bounds))
{
    ASSERT_ARGS(ucs4_partial_scan)
    const utf32_t * const ptr = (const utf32_t *)buf;
    UINTVAL               len   = bounds->bytes >> 1;
    const INTVAL          chars = bounds->chars;
    const INTVAL          delim = bounds->delim;
    INTVAL                c     = -1;
    UINTVAL               i;

    if (chars >= 0 && (UINTVAL)chars < len)
        len = chars;

    for (i = 0; i < len; ++i) {
        c = ptr[i];

        if (UNICODE_IS_INVALID(c))
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_CHARACTER,
                    "Invalid character in UCS-4 string\n");

        if (c == delim) {
            len = i + 1;
            break;
        }
    }

    bounds->bytes = len << 2;
    bounds->chars = len;
    bounds->delim = c;

    return 0;
}

/* Gets the current value for an attribute. */
static PMC * get_attribute(PARROT_INTERP, PMC *obj, PMC *class_handle, STRING *name, INTVAL hint) {
    P6opaqueInstance *instance  = (P6opaqueInstance *)PMC_data(obj);
    P6opaqueREPRData *repr_data = (P6opaqueREPRData *)STABLE(obj)->REPR_data;
    INTVAL            slot;

    /* Ensure it is a defined object. */
    if (!instance->spill)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                "Cannot access attributes in a type object");

    /* Try the slot allocation first. */
    slot = try_get_slot(interp, repr_data, class_handle, name);
    if (slot >= 0) {
        PMC *result = get_pmc_at_offset(instance, repr_data->attribute_offsets[slot]);
        if (result) {
            return result;
        }
        else {
            /* Maybe we know how to auto-viv it to a container. */
            if (repr_data->auto_viv_values) {
                PMC *value = repr_data->auto_viv_values[slot];
                if (value != NULL) {
                    value = REPR(value)->clone(interp, value);
                    set_pmc_at_offset(instance, repr_data->attribute_offsets[slot], value);
                    return value;
                }
            }
            return PMCNULL;
        }
    }
    
    /* Otherwise, complain that the attribute doesn't exist. */
    no_such_attribute(interp, "get", class_handle, name);
}

/* Helper for complaining about attrbiute access errors. */
static void no_such_attribute(PARROT_INTERP, char *action, PMC *class_handle, STRING *name) {
    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "Can not %s non-existant attribute '%Ss' on class '%Ss'",
            action, name, VTABLE_get_string(interp, introspection_call(interp,
                class_handle, STABLE(class_handle)->HOW,
                Parrot_str_new_constant(interp, "name"), 0)));
}

PARROT_DOES_NOT_RETURN
static void no_ICU_lib(PARROT_INTERP) /* HEADERIZER SKIP */
{
    Parrot_ex_throw_from_c_args(interp, NULL,
        EXCEPTION_LIBRARY_ERROR,
        "no ICU lib loaded");
}

INTVAL
Parrot_io_internal_poll(PARROT_INTERP, PIOHANDLE os_handle, int which, int sec,
    int usec)
{
    fd_set r, w, e;
    struct timeval t;
    int n;
    PIOSOCKET sock = (PIOSOCKET)os_handle;

    t.tv_sec = sec;
    t.tv_usec = usec;
    FD_ZERO(&r); FD_ZERO(&w); FD_ZERO(&e);
    /* These should be defined in header */
    if (which & 1) FD_SET(sock, &r);
    if (which & 2) FD_SET(sock, &w);
    if (which & 4) FD_SET(sock, &e);
AGAIN:
    if (select(sock + 1, &r, &w, &e, &t) < 0) {
        switch (PIO_SOCK_ERRNO) {
            case PIO_SOCK_EINTR:
                goto AGAIN;
            default:
                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
                        "select failed: %Ss",
                        Parrot_platform_strerror(interp, PIO_SOCK_ERRNO));
        }
    }

    n  = (FD_ISSET(sock, &r) ? 1 : 0);
    n |= (FD_ISSET(sock, &w) ? 2 : 0);
    n |= (FD_ISSET(sock, &e) ? 4 : 0);

    return n;
}

INTVAL
Parrot_Run_OS_Command(PARROT_INTERP, STRING *command)
{
    pid_t child;
    child = fork();
    /* Did we fail? */
    if (-1 == child)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
            "Can't spawn child process");

    /* Are we the parent or child? */
    if (child) {
        /* parent */
        int   status;
        waitpid(child, &status, 0);
        return status;
    }
    else {
        /* child */
        char * const cmd    = Parrot_str_to_cstring(interp, command);
        const int    status = execlp("sh", "sh", "-c", cmd, (void *)NULL);

        /* if we get here, something's horribly wrong, but free anyway... */
        Parrot_str_free_cstring(cmd);

        if (status)
            exit(status);
    }

    /* make gcc happy */
    return 1;
}

/* Some objects serve primarily as boxes of others, inlining them. This gets
 * gets the reference to such things, using the representation ID to distinguish
 * them. */
static void * get_boxed_ref(PARROT_INTERP, STable *st, void *data, INTVAL repr_id) {
    UNUSED(st);
    UNUSED(data);
    UNUSED(repr_id);
    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "P6bigint cannot box other types");
}

static STRING *get_str(PARROT_INTERP, STable *st, void *data) {
    CStrBody *body = (CStrBody *) data;
    PMC *old_ctx, *cappy, *meth, *enc_pmc;
    STRING *enc;
    STR_VTABLE *encoding;

    if (!body->cstr)
        return (STRING *) NULL;

    /* Look up "encoding" method. */
    meth = VTABLE_find_method(interp, st->WHAT,
        Parrot_str_new_constant(interp, "encoding"));
    if (PMC_IS_NULL(meth))
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "CStr representation expects an 'encoding' method, specifying the encoding");

    old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
    cappy   = Parrot_pmc_new(interp, enum_class_CallContext);
    VTABLE_push_pmc(interp, cappy, st->WHAT);
    Parrot_pcc_invoke_from_sig_object(interp, meth, cappy);
    cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
    Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
    enc_pmc = decontainerize(interp, VTABLE_get_pmc_keyed_int(interp, cappy, 0));
    enc = REPR(enc_pmc)->box_funcs->get_str(interp, STABLE(enc_pmc), OBJECT_BODY(enc_pmc));

    return new_from_cstring(interp, body->cstr, enc);
}

/* Used with boxing. Sets a string value, for representations that can hold
 * one. */
static void set_str(PARROT_INTERP, STable *st, void *data, STRING *value) {
    UNUSED(st);
    UNUSED(data);
    UNUSED(value);
    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "P6bigint cannot box a native string");
}

/* Binds the given value to the specified attribute. */
static void bind_attribute_boxed(PARROT_INTERP, STable *st, void *data, PMC *class_handle, STRING *name, INTVAL hint, PMC *value) {
    P6opaqueREPRData *repr_data = (P6opaqueREPRData *)st->REPR_data;
    INTVAL            slot;

    /* Try the slot allocation first. */
    slot = hint >= 0 && !(repr_data->mi) ? hint :
        try_get_slot(interp, repr_data, class_handle, name);
    if (slot >= 0) {
        STable *st = repr_data->flattened_stables[slot];
        if (st) {
            if (value->vtable->base_type == smo_id && st == STABLE(value))
                st->REPR->copy_to(interp, st, OBJECT_BODY(value),
                    (char *)data + repr_data->attribute_offsets[slot]);
            else
                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                    "Type mismatch when storing value to attribute '%Ss' on class '%Ss'",
                    name, VTABLE_get_string(interp, introspection_call(interp,
                        class_handle, STABLE(class_handle)->HOW,
                        Parrot_str_new_constant(interp, "name"), 0)));
        }
        else {
            set_pmc_at_offset(data, repr_data->attribute_offsets[slot], value);
        }
    }
    else {
        /* Otherwise, complain that the attribute doesn't exist. */
        no_such_attribute(interp, "bind", class_handle, name);
    }
}

/* Helper for finding a slot number. */
static INTVAL try_get_slot(PARROT_INTERP, P6opaqueREPRData *repr_data, PMC *class_key, STRING *name) {
    INTVAL slot = -1;
    if (repr_data->name_to_index_mapping) {
        P6opaqueNameMap *cur_map_entry = repr_data->name_to_index_mapping;
        while (cur_map_entry->class_key != NULL) {
            if (cur_map_entry->class_key == class_key) {
                if (!PMC_IS_NULL(cur_map_entry->name_map)) {
                    PMC *slot_pmc = VTABLE_get_pmc_keyed_str(interp, cur_map_entry->name_map, name);
                    if (!PMC_IS_NULL(slot_pmc))
                        slot = VTABLE_get_integer(interp, slot_pmc);
                    break;
                }
                else {
                    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                        "Null attribute map for P6opaque in class '%Ss'",
                        VTABLE_get_string(interp, introspection_call(interp,
                            class_key, STABLE(class_key)->HOW,
                            Parrot_str_new_constant(interp, "name"), 0)));
                }
            }
            cur_map_entry++;
        }
    }
    return slot;
}