/*
Copyright (C) 2001-2010, Parrot Foundation.
$Id: sub.pmc 48435 2010-08-12 19:37:47Z chromatic $

=head1 NAME

src/pmc/sub.pmc - Subroutine

=head1 DESCRIPTION

These are the vtable functions for the Sub (subroutine) base class

=head2 Functions

=over 4

=cut

*/

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

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

static void print_sub_name(PARROT_INTERP, ARGIN_NULLOK(PMC *sub))
        __attribute__nonnull__(1);

#define ASSERT_ARGS_print_sub_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
       PARROT_ASSERT_ARG(interp))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
/* HEADERIZER END: static */

/*

=item C<static void print_sub_name(PARROT_INTERP, PMC *sub)>

=cut

*/

static void
print_sub_name(PARROT_INTERP, ARGIN_NULLOK(PMC *sub))
{
    ASSERT_ARGS(print_sub_name)
    Interp * const tracer = (interp->pdb && interp->pdb->debugger)
                          ? interp->pdb->debugger
                          : interp;

    /* sub was located via globals */
    Parrot_io_eprintf(tracer, "# Calling sub '%Ss'\n# ",
        Parrot_full_sub_name(interp, sub));

    print_pbc_location(interp);
}

pmclass Sub auto_attrs provides invokable {
    ATTR PackFile_ByteCode *seg;        /* bytecode segment */
    ATTR size_t             start_offs; /* sub entry in ops from seg->base.data */
    ATTR size_t             end_offs;

    ATTR INTVAL             HLL_id;         /* see src/hll.c XXX or per segment? */
    ATTR PMC               *namespace_name; /* where this Sub is in - this is either
                                             * a String or a [Key] and describes
                                             * the relative path in the NameSpace
                                             */
    ATTR PMC               *namespace_stash; /* the actual hash, HLL::namespace */
    ATTR STRING            *name;            /* name of the sub */
    ATTR STRING            *method_name;     /* method name of the sub */
    ATTR STRING            *ns_entry_name;   /* ns entry name of the sub */
    ATTR STRING            *subid;           /* The ID of the sub. */
    ATTR INTVAL             vtable_index;    /* index in Parrot_vtable_slot_names */
    ATTR PMC               *multi_signature; /* list of types for MMD */
    ATTR UINTVAL            n_regs_used[4];  /* INSP in PBC */

    ATTR PMC               *lex_info;        /* LexInfo PMC */
    ATTR PMC               *outer_sub;       /* :outer for closures */
    ATTR PMC               *eval_pmc;        /* eval container / NULL */
    ATTR PMC               *ctx;             /* the context this sub is in */
    ATTR UINTVAL            comp_flags;      /* compile time and additional flags */
    ATTR Parrot_sub_arginfo *arg_info;       /* Argument counts and flags. */

    ATTR PMC               *outer_ctx;       /* outer context, if a closure */

/*

=item C<void init()>

Initializes the subroutine.

=cut

*/

    /*
     * Sub PMC's flags usage:
     * - private0 ... Coroutine flip/flop - C exception handler
     * - private1 ... _IS_OUTER - have to preserve context
     *                as some other sub has :outer(this)
     * - private2 ... tailcall invoked this Sub
     * - private3 ... pythonic coroutine generator flag
     * - private4 ... :main (originally @MAIN)
     * - private5 ... :load (originally @LOAD)
     * - private6 ... :immediate (originally @IMMEDIATE)
     * - private7 ... :postcomp (originally @POSTCOMP)
     *
     * see also the enum in include/parrot/sub.h
     */
    VTABLE void init() {
        Parrot_Sub_attributes * const attrs =
            PMC_data_typed(SELF, Parrot_Sub_attributes *);

        attrs->seg             = INTERP->code;
        attrs->outer_sub       = PMCNULL;
        attrs->multi_signature = PMCNULL;
        attrs->namespace_name  = PMCNULL;
        attrs->vtable_index    = -1;

        PObj_custom_mark_destroy_SETALL(SELF);
    }


/*

=item C<void init_pmc()>

Initializes the "detached" subroutine from passed Hash. "Detached" means that
surboutine is fully constructed but not attached to interpreter.

=cut

*/

    VTABLE void init_pmc(PMC* init) {
        Parrot_Sub_attributes * const attrs =
            PMC_data_typed(SELF, Parrot_Sub_attributes *);
        STRING *field = CONST_STRING(INTERP, "start_offs");

        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->start_offs = VTABLE_get_integer_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "end_offs");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->end_offs = VTABLE_get_integer_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "HLL_id");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->HLL_id = VTABLE_get_integer_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "namespace_name");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->namespace_name = VTABLE_get_pmc_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "namespace_stash");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->namespace_stash = VTABLE_get_pmc_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "name");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->name = VTABLE_get_string_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "method_name");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->method_name = VTABLE_get_string_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "ns_entry_name");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->ns_entry_name = VTABLE_get_string_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "subid");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->subid = VTABLE_get_string_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "vtable_index");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->vtable_index = VTABLE_get_integer_keyed_str(INTERP, init, field);
        else
            attrs->vtable_index = -1;

        field = CONST_STRING(INTERP, "multi_signature");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->multi_signature = VTABLE_get_pmc_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "lex_info");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->lex_info = VTABLE_get_pmc_keyed_str(INTERP, init, field);

        field = CONST_STRING(INTERP, "outer_sub");
        if (VTABLE_exists_keyed_str(INTERP, init, field))
            attrs->outer_sub = VTABLE_get_pmc_keyed_str(INTERP, init, field);

        /* comp_flags is actually UINTVAL */
        field = CONST_STRING(INTERP, "comp_flags");
        if (VTABLE_exists_keyed_str(INTERP, init, field)) {
            UINTVAL flags = (UINTVAL)VTABLE_get_integer_keyed_str(INTERP, init, field);
            /* Mask comp flags only */
            attrs->comp_flags = flags & SUB_COMP_FLAG_MASK;
        }

        /* In order to create Sub dynamicaly we have to set PObj flags */
        field = CONST_STRING(INTERP, "pf_flags");
        if (VTABLE_exists_keyed_str(INTERP, init, field)) {
            UINTVAL flags = (UINTVAL)VTABLE_get_integer_keyed_str(INTERP, init, field);
            /* Mask Sub specific flags only */
            PObj_get_FLAGS(SELF) |= flags & SUB_FLAG_PF_MASK;
        }

        field = CONST_STRING(INTERP, "n_regs_used");
        if (VTABLE_exists_keyed_str(INTERP, init, field)) {
            PMC * const tmp = VTABLE_get_pmc_keyed_str(INTERP, init, field);
            INTVAL i;
            for (i = 0; i < 4; ++i)
                attrs->n_regs_used[i] = VTABLE_get_integer_keyed_int(INTERP, tmp, i);
        }

        field = CONST_STRING(INTERP, "arg_info");
        if (VTABLE_exists_keyed_str(INTERP, init, field)) {
            PMC * const tmp = VTABLE_get_pmc_keyed_str(INTERP, init, field);
            /* Allocate structure to store argument information in. */
            attrs->arg_info = mem_gc_allocate_zeroed_typed(INTERP,
                    Parrot_sub_arginfo);
            /*
            Hash.get_integer_keyed_str return 0 if key doesn't exists.
            So, don't check existence of key, just use it.
            NB: Don't split line. CONST_STRING b0rked.
            */
            attrs->arg_info->pos_required = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_required"));
            attrs->arg_info->pos_optional = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_optional"));
            attrs->arg_info->pos_slurpy = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_slurpy"));
            attrs->arg_info->named_required = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_required"));
            attrs->arg_info->named_optional = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_optional"));
            attrs->arg_info->named_slurpy = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_slurpy"));
        }

        /* C<eval_pmc> and C<ctx> are not handled here, and shouldn't be,
         * because of run-time nature.  */

        PObj_custom_mark_destroy_SETALL(SELF);
    }


