perl6.ops

/*
 * Copyright (C) 2008-2010, The Perl Foundation.
 */

BEGIN_OPS_PREAMBLE

#include "parrot/parrot.h"
#include "parrot/extend.h"
#include "parrot/dynext.h"
#include "pmc_object.h"
#include "pmc_class.h"
#include "pmc_callcontext.h"
#include "pmc_sub.h"
#include "../pmc/pmc_p6lowlevelsig.h"
#include "../binder/bind.h"

#if PARROT_HAS_ICU
#  include <unicode/uchar.h>
#endif

/* We cache a couple of type IDs for an op that we hit on every method call. */
static INTVAL p6s_id = 0;
static INTVAL or_id  = 0;
static INTVAL lls_id = 0;
static INTVAL obj_id = 0;
static INTVAL p6o_id = 0;

static STRING *LLSIG_ATTR_str;
static STRING *BANG_LLSIG_str;
static STRING *DISPATCH_JUNCTION_str;

/* Plus a function pointer to the binder. */
typedef INTVAL (*bind_llsig_func_type) (PARROT_INTERP, PMC *lexpad,
    PMC *llsig, PMC *capture, INTVAL no_nom_type_check, STRING **error);

static bind_llsig_func_type bind_llsig_func = NULL;

END_OPS_PREAMBLE

/*

=item rakudo_dynop_setup()

Does various setup tasks on behalf of all of the other dynops.

=cut

*/
inline op rakudo_dynop_setup() :base_core {
    /* Look up some type IDs. */
    p6s_id = pmc_type(interp, Parrot_str_new(interp, "Perl6Scalar", 0));
    or_id  = pmc_type(interp, Parrot_str_new(interp, "ObjectRef", 0));
    lls_id = pmc_type(interp, Parrot_str_new(interp, "P6LowLevelSig", 0));
    p6o_id = pmc_type(interp, Parrot_str_new(interp, "P6opaque", 0));
    obj_id = enum_class_Object;

    BANG_LLSIG_str        = Parrot_str_new_constant(interp, "!llsig");
    LLSIG_ATTR_str        = Parrot_str_new_constant(interp, "$!llsig");
    DISPATCH_JUNCTION_str = Parrot_str_new_constant(interp,
                                "!DISPATCH_JUNCTION_SINGLE");

    /* Create dummy low level sig op and use its get_pointer to get a pointer
     * to the signature binder. */
    bind_llsig_func = (bind_llsig_func_type)VTABLE_get_pointer(interp, pmc_new(interp, lls_id));

    goto NEXT();
}


