From: Rafael Garcia-Suarez Date: Mon, 23 Apr 2007 08:21:50 +0000 (+0000) Subject: An optimisation to the MRO code, by Brandon Black, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8638e433f90c5046b38f1d145c125bad5dbfdb7e;p=p5sagit%2Fp5-mst-13.2.git An optimisation to the MRO code, by Brandon Black, plus more comments. p4raw-id: //depot/perl@31025 --- diff --git a/mro.c b/mro.c index d0bef84..0313feb 100644 --- a/mro.c +++ b/mro.c @@ -245,11 +245,18 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level) http://search.cpan.org/src/STEVAN/Algorithm-C3-0.01/lib/Algorithm/C3.pm (later versions go about it differently than this code for speed reasons) */ + if(isa && AvFILLp(isa) >= 0) { SV** seqs_ptr; I32 seqs_items; HV* tails = (HV*)sv_2mortal((SV*)newHV()); AV* seqs = (AV*)sv_2mortal((SV*)newAV()); + I32* heads; + + /* This builds @seqs, which is an array of arrays. + The members of @seqs are the MROs of + the members of @ISA, followed by @ISA itself. + */ I32 items = AvFILLp(isa) + 1; SV** isa_ptr = AvARRAY(isa); while(items--) { @@ -257,16 +264,28 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level) SV* isa_item = *isa_ptr++; HV* isa_item_stash = gv_stashsv(isa_item, 0); if(!isa_item_stash) { - isa_lin = newAV(); + /* if no stash, make a temporary fake MRO + containing just itself */ + isa_lin = (AV*)sv_2mortal((SV*)newAV()); av_push(isa_lin, newSVsv(isa_item)); } else { isa_lin = mro_get_linear_isa_c3(isa_item_stash, level + 1); /* recursion */ } - av_push(seqs, (SV*)av_make(AvFILLp(isa_lin)+1, AvARRAY(isa_lin))); + av_push(seqs, (SV*)isa_lin); } - av_push(seqs, (SV*)av_make(AvFILLp(isa)+1, AvARRAY(isa))); - + av_push(seqs, (SV*)isa); + + /* This builds "heads", which as an array of integer array + indices, one per seq, which point at the virtual "head" + of the seq (initially zero) */ + Newxz(heads, AvFILLp(seqs)+1, I32); + + /* This builds %tails, which has one key for every class + mentioned in the tail of any sequence in @seqs (tail meaning + everything after the first class, the "head"). The value + is how many times this key appears in the tails of @seqs. + */ seqs_ptr = AvARRAY(seqs); seqs_items = AvFILLp(seqs) + 1; while(seqs_items--) { @@ -288,6 +307,8 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level) } } + /* This loop won't terminate until we either finish building + the MRO, or get an exception. */ while(1) { SV* seqhead = NULL; SV* cand = NULL; @@ -295,15 +316,22 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level) SV* val; HE* tail_entry; AV* seq; + int s; + + /* "foreach $seq (@seqs)" */ SV** avptr = AvARRAY(seqs); - items = AvFILLp(seqs)+1; - while(items--) { + for(s = 0; s <= AvFILLp(seqs); s++) { SV** svp; - seq = (AV*)*avptr++; - if(AvFILLp(seq) < 0) continue; - svp = av_fetch(seq, 0, 0); - seqhead = *svp; + seq = (AV*)(avptr[s]); + if(!seq) continue; /* skip empty seqs */ + svp = av_fetch(seq, heads[s], 0); + seqhead = *svp; /* seqhead = head of this seq */ if(!winner) { + /* if we haven't found a winner for this round yet, + and this seqhead is not in tails (or the count + for it in tails has dropped to zero), then this + seqhead is our new winner, and is added to the + final MRO immediately */ cand = seqhead; if((tail_entry = hv_fetch_ent(tails, cand, 0, 0)) && (val = HeVAL(tail_entry)) @@ -311,27 +339,52 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level) continue; winner = newSVsv(cand); av_push(retval, winner); + /* note however that even when we find a winner, + we continue looping over @seqs to do housekeeping */ } if(!sv_cmp(seqhead, winner)) { - - /* this is basically shift(@seq) in void context */ - SvREFCNT_dec(*AvARRAY(seq)); - *AvARRAY(seq) = &PL_sv_undef; - AvARRAY(seq) = AvARRAY(seq) + 1; - AvMAX(seq)--; - AvFILLp(seq)--; - - if(AvFILLp(seq) < 0) continue; - svp = av_fetch(seq, 0, 0); - seqhead = *svp; - tail_entry = hv_fetch_ent(tails, seqhead, 0, 0); - val = HeVAL(tail_entry); - sv_dec(val); + /* Once we have a winner (including the iteration + where we first found him), inc the head ptr + for any seq which had the winner as a head, + NULL out any seq which is now empty, + and adjust tails for consistency */ + + int new_head = ++heads[s]; + if(new_head > AvFILLp(seq)) { + avptr[s] = NULL; + } + else { + /* Because we know this new seqhead used to be + a tail, we can assume it is in tails and has + a positive value, which we need to dec */ + svp = av_fetch(seq, new_head, 0); + seqhead = *svp; + tail_entry = hv_fetch_ent(tails, seqhead, 0, 0); + val = HeVAL(tail_entry); + sv_dec(val); + } } } - if(!cand) break; + + /* if we found no candidates, we are done building the MRO. + !cand means no seqs have any entries left to check */ + if(!cand) { + Safefree(heads); + break; + } + + /* If we had candidates, but nobody won, then the @ISA + hierarchy is not C3-incompatible */ if(!winner) { + /* we have to do some cleanup before we croak */ + SV** svp = AvARRAY(seqs); + items = AvFILLp(seqs) + 1; + while (items--) + *svp++ = NULL; + SvREFCNT_dec(retval); + Safefree(heads); + Perl_croak(aTHX_ "Inconsistent hierarchy during C3 merge of class '%s': " "merging failed on parent '%"SVf"'", stashname, SVfARG(cand)); }