/*
 * $Id: /mirror/trunk/src/ops/set.ops 35266 2009-01-09T02:07:32.249591Z coke  $
** set.ops
*/

VERSION = PARROT_VERSION;

=head1 NAME

set.ops - Register Loading Ops

=head1 DESCRIPTION

These operations all set registers to various values.

=over 4

=cut

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

=item B<clone>(out STR, in STR)

Make a clone of $2, and put it in $1. Doesn't affect what was in
$1. Removes the constant flag on the copy, if there was one.

=cut

inline op clone(out STR, in STR) :base_mem {
  $1 = string_copy(interp, $2);
}



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

=item B<exchange>(inout INT, inout INT)

=item B<exchange>(inout NUM, inout NUM)

=item B<exchange>(inout PMC, inout PMC)

=item B<exchange>(inout STR, inout STR)

Exchange the contents of registers $1 and $2

=cut

op exchange(inout INT, inout INT) :base_core {
   const INTVAL temp = $1;
   $1 = $2;
   $2 = temp;
}

op exchange(inout PMC, inout PMC) :base_core {
   PMC * const temp = $1;
   $1 = $2;
   $2 = temp;
}

op exchange(inout NUM, inout NUM) :base_core {
   FLOATVAL temp = $1;
   $1 = $2;
   $2 = temp;
}

op exchange(inout STR, inout STR) :base_core {
   STRING * const temp = $1;
   $1 = $2;
   $2 = temp;
}

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

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

=item B<set>(out INT, in NUM)

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

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

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

=item B<set>(out NUM, in INT)

=item B<set>(out NUM, in NUM)

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

=item B<set>(out NUM, in STR)

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

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

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

=item B<set>(invar PMC, invar STR)

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

=item B<set>(out STR, in NUM)

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

=item B<set>(out STR, inconst STR)

=item B<set>(out STR, invar STR)

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

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

Set $1 to $2.

=cut

inline op set(out INT, in INT) :base_core {
  $1 = $2;
}

inline op set(out INT, in NUM) :base_core {
  $1 = (INTVAL)($2);
}

inline op set(out INT, in STR) :base_core {
  $1 = string_to_int(interp, $2);
}

inline op set(out NUM, in NUM) :base_core {
  $1 = $2;
}

inline op set(out NUM, in INT) :base_core {
  $1 = (FLOATVAL)$2;
}

inline op set(out NUM, in STR) :base_core {
  $1 = string_to_num(interp, $2);
}

inline op set(out NUM, invar PMC) :base_core {
  $1 = VTABLE_get_number(interp, $2);
}

inline op set(out STR, invar PMC) :base_core {
  $1 = VTABLE_get_string(interp, $2);
}

inline op set(out STR, invar STR) :base_core {
  $1 = $2;
}

inline op set(out STR, inconst STR) :base_core {
  $1 = string_copy(interp, $2);
}

inline op set(out STR, in INT) :base_core {
  $1 = string_from_int(interp, $2);
}

inline op set(out STR, in NUM) :base_core {
  $1 = string_from_num(interp, $2);
}

inline op set(out PMC, inconst PMC) :base_core {
  $1 = $2;
}

inline op set(out PMC, invar PMC) :base_core {
  $1 = $2;
}

inline op set(invar PMC, in INT) :base_core {
  VTABLE_set_integer_native(interp, $1, $2);
}

inline op set(invar PMC, in NUM) :base_core {
  VTABLE_set_number_native(interp, $1, $2);
}

inline op set(invar PMC, invar STR) :base_core {
  VTABLE_set_string_native(interp, $1, $2);
}

inline op set(invar PMC, inconst STR) :base_core {
  VTABLE_set_string_native(interp, $1,
    string_copy(interp, $2));
}
inline op set(out INT, invar PMC) :base_core {
  $1 = VTABLE_get_integer(interp, $2);
}

=back

=cut

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

=head2 PMC assignment operations: Px = x

=over 4

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

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

Assign a new value $2, to PMC $1. Same as the equivalent B<set> opcodes.

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

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

Assign a new value $2, to PMC $1 by copying the value.

=item B<assign>(out STR, in STR)

Assign a new value to a string by reusing the string header.

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

Make $1 refer to $2 by calling C<set_pmc>.

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

Not strictly an assignment operation: Put into $1 the PMC that the
reference PMC $2 refers to.

