/*

Copyright (C) 2001-2008, The Perl Foundation.
$Id: /mirror/trunk/src/ops/pmc.ops 35367 2009-01-10T10:50:26.942379Z cotto  $

pmc.ops

*/

VERSION = PARROT_VERSION;

=head1 NAME

pmc.ops - PMC Operations

=head1 DESCRIPTION

Operations that deal with PMCs, including creation and
destruction, manipulation, and introspection.

=cut

###############################################################################

=head2 Creation and Types

These operations are used to create PMCs and examine
type information.

=over 4

=cut

########################################

=item B<new>(out PMC, in STR)

=item B<new>(out PMC, in STR, invar PMC)

=item B<new>(out PMC, in PMC)

=item B<new>(out PMC, in PMC, invar PMC)

Instantiate a new object from a string PMC or key name, or from a class object.
For strings and keys, first check the namespace for a class object, then fall
back to the type ID if no class object is stored in the namespace.

  new P0, 'ResizableBooleanArray'

Optionally a PMC may be passed to the constructor. It's up to the class what
to do with the intializer.  See PDD02 for more.

=cut

op new(out PMC, in STR) {
    STRING * const classname = $2;
    PMC * const classobj = Parrot_oo_get_class_str(interp, classname);

    if (!PMC_IS_NULL(classobj))
        $1 = VTABLE_instantiate(interp, classobj, PMCNULL);
    else {
        const INTVAL type = pmc_type(interp, classname);
        if (type <= 0) {
            opcode_t *dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
                EXCEPTION_NO_CLASS,
                "Class '%Ss' not found", classname);
            goto ADDRESS(dest);
        }
        $1 = pmc_new(interp, type);
    }
}

op new(out PMC, in STR, in PMC) {
    STRING * const classname = $2;
    PMC * const classobj = Parrot_oo_get_class_str(interp, classname);

    if (!PMC_IS_NULL(classobj))
        $1 = VTABLE_instantiate(interp, classobj, $3);
    else {
        const INTVAL type = pmc_type(interp, classname);
        if (type <= 0) {
            opcode_t *dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
                EXCEPTION_NO_CLASS,
                "Class '%Ss' not found", classname);
            goto ADDRESS(dest);
        }
        $1 = pmc_new_init(interp, type, $3);
    }
}

inline op new(out PMC, in PMC) :object_classes {
    PMC * const classname_key = $2;
    PMC * const classobj = Parrot_oo_get_class(interp, classname_key);

    if (!PMC_IS_NULL(classobj))
        $1 = VTABLE_instantiate(interp, classobj, PMCNULL);
    else {
        const INTVAL type = pmc_type_p(interp, classname_key);
        if (type <= 0) {
            opcode_t *dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
                EXCEPTION_NO_CLASS,
                "Class '%Ss' not found", VTABLE_get_repr(interp, classname_key));
            goto ADDRESS(dest);
        }
        $1 = pmc_new(interp, type);
    }
}

op new(out PMC, in PMC, in PMC) {
    PMC * const classname_key = $2;
    PMC * const classobj = Parrot_oo_get_class(interp, classname_key);

    if (!PMC_IS_NULL(classobj))
        $1 = VTABLE_instantiate(interp, classobj, $3);
    else {
        const INTVAL type = pmc_type_p(interp, classname_key);
        if (type <= 0) {
            opcode_t *dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
                EXCEPTION_NO_CLASS,
                "Class '%Ss' not found", VTABLE_get_repr(interp, classname_key));
            goto ADDRESS(dest);
        }
        $1 = pmc_new_init(interp, type, $3);
    }
}

########################################

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

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

Return the type of PMC in $2.

=cut

inline op typeof(out STR, invar PMC) {
  $1 = VTABLE_name(interp, $2);
}

inline op typeof(out PMC, invar PMC) {
  $1 = VTABLE_get_class(interp, $2);
}

########################################

=item B<get_repr>(out STR, invar PMC)

Set $1 to a string representation of $2

=cut

op get_repr(out STR, invar PMC) {
    $1 = VTABLE_get_repr(interp, $2);
}

=back

=cut

###############################################################################

=head2 Basic Operations

A few simple and common PMC operations.

=over 4

=cut

########################################

=item B<find_method>(out PMC, invar PMC, in STR)

Looks up method $3 in $2's vtable, placing the corresponding method
PMC in $1.

=cut

