/*
Copyright (C) 2001-2008, The Perl Foundation.
$Id: /mirror/trunk/src/pmc/bound_nci.pmc 29983 2008-08-02T22:45:13.271765Z allison  $

=head1 NAME

src/pmc/bound_nci.pmc - Bound internal method

=head1 DESCRIPTION

A bound internal method is a NCI method call, where the object is
bound to this call instance.

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"

pmclass Bound_NCI extends NCI need_ext {

/*

=item C<void set_pmc(PMC *obj)>

Bind the object C<obj> to this call instance.

=item C<PMC *get_pmc(void)>

Return the bound object.

=item C<opcode_t *invoke(void *next)>

Calls the associated C method, returning C<*next>.

=item C<void mark()>

Set the bound object live.

=cut

*/

    VTABLE void set_pmc(PMC *obj) {
        PMC_pmc_val(SELF) = obj;
        if (!PMC_IS_NULL(obj))
            PObj_custom_mark_SET(SELF);
    }

    VTABLE PMC *get_pmc() {
        return PMC_pmc_val(SELF);
    }

    VTABLE opcode_t *invoke(void *next) {
        if (PObj_get_FLAGS(SELF) & PObj_private0_FLAG) {
            /* bound multi sub
             * XXX maybe create separate PMC class
             * see also src/pmc/default.pmc:get_attr_str()
             * */
            PMC *multi = (PMC *)PMC_struct_val(SELF);
            next       = VTABLE_invoke(INTERP, multi, next);
        }
        else {
            /* Locate register holding invocant. */
            int  sig_const = interp->current_args[1];
            PMC *sig       = CONTEXT(interp)->constants[sig_const]->u.key;

            if (PMC_IS_NULL(sig))
                Parrot_ex_throw_from_c_args(interp, NULL,
                    EXCEPTION_INVALID_OPERATION,
                    "Bound NCI call made, but no current signature found.");

            ASSERT_SIG_PMC(sig);

            /* Get invocant register. */
            if (SIG_ELEMS(sig) > 0 && SIG_ITEM(sig, 0) & PARROT_ARG_PMC) {
                int  invocant_reg      = interp->current_args[2];
                PMC *p2                = REG_PMC(interp, invocant_reg);
                INTERP->current_object = REG_PMC(interp, invocant_reg)
                                           = PMC_pmc_val(SELF);
                SUPER(next);
                REG_PMC(interp, invocant_reg)  = p2;
            }
            else {
                Parrot_ex_throw_from_c_args(interp, NULL,
                    EXCEPTION_INVALID_OPERATION, "Bound NCI call made, "
                        "but the current call has no invocant.");
            }
        }

        return (opcode_t *)next;
    }

    VTABLE void mark() {
        if (PMC_pmc_val(SELF))
            pobject_lives(INTERP, (PObj *)PMC_pmc_val(SELF));
        if (PObj_get_FLAGS(SELF) & PObj_private0_FLAG) {
            if (PMC_struct_val(SELF))
                pobject_lives(INTERP, (PObj *)PMC_struct_val(SELF));
        }
    }

}

/*

=back

=head1 SEE ALSO

F<src/pmc/nci.pmc>

=head1 HISTORY

Initial revision by leo 2005.01.31.

=cut

*/

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