exception.pmc

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

=head1 NAME

src/pmc/exception.pmc - Exception PMC

=head1 DESCRIPTION

This is the exception base class. An exception object has the following
attributes:

=over 4

=item C<message>

Textual representation of the exception.

=item C<severity>

The severity of the exception, (see F<include/parrot/exceptions.h>,
F<except_severity.pasm>).

=item C<type>

The type of the exception.

=item C<exit_code>

The exit code of the exception. (Added temporarily, to be removed.)

=item C<handled>

Whether the exception has been handled. Defaults to 0, 1 for handled, -1 for a
rethrown exception.

=item C<payload>

Additional data for the exception.

=back

When an exception handler is called, the exception object is passed as
as the first argument, the message as the second argument of the call.
These arguments can be retrieved with the C<get_results> opcode.

=cut

*/

#include "parrot/exceptions.h"
#include "pmc/pmc_sub.h"

/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* HEADERIZER END: static */

pmclass Exception auto_attrs {

    ATTR INTVAL          id;           /* The task ID in the scheduler. */
    ATTR FLOATVAL        birthtime;    /* The creation time stamp of the exception. */
    ATTR STRING         *message;      /* The exception message. */
    ATTR PMC            *payload;      /* The payload for the exception. */
    ATTR PMC            *resume;       /* Continuation for resuming after handling the exception. */
    ATTR INTVAL          severity;     /* The severity of the exception. */
    ATTR INTVAL          type;         /* The type of the exception. */
    ATTR INTVAL          exit_code;    /* The exit code of the exception. */
    ATTR PMC            *backtrace;    /* The backtrace of an exception. */
    ATTR INTVAL          handled;      /* Whether the exception has been handled. */
    ATTR PMC            *handler_iter; /* An iterator of handlers (for rethrow). */
    ATTR PMC            *handler_ctx;  /* A stored context for handler iterator. */
    ATTR PMC            *thrower;      /* The position we were at when thrown. */

/*

=head2 Vtable Functions

=over 4

=item C<void init()>

Initializes the exception with default values.

=cut

*/

    VTABLE void init() {
        /* Set flags for custom GC mark and destroy. */
        PObj_custom_mark_SET(SELF);

        SET_ATTR_severity(INTERP, SELF, EXCEPT_error);
        SET_ATTR_handled(INTERP, SELF, 0);
        SET_ATTR_message(INTERP, SELF, NULL);
        SET_ATTR_payload(INTERP, SELF, PMCNULL);
        SET_ATTR_resume(INTERP, SELF, PMCNULL);
        SET_ATTR_backtrace(INTERP, SELF, PMCNULL);
        SET_ATTR_handler_iter(INTERP, SELF, PMCNULL);
    }

/*

=item C<void init_pmc()>

Initializes the exception with supplied values.

=cut

*/

    VTABLE void init_pmc(PMC *values) {
        INTVAL severity_val;
        STRING *message_val;

        INTVAL ishash = VTABLE_isa(interp, values, CONST_STRING(interp, 'Hash'));

        if (ishash) {
            STRING * const severity = CONST_STRING(interp, "severity");
            STRING * const message  = CONST_STRING(interp, "message");
            severity_val = VTABLE_get_integer_keyed_str(interp, values, severity);
            message_val = VTABLE_get_string_keyed_str(interp, values, message);
        }
        else {
            severity_val = EXCEPT_error;
            message_val  = VTABLE_get_string(interp, values);
        }

        /* Set flags for custom GC mark. */
        PObj_custom_mark_SET(SELF);

        /* Set up the core struct and default values for the exception object. */

        SET_ATTR_severity(INTERP, SELF, severity_val);
        SET_ATTR_handled(INTERP, SELF, 0);
        SET_ATTR_message(INTERP, SELF, message_val);
        SET_ATTR_payload(INTERP, SELF, PMCNULL);
        SET_ATTR_resume(INTERP, SELF, PMCNULL);
        SET_ATTR_backtrace(INTERP, SELF, PMCNULL);
        SET_ATTR_handler_iter(INTERP, SELF, PMCNULL);

    }

/*

=item C<void mark()>

Mark any active exception data as live.

=cut

*/

    VTABLE void mark() {
        Parrot_Exception_attributes * const core_struct = PARROT_EXCEPTION(SELF);
        Parrot_gc_mark_STRING_alive(interp, core_struct->message);
        Parrot_gc_mark_PMC_alive(interp, core_struct->payload);
        Parrot_gc_mark_PMC_alive(interp, core_struct->resume);
        Parrot_gc_mark_PMC_alive(interp, core_struct->backtrace);
        Parrot_gc_mark_PMC_alive(interp, core_struct->handler_iter);
        Parrot_gc_mark_PMC_alive(interp, core_struct->handler_ctx);
        Parrot_gc_mark_PMC_alive(interp, core_struct->thrower);
    }

/*

=item C<INTVAL get_bool()>

Return true.

=cut

*/

    VTABLE INTVAL get_bool() {
        return 1;
    }

/*

=item C<STRING *get_string()>

Return the exception message.

=cut

*/

    VTABLE STRING *get_string() {
        STRING *message;
        GET_ATTR_message(interp, SELF, message);
        if (STRING_IS_NULL(message))
            message = CONST_STRING(interp, "");
        return message;
    }

/*

=item C<INTVAL get_integer()>

Returns the id of the exception.

=cut

*/

    VTABLE INTVAL get_integer() {
        Parrot_Exception_attributes * const exception = PARROT_EXCEPTION(SELF);
        return exception->id;
    }

/*

=item C<STRING *get_string_keyed(PMC *key)>

Returns the Parrot string value for C<*key>. The only current recognized
C<key> is "message".

=cut

*/

    VTABLE STRING *get_string_keyed(PMC *key) {
        STRING *name = VTABLE_get_string(INTERP, key);
        STRING *message;

        if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "message"))) {
            message = SELF.get_string();
        }
        else {
            /* If unknown attribute name, throw an exception. */
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                "No such string attribute '%S'", name);
        }

        return message;
    }

