/*
Copyright (C) 2001-2003, The Perl Foundation.
$Id: retcontinuation.pmc 16275 2006-12-28 01:20:44Z particle $

=head1 NAME

src/pmc/retcontinuation.pmc - Return Continuation

=head1 DESCRIPTION

C<RetContinuation> extends C<Continuation>.

A return continuation is a one shot Continuation, it gets recycled
immediately after invocation.

=head2 Methods

=over 4

=cut

*/

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


pmclass RetContinuation extends Continuation need_ext {

/*

=item C<void init()>

Initializes the continuation.

=cut

*/

    void init() {
        PMC_struct_val(SELF) = new_ret_continuation(INTERP);
        PMC_pmc_val(SELF) = NULL;
        PObj_custom_mark_destroy_SETALL(SELF);
    }

    /*
     * XXX when reusing SUPER.destroy() RetContinuations
     *     have to set ref_count initially to 1
     */

    void destroy() {
        struct Parrot_cont * cc = PMC_cont(SELF);
        if (cc) {
            mem_sys_free(cc);
            PMC_struct_val(SELF) = NULL;
        }
    }
/*

=item C<PMC* clone>

Return a new Continuation PMC with the context of SELF. Note: the
returned object is not a RetContinuation and creating a real
Continuation invalidates all RetContinuation all the way up the call
chain that is, these can't be recycled, they get persistent until
the GC gets at them.

=cut

*/
    PMC* clone() {
        invalidate_retc_context(INTERP, SELF);
        return SUPER();
    }
/*

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

Transfers control to the calling context, and frees the current context.

=cut

*/

    void* invoke(void* next) {
        struct Parrot_cont * cc = PMC_cont(SELF);
        parrot_context_t *from_ctx = cc->from_ctx;
        struct PackFile_ByteCode * const seg = cc->seg;

        next = SUPER(next);
        Parrot_free_context(INTERP, from_ctx, 1);
#ifdef NDEBUG
        /* the continuation is dead - delete and destroy it */
        mem_sys_free(cc);
        {
            struct Arenas *arena_base = interp->arena_base;
            struct Small_Object_Pool *pool, *ext_pool =
                arena_base->pmc_ext_pool;
            ext_pool->add_free_object(interp, ext_pool,
                    SELF->pmc_ext);
            PObj_flags_SETTO((PObj *)SELF, PObj_on_free_list_FLAG);
            pool = arena_base->pmc_pool;
            pool->add_free_object(interp, pool, SELF);
            pool->num_free_objects ++;
        }
#else
        cc->from_ctx = NULL;
        /*
         * the to_ctx is marked in Continuation.mark
         * NULLify it or turn off the custom_mark bit
         */
        cc->to_ctx = NULL;
#endif
        if (INTERP->code != seg) {
            Parrot_switch_to_cs(INTERP, seg, 1);
        }
        return next;
    }

}

/*

=back

=head1 HISTORY

Initial revision by sean 2002/08/04.

=cut

*/

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