=cut

inline op assign(invar PMC, invar PMC) :base_core {
  VTABLE_assign_pmc(interp, $1, $2);
}

inline op assign(invar PMC, in INT) :base_core {
  VTABLE_set_integer_native(interp, $1, $2);
}

inline op assign(invar PMC, in NUM) :base_core {
  VTABLE_set_number_native(interp, $1, $2);
}

inline op assign(invar PMC, in STR) :base_core {
  VTABLE_assign_string_native(interp, $1, $2);
}

inline op assign(out STR, in STR) :base_core {
  $1 = string_set(interp, $1, $2);
}

inline op setref(invar PMC, invar PMC) :base_core {
  VTABLE_set_pmc(interp, $1, $2);
}

inline op deref(out PMC, invar PMC) :base_ref {
  $1 = VTABLE_get_pmc(interp, $2);
}

=back

=head2 Indirect PMC register set

=over 4

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

Set the PMC in register $1 to $2.
Please note, that the register allocator doesn't track the usage of the
affected register - handle with care.

=cut

inline op setp_ind(in INT, invar PMC) :base_ref {
    if ($1 < 0 || $1 >= NUM_REGISTERS)
        PANIC(interp, "Out of bound register access");
    REG_PMC(interp, $1) = $2;
}

=item B<setn_ind>(in INT, in NUM)

Set the number in register $1 to $2.
Please note, that the register allocator doesn't track the usage of the
affected register - handle with care.

=cut

inline op setn_ind(in INT, in NUM) :base_ref {
    if ($1 < 0 || $1 >= NUM_REGISTERS)
        PANIC(interp, "Out of bound register access");
    REG_NUM(interp, $1) = $2;
}

=item B<sets_ind>(in INT, in STR)

Set the string in register $1 to $2.
Please note, that the register allocator doesn't track the usage of the
affected register - handle with care.

=cut

inline op sets_ind(in INT, in STR) :base_ref {
    if ($1 < 0 || $1 >= NUM_REGISTERS)
        PANIC(interp, "Out of bound register access");
    REG_STR(interp, $1) = $2;
}

=item B<seti_ind>(in INT, in INT)

Set the int in register $1 to $2.
Please note, that the register allocator doesn't track the usage of the
affected register - handle with care.

=cut

inline op seti_ind(in INT, in INT) :base_ref {
    if ($1 < 0 || $1 >= NUM_REGISTERS)
        PANIC(interp, "Out of bound register access");
    REG_INT(interp, $1) = $2;
}

=back

=cut

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

=head2 Keyed set operations: Px[ INTKEY ] = Bx

=over 4

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

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

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

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

=cut

inline op set(invar PMC, in INTKEY, in INT) :base_core {
    VTABLE_set_integer_keyed_int(interp, $1, $2, $3);
}

inline op set(invar PMC, in INTKEY, in NUM) :base_core {
    VTABLE_set_number_keyed_int(interp, $1, $2, $3);
}

inline op set(invar PMC, in INTKEY, in STR) :base_core {
    VTABLE_set_string_keyed_int(interp, $1, $2, $3);
}

inline op set(invar PMC, in INTKEY, invar PMC) :base_core {
    VTABLE_set_pmc_keyed_int(interp, $1, $2, $3);
}

=back

=cut

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

=head2 Keyed get operations: Ax = Px[ INTKEY ]

=over 4

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

=item B<set>(out NUM, invar PMC, in INTKEY)

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

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

=cut

inline op set(out INT, invar PMC, in INTKEY) :base_core {
    $1 = VTABLE_get_integer_keyed_int(interp, $2, $3);
}

inline op set(out NUM, invar PMC, in INTKEY) :base_core {
    $1 = VTABLE_get_number_keyed_int(interp, $2, $3);
}

inline op set(out STR, invar PMC, in INTKEY) :base_core {
    $1 = VTABLE_get_string_keyed_int(interp, $2, $3);
}

inline op set(out PMC, invar PMC, in INTKEY) :base_core {
    $1 = VTABLE_get_pmc_keyed_int(interp, $2, $3);
}

=back

=cut

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

=head2 Keyed set operations: Px[ KEY ] = Bx

=over 4

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

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

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

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

=cut

inline op set(invar PMC, in KEY, in INT) :base_core {
    VTABLE_set_integer_keyed(interp, $1, $2, $3);
}

