cvsuser 04/02/14 02:39:27
Modified: . MANIFEST
ops string.ops
t/op string.t
Added: examples/benchmarks vpm.imc vpm.pl vpm1.imc vpm2.imc
Log:
split and join ops
* split handles only the empty string case
* join should be fine
* benchmarks - thanks to Thomas Klausner
* minimal tests
Revision Changes Path
1.552 +4 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.551
retrieving revision 1.552
diff -u -w -r1.551 -r1.552
--- MANIFEST 12 Feb 2004 07:36:00 -0000 1.551
+++ MANIFEST 14 Feb 2004 10:39:20 -0000 1.552
@@ -327,6 +327,10 @@
examples/benchmarks/stress2.pasm [main]doc
examples/benchmarks/stress2.pl [main]doc
examples/benchmarks/stress3.pasm [main]doc
+examples/benchmarks/vpm.pl [main]doc
+examples/benchmarks/vpm.imc [main]doc
+examples/benchmarks/vpm1.imc [main]doc
+examples/benchmarks/vpm2.imc [main]doc
examples/io/echo_client.imc [main]doc
examples/io/http.imc [main]doc
examples/io/net_smtp.pasm [main]doc
1.1 parrot/examples/benchmarks/vpm.imc
Index: vpm.imc
===================================================================
# perl program by Thomas Klausner posted on Vienna-PM list
#
# timings in seconds on Athlon 800
#
# perl vpm.pl 19.8
# perl58-th vpm.pl 30.8
#
# parrot -j vpm.imc 20.7
# parrot -j vpm1.imc 16.3
# parrot -j vpm2.imc 15.6
# parrot -C vpm2.imc 15.9
#
# perl is 5.8.0, parrot built optimized gcc 2.95.2
# Thomas did report that 50% slowdown with threaded perl 5.8.3 too.
# vpm.imc ... split and join simulated in a loop
# vpm1.imc ... join opcode
# vpm2.imc ... join and split opcodes
# beginn
#use strict;
#
#use warnings;
.sub _main
# my $big;
.sym pmc big
big = new PerlUndef
# my $string="just another perl hacker";
.sym pmc String
String = new PerlUndef
String = "just another perl hacker"
# for (0 .. 299999) {
$P0 = new PerlUndef
$P0 = 0
loop:
# $big++;
inc big
# my @str=split(//,$string);
.sym pmc str
str = new PerlArray
$S0 = String
length $I0, $S0
$I1 = 0
spl:
$S1 = $S0[$I1]
str[$I1] = $S1
inc $I1
if $I1 < $I0 goto spl
# my $f=shift(@str);
.sym pmc f
f = new PerlUndef
shift $P2, str
assign f, $P2
# push(@str,$f);
push str, f
# $string=join('',@str);
String = new PerlString
$I0 = str
$I1 = 0
jlp:
$P1 = str[$I1]
concat String, String, $P1
inc $I1
if $I1 < $I0 goto jlp
#}
inc $P0
if $P0 <= 299999 goto loop
#print "$big;
print big
print "\n"
#$string
#";
print String
print "\n"
end
# ende
.end
1.1 parrot/examples/benchmarks/vpm.pl
Index: vpm.pl
===================================================================
# perl program by Thomas Klausner posted on Vienna-PM list
#
# timings in seconds on Athlon 800
#
# perl vpm.pl 19.8
# perl58-th vpm.pl 30.8
#
# parrot -j vpm.imc 20.7
# parrot -j vpm1.imc 16.3
# parrot -j vpm2.imc 15.6
# parrot -C vpm2.imc 15.9
#
# perl is 5.8.0, parrot built optimized gcc 2.95.2
# Thomas did report that 50% slowdown with threaded perl 5.8.3 too.
# vpm.imc ... split and join simulated in a loop
# vpm1.imc ... join opcode
# vpm2.imc ... join and split opcodes
#
# beginn
use strict;
use warnings;
my $big;
my $string="just another perl hacker";
for (0 .. 299999) {
$big++;
my @str=split(//,$string);
my $f=shift(@str);
push(@str,$f);
$string=join('',@str);
}
print "$big;
$string
";
# ende
1.1 parrot/examples/benchmarks/vpm1.imc
Index: vpm1.imc
===================================================================
# beginn
#use strict;
#
#use warnings;
.sub _main
# my $big;
.sym pmc big
big = new PerlUndef
# my $string="just another perl hacker";
.sym pmc String
String = new PerlUndef
String = "just another perl hacker"
# for (0 .. 299999) {
$P0 = new PerlUndef
$P0 = 0
loop:
# $big++;
inc big
# my @str=split(//,$string);
.sym pmc str
str = new PerlArray
$S0 = String
length $I0, $S0
$I1 = 0
spl:
$S1 = $S0[$I1]
str[$I1] = $S1
inc $I1
if $I1 < $I0 goto spl
# my $f=shift(@str);
.sym pmc f
f = new PerlUndef
shift $P2, str
assign f, $P2
# push(@str,$f);
push str, f
# $string=join('',@str);
join $S2, "", str
String = $S2
#}
inc $P0
if $P0 <= 299999 goto loop
#print "$big;
print big
print "\n"
#$string
#";
print String
print "\n"
end
# ende
.end
1.1 parrot/examples/benchmarks/vpm2.imc
Index: vpm2.imc
===================================================================
# beginn
#use strict;
#
#use warnings;
.sub _main
# my $big;
.sym pmc big
big = new PerlUndef
# my $string="just another perl hacker";
.sym pmc String
String = new PerlUndef
String = "just another perl hacker"
# for (0 .. 299999) {
$P0 = new PerlUndef
$P0 = 0
loop:
# $big++;
inc big
# my @str=split(//,$string);
.sym pmc str
$S0 = String
split str, "", $S0
# my $f=shift(@str);
.sym pmc f
f = new PerlUndef
shift $P2, str
assign f, $P2
# push(@str,$f);
push str, f
# $string=join('',@str);
join $S2, "", str
String = $S2
#}
inc $P0
if $P0 <= 299999 goto loop
#print "$big;
print big
print "\n"
#$string
#";
print String
print "\n"
end
# ende
.end
1.13 +53 -0 parrot/ops/string.ops
Index: string.ops
===================================================================
RCS file: /cvs/public/parrot/ops/string.ops,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- string.ops 12 Feb 2004 18:43:02 -0000 1.12
+++ string.ops 14 Feb 2004 10:39:25 -0000 1.13
@@ -647,6 +647,59 @@
=back
+=item B<join>(out STR, in STR, in PMC)
+
+Create a new PerlString $1 by joining array elements from array $3
+with string $2.
+
+=item B<split>(out PMC, in STR, in STR)
+
+Create a new PerlArray PMC $1 by splitting the string $3 with
+regexp $2. Currently implemented only for the empty string $2.
+
+=cut
+
+op join(out STR, in STR, in PMC) {
+ STRING *res;
+ PMC *ar = $3;
+ STRING *j = $2;
+ STRING *s;
+ int i, ar_len = VTABLE_elements(interpreter, ar);
+
+ if (ar_len == 0) {
+ $1 = string_make(interpreter, NULL, 0, NULL, 0, NULL);
+ goto NEXT();
+ }
+ s = VTABLE_get_string_keyed_int(interpreter, ar, 0);
+ res = string_copy(interpreter, s);
+ for (i = 1; i < ar_len; ++i) {
+ res = string_append(interpreter, res, j, 0);
+ s = VTABLE_get_string_keyed_int(interpreter, ar, i);
+ res = string_append(interpreter, res, s, 0);
+ }
+ $1 = res;
+ goto NEXT();
+}
+
+op split(out PMC, in STR, in STR) {
+ PMC *res = $1 = pmc_new(interpreter, enum_class_PerlArray);
+ STRING *r = $2;
+ STRING *s = $3;
+ int slen = string_length(s);
+ int i;
+
+ if (!slen)
+ goto NEXT();
+ if (string_length(r))
+ internal_exception(1, "Unimplemented join by regex");
+ for (i = 0; i < slen; ++i) {
+ STRING *p = string_substr(interpreter, s, i, 1, NULL, 0);
+ /* TODO first set empty string, then replace */
+ VTABLE_set_string_keyed_int(interpreter, res, i, p);
+ }
+ goto NEXT();
+}
+
=head1 COPYRIGHT
Copyright (C) 2001-2003 The Perl Foundation. All rights reserved.
1.63 +37 -1 parrot/t/op/string.t
Index: string.t
===================================================================
RCS file: /cvs/public/parrot/t/op/string.t,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -w -r1.62 -r1.63
--- string.t 3 Jan 2004 09:44:15 -0000 1.62
+++ string.t 14 Feb 2004 10:39:27 -0000 1.63
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 124;
+use Parrot::Test tests => 126;
use Test::More;
output_is( <<'CODE', <<OUTPUT, "set_s_s|sc" );
@@ -2250,6 +2250,42 @@
}
return $rt;
}
+
+output_is( <<'CODE', <<OUTPUT, "split");
+_main:
+ split P0, "", "ab"
+ set I0, P0
+ print I0
+ print "\n"
+ set S0, P0[0]
+ print S0
+ set S0, P0[1]
+ print S0
+ print "\n"
+ end
+CODE
+2
+ab
+OUTPUT
+
+output_is( <<'CODE', <<OUTPUT, "join");
+_main:
+ new P0, .PerlArray
+ push P0, "a"
+ join S0, "--", P0
+ print S0
+ print "\n"
+ new P0, .PerlArray
+ push P0, "a"
+ push P0, "b"
+ join S0, "--", P0
+ print S0
+ print "\n"
+ end
+CODE
+a
+a--b
+OUTPUT
1;
