exception_handler.pmc

/*
Copyright (C) 2001-2007, The Perl Foundation.
$Id$

=head1 NAME

src/pmc/exception_handler.pmc - Exception Handler PMC

=head1 DESCRIPTION

When an exception handler is called, the exception object is passed as
C<REG_PMC(interp, 5)>, the original contents of this register is in the
exception object's C<_P5> attribute.

=head2 Methods

=over 4

=cut

*/

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

static opcode_t *
pass_exception_args(PARROT_INTERP, const char *sig,
        opcode_t *dest, parrot_context_t * old_ctx, ...)
{
    va_list   ap;
    opcode_t *next;

    va_start(ap, old_ctx);
    next = parrot_pass_args_fromc(interp, sig, dest, old_ctx, ap);
    va_end(ap);

    return next;
}

pmclass Exception_Handler extends Continuation need_ext {

/*

=item C<void init()>

Initializes the exception handler.

=cut

*/

    VTABLE void init() {
        PMC_struct_val(SELF) = new_continuation(INTERP, NULL);
        PMC_pmc_val(SELF)    = PMCNULL;

        /* an exception handler has no separate context; it's only a snapshot
         * of an "earlier" context, which is contained in the interpreter's
         * context - the stacks can only be deeper in the interpreter - so no
         * mark of context is needed */
        PObj_active_destroy_SET(SELF);
    }

    /*
     * can't reuse Continuation's destroy yet -
     * RT#46703 fix ref_count handling for exception_handlers first
     *
     * An Exception_Handler is kind of a limited Continuation
     * (can only call 'up the stack').  Therefore we probably don't
     * have to convert all RetContinuations to real Continuations
     */

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

        if (cc) {
            mem_sys_free(cc);
            PMC_struct_val(SELF) = NULL;
        }
    }

    VTABLE PMC *clone() {
        PMC * const result = SUPER();
        PObj_custom_mark_CLEAR(result);
        return result;
    }

    VTABLE opcode_t *invoke(void *ex) {
        Parrot_cont        *cc        = PMC_cont(SELF);
        PMC                *exception = (PMC *)ex;
        opcode_t           *next      = NULL;
        parrot_context_t   *ex_ctx;
        opcode_t           *results;

        /* COMPAT:  PMC *p5 = REG_PMC(interp, 5);*/

        PARROT_ASSERT(cc->to_ctx == cc->from_ctx);
        results = cc->current_results;

        /* clear all results, so that continuation.invoke
         * doesn't pass any args #' */
        cc->to_ctx->current_results = cc->current_results = NULL;
        ex_ctx                      = CONTEXT(INTERP->ctx);
        next                        = SUPER(next);

        if (results) {
            STRING *message = VTABLE_get_string_keyed_int(INTERP,
                    exception, 0);
            PARROT_ASSERT(next == results);
            next            = pass_exception_args(interp, "PS", next,
                                                  ex_ctx, exception, message);
        }

        return next;
    }
}

/*

=back

=head1 HISTORY

Initial revision by leo 2003.07.10.

=cut

*/

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