/*

=item C<void destroy()>

Destroys the subroutine.

=cut

*/

    VTABLE void destroy() {
        Parrot_Sub_attributes * const sub = PARROT_SUB(SELF);

        if (sub && sub->arg_info)
            mem_gc_free(INTERP, sub->arg_info);
    }


/*

=item C<STRING *get_string()>

Returns the name of the subroutine.

=item C<void set_string_native(STRING *subname)>

Sets the name of the subroutine.

=cut

*/

    VTABLE STRING *get_string() {
        STRING *name;
        GET_ATTR_name(INTERP, SELF, name);
        return name;
    }


    VTABLE void set_string_native(STRING *subname) {
        SET_ATTR_name(INTERP, SELF, subname);
    }


/*

=item C<void set_pointer(void *value)>

Sets the pointer to the actual subroutine.

*** Don't use that - use C<.const 'Sub'> in PIR instead ***

=cut

*/

    VTABLE void set_pointer(void *value) {
        UNUSED(value)
        Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
            "Don't set the address of a sub\nuse .const 'Sub' instead");
    }


/*

=item C<void *get_pointer()>

Returns the address of the actual subroutine.

=cut

*/

    VTABLE void *get_pointer() {
        Parrot_Sub_attributes *sub;
        PMC_get_sub(INTERP, SELF, sub);
        return sub->seg->base.data + sub->start_offs;
    }


