In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b46e009d94293e069270690750f6c669c6d0ce22?hp=df968918245d10232f955ab0965da7f8d6297a29>
- Log ----------------------------------------------------------------- commit b46e009d94293e069270690750f6c669c6d0ce22 Author: syber <[email protected]> Date: Thu Sep 4 22:08:59 2014 +0400 Make OP_METHOD* to be of new class METHOP Introduce a new opcode class, METHOP, which will hold class/method related info needed at runtime to improve performance of class/object method calls, then change OP_METHOD and OP_METHOD_NAMED from being UNOP/SVOP to being METHOP. Note that because OP_METHOD is a UNOP with an op_first, while OP_METHOD_NAMED is an SVOP, the first field of the METHOP structure is a union holding either op_first or op_sv. This was seen as less messy than having to introduce two new op classes. The new op class's character is '.' Nothing has changed in functionality and/or performance by this commit. It just introduces new structure which will be extended with extra fields and used in later commits. Added METHOP constructors: - newMETHOP() for method ops with dynamic method names. The only optype for this op is OP_METHOD. - newMETHOP_named() for method ops with constant method names. Optypes for this op are: OP_METHOD_NAMED (currently) and (later) OP_METHOD_SUPER, OP_METHOD_REDIR, OP_METHOD_NEXT, OP_METHOD_NEXTCAN, OP_METHOD_MAYBENEXT (This commit includes fixups by davem) ----------------------------------------------------------------------- Summary of changes: dump.c | 2 +- embed.fnc | 7 + embed.h | 6 + ext/B/B.pm | 21 ++- ext/B/B.xs | 37 +++- ext/B/B/Concise.pm | 22 ++- ext/B/t/optree_specials.t | 36 ++-- lib/B/Deparse.pm | 15 +- lib/B/Op_private.pm | 1 + op.c | 162 ++++++++++++---- op.h | 15 ++ opcode.h | 307 +++++++++++++++---------------- perl.c | 23 +-- perl.h | 1 + perly.act | 457 +++++++++++++++++++++++----------------------- perly.h | 64 ++++--- perly.tab | 29 +-- perly.y | 8 +- pp_hot.c | 6 +- proto.h | 23 +++ regen/op_private | 1 + regen/opcode.pl | 1 + regen/opcodes | 6 +- 23 files changed, 742 insertions(+), 508 deletions(-) diff --git a/dump.c b/dump.c index bfc176d..addc38d 100644 --- a/dump.c +++ b/dump.c @@ -962,7 +962,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) #ifndef USE_ITHREADS /* with ITHREADS, consts are stored in the pad, and the right pad * may not be active here, so skip */ - Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv)); + Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cMETHOPx_meth(o))); #endif break; case OP_NEXTSTATE: diff --git a/embed.fnc b/embed.fnc index 7f759eb..320a476 100644 --- a/embed.fnc +++ b/embed.fnc @@ -471,6 +471,11 @@ p |char* |find_script |NN const char *scriptname|bool dosearch \ s |OP* |force_list |NULLOK OP* arg|bool nullit i |OP* |op_integerize |NN OP *o i |OP* |op_std_init |NN OP *o +#if defined(USE_ITHREADS) +i |void |op_relocate_sv |NN SV** svp|NN PADOFFSET* targp +#endif +i |OP* |newMETHOP_internal |I32 type|I32 flags|NULLOK OP* dynamic_meth \ + |NULLOK SV* const_meth : FIXME s |OP* |fold_constants |NN OP *o #endif @@ -1029,6 +1034,8 @@ Apda |OP* |newWHENOP |NULLOK OP* cond|NN OP* block Apda |OP* |newWHILEOP |I32 flags|I32 debuggable|NULLOK LOOP* loop \ |NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \ |I32 has_my +Apda |OP* |newMETHOP |I32 type|I32 flags|NN OP* dynamic_meth +Apda |OP* |newMETHOP_named|I32 type|I32 flags|NN SV* const_meth Apd |CV* |rv2cv_op_cv |NN OP *cvop|U32 flags Apd |OP* |ck_entersub_args_list|NN OP *entersubop Apd |OP* |ck_entersub_args_proto|NN OP *entersubop|NN GV *namegv|NN SV *protosv diff --git a/embed.h b/embed.h index ebb1e9f..4b7cbb1 100644 --- a/embed.h +++ b/embed.h @@ -371,6 +371,8 @@ #define newLOGOP(a,b,c,d) Perl_newLOGOP(aTHX_ a,b,c,d) #define newLOOPEX(a,b) Perl_newLOOPEX(aTHX_ a,b) #define newLOOPOP(a,b,c,d) Perl_newLOOPOP(aTHX_ a,b,c,d) +#define newMETHOP(a,b,c) Perl_newMETHOP(aTHX_ a,b,c) +#define newMETHOP_named(a,b,c) Perl_newMETHOP_named(aTHX_ a,b,c) #define newMYSUB(a,b,c,d,e) Perl_newMYSUB(aTHX_ a,b,c,d,e) #define newNULLLIST() Perl_newNULLLIST(aTHX) #define newOP(a,b) Perl_newOP(aTHX_ a,b) @@ -1525,6 +1527,7 @@ #define my_kid(a,b,c) S_my_kid(aTHX_ a,b,c) #define newDEFSVOP() S_newDEFSVOP(aTHX) #define newGIVWHENOP(a,b,c,d,e) S_newGIVWHENOP(aTHX_ a,b,c,d,e) +#define newMETHOP_internal(a,b,c,d) S_newMETHOP_internal(aTHX_ a,b,c,d) #define new_logop(a,b,c,d) S_new_logop(aTHX_ a,b,c,d) #define no_bareword_allowed(a) S_no_bareword_allowed(aTHX_ a) #define no_fh_allowed(a) S_no_fh_allowed(aTHX_ a) @@ -1543,6 +1546,9 @@ #define simplify_sort(a) S_simplify_sort(aTHX_ a) #define too_few_arguments_pv(a,b,c) S_too_few_arguments_pv(aTHX_ a,b,c) #define too_many_arguments_pv(a,b,c) S_too_many_arguments_pv(aTHX_ a,b,c) +# if defined(USE_ITHREADS) +#define op_relocate_sv(a,b) S_op_relocate_sv(aTHX_ a,b) +# endif # endif # if defined(PERL_IN_OP_C) || defined(PERL_IN_SV_C) #define report_redefined_cv(a,b,c) Perl_report_redefined_cv(aTHX_ a,b,c) diff --git a/ext/B/B.pm b/ext/B/B.pm index f0dd77a..8388541 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -69,10 +69,11 @@ push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs @B::LOOP::ISA = 'B::LISTOP'; @B::PMOP::ISA = 'B::LISTOP'; @B::COP::ISA = 'B::OP'; +@B::METHOP::ISA = 'B::OP'; @B::SPECIAL::ISA = 'B::OBJECT'; -@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); +@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP METHOP); # bytecode.pl contained the following comment: # Nullsv *must* come first in the following so that the condition # ($$sv == 0) can continue to be used to test (sv == Nullsv). @@ -1065,7 +1066,7 @@ information is no longer stored directly in the hash. =head2 OP-RELATED CLASSES C<B::OP>, C<B::UNOP>, C<B::BINOP>, C<B::LOGOP>, C<B::LISTOP>, C<B::PMOP>, -C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>, C<B::COP>. +C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>, C<B::COP>, C<B::METHOP>. These classes correspond in the obvious way to the underlying C structures of similar names. The inheritance hierarchy mimics the @@ -1073,9 +1074,9 @@ underlying C "inheritance": B::OP | - +---------------+--------+--------+-------+ - | | | | | - B::UNOP B::SVOP B::PADOP B::COP B::PVOP + +----------+---------+--------+-------+---------+ + | | | | | | + B::UNOP B::SVOP B::PADOP B::COP B::PVOP B::METHOP ,' `-. / `--. B::BINOP B::LOGOP @@ -1263,6 +1264,16 @@ Since perl 5.17.1 =back +=head2 B::METHOP Methods (Since Perl 5.22) + +=over 4 + +=item first + +=item meth_sv + +=back + =head2 OTHER CLASSES Perl 5.18 introduces a new class, B::PADLIST, returned by B::CV's diff --git a/ext/B/B.xs b/ext/B/B.xs index bc423cc..716e444 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -60,7 +60,8 @@ typedef enum { OPc_PADOP, /* 8 */ OPc_PVOP, /* 9 */ OPc_LOOP, /* 10 */ - OPc_COP /* 11 */ + OPc_COP, /* 11 */ + OPc_METHOP /* 12 */ } opclass; static const char* const opclassnames[] = { @@ -75,7 +76,8 @@ static const char* const opclassnames[] = { "B::PADOP", "B::PVOP", "B::LOOP", - "B::COP" + "B::COP", + "B::METHOP" }; static const size_t opsizes[] = { @@ -90,7 +92,8 @@ static const size_t opsizes[] = { sizeof(PADOP), sizeof(PVOP), sizeof(LOOP), - sizeof(COP) + sizeof(COP), + sizeof(METHOP) }; #define MY_CXT_KEY "B::_guts" XS_VERSION @@ -232,6 +235,8 @@ cc_opclass(pTHX_ const OP *o) return OPc_BASEOP; else return OPc_PVOP; + case OA_METHOP: + return OPc_METHOP; } warn("can't determine class of operator %s, assuming BASEOP\n", OP_NAME(o)); @@ -586,6 +591,7 @@ typedef PADOP *B__PADOP; typedef PVOP *B__PVOP; typedef LOOP *B__LOOP; typedef COP *B__COP; +typedef METHOP *B__METHOP; typedef SV *B__SV; typedef SV *B__IV; @@ -735,6 +741,10 @@ struct OP_methods { { STR_WITH_LEN("parent"), op_offset_special, 0, },/*52*/ # endif #endif +#if PERL_VERSION >= 21 + { STR_WITH_LEN("first"), op_offset_special, 0, },/*53*/ + { STR_WITH_LEN("meth_sv"), op_offset_special, 0, },/*54*/ +#endif }; #include "const-c.inc" @@ -1012,6 +1022,8 @@ next(o) B::OP::folded = 50 B::OP::lastsib = 51 B::OP::parent = 52 + B::METHOP::first = 53 + B::METHOP::meth_sv = 54 PREINIT: SV *ret; PPCODE: @@ -1208,6 +1220,25 @@ next(o) case 52: /* B::OP::parent */ ret = make_op_object(aTHX_ op_parent(o)); break; + case 53: /* B::METHOP::first */ + /* METHOP struct has an op_first/op_meth_sv union + * as its first extra field. How to interpret the + * union depends on the op type. For the purposes of + * B, we treat it as a struct with both fields present, + * where one of the fields always happens to be null + * (i.e. we return NULL in preference to croaking with + * 'method not implemented'). + */ + ret = make_op_object(aTHX_ + o->op_type == OP_METHOD + ? cMETHOPx(o)->op_u.op_first : NULL); + break; + case 54: /* B::METHOP::meth_sv */ + /* see comment above about METHOP */ + ret = make_sv_object(aTHX_ + o->op_type == OP_METHOD + ? NULL : cMETHOPx(o)->op_u.op_meth_sv); + break; default: croak("method %s not implemented", op_methods[ix].name); } else { diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index b531ce8..51ef7a7 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.993"; +our $VERSION = "0.994"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -400,7 +400,8 @@ my $lastnext; # remembers op-chain, used to insert gotos my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|", 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*", - 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#"); + 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#", + 'METHOP' => '.'); no warnings 'qw'; # "Possible attempt to put comments..."; use #7 my @linenoise = @@ -891,16 +892,26 @@ sub concise_op { elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") { unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) { my $idx = ($h{class} eq "SVOP") ? $op->targ : $op->padix; - my $preferpv = $h{name} eq "method_named"; if ($h{class} eq "PADOP" or !${$op->sv}) { my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$idx]; - $h{arg} = "[" . concise_sv($sv, \%h, $preferpv) . "]"; + $h{arg} = "[" . concise_sv($sv, \%h, 0) . "]"; $h{targarglife} = $h{targarg} = ""; } else { - $h{arg} = "(" . concise_sv($op->sv, \%h, $preferpv) . ")"; + $h{arg} = "(" . concise_sv($op->sv, \%h, 0) . ")"; } } } + elsif ($h{class} eq "METHOP") { + if ($h{name} eq "method_named") { + if (${$op->meth_sv}) { + $h{arg} = "(" . concise_sv($op->meth_sv, \%h, 1) . ")"; + } else { + my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ]; + $h{arg} = "[" . concise_sv($sv, \%h, 1) . "]"; + $h{targarglife} = $h{targarg} = ""; + } + } + } $h{seq} = $h{hyphseq} = seq($op); $h{seq} = "" if $h{seq} eq "-"; $h{opt} = $op->opt; @@ -1379,6 +1390,7 @@ B:: namespace that represents the ops in your Perl code. { LOOP An OP that holds pointers for a loop ; COP An OP that marks the start of a statement # PADOP An OP with a GV on the pad + . METHOP An OP with method call info =head2 OP flags abbreviations diff --git a/ext/B/t/optree_specials.t b/ext/B/t/optree_specials.t index 414fa79..f22b77f 100644 --- a/ext/B/t/optree_specials.t +++ b/ext/B/t/optree_specials.t @@ -52,7 +52,7 @@ checkOptree ( name => 'BEGIN', # 5 <0> pushmark s ->6 # 6 <$> const[PV "strict"] sM ->7 # 7 <$> const[PV "refs"] sM ->8 -# 8 <$> method_named[PV "unimport"] ->9 +# 8 <.> method_named[PV "unimport"] ->9 # BEGIN 2: # k <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq K ->k @@ -66,7 +66,7 @@ checkOptree ( name => 'BEGIN', # f <0> pushmark s ->g # g <$> const[PV "strict"] sM ->h # h <$> const[PV "refs"] sM ->i -# i <$> method_named[PV "unimport"] ->j +# i <.> method_named[PV "unimport"] ->j # BEGIN 3: # u <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->u @@ -80,7 +80,7 @@ checkOptree ( name => 'BEGIN', # p <0> pushmark s ->q # q <$> const[PV "warnings"] sM ->r # r <$> const[PV "qw"] sM ->s -# s <$> method_named[PV "unimport"] ->t +# s <.> method_named[PV "unimport"] ->t # BEGIN 4: # y <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->y @@ -102,7 +102,7 @@ EOT_EOT # 5 <0> pushmark s ->6 # 6 <$> const(PV "strict") sM ->7 # 7 <$> const(PV "refs") sM ->8 -# 8 <$> method_named(PV "unimport") ->9 +# 8 <.> method_named(PV "unimport") ->9 # BEGIN 2: # k <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq K ->k @@ -116,7 +116,7 @@ EOT_EOT # f <0> pushmark s ->g # g <$> const(PV "strict") sM ->h # h <$> const(PV "refs") sM ->i -# i <$> method_named(PV "unimport") ->j +# i <.> method_named(PV "unimport") ->j # BEGIN 3: # u <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->u @@ -130,7 +130,7 @@ EOT_EOT # p <0> pushmark s ->q # q <$> const(PV "warnings") sM ->r # r <$> const(PV "qw") sM ->s -# s <$> method_named(PV "unimport") ->t +# s <.> method_named(PV "unimport") ->t # BEGIN 4: # y <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->y @@ -245,7 +245,7 @@ checkOptree ( name => 'all of BEGIN END INIT CHECK UNITCHECK -exec', # 5 <0> pushmark s # 6 <$> const[PV "strict"] sM # 7 <$> const[PV "refs"] sM -# 8 <$> method_named[PV "unimport"] +# 8 <.> method_named[PV "unimport"] # 9 <1> entersub[t1] KS*/TARG,STRICT # a <1> leavesub[1 ref] K/REFC,1 # BEGIN 2: @@ -256,7 +256,7 @@ checkOptree ( name => 'all of BEGIN END INIT CHECK UNITCHECK -exec', # f <0> pushmark s # g <$> const[PV "strict"] sM # h <$> const[PV "refs"] sM -# i <$> method_named[PV "unimport"] +# i <.> method_named[PV "unimport"] # j <1> entersub[t1] KS*/TARG,STRICT # k <1> leavesub[1 ref] K/REFC,1 # BEGIN 3: @@ -267,7 +267,7 @@ checkOptree ( name => 'all of BEGIN END INIT CHECK UNITCHECK -exec', # p <0> pushmark s # q <$> const[PV "warnings"] sM # r <$> const[PV "qw"] sM -# s <$> method_named[PV "unimport"] +# s <.> method_named[PV "unimport"] # t <1> entersub[t1] KS*/TARG,STRICT # u <1> leavesub[1 ref] K/REFC,1 # BEGIN 4: @@ -304,7 +304,7 @@ EOT_EOT # 5 <0> pushmark s # 6 <$> const(PV "strict") sM # 7 <$> const(PV "refs") sM -# 8 <$> method_named(PV "unimport") +# 8 <.> method_named(PV "unimport") # 9 <1> entersub[t1] KS*/TARG,STRICT # a <1> leavesub[1 ref] K/REFC,1 # BEGIN 2: @@ -315,7 +315,7 @@ EOT_EOT # f <0> pushmark s # g <$> const(PV "strict") sM # h <$> const(PV "refs") sM -# i <$> method_named(PV "unimport") +# i <.> method_named(PV "unimport") # j <1> entersub[t1] KS*/TARG,STRICT # k <1> leavesub[1 ref] K/REFC,1 # BEGIN 3: @@ -326,7 +326,7 @@ EOT_EOT # p <0> pushmark s # q <$> const(PV "warnings") sM # r <$> const(PV "qw") sM -# s <$> method_named(PV "unimport") +# s <.> method_named(PV "unimport") # t <1> entersub[t1] KS*/TARG,STRICT # u <1> leavesub[1 ref] K/REFC,1 # BEGIN 4: @@ -373,7 +373,7 @@ checkOptree ( name => 'regression test for patch 25352', # 5 <0> pushmark s # 6 <$> const[PV "strict"] sM # 7 <$> const[PV "refs"] sM -# 8 <$> method_named[PV "unimport"] +# 8 <.> method_named[PV "unimport"] # 9 <1> entersub[t1] KS*/TARG,STRICT # a <1> leavesub[1 ref] K/REFC,1 # BEGIN 2: @@ -384,7 +384,7 @@ checkOptree ( name => 'regression test for patch 25352', # f <0> pushmark s # g <$> const[PV "strict"] sM # h <$> const[PV "refs"] sM -# i <$> method_named[PV "unimport"] +# i <.> method_named[PV "unimport"] # j <1> entersub[t1] KS*/TARG,STRICT # k <1> leavesub[1 ref] K/REFC,1 # BEGIN 3: @@ -395,7 +395,7 @@ checkOptree ( name => 'regression test for patch 25352', # p <0> pushmark s # q <$> const[PV "warnings"] sM # r <$> const[PV "qw"] sM -# s <$> method_named[PV "unimport"] +# s <.> method_named[PV "unimport"] # t <1> entersub[t1] KS*/TARG,STRICT # u <1> leavesub[1 ref] K/REFC,1 EOT_EOT @@ -407,7 +407,7 @@ EOT_EOT # 5 <0> pushmark s # 6 <$> const(PV "strict") sM # 7 <$> const(PV "refs") sM -# 8 <$> method_named(PV "unimport") +# 8 <.> method_named(PV "unimport") # 9 <1> entersub[t1] KS*/TARG,STRICT # a <1> leavesub[1 ref] K/REFC,1 # BEGIN 2: @@ -418,7 +418,7 @@ EOT_EOT # f <0> pushmark s # g <$> const(PV "strict") sM # h <$> const(PV "refs") sM -# i <$> method_named(PV "unimport") +# i <.> method_named(PV "unimport") # j <1> entersub[t1] KS*/TARG,STRICT # k <1> leavesub[1 ref] K/REFC,1 # BEGIN 3: @@ -429,7 +429,7 @@ EOT_EOT # p <0> pushmark s # q <$> const(PV "warnings") sM # r <$> const(PV "qw") sM -# s <$> method_named(PV "unimport") +# s <.> method_named(PV "unimport") # t <1> entersub[t1] KS*/TARG,STRICT # u <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 1d08755..31f1be8 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -542,7 +542,7 @@ sub begin_is_use { } $constop = $constop->sibling; return if $constop->name ne "method_named"; - return if $self->const_sv($constop)->PV ne "VERSION"; + return if $self->meth_sv($constop)->PV ne "VERSION"; } $lineseq = $version_op->sibling; @@ -570,7 +570,7 @@ sub begin_is_use { my $use = 'use'; my $method_named = $svop; return if $method_named->name ne "method_named"; - my $method_name = $self->const_sv($method_named)->PV; + my $method_name = $self->meth_sv($method_named)->PV; if ($method_name eq "unimport") { $use = 'no'; @@ -3706,7 +3706,7 @@ sub _method { } if ($meth->name eq "method_named") { - $meth = $self->const_sv($meth)->PV; + $meth = $self->meth_sv($meth)->PV; } else { $meth = $meth->first; if ($meth->name eq "const") { @@ -4314,6 +4314,15 @@ sub const_sv { return $sv; } +sub meth_sv { + my $self = shift; + my $op = shift; + my $sv = $op->meth_sv; + # the constant could be in the pad (under useithreads) + $sv = $self->padval($op->targ) unless $$sv; + return $sv; +} + sub pp_const { my $self = shift; my($op, $cx) = @_; diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 453a3ea..6b430ec 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -383,6 +383,7 @@ $bits{lstat}{0} = $bf[0]; @{$bits{lt}}{1,0} = ($bf[1], $bf[1]); $bits{mapwhile}{0} = $bf[0]; $bits{method}{0} = $bf[0]; +$bits{method_named}{0} = $bf[0]; @{$bits{mkdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); @{$bits{modulo}}{1,0} = ($bf[1], $bf[1]); @{$bits{msgctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); diff --git a/op.c b/op.c index 08e6028..930df2d 100644 --- a/op.c +++ b/op.c @@ -823,6 +823,15 @@ Perl_op_clear(pTHX_ OP *o) } break; case OP_METHOD_NAMED: + SvREFCNT_dec(cMETHOPx(o)->op_u.op_meth_sv); + cMETHOPx(o)->op_u.op_meth_sv = NULL; +#ifdef USE_ITHREADS + if (o->op_targ) { + pad_swipe(o->op_targ, 1); + o->op_targ = 0; + } +#endif + break; case OP_CONST: case OP_HINTSEVAL: SvREFCNT_dec(cSVOPo->op_sv); @@ -2036,6 +2045,27 @@ Perl_finalize_optree(pTHX_ OP* o) LEAVE; } +#ifdef USE_ITHREADS +/* Relocate sv to the pad for thread safety. + * Despite being a "constant", the SV is written to, + * for reference counts, sv_upgrade() etc. */ +PERL_STATIC_INLINE void +S_op_relocate_sv(pTHX_ SV** svp, PADOFFSET* targp) +{ + PADOFFSET ix; + PERL_ARGS_ASSERT_OP_RELOCATE_SV; + if (!*svp) return; + ix = pad_alloc(OP_CONST, SVf_READONLY); + SvREFCNT_dec(PAD_SVl(ix)); + PAD_SETSV(ix, *svp); + /* XXX I don't know how this isn't readonly already. */ + if (!SvIsCOW(PAD_SVl(ix))) SvREADONLY_on(PAD_SVl(ix)); + *svp = NULL; + *targp = ix; +} +#endif + + STATIC void S_finalize_op(pTHX_ OP* o) { @@ -2088,21 +2118,16 @@ S_finalize_op(pTHX_ OP* o) /* FALLTHROUGH */ #ifdef USE_ITHREADS case OP_HINTSEVAL: + op_relocate_sv(&cSVOPo->op_sv, &o->op_targ); +#endif + break; + +#ifdef USE_ITHREADS + /* Relocate all the METHOP's SVs to the pad for thread safety. */ case OP_METHOD_NAMED: - /* Relocate sv to the pad for thread safety. - * Despite being a "constant", the SV is written to, - * for reference counts, sv_upgrade() etc. */ - if (cSVOPo->op_sv) { - const PADOFFSET ix = pad_alloc(OP_CONST, SVf_READONLY); - SvREFCNT_dec(PAD_SVl(ix)); - PAD_SETSV(ix, cSVOPo->op_sv); - /* XXX I don't know how this isn't readonly already. */ - if (!SvIsCOW(PAD_SVl(ix))) SvREADONLY_on(PAD_SVl(ix)); - cSVOPo->op_sv = NULL; - o->op_targ = ix; - } + op_relocate_sv(&cMETHOPx(o)->op_u.op_meth_sv, &o->op_targ); + break; #endif - break; case OP_HELEM: { UNOP *rop; @@ -2238,6 +2263,7 @@ S_finalize_op(pTHX_ OP* o) || family == OA_BASEOP_OR_UNOP || family == OA_FILESTATOP || family == OA_LOOPEXOP + || family == OA_METHOP /* I don't know why SASSIGN is tagged as OA_BASEOP - DAPM */ || type == OP_SASSIGN || type == OP_CUSTOM @@ -2920,7 +2946,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL|OPf_WANT_VOID, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, pack, list(arg)), - newSVOP(OP_METHOD_NAMED, 0, meth))); + newMETHOP_named(OP_METHOD_NAMED, 0, meth))); /* Combine the ops. */ *imopsp = op_append_elem(OP_LIST, *imopsp, imop); @@ -4275,6 +4301,77 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first) } /* +=for apidoc Am|OP *|newMETHOP|I32 type|I32 flags|OP *first + +Constructs, checks, and returns an op of method type with a method name +evaluated at runtime. I<type> is the opcode. I<flags> gives the eight +bits of C<op_flags>, except that C<OPf_KIDS> will be set automatically, +and, shifted up eight bits, the eight bits of C<op_private>, except that +the bit with value 1 is automatically set. I<dynamic_meth> supplies an +op which evaluates method name; it is consumed by this function and +become part of the constructed op tree. +Supported optypes: OP_METHOD. + +=cut +*/ + +static OP* +S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth) { + dVAR; + METHOP *methop; + + assert((PL_opargs[type] & OA_CLASS_MASK) == OA_METHOP); + + NewOp(1101, methop, 1, METHOP); + if (dynamic_meth) { + if (PL_opargs[type] & OA_MARK) dynamic_meth = force_list(dynamic_meth, 1); + methop->op_flags = (U8)(flags | OPf_KIDS); + methop->op_u.op_first = dynamic_meth; + methop->op_private = (U8)(1 | (flags >> 8)); + } + else { + assert(const_meth); + methop->op_flags = (U8)(flags & ~OPf_KIDS); + methop->op_u.op_meth_sv = const_meth; + methop->op_private = (U8)(0 | (flags >> 8)); + methop->op_next = (OP*)methop; + } + + methop->op_type = (OPCODE)type; + methop->op_ppaddr = PL_ppaddr[type]; + methop = (METHOP*) CHECKOP(type, methop); + + if (methop->op_next) return (OP*)methop; + + return fold_constants(op_integerize(op_std_init((OP *) methop))); +} + +OP * +Perl_newMETHOP (pTHX_ I32 type, I32 flags, OP* dynamic_meth) { + PERL_ARGS_ASSERT_NEWMETHOP; + return newMETHOP_internal(type, flags, dynamic_meth, NULL); +} + +/* +=for apidoc Am|OP *|newMETHOP_named|I32 type|I32 flags|SV *const_meth + +Constructs, checks, and returns an op of method type with a constant +method name. I<type> is the opcode. I<flags> gives the eight bits of +C<op_flags>, and, shifted up eight bits, the eight bits of +C<op_private>. I<const_meth> supplies a constant method name; +it must be a shared COW string. +Supported optypes: OP_METHOD_NAMED. + +=cut +*/ + +OP * +Perl_newMETHOP_named (pTHX_ I32 type, I32 flags, SV* const_meth) { + PERL_ARGS_ASSERT_NEWMETHOP_NAMED; + return newMETHOP_internal(type, flags, NULL, const_meth); +} + +/* =for apidoc Am|OP *|newBINOP|I32 type|I32 flags|OP *first|OP *last Constructs, checks, and returns an op of any binary type. I<type> @@ -5328,7 +5425,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, pack, list(version)), - newSVOP(OP_METHOD_NAMED, 0, meth))); + newMETHOP_named(OP_METHOD_NAMED, 0, meth))); } } @@ -5355,7 +5452,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, pack, list(arg)), - newSVOP(OP_METHOD_NAMED, 0, meth))); + newMETHOP_named(OP_METHOD_NAMED, 0, meth))); } /* Fake up the BEGIN {}, which does its thing immediately. */ @@ -9703,25 +9800,26 @@ Perl_ck_match(pTHX_ OP *o) OP * Perl_ck_method(pTHX_ OP *o) { + SV* sv; + const char* method; OP * const kid = cUNOPo->op_first; PERL_ARGS_ASSERT_CK_METHOD; - - if (kid->op_type == OP_CONST) { - SV* sv = kSVOP->op_sv; - const char * const method = SvPVX_const(sv); - if (!(strchr(method, ':') || strchr(method, '\''))) { - OP *cmop; - if (!SvIsCOW_shared_hash(sv)) { - sv = newSVpvn_share(method, SvUTF8(sv) ? -(I32)SvCUR(sv) : (I32)SvCUR(sv), 0); - } - else { - kSVOP->op_sv = NULL; - } - cmop = newSVOP(OP_METHOD_NAMED, 0, sv); - op_free(o); - return cmop; - } + if (kid->op_type != OP_CONST) return o; + + sv = kSVOP->op_sv; + method = SvPVX_const(sv); + if (!(strchr(method, ':') || strchr(method, '\''))) { + OP *cmop; + if (!SvIsCOW_shared_hash(sv)) { + sv = newSVpvn_share(method, SvUTF8(sv) ? -(I32)SvCUR(sv) : (I32)SvCUR(sv), 0); + } + else { + kSVOP->op_sv = NULL; + } + cmop = newMETHOP_named(OP_METHOD_NAMED, 0, sv); + op_free(o); + return cmop; } return o; } diff --git a/op.h b/op.h index 9d177d0..bec9df4 100644 --- a/op.h +++ b/op.h @@ -195,6 +195,17 @@ struct listop { OP * op_last; }; +struct methop { + BASEOP + union { + /* op_u.op_first *must* be aligned the same as the op_first + * field of the other op types, and op_u.op_meth_sv *must* + * be aligned with op_sv */ + OP* op_first; /* optree for method name */ + SV* op_meth_sv; /* static method name */ + } op_u; +}; + struct pmop { BASEOP OP * op_first; @@ -385,6 +396,7 @@ struct loop { #define cPVOPx(o) ((PVOP*)o) #define cCOPx(o) ((COP*)o) #define cLOOPx(o) ((LOOP*)o) +#define cMETHOPx(o) ((METHOP*)o) #define cUNOP cUNOPx(PL_op) #define cBINOP cBINOPx(PL_op) @@ -441,6 +453,8 @@ struct loop { # define cSVOPx_svp(v) (&cSVOPx(v)->op_sv) #endif +# define cMETHOPx_meth(v) cSVOPx_sv(v) + #define cGVOP_gv cGVOPx_gv(PL_op) #define cGVOPo_gv cGVOPx_gv(o) #define kGVOP_gv cGVOPx_gv(kid) @@ -481,6 +495,7 @@ struct loop { #define OA_BASEOP_OR_UNOP (11 << OCSHIFT) #define OA_FILESTATOP (12 << OCSHIFT) #define OA_LOOPEXOP (13 << OCSHIFT) +#define OA_METHOP (14 << OCSHIFT) /* Each remaining nybble of PL_opargs (i.e. bits 12..15, 16..19 etc) * encode the type for each arg */ diff --git a/opcode.h b/opcode.h index dae93ab..1883412 100644 --- a/opcode.h +++ b/opcode.h @@ -1899,7 +1899,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000304, /* andassign */ 0x00000304, /* orassign */ 0x00000304, /* dorassign */ - 0x00000140, /* method */ + 0x00000e40, /* method */ 0x00002149, /* entersub */ 0x00000100, /* leavesub */ 0x00000100, /* leavesublv */ @@ -1925,7 +1925,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000d44, /* dump */ 0x00000d44, /* goto */ 0x00009b44, /* exit */ - 0x00000640, /* method_named */ + 0x00000e40, /* method_named */ 0x00000340, /* entergiven */ 0x00000100, /* leavegiven */ 0x00000340, /* enterwhen */ @@ -2532,184 +2532,184 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 352, /* dump */ 354, /* goto */ 356, /* exit */ - -1, /* method_named */ - 357, /* entergiven */ - 358, /* leavegiven */ - 359, /* enterwhen */ - 360, /* leavewhen */ + 357, /* method_named */ + 358, /* entergiven */ + 359, /* leavegiven */ + 360, /* enterwhen */ + 361, /* leavewhen */ -1, /* break */ -1, /* continue */ - 361, /* open */ - 366, /* close */ - 367, /* pipe_op */ - 368, /* fileno */ - 369, /* umask */ - 370, /* binmode */ - 371, /* tie */ - 372, /* untie */ - 373, /* tied */ - 374, /* dbmopen */ - 375, /* dbmclose */ - 376, /* sselect */ - 377, /* select */ - 378, /* getc */ - 379, /* read */ - 380, /* enterwrite */ - 381, /* leavewrite */ + 362, /* open */ + 367, /* close */ + 368, /* pipe_op */ + 369, /* fileno */ + 370, /* umask */ + 371, /* binmode */ + 372, /* tie */ + 373, /* untie */ + 374, /* tied */ + 375, /* dbmopen */ + 376, /* dbmclose */ + 377, /* sselect */ + 378, /* select */ + 379, /* getc */ + 380, /* read */ + 381, /* enterwrite */ + 382, /* leavewrite */ -1, /* prtf */ -1, /* print */ -1, /* say */ - 383, /* sysopen */ - 384, /* sysseek */ - 385, /* sysread */ - 386, /* syswrite */ - 387, /* eof */ - 388, /* tell */ - 389, /* seek */ - 390, /* truncate */ - 391, /* fcntl */ - 392, /* ioctl */ - 393, /* flock */ - 395, /* send */ - 396, /* recv */ - 397, /* socket */ - 398, /* sockpair */ - 399, /* bind */ - 400, /* connect */ - 401, /* listen */ - 402, /* accept */ - 403, /* shutdown */ - 404, /* gsockopt */ - 405, /* ssockopt */ - 406, /* getsockname */ - 407, /* getpeername */ - 408, /* lstat */ - 409, /* stat */ - 410, /* ftrread */ - 415, /* ftrwrite */ - 420, /* ftrexec */ - 425, /* fteread */ - 430, /* ftewrite */ - 435, /* fteexec */ - 440, /* ftis */ - 444, /* ftsize */ - 448, /* ftmtime */ - 452, /* ftatime */ - 456, /* ftctime */ - 460, /* ftrowned */ - 464, /* fteowned */ - 468, /* ftzero */ - 472, /* ftsock */ - 476, /* ftchr */ - 480, /* ftblk */ - 484, /* ftfile */ - 488, /* ftdir */ - 492, /* ftpipe */ - 496, /* ftsuid */ - 500, /* ftsgid */ - 504, /* ftsvtx */ - 508, /* ftlink */ - 512, /* fttty */ - 516, /* fttext */ - 520, /* ftbinary */ - 524, /* chdir */ - 526, /* chown */ - 528, /* chroot */ - 530, /* unlink */ - 532, /* chmod */ - 534, /* utime */ - 536, /* rename */ - 538, /* link */ - 540, /* symlink */ - 542, /* readlink */ - 543, /* mkdir */ - 545, /* rmdir */ - 547, /* open_dir */ - 548, /* readdir */ - 549, /* telldir */ - 550, /* seekdir */ - 551, /* rewinddir */ - 552, /* closedir */ + 384, /* sysopen */ + 385, /* sysseek */ + 386, /* sysread */ + 387, /* syswrite */ + 388, /* eof */ + 389, /* tell */ + 390, /* seek */ + 391, /* truncate */ + 392, /* fcntl */ + 393, /* ioctl */ + 394, /* flock */ + 396, /* send */ + 397, /* recv */ + 398, /* socket */ + 399, /* sockpair */ + 400, /* bind */ + 401, /* connect */ + 402, /* listen */ + 403, /* accept */ + 404, /* shutdown */ + 405, /* gsockopt */ + 406, /* ssockopt */ + 407, /* getsockname */ + 408, /* getpeername */ + 409, /* lstat */ + 410, /* stat */ + 411, /* ftrread */ + 416, /* ftrwrite */ + 421, /* ftrexec */ + 426, /* fteread */ + 431, /* ftewrite */ + 436, /* fteexec */ + 441, /* ftis */ + 445, /* ftsize */ + 449, /* ftmtime */ + 453, /* ftatime */ + 457, /* ftctime */ + 461, /* ftrowned */ + 465, /* fteowned */ + 469, /* ftzero */ + 473, /* ftsock */ + 477, /* ftchr */ + 481, /* ftblk */ + 485, /* ftfile */ + 489, /* ftdir */ + 493, /* ftpipe */ + 497, /* ftsuid */ + 501, /* ftsgid */ + 505, /* ftsvtx */ + 509, /* ftlink */ + 513, /* fttty */ + 517, /* fttext */ + 521, /* ftbinary */ + 525, /* chdir */ + 527, /* chown */ + 529, /* chroot */ + 531, /* unlink */ + 533, /* chmod */ + 535, /* utime */ + 537, /* rename */ + 539, /* link */ + 541, /* symlink */ + 543, /* readlink */ + 544, /* mkdir */ + 546, /* rmdir */ + 548, /* open_dir */ + 549, /* readdir */ + 550, /* telldir */ + 551, /* seekdir */ + 552, /* rewinddir */ + 553, /* closedir */ -1, /* fork */ - 553, /* wait */ - 554, /* waitpid */ - 556, /* system */ - 558, /* exec */ - 560, /* kill */ - 562, /* getppid */ - 563, /* getpgrp */ - 565, /* setpgrp */ - 567, /* getpriority */ - 569, /* setpriority */ - 571, /* time */ + 554, /* wait */ + 555, /* waitpid */ + 557, /* system */ + 559, /* exec */ + 561, /* kill */ + 563, /* getppid */ + 564, /* getpgrp */ + 566, /* setpgrp */ + 568, /* getpriority */ + 570, /* setpriority */ + 572, /* time */ -1, /* tms */ - 572, /* localtime */ - 573, /* gmtime */ - 574, /* alarm */ - 575, /* sleep */ - 577, /* shmget */ - 578, /* shmctl */ - 579, /* shmread */ - 580, /* shmwrite */ - 581, /* msgget */ - 582, /* msgctl */ - 583, /* msgsnd */ - 584, /* msgrcv */ - 585, /* semop */ - 586, /* semget */ - 587, /* semctl */ - 588, /* require */ - 589, /* dofile */ + 573, /* localtime */ + 574, /* gmtime */ + 575, /* alarm */ + 576, /* sleep */ + 578, /* shmget */ + 579, /* shmctl */ + 580, /* shmread */ + 581, /* shmwrite */ + 582, /* msgget */ + 583, /* msgctl */ + 584, /* msgsnd */ + 585, /* msgrcv */ + 586, /* semop */ + 587, /* semget */ + 588, /* semctl */ + 589, /* require */ + 590, /* dofile */ -1, /* hintseval */ - 590, /* entereval */ - 596, /* leaveeval */ - 598, /* entertry */ + 591, /* entereval */ + 597, /* leaveeval */ + 599, /* entertry */ -1, /* leavetry */ - 599, /* ghbyname */ - 600, /* ghbyaddr */ + 600, /* ghbyname */ + 601, /* ghbyaddr */ -1, /* ghostent */ - 601, /* gnbyname */ - 602, /* gnbyaddr */ + 602, /* gnbyname */ + 603, /* gnbyaddr */ -1, /* gnetent */ - 603, /* gpbyname */ - 604, /* gpbynumber */ + 604, /* gpbyname */ + 605, /* gpbynumber */ -1, /* gprotoent */ - 605, /* gsbyname */ - 606, /* gsbyport */ + 606, /* gsbyname */ + 607, /* gsbyport */ -1, /* gservent */ - 607, /* shostent */ - 608, /* snetent */ - 609, /* sprotoent */ - 610, /* sservent */ + 608, /* shostent */ + 609, /* snetent */ + 610, /* sprotoent */ + 611, /* sservent */ -1, /* ehostent */ -1, /* enetent */ -1, /* eprotoent */ -1, /* eservent */ - 611, /* gpwnam */ - 612, /* gpwuid */ + 612, /* gpwnam */ + 613, /* gpwuid */ -1, /* gpwent */ -1, /* spwent */ -1, /* epwent */ - 613, /* ggrnam */ - 614, /* ggrgid */ + 614, /* ggrnam */ + 615, /* ggrgid */ -1, /* ggrent */ -1, /* sgrent */ -1, /* egrent */ -1, /* getlogin */ - 615, /* syscall */ - 616, /* lock */ - 617, /* once */ + 616, /* syscall */ + 617, /* lock */ + 618, /* once */ -1, /* custom */ - 618, /* reach */ - 619, /* rkeys */ - 621, /* rvalues */ - 622, /* coreargs */ - 626, /* runcv */ - 627, /* fc */ + 619, /* reach */ + 620, /* rkeys */ + 622, /* rvalues */ + 623, /* coreargs */ + 627, /* runcv */ + 628, /* fc */ -1, /* padcv */ -1, /* introcv */ -1, /* clonecv */ - 628, /* padrange */ + 629, /* padrange */ }; @@ -2918,6 +2918,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = { /* dump */ 0x3bdc, 0x0003, /* goto */ 0x3bdc, 0x0003, /* exit */ 0x012f, + /* method_named */ 0x0003, /* entergiven */ 0x0003, /* leavegiven */ 0x0003, /* enterwhen */ 0x0003, @@ -3276,7 +3277,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* DUMP */ (OPpARG1_MASK|OPpPV_IS_UTF8), /* GOTO */ (OPpARG1_MASK|OPpPV_IS_UTF8), /* EXIT */ (OPpARG4_MASK), - /* METHOD_NAMED */ (0), + /* METHOD_NAMED */ (OPpARG1_MASK), /* ENTERGIVEN */ (OPpARG1_MASK), /* LEAVEGIVEN */ (OPpARG1_MASK), /* ENTERWHEN */ (OPpARG1_MASK), diff --git a/perl.c b/perl.c index 478b415..f11bcb4 100644 --- a/perl.c +++ b/perl.c @@ -2646,8 +2646,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) { dVAR; dSP; LOGOP myop; /* fake syntax tree node */ - UNOP method_unop; - SVOP method_svop; + METHOP method_op; I32 oldmark; VOL I32 retval = 0; I32 oldscope; @@ -2691,23 +2690,19 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) myop.op_private |= OPpENTERSUB_DB; if (flags & (G_METHOD|G_METHOD_NAMED)) { + Zero(&method_op, 1, METHOP); + method_op.op_next = (OP*)&myop; + PL_op = (OP*)&method_op; if ( flags & G_METHOD_NAMED ) { - Zero(&method_svop, 1, SVOP); - method_svop.op_next = (OP*)&myop; - method_svop.op_ppaddr = PL_ppaddr[OP_METHOD_NAMED]; - method_svop.op_type = OP_METHOD_NAMED; - method_svop.op_sv = sv; - PL_op = (OP*)&method_svop; + method_op.op_ppaddr = PL_ppaddr[OP_METHOD_NAMED]; + method_op.op_type = OP_METHOD_NAMED; + method_op.op_u.op_meth_sv = sv; } else { - Zero(&method_unop, 1, UNOP); - method_unop.op_next = (OP*)&myop; - method_unop.op_ppaddr = PL_ppaddr[OP_METHOD]; - method_unop.op_type = OP_METHOD; - PL_op = (OP*)&method_unop; + method_op.op_ppaddr = PL_ppaddr[OP_METHOD]; + method_op.op_type = OP_METHOD; } myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB]; myop.op_type = OP_ENTERSUB; - } if (!(flags & G_EVAL)) { diff --git a/perl.h b/perl.h index 436c7d1..b958d74 100644 --- a/perl.h +++ b/perl.h @@ -2602,6 +2602,7 @@ typedef struct svop SVOP; typedef struct padop PADOP; typedef struct pvop PVOP; typedef struct loop LOOP; +typedef struct methop METHOP; #ifdef PERL_CORE typedef struct opslab OPSLAB; diff --git a/perly.act b/perly.act index 2d12b05..97784c9 100644 --- a/perly.act +++ b/perly.act @@ -8,7 +8,7 @@ case 2: #line 114 "perly.y" { parser->expect = XSTATE; - ;} + } break; case 3: @@ -16,14 +16,14 @@ case 2: { newPROG(block_end((ps[(3) - (4)].val.ival),(ps[(4) - (4)].val.opval))); (yyval.ival) = 0; - ;} + } break; case 4: #line 123 "perly.y" { parser->expect = XTERM; - ;} + } break; case 5: @@ -31,14 +31,14 @@ case 2: { PL_eval_root = (ps[(3) - (3)].val.opval); (yyval.ival) = 0; - ;} + } break; case 6: #line 132 "perly.y" { parser->expect = XBLOCK; - ;} + } break; case 7: @@ -49,14 +49,14 @@ case 2: (yyval.ival) = 0; yyunlex(); parser->yychar = YYEOF; - ;} + } break; case 8: #line 144 "perly.y" { parser->expect = XSTATE; - ;} + } break; case 9: @@ -67,14 +67,14 @@ case 2: (yyval.ival) = 0; yyunlex(); parser->yychar = YYEOF; - ;} + } break; case 10: #line 156 "perly.y" { parser->expect = XSTATE; - ;} + } break; case 11: @@ -85,14 +85,14 @@ case 2: (yyval.ival) = 0; yyunlex(); parser->yychar = YYEOF; - ;} + } break; case 12: #line 168 "perly.y" { parser->expect = XSTATE; - ;} + } break; case 13: @@ -100,7 +100,7 @@ case 2: { PL_eval_root = (ps[(3) - (3)].val.opval); (yyval.ival) = 0; - ;} + } break; case 14: @@ -108,7 +108,7 @@ case 2: { if (parser->copline > (line_t)(ps[(1) - (4)].val.ival)) parser->copline = (line_t)(ps[(1) - (4)].val.ival); (yyval.opval) = block_end((ps[(2) - (4)].val.ival), (ps[(3) - (4)].val.opval)); - ;} + } break; case 15: @@ -116,12 +116,12 @@ case 2: { if (parser->copline > (line_t)(ps[(1) - (7)].val.ival)) parser->copline = (line_t)(ps[(1) - (7)].val.ival); (yyval.opval) = block_end((ps[(2) - (7)].val.ival), (ps[(5) - (7)].val.opval)); - ;} + } break; case 16: #line 195 "perly.y" - { (yyval.ival) = block_start(TRUE); ;} + { (yyval.ival) = block_start(TRUE); } break; case 17: @@ -129,17 +129,17 @@ case 2: { if (parser->copline > (line_t)(ps[(1) - (4)].val.ival)) parser->copline = (line_t)(ps[(1) - (4)].val.ival); (yyval.opval) = block_end((ps[(2) - (4)].val.ival), (ps[(3) - (4)].val.opval)); - ;} + } break; case 18: #line 206 "perly.y" - { (yyval.ival) = block_start(FALSE); ;} + { (yyval.ival) = block_start(FALSE); } break; case 19: #line 211 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 20: @@ -148,12 +148,12 @@ case 2: PL_pad_reset_pending = TRUE; if ((ps[(1) - (2)].val.opval) && (ps[(2) - (2)].val.opval)) PL_hints |= HINT_BLOCK_SCOPE; - ;} + } break; case 21: #line 222 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 22: @@ -162,38 +162,38 @@ case 2: PL_pad_reset_pending = TRUE; if ((ps[(1) - (2)].val.opval) && (ps[(2) - (2)].val.opval)) PL_hints |= HINT_BLOCK_SCOPE; - ;} + } break; case 23: #line 233 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval) ? newSTATEOP(0, NULL, (ps[(1) - (1)].val.opval)) : NULL; - ;} + } break; case 24: #line 237 "perly.y" - { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} + { (yyval.opval) = (ps[(1) - (1)].val.opval); } break; case 25: #line 241 "perly.y" { (yyval.opval) = newSTATEOP(SVf_UTF8 * (ps[(1) - (2)].val.pval)[strlen((ps[(1) - (2)].val.pval))+1], (ps[(1) - (2)].val.pval), (ps[(2) - (2)].val.opval)); - ;} + } break; case 26: #line 245 "perly.y" { (yyval.opval) = newSTATEOP(SVf_UTF8 * (ps[(1) - (2)].val.pval)[strlen((ps[(1) - (2)].val.pval))+1], (ps[(1) - (2)].val.pval), (ps[(2) - (2)].val.opval)); - ;} + } break; case 27: #line 252 "perly.y" - { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} + { (yyval.opval) = (ps[(1) - (1)].val.opval); } break; case 28: @@ -206,7 +206,7 @@ case 2: SvREFCNT_inc_simple_void(fmtcv); pad_add_anon(fmtcv, OP_NULL); } - ;} + } break; case 29: @@ -231,7 +231,7 @@ case 2: CvCLONE_on(PL_compcv); parser->in_my = 0; parser->in_my_stash = NULL; - ;} + } break; case 30: @@ -244,7 +244,7 @@ case 2: ; (yyval.opval) = (OP*)NULL; intro_my(); - ;} + } break; case 31: @@ -254,12 +254,12 @@ case 2: if ((ps[(2) - (4)].val.opval)) package_version((ps[(2) - (4)].val.opval)); (yyval.opval) = (OP*)NULL; - ;} + } break; case 32: #line 303 "perly.y" - { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ ;} + { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 33: @@ -268,7 +268,7 @@ case 2: SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[(1) - (7)].val.ival), (ps[(2) - (7)].val.ival), (ps[(4) - (7)].val.opval), (ps[(5) - (7)].val.opval), (ps[(6) - (7)].val.opval)); (yyval.opval) = (OP*)NULL; - ;} + } break; case 34: @@ -277,7 +277,7 @@ case 2: (yyval.opval) = block_end((ps[(3) - (7)].val.ival), newCONDOP(0, (ps[(4) - (7)].val.opval), op_scope((ps[(6) - (7)].val.opval)), (ps[(7) - (7)].val.opval))); parser->copline = (line_t)(ps[(1) - (7)].val.ival); - ;} + } break; case 35: @@ -286,7 +286,7 @@ case 2: (yyval.opval) = block_end((ps[(3) - (7)].val.ival), newCONDOP(0, (ps[(4) - (7)].val.opval), op_scope((ps[(6) - (7)].val.opval)), (ps[(7) - (7)].val.opval))); parser->copline = (line_t)(ps[(1) - (7)].val.ival); - ;} + } break; case 36: @@ -300,17 +300,17 @@ case 2: ? 0 : offset)); parser->copline = (line_t)(ps[(1) - (6)].val.ival); - ;} + } break; case 37: #line 334 "perly.y" - { (yyval.opval) = block_end((ps[(3) - (6)].val.ival), newWHENOP((ps[(4) - (6)].val.opval), op_scope((ps[(6) - (6)].val.opval)))); ;} + { (yyval.opval) = block_end((ps[(3) - (6)].val.ival), newWHENOP((ps[(4) - (6)].val.opval), op_scope((ps[(6) - (6)].val.opval)))); } break; case 38: #line 336 "perly.y" - { (yyval.opval) = newWHENOP(0, op_scope((ps[(2) - (2)].val.opval))); ;} + { (yyval.opval) = newWHENOP(0, op_scope((ps[(2) - (2)].val.opval))); } break; case 39: @@ -320,7 +320,7 @@ case 2: newWHILEOP(0, 1, (LOOP*)(OP*)NULL, (ps[(4) - (8)].val.opval), (ps[(7) - (8)].val.opval), (ps[(8) - (8)].val.opval), (ps[(6) - (8)].val.ival))); parser->copline = (line_t)(ps[(1) - (8)].val.ival); - ;} + } break; case 40: @@ -330,17 +330,17 @@ case 2: newWHILEOP(0, 1, (LOOP*)(OP*)NULL, (ps[(4) - (8)].val.opval), (ps[(7) - (8)].val.opval), (ps[(8) - (8)].val.opval), (ps[(6) - (8)].val.ival))); parser->copline = (line_t)(ps[(1) - (8)].val.ival); - ;} + } break; case 41: #line 352 "perly.y" - { parser->expect = XTERM; ;} + { parser->expect = XTERM; } break; case 42: #line 354 "perly.y" - { parser->expect = XTERM; ;} + { parser->expect = XTERM; } break; case 43: @@ -357,7 +357,7 @@ case 2: } (yyval.opval) = block_end((ps[(3) - (13)].val.ival), forop); parser->copline = (line_t)(ps[(1) - (13)].val.ival); - ;} + } break; case 44: @@ -365,7 +365,7 @@ case 2: { (yyval.opval) = block_end((ps[(3) - (9)].val.ival), newFOROP(0, (ps[(4) - (9)].val.opval), (ps[(6) - (9)].val.opval), (ps[(8) - (9)].val.opval), (ps[(9) - (9)].val.opval))); parser->copline = (line_t)(ps[(1) - (9)].val.ival); - ;} + } break; case 45: @@ -374,7 +374,7 @@ case 2: (yyval.opval) = block_end((ps[(4) - (8)].val.ival), newFOROP(0, op_lvalue((ps[(2) - (8)].val.opval), OP_ENTERLOOP), (ps[(5) - (8)].val.opval), (ps[(7) - (8)].val.opval), (ps[(8) - (8)].val.opval))); parser->copline = (line_t)(ps[(1) - (8)].val.ival); - ;} + } break; case 46: @@ -383,7 +383,7 @@ case 2: (yyval.opval) = block_end((ps[(3) - (7)].val.ival), newFOROP(0, (OP*)NULL, (ps[(4) - (7)].val.opval), (ps[(6) - (7)].val.opval), (ps[(7) - (7)].val.opval))); parser->copline = (line_t)(ps[(1) - (7)].val.ival); - ;} + } break; case 47: @@ -392,7 +392,7 @@ case 2: /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, (OP*)NULL, (ps[(1) - (2)].val.opval), (ps[(2) - (2)].val.opval), 0); - ;} + } break; case 48: @@ -402,7 +402,7 @@ case 2: if ((ps[(2) - (5)].val.opval)) { package_version((ps[(2) - (5)].val.opval)); } - ;} + } break; case 49: @@ -413,14 +413,14 @@ case 2: (OP*)NULL, block_end((ps[(5) - (8)].val.ival), (ps[(7) - (8)].val.opval)), (OP*)NULL, 0); if (parser->copline > (line_t)(ps[(4) - (8)].val.ival)) parser->copline = (line_t)(ps[(4) - (8)].val.ival); - ;} + } break; case 50: #line 409 "perly.y" { (yyval.opval) = (ps[(1) - (2)].val.opval); - ;} + } break; case 51: @@ -428,7 +428,7 @@ case 2: { (yyval.opval) = (OP*)NULL; parser->copline = NOLINE; - ;} + } break; case 52: @@ -446,63 +446,63 @@ case 2: else parser->copline--; (yyval.opval) = newSTATEOP(0, NULL, convert(OP_FORMLINE, 0, list)); - ;} + } break; case 53: #line 438 "perly.y" - { (yyval.opval) = NULL; ;} + { (yyval.opval) = NULL; } break; case 54: #line 440 "perly.y" - { (yyval.opval) = op_unscope((ps[(2) - (3)].val.opval)); ;} + { (yyval.opval) = op_unscope((ps[(2) - (3)].val.opval)); } break; case 55: #line 445 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 56: #line 447 "perly.y" - { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} + { (yyval.opval) = (ps[(1) - (1)].val.opval); } break; case 57: #line 449 "perly.y" - { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); ;} + { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); } break; case 58: #line 451 "perly.y" - { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); ;} + { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); } break; case 59: #line 453 "perly.y" - { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[(3) - (3)].val.opval)), (ps[(1) - (3)].val.opval)); ;} + { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[(3) - (3)].val.opval)), (ps[(1) - (3)].val.opval)); } break; case 60: #line 455 "perly.y" - { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); ;} + { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); } break; case 61: #line 457 "perly.y" { (yyval.opval) = newFOROP(0, (OP*)NULL, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval), (OP*)NULL); - parser->copline = (line_t)(ps[(2) - (3)].val.ival); ;} + parser->copline = (line_t)(ps[(2) - (3)].val.ival); } break; case 62: #line 460 "perly.y" - { (yyval.opval) = newWHENOP((ps[(3) - (3)].val.opval), op_scope((ps[(1) - (3)].val.opval))); ;} + { (yyval.opval) = newWHENOP((ps[(3) - (3)].val.opval), op_scope((ps[(1) - (3)].val.opval))); } break; case 63: #line 465 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 64: @@ -510,7 +510,7 @@ case 2: { ((ps[(2) - (2)].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[(2) - (2)].val.opval)); - ;} + } break; case 65: @@ -520,119 +520,119 @@ case 2: newSTATEOP(OPf_SPECIAL,NULL,(ps[(3) - (6)].val.opval)), op_scope((ps[(5) - (6)].val.opval)), (ps[(6) - (6)].val.opval)); PL_hints |= HINT_BLOCK_SCOPE; - ;} + } break; case 66: #line 482 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 67: #line 484 "perly.y" - { (yyval.opval) = op_scope((ps[(2) - (2)].val.opval)); ;} + { (yyval.opval) = op_scope((ps[(2) - (2)].val.opval)); } break; case 68: #line 489 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); - intro_my(); ;} + intro_my(); } break; case 69: #line 495 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 71: #line 501 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); - (yyval.opval) = tmplval.opval; ;} + (yyval.opval) = tmplval.opval; } break; case 73: #line 509 "perly.y" - { (yyval.opval) = invert(scalar((ps[(1) - (1)].val.opval))); ;} + { (yyval.opval) = invert(scalar((ps[(1) - (1)].val.opval))); } break; case 74: #line 514 "perly.y" - { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); ;} + { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); } break; case 75: #line 518 "perly.y" - { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); ;} + { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); } break; case 76: #line 522 "perly.y" - { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); ;} + { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); } break; case 77: #line 525 "perly.y" - { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} + { (yyval.opval) = (ps[(1) - (1)].val.opval); } break; case 78: #line 526 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 79: #line 530 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); - SAVEFREESV(PL_compcv); ;} + SAVEFREESV(PL_compcv); } break; case 80: #line 536 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); - SAVEFREESV(PL_compcv); ;} + SAVEFREESV(PL_compcv); } break; case 81: #line 541 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); - SAVEFREESV(PL_compcv); ;} + SAVEFREESV(PL_compcv); } break; case 84: #line 552 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 86: #line 558 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 87: #line 560 "perly.y" - { (yyval.opval) = (ps[(2) - (2)].val.opval); ;} + { (yyval.opval) = (ps[(2) - (2)].val.opval); } break; case 88: #line 562 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 89: #line 567 "perly.y" - { (yyval.opval) = (ps[(2) - (2)].val.opval); ;} + { (yyval.opval) = (ps[(2) - (2)].val.opval); } break; case 90: #line 569 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 91: #line 573 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 92: @@ -645,7 +645,7 @@ case 2: packWARN(WARN_EXPERIMENTAL__SIGNATURES), "The signatures feature is experimental"); (yyval.opval) = parse_subsignature(); - ;} + } break; case 93: @@ -654,7 +654,7 @@ case 2: (yyval.opval) = op_append_list(OP_LINESEQ, (ps[(2) - (3)].val.opval), newSTATEOP(0, NULL, sawparens(newNULLLIST()))); parser->expect = XBLOCK; - ;} + } break; case 94: @@ -664,37 +664,37 @@ case 2: parser->copline = (line_t)(ps[(3) - (5)].val.ival); (yyval.opval) = block_end((ps[(1) - (5)].val.ival), op_append_list(OP_LINESEQ, (ps[(2) - (5)].val.opval), (ps[(4) - (5)].val.opval))); - ;} + } break; case 95: #line 603 "perly.y" - { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} + { (yyval.opval) = (ps[(1) - (1)].val.opval); } break; case 96: #line 604 "perly.y" - { (yyval.opval) = (OP*)NULL; ;} + { (yyval.opval) = (OP*)NULL; } break; case 97: #line 609 "perly.y" - { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); ;} + { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); } break; case 98: #line 611 "perly.y" - { (yyval.opval) = newLOGOP((ps[(2) - (3)].val.ival), 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); ;} + { (yyval.opval) = newLOGOP((ps[(2) - (3)].val.ival), 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); } break; case 99: #line 613 "perly.y" - { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); ;} + { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); } break; case 101: #line 619 "perly.y" - { (yyval.opval) = (ps[(1) - (2)].val.opval); ;} + { (yyval.opval) = (ps[(1) - (2)].val.opval); } break; case 102: @@ -702,21 +702,21 @@ case 2: { OP* term = (ps[(3) - (3)].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[(1) - (3)].val.opval), term); - ;} + } break; case 104: #line 630 "perly.y" { (yyval.opval) = convert((ps[(1) - (3)].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[(1) - (3)].val.ival),(ps[(2) - (3)].val.opval)), (ps[(3) - (3)].val.opval)) ); - ;} + } break; case 105: #line 634 "perly.y" { (yyval.opval) = convert((ps[(1) - (5)].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[(1) - (5)].val.ival),(ps[(3) - (5)].val.opval)), (ps[(4) - (5)].val.opval)) ); - ;} + } break; case 106: @@ -724,16 +724,16 @@ case 2: { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[(1) - (6)].val.opval)), (ps[(5) - (6)].val.opval)), - newUNOP(OP_METHOD, 0, (ps[(3) - (6)].val.opval)))); - ;} + newMETHOP(OP_METHOD, 0, (ps[(3) - (6)].val.opval)))); + } break; case 107: #line 644 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[(1) - (3)].val.opval)), - newUNOP(OP_METHOD, 0, (ps[(3) - (3)].val.opval)))); - ;} + newMETHOP(OP_METHOD, 0, (ps[(3) - (3)].val.opval)))); + } break; case 108: @@ -741,8 +741,8 @@ case 2: { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[(2) - (3)].val.opval), (ps[(3) - (3)].val.opval)), - newUNOP(OP_METHOD, 0, (ps[(1) - (3)].val.opval)))); - ;} + newMETHOP(OP_METHOD, 0, (ps[(1) - (3)].val.opval)))); + } break; case 109: @@ -750,24 +750,24 @@ case 2: { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[(2) - (5)].val.opval), (ps[(4) - (5)].val.opval)), - newUNOP(OP_METHOD, 0, (ps[(1) - (5)].val.opval)))); - ;} + newMETHOP(OP_METHOD, 0, (ps[(1) - (5)].val.opval)))); + } break; case 110: #line 661 "perly.y" - { (yyval.opval) = convert((ps[(1) - (2)].val.ival), 0, (ps[(2) - (2)].val.opval)); ;} + { (yyval.opval) = convert((ps[(1) - (2)].val.ival), 0, (ps[(2) - (2)].val.opval)); } break; case 111: #line 663 "perly.y" - { (yyval.opval) = convert((ps[(1) - (4)].val.ival), 0, (ps[(3) - (4)].val.opval)); ;} + { (yyval.opval) = convert((ps[(1) - (4)].val.ival), 0, (ps[(3) - (4)].val.opval)); } **** PATCH TRUNCATED AT 2000 LINES -- 1161 NOT SHOWN **** -- Perl5 Master Repository
