In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/dbdb57e61cddbe8e7a199ac438f0523d0c20e4ce?hp=1c5665476f0d7250c7d93f82eab2b7cda1e6937f>
- Log ----------------------------------------------------------------- commit dbdb57e61cddbe8e7a199ac438f0523d0c20e4ce Merge: 1c56654 c62c27b Author: David Mitchell <[email protected]> Date: Tue Oct 4 11:40:12 2016 +0100 [MERGE] eliminate OP_PUSHRE and optimise split() commit c62c27bf164f6671b74cfff2449a8b553f7081ae Author: David Mitchell <[email protected]> Date: Sun Sep 25 19:30:39 2016 +0100 Perl_newASSIGNOP: fix on g++ builds op.c: In function âOP* Perl_newASSIGNOP(PerlInterpreter*, I32, OP*, I32, OP*)â: op.c:6605:15: error: jump to label âdetach_splitâ [-fpermissive] detach_split: ^ op.c:6631:22: note: from here goto detach_split; ^ op.c:6584:30: note: skips initialization of âPMOP* const pmâ PMOP * const pm = (PMOP*)right; M op.c commit 4ad59fdb481181ca4ec84ec004a9b4a58ab357f6 Author: David Mitchell <[email protected]> Date: Mon Sep 19 16:42:45 2016 +0100 Concise.pm: extract padname code and fixup split The code that prints '$i:1,2'' in something like 'padsv[$i:1,2]': extract it out into a separate function, then use it with split to display the array name rather than just a target number in: $ perl -MO=Concise -e'my @a = split()' ... split(/" "/ => @a:1,2)[t2] vK/LVINTRO,RTIME,ASSIGN,LEX,IMPLIM ->6 M ext/B/B/Concise.pm commit 47a8f19b6f8f837245506422e5a4d36804e7b56a Author: David Mitchell <[email protected]> Date: Mon Sep 19 15:39:34 2016 +0100 fix common assign issue on @a = (split(), 1) RT #127999 Slowdown in split + list assign The compile-time common-value detection mechanism for OP_ASSIGN was getting OP_SPLIT wrong. It was assuming that OP_SPLIT was always dangerous. In fact, OP_SPLIT is usually completely safe, not passing though any of its arguments, except where the assign in (@a = split()) has been optimised away and the array attached directly to the OP_SPLIT op, or the ops that produce the array have been appended as an extra child of the OP_SPLIT op (OPf_STACKED). M op.c M t/perf/benchmarks M t/perf/optree.t commit 692044df8403d4568b919fe9ad7e282e864ec85e Author: David Mitchell <[email protected]> Date: Mon Sep 19 12:35:13 2016 +0100 Better optimise my/local @a = split() There are currently two optimisations for when the results of a split are assigned to an array. For the first, @array = split(...); the aassign and padav/rv2av are optimised away, and pp_split() directly assigns to the array attached to the split op (via op_pmtargetoff or op_pmtargetgv). For the second, my @array = split(...); local @array = split(...); @{$expr} = split(...); The aassign is optimised away, but the padav/rv2av is kept as an additional arg to split. pp_split itself then uses the first arg popped off the stack as the array (This was introduced by FC with v5.21.4-409-gef7999f). This commit moves these two: my @array = split(...); local @array = split(...); from the second case to the first case, by simply setting OPpLVAL_INTRO on the OP_SPLIT, and making pp_split() do SAVECLEARSV() or save_ary() as appropriate. This makes my @a = split(...) a few percent faster. M ext/B/B/Concise.pm M lib/B/Deparse.pm M lib/B/Op_private.pm M op.c M opcode.h M pp.c M regen/op_private M t/op/split.t M t/perf/benchmarks M t/perf/opcount.t commit 70027d69be2857dc45d5ff75021fc5f55d6295da Author: David Mitchell <[email protected]> Date: Sun Sep 18 16:13:41 2016 +0100 re-indent block in Perl_newASSIGNOP Whitepace-only change. This is a followup to the previous commit, which simplified that code somewhat. M op.c commit 5012eebe5586df96a1869edfedea1382aa254085 Author: David Mitchell <[email protected]> Date: Thu Sep 15 10:59:37 2016 +0100 make OP_SPLIT a PMOP, and eliminate OP_PUSHRE Most ops that execute a regex, such as match and subst, are of type PMOP. A PMOP allows the actual regex to be attached directly to that op, due to its extra fields. OP_SPLIT is different; it is just a plain LISTOP, but it always has an OP_PUSHRE as its first child, which *is* a PMOP and which has the regex attached. At runtime, pp_pushre()'s only job is to push itself (i.e. the current PL_op) onto the stack. Later pp_split() pops this to get access to the regex it wants to execute. This is a bit unpleasant, because we're pushing an OP* onto the stack, which is supposed to be an array of SV*'s. As a bit of a hack, on DEBUGGING builds we push a PVLV with the PL_op address embedded instead, but this still isn't very satisfactory. Now that regexes are first-class SVs, we could push a REGEXP onto the stack rather than PL_op. However, there is an optimisation of @array = split which eliminates the assign and embeds the array's GV/padix directly in the PUSHRE op. So split still needs access to that op. But the pushre op will always be splitop->op_first anyway, so one possibility is to just skip executing the pushre altogether, and make pp_split just directly access op_first instead to get the regex and @array info. But if we're doing that, then why not just go the full hog and make OP_SPLIT into a PMOP, and eliminate the OP_PUSHRE op entirely: with the data that was spread across the two ops now combined into just the one split op. That is exactly what this commit does. For a simple compile-time pattern like split(/foo/, $s, 1), the optree looks like: before: <@> split[t2] lK </> pushre(/"foo"/) s/RTIME <0> padsv[$s:1,2] s <$> const(IV 1) s after: </> split(/"foo"/)[t2] lK/RTIME <0> padsv[$s:1,2] s <$> const[IV 1] s while for a run-time expression like split(/$pat/, $s, 1), before: <@> split[t3] lK </> pushre() sK/RTIME <|> regcomp(other->8) sK <0> padsv[$pat:2,3] s <0> padsv[$s:1,3] s <$> const(IV 1)s after: </> split()[t3] lK/RTIME <|> regcomp(other->8) sK <0> padsv[$pat:2,3] s <0> padsv[$s:1,3] s <$> const[IV 1] s This makes the code faster and simpler. At the same time, two new private flags have been added for OP_SPLIT - OPpSPLIT_ASSIGN and OPpSPLIT_LEX - which make it explicit that the assign op has been optimised away, and if so, whether the array is lexical. Also, deparsing of split has been improved, to the extent that perl TEST -deparse op/split.t now passes. Also, a couple of panic messages in pp_split() have been replaced with asserts(). M Porting/deparse-skips.txt M cpan/B-Debug/t/debug.t M dist/Safe/t/safeops.t M dump.c M embed.fnc M ext/B/B.pm M ext/B/B.xs M ext/B/B/Concise.pm M ext/B/t/b.t M ext/B/t/optree_concise.t M ext/B/t/walkoptree.t M ext/Opcode/Opcode.pm M lib/B/Deparse.pm M lib/B/Deparse.t M lib/B/Op_private.pm M op.c M op.h M opcode.h M opnames.h M pod/perldiag.pod M pp.c M pp_ctl.c M pp_hot.c M pp_proto.h M proto.h M regen/op_private M regen/opcodes M regexp.h M t/op/split.t M t/perf/benchmarks ----------------------------------------------------------------------- Summary of changes: Porting/deparse-skips.txt | 1 - cpan/B-Debug/t/debug.t | 6 +- dist/Safe/t/safeops.t | 1 - dump.c | 15 +- embed.fnc | 2 +- ext/B/B.pm | 2 +- ext/B/B.xs | 23 +- ext/B/B/Concise.pm | 121 +++++--- ext/B/t/b.t | 3 +- ext/B/t/optree_concise.t | 4 +- ext/B/t/walkoptree.t | 6 +- ext/Opcode/Opcode.pm | 4 +- lib/B/Deparse.pm | 91 +++--- lib/B/Deparse.t | 26 ++ lib/B/Op_private.pm | 22 +- op.c | 324 ++++++++++--------- op.h | 8 +- opcode.h | 425 +++++++++++++------------ opnames.h | 769 +++++++++++++++++++++++----------------------- pod/perldiag.pod | 8 - pp.c | 49 +-- pp_ctl.c | 12 - pp_hot.c | 19 -- pp_proto.h | 1 - proto.h | 2 +- regen/op_private | 15 +- regen/opcodes | 4 +- regexp.h | 5 +- t/op/split.t | 89 +++++- t/perf/benchmarks | 29 ++ t/perf/opcount.t | 27 +- t/perf/optree.t | 7 +- 32 files changed, 1173 insertions(+), 947 deletions(-) diff --git a/Porting/deparse-skips.txt b/Porting/deparse-skips.txt index 7e77d71..efac18f 100644 --- a/Porting/deparse-skips.txt +++ b/Porting/deparse-skips.txt @@ -175,7 +175,6 @@ op/pack.t op/postfixderef.t op/range.t op/readline.t -op/split.t op/srand.t op/sub.t op/sub_lval.t diff --git a/cpan/B-Debug/t/debug.t b/cpan/B-Debug/t/debug.t index f4f0a10..0c79adb 100644 --- a/cpan/B-Debug/t/debug.t +++ b/cpan/B-Debug/t/debug.t @@ -56,19 +56,19 @@ my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define'; if ($is_thread) { $b=<<EOF; leave enter nextstate label leaveloop enterloop null and defined null -threadsv readline gv lineseq nextstate aassign null pushmark split pushre +threadsv readline gv lineseq nextstate aassign null pushmark split threadsv const null pushmark rvav gv nextstate subst const unstack EOF } elsif ($] >= 5.021005) { $b=<<EOF; leave enter nextstate label leaveloop enterloop null and defined null null -gvsv readline gv lineseq nextstate split pushre null +gvsv readline gv lineseq nextstate split null gvsv const nextstate subst const unstack EOF } else { $b=<<EOF; leave enter nextstate label leaveloop enterloop null and defined null null -gvsv readline gv lineseq nextstate aassign null pushmark split pushre null +gvsv readline gv lineseq nextstate aassign null pushmark split null gvsv const null pushmark rvav gv nextstate subst const unstack EOF } diff --git a/dist/Safe/t/safeops.t b/dist/Safe/t/safeops.t index 2133bde..9094a00 100644 --- a/dist/Safe/t/safeops.t +++ b/dist/Safe/t/safeops.t @@ -111,7 +111,6 @@ padsv SKIP my $x padav SKIP my @x padhv SKIP my %x padany SKIP (not implemented) -pushre SKIP split /foo/ rv2gv *x rv2sv $x av2arylen $#x diff --git a/dump.c b/dump.c index e69421b..5f75338 100644 --- a/dump.c +++ b/dump.c @@ -670,10 +670,17 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : ""); else Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n"); - if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) { - Perl_dump_indent(aTHX_ level, file, "PMf_REPL = "); - op_dump(pm->op_pmreplrootu.op_pmreplroot); + + if (pm->op_type == OP_SPLIT) + Perl_dump_indent(aTHX_ level, file, "TARGOFF/GV = 0x%"UVxf"\n", + PTR2UV(pm->op_pmreplrootu.op_pmtargetgv)); + else { + if (pm->op_pmreplrootu.op_pmreplroot) { + Perl_dump_indent(aTHX_ level, file, "PMf_REPL = "); + op_dump(pm->op_pmreplrootu.op_pmreplroot); + } } + if (pm->op_code_list) { if (pm->op_pmflags & PMf_CODELIST_PRIVATE) { Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n"); @@ -1043,7 +1050,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) else PerlIO_printf(file, "DONE\n"); break; - case OP_PUSHRE: + case OP_SPLIT: case OP_MATCH: case OP_QR: case OP_SUBST: diff --git a/embed.fnc b/embed.fnc index 168fe68..e4c4e30 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1228,7 +1228,7 @@ s |void |pidgone |Pid_t pid|int status #endif : Used in perly.y p |OP* |pmruntime |NN OP *o|NN OP *expr|NULLOK OP *repl \ - |bool isreg|I32 floor + |UV flags|I32 floor #if defined(PERL_IN_OP_C) s |OP* |pmtrans |NN OP* o|NN OP* expr|NN OP* repl #endif diff --git a/ext/B/B.pm b/ext/B/B.pm index ffe9724..5cc253e 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -15,7 +15,7 @@ require Exporter; # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.63'; + $B::VERSION = '1.64'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index fb42954..0490352 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -542,7 +542,7 @@ walkoptree(pTHX_ OP *o, const char *method, SV *ref) ref = walkoptree(aTHX_ kid, method, ref); } } - if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE + if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_SPLIT && (kid = PMOP_pmreplroot(cPMOPo))) { ref = walkoptree(aTHX_ kid, method, ref); @@ -1128,16 +1128,19 @@ next(o) } break; case 34: /* B::PMOP::pmreplroot */ - if (cPMOPo->op_type == OP_PUSHRE) { -#ifdef USE_ITHREADS - ret = sv_newmortal(); - sv_setiv(ret, cPMOPo->op_pmreplrootu.op_pmtargetoff); -#else - GV *const target = cPMOPo->op_pmreplrootu.op_pmtargetgv; + if (cPMOPo->op_type == OP_SPLIT) { ret = sv_newmortal(); - sv_setiv(newSVrv(ret, target ? - svclassnames[SvTYPE((SV*)target)] : "B::SV"), - PTR2IV(target)); +#ifndef USE_ITHREADS + if (o->op_private & OPpSPLIT_LEX) +#endif + sv_setiv(ret, cPMOPo->op_pmreplrootu.op_pmtargetoff); +#ifndef USE_ITHREADS + else { + GV *const target = cPMOPo->op_pmreplrootu.op_pmtargetgv; + sv_setiv(newSVrv(ret, target ? + svclassnames[SvTYPE((SV*)target)] : "B::SV"), + PTR2IV(target)); + } #endif } else { diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 34efc2c..315e00a 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "0.998"; +our $VERSION = "0.999"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -28,6 +28,8 @@ our %EXPORT_TAGS = # use #6 use B qw(class ppname main_start main_root main_cv cstring svref_2object SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL + OPf_STACKED + OPpSPLIT_ASSIGN OPpSPLIT_LEX CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK); my %style = @@ -762,6 +764,50 @@ sub fill_srclines { $srclines{$fullnm} = \@l; } +# Given a pad target, return the pad var's name and cop range / +# fakeness, or failing that, its target number. +# e.g. +# ('$i', '$i:5,7') +# or +# ('$i', '$i:fake:a') +# or +# ('t5', 't5') + +sub padname { + my ($targ) = @_; + + my ($targarg, $targarglife); + my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$targ]; + if (defined $padname and class($padname) ne "SPECIAL" and + $padname->LEN) + { + $targarg = $padname->PVX; + if ($padname->FLAGS & SVf_FAKE) { + # These changes relate to the jumbo closure fix. + # See changes 19939 and 20005 + my $fake = ''; + $fake .= 'a' + if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON; + $fake .= 'm' + if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI; + $fake .= ':' . $padname->PARENT_PAD_INDEX + if $curcv->CvFLAGS & CVf_ANON; + $targarglife = "$targarg:FAKE:$fake"; + } + else { + my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base; + my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base; + $finish = "end" if $finish == 999999999 - $cop_seq_base; + $targarglife = "$targarg:$intro,$finish"; + } + } else { + $targarglife = $targarg = "t" . $targ; + } + return $targarg, $targarglife; +} + + + sub concise_op { my ($op, $level, $format) = @_; my %h; @@ -794,33 +840,7 @@ sub concise_op { : 1; my (@targarg, @targarglife); for my $i (0..$count-1) { - my ($targarg, $targarglife); - my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}+$i]; - if (defined $padname and class($padname) ne "SPECIAL" and - $padname->LEN) - { - $targarg = $padname->PVX; - if ($padname->FLAGS & SVf_FAKE) { - # These changes relate to the jumbo closure fix. - # See changes 19939 and 20005 - my $fake = ''; - $fake .= 'a' - if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON; - $fake .= 'm' - if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI; - $fake .= ':' . $padname->PARENT_PAD_INDEX - if $curcv->CvFLAGS & CVf_ANON; - $targarglife = "$targarg:FAKE:$fake"; - } - else { - my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base; - my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base; - $finish = "end" if $finish == 999999999 - $cop_seq_base; - $targarglife = "$targarg:$intro,$finish"; - } - } else { - $targarglife = $targarg = "t" . ($h{targ}+$i); - } + my ($targarg, $targarglife) = padname($h{targ} + $i); push @targarg, $targarg; push @targarglife, $targarglife; } @@ -845,22 +865,35 @@ sub concise_op { $extra = " replstart->" . seq($op->pmreplstart); } } - elsif ($op->name eq 'pushre') { - # with C<@stash_array = split(/pat/, str);>, - # *stash_array is stored in /pat/'s pmreplroot. - my $gv = $op->pmreplroot; - if (!ref($gv)) { - # threaded: the value is actually a pad offset for where - # the GV is kept (op_pmtargetoff) - if ($gv) { - $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$gv]->NAME; - } - } - else { - # unthreaded: its a GV (if it exists) - $gv = (ref($gv) eq "B::GV") ? $gv->NAME : undef; - } - $extra = " => \@$gv" if $gv; + elsif ($op->name eq 'split') { + if ( ($op->private & OPpSPLIT_ASSIGN) # @array = split + && (not $op->flags & OPf_STACKED)) # @{expr} = split + { + # with C<@array = split(/pat/, str);>, + # array is stored in /pat/'s pmreplroot; either + # as an integer index into the pad (for a lexical array) + # or as GV for a package array (which will be a pad index + # on threaded builds) + + if ($op->private & $B::Op_private::defines{'OPpSPLIT_LEX'}) { + my $off = $op->pmreplroot; # union with op_pmtargetoff + my ($name, $full) = padname($off); + $extra = " => $full"; + } + else { + # union with op_pmtargetoff, op_pmtargetgv + my $gv = $op->pmreplroot; + if (!ref($gv)) { + # the value is actually a pad offset + $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$gv]->NAME; + } + else { + # unthreaded: its a GV + $gv = $gv->NAME; + } + $extra = " => \@$gv"; + } + } } $h{arg} = "($precomp$extra)"; } elsif ($h{class} eq "PVOP" and $h{name} !~ '^transr?\z') { diff --git a/ext/B/t/b.t b/ext/B/t/b.t index 4638c3e..a5d7249 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -298,8 +298,7 @@ is(B::opnumber("pp_null"), 0, "Testing opnumber with opname (pp_null)"); is(B::class(bless {}, "Wibble::Bibble"), "Bibble", "Testing B::class()"); is(B::cast_I32(3.14), 3, "Testing B::cast_I32()"); -is(B::opnumber("chop"), $] >= 5.015 ? 39 : 38, - "Testing opnumber with opname (chop)"); +is(B::opnumber("chop"), 38, "Testing opnumber with opname (chop)"); { no warnings 'once'; diff --git a/ext/B/t/optree_concise.t b/ext/B/t/optree_concise.t index 12781ac..1e25947 100644 --- a/ext/B/t/optree_concise.t +++ b/ext/B/t/optree_concise.t @@ -183,13 +183,13 @@ checkOptree ( name => "terse basic", UNOP (0x82b0918) leavesub [1] LISTOP (0x82b08d8) lineseq COP (0x82b0880) nextstate - UNOP (0x82b0860) null [15] + UNOP (0x82b0860) null [14] PADOP (0x82b0840) gvsv GV (0x82a818c) *a EOT_EOT # UNOP (0x8282310) leavesub [1] # LISTOP (0x82822f0) lineseq # COP (0x82822b8) nextstate -# UNOP (0x812fc20) null [15] +# UNOP (0x812fc20) null [14] # SVOP (0x812fc00) gvsv GV (0x814692c) *a EONT_EONT diff --git a/ext/B/t/walkoptree.t b/ext/B/t/walkoptree.t index 3648835..1d42dd5 100644 --- a/ext/B/t/walkoptree.t +++ b/ext/B/t/walkoptree.t @@ -36,13 +36,13 @@ my $victim = sub { $_[0] =~ s/(a)/ $1/; # PMOP_pmreplroot(cPMOPo) is NULL for this $_[0] =~ s/(b)//; - # This gives an OP_PUSHRE + # This gives an OP_SPLIT split /c/; }; is (B::walkoptree_debug, 0, 'walkoptree_debug() is 0'); B::walkoptree(B::svref_2object($victim)->ROOT, "pie"); -foreach (qw(substcont pushre split leavesub)) { +foreach (qw(substcont split split leavesub)) { is ($seen{$_}, 1, "Our victim had a $_ OP"); } is_deeply ([keys %debug], [], 'walkoptree_debug was not called'); @@ -52,7 +52,7 @@ is (B::walkoptree_debug, 1, 'walkoptree_debug() is 1'); %seen = (); B::walkoptree(B::svref_2object($victim)->ROOT, "pie"); -foreach (qw(substcont pushre split leavesub)) { +foreach (qw(substcont split split leavesub)) { is ($seen{$_}, 1, "Our victim had a $_ OP"); } is_deeply (\%debug, \%seen, 'walkoptree_debug was called correctly'); diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 912aa4d..1b9f95f 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -6,7 +6,7 @@ use strict; our($VERSION, @ISA, @EXPORT_OK); -$VERSION = "1.37"; +$VERSION = "1.38"; use Carp; use Exporter (); @@ -409,7 +409,7 @@ These are a hotchpotch of opcodes still waiting to be considered bless -- could be used to change ownership of objects (reblessing) - pushre regcmaybe regcreset regcomp subst substcont + regcmaybe regcreset regcomp subst substcont sprintf prtf -- can core dump diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 5254f86..e14620b 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -16,6 +16,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER OPpREPEAT_DOLIST OPpSORT_REVERSE OPpMULTIDEREF_EXISTS OPpMULTIDEREF_DELETE + OPpSPLIT_ASSIGN OPpSPLIT_LEX SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG SVs_PADTMP SVpad_TYPED CVf_METHOD CVf_LVALUE @@ -46,7 +47,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring MDEREF_SHIFT ); -$VERSION = '1.38'; +$VERSION = '1.39'; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -5630,7 +5631,7 @@ sub matchop { my($op, $cx, $name, $delim) = @_; my $kid = $op->first; my ($binop, $var, $re) = ("", "", ""); - if ($op->flags & OPf_STACKED) { + if ($op->name ne 'split' && $op->flags & OPf_STACKED) { $binop = 1; $var = $self->deparse($kid, 20); $kid = $kid->sibling; @@ -5669,7 +5670,13 @@ sub matchop { } elsif (!$have_kid) { $re = re_uninterp(escape_re(re_unback($op->precomp))); } elsif ($kid->name ne 'regcomp') { - carp("found ".$kid->name." where regcomp expected"); + if ($op->name eq 'split') { + # split has other kids, not just regcomp + $re = re_uninterp(escape_re(re_unback($op->precomp))); + } + else { + carp("found ".$kid->name." where regcomp expected"); + } } else { ($re, $quote) = $self->regcomp($kid, 21); } @@ -5709,64 +5716,58 @@ sub matchop { } sub pp_match { matchop(@_, "m", "/") } -sub pp_pushre { matchop(@_, "m", "/") } sub pp_qr { matchop(@_, "qr", "") } sub pp_runcv { unop(@_, "__SUB__"); } sub pp_split { - maybe_targmy(@_, \&split); -} -sub split { my $self = shift; my($op, $cx) = @_; my($kid, @exprs, $ary, $expr); + my $stacked = $op->flags & OPf_STACKED; + $kid = $op->first; + $kid = $kid->sibling if $kid->name eq 'regcomp'; + for (; !null($kid); $kid = $kid->sibling) { + push @exprs, $self->deparse($kid, 6); + } - # For our kid (an OP_PUSHRE), pmreplroot is never actually the - # root of a replacement; it's either empty, or abused to point to - # the GV for an array we split into (an optimization to save - # assignment overhead). Depending on whether we're using ithreads, - # this OP* holds either a GV* or a PADOFFSET. Luckily, B.xs - # figures out for us which it is. - my $replroot = $kid->pmreplroot; - my $gv = 0; - my $stacked = $op->flags & OPf_STACKED; - if (ref($replroot) eq "B::GV") { - $gv = $replroot; - } elsif (!ref($replroot) and $replroot > 0) { - $gv = $self->padval($replroot); - } elsif ($kid->targ) { - $ary = $self->padname($kid->targ) - } elsif ($stacked) { - $ary = $self->deparse($op->last, 7); - } - $ary = $self->maybe_local(@_, + unshift @exprs, $self->matchop($op, $cx, "m", "/"); + + if ($op->private & OPpSPLIT_ASSIGN) { + # With C<@array = split(/pat/, str);>, + # array is stored in split's pmreplroot; either + # as an integer index into the pad (for a lexical array) + # or as GV for a package array (which will be a pad index + # on threaded builds) + # With my/our @array = split(/pat/, str), the array is instead + # accessed via an extra padav/rv2av op at the end of the + # split's kid ops. + + if ($stacked) { + $ary = pop @exprs; + } + else { + if ($op->private & OPpSPLIT_LEX) { + $ary = $self->padname($op->pmreplroot); + } + else { + # union with op_pmtargetoff, op_pmtargetgv + my $gv = $op->pmreplroot; + $gv = $self->padval($gv) if !ref($gv); + $ary = $self->maybe_local(@_, $self->stash_variable('@', $self->gv_name($gv), $cx)) - if $gv; - - # Skip the last kid when OPf_STACKED is set, since it is the array - # on the left. - for (; !null($stacked ? $kid->sibling : $kid); $kid = $kid->sibling) { - push @exprs, $self->deparse($kid, 6); + } + if ($op->private & OPpLVAL_INTRO) { + $ary = $op->private & OPpSPLIT_LEX ? "my $ary" : "local $ary"; + } + } } # handle special case of split(), and split(' ') that compiles to /\s+/ - # Under 5.10, the reflags may be undef if the split regexp isn't a constant - # Under 5.17.5-5.17.9, the special flag is on split itself. - $kid = $op->first; - if ( $op->flags & OPf_SPECIAL - or ( - $kid->flags & OPf_SPECIAL - and ( $] < 5.009 ? $kid->pmflags & PMf_SKIPWHITE() - : ($kid->reflags || 0) & RXf_SKIPWHITE() - ) - ) - ) { - $exprs[0] = "' '"; - } + $exprs[0] = q{' '} if ($op->reflags // 0) & RXf_SKIPWHITE(); $expr = "split(" . join(", ", @exprs) . ")"; if ($ary) { diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 7d65d74..c378fec 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -785,12 +785,38 @@ print $_ foreach (reverse 1, 2..5); our @ary; @ary = split(' ', 'foo', 0); #### +my @ary; +@ary = split(' ', 'foo', 0); +#### # Split to our array our @array = split(//, 'foo', 0); #### # Split to my array my @array = split(//, 'foo', 0); #### +our @array; +my $c; +@array = split(/x(?{ $c++; })y/, 'foo', 0); +#### +my($x, $y, $p); +our $c; +($x, $y) = split(/$p(?{ $c++; })y/, 'foo', 2); +#### +our @ary; +my $pat; +@ary = split(/$pat/, 'foo', 0); +#### +my @ary; +our $pat; +@ary = split(/$pat/, 'foo', 0); +#### +our @array; +my $pat; +local @array = split(/$pat/, 'foo', 0); +#### +our $pat; +my @array = split(/$pat/, 'foo', 0); +#### # bug #40055 do { () }; #### diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 8a25ec6..f369370 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -133,7 +133,7 @@ $bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate); $bits{$_}{1} = 'OPpITER_REVERSED' for qw(enteriter iter); $bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop); $bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem multideref); -$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av r ... [18 chars truncated] +$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av r ... [24 chars truncated] $bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign); $bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign); $bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec); @@ -147,7 +147,7 @@ $bits{$_}{6} = 'OPpOUR_INTRO' for qw(enteriter gvsv rv2av rv2hv rv2sv split); $bits{$_}{6} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark refassign); $bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo); $bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite); -$bits{$_}{6} = 'OPpRUNTIME' for qw(match pushre qr subst substcont); +$bits{$_}{5} = 'OPpRUNTIME' for qw(match qr split subst substcont); $bits{$_}{2} = 'OPpSLICEWARNING' for qw(aslice hslice padav padhv rv2av rv2hv); $bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtr ... [294 chars truncated] $bits{$_}{5} = 'OPpTRANS_COMPLEMENT' for qw(trans transr); @@ -538,7 +538,7 @@ $bits{snetent}{0} = $bf[0]; @{$bits{sockpair}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{sort}}{6,5,4,3,2,1,0} = ('OPpSORT_STABLE', 'OPpSORT_QSORT', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER', 'OPpSORT_NUMERIC'); @{$bits{splice}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); -$bits{split}{7} = 'OPpSPLIT_IMPLIM'; +@{$bits{split}}{4,3,2} = ('OPpSPLIT_ASSIGN', 'OPpSPLIT_LEX', 'OPpSPLIT_IMPLIM'); @{$bits{sprintf}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sprotoent}{0} = $bf[0]; $bits{sqrt}{0} = $bf[0]; @@ -661,7 +661,7 @@ our %defines = ( OPpREFCOUNTED => 64, OPpREPEAT_DOLIST => 64, OPpREVERSE_INPLACE => 8, - OPpRUNTIME => 64, + OPpRUNTIME => 32, OPpSLICE => 64, OPpSLICEWARNING => 4, OPpSORT_DESCEND => 16, @@ -671,7 +671,9 @@ our %defines = ( OPpSORT_QSORT => 32, OPpSORT_REVERSE => 4, OPpSORT_STABLE => 64, - OPpSPLIT_IMPLIM => 128, + OPpSPLIT_ASSIGN => 16, + OPpSPLIT_IMPLIM => 4, + OPpSPLIT_LEX => 8, OPpSUBSTR_REPL_FIRST => 16, OPpTARGET_MY => 16, OPpTRANS_COMPLEMENT => 32, @@ -764,7 +766,9 @@ our %labels = ( OPpSORT_QSORT => 'QSORT', OPpSORT_REVERSE => 'REV', OPpSORT_STABLE => 'STABLE', + OPpSPLIT_ASSIGN => 'ASSIGN', OPpSPLIT_IMPLIM => 'IMPLIM', + OPpSPLIT_LEX => 'LEX', OPpSUBSTR_REPL_FIRST => 'REPL1ST', OPpTARGET_MY => 'TARGMY', OPpTRANS_COMPLEMENT => 'COMPL', @@ -800,7 +804,7 @@ our %ops_using = ( OPpLIST_GUESSED => [qw(list)], OPpLVALUE => [qw(leave leaveloop)], OPpLVAL_DEFER => [qw(aelem helem multideref)], - OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2 ... [17 chars truncated] + OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2 ... [23 chars truncated] OPpLVREF_ELEM => [qw(lvref refassign)], OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)], OPpMAYBE_TRUEBOOL => [qw(padhv rv2hv)], @@ -813,11 +817,11 @@ our %ops_using = ( OPpREFCOUNTED => [qw(leave leaveeval leavesub leavesublv leavewrite)], OPpREPEAT_DOLIST => [qw(repeat)], OPpREVERSE_INPLACE => [qw(reverse)], - OPpRUNTIME => [qw(match pushre qr subst substcont)], + OPpRUNTIME => [qw(match qr split subst substcont)], OPpSLICE => [qw(delete)], OPpSLICEWARNING => [qw(aslice hslice padav padhv rv2av rv2hv)], OPpSORT_DESCEND => [qw(sort)], - OPpSPLIT_IMPLIM => [qw(split)], + OPpSPLIT_ASSIGN => [qw(split)], OPpSUBSTR_REPL_FIRST => [qw(substr)], OPpTARGET_MY => [qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtra ... [294 chars truncated] OPpTRANS_COMPLEMENT => [qw(trans transr)], @@ -854,6 +858,8 @@ $ops_using{OPpSORT_NUMERIC} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_QSORT} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_REVERSE} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_STABLE} = $ops_using{OPpSORT_DESCEND}; +$ops_using{OPpSPLIT_IMPLIM} = $ops_using{OPpSPLIT_ASSIGN}; +$ops_using{OPpSPLIT_LEX} = $ops_using{OPpSPLIT_ASSIGN}; $ops_using{OPpTRANS_DELETE} = $ops_using{OPpTRANS_COMPLEMENT}; $ops_using{OPpTRANS_FROM_UTF} = $ops_using{OPpTRANS_COMPLEMENT}; $ops_using{OPpTRANS_GROWS} = $ops_using{OPpTRANS_COMPLEMENT}; diff --git a/op.c b/op.c index 5621d07..86e1f0c 100644 --- a/op.c +++ b/op.c @@ -1015,14 +1015,20 @@ Perl_op_clear(pTHX_ OP *o) case OP_SUBST: op_free(cPMOPo->op_pmreplrootu.op_pmreplroot); goto clear_pmop; - case OP_PUSHRE: + + case OP_SPLIT: + if ( (o->op_private & OPpSPLIT_ASSIGN) /* @array = split */ + && !(o->op_flags & OPf_STACKED)) /* @{expr} = split */ + { + if (o->op_private & OPpSPLIT_LEX) + pad_free(cPMOPo->op_pmreplrootu.op_pmtargetoff); + else #ifdef USE_ITHREADS - if (cPMOPo->op_pmreplrootu.op_pmtargetoff) { - pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE); - } + pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE); #else - SvREFCNT_dec(MUTABLE_SV(cPMOPo->op_pmreplrootu.op_pmtargetgv)); + SvREFCNT_dec(MUTABLE_SV(cPMOPo->op_pmreplrootu.op_pmtargetgv)); #endif + } /* FALLTHROUGH */ case OP_MATCH: case OP_QR: @@ -1226,7 +1232,7 @@ S_find_and_forget_pmops(pTHX_ OP *o) while (kid) { switch (kid->op_type) { case OP_SUBST: - case OP_PUSHRE: + case OP_SPLIT: case OP_MATCH: case OP_QR: forget_pmop((PMOP*)kid); @@ -1992,16 +1998,7 @@ Perl_scalarvoid(pTHX_ OP *arg) break; case OP_SPLIT: - kid = cLISTOPo->op_first; - if (kid && kid->op_type == OP_PUSHRE - && !kid->op_targ - && !(o->op_flags & OPf_STACKED) -#ifdef USE_ITHREADS - && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff -#else - && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv -#endif - ) + if (!(o->op_private & OPpSPLIT_ASSIGN)) useless = OP_DESC(o); break; @@ -3238,16 +3235,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) return o; case OP_SPLIT: - kid = cLISTOPo->op_first; - if (kid && kid->op_type == OP_PUSHRE && - ( kid->op_targ - || o->op_flags & OPf_STACKED -#ifdef USE_ITHREADS - || ((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff -#else - || ((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv -#endif - )) { + if ((o->op_private & OPpSPLIT_ASSIGN)) { /* This is actually @array = split. */ PL_modcount = RETURN_UNLIMITED_NUMBER; break; @@ -4772,7 +4760,13 @@ Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o) } } - OpTYPE_set(o, type); + if (type != OP_SPLIT) + /* At this point o is a LISTOP, but OP_SPLIT is a PMOP; let + * ck_split() create a real PMOP and leave the op's type as listop + * for for now. Otherwise op_free() etc will crash. + */ + OpTYPE_set(o, type); + o->op_flags |= flags; if (flags & OPf_FOLDED) o->op_folded = 1; @@ -5600,10 +5594,12 @@ S_set_haseval(pTHX) * constant), or convert expr into a runtime regcomp op sequence (if it's * not) * - * isreg indicates that the pattern is part of a regex construct, eg + * Flags currently has 2 bits or meaning: + * 1: isreg indicates that the pattern is part of a regex construct, eg * $x =~ /pattern/ or split /pattern/, as opposed to $x =~ $pattern or * split "pattern", which aren't. In the former case, expr will be a list * if the pattern contains more than one term (eg /a$b/). + * 2: The pattern is for a split. * * When the pattern has been compiled within a new anon CV (for * qr/(?{...})/ ), then floor indicates the savestack level just before @@ -5611,7 +5607,7 @@ S_set_haseval(pTHX) */ OP * -Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor) +Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor) { PMOP *pm; LOGOP *rcop; @@ -5619,6 +5615,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor) bool is_trans = (o->op_type == OP_TRANS || o->op_type == OP_TRANSR); bool is_compiletime; bool has_code; + bool isreg = cBOOL(flags & 1); + bool is_split = cBOOL(flags & 2); PERL_ARGS_ASSERT_PMRUNTIME; @@ -5723,8 +5721,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor) U32 rx_flags = pm->op_pmflags & RXf_PMf_COMPILETIME; regexp_engine const *eng = current_re_engine(); - if (o->op_flags & OPf_SPECIAL) + if (is_split) { + /* make engine handle split ' ' specially */ + pm->op_pmflags |= PMf_SPLIT; rx_flags |= RXf_SPLIT; + } if (!has_code || !eng->op_comp) { /* compile-time simple constant pattern */ @@ -5813,7 +5814,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor) pm->op_pmflags |= PMf_CODELIST_PRIVATE; } - if (o->op_flags & OPf_SPECIAL) + if (is_split) + /* make engine handle split ' ' specially */ pm->op_pmflags |= PMf_SPLIT; /* the OP_REGCMAYBE is a placeholder in the non-threaded case @@ -6565,91 +6567,94 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) yyerror(no_list_state); } - if (right && right->op_type == OP_SPLIT - && !(right->op_flags & OPf_STACKED)) { - OP* tmpop = ((LISTOP*)right)->op_first; - PMOP * const pm = (PMOP*)tmpop; - assert (tmpop && (tmpop->op_type == OP_PUSHRE)); - if ( -#ifdef USE_ITHREADS - !pm->op_pmreplrootu.op_pmtargetoff -#else - !pm->op_pmreplrootu.op_pmtargetgv -#endif - && !pm->op_targ - ) { - if (!(left->op_private & OPpLVAL_INTRO) && - ( (left->op_type == OP_RV2AV && - (tmpop=((UNOP*)left)->op_first)->op_type==OP_GV) - || left->op_type == OP_PADAV ) - ) { - if (tmpop != (OP *)pm) { + /* optimise @a = split(...) into: + * @{expr}: split(..., @{expr}) (where @a is not flattened) + * @a, my @a, local @a: split(...) (where @a is attached to + * the split op itself) + */ + + if ( right + && right->op_type == OP_SPLIT + /* don't do twice, e.g. @b = (@a = split) */ + && !(right->op_private & OPpSPLIT_ASSIGN)) + { + OP *gvop = NULL; + + if ( ( left->op_type == OP_RV2AV + && (gvop=((UNOP*)left)->op_first)->op_type==OP_GV) + || left->op_type == OP_PADAV) + { + /* @pkg or @lex or local @pkg' or 'my @lex' */ + OP *tmpop; + if (gvop) { #ifdef USE_ITHREADS - pm->op_pmreplrootu.op_pmtargetoff - = cPADOPx(tmpop)->op_padix; - cPADOPx(tmpop)->op_padix = 0; /* steal it */ + ((PMOP*)right)->op_pmreplrootu.op_pmtargetoff + = cPADOPx(gvop)->op_padix; + cPADOPx(gvop)->op_padix = 0; /* steal it */ #else - pm->op_pmreplrootu.op_pmtargetgv - = MUTABLE_GV(cSVOPx(tmpop)->op_sv); - cSVOPx(tmpop)->op_sv = NULL; /* steal it */ + ((PMOP*)right)->op_pmreplrootu.op_pmtargetgv + = MUTABLE_GV(cSVOPx(gvop)->op_sv); + cSVOPx(gvop)->op_sv = NULL; /* steal it */ #endif - right->op_private |= - left->op_private & OPpOUR_INTRO; - } - else { - pm->op_targ = left->op_targ; - left->op_targ = 0; /* filch it */ - } - detach_split: - tmpop = cUNOPo->op_first; /* to list (nulled) */ - tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ - /* detach rest of siblings from o subtree, - * and free subtree */ - op_sibling_splice(cUNOPo->op_first, tmpop, -1, NULL); - op_free(o); /* blow off assign */ - right->op_flags &= ~OPf_WANT; - /* "I don't know and I don't care." */ - return right; - } - else if (left->op_type == OP_RV2AV - || left->op_type == OP_PADAV) - { - /* Detach the array. */ -#ifdef DEBUGGING - OP * const ary = -#endif - op_sibling_splice(cBINOPo->op_last, - cUNOPx(cBINOPo->op_last) - ->op_first, 1, NULL); - assert(ary == left); - /* Attach it to the split. */ - op_sibling_splice(right, cLISTOPx(right)->op_last, - 0, left); - right->op_flags |= OPf_STACKED; - /* Detach split and expunge aassign as above. */ - goto detach_split; - } - else if (PL_modcount < RETURN_UNLIMITED_NUMBER && - ((LISTOP*)right)->op_last->op_type == OP_CONST) - { - SV ** const svp = - &((SVOP*)((LISTOP*)right)->op_last)->op_sv; - SV * const sv = *svp; - if (SvIOK(sv) && SvIVX(sv) == 0) - { - if (right->op_private & OPpSPLIT_IMPLIM) { - /* our own SV, created in ck_split */ - SvREADONLY_off(sv); - sv_setiv(sv, PL_modcount+1); - } - else { - /* SV may belong to someone else */ - SvREFCNT_dec(sv); - *svp = newSViv(PL_modcount+1); - } - } - } - } + right->op_private |= + left->op_private & OPpOUR_INTRO; + } + else { + ((PMOP*)right)->op_pmreplrootu.op_pmtargetoff = left->op_targ; + left->op_targ = 0; /* steal it */ + right->op_private |= OPpSPLIT_LEX; + } + right->op_private |= left->op_private & OPpLVAL_INTRO; + + detach_split: + tmpop = cUNOPo->op_first; /* to list (nulled) */ + tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ + assert(OpSIBLING(tmpop) == right); + assert(!OpHAS_SIBLING(right)); + /* detach the split subtreee from the o tree, + * then free the residual o tree */ + op_sibling_splice(cUNOPo->op_first, tmpop, 1, NULL); + op_free(o); /* blow off assign */ + right->op_private |= OPpSPLIT_ASSIGN; + right->op_flags &= ~OPf_WANT; + /* "I don't know and I don't care." */ + return right; + } + else if (left->op_type == OP_RV2AV) { + /* @{expr} */ + + OP *pushop = cUNOPx(cBINOPo->op_last)->op_first; + assert(OpSIBLING(pushop) == left); + /* Detach the array ... */ + op_sibling_splice(cBINOPo->op_last, pushop, 1, NULL); + /* ... and attach it to the split. */ + op_sibling_splice(right, cLISTOPx(right)->op_last, + 0, left); + right->op_flags |= OPf_STACKED; + /* Detach split and expunge aassign as above. */ + goto detach_split; + } + else if (PL_modcount < RETURN_UNLIMITED_NUMBER && + ((LISTOP*)right)->op_last->op_type == OP_CONST) + { + /* convert split(...,0) to split(..., PL_modcount+1) */ + SV ** const svp = + &((SVOP*)((LISTOP*)right)->op_last)->op_sv; + SV * const sv = *svp; + if (SvIOK(sv) && SvIVX(sv) == 0) + { + if (right->op_private & OPpSPLIT_IMPLIM) { + /* our own SV, created in ck_split */ + SvREADONLY_off(sv); + sv_setiv(sv, PL_modcount+1); + } + else { + /* SV may belong to someone else */ + SvREFCNT_dec(sv); + *svp = newSViv(PL_modcount+1); + } + } + } } return o; } @@ -11127,52 +11132,76 @@ Perl_ck_split(pTHX_ OP *o) { dVAR; OP *kid; + OP *sibs; PERL_ARGS_ASSERT_CK_SPLIT; + assert(o->op_type == OP_LIST); + if (o->op_flags & OPf_STACKED) return no_fh_allowed(o); kid = cLISTOPo->op_first; - if (kid->op_type != OP_NULL) - Perl_croak(aTHX_ "panic: ck_split, type=%u", (unsigned) kid->op_type); /* delete leading NULL node, then add a CONST if no other nodes */ + assert(kid->op_type == OP_NULL); op_sibling_splice(o, NULL, 1, OpHAS_SIBLING(kid) ? NULL : newSVOP(OP_CONST, 0, newSVpvs(" "))); op_free(kid); kid = cLISTOPo->op_first; if (kid->op_type != OP_MATCH || kid->op_flags & OPf_STACKED) { - /* remove kid, and replace with new optree */ + /* remove match expression, and replace with new optree with + * a match op at its head */ op_sibling_splice(o, NULL, 1, NULL); - /* OPf_SPECIAL is used to trigger split " " behavior */ - kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, NULL, 0, 0); + /* pmruntime will handle split " " behavior with flag==2 */ + kid = pmruntime(newPMOP(OP_MATCH, 0), kid, NULL, 2, 0); op_sibling_splice(o, NULL, 0, kid); } - OpTYPE_set(kid, OP_PUSHRE); - /* target implies @ary=..., so wipe it */ - kid->op_targ = 0; - scalar(kid); + + assert(kid->op_type == OP_MATCH || kid->op_type == OP_SPLIT); + if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL) { Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /g modifier is meaningless in split"); } - if (!OpHAS_SIBLING(kid)) - op_append_elem(OP_SPLIT, o, newDEFSVOP()); + /* eliminate the split op, and move the match op (plus any children) + * into its place, then convert the match op into a split op. i.e. + * + * SPLIT MATCH SPLIT(ex-MATCH) + * | | | + * MATCH - A - B - C => R - A - B - C => R - A - B - C + * | | | + * R X - Y X - Y + * | + * X - Y + * + * (R, if it exists, will be a regcomp op) + */ + + op_sibling_splice(o, NULL, 1, NULL); /* detach match op from o */ + sibs = op_sibling_splice(o, NULL, -1, NULL); /* detach any other sibs */ + op_sibling_splice(kid, cLISTOPx(kid)->op_last, 0, sibs); /* and reattach */ + OpTYPE_set(kid, OP_SPLIT); + kid->op_flags = (o->op_flags | (kid->op_flags & OPf_KIDS)); + assert(!(kid->op_private & ~OPpRUNTIME)); + kid->op_private = (o->op_private | (kid->op_private & OPpRUNTIME)); + op_free(o); + o = kid; + kid = sibs; /* kid is now the string arg of the split */ - kid = OpSIBLING(kid); - assert(kid); + if (!kid) { + kid = newDEFSVOP(); + op_append_elem(OP_SPLIT, o, kid); + } scalar(kid); - if (!OpHAS_SIBLING(kid)) - { - op_append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0))); + kid = OpSIBLING(kid); + if (!kid) { + kid = newSVOP(OP_CONST, 0, newSViv(0)); + op_append_elem(OP_SPLIT, o, kid); o->op_private |= OPpSPLIT_IMPLIM; } - assert(OpHAS_SIBLING(kid)); - - kid = OpSIBLING(kid); scalar(kid); if (OpHAS_SIBLING(kid)) @@ -12490,6 +12519,7 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p) case OP_PADAV: case OP_PADHV: (*scalars_p) += 2; + /* if !top, could be e.g. @a[0,1] */ if (top && (o->op_flags & OPf_REF)) return (o->op_private & OPpLVAL_INTRO) ? AAS_MY_AGG : AAS_LEX_AGG; @@ -12510,6 +12540,7 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p) if (cUNOPx(o)->op_first->op_type != OP_GV) return AAS_DANGEROUS; /* @{expr}, %{expr} */ /* @pkg, %pkg */ + /* if !top, could be e.g. @a[0,1] */ if (top && (o->op_flags & OPf_REF)) return AAS_PKG_AGG; return AAS_DANGEROUS; @@ -12523,15 +12554,32 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p) return AAS_PKG_SCALAR; /* $pkg */ case OP_SPLIT: - if (cLISTOPo->op_first->op_type == OP_PUSHRE) { - /* "@foo = split... " optimises away the aassign and stores its - * destination array in the OP_PUSHRE that precedes it. - * A flattened array is always dangerous. + if (o->op_private & OPpSPLIT_ASSIGN) { + /* the assign in @a = split() has been optimised away + * and the @a attached directly to the split op + * Treat the array as appearing on the RHS, i.e. + * ... = (@a = split) + * is treated like + * ... = @a; */ + + if (o->op_flags & OPf_STACKED) + /* @{expr} = split() - the array expression is tacked + * on as an extra child to split - process kid */ + return S_aassign_scan(aTHX_ cLISTOPo->op_last, rhs, + top, scalars_p); + + /* ... else array is directly attached to split op */ (*scalars_p) += 2; - return AAS_DANGEROUS; + if (PL_op->op_private & OPpSPLIT_LEX) + return (o->op_private & OPpLVAL_INTRO) + ? AAS_MY_AGG : AAS_LEX_AGG; + else + return AAS_PKG_AGG; } - break; + (*scalars_p)++; + /* other args of split can't be returned */ + return AAS_SAFE_SCALAR; case OP_UNDEF: /* undef counts as a scalar on the RHS: diff --git a/op.h b/op.h index 3ded4bb..47e6265 100644 --- a/op.h +++ b/op.h @@ -123,7 +123,6 @@ Deprecated. Use C<GIMME_V> instead. /* On OP_NULL, saw a "do". */ /* On OP_EXISTS, treat av as av, not avhv. */ /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */ - /* On pushre, rx is used as part of split, e.g. split " " */ /* On regcomp, "use re 'eval'" was in scope */ /* On RV2[ACGHS]V, don't create GV--in defined()*/ @@ -261,11 +260,8 @@ struct pmop { U32 op_pmflags; union { OP * op_pmreplroot; /* For OP_SUBST */ -#ifdef USE_ITHREADS - PADOFFSET op_pmtargetoff; /* For OP_PUSHRE */ -#else - GV * op_pmtargetgv; -#endif + PADOFFSET op_pmtargetoff; /* For OP_SPLIT lex ary or thr GV */ + GV * op_pmtargetgv; /* For OP_SPLIT non-threaded GV */ } op_pmreplrootu; union { OP * op_pmreplstart; /* Only used in OP_SUBST */ diff --git a/opcode.h b/opcode.h index 565cc9f..525ddc1 100644 --- a/opcode.h +++ b/opcode.h @@ -159,7 +159,6 @@ EXTCONST char* const PL_op_name[] = { "padav", "padhv", "padany", - "pushre", "rv2gv", "rv2sv", "av2arylen", @@ -564,7 +563,6 @@ EXTCONST char* const PL_op_desc[] = { "private array", "private hash", "private value", - "push regexp", "ref-to-glob cast", "scalar dereference", "array length", @@ -983,7 +981,6 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_padav, Perl_pp_padhv, Perl_pp_padany, /* implemented by Perl_unimplemented_op */ - Perl_pp_pushre, Perl_pp_rv2gv, Perl_pp_rv2sv, Perl_pp_av2arylen, @@ -1398,7 +1395,6 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_null, /* padav */ Perl_ck_null, /* padhv */ Perl_ck_null, /* padany */ - Perl_ck_null, /* pushre */ Perl_ck_rvconst, /* rv2gv */ Perl_ck_rvconst, /* rv2sv */ Perl_ck_null, /* av2arylen */ @@ -1807,7 +1803,6 @@ EXTCONST U32 PL_opargs[] = { 0x00000040, /* padav */ 0x00000040, /* padhv */ 0x00000040, /* padany */ - 0x00000540, /* pushre */ 0x00000144, /* rv2gv */ 0x00000144, /* rv2sv */ 0x00000104, /* av2arylen */ @@ -1950,7 +1945,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000f44, /* multideref */ 0x00091480, /* unpack */ 0x0002140f, /* pack */ - 0x00111408, /* split */ + 0x00111508, /* split */ 0x0002140f, /* join */ 0x00002401, /* list */ 0x00224200, /* lslice */ @@ -2226,6 +2221,7 @@ END_EXTERN_C #define OPpLVREF_ELEM 0x04 #define OPpSLICEWARNING 0x04 #define OPpSORT_REVERSE 0x04 +#define OPpSPLIT_IMPLIM 0x04 #define OPpTRANS_IDENTICAL 0x04 #define OPpARGELEM_MASK 0x06 #define OPpARG3_MASK 0x07 @@ -2239,6 +2235,7 @@ END_EXTERN_C #define OPpMAYBE_LVSUB 0x08 #define OPpREVERSE_INPLACE 0x08 #define OPpSORT_INPLACE 0x08 +#define OPpSPLIT_LEX 0x08 #define OPpTRANS_SQUASH 0x08 #define OPpARG4_MASK 0x0f #define OPpASSIGN_COMMON_AGG 0x10 @@ -2251,6 +2248,7 @@ END_EXTERN_C #define OPpMULTIDEREF_EXISTS 0x10 #define OPpOPEN_IN_RAW 0x10 #define OPpSORT_DESCEND 0x10 +#define OPpSPLIT_ASSIGN 0x10 #define OPpSUBSTR_REPL_FIRST 0x10 #define OPpTARGET_MY 0x10 #define OPpASSIGN_COMMON_RC1 0x20 @@ -2262,6 +2260,7 @@ END_EXTERN_C #define OPpMAY_RETURN_CONSTANT 0x20 #define OPpMULTIDEREF_DELETE 0x20 #define OPpOPEN_IN_CRLF 0x20 +#define OPpRUNTIME 0x20 #define OPpSORT_QSORT 0x20 #define OPpTRANS_COMPLEMENT 0x20 #define OPpTRUEBOOL 0x20 @@ -2284,7 +2283,6 @@ END_EXTERN_C #define OPpPAD_STATE 0x40 #define OPpREFCOUNTED 0x40 #define OPpREPEAT_DOLIST 0x40 -#define OPpRUNTIME 0x40 #define OPpSLICE 0x40 #define OPpSORT_STABLE 0x40 #define OPpTRANS_GROWS 0x40 @@ -2297,7 +2295,6 @@ END_EXTERN_C #define OPpOFFBYONE 0x80 #define OPpOPEN_OUT_CRLF 0x80 #define OPpPV_IS_UTF8 0x80 -#define OPpSPLIT_IMPLIM 0x80 #define OPpTRANS_DELETE 0x80 START_EXTERN_C @@ -2328,6 +2325,7 @@ EXTCONST char PL_op_private_labels[] = { '<','U','T','F','\0', '>','U','T','F','\0', 'A','M','P','E','R','\0', + 'A','S','S','I','G','N','\0', 'A','V','\0', 'B','A','R','E','\0', 'B','K','W','A','R','D','\0', @@ -2375,6 +2373,7 @@ EXTCONST char PL_op_private_labels[] = { 'I','N','P','L','A','C','E','\0', 'I','N','T','\0', 'I','T','E','R','\0', + 'L','E','X','\0', 'L','I','N','E','N','U','M','\0', 'L','V','\0', 'L','V','D','E','F','E','R','\0', @@ -2429,14 +2428,14 @@ EXTCONST char PL_op_private_labels[] = { EXTCONST I16 PL_op_private_bitfields[] = { 0, 8, -1, 0, 8, -1, - 0, 534, -1, + 0, 545, -1, 0, 8, -1, 0, 8, -1, + 0, 552, -1, 0, 541, -1, - 0, 530, -1, - 1, -1, 0, 507, 1, 26, 2, 276, -1, - 4, -1, 1, 157, 2, 164, 3, 171, -1, - 4, -1, 0, 507, 1, 26, 2, 276, 3, 103, -1, + 1, -1, 0, 518, 1, 33, 2, 283, -1, + 4, -1, 1, 164, 2, 171, 3, 178, -1, + 4, -1, 0, 518, 1, 33, 2, 283, 3, 110, -1, }; @@ -2458,27 +2457,26 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 16, /* padav */ 20, /* padhv */ -1, /* padany */ - 26, /* pushre */ - 27, /* rv2gv */ - 34, /* rv2sv */ - 39, /* av2arylen */ - 41, /* rv2cv */ + 26, /* rv2gv */ + 33, /* rv2sv */ + 38, /* av2arylen */ + 40, /* rv2cv */ -1, /* anoncode */ 0, /* prototype */ 0, /* refgen */ 0, /* srefgen */ 0, /* ref */ - 48, /* bless */ - 49, /* backtick */ - 48, /* glob */ + 47, /* bless */ + 48, /* backtick */ + 47, /* glob */ 0, /* readline */ -1, /* rcatline */ 0, /* regcmaybe */ 0, /* regcreset */ 0, /* regcomp */ - 26, /* match */ - 26, /* qr */ - 26, /* subst */ + 53, /* match */ + 53, /* qr */ + 53, /* subst */ 54, /* substcont */ 56, /* trans */ 56, /* transr */ @@ -2491,7 +2489,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* defined */ 0, /* undef */ 0, /* study */ - 39, /* pos */ + 38, /* pos */ 0, /* preinc */ 0, /* i_preinc */ 0, /* predec */ @@ -2570,8 +2568,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 82, /* vec */ 77, /* index */ 77, /* rindex */ - 48, /* sprintf */ - 48, /* formline */ + 47, /* sprintf */ + 47, /* formline */ 71, /* ord */ 71, /* chr */ 77, /* crypt */ @@ -2588,10 +2586,10 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 99, /* kvaslice */ 0, /* aeach */ 0, /* avalues */ - 39, /* akeys */ + 38, /* akeys */ 0, /* each */ 0, /* values */ - 39, /* keys */ + 38, /* keys */ 100, /* delete */ 103, /* exists */ 105, /* rv2hv */ @@ -2599,65 +2597,65 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 96, /* hslice */ 99, /* kvhslice */ 113, /* multideref */ - 48, /* unpack */ - 48, /* pack */ + 47, /* unpack */ + 47, /* pack */ 120, /* split */ - 48, /* join */ - 122, /* list */ + 47, /* join */ + 126, /* list */ 12, /* lslice */ - 48, /* anonlist */ - 48, /* anonhash */ - 48, /* splice */ + 47, /* anonlist */ + 47, /* anonhash */ + 47, /* splice */ 77, /* push */ 0, /* pop */ 0, /* shift */ 77, /* unshift */ - 124, /* sort */ - 131, /* reverse */ + 128, /* sort */ + 135, /* reverse */ 0, /* grepstart */ 0, /* grepwhile */ 0, /* mapstart */ 0, /* mapwhile */ 0, /* range */ - 133, /* flip */ - 133, /* flop */ + 137, /* flip */ + 137, /* flop */ 0, /* and */ 0, /* or */ 12, /* xor */ 0, /* dor */ - 135, /* cond_expr */ + 139, /* cond_expr */ 0, /* andassign */ 0, /* orassign */ 0, /* dorassign */ 0, /* method */ - 137, /* entersub */ - 144, /* leavesub */ - 144, /* leavesublv */ + 141, /* entersub */ + 148, /* leavesub */ + 148, /* leavesublv */ 0, /* argcheck */ - 146, /* argelem */ + 150, /* argelem */ 0, /* argdefelem */ - 148, /* caller */ - 48, /* warn */ - 48, /* die */ - 48, /* reset */ + 152, /* caller */ + 47, /* warn */ + 47, /* die */ + 47, /* reset */ -1, /* lineseq */ - 150, /* nextstate */ - 150, /* dbstate */ + 154, /* nextstate */ + 154, /* dbstate */ -1, /* unstack */ -1, /* enter */ - 151, /* leave */ + 155, /* leave */ -1, /* scope */ - 153, /* enteriter */ - 157, /* iter */ + 157, /* enteriter */ + 161, /* iter */ -1, /* enterloop */ - 158, /* leaveloop */ + 162, /* leaveloop */ -1, /* return */ - 160, /* last */ - 160, /* next */ - 160, /* redo */ - 160, /* dump */ - 160, /* goto */ - 48, /* exit */ + 164, /* last */ + 164, /* next */ + 164, /* redo */ + 164, /* dump */ + 164, /* goto */ + 47, /* exit */ 0, /* method_named */ 0, /* method_super */ 0, /* method_redir */ @@ -2668,79 +2666,79 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* leavewhen */ -1, /* break */ -1, /* continue */ - 162, /* open */ - 48, /* close */ - 48, /* pipe_op */ - 48, /* fileno */ - 48, /* umask */ - 48, /* binmode */ - 48, /* tie */ + 166, /* open */ + 47, /* close */ + 47, /* pipe_op */ + 47, /* fileno */ + 47, /* umask */ + 47, /* binmode */ + 47, /* tie */ 0, /* untie */ 0, /* tied */ - 48, /* dbmopen */ + 47, /* dbmopen */ 0, /* dbmclose */ - 48, /* sselect */ - 48, /* select */ - 48, /* getc */ - 48, /* read */ - 48, /* enterwrite */ - 144, /* leavewrite */ + 47, /* sselect */ + 47, /* select */ + 47, /* getc */ + 47, /* read */ + 47, /* enterwrite */ + 148, /* leavewrite */ -1, /* prtf */ -1, /* print */ -1, /* say */ - 48, /* sysopen */ - 48, /* sysseek */ - 48, /* sysread */ - 48, /* syswrite */ - 48, /* eof */ - 48, /* tell */ - 48, /* seek */ - 48, /* truncate */ - 48, /* fcntl */ - 48, /* ioctl */ + 47, /* sysopen */ + 47, /* sysseek */ + 47, /* sysread */ + 47, /* syswrite */ + 47, /* eof */ + 47, /* tell */ + 47, /* seek */ + 47, /* truncate */ + 47, /* fcntl */ + 47, /* ioctl */ 77, /* flock */ - 48, /* send */ - 48, /* recv */ - 48, /* socket */ - 48, /* sockpair */ - 48, /* bind */ - 48, /* connect */ - 48, /* listen */ - 48, /* accept */ - 48, /* shutdown */ - 48, /* gsockopt */ - 48, /* ssockopt */ + 47, /* send */ + 47, /* recv */ + 47, /* socket */ + 47, /* sockpair */ + 47, /* bind */ + 47, /* connect */ + 47, /* listen */ + 47, /* accept */ + 47, /* shutdown */ + 47, /* gsockopt */ + 47, /* ssockopt */ 0, /* getsockname */ 0, /* getpeername */ 0, /* lstat */ 0, /* stat */ - 167, /* ftrread */ - 167, /* ftrwrite */ - 167, /* ftrexec */ - 167, /* fteread */ - 167, /* ftewrite */ - 167, /* fteexec */ - 172, /* ftis */ - 172, /* ftsize */ - 172, /* ftmtime */ - 172, /* ftatime */ - 172, /* ftctime */ - 172, /* ftrowned */ - 172, /* fteowned */ - 172, /* ftzero */ - 172, /* ftsock */ - 172, /* ftchr */ - 172, /* ftblk */ - 172, /* ftfile */ - 172, /* ftdir */ - 172, /* ftpipe */ - 172, /* ftsuid */ - 172, /* ftsgid */ - 172, /* ftsvtx */ - 172, /* ftlink */ - 172, /* fttty */ - 172, /* fttext */ - 172, /* ftbinary */ + 171, /* ftrread */ + 171, /* ftrwrite */ + 171, /* ftrexec */ + 171, /* fteread */ + 171, /* ftewrite */ + 171, /* fteexec */ + 176, /* ftis */ + 176, /* ftsize */ + 176, /* ftmtime */ + 176, /* ftatime */ + 176, /* ftctime */ + 176, /* ftrowned */ + 176, /* fteowned */ + 176, /* ftzero */ + 176, /* ftsock */ + 176, /* ftchr */ + 176, /* ftblk */ + 176, /* ftfile */ + 176, /* ftdir */ + 176, /* ftpipe */ + 176, /* ftsuid */ + 176, /* ftsgid */ + 176, /* ftsvtx */ + 176, /* ftlink */ + 176, /* fttty */ + 176, /* fttext */ + 176, /* ftbinary */ 77, /* chdir */ 77, /* chown */ 71, /* chroot */ @@ -2753,58 +2751,58 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* readlink */ 77, /* mkdir */ 71, /* rmdir */ - 48, /* open_dir */ + 47, /* open_dir */ 0, /* readdir */ 0, /* telldir */ - 48, /* seekdir */ + 47, /* seekdir */ 0, /* rewinddir */ 0, /* closedir */ -1, /* fork */ - 176, /* wait */ + 180, /* wait */ 77, /* waitpid */ 77, /* system */ 77, /* exec */ 77, /* kill */ - 176, /* getppid */ + 180, /* getppid */ 77, /* getpgrp */ 77, /* setpgrp */ 77, /* getpriority */ 77, /* setpriority */ - 176, /* time */ + 180, /* time */ -1, /* tms */ 0, /* localtime */ - 48, /* gmtime */ + 47, /* gmtime */ 0, /* alarm */ 77, /* sleep */ - 48, /* shmget */ - 48, /* shmctl */ - 48, /* shmread */ - 48, /* shmwrite */ - 48, /* msgget */ - 48, /* msgctl */ - 48, /* msgsnd */ - 48, /* msgrcv */ - 48, /* semop */ - 48, /* semget */ - 48, /* semctl */ + 47, /* shmget */ + 47, /* shmctl */ + 47, /* shmread */ + 47, /* shmwrite */ + 47, /* msgget */ + 47, /* msgctl */ + 47, /* msgsnd */ + 47, /* msgrcv */ + 47, /* semop */ + 47, /* semget */ + 47, /* semctl */ 0, /* require */ 0, /* dofile */ -1, /* hintseval */ - 177, /* entereval */ - 144, /* leaveeval */ + 181, /* entereval */ + 148, /* leaveeval */ 0, /* entertry */ -1, /* leavetry */ 0, /* ghbyname */ - 48, /* ghbyaddr */ + 47, /* ghbyaddr */ -1, /* ghostent */ 0, /* gnbyname */ - 48, /* gnbyaddr */ + 47, /* gnbyaddr */ -1, /* gnetent */ 0, /* gpbyname */ - 48, /* gpbynumber */ + 47, /* gpbynumber */ -1, /* gprotoent */ - 48, /* gsbyname */ - 48, /* gsbyport */ + 47, /* gsbyname */ + 47, /* gsbyport */ -1, /* gservent */ 0, /* shostent */ 0, /* snetent */ @@ -2825,22 +2823,22 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { -1, /* sgrent */ -1, /* egrent */ -1, /* getlogin */ - 48, /* syscall */ + 47, /* syscall */ 0, /* lock */ 0, /* once */ -1, /* custom */ - 183, /* coreargs */ - 187, /* avhvswitch */ + 187, /* coreargs */ + 191, /* avhvswitch */ 3, /* runcv */ 0, /* fc */ -1, /* padcv */ -1, /* introcv */ -1, /* clonecv */ - 189, /* padrange */ - 191, /* refassign */ - 197, /* lvref */ - 203, /* lvrefslice */ - 204, /* lvavref */ + 193, /* padrange */ + 195, /* refassign */ + 201, /* lvref */ + 207, /* lvrefslice */ + 208, /* lvavref */ 0, /* anonconst */ }; @@ -2861,69 +2859,69 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { EXTCONST U16 PL_op_private_bitdefs[] = { 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i ... [643 chars truncated] - 0x2b5c, 0x3d59, /* pushmark */ + 0x2cbc, 0x3eb9, /* pushmark */ 0x00bd, /* wantarray, runcv */ - 0x03b8, 0x17f0, 0x3e0c, 0x38c8, 0x2f25, /* const */ - 0x2b5c, 0x3079, /* gvsv */ - 0x1655, /* gv */ + 0x0498, 0x18d0, 0x3f6c, 0x3a28, 0x3085, /* const */ + 0x2cbc, 0x31d9, /* gvsv */ + 0x1735, /* gv */ 0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, ... [14 chars truncated] - 0x2b5c, 0x3d58, 0x03d7, /* padsv */ - 0x2b5c, 0x3d58, 0x2c4c, 0x3a49, /* padav */ - 0x2b5c, 0x3d58, 0x0534, 0x05d0, 0x2c4c, 0x3a49, /* padhv */ - 0x3819, /* pushre, match, qr, subst */ - 0x2b5c, 0x19d8, 0x03d6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */ - 0x2b5c, 0x3078, 0x03d6, 0x3e04, 0x0003, /* rv2sv */ - 0x2c4c, 0x0003, /* av2arylen, pos, akeys, keys */ - 0x2dbc, 0x0e18, 0x0b74, 0x028c, 0x3fc8, 0x3e04, 0x0003, /* rv2cv */ + 0x2cbc, 0x3eb8, 0x03d7, /* padsv */ + 0x2cbc, 0x3eb8, 0x2dac, 0x3ba9, /* padav */ + 0x2cbc, 0x3eb8, 0x0614, 0x06b0, 0x2dac, 0x3ba9, /* padhv */ + 0x2cbc, 0x1ab8, 0x03d6, 0x2dac, 0x2fa8, 0x3f64, 0x0003, /* rv2gv */ + 0x2cbc, 0x31d8, 0x03d6, 0x3f64, 0x0003, /* rv2sv */ + 0x2dac, 0x0003, /* av2arylen, pos, akeys, keys */ + 0x2f1c, 0x0ef8, 0x0c54, 0x028c, 0x4128, 0x3f64, 0x0003, /* rv2cv */ 0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, rea ... [363 chars truncated] - 0x325c, 0x3178, 0x2634, 0x2570, 0x0003, /* backtick */ - 0x3818, 0x0003, /* substcont */ - 0x0f1c, 0x1f58, 0x0754, 0x3b8c, 0x22e8, 0x01e4, 0x0141, /* trans, transr */ - 0x0d5c, 0x0458, 0x0067, /* sassign */ - 0x0a18, 0x0914, 0x0810, 0x2c4c, 0x0067, /* aassign */ - 0x4070, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */ - 0x4070, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */ - 0x12d8, 0x0067, /* repeat */ - 0x4070, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgr ... [46 chars truncated] - 0x3570, 0x2c4c, 0x012b, /* substr */ - 0x2c4c, 0x0067, /* vec */ - 0x2b5c, 0x3078, 0x2c4c, 0x3a48, 0x3e04, 0x0003, /* rv2av */ + 0x33bc, 0x32d8, 0x2714, 0x2650, 0x0003, /* backtick */ + 0x3975, /* match, qr, subst */ + 0x3974, 0x0003, /* substcont */ + 0x0ffc, 0x2038, 0x0834, 0x3cec, 0x23c8, 0x01e4, 0x0141, /* trans, transr */ + 0x0e3c, 0x0538, 0x0067, /* sassign */ + 0x0af8, 0x09f4, 0x08f0, 0x2dac, 0x0067, /* aassign */ + 0x41d0, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */ + 0x41d0, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */ + 0x13b8, 0x0067, /* repeat */ + 0x41d0, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgr ... [46 chars truncated] + 0x36d0, 0x2dac, 0x012b, /* substr */ + 0x2dac, 0x0067, /* vec */ + 0x2cbc, 0x31d8, 0x2dac, 0x3ba8, 0x3f64, 0x0003, /* rv2av */ 0x025f, /* aelemfast, aelemfast_lex */ - 0x2b5c, 0x2a58, 0x03d6, 0x2c4c, 0x0067, /* aelem, helem */ - 0x2b5c, 0x2c4c, 0x3a49, /* aslice, hslice */ - 0x2c4d, /* kvaslice, kvhslice */ - 0x2b5c, 0x3998, 0x0003, /* delete */ - 0x3ef8, 0x0003, /* exists */ - 0x2b5c, 0x3078, 0x0534, 0x05d0, 0x2c4c, 0x3a48, 0x3e04, 0x0003, /* rv2hv */ - 0x2b5c, 0x2a58, 0x0f94, 0x18f0, 0x2c4c, 0x3e04, 0x0003, /* multideref */ - 0x23bc, 0x3079, /* split */ - 0x2b5c, 0x2019, /* list */ - 0x3c78, 0x3314, 0x1230, 0x26cc, 0x3668, 0x27c4, 0x2fe1, /* sort */ - 0x26cc, 0x0003, /* reverse */ - 0x28f8, 0x0003, /* flip, flop */ - 0x2b5c, 0x0003, /* cond_expr */ - 0x2b5c, 0x0e18, 0x03d6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */ - 0x33d8, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ + 0x2cbc, 0x2bb8, 0x03d6, 0x2dac, 0x0067, /* aelem, helem */ + 0x2cbc, 0x2dac, 0x3ba9, /* aslice, hslice */ + 0x2dad, /* kvaslice, kvhslice */ + 0x2cbc, 0x3af8, 0x0003, /* delete */ + 0x4058, 0x0003, /* exists */ + 0x2cbc, 0x31d8, 0x0614, 0x06b0, 0x2dac, 0x3ba8, 0x3f64, 0x0003, /* rv2hv */ + 0x2cbc, 0x2bb8, 0x1074, 0x19d0, 0x2dac, 0x3f64, 0x0003, /* multideref */ + 0x2cbc, 0x31d8, 0x3974, 0x0350, 0x29cc, 0x2489, /* split */ + 0x2cbc, 0x20f9, /* list */ + 0x3dd8, 0x3474, 0x1310, 0x27ac, 0x37c8, 0x28a4, 0x3141, /* sort */ + 0x27ac, 0x0003, /* reverse */ + 0x2a58, 0x0003, /* flip, flop */ + 0x2cbc, 0x0003, /* cond_expr */ + 0x2cbc, 0x0ef8, 0x03d6, 0x028c, 0x4128, 0x3f64, 0x2561, /* entersub */ + 0x3538, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ 0x02aa, 0x0003, /* argelem */ 0x00bc, 0x018f, /* caller */ - 0x21f5, /* nextstate, dbstate */ - 0x29fc, 0x33d9, /* leave */ - 0x2b5c, 0x3078, 0x0e8c, 0x36e5, /* enteriter */ - 0x36e5, /* iter */ - 0x29fc, 0x0067, /* leaveloop */ - 0x41dc, 0x0003, /* last, next, redo, dump, goto */ - 0x325c, 0x3178, 0x2634, 0x2570, 0x018f, /* open */ - 0x1b90, 0x1dec, 0x1ca8, 0x1a64, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */ - 0x1b90, 0x1dec, 0x1ca8, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ... [12 chars truncated] - 0x4071, /* wait, getppid, time */ - 0x3474, 0x0c30, 0x068c, 0x4148, 0x2104, 0x0003, /* entereval */ - 0x2d1c, 0x0018, 0x1144, 0x1061, /* coreargs */ - 0x2c4c, 0x00c7, /* avhvswitch */ - 0x2b5c, 0x01fb, /* padrange */ - 0x2b5c, 0x3d58, 0x04f6, 0x284c, 0x1748, 0x0067, /* refassign */ - 0x2b5c, 0x3d58, 0x04f6, 0x284c, 0x1748, 0x0003, /* lvref */ - 0x2b5d, /* lvrefslice */ - 0x2b5c, 0x3d58, 0x0003, /* lvavref */ + 0x22d5, /* nextstate, dbstate */ + 0x2b5c, 0x3539, /* leave */ + 0x2cbc, 0x31d8, 0x0f6c, 0x3845, /* enteriter */ + 0x3845, /* iter */ + 0x2b5c, 0x0067, /* leaveloop */ + 0x433c, 0x0003, /* last, next, redo, dump, goto */ + 0x33bc, 0x32d8, 0x2714, 0x2650, 0x018f, /* open */ + 0x1c70, 0x1ecc, 0x1d88, 0x1b44, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */ + 0x1c70, 0x1ecc, 0x1d88, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ... [12 chars truncated] + 0x41d1, /* wait, getppid, time */ + 0x35d4, 0x0d10, 0x076c, 0x42a8, 0x21e4, 0x0003, /* entereval */ + 0x2e7c, 0x0018, 0x1224, 0x1141, /* coreargs */ + 0x2dac, 0x00c7, /* avhvswitch */ + 0x2cbc, 0x01fb, /* padrange */ + 0x2cbc, 0x3eb8, 0x04f6, 0x292c, 0x1828, 0x0067, /* refassign */ + 0x2cbc, 0x3eb8, 0x04f6, 0x292c, 0x1828, 0x0003, /* lvref */ + 0x2cbd, /* lvrefslice */ + 0x2cbc, 0x3eb8, 0x0003, /* lvavref */ }; @@ -2945,7 +2943,6 @@ EXTCONST U8 PL_op_private_valid[] = { /* PADAV */ (OPpSLICEWARNING|OPpMAYBE_LVSUB|OPpPAD_STATE|OPpLVAL_INTRO), /* PADHV */ (OPpSLICEWARNING|OPpMAYBE_LVSUB|OPpMAYBE_TRUEBOOL|OPpTRUEBOOL|OPpPAD_STATE|OPpLVAL_INTRO), /* PADANY */ (0), - /* PUSHRE */ (OPpRUNTIME), /* RV2GV */ (OPpARG1_MASK|OPpHINT_STRICT_REFS|OPpDONT_INIT_GV|OPpMAYBE_LVSUB|OPpDEREF|OPpALLOW_FAKE|OPpLVAL_INTRO), /* RV2SV */ (OPpARG1_MASK|OPpHINT_STRICT_REFS|OPpDEREF|OPpOUR_INTRO|OPpLVAL_INTRO), /* AV2ARYLEN */ (OPpARG1_MASK|OPpMAYBE_LVSUB), @@ -3088,7 +3085,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* MULTIDEREF */ (OPpARG1_MASK|OPpHINT_STRICT_REFS|OPpMAYBE_LVSUB|OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE|OPpLVAL_DEFER|OPpLVAL_INTRO), /* UNPACK */ (OPpARG4_MASK), /* PACK */ (OPpARG4_MASK), - /* SPLIT */ (OPpOUR_INTRO|OPpSPLIT_IMPLIM), + /* SPLIT */ (OPpSPLIT_IMPLIM|OPpSPLIT_LEX|OPpSPLIT_ASSIGN|OPpRUNTIME|OPpOUR_INTRO|OPpLVAL_INTRO), /* JOIN */ (OPpARG4_MASK), /* LIST */ (OPpLIST_GUESSED|OPpLVAL_INTRO), /* LSLICE */ (OPpARG2_MASK), diff --git a/opnames.h b/opnames.h index e04d331..62bed50 100644 --- a/opnames.h +++ b/opnames.h @@ -27,394 +27,393 @@ typedef enum opcode { OP_PADAV = 10, OP_PADHV = 11, OP_PADANY = 12, - OP_PUSHRE = 13, - OP_RV2GV = 14, - OP_RV2SV = 15, - OP_AV2ARYLEN = 16, - OP_RV2CV = 17, - OP_ANONCODE = 18, - OP_PROTOTYPE = 19, - OP_REFGEN = 20, - OP_SREFGEN = 21, - OP_REF = 22, - OP_BLESS = 23, - OP_BACKTICK = 24, - OP_GLOB = 25, - OP_READLINE = 26, - OP_RCATLINE = 27, - OP_REGCMAYBE = 28, - OP_REGCRESET = 29, - OP_REGCOMP = 30, - OP_MATCH = 31, - OP_QR = 32, - OP_SUBST = 33, - OP_SUBSTCONT = 34, - OP_TRANS = 35, - OP_TRANSR = 36, - OP_SASSIGN = 37, - OP_AASSIGN = 38, - OP_CHOP = 39, - OP_SCHOP = 40, - OP_CHOMP = 41, - OP_SCHOMP = 42, - OP_DEFINED = 43, - OP_UNDEF = 44, - OP_STUDY = 45, - OP_POS = 46, - OP_PREINC = 47, - OP_I_PREINC = 48, - OP_PREDEC = 49, - OP_I_PREDEC = 50, - OP_POSTINC = 51, - OP_I_POSTINC = 52, - OP_POSTDEC = 53, - OP_I_POSTDEC = 54, - OP_POW = 55, - OP_MULTIPLY = 56, - OP_I_MULTIPLY = 57, - OP_DIVIDE = 58, - OP_I_DIVIDE = 59, - OP_MODULO = 60, - OP_I_MODULO = 61, - OP_REPEAT = 62, - OP_ADD = 63, - OP_I_ADD = 64, - OP_SUBTRACT = 65, - OP_I_SUBTRACT = 66, - OP_CONCAT = 67, - OP_STRINGIFY = 68, - OP_LEFT_SHIFT = 69, - OP_RIGHT_SHIFT = 70, - OP_LT = 71, - OP_I_LT = 72, - OP_GT = 73, - OP_I_GT = 74, - OP_LE = 75, - OP_I_LE = 76, - OP_GE = 77, - OP_I_GE = 78, - OP_EQ = 79, - OP_I_EQ = 80, - OP_NE = 81, - OP_I_NE = 82, - OP_NCMP = 83, - OP_I_NCMP = 84, - OP_SLT = 85, - OP_SGT = 86, - OP_SLE = 87, - OP_SGE = 88, - OP_SEQ = 89, - OP_SNE = 90, - OP_SCMP = 91, - OP_BIT_AND = 92, - OP_BIT_XOR = 93, - OP_BIT_OR = 94, - OP_NBIT_AND = 95, - OP_NBIT_XOR = 96, - OP_NBIT_OR = 97, - OP_SBIT_AND = 98, - OP_SBIT_XOR = 99, - OP_SBIT_OR = 100, - OP_NEGATE = 101, - OP_I_NEGATE = 102, - OP_NOT = 103, - OP_COMPLEMENT = 104, - OP_NCOMPLEMENT = 105, - OP_SCOMPLEMENT = 106, - OP_SMARTMATCH = 107, - OP_ATAN2 = 108, - OP_SIN = 109, - OP_COS = 110, - OP_RAND = 111, - OP_SRAND = 112, - OP_EXP = 113, - OP_LOG = 114, - OP_SQRT = 115, - OP_INT = 116, - OP_HEX = 117, - OP_OCT = 118, - OP_ABS = 119, **** PATCH TRUNCATED AT 2000 LINES -- 1160 NOT SHOWN **** -- Perl5 Master Repository