/*

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

Returns the integer value for C<*key>.

=cut

*/

    VTABLE INTVAL get_integer_keyed(PMC *key) {
        STRING *name   = VTABLE_get_string(INTERP, key);
        INTVAL  result = 0;

        if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "type"))) {
            GET_ATTR_type(interp, SELF, result);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "severity"))) {
            GET_ATTR_severity(interp, SELF, result);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "exit_code"))) {
            GET_ATTR_exit_code(interp, SELF, result);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "handled"))) {
            GET_ATTR_handled(interp, SELF, result);
        }
        else {
            /* If unknown attribute name, throw an exception. */
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                "No such integer attribute '%S'", name);
        }

        return result;
    }

/*

=item C<INTVAL get_integer_keyed_str(STRING *key)>

Returns the integer value for C<*key>.

=cut

*/

    VTABLE INTVAL get_integer_keyed_str(STRING *key) {
        INTVAL result = 0;

        if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "type"))) {
            GET_ATTR_type(interp, SELF, result);
        }
        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "severity"))) {
            GET_ATTR_severity(interp, SELF, result);
        }
        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "exit_code"))) {
            GET_ATTR_exit_code(interp, SELF, result);
        }
        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "handled"))) {
            GET_ATTR_handled(interp, SELF, result);
        }
        else {
            /* If unknown attribute name, throw an exception. */
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                "No such integer attribute '%S'", key);
        }

        return result;
    }

/*

=item C<PMC *get_pmc_keyed(PMC *key)>

Returns the PMC value for C<*key>.

=cut

*/

    VTABLE PMC *get_pmc_keyed(PMC *key) {
        STRING *s = VTABLE_get_string(INTERP, key);
        return SELF.get_attr_str(s);
    }


/*

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

Sets the C<message> of the Exception.

=cut

*/

    VTABLE void set_string_native(STRING *value) {
        SET_ATTR_message(interp, SELF, value);
    }


/*

=item C<void set_integer_native(INTVAL *value)>

Sets the C<id> of the Exception.

=cut

*/

    VTABLE void set_integer_native(INTVAL value) {
        SET_ATTR_id(interp, SELF, value);
    }

/*

=item C<void set_number_native(FLOATVAL value)>

Sets the birthtime of the exception.

=cut

*/

    VTABLE void set_number_native(FLOATVAL value) {
        SET_ATTR_birthtime(interp, SELF, value);
    }


/*

=item C<void set_string_keyed(PMC *key, STRING *value)>

Sets the Parrot string value for C<*key>.

=cut

*/

    VTABLE void set_string_keyed(PMC *key, STRING *value) {
        STRING *name = VTABLE_get_string(INTERP, key);

        if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "message"))) {
            SELF.set_string_native(value);
        }
        else {
            /* If unknown attribute name, throw an exception. */
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                "No such string attribute '%S'", name);
        }
    }

/*

=item C<void set_integer_keyed(PMC *key, INTVAL value)>

Sets the integer value for C<*key>.

=cut

*/

    VTABLE void set_integer_keyed(PMC *key, INTVAL value) {
        STRING *name = VTABLE_get_string(INTERP, key);

        if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "type"))) {
            SET_ATTR_type(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "severity"))) {
            SET_ATTR_severity(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "exit_code"))) {
            SET_ATTR_exit_code(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "handled"))) {
            SET_ATTR_handled(interp, SELF, value);
        }
        else {
            /* If unknown attribute name, throw an exception. */
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                "No such integer attribute '%S'", name);
        }
    }