/*

=item rebless_subclass(in PMC, in PMC)

Takes PMC $1 and reblesses it in-place, without any change of address, to be
an instance of class $2, where $2 is a subclass of the class of $1.

=cut

*/
inline op rebless_subclass(in PMC, in PMC) :base_core {
    PMC *value;
    PMC * const current_class = VTABLE_get_class(interp, $1);
    PMC * parent_list;
    int num_parents;
    int in_parents = 0;
    int new_attribs = 0;
    int i;

    /* Check what we're trying to bless into is a standard Parrot class. */
    if ($2->vtable->base_type != enum_class_Class)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "Can only rebless into a standard Parrot class.");

    /* Get parents list. */
    parent_list = PARROT_CLASS($2)->all_parents;
    num_parents = VTABLE_elements(interp, parent_list);

    /* First verify that the object's class is a superclass of the one we're
     * to re-bless it into. While we're at it, count the number of attributes
     * the current class has that the parent class does not. */
    for (i = 0; i < num_parents; i++) {
        PMC * const test_class = VTABLE_get_pmc_keyed_int(interp, parent_list, i);
        if (test_class == current_class) {
            in_parents = 1;
            break;
        }
        else {
            new_attribs += VTABLE_elements(interp, PARROT_CLASS($2)->attrib_metadata);
        }
    }
    if (!in_parents)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "Attempt to use rebless_subclass where the new class was not a subclass");

    /* Make sure we're operating on the real value, not a ObjectRef. */
    value = $1;
    while (value->vtable->base_type == or_id || value->vtable->base_type == p6s_id)
        value = VTABLE_get_pmc(interp, value);

    /* Check if the value is a parrot Object and the original class is a standard
     * Parrot Class. */
    if (value->vtable->base_type != enum_class_Object
            && current_class->vtable->base_type != enum_class_Class) {
        /* In this case, we have something from a foreign class system,
         * probably a PMC. We'll start by instantiating a new instance
         * of the derived class. */
        PMC * const new_ins = VTABLE_instantiate(interp, $2, PMCNULL);

        /* Now we do some nasty swapping around of memory. The end result is:
         *  - The proxy object from new_ins becomes the current value
         *  - The current value becomes the new instance
         *  - The new instance becomes the (now-replaced) proxy, and gets
         *    swept on the next GC run.
         * We do this by shuffling PMC headers around. It should be safe as
         * in the end we will end up with just as many PMCs existing. */
        PMC * const temp  = mem_allocate_typed(PMC);
        PMC * const proxy = VTABLE_get_attr_keyed(interp, new_ins, current_class,
                Parrot_str_new(interp, "proxy", 0));
        Parrot_block_GC_mark(interp);

        /* Using memcpy here may trigger gcc optimizations, which at this point
         * can wreak havoc on register-starved x86:
         * error: unable to find a register to spill in class 'SIREG'
         * Use memmove instead, which is slower, but isn't inlined by gcc. */
        memmove(temp, proxy, sizeof (PMC));
        memmove(proxy, value, sizeof (PMC));
        memmove(value, new_ins, sizeof (PMC));
        memmove(new_ins, temp, sizeof (PMC));

        Parrot_unblock_GC_mark(interp);
        mem_sys_free(temp);

        /* Now set any new attributes to be undef. */
        for (i = 0; i < new_attribs; i++)
            VTABLE_set_pmc_keyed_int(interp, PARROT_OBJECT(value)->attrib_store,
                i, pmc_new(interp, enum_class_Undef));
    }
    else if ((value->vtable->base_type != enum_class_Object && value->vtable->base_type != p6o_id)
            || current_class->vtable->base_type != enum_class_Class) {
        /* If we're here, we found a really odd state - the class claims to be
         * a standard Parrot one but the object it supposedly created is not.
         * In this case, something is probably wrong. */
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
            "Object to be reblessed does not appear to be of the expected class.");
    }
    else {
        /* We have a standard Parrot class and object and can tweak it's guts.
         * Shuffle up attributes to the point of the difference between the number
         * of attributes in the parent and the derived class. Yes, this is evil -
         * we're diddling the object's internals. */
        for (i = 0; i < new_attribs; i++)
            VTABLE_unshift_pmc(interp, PARROT_OBJECT(value)->attrib_store,
                pmc_new(interp, enum_class_Undef));

        /* Now switch object's class pointer to point at the new class. This is
         * also evil. */
        PARROT_OBJECT(value)->_class = $2;
    }

    goto NEXT();
}

/*

=item find_lex_skip_current(out PMC, in STR)

Finds the lexical named $2 and returns it. However, unlike find_lex this op
skips the current sub and starts looking immediately at its outers.

=cut

*/
inline op find_lex_skip_current(out PMC, in STR) :base_core {
    PMC *ctx = CURRENT_CONTEXT(interp);
    $1 = PMCNULL;

    while (Parrot_pcc_get_outer_ctx(interp, ctx)) {
        PMC   * const outer   = Parrot_pcc_get_outer_ctx(interp, ctx);
        PMC   * const lex_pad = Parrot_pcc_get_lex_pad(interp, outer);

        if (!PMC_IS_NULL(lex_pad) && VTABLE_exists_keyed_str(interp, lex_pad, $2)) {
            $1 = VTABLE_get_pmc_keyed_str(interp, lex_pad, $2);
            break;
        }

        ctx = outer;
    }

    goto NEXT();
}


