Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Optimise foreach on builtin::indexed ARRAY #22641

Open
wants to merge 5 commits into
base: blead
Choose a base branch
from
Open

Optimise foreach on builtin::indexed ARRAY #22641

Show file tree
Hide file tree
Changes from 4 commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
769a02a
op.c: Rename 'iterflags' to 'enteriterflags' because it relates to th…
leonerd Oct 2, 2024
a997c99
Define a new OPpITER_INDEXED private flag for OP_ITER
leonerd Oct 2, 2024
e5bece6
Optimise foreach on a list from builtin::indexed @array into two lexi…
leonerd Oct 2, 2024
2f2b892
Declare the XSUB function for builtin::indexed via embed.fnc so that …
leonerd Oct 9, 2024
6ebf91c
Add perldelta
leonerd Oct 28, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions builtin.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -490,9 +490,12 @@ 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)
Comment on lines +493 to +495
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more. 

builtin.c: In function ‘Perl_XS_builtin_indexed’:
builtin.c:495:35: warning: unused parameter ‘cv’ [-Wunused-parameter]
  495 | Perl_XS_builtin_indexed(pTHX_ CV *cv)
      |                               ~~~~^~

Normally suppressed by the attribute in :

#define XSPROTO(name) void name(pTHX_ CV* cv __attribute__unused__)

{
dXSARGS;
PERL_ARGS_ASSERT_XS_BUILTIN_INDEXED;

switch(GIMME_V) {
case G_VOID:
Expand Down Expand Up @@ -638,7 +641,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 }
Expand Down
2 changes: 2 additions & 0 deletions embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4087,6 +4087,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) || \
Expand Down
1 change: 1 addition & 0 deletions embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1202,6 +1202,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)
Expand Down
4 changes: 4 additions & 0 deletions lib/B/Op_private.pm
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

24 changes: 24 additions & 0 deletions lib/builtin.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -347,6 +347,30 @@ package FetchStoreCounter {
is(prototype(\&builtin::indexed), '@', 'indexed prototype');
}

# indexed + foreach loop optimisation appears transparent
tonycoz marked this conversation as resolved.
Show resolved Hide resolved
{
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 );
Expand Down
97 changes: 84 additions & 13 deletions op.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -9661,15 +9694,16 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
OP *iter;
PADOFFSET padoff = 0;
PADOFFSET how_many_more = 0;
I32 iterflags = 0;
I32 iterpflags = 0;
I32 enteriterflags = 0;
I32 enteriterpflags = 0;
U8 iterpflags = 0;
bool parens = 0;

PERL_ARGS_ASSERT_NEWFOROP;

if (sv) {
if (sv->op_type == OP_RV2SV) { /* symbol table variable */
iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
enteriterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
OpTYPE_set(sv, OP_RV2GV);

/* The op_type check is needed to prevent a possible segfault
Expand All @@ -9680,15 +9714,15 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
*/
if (cUNOPx(sv)->op_first->op_type == OP_GV
&& cGVOPx_gv(cUNOPx(sv)->op_first) == PL_defgv)
iterpflags |= OPpITER_DEF;
enteriterpflags |= OPpITER_DEF;
}
else if (sv->op_type == OP_PADSV) { /* private variable */
if (sv->op_flags & OPf_PARENS) {
/* handle degenerate 1-var form of "for my ($x, ...)" */
sv->op_private |= OPpLVAL_INTRO;
parens = 1;
}
iterpflags = sv->op_private & OPpLVAL_INTRO; /* for my $x () */
enteriterpflags = sv->op_private & OPpLVAL_INTRO; /* for my $x () */
padoff = sv->op_targ;
sv->op_targ = 0;
op_free(sv);
Expand All @@ -9704,7 +9738,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
UNOP *padsv;
PADOFFSET i;

iterpflags = OPpLVAL_INTRO; /* for my ($k, $v) () */
enteriterpflags = OPpLVAL_INTRO; /* for my ($k, $v) () */
parens = 1;

if (!pushmark || pushmark->op_type != OP_PUSHMARK) {
Expand Down Expand Up @@ -9762,17 +9796,53 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
const char * const name = PadnamePV(pn);

if (PadnameLEN(pn) == 2 && name[0] == '$' && name[1] == '_')
iterpflags |= OPpITER_DEF;
enteriterpflags |= OPpITER_DEF;
}
}
else {
sv = newGVOP(OP_GV, 0, PL_defgv);
iterpflags |= OPpITER_DEF;
enteriterpflags |= OPpITER_DEF;
}

if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
expr = op_lvalue(op_force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
iterflags |= OPf_STACKED;
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) &&
Expand Down Expand Up @@ -9801,19 +9871,20 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
op_free(expr);
expr = (OP*)(listop);
op_null(expr);
iterflags |= OPf_STACKED;
enteriterflags |= OPf_STACKED;
}
else {
expr_not_special:
expr = op_lvalue(op_force_list(expr), OP_GREPSTART);
}

loop = (LOOP*)op_convert_list(OP_ENTERITER, iterflags,
loop = (LOOP*)op_convert_list(OP_ENTERITER, enteriterflags,
op_append_elem(OP_LIST, list(expr),
scalar(sv)));
assert(!loop->op_next);
/* for my $x () sets OPpLVAL_INTRO;
* for our $x () sets OPpOUR_INTRO */
loop->op_private = (U8)iterpflags;
loop->op_private = (U8)enteriterpflags;

/* upgrade loop from a LISTOP to a LOOPOP;
* keep it in-place if there's space */
Expand All @@ -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);
}
Expand Down
Loading
Loading