/*

=item C<void set_integer_keyed_str(STRING *key, INTVAL value) >

Sets the integer value for C<*key>.

=cut

*/

    VTABLE void set_integer_keyed_str(STRING *key, INTVAL value) {
        if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "type"))) {
            SET_ATTR_type(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "severity"))) {
            SET_ATTR_severity(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "exit_code"))) {
            SET_ATTR_exit_code(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "handled"))) {
            SET_ATTR_handled(interp, SELF, value);
        }
        else {
            /* If unknown attribute name, throw an exception. */
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                "No such integer attribute '%S'", key);
        }
    }

/*

=item C<void set_pmc_keyed(PMC *key, PMC *value)>

Sets the PMC value for C<*key>.

=cut

*/

    VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
        STRING *s = VTABLE_get_string(INTERP, key);
        SELF.set_attr_str(s, value);
    }

/*

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

Store a context for the handler iterator.

=cut

*/

    VTABLE void set_pointer(void *context) {
        Parrot_Exception_attributes * const core_struct = PARROT_EXCEPTION(SELF);

        core_struct->handler_ctx = (PMC*)context;
    }

/*

=item C<void *get_pointer()>

Retrieve a context stored for the handler iterator.

=cut

*/

    VTABLE void *get_pointer() {
        Parrot_Exception_attributes * const core_struct = PARROT_EXCEPTION(SELF);
        return core_struct->handler_ctx;
    }

/*

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

Compare the passed in Exception with C<SELF>. Returns true if C<SELF> and
C<value> are the same type, and have the same values for type, severity, and
exit_code.

=cut

*/
    VTABLE INTVAL is_equal(PMC *value) {
        STRING * const exception_str = CONST_STRING(INTERP, "Exception");

        if (value->vtable->base_type == SELF->vtable->base_type
        &&  VTABLE_isa(INTERP, value, exception_str)) {
            INTVAL self_compare, value_compare;
            GET_ATTR_type(interp, SELF, self_compare);
            GET_ATTR_type(interp, value, value_compare);
            if (self_compare == value_compare) {
                GET_ATTR_severity(interp, SELF, self_compare);
                GET_ATTR_severity(interp, value, value_compare);
                if (self_compare == value_compare) {
                    GET_ATTR_exit_code(interp, SELF, self_compare);
                    GET_ATTR_exit_code(interp, value, value_compare);
                    if (self_compare == value_compare)
                        return 1;
                }
            }
        }

        return 0;
    }

/*

=item C<get_attr_str>

Retrieve an attribute value for the exception object.

=cut

*/
    VTABLE PMC *get_attr_str(STRING *name) {
        PMC *value = PMCNULL;

        if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "type"))) {
                INTVAL type;
                GET_ATTR_type(interp, SELF, type);
                value = Parrot_pmc_new(interp, enum_class_Integer);
                VTABLE_set_integer_native(interp, value, type);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "severity"))) {
                INTVAL severity;
                GET_ATTR_severity(interp, SELF, severity);
                value = Parrot_pmc_new(interp, enum_class_Integer);
                VTABLE_set_integer_native(interp, value, severity);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "exit_code"))) {
                INTVAL exit_code;
                GET_ATTR_exit_code(interp, SELF, exit_code);
                value = Parrot_pmc_new(interp, enum_class_Integer);
                VTABLE_set_integer_native(interp, value, exit_code);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "handled"))) {
                INTVAL handled;
                GET_ATTR_handled(interp, SELF, handled);
                value = Parrot_pmc_new(interp, enum_class_Integer);
                VTABLE_set_integer_native(interp, value, handled);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "message"))) {
                STRING *message = SELF.get_string();
                value = Parrot_pmc_new(interp, enum_class_String);
                VTABLE_set_string_native(interp, value, message);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "payload"))) {
                GET_ATTR_payload(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "resume"))) {
                GET_ATTR_resume(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "backtrace"))) {
                GET_ATTR_backtrace(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "handler_iter"))) {
                GET_ATTR_handler_iter(interp, SELF, value);
        }
        else {
            /* If unknown attribute name, throw an exception. */
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                "No such attribute '%S'", name);
        }

        return value;
    }