/*

=item inline op x_is_uprop(out INT, in STR, in STR, in INT)

Sets a true value in $1 if character $4 in string $3 has the unicode property
named $2.

=cut

*/
inline op x_is_uprop(out INT, in STR, in STR, in INT) :base_core {
#if PARROT_HAS_ICU
    char     *cstr;
    INTVAL    ord;
    int32_t   strwhich, ordwhich;
    UProperty strprop;
    opcode_t  *handler;

    if ($4 > 0 && (UINTVAL)$4 == ($3->strlen)) {
        $1 = 0;
        goto NEXT();
    }

    ord = Parrot_str_indexed(interp, $3, $4);
    cstr = Parrot_str_to_cstring(interp, $2);

    /* try block tests */
    if (strncmp(cstr, "In", 2) == 0) {
        strwhich = u_getPropertyValueEnum(UCHAR_BLOCK, cstr+2);
        ordwhich = u_getIntPropertyValue(ord, UCHAR_BLOCK);
        if (strwhich != UCHAR_INVALID_CODE) {
            $1 = (strwhich == ordwhich);
            Parrot_str_free_cstring(cstr);
            goto NEXT();
        }
    }

    /* try bidi tests */
    if (strncmp(cstr, "Bidi", 4) == 0) {
        strwhich = u_getPropertyValueEnum(UCHAR_BIDI_CLASS, cstr+4);
        ordwhich = u_getIntPropertyValue(ord, UCHAR_BIDI_CLASS);
        if (strwhich != UCHAR_INVALID_CODE) {
            $1 = (strwhich == ordwhich);
            Parrot_str_free_cstring(cstr);
            goto NEXT();
        }
    }

    /* try property value aliases */
    strwhich = u_getPropertyValueEnum(UCHAR_GENERAL_CATEGORY_MASK, cstr);
    if (strwhich != UCHAR_INVALID_CODE) {
        ordwhich = u_getIntPropertyValue(ord, UCHAR_GENERAL_CATEGORY_MASK);
        $1 = ((strwhich & ordwhich) != 0);
        Parrot_str_free_cstring(cstr);
        goto NEXT();
    }

    /* try property */
    strprop = u_getPropertyEnum(cstr);
    if (strprop != UCHAR_INVALID_CODE) {
        $1 = (u_hasBinaryProperty(ord, strprop) != 0);
        Parrot_str_free_cstring(cstr);
        goto NEXT();
    }

    /* try script aliases */
    strwhich = u_getPropertyValueEnum(UCHAR_SCRIPT, cstr);
    if (strwhich != UCHAR_INVALID_CODE) {
        ordwhich = u_getIntPropertyValue(ord, UCHAR_SCRIPT);
        $1 = (strwhich == ordwhich);
        Parrot_str_free_cstring(cstr);
        goto NEXT();
    }

    /* unrecognized property name */
    Parrot_str_free_cstring(cstr);
    handler =  Parrot_ex_throw_from_op_args(interp, NULL,
            EXCEPTION_ICU_ERROR,
            "Unicode property '%Ss' not found", $2);
    goto ADDRESS(handler);
#else
    opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
            EXCEPTION_ICU_ERROR,
            "ICU not loaded", $2);
    goto ADDRESS(handler);
#endif
}


/*

=item get_next_candidate_info(out PMC, out PMC, out PMC)

Looks through the outers of our caller, until we find a Routine, for a lexical
named __CANDIDATE_LIST__. Hands this lexical back in $1, the PMC for the Routine
it was found in as $2 and the lexpad of that routine as $3. This is a fairly
special-purpose op that does just what callwith, callsame, nextwith and
nextsame need.

=cut

*/
inline op get_next_candidate_info(out PMC, out PMC, out PMC) :base_core {
    PMC     *ctx         = Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
    STRING  *name        = Parrot_str_new(interp, "__CANDIDATE_LIST__", 0);
    PMC     *last_lexpad = PMCNULL;
    PMC     *last_sub    = PMCNULL;

    while (!PMC_IS_NULL(ctx)) {
        /* See if we've found a candidate list. */
        PMC *lexpad = Parrot_pcc_get_lex_pad(interp, ctx);
        PMC *clist  = VTABLE_get_pmc_keyed_str(interp, lexpad, name);
        if (!PMC_IS_NULL(clist)) {
            /* Found. Set results and we're done. */
            $1 = clist;
            $2 = Parrot_pcc_get_sub(interp, ctx);
            $3 = lexpad;
            break;
        }
        else {
            /* Not found; keep looking. */
            last_sub = Parrot_pcc_get_sub(interp, ctx);
            last_lexpad = lexpad;
            ctx = Parrot_pcc_get_outer_ctx(interp, ctx);
        }
    }
    if (!ctx)
        $1 = $2 = $3 = PMCNULL;

    goto NEXT();
}


