Re: optimize push @ISA, (was Re: parent.pm at http://corion.net/perl-dev)

From: "Brandon Black" <blblack@gmail.com>
Message-ID: <84621a60708121336m13dcf9e5uac624fb246f2a79c@mail.gmail.com>

p4raw-id: //depot/perl@31770

diff --git a/av.c b/av.c
index c1b03fe..07d8e22 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/lib/mro.pm
+++ b/lib/mro.pm
@@ -319,8 +319,8 @@ works (like C<goto &maybe::next::method>);
 
 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<push> (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<use base> 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<push> as
-opposed to assignment, C<@ISA = (@ISA, qw/A B C/);>
-will still be faster than C<push(@ISA, qw/A B 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;