pic.ops

/*
 * $Id$
** pic.ops
*/

#include "parrot/oplib/ops.h"
#include "../src/pmc/pmc_fixedintegerarray.h"

typedef opcode_t* (*interface_f)(Interp*, INTVAL*, void **);

VERSION = PARROT_VERSION;

=head1 NAME

pic.ops - PIC (Polymorphic Inline Cache) opcode variants

=cut

=head1 DESCRIPTION

During predereferencing opcodes that allow caching are rewritten so that
equivalent opcodes in this file are used. User code MUST never emit these
opcodes directly.

=head2 General infix operations

These operations take an infix operation number and PMC arguments.

=cut

=over 4

=item B<pic_infix__>(inconst INT, invar PMC, invar PMC)

One for fun and MOPS.

=cut

inline op pic_infix__(inconst INT, invar PMC, invar PMC) :pic :flow {
    Parrot_MIC *mic;
    Parrot_PIC_lru *lru;
    PMC *left, *right;
    INTVAL lr_types;

    mic = (Parrot_MIC *) cur_opcode[1];
    left = $2;
    right = $3;
    lru = &mic->lru;
    lr_types = (VTABLE_type(interp, left) << 16) | VTABLE_type(interp, right);
    if (lru->u.type == lr_types) {
runit_v_pp:
        ((mmd_f_v_pp)lru->f.real_function)(interp, left, right);
        goto NEXT();
    }
    if (mic->pic) {
        lru = mic->pic->lru;
        if (lru->u.type == lr_types)
            goto runit_v_pp;
        if (++lru->u.type == lr_types)
            goto runit_v_pp;
        if (++lru->u.type == lr_types)
            goto runit_v_pp;
        mic->pic->miss_count++;
        /*
         * RT#42353 if we got too often here just do a dynamic lookup
         */
    }
    parrot_pic_find_infix_v_pp(interp, left, right, mic, cur_opcode);
    /* rerun this opcode */
    goto OFFSET(0);
}

=item B<pic_inline_sub__>(inconst INT, invar PMC, invar PMC)

And for more fun an inlined variant too.

=cut

inline op pic_inline_sub__(inconst INT, invar PMC, invar PMC) :pic {
    Parrot_MIC *mic;
    Parrot_PIC_lru *lru;
    PMC *left, *right;
    INTVAL lr_types, lt, rt;

    left = $2;
    mic = (Parrot_MIC *) cur_opcode[1];
    lt = VTABLE_type(interp, left);
    right = $3;
    lru = &mic->lru;
    rt = VTABLE_type(interp, right);
    lr_types = (lt << 16) | rt;
    if (lru->u.type == lr_types) {
        INTVAL a = lt == enum_class_Integer ? PMC_int_val(left) :
            VTABLE_get_integer(interp, left);
        INTVAL b = rt == enum_class_Integer ? PMC_int_val(right) :
            VTABLE_get_integer(interp, right);
        INTVAL c = a - b;
        if ((c^a) >= 0 || (c^~b) >= 0) {
            if (lt == enum_class_Integer)
                PMC_int_val(left) = c;
            else
                VTABLE_set_integer_native(interp, left, c);
        }
        else {
            if (PARROT_ERRORS_test(interp, PARROT_ERRORS_OVERFLOW_FLAG)) {
                opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
                        EXCEPTION_ERR_OVERFLOW,
                        "Integer overflow");
                goto ADDRESS(handler);
            }
            /* #RT42354 preserve type system */
            VTABLE_morph(interp, left, interp->vtables[enum_class_BigInt]->pmc_class);
            VTABLE_set_integer_native(interp, left, a);
            $2 = VTABLE_subtract_int(interp, left, b, left);
        }
    }
    else {
        ((void**)cur_opcode)[0] =
            parrot_pic_opcode(interp, PARROT_OP_pic_infix___ic_p_p);
        goto OFFSET(0);
    }
}

=item B<pic_get_params__>(inconst PMC /* , ... */)

Fetch function parameters for this subroutine.

=item B<pic_set_returns__>(inconst PMC /* , ... */)

Return values to caller.

=cut

inline op pic_get_params__(inconst PMC) :pic :flow {
    Parrot_MIC *mic;
    Parrot_PIC_lru *lru;
    PMC *sig, *ccont;
    opcode_t *src_pc;
    void **src_pred;
    Parrot_Context *caller_ctx, *ctx;
    int n;

    /* avoid load dependencies - intermix derefs
     * - yes, confusing but faster
     */
    ctx = CONTEXT(interp);
    src_pc = interp->current_args;
    mic = (Parrot_MIC *) cur_opcode[1];
    caller_ctx = ctx->caller_ctx;
    if (src_pc) {
        src_pred = (void**) src_pc - caller_ctx->pred_offset;
        sig = (PMC*)(src_pred[1]);
    }
    else {
        sig = NULL;
        src_pred = NULL;        /* just for gcc */
    }
    lru = &mic->lru;
    if (lru->u.signature == sig) {
        if (sig) {
            n = ((arg_pass_f)lru->f.real_function)(interp, sig,
                    (char*)caller_ctx->bp.regs_i, src_pred,
                    _reg_base, (void**)cur_opcode);
        }
        else
            n = 2;
        ccont = ctx->current_cont;
        if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
            PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
            --ctx->recursion_depth;
            ctx->caller_ctx = caller_ctx->caller_ctx;
            Parrot_free_context(interp, caller_ctx, 1);
            interp->current_args = NULL;
        }

        goto OFFSET(n);
    }
    /* no match redo plain opcode */
    ((void**)cur_opcode)[0] =
        parrot_pic_opcode(interp, PARROT_OP_get_params_pc);
    ((void**)cur_opcode)[1] = mic->m.sig;
    goto OFFSET(0);
}