/*

=item C<INTVAL get_integer_keyed(PMC *key)>

I<This just unconditionally returns the start of bytecode. It's wrong,
wrong, wrong, *WRONG*. And there's no other good way, so it's here for
now.> -DRS

=cut

*/

    VTABLE INTVAL get_integer_keyed(PMC *key) {
        Parrot_Sub_attributes *sub;
        UNUSED(key)
        PMC_get_sub(INTERP, SELF, sub);

        return (INTVAL) (sub->seg->base.data);
    }


/*

=item C<INTVAL defined()>

=item C<INTVAL get_bool()>

Returns True.

=cut

*/

    VTABLE INTVAL defined() {
        return 1;
    }

    VTABLE INTVAL get_bool() {
        return 1;
    }


/*

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

Invokes the subroutine.

=cut

*/

    VTABLE opcode_t *invoke(void *next) {
        PMC * const caller_ctx = CURRENT_CONTEXT(INTERP);
        PMC *ccont      = INTERP->current_cont;
        PMC *object;

        /* plain subroutine call
         * create new context, place it in interpreter */
        PMC *context    = Parrot_pcc_get_signature(INTERP, caller_ctx);

        Parrot_Sub_attributes *sub;
        opcode_t              *pc;

        PMC_get_sub(INTERP, SELF, sub);
        if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
            print_sub_name(INTERP, SELF);

        /*
         * A remark WRT tail calls
         *
         * we have:
         * sub A:
         *    ...
         *    B()
         *    ...
         * sub B:
         *    ...
         *    .return C(...)
         *
         * that is the sub B() returns whatever C() returns.
         *
         * We are just calling the sub C().
         * If the private2 flag is set, this code is called by a
         * tailcall opcode.
         *
         * We allocate a new register frame and recycle it
         * immediately after argument passing.
         *
         */
        pc                   = sub->seg->base.data + sub->start_offs;
        INTERP->current_cont = NULL;

        if (ccont == NEED_CONTINUATION) {
            ccont = pmc_new(INTERP, enum_class_Continuation);
            VTABLE_set_pointer(INTERP, ccont, next);
        }

        PARROT_ASSERT(!PMC_IS_NULL(ccont));

        if (PMC_IS_NULL(context))
            context = Parrot_pmc_new(INTERP, enum_class_CallContext);

        CURRENT_CONTEXT(INTERP) = context;
        Parrot_pcc_set_caller_ctx(INTERP, context, caller_ctx);
        Parrot_pcc_allocate_registers(INTERP, context, sub->n_regs_used);
        /* Preserve object */
        object = Parrot_pcc_get_object(INTERP, context);
        Parrot_pcc_init_context(INTERP, context, caller_ctx);
        Parrot_pcc_set_object(INTERP, context, object);

        Parrot_pcc_set_sub(INTERP, context, SELF);
        Parrot_pcc_set_continuation(INTERP, context, ccont);
        Parrot_pcc_set_constants(INTERP, context, sub->seg->const_table->constants);

        /* check recursion/call depth */
        if (Parrot_pcc_inc_recursion_depth(INTERP, context) > INTERP->recursion_limit)
            Parrot_ex_throw_from_c_args(INTERP, next, CONTROL_ERROR,
                    "maximum recursion depth exceeded");

        /* and copy set context variables */
        PARROT_CONTINUATION(ccont)->from_ctx = context;

        /* if this is an outer sub, then we need to set sub->ctx
         * to the new context (refcounted) */
        if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER) {
            sub->ctx = context;
        }

        /* create pad if needed
         * TODO move this up in front of argument passing
         *      and factor out common code with coroutine pmc
         */
        if (!PMC_IS_NULL(sub->lex_info)) {
            Parrot_pcc_set_lex_pad(INTERP, context, Parrot_pmc_new_init(INTERP,
                    Parrot_get_ctx_HLL_type(INTERP, enum_class_LexPad),
                    sub->lex_info));
            VTABLE_set_pointer(INTERP, Parrot_pcc_get_lex_pad(INTERP, context), context);
        }

        /* set outer context */
        if (!PMC_IS_NULL(sub->outer_ctx))
            Parrot_pcc_set_outer_ctx(INTERP, context, sub->outer_ctx);
        else {
            /* autoclose */
            PMC *c       = context;
            PMC *outer_c = Parrot_pcc_get_outer_ctx(INTERP, c);

            for (c = context; PMC_IS_NULL(outer_c); c = outer_c) {

                PMC *outer_pmc;
                Parrot_Sub_attributes *current_sub, *outer_sub;

                PMC_get_sub(INTERP, Parrot_pcc_get_sub(INTERP, c), current_sub);
                outer_pmc   = current_sub->outer_sub;

                if (PMC_IS_NULL(outer_pmc))
                    break;

                PMC_get_sub(INTERP, outer_pmc, outer_sub);

                if (PMC_IS_NULL(outer_sub->ctx)) {
                    PMC * const dummy = Parrot_alloc_context(INTERP,
                                                outer_sub->n_regs_used, NULL);
                    Parrot_pcc_set_sub(INTERP, dummy, outer_pmc);

                    if (!PMC_IS_NULL(outer_sub->lex_info)) {
                        Parrot_pcc_set_lex_pad(INTERP, dummy,
                            Parrot_pmc_new_init(INTERP,
                                Parrot_get_ctx_HLL_type(INTERP,
                                    enum_class_LexPad), outer_sub->lex_info));

                        VTABLE_set_pointer(INTERP,
                            Parrot_pcc_get_lex_pad(INTERP, dummy), dummy);
                    }

                    if (!PMC_IS_NULL(outer_sub->outer_ctx))
                        Parrot_pcc_set_outer_ctx(INTERP, dummy,
                            outer_sub->outer_ctx);

                    outer_sub->ctx = dummy;
                }

                Parrot_pcc_set_outer_ctx(INTERP, c, outer_sub->ctx);
                outer_c = outer_sub->ctx;
            }
        }

        /* switch code segment if needed */
        if (INTERP->code != sub->seg)
            Parrot_switch_to_cs(INTERP, sub->seg, 1);

        return pc;
    }


