Skip to content
This repository
tree: 0ae5d55426
Fetching contributors…

Cannot retrieve contributors at this time

file 129 lines (101 sloc) 2.963 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
/*
Copyright (C) 2001-2003, 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(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(Interp *interp, const char *sig,
        opcode_t *dest, parrot_context_t * old_ctx, ...)
{
    va_list ap;
    void *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

*/

    void init() {
        PMC_struct_val(SELF) = new_continuation(INTERP, NULL);
        PMC_pmc_val(SELF) = NULL;
        /*
         * an exception handler has no separate context, its
         * 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 -
     * XXX 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
     */

    void destroy() {
        struct Parrot_cont * cc = PMC_cont(SELF);
        if (cc) {
            mem_sys_free(cc);
            PMC_struct_val(SELF) = NULL;
        }
    }
    PMC* clone() {
        PMC *result = SUPER();
        PObj_custom_mark_CLEAR(result);
        return result;
    }

    opcode_t* invoke(void* ex) {
        struct Parrot_cont * cc = PMC_cont(SELF);
        PMC *exception = ex;
        parrot_context_t *ex_ctx;
        void *next = NULL;
        opcode_t *results;
        /* COMPAT: PMC *p5 = REG_PMC(5);*/

        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);
            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:
 */
Something went wrong with that request. Please try again.