Skip to content

Commit

Permalink
Make Rakudo_binding_bind_signature actually take a low level signatur…
Browse files Browse the repository at this point in the history
…e object rather than an already unpacked one - this will make it far neater to recurse into the binder later. Also, cache the nameds to positionals hash. Doesn't actually win much performance, though we're building probably several less PMCs per dispatch, so less memory overhead for sure. Also remove a leak.
  • Loading branch information
jnthn committed Oct 20, 2009
1 parent 0a9860f commit 7eed769
Show file tree
Hide file tree
Showing 6 changed files with 94 additions and 64 deletions.
6 changes: 2 additions & 4 deletions build/Makefile.in
Expand Up @@ -421,16 +421,14 @@ $(DYNEXT_TARGET): $(DYNPMC) $(DYNOPS)
# spaces and some compilers/linkers forbid a (forced) space.
# See RT #66558 and TT #700.

src/binder/bind$(O): src/binder/bind.c src/binder/bind.h
cd src/binder && $(CC) -c @cc_o_out@bind$(O) -I$(PMC_DIR) $(CINCLUDES) $(CFLAGS) bind.c

$(DYNPMC): $(PMC_SOURCES) src/binder/bind$(O)
$(DYNPMC): $(PMC_SOURCES) src/binder/bind.c src/binder/bind.h
$(PMC2C) --no-lines --dump $(PMC2C_INCLUDES) src/pmc/objectref.pmc
$(PMC2C) --no-lines --dump $(PMC2C_INCLUDES) $(PMC_SOURCES)
$(PMC2C) --no-lines --c $(PMC2C_INCLUDES) $(PMC_SOURCES)
$(PMC2C) --no-lines --library $(GROUP) --c $(PMC_SOURCES)
$(CC) -c @cc_o_out@$(GROUP)$(O) -I$(PMC_DIR) $(CINCLUDES) $(CFLAGS) $(GROUP).c
cd $(PMC_DIR) && $(CC) -c $(CINCLUDES) $(CFLAGS) *.c
cd src/binder && $(CC) -c @cc_o_out@bind$(O) -I$(PMC_DIR) $(CINCLUDES) $(CFLAGS) bind.c
$(LD) @ld_out@$(DYNPMC) $(GROUP)$(O) src/pmc/*$(O) src/binder/bind$(O) $(LINKARGS)

$(OPS_DIR)/$(OPS)$(LOAD_EXT): $(OPS_DIR)/$(OPS_SOURCE) src/binder/bind.h $(DYNPMC)
Expand Down
119 changes: 81 additions & 38 deletions src/binder/bind.c
Expand Up @@ -7,6 +7,11 @@ Copyright (C) 2009, The Perl Foundation.
#include "parrot/parrot.h"
#include "parrot/extend.h"
#include "bind.h"
#include "../pmc/pmc_p6lowlevelsig.h"


/* Cache of the type ID for low level signatures. */
static INTVAL lls_id = 0;


/* Unwraps things inside a scalar reference. */
Expand Down Expand Up @@ -269,14 +274,16 @@ Rakudo_binding_handle_optional(PARROT_INTERP, llsig_element *sig_info, PMC *lexp
* 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_signature(PARROT_INTERP, PMC *lexpad,
llsig_element **elements, INTVAL num_elements,
Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad, PMC *signature,
PMC *pos_args, PMC *named_args,
INTVAL no_nom_type_check, STRING **error) {
INTVAL i;
INTVAL bind_fail;
INTVAL cur_pos_arg = 0;
INTVAL num_pos_args = VTABLE_elements(interp, pos_args);
INTVAL i;
INTVAL bind_fail;
INTVAL cur_pos_arg = 0;
INTVAL num_pos_args = VTABLE_elements(interp, pos_args);
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;
Expand All @@ -287,32 +294,42 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
* taking one - tell us we have a problem. */
PMC *named_args_copy = PMCNULL;

/* Build nameds -> position hash for named positional arguments. */
/* XXX We only need do this on the first binding, not every one - add
* logic to cache this instead. For extra minor speed win, use Hash
* directly perhaps, to avoid a level of indirection through the PMC
* interface. */
PMC *named_to_pos_cache = pmc_new(interp, enum_class_Hash);
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 (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, NULL, 0);
if (Parrot_str_equal(interp, sigil, string_from_literal(interp, "$")) ||
Parrot_str_equal(interp, sigil, string_from_literal(interp, "@")) ||
Parrot_str_equal(interp, sigil, string_from_literal(interp, "%")))
store = Parrot_str_substr(interp, store, 1,
Parrot_str_byte_length(interp, store), NULL, 0);
VTABLE_set_integer_keyed_str(interp, named_to_pos_cache, store, i);
/* Check that we have a valid signature and pull the bits out of it. */
if (!lls_id)
lls_id = pmc_type(interp, string_from_literal(interp, "P6LowLevelSig"));
if (signature->vtable->base_type != lls_id)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Internal Error: Rakudo_binding_bind_signature passed invalid signature");
GETATTR_P6LowLevelSig_elements(interp, signature, elements);
GETATTR_P6LowLevelSig_num_elements(interp, signature, num_elements);
GETATTR_P6LowLevelSig_named_to_pos_cache(interp, signature, 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);
SETATTR_P6LowLevelSig_named_to_pos_cache(interp, signature, 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 (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, NULL, 0);
if (Parrot_str_equal(interp, sigil, string_from_literal(interp, "$")) ||
Parrot_str_equal(interp, sigil, string_from_literal(interp, "@")) ||
Parrot_str_equal(interp, sigil, string_from_literal(interp, "%")))
store = Parrot_str_substr(interp, store, 1,
Parrot_str_byte_length(interp, store), NULL, 0);
VTABLE_set_integer_keyed_str(interp, named_to_pos_cache, store, i);
}
}
}

