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

10 files changed, 44 insertions, 35 deletions

diff --git a/av.c b/av.c
index c1b03fee75..07d8e2266e 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 cde2b39a97..15057bce69 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 66dedb70f5..0dca6ba4df 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 986a364852..7cae473960 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 c4639382f1..a9f3927e1f 100644
--- 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 89f4c32910..c4fc190185 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 a01923923a..05cf09ff70 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 5171e57569..dbfc95c567 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 5cd758f6ab..05b9b1680b 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 e431cff3f7..4a2110779b 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;