From: Brandon Black Date: Sun, 12 Aug 2007 13:36:14 +0000 (-0700) Subject: Re: optimize push @ISA, (was Re: parent.pm at http://corion.net/perl-dev) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=89c14e2ec1b845cd5ec17986d2c65288a7da7ba8;p=p5sagit%2Fp5-mst-13.2.git Re: optimize push @ISA, (was Re: parent.pm at corion.net/perl-dev) From: "Brandon Black" Message-ID: <84621a60708121336m13dcf9e5uac624fb246f2a79c@mail.gmail.com> p4raw-id: //depot/perl@31770 --- diff --git a/av.c b/av.c index c1b03fe..07d8e22 100644 --- a/av.c +++ b/av.c @@ -342,11 +342,14 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) SvREFCNT_dec(ary[key]); ary[key] = val; if (SvSMAGICAL(av)) { + const MAGIC* const mg = SvMAGIC(av); if (val != &PL_sv_undef) { - const MAGIC* const mg = SvMAGIC(av); sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key); } - mg_set((SV*)av); + if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) + PL_delaymagic |= DM_ARRAY; + else + mg_set((SV*)av); } return &ary[key]; } @@ -428,8 +431,13 @@ Perl_av_clear(pTHX_ register AV *av) Perl_croak(aTHX_ PL_no_modify); /* Give any tie a chance to cleanup first */ - if (SvRMAGICAL(av)) - mg_clear((SV*)av); + if (SvRMAGICAL(av)) { + const MAGIC* const mg = SvMAGIC(av); + if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) + PL_delaymagic |= DM_ARRAY; + else + mg_clear((SV*)av); + } if (AvMAX(av) < 0) return; diff --git a/embedvar.h b/embedvar.h index cde2b39..15057bc 100644 --- a/embedvar.h +++ b/embedvar.h @@ -116,7 +116,6 @@ #define PL_defgv (vTHX->Idefgv) #define PL_defoutgv (vTHX->Idefoutgv) #define PL_defstash (vTHX->Idefstash) -#define PL_delayedisa (vTHX->Idelayedisa) #define PL_delaymagic (vTHX->Idelaymagic) #define PL_diehook (vTHX->Idiehook) #define PL_dirty (vTHX->Idirty) @@ -431,7 +430,6 @@ #define PL_Idefgv PL_defgv #define PL_Idefoutgv PL_defoutgv #define PL_Idefstash PL_defstash -#define PL_Idelayedisa PL_delayedisa #define PL_Idelaymagic PL_delaymagic #define PL_Idiehook PL_diehook #define PL_Idirty PL_dirty diff --git a/gv.h b/gv.h index 66dedb7..0dca6ba 100644 --- a/gv.h +++ b/gv.h @@ -181,6 +181,7 @@ Return the SV from the GV. #define DM_UID 0x003 #define DM_RUID 0x001 #define DM_EUID 0x002 +#define DM_ARRAY 0x004 #define DM_GID 0x030 #define DM_RGID 0x010 #define DM_EGID 0x020 diff --git a/intrpvar.h b/intrpvar.h index 986a364..7cae473 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -180,8 +180,6 @@ PERLVAR(Iwatchok, char *) PERLVARI(Iregmatch_slab, regmatch_slab *, NULL) PERLVAR(Iregmatch_state, regmatch_state *) -PERLVARI(Idelayedisa, HV*, NULL) /* stash for PL_delaymagic for magic_setisa */ - /* Put anything new that is pointer aligned here. */ PERLVAR(Idelaymagic, U16) /* ($<,$>) = ... */ diff --git a/lib/mro.pm b/lib/mro.pm index c463938..a9f3927 100644 --- a/lib/mro.pm +++ b/lib/mro.pm @@ -319,8 +319,8 @@ works (like C); Specifying the mro type of a class before setting C<@ISA> will be faster than the other way around. Also, making all of your -C<@ISA> manipulations in a single assignment statement will be -faster that doing them one by one via C (which is what +C<@ISA> manipulations in a single assignment or push statement +will be faster that doing them one by one (which is what C does currently). Examples: @@ -330,23 +330,29 @@ Examples: use base qw/A B C/; use mro 'c3'; + # Equivalently slow + package Foo; + our @ISA; + require A; push(@ISA, 'A'); + require B; push(@ISA, 'B'); + require C; push(@ISA, 'C'); + use mro 'c3'; + # The fastest way # (not exactly equivalent to above, # as base.pm can do other magic) + package Foo; use mro 'c3'; - use A (); - use B (); - use C (); + require A; + require B; + require C; our @ISA = qw/A B C/; Generally speaking, every time C<@ISA> is modified, the MRO -of that class will be recalculated, because of the way array -magic works. Pushing multiple items onto C<@ISA> in one push -statement still counts as multiple modifications. However, -assigning a list to C<@ISA> only counts as a single -modification. Thus if you really need to do C as -opposed to assignment, C<@ISA = (@ISA, qw/A B C/);> -will still be faster than C +of that class will be recalculated because of the way array +magic works. Cutting down on unecessary recalculations is +a win, especially with complex class hierarchies and/or +the c3 mro. =head1 SEE ALSO diff --git a/mg.c b/mg.c index 89f4c32..c4fc190 100644 --- a/mg.c +++ b/mg.c @@ -1528,6 +1528,10 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) /* Bail out if destruction is going on */ if(PL_dirty) return 0; + /* Skip _isaelem because _isa will handle it shortly */ + if (PL_delaymagic & DM_ARRAY && mg->mg_type == PERL_MAGIC_isaelem) + return 0; + /* XXX Once it's possible, we need to detect that our @ISA is aliased in other stashes, and act on the stashes @@ -1542,10 +1546,7 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) : (GV*)SvMAGIC(mg->mg_obj)->mg_obj ); - if(PL_delaymagic) - PL_delayedisa = stash; - else - mro_isa_changed_in(stash); + mro_isa_changed_in(stash); return 0; } diff --git a/perlapi.h b/perlapi.h index a019239..05cf09f 100644 --- a/perlapi.h +++ b/perlapi.h @@ -268,8 +268,6 @@ END_EXTERN_C #define PL_defoutgv (*Perl_Idefoutgv_ptr(aTHX)) #undef PL_defstash #define PL_defstash (*Perl_Idefstash_ptr(aTHX)) -#undef PL_delayedisa -#define PL_delayedisa (*Perl_Idelayedisa_ptr(aTHX)) #undef PL_delaymagic #define PL_delaymagic (*Perl_Idelaymagic_ptr(aTHX)) #undef PL_diehook diff --git a/pp.c b/pp.c index 5171e57..dbfc95c 100644 --- a/pp.c +++ b/pp.c @@ -4420,12 +4420,17 @@ PP(pp_push) PUSHi( AvFILL(ary) + 1 ); } else { + PL_delaymagic = DM_DELAY; for (++MARK; MARK <= SP; MARK++) { SV * const sv = newSV(0); if (*MARK) sv_setsv(sv, *MARK); av_store(ary, AvFILLp(ary)+1, sv); } + if (PL_delaymagic & DM_ARRAY) + mg_set((SV*)ary); + + PL_delaymagic = 0; SP = ORIGMARK; PUSHi( AvFILLp(ary) + 1 ); } diff --git a/pp_hot.c b/pp_hot.c index 5cd758f..05b9b16 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1122,6 +1122,9 @@ PP(pp_aassign) PL_egid = PerlProc_getegid(); } PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); + + if (PL_delaymagic & DM_ARRAY && SvMAGICAL((SV*)ary)) + mg_set((SV*)ary); } PL_delaymagic = 0; @@ -1152,14 +1155,6 @@ PP(pp_aassign) *relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef; } - /* This is done at the bottom and in this order because - mro_isa_changed_in() can throw exceptions */ - if(PL_delayedisa) { - HV* stash = PL_delayedisa; - PL_delayedisa = NULL; - mro_isa_changed_in(stash); - } - RETURN; } diff --git a/sv.c b/sv.c index e431cff..4a21107 100644 --- a/sv.c +++ b/sv.c @@ -11167,7 +11167,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_sub_generation = proto_perl->Isub_generation; PL_isarev = hv_dup_inc(proto_perl->Iisarev, param); - PL_delayedisa = hv_dup_inc(proto_perl->Idelayedisa, param); /* funky return mechanisms */ PL_forkprocess = proto_perl->Iforkprocess;