cvsuser 03/08/05 06:47:59
Modified: . bit.ops string.c vtable.tbl
classes default.pmc
include/parrot string_funcs.h
t/op string.t
Log:
bitwise string vtables; ands, ors opcodes
Revision Changes Path
1.2 +98 -1 parrot/bit.ops
Index: bit.ops
===================================================================
RCS file: /cvs/public/parrot/bit.ops,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- bit.ops 22 Jul 2003 16:11:49 -0000 1.1
+++ bit.ops 5 Aug 2003 13:47:53 -0000 1.2
@@ -13,6 +13,8 @@
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
@@ -67,6 +69,54 @@
goto NEXT();
}
+=item B<bands>(inout STR, in STR)
+
+=item B<bands>(in PMC, in STR)
+
+=item B<bands>(in PMC, in PMC)
+
+Set the bits of $1 according to the B<and> of the corresponding bits from $1 and $2.
+
+=item B<bands>(out STR, in STR, in STR)
+
+=item B<bands>(in PMC, in PMC, in STR)
+
+=item B<bands>(in PMC, in PMC, in PMC)
+
+Set the bits of $1 according to the B<and> of the corresponding bits from $2 and $3.
+
+=cut
+
+inline op bands(inout STR, in STR) {
+ string_bitwise_and(interpreter, $1, $2, &$1);
+ goto NEXT();
+}
+
+inline op bands(in PMC, in STR) {
+ $1->vtable->bitwise_ands_str(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
+inline op bands(in PMC, in PMC) {
+ $1->vtable->bitwise_ands(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
+inline op bands(out STR, in STR, in STR) {
+ $1 = string_bitwise_and(interpreter, $2, $3, NULL);
+ goto NEXT();
+}
+
+inline op bands(in PMC, in PMC, in STR) {
+ $2->vtable->bitwise_ands_str(interpreter, $2, $3, $1);
+ goto NEXT();
+}
+
+inline op bands(in PMC, in PMC, in PMC) {
+ $2->vtable->bitwise_ands(interpreter, $2, $3, $1);
+ goto NEXT();
+}
+
########################################
=item B<bnot>(out INT, in INT)
@@ -137,6 +187,53 @@
goto NEXT();
}
+=item B<bors>(inout STR, in STR)
+
+=item B<bors>(in PMC, in STR)
+
+=item B<bors>(in PMC, in 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>(in PMC, in PMC, in STR)
+
+=item B<bors>(in PMC, in PMC, in PMC)
+
+Set the bits of $1 according to the B<or> of the corresponding bits from $2 and $3.
+
+=cut
+
+inline op bors(inout STR, in STR) {
+ string_bitwise_or(interpreter, $1, $2, &$1);
+ goto NEXT();
+}
+
+inline op bors(in PMC, in STR) {
+ $1->vtable->bitwise_ors_str(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
+inline op bors(in PMC, in PMC) {
+ $1->vtable->bitwise_ors(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
+inline op bors(out STR, in STR, in STR) {
+ $1 = string_bitwise_or(interpreter, $2, $3, NULL);
+ goto NEXT();
+}
+
+inline op bors(in PMC, in PMC, in STR) {
+ $2->vtable->bitwise_ors_str(interpreter, $2, $3, $1);
+ goto NEXT();
+}
+
+inline op bors(in PMC, in PMC, in PMC) {
+ $2->vtable->bitwise_ors(interpreter, $2, $3, $1);
+ goto NEXT();
+}
########################################
=item B<shl>(out INT, in INT, in INT)
1.141 +145 -1 parrot/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/string.c,v
retrieving revision 1.140
retrieving revision 1.141
diff -u -w -r1.140 -r1.141
--- string.c 28 Jul 2003 23:03:45 -0000 1.140
+++ string.c 5 Aug 2003 13:47:53 -0000 1.141
@@ -1,7 +1,7 @@
/* string.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: string.c,v 1.140 2003/07/28 23:03:45 scog Exp $
+ * $Id: string.c,v 1.141 2003/08/05 13:47:53 leo Exp $
* Overview:
* This is the api definitions for the string subsystem
* Data Structure and Algorithms:
@@ -991,6 +991,150 @@
return cmp;
}
+/*=for api string string_bitwise_and
+ * and two strings, performing type and encoding conversions if
+ * necessary. If *dest != NULL reuse dest, else create a new result
+ */
+STRING *
+string_bitwise_and(struct Parrot_Interp *interpreter, STRING *s1,
+ STRING *s2, STRING **dest)
+{
+ const char *s1start;
+ const char *s2start;
+ char *dp;
+ 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)
+ 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->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);
+ }
+ /* get the real len after trancode */
+ len = s1 ? s1->bufused : 0;
+ if (s2 && s2->bufused < len)
+ len = s2->bufused;
+ if (!dest || *dest)
+ res = string_make(interpreter, NULL, len, s1->encoding, 0, s1->type);
+
+ s1start = s1->strstart;
+ s2start = s2->strstart;
+ dp = res->strstart;
+ res->bufused = len;
+
+ for ( ; len ; ++s1start, ++s2start, ++dp, --len)
+ *dp = *s1start & *s2start;
+ res->strlen = s1->strlen;
+ if (s2->strlen < s1->strlen)
+ res->strlen = s2->strlen;
+
+ if (dest)
+ *dest = res;
+ return res;
+}
+
+/*=for api string string_bitwise_or
+ * or two strings, performing type and encoding conversions if
+ * necessary. If *dest != NULL reuse dest, else create a new result
+ */
+STRING *
+string_bitwise_or(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;
+
+ len = s1 ? s1->bufused : 0;
+ if (s2 && s2->bufused > len)
+ len = s2->bufused;
+
+ if (dest && *dest)
+ res = *dest;
+ else if (len == 0)
+ res = string_make(interpreter, NULL, 0, NULL, 0, NULL);
+ if (!len) {
+ 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) || !s1)
+ 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;
+}
/* A string is "true" if it is equal to anything but "" and "0" */
INTVAL
string_bool(const STRING *s)
1.40 +13 -1 parrot/vtable.tbl
Index: vtable.tbl
===================================================================
RCS file: /cvs/public/parrot/vtable.tbl,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -w -r1.39 -r1.40
--- vtable.tbl 9 Jul 2003 10:31:51 -0000 1.39
+++ vtable.tbl 5 Aug 2003 13:47:53 -0000 1.40
@@ -1,4 +1,4 @@
-# $Id: vtable.tbl,v 1.39 2003/07/09 10:31:51 leo Exp $
+# $Id: vtable.tbl,v 1.40 2003/08/05 13:47:53 leo Exp $
void init()
void init_pmc(PMC* initializer)
@@ -183,6 +183,18 @@
void bitwise_xor(PMC* value, PMC* dest)
void bitwise_xor_int(INTVAL value, PMC* dest)
void bitwise_xor_same(PMC* value, PMC* dest)
+
+void bitwise_ors(PMC* value, PMC* dest)
+void bitwise_ors_str(STRING* value, PMC* dest)
+void bitwise_ors_same(PMC* value, PMC* dest)
+
+void bitwise_ands(PMC* value, PMC* dest)
+void bitwise_ands_str(STRING* value, PMC* dest)
+void bitwise_ands_same(PMC* value, PMC* dest)
+
+void bitwise_xors(PMC* value, PMC* dest)
+void bitwise_xors_str(STRING* value, PMC* dest)
+void bitwise_xors_same(PMC* value, PMC* dest)
void bitwise_not(PMC* dest)
1.57 +55 -1 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -w -r1.56 -r1.57
--- default.pmc 21 Jul 2003 18:00:29 -0000 1.56
+++ default.pmc 5 Aug 2003 13:47:55 -0000 1.57
@@ -1,6 +1,6 @@
/* default.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
- * CVS Info $Id: default.pmc,v 1.56 2003/07/21 18:00:29 chromatic Exp $
+ * CVS Info $Id: default.pmc,v 1.57 2003/08/05 13:47:55 leo Exp $
* Overview:
* These are the vtable functions for the default PMC class
* Data Structure and Algorithms:
@@ -795,6 +795,24 @@
caller(INTERP, SELF));
}
+ void bitwise_ors (PMC* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_ors() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
+
+ void bitwise_ors_str (STRING* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_ors_str() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
+
+ void bitwise_ors_same (PMC* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_ors_same() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
+
void bitwise_and (PMC* value, PMC* dest) {
internal_exception(ILL_INHERIT,
"bitwise_and() not implemented in class '%s'\n",
@@ -813,6 +831,24 @@
caller(INTERP, SELF));
}
+ void bitwise_ands (PMC* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_ands() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
+
+ void bitwise_ands_str (STRING* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_ands_str() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
+
+ void bitwise_ands_same (PMC* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_ands_same() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
+
void bitwise_xor (PMC* value, PMC* dest) {
internal_exception(ILL_INHERIT,
"bitwise_xor() not implemented in class '%s'\n",
@@ -831,6 +867,24 @@
caller(INTERP, SELF));
}
+
+ void bitwise_xors (PMC* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_xors() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
+
+ void bitwise_xors_str (STRING* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_xors_str() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
+
+ void bitwise_xors_same (PMC* value, PMC* dest) {
+ internal_exception(ILL_INHERIT,
+ "bitwise_xors_same() not implemented in class '%s'\n",
+ caller(INTERP, SELF));
+ }
void bitwise_not (PMC* dest) {
internal_exception(ILL_INHERIT,
1.28 +7 -1 parrot/include/parrot/string_funcs.h
Index: string_funcs.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/string_funcs.h,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- string_funcs.h 28 Jul 2003 02:52:32 -0000 1.27
+++ string_funcs.h 5 Aug 2003 13:47:57 -0000 1.28
@@ -1,7 +1,7 @@
/* string_funcs.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: string_funcs.h,v 1.27 2003/07/28 02:52:32 scog Exp $
+ * $Id: string_funcs.h,v 1.28 2003/08/05 13:47:57 leo Exp $
* Overview:
* This is the api header for the string subsystem
* Data Structure and Algorithms:
@@ -61,6 +61,12 @@
void string_cstring_free(void *);
void string_pin(struct Parrot_Interp *, STRING *);
void string_unpin(struct Parrot_Interp *, STRING *);
+STRING *string_bitwise_and(struct Parrot_Interp *interpreter, STRING *s1,
+ STRING *s2, STRING **dest);
+STRING *string_bitwise_or(struct Parrot_Interp *interpreter, STRING *s1,
+ STRING *s2, STRING **dest);
+STRING *string_bitwise_xor(struct Parrot_Interp *interpreter, STRING *s1,
+ STRING *s2, STRING **dest);
#endif
1.52 +125 -1 parrot/t/op/string.t
Index: string.t
===================================================================
RCS file: /cvs/public/parrot/t/op/string.t,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -w -r1.51 -r1.52
--- string.t 9 Jul 2003 15:20:25 -0000 1.51
+++ string.t 5 Aug 2003 13:47:58 -0000 1.52
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 107;
+use Parrot::Test tests => 113;
use Test::More;
output_is( <<'CODE', <<OUTPUT, "set_s_s|sc" );
@@ -1769,6 +1769,130 @@
CODE
Parrot
Parrot
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bands NULL string");
+ null S1
+ set S2, "abc"
+ bands S1, S2
+ null S3
+ eq S1, S3, ok1
+ print "not "
+ok1: print "ok 1\n"
+ set S1, ""
+ bands S1, S2
+ unless S1, ok2
+ print "not "
+ok2: print "ok 2\n"
+
+ null S2
+ set S1, "abc"
+ bands S1, S2
+ null S3
+ eq S1, S3, ok3
+ print "not "
+ok3: print "ok 3\n"
+ set S2, ""
+ bands S1, S2
+ unless S1, ok4
+ print "not "
+ok4: print "ok 4\n"
+ end
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bands 2");
+ set S1, "abc"
+ set S2, "EE"
+ bands S1, S2
+ print S1
+ print "\n"
+ print S2
+ print "\n"
+ end
+CODE
+A@
+EE
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bands 3");
+ set S1, "abc"
+ set S2, "EE"
+ bands S0, S1, S2
+ print S0
+ print "\n"
+ print S1
+ print "\n"
+ print S2
+ print "\n"
+ end
+CODE
+A@
+abc
+EE
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bors NULL string");
+ null S1
+ set S2, "abc"
+ bors S1, S2
+ print S1
+ print "\n"
+ set S1, ""
+ bors S1, S2
+ print S1
+ print "\n"
+
+ null S2
+ set S1, "abc"
+ bors S1, S2
+ print S1
+ print "\n"
+ set S2, ""
+ bors S1, S2
+ print S1
+ print "\n"
+ end
+CODE
+abc
+abc
+abc
+abc
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bors 2");
+ set S1, "abc"
+ set S2, "EE"
+ bors S1, S2
+ print S1
+ print "\n"
+ print S2
+ print "\n"
+ end
+CODE
+egc
+EE
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "bors 3");
+ set S1, "abc"
+ set S2, "EE"
+ bors S0, S1, S2
+ print S0
+ print "\n"
+ print S1
+ print "\n"
+ print S2
+ print "\n"
+ end
+CODE
+egc
+abc
+EE
OUTPUT
# Set all string registers to values given by &$_[0](reg num)