Expand Down Expand Up @@ -347,8 +364,11 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
/* We have the value - try bind this parameter. */
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, elements[i],
pos_from_named[i], no_nom_type_check, error);
if (bind_fail)
if (bind_fail) {
if (pos_from_named)
mem_sys_free(pos_from_named);
return bind_fail;
}
}

/* Could it be a named slurpy? */
Expand All @@ -361,8 +381,11 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
named_args_copy;
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, elements[i],
slurpy, no_nom_type_check, error);
if (bind_fail)
if (bind_fail) {
if (pos_from_named)
mem_sys_free(pos_from_named);
return bind_fail;
}

/* Nullify named arguments hash now we've consumed it, to mark all
* is well. */
Expand All @@ -386,8 +409,11 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
Parrot_run_meth_fromc_args(interp, store_meth, slurpy, STORE, "vP", temp);
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, elements[i],
slurpy, no_nom_type_check, error);
if (bind_fail)
if (bind_fail) {
if (pos_from_named)
mem_sys_free(pos_from_named);
return bind_fail;
}
}

/* Otherwise, a positional. */
Expand All @@ -407,8 +433,11 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
PMC *arg = VTABLE_get_pmc_keyed_int(interp, pos_args, cur_pos_arg);
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, elements[i],
arg, no_nom_type_check, error);
if (bind_fail)
if (bind_fail) {
if (pos_from_named)
mem_sys_free(pos_from_named);
return bind_fail;
}
cur_pos_arg++;
}
else {
Expand All @@ -419,12 +448,17 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
PMC *value = Rakudo_binding_handle_optional(interp, elements[i], lexpad);
bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, elements[i],
value, 1, error);
if (bind_fail)
if (bind_fail) {
if (pos_from_named)
mem_sys_free(pos_from_named);
return bind_fail;
}
}
else {
if (error)
*error = Rakudo_binding_arity_fail(interp, elements, num_elements, num_pos_args, 0);
if (pos_from_named)
mem_sys_free(pos_from_named);
return BIND_RESULT_FAIL;
}
}
Expand Down Expand Up @@ -461,6 +495,8 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
if (error)
*error = Parrot_sprintf_c(interp, "Required named parameter '%S' not passed",
VTABLE_get_string_keyed_int(interp, elements[i]->named_names, 0));
if (pos_from_named)
mem_sys_free(pos_from_named);
return BIND_RESULT_FAIL;
}
}
Expand All @@ -470,11 +506,18 @@ Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
}

/* If we get here, we have a value. Bind it. */
if (bind_fail)
if (bind_fail) {
if (pos_from_named)
mem_sys_free(pos_from_named);
return bind_fail;
}
}
}

/* Free pos_from_named - we no longer need it. */
if (pos_from_named)
mem_sys_free(pos_from_named);

