/*
Copyright (C) 2006, The Perl Foundation.
$Id: wmls.ops 17096 2007-02-20 20:20:48Z paultcochrane $
*/

=head1 NAME

wmls.ops - WMLScript Operations

=head1 DESCRIPTION

=head2 Operations

=over 8

=cut

#include "parrot/dynext.h"
VERSION = PARROT_VERSION;


=item B<defined>(out PMC, invar PMC)

implements C<ISVALID> WMLScript opcode.

=cut

inline op defined(out PMC, invar PMC) :base_core {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));

    INTVAL result = PMC_IS_NULL($2) ? 0 : VTABLE_defined(interp, $2);
    $1 = pmc_new(interp, dynpmc_WmlsBoolean);
    PMC_int_val($1) = result;
    goto NEXT();
}


=item B<istrue>(out PMC, invar PMC)

implements C<TOBOOL> WMLScript opcode.

=cut

inline op istrue(out PMC, invar PMC) :base_core {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));
    INTVAL dynpmc_WmlsInvalid = pmc_type(interp,
        const_string(interp, "WmlsInvalid"));
    INTVAL type = VTABLE_type(interp, $2);

    if (type == dynpmc_WmlsInvalid) {
        $1 = pmc_new(interp, dynpmc_WmlsInvalid);
    }
    else {
        INTVAL result = VTABLE_get_bool(interp, $2);
        $1 = pmc_new(interp, dynpmc_WmlsBoolean);
        PMC_int_val($1) = result;
    }
    goto NEXT();
}


=item B<typeof>(out PMC, invar PMC)

implements C<TYPEOF> WMLScript opcode.

=cut

inline op typeof(out PMC, invar PMC) :base_core {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));
    INTVAL dynpmc_WmlsFloat = pmc_type(interp,
        const_string(interp, "WmlsFloat"));
    INTVAL dynpmc_WmlsInteger = pmc_type(interp,
        const_string(interp, "WmlsInteger"));
    INTVAL dynpmc_WmlsInvalid = pmc_type(interp,
        const_string(interp, "WmlsInvalid"));
    INTVAL dynpmc_WmlsString = pmc_type(interp,
        const_string(interp, "WmlsString"));
    INTVAL type = VTABLE_type(interp, $2);
    INTVAL result;

    if      (type == dynpmc_WmlsInteger) {
        result = 0;
    }
    else if (type == dynpmc_WmlsFloat) {
        result = 1;
    }
    else if (type == dynpmc_WmlsString) {
        result = 2;
    }
    else if (type == dynpmc_WmlsBoolean) {
        result = 3;
    }
    else if (type == dynpmc_WmlsInvalid) {
        result = 4;
    }
    else {
        real_exception(interp, NULL, NO_CLASS,
            "Attempt to typeof of a non-wmls type.");
    }
    $1 = pmc_new(interp, dynpmc_WmlsInteger);
    PMC_int_val($1) = result;
    goto NEXT();
}


=item B<isgt>(out PMC, invar PMC, invar PMC)

implements C<GT> WMLScript opcode.

=cut

inline op isgt(out PMC, invar PMC, invar PMC) {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));
    INTVAL dynpmc_WmlsInvalid = pmc_type(interp,
        const_string(interp, "WmlsInvalid"));
    INTVAL result = mmd_dispatch_i_pp(interp, $2, $3, MMD_CMP);

    if (4 == result) {
        $1 = pmc_new(interp, dynpmc_WmlsInvalid);
    }
    else {
        $1 = pmc_new(interp, dynpmc_WmlsBoolean);
        PMC_int_val($1) = result > 0;
    }
    goto NEXT();
}


=item B<isge>(out PMC, invar PMC, invar PMC)

implements C<GE> WMLScript opcode.

=cut

inline op isge(out PMC, invar PMC, invar PMC) {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));
    INTVAL dynpmc_WmlsInvalid = pmc_type(interp,
        const_string(interp, "WmlsInvalid"));
    INTVAL result = mmd_dispatch_i_pp(interp, $2, $3, MMD_CMP);

    if (4 == result) {
        $1 = pmc_new(interp, dynpmc_WmlsInvalid);
    }
    else {
        $1 = pmc_new(interp, dynpmc_WmlsBoolean);
        PMC_int_val($1) = result >= 0;
    }
    goto NEXT();
}


=item B<isle>(out PMC, invar PMC, invar PMC)

implements C<LE> WMLScript opcode.

=cut

inline op isle(out PMC, invar PMC, invar PMC) {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));
    INTVAL dynpmc_WmlsInvalid = pmc_type(interp,
        const_string(interp, "WmlsInvalid"));
    INTVAL result = mmd_dispatch_i_pp(interp, $2, $3, MMD_CMP);

    if (4 == result) {
        $1 = pmc_new(interp, dynpmc_WmlsInvalid);
    }
    else {
        $1 = pmc_new(interp, dynpmc_WmlsBoolean);
        PMC_int_val($1) = result <= 0;
    }
    goto NEXT();
}


=item B<islt>(out PMC, invar PMC, invar PMC)

implements C<LT> WMLScript opcode.

=cut

inline op islt(out PMC, invar PMC, invar PMC) {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));
    INTVAL dynpmc_WmlsInvalid = pmc_type(interp,
        const_string(interp, "WmlsInvalid"));
    INTVAL result = mmd_dispatch_i_pp(interp, $2, $3, MMD_CMP);

    if (4 == result) {
        $1 = pmc_new(interp, dynpmc_WmlsInvalid);
    }
    else {
        $1 = pmc_new(interp, dynpmc_WmlsBoolean);
        PMC_int_val($1) = result < 0;
    }
    goto NEXT();
}

=item B<iseq>(out PMC, invar PMC, invar PMC)

implements C<EQ> WMLScript opcode.

=cut

inline op iseq(out PMC, invar PMC, invar PMC) {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));
    INTVAL dynpmc_WmlsInvalid = pmc_type(interp,
        const_string(interp, "WmlsInvalid"));
    INTVAL result = mmd_dispatch_i_pp(interp, $2, $3, MMD_EQ);

    if (4 == result) {
        $1 = pmc_new(interp, dynpmc_WmlsInvalid);
    }
    else {
        $1 = pmc_new(interp, dynpmc_WmlsBoolean);
        PMC_int_val($1) = result;
    }
    goto NEXT();
}


=item B<isne>(out PMC, invar PMC, invar PMC)

implements C<NE> WMLScript opcode.

=cut

inline op isne(out PMC, invar PMC, invar PMC) {
    INTVAL dynpmc_WmlsBoolean = pmc_type(interp,
        const_string(interp, "WmlsBoolean"));
    INTVAL dynpmc_WmlsInvalid = pmc_type(interp,
        const_string(interp, "WmlsInvalid"));
    INTVAL result = mmd_dispatch_i_pp(interp, $2, $3, MMD_EQ);

    if (4 == result) {
        $1 = pmc_new(interp, dynpmc_WmlsInvalid);
    }
    else {
        $1 = pmc_new(interp, dynpmc_WmlsBoolean);
        PMC_int_val($1) = !result;
    }
    goto NEXT();
}


=back

=head1 AUTHORS

Francois Perrad.

=cut

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