/*

=item C<PMC *clone()>

Creates and returns a clone of the subroutine.

=cut

*/

    VTABLE PMC *clone() {
        PMC * const ret = Parrot_pmc_new(INTERP, SELF->vtable->base_type);

        Parrot_Sub_attributes *dest_sub;
        Parrot_Sub_attributes *sub;

        /* XXX Why? */
        /* we have to mark it ourselves */
        PObj_custom_mark_destroy_SETALL(ret);

        PMC_get_sub(INTERP, SELF, dest_sub);
        PMC_get_sub(INTERP, ret, sub);

        /* first set the sub struct, Parrot_str_copy may cause GC */
        *sub = *dest_sub;

        /* Be sure not to share arg_info. */
        dest_sub->arg_info = NULL;

        return ret;
    }


/*

=item C<void assign_pmc(PMC *other)>

Set SELF to the data in other.

=cut

*/

    VTABLE void set_pmc(PMC *other) {
        SELF.assign_pmc(other);
    }

    VTABLE void assign_pmc(PMC *other) {
        /* only handle the case where the other PMC is the same type */
        if (other->vtable->base_type == SELF->vtable->base_type) {
            Parrot_Sub_attributes *my_sub;
            Parrot_Sub_attributes *other_sub;

            PMC_get_sub(INTERP, SELF, my_sub);
            PMC_get_sub(INTERP, other, other_sub);

            /* copy the sub struct */
            memmove(my_sub, other_sub, sizeof (Parrot_Sub_attributes));
        }
        else
            Parrot_ex_throw_from_c_args(INTERP, NULL,
                EXCEPTION_INVALID_OPERATION,
                "Can't assign a non-Sub type to a Sub");
    }


/*

=item C<void mark()>

Marks the sub as live.

=cut

*/

    VTABLE void mark() {
        Parrot_Sub_attributes * const sub = PARROT_SUB(SELF);

        if (!sub)
            return;

        Parrot_gc_mark_STRING_alive(INTERP, sub->name);
        Parrot_gc_mark_STRING_alive(INTERP, sub->subid);
        Parrot_gc_mark_STRING_alive(INTERP, sub->method_name);
        Parrot_gc_mark_STRING_alive(INTERP, sub->ns_entry_name);

        Parrot_gc_mark_PMC_alive(INTERP, sub->ctx);
        Parrot_gc_mark_PMC_alive(INTERP, sub->eval_pmc);
        Parrot_gc_mark_PMC_alive(INTERP, sub->lex_info);
        Parrot_gc_mark_PMC_alive(INTERP, sub->outer_ctx);
        Parrot_gc_mark_PMC_alive(INTERP, sub->outer_sub);
        Parrot_gc_mark_PMC_alive(INTERP, sub->namespace_name);
        Parrot_gc_mark_PMC_alive(INTERP, sub->multi_signature);
        Parrot_gc_mark_PMC_alive(INTERP, sub->namespace_stash);
    }

