Front page | perl.perl5.porters |
Postings from March 2000
[PATCH 5.5.670] pseudohash, one more try
Thread Previous
|
Thread Next
From:
John Tobey
Date:
March 2, 2000 02:31
Subject:
[PATCH 5.5.670] pseudohash, one more try
Message ID:
m12QStM-000FSsC@feynman.localnet
Gurusamy Sarathy <gsar@ActiveState.com> wrote:
> On Mon, 28 Feb 2000 22:13:31 EST, John Tobey wrote:
> >Here is a new version of the patch that avoids op.c and instead walks
> >the op tree at run time in pp_aassign.
>
> In general, walking the optree at run time is less desirable than
> compile time recognition. I think your previous approach with
> ck_aassign() was better.
Okay. I've put the compile-time check back in, this time in
Perl_newASSIGNOP. pp_aassign walks the op tree when an AV/AVHV is
found and the op flag indicates a % expression exists somewhere on the
left side. Simple hash variables (%foo) are discounted because they
cannot be pseudohashes. I believe that false positives (op tree
walked but no avhv) would be rare.
I mentioned benchmarks that showed an earlier version of this patch to
be up to 10% slower on list assignments. Subsequent testing indicates
that 10% is within the range of random noise for my benchmark. For
example, this patch, applied to 5.5.660, actually *improves*
performance by 10% in one of my cases and by 3% even in the case that
requires op-walking. But patching 5.5.670 with it results in a 5%
slowdown. (All tests used gcc -O2 and did a million assignments to
lists. The randomness is per-build, not per run of the benchmark.) I
conclude that it will have different effects on different machines and
releases, so it does not concern us.
I've split two pieces of pp_aassign out into static functions. This
was part of an experiment to see if moving less-frequently executed
code out of the middle would trigger some CPU or paging magic that
would improve performance. I might try merging the functions back
into pp_aassign if I had the tuits.
Thanks
-John
--
John Tobey, late nite hacker <jtobey@john-edwin-tobey.org>
\\\ ///
]]] With enough bugs, all eyes are shallow. [[[
/// \\\
diff -ur perl-5.5.670/av.c perl-5.5.670.john/av.c
--- perl-5.5.670/av.c Sat Feb 26 02:45:37 2000
+++ perl-5.5.670.john/av.c Thu Mar 2 03:56:47 2000
@@ -805,6 +805,20 @@
return index;
}
+STATIC I32
+S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash)
+{
+ HV *keys;
+ HE *he;
+ STRLEN n_a;
+
+ keys = avhv_keys(av);
+ he = hv_fetch_ent(keys, keysv, FALSE, hash);
+ if (!he)
+ Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
+ return avhv_index_sv(HeVAL(he));
+}
+
HV*
Perl_avhv_keys(pTHX_ AV *av)
{
@@ -824,17 +838,15 @@
}
SV**
+Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash)
+{
+ return av_store(av, avhv_index(av, keysv, hash), val);
+}
+
+SV**
Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
{
- SV **indsvp;
- HV *keys = avhv_keys(av);
- HE *he;
- STRLEN n_a;
-
- he = hv_fetch_ent(keys, keysv, FALSE, hash);
- if (!he)
- Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
- return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
+ return av_fetch(av, avhv_index(av, keysv, hash), lval);
}
SV *
diff -ur perl-5.5.670/dump.c perl-5.5.670.john/dump.c
--- perl-5.5.670/dump.c Thu Feb 17 12:48:49 2000
+++ perl-5.5.670.john/dump.c Thu Mar 2 05:02:08 2000
@@ -433,6 +433,8 @@
if (o->op_type == OP_AASSIGN) {
if (o->op_private & OPpASSIGN_COMMON)
sv_catpv(tmpsv, ",COMMON");
+ if (o->op_private & OPpASSIGN_HASH)
+ sv_catpv(tmpsv, ",HASH");
}
else if (o->op_type == OP_SASSIGN) {
if (o->op_private & OPpASSIGN_BACKWARDS)
diff -ur perl-5.5.670/embed.pl perl-5.5.670.john/embed.pl
--- perl-5.5.670/embed.pl Mon Feb 28 23:15:15 2000
+++ perl-5.5.670.john/embed.pl Thu Mar 2 03:56:47 2000
@@ -1354,6 +1354,7 @@
Ap |SV* |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash
Ap |bool |avhv_exists_ent|AV *ar|SV* keysv|U32 hash
Ap |SV** |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash
+Ap |SV** |avhv_store_ent |AV *ar|SV* keysv|SV* val|U32 hash
Ap |HE* |avhv_iternext |AV *ar
Ap |SV* |avhv_iterval |AV *ar|HE* entry
Ap |HV* |avhv_keys |AV *ar
@@ -2156,6 +2157,7 @@
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
s |I32 |avhv_index_sv |SV* sv
+s |I32 |avhv_index |AV* av|SV* sv|U32 hash
#endif
#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
@@ -2287,6 +2289,9 @@
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+s |int |do_maybe_phash |AV *ary|SV **lelem|SV **firstlelem \
+ |SV **relem|SV **lastrelem
+s |void |do_oddball |HV *hash|SV **relem|SV **firstrelem
s |CV* |get_db_sub |SV **svp|CV *cv
s |SV* |method_common |SV* meth|U32* hashp
#endif
diff -ur perl-5.5.670/op.c perl-5.5.670.john/op.c
--- perl-5.5.670/op.c Sun Feb 27 09:28:52 2000
+++ perl-5.5.670.john/op.c Thu Mar 2 05:26:52 2000
@@ -3273,6 +3273,8 @@
if (list_assignment(left)) {
dTHR;
+ OP *curop;
+
PL_modcount = 0;
PL_eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
left = mod(left, OP_AASSIGN);
@@ -3283,12 +3285,18 @@
op_free(right);
return Nullop;
}
- o = newBINOP(OP_AASSIGN, flags,
- list(force_list(right)),
- list(force_list(left)) );
+ curop = list(force_list(left));
+ o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
o->op_private = 0 | (flags >> 8);
+ for (curop = ((LISTOP*)curop)->op_first;
+ curop; curop = curop->op_sibling) {
+ if (curop->op_type == OP_RV2HV &&
+ ((UNOP*)curop)->op_first->op_type != OP_GV) {
+ o->op_private |= OPpASSIGN_HASH;
+ break;
+ }
+ }
if (!(left->op_private & OPpLVAL_INTRO)) {
- OP *curop;
OP *lastop = o;
PL_generation++;
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -3332,7 +3340,7 @@
lastop = curop;
}
if (curop != o)
- o->op_private = OPpASSIGN_COMMON;
+ o->op_private |= OPpASSIGN_COMMON;
}
if (right && right->op_type == OP_SPLIT) {
OP* tmpop;
diff -ur perl-5.5.670/op.h perl-5.5.670.john/op.h
--- perl-5.5.670/op.h Fri Feb 25 13:56:46 2000
+++ perl-5.5.670.john/op.h Thu Mar 2 03:56:47 2000
@@ -118,6 +118,7 @@
/* Private for OP_AASSIGN */
#define OPpASSIGN_COMMON 64 /* Left & right have syms in common. */
+#define OPpASSIGN_HASH 32 /* Assigning to possible pseudohash. */
/* Private for OP_SASSIGN */
#define OPpASSIGN_BACKWARDS 64 /* Left & right switched. */
diff -ur perl-5.5.670/pp_hot.c perl-5.5.670.john/pp_hot.c
--- perl-5.5.670/pp_hot.c Sat Feb 26 13:12:51 2000
+++ perl-5.5.670.john/pp_hot.c Thu Mar 2 03:56:47 2000
@@ -621,6 +621,89 @@
}
}
+STATIC int
+S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem,
+ SV **lastrelem)
+{
+ OP *leftop;
+ SV *tmpstr;
+ I32 i;
+
+ leftop = ((BINOP*)PL_op)->op_last;
+ assert(leftop);
+ assert(leftop->op_type == OP_NULL && leftop->op_targ == OP_LIST);
+ leftop = ((LISTOP*)leftop)->op_first;
+ assert(leftop);
+ /* Skip PUSHMARK and each element already assigned to. */
+ for (i = lelem - firstlelem; i > 0; i--) {
+ leftop = leftop->op_sibling;
+ assert(leftop);
+ }
+ if (leftop->op_type != OP_RV2HV)
+ return 0;
+
+ /* pseudohash */
+ if (av_len(ary) > 0)
+ av_fill(ary, 0); /* clear all but the fields hash */
+ if (lastrelem >= relem) {
+ while (relem < lastrelem) { /* gobble up all the rest */
+ SV *tmpstr;
+ assert(relem[0]);
+ assert(relem[1]);
+ /* Avoid a memory leak when avhv_store_ent dies. */
+ tmpstr = sv_newmortal();
+ sv_setsv(tmpstr,relem[1]); /* value */
+ relem[1] = tmpstr;
+ if (avhv_store_ent(ary,relem[0],tmpstr,0))
+ SvREFCNT_inc(tmpstr);
+ if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr))
+ mg_set(tmpstr);
+ relem += 2;
+ TAINT_NOT;
+ }
+ }
+ if (relem == lastrelem)
+ return 1;
+ return 2;
+}
+
+STATIC void
+S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
+{
+ if (*relem) {
+ SV *tmpstr;
+ if (ckWARN(WARN_MISC)) {
+ if (relem == firstrelem &&
+ SvROK(*relem) &&
+ ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+ SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
+ Perl_warner(aTHX_ WARN_MISC, "Reference found where even-sized list expected");
+ else
+ Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
+ }
+ if (SvTYPE(hash) == SVt_PVAV) {
+ /* pseudohash */
+ tmpstr = sv_newmortal();
+ if (avhv_store_ent((AV*)hash,*relem,tmpstr,0))
+ SvREFCNT_inc(tmpstr);
+ if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr))
+ mg_set(tmpstr);
+ }
+ else {
+ HE *didstore;
+ tmpstr = NEWSV(29,0);
+ didstore = hv_store_ent(hash,*relem,tmpstr,0);
+ if (SvMAGICAL(hash)) {
+ if (SvSMAGICAL(tmpstr))
+ mg_set(tmpstr);
+ if (!didstore)
+ sv_2mortal(tmpstr);
+ }
+ }
+ TAINT_NOT;
+ }
+}
+
PP(pp_aassign)
{
djSP;
@@ -646,21 +729,22 @@
* special care that assigning the identifier on the left doesn't
* clobber a value on the right that's used later in the list.
*/
- if (PL_op->op_private & OPpASSIGN_COMMON) {
+ if (PL_op->op_private & (OPpASSIGN_COMMON)) {
EXTEND_MORTAL(lastrelem - firstrelem + 1);
- for (relem = firstrelem; relem <= lastrelem; relem++) {
- /*SUPPRESS 560*/
- if (sv = *relem) {
+ for (relem = firstrelem; relem <= lastrelem; relem++) {
+ /*SUPPRESS 560*/
+ if (sv = *relem) {
TAINT_NOT; /* Each item is independent */
- *relem = sv_mortalcopy(sv);
+ *relem = sv_mortalcopy(sv);
}
- }
+ }
}
relem = firstrelem;
lelem = firstlelem;
ary = Null(AV*);
hash = Null(HV*);
+
while (lelem <= lastlelem) {
TAINT_NOT; /* Each item stands on its own, taintwise. */
sv = *lelem++;
@@ -668,7 +752,19 @@
case SVt_PVAV:
ary = (AV*)sv;
magic = SvMAGICAL(ary) != 0;
-
+ if (PL_op->op_private & OPpASSIGN_HASH) {
+ switch (do_maybe_phash(ary, lelem, firstlelem, relem,
+ lastrelem))
+ {
+ case 0:
+ goto normal_array;
+ case 1:
+ do_oddball((HV*)ary, relem, firstrelem);
+ }
+ relem = lastrelem + 1;
+ break;
+ }
+ normal_array:
av_clear(ary);
av_extend(ary, lastrelem - relem);
i = 0;
@@ -688,7 +784,7 @@
TAINT_NOT;
}
break;
- case SVt_PVHV: {
+ case SVt_PVHV: { /* normal hash */
SV *tmpstr;
hash = (HV*)sv;
@@ -715,27 +811,7 @@
TAINT_NOT;
}
if (relem == lastrelem) {
- if (*relem) {
- HE *didstore;
- if (ckWARN(WARN_MISC)) {
- if (relem == firstrelem &&
- SvROK(*relem) &&
- ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
- SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
- Perl_warner(aTHX_ WARN_MISC, "Reference found where even-sized list expected");
- else
- Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
- }
- tmpstr = NEWSV(29,0);
- didstore = hv_store_ent(hash,*relem,tmpstr,0);
- if (magic) {
- if (SvSMAGICAL(tmpstr))
- mg_set(tmpstr);
- if (!didstore)
- sv_2mortal(tmpstr);
- }
- TAINT_NOT;
- }
+ do_oddball(hash, relem, firstrelem);
relem++;
}
}
diff -ur perl-5.5.670/t/op/avhv.t perl-5.5.670.john/t/op/avhv.t
--- perl-5.5.670/t/op/avhv.t Thu Jan 13 01:42:53 2000
+++ perl-5.5.670.john/t/op/avhv.t Thu Mar 2 05:28:52 2000
@@ -1,5 +1,5 @@
#!./perl
-
+
BEGIN {
chdir 't' if -d 't';
unshift @INC, '../lib';
@@ -17,7 +17,7 @@
package main;
-print "1..20\n";
+print "1..28\n";
$sch = {
'abc' => 1,
@@ -139,3 +139,40 @@
print "not " unless "$avhv->{bar}" eq "yyy";
print "ok 20\n";
+
+# hash assignment
+%$avhv = ();
+print "not " unless ref($avhv->[0]) eq 'HASH';
+print "ok 21\n";
+
+%hv = %$avhv;
+print "not " if grep defined, values %hv;
+print "ok 22\n";
+print "not " if grep ref, keys %hv;
+print "ok 23\n";
+
+%$avhv = (foo => 29, pants => 2, bar => 0);
+print "not " unless "@$avhv[1..3]" eq '29 0 2';
+print "ok 24\n";
+
+my $extra;
+my @extra;
+($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and $extra eq 'moo';
+print "ok 25\n";
+
+%$avhv = ();
+(%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and !defined $extra;
+print "ok 26\n";
+
+@extra = qw(whatever and stuff);
+%$avhv = ();
+(%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and @extra == 0;
+print "ok 27\n";
+
+%$avhv = ();
+(@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless ref $avhv->[0] eq 'HASH' and @extra == 6;
+print "ok 28\n";
diff -ur perl-5.5.670/t/op/hashwarn.t perl-5.5.670.john/t/op/hashwarn.t
--- perl-5.5.670/t/op/hashwarn.t Tue Jul 20 13:18:14 1999
+++ perl-5.5.670.john/t/op/hashwarn.t Thu Mar 2 03:56:47 2000
@@ -14,7 +14,7 @@
# ...and save 'em as we go
$SIG{'__WARN__'} = sub { push @warnings, @_ };
$| = 1;
- print "1..7\n";
+ print "1..9\n";
}
END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
@@ -66,6 +66,13 @@
%hash = sub { print "ok" };
test_warning 6, shift @warnings, $odd_msg;
+ my $avhv = [{x=>1,y=>2}];
+ %$avhv = (x=>13,'y');
+ test_warning 7, shift @warnings, $odd_msg;
+
+ %$avhv = 'x';
+ test_warning 8, shift @warnings, $odd_msg;
+
$_ = { 1..10 };
- test 7, ! @warnings, "Unexpected warning";
+ test 9, ! @warnings, "Unexpected warning";
}
Thread Previous
|
Thread Next