/*
** 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 INT)

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

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

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

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

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

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

Create a new PMC of class $2; look in F<core_pmcs.h> for the base vtable
types.  The assembler allows you to specify PMCs by type name, by key for
names in nested namespace, as well as by integer - you should do this for
compatibility, to avoid problems if the base types get reassigned. For
example:

  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 INT) {
  if ($2 <= 0 || $2 >= interp->n_vtable_max) {
    real_exception(interp, 0, NO_CLASS,
                   "Illegal PMC enum (%d) in new", (int)$2);
  }

  /* Why?? If we're creating a continuation, the continuation PMC
   * needs to be in the destination register before its init method
   * copies the registers. */
  $1 = pmc_new_noinit(interp, $2);
  $1->vtable->init(interp, $1);
  goto NEXT();
}

op new(out PMC, in INT, in PMC) {
  if ($2 <= 0 || $2 >= interp->n_vtable_max) {
    real_exception(interp, 0, NO_CLASS,
                   "Illegal PMC enum (%d) in new", (int)$2);
  }
  $1 = pmc_new_init(interp, $2, $3);
  goto NEXT();
}

op new(out PMC, inconst STR) {
    STRING *class = $2;
    INTVAL type = pmc_type(interp, class);
    if (!type)
        type = pmc_type(interp, class);
    if (type <= 0)
        real_exception(interp, NULL, NO_CLASS,
            "Class '%Ss' not found", class);
  $1 = pmc_new(interp, type);
  goto NEXT();
}

op new(out PMC, inconst STR, in PMC) {
    STRING *class = $2;
    INTVAL type = pmc_type(interp, class);
    if (!type)
        type = pmc_type(interp, class);
    if (type <= 0)
        real_exception(interp, NULL, NO_CLASS,
            "Class '%Ss' not found", class);
    $1 = pmc_new_init(interp, type, $3);
    goto NEXT();
}

inline op new(out PMC, inconst PMC) :object_classes {
    PMC *class = $2;
    INTVAL type = pmc_type_p(interp, class);
    if (type <= 0)
        real_exception(interp, NULL, NO_CLASS,
            "Class '%Ss' not found", readable_name(interp, class));
    $1 = pmc_new(interp, type);
    goto NEXT();
}

op new(out PMC, inconst PMC, in PMC) {
    PMC *class = $2;
    INTVAL type = pmc_type_p(interp, class);
    if (type <= 0)
        real_exception(interp, NULL, NO_CLASS,
            "Class '%Ss' not found", readable_name(interp, class));
    $1 = pmc_new_init(interp, type, $3);
    goto NEXT();
}

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

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

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

Return the type of PMC in $2.

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

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

Return the type of the entry in aggregate PMC in $2 at key $3.

=cut

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

inline op typeof (out INT, invar PMC) {
  $1 = $2->vtable->type(interp, $2);
  goto NEXT();
}

inline op typeof (out INT, invar PMC, in KEY) {
  $1 = $2->vtable->type_keyed(interp, $2, $3);
  goto NEXT();
}

inline op typeof (out INT, invar PMC, in INTKEY) {
  $1 = $2->vtable->type_keyed_int(interp, $2, $3);
  goto NEXT();
}
########################################

=item B<typeof>(out STR, in INT)

Return the (native) Parrot type of datatype $2.

=cut

inline op typeof(out STR, in INT) {
    if ($2 > 0 && $2 < interp->n_vtable_max)
                $1 = interp->vtables[$2]->whoami;
    else
                $1 = Parrot_get_datatype_name(interp, $2);
    goto NEXT();
}

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

=item B<find_type>(out INT, in STR)

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

Find the PMC type or Parrot datatype by name.

=cut

op find_type(out INT, in STR) {
    $1 = pmc_type(interp, $2);
    goto NEXT();
}

op find_type(out INT, in PMC) {

    /* KLUDGE ALERT - XXX FIXME - THIS LOGIC SHOULD BE IN pmc_type_p() */

    INTVAL n;

    if ($2->vtable->base_type == enum_class_String)
        $1 = pmc_type(interp, VTABLE_get_string(interp, $2));
    else if ($2->vtable->base_type == enum_class_Key)
        $1 = pmc_type_p(interp, $2);
    else if ((n = VTABLE_elements(interp, $2)) <= 0)
        $1 = 0;
    else {
        PMC *class = interp->class_hash;
        INTVAL i;
        for (i = 0; i < n; ++i) {
            STRING *part = VTABLE_get_string_keyed_int(interp, $2, i);
            class = VTABLE_get_pmc_keyed_str(interp, class, part);
            if (PMC_IS_NULL(class))
                break;
        }
        $1 = PMC_IS_NULL(class) ? 0 : PMC_int_val(class);
    }
    goto NEXT();
}

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

=item B<valid_type>(out INT, in INT)

Check if the PMC type or Parrot datatype $2 is valid.

=cut

op valid_type(out INT, in INT) {
    if ($2 > 0 && $2 < interp->n_vtable_max)
        $1 = 1;
    else if ($2 >= enum_first_type && $2 < enum_last_type)
        $1 = 1;
    else
        $1 = 0;
    goto NEXT();
}


=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 = $2->vtable->get_repr(interp, $2);
    goto NEXT();
}