/*

=item C<INTVAL is_equal(PMC *value)>

Returns whether the two subroutines are equal.

=cut

*/

    MULTI INTVAL is_equal(PMC *value) {
        Parrot_Sub_attributes *my_sub, *value_sub;

        PMC_get_sub(INTERP, SELF, my_sub);
        PMC_get_sub(INTERP, value, value_sub);

        return SELF->vtable         == value->vtable
        &&     (my_sub)->start_offs == (value_sub)->start_offs
        &&     (my_sub)->seg        == (value_sub)->seg;
    }


/*

=item C<void visit(PMC *info)>

This is used by freeze/thaw to visit the contents of the sub.

=item C<void freeze(PMC *info)>

Archives the subroutine.

=cut

*/

    VTABLE void visit(PMC *info) {
        VISIT_PMC_ATTR(INTERP, info, SELF, Sub, namespace_name);
        VISIT_PMC_ATTR(INTERP, info, SELF, Sub, multi_signature);
        VISIT_PMC_ATTR(INTERP, info, SELF, Sub, outer_sub);

        /*
         * XXX visit_pmc_now is wrong, because it breaks
         *     depth-first visit inside the todo list
         * TODO change all user visit functions to use
         *    visit_pmc (the todo renamed visit_pm_later)
         *
         * Therefore the hash must be last during visit for now.
         */
        VISIT_PMC_ATTR(INTERP, info, SELF, Sub, lex_info);

        SUPER(info);
    }


    VTABLE void freeze(PMC *info) {
        Parrot_Sub_attributes *sub;
        STRING                *hll_name;
        int i;

        SUPER(info);
        PMC_get_sub(INTERP, SELF, sub);
        /*
         * we currently need to write these items:
         * - start offset in byte-code segment
         * - end   offset in byte-code segment
         * - segment TODO ???
         * - flags  (i.e. :load pragma and such)
         * - name of the sub's label
         * - method name
         * - ns entry name
         * - namespace
         * - HLL_id
         * - multi_signature
         * - n_regs_used[i]
         * - lex_info
         * - vtable_index
         * - subid
         */

        VTABLE_push_integer(INTERP, info, (INTVAL) sub->start_offs);
        VTABLE_push_integer(INTERP, info, (INTVAL) sub->end_offs);
        VTABLE_push_integer(INTERP, info,
            (INTVAL)(PObj_get_FLAGS(SELF) & SUB_FLAG_PF_MASK));

        VTABLE_push_string(INTERP, info, sub->name);

        if (!sub->method_name)
            sub->method_name = CONST_STRING(INTERP, "");
        VTABLE_push_string(INTERP, info, sub->method_name);

        if (!sub->ns_entry_name)
            sub->ns_entry_name = CONST_STRING(INTERP, "");
        VTABLE_push_string(INTERP, info, sub->ns_entry_name);

        hll_name = Parrot_get_HLL_name(INTERP, sub->HLL_id);
        if (!hll_name)
            hll_name = CONST_STRING(INTERP, "");
        VTABLE_push_string(INTERP, info, hll_name);

        VTABLE_push_integer(INTERP, info, (INTVAL)sub->comp_flags);
        VTABLE_push_integer(INTERP, info, sub->vtable_index);

        for (i = 0; i < 4; ++i)
            VTABLE_push_integer(INTERP, info, sub->n_regs_used[i]);

        if (!sub->subid)
            sub->subid = CONST_STRING(INTERP, "");

        VTABLE_push_string(INTERP, info, sub->subid);
    }


/*

=item C<void thaw(PMC *info)>

Unarchives the subroutine.

=cut

*/

    VTABLE void thaw(PMC *info) {
        Parrot_Sub_attributes *sub;
        INTVAL flags;
        int    i;

        SUPER(info);

        PMC_get_sub(INTERP, SELF, sub);

        /* we get relative offsets */
        sub->start_offs   = (size_t) VTABLE_shift_integer(INTERP, info);
        sub->end_offs     = (size_t) VTABLE_shift_integer(INTERP, info);
        flags             = VTABLE_shift_integer(INTERP, info);

        PObj_get_FLAGS(SELF) |= flags & SUB_FLAG_PF_MASK;

        sub->name           = VTABLE_shift_string(INTERP, info);
        sub->method_name    = VTABLE_shift_string(INTERP, info);
        sub->ns_entry_name  = VTABLE_shift_string(INTERP, info);
        sub->HLL_id         = Parrot_get_HLL_id(INTERP,
            VTABLE_shift_string(INTERP, info));
        sub->comp_flags     = VTABLE_shift_integer(INTERP, info);
        sub->vtable_index   = VTABLE_shift_integer(INTERP, info);

        for (i = 0; i < 4; ++i)
            sub->n_regs_used[i] = VTABLE_shift_integer(INTERP, info);

        sub->subid        = VTABLE_shift_string(INTERP, info);
    }


