cvsuser 03/08/08 01:44:15
Modified: . bit.ops string.c
t/op string.t
Log:
bitwise string xor by Vladimir Lipskiy
Revision Changes Path
1.3 +48 -0 parrot/bit.ops
Index: bit.ops
===================================================================
RCS file: /cvs/public/parrot/bit.ops,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- bit.ops 5 Aug 2003 13:47:53 -0000 1.2
+++ bit.ops 8 Aug 2003 08:44:13 -0000 1.3
@@ -337,6 +337,54 @@
goto NEXT();
}
+=item B<bxors>(inout STR, in STR)
+
+=item B<bxors>(in PMC, in STR)
+
+=item B<bxors>(in PMC, in 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>(in PMC, in PMC, in STR)
+
+=item B<bxors>(in PMC, in PMC, in PMC)
+
+Set the bits of $1 according to the B<xor> of the corresponding bits from $2 and $3.
+
+=cut
+
+inline op bxors(inout STR, in STR) {
+ string_bitwise_xor(interpreter, $1, $2, &$1);
+ goto NEXT();
+}
+
+inline op bxors(in PMC, in STR) {
+ $1->vtable->bitwise_xors_str(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
+inline op bxors(in PMC, in PMC) {
+ $1->vtable->bitwise_xors(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
+inline op bxors(out STR, in STR, in STR) {
+ $1 = string_bitwise_xor(interpreter, $2, $3, NULL);
+ goto NEXT();
+}
+
+inline op bxors(in PMC, in PMC, in STR) {
+ $2->vtable->bitwise_xors_str(interpreter, $2, $3, $1);
+ goto NEXT();
+}
+
+inline op bxors(in PMC, in PMC, in PMC) {
+ $2->vtable->bitwise_xors(interpreter, $2, $3, $1);
+ goto NEXT();
+}
+
=back
=cut
1.142 +93 -13 parrot/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/string.c,v
retrieving revision 1.141
retrieving revision 1.142
diff -u -w -r1.141 -r1.142
--- string.c 5 Aug 2003 13:47:53 -0000 1.141
+++ string.c 8 Aug 2003 08:44:13 -0000 1.142
@@ -1,7 +1,7 @@
/* string.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: string.c,v 1.141 2003/08/05 13:47:53 leo Exp $
+ * $Id: string.c,v 1.142 2003/08/08 08:44:13 leo Exp $
* Overview:
* This is the api definitions for the string subsystem
* Data Structure and Algorithms:
@@ -1005,10 +1005,6 @@
STRING *res;
size_t len;
- len = s1 ? s1->bufused : 0;
- if (s2 && s2->bufused < len)
- len = s2->bufused;
-
if (dest && *dest)
res = *dest;
else if (!s1 || !s2)
@@ -1030,12 +1026,14 @@
s2 = string_transcode(interpreter, s2, NULL, string_unicode_type,
NULL);
}
- /* get the real len after trancode */
+
len = s1 ? s1->bufused : 0;
if (s2 && s2->bufused < len)
len = s2->bufused;
- if (!dest || *dest)
+ if (!dest || !*dest)
res = string_make(interpreter, NULL, len, s1->encoding, 0, s1->type);
+ else if (res->bufused < len)
+ string_grow(interpreter, res, len - res->bufused);
s1start = s1->strstart;
s2start = s2->strstart;
@@ -1069,15 +1067,94 @@
STRING *res;
size_t len;
+ if (dest && *dest)
+ res = *dest;
+ else if (!s1 && !s2)
+ res = string_make(interpreter, NULL, 0, NULL, 0, NULL);
+
+ if (!s1 && !s2) {
+ res->bufused = 0;
+ res->strlen = 0;
+ return res;
+ }
+
+ /* trigger GC for debug */
+ if (interpreter && GC_DEBUG(interpreter))
+ Parrot_do_dod_run(interpreter, 1);
+
+ if (s1 && s2) {
+ if (s1->type != s2->type || s1->encoding != s2->encoding) {
+ s1 = string_transcode(interpreter, s1, NULL, string_unicode_type,
+ NULL);
+ s2 = string_transcode(interpreter, s2, NULL, string_unicode_type,
+ NULL);
+ }
+ }
+
len = s1 ? s1->bufused : 0;
if (s2 && s2->bufused > len)
len = s2->bufused;
+ if (!dest || !*dest)
+ res = string_make(interpreter, NULL, len,
+ s1 ? s1->encoding : NULL, 0, s1 ? s1->type : NULL);
+ else if (res->bufused < len)
+ string_grow(interpreter, res, len - res->bufused);
+
+ if (s1) {
+ s1start = s1->strstart;
+ s1end = s1start + s1->bufused;
+ res->strlen = s1->strlen;
+ }
+ else
+ s1start = s1end = NULL;
+ if (s2) {
+ s2start = s2->strstart;
+ s2end = s2start + s2->bufused;
+ if (!s1 || s2->strlen > s1->strlen)
+ res->strlen = s2->strlen;
+ }
+ else
+ s2start = s2end = NULL;
+ dp = res->strstart;
+ res->bufused = len;
+
+ for ( ; len ; ++s1start, ++s2start, ++dp, --len) {
+ if (s1start < s1end && s2start < s2end)
+ *dp = *s1start | *s2start;
+ else if (s1start < s1end)
+ *dp = *s1start;
+ else
+ *dp = *s2start;
+ }
+
+ if (dest)
+ *dest = res;
+
+ return res;
+}
+
+/*=for api string string_bitwise_xor
+ * or two strings, performing type and encoding conversions if
+ * necessary. If *dest != NULL reuse dest, else create a new result
+ */
+STRING *
+string_bitwise_xor(struct Parrot_Interp *interpreter, STRING *s1,
+ STRING *s2, STRING **dest)
+{
+ const char *s1start;
+ const char *s2start;
+ const char *s1end;
+ const char *s2end;
+ char *dp;
+ STRING *res;
+ size_t len;
if (dest && *dest)
res = *dest;
- else if (len == 0)
+ else if (!s1 && !s2)
res = string_make(interpreter, NULL, 0, NULL, 0, NULL);
- if (!len) {
+
+ if (!s1 && !s2) {
res->bufused = 0;
res->strlen = 0;
return res;
@@ -1095,6 +1172,7 @@
NULL);
}
}
+
len = s1 ? s1->bufused: 0;
if (s2 && s2->bufused > len)
len = s2->bufused;
@@ -1114,7 +1192,7 @@
if (s2) {
s2start = s2->strstart;
s2end = s2start + s2->bufused;
- if ((s1 && s2->strlen > s1->strlen) || !s1)
+ if (!s1 || s2->strlen > s1->strlen)
res->strlen = s2->strlen;
}
else
@@ -1124,17 +1202,19 @@
for ( ; len ; ++s1start, ++s2start, ++dp, --len) {
if (s1start < s1end && s2start < s2end)
- *dp = *s1start | *s2start;
+ *dp = *s1start ^ *s2start;
else if (s1start < s1end)
*dp = *s1start;
else
*dp = *s2start;
}
+
if (dest)
*dest = res;
return res;
}
+
/* A string is "true" if it is equal to anything but "" and "0" */
INTVAL
string_bool(const STRING *s)
1.53 +84 -1 parrot/t/op/string.t
Index: string.t
===================================================================
RCS file: /cvs/public/parrot/t/op/string.t,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -w -r1.52 -r1.53
--- string.t 5 Aug 2003 13:47:58 -0000 1.52
+++ string.t 8 Aug 2003 08:44:15 -0000 1.53
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 113;
+use Parrot::Test tests => 116;
use Test::More;
output_is( <<'CODE', <<OUTPUT, "set_s_s|sc" );
@@ -1893,6 +1893,89 @@
egc
abc
EE
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bxors NULL string");
+ null S1
+ set S2, ""
+ bxors S1, S2
+ null S3
+ eq S1, S3, ok1
+ print "not "
+ok1: print "ok 1\n"
+ bxors S2, S1
+ eq S2, S3, ok2
+ print "not "
+ok2: print "ok 2\n"
+ null S1
+ set S2, "abc"
+ bxors S1, S2
+ eq S1, "abc", ok3
+ print "not "
+ok3: print "ok 3\n"
+ null S2
+ bxors S1, S2
+ eq S1, "abc", ok4
+ print "not "
+ok4: print "ok 4\n"
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bxors 2");
+ set S1, "a2c"
+ set S2, "Dw"
+ bxors S1, S2
+ print S1
+ print "\n"
+ print S2
+ print "\n"
+ set S1, "abc"
+ set S2, " X"
+ bxors S1, S2
+ print S1
+ print "\n"
+ print S2
+ print "\n"
+ end
+CODE
+%Ec
+Dw
+ABCX
+ X
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bxors 3");
+ set S1, "a2c"
+ set S2, "Dw"
+ bxors S0, S1, S2
+ print S0
+ print "\n"
+ print S1
+ print "\n"
+ print S2
+ print "\n"
+ set S1, "abc"
+ set S2, " Y"
+ bxors S0, S1, S2
+ print S0
+ print "\n"
+ print S1
+ print "\n"
+ print S2
+ print "\n"
+ end
+CODE
+%Ec
+a2c
+Dw
+ABCY
+abc
+ Y
OUTPUT
# Set all string registers to values given by &$_[0](reg num)
