#!perl
# Name: Try the tr/// function
# Require: 4
# Desc:
#
require 'benchlib.pl';
@a = (0 .. 255);
for (@a) { $_ = sprintf("%c", $_) };
$a = join("", @a);
&runtest(10, <<'ENDTEST');
$a =~ tr/A-ZÀ-ÖØ-Ş/a-zà-öø-ş/;
$a =~ tr/a-zà-öø-ş/A-ZÀ-ÖØ-Ş/;
$a =~ tr/A-ZÀ-ÖØ-Ş/a-zà-öø-ş/;
$a =~ tr/a-zà-öø-ş/A-ZÀ-ÖØ-Ş/;
ENDTEST
__END__
I don't see why this is performing lots of hash copies. Yet, if I apply
this patch to 5.9 (with copy on write enabled), which *should* make things
faster because it will avoid recalculating hash values for list assignments
where the keys are shared hash scalars:
--- pp_hot.c.orig Mon Dec 3 18:26:05 2001
+++ pp_hot.c Mon Dec 10 13:01:29 2001
@@ -1053,15 +1053,19 @@ PP(pp_aassign)
while (relem < lastrelem) { /* gobble up all the rest */
HE *didstore;
- if (*relem)
+ U32 prehash = 0;
+ if (*relem) {
sv = *(relem++);
+ if (SvREADONLY(sv) && SvFAKE(sv) && !SvLEN(sv))
+ prehash = SvUVX(sv);
+ }
else
sv = &PL_sv_no, relem++;
tmpstr = NEWSV(29,0);
if (*relem)
sv_setsv(tmpstr,*relem); /* value */
*(relem++) = tmpstr;
- didstore = hv_store_ent(hash,sv,tmpstr,0);
+ didstore = hv_store_ent(hash,sv,tmpstr,prehash);
if (magic) {
if (SvSMAGICAL(tmpstr))
mg_set(tmpstr);
then perlbench drops from 100 down to 57.
Full perlbench results for 17729
A, F are normal
B, E have copy on write but not the patch above
C, D have copy on write plus the patch above.
A B C D E F
---- ---- ---- ---- ---- ----
arith/mixed 100 100 102 102 100 100
arith/trig 100 100 102 102 100 100
array/copy 100 104 98 98 104 100
array/foreach 100 104 104 104 104 100
array/index 100 106 108 108 106 100
array/pop 100 106 104 104 105 100
array/shift 100 102 102 102 102 100
array/sort-num 100 100 99 100 99 100
array/sort 100 100 100 99 101 99
call/0arg 100 99 104 105 99 100
call/1arg 100 95 97 97 95 100
call/2arg 100 92 99 99 92 100
call/9arg 100 104 104 103 104 100
call/empty 100 93 98 98 94 100
call/fib 100 99 95 95 99 100
call/method 100 99 102 101 99 100
call/wantarray 100 95 101 101 96 100
hash/copy 100 100 100 100 100 100
hash/each 100 89 88 88 90 100
hash/foreach-sort 100 99 99 98 99 100
hash/foreach 100 101 101 101 101 100
hash/get 100 103 108 108 104 100
hash/set 100 102 106 106 102 100
loop/for-c 100 100 103 103 100 100
loop/for-range-const 100 104 103 103 104 100
loop/for-range 100 107 107 106 107 100
loop/getline 100 93 94 94 94 99
loop/while-my 100 106 106 106 106 100
loop/while 100 103 106 105 103 100
re/const 100 97 98 97 97 100
re/w 100 104 104 105 104 100
startup/fewmod 100 99 100 100 99 100
startup/lotsofsub 100 101 100 100 102 102
startup/noprog 100 99 99 99 99 100
string/base64 100 103 101 101 102 100
string/htmlparser 100 96 96 96 95 100
string/index-const 100 102 103 103 102 100
string/index-var 100 101 103 103 101 100
string/ipol 100 104 105 106 104 100
string/tr 100 100 57 57 100 100
AVERAGE 100 100 100 100 100 100
the patch above was doing very well until the last line.
If I can solve why it slows things down for string/tr.t, then copy on write
with it will beat regular perl. And I don't think perlbench is throwing large
scalars around, which copy on write would really help with, nor does the
current implementation make $& a copy on write copy of the matched string,
both of which should go in the favour of copy on write.
Nicholas Clark
--
Even better than the real thing: http://nms-cgi.sourceforge.net/
> &runtest(10, <<'ENDTEST');
>
> $a =~ tr/A-ZÀ-ÖØ-Ş/a-zà-öø-ş/;
> $a =~ tr/a-zà-öø-ş/A-ZÀ-ÖØ-Ş/;
>
> $a =~ tr/A-ZÀ-ÖØ-Ş/a-zà-öø-ş/;
> $a =~ tr/a-zà-öø-ş/A-ZÀ-ÖØ-Ş/;
>
> ENDTEST
> I don't see why this is performing lots of hash copies. Yet, if I apply
> Full perlbench results for 17729
A, F are normal
B, E have copy on write but not the patch above
C, D have copy on write plus the patch below
> AVERAGE 100 100 100 100 100 100
>
> the patch above was doing very well until the last line.
> If I can solve why it slows things down for string/tr.t, then copy on write
> with it will beat regular perl. And I don't think perlbench is throwing large
> scalars around, which copy on write would really help with, nor does the
> current implementation make $& a copy on write copy of the matched string,
> both of which should go in the favour of copy on write.
Well, I haven't solved why it slows string/tr.t, but if I do it differently
I can make copy on write faster than normal perl:
A B C D E F
---- ---- ---- ---- ---- ----
arith/mixed 100 98 102 102 98 100
arith/trig 100 100 100 100 100 100
array/copy 100 102 103 103 103 100
array/foreach 100 100 104 104 100 100
array/index 100 104 103 103 103 100
array/pop 100 103 104 104 103 100
array/shift 100 99 102 102 98 100
array/sort-num 100 100 100 100 100 100
array/sort 100 101 100 100 101 100
call/0arg 100 104 98 98 103 100
call/1arg 100 101 96 96 101 100
call/2arg 100 101 95 95 101 100
call/9arg 100 104 105 105 105 101
call/empty 100 99 97 97 99 100
call/fib 100 98 97 97 98 100
call/method 100 100 98 98 100 100
call/wantarray 100 93 98 98 94 100
hash/copy 100 99 100 100 99 100
hash/each 100 90 88 88 90 100
hash/foreach-sort 100 100 99 100 99 100
hash/foreach 100 98 98 98 98 100
hash/get 100 104 104 103 104 99
hash/set 100 102 105 105 102 101
loop/for-c 100 101 102 102 101 100
loop/for-range-const 100 106 104 104 106 100
loop/for-range 100 104 106 107 104 100
loop/getline 100 94 95 95 93 100
loop/while-my 100 102 104 105 102 100
loop/while 100 104 105 105 104 100
re/const 100 95 95 96 95 99
re/w 100 104 104 105 104 100
startup/fewmod 100 100 100 100 101 100
startup/lotsofsub 100 101 101 101 102 102
startup/noprog 100 100 99 99 100 100
string/base64 100 101 102 102 101 99
string/htmlparser 100 96 96 95 95 100
string/index-const 100 104 106 106 103 100
string/index-var 100 102 102 101 102 100
string/ipol 100 103 106 106 103 100
string/tr 100 100 99 99 100 100
AVERAGE 100 100 101 101 100 100
--- hv.c.orig Fri May 17 18:59:05 2002
+++ hv.c Sun Aug 18 21:56:23 2002
@@ -409,8 +409,13 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keys
flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
}
- if (!hash)
- PERL_HASH(hash, key, klen);
+ if (!hash) {
+ if SvIsCOW_shared_hash(keysv) {
+ hash = SvUVX(keysv);
+ } else {
+ PERL_HASH(hash, key, klen);
+ }
+ }
/* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
@@ -737,8 +742,13 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keys
HvHASKFLAGS_on((SV*)hv);
}
- if (!hash)
- PERL_HASH(hash, key, klen);
+ if (!hash) {
+ if SvIsCOW_shared_hash(keysv) {
+ hash = SvUVX(keysv);
+ } else {
+ PERL_HASH(hash, key, klen);
+ }
+ }
if (!xhv->xhv_array /* !HvARRAY(hv) */)
Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
Thanks, applied as #17740.
Also applied as part of the same change# are your cleanups for the
macros and debug facilities sent under separate cover, giving the
new '-DC' flag.
Hugo