/*

=item C<PMC *inspect()>

Returns the full set of meta-data about the sub.

=cut

*/

    VTABLE PMC *inspect()
    {
        /* Create a hash, then use inspect_str to get all of its data */

        PMC    * const metadata           = Parrot_pmc_new(INTERP, enum_class_Hash);
        STRING * const pos_required_str   = CONST_STRING(INTERP, "pos_required");
        STRING * const pos_optional_str   = CONST_STRING(INTERP, "pos_optional");
        STRING * const named_required_str = CONST_STRING(INTERP, "named_required");
        STRING * const named_optional_str = CONST_STRING(INTERP, "named_optional");
        STRING * const pos_slurpy_str     = CONST_STRING(INTERP, "pos_slurpy");
        STRING * const named_slurpy_str   = CONST_STRING(INTERP, "named_slurpy");

        VTABLE_set_pmc_keyed_str(INTERP, metadata, pos_required_str,
            VTABLE_inspect_str(INTERP, SELF, pos_required_str));

        VTABLE_set_pmc_keyed_str(INTERP, metadata, pos_optional_str,
            VTABLE_inspect_str(INTERP, SELF, pos_optional_str));

        VTABLE_set_pmc_keyed_str(INTERP, metadata, named_required_str,
            VTABLE_inspect_str(INTERP, SELF, named_required_str));

        VTABLE_set_pmc_keyed_str(INTERP, metadata, named_optional_str,
            VTABLE_inspect_str(INTERP, SELF, named_optional_str));

        VTABLE_set_pmc_keyed_str(INTERP, metadata, pos_slurpy_str,
            VTABLE_inspect_str(INTERP, SELF, pos_slurpy_str));

        VTABLE_set_pmc_keyed_str(INTERP, metadata, named_slurpy_str,
            VTABLE_inspect_str(INTERP, SELF, named_slurpy_str));

        return metadata;
    }


