tagged release 0.6.4

[parrot.git] / src / inter_call.c

/*
Copyright (C) 2001-2008, The Perl Foundation.
$Id$

=head1 NAME

src/inter_call.c - Parrot Interpreter - Argument passing code

=head1 DESCRIPTION

Functions in this file handle argument/return value passing to and from
subroutines.

=head2 Functions

=over 4

=cut

*/

#include "parrot/parrot.h"
#include "parrot/oplib/ops.h"
#include "inter_call.str"

/* HEADERIZER HFILE: include/parrot/inter_call.h */

/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */

static void check_for_opt_flag(ARGMOD(call_state *st), int has_arg)
        __attribute__nonnull__(1)
        FUNC_MODIFIES(*st);

static void check_named(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static void clone_key_arg(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static void commit_last_arg(PARROT_INTERP,
    int index,
    int cur,
    ARGMOD(opcode_t *n_regs_used),
    int seen_arrow,
    ARGIN(PMC * const *sigs),
    ARGMOD(opcode_t **indexes),
    ARGMOD(parrot_context_t *ctx),
    ARGIN_NULLOK(PMC *pmc),
    ARGIN(va_list *list))
        __attribute__nonnull__(1)
        __attribute__nonnull__(4)
        __attribute__nonnull__(6)
        __attribute__nonnull__(7)
        __attribute__nonnull__(8)
        __attribute__nonnull__(10)
        FUNC_MODIFIES(*n_regs_used)
        FUNC_MODIFIES(*indexes)
        FUNC_MODIFIES(*ctx);

static void convert_arg_from_int(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static void convert_arg_from_num(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static void convert_arg_from_pmc(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static void convert_arg_from_str(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static int fetch_arg_op(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static int fetch_arg_sig(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static void init_call_stats(ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        FUNC_MODIFIES(*st);

static void init_first_dest_named(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static int locate_named_named(PARROT_INTERP, ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static void next_arg_sig(ARGMOD(call_state_item *sti))
        __attribute__nonnull__(1)
        FUNC_MODIFIES(*sti);

static void null_val(int sig, ARGMOD(call_state *st))
        __attribute__nonnull__(2)
        FUNC_MODIFIES(*st);

static int set_retval_util(PARROT_INTERP,
    ARGIN(const char *sig),
    ARGIN(parrot_context_t *ctx),
    ARGMOD(call_state *st))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        __attribute__nonnull__(3)
        __attribute__nonnull__(4)
        FUNC_MODIFIES(*st);

static void start_flatten(PARROT_INTERP,
    ARGMOD(call_state *st),
    ARGIN(PMC *p_arg))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        __attribute__nonnull__(3)
        FUNC_MODIFIES(*st);

static void store_arg(ARGIN(const call_state *st), INTVAL idx)
        __attribute__nonnull__(1);

static void too_few(PARROT_INTERP,
    ARGIN(const call_state *st),
    ARGIN(const char *action))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        __attribute__nonnull__(3);

static void too_many(PARROT_INTERP,
    ARGIN(const call_state *st),
    ARGIN(const char *action))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        __attribute__nonnull__(3);

/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
/* HEADERIZER END: static */


/* Make sure we don't conflict with any other MAX() macros defined elsewhere */
#define PARROT_MAX(a, b) (((a)) > (b) ? (a) : (b))

#define SAVE_OFF_REGS(orig, next, save) \
        (save).bp = (orig).bp;\
        (save).bp_ps = (orig).bp_ps;\
        (orig).bp = (next).bp;\
        (orig).bp_ps = (next).bp_ps;

#define RESTORE_REGS(orig, save) \
        (orig).bp = (save).bp;\
        (orig).bp_ps = (save).bp_ps;


/*

=item C<void Parrot_init_arg_nci>

Initializes the argument passing state C<call_state> for the given NCI
signature.

=cut

*/

PARROT_API
void
Parrot_init_arg_nci(PARROT_INTERP, ARGOUT(call_state *st),
    ARGIN(const char *sig))
{
    init_call_stats(st);

    if (PMC_IS_NULL(interp->args_signature))
        Parrot_init_arg_op(interp, CONTEXT(interp), interp->current_args,
                           &st->src);
    else
        Parrot_init_arg_indexes_and_sig_pmc(interp, CONTEXT(interp),
            interp->current_args, interp->args_signature, &st->src);

    Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL, &st->dest);
}


/*

=item C<void Parrot_init_ret_nci>

Initializes the return value, passing state C<call_state> for the given NCI
signature.

=cut

*/

PARROT_API
void
Parrot_init_ret_nci(PARROT_INTERP, ARGOUT(call_state *st), ARGIN(const char *sig))
{
    Parrot_Context *ctx                 = CONTEXT(interp);
    PMC            * const current_cont = ctx->current_cont;

    /* if this NCI call was a taicall, return results to caller's get_results
     * this also means that we pass the caller's register base pointer */
    if (SUB_FLAG_TAILCALL_ISSET(current_cont))
        ctx = PMC_cont(current_cont)->to_ctx;

    /* TODO simplify all */
    Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL, &st->src);
    Parrot_init_arg_op(interp, ctx, ctx->current_results, &st->dest);
}


/*

=item C<int Parrot_init_arg_indexes_and_sig_pmc>

Initializes argument transfer with given context registers, register indexes,
and a signature PMC.

All C<Parrot_init_arg*> functions can be used for either source or destination,
by passing either C<&st.src> or C<&st.dest> of a C<call_state> structure.

These functions return 0 if no arguments are present, or 1 on success.

=cut

*/

PARROT_API
int
Parrot_init_arg_indexes_and_sig_pmc(SHIM_INTERP, ARGIN(parrot_context_t *ctx),
        ARGIN_NULLOK(opcode_t *indexes), ARGIN_NULLOK(PMC* sig_pmc),
        ARGMOD(call_state_item *sti))
{
    if (!sig_pmc && indexes) {
        ++indexes;
        sig_pmc = ctx->constants[*indexes]->u.key;
        ASSERT_SIG_PMC(sig_pmc);
        ++indexes;
    }

    sti->used  = 1;
    sti->i     = 0;
    sti->n     = 0;
    sti->mode  = CALL_STATE_OP;
    sti->ctx   = ctx;
    sti->sig   = 0;
    sti->slurp = NULL;

    if (indexes) {
        ASSERT_SIG_PMC(sig_pmc);
        sti->u.op.signature = sig_pmc;
        sti->u.op.pc        = indexes;
        sti->n              = SIG_ELEMS(sig_pmc);

        /* initialize sti->sig */
        if (sti->n)
            next_arg_sig(sti);
    }

    return sti->n > 0;
}


/*

=item C<int Parrot_init_arg_op>

Initializes argument transfer with given context registers and opcode location
of a C<get_*> or C<set_*> argument opcode.

=cut

*/

PARROT_API
int
Parrot_init_arg_op(PARROT_INTERP, ARGIN(parrot_context_t *ctx),
    ARGIN_NULLOK(opcode_t *pc), ARGIN(call_state_item *sti))
{
    PMC *sig_pmc = PMCNULL;

    if (pc) {
        ++pc;
        sig_pmc = ctx->constants[*pc]->u.key;
        ASSERT_SIG_PMC(sig_pmc);
        ++pc;
    }

    return Parrot_init_arg_indexes_and_sig_pmc(interp, ctx, pc, sig_pmc, sti);
}


/*

=item C<int Parrot_init_arg_sig>

Initializes argument transfer with given code segment (holding the
const_table), registers, function signature, and arguments.

=cut

*/

PARROT_API
int
Parrot_init_arg_sig(SHIM_INTERP, ARGIN(parrot_context_t *ctx),
    ARGIN(const char *sig), ARGIN_NULLOK(void *ap),
    ARGMOD(call_state_item *sti))
{
    sti->used = 1;
    sti->i    = 0;
    sti->n    = 0;
    sti->mode = CALL_STATE_SIG;
    sti->ctx  = ctx;
    sti->sig  = 0;

    if (*sig) {
        sti->u.sig.sig = sig;
        sti->u.sig.ap  = ap;
        sti->n         = strlen(sig);

        /* initialize st->sig */
        if (sti->n)
            next_arg_sig(sti);
    }

    return sti->n > 0;
}


/*

=item C<static void start_flatten>

Marks the source state as flattening with the passed PMC being flattened and
fetches the first arg from the flattened set.

=cut

*/

static void
start_flatten(PARROT_INTERP, ARGMOD(call_state *st), ARGIN(PMC *p_arg))
{
    if (PARROT_ARG_NAME_ISSET(st->src.sig)) {
        /* src ought to be an hash */
        if (!VTABLE_does(interp, p_arg, CONST_STRING(interp, "hash")))
            real_exception(interp, NULL, E_ValueError, "argument doesn't hash");

        /* create key needed to iterate the hash */
        st->key              = pmc_new(interp, enum_class_Key);
        PMC_int_val(st->key) = 0;
        PMC_data(st->key)    = (void *)INITBucketIndex;

        dod_register_pmc(interp, st->key);
    }
    else {
        /* src ought to be an array */
        if (!VTABLE_does(interp, p_arg, CONST_STRING(interp, "array")))
            real_exception(interp, NULL, E_ValueError, "argument doesn't array");
    }

    st->src.mode   |= CALL_STATE_FLATTEN;
    st->src.slurp   = p_arg;
    st->src.slurp_i = 0;
    st->src.slurp_n = VTABLE_elements(interp, p_arg);

    /* the -1 is because the :flat PMC itself doesn't count. */
    st->n_actual_args += st->src.slurp_n - 1;
}


/*

=item C<static void next_arg_sig>

Moves the call state to the next argument in the signature, calculating which
type of argument/parameter to get next.  The index gets increased elsewhere.

=cut

*/

static void
next_arg_sig(ARGMOD(call_state_item *sti))
{
    switch (sti->mode & CALL_S_D_MASK) {
        case CALL_STATE_OP:
            sti->sig = SIG_ITEM(sti->u.op.signature, sti->i);
            break;
        case CALL_STATE_SIG:
            switch (sti->u.sig.sig[sti->i]) {
                case 'I':
                    sti->sig = PARROT_ARG_INTVAL; break;
                case 'N':
                    sti->sig = PARROT_ARG_FLOATVAL; break;
                case 'S':
                    sti->sig = PARROT_ARG_STRING; break;
                case 'O':
                case 'P':
                    sti->sig = PARROT_ARG_PMC; break;
                case '@':
                    sti->sig = PARROT_ARG_PMC | PARROT_ARG_SLURPY_ARRAY; break;
                case 'F':
                    sti->sig = PARROT_ARG_PMC | PARROT_ARG_FLATTEN; break;
                default:
                    break;
            }
            break;
        default:
            break;
    }
}


/*

=item C<static int fetch_arg_sig>

Fetches the next argument from the signature in the given call state.

=cut

*/

/* Fetch an argument from C code */
static int
fetch_arg_sig(PARROT_INTERP, ARGMOD(call_state *st))
{
    va_list * const ap = (va_list *)(st->src.u.sig.ap);

    switch (st->src.sig & PARROT_ARG_TYPE_MASK) {
        case PARROT_ARG_INTVAL:
            UVal_int(st->val) = va_arg(*ap, INTVAL);
            break;
        case PARROT_ARG_STRING:
            UVal_str(st->val) = va_arg(*ap, STRING *);
            break;
        case PARROT_ARG_FLOATVAL:
            UVal_num(st->val) = va_arg(*ap, FLOATVAL);
            break;
        case PARROT_ARG_PMC:
            if (st->src.u.sig.sig[st->src.i] == 'O')
                UVal_pmc(st->val) = CONTEXT(interp)->current_object;
            else {
                UVal_pmc(st->val) = va_arg(*ap, PMC *);
                dod_register_pmc(interp, UVal_pmc(st->val));
            }

            if (st->src.sig & PARROT_ARG_FLATTEN) {
                int retval;
                start_flatten(interp, st, UVal_pmc(st->val));

                /* if the :flat arg is empty, just go to the next arg */
                if (!st->src.slurp_n) {
                    st->src.mode &= ~CALL_STATE_FLATTEN;
                    st->src.i++;
                }

                st->src.used = 1;
                retval       = Parrot_fetch_arg(interp, st);

                if (!PMC_IS_NULL(st->key))
                    dod_unregister_pmc(interp, st->key);

                return retval;
            }
            break;
        default:
            break;
    }

    st->src.i++;
    return 1;
}


/*

=item C<static int fetch_arg_op>

Fetches an argument from the appropriate context.

=cut

*/

static int
fetch_arg_op(PARROT_INTERP, ARGMOD(call_state *st))
{
    const int    constant = PARROT_ARG_CONSTANT_ISSET(st->src.sig);
    const INTVAL idx      = st->src.u.op.pc[st->src.i];

    switch (PARROT_ARG_TYPE_MASK_MASK(st->src.sig)) {
        case PARROT_ARG_INTVAL:
            UVal_int(st->val) = constant ? idx : CTX_REG_INT(st->src.ctx, idx);
            break;
        case PARROT_ARG_STRING:
            UVal_str(st->val) = constant ? st->src.ctx->constants[idx]->u.string
                                         : CTX_REG_STR(st->src.ctx, idx);
            break;
        case PARROT_ARG_FLOATVAL:
            UVal_num(st->val) = constant ? st->src.ctx->constants[idx]->u.number
                                         : CTX_REG_NUM(st->src.ctx, idx);
            break;
        case PARROT_ARG_PMC:
            UVal_pmc(st->val) = constant ? st->src.ctx->constants[idx]->u.key
                                         : CTX_REG_PMC(st->src.ctx, idx);

            if (st->src.sig & PARROT_ARG_FLATTEN) {
                int retval;
                start_flatten(interp, st, UVal_pmc(st->val));

                /* if the :flat arg is empty, just go to the next arg */
                if (!st->src.slurp_n) {
                    st->src.mode &= ~CALL_STATE_FLATTEN;
                    st->src.i++;
                }

                st->src.used = 1;
                retval       = Parrot_fetch_arg(interp, st);

                if (!PMC_IS_NULL(st->key))
                    dod_unregister_pmc(interp, st->key);

                return retval;
            }
            break;
        default:
            break;
    }

    st->src.i++;
    return 1;
}


/*

=item C<int Parrot_fetch_arg>

RT#48260: Not yet documented!!!

=cut

*/

/* Fetch a new argument.
 */
PARROT_API
int
Parrot_fetch_arg(PARROT_INTERP, ARGMOD(call_state *st))
{
    if (!st->src.used)
        return 1;

    if (st->src.i >= st->src.n)
        return 0;

    st->src.used = 0;

    next_arg_sig(&st->src);

    /* check if we're supposed to continue a :flat argument */
    if (st->src.mode & CALL_STATE_FLATTEN) {
        PARROT_ASSERT(st->src.slurp_i < st->src.slurp_n);
        if (!PMC_IS_NULL(st->key)) {
            st->src.slurp_i++;
            st->name = (STRING *)parrot_hash_get_idx(interp,
                            (Hash *)PMC_struct_val(st->src.slurp), st->key);
            PARROT_ASSERT(st->name);
            UVal_pmc(st->val) = VTABLE_get_pmc_keyed_str(interp,
                st->src.slurp, st->name);
        }
        else {
            UVal_pmc(st->val) = VTABLE_get_pmc_keyed_int(interp,
                st->src.slurp, st->src.slurp_i++);
        }

        st->src.sig       = PARROT_ARG_PMC;

        /* done with flattening */
        if (st->src.slurp_i == st->src.slurp_n) {
            st->src.mode &= ~CALL_STATE_FLATTEN;

            if (!PMC_IS_NULL(st->key))
                dod_unregister_pmc(interp, st->key);

            st->key = PMCNULL;
            st->src.i++;
        }

        return 1;
    }

    /* If we're at a named arg, store the name and then get the next arg, which
     * is the actual value of the named arg. */
    if ((st->src.sig & PARROT_ARG_NAME)
    && !(st->src.sig & PARROT_ARG_FLATTEN)) {
        fetch_arg_op(interp, st);
        st->name = UVal_str(st->val);
        next_arg_sig(&st->src);
    }

    switch (st->src.mode & CALL_S_D_MASK) {
        case CALL_STATE_OP:
            return fetch_arg_op(interp, st);
        case CALL_STATE_SIG:
            return fetch_arg_sig(interp, st);
        default:
            real_exception(interp, NULL, 1, "invalid call state mode");
    }
}


/*

=item C<int Parrot_fetch_arg_nci>

RT#48260: Not yet documented!!!

=cut

*/

PARROT_API
int
Parrot_fetch_arg_nci(PARROT_INTERP, ARGMOD(call_state *st))
{
    next_arg_sig(&st->dest);

    if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY) {
        PMC *slurped = pmc_new(interp, enum_class_ResizablePMCArray);

        PARROT_ASSERT((st->dest.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC);

        while (Parrot_fetch_arg(interp, st)) {
            st->src.used = 1;
            Parrot_convert_arg(interp, st);
            VTABLE_push_pmc(interp, slurped, UVal_pmc(st->val));
        }

        UVal_pmc(st->val) = slurped;
        dod_register_pmc(interp, slurped);
    }
    else {
        Parrot_fetch_arg(interp, st);
        st->src.used = 1;
        Parrot_convert_arg(interp, st);
    }

    st->dest.i++;
    return 1;
}


/*

=item C<static void convert_arg_from_int>

Autoboxes an int into the expected container type.

=cut

*/

static void
convert_arg_from_int(PARROT_INTERP, ARGMOD(call_state *st))
{
    switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
        case PARROT_ARG_FLOATVAL:
            UVal_num(st->val) = (FLOATVAL)UVal_int(st->val);
            break;
        case PARROT_ARG_STRING:
            UVal_str(st->val) = string_from_int(interp, UVal_int(st->val));
            break;
        case PARROT_ARG_PMC:
            {
            PMC * const d = pmc_new(interp,
                Parrot_get_ctx_HLL_type(interp, enum_class_Integer));

            VTABLE_set_integer_native(interp, d, UVal_int(st->val));
            UVal_pmc(st->val) = d;
            dod_register_pmc(interp, d);
            }
            break;
        default:
            break;
    }
}


/*

=item C<static void convert_arg_from_num>

Autoboxes a num into the expected container type.

=cut

*/

static void
convert_arg_from_num(PARROT_INTERP, ARGMOD(call_state *st))
{
    switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
        case PARROT_ARG_INTVAL:
            UVal_int(st->val) = (INTVAL)UVal_num(st->val);
            break;
        case PARROT_ARG_STRING:
            UVal_str(st->val) = string_from_num(interp, UVal_num(st->val));
            break;
        case PARROT_ARG_PMC:
            {
            PMC * const d = pmc_new(interp,
                Parrot_get_ctx_HLL_type(interp, enum_class_Float));

            VTABLE_set_number_native(interp, d, UVal_num(st->val));
            UVal_pmc(st->val) = d;
            dod_register_pmc(interp, d);
            }
            break;
        default:
            break;
    }
}


/*

=item C<static void convert_arg_from_str>

Autoboxes a string primitive to the expected container type.

=cut

*/

static void
convert_arg_from_str(PARROT_INTERP, ARGMOD(call_state *st))
{
    switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
        case PARROT_ARG_INTVAL:
            UVal_int(st->val) = string_to_int(interp, UVal_str(st->val));
            break;
        case PARROT_ARG_FLOATVAL:
            UVal_num(st->val) = string_to_num(interp, UVal_str(st->val));
            break;
        case PARROT_ARG_PMC:
            {
            PMC * const d = pmc_new(interp,
                Parrot_get_ctx_HLL_type(interp, enum_class_String));

            VTABLE_set_string_native(interp, d, UVal_str(st->val));
            UVal_pmc(st->val) = d;
            dod_register_pmc(interp, d);
            }
            break;
        default:
            break;
    }
}

/*

=item C<static void convert_arg_from_pmc>

Unboxes a PMC to the expected primitive type.

=cut

*/

static void
convert_arg_from_pmc(PARROT_INTERP, ARGMOD(call_state *st))
{
    switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
        case PARROT_ARG_INTVAL:
            UVal_int(st->val) = VTABLE_get_integer(interp, UVal_pmc(st->val));
            break;
        case PARROT_ARG_FLOATVAL:
            UVal_num(st->val) = VTABLE_get_number(interp, UVal_pmc(st->val));
            break;
        case PARROT_ARG_STRING:
            UVal_str(st->val) = VTABLE_get_string(interp, UVal_pmc(st->val));
            break;
        default:
            break;
    }
}


/*

=item C<static void check_for_opt_flag>

Processes the next argument, if it has the optional flag set.  Otherwise moves
on.

=cut

*/

static void
check_for_opt_flag(ARGMOD(call_state *st), int has_arg)
{
    INTVAL idx;
    call_state_item * const dest = &st->dest;

    ++st->optionals;

    /* look at the next arg */
    dest->i++;
    if (dest->i >= dest->n)
        return;

    next_arg_sig(dest);

    /* if this isn't an :opt_flag argument, we need to reset things
     * and go to the next argument */
    if (!(st->dest.sig & PARROT_ARG_OPT_FLAG)) {
        dest->i--;
        return;
    }

    /* we're at an :opt_flag argument, so actually store something */
    idx = st->dest.u.op.pc[st->dest.i];

    --st->params;
    PARROT_ASSERT(idx >= 0);
    CTX_REG_INT(st->dest.ctx, idx) = has_arg;
}


/*

=item C<static void clone_key_arg>

Replaces any src registers by their values (done inside clone).  This needs a
test for tailcalls too, but I think there is no syntax to pass a key to a
tailcalled function or method.

=cut

*/

static void
clone_key_arg(PARROT_INTERP, ARGMOD(call_state *st))
{
    PMC *key = UVal_pmc(st->val);

    if (!key)
        return;

    if (key->vtable->base_type != enum_class_Key)
        return;

    for (; key; key=key_next(interp, key)) {
        /* register keys have to be cloned */
        if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
            parrot_context_t temp_ctx;

            /* clone sets key values according to refered register items */
            SAVE_OFF_REGS(interp->ctx, (*(st->src.ctx)), temp_ctx)
            UVal_pmc(st->val) = VTABLE_clone(interp, key);
            RESTORE_REGS(interp->ctx, temp_ctx)
            return;
        }
    }
}


/*

=item C<static void init_first_dest_named>

Initializes dest calling state for the first named arg.

=cut

*/

static void
init_first_dest_named(PARROT_INTERP, ARGMOD(call_state *st))
{
    int i, n_named;

    if (st->dest.mode & CALL_STATE_SIG)
        real_exception(interp, NULL, E_ValueError,
            "Can't call C function with named arguments");

    st->first_named = st->dest.i;
    n_named         = 0;

    /* 1) if we were slurpying positional args, we are done, turn it off
     * 2) set destination named args bit */
    st->dest.slurp = NULL;

    /* 1) count named args, make sure there is less than 32/64
     * 2) create slurpy hash if needed */
    for (i = st->dest.i; i < st->dest.n; ++i) {
        const INTVAL sig = SIG_ITEM(st->dest.u.op.signature, i);

        /* skip the arg name, only count the actual args of the named args */
        if (!(sig & PARROT_ARG_NAME))
            continue;

        /* slurpy named args, create slurpy hash */
        else if (sig & PARROT_ARG_SLURPY_ARRAY) {
            int idx;

            /* Create PMC for slurpy mode and register it; we must do this
             * otherwise it may get collected. */
            st->dest.slurp = pmc_new(interp,
                Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
            dod_register_pmc(interp, st->dest.slurp);

            /* pass the slurpy hash */
            idx = st->dest.u.op.pc[i];
            CTX_REG_PMC(st->dest.ctx, idx) = st->dest.slurp;
        }
        /* must be the actual arg of a named arg, count it */
        else
            n_named++;
    }

    /* only 32/64 named args allowed;
     * uses UINTVAL as a bitfield to detect duplicates */
    if (n_named >= (int)(sizeof (UINTVAL) * 8))
        real_exception(interp, NULL, E_ValueError, "Too many named arguments");

    st->named_done = 0;
}


/*

=item C<static int locate_named_named>

Locates a destination argument name, returning 0 if not found.

=cut

*/

static int
locate_named_named(PARROT_INTERP, ARGMOD(call_state *st))
{
    int i;
    int n_named = -1;

    for (i = st->first_named; i < st->dest.n; ++i) {
        int idx;
        STRING *param;

        st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
        if (!(st->dest.sig & PARROT_ARG_NAME))
            continue;

        if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY)
            return 1;

        n_named++;
        idx   = st->dest.u.op.pc[i];
        param = PARROT_ARG_CONSTANT_ISSET(st->dest.sig)
                ? st->dest.ctx->constants[idx]->u.string
                : CTX_REG_STR(st->dest.ctx, idx);

        if (st->name == param || string_equal(interp, st->name, param) == 0) {
            ++i;
            st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
            st->dest.i   = i;

            /* if bit is set we have a duplicate */
            if (st->named_done & (1 << n_named))
                real_exception(interp, NULL, E_ValueError,
                        "duplicate named argument - '%Ss' not expected", param);

            st->named_done |= 1 << n_named;
            return 1;
        }
    }

    return 0;
}


/*

=item C<static void store_arg>

Stores the next argument in the destination register appropriately.

=cut

*/

static void
store_arg(ARGIN(const call_state *st), INTVAL idx)
{
    switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
        case PARROT_ARG_INTVAL:
            CTX_REG_INT(st->dest.ctx, idx) = UVal_int(st->val);
            break;
        case PARROT_ARG_FLOATVAL:
            CTX_REG_NUM(st->dest.ctx, idx) = UVal_num(st->val);
            break;
        case PARROT_ARG_STRING:
            CTX_REG_STR(st->dest.ctx, idx) = UVal_str(st->val);
            break;
        case PARROT_ARG_PMC:
            CTX_REG_PMC(st->dest.ctx, idx) = UVal_pmc(st->val);
            break;
        default:
            break;
    }
}


/*

=item C<int Parrot_store_arg>

RT#48260: Not yet documented!!!

=cut

*/

int
Parrot_store_arg(SHIM_INTERP, ARGIN(const call_state *st))
{
    INTVAL idx;
    if (st->dest.i >= st->dest.n)
        return 0;

    PARROT_ASSERT(st->dest.mode & CALL_STATE_OP);
    idx = st->dest.u.op.pc[st->dest.i];
    PARROT_ASSERT(idx >= 0);
    store_arg(st, idx);

    return 1;
}


/*

=item C<static void too_few>

Throws an exception if there are too few arguments passed.

=cut

*/

static void
too_few(PARROT_INTERP, ARGIN(const call_state *st), ARGIN(const char *action))
{
    const int max_expected_args = st->params;
    const int min_expected_args = max_expected_args - st->optionals;

    if (st->n_actual_args < min_expected_args) {
        real_exception(interp, NULL, E_ValueError,
                "too few arguments passed (%d) - %s%d %s expected",
                st->n_actual_args,
                (min_expected_args < max_expected_args ? "at least " : ""),
                min_expected_args, action);
    }
}


/*

=item C<static void too_many>

Throws an exception if there are too many arguments passed.

=cut

*/

static void
too_many(PARROT_INTERP, ARGIN(const call_state *st), ARGIN(const char *action))
{
    const int max_expected_args = st->params;
    const int min_expected_args = max_expected_args - st->optionals;

    if (st->n_actual_args > max_expected_args) {
        real_exception(interp, NULL, E_ValueError,
                "too many arguments passed (%d) - %s%d %s expected",
                st->n_actual_args,
                (min_expected_args < max_expected_args ? "at most " : ""),
                max_expected_args, action);
    }
}


/*

=item C<static void null_val>

Adds a null value to the appropriate register.

=cut

*/

static void
null_val(int sig, ARGMOD(call_state *st))
{
    switch (sig & PARROT_ARG_TYPE_MASK) {
        case PARROT_ARG_INTVAL:   UVal_int(st->val) = 0;       break;
        case PARROT_ARG_FLOATVAL: UVal_num(st->val) = 0.0;     break;
        case PARROT_ARG_STRING:   UVal_str(st->val) = NULL;    break;
        case PARROT_ARG_PMC:      UVal_pmc(st->val) = PMCNULL; break;
        default:
            break;
    }
}


/*

=item C<static void check_named>

Makes sure that all required named args are set and that all optional
args and flags are set to null and false if not present.

A named arg takes the form of

    STRING* name, [INPS] actual_arg,

or

    STRING* name, [INPS] actual_arg, int opt_arg_flag

=cut

*/

static void
check_named(PARROT_INTERP, ARGMOD(call_state *st))
{
    int i;
    int n_named = -1;

    for (i = st->first_named; i < st->dest.n; ++i) {
        /* verify that a name exists */
        const INTVAL sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
        if (sig & PARROT_ARG_NAME) {
            INTVAL arg_sig;
            int last_name_pos;

            /* if slurpy then no errors, return */
            if (sig & PARROT_ARG_SLURPY_ARRAY)
                return;

            n_named++;
            last_name_pos = i;

            /* move on to the actual arg */
            i++;

            /* verify that an actual arg exists */
            arg_sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
            PARROT_ASSERT(!(arg_sig & PARROT_ARG_NAME));

            /* if this named arg is already filled, continue */
            if (st->named_done & (1 << n_named)) {
                arg_sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i+1);

                /* skip associated opt flag arg as well */
                if (arg_sig & PARROT_ARG_OPT_FLAG)
                    i++;

                continue;
            }
            else if (arg_sig & PARROT_ARG_OPTIONAL) {
                INTVAL idx;
                null_val(arg_sig, st);
                idx = st->dest.u.op.pc[i];
                store_arg(st, idx);

                /* Don't walk off the end of the array */
                if (i+1 >= st->dest.n)
                    continue;
                arg_sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i+1);
                if (arg_sig & PARROT_ARG_OPT_FLAG) {
                    i++;
                    idx = st->dest.u.op.pc[i];
                    CTX_REG_INT(st->dest.ctx, idx) = 0;
                }
                continue;
            }
            else {
                const   INTVAL idx   = st->dest.u.op.pc[last_name_pos];
                STRING * const param = PARROT_ARG_CONSTANT_ISSET(sig)
                    ? st->dest.ctx->constants[idx]->u.string
                    : CTX_REG_STR(st->dest.ctx, idx);

                real_exception(interp, NULL, E_ValueError,
                        "too few arguments passed"
                        " - missing required named arg '%Ss'", param);
            }
        }
        else
            real_exception(interp, NULL, E_ValueError,
                    "invalid arg type in named portion of args");
    }
}


/*

=item C<static void init_call_stats>

Sets the default values of the passed C<call_state>.

=cut

*/

static void
init_call_stats(ARGMOD(call_state *st))
{
    /* initial guess, adjusted for :flat args */
    st->n_actual_args = st->src.n;

    st->optionals     = 0;
    st->params        = st->dest.n;
    st->name          = NULL;
    st->key           = PMCNULL;
    st->first_named   = -1;
}


/*

=item C<void Parrot_process_args>

RT#48260: Not yet documented!!!

=cut

*/

PARROT_API
void
Parrot_process_args(PARROT_INTERP, ARGMOD(call_state *st), arg_pass_t param_or_result)
{
    int n_named;
    int err_check = 1;
    call_state_item *src, *dest;

    const char * const action = (param_or_result == PARROT_PASS_RESULTS)
        ? "results" : "params";

    /* Check if we should be throwing errors. This can be configured separately
     * for parameters and return values. */
    if (param_or_result == PARROT_PASS_RESULTS) {
        if (!PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
            err_check = 0;
    }
    else if (!PARROT_ERRORS_test(interp, PARROT_ERRORS_PARAM_COUNT_FLAG))
            err_check = 0;

    init_call_stats(st);

    src  = &st->src;
    dest = &st->dest;

    /* 1st: Positional non-:slurpy */
    for (; dest->i < dest->n; dest->i++) {
        INTVAL idx;
        int has_arg;

        /* check if the next dest arg is :slurpy */
        next_arg_sig(dest);
        if (dest->sig & PARROT_ARG_SLURPY_ARRAY)
            break;

        /* Check if there is another argument. We need to store the value to
         * handle :opt_flag, which needs to know if there was a preceding
         * argument. */
        has_arg = Parrot_fetch_arg(interp, st);

        /* if the src arg is named, we're done here */
        if (st->name) {
            /* but first, take care of any :optional arguments */
            while (dest->sig & PARROT_ARG_OPTIONAL) {
                null_val(st->dest.sig, st);

                /* actually store the argument */
                idx = st->dest.u.op.pc[st->dest.i];
                PARROT_ASSERT(idx >= 0);
                store_arg(st, idx);

                check_for_opt_flag(st, 0);

                /* next dest arg */
                dest->i++;
                next_arg_sig(dest);
            }
            break;
        }

        /* if the dest is a named argument, we need to fill it as a positional
         * since no named arguments have been given. so skip the name. */
        if (dest->sig & PARROT_ARG_NAME) {
            if (!has_arg)
                break;
            dest->i++;
            next_arg_sig(dest);
        }

        /* if there *is* an arg, convert it */
        if (has_arg) {
            src->used = 1;
            Parrot_convert_arg(interp, st);
        }

        /* if this is an optional argument, null it */
        else if (dest->sig & PARROT_ARG_OPTIONAL)
            null_val(st->dest.sig, st);

        /* there's no argument - throw an exception (if we're in to that) */
        else if (err_check)
            too_few(interp, st, action);

        /* otherwise, we're done */
        else
            return;

        /* actually store the argument */
        idx = st->dest.u.op.pc[st->dest.i];
        PARROT_ASSERT(idx >= 0);
        store_arg(st, idx);

        /* if we're at an :optional argument, check for an :opt_flag */
        if (dest->sig & PARROT_ARG_OPTIONAL)
            check_for_opt_flag(st, has_arg);
    }

    /* 2nd: Positional :slurpy */
    if (dest->sig & PARROT_ARG_SLURPY_ARRAY && !(dest->sig & PARROT_ARG_NAME)) {
        PMC * const  array = pmc_new(interp, enum_class_ResizablePMCArray);
        const INTVAL idx   = st->dest.u.op.pc[dest->i];

        PARROT_ASSERT(idx >= 0);

        /* Must register this PMC or it may get collected when only the struct
         * references it. */
        dod_register_pmc(interp, array);
        CTX_REG_PMC(st->dest.ctx, idx) = array;

        while (Parrot_fetch_arg(interp, st)) {
            /* if the src arg is named, we're done here */
            if (st->name)
                break;

            src->used = 1;

            /* we have to convert to a PMC to we can put it in the PMC array */
            dest->sig |= PARROT_ARG_PMC;
            Parrot_convert_arg(interp, st);

            VTABLE_push_pmc(interp, array, UVal_pmc(st->val));
        }

        dest->i++;
        dod_unregister_pmc(interp, array);
    }

    /* is there another argument? if we're throwing errors, that's an error */
    if (err_check && Parrot_fetch_arg(interp, st)
    && !st->name  && !(dest->sig & PARROT_ARG_NAME))
        too_many(interp, st, action);

    /* are we at the end? */
    if (dest->i == dest->n)
        return;

    /* 3rd: :named */
    init_first_dest_named(interp, st);
    n_named = 0;

    while (Parrot_fetch_arg(interp, st)) {
        src->used = 1;

        if (!st->name)
            real_exception(interp, NULL, 0,
                           "positional inside named args at position %i",
                           st->src.i - n_named);

        if (!locate_named_named(interp, st))
            real_exception(interp, NULL, E_ValueError,
                           "too many named arguments"
                           " - '%Ss' not expected", st->name);

        n_named++;

        /* if the dest arg is :named :slurpy */
        if (dest->sig & PARROT_ARG_SLURPY_ARRAY) {
            /* Convert to a PMC to store in the hash */
            dest->sig |= PARROT_ARG_PMC;
            Parrot_convert_arg(interp, st);
            VTABLE_set_pmc_keyed_str(interp, dest->slurp, st->name, UVal_pmc(st->val));
        }
        else {
            Parrot_convert_arg(interp, st);
            Parrot_store_arg(interp, st);

            /* if we're at an :optional argument, check for an :opt_flag */
            if (dest->sig & PARROT_ARG_OPTIONAL)
                check_for_opt_flag(st, 1);
        }

        /* otherwise this doesn't get reset and we can't catch positional args
         * inside of named args */
        st->name = NULL;
    }

    check_named(interp, st);

    /* we may or may not have registered this pmc */
    if (dest->slurp)
        dod_unregister_pmc(interp, dest->slurp);
}


/*

=item C<void Parrot_convert_arg>

Converts a source argument to the expected destination type.

=cut

*/

PARROT_API
void
Parrot_convert_arg(PARROT_INTERP, ARGMOD(call_state *st))
{
    /* register key args have to be cloned */
    if ((st->src.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC)
        clone_key_arg(interp, st);

    /* if types are already equivalent, no need to convert */
    if (PARROT_ARG_TYPE(st->dest.sig) == PARROT_ARG_TYPE(st->src.sig))
        return;

    /* convert */
    switch (st->src.sig & PARROT_ARG_TYPE_MASK) {
        case PARROT_ARG_INTVAL:   convert_arg_from_int(interp, st); break;
        case PARROT_ARG_FLOATVAL: convert_arg_from_num(interp, st); break;
        case PARROT_ARG_STRING:   convert_arg_from_str(interp, st); break;
        case PARROT_ARG_PMC:      convert_arg_from_pmc(interp, st); break;
        default:
            break;
    }
}


/*

=item C<void parrot_pass_args>

Main argument passing routine.

Prelims: code segments aren't yet switched, so the current constants are still
that of the caller.  The destination context is already created and set,
C<src_ctx> point to the caller's context. C<dst_seg> has the constants of the
destination.

C<what> is either C<PARROT_OP_get_params_pc> or C<PARROT_OP_get_results_pc>.
With the former arguments are passed from the caller into a subroutine, the
latter handles return values and yields.

=cut

*/

PARROT_API
void
parrot_pass_args(PARROT_INTERP,
        ARGMOD(parrot_context_t *src_ctx), ARGMOD(parrot_context_t *dest_ctx),
        ARGMOD(opcode_t *src_indexes),     ARGMOD(opcode_t *dest_indexes),
        arg_pass_t param_or_result)
{
    call_state st;
    PMC *src_signature, *dest_signature;

    if (param_or_result == PARROT_PASS_PARAMS) {
        src_signature            = interp->args_signature;
        dest_signature           = interp->params_signature;
        interp->args_signature   = NULL;
        interp->params_signature = NULL;
    }
    else /* (param_or_result == PARROT_PASS_RESULTS) */ {
        src_signature               = interp->returns_signature;
        dest_signature              = dest_ctx->results_signature;
        interp->returns_signature   = NULL;
        dest_ctx->results_signature = NULL;
    }

    Parrot_init_arg_indexes_and_sig_pmc(interp, src_ctx, src_indexes,
        src_signature, &st.src);

    Parrot_init_arg_indexes_and_sig_pmc(interp, dest_ctx, dest_indexes,
        dest_signature, &st.dest);

    Parrot_process_args(interp, &st, param_or_result);

    /* If we created a slurpy, we had to DOD register it so it did not get
     * collected during arg processing; we'll now unregister it. */
    if (st.dest.slurp)
        dod_unregister_pmc(interp, st.dest.slurp);
}


/*

=item C<opcode_t * parrot_pass_args_fromc>

Passes arguments from C code with given signature to a Parrot Sub.
Prerequisites are like above.

=cut

*/

PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
opcode_t *
parrot_pass_args_fromc(PARROT_INTERP, ARGIN(const char *sig),
        ARGMOD(opcode_t *dest), ARGIN(parrot_context_t *old_ctxp), va_list ap)
{
    call_state st;

    Parrot_init_arg_op(interp, CONTEXT(interp), dest, &st.dest);
    Parrot_init_arg_sig(interp, old_ctxp, sig, PARROT_VA_TO_VAPTR(ap), &st.src);
    Parrot_process_args(interp, &st, PARROT_PASS_PARAMS);
    return dest + st.dest.n + 2;
}


/*

=item C<static int set_retval_util>

RT#48260: Not yet documented!!!

=cut

*/

static int
set_retval_util(PARROT_INTERP, ARGIN(const char *sig),
    ARGIN(parrot_context_t *ctx), ARGMOD(call_state *st))
{
    opcode_t * const src_pc = interp->current_returns;
    int              todo   = Parrot_init_arg_op(interp, ctx, src_pc, &st->src);

    interp->current_returns = NULL;

    if (todo) {
        todo = Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL,
            &st->dest);

        if (todo) {
            Parrot_fetch_arg(interp, st);
            Parrot_convert_arg(interp, st);
            return 1;
        }
    }

    return 0;
}


/*

=item C<void * set_retval>

Handles void and pointer (PMC *, STRING *) return values.  Returns a PMC,
STRING, or NULL pointer as appropriate.

=cut

*/

PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
void *
set_retval(PARROT_INTERP, int sig_ret, ARGIN(parrot_context_t *ctx))
{
    call_state st;

    if (!sig_ret || sig_ret == 'v')
        return NULL;

    switch (sig_ret) {
        case 'S':
            if (set_retval_util(interp, "S", ctx, &st))
                return UVal_str(st.val);
        case 'P':
            if (set_retval_util(interp, "P", ctx, &st)) {
                PMC *retval = UVal_pmc(st.val);
                dod_unregister_pmc(interp, retval);
                return (void *)retval;
            }
        default:
            return NULL;
    }
}


/*

=item C<INTVAL set_retval_i>

Handles an INTVAL return value, returning its value if present and 0 otherwise.

=cut

*/

INTVAL
set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(parrot_context_t *ctx))
{
    call_state st;

    if (sig_ret != 'I')
        real_exception(interp, NULL, E_ValueError, "return signature not 'I'");

    if (set_retval_util(interp, "I", ctx, &st))
        return UVal_int(st.val);

    return 0;
}


/*

=item C<FLOATVAL set_retval_f>

Handles a FLOATVAL return value, returning its value if present and 0.0
otherwise.

=cut

*/

FLOATVAL
set_retval_f(PARROT_INTERP, int sig_ret, ARGIN(parrot_context_t *ctx))
{
    call_state st;

    if (sig_ret != 'N')
        real_exception(interp, NULL, E_ValueError, "return signature not 'N'");

    if (set_retval_util(interp, "N", ctx, &st))
        return UVal_num(st.val);

    return 0.0;
}


/*

=item C<STRING* set_retval_s>

Handles a STRING return value, returning its pointer if present and NULL
otherwise.

=cut

*/

PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
STRING*
set_retval_s(PARROT_INTERP, int sig_ret, ARGIN(parrot_context_t *ctx))
{
    call_state st;

    if (sig_ret != 'S')
        real_exception(interp, NULL, E_ValueError, "return signature not 'S'");

    if (set_retval_util(interp, "S", ctx, &st))
        return UVal_str(st.val);

    return NULL;
}


/*

=item C<PMC* set_retval_p>

Handles a PMC return value, returning the PMC pointer if present and NULL
otherwise.

=cut

*/

PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC*
set_retval_p(PARROT_INTERP, int sig_ret, ARGIN(parrot_context_t *ctx))
{
    call_state st;

    if (sig_ret != 'P')
        real_exception(interp, NULL, E_ValueError, "return signature not 'P'");

    if (set_retval_util(interp, "P", ctx, &st))
        return UVal_pmc(st.val);

    return NULL;
}


/*

=item C<static void commit_last_arg>

Called by Parrot_PCCINVOKE when it reaches the end of each arg in the arg
signature.  See C<Parrot_PCCINVOKE> for signature syntax.

=cut

*/

static void
commit_last_arg(PARROT_INTERP, int index, int cur,
    ARGMOD(opcode_t *n_regs_used), int seen_arrow, ARGIN(PMC * const *sigs),
    ARGMOD(opcode_t **indexes), ARGMOD(parrot_context_t *ctx),
    ARGIN_NULLOK(PMC *pmc), ARGIN(va_list *list))
{
    int reg_offset = 0;

    /* invocant already commited, just return */
    if (seen_arrow == 0 && index == 0 && pmc)
        return;

    /* calculate arg's register offset */
    switch (cur & PARROT_ARG_TYPE_MASK) { /* calc reg offset */
        case PARROT_ARG_INTVAL:
            reg_offset = n_regs_used[seen_arrow * 4 + REGNO_INT]++; break;
        case PARROT_ARG_FLOATVAL:
            reg_offset = n_regs_used[seen_arrow * 4 + REGNO_NUM]++; break;
        case PARROT_ARG_STRING:
            reg_offset = n_regs_used[seen_arrow * 4 + REGNO_STR]++; break;
        case PARROT_ARG_PMC :
            reg_offset = n_regs_used[seen_arrow * 4 + REGNO_PMC]++; break;
        default:
            real_exception(interp, NULL, E_IndexError,
                "Parrot_PCCINVOKE: invalid reg type");
    }

    /* set the register offset into the index int[] */
    indexes[seen_arrow][index] = reg_offset;

    /* set the PARROT_ARG_FLAGS into the signature FIA */
    VTABLE_set_integer_keyed_int(interp, sigs[seen_arrow], index, cur);

    /* perform the arg accessor function, assigning the arg to its
     * corresponding register */
    if (!seen_arrow) {
        switch (cur & PARROT_ARG_TYPE_MASK) {
            case PARROT_ARG_INTVAL:
                CTX_REG_INT(ctx, reg_offset) = va_arg(*list, INTVAL);   break;
            case PARROT_ARG_FLOATVAL:
                CTX_REG_NUM(ctx, reg_offset) = va_arg(*list, FLOATVAL); break;
            case PARROT_ARG_STRING:
                CTX_REG_STR(ctx, reg_offset) = va_arg(*list, STRING *); break;
            case PARROT_ARG_PMC:
                CTX_REG_PMC(ctx, reg_offset) = va_arg(*list, PMC *);    break;
            default:
                real_exception(interp, NULL, E_IndexError,
                    "Parrot_PCCINVOKE: invalid reg type");
        }
    }
}


/*

=item C<void Parrot_PCCINVOKE>

pmc is the invocant.

method_name is the method_name used in the find_method VTABLE call

signature is a string describing the Parrot calling conventions for
Parrot_PCCINVOKE.  ... variable args contains the IN arguments followed by the
OUT results variables.  You must pass the address_of(&) the OUT results of
course.

Signatures:
  uppercase letters repesent each arg and denote its types

  I INTVAL
  N FLOATVAL
  S STRING *
  P PMC *

  lowercase letters are adverb modifiers to the preceeding uppercase arg
  identifier

  f flatten
  n named
  s slurpy
  o optional
  p opt flag

  -> is the separator between args and results, similar to type theory notation.

  Named args require two arg slots. The first is the name, the second the arg.

Example signature:

  "SnIPf->INPs"

  The args to the method invocation are
    a named INTVAL:  SnI
    a flattened PMC:  Pf

  The results of the method invocation are
    a INTVAL: I
    a FLOATVAL: N
    a slurpy PMC: Ps

invokes a PMC method

=cut

*/

PARROT_API
void
Parrot_PCCINVOKE(PARROT_INTERP, ARGIN(PMC* pmc), ARGMOD(STRING *method_name),
        ARGIN(const char *signature), ...)
{
#define PCC_ARG_MAX 1024
    /* variables from PCCINVOKE impl in PCCMETHOD.pm */
    /* args INSP, returns INSP */
    INTVAL n_regs_used[] = { 0, 0, 0, 0, 0, 0, 0, 0 };

    /* Each of these is 8K. Do we want 16K on the stack? */
    opcode_t arg_indexes[PCC_ARG_MAX];
    opcode_t result_indexes[PCC_ARG_MAX];

    PMC * const args_sig    = pmc_new(interp, enum_class_FixedIntegerArray);
    PMC * const results_sig = pmc_new(interp, enum_class_FixedIntegerArray);
    PMC * const ret_cont    = new_ret_continuation_pmc(interp, NULL);

    parrot_context_t *ctx;
    PMC              *pccinvoke_meth;

    opcode_t         *save_current_args;
    PMC              *save_args_signature;
    PMC              *save_current_object;

    /* temporary state vars for building PCC index and PCC signature arrays. */

    /* arg_indexes, result_indexes */
    opcode_t *indexes[2];

    /* args_sig, results_sig */
    PMC *sigs[2];

    /* # of arg args, # of result args */
    int arg_ret_cnt[2] = { 0, 0 };

    /* INSP args, INSP results */
    int         max_regs[8]    = { 0, 0, 0, 0, 0, 0, 0, 0 };
    int         seen_arrow     = 0;

    const char *x;
    const char *ret_x  = NULL;
    int         index  = -1;
    int         cur    =  0;

    va_list list;
    va_start(list, signature);

    indexes[0] = arg_indexes;
    indexes[1] = result_indexes;
    sigs[0]    = args_sig;
    sigs[1]    = results_sig;

    /* account for passing invocant in-band */
    if (!pmc)
        real_exception(interp, NULL, 1,
            "NULL PMC passed into Parrot_PCCINVOKE");

    arg_ret_cnt[seen_arrow]++;
    max_regs[REGNO_PMC]++;

    /* first loop through signature to get sizing info */
    for (x = signature; *x != '\0'; x++) {
        switch (*x) {
            case '-':
                /* detect -> separator */
                seen_arrow = 1 ;
                ++x;
                if (*x != '>')
                    real_exception(interp, NULL, E_IndexError,
                        "Parrot_PCCINVOKE: invalid signature separator %c!",
                        *x);
                break;
            case 'I':
                arg_ret_cnt[seen_arrow]++;
                max_regs[seen_arrow * 4 + REGNO_INT]++;
                break;
            case 'N':
                arg_ret_cnt[seen_arrow]++;
                max_regs[seen_arrow * 4 + REGNO_NUM]++;
                break;
            case 'S':
                arg_ret_cnt[seen_arrow]++;
                max_regs[seen_arrow * 4 + REGNO_STR]++;
                break;
            case 'P':
                arg_ret_cnt[seen_arrow]++;
                max_regs[seen_arrow * 4 + REGNO_PMC]++;
                break;
            case 'f':
            case 'n':
            case 's':
            case 'o':
            case 'p':
                break;
            default:
                real_exception(interp, NULL, E_IndexError,
                    "Parrot_PCCINVOKE: invalid reg type %c!", *x);
        }
    }

    /* calculate max reg types needed for both args and results */
    n_regs_used[0] = PARROT_MAX(max_regs[0], max_regs[4]);
    n_regs_used[1] = PARROT_MAX(max_regs[1], max_regs[5]);
    n_regs_used[2] = PARROT_MAX(max_regs[2], max_regs[6]);
    n_regs_used[3] = PARROT_MAX(max_regs[3], max_regs[7]);

    /* initialize arg and return sig FIAs with collected info */
    if (arg_ret_cnt[0] > 0)
        VTABLE_set_integer_native(interp, args_sig, arg_ret_cnt[0]);

    if (arg_ret_cnt[1] > 0)
        VTABLE_set_integer_native(interp, results_sig, arg_ret_cnt[1]);

    ctx = Parrot_push_context(interp, n_regs_used);

    /* reset n_regs_used for reuse reused during arg index allocation step */
    n_regs_used[0] = 0;
    n_regs_used[1] = 0;
    n_regs_used[2] = 0;
    n_regs_used[3] = 0;

    /* second loop through signature to build all index and arg_flag
     * loop also assigns args(up to the ->) to registers */
    index      = -1;
    seen_arrow =  0;

    /* account for passing invocant in-band */
    indexes[0][0] = 0;

    VTABLE_set_integer_keyed_int(interp, sigs[0], 0, PARROT_ARG_PMC);
    CTX_REG_PMC(ctx, 0) = pmc;

    n_regs_used[seen_arrow * 4 + REGNO_PMC]++;
    index = 0;

    for (x = signature; *x != '\0'; x++) {
        /* detect -> separator */
        if (*x == '-') {

            /* skip '>' */
            x++;

            /* allows us to jump directly to the result signature portion
             * during results assignment */
            ret_x = x;

            /* save off pointer to results */
            ret_x++;

            if (index >= 0)
                commit_last_arg(interp, index, cur, n_regs_used, seen_arrow,
                    sigs, indexes, ctx, pmc, &list);

            /* reset parsing state so we can now handle results */
            seen_arrow =  1;
            index      = -1;

            /* reset n_regs_used for reuse during result index allocation */
            n_regs_used[0] = 0;
            n_regs_used[1] = 0;
            n_regs_used[2] = 0;
            n_regs_used[3] = 0;
        }
        /* parse arg type */
        else if (isupper((unsigned char)*x)) {
            if (index >= 0)
                commit_last_arg(interp, index, cur, n_regs_used, seen_arrow,
                    sigs, indexes, ctx, pmc, &list);

            index++;

            switch (*x) {
                case 'I': cur = PARROT_ARG_INTVAL;   break;
                case 'N': cur = PARROT_ARG_FLOATVAL; break;
                case 'S': cur = PARROT_ARG_STRING;   break;
                case 'P': cur = PARROT_ARG_PMC;      break;
                default:
                          real_exception(interp, NULL, E_IndexError,
                                  "Parrot_PCCINVOKE: invalid reg type %c!", *x);
            }

        }
        /* parse arg adverbs */
        else if (islower((unsigned char)*x)) {
            switch (*x) {
                case 'n': cur |= PARROT_ARG_NAME;         break;
                case 'f': cur |= PARROT_ARG_FLATTEN;      break;
                case 's': cur |= PARROT_ARG_SLURPY_ARRAY; break;
                case 'o': cur |= PARROT_ARG_OPTIONAL;     break;
                case 'p': cur |= PARROT_ARG_OPT_FLAG;     break;
                default:
                    real_exception(interp, NULL, E_IndexError,
                        "Parrot_PCCINVOKE: invalid adverb type %c!", *x);
            }
        }
    }

    if (index >= 0)
        commit_last_arg(interp, index, cur, n_regs_used, seen_arrow, sigs,
            indexes, ctx, pmc, &list);

    /* code from PCCINVOKE impl in PCCMETHOD.pm */
    save_current_args      = interp->current_args;
    save_args_signature    = interp->args_signature;
    save_current_object    = interp->current_object;

    interp->current_args   = arg_indexes;
    interp->args_signature = args_sig;
    ctx->current_results   = result_indexes;
    ctx->results_signature = results_sig;

    /* arg_accessors assigned in loop above */

    interp->current_object       = pmc;
    interp->current_cont         = NEED_CONTINUATION;
    ctx->current_cont            = ret_cont;
    PMC_cont(ret_cont)->from_ctx = ctx;
    ctx->ref_count++;
    pccinvoke_meth               = VTABLE_find_method(interp, pmc, method_name);

    if (PMC_IS_NULL(pccinvoke_meth))
        real_exception(interp, NULL, METH_NOT_FOUND, "Method '%Ss' not found",
            method_name);
    else
        VTABLE_invoke(interp, pccinvoke_meth, NULL);

    /* result_accessors perform the arg accessor function,
     * assigning the corresponding registers to the result variables */
    index      = 0;
    seen_arrow = 1;

    for (x = ret_x; x && *x; x++) {
        if (isupper((unsigned char)*x)) {
            switch (*x) {
                case 'I':
                    {
                    INTVAL * const tmpINTVAL = va_arg(list, INTVAL*);
                    *tmpINTVAL = CTX_REG_INT(ctx, indexes[seen_arrow][index]);
                    }
                    break;
                case 'N':
                    {
                    FLOATVAL * const tmpFLOATVAL = va_arg(list, FLOATVAL*);
                    *tmpFLOATVAL = CTX_REG_NUM(ctx, indexes[seen_arrow][index]);
                    }
                    break;
                case 'S':
                    {
                    STRING ** const tmpSTRING = va_arg(list, STRING**);
                    *tmpSTRING = CTX_REG_STR(ctx, indexes[seen_arrow][index]);
                    }
                    break;
                case 'P':
                    {
                    PMC ** const tmpPMC = va_arg(list, PMC**);
                    *tmpPMC = CTX_REG_PMC(ctx, indexes[seen_arrow][index]);
                    }
                    break;
                default:
                    real_exception(interp, NULL, E_IndexError,
                        "Parrot_PCCINVOKE: invalid reg type %c!", *x);
            }
        }
    }

    PObj_live_CLEAR(args_sig);
    PObj_live_CLEAR(results_sig);

    Parrot_pop_context(interp);

    interp->current_args   = save_current_args;
    interp->args_signature = save_args_signature;
    interp->current_object = save_current_object;
}


/*

=back

=head1 SEE ALSO

F<include/parrot/interpreter.h>, F<src/inter_run.c>, F<src/pmc/sub.pmc>.

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */