<commit_before>/*
Copyright (C) 2001-2003, 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 <assert.h>
#include "parrot/parrot.h"
#include "parrot/oplib/ops.h"
#include "inter_call.str"


#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;


static int next_arg(Interp *, struct call_state_item *st);
static void next_arg_sig(Interp *interp, struct call_state_item *st);
static int set_retval_util(Parrot_Interp interp, const char *sig, parrot_context_t *ctx,
        struct call_state *st);

/*

=item C<int Parrot_init_arg_nci(Interp *, struct call_state *st, const char *sig)>

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

=item C<int Parrot_init_ret_nci(Interp *, struct call_state *st, const char *sig)>

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

=cut

*/

int
Parrot_init_arg_nci(Interp *interp, struct call_state *st, const char *sig)
{
    Parrot_init_arg_op(interp, CONTEXT(interp->ctx), interp->current_args, &st->src);
    Parrot_init_arg_sig(interp, CONTEXT(interp->ctx), sig, NULL, &st->dest);
    return 1;
}

int
Parrot_init_ret_nci(Interp *interp, struct call_state *st, const char *sig)
{
    struct Parrot_Context *ctx = CONTEXT(interp->ctx);
    PMC *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->ctx), sig, NULL, &st->src);
    Parrot_init_arg_op(interp, ctx, ctx->current_results, &st->dest);
    return 1;
}

/*
int
=item C<Parrot_init_arg_indexes_and_sig_pmc(Interp *interp, parrot_context_t *ctx,
        opcode_t *indexes, PMC* sig_pmc, struct call_state_item *st)>

Initialize argument transfer with given context registers, register indexes, and
a signature pmc.

=item C<int Parrot_init_arg_sig(Interp *, parrot_context_t *ctx,
        const char *sig, void *ap, struct call_state_item *st)>

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

=item C<int Parrot_init_arg_op(Interp *, parrot_context_t *ctx,
        opcode_t *pc, struct call_state_item *st)>

Initialize argument transfer with given context registers, and opcode
location of a get_ or set_ argument opcode.

All 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

*/

int
Parrot_init_arg_indexes_and_sig_pmc(Interp *interp, parrot_context_t *ctx,
        opcode_t *indexes, PMC* sig_pmc, struct call_state_item *st)
{
    if (!sig_pmc && indexes) {
        ++indexes;
        sig_pmc = ctx->constants[*indexes]->u.key;
        ASSERT_SIG_PMC(sig_pmc);
        ++indexes;
    }

    st->i = 0;
    st->n = 0;
    st->mode = CALL_STATE_OP;
    st->ctx = ctx;
    st->sig = 0;

    if (indexes) {
        ASSERT_SIG_PMC(sig_pmc);
        st->u.op.signature = sig_pmc;
        st->u.op.pc = indexes;
        st->n = SIG_ELEMS(sig_pmc);
        /* initialize st->sig */
        if (st->n)
            next_arg_sig(interp, st);

    }
    return st->n > 0;
}

int
Parrot_init_arg_op(Interp *interp, parrot_context_t *ctx,
        opcode_t *pc, struct call_state_item *st)
{
    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, st);
}

int
Parrot_init_arg_sig(Interp *interp, parrot_context_t *ctx,
        const char *sig, void *ap, struct call_state_item *st)
{
    st->i = 0;
    st->n = 0;
    st->mode = CALL_STATE_SIG;
    st->ctx = ctx;
    st->sig = 0;

    if (*sig) {
        st->u.sig.sig = sig;
        st->u.sig.ap = ap;
        st->n = strlen(sig);
        /* initialize st->sig */
        if (st->n)
          next_arg_sig(interp, st);
    }
    return st->n > 0;
}

/* mark the source state as flattening with the passed
 * PMC being flattened, and fetch the first arg from the flattened set.
 */
static void
start_flatten(Interp *interp, struct call_state *st, 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;
    }
    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;
    Parrot_fetch_arg(interp, st);
}


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

static int
next_arg(Interp *interp, struct call_state_item *st)
{
    st->i++;
    if (st->i >= st->n) {
        st->sig = 0;
        return 0;
    }
    st->mode &= ~CALL_STATE_NEXT_ARG;
    next_arg_sig(interp, st);
    return 1;
}

static void
fetch_arg_sig(Interp *interp, struct call_state *st)
{
    va_list *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->ctx)->current_object;
            else
                UVal_pmc(st->val) = va_arg(*ap, PMC*);

            if (st->src.sig & PARROT_ARG_FLATTEN) {
                start_flatten(interp, st, UVal_pmc(st->val));
                return;
            }
            break;
    }
    st->src.mode |= CALL_STATE_NEXT_ARG;
}


static void
fetch_arg_op(Interp *interp, struct call_state *st)
{
    int constant = PARROT_ARG_CONSTANT_ISSET(st->src.sig);
    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) {
                start_flatten(interp, st, UVal_pmc(st->val));
                return;
            }
            break;
    }
    st->src.mode |= CALL_STATE_NEXT_ARG;
}


int
Parrot_fetch_arg(Interp *interp, struct call_state *st)
{
    if (st->dest.mode & CALL_STATE_NEXT_ARG) {
        if (!next_arg(interp, &st->dest))
            st->dest.mode |= CALL_STATE_x_END;
    }
    if (!st->src.n) {
        st->dest.mode |= CALL_STATE_END_x;
        return 0;
    }
    if (st->src.mode & CALL_STATE_NEXT_ARG) {
        if (!next_arg(interp, &st->src)) {
            st->dest.mode |= CALL_STATE_END_x;
            return 0;
        }
    }
#if 0
    /* NOT YET
     * e.g.
     * $ make
     * ../../parrot pgc.pir  --output=PGE/builtins_gen.pir PGE/builtins.pg
     * positional inside named args
     * ...
     */

    if ((st->dest.mode & CALL_STATE_NAMED_x) && !(st->src.sig & PARROT_ARG_NAME))
        real_exception(interp, NULL, E_ValueError, "positional inside named args");
#endif

    if (st->src.mode & CALL_STATE_FLATTEN) {
        if (st->src.slurp_i < st->src.slurp_n) {
            PMC *elem;
            if (st->key) {
                st->src.slurp_i++;
                st->name = parrot_hash_get_idx(interp, PMC_struct_val(st->src.slurp), st->key);
                assert(st->name);
                elem = VTABLE_get_pmc_keyed_str(interp, st->src.slurp, st->name);
            }
            else {
                elem = VTABLE_get_pmc_keyed_int(interp, st->src.slurp, st->src.slurp_i++);
            }
            st->src.sig = PARROT_ARG_PMC;
            UVal_pmc(st->val) = elem;
            return 1;
        }
        /* done with flattening */
        st->src.mode &= ~CALL_STATE_FLATTEN;
        st->src.mode |= CALL_STATE_NEXT_ARG;
        st->key = NULL;
        /* advance src - get next arg */
        return Parrot_fetch_arg(interp, st);
    }

    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(interp, &st->src);
    }
    switch (st->src.mode & CALL_S_D_MASK) {
        case CALL_STATE_OP:
            fetch_arg_op(interp, st);
            break;
        case CALL_STATE_SIG:
            fetch_arg_sig(interp, st);
            break;
    }
    return 1;
}


int
Parrot_fetch_arg_nci(Interp *interp, struct call_state *st)
{
    Parrot_fetch_arg(interp, st);
    if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY) {
        PMC *slurped;
        assert((st->dest.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC);
        slurped = pmc_new(interp, enum_class_ResizablePMCArray);
        while (!(st->dest.mode & CALL_STATE_END_x)) {
            Parrot_convert_arg(interp, st);
            st->dest.mode |= CALL_STATE_SLURP;
            VTABLE_push_pmc(interp, slurped, UVal_pmc(st->val));
            Parrot_fetch_arg(interp, st);
        }
        UVal_pmc(st->val) = slurped;
    }
    else {
        Parrot_convert_arg(interp, st);
        st->dest.mode |= CALL_STATE_NEXT_ARG;
    }
    return 1;
}

static void
convert_arg_from_int(Interp *interp, struct call_state *st)
{
    PMC *d;

    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:
            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;
            break;
    }
}

static void
convert_arg_from_num(Interp *interp, struct call_state *st)
{
    PMC *d;

    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:
            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;
            break;
    }
}

static void
convert_arg_from_str(Interp *interp, struct call_state *st)
{
    PMC *d;

    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:
            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;
            break;
    }
}

static void
convert_arg_from_pmc(Interp *interp, struct 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;
    }
}

/*
 * replace any src register by their values (done inside clone)
 * need a test for tailcalls too, but I think there is no syntax
 * to pass a key to a tailcalled function or method
 */
static void
clone_key_arg(Interp *interp, struct call_state *st)
{
    PMC *key = UVal_pmc(st->val);

    if (key && key->vtable->base_type == enum_class_Key) {
        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;
            }
        }
    }
}

/*
 * initializes dest calling state for recption of first named arg.
 */
static void
init_first_dest_named(Interp *interp, struct call_state *st)
{
    int i, n_named, idx;
    INTVAL sig;

    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.mode &= ~CALL_STATE_SLURP;
    st->dest.slurp = NULL;
    st->dest.mode |= CALL_STATE_x_NAMED;

    /* 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) {
        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) {
            /* 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 actua arg of a named arg, count it */
        else
            n_named++;
    }

    /* only 32/64 named args allowed, an UINTVAL is used 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;
}

/*
 * locate destination pos, return 0 if state changed
 */
static int
locate_pos_named(Interp *interp, struct call_state *st)
{
    int i, n_named;
    INTVAL sig;

    n_named = -1;
    st->dest.mode &= ~CALL_STATE_SLURP;
    st->dest.mode |= CALL_STATE_x_NAMED;
    for (i = st->first_named; i < st->dest.n; ++i) {
        sig = SIG_ITEM(st->dest.u.op.signature, i);
        if (!(sig & PARROT_ARG_NAME))
            continue;
        if (sig & PARROT_ARG_SLURPY_ARRAY)
            break;
        n_named++;
        if (st->named_done & (1 << n_named))
            continue;
        ++i;
        st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
        st->dest.i = i;
        st->named_done |= 1 << n_named;
        return 1;
    }
    st->dest.mode |= CALL_STATE_x_END;
    return 0;
}

/*
 * locate destination name, return 0 if not found
 */
static int
locate_named_named(Interp *interp, struct call_state *st)
{
    int i, n_named, idx;
    INTVAL sig;
    STRING *param;

    n_named = -1;
    st->dest.mode &= ~CALL_STATE_SLURP;
    st->dest.mode &= ~CALL_STATE_OPT;
    for (i = st->first_named; i < st->dest.n; ++i) {
        sig = SIG_ITEM(st->dest.u.op.signature, i);
        if (!(sig & PARROT_ARG_NAME))
            continue;
        if (sig & PARROT_ARG_SLURPY_ARRAY) {
            st->dest.mode |= CALL_STATE_SLURP;
            return 1;
        }
        n_named++;
        idx = st->dest.u.op.pc[i];
        param = PARROT_ARG_CONSTANT_ISSET(sig) ? st->dest.ctx->constants[idx]->u.string
                : CTX_REG_STR(st->dest.ctx, idx);
        if (st->name == param || 0 == string_equal(interp, st->name, param)) {
            ++i;
            st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
            st->dest.i = i;
            /* if bit is set we got duplicated */
            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;
        }
    }
    st->dest.mode |= CALL_STATE_x_END;
    return 0;
}

static void
store_arg(struct 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;
    }
}

static int
store_current_arg(Interp *interp, struct call_state *st)
{
    INTVAL idx;
    if (st->dest.i >= st->dest.n)
        return 0;

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

    return 1;
}

int
Parrot_store_arg(Interp *interp, struct call_state *st)
{
    if (!store_current_arg(interp, st))
        return 0;
    if (!(st->dest.mode & CALL_STATE_x_NAMED))
        st->dest.mode |= CALL_STATE_NEXT_ARG;
    return 1;
}



static void
create_slurpy_array(Interp *interp, struct call_state *st, INTVAL idx)
{
    st->dest.slurp =
        pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));

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

    CTX_REG_PMC(st->dest.ctx, idx) = st->dest.slurp;
    st->dest.mode |= CALL_STATE_SLURP;
    st->dest.mode &= ~CALL_STATE_OPT;
}

static void
too_few(Interp *interp, struct call_state *st, const char *action)
{
    int max_expected_args = st->params;
    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);
    }
}

static void
too_many(Interp *interp, struct call_state *st, const char *action)
{
    int max_expected_args = st->params;
    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);
    }
}

static void
null_val(int sig, struct 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;
    }
}

/* 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
 */
static void
check_named(Interp *interp, struct call_state *st, const char *action)
{
    int i;
    int n_named = -1;

    for (i = st->first_named; i < st->dest.n; ++i) {
        INTVAL idx;

        /* verify that a name exists */
        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;

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

            /* verify that an actual arg exists */
            arg_sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
            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);
                if(arg_sig & PARROT_ARG_OPT_FLAG)
                    i++; /* skip associated opt flag arg as well */
                continue;
            }
            else if (arg_sig & PARROT_ARG_OPTIONAL) {
                null_val(arg_sig, st);
                idx = st->dest.u.op.pc[i];
                store_arg(st, idx);

                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;<commit_msg>[src] Fixed parentheses as per coding standards Patch courtesy of <NAME> <<EMAIL>><commit_after>/*
Copyright (C) 2001-2003, 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 <assert.h>
#include "parrot/parrot.h"
#include "parrot/oplib/ops.h"
#include "inter_call.str"


#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;


static int next_arg(Interp *, struct call_state_item *st);
static void next_arg_sig(Interp *interp, struct call_state_item *st);
static int set_retval_util(Parrot_Interp interp, const char *sig, parrot_context_t *ctx,
        struct call_state *st);

/*

=item C<int Parrot_init_arg_nci(Interp *, struct call_state *st, const char *sig)>

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

=item C<int Parrot_init_ret_nci(Interp *, struct call_state *st, const char *sig)>

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

=cut

*/

int
Parrot_init_arg_nci(Interp *interp, struct call_state *st, const char *sig)
{
    Parrot_init_arg_op(interp, CONTEXT(interp->ctx), interp->current_args, &st->src);
    Parrot_init_arg_sig(interp, CONTEXT(interp->ctx), sig, NULL, &st->dest);
    return 1;
}

int
Parrot_init_ret_nci(Interp *interp, struct call_state *st, const char *sig)
{
    struct Parrot_Context *ctx = CONTEXT(interp->ctx);
    PMC *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->ctx), sig, NULL, &st->src);
    Parrot_init_arg_op(interp, ctx, ctx->current_results, &st->dest);
    return 1;
}

/*
int
=item C<Parrot_init_arg_indexes_and_sig_pmc(Interp *interp, parrot_context_t *ctx,
        opcode_t *indexes, PMC* sig_pmc, struct call_state_item *st)>

Initialize argument transfer with given context registers, register indexes, and
a signature pmc.

=item C<int Parrot_init_arg_sig(Interp *, parrot_context_t *ctx,
        const char *sig, void *ap, struct call_state_item *st)>

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

=item C<int Parrot_init_arg_op(Interp *, parrot_context_t *ctx,
        opcode_t *pc, struct call_state_item *st)>

Initialize argument transfer with given context registers, and opcode
location of a get_ or set_ argument opcode.

All 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

*/

int
Parrot_init_arg_indexes_and_sig_pmc(Interp *interp, parrot_context_t *ctx,
        opcode_t *indexes, PMC* sig_pmc, struct call_state_item *st)
{
    if (!sig_pmc && indexes) {
        ++indexes;
        sig_pmc = ctx->constants[*indexes]->u.key;
        ASSERT_SIG_PMC(sig_pmc);
        ++indexes;
    }

    st->i = 0;
    st->n = 0;
    st->mode = CALL_STATE_OP;
    st->ctx = ctx;
    st->sig = 0;

    if (indexes) {
        ASSERT_SIG_PMC(sig_pmc);
        st->u.op.signature = sig_pmc;
        st->u.op.pc = indexes;
        st->n = SIG_ELEMS(sig_pmc);
        /* initialize st->sig */
        if (st->n)
            next_arg_sig(interp, st);

    }
    return st->n > 0;
}

int
Parrot_init_arg_op(Interp *interp, parrot_context_t *ctx,
        opcode_t *pc, struct call_state_item *st)
{
    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, st);
}

int
Parrot_init_arg_sig(Interp *interp, parrot_context_t *ctx,
        const char *sig, void *ap, struct call_state_item *st)
{
    st->i = 0;
    st->n = 0;
    st->mode = CALL_STATE_SIG;
    st->ctx = ctx;
    st->sig = 0;

    if (*sig) {
        st->u.sig.sig = sig;
        st->u.sig.ap = ap;
        st->n = strlen(sig);
        /* initialize st->sig */
        if (st->n)
          next_arg_sig(interp, st);
    }
    return st->n > 0;
}

/* mark the source state as flattening with the passed
 * PMC being flattened, and fetch the first arg from the flattened set.
 */
static void
start_flatten(Interp *interp, struct call_state *st, 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;
    }
    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;
    Parrot_fetch_arg(interp, st);
}


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

static int
next_arg(Interp *interp, struct call_state_item *st)
{
    st->i++;
    if (st->i >= st->n) {
        st->sig = 0;
        return 0;
    }
    st->mode &= ~CALL_STATE_NEXT_ARG;
    next_arg_sig(interp, st);
    return 1;
}

static void
fetch_arg_sig(Interp *interp, struct call_state *st)
{
    va_list *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->ctx)->current_object;
            else
                UVal_pmc(st->val) = va_arg(*ap, PMC*);

            if (st->src.sig & PARROT_ARG_FLATTEN) {
                start_flatten(interp, st, UVal_pmc(st->val));
                return;
            }
            break;
    }
    st->src.mode |= CALL_STATE_NEXT_ARG;
}


static void
fetch_arg_op(Interp *interp, struct call_state *st)
{
    int constant = PARROT_ARG_CONSTANT_ISSET(st->src.sig);
    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) {
                start_flatten(interp, st, UVal_pmc(st->val));
                return;
            }
            break;
    }
    st->src.mode |= CALL_STATE_NEXT_ARG;
}


int
Parrot_fetch_arg(Interp *interp, struct call_state *st)
{
    if (st->dest.mode & CALL_STATE_NEXT_ARG) {
        if (!next_arg(interp, &st->dest))
            st->dest.mode |= CALL_STATE_x_END;
    }
    if (!st->src.n) {
        st->dest.mode |= CALL_STATE_END_x;
        return 0;
    }
    if (st->src.mode & CALL_STATE_NEXT_ARG) {
        if (!next_arg(interp, &st->src)) {
            st->dest.mode |= CALL_STATE_END_x;
            return 0;
        }
    }
#if 0
    /* NOT YET
     * e.g.
     * $ make
     * ../../parrot pgc.pir  --output=PGE/builtins_gen.pir PGE/builtins.pg
     * positional inside named args
     * ...
     */

    if ((st->dest.mode & CALL_STATE_NAMED_x) && !(st->src.sig & PARROT_ARG_NAME))
        real_exception(interp, NULL, E_ValueError, "positional inside named args");
#endif

    if (st->src.mode & CALL_STATE_FLATTEN) {
        if (st->src.slurp_i < st->src.slurp_n) {
            PMC *elem;
            if (st->key) {
                st->src.slurp_i++;
                st->name = parrot_hash_get_idx(interp, PMC_struct_val(st->src.slurp), st->key);
                assert(st->name);
                elem = VTABLE_get_pmc_keyed_str(interp, st->src.slurp, st->name);
            }
            else {
                elem = VTABLE_get_pmc_keyed_int(interp, st->src.slurp, st->src.slurp_i++);
            }
            st->src.sig = PARROT_ARG_PMC;
            UVal_pmc(st->val) = elem;
            return 1;
        }
        /* done with flattening */
        st->src.mode &= ~CALL_STATE_FLATTEN;
        st->src.mode |= CALL_STATE_NEXT_ARG;
        st->key = NULL;
        /* advance src - get next arg */
        return Parrot_fetch_arg(interp, st);
    }

    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(interp, &st->src);
    }
    switch (st->src.mode & CALL_S_D_MASK) {
        case CALL_STATE_OP:
            fetch_arg_op(interp, st);
            break;
        case CALL_STATE_SIG:
            fetch_arg_sig(interp, st);
            break;
    }
    return 1;
}


int
Parrot_fetch_arg_nci(Interp *interp, struct call_state *st)
{
    Parrot_fetch_arg(interp, st);
    if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY) {
        PMC *slurped;
        assert((st->dest.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC);
        slurped = pmc_new(interp, enum_class_ResizablePMCArray);
        while (!(st->dest.mode & CALL_STATE_END_x)) {
            Parrot_convert_arg(interp, st);
            st->dest.mode |= CALL_STATE_SLURP;
            VTABLE_push_pmc(interp, slurped, UVal_pmc(st->val));
            Parrot_fetch_arg(interp, st);
        }
        UVal_pmc(st->val) = slurped;
    }
    else {
        Parrot_convert_arg(interp, st);
        st->dest.mode |= CALL_STATE_NEXT_ARG;
    }
    return 1;
}

static void
convert_arg_from_int(Interp *interp, struct call_state *st)
{
    PMC *d;

    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:
            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;
            break;
    }
}

static void
convert_arg_from_num(Interp *interp, struct call_state *st)
{
    PMC *d;

    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:
            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;
            break;
    }
}

static void
convert_arg_from_str(Interp *interp, struct call_state *st)
{
    PMC *d;

    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:
            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;
            break;
    }
}

static void
convert_arg_from_pmc(Interp *interp, struct 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;
    }
}

/*
 * replace any src register by their values (done inside clone)
 * need a test for tailcalls too, but I think there is no syntax
 * to pass a key to a tailcalled function or method
 */
static void
clone_key_arg(Interp *interp, struct call_state *st)
{
    PMC *key = UVal_pmc(st->val);

    if (key && key->vtable->base_type == enum_class_Key) {
        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;
            }
        }
    }
}

/*
 * initializes dest calling state for recption of first named arg.
 */
static void
init_first_dest_named(Interp *interp, struct call_state *st)
{
    int i, n_named, idx;
    INTVAL sig;

    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.mode &= ~CALL_STATE_SLURP;
    st->dest.slurp = NULL;
    st->dest.mode |= CALL_STATE_x_NAMED;

    /* 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) {
        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) {
            /* 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 actua arg of a named arg, count it */
        else
            n_named++;
    }

    /* only 32/64 named args allowed, an UINTVAL is used 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;
}

/*
 * locate destination pos, return 0 if state changed
 */
static int
locate_pos_named(Interp *interp, struct call_state *st)
{
    int i, n_named;
    INTVAL sig;

    n_named = -1;
    st->dest.mode &= ~CALL_STATE_SLURP;
    st->dest.mode |= CALL_STATE_x_NAMED;
    for (i = st->first_named; i < st->dest.n; ++i) {
        sig = SIG_ITEM(st->dest.u.op.signature, i);
        if (!(sig & PARROT_ARG_NAME))
            continue;
        if (sig & PARROT_ARG_SLURPY_ARRAY)
            break;
        n_named++;
        if (st->named_done & (1 << n_named))
            continue;
        ++i;
        st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
        st->dest.i = i;
        st->named_done |= 1 << n_named;
        return 1;
    }
    st->dest.mode |= CALL_STATE_x_END;
    return 0;
}

/*
 * locate destination name, return 0 if not found
 */
static int
locate_named_named(Interp *interp, struct call_state *st)
{
    int i, n_named, idx;
    INTVAL sig;
    STRING *param;

    n_named = -1;
    st->dest.mode &= ~CALL_STATE_SLURP;
    st->dest.mode &= ~CALL_STATE_OPT;
    for (i = st->first_named; i < st->dest.n; ++i) {
        sig = SIG_ITEM(st->dest.u.op.signature, i);
        if (!(sig & PARROT_ARG_NAME))
            continue;
        if (sig & PARROT_ARG_SLURPY_ARRAY) {
            st->dest.mode |= CALL_STATE_SLURP;
            return 1;
        }
        n_named++;
        idx = st->dest.u.op.pc[i];
        param = PARROT_ARG_CONSTANT_ISSET(sig) ? st->dest.ctx->constants[idx]->u.string
                : CTX_REG_STR(st->dest.ctx, idx);
        if (st->name == param || 0 == string_equal(interp, st->name, param)) {
            ++i;
            st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
            st->dest.i = i;
            /* if bit is set we got duplicated */
            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;
        }
    }
    st->dest.mode |= CALL_STATE_x_END;
    return 0;
}

static void
store_arg(struct 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;
    }
}

static int
store_current_arg(Interp *interp, struct call_state *st)
{
    INTVAL idx;
    if (st->dest.i >= st->dest.n)
        return 0;

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

    return 1;
}

int
Parrot_store_arg(Interp *interp, struct call_state *st)
{
    if (!store_current_arg(interp, st))
        return 0;
    if (!(st->dest.mode & CALL_STATE_x_NAMED))
        st->dest.mode |= CALL_STATE_NEXT_ARG;
    return 1;
}



static void
create_slurpy_array(Interp *interp, struct call_state *st, INTVAL idx)
{
    st->dest.slurp =
        pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));

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

    CTX_REG_PMC(st->dest.ctx, idx) = st->dest.slurp;
    st->dest.mode |= CALL_STATE_SLURP;
    st->dest.mode &= ~CALL_STATE_OPT;
}

static void
too_few(Interp *interp, struct call_state *st, const char *action)
{
    int max_expected_args = st->params;
    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);
    }
}

static void
too_many(Interp *interp, struct call_state *st, const char *action)
{
    int max_expected_args = st->params;
    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);
    }
}

static void
null_val(int sig, struct 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;
    }
}

/* 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
 */
static void
check_named(Interp *interp, struct call_state *st, const char *action)
{
    int i;
    int n_named = -1;

    for (i = st->first_named; i < st->dest.n; ++i) {
        INTVAL idx;

        /* verify that a name exists */
        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;

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

            /* verify that an actual arg exists */
            arg_sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
            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);
                if (arg_sig & PARROT_ARG_OPT_FLAG)
                    i++; /* skip associated opt flag arg as well */
                continue;
            }
            else if (arg_sig & PARROT_ARG_OPTIONAL) {
                null_val(arg_sig, st);
                idx = st->dest.u.op.pc[i];
                store_arg(st, idx);

                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;
{'fraction_non_alphanumeric': 0.1239214705514568, 'fraction_numerical': 0.0032929015047309406, 'mean_word_length': 2.2097799183891897, 'pattern_counts': {'":': 0, '<': 64, '<?xml version=': 0, '>': 586, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3344881', 'n_tokens_mistral': 17499, 'n_tokens_neox': 17034, 'n_words': 3707}