inline op set(invar PMC, in KEY, in NUM) :base_core {
    VTABLE_set_number_keyed(interp, $1, $2, $3);
}

inline op set(invar PMC, in KEY, in STR) :base_core {
    VTABLE_set_string_keyed(interp, $1, $2, $3);
}

inline op set(invar PMC, in KEY, invar PMC) :base_core {
    VTABLE_set_pmc_keyed(interp, $1, $2, $3);
}

=back

=cut

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

=head2 Keyed get operations: Ax = Px[ KEY ]

=over 4

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

=item B<set>(out NUM, invar PMC, in KEY)

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

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

=cut

inline op set(out INT, invar PMC, in KEY) :base_core {
    $1 = VTABLE_get_integer_keyed(interp, $2, $3);
}

inline op set(out NUM, invar PMC, in KEY) :base_core {
    $1 = VTABLE_get_number_keyed(interp, $2, $3);
}

inline op set(out STR, invar PMC, in KEY) :base_core {
    $1 = VTABLE_get_string_keyed(interp, $2, $3);
}

inline op set(out PMC, invar PMC, in KEY) :base_core {
    $1 = VTABLE_get_pmc_keyed(interp, $2, $3);
}

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

Makes a copy of the PMC in $2 and puts it in $1.

=cut

inline op clone(out PMC, invar PMC) :base_mem {
  $1 = VTABLE_clone(interp, $2);
}

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

Makes a copy of the PMC in $2 and puts it in $1, using the arguments in $3.

=cut

inline op clone(out PMC, invar PMC, in PMC) :base_mem {
  $1 = VTABLE_clone_pmc(interp, $2, $3);
}

=item B<copy>(inout PMC, invar PMC)

Morphs the PMC in $1 to the type of the PMC in $2, then assigns $2 to $1.

=cut

inline op copy(inout PMC, invar PMC) :base_mem {
  PMC   * const clone = VTABLE_clone(interp, $2);
  INTVAL type         = VTABLE_type(interp, $2);

  /* Preserve the metadata on the destination. */
  PMC   * const meta  = VTABLE_getprops(interp, $1);

  /* avoid leaks and unreachable memory by destroying the destination PMC */
  if (PObj_active_destroy_TEST($1))
      VTABLE_destroy(interp, $1);

  /* the source PMC knows how to clone itself, but we must reuse the
   destination header */
  memmove($1, clone, sizeof (PMC));

  /* don't let the clone's destruction destroy the destination's data */
  PObj_active_destroy_CLEAR(clone);
  if (PObj_is_PMC_EXT_TEST(clone))
    clone->pmc_ext = NULL;

  /* Restore metadata. */
  if (!PMC_IS_NULL(meta)) {
      PMC * const iter = VTABLE_get_iter(interp, meta);
      while (VTABLE_get_bool(interp, iter)) {
          STRING * const key = VTABLE_shift_string(interp, iter);
          PMC * const value  = VTABLE_get_pmc_keyed_str(interp, meta, key);
          VTABLE_setprop(interp, $1, key, value);
      }
  }
}

=back

=cut

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

=head2 Register operations

These operations effect entire sets of registers.

=over 4

=cut

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

=item B<null>(out INT)

=item B<null>(out NUM)

Set register $1 to zero.

=item B<null>(out STR)

Set register $1 to a NULL string value.

=item B<null>(out PMC)

Set register $1 to PMCNULL.

=cut

inline op null(out STR) :base_core {
  $1 = NULL;
}

inline op null(out INT) :base_core {
  $1 = 0;
}

inline op null(out PMC) :base_core {
  $1 = PMCNULL;
}

inline op null(out NUM) :base_core {
  $1 = 0;
}

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

=item B<cleari>()

=item B<clearn>()

=item B<clearp>()

=item B<clears>()

Clear all the registers of the type indicated in the name of the operation.

INTVAL ('i') and FLOATVAL ('n') registers clear to zero.

PMC ('p') and STRING ('s') registers clear to NULL.

=cut

inline op cleari() :base_core {
  Parrot_clear_i(interp);
}

inline op clearn() :base_core {
  Parrot_clear_n(interp);
}

inline op clears() :base_core {
  Parrot_clear_s(interp);
}

inline op clearp() :base_core {
  Parrot_clear_p(interp);
}

=back

=cut

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

=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:
 */