/*

=item transform_to_p6opaque(inout PMC)

Takes PMC $1 and swaps out its Object vtable for a P6opaque vtable. (Expect
this op to be temporary, but for now it lets us get things in the right
kinda direction.)

=cut

*/
inline op transform_to_p6opaque(inout PMC) :base_core {
    /* Sanity check. */
    if ($1->vtable->base_type == enum_class_Object) {
        $1->vtable = interp->vtables[p6o_id];
        goto NEXT();
    }
    else {
        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
            EXCEPTION_INVALID_OPERATION, "Can only transform an Object to p6opaque");
        goto ADDRESS(handler);
    }
}


/*

=item deobjectref(out PMC, in PMC)

If $2 is an ObjectRef, then follow the chain of ObjectRef
references until we get to a value of some sort (which could be
a Perl6Scalar).

=cut

*/
inline op deobjectref(out PMC, in PMC) :base_core {
    PMC * ref;
    ref = $2;
    while (ref->vtable->base_type == or_id)
        ref = VTABLE_get_pmc(interp, ref);
    $1 = ref;
    goto NEXT();
}

/*

=item descalarref(out PMC, in PMC)

If $2 is an ObjectRef or Perl6Scalar, then follow the chain of
ObjectRef/Perl6Scalar references until we get to the real
underlying value.

=cut

*/
inline op descalarref(out PMC, in PMC) :base_core {
    PMC * ref;
    ref = $2;
    while (ref->vtable->base_type == or_id || ref->vtable->base_type == p6s_id)
        ref = VTABLE_get_pmc(interp, ref);
    $1 = ref;
    goto NEXT();
}


/*

=item deref_unless_object(out PMC, in PMC)

If the value underlying $2 is anything but an Object or P6opaque,
return that value; otherwise return $2.

=cut

*/
inline op deref_unless_object(out PMC, in PMC) :base_core {
    PMC * val;
    val = $2;
    while (val->vtable->base_type == or_id || val->vtable->base_type == p6s_id)
        val = VTABLE_get_pmc(interp, val);
    $1 = (val->vtable->base_type == obj_id || val->vtable->base_type == p6o_id)
         ? $2 : val;
    goto NEXT();
}


/*

=item allocate_llsig(out PMC, in INT)

Sets $1 to be a P6LowLevelSig with $2 signature elements allocated.

=cut

*/
inline op allocate_llsig(out PMC, in INT) :base_core {
    struct llsig_element **elements;
    INTVAL i;

    /* Create new low level signature PMC. */
    $1 = Parrot_pmc_new_init_int(interp, lls_id, $2);
    goto NEXT();
}


/*

=item get_llsig_size(out INT, in PMC)

Sets $1 to be the number of elements the P6LowLevelSig $2 has.

=cut

*/
inline op get_llsig_size(out INT, in PMC) :base_core {
    if ($2->vtable->base_type == lls_id) {
        INTVAL num_elements;
        GETATTR_P6LowLevelSig_num_elements(interp, $2, num_elements);
        $1 = num_elements;
        goto NEXT();
    }
    else {
        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
                EXCEPTION_INVALID_OPERATION, "get_llsig_size only works on P6LowLevelSig PMCs");
        goto ADDRESS(handler);
    }
}


/*

=item set_llsig_elem(in PMC, in INT, in STR, in INT, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, in STR)

Takes $1 (a P6LowLevelSig) and sets the contents of the signature element with
index $2 as follows:

  $3  = lexical name to bind to
  $4  = flags
  $5  = main (nominal) type
  $6  = constraint type or junction of constraint types; null if none
  $7  = array of names for a named parameter
  $8  = array of type captures
  $9  = default value closure
  $10 = nested signature
  $11 = name of coercion method to call, if any

=cut

*/
inline op set_llsig_elem(in PMC, in INT, in STR, in INT, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC, in STR) :base_core {
    if ($1->vtable->base_type == lls_id) {
        struct llsig_element **elements;
        INTVAL num_elements;

        /* Check we're not out of range. */
        GETATTR_P6LowLevelSig_elements(interp, $1, elements);
        GETATTR_P6LowLevelSig_num_elements(interp, $1, num_elements);
        if ($2 < num_elements) {
            /* Set up sig. */
            struct llsig_element *element = elements[$2];
            element->variable_name    = $3;
            element->flags            = $4;
            element->post_constraints = $6;
            element->named_names      = $7;
            element->type_captures    = $8;
            element->default_closure  = $9;
            element->sub_llsig        = $10;
            element->coerce_to        = $11;

            /* Also need to do fixups on the nominal type. */
            if (!PMC_IS_NULL($5)) {
                PMC *refined = VTABLE_getprop(interp, $5, Parrot_str_new(interp, "subtype_realtype", 0));
                if (PMC_IS_NULL(refined)) {
                    /* It's not some subtype, we're fine. */
                    element->nominal_type = $5;
                }
                else {
                    /* Need to break up into type and constraint. */
                    element->nominal_type = refined;
                    if (PMC_IS_NULL(element->post_constraints))
                        element->post_constraints = pmc_new(interp, enum_class_ResizablePMCArray);
                    VTABLE_push_pmc(interp, element->post_constraints, $5);
                }
            }
            else {
                element->nominal_type = Parrot_ns_find_namespace_global(interp, Parrot_get_ctx_HLL_namespace(interp),
                        Parrot_str_new(interp, "Mu", 0));
            }

            goto NEXT();
        }
        else {
            opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
                    EXCEPTION_INVALID_OPERATION, "signature element out of range in set_llsig_elem");
            goto ADDRESS(handler);
        }
    }
    else {
        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
                EXCEPTION_INVALID_OPERATION, "set_llsig_elem only works on P6LowLevelSig PMCs");
        goto ADDRESS(handler);
    }
}


