void yr_rules_print_profiling_info(
YR_RULES* rules)
{
YR_RULE* rule;
YR_STRING* string;
clock_t clock_ticks;
printf("===== PROFILING_ENABLED INFORMATION =====\n");
rule = rules->rules_list_head;
while (!RULE_IS_NULL(rule))
{
clock_ticks = rule->clock_ticks;
string = rule->strings;
while (!STRING_IS_NULL(string))
{
clock_ticks += string->clock_ticks;
string++;
}
printf(
"%s:%s: %li\n",
rule->ns->name,
rule->identifier,
clock_ticks);
rule++;
}
printf("================================\n");
}
YR_STRING* yr_parser_lookup_string(
yyscan_t yyscanner,
const char* identifier)
{
YR_STRING* string;
YR_COMPILER* compiler = yyget_extra(yyscanner);
string = compiler->current_rule_strings;
while(!STRING_IS_NULL(string))
{
// If some string $a gets fragmented into multiple chained
// strings, all those fragments have the same $a identifier
// but we are interested in the heading fragment, which is
// that with chained_to == NULL
if (strcmp(string->identifier, identifier) == 0 &&
string->chained_to == NULL)
{
return string;
}
string = yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
yr_compiler_set_error_extra_info(compiler, identifier);
compiler->last_result = ERROR_UNDEFINED_STRING;
return NULL;
}
void _yr_rules_clean_matches(
YR_RULES* rules)
{
YR_RULE* rule;
YR_STRING* string;
int tidx = yr_get_tidx();
rule = rules->rules_list_head;
while (!RULE_IS_NULL(rule))
{
rule->t_flags[tidx] &= ~RULE_TFLAGS_MATCH;
rule->ns->t_flags[tidx] &= ~NAMESPACE_TFLAGS_UNSATISFIED_GLOBAL;
string = rule->strings;
while (!STRING_IS_NULL(string))
{
string->matches[tidx].count = 0;
string->matches[tidx].head = NULL;
string->matches[tidx].tail = NULL;
string->unconfirmed_matches[tidx].count = 0;
string->unconfirmed_matches[tidx].head = NULL;
string->unconfirmed_matches[tidx].tail = NULL;
string++;
}
rule++;
}
}
YR_STRING* yr_parser_lookup_string(
yyscan_t yyscanner,
const char* identifier)
{
YR_STRING* string;
YR_COMPILER* compiler = yyget_extra(yyscanner);
string = compiler->current_rule_strings;
while(!STRING_IS_NULL(string))
{
if (strcmp(string->identifier, identifier) == 0)
return string;
string = yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
yr_compiler_set_error_extra_info(compiler, identifier);
compiler->last_result = ERROR_UNDEFINED_STRING;
return NULL;
}
int yr_parser_emit_pushes_for_strings(
yyscan_t yyscanner,
const char* identifier)
{
YR_COMPILER* compiler = yyget_extra(yyscanner);
YR_STRING* string = compiler->current_rule->strings;
const char* string_identifier;
const char* target_identifier;
int matching = 0;
while(!STRING_IS_NULL(string))
{
// Don't generate pushes for strings chained to another one, we are
// only interested in non-chained strings or the head of the chain.
if (string->chained_to == NULL)
{
string_identifier = string->identifier;
target_identifier = identifier;
while (*target_identifier != '\0' &&
*string_identifier != '\0' &&
*target_identifier == *string_identifier)
{
target_identifier++;
string_identifier++;
}
if ((*target_identifier == '\0' && *string_identifier == '\0') ||
*target_identifier == '*')
{
yr_parser_emit_with_arg_reloc(
yyscanner,
OP_PUSH,
PTR_TO_INT64(string),
NULL,
NULL);
string->g_flags |= STRING_GFLAGS_REFERENCED;
string->g_flags &= ~STRING_GFLAGS_FIXED_OFFSET;
matching++;
}
}
string = (YR_STRING*) yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
if (matching == 0)
{
yr_compiler_set_error_extra_info(compiler, identifier);
compiler->last_result = ERROR_UNDEFINED_STRING;
}
return compiler->last_result;
}
/* This Parrot-specific addition to the API is used to mark an object. */
static void gc_mark(PARROT_INTERP, PMC *obj) {
P6strInstance *instance = (P6strInstance *)PMC_data(obj);
if (!PMC_IS_NULL(instance->common.stable))
Parrot_gc_mark_PMC_alive(interp, instance->common.stable);
if (!PMC_IS_NULL(instance->common.sc))
Parrot_gc_mark_PMC_alive(interp, instance->common.sc);
if (!STRING_IS_NULL(instance->value))
Parrot_gc_mark_STRING_alive(interp, instance->value);
}
/* This Parrot-specific addition to the API is used to mark an object. */
static void gc_mark(PARROT_INTERP, STable *st, void *data) {
KnowHOWREPRBody *body = (KnowHOWREPRBody *)data;
UNUSED(st);
if (!STRING_IS_NULL(body->name))
Parrot_gc_mark_STRING_alive(interp, body->name);
if (!PMC_IS_NULL(body->methods))
Parrot_gc_mark_PMC_alive(interp, body->methods);
if (!PMC_IS_NULL(body->attributes))
Parrot_gc_mark_PMC_alive(interp, body->attributes);
}
int yr_parser_reduce_rule_declaration_phase_2(
yyscan_t yyscanner,
YR_RULE* rule)
{
uint32_t max_strings_per_rule;
uint32_t strings_in_rule = 0;
YR_COMPILER* compiler = yyget_extra(yyscanner);
// Check for unreferenced (unused) strings.
YR_STRING* string = rule->strings;
yr_get_configuration(
YR_CONFIG_MAX_STRINGS_PER_RULE,
(void*) &max_strings_per_rule);
while (!STRING_IS_NULL(string))
{
// Only the heading fragment in a chain of strings (the one with
// chained_to == NULL) must be referenced. All other fragments
// are never marked as referenced.
if (!STRING_IS_REFERENCED(string) &&
string->chained_to == NULL)
{
yr_compiler_set_error_extra_info(compiler, string->identifier);
compiler->last_result = ERROR_UNREFERENCED_STRING;
return compiler->last_result;
}
strings_in_rule++;
if (strings_in_rule > max_strings_per_rule) {
yr_compiler_set_error_extra_info(compiler, rule->identifier);
compiler->last_result = ERROR_TOO_MANY_STRINGS;
return compiler->last_result;
}
string = (YR_STRING*) yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
compiler->last_result = yr_parser_emit_with_arg_reloc(
yyscanner,
OP_MATCH_RULE,
rule,
NULL,
NULL);
return compiler->last_result;
}
PARROT_API
Parrot_Int
Parrot_api_string_export_ascii(ARGIN(Parrot_PMC interp_pmc), ARGIN(Parrot_String string),
ARGOUT(char ** strout))
{
ASSERT_ARGS(Parrot_api_string_export_ascii)
EMBED_API_CALLIN(interp_pmc, interp);
if (!STRING_IS_NULL(string))
*strout = Parrot_str_to_cstring(interp, string);
else
*strout = NULL;
EMBED_API_CALLOUT(interp_pmc, interp);
}
static void
pcf_cstr_cstr_cstr(PARROT_INTERP, PMC *nci, SHIM(PMC *self))
{
typedef char *(* func_t)(char *, char *);
func_t fn_pointer;
void *orig_func;
PMC * const ctx = CURRENT_CONTEXT(interp);
PMC * const call_object = Parrot_pcc_get_signature(interp, ctx);
STRING * t_0; char * v_0;
STRING * t_1; char * v_1;
STRING * t_2; char * v_2;
Parrot_pcc_fill_params_from_c_args(interp, call_object, "SS", &t_1, &t_2);
v_1 = STRING_IS_NULL(t_1) ? NULL : Parrot_str_to_cstring(interp, t_1);
v_2 = STRING_IS_NULL(t_2) ? NULL : Parrot_str_to_cstring(interp, t_2);
GETATTR_NCI_orig_func(interp, nci, orig_func);
fn_pointer = (func_t)D2FPTR(orig_func);
v_0 = (*fn_pointer)(v_1, v_2);
t_0 = Parrot_str_new(interp, v_0, 0);
t_1 = Parrot_str_new(interp, v_1, 0);
t_2 = Parrot_str_new(interp, v_2, 0);
Parrot_pcc_set_call_from_c_args(interp, call_object, "SSS", t_0, t_1, t_2);
}
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;
}
/* This is what Parrot_str_new_from_cstring does but that isn't exported. */
static STRING *
new_from_cstring(PARROT_INTERP, const char *buffer, STRING *encodingname)
{
STRING *result = STRINGNULL;
if (buffer) {
const STR_VTABLE *encoding = STRING_IS_NULL(encodingname) ?
Parrot_platform_encoding_ptr :
Parrot_find_encoding_by_string(interp, encodingname);
if (encoding == NULL)
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_ENCODING,
"Invalid encoding");
else {
int size = strlen(buffer);
result = Parrot_str_new_init(interp, buffer, size, encoding, 0);
}
}
return result;
}
void yr_parser_emit_pushes_for_strings(
yyscan_t yyscanner,
const char* identifier)
{
YR_COMPILER* compiler = yyget_extra(yyscanner);
YR_STRING* string = compiler->current_rule_strings;
const char* string_identifier;
const char* target_identifier;
while(!STRING_IS_NULL(string))
{
string_identifier = string->identifier;
target_identifier = identifier;
while (*target_identifier != '\0' &&
*string_identifier != '\0' &&
*target_identifier == *string_identifier)
{
target_identifier++;
string_identifier++;
}
if ((*target_identifier == '\0' && *string_identifier == '\0') ||
*target_identifier == '*')
{
yr_parser_emit_with_arg_reloc(
yyscanner,
PUSH,
PTR_TO_UINT64(string),
NULL);
string->g_flags |= STRING_GFLAGS_REFERENCED;
}
string = yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
}
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_io_open_handle(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(STRING *path), ARGIN(STRING *mode))
{
ASSERT_ARGS(Parrot_io_open_handle)
PMC *filehandle;
const INTVAL typenum = Parrot_hll_get_ctx_HLL_type(interp,
Parrot_PMC_typenum(interp, "FileHandle"));
if (PMC_IS_NULL(pmc)) {
filehandle = Parrot_pmc_new(interp, typenum);
}
else
filehandle = pmc;
if (STRING_IS_NULL(path))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"Cannot open filehandle, no path");
if (filehandle->vtable->base_type == typenum) {
INTVAL flags = Parrot_io_parse_open_flags(interp, mode);
PIOHANDLE os_handle;
/* TODO: a filehandle shouldn't allow a NULL path. */
PARROT_ASSERT(filehandle->vtable->base_type == typenum);
if (flags & PIO_F_PIPE) {
const int f_read = (flags & PIO_F_READ) != 0;
const int f_write = (flags & PIO_F_WRITE) != 0;
INTVAL pid;
if (f_read == f_write)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"Invalid pipe mode: %X", flags);
os_handle = PIO_OPEN_PIPE(interp, path, flags, &pid);
/* Save the pid of the child, we'll wait for it when closing */
VTABLE_set_integer_keyed_int(interp, filehandle, 0, pid);
}
else {
if ((flags & (PIO_F_WRITE | PIO_F_READ)) == 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Invalid mode for file open");
os_handle = PIO_OPEN(interp, path, flags);
if (os_handle == PIO_INVALID_HANDLE)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"Unable to open filehandle from path '%Ss'", path);
flags |= PIO_F_FILE;
/* Set generic flag here if is a terminal then
* FileHandle can know how to setup buffering.
* STDIN, STDOUT, STDERR would be in this case
* so we would setup linebuffering.
*/
if (PIO_IS_TTY(interp, os_handle))
flags |= PIO_F_CONSOLE;
}
if (STRING_IS_NULL(mode))
mode = CONST_STRING(interp, "r");
else if (STRING_index(interp, mode, CONST_STRING(interp, "b"), 0) >= 0)
SETATTR_FileHandle_encoding(interp, filehandle, CONST_STRING(interp, "binary"));
SETATTR_FileHandle_os_handle(interp, filehandle, os_handle);
SETATTR_FileHandle_flags(interp, filehandle, flags);
SETATTR_FileHandle_filename(interp, filehandle, path);
SETATTR_FileHandle_mode(interp, filehandle, mode);
Parrot_io_setbuf(interp, filehandle, PIO_UNBOUND);
}
else
Parrot_pcc_invoke_method_from_c_args(interp, filehandle, CONST_STRING(interp, "open"), "SS->P", path, mode, &filehandle);
return filehandle;
}
/* 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(PARROT_INTERP, PMC *lexpad, PMC *sig_pmc, PMC *capture,
INTVAL no_nom_type_check, STRING **error) {
INTVAL i, num_pos_args;
INTVAL bind_fail = 0;
INTVAL cur_pos_arg = 0;
Rakudo_Signature *sig = (Rakudo_Signature *)PMC_data(sig_pmc);
PMC *params = sig->params;
INTVAL num_params = VTABLE_elements(interp, params);
Rakudo_BindVal cur_bv;
/* 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;
/* If it's a Parrot capture, it may contain natively typed arguments.
* NOTE: This is a really an encapsulation breakage; if Parrot folks
* change stuff and this breaks, it's not Parrot's fault. */
struct Pcc_cell * pc_positionals = NULL;
/* Set up statics. */
if (!smo_id)
setup_binder_statics(interp);
/* If we've got a CallContext, just has an attribute with list of named
* parameter names. Otherwise, it's probably a Perl 6 Capture and we need
* to extract its parts. */
if (capture->vtable->base_type == enum_class_CallContext) {
PMC *named_names = VTABLE_get_attr_str(interp, capture, NAMED_str);
if (!PMC_IS_NULL(named_names)) {
PMC *iter = VTABLE_get_iter(interp, named_names);
named_args_copy = Parrot_pmc_new(interp, enum_class_Hash);
while (VTABLE_get_bool(interp, iter)) {
STRING *name = VTABLE_shift_string(interp, iter);
VTABLE_set_pmc_keyed_str(interp, named_args_copy, name,
VTABLE_get_pmc_keyed_str(interp, capture, name));
}
}
GETATTR_CallContext_positionals(interp, capture, pc_positionals);
}
else if (capture->vtable->base_type == smo_id &&
STABLE(capture)->type_check(interp, capture, Rakudo_types_capture_get())) {
PMC *captype = Rakudo_types_capture_get();
PMC *list_part = VTABLE_get_attr_keyed(interp, capture, captype, LIST_str);
PMC *hash_part = VTABLE_get_attr_keyed(interp, capture, captype, HASH_str);
capture = Rakudo_isnqplist(list_part)
? list_part
: Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
if (hash_part->vtable->base_type == enum_class_Hash) {
PMC *iter = VTABLE_get_iter(interp, hash_part);
named_args_copy = Parrot_pmc_new(interp, enum_class_Hash);
while (VTABLE_get_bool(interp, iter)) {
STRING *arg_copy_name = VTABLE_shift_string(interp, iter);
VTABLE_set_pmc_keyed_str(interp, named_args_copy, arg_copy_name,
VTABLE_get_pmc_keyed_str(interp, hash_part, arg_copy_name));
}
}
}
else {
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Internal Error: Rakudo_binding_bind passed invalid Capture");
}
/* Now we'll walk through the signature and go about binding things. */
num_pos_args = VTABLE_elements(interp, capture);
for (i = 0; i < num_params; i++) {
Rakudo_Parameter *param = (Rakudo_Parameter *)PMC_data(
VTABLE_get_pmc_keyed_int(interp, params, i));
/* Is it looking for us to bind a capture here? */
if (param->flags & SIG_ELEM_IS_CAPTURE) {
/* Capture the arguments from this point forwards into a Capture.
* Of course, if there's no variable name we can (cheaply) do pretty
* much nothing. */
if (STRING_IS_NULL(param->variable_name)) {
bind_fail = BIND_RESULT_OK;
}
else {
PMC *captype = Rakudo_types_capture_get();
PMC *capsnap = REPR(captype)->allocate(interp, STABLE(captype));
PMC *pos_args = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
PMC *named_args = Parrot_pmc_new(interp, enum_class_Hash);
INTVAL k;
VTABLE_set_attr_keyed(interp, capsnap, captype, LIST_str, pos_args);
VTABLE_set_attr_keyed(interp, capsnap, captype, HASH_str, named_args);
for (k = cur_pos_arg; k < num_pos_args; k++) {
cur_bv = get_positional_bind_val(interp, pc_positionals, capture, k);
VTABLE_push_pmc(interp, pos_args, cur_bv.type == BIND_VAL_OBJ ?
cur_bv.val.o :
create_box(interp, cur_bv));
}
if (!PMC_IS_NULL(named_args_copy)) {
PMC *iter = VTABLE_get_iter(interp, named_args_copy);
while (VTABLE_get_bool(interp, iter)) {
STRING *name = VTABLE_shift_string(interp, iter);
VTABLE_set_pmc_keyed_str(interp, named_args, name,
VTABLE_get_pmc_keyed_str(interp, named_args_copy, name));
}
}
cur_bv.type = BIND_VAL_OBJ;
cur_bv.val.o = capsnap;
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv,
no_nom_type_check, error);
}
if (bind_fail) {
return bind_fail;
}
else if (i + 1 == num_params) {
/* Since a capture acts as "the ultimate slurpy" in a sense, if
* this is the last parameter in the signature we can return
* success right off the bat. */
return BIND_RESULT_OK;
}
else {
Rakudo_Parameter *next_param = (Rakudo_Parameter *)PMC_data(
VTABLE_get_pmc_keyed_int(interp, params, i + 1));
if (next_param->flags & (SIG_ELEM_SLURPY_POS | SIG_ELEM_SLURPY_NAMED))
suppress_arity_fail = 1;
}
}
/* Could it be a named slurpy? */
else if (param->flags & SIG_ELEM_SLURPY_NAMED) {
/* Can cheat a bit if it's the default method %_.
* We give the hash to the lexpad. */
if (param->flags & SIG_ELEM_METHOD_SLURPY_NAMED && lexpad->vtable->base_type == p6l_id) {
SETATTR_Perl6LexPad_default_named_slurpy(interp, lexpad, named_args_copy);
PARROT_GC_WRITE_BARRIER(interp, lexpad);
}
else {
/* We'll either take the current named arguments copy hash which
* will by definition contain all unbound named parameters and use
* that, or just create an empty one. */
PMC *slurpy = PMC_IS_NULL(named_args_copy) ?
Parrot_pmc_new(interp, enum_class_Hash) :
named_args_copy;
cur_bv.type = BIND_VAL_OBJ;
cur_bv.val.o = Rakudo_binding_create_hash(interp, slurpy);
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param,
cur_bv, no_nom_type_check, error);
if (bind_fail)
return bind_fail;
}
/* Nullify named arguments hash now we've consumed it, to mark all
* is well. */
named_args_copy = PMCNULL;
}
/* Otherwise, maybe it's a positional. */
else if (PMC_IS_NULL(param->named_names)) {
/* Slurpy or LoL-slurpy? */
if (param->flags & (SIG_ELEM_SLURPY_POS | SIG_ELEM_SLURPY_LOL)) {
/* Create Perl 6 array, create RPA of all remaining things, then
* store it. */
PMC *temp = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
while (cur_pos_arg < num_pos_args) {
cur_bv = get_positional_bind_val(interp, pc_positionals, capture, cur_pos_arg);
VTABLE_push_pmc(interp, temp, cur_bv.type == BIND_VAL_OBJ ?
cur_bv.val.o :
create_box(interp, cur_bv));
cur_pos_arg++;
}
cur_bv.type = BIND_VAL_OBJ;
cur_bv.val.o = param->flags & SIG_ELEM_SLURPY_POS ?
Rakudo_binding_create_positional(interp, temp) :
Rakudo_binding_create_lol(interp, temp);
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param,
cur_bv, no_nom_type_check, error);
if (bind_fail)
return bind_fail;
}
/* Otherwise, a positional. */
else {
/* Do we have a value?. */
if (cur_pos_arg < num_pos_args) {
/* Easy - just bind that. */
cur_bv = get_positional_bind_val(interp, pc_positionals, capture, cur_pos_arg);
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param,
cur_bv, no_nom_type_check, error);
if (bind_fail)
return bind_fail;
cur_pos_arg++;
}
else {
/* No value. If it's optional, fetch a default and bind that;
* if not, we're screwed. Note that we never nominal type check
* an optional with no value passed. */
if (param->flags & SIG_ELEM_IS_OPTIONAL) {
cur_bv.type = BIND_VAL_OBJ;
cur_bv.val.o = Rakudo_binding_handle_optional(interp, param, lexpad);
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param,
cur_bv, 0, error);
if (bind_fail)
return bind_fail;
}
else {
if (error)
*error = Rakudo_binding_arity_fail(interp, params, num_params, num_pos_args, 0);
return BIND_RESULT_FAIL;
}
}
}
}
/* Else, it's a non-slurpy named. */
else {
/* Try and get hold of value. */
PMC *value = PMCNULL;
INTVAL num_names = VTABLE_elements(interp, param->named_names);
INTVAL j;
if (!PMC_IS_NULL(named_args_copy)) {
for (j = 0; j < num_names; j++) {
STRING *name = VTABLE_get_string_keyed_int(interp, param->named_names, j);
value = VTABLE_get_pmc_keyed_str(interp, named_args_copy, name);
if (!PMC_IS_NULL(value)) {
/* Found a value. Delete entry from to-bind args and stop looking. */
VTABLE_delete_keyed_str(interp, named_args_copy, name);
break;
}
}
}
/* Did we get one? */
if (PMC_IS_NULL(value)) {
/* Nope. We'd better hope this param was optional... */
if (param->flags & SIG_ELEM_IS_OPTIONAL) {
cur_bv.type = BIND_VAL_OBJ;
cur_bv.val.o = Rakudo_binding_handle_optional(interp, param, lexpad);
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param,
cur_bv, 0, error);
}
else if (!suppress_arity_fail) {
if (error)
*error = Parrot_sprintf_c(interp, "Required named parameter '%S' not passed",
VTABLE_get_string_keyed_int(interp, param->named_names, 0));
return BIND_RESULT_FAIL;
}
}
else {
cur_bv.type = BIND_VAL_OBJ;
cur_bv.val.o = value;
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param,
cur_bv, 0, error);
}
/* If we got a binding failure, return it. */
if (bind_fail)
return bind_fail;
}
}
/* Do we have any left-over args? */
if (cur_pos_arg < num_pos_args && !suppress_arity_fail) {
/* Oh noes, too many positionals passed. */
if (error)
*error = Rakudo_binding_arity_fail(interp, params, num_params, num_pos_args, 1);
return BIND_RESULT_FAIL;
}
if (!PMC_IS_NULL(named_args_copy) && VTABLE_elements(interp, named_args_copy)) {
/* Oh noes, unexpected named args. */
if (error) {
INTVAL num_extra = VTABLE_elements(interp, named_args_copy);
PMC *iter = VTABLE_get_iter(interp, named_args_copy);
if (num_extra == 1) {
*error = Parrot_sprintf_c(interp, "Unexpected named parameter '%S' passed",
VTABLE_shift_string(interp, iter));
}
else {
INTVAL first = 1;
STRING *comma = Parrot_str_new(interp, ", ", 0);
*error = Parrot_sprintf_c(interp, "%d unexpected named parameters passed (", num_extra);
while (VTABLE_get_bool(interp, iter)) {
STRING *name = VTABLE_shift_string(interp, iter);
if (!first)
*error = Parrot_str_concat(interp, *error, comma);
else
first = 0;
*error = Parrot_str_concat(interp, *error, name);
}
*error = Parrot_str_concat(interp, *error, Parrot_str_new(interp, ")", 0));
}
}
return BIND_RESULT_FAIL;
}
/* If we get here, we're done. */
return BIND_RESULT_OK;
}
/* Binds a single argument into the lexpad, after doing any checks that are
* needed. Also handles any type captures. If there is a sub signature, then
* re-enters the binder. Returns one of the BIND_RESULT_* codes. */
static INTVAL
Rakudo_binding_bind_one_param(PARROT_INTERP, PMC *lexpad, Rakudo_Signature *signature, Rakudo_Parameter *param,
Rakudo_BindVal orig_bv, INTVAL no_nom_type_check, STRING **error) {
PMC *decont_value = NULL;
INTVAL desired_native;
Rakudo_BindVal bv;
/* Check if boxed/unboxed expections are met. */
desired_native = param->flags & SIG_ELEM_NATIVE_VALUE;
if (desired_native == 0 && orig_bv.type == BIND_VAL_OBJ ||
desired_native == SIG_ELEM_NATIVE_INT_VALUE && orig_bv.type == BIND_VAL_INT ||
desired_native == SIG_ELEM_NATIVE_NUM_VALUE && orig_bv.type == BIND_VAL_NUM ||
desired_native == SIG_ELEM_NATIVE_STR_VALUE && orig_bv.type == BIND_VAL_STR)
{
/* We have what we want. */
bv = orig_bv;
}
else if (desired_native == 0) {
/* We need to do a boxing operation. */
bv.type = BIND_VAL_OBJ;
bv.val.o = create_box(interp, orig_bv);
}
else {
storage_spec spec;
decont_value = Rakudo_cont_decontainerize(interp, orig_bv.val.o);
spec = REPR(decont_value)->get_storage_spec(interp, STABLE(decont_value));
switch (desired_native) {
case SIG_ELEM_NATIVE_INT_VALUE:
if (spec.can_box & STORAGE_SPEC_CAN_BOX_INT) {
bv.type = BIND_VAL_INT;
bv.val.i = REPR(decont_value)->box_funcs->get_int(interp, STABLE(decont_value), OBJECT_BODY(decont_value));
}
else {
if (error)
*error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native int",
param->variable_name);
return BIND_RESULT_FAIL;
}
break;
case SIG_ELEM_NATIVE_NUM_VALUE:
if (spec.can_box & STORAGE_SPEC_CAN_BOX_NUM) {
bv.type = BIND_VAL_NUM;
bv.val.n = REPR(decont_value)->box_funcs->get_num(interp, STABLE(decont_value), OBJECT_BODY(decont_value));
}
else {
if (error)
*error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native num",
param->variable_name);
return BIND_RESULT_FAIL;
}
break;
case SIG_ELEM_NATIVE_STR_VALUE:
if (spec.can_box & STORAGE_SPEC_CAN_BOX_STR) {
bv.type = BIND_VAL_STR;
bv.val.s = REPR(decont_value)->box_funcs->get_str(interp, STABLE(decont_value), OBJECT_BODY(decont_value));
}
else {
if (error)
*error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native str",
param->variable_name);
return BIND_RESULT_FAIL;
}
break;
default:
if (error)
*error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native type",
param->variable_name);
return BIND_RESULT_FAIL;
}
decont_value = NULL;
}
/* By this point, we'll either have an object that we might be able to
* bind if it passes the type check, or a native value that needs no
* further checking. */
if (bv.type == BIND_VAL_OBJ) {
/* Ensure the value is a 6model object; if not, marshall it to one. */
if (bv.val.o->vtable->base_type != smo_id) {
bv.val.o = Rakudo_types_parrot_map(interp, bv.val.o);
if (bv.val.o->vtable->base_type != smo_id) {
*error = Parrot_sprintf_c(interp, "Unmarshallable foreign language value passed for parameter '%S'",
param->variable_name);
return BIND_RESULT_FAIL;
}
}
/* We pretty much always need to de-containerized value, so get it
* right off. */
decont_value = Rakudo_cont_decontainerize(interp, bv.val.o);
/* Skip nominal type check if not needed. */
if (!no_nom_type_check) {
PMC *nom_type;
/* Is the nominal type generic and in need of instantiation? (This
* can happen in (::T, T) where we didn't learn about the type until
* during the signature bind). */
if (param->flags & SIG_ELEM_NOMINAL_GENERIC) {
PMC *HOW = STABLE(param->nominal_type)->HOW;
PMC *ig = VTABLE_find_method(interp, HOW, INSTANTIATE_GENERIC_str);
Parrot_ext_call(interp, ig, "PiPP->P", HOW, param->nominal_type,
lexpad, &nom_type);
}
else {
nom_type = param->nominal_type;
}
/* If not, do the check. If the wanted nominal type is Mu, then
* anything goes. */
if (nom_type != Rakudo_types_mu_get() &&
(decont_value->vtable->base_type != smo_id ||
!STABLE(decont_value)->type_check(interp, decont_value, nom_type))) {
/* Type check failed; produce error if needed. */
if (error) {
PMC * got_how = STABLE(decont_value)->HOW;
PMC * exp_how = STABLE(nom_type)->HOW;
PMC * got_name_meth = VTABLE_find_method(interp, got_how, NAME_str);
PMC * exp_name_meth = VTABLE_find_method(interp, exp_how, NAME_str);
STRING * expected, * got;
Parrot_ext_call(interp, got_name_meth, "PiP->S", got_how, bv.val.o, &got);
Parrot_ext_call(interp, exp_name_meth, "PiP->S", exp_how, nom_type, &expected);
*error = Parrot_sprintf_c(interp, "Nominal type check failed for parameter '%S'; expected %S but got %S instead",
param->variable_name, expected, got);
}
/* Report junction failure mode if it's a junction. */
return junc_or_fail(interp, decont_value);
}
/* Also enforce definedness constraints. */
if (param->flags & SIG_ELEM_DEFINEDNES_CHECK) {
INTVAL defined = IS_CONCRETE(decont_value);
if (defined && param->flags & SIG_ELEM_UNDEFINED_ONLY) {
if (error)
*error = Parrot_sprintf_c(interp,
"Parameter '%S' requires a type object, but an object instance was passed",
param->variable_name);
return junc_or_fail(interp, decont_value);
}
if (!defined && param->flags & SIG_ELEM_DEFINED_ONLY) {
if (error)
*error = Parrot_sprintf_c(interp,
"Parameter '%S' requires an instance, but a type object was passed",
param->variable_name);
return junc_or_fail(interp, decont_value);
}
}
}
}
/* Do we have any type captures to bind? */
if (!PMC_IS_NULL(param->type_captures)) {
Rakudo_binding_bind_type_captures(interp, lexpad, param, bv);
}
/* Do a coercion, if one is needed. */
if (!PMC_IS_NULL(param->coerce_type)) {
/* Coercing natives not possible - nothing to call a method on. */
if (bv.type != BIND_VAL_OBJ) {
*error = Parrot_sprintf_c(interp,
"Unable to coerce natively typed parameter '%S'",
param->variable_name);
return BIND_RESULT_FAIL;
}
/* Only coerce if we don't already have the correct type. */
if (!STABLE(decont_value)->type_check(interp, decont_value, param->coerce_type)) {
PMC *coerce_meth = VTABLE_find_method(interp, decont_value, param->coerce_method);
if (!PMC_IS_NULL(coerce_meth)) {
Parrot_ext_call(interp, coerce_meth, "Pi->P", decont_value, &decont_value);
}
else {
/* No coercion method availale; whine and fail to bind. */
if (error) {
PMC * got_how = STABLE(decont_value)->HOW;
PMC * got_name_meth = VTABLE_find_method(interp, got_how, NAME_str);
STRING * got;
Parrot_ext_call(interp, got_name_meth, "PiP->S", got_how, decont_value, &got);
*error = Parrot_sprintf_c(interp,
"Unable to coerce value for '%S' from %S to %S; no coercion method defined",
param->variable_name, got, param->coerce_method);
}
return BIND_RESULT_FAIL;
}
}
}
/* If it's not got attributive binding, we'll go about binding it into the
* lex pad. */
if (!(param->flags & SIG_ELEM_BIND_ATTRIBUTIVE) && !STRING_IS_NULL(param->variable_name)) {
/* Is it native? If so, just go ahead and bind it. */
if (bv.type != BIND_VAL_OBJ) {
switch (bv.type) {
case BIND_VAL_INT:
VTABLE_set_integer_keyed_str(interp, lexpad, param->variable_name, bv.val.i);
break;
case BIND_VAL_NUM:
VTABLE_set_number_keyed_str(interp, lexpad, param->variable_name, bv.val.n);
break;
case BIND_VAL_STR:
VTABLE_set_string_keyed_str(interp, lexpad, param->variable_name, bv.val.s);
break;
}
}
/* Otherwise it's some objecty case. */
else if (param->flags & SIG_ELEM_IS_RW) {
/* XXX TODO Check if rw flag is set; also need to have a
* wrapper container that carries extra constraints. */
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bv.val.o);
}
else if (param->flags & SIG_ELEM_IS_PARCEL) {
/* Just bind the thing as is into the lexpad. */
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bv.val.o);
}
else {
/* If it's an array, copy means make a new one and store,
* and a normal bind is a straightforward binding plus
* adding a constraint. */
if (param->flags & SIG_ELEM_ARRAY_SIGIL) {
PMC *bindee = decont_value;
if (param->flags & SIG_ELEM_IS_COPY) {
bindee = Rakudo_binding_create_positional(interp,
Parrot_pmc_new(interp, enum_class_ResizablePMCArray));
Rakudo_cont_store(interp, bindee, decont_value, 0, 0);
}
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bindee);
}
/* If it's a hash, similar approach to array. */
else if (param->flags & SIG_ELEM_HASH_SIGIL) {
PMC *bindee = decont_value;
if (param->flags & SIG_ELEM_IS_COPY) {
bindee = Rakudo_binding_create_hash(interp,
Parrot_pmc_new(interp, enum_class_Hash));
Rakudo_cont_store(interp, bindee, decont_value, 0, 0);
}
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bindee);
}
/* If it's a scalar, we always need to wrap it into a new
* container and store it, for copy or ro case (the rw bit
* in the container descriptor takes care of the rest). */
else {
PMC *new_cont = Rakudo_cont_scalar_from_descriptor(interp, param->container_descriptor);
Rakudo_cont_store(interp, new_cont, decont_value, 0, 0);
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, new_cont);
}
}
}
/* Is it the invocant? If so, also have to bind to self lexical. */
if (param->flags & SIG_ELEM_INVOCANT)
VTABLE_set_pmc_keyed_str(interp, lexpad, SELF_str, decont_value);
/* Handle any constraint types (note that they may refer to the parameter by
* name, so we need to have bound it already). */
if (!PMC_IS_NULL(param->post_constraints)) {
PMC * code_type = Rakudo_types_code_get();
PMC * const constraints = param->post_constraints;
INTVAL num_constraints = VTABLE_elements(interp, constraints);
INTVAL i;
for (i = 0; i < num_constraints; i++) {
/* Check we meet the constraint. */
PMC *cons_type = VTABLE_get_pmc_keyed_int(interp, constraints, i);
PMC *accepts_meth = VTABLE_find_method(interp, cons_type, ACCEPTS);
PMC *old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *cappy = Parrot_pmc_new(interp, enum_class_CallContext);
if (STABLE(cons_type)->type_check(interp, cons_type, code_type))
Parrot_sub_capture_lex(interp,
VTABLE_get_attr_keyed(interp, cons_type, code_type, DO_str));
VTABLE_push_pmc(interp, cappy, cons_type);
switch (bv.type) {
case BIND_VAL_OBJ:
VTABLE_push_pmc(interp, cappy, bv.val.o);
break;
case BIND_VAL_INT:
VTABLE_push_integer(interp, cappy, bv.val.i);
break;
case BIND_VAL_NUM:
VTABLE_push_float(interp, cappy, bv.val.n);
break;
case BIND_VAL_STR:
VTABLE_push_string(interp, cappy, bv.val.s);
break;
}
Parrot_pcc_invoke_from_sig_object(interp, accepts_meth, cappy);
cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
if (!VTABLE_get_bool(interp, VTABLE_get_pmc_keyed_int(interp, cappy, 0))) {
if (error)
*error = Parrot_sprintf_c(interp, "Constraint type check failed for parameter '%S'",
param->variable_name);
return BIND_RESULT_FAIL;
}
}
}
/* If it's attributive, now we assign it. */
if (param->flags & SIG_ELEM_BIND_ATTRIBUTIVE) {
INTVAL result = Rakudo_binding_assign_attributive(interp, lexpad, param, bv, decont_value, error);
if (result != BIND_RESULT_OK)
return result;
}
/* If it has a sub-signature, bind that. */
if (!PMC_IS_NULL(param->sub_llsig) && bv.type == BIND_VAL_OBJ) {
/* Turn value into a capture, unless we already have one. */
PMC *capture = PMCNULL;
INTVAL result;
if (param->flags & SIG_ELEM_IS_CAPTURE) {
capture = decont_value;
}
else {
PMC *meth = VTABLE_find_method(interp, decont_value, Parrot_str_new(interp, "Capture", 0));
if (PMC_IS_NULL(meth)) {
if (error)
*error = Parrot_sprintf_c(interp, "Could not turn argument into capture");
return BIND_RESULT_FAIL;
}
Parrot_ext_call(interp, meth, "Pi->P", decont_value, &capture);
}
/* Recurse into signature binder. */
result = Rakudo_binding_bind(interp, lexpad, param->sub_llsig,
capture, no_nom_type_check, error);
if (result != BIND_RESULT_OK)
{
if (error) {
/* Note in the error message that we're in a sub-signature. */
*error = Parrot_str_concat(interp, *error,
Parrot_str_new(interp, " in sub-signature", 0));
/* Have we a variable name? */
if (!STRING_IS_NULL(param->variable_name)) {
*error = Parrot_str_concat(interp, *error,
Parrot_str_new(interp, " of parameter ", 0));
*error = Parrot_str_concat(interp, *error, param->variable_name);
}
}
return result;
}
}
/* Binding of this parameter was thus successful - we're done. */
return BIND_RESULT_OK;
}
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_io_internal_getaddrinfo(PARROT_INTERP, ARGIN(STRING *addr), INTVAL port,
INTVAL protocol, INTVAL fam, INTVAL passive)
{
#ifdef PARROT_HAS_IPV6
PMC *array;
struct addrinfo hints;
struct addrinfo *ai, *walk;
/* We need to pass the port as a string (because you could also use a
* service specification from /etc/services). The highest port is 65535,
* so we need 5 characters + trailing null-byte. */
char portstr[6];
int ret;
/* convert Parrot's family to system family */
if (fam < 0
|| fam >= PIO_PF_MAX
|| (fam = pio_pf[fam]) < 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"unsupported protocol family: %ld", fam);
memset(&hints, 0, sizeof (struct addrinfo));
if (passive)
hints.ai_flags = AI_PASSIVE;
hints.ai_family = fam;
hints.ai_protocol = protocol;
snprintf(portstr, sizeof (portstr), "%ld", port);
{
/* Limited scope for the C string to prevent mistakes */
char *s = STRING_IS_NULL(addr)
? (char *) NULL
: Parrot_str_to_cstring(interp, addr);
ret = getaddrinfo(s, portstr, &hints, &ai);
Parrot_str_free_cstring(s);
}
if (ret != 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"getaddrinfo failed: %Ss: %Ss", addr,
Parrot_platform_strerror(interp, PIO_SOCK_ERRNO));
array = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
for (walk = ai; walk; walk = walk->ai_next) {
PMC *sockaddr = Parrot_pmc_new(interp, enum_class_Sockaddr);
Parrot_Sockaddr_attributes *sa_attrs = PARROT_SOCKADDR(sockaddr);
sa_attrs->family = walk->ai_family;
sa_attrs->type = walk->ai_socktype;
sa_attrs->protocol = walk->ai_protocol;
sa_attrs->len = walk->ai_addrlen;
sa_attrs->pointer = Parrot_gc_allocate_memory_chunk(interp,
walk->ai_addrlen);
memcpy(sa_attrs->pointer, walk->ai_addr, walk->ai_addrlen);
VTABLE_push_pmc(interp, array, sockaddr);
}
freeaddrinfo(ai);
return array;
#else /* PARROT_HAS_IPV6 */
const char *host;
char *cstring;
int success;
PMC *sockaddr;
PMC *array;
const size_t addr_len = sizeof (struct sockaddr_in);
struct sockaddr_in *sa;
Parrot_Sockaddr_attributes *sa_attrs;
sa = (struct sockaddr_in *)Parrot_gc_allocate_memory_chunk(interp,
addr_len);
sockaddr = Parrot_pmc_new(interp, enum_class_Sockaddr);
sa_attrs = PARROT_SOCKADDR(sockaddr);
sa_attrs->family = PF_INET;
sa_attrs->type = 0;
sa_attrs->protocol = 0;
sa_attrs->len = addr_len;
sa_attrs->pointer = sa;
if (STRING_IS_NULL(addr)) {
cstring = NULL;
host = "127.0.0.1";
}
else {
cstring = Parrot_str_to_cstring(interp, addr);
host = cstring;
}
# ifdef _WIN32
sa->sin_addr.S_un.S_addr = inet_addr(host);
success = sa->sin_addr.S_un.S_addr != -1;
# else
# ifdef PARROT_DEF_INET_ATON
success = inet_aton(host, &sa->sin_addr) != 0;
# else
/* positive retval is success */
success = inet_pton(PF_INET, host, &sa->sin_addr) > 0;
# endif
# endif
if (!success) {
/* Maybe it is a hostname, try to lookup */
/* XXX Check PIO option before doing a name lookup,
* it may have been toggled off.
*/
const struct hostent * const he = gethostbyname(host);
if (!he) {
if (cstring)
Parrot_str_free_cstring(cstring);
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"getaddrinfo failed: %s", host);
}
memcpy((char*)&sa->sin_addr, he->h_addr, sizeof (sa->sin_addr));
}
if (cstring)
Parrot_str_free_cstring(cstring);
sa->sin_family = PF_INET;
sa->sin_port = htons(port);
array = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
VTABLE_push_pmc(interp, array, sockaddr);
return array;
#endif /* PARROT_HAS_IPV6 */
}
/* This Parrot-specific addition to the API is used to mark an object. */
static void gc_mark(PARROT_INTERP, STable *st, void *data) {
P6strBody *body = (P6strBody *)data;
if (!STRING_IS_NULL(body->value))
Parrot_gc_mark_STRING_alive(interp, body->value);
}
/* 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));
}
}
int yr_parser_reduce_rule_declaration_phase_2(
yyscan_t yyscanner,
YR_RULE* rule)
{
uint32_t max_strings_per_rule;
uint32_t strings_in_rule = 0;
uint8_t* nop_inst_addr = NULL;
int result;
YR_FIXUP *fixup;
YR_STRING* string;
YR_COMPILER* compiler = yyget_extra(yyscanner);
yr_get_configuration(
YR_CONFIG_MAX_STRINGS_PER_RULE,
(void*) &max_strings_per_rule);
// Show warning if the rule is generating too many atoms. The warning is
// shown if the number of atoms is greater than 20 times the maximum number
// of strings allowed for a rule, as 20 is minimum number of atoms generated
// for a string using *nocase*, *ascii* and *wide* modifiers simultaneosly.
if (rule->num_atoms > YR_ATOMS_PER_RULE_WARNING_THRESHOLD)
{
yywarning(
yyscanner,
"rule %s is slowing down scanning",
rule->identifier);
}
// Check for unreferenced (unused) strings.
string = rule->strings;
while (!STRING_IS_NULL(string))
{
// Only the heading fragment in a chain of strings (the one with
// chained_to == NULL) must be referenced. All other fragments
// are never marked as referenced.
if (!STRING_IS_REFERENCED(string) &&
string->chained_to == NULL)
{
yr_compiler_set_error_extra_info(compiler, string->identifier);
return ERROR_UNREFERENCED_STRING;
}
strings_in_rule++;
if (strings_in_rule > max_strings_per_rule)
{
yr_compiler_set_error_extra_info(compiler, rule->identifier);
return ERROR_TOO_MANY_STRINGS;
}
string = (YR_STRING*) yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
result = yr_parser_emit_with_arg_reloc(
yyscanner,
OP_MATCH_RULE,
rule,
NULL,
NULL);
// Generate a do-nothing instruction (NOP) in order to get its address
// and use it as the destination for the OP_INIT_RULE skip jump. We can not
// simply use the address of the OP_MATCH_RULE instruction +1 because we
// can't be sure that the instruction following the OP_MATCH_RULE is going to
// be in the same arena page. As we don't have a reliable way of getting the
// address of the next instruction we generate the OP_NOP.
if (result == ERROR_SUCCESS)
result = yr_parser_emit(yyscanner, OP_NOP, &nop_inst_addr);
fixup = compiler->fixup_stack_head;
*(void**)(fixup->address) = (void*) nop_inst_addr;
compiler->fixup_stack_head = fixup->next;
yr_free(fixup);
return result;
}
int yr_parser_reduce_rule_declaration(
yyscan_t yyscanner,
int32_t flags,
const char* identifier,
char* tags,
YR_STRING* strings,
YR_META* metas)
{
YR_COMPILER* compiler = yyget_extra(yyscanner);
YR_RULE* rule;
YR_STRING* string;
if (yr_hash_table_lookup(
compiler->rules_table,
identifier,
compiler->current_namespace->name) != NULL)
{
// A rule with the same identifier already exists, return the
// appropriate error.
yr_compiler_set_error_extra_info(compiler, identifier);
compiler->last_result = ERROR_DUPLICATE_RULE_IDENTIFIER;
return compiler->last_result;
}
// Check for unreferenced (unused) strings.
string = compiler->current_rule_strings;
while(!STRING_IS_NULL(string))
{
// Only the heading fragment in a chain of strings (the one with
// chained_to == NULL) must be referenced. All other fragments
// are never marked as referenced.
if (!STRING_IS_REFERENCED(string) &&
string->chained_to == NULL)
{
yr_compiler_set_error_extra_info(compiler, string->identifier);
compiler->last_result = ERROR_UNREFERENCED_STRING;
break;
}
string = yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
if (compiler->last_result != ERROR_SUCCESS)
return compiler->last_result;
compiler->last_result = yr_arena_allocate_struct(
compiler->rules_arena,
sizeof(YR_RULE),
(void**) &rule,
offsetof(YR_RULE, identifier),
offsetof(YR_RULE, tags),
offsetof(YR_RULE, strings),
offsetof(YR_RULE, metas),
offsetof(YR_RULE, ns),
EOL);
if (compiler->last_result != ERROR_SUCCESS)
return compiler->last_result;
compiler->last_result = yr_arena_write_string(
compiler->sz_arena,
identifier,
&rule->identifier);
if (compiler->last_result != ERROR_SUCCESS)
return compiler->last_result;
compiler->last_result = yr_parser_emit_with_arg_reloc(
yyscanner,
RULE_POP,
PTR_TO_UINT64(rule),
NULL);
if (compiler->last_result != ERROR_SUCCESS)
return compiler->last_result;
rule->g_flags = flags | compiler->current_rule_flags;
rule->tags = tags;
rule->strings = strings;
rule->metas = metas;
rule->ns = compiler->current_namespace;
compiler->current_rule_flags = 0;
compiler->current_rule_strings = NULL;
yr_hash_table_add(
compiler->rules_table,
identifier,
compiler->current_namespace->name,
(void*) rule);
return compiler->last_result;
}
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);
}
int yr_parser_reduce_string_identifier(
yyscan_t yyscanner,
const char* identifier,
uint8_t instruction,
uint64_t at_offset)
{
YR_STRING* string;
YR_COMPILER* compiler = yyget_extra(yyscanner);
if (strcmp(identifier, "$") == 0) // is an anonymous string ?
{
if (compiler->loop_for_of_mem_offset >= 0) // inside a loop ?
{
yr_parser_emit_with_arg(
yyscanner,
OP_PUSH_M,
compiler->loop_for_of_mem_offset,
NULL,
NULL);
yr_parser_emit(yyscanner, instruction, NULL);
string = compiler->current_rule->strings;
while(!STRING_IS_NULL(string))
{
if (instruction != OP_FOUND)
string->g_flags &= ~STRING_GFLAGS_SINGLE_MATCH;
if (instruction == OP_FOUND_AT)
{
// Avoid overwriting any previous fixed offset
if (string->fixed_offset == UNDEFINED)
string->fixed_offset = at_offset;
// If a previous fixed offset was different, disable
// the STRING_GFLAGS_FIXED_OFFSET flag because we only
// have room to store a single fixed offset value
if (string->fixed_offset != at_offset)
string->g_flags &= ~STRING_GFLAGS_FIXED_OFFSET;
}
else
{
string->g_flags &= ~STRING_GFLAGS_FIXED_OFFSET;
}
string = (YR_STRING*) yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
}
else
{
// Anonymous strings not allowed outside of a loop
compiler->last_result = ERROR_MISPLACED_ANONYMOUS_STRING;
}
}
else
{
string = yr_parser_lookup_string(yyscanner, identifier);
if (string != NULL)
{
yr_parser_emit_with_arg_reloc(
yyscanner,
OP_PUSH,
PTR_TO_INT64(string),
NULL,
NULL);
if (instruction != OP_FOUND)
string->g_flags &= ~STRING_GFLAGS_SINGLE_MATCH;
if (instruction == OP_FOUND_AT)
{
// Avoid overwriting any previous fixed offset
if (string->fixed_offset == UNDEFINED)
string->fixed_offset = at_offset;
// If a previous fixed offset was different, disable
// the STRING_GFLAGS_FIXED_OFFSET flag because we only
// have room to store a single fixed offset value
if (string->fixed_offset == UNDEFINED ||
string->fixed_offset != at_offset)
{
string->g_flags &= ~STRING_GFLAGS_FIXED_OFFSET;
}
}
else
{
string->g_flags &= ~STRING_GFLAGS_FIXED_OFFSET;
}
yr_parser_emit(yyscanner, instruction, NULL);
string->g_flags |= STRING_GFLAGS_REFERENCED;
}
}
return compiler->last_result;
}
PARROT_EXPORT
void
Parrot_lib_update_paths_from_config_hash(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_lib_update_paths_from_config_hash)
STRING * versionlib = NULL;
STRING * entry = NULL;
STRING * builddir = NULL;
PMC * const lib_paths =
VTABLE_get_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_LIB_PATHS);
PMC * const config_hash =
VTABLE_get_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_CONFIG_HASH);
PMC * paths;
if (VTABLE_elements(interp, config_hash)) {
STRING * const libkey = CONST_STRING(interp, "libdir");
STRING * const verkey = CONST_STRING(interp, "versiondir");
STRING * const builddirkey = CONST_STRING(interp, "build_dir");
STRING * const installed = CONST_STRING(interp, "installed");
versionlib = VTABLE_get_string_keyed_str(interp, config_hash, libkey);
entry = VTABLE_get_string_keyed_str(interp, config_hash, verkey);
versionlib = Parrot_str_concat(interp, versionlib, entry);
if (!VTABLE_get_integer_keyed_str(interp, config_hash, installed))
builddir = VTABLE_get_string_keyed_str(interp,
config_hash, builddirkey);
}
paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, PARROT_LIB_PATH_INCLUDE);
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/"));
VTABLE_push_string(interp, paths, entry);
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/include/"));
VTABLE_push_string(interp, paths, entry);
}
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/include/"));
VTABLE_push_string(interp, paths, entry);
}
paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, PARROT_LIB_PATH_LIBRARY);
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/library/"));
VTABLE_push_string(interp, paths, entry);
}
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/library/"));
VTABLE_push_string(interp, paths, entry);
}
paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, PARROT_LIB_PATH_LANG);
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/languages/"));
VTABLE_push_string(interp, paths, entry);
}
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/languages/"));
VTABLE_push_string(interp, paths, entry);
}
paths = VTABLE_get_pmc_keyed_int(interp, lib_paths, PARROT_LIB_PATH_DYNEXT);
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/dynext/"));
VTABLE_push_string(interp, paths, entry);
}
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/dynext/"));
VTABLE_push_string(interp, paths, entry);
}
}
/* Binds a single argument into the lexpad, after doing any checks that are
* needed. Also handles any type captures. If there is a sub signature, then
* re-enters the binder. Returns one of the BIND_RESULT_* codes. */
static INTVAL
Rakudo_binding_bind_one_param(PARROT_INTERP, PMC *lexpad, PMC *llsig, llsig_element *sig_info,
PMC *value, INTVAL no_nom_type_check, STRING **error) {
/* If we need to do a type check, do one. */
if (!no_nom_type_check) {
/* See if we get a hit in the type cache. */
INTVAL cache_matched = 0;
INTVAL value_type = VTABLE_type(interp, value);
if (value_type != 0) {
INTVAL i;
for (i = 0; i < NOM_TYPE_CACHE_SIZE; i++) {
if (sig_info->nom_type_cache[i] == value_type)
{
cache_matched = 1;
break;
}
}
}
/* If not, do the check. */
if (!cache_matched) {
PMC * const type_obj = sig_info->nominal_type;
PMC * accepts_meth = VTABLE_find_method(interp, type_obj, ACCEPTS);
PMC * result = PMCNULL;
Parrot_ext_call(interp, accepts_meth, "PiP->P", type_obj, value, &result);
if (VTABLE_get_bool(interp, result)) {
/* Cache if possible. */
if (value_type != 0 && value_type != p6r_id && value_type != p6o_id) {
INTVAL i;
for (i = 0; i < NOM_TYPE_CACHE_SIZE; i++) {
if (sig_info->nom_type_cache[i] == 0)
{
sig_info->nom_type_cache[i] = value_type;
PARROT_GC_WRITE_BARRIER(interp, llsig);
break;
}
}
}
}
else {
/* Type check failed. However, for language inter-op, we do some
* extra checks if the type is just Positional, Associative, or
* Callable and the thingy we have matches those enough. */
/* XXX TODO: Implement language interop checks. */
if (error) {
STRING * const perl = PERL_str;
PMC * perl_meth = VTABLE_find_method(interp, type_obj, perl);
PMC * how_meth = VTABLE_find_method(interp, value, HOW);
STRING * expected, * got;
PMC * value_how, * value_type;
Parrot_ext_call(interp, perl_meth, "Pi->S", type_obj, &expected);
Parrot_ext_call(interp, how_meth, "Pi->P", value, &value_how);
value_type = VTABLE_get_attr_str(interp, value_how, SHORTNAME_str);
got = VTABLE_get_string(interp, value_type);
*error = Parrot_sprintf_c(interp, "Nominal type check failed for parameter '%S'; expected %S but got %S instead",
sig_info->variable_name, expected, got);
}
if (VTABLE_isa(interp, value, JUNCTION_str))
return BIND_RESULT_JUNCTION;
else
return BIND_RESULT_FAIL;
}
}
}
/* Do we have any type captures to bind? */
if (!PMC_IS_NULL(sig_info->type_captures))
Rakudo_binding_bind_type_captures(interp, lexpad, sig_info, value);
/* Do a coercion, if one is needed. */
if (!STRING_IS_NULL(sig_info->coerce_to)) {
PMC *coerce_meth = VTABLE_find_method(interp, value, sig_info->coerce_to);
if (!PMC_IS_NULL(coerce_meth)) {
Parrot_ext_call(interp, coerce_meth, "Pi->P", value, &value);
}
else {
/* No coercion method availale; whine and fail to bind. */
if (error) {
PMC * how_meth = VTABLE_find_method(interp, value, HOW);
PMC * value_how, * value_type;
STRING * got;
Parrot_ext_call(interp, how_meth, "Pi->P", value, &value_how);
value_type = VTABLE_get_attr_str(interp, value_how, SHORTNAME_str);
got = VTABLE_get_string(interp, value_type);
*error = Parrot_sprintf_c(interp,
"Unable to coerce value for '%S' from %S to %S; no coercion method defined",
sig_info->variable_name, got, sig_info->coerce_to);
}
return BIND_RESULT_FAIL;
}
}
/* If it's not got attributive binding, we'll go about binding it into the
* lex pad. */
if (!(sig_info->flags & SIG_ELEM_BIND_ATTRIBUTIVE)) {
/* Is it "is rw"? */
if (sig_info->flags & SIG_ELEM_IS_RW) {
/* XXX TODO Check if rw flag is set. */
if (!STRING_IS_NULL(sig_info->variable_name))
VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, value);
}
else if (sig_info->flags & SIG_ELEM_IS_PARCEL) {
/* Just bind the thing as is into the lexpad. */
if (!STRING_IS_NULL(sig_info->variable_name))
VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, value);
}
else if (sig_info->flags & SIG_ELEM_IS_COPY) {
/* Place the value into a new container instead of binding to an existing one */
value = descalarref(interp, value);
if (!STRING_IS_NULL(sig_info->variable_name)) {
PMC *copy, *ref, *store_meth;
if (sig_info->flags & SIG_ELEM_ARRAY_SIGIL) {
copy = Rakudo_binding_create_positional(interp, PMCNULL, ARRAY_str);
store_meth = VTABLE_find_method(interp, copy, STORE_str);
Parrot_ext_call(interp, store_meth, "PiP", copy, value);
}
else if (sig_info->flags & SIG_ELEM_HASH_SIGIL) {
copy = Rakudo_binding_create_hash(interp, pmc_new(interp, enum_class_Hash));
store_meth = VTABLE_find_method(interp, copy, STORE_str);
Parrot_ext_call(interp, store_meth, "PiP", copy, value);
}
else {
copy = pmc_new_init(interp, p6s_id, value);
VTABLE_setprop(interp, copy, SCALAR_str, copy);
}
VTABLE_setprop(interp, copy, RW_str, copy);
VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, copy);
}
}
else {
/* Read only. Wrap it into a ObjectRef, mark readonly and bind it. */
if (!STRING_IS_NULL(sig_info->variable_name)) {
PMC *ref = pmc_new_init(interp, or_id, value);
if (!(sig_info->flags & (SIG_ELEM_ARRAY_SIGIL | SIG_ELEM_HASH_SIGIL)))
VTABLE_setprop(interp, ref, SCALAR_str, ref);
VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, ref);
}
}
}
/* Is it the invocant? If so, also have to bind to self lexical. */
if (sig_info->flags & SIG_ELEM_INVOCANT)
VTABLE_set_pmc_keyed_str(interp, lexpad, SELF_str, value);
/* Handle any constraint types (note that they may refer to the parameter by
* name, so we need to have bound it already). */
if (!PMC_IS_NULL(sig_info->post_constraints)) {
PMC * const constraints = sig_info->post_constraints;
INTVAL num_constraints = VTABLE_elements(interp, constraints);
PMC * result = PMCNULL;
INTVAL i;
for (i = 0; i < num_constraints; i++) {
PMC *cons_type = VTABLE_get_pmc_keyed_int(interp, constraints, i);
PMC *accepts_meth = VTABLE_find_method(interp, cons_type, ACCEPTS);
if (VTABLE_isa(interp, cons_type, BLOCK_str))
Parrot_sub_capture_lex(interp,
VTABLE_get_attr_str(interp, cons_type, DO_str));
Parrot_ext_call(interp, accepts_meth, "PiP->P", cons_type, value, &result);
if (!VTABLE_get_bool(interp, result)) {
if (error)
*error = Parrot_sprintf_c(interp, "Constraint type check failed for parameter '%S'",
sig_info->variable_name);
return BIND_RESULT_FAIL;
}
}
}
/* If it's attributive, now we assign it. */
if (sig_info->flags & SIG_ELEM_BIND_ATTRIBUTIVE) {
INTVAL result = Rakudo_binding_assign_attributive(interp, lexpad, sig_info, value, error);
if (result != BIND_RESULT_OK)
return result;
}
/* If it has a sub-signature, bind that. */
if (!PMC_IS_NULL(sig_info->sub_llsig)) {
/* Turn value into a capture, unless we already have one. */
PMC *capture = PMCNULL;
INTVAL result;
if (sig_info->flags & SIG_ELEM_IS_CAPTURE) {
capture = value;
}
else {
PMC *meth = VTABLE_find_method(interp, value, Parrot_str_new(interp, "Capture", 0));
if (PMC_IS_NULL(meth)) {
if (error)
*error = Parrot_sprintf_c(interp, "Could not turn argument into capture");
return BIND_RESULT_FAIL;
}
Parrot_ext_call(interp, meth, "Pi->P", value, &capture);
}
/* Recurse into signature binder. */
result = Rakudo_binding_bind_llsig(interp, lexpad, sig_info->sub_llsig,
capture, no_nom_type_check, error);
if (result != BIND_RESULT_OK)
{
if (error) {
/* Note in the error message that we're in a sub-signature. */
*error = Parrot_str_concat(interp, *error,
Parrot_str_new(interp, " in sub-signature", 0));
/* Have we a variable name? */
if (!STRING_IS_NULL(sig_info->variable_name)) {
*error = Parrot_str_concat(interp, *error,
Parrot_str_new(interp, " of parameter ", 0));
*error = Parrot_str_concat(interp, *error, sig_info->variable_name);
}
}
return result;
}
}
/* Binding of this parameter was thus successful - we're done. */
return BIND_RESULT_OK;
}
int get_match_data(int message, void* message_data, void* data)
{
matches target;
YR_META* meta;
YR_STRING* s;
YR_RULE* rule;
pMatch m;
YR_MODULE_IMPORT* mi; // Used for the CALLBACK_MSG_IMPORT_MODULE message.
pcallback_data* cb_data = (pcallback_data*) data;
if (!cb_data)
{
PRINT_ERROR << "Yara wrapper callback called with no data!" << std::endl;
return ERROR_CALLBACK_ERROR;
}
switch (message)
{
case CALLBACK_MSG_RULE_MATCHING:
rule = (YR_RULE*) message_data;
target = cb_data->get()->yara_matches;
meta = rule->metas;
s = rule->strings;
m = boost::make_shared<Match>();
while (!META_IS_NULL(meta))
{
m->add_metadata(std::string(meta->identifier), meta->string);
++meta;
}
while (!STRING_IS_NULL(s))
{
if (STRING_FOUND(s))
{
YR_MATCH* match = STRING_MATCHES(s).head;
while (match != nullptr)
{
if (!STRING_IS_HEX(s))
{
std::string found((char*) match->data, match->length);
// Yara inserts null bytes when it matches unicode strings. Dirty fix to remove them all.
found.erase(std::remove(found.begin(), found.end(), '\0'), found.end());
m->add_found_string(found);
}
else
{
std::stringstream ss;
ss << std::hex;
for (int i = 0; i < std::min(20, match->length); i++) {
ss << static_cast<unsigned int>(match->data[i]) << " "; // Don't interpret as a char
}
if (match->length > 20) {
ss << "...";
}
m->add_found_string(ss.str());
}
match = match->next;
}
}
++s;
}
target->push_back(m);
return CALLBACK_CONTINUE; // Don't stop on the first matching rule.
case CALLBACK_MSG_RULE_NOT_MATCHING:
return CALLBACK_CONTINUE;
// Detect when the ManaPE module is loaded
case CALLBACK_MSG_IMPORT_MODULE:
mi = (YR_MODULE_IMPORT*) message_data;
if (std::string(mi->module_name) == "manape")
{
if (!cb_data || cb_data->get()->pe_info == nullptr)
{
PRINT_ERROR << "Yara rule imports the ManaPE module, but no ManaPE data was given!" << std::endl;
return ERROR_CALLBACK_ERROR;
}
else if (!cb_data)
{
PRINT_ERROR << "No data given to the callback to store results!" << std::endl;
return ERROR_CALLBACK_ERROR;
}
mi->module_data = &*(cb_data->get()->pe_info);
}
return ERROR_SUCCESS;
case CALLBACK_MSG_SCAN_FINISHED:
return ERROR_SUCCESS;
default:
PRINT_WARNING << "Yara callback received an unhandled message (" << message << ")." << std::endl;
return ERROR_SUCCESS;
}
}
int yara_callback(
int message,
YR_RULE* rule,
void* data)
{
YR_STRING* string;
YR_MATCH* m;
YR_META* meta;
char* tag_name;
size_t tag_length;
PyObject* tag_list = NULL;
PyObject* string_list = NULL;
PyObject* meta_list = NULL;
PyObject* match;
PyObject* callback_dict;
PyObject* object;
PyObject* tuple;
PyObject* matches = ((CALLBACK_DATA*) data)->matches;
PyObject* callback = ((CALLBACK_DATA*) data)->callback;
PyObject* callback_result;
PyGILState_STATE gil_state;
int result = CALLBACK_CONTINUE;
if (message == CALLBACK_MSG_SCAN_FINISHED)
return CALLBACK_CONTINUE;
if (message == CALLBACK_MSG_RULE_NOT_MATCHING && callback == NULL)
return CALLBACK_CONTINUE;
gil_state = PyGILState_Ensure();
tag_list = PyList_New(0);
string_list = PyList_New(0);
meta_list = PyDict_New();
if (tag_list == NULL || string_list == NULL || meta_list == NULL)
{
Py_XDECREF(tag_list);
Py_XDECREF(string_list);
Py_XDECREF(meta_list);
PyGILState_Release(gil_state);
return CALLBACK_ERROR;
}
tag_name = rule->tags;
tag_length = tag_name != NULL ? strlen(tag_name) : 0;
while (tag_length > 0)
{
object = PY_STRING(tag_name);
PyList_Append(tag_list, object);
Py_DECREF(object);
tag_name += tag_length + 1;
tag_length = strlen(tag_name);
}
meta = rule->metas;
while(!META_IS_NULL(meta))
{
if (meta->type == META_TYPE_INTEGER)
object = Py_BuildValue("I", meta->integer);
else if (meta->type == META_TYPE_BOOLEAN)
object = PyBool_FromLong(meta->integer);
else
object = PY_STRING(meta->string);
PyDict_SetItemString(meta_list, meta->identifier, object);
Py_DECREF(object);
meta++;
}
string = rule->strings;
while (!STRING_IS_NULL(string))
{
if (STRING_FOUND(string))
{
m = STRING_MATCHES(string).head;
while (m != NULL)
{
object = PyBytes_FromStringAndSize((char*) m->data, m->length);
tuple = Py_BuildValue(
"(L,s,O)",
m->offset,
string->identifier,
object);
PyList_Append(string_list, tuple);
Py_DECREF(object);
Py_DECREF(tuple);
m = m->next;
}
}
string++;
}
if (message == CALLBACK_MSG_RULE_MATCHING)
{
match = Match_NEW(
rule->identifier,
rule->ns->name,
tag_list,
meta_list,
string_list);
if (match != NULL)
{
PyList_Append(matches, match);
Py_DECREF(match);
}
else
{
Py_DECREF(tag_list);
Py_DECREF(string_list);
Py_DECREF(meta_list);
PyGILState_Release(gil_state);
return CALLBACK_ERROR;
}
}
if (callback != NULL)
{
Py_INCREF(callback);
callback_dict = PyDict_New();
object = PyBool_FromLong(message == CALLBACK_MSG_RULE_MATCHING);
PyDict_SetItemString(callback_dict, "matches", object);
Py_DECREF(object);
object = PY_STRING(rule->identifier);
PyDict_SetItemString(callback_dict, "rule", object);
Py_DECREF(object);
object = PY_STRING(rule->ns->name);
PyDict_SetItemString(callback_dict, "namespace", object);
Py_DECREF(object);
PyDict_SetItemString(callback_dict, "tags", tag_list);
PyDict_SetItemString(callback_dict, "meta", meta_list);
PyDict_SetItemString(callback_dict, "strings", string_list);
callback_result = PyObject_CallFunctionObjArgs(
callback,
callback_dict,
NULL);
if (callback_result != NULL)
{
#if PY_MAJOR_VERSION >= 3
if (PyLong_Check(callback_result))
#else
if (PyLong_Check(callback_result) || PyInt_Check(callback_result))
#endif
{
result = (int) PyLong_AsLong(callback_result);
}
Py_DECREF(callback_result);
}
else
{
result = CALLBACK_ERROR;
}
Py_DECREF(callback_dict);
Py_DECREF(callback);
}
Py_DECREF(tag_list);
Py_DECREF(string_list);
Py_DECREF(meta_list);
PyGILState_Release(gil_state);
return result;
}
int handle_message(int message, YR_RULE* rule, void* data)
{
TAG* tag;
IDENTIFIER* identifier;
YR_STRING* string;
YR_MATCH* match;
YR_META* meta;
char* tag_name;
size_t tag_length;
int is_matching;
int string_found;
int show = TRUE;
if (show_specified_tags)
{
show = FALSE;
tag = specified_tags_list;
while (tag != NULL)
{
tag_name = rule->tags;
tag_length = tag_name != NULL ? strlen(tag_name) : 0;
while (tag_length > 0)
{
if (strcmp(tag_name, tag->identifier) == 0)
{
show = TRUE;
break;
}
tag_name += tag_length + 1;
tag_length = strlen(tag_name);
}
tag = tag->next;
}
}
if (show_specified_rules)
{
show = FALSE;
identifier = specified_rules_list;
while (identifier != NULL)
{
if (strcmp(identifier->name, rule->identifier) == 0)
{
show = TRUE;
break;
}
identifier = identifier->next;
}
}
is_matching = (message == CALLBACK_MSG_RULE_MATCHING);
show = show && ((!negate && is_matching) || (negate && !is_matching));
if (show)
{
mutex_lock(&output_mutex);
printf("%s ", rule->identifier);
if (show_tags)
{
printf("[");
tag_name = rule->tags;
tag_length = tag_name != NULL ? strlen(tag_name) : 0;
while (tag_length > 0)
{
printf("%s", tag_name);
tag_name += tag_length + 1;
tag_length = strlen(tag_name);
if (tag_length > 0)
printf(",");
}
printf("] ");
}
// Show meta-data.
if (show_meta)
{
meta = rule->metas;
printf("[");
while(!META_IS_NULL(meta))
{
if (meta->type == META_TYPE_INTEGER)
printf("%s=%d", meta->identifier, meta->integer);
else if (meta->type == META_TYPE_BOOLEAN)
printf("%s=%s", meta->identifier, meta->integer ? "true" : "false");
else
printf("%s=\"%s\"", meta->identifier, meta->string);
meta++;
if (!META_IS_NULL(meta))
printf(",");
}
printf("] ");
}
printf("%s\n", (char*) data);
// Show matched strings.
if (show_strings)
{
string = rule->strings;
while (!STRING_IS_NULL(string))
{
string_found = STRING_FOUND(string);
if (string_found)
{
match = STRING_MATCHES(string).head;
while (match != NULL)
{
printf("0x%" PRIx64 ":%s: ", match->first_offset, string->identifier);
if (STRING_IS_HEX(string))
{
print_hex_string(match->data, match->length);
}
else
{
print_string(match->data, match->length);
}
match = match->next;
}
}
string++;
}
}
mutex_unlock(&output_mutex);
}
if (is_matching)
count++;
if (limit != 0 && count >= limit)
return CALLBACK_ABORT;
return CALLBACK_CONTINUE;
}
int yr_parser_reduce_string_identifier(
yyscan_t yyscanner,
const char* identifier,
int8_t instruction)
{
YR_STRING* string;
YR_COMPILER* compiler = yyget_extra(yyscanner);
if (strcmp(identifier, "$") == 0)
{
if (compiler->loop_depth > 0)
{
yr_parser_emit_with_arg(
yyscanner,
PUSH_M,
LOOP_LOCAL_VARS * (compiler->loop_depth - 1),
NULL);
yr_parser_emit(yyscanner, instruction, NULL);
if (instruction != SFOUND)
{
string = compiler->current_rule_strings;
while(!STRING_IS_NULL(string))
{
string->g_flags &= ~STRING_GFLAGS_SINGLE_MATCH;
string = yr_arena_next_address(
compiler->strings_arena,
string,
sizeof(YR_STRING));
}
}
}
else
{
compiler->last_result = ERROR_MISPLACED_ANONYMOUS_STRING;
}
}
else
{
string = yr_parser_lookup_string(yyscanner, identifier);
if (string != NULL)
{
yr_parser_emit_with_arg_reloc(
yyscanner,
PUSH,
PTR_TO_UINT64(string),
NULL);
if (instruction != SFOUND)
string->g_flags &= ~STRING_GFLAGS_SINGLE_MATCH;
yr_parser_emit(yyscanner, instruction, NULL);
string->g_flags |= STRING_GFLAGS_REFERENCED;
}
}
return compiler->last_result;
}
void
parrot_init_library_paths(PARROT_INTERP)
{
ASSERT_ARGS(parrot_init_library_paths)
PMC *paths;
STRING *entry;
STRING *versionlib = NULL;
STRING *builddir = NULL;
PMC * const iglobals = interp->iglobals;
PMC * const config_hash = VTABLE_get_pmc_keyed_int(interp, iglobals,
(INTVAL)IGLOBALS_CONFIG_HASH);
/* create the lib_paths array */
PMC * const lib_paths = Parrot_pmc_new_init_int(interp,
enum_class_FixedPMCArray, PARROT_LIB_PATH_SIZE);
VTABLE_set_pmc_keyed_int(interp, iglobals,
IGLOBALS_LIB_PATHS, lib_paths);
if (VTABLE_elements(interp, config_hash)) {
STRING * const libkey = CONST_STRING(interp, "libdir");
STRING * const verkey = CONST_STRING(interp, "versiondir");
STRING * const builddirkey = CONST_STRING(interp, "build_dir");
STRING * const installed = CONST_STRING(interp, "installed");
versionlib = VTABLE_get_string_keyed_str(interp, config_hash, libkey);
entry = VTABLE_get_string_keyed_str(interp, config_hash, verkey);
versionlib = Parrot_str_concat(interp, versionlib, entry);
if (!VTABLE_get_integer_keyed_str(interp, config_hash, installed))
builddir = VTABLE_get_string_keyed_str(interp,
config_hash, builddirkey);
}
/* each is an array of strings */
/* define include paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_INCLUDE, paths);
{ /* EXPERIMENTAL: add include path from environment */
const char *envvar = Parrot_getenv(interp,
Parrot_str_new_constant(interp, "PARROT_INCLUDE"));
if (envvar != NULL && envvar[0]) {
entry = Parrot_str_new(interp, envvar, 0);
VTABLE_push_string(interp, paths, entry);
}
}
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/"));
VTABLE_push_string(interp, paths, entry);
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/include/"));
VTABLE_push_string(interp, paths, entry);
}
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/include/"));
VTABLE_push_string(interp, paths, entry);
}
/* define library paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_LIBRARY, paths);
{ /* EXPERIMENTAL: add library path from environment */
const char *envvar = Parrot_getenv(interp,
Parrot_str_new_constant(interp, "PARROT_LIBRARY"));
if (envvar != NULL && envvar[0]) {
entry = Parrot_str_new(interp, envvar, 0);
VTABLE_push_string(interp, paths, entry);
}
}
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/library/"));
VTABLE_push_string(interp, paths, entry);
}
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/library/"));
VTABLE_push_string(interp, paths, entry);
}
/* define languages paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_LANG, paths);
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/languages/"));
VTABLE_push_string(interp, paths, entry);
}
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/languages/"));
VTABLE_push_string(interp, paths, entry);
}
/* define dynext paths */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_DYNEXT, paths);
if (!STRING_IS_NULL(builddir)) {
entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/dynext/"));
VTABLE_push_string(interp, paths, entry);
}
entry = CONST_STRING(interp, "dynext/");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/dynext/"));
VTABLE_push_string(interp, paths, entry);
}
/* shared exts */
paths = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_DYN_EXTS, paths);
/* no CONST_STRING here - the c2str.pl preprocessor needs "real strs" */
entry = Parrot_str_new_constant(interp, PARROT_LOAD_EXT);
VTABLE_push_string(interp, paths, entry);
/* OS/X has .dylib and .bundle */
if (!STREQ(PARROT_LOAD_EXT, PARROT_SHARE_EXT)) {
entry = Parrot_str_new_constant(interp, PARROT_SHARE_EXT);
VTABLE_push_string(interp, paths, entry);
}
#ifdef PARROT_PLATFORM_LIB_PATH_INIT_HOOK
PARROT_PLATFORM_LIB_PATH_INIT_HOOK(interp, lib_paths);
#endif
}