From a8394b4e8cb3545141487cc9f17c08f312ec635c Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Wed, 2 Oct 2024 17:34:57 +0100 Subject: [PATCH] Optimise foreach on a list from builtin::indexed @array into two lexicals Rather than generating an entire temporary list that is twice as big as the original array, instead set a flag on the `OP_ITER` that tells it to set one of the iteration variables to the current array index and use the same `CXt_LOOP_ARY` optimisation that regular foreach over an array would use. --- builtin.c | 8 +- embed.fnc | 2 + embed.h | 1 + lib/B/Deparse.pm | 12 ++- lib/B/Deparse.t | 5 + lib/B/Op_private.pm | 4 + lib/builtin.t | 24 +++++ op.c | 73 ++++++++++++- opcode.h | 258 ++++++++++++++++++++++---------------------- pod/perldelta.pod | 17 +++ pp_hot.c | 13 ++- proto.h | 6 ++ regen/op_private | 3 +- t/perf/opcount.t | 9 ++ 14 files changed, 298 insertions(+), 137 deletions(-) diff --git a/builtin.c b/builtin.c index 34865ec9a4bb..a52a22f6fa86 100644 --- a/builtin.c +++ b/builtin.c @@ -490,9 +490,13 @@ static OP *ck_builtin_func1(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) } } -XS(XS_builtin_indexed) +/* This does not use the XS() macro so that op.c can see its prototype */ +void +Perl_XS_builtin_indexed(pTHX_ CV *cv) { dXSARGS; + PERL_ARGS_ASSERT_XS_BUILTIN_INDEXED; + PERL_UNUSED_VAR(cv); switch(GIMME_V) { case G_VOID: @@ -638,7 +642,7 @@ static const struct BuiltinFuncDescriptor builtins[] = { { "load_module", NO_BUNDLE, &XS_builtin_load_module, &ck_builtin_func1, 0, true }, /* list functions */ - { "indexed", SHORTVER(5,39), &XS_builtin_indexed, &ck_builtin_funcN, 0, false }, + { "indexed", SHORTVER(5,39), &Perl_XS_builtin_indexed, &ck_builtin_funcN, 0, false }, { "export_lexically", NO_BUNDLE, &XS_builtin_export_lexically, NULL, 0, true }, { NULL, 0, NULL, NULL, 0, false } diff --git a/embed.fnc b/embed.fnc index 198073342d2e..634835c76795 100644 --- a/embed.fnc +++ b/embed.fnc @@ -4127,6 +4127,8 @@ p |void |finish_export_lexical p |void |import_builtin_bundle \ |U16 ver p |void |prepare_export_lexical +p |void |XS_builtin_indexed \ + |NN CV *cv #endif #if defined(PERL_IN_CLASS_C) || defined(PERL_IN_OP_C) || \ defined(PERL_IN_PAD_C) || defined(PERL_IN_PERLY_C) || \ diff --git a/embed.h b/embed.h index 973978756dc2..0836a086cf4d 100644 --- a/embed.h +++ b/embed.h @@ -1211,6 +1211,7 @@ # define get_aux_mg(a) S_get_aux_mg(aTHX_ a) # endif # if defined(PERL_IN_BUILTIN_C) || defined(PERL_IN_OP_C) +# define XS_builtin_indexed(a) Perl_XS_builtin_indexed(aTHX_ a) # define finish_export_lexical() Perl_finish_export_lexical(aTHX) # define import_builtin_bundle(a) Perl_import_builtin_bundle(aTHX_ a) # define prepare_export_lexical() Perl_prepare_export_lexical(aTHX) diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index d3b21441c721..6e3389373695 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -7,7 +7,7 @@ # This is based on the module of the same name by Malcolm Beattie, # but essentially none of his code remains. -package B::Deparse 1.79; +package B::Deparse 1.80; use strict; use Carp; use B qw(class main_root main_start main_cv svref_2object opnumber perlstring @@ -66,7 +66,8 @@ BEGIN { # List version-specific constants here. # Easiest way to keep this code portable between version looks to # be to fake up a dummy constant that will never actually be true. - foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED OPpCONST_NOVER + foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_INDEXED + OPpITER_REVERSED OPpCONST_NOVER OPpPAD_STATE PMf_SKIPWHITE RXf_SKIPWHITE PMf_CHARSET PMf_KEEPCOPY PMf_NOCAPTURE CVf_ANONCONST CVf_LOCKED OPpREVERSE_INPLACE OPpSUBSTR_REPL_FIRST @@ -4018,6 +4019,7 @@ sub loop_common { } elsif ($enter->name eq "enteriter") { # foreach my $ary = $enter->first->sibling; # first was pushmark my $var = $ary->sibling; + my $iter = $kid->first->first; if ($ary->name eq 'null' and $enter->private & OPpITER_REVERSED) { # "reverse" was optimised away $ary = listop($self, $ary->first->sibling, 1, 'reverse'); @@ -4030,6 +4032,10 @@ sub loop_common { $ary = $self->deparse($ary, 1); } + if ($iter->private & OPpITER_INDEXED) { + $ary = "builtin::indexed $ary"; + } + if ($enter->flags & OPf_PARENS) { # for my ($x, $y, ...) ... # for my ($foo, $bar) () stores the count (less 1) in the targ of @@ -4057,7 +4063,7 @@ sub loop_common { } else { $var = $self->deparse($var, 1); } - $body = $kid->first->first->sibling; # skip OP_AND and OP_ITER + $body = $iter->sibling; if (!is_state $body->first and $body->first->name !~ /^(?:stub|leave|scope)$/) { confess unless $var eq '$_'; $body = $body->first; diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 42bdc805f5f0..59f937dcc52d 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -2610,6 +2610,11 @@ foreach my ($key, $value) (%hash) { study $_; } #### +my @arr; +foreach my ($idx, $elem) (builtin::indexed @arr) { + die; +} +#### my @ducks; foreach my ($tick, $trick, $track) (@ducks) { study $_; diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 6fdd8c7db13c..255817c85fc1 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -436,6 +436,7 @@ $bits{is_bool}{0} = $bf[0]; $bits{is_tainted}{0} = $bf[0]; $bits{is_weak}{0} = $bf[0]; @{$bits{isa}}{1,0} = ($bf[1], $bf[1]); +$bits{iter}{2} = 'OPpITER_INDEXED'; @{$bits{join}}{3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5]); $bits{keys}{0} = $bf[0]; @{$bits{kill}}{3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5]); @@ -685,6 +686,7 @@ our %defines = ( OPpINITFIELD_AV => 2, OPpINITFIELD_HV => 4, OPpITER_DEF => 8, + OPpITER_INDEXED => 4, OPpITER_REVERSED => 2, OPpKVSLICE => 32, OPpLIST_GUESSED => 64, @@ -808,6 +810,7 @@ our %labels = ( OPpINITFIELD_AV => 'INITFIELD_AV', OPpINITFIELD_HV => 'INITFIELD_HV', OPpITER_DEF => 'DEF', + OPpITER_INDEXED => 'INDEXED', OPpITER_REVERSED => 'REVERSED', OPpKVSLICE => 'KVSLICE', OPpLIST_GUESSED => 'GUESSED', @@ -895,6 +898,7 @@ our %ops_using = ( OPpINITFIELDS => [qw(methstart)], OPpINITFIELD_AV => [qw(initfield)], OPpITER_DEF => [qw(enteriter)], + OPpITER_INDEXED => [qw(iter)], OPpITER_REVERSED => [qw(enteriter iter)], OPpKVSLICE => [qw(delete)], OPpLIST_GUESSED => [qw(list)], diff --git a/lib/builtin.t b/lib/builtin.t index ce5de3455b60..c4b26ee3640b 100644 --- a/lib/builtin.t +++ b/lib/builtin.t @@ -347,6 +347,30 @@ package FetchStoreCounter { is(prototype(\&builtin::indexed), '@', 'indexed prototype'); } +# indexed + foreach loop optimisation appears transparent +{ + my @output; + my @input = qw( zero one two three four five ); + + foreach my ( $idx, $val ) ( builtin::indexed @input ) { + push @output, "[$idx]=$val"; + } + + ok(eq_array(\@output, [qw( [0]=zero [1]=one [2]=two [3]=three [4]=four [5]=five )] ), + 'foreach + builtin::indexed' ); + + undef @output; + + use builtin qw( indexed ); + + foreach my ( $idx, $val ) ( indexed @input ) { + push @output, "[$idx]=$val"; + } + + ok(eq_array(\@output, [qw( [0]=zero [1]=one [2]=two [3]=three [4]=four [5]=five )] ), + 'foreach + imported indexed' ); +} + # Vanilla trim tests { use builtin qw( trim ); diff --git a/op.c b/op.c index e0340bb7707a..9dc1c79dc1cc 100644 --- a/op.c +++ b/op.c @@ -9631,6 +9631,39 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, return o; } +#define op_is_cv_xsub(o, xsub) S_op_is_cv_xsub(aTHX_ o, xsub) +static bool +S_op_is_cv_xsub(pTHX_ OP *o, XSUBADDR_t xsub) +{ + if(o->op_type == OP_NULL) + o = cUNOPo->op_first; + + CV *cv; + switch(o->op_type) { + case OP_GV: + { + GV *gv; + if(!(gv = cGVOPo_gv)) + return false; + cv = GvCV(gv); + break; + } + + case OP_PADCV: + cv = (CV *)PAD_SVl(o->op_targ); + assert(cv && SvTYPE(cv) == SVt_PVCV); + break; + + default: + return false; + } + + if(!cv || !CvISXSUB(cv)) + return false; + + return CvXSUB(cv) == xsub; +} + /* =for apidoc newFOROP @@ -9663,6 +9696,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) PADOFFSET how_many_more = 0; I32 enteriterflags = 0; I32 enteriterpflags = 0; + U8 iterpflags = 0; bool parens = 0; PERL_ARGS_ASSERT_NEWFOROP; @@ -9774,6 +9808,42 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) expr = op_lvalue(op_force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART); enteriterflags |= OPf_STACKED; } + else if (padoff != 0 && how_many_more == 1 && /* two lexical vars */ + expr->op_type == OP_ENTERSUB) { + OP *args = cUNOPx(expr)->op_first; + assert(OP_TYPE_IS_OR_WAS(args, OP_LIST)); + + OP *pre_firstarg = NULL; + OP *firstarg = cLISTOPx(args)->op_first; + OP *lastarg = cLISTOPx(args)->op_last; + + if(firstarg->op_type == OP_PUSHMARK) + pre_firstarg = firstarg, firstarg = OpSIBLING(firstarg); + if(firstarg == lastarg) + firstarg = NULL; + + if (op_is_cv_xsub(lastarg, &Perl_XS_builtin_indexed) && /* a call to builtin::indexed */ + firstarg && OpSIBLING(firstarg) == lastarg && /* with one arg */ + (firstarg->op_type == OP_RV2AV || firstarg->op_type == OP_PADAV) /* ... which is an array */ + ) { + /* Turn for my ($idx, $val) (indexed @arr) into a similar OPf_STACKED + * loop on the array itself as the case above, plus a flag to tell + * pp_iter to set the index directly + */ + + /* Cut the array arg out of the args list and discard the rest of + * the original expr + */ + op_sibling_splice(args, pre_firstarg, 1, NULL); + op_free(expr); + + expr = op_lvalue(op_force_list(scalar(ref(firstarg, OP_ITER))), OP_GREPSTART); + enteriterflags |= OPf_STACKED; + iterpflags |= OPpITER_INDEXED; + } + else + goto expr_not_special; + } else if (expr->op_type == OP_NULL && (expr->op_flags & OPf_KIDS) && cBINOPx(expr)->op_first->op_type == OP_FLOP) @@ -9804,6 +9874,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) enteriterflags |= OPf_STACKED; } else { +expr_not_special: expr = op_lvalue(op_force_list(expr), OP_GREPSTART); } @@ -9840,7 +9911,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) if (parens) /* hint to deparser that this: for my (...) ... */ loop->op_flags |= OPf_PARENS; - iter = newOP(OP_ITER, 0); + iter = newOP(OP_ITER, (U32)iterpflags << 8); iter->op_targ = how_many_more; return newWHILEOP(flags, 1, loop, iter, block, cont, 0); } diff --git a/opcode.h b/opcode.h index 99f98156ed76..ab62fa16ccc6 100644 --- a/opcode.h +++ b/opcode.h @@ -2281,6 +2281,7 @@ END_EXTERN_C #define OPpEVAL_UNICODE 0x04 #define OPpFT_STACKED 0x04 #define OPpINITFIELD_HV 0x04 +#define OPpITER_INDEXED 0x04 #define OPpLVREF_ELEM 0x04 #define OPpSLICEWARNING 0x04 #define OPpSORT_REVERSE 0x04 @@ -2454,6 +2455,7 @@ EXTCONST char PL_op_private_labels[] = { 'I','N','A','R','G','S','\0', 'I','N','B','I','N','\0', 'I','N','C','R','\0', + 'I','N','D','E','X','E','D','\0', 'I','N','I','T','F','I','E','L','D','S','\0', 'I','N','I','T','F','I','E','L','D','_','A','V','\0', 'I','N','I','T','F','I','E','L','D','_','H','V','\0', @@ -2526,16 +2528,16 @@ EXTCONST char PL_op_private_labels[] = { EXTCONST I16 PL_op_private_bitfields[] = { 0, 8, -1, 0, 8, -1, - 0, 707, 1, 546, 2, 71, 3, 298, -1, - 0, 741, -1, + 0, 715, 1, 554, 2, 71, 3, 298, -1, + 0, 749, -1, 0, 8, -1, 0, 8, -1, - 0, 748, -1, - 0, 737, -1, - 1, -1, 0, 686, 1, 39, 2, 324, -1, + 0, 756, -1, + 0, 745, -1, + 1, -1, 0, 694, 1, 39, 2, 324, -1, 4, -1, 1, 185, 2, 192, 3, 199, -1, - 4, -1, 0, 686, 1, 39, 2, 324, 3, 131, -1, - 6, 701, 1, 455, 2, 246, 3, 588, -1, + 4, -1, 0, 694, 1, 39, 2, 324, 3, 131, -1, + 6, 709, 1, 463, 2, 246, 3, 596, -1, }; @@ -2750,20 +2752,20 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 200, /* enteriter */ 204, /* iter */ -1, /* enterloop */ - 205, /* leaveloop */ + 206, /* leaveloop */ -1, /* return */ - 207, /* last */ - 207, /* next */ - 207, /* redo */ - 207, /* dump */ - 209, /* goto */ + 208, /* last */ + 208, /* next */ + 208, /* redo */ + 208, /* dump */ + 210, /* goto */ 56, /* exit */ - 212, /* method */ - 212, /* method_named */ - 212, /* method_super */ - 212, /* method_redir */ - 212, /* method_redir_super */ - 214, /* open */ + 213, /* method */ + 213, /* method_named */ + 213, /* method_super */ + 213, /* method_redir */ + 213, /* method_redir_super */ + 215, /* open */ 56, /* close */ 56, /* pipe_op */ 56, /* fileno */ @@ -2809,33 +2811,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* getpeername */ 0, /* lstat */ 0, /* stat */ - 219, /* ftrread */ - 219, /* ftrwrite */ - 219, /* ftrexec */ - 219, /* fteread */ - 219, /* ftewrite */ - 219, /* fteexec */ - 224, /* ftis */ - 224, /* ftsize */ - 224, /* ftmtime */ - 224, /* ftatime */ - 224, /* ftctime */ - 224, /* ftrowned */ - 224, /* fteowned */ - 224, /* ftzero */ - 224, /* ftsock */ - 224, /* ftchr */ - 224, /* ftblk */ - 224, /* ftfile */ - 224, /* ftdir */ - 224, /* ftpipe */ - 224, /* ftsuid */ - 224, /* ftsgid */ - 224, /* ftsvtx */ - 224, /* ftlink */ - 224, /* fttty */ - 224, /* fttext */ - 224, /* ftbinary */ + 220, /* ftrread */ + 220, /* ftrwrite */ + 220, /* ftrexec */ + 220, /* fteread */ + 220, /* ftewrite */ + 220, /* fteexec */ + 225, /* ftis */ + 225, /* ftsize */ + 225, /* ftmtime */ + 225, /* ftatime */ + 225, /* ftctime */ + 225, /* ftrowned */ + 225, /* fteowned */ + 225, /* ftzero */ + 225, /* ftsock */ + 225, /* ftchr */ + 225, /* ftblk */ + 225, /* ftfile */ + 225, /* ftdir */ + 225, /* ftpipe */ + 225, /* ftsuid */ + 225, /* ftsgid */ + 225, /* ftsvtx */ + 225, /* ftlink */ + 225, /* fttty */ + 225, /* fttext */ + 225, /* ftbinary */ 56, /* chdir */ 101, /* chown */ 78, /* chroot */ @@ -2855,17 +2857,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* rewinddir */ 0, /* closedir */ -1, /* fork */ - 228, /* wait */ + 229, /* wait */ 101, /* waitpid */ 101, /* system */ 101, /* exec */ 101, /* kill */ - 228, /* getppid */ + 229, /* getppid */ 101, /* getpgrp */ 101, /* setpgrp */ 101, /* getpriority */ 101, /* setpriority */ - 228, /* time */ + 229, /* time */ -1, /* tms */ 0, /* localtime */ 56, /* gmtime */ @@ -2885,7 +2887,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* require */ 0, /* dofile */ -1, /* hintseval */ - 229, /* entereval */ + 230, /* entereval */ 188, /* leaveeval */ 0, /* entertry */ -1, /* leavetry */ @@ -2924,17 +2926,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* lock */ 0, /* once */ -1, /* custom */ - 236, /* coreargs */ - 240, /* avhvswitch */ + 237, /* coreargs */ + 241, /* avhvswitch */ 3, /* runcv */ 0, /* fc */ -1, /* padcv */ -1, /* introcv */ -1, /* clonecv */ - 242, /* padrange */ - 244, /* refassign */ - 250, /* lvref */ - 256, /* lvrefslice */ + 243, /* padrange */ + 245, /* refassign */ + 251, /* lvref */ + 257, /* lvrefslice */ 17, /* lvavref */ 0, /* anonconst */ 13, /* isa */ @@ -2944,20 +2946,20 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { -1, /* leavetrycatch */ -1, /* poptry */ 0, /* catch */ - 257, /* pushdefer */ + 258, /* pushdefer */ 0, /* is_bool */ 0, /* is_weak */ 0, /* weaken */ 0, /* unweaken */ 53, /* blessed */ - 259, /* refaddr */ - 259, /* reftype */ - 259, /* ceil */ - 259, /* floor */ + 260, /* refaddr */ + 260, /* reftype */ + 260, /* ceil */ + 260, /* floor */ 0, /* is_tainted */ - 262, /* helemexistsor */ - 264, /* methstart */ - 266, /* initfield */ + 263, /* helemexistsor */ + 265, /* methstart */ + 267, /* initfield */ -1, /* classname */ }; @@ -2978,87 +2980,87 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { EXTCONST U16 PL_op_private_bitdefs[] = { 0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, not, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst, cmpchain_and, cmpchain_dup, entertrycatch, catch, is_bool, is_weak, weaken, unweaken, is_tainted */ - 0x3bfc, 0x5279, /* pushmark */ + 0x3cfc, 0x5379, /* pushmark */ 0x00bd, /* wantarray, runcv */ - 0x077e, 0x0554, 0x1b70, 0x532c, 0x4ec8, 0x4125, /* const */ - 0x3bfc, 0x46f9, /* gvsv */ + 0x077e, 0x0554, 0x1b70, 0x542c, 0x4fc8, 0x4225, /* const */ + 0x3cfc, 0x47f9, /* gvsv */ 0x19d5, /* 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, lslice, xor, isa */ - 0x3bfc, 0x5278, 0x04f7, /* padsv */ - 0x3bfc, 0x5278, 0x0003, /* padsv_store, lvavref */ - 0x3bfc, 0x5278, 0x06d4, 0x3cec, 0x5049, /* padav */ - 0x3bfc, 0x5278, 0x06d4, 0x0770, 0x3cec, 0x5048, 0x36c1, /* padhv */ - 0x3bfc, 0x1e38, 0x04f6, 0x3cec, 0x4048, 0x5324, 0x0003, /* rv2gv */ - 0x3bfc, 0x46f8, 0x04f6, 0x5324, 0x0003, /* rv2sv */ - 0x3cec, 0x0003, /* av2arylen, akeys, values, keys */ - 0x3fbc, 0x1198, 0x0ef4, 0x014c, 0x5628, 0x5324, 0x0003, /* rv2cv */ + 0x3cfc, 0x5378, 0x04f7, /* padsv */ + 0x3cfc, 0x5378, 0x0003, /* padsv_store, lvavref */ + 0x3cfc, 0x5378, 0x06d4, 0x3dec, 0x5149, /* padav */ + 0x3cfc, 0x5378, 0x06d4, 0x0770, 0x3dec, 0x5148, 0x37c1, /* padhv */ + 0x3cfc, 0x1e38, 0x04f6, 0x3dec, 0x4148, 0x5424, 0x0003, /* rv2gv */ + 0x3cfc, 0x47f8, 0x04f6, 0x5424, 0x0003, /* rv2sv */ + 0x3dec, 0x0003, /* av2arylen, akeys, values, keys */ + 0x40bc, 0x1198, 0x0ef4, 0x014c, 0x5728, 0x5424, 0x0003, /* rv2cv */ 0x06d4, 0x0770, 0x0003, /* ref, blessed */ 0x02af, /* 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, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, chdir, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */ - 0x48dc, 0x47f8, 0x2e74, 0x2db0, 0x0003, /* backtick */ + 0x49dc, 0x48f8, 0x2e74, 0x2db0, 0x0003, /* backtick */ 0x06d5, /* subst */ - 0x129c, 0x5a98, 0x0ad4, 0x518c, 0x28e8, 0x00c7, /* trans, transr */ + 0x129c, 0x5b98, 0x0ad4, 0x528c, 0x28e8, 0x00c7, /* trans, transr */ 0x10dc, 0x05f8, 0x0067, /* sassign */ - 0x0d98, 0x0c94, 0x0b90, 0x3cec, 0x06c8, 0x0067, /* aassign */ - 0x56d0, 0x0003, /* chomp, schomp, negate, i_negate, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir */ - 0x3bfc, 0x5278, 0x35d4, 0x56d0, 0x0003, /* undef */ - 0x06d4, 0x3cec, 0x0003, /* pos */ - 0x56d0, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract */ + 0x0d98, 0x0c94, 0x0b90, 0x3dec, 0x06c8, 0x0067, /* aassign */ + 0x57d0, 0x0003, /* chomp, schomp, negate, i_negate, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir */ + 0x3cfc, 0x5378, 0x36d4, 0x57d0, 0x0003, /* undef */ + 0x06d4, 0x3dec, 0x0003, /* pos */ + 0x57d0, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract */ 0x1658, 0x0067, /* repeat */ - 0x3ed8, 0x56d0, 0x0067, /* concat */ - 0x3bfc, 0x0338, 0x1e34, 0x56d0, 0x540c, 0x0003, /* multiconcat */ - 0x56d0, 0x02af, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */ - 0x56d0, 0x59a9, /* left_shift, right_shift, nbit_and, nbit_xor, nbit_or, ncomplement */ - 0x59a9, /* bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, complement */ - 0x06d4, 0x56d0, 0x0003, /* length */ - 0x4c30, 0x3cec, 0x024b, /* substr */ - 0x3cec, 0x0067, /* vec */ - 0x3e58, 0x06d4, 0x56d0, 0x02af, /* index, rindex */ - 0x3bfc, 0x46f8, 0x06d4, 0x3cec, 0x5048, 0x5324, 0x0003, /* rv2av */ + 0x3fd8, 0x57d0, 0x0067, /* concat */ + 0x3cfc, 0x0338, 0x1e34, 0x57d0, 0x550c, 0x0003, /* multiconcat */ + 0x57d0, 0x02af, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */ + 0x57d0, 0x5aa9, /* left_shift, right_shift, nbit_and, nbit_xor, nbit_or, ncomplement */ + 0x5aa9, /* bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, complement */ + 0x06d4, 0x57d0, 0x0003, /* length */ + 0x4d30, 0x3dec, 0x024b, /* substr */ + 0x3dec, 0x0067, /* vec */ + 0x3f58, 0x06d4, 0x57d0, 0x02af, /* index, rindex */ + 0x3cfc, 0x47f8, 0x06d4, 0x3dec, 0x5148, 0x5424, 0x0003, /* rv2av */ 0x037f, /* aelemfast, aelemfast_lex, aelemfastlex_store */ - 0x3bfc, 0x3af8, 0x04f6, 0x3cec, 0x0067, /* aelem, helem */ - 0x3bfc, 0x3cec, 0x5049, /* aslice, hslice */ - 0x3ced, /* kvaslice, kvhslice */ - 0x3bfc, 0x4f98, 0x3774, 0x0003, /* delete */ - 0x5558, 0x0003, /* exists */ - 0x3bfc, 0x46f8, 0x06d4, 0x0770, 0x3cec, 0x5048, 0x5324, 0x36c1, /* rv2hv */ - 0x3bfc, 0x3af8, 0x1314, 0x1d50, 0x3cec, 0x5324, 0x0003, /* multideref */ - 0x3bfc, 0x46f8, 0x0410, 0x386c, 0x2be9, /* split */ - 0x3bfc, 0x2619, /* list */ - 0x3bfc, 0x5278, 0x0214, 0x56d0, 0x02af, /* emptyavhv */ - 0x15b0, 0x33ac, 0x4d28, 0x34a4, 0x43c1, /* sort */ - 0x33ac, 0x0003, /* reverse */ + 0x3cfc, 0x3bf8, 0x04f6, 0x3dec, 0x0067, /* aelem, helem */ + 0x3cfc, 0x3dec, 0x5149, /* aslice, hslice */ + 0x3ded, /* kvaslice, kvhslice */ + 0x3cfc, 0x5098, 0x3874, 0x0003, /* delete */ + 0x5658, 0x0003, /* exists */ + 0x3cfc, 0x47f8, 0x06d4, 0x0770, 0x3dec, 0x5148, 0x5424, 0x37c1, /* rv2hv */ + 0x3cfc, 0x3bf8, 0x1314, 0x1d50, 0x3dec, 0x5424, 0x0003, /* multideref */ + 0x3cfc, 0x47f8, 0x0410, 0x396c, 0x2be9, /* split */ + 0x3cfc, 0x2619, /* list */ + 0x3cfc, 0x5378, 0x0214, 0x57d0, 0x02af, /* emptyavhv */ + 0x15b0, 0x34ac, 0x4e28, 0x35a4, 0x44c1, /* sort */ + 0x34ac, 0x0003, /* reverse */ 0x06d4, 0x0003, /* grepwhile */ - 0x3998, 0x0003, /* flip, flop */ - 0x3bfc, 0x0003, /* cond_expr */ - 0x3bfc, 0x1198, 0x04f6, 0x014c, 0x5628, 0x5324, 0x2cc1, /* entersub */ - 0x4a98, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ + 0x3a98, 0x0003, /* flip, flop */ + 0x3cfc, 0x0003, /* cond_expr */ + 0x3cfc, 0x1198, 0x04f6, 0x014c, 0x5728, 0x5424, 0x2cc1, /* entersub */ + 0x4b98, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ 0x03ca, 0x0003, /* argelem */ 0x2adc, 0x29b8, 0x0003, /* argdefelem */ 0x00bc, 0x02af, /* caller */ 0x27f5, /* nextstate, dbstate */ - 0x3a9c, 0x4a99, /* leave */ - 0x3bfc, 0x46f8, 0x120c, 0x4da5, /* enteriter */ - 0x4da5, /* iter */ - 0x3a9c, 0x0067, /* leaveloop */ - 0x5bbc, 0x0003, /* last, next, redo, dump */ - 0x5bbc, 0x5628, 0x0003, /* goto */ - 0x41e4, 0x0003, /* method, method_named, method_super, method_redir, method_redir_super */ - 0x48dc, 0x47f8, 0x2e74, 0x2db0, 0x02af, /* open */ + 0x3b9c, 0x4b99, /* leave */ + 0x3cfc, 0x47f8, 0x120c, 0x4ea5, /* enteriter */ + 0x2f08, 0x4ea5, /* iter */ + 0x3b9c, 0x0067, /* leaveloop */ + 0x5cbc, 0x0003, /* last, next, redo, dump */ + 0x5cbc, 0x5728, 0x0003, /* goto */ + 0x42e4, 0x0003, /* method, method_named, method_super, method_redir, method_redir_super */ + 0x49dc, 0x48f8, 0x2e74, 0x2db0, 0x02af, /* open */ 0x2190, 0x23ec, 0x22a8, 0x2064, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */ 0x2190, 0x23ec, 0x22a8, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */ - 0x56d1, /* wait, getppid, time */ - 0x1c78, 0x4b34, 0x0fb0, 0x082c, 0x5928, 0x2704, 0x0003, /* entereval */ - 0x3dbc, 0x0018, 0x14c4, 0x13e1, /* coreargs */ - 0x3cec, 0x01e7, /* avhvswitch */ - 0x3bfc, 0x031b, /* padrange */ - 0x3bfc, 0x5278, 0x0616, 0x352c, 0x1ac8, 0x0067, /* refassign */ - 0x3bfc, 0x5278, 0x0616, 0x352c, 0x1ac8, 0x0003, /* lvref */ - 0x3bfd, /* lvrefslice */ + 0x57d1, /* wait, getppid, time */ + 0x1c78, 0x4c34, 0x0fb0, 0x082c, 0x5a28, 0x2704, 0x0003, /* entereval */ + 0x3ebc, 0x0018, 0x14c4, 0x13e1, /* coreargs */ + 0x3dec, 0x01e7, /* avhvswitch */ + 0x3cfc, 0x031b, /* padrange */ + 0x3cfc, 0x5378, 0x0616, 0x362c, 0x1ac8, 0x0067, /* refassign */ + 0x3cfc, 0x5378, 0x0616, 0x362c, 0x1ac8, 0x0003, /* lvref */ + 0x3cfd, /* lvrefslice */ 0x1f7c, 0x0003, /* pushdefer */ - 0x56d0, 0x5628, 0x0003, /* refaddr, reftype, ceil, floor */ + 0x57d0, 0x5728, 0x0003, /* refaddr, reftype, ceil, floor */ 0x131c, 0x0003, /* helemexistsor */ - 0x2f1c, 0x0003, /* methstart */ - 0x3208, 0x3064, 0x0003, /* initfield */ + 0x301c, 0x0003, /* methstart */ + 0x3308, 0x3164, 0x0003, /* initfield */ }; @@ -3271,7 +3273,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* LEAVE */ (OPpREFCOUNTED|OPpLVALUE), /* SCOPE */ (0), /* ENTERITER */ (OPpITER_REVERSED|OPpITER_DEF|OPpOUR_INTRO|OPpLVAL_INTRO), - /* ITER */ (OPpITER_REVERSED), + /* ITER */ (OPpITER_REVERSED|OPpITER_INDEXED), /* ENTERLOOP */ (0), /* LEAVELOOP */ (OPpARG2_MASK|OPpLVALUE), /* RETURN */ (0), diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 63e0bd751bd9..ee4f3ffb9e5c 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -91,6 +91,23 @@ There may well be none in a stable release. XXX +=item * + +Code that uses the C function from the L module to generate +a list of index/value pairs out of array which is then passed into a +two-variable C list to unpack those again is now optimised to be more +efficient. + + my @array = (...); + + foreach my ($idx, $val) (builtin::indexed @array) { + ... + } + +In particular, a temporary list twice the size of the original +array is no longer generated. Instead, the list iterates down the array +in-place directly, in the same way that C would do. + =back =head1 Modules and Pragmata diff --git a/pp_hot.c b/pp_hot.c index 4f1e54711f22..b6042fad0498 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -4868,6 +4868,7 @@ PP(pp_iter) PERL_CONTEXT *cx = CX_CUR(); SV **itersvp = CxITERVAR(cx); const U8 type = CxTYPE(cx); + U8 pflags = PL_op->op_private; /* Classic "for" syntax iterates one-at-a-time. Many-at-a-time for loops are only for lexicals declared as part of the @@ -5014,7 +5015,7 @@ PP(pp_iter) case CXt_LOOP_LIST: /* for (1,2,3) */ assert(OPpITER_REVERSED == 2); /* so inc becomes -1 or 1 */ - inc = (IV)1 - (IV)(PL_op->op_private & OPpITER_REVERSED); + inc = (IV)1 - (IV)(pflags & OPpITER_REVERSED); ix = (cx->blk_loop.state_u.stack.ix += inc); if (UNLIKELY(inc > 0 ? ix > cx->blk_oldsp @@ -5036,7 +5037,7 @@ PP(pp_iter) case CXt_LOOP_ARY: /* for (@ary) */ av = cx->blk_loop.state_u.ary.ary; - inc = (IV)1 - (IV)(PL_op->op_private & OPpITER_REVERSED); + inc = (IV)1 - (IV)(pflags & OPpITER_REVERSED); ix = (cx->blk_loop.state_u.ary.ix += inc); if (UNLIKELY(inc > 0 ? ix > AvFILL(av) @@ -5055,6 +5056,14 @@ PP(pp_iter) sv = AvARRAY(av)[ix]; } + if (UNLIKELY(pflags & OPpITER_INDEXED) && (i == 0)) { + SvREFCNT_dec(*itersvp); + *itersvp = newSViv(ix); + + ++i; + ++itersvp; + } + loop_ary_common: if (UNLIKELY(cx->cx_type & CXp_FOR_LVREF)) { diff --git a/proto.h b/proto.h index 64734e6d82e0..6318430424e0 100644 --- a/proto.h +++ b/proto.h @@ -6203,6 +6203,12 @@ S_get_aux_mg(pTHX_ AV *av); #endif #if defined(PERL_IN_BUILTIN_C) || defined(PERL_IN_OP_C) +PERL_CALLCONV void +Perl_XS_builtin_indexed(pTHX_ CV *cv) + __attribute__visibility__("hidden"); +# define PERL_ARGS_ASSERT_XS_BUILTIN_INDEXED \ + assert(cv); assert(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM) + PERL_CALLCONV void Perl_finish_export_lexical(pTHX) __attribute__visibility__("hidden"); diff --git a/regen/op_private b/regen/op_private index 419874ae412d..409db837faf0 100644 --- a/regen/op_private +++ b/regen/op_private @@ -690,7 +690,8 @@ addbits('enteriter', 1 => qw(OPpITER_REVERSED REVERSED),# for (reverse ...) 3 => qw(OPpITER_DEF DEF), # 'for $_' ); -addbits('iter', 1 => qw(OPpITER_REVERSED REVERSED)); +addbits('iter', 1 => qw(OPpITER_REVERSED REVERSED), + 2 => qw(OPpITER_INDEXED INDEXED)); diff --git a/t/perf/opcount.t b/t/perf/opcount.t index 45f4bbcb991a..ece5ec8ef907 100644 --- a/t/perf/opcount.t +++ b/t/perf/opcount.t @@ -1011,4 +1011,13 @@ test_opcount(0, "Empty anonhash ref and direct lexical assignment", srefgen => 1, }); +test_opcount(0, "foreach 2 lexicals on builtin::indexed", + sub { my @input = (); foreach my ($i, $x) (builtin::indexed @input) { } }, + { + entersub => 0, # no call to builtin::indexed + enteriter => 1, + iter => 1, + padav => 2, + }); + done_testing();