/*

=item C<PMC *inspect_str(STRING *what)>

Returns the specified item of metadata about the sub. Allowable
values are:

=over 4

=item pos_required

The number of required positional arguments

=item pos_optional

The number of optional positional arguments

=item named_required

The number of required named arguments

=item named_optional

The number of optional named arguments

=item pos_slurpy

1 if it takes slurpy positional arguments, 0 if not

=item named_slurpy

1 if it takes slurpy named arguments, 0 if not

=back

=cut

*/

    VTABLE PMC *inspect_str(STRING *what)
    {
        Parrot_Sub_attributes *sub;
        PMC                   *retval;
        INTVAL                 count_found = -1;

        PMC_get_sub(INTERP, SELF, sub);

        /* If the argument info hasn't been generated yet, generate it. */
        if (!sub->arg_info) {
            /* Get pointer into the bytecode where this sub starts. */
            const opcode_t *pc = sub->seg->base.data + sub->start_offs;

            /* Allocate structure to store argument information in. */
            sub->arg_info = mem_gc_allocate_zeroed_typed(INTERP,
                    Parrot_sub_arginfo);

            /* If the first instruction is a get_params... */
            if (sub->seg->op_func_table[*pc]
                == interp->op_func_table[PARROT_OP_get_params_pc]) {
                /* Get the signature (the next thing in the bytecode). */
                PMC * const sig = PF_CONST(sub->seg, *(++pc)).u.key;

                /* Iterate over the signature and compute argument counts. */
                const INTVAL sig_length = VTABLE_elements(INTERP, sig);
                int     i;

                ASSERT_SIG_PMC(sig);

                for (i = 0; i < sig_length; ++i) {
                    int sig_item = VTABLE_get_integer_keyed_int(INTERP, sig, i);
                    if (PARROT_ARG_SLURPY_ARRAY_ISSET(sig_item)){
                        if (PARROT_ARG_NAME_ISSET(sig_item))
                            sub->arg_info->named_slurpy = 1;
                        else
                            sub->arg_info->pos_slurpy = 1;
                    }
                    else if (PARROT_ARG_NAME_ISSET(sig_item)) {
                        ++i;
                        sig_item = VTABLE_get_integer_keyed_int(INTERP, sig, i);
                        if (PARROT_ARG_OPTIONAL_ISSET(sig_item))
                            ++sub->arg_info->named_optional;
                        else
                            ++sub->arg_info->named_required;
                    }
                    else if (!PARROT_ARG_OPT_FLAG_ISSET(sig_item)) {
                        if (PARROT_ARG_OPTIONAL_ISSET(sig_item))
                            ++sub->arg_info->pos_optional;
                        else
                            ++sub->arg_info->pos_required;
                    }
                }
            }
        }

        /* Return the requested argument information */
        if (Parrot_str_equal(INTERP, what, CONST_STRING(INTERP, "pos_required"))) {
            count_found = (INTVAL)sub->arg_info->pos_required;
        }
        else if (Parrot_str_equal(INTERP, what, CONST_STRING(INTERP, "pos_optional"))) {
            count_found = (INTVAL)sub->arg_info->pos_optional;
        }
        else if (Parrot_str_equal(INTERP, what, CONST_STRING(INTERP, "pos_slurpy"))) {
            count_found = (INTVAL)sub->arg_info->pos_slurpy;
        }
        else if (Parrot_str_equal(INTERP, what, CONST_STRING(INTERP, "named_required"))) {
            count_found = (INTVAL)sub->arg_info->named_required;
        }
        else if (Parrot_str_equal(INTERP, what, CONST_STRING(INTERP, "named_optional"))) {
            count_found = (INTVAL)sub->arg_info->named_optional;
        }
        else if (Parrot_str_equal(INTERP, what, CONST_STRING(INTERP, "named_slurpy"))) {
            count_found = (INTVAL)sub->arg_info->named_slurpy;
        }
        else
            Parrot_ex_throw_from_c_args(INTERP, NULL,
                EXCEPTION_INVALID_OPERATION,
                "Unknown introspection value '%S'", what);

        retval = Parrot_pmc_new_init_int(INTERP, enum_class_Integer, count_found);
        return retval;
    }