=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) {
    opcode_t * resume = expr NEXT();
    $1 = $2->vtable->find_method(interp, $2, $3);
    if (!$1 || !VTABLE_defined(interp, $1))
        real_exception(interp, resume, METH_NOT_FOUND,
            "Method '%s' not found", string_to_cstring(interp, $3));
    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 : $2->vtable->defined(interp, $2);
  goto NEXT();
}

inline op defined(out INT, invar PMC, in INTKEY) {
  $1 = PMC_IS_NULL($2) ? 0 : $2->vtable->defined_keyed_int(interp, $2, $3);
  goto NEXT();
}

inline op defined(out INT, invar PMC, in KEY) {
  $1 = PMC_IS_NULL($2) ? 0 : $2->vtable->defined_keyed(interp, $2, $3);
  goto NEXT();
}

inline op exists(out INT, invar PMC, in INTKEY) {
  $1 = PMC_IS_NULL($2) ? 0 : $2->vtable->exists_keyed_int(interp, $2, $3);
  goto NEXT();
}

inline op exists(out INT, invar PMC, in KEY) {
  $1 = PMC_IS_NULL($2) ? 0: $2->vtable->exists_keyed(interp, $2, $3);
  goto NEXT();
}

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

=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) {
  $1->vtable->delete_keyed(interp, $1, $2);
  goto NEXT();
}

inline op delete(invar PMC, in INTKEY) {
  $1->vtable->delete_keyed_int(interp, $1, $2);
  goto NEXT();
}

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

=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);
  goto NEXT();
}

=back

=cut

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

=head2 Fast access ops

The fast access ops are shortcuts to common operations implemented invar 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) {
    $1->vtable->push_integer(interp, $1, $2);
    goto NEXT();
}

inline op push (invar PMC, in NUM) {
    $1->vtable->push_float(interp, $1, $2);
    goto NEXT();
}

inline op push (invar PMC, in STR) {
    $1->vtable->push_string(interp, $1, $2);
    goto NEXT();
}

inline op push (invar PMC, invar PMC) {
    $1->vtable->push_pmc(interp, $1, $2);
    goto NEXT();
}

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

=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 = $2->vtable->pop_integer(interp, $2);
    goto NEXT();
}

inline op pop (out NUM, invar PMC) {
    $1 = $2->vtable->pop_float(interp, $2);
    goto NEXT();
}

inline op pop (out STR, invar PMC) {
    $1 = $2->vtable->pop_string(interp, $2);
    goto NEXT();
}

inline op pop (out PMC, invar PMC) {
    $1 = $2->vtable->pop_pmc(interp, $2);
    goto NEXT();
}

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

=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) {
    $1->vtable->unshift_integer(interp, $1, $2);
    goto NEXT();
}

inline op unshift (invar PMC, in NUM) {
    $1->vtable->unshift_float(interp, $1, $2);
    goto NEXT();
}

inline op unshift (invar PMC, in STR) {
    $1->vtable->unshift_string(interp, $1, $2);
    goto NEXT();
}

inline op unshift (invar PMC, invar PMC) {
    $1->vtable->unshift_pmc(interp, $1, $2);
    goto NEXT();
}

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

=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 = $2->vtable->shift_integer(interp, $2);
    goto NEXT();
}

inline op shift (out NUM, invar PMC) {
    $1 = $2->vtable->shift_float(interp, $2);
    goto NEXT();
}

inline op shift (out STR, invar PMC) {
    $1 = $2->vtable->shift_string(interp, $2);
    goto NEXT();
}

inline op shift (out PMC, invar PMC) {
    $1 = $2->vtable->shift_pmc(interp, $2);
    goto NEXT();
}


=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) {
      $1->vtable->setprop(interp, $1, $2, $3);
      goto NEXT();
}

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

=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 = $3->vtable->getprop(interp, $3, $2);
   goto NEXT();
}

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

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

Delete property $2 from PMC $1.

=cut

op delprop(invar PMC, in STR) {
   $1->vtable->delprop(interp, $1, $2);
   goto NEXT();
}

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

=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 = $2->vtable->getprops(interp, $2);
   goto NEXT();
}

=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);
   goto NEXT();
}

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

=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<mmdvtregister>(in INT, in INT, in INT, invar PMC)

Register method $4 as the MMD method for vtable entry $1 for classes
$2 and $3.

=cut

inline op mmdvtregister(in INT, in INT, in INT, invar PMC) {
  mmd_register_sub(interp, $1, $2, $3, $4);
  goto NEXT();
}

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

Find the sub that would be called for vtable entry $2 for types $3 and $4.

=cut

inline op mmdvtfind(out PMC, in INT, in INT, in INT) {
  $1 = mmd_vtfind(interp, $2, $3, $4);
  goto NEXT();
}

=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);
  goto NEXT();
}

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

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

Set $1 to the hash value of $2.

=cut

op hash(out INT, invar PMC) {
  $1 = VTABLE_hash(interp, $2, 0);   /* XXX */
  goto NEXT();
}

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

Set $1 to the mro array of the PMC $2. Please note that this is a
direct reference so messing with it can do harm to the method lookup.

=cut

op get_mro(out PMC, invar PMC) {
  $1 = $2->vtable->mro;
  goto NEXT();
}

=back

=head1 COPYRIGHT

Copyright (C) 2001-2007, 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:
 */
