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;
}
/* Binds the given value to the specified attribute. */
static void bind_attribute(PARROT_INTERP, PMC *obj, PMC *class_handle, STRING *name, INTVAL hint, PMC *value) {
HashAttrStoreInstance *instance = (HashAttrStoreInstance *)PMC_data(obj);
if (!instance->store)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Cannot access attributes in a type object");
VTABLE_set_pmc_keyed_str(interp, instance->store, name, value);
}
/* Checks if an attribute has been initialized. */
static INTVAL is_attribute_initialized(PARROT_INTERP, PMC *obj, PMC *class_handle, STRING *name, INTVAL hint) {
HashAttrStoreInstance *instance = (HashAttrStoreInstance *)PMC_data(obj);
if (!instance->store)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Cannot access attributes in a type object");
return VTABLE_exists_keyed_str(interp, instance->store, name);
}
INTVAL
Parrot_Run_OS_Command_Argv(PARROT_INTERP, PMC *cmdargs)
{
pid_t child;
int len = VTABLE_elements(interp, cmdargs);
if (len == 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
"Empty argument array for execvp");
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;
pid_t returnstat = waitpid(child, &status, 0);
UNUSED(returnstat);
return status;
}
else {
/* child. Be horribly profligate with memory, since we're
about to be something else */
int status, i;
STRING *s;
char *cmd;
char **argv = mem_gc_allocate_n_typed(interp, (len+1), char*);
for (i = 0; i < len; ++i) {
s = VTABLE_get_string_keyed_int(interp, cmdargs, i);
argv[i] = Parrot_str_to_cstring(interp, s);
}
cmd = argv[0];
argv[i] = NULL;
status = execvp(cmd, argv);
/* if we get here, something's horribly wrong... */
if (status) {
exit(status);
}
}
return 1; /* make gcc happy */
}
static void
null_error(PARROT_INTERP)
{
ASSERT_ARGS(null_error)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNEXPECTED_NULL,
"Invalid operation on null string");
}
/* Given an SC and an index, fetch the object stored there. */
PMC * SC_get_object(PARROT_INTERP, PMC *sc, INTVAL idx) {
PMC *objects;
GETATTR_SerializationContext_root_objects(interp, sc, objects);
if (idx >= VTABLE_elements(interp, objects))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"No object at index %d", idx);
return VTABLE_get_pmc_keyed_int(interp, objects, idx);
}
/* Helper for complaining about attribute access errors. */
PARROT_DOES_NOT_RETURN
static void no_such_attribute(PARROT_INTERP, const char *action, PMC *class_handle, STRING *name) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Can not %s attribute '%Ss' declared in class '%Ss' with this object",
action, name, VTABLE_get_string(interp, introspection_call(interp,
class_handle, STABLE(class_handle)->HOW,
Parrot_str_new_constant(interp, "name"), 0)));
}
void
Parrot_io_internal_listen(PARROT_INTERP, PIOHANDLE os_handle, INTVAL sec)
{
if (listen((PIOSOCKET)os_handle, sec) != 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"listen failed: %Ss",
Parrot_platform_strerror(interp, PIO_SOCK_ERRNO));
}
PARROT_WARN_UNUSED_RESULT
static UINTVAL
utf16_scan(PARROT_INTERP, ARGIN(const STRING *src))
{
ASSERT_ARGS(utf16_scan)
const utf16_t *p = (utf16_t *)src->strstart;
UINTVAL len = 0;
UINTVAL i, n;
if (src->bufused & 1)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_UTF16,
"Unaligned end in UTF-16 string\n");
n = src->bufused >> 1;
for (i = 0; i < n; ++i) {
UINTVAL c = p[i];
if (UNICODE_IS_HIGH_SURROGATE(c)) {
++i;
if (i >= n)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_UTF16,
"Unaligned end in UTF-16 string\n");
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");
++len;
}
return len;
}
PARROT_CANNOT_RETURN_NULL
static STRING *
ascii_to_encoding(PARROT_INTERP, ARGIN(const STRING *src))
{
ASSERT_ARGS(ascii_to_encoding)
STRING *dest;
if (STRING_max_bytes_per_codepoint(src) == 1) {
unsigned char * const src_buf = (unsigned char *)src->strstart;
UINTVAL offs;
for (offs = 0; offs < src->strlen; ++offs) {
UINTVAL c = src_buf[offs];
if (c >= 0x80)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LOSSY_CONVERSION,
"lossy conversion to ascii");
}
dest = Parrot_str_clone(interp, src);
dest->encoding = Parrot_ascii_encoding_ptr;
}
else {
String_iter iter;
unsigned char *p;
const UINTVAL len = src->strlen;
dest = Parrot_str_new_init(interp, NULL, len,
Parrot_ascii_encoding_ptr, 0);
p = (unsigned char *)dest->strstart;
STRING_ITER_INIT(interp, &iter);
while (iter.charpos < len) {
const UINTVAL c = STRING_iter_get_and_advance(interp, src, &iter);
if (c >= 0x80)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LOSSY_CONVERSION,
"can't convert unicode string to ascii");
*p++ = c;
}
dest->bufused = len;
dest->strlen = len;
}
return dest;
}
PARROT_EXPORT
void
PackFile_pack(PARROT_INTERP, ARGMOD(PackFile *self), ARGOUT(opcode_t *cursor))
{
ASSERT_ARGS(PackFile_pack)
opcode_t *ret;
size_t size;
PackFile_Directory * const dir = &self->directory;
PackFile_Segment *seg;
int padding_size;
char *byte_cursor = (char*)cursor;
self->src = cursor;
/* Pack the fixed part of the header */
mem_sys_memcopy(cursor, self->header, PACKFILE_HEADER_BYTES);
byte_cursor += PACKFILE_HEADER_BYTES;
/* Pack the UUID. */
if (self->header->uuid_size > 0)
mem_sys_memcopy(byte_cursor, self->header->uuid_data,
self->header->uuid_size);
/* Padding. */
padding_size = 16 - (PACKFILE_HEADER_BYTES + self->header->uuid_size) % 16;
if (padding_size < 16) {
int i;
for (i = 0; i < padding_size; ++i)
*byte_cursor++ = 0;
}
else {
padding_size = 0;
}
/* Set cursor. */
cursor += (PACKFILE_HEADER_BYTES + self->header->uuid_size + padding_size)
/ sizeof (opcode_t);
/* Directory format and padding. */
*cursor++ = PF_DIR_FORMAT;
*cursor++ = 0;
*cursor++ = 0;
*cursor++ = 0;
/* pack the directory */
seg = (PackFile_Segment *) dir;
/* dir size */
size = seg->op_count;
ret = PackFile_Segment_pack(interp, seg, cursor);
if ((size_t)(ret - cursor) != size) {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
"PackFile_pack segment '%Ss' used size %d but reported %d\n",
seg->name, (int)(ret-cursor), (int)size);
}
}
