[svn:parrot] r46954 - branches/ops_massacre/src/dynoplibs

plobsing at svn.parrot.org plobsing at svn.parrot.org
Mon May 24 10:25:45 UTC 2010


Author: plobsing
Date: Mon May 24 10:25:44 2010
New Revision: 46954
URL: https://trac.parrot.org/parrot/changeset/46954

Log:
add bitops dynops source (oops)

Added:
   branches/ops_massacre/src/dynoplibs/bit.ops

Added: branches/ops_massacre/src/dynoplibs/bit.ops
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/ops_massacre/src/dynoplibs/bit.ops	Mon May 24 10:25:44 2010	(r46954)
@@ -0,0 +1,413 @@
+/*
+ * $Id$
+** bit.ops
+*/
+
+BEGIN_OPS_PREAMBLE
+ /* Signed shift operator that is compatible with PMC shifts.  This is
+  * guaranteed to produce the same result as bitwise_left_shift_internal modulo
+  * word size, ignoring the fact that Parrot integers are always signed.  This
+  * usually gives the same answer regardless whether you shift PMC operands and
+  * then assign to an I-reg, or move the operands to I-regs and do the shift
+  * there -- except when the true result is between 2^{w-1} and 2^w (where w is
+  * the word size), in which case the high order bit is taken as the sign,
+  * giving a truncated result that is 2^w lower.
+  */
+#define bit_shift_left(number, bits) \
+    ((bits) >= 8*INTVAL_SIZE     ? 0                    \
+     : (bits) >= 0               ? (number) << (bits)   \
+     : (bits) > -8*INTVAL_SIZE   ? (number) >> -(bits)   \
+     : 0)
+
+END_OPS_PREAMBLE
+
+=head1 NAME
+
+bit.ops - Bitwise Opcodes Dynoplib
+
+=head1 DESCRIPTION
+
+Operations that deal with bits directly, either individually
+or in groups.
+
+The variant with an appended B<s> like B<bands> work on strings.
+
+=over 4
+
+=cut
+
+########################################
+
+=item B<bors>(invar PMC, in STR)
+
+=item B<bors>(invar PMC, invar PMC)
+
+Set the bits of $1 according to the B<or> of the corresponding bits
+from $1 and $2.
+
+=item B<bors>(out STR, in STR, in STR)
+
+=item B<bors>(invar PMC, invar PMC, in STR)
+
+=item B<bors>(invar PMC, invar PMC, invar PMC)
+
+Set the bits of $1 according to the B<or> of the corresponding bits
+from $2 and $3.
+
+=cut
+
+inline op bors(invar PMC, in STR) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $1);
+    STRING * const b = Parrot_str_bitwise_or(interp, a, $2);
+    VTABLE_set_string_native(interp, $1, b);
+}
+
+inline op bors(invar PMC, invar PMC) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $1);
+    STRING * const b = VTABLE_get_string(interp, $2);
+    STRING * const c = Parrot_str_bitwise_or(interp, a, b);
+    VTABLE_set_string_native(interp, $1, c);
+}
+
+inline op bors(out STR, in STR, in STR) :base_core {
+    $1 = Parrot_str_bitwise_or(interp, $2, $3);
+}
+
+inline op bors(invar PMC, invar PMC, in STR) :base_core {
+    STRING * const b = VTABLE_get_string(interp, $2);
+    STRING * const c = Parrot_str_bitwise_or(interp, b, $3);
+    VTABLE_set_string_native(interp, $1, c);
+}
+
+inline op bors(invar PMC, invar PMC, invar PMC) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $2);
+    STRING * const b = VTABLE_get_string(interp, $3);
+    STRING * const c = Parrot_str_bitwise_or(interp, a, b);
+    VTABLE_set_string_native(interp, $1, c);
+}
+
+########################################
+
+=item B<shl>(invar PMC, in INT)
+
+=item B<shl>(invar PMC, invar PMC)
+
+Shift left $1 by $2 bits.
+
+=item B<shl>(invar PMC, invar PMC, in INT)
+
+=item B<shl>(invar PMC, invar PMC, invar PMC)
+
+Set $1 to the value of $2 shifted left by $3 bits.
+
+=cut
+
+inline op shl(invar PMC, in INT) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $1);
+    const INTVAL b = bit_shift_left(a, $2);
+    VTABLE_set_integer_native(interp, $1, b);
+}
+
+inline op shl(invar PMC, invar PMC) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $1);
+    const INTVAL b = VTABLE_get_integer(interp, $2);
+    const INTVAL c = bit_shift_left(a, b);
+    VTABLE_set_integer_native(interp, $1, c);
+}
+
+inline op shl(invar PMC, invar PMC, in INT) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $2);
+    const INTVAL b = bit_shift_left(a, $3);
+    VTABLE_set_integer_native(interp, $1, b);
+}
+
+inline op shl(invar PMC, invar PMC, invar PMC) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $2);
+    const INTVAL b = VTABLE_get_integer(interp, $3);
+    const INTVAL c = bit_shift_left(a, b);
+    VTABLE_set_integer_native(interp, $1, c);
+}
+
+########################################
+
+=item B<shr>(invar PMC, in INT)
+
+=item B<shr>(invar PMC, invar PMC)
+
+Shift right $1 by $2 bits.
+
+=item B<shr>(invar PMC, invar PMC, in INT)
+
+=item B<shr>(invar PMC, invar PMC, invar PMC)
+
+Set $1 to the value of $2 shifted right by $3 bits.
+
+=cut
+
+inline op shr(invar PMC, in INT) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $1);
+    const INTVAL b = bit_shift_left(a, -$2);
+    VTABLE_set_integer_native(interp, $1, b);
+}
+
+inline op shr(invar PMC, invar PMC) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $1);
+    const INTVAL b = VTABLE_get_integer(interp, $2);
+    const INTVAL c = bit_shift_left(a, -b);
+    VTABLE_set_integer_native(interp, $1, c);
+}
+
+inline op shr(invar PMC, invar PMC, in INT) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $2);
+    const INTVAL c = bit_shift_left(a, -$3);
+    VTABLE_set_integer_native(interp, $1, c);
+}
+
+inline op shr(invar PMC, invar PMC, invar PMC) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $2);
+    const INTVAL b = VTABLE_get_integer(interp, $3);
+    const INTVAL c = bit_shift_left(a, -b);
+    VTABLE_set_integer_native(interp, $1, c);
+}
+
+########################################
+
+=item B<bnot>(inout INT)
+
+=item B<bnot>(invar PMC)
+
+Sets $1 to C<bitwise not> $1 inplace.
+
+=item B<bnot>(out INT, in INT)
+
+=item B<bnot>(out PMC, invar PMC)
+
+=cut
+
+inline op bnot(inout INT) :base_core {
+    $1 = ~ $1;
+}
+
+inline op bnot(out INT, in INT) :base_core {
+    $1 = ~ $2;
+}
+
+inline op bnot(invar PMC) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $1);
+    VTABLE_set_integer_native(interp, $1, ~a);
+}
+
+inline op bnot(out PMC, invar PMC) :base_core {
+    const INTVAL a = VTABLE_get_integer(interp, $2);
+    PMC * const b = Parrot_pmc_new(interp, VTABLE_type(interp, $2));
+    VTABLE_set_integer_native(interp, b, ~a);
+    $1 = b;
+}
+
+=item B<bnots>(invar PMC)
+
+=item B<bnots>(out STR, in STR)
+
+=item B<bnots>(out PMC, invar PMC)
+
+=cut
+
+inline op bnots(out STR, in STR) :base_core {
+    $1 = Parrot_str_bitwise_not(interp, $2);
+}
+
+inline op bnots(invar PMC) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $1);
+    STRING * const b = Parrot_str_bitwise_not(interp, a);
+    VTABLE_set_string_native(interp, $1, b);
+}
+
+inline op bnots(out PMC, invar PMC) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $2);
+    STRING * const b = Parrot_str_bitwise_not(interp, a);
+    VTABLE_set_string_native(interp, $1, b);
+}
+
+########################################
+
+=item B<lsr>(invar PMC, in INT)
+
+=item B<lsr>(invar PMC, invar PMC)
+
+Shift $1 logically shifted right by $2 bits.
+
+=item B<lsr>(invar PMC, invar PMC, in INT)
+
+=item B<lsr>(invar PMC, invar PMC, invar PMC)
+
+Set $1 to the value of $2 logically shifted right by $3 bits.
+
+=cut
+
+inline op lsr(invar PMC, in INT) :base_core {
+    const UINTVAL a = (UINTVAL)VTABLE_get_integer(interp, $1);
+    const UINTVAL b = a >> $2;
+    VTABLE_set_integer_native(interp, $1, (INTVAL)b);
+}
+
+inline op lsr(invar PMC, invar PMC) :base_core {
+    const UINTVAL a = (UINTVAL)VTABLE_get_integer(interp, $1);
+    const UINTVAL b = (UINTVAL)VTABLE_get_integer(interp, $2);
+    const UINTVAL c = a >> b;
+    VTABLE_set_integer_native(interp, $1, (INTVAL)c);
+}
+
+inline op lsr(invar PMC, invar PMC, in INT) :base_core {
+    const UINTVAL a = (UINTVAL)VTABLE_get_integer(interp, $2);
+    const UINTVAL b = (UINTVAL)$3;
+    const UINTVAL c = a >> b;
+    VTABLE_set_integer_native(interp, $1, (INTVAL)c);
+}
+
+inline op lsr(invar PMC, invar PMC, invar PMC) :base_core {
+    const UINTVAL a = (UINTVAL)VTABLE_get_integer(interp, $2);
+    const UINTVAL b = (UINTVAL)VTABLE_get_integer(interp, $3);
+    const UINTVAL c = a >> b;
+    VTABLE_set_integer_native(interp, $3, (INTVAL)c);
+}
+
+=item B<rot>(out INT, in INT, in INT, inconst INT)
+
+Rotate $2 left or right by $3 and place result in $1.
+$4 is the amount of bits to rotate, 32 bit on a 32-bit CPU and 32 or 64
+on a 64-bit CPU. If the rotate count is negative a rotate right by ($3+$4)
+is performed.
+
+=cut
+
+inline op rot(out INT, in INT, in INT, inconst INT) {
+    const INTVAL r = $2;
+    INTVAL s = $3;
+    const INTVAL w = $4;
+    INTVAL d, t;
+    if (s < 0)
+        s += w;
+    d = r << s;
+    t = w - s;
+    t = (INTVAL)((UINTVAL)r >> t);
+    d |= t;
+    $1 = d;
+}
+
+########################################
+
+=item B<bxor>(invar PMC, in INT)
+
+=item B<bxor>(invar PMC, invar PMC)
+
+Set the bits of $1 according to the B<xor> of the corresponding bits
+from $1 and $2.
+
+=item B<bxor>(invar PMC, invar PMC, in INT)
+
+=item B<bxor>(invar PMC, invar PMC, invar PMC)
+
+Set the bits of $1 according to the B<xor> of the corresponding bits
+from $2 and $3.
+
+=cut
+
+inline op bxor(invar PMC, in INT) :base_core {
+    const UINTVAL a = (UINTVAL)VTABLE_get_integer(interp, $1);
+    const UINTVAL b = a ^ $2;
+    VTABLE_set_integer_native(interp, $1, (INTVAL)b);
+}
+
+inline op bxor(invar PMC, invar PMC) :base_core {
+    const UINTVAL a = (UINTVAL)VTABLE_get_integer(interp, $1);
+    const UINTVAL b = (UINTVAL)VTABLE_get_integer(interp, $2);
+    const UINTVAL c = a ^ b;
+    VTABLE_set_integer_native(interp, $1, (INTVAL)c);
+}
+
+inline op bxor(invar PMC, invar PMC, in INT) :base_core {
+    const UINTVAL a = (UINTVAL)VTABLE_get_integer(interp, $2);
+    const UINTVAL b = a ^ $3;
+    VTABLE_set_integer_native(interp, $1, (INTVAL)b);
+}
+
+inline op bxor(invar PMC, invar PMC, invar PMC) :base_core {
+    const UINTVAL a = (UINTVAL)VTABLE_get_integer(interp, $2);
+    const UINTVAL b = (UINTVAL)VTABLE_get_integer(interp, $3);
+    const UINTVAL c = a ^ b;
+    VTABLE_set_integer_native(interp, $1, (INTVAL)c);
+}
+
+########################################
+
+=item B<bxors>(invar PMC, in STR)
+
+=item B<bxors>(invar PMC, invar PMC)
+
+Set the bits of $1 according to the B<xor> of the corresponding bits
+from $1 and $2.
+
+=item B<bxors>(out STR, in STR, in STR)
+
+=item B<bxors>(invar PMC, invar PMC, in STR)
+
+=item B<bxors>(invar PMC, invar PMC, invar PMC)
+
+Set the bits of $1 according to the B<xor> of the corresponding bits
+from $2 and $3.
+
+=cut
+
+inline op bxors(invar PMC, in STR) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $1);
+    STRING * const b = Parrot_str_bitwise_xor(interp, a, $2);
+    VTABLE_set_string_native(interp, $1, b);
+}
+
+inline op bxors(invar PMC, invar PMC) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $1);
+    STRING * const b = VTABLE_get_string(interp, $2);
+    STRING * const c = Parrot_str_bitwise_xor(interp, a, b);
+    VTABLE_set_string_native(interp, $1, c);
+}
+
+inline op bxors(out STR, in STR, in STR) :base_core {
+    $1 = Parrot_str_bitwise_xor(interp, $2, $3);
+}
+
+inline op bxors(invar PMC, invar PMC, in STR) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $2);
+    STRING * const b = Parrot_str_bitwise_xor(interp, a, $3);
+    VTABLE_set_string_native(interp, $1, b);
+}
+
+inline op bxors(invar PMC, invar PMC, invar PMC) :base_core {
+    STRING * const a = VTABLE_get_string(interp, $2);
+    STRING * const b = VTABLE_get_string(interp, $3);
+    STRING * const c = Parrot_str_bitwise_xor(interp, a, b);
+    VTABLE_set_string_native(interp, $1, c);
+}
+
+=back
+
+=cut
+
+###############################################################################
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001-2010, Parrot 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:
+ */


More information about the parrot-commits mailing list