/*

=item get_llsig_elem(in PMC, in INT, out STR, out INT, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC, out STR)

Takes $1 (a P6LowLevelSig) and sets the registers with the contents of the
signature element with index $2 as follows:

  $3  = lexical name to bind to
  $4  = flags
  $5  = main (nominal) type
  $6  = constraint type or junction of constraint types; null if none
  $7  = array of names for a named parameter
  $8  = array of type captures
  $9  = default value closure
  $10 = nested signature
  $11 = name of coercion method to call, if any

=cut

*/
inline op get_llsig_elem(in PMC, in INT, out STR, out INT, out PMC, out PMC, out PMC, out PMC, out PMC, out PMC, out STR) :base_core {
    if ($1->vtable->base_type == lls_id) {
        struct llsig_element **elements;
        INTVAL num_elements;

        /* Check we're not out of range. */
        GETATTR_P6LowLevelSig_elements(interp, $1, elements);
        GETATTR_P6LowLevelSig_num_elements(interp, $1, num_elements);
        if ($2 < num_elements) {
            struct llsig_element *element = elements[$2];
            $3  = element->variable_name;
            $4  = element->flags;
            $5  = element->nominal_type;
            $6  = element->post_constraints;
            $7  = element->named_names;
            $8  = element->type_captures;
            $9  = element->default_closure;
            $10 = element->sub_llsig;
            $11 = element->coerce_to;
            goto NEXT();
        }
        else {
            opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
                    EXCEPTION_INVALID_OPERATION, "signature element out of range in set_llsig_elem");
            goto ADDRESS(handler);
        }
    }
    else {
        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
                EXCEPTION_INVALID_OPERATION, "get_llsig_elem only works on P6LowLevelSig PMCs");
        goto ADDRESS(handler);
    }
}