/*

=item C<set_attr_str>

Set an attribute value for the exception object.

=cut

*/
    VTABLE void set_attr_str(STRING *name, PMC *value) {

        if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "type"))) {
            INTVAL type = VTABLE_get_integer(interp, value);
            SET_ATTR_type(interp, SELF, type);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "severity"))) {
            INTVAL severity = VTABLE_get_integer(interp, value);
            SET_ATTR_severity(interp, SELF, severity);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "exit_code"))) {
            INTVAL exit_code = VTABLE_get_integer(interp, value);
            SET_ATTR_exit_code(interp, SELF, exit_code);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "handled"))) {
            INTVAL handled = VTABLE_get_integer(interp, value);
            SET_ATTR_handled(interp, SELF, handled);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "message"))) {
            STRING *message = VTABLE_get_string(interp, value);
            SELF.set_string_native(message);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "payload"))) {
            SET_ATTR_payload(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "resume"))) {
            SET_ATTR_resume(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "backtrace"))) {
            SET_ATTR_backtrace(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "handler_iter"))) {
            SET_ATTR_handler_iter(interp, SELF, value);
        }
        else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "thrower"))) {
            /* Ensure it's a ret cont, and extract the from_ctx.
             * XXX TT #596 - when we have Context PMCs, just take and set that. */
            if (!PMC_IS_NULL(value) && VTABLE_isa(interp, value, CONST_STRING(interp, "Continuation"))) {
                PMC *ctx = PMC_cont(value)->from_ctx;
                if (!PMC_IS_NULL(ctx))
                    SET_ATTR_thrower(interp, SELF, ctx);
            }
        }
        else {
            /* If unknown attribute name, throw an exception. */
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
                "No such attribute '%S'", name);
        }

    }

/*

=item C<PMC *share_ro()>

Set this PMC as shared.

=cut

*/

    VTABLE PMC *share_ro() {
        PMC *shared_self;
        Parrot_Exception_attributes *shared_struct;

        if (PObj_is_PMC_shared_TEST(SELF))
            return SELF;

        shared_self = pt_shared_fixup(INTERP, SELF);
        shared_struct = PARROT_EXCEPTION(shared_self);

        if (!PMC_IS_NULL(shared_struct->payload))
            shared_struct->payload = pt_shared_fixup(INTERP, shared_struct->payload);

        if (!PMC_IS_NULL(shared_struct->backtrace))
            shared_struct->backtrace = pt_shared_fixup(INTERP, shared_struct->backtrace);

        if (!PMC_IS_NULL(shared_struct->handler_iter))
            shared_struct->handler_iter = pt_shared_fixup(INTERP, shared_struct->handler_iter);

        return shared_self;
    }


/*

=item C<PMC *annotations>

Gets any bytecode annotations in force at the point where the exception was
thrown. If the optional name of an annotation is specified, gets just that
annotation. If not, returns a Hash of all of them.

=cut

*/

    METHOD annotations(STRING *name :optional, INTVAL have_name :opt_flag) {
        PMC *resume;
        PMC *result = PMCNULL;

        /* Get resume continuation, to find location we failed at. */
        GET_ATTR_resume(interp, SELF, resume);
        if (!PMC_IS_NULL(resume)) {
            Parrot_Continuation_attributes *cont = PARROT_CONTINUATION(resume);
            if (cont->seg != NULL && cont->seg->annotations != NULL)
                result = PackFile_Annotations_lookup(interp, cont->seg->annotations,
                        cont->address - cont->seg->base.data, name);
        }

        /* If we didn't have a key specified and we found no annotations to
         * return, should return an empty hash. */
        if (!have_name && PMC_IS_NULL(result))
            result = Parrot_pmc_new(interp, enum_class_Hash);

        RETURN(PMC *result);
    }


/*

=item C<PMC *backtrace>

Gets a representation of the backtrace at the point that this exception was
thrown. Returns an array of hashes. Each array element represents a caller in
the backtrace, the most recent caller first. The hash has two keys: C<sub>,
which holds the PMC representing the sub, and C<annotations> which is a hash
of the annotations at the point where the exception was thrown for the current
sub, or for the point of the call a level deeper for the rest.

=cut

*/

    METHOD backtrace() {
        PMC *result = PMCNULL;
        PMC *resume;
        Parrot_Continuation_attributes    *cont;

        /* Get starting context, then loop over them. */
        GET_ATTR_resume(interp, SELF, resume);
        if (!PMC_IS_NULL(resume)) {
            /* We have a resume continuation, so we can get the address from
             * that. */
            cont    = PARROT_CONTINUATION(resume);
            Parrot_pcc_invoke_method_from_c_args(INTERP, cont->to_ctx, CONST_STRING(interp, "backtrace"), "P->P", resume, &result);
        }
        else {
            PMC *cur_ctx;
            /* No return continuation. Assuming we're being called  */
            cont = NULL;
            GET_ATTR_thrower(interp, SELF, cur_ctx);
            Parrot_pcc_invoke_method_from_c_args(INTERP, CURRENT_CONTEXT(INTERP), CONST_STRING(interp, "backtrace"), "->P", &result);
        }

        RETURN(PMC *result);
    }


/*

=back

=cut

*/

}

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