continuation.pmc

/*
Copyright (C) 2001-2008, Parrot Foundation.
$Id$

=head1 NAME

src/pmc/continuation.pmc - Continuation PMC

=head1 DESCRIPTION

A C<Continuation> has a copy of the interpreter's context at the location where
the Continuation was constructed.  See the L<Glossary|docs/glossary.pod> for
more information.

=head2 Functions

=over 4

=cut

*/


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

/*

=back

=head2 Methods

=over 4

=cut

*/


/*
 * A Continuation (and RetContinuation, ExceptionHandler) has in its
 * context a pointer to the register frame, which contains active objects.
 * Additionally ct->current_cont has the continuation of the caller.
 * To avoid deep recursion during marking of nested subroutines, we
 * need the next_for_GC pointer in the pmc_ext area.
 */

pmclass Continuation need_ext {
    ATTR struct Parrot_cont *cont; /* the continuation struct */

/*

=item C<void init()>

Initializes the continuation.

=cut

*/

    VTABLE void init() {
        Parrot_Continuation_attributes *attrs =
            mem_allocate_zeroed_typed(Parrot_Continuation_attributes);
        PMC_data(SELF) = attrs;

        PMC_cont(SELF) = new_continuation(INTERP, NULL);
        PObj_custom_mark_destroy_SETALL(SELF);
        /* PANIC("don't do that"); */
        /*
         * Whenever we create a continuation, all return continuations
         * up the call chain may be reused due to invoking the
         * continuation. To avoid that all return continuations are
         * converted to true continuations.
         */
        invalidate_retc_context(INTERP, SELF);
    }

/*

=item C<void mark()>

Marks the continuation as live.

=cut

*/

    VTABLE void mark() {
        Parrot_cont *cc = PMC_cont(SELF);

        if (cc->to_ctx)
            mark_context(INTERP, cc->to_ctx);
        if (cc->from_ctx)
            mark_context(INTERP, cc->from_ctx);
    }

/*

=item C<void destroy()>

Destroys the continuation.

=cut

*/

    VTABLE void destroy() {
        Parrot_cont * const cc = PMC_cont(SELF);
        if (cc) {
#if CTX_LEAK_DEBUG
            if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
                fprintf(stderr,
                        "[destroy cont    %p, to_ctx %p, from_ctx %p]\n",
                        (void *)SELF, (void *)cc->to_ctx, (void *)cc->from_ctx);
            }

#endif
            if (cc->from_ctx)
                Parrot_free_context(interp, cc->from_ctx, 1);

            mem_sys_free(cc);
        }
        mem_sys_free(PMC_data(SELF));
        PMC_data(SELF) = NULL;
    }
/*

=item C<PMC *clone()>

Creates and returns a clone of the continuation.

=cut

*/

    VTABLE PMC *clone() {
        Parrot_cont * const cc_self = PMC_cont(SELF);
        Parrot_cont * const cc      = new_continuation(INTERP, cc_self);
        PMC         * const ret     = pmc_new(INTERP, enum_class_Continuation);

        PObj_custom_mark_destroy_SETALL(ret);
        cc->runloop_id = cc_self->runloop_id;
        PMC_cont(ret)  = cc;

        return ret;
    }

/*

=item C<PMC *set_pmc()>

Assign context.

=cut

*/
    VTABLE void set_pmc(PMC *src) {
        Parrot_cont * const cc_self = PMC_cont(SELF);
        Parrot_cont * const cc_src  = PMC_cont(src);

        STRUCT_COPY(cc_self, cc_src);
    }
/*

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

Sets the pointer to the return instruction.  Also captures the descriptor
address for any returned values.

=cut

*/

    VTABLE void set_pointer(void *value) {
        opcode_t    * const pos = (opcode_t *)value;
        Parrot_cont * const cc  = PMC_cont(SELF);

        cc->address       = (opcode_t *)value;
        cc->runloop_id    = INTERP->current_runloop_id;

        if (pos && (*pos == PARROT_OP_get_results_pc))
            cc->current_results = pos;
        else
            cc->current_results = NULL;
    }

/*

=item C<void *get_pointer()>

Returns the pointer to the return instruction.

=cut

*/

    VTABLE void *get_pointer() {
        return PMC_cont(SELF)->address;
    }
/*

=item C<INTVAL defined()>

=item C<INTVAL get_bool()>

Returns whether the subroutine is defined.

=cut

*/

    VTABLE INTVAL defined() {
        return PMC_cont(SELF)->address != NULL;
    }

    VTABLE INTVAL get_bool() {
        return PMC_cont(SELF)->address != NULL;
    }

/*

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

Restores the context of the interpreter and returns the branch
destination to continue execution.

=cut

*/

    VTABLE opcode_t *invoke(void *next) {
        Parrot_cont      *cc           = PMC_cont(SELF);
        Parrot_Context   *from_ctx     = CONTEXT(interp);
        Parrot_Context   *to_ctx       = cc->to_ctx;
        opcode_t         *pc           = cc->address;
        UNUSED(next)

        Parrot_continuation_check(interp, SELF, cc);
        Parrot_continuation_rewind_environment(interp, SELF, cc);

        /* pass args to where caller wants result */
        if (cc->current_results)
            to_ctx->current_results = cc->current_results;

        if (to_ctx->current_results && INTERP->current_args) {
            /*
             * the register pointer is already switched back
             * to the caller, therefore the registers of the
             * sub we are returning from aren't marked, if
             * inside argument passing a GC run is triggered
             * therefore we have to block GC
             */
            opcode_t *src_indexes  = interp->current_args;
            opcode_t *dest_indexes = to_ctx->current_results;
            interp->current_args   = NULL;

            Parrot_block_GC_mark(INTERP);
            parrot_pass_args(INTERP, from_ctx, to_ctx,
                             src_indexes, dest_indexes, PARROT_PASS_PARAMS);
            Parrot_unblock_GC_mark(INTERP);
        }

        /* switch segment */
        INTERP->current_args = NULL;

        if (INTERP->code != cc->seg)
            Parrot_switch_to_cs(INTERP, cc->seg, 1);

        return pc;
    }

/*

=item C<STRING *get_string()>

Experimental: return caller info as a STRING.

=cut

*/

    VTABLE STRING *get_string() {
        return Parrot_Context_infostr(INTERP, PMC_cont(SELF)->to_ctx);
    }

/*

=item C<PMC *caller()>

Experimental: return caller PMC or PMCNULL if none.

=cut

*/

    METHOD caller() {
        Parrot_cont *cc     = PMC_cont(SELF);
        PMC         *caller = cc->to_ctx->current_sub;
        Parrot_sub  *sub;

        PMC_get_sub(INTERP, caller, sub);
        if (!caller || !sub->seg)
            caller = PMCNULL;

        RETURN(PMC *caller);

    }
/*

=item C<PMC *continuation()>

Experimental: return continuation PMC of this Continuation or PMCNULL if none.

=cut

*/

    METHOD continuation() {
        Parrot_cont *cc   = PMC_cont(SELF);
        PMC         *cont = cc->to_ctx->current_cont;

        if (cont)
            RETURN(PMC *cont);

        RETURN(PMC *PMCNULL);
    }
}

/*

=back

=head1 HISTORY

Initial revision by sean 2002/08/04.

=cut

*/

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