inline op pic_set_returns__(inconst PMC) :pic :flow {
    Parrot_MIC *mic;
    Parrot_PIC_lru *lru;
    PMC *sig, *ccont;
    opcode_t *dest_pc;
    void **dest_pred;
    Parrot_Context *caller_ctx, *ctx;
    Parrot_cont *cc;
    int n;

    ctx = CONTEXT(interp);
    mic = (Parrot_MIC *) cur_opcode[1];
    ccont = ctx->current_cont;
    cc = PMC_cont(ccont);
    if (!cc->address) {
        interp->current_returns = CUR_OPCODE;
        n = PMC_int_val(mic->m.sig);
        goto OFFSET(n + 2);
    }
    caller_ctx = cc->to_ctx;
    interp->current_args = NULL;
    dest_pc = caller_ctx->current_results;
    if (dest_pc) {
        dest_pred = (void**) dest_pc - caller_ctx->pred_offset;
        sig = (PMC*)(dest_pred[1]);
    }
    else {
        sig = NULL;
        dest_pred = NULL;
    }
    lru = &mic->lru;
    if (lru->u.signature == sig) {
        if (sig) {
            n = ((arg_pass_f)lru->f.real_function)(interp, mic->m.sig,
                    _reg_base, (void**)cur_opcode,
                    (char*)caller_ctx->bp.regs_i, dest_pred);
        }
        else
            n = 2;
        goto OFFSET(n);
    }
    /* no match redo plain opcode */
    ((void**)cur_opcode)[0] =
        parrot_pic_opcode(interp, PARROT_OP_set_returns_pc);
    ((void**)cur_opcode)[1] = mic->m.sig;
    goto OFFSET(0);
}

=item B<pic_callr__>(inconst PMC)

Call the function $1 as C<pc = func(interp, 0, **args)>. args[0] holds the
address of the function result, args[1..] are function arguments, both
according to the C<get_results> and C<set_args> opcodes. The function is
a C interface function (or NCI) or a JITed PIR function. args[n+1] holds the
C<pc> of the next opcode and is usually just returned.

=cut

inline op pic_callr__(inconst PMC) :pic :flow {
    Parrot_MIC *mic;
    Parrot_PIC_lru *lru;
    void *args[6];      /* RT#42355 ARG_MAX */
    Parrot_Context *ctx;
    opcode_t *pc;
    void **pred_pc;
    INTVAL i, n_args, *sig_bits;
    PMC *sig;

    ctx = CONTEXT(interp);
    mic = (Parrot_MIC *) cur_opcode[1];
    /* get_results */
    pc = ctx->current_results;
    if (pc) {
        pred_pc = (void**) pc - ctx->pred_offset;
        sig = (PMC*)(pred_pc[1]);
        ASSERT_SIG_PMC(sig);
        PARROT_ASSERT(VTABLE_elements(interp, sig) <= 1);
        args[0] = VTABLE_elements(interp, sig) ?
            (_reg_base + ((opcode_t*)pred_pc)[2]) : NULL;
    }
    else
        args[0] = NULL;
    /* set_args */
    n_args = 0;
    sig = mic->m.sig;
    ASSERT_SIG_PMC(sig);
    n_args = VTABLE_elements(interp, sig);
    GETATTR_FixedIntegerArray_int_array(interp, sig, sig_bits);
    for (i = 0; i < n_args; ++i) {
        switch (sig_bits[i]) {
            case PARROT_ARG_INTVAL:
                args[1 + i] = (void*)*(INTVAL*)(_reg_base +
                        ((opcode_t*)cur_opcode)[2 + i]);
                break;
            case PARROT_ARG_INTVAL|PARROT_ARG_CONSTANT:
            case PARROT_ARG_FLOATVAL|PARROT_ARG_CONSTANT:
                args[1 + i] = (void**)cur_opcode[2 + i];
                break;
            case PARROT_ARG_FLOATVAL:
                args[1 + i] = (_reg_base +
                        ((opcode_t*)cur_opcode)[2 + i]);
                break;
            default:
                {
                    opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL,
                        EXCEPTION_INVALID_OPERATION,
                        "unhandled sig_bits");
                    goto ADDRESS(handler);
                }
        }
    }
    /* set_args(); set_p_pc; get_results(1), x; invokecc_p */
    pc = CUR_OPCODE + 2 + n_args + 3 + 3 + 2;
    args[1 + n_args] = pc;
    lru = &mic->lru;
    /* RT#42356 verify $1 didn't change */
    (void) ((interface_f)lru->f.real_function)(interp, sig_bits, args);
    goto ADDRESS(pc);
}

=back

=cut

###############################################################################

=head1 COPYRIGHT

Copyright (C) 2005-2008, Parrot Foundation.

=head1 LICENSE

This program is free software. It is subject to the same license
as the Parrot interpreter itself.

=cut


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