/* Do we have any left-over args? */
if (cur_pos_arg < num_pos_args) {
/* Oh noes, too many positionals passed. */
Expand Down
3 changes: 1 addition & 2 deletions src/binder/bind.h
Expand Up @@ -48,8 +48,7 @@ typedef struct llsig_element {

/* A function we want to share to provide the interface to the binder. */
INTVAL
Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad,
llsig_element **elements, INTVAL num_elements,
Rakudo_binding_bind_signature(PARROT_INTERP, PMC *lexpad, PMC *signature,
PMC *pos_args, PMC *named_args,
INTVAL no_nom_type_check, STRING **error);

Expand Down
18 changes: 3 additions & 15 deletions src/ops/perl6.ops
Expand Up @@ -20,8 +20,7 @@ static INTVAL or_id = 0;
static INTVAL lls_id = 0;

/* Plus a function pointer to the binder. */
static INTVAL (*bind_signature_func) (PARROT_INTERP, PMC *lexpad,
llsig_element **elements, INTVAL num_elements,
static INTVAL (*bind_signature_func) (PARROT_INTERP, PMC *lexpad, PMC *signature,
PMC *pos_args, PMC *named_args,
INTVAL no_nom_type_check, STRING **error) = NULL;

Expand Down Expand Up @@ -607,20 +606,9 @@ inline op bind_signature(in PMC, in PMC) :base_core {
PMC *signature = VTABLE_getprop(interp, sub, string_from_literal(interp, "$!signature"));
INTVAL noms_checked = PObj_flag_TEST(P6S_ALREADY_CHECKED, ctx);
STRING *error = NULL;
struct llsig_element **elements;
INTVAL num_elements, bind_error;

/* Ensure Signature is fine. */
if (signature->vtable->base_type != lls_id) {
opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
EXCEPTION_INVALID_OPERATION, "bind_signature could not find signature for sub");
goto ADDRESS(handler);
}

/* Extract bits from the signature and invoke the binder. */
GETATTR_P6LowLevelSig_elements(interp, signature, elements);
GETATTR_P6LowLevelSig_num_elements(interp, signature, num_elements);
bind_error = bind_signature_func(interp, lexpad, elements, num_elements, $1, $2, noms_checked, &error);
/* Call signature binder. */
INTVAL bind_error = bind_signature_func(interp, lexpad, signature, $1, $2, noms_checked, &error);
if (!bind_error) {
goto NEXT();
}
Expand Down
5 changes: 5 additions & 0 deletions src/pmc/p6lowlevelsig.pmc
Expand Up @@ -53,6 +53,7 @@ The number of items we have inside the signature.
pmclass P6LowLevelSig need_ext dynpmc group perl6_group {
ATTR struct llsig_element **elements;
ATTR INTVAL num_elements;
ATTR PMC *named_to_pos_cache;

/*

Expand Down Expand Up @@ -112,10 +113,14 @@ Marks anything we're referencing.
VTABLE void mark() {
llsig_element **elements;
INTVAL num_elements, i;
PMC *named_to_pos_cache;

/* Mark everything referenced form the elements structs. */
GETATTR_P6LowLevelSig_elements(interp, SELF, elements);
GETATTR_P6LowLevelSig_num_elements(interp, SELF, num_elements);
GETATTR_P6LowLevelSig_named_to_pos_cache(interp, SELF, named_to_pos_cache);
if (named_to_pos_cache)
Parrot_gc_mark_PMC_alive(interp, named_to_pos_cache);
for (i = 0; i < num_elements; i++) {
if (!elements[i])
continue;
Expand Down
7 changes: 2 additions & 5 deletions src/pmc/perl6multisub.pmc
Expand Up @@ -577,12 +577,9 @@ static PMC* do_dispatch(PARROT_INTERP, PMC *self, candidate_info **candidates, P
opcode_t *where = VTABLE_invoke(interp, possibles[i]->sub, next);
PMC *lexpad = Parrot_pcc_get_lex_pad(interp, CURRENT_CONTEXT(interp));
PMC *signature = possibles[i]->signature;
llsig_element **sig_elem_info;
INTVAL bind_check_result, sig_elems;
GETATTR_P6LowLevelSig_elements(interp, signature, sig_elem_info);
GETATTR_P6LowLevelSig_num_elements(interp, signature, sig_elems);
INTVAL bind_check_result;
bind_check_result = Rakudo_binding_bind_signature(interp, lexpad,
sig_elem_info, sig_elems, pos_args, named_args, 1, NULL);
signature, pos_args, named_args, 1, NULL);

/* XXX In the future, we can actually keep the context if we only
* need one candidate, and then hand back the current PC and mark
Expand Down

0 comments on commit 7eed769

Please sign in to comment.