op find_method(out PMC, invar PMC, in STR) :flow {
    opcode_t * const resume = expr NEXT();
    $1 = VTABLE_find_method(interp, $2, $3);
    if (PMC_IS_NULL($1) || !VTABLE_defined(interp, $1)) {
        opcode_t *dest = Parrot_ex_throw_from_op_args(interp, resume,
            EXCEPTION_METHOD_NOT_FOUND,
            "Method '%Ss' not found for invocant of class '%Ss'", $3,
            VTABLE_get_string(interp, VTABLE_get_class(interp, $2)));
        goto ADDRESS(dest);
    }
    restart ADDRESS(resume);
}

########################################

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

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

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

Test PMC for definedness.

=item B<exists>(out INT, invar PMC, in INTKEY)

=item B<exists>(out INT, invar PMC, in KEY)

Tests whether KEY or INTKEY exists in the aggregate PMC.
Places the answer in INT.

=cut

inline op defined(out INT, invar PMC) {
  $1 = PMC_IS_NULL($2) ? 0 : VTABLE_defined(interp, $2);
}

inline op defined(out INT, invar PMC, in INTKEY) {
  $1 = PMC_IS_NULL($2) ? 0 : VTABLE_defined_keyed_int(interp, $2, $3);
}

inline op defined(out INT, invar PMC, in KEY) {
  $1 = PMC_IS_NULL($2) ? 0 : VTABLE_defined_keyed(interp, $2, $3);
}

inline op exists(out INT, invar PMC, in INTKEY) {
  $1 = PMC_IS_NULL($2) ? 0 : VTABLE_exists_keyed_int(interp, $2, $3);
}

inline op exists(out INT, invar PMC, in KEY) {
  $1 = PMC_IS_NULL($2) ? 0: VTABLE_exists_keyed(interp, $2, $3);
}

########################################

=item B<delete>(invar PMC, in KEY)

=item B<delete>(invar PMC, in INTKEY)

Delete the specified entry $2 from aggregate $1.

=cut

inline op delete(invar PMC, in KEY) {
  VTABLE_delete_keyed(interp, $1, $2);
}

inline op delete(invar PMC, in INTKEY) {
  VTABLE_delete_keyed_int(interp, $1, $2);
}

########################################

=item B<elements>(out INT, invar PMC)

Returns the number of items in aggregate $2

=cut

inline op elements(out INT, invar PMC) {
  $1 = VTABLE_elements(interp, $2);
}

=back

=cut

###############################################################################

=head2 Fast access ops

The fast access ops are shortcuts to common operations implemented in var PMCs.

=over 4

=cut

########################################

=item B<push>(invar PMC, in INT)

=item B<push>(invar PMC, in NUM)

=item B<push>(invar PMC, in STR)

=item B<push>(invar PMC, invar PMC)

Push $2 onto the end of the aggregate PMC $1, if that operation is defined.

=cut

inline op push(invar PMC, in INT) {
    VTABLE_push_integer(interp, $1, $2);
}

inline op push(invar PMC, in NUM) {
    VTABLE_push_float(interp, $1, $2);
}

inline op push(invar PMC, in STR) {
    VTABLE_push_string(interp, $1, $2);
}

inline op push(invar PMC, invar PMC) {
    VTABLE_push_pmc(interp, $1, $2);
}

########################################

=item B<pop>(out INT, invar PMC)

=item B<pop>(out NUM, invar PMC)

=item B<pop>(out STR, invar PMC)

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

Pop off last entry in the aggregate $2, placing the result in $1.

=cut

inline op pop(out INT, invar PMC) {
    $1 = VTABLE_pop_integer(interp, $2);
}

inline op pop(out NUM, invar PMC) {
    $1 = VTABLE_pop_float(interp, $2);
}

inline op pop(out STR, invar PMC) {
    $1 = VTABLE_pop_string(interp, $2);
}

inline op pop(out PMC, invar PMC) {
    $1 = VTABLE_pop_pmc(interp, $2);
}

########################################

=item B<unshift>(invar PMC, in INT)

=item B<unshift>(invar PMC, in NUM)

=item B<unshift>(invar PMC, in STR)

=item B<unshift>(invar PMC, invar PMC)

Unshift $2 onto the front of the aggregate PMC $1.

=cut

inline op unshift(invar PMC, in INT) {
    VTABLE_unshift_integer(interp, $1, $2);
}

inline op unshift(invar PMC, in NUM) {
    VTABLE_unshift_float(interp, $1, $2);
}

inline op unshift(invar PMC, in STR) {
    VTABLE_unshift_string(interp, $1, $2);
}

inline op unshift(invar PMC, invar PMC) {
    VTABLE_unshift_pmc(interp, $1, $2);
}

########################################

=item B<shift>(out INT, invar PMC)

=item B<shift>(out NUM, invar PMC)

=item B<shift>(out STR, invar PMC)

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