/*

=item bind_llsig(in PMC, in PMC)

This is emitted into a sub to cause it's Perl 6 signature to be bound. $1 is
an array of positional arguments (obtained by using :flat) and $2 is a hash of
named arguments (obtained using :flat :slurpy). Eventually, after Parrot
refactors are complete, it will take one argument - the CallContext.

=cut

*/
inline op bind_llsig(in PMC) :base_core {
    PMC *ctx = CURRENT_CONTEXT(interp);

    /* If we aren't already bound, enter the appropriate binder. */
    if (!PObj_flag_TEST(P6S_ALREADY_BOUND, ctx)) {
        PMC *lexpad         = Parrot_pcc_get_lex_pad(interp, ctx);
        PMC *sub            = Parrot_pcc_get_sub(interp, ctx);
        PMC *llsig          = VTABLE_getprop(interp, sub, LLSIG_ATTR_str);
        INTVAL noms_checked = PObj_flag_TEST(P6S_ALREADY_CHECKED, ctx);
        STRING *error       = NULL;
        INTVAL bind_error;

        /* Need to make sure some stuff doesn't get destroyed. */
        PMC      * ctx               = CURRENT_CONTEXT(interp);
        PMC      * const saved_ccont = interp->current_cont;
        PMC      * const saved_sig   = Parrot_pcc_get_signature(interp, ctx);
        opcode_t * const current_pc  = Parrot_pcc_get_pc(interp, ctx);

        /* Ensure we actually have a signature; if not, try to lazily generate
         * it. */
        if (PMC_IS_NULL(llsig)) {
            PMC *sig_meth    = VTABLE_find_method(interp, sub, BANG_LLSIG_str);
            Parrot_ext_call(interp, sig_meth, "P->P", sub, &llsig);
        }

        /* Call signature binder. */
        bind_error = bind_llsig_func(interp, lexpad, llsig, $1, noms_checked, &error);

        /* Bind ok? */
        if (!bind_error) {
            /* Re-instate anything we may have damaged. */
            CURRENT_CONTEXT(interp) = ctx;
            interp->current_cont    = saved_ccont;
            Parrot_pcc_set_signature(interp, ctx, saved_sig);
            Parrot_pcc_set_pc(interp, ctx, current_pc);
            goto NEXT();
        }
        else {
            /* Maybe we need to auto-thread... */
            if (bind_error == BIND_RESULT_JUNCTION) {
                /* Find dispatcher and call it. */
                PMC *returns = Parrot_pmc_new(interp, enum_class_CallContext);
                PMC *dispatcher = Parrot_ns_find_namespace_global(interp, Parrot_get_ctx_HLL_namespace(interp), DISPATCH_JUNCTION_str);

                opcode_t *next;
                PMC *junc_result, *caller_sig;
                Parrot_ext_call(interp, dispatcher, "PP->P", sub, $1, &junc_result);

                /* Build call signautre of returns and set it. */
                VTABLE_push_pmc(interp, returns, junc_result);
                Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), returns);

                /* Invoke the current return continuation, to return said value. */
                next = VTABLE_invoke(interp, Parrot_pcc_get_continuation(interp,
                        CURRENT_CONTEXT(interp)), expr NEXT());
                goto ADDRESS(next);
            }
            else {
                /* Nope, just normal fail... */
                opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
                        EXCEPTION_INVALID_OPERATION, "%Ss", error);
                goto ADDRESS(handler);
            }
        }
    }
    else {
        goto NEXT();
    }
}


/*

=item x_setprophash(in PMC, in PMC)

Sets the properties hash of $1 to be $2.

=cut

*/
inline op x_setprophash(in PMC, in PMC) :base_core {
    PMC_metadata($1) = $2;
    goto NEXT();
}


/*

=item find_method_null_ok(out PMC, in PMC, in STR)

Like Parrot's find_method, but returns PMCNULL in $1 if $2 doesn't have a
method named $3 instead of throwing an exception.

=cut

*/
inline op find_method_null_ok(out PMC, in PMC, in STR) :base_core {
    $1 = VTABLE_find_method(interp, $2, $3);
    goto NEXT();
}


/*

=item fixup_outer_ctx(inout PMC)

=cut

*/
inline op fixup_outer_ctx(inout PMC) :base_core {
    PMC *cur_ctx = CURRENT_CONTEXT(interp);
    if ($1->vtable->base_type == enum_class_CallContext) {
        Parrot_pcc_set_outer_ctx(interp, $1, cur_ctx);
        goto NEXT();
    }
    else {
        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
                EXCEPTION_INVALID_OPERATION, "fixup_outer_ctx only valid on a context");
        goto ADDRESS(handler);
    }
}


/*

=item encodelocaltime(out INT, in PMC)

The inverse of C<decodelocaltime>.

=cut

*/
inline op encodelocaltime(out INT, in PMC) :base_core {
    struct tm tm;

    tm.tm_sec  = VTABLE_get_integer_keyed_int(interp, $2, 0);
    tm.tm_min  = VTABLE_get_integer_keyed_int(interp, $2, 1);
    tm.tm_hour = VTABLE_get_integer_keyed_int(interp, $2, 2);
    tm.tm_mday = VTABLE_get_integer_keyed_int(interp, $2, 3);
    tm.tm_mon  = VTABLE_get_integer_keyed_int(interp, $2, 4) - 1;
    tm.tm_year = VTABLE_get_integer_keyed_int(interp, $2, 5) - 1900;
    /* We needn't bother setting tm_wday or tm_yday, since mktime
    is required to ignore them. */
    tm.tm_isdst = VTABLE_get_integer_keyed_int(interp, $2, 8);

    $1 = mktime(&tm);
    goto NEXT();
}

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