PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
INTVAL
Parrot_io_parse_open_flags(PARROT_INTERP, ARGIN(const STRING *mode_str))
{
ASSERT_ARGS(Parrot_io_parse_open_flags)
INTVAL i, mode_len;
INTVAL flags = 0;
if (STRING_IS_NULL(mode_str))
return PIO_F_READ;
mode_len = Parrot_str_byte_length(interp, mode_str);
for (i = 0; i < mode_len; ++i) {
const INTVAL s = STRING_ord(interp, mode_str, i);
switch (s) {
case 'r':
flags |= PIO_F_READ;
break;
case 'w':
flags |= PIO_F_WRITE;
if (!(flags & PIO_F_APPEND)) /* don't truncate if appending */
flags |= PIO_F_TRUNC;
break;
case 'a':
flags |= PIO_F_APPEND;
flags |= PIO_F_WRITE;
if ((flags & PIO_F_TRUNC)) /* don't truncate if appending */
flags &= ~PIO_F_TRUNC;
break;
case 'p':
flags |= PIO_F_PIPE;
break;
case 'b':
flags |= PIO_F_BINARY;
break;
default:
break;
}
}
return flags;
}
/* Takes a signature along with positional and named arguments and binds them
* into the provided lexpad (actually, anything that has a Hash interface will
* do). Returns BIND_RESULT_OK if binding works out, BIND_RESULT_FAIL if there
* is a failure and BIND_RESULT_JUNCTION if the failure was because of a
* Junction being passed (meaning we need to auto-thread). */
INTVAL
Rakudo_binding_bind_llsig(PARROT_INTERP, PMC *lexpad, PMC *llsig,
PMC *capture, INTVAL no_nom_type_check,
STRING **error) {
INTVAL i;
INTVAL bind_fail;
INTVAL cur_pos_arg = 0;
INTVAL num_pos_args = VTABLE_elements(interp, capture);
PMC *named_names = PMCNULL;
llsig_element **elements;
INTVAL num_elements;
PMC *named_to_pos_cache;
/* Lazily allocated array of bindings to positionals of nameds. */
PMC **pos_from_named = NULL;
/* If we do have some named args, we want to make a clone of the hash
* to work on. We'll delete stuff from it as we bind, and what we have
* left over can become the slurpy hash or - if we aren't meant to be
* taking one - tell us we have a problem. */
PMC *named_args_copy = PMCNULL;
/* If we have a |$foo that's followed by slurpies, then we can suppress
* any future arity checks. */
INTVAL suppress_arity_fail = 0;
/* Check that we have a valid signature and pull the bits out of it. */
if (!lls_id)
setup_binder_statics(interp);
if (llsig->vtable->base_type != lls_id)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Internal Error: Rakudo_binding_bind_llsig passed invalid signature");
GETATTR_P6LowLevelSig_elements(interp, llsig, elements);
GETATTR_P6LowLevelSig_num_elements(interp, llsig, num_elements);
GETATTR_P6LowLevelSig_named_to_pos_cache(interp, llsig, named_to_pos_cache);
/* Build nameds -> position hash for named positional arguments,
* if it was not yet built. */
if (PMC_IS_NULL(named_to_pos_cache)) {
named_to_pos_cache = pmc_new(interp, enum_class_Hash);
PARROT_GC_WRITE_BARRIER(interp, llsig);
SETATTR_P6LowLevelSig_named_to_pos_cache(interp, llsig, named_to_pos_cache);
for (i = 0; i < num_elements; i++) {
/* If we find a named argument, we're done with the positionals. */
if (!PMC_IS_NULL(elements[i]->named_names))
break;
/* Skip slurpies (may be a slurpy block, so can't just break). */
if (elements[i]->flags & SIG_ELEM_SLURPY)
continue;
/* Provided it has a name... */
if (!STRING_IS_NULL(elements[i]->variable_name)) {
/* Strip any sigil, then stick in named to positional array. */
STRING *store = elements[i]->variable_name;
STRING *sigil = Parrot_str_substr(interp, store, 0, 1);
STRING *twigil = Parrot_str_substr(interp, store, 1, 1);
if (Parrot_str_equal(interp, sigil, SCALAR_SIGIL_str)
|| Parrot_str_equal(interp, sigil, ARRAY_SIGIL_str)
|| Parrot_str_equal(interp, sigil, HASH_SIGIL_str))
store = Parrot_str_substr(interp, store, 1,
Parrot_str_byte_length(interp, store));
if (Parrot_str_equal(interp, twigil, BANG_TWIGIL_str))
store = Parrot_str_substr(interp, store, 1,
Parrot_str_byte_length(interp, store));
VTABLE_set_integer_keyed_str(interp, named_to_pos_cache, store, i);
}
}
}
/* If we've got a CallContext, just has an attribute with list of named
* parameter names. Otherwise, it's a Capture and we need to do .hash and
* grab out the keys. */
if (capture->vtable->base_type == enum_class_CallContext
|| VTABLE_isa(interp, capture, CALLCONTEXT_str)) {
named_names = VTABLE_get_attr_str(interp, capture, Parrot_str_new(interp, "named", 0));
}
else if (VTABLE_isa(interp, capture, CAPTURE_str)) {
PMC *meth = VTABLE_find_method(interp, capture, Parrot_str_new(interp, "!PARROT_NAMEDS", 0));
PMC *hash = PMCNULL;
PMC *iter;
Parrot_ext_call(interp, meth, "Pi->P", capture, &hash);
iter = VTABLE_get_iter(interp, hash);
if (VTABLE_get_bool(interp, iter)) {
named_names = pmc_new(interp, enum_class_ResizableStringArray);
while (VTABLE_get_bool(interp, iter))
VTABLE_push_string(interp, named_names, VTABLE_shift_string(interp, iter));
}
}
else {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Internal Error: Rakudo_binding_bind_llsig passed invalid Capture");
}
/* First, consider named arguments, to see if there are any that we will
* be wanting to bind positionally. */
if (!PMC_IS_NULL(named_names)) {
PMC *iter = VTABLE_get_iter(interp, named_names);
named_args_copy = pmc_new(interp, enum_class_Hash);
while (VTABLE_get_bool(interp, iter)) {
STRING *name = VTABLE_shift_string(interp, iter);
if (VTABLE_exists_keyed_str(interp, named_to_pos_cache, name)) {
/* Found one. We'll stash it away for quick access to bind it
* later. */
INTVAL pos = VTABLE_get_integer_keyed_str(interp, named_to_pos_cache, name);
if (!pos_from_named)
pos_from_named = mem_allocate_n_zeroed_typed(num_elements, PMC *);
pos_from_named[pos] = VTABLE_get_pmc_keyed_str(interp, capture, name);
}
else {
/* Otherwise, we'll enter it into the hash of things to bind
* to nameds. */
VTABLE_set_pmc_keyed_str(interp, named_args_copy, name,
VTABLE_get_pmc_keyed_str(interp, capture, name));
}
}
PARROT_EXPORT
Parrot_UInt4
string_unescape_one(PARROT_INTERP, ARGMOD(UINTVAL *offset),
ARGMOD(STRING *string))
{
ASSERT_ARGS(string_unescape_one)
UINTVAL workchar = 0;
UINTVAL charcount = 0;
const UINTVAL len = Parrot_str_byte_length(interp, string);
/* Well, not right now */
UINTVAL codepoint = CHARSET_GET_BYTE(interp, string, *offset);
++*offset;
switch (codepoint) {
case 'x':
codepoint = CHARSET_GET_BYTE(interp, string, *offset);
if (codepoint >= '0' && codepoint <= '9') {
workchar = codepoint - '0';
}
else if (codepoint >= 'a' && codepoint <= 'f') {
workchar = codepoint - 'a' + 10;
}
else if (codepoint >= 'A' && codepoint <= 'F') {
workchar = codepoint - 'A' + 10;
}
else if (codepoint == '{') {
int i;
++*offset;
workchar = 0;
for (i = 0; i < 8 && *offset < len; ++i, ++*offset) {
codepoint = CHARSET_GET_BYTE(interp, string, *offset);
if (codepoint == '}') {
++*offset;
return workchar;
}
workchar *= 16;
if (codepoint >= '0' && codepoint <= '9') {
workchar += codepoint - '0';
}
else if (codepoint >= 'a' && codepoint <= 'f') {
workchar += codepoint - 'a' + 10;
}
else if (codepoint >= 'A' && codepoint <= 'F') {
workchar += codepoint - 'A' + 10;
}
else {
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_UNIMPLEMENTED,
"Illegal escape sequence inside {}");
}
}
if (*offset == len)
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_UNIMPLEMENTED,
"Illegal escape sequence no '}'");
}
else {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"Illegal escape sequence in");
}
++*offset;
if (*offset < len) {
workchar *= 16;
codepoint = CHARSET_GET_BYTE(interp, string, *offset);
if (codepoint >= '0' && codepoint <= '9') {
workchar += codepoint - '0';
}
else if (codepoint >= 'a' && codepoint <= 'f') {
workchar += codepoint - 'a' + 10;
}
else if (codepoint >= 'A' && codepoint <= 'F') {
workchar += codepoint - 'A' + 10;
}
else {
return workchar;
}
}
else {
return workchar;
}
++*offset;
return workchar;
case 'c':
codepoint = CHARSET_GET_BYTE(interp, string, *offset);
if (codepoint >= 'A' && codepoint <= 'Z') {
workchar = codepoint - 'A' + 1;
}
else {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"Illegal escape sequence");
}
++*offset;
return workchar;
case 'u':
workchar = 0;
for (charcount = 0; charcount < 4; charcount++) {
if (*offset < len) {
workchar *= 16;
codepoint = CHARSET_GET_BYTE(interp, string, *offset);
if (codepoint >= '0' && codepoint <= '9') {
workchar += codepoint - '0';
}
else if (codepoint >= 'a' && codepoint <= 'f') {
workchar += codepoint - 'a' + 10;
}
else if (codepoint >= 'A' && codepoint <= 'F') {
workchar += codepoint - 'A' + 10;
}
else {
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_UNIMPLEMENTED,
"Illegal escape sequence in uxxx escape");
}
}
else {
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_UNIMPLEMENTED,
"Illegal escape sequence in uxxx escape - too short");
}
++*offset;
}
return workchar;
case 'U':
workchar = 0;
for (charcount = 0; charcount < 8; charcount++) {
if (*offset < len) {
workchar *= 16;
codepoint = CHARSET_GET_BYTE(interp, string, *offset);
if (codepoint >= '0' && codepoint <= '9') {
workchar += codepoint - '0';
}
else if (codepoint >= 'a' && codepoint <= 'f') {
workchar += codepoint - 'a' + 10;
}
else if (codepoint >= 'A' && codepoint <= 'F') {
workchar += codepoint - 'A' + 10;
}
else {
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_UNIMPLEMENTED,
"Illegal escape sequence in Uxxx escape");
}
}
else {
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_UNIMPLEMENTED,
"Illegal escape sequence in uxxx escape - too short");
}
++*offset;
}
return workchar;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
workchar = codepoint - '0';
if (*offset < len) {
workchar *= 8;
codepoint = CHARSET_GET_BYTE(interp, string, *offset);
if (codepoint >= '0' && codepoint <= '7') {
workchar += codepoint - '0';
}
else {
return workchar;
}
}
else {
return workchar;
}
++*offset;
if (*offset < len) {
workchar *= 8;
codepoint = CHARSET_GET_BYTE(interp, string, *offset);
if (codepoint >= '0' && codepoint <= '7') {
workchar += codepoint - '0';
}
else {
return workchar;
}
}
else {
return workchar;
}
++*offset;
return workchar;
case 'a':
return 7; /* bell */
case 'b':
return 8; /* bs */
case 't':
return 9;
case 'n':
return 10;
case 'v':
return 11;
case 'f':
return 12;
case 'r':
return 13;
case 'e':
return 27;
case 92: /* \ */
return 92;
case '"':
return '"';
default:
return codepoint; /* any not special return the char */
}
}
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_nci_parse_signature(PARROT_INTERP, ARGIN(STRING *sig_str))
{
ASSERT_ARGS(Parrot_nci_parse_signature)
const size_t sig_length = Parrot_str_byte_length(interp, sig_str);
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray,
sig_length);
size_t i;
if (!sig_length) {
sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, 1);
VTABLE_set_integer_keyed_int(interp, sig_pmc, 0, enum_type_void);
return sig_pmc;
}
for (i = 0; i < sig_length; ++i) {
const INTVAL c = Parrot_str_indexed(interp, sig_str, i);
PARROT_DATA_TYPE e;
PARROT_ASSERT(c == (char)c);
switch ((char)c) {
case 'f':
e = enum_type_float;
break;
case 'd':
e = enum_type_double;
break;
case 'N':
e = enum_type_FLOATVAL;
break;
case 'c': /* char */
e = enum_type_char;
break;
case 's': /* short */
e = enum_type_short;
break;
case 'i': /* int */
e = enum_type_int;
break;
case 'l': /* long */
e = enum_type_long;
break;
case 'I': /* INTVAL */
e = enum_type_INTVAL;
break;
case '2': /* short PMC */
e = enum_type_pshort;
break;
case '3': /* int PMC */
e = enum_type_pint;
break;
case '4': /* long PMC */
e = enum_type_plong;
break;
case 'S':
e = enum_type_STRING;
break;
case 't': /* string as cstring */
e = enum_type_cstr;
break;
case 'p': /* push pmc->data */
e = enum_type_ptr;
break;
case 'O': /* PMC invocant */
case 'P': /* push PMC * */
e = enum_type_PMC;
break;
case 'v':
e = enum_type_void;
break;
default:
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_JIT_ERROR,
"Unknown param Signature %c\n", (char)c);
break;
}
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, e);
}
return sig_pmc;
}