Shift off the first entry in the aggregate $2 and places it in $1.

=cut

inline op shift(out INT, invar PMC) {
    $1 = VTABLE_shift_integer(interp, $2);
}

inline op shift(out NUM, invar PMC) {
    $1 = VTABLE_shift_float(interp, $2);
}

inline op shift(out STR, invar PMC) {
    $1 = VTABLE_shift_string(interp, $2);
}

inline op shift(out PMC, invar PMC) {
    $1 = VTABLE_shift_pmc(interp, $2);
}


=back

=cut

###############################################################################

=head2 Properties

Ops to deal with PMC properties.

=over 4

=cut

########################################

=item B<setprop>(invar PMC, in STR, invar PMC)

Set property $2 to value $3 for PMC $1.

=cut

op setprop(invar PMC, in STR, invar PMC) {
      VTABLE_setprop(interp, $1, $2, $3);
}

########################################

=item B<getprop>(out PMC, in STR, invar PMC)

Get property $2 of PMC $3 and put it in $1.

=cut

op getprop(out PMC, in STR, invar PMC) {
   $1 = VTABLE_getprop(interp, $3, $2);
}

########################################

=item B<delprop>(invar PMC, in STR)

Delete property $2 from PMC $1.

=cut

op delprop(invar PMC, in STR) {
   VTABLE_delprop(interp, $1, $2);
}

########################################

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

Get a hash for the properties invar PMC $2 and put it in $1. If the property
hash doesn't exist, the C<Null> PMC is returned.

=cut

op prophash(out PMC, invar PMC) {
   $1 = VTABLE_getprops(interp, $2);
}

=back

=cut

###############################################################################

=head2 Freeze, thaw and friends

Ops to PMC freeze, thaw.

=over 4

=cut

########################################

=item B<freeze>(out STR, invar PMC)

Set $1 to the frozen image of $2.

=item B<thaw>(out PMC, in STR)

Set $1 to a newly created PMC from the image $2.

=cut

op freeze(out STR, invar PMC) {
   $1 = Parrot_freeze(interp, $2);
}

op thaw(out PMC, in STR) {
   $1 = Parrot_thaw(interp, $2);
}

=back

=cut

###############################################################################

=head2 Vtable MMD manipulation functions

These functions manipulate the vtable MMD function table.

These functions allow bytecode to register subs or methods and query which
sub or method would get called for a particular vtable operation. This way
you're not required to drop to C to register a new method variant for
addition or subtraction, or one of the other binary MMD operations.

=over 4

=cut

########################################

=item B<add_multi>(in STR, in STR, invar PMC)

Register method $3 as the MMD method for the sub named $1 with signature $2.

=cut

inline op add_multi(in STR, in STR, invar PMC) {
  Parrot_mmd_add_multi_from_long_sig(interp, $1, $2, $3);
}

=item B<find_multi>(out PMC, in STR, in STR)

Set $1 to the sub that would be called for sub named $2 with signature $3.

=cut

inline op find_multi(out PMC, in STR, in STR) {
  $1 = Parrot_mmd_find_multi_from_long_sig(interp, $2, $3);
}

=back

=cut

###############################################################################

=head2 Misc PMC related ops

=over 4

=cut

########################################

=item B<register>(invar PMC)

Add a reference of PMC $1 to the interpreter's root set of PMCs. This is needed
for extensions to make sure that the PMC is properly marked during DOD, if that
PMC is not known to Parrot's core elsewhere.

A PMC can be registered multiple times.  If it's unregistered and the
registration count reaches zero, it will be destroyed during the next DOD run.

=item B<unregister>(invar PMC)

Remove one reference of $1.

=cut

op register(invar PMC) {
  dod_register_pmc(interp, $1);
}

op unregister(invar PMC) {
  dod_unregister_pmc(interp, $1);
}


########################################

=item B<box>(out PMC, in INT)

=item B<box>(out PMC, in NUM)

=item B<box>(out PMC, in STR)

Create a HLL-mapped PMC containing the provided primitive.

=cut

op box(out PMC, in INT) {
    $1 = pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Integer));
    VTABLE_set_integer_native(interp, $1, $2);
}

op box(out PMC, in NUM) {
    $1 = pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Float));
    VTABLE_set_number_native(interp, $1, $2);
}

op box(out PMC, in STR) {
    $1 = pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_String));
    VTABLE_set_string_native(interp, $1, $2);
}

=back

=head1 COPYRIGHT

Copyright (C) 2001-2008, The Perl Foundation.

=head1 LICENSE

This program is free software. It is subject to the same license
as the Parrot interpreter itself.

=cut

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