/*

=back

=head2 METHODS

=over 4

=item C<INTVAL start_offs()>

Returns the start offset of the Sub.

=item C<INTVAL end_offs()>

Returns the end offset of the Sub.

=item C<PMC *get_namespace()>

Returns the namespace PMC, where the Sub is defined.

TODO return C<namespace_stash> instead.

=item C<INTVAL __get_regs_used(char *kind)>

Returns the number of used registers for register kinds "I", "S", "P", "N".

=item C<PMC *get_lexinfo()>

Returns the LexInfo PMC, if any or a Null PMC.

=item C<PMC *get_multisig()>

Returns the MMD signature PMC, if any, or a Null PMC.

=item C<PMC *get_outer()>

Gets the sub that is the outer of this one, if any, or a Null PMC.

=item C<void set_outer(PMC *outer)>

Sets the sub that is the outer of this one.

=item C<void set_outer_ctx(PMC *outer_ctx)>

Set the outer context to be used on the next invocation of this sub.

=item C<INTVAL arity()>

Returns the arity of the Sub (the number of arguments, excluding optional and
slurpy arguments).

=cut

*/
    METHOD start_offs() {
        Parrot_Sub_attributes  *sub;
        INTVAL                  start_offs;

        PMC_get_sub(INTERP, SELF, sub);
        start_offs = sub->start_offs;
        RETURN(INTVAL start_offs);
    }


    METHOD end_offs() {
        Parrot_Sub_attributes  *sub;
        INTVAL                  end_offs;
        PMC_get_sub(INTERP, SELF, sub);
        end_offs = sub->end_offs;
        RETURN(INTVAL end_offs);
    }


    METHOD get_namespace() {
        PMC                   *_namespace;
        Parrot_Sub_attributes *sub;

        PMC_get_sub(INTERP, SELF, sub);
        /*
        XXX Rakudo's failing with with this code on ASSERT. Why???
        GET_ATTR_namespace_stash(INTERP, SELF, _namespace);
        PARROT_ASSERT(_namespace == sub->namespace_stash || !"consistency!!!");
        */
        _namespace = sub->namespace_stash;
        RETURN(PMC *_namespace);
    }


    METHOD __get_regs_used(STRING *reg) {
        /* TODO switch to canonical NiSP order
         * see also imcc/reg_alloc.c */
        STRING                * const types = CONST_STRING(INTERP, "INSP");
        Parrot_Sub_attributes *sub;
        INTVAL                 regs_used;
        INTVAL                 kind;

        PMC_get_sub(INTERP, SELF, sub);
        PARROT_ASSERT(sub->n_regs_used);

        if (!reg || Parrot_str_length(INTERP, reg) != 1)
            Parrot_ex_throw_from_c_args(INTERP, NULL,
                EXCEPTION_INVALID_OPERATION,
                "illegal register kind '%Ss'", reg);

        kind = Parrot_str_find_index(INTERP, types, reg, 0);

        if (kind == -1)
            Parrot_ex_throw_from_c_args(INTERP, NULL,
               EXCEPTION_INVALID_OPERATION, "illegal register kind '%Ss'", reg);

        regs_used = sub->n_regs_used[kind];
        RETURN(INTVAL regs_used);
    }


    METHOD get_lexinfo() {
        PMC                   *lexinfo;
        Parrot_Sub_attributes *sub;
        PMC_get_sub(INTERP, SELF, sub);

        lexinfo = sub->lex_info ? sub->lex_info : PMCNULL;

        RETURN(PMC *lexinfo);
    }


    METHOD get_subid() {
        STRING                *subid;
        Parrot_Sub_attributes *sub;
        PMC_get_sub(INTERP, SELF, sub);

        subid = sub->subid ? sub->subid : CONST_STRING(INTERP, "");

        RETURN(STRING *subid);
    }


    METHOD get_outer() {
        PMC                   *outersub;
        Parrot_Sub_attributes *sub;
        PMC_get_sub(INTERP, SELF, sub);

        outersub = sub->outer_sub ? sub->outer_sub : PMCNULL;

        RETURN(PMC *outersub);
    }


    METHOD set_outer(PMC *outer) {
        /* Set outer sub. */
        Parrot_Sub_attributes *sub;
        PMC                   *outer_ctx;
        PMC_get_sub(INTERP, SELF, sub);

        sub->outer_sub = outer;

        /* Make sure outer flag of that sub is set. */
        PObj_get_FLAGS(outer) |= SUB_FLAG_IS_OUTER;

        /* Ensure we have lex info. */
        if (PMC_IS_NULL(sub->lex_info)) {
            const INTVAL lex_info_id = Parrot_get_ctx_HLL_type(INTERP,
                                           enum_class_LexInfo);
            sub->lex_info = Parrot_pmc_new_init(INTERP, lex_info_id, SELF);
        }

        /* Clear any existing outer context */
        sub->outer_ctx = PMCNULL;

        /* If we've got a context around for the outer sub, set it as the
         * outer context. */
        outer_ctx = CURRENT_CONTEXT(INTERP);

        while (!PMC_IS_NULL(outer_ctx)) {
            if (Parrot_pcc_get_sub(INTERP, outer_ctx) == outer) {
                sub->outer_ctx = outer_ctx;
                break;
            }
            outer_ctx = Parrot_pcc_get_caller_ctx(INTERP, outer_ctx);
        }
    }


    METHOD set_outer_ctx(PMC *outer_ctx) {
        Parrot_Sub_attributes *sub;
        PMC_get_sub(INTERP, SELF, sub);
        sub->outer_ctx = outer_ctx;
    }


    METHOD get_multisig() {
        PMC                   *multisig;
        Parrot_Sub_attributes *sub;
        PMC_get_sub(INTERP, SELF, sub);

        multisig = sub->multi_signature ? sub->multi_signature : PMCNULL;

        RETURN(PMC *multisig);
    }


    METHOD arity() {
        PMC * const pos_required   = VTABLE_inspect_str(INTERP, SELF, CONST_STRING(INTERP, "pos_required"));
        PMC * const named_required = VTABLE_inspect_str(INTERP, SELF, CONST_STRING(INTERP, "named_required"));

        const INTVAL arity = VTABLE_get_integer(INTERP, pos_required)
                           + VTABLE_get_integer(INTERP, named_required);

        RETURN(INTVAL arity);
    }

/*
=item C<INTVAL comp_flags()>

=item C<INTVAL pf_flags()>

(Experimental) Returns Sub flags.

=back

=cut

*/
    METHOD comp_flags() {
        Parrot_Sub_attributes  *sub;
        INTVAL                  flags;

        PMC_get_sub(INTERP, SELF, sub);
        flags = sub->comp_flags;
        RETURN(INTVAL flags);
    }

    METHOD pf_flags() {
        /* Only PF specific flags */
        INTVAL  flags = PObj_get_FLAGS(SELF) & SUB_FLAG_PF_MASK;
        RETURN(INTVAL flags);
    }

}


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