Skip to content
This repository was archived by the owner on Jun 1, 2023. It is now read-only.

Commit 013b8b5

Browse files
author
Reini Urban
committed
mderef_u: implement loop oob elimination
uncheck out-of-bounds for multideref access in loops also, not only aelem_u and aelemfast_lex_u. this is pretty common for exists, delete and assign ops. now mderef uoob (unchecked out-of-bounds) indices can have all 3 types: const, padsv, gvsv for the very first index. add 2 helper functions: S_mderef_noob_gv,S_mderef_noob_targ to set the noob flag if the index matches. (only for the first) Bump B VERSION to 1.62_03.
1 parent a792ee8 commit 013b8b5

File tree

10 files changed

+136
-66
lines changed

10 files changed

+136
-66
lines changed

dist/Module-CoreList/lib/Module/CoreList.pm

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12759,6 +12759,7 @@ for my $version ( sort { version_sort($a, $b) } keys %released ) {
1275912759
'Module::CoreList' => '5.20160730c',
1276012760
'Module::CoreList::TieHashDelta'=> '5.20160618',
1276112761
'Module::CoreList::Utils'=> '5.20160730c',
12762+
'B' => '1.62_03',
1276212763
},
1276312764
removed => {
1276412765
}

dump.c

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2506,6 +2506,8 @@ Perl_multideref_stringify(pTHX_ const OP *o, CV *cv)
25062506
S_append_gv_name(aTHX_ (GV*)sv, out);
25072507
break;
25082508
}
2509+
if (actions & MDEREF_INDEX_uoob)
2510+
Perl_sv_catpvf(aTHX_ out, " _u");
25092511
sv_catpvn_nomg(out, (is_hash ? "}" : "]"), 1);
25102512

25112513
if (actions & MDEREF_FLAG_last)

ext/B/B.pm

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
#
88
package B;
99

10-
$B::VERSION = '1.62_02';
10+
$B::VERSION = '1.62_03';
1111

1212
require XSLoader;
1313
require Exporter;

ext/B/B.xs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1470,7 +1470,6 @@ aux_list(o)
14701470
case MDEREF_INDEX_none:
14711471
last = 1;
14721472
break;
1473-
case MDEREF_INDEX_const|MDEREF_INDEX_uoob:
14741473
case MDEREF_INDEX_const:
14751474
if (is_hash)
14761475
PUSH_SV(++items);

op.c

Lines changed: 107 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -14249,10 +14249,14 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1424914249
&& !(o->op_flags & (OPf_REF|OPf_MOD))
1425014250
&& o->op_private == 0)
1425114251
{
14252-
if (PASS2)
14252+
index_type = MDEREF_INDEX_padsv;
14253+
if (PASS2) {
1425314254
arg->pad_offset = o->op_targ;
14255+
/* you can get here via loop oob elimination */
14256+
if (o->op_next->op_type == OP_AELEM_U)
14257+
index_type |= MDEREF_INDEX_uoob;
14258+
}
1425414259
arg++;
14255-
index_type = MDEREF_INDEX_padsv;
1425614260
o = o->op_next;
1425714261
}
1425814262
break;
@@ -14316,7 +14320,9 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1431614320
index_type = MDEREF_INDEX_const;
1431714321
if (PASS2) {
1431814322
OP *aelem_op = o->op_next;
14319-
if (aelem_op->op_type == OP_AELEM) {
14323+
if (aelem_op->op_type == OP_AELEM_U) {
14324+
index_type |= MDEREF_INDEX_uoob;
14325+
} else if (aelem_op->op_type == OP_AELEM) {
1432014326
PADOFFSET targ = (((BINOP*)aelem_op)->op_first)->op_targ;
1432114327
SV* av; /* targ may still be empty here */
1432214328
if (targ && (av = PAD_SV(targ)) && AvSHAPED(av)) {
@@ -14411,11 +14417,11 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1441114417

1441214418
/* if something like arybase (a.k.a $[ ) is in scope,
1441314419
* abandon optimisation attempt */
14414-
if ( o->op_type == OP_AELEM && PL_check[o->op_type] != Perl_ck_aelem)
14420+
if (o->op_type == OP_AELEM && PL_check[o->op_type] != Perl_ck_aelem)
1441514421
return;
1441614422

1441714423
/* skip aelemfast if private cannot hold all bits */
14418-
if ( o->op_type != OP_AELEM
14424+
if ( (o->op_type != OP_AELEM && o->op_type != OP_AELEM_U)
1441914425
|| (o->op_private &
1442014426
(OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)))
1442114427
maybe_aelemfast = FALSE;
@@ -14428,14 +14434,15 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1442814434
*/
1442914435

1443014436
if ( index_type == MDEREF_INDEX_none
14431-
|| ( o->op_type != OP_AELEM && o->op_type != OP_HELEM
14437+
|| ( o->op_type != OP_AELEM && o->op_type != OP_AELEM_U
14438+
&& o->op_type != OP_HELEM
1443214439
&& o->op_type != OP_EXISTS && o->op_type != OP_DELETE)
1443314440
)
1443414441
ok = FALSE;
1443514442
else {
1443614443
/* we have aelem/helem/exists/delete with valid simple index */
1443714444

14438-
is_deref = (o->op_type == OP_AELEM || o->op_type == OP_HELEM)
14445+
is_deref = (o->op_type == OP_AELEM || o->op_type == OP_AELEM_U || o->op_type == OP_HELEM)
1443914446
&& ( (o->op_private & OPpDEREF) == OPpDEREF_AV
1444014447
|| (o->op_private & OPpDEREF) == OPpDEREF_HV);
1444114448

@@ -14467,12 +14474,14 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1446714474
ok = (ok && cBOOL(o->op_flags & OPf_SPECIAL));
1446814475
}
1446914476
else {
14470-
ASSUME(o->op_type == OP_AELEM || o->op_type == OP_HELEM);
14477+
ASSUME(o->op_type == OP_AELEM || o->op_type == OP_AELEM_U || o->op_type == OP_HELEM);
1447114478
ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_MOD
1447214479
|OPf_PARENS|OPf_REF|OPf_SPECIAL)));
1447314480
ASSUME(!(o->op_private & ~(OPpARG2_MASK|OPpMAYBE_LVSUB
1447414481
|OPpLVAL_DEFER|OPpDEREF|OPpLVAL_INTRO)));
1447514482
ok = (o->op_private & OPpDEREF) != OPpDEREF_SV;
14483+
if (PASS2 && o->op_type == OP_AELEM_U)
14484+
action |= MDEREF_INDEX_uoob;
1447614485
}
1447714486
}
1447814487

@@ -14501,8 +14510,11 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1450114510
* but stop at that point. So $a[0][expr] will do one
1450214511
* av_fetch, vivify and deref, then continue executing at
1450314512
* expr */
14504-
if (!action_count)
14513+
if (!action_count) {
14514+
DEBUG_kv(Perl_deb(aTHX_ "no multideref: %s %s\n",
14515+
OP_NAME(start), OP_NAME(o)));
1450514516
return;
14517+
}
1450614518
is_last = TRUE;
1450714519
index_skip = action_count;
1450814520
action |= MDEREF_FLAG_last;
@@ -14524,7 +14536,6 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1452414536
} /* while !is_last */
1452514537

1452614538
/* success! */
14527-
1452814539
if (PASS2) {
1452914540
OP *mderef;
1453014541
OP *p, *q;
@@ -14702,8 +14713,10 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1470214713
else {
1470314714
Size_t size = arg - arg_buf;
1470414715

14705-
if (maybe_aelemfast && action_count == 1)
14716+
if (maybe_aelemfast && action_count == 1) {
14717+
DEBUG_kv(Perl_deb(aTHX_ "no multideref %s = > aelemfast\n", OP_NAME(start)));
1470614718
return;
14719+
}
1470714720

1470814721
arg_buf = (UNOP_AUX_item*)PerlMemShared_malloc(
1470914722
sizeof(UNOP_AUX_item) * (size + 1));
@@ -14713,9 +14726,56 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
1471314726
arg_buf++;
1471414727
}
1471514728
} /* for (pass = ...) */
14729+
DEBUG_kv(Perl_deb(aTHX_ "=> multideref %s %s\n", PL_op_name[start->op_targ],
14730+
SvPVX(multideref_stringify(start->op_next, NULL))));
1471614731
#undef PASS2
1471714732
}
1471814733

14734+
/* check the targ of the first INDEX_padsv of a MDEREF_AV,
14735+
compare it with the given targ,
14736+
and set INDEX_uoob. */
14737+
STATIC bool
14738+
S_mderef_uoob_targ(OP* o, PADOFFSET targ)
14739+
{
14740+
UNOP_AUX_item *items = cUNOP_AUXx(o)->op_aux;
14741+
UV actions = items->uv;
14742+
/* the pad action must be the first */
14743+
int action = actions & MDEREF_ACTION_MASK;
14744+
assert(action);
14745+
if ( (action == MDEREF_AV_padav_aelem
14746+
|| action == MDEREF_AV_padsv_vivify_rv2av_aelem)
14747+
&& ((actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_padsv)
14748+
&& items->pad_offset == targ)
14749+
{
14750+
actions |= MDEREF_INDEX_uoob;
14751+
return TRUE;
14752+
}
14753+
return FALSE;
14754+
}
14755+
14756+
/* check the key index sv of the first INDEX_gvsv of a MDEREF_AV,
14757+
compare it with the given key,
14758+
and set INDEX_uoob. */
14759+
STATIC bool
14760+
S_mderef_uoob_gv(pTHX_ OP* o, SV* idx)
14761+
{
14762+
UNOP_AUX_item *items = cUNOP_AUXx(o)->op_aux;
14763+
UV actions = items->uv;
14764+
/* the gvsv action must be the first */
14765+
int action = actions & MDEREF_ACTION_MASK;
14766+
assert(actions);
14767+
if ( (action == MDEREF_AV_gvav_aelem
14768+
|| action == MDEREF_AV_gvsv_vivify_rv2av_aelem)
14769+
&& ((actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_gvsv)
14770+
&& UNOP_AUX_item_sv(items) == idx)
14771+
{
14772+
actions |= MDEREF_INDEX_uoob;
14773+
return TRUE;
14774+
}
14775+
return FALSE;
14776+
}
14777+
14778+
1471914779
/* returns the next non-null op */
1472014780

1472114781
/* mechanism for deferring recursion in rpeep() */
@@ -15160,6 +15220,7 @@ Perl_rpeep(pTHX_ OP *o)
1516015220
/* TODO easy with op_clone_oplist from feature/CM-707-cperl-inline-subs */
1516115221
}
1516215222

15223+
/* for (0..$#a) { ... $a[$_] ...} */
1516315224
if (OP_TYPE_IS(to, OP_AV2ARYLEN)) {
1516415225
OP *kid = cUNOPx(to)->op_first;
1516515226
OP *loop, *iter, *body, *o2;
@@ -15181,11 +15242,11 @@ Perl_rpeep(pTHX_ OP *o)
1518115242
iname = PAD_COMPNAME_PV(loop->op_targ);
1518215243
#endif
1518315244
} else {
15184-
OP* rv2gv = cLOOPx(loop)->op_last;
15185-
if (rv2gv->op_type == OP_RV2GV) {
15186-
kid = cUNOPx(rv2gv)->op_first;
15187-
if (kid->op_type == OP_GV) {
15188-
idx = kSVOP_sv; /* PVGV or PADOFFSET */
15245+
o2 = cLOOPx(loop)->op_last;
15246+
if (o2->op_type == OP_RV2GV) {
15247+
o2 = cUNOPx(o2)->op_first;
15248+
if (o2->op_type == OP_GV) {
15249+
idx = cSVOPx_sv(o2); /* PVGV or PADOFFSET */
1518915250
#if defined(DEBUGGING)
1519015251
# ifdef USE_ITHREADS
1519115252
iname = GvNAME_get(PAD_SV((PADOFFSET)idx));
@@ -15204,53 +15265,52 @@ Perl_rpeep(pTHX_ OP *o)
1520415265
this loop body, if the index is the loop counter */
1520515266
for (o2=body; o2!=iter; o2=o2->op_next) {
1520615267
const OPCODE type = o2->op_type;
15268+
/*DEBUG_kv(Perl_deb(aTHX_ "rpeep: loop oob %s\n", OP_NAME(o2)));*/
15269+
DEBUG_kv(
15270+
if (type == OP_AELEM && OP_TYPE_IS(cUNOPx(o2)->op_first, OP_PADAV))
15271+
Perl_deb(aTHX_ "rpeep: aelem %s vs %s\n",
15272+
aname, PAD_COMPNAME_PV(cUNOPx(o2)->op_first->op_targ)));
1520715273
/* here aelem might not be already optimized to multideref.
15208-
aelem_u is faster. */
15209-
if (type == OP_AELEM && OP_TYPE_IS(cUNOPx(o2)->op_first, OP_PADAV)
15210-
&& strEQ(aname, PAD_COMPNAME_PV(cUNOPx(o2)->op_first->op_targ))
15274+
aelem_u is faster, but does no deref so far. */
15275+
if (type == OP_AELEM
15276+
&& OP_TYPE_IS(cUNOPx(o2)->op_first, OP_PADAV)
15277+
&& kid->op_targ == cUNOPx(o2)->op_first->op_targ /* same lex array */
1521115278
&& !(o2->op_private & (OPpLVAL_DEFER|OPpLVAL_INTRO|OPpDEREF))) {
15212-
/* check index */
15279+
/* same lex. index */
1521315280
if (o2->op_targ && o2->op_targ == loop->op_targ) {
1521415281
DEBUG_k(Perl_deb(aTHX_ "loop oob: aelem %s[my %s] => aelem_u\n",
1521515282
aname, iname));
1521615283
OpTYPE_set(o2, OP_AELEM_U);
15217-
} else if (!o2->op_targ && idx) {
15284+
} else if (!o2->op_targ && idx) { /* or same gv index */
1521815285
OP* ixop = cBINOPx(o2)->op_last;
15219-
if ((OP_TYPE_IS(ixop, OP_RV2SV)
15220-
&& idx == cSVOPx(cUNOPx(ixop)->op_first)->op_sv)) {
15286+
if (OP_TYPE_IS(ixop, OP_RV2SV)
15287+
&& idx == cSVOPx_sv(cUNOPx(ixop)->op_first)) {
1522115288
DEBUG_k(Perl_deb(aTHX_ "loop oob: aelem %s[$%s] => aelem_u\n",
1522215289
aname, iname));
1522315290
OpTYPE_set(o2, OP_AELEM_U);
1522415291
}
1522515292
}
15226-
#ifdef DEBUGGING
15227-
} else if (type == OP_MULTIDEREF && o2->op_targ
15228-
&& strEQ(aname, PAD_COMPNAME_PV(o2->op_targ))) {
15229-
DEBUG_k(Perl_deb(aTHX_ "nyi multideref[%s] => MDEREF_INDEX_uoob\n",
15230-
aname));
15231-
/* TODO: find this padsv item (the first)
15232-
and set MDEREF_INDEX_uoob */
15233-
} else if (type == OP_AELEMFAST && SvPOK(kSVOP_sv)
15234-
&& strEQ(aname, SvPVX(kSVOP_sv))) {
15235-
/* TODO no magic in array allowed, array must be typed */
15236-
if (o2->op_targ && o2->op_targ == loop->op_targ) {
15237-
DEBUG_k(Perl_deb(aTHX_ "loop oob: aelemfast %s[my %s] => aelemfast_lex_u\n",
15293+
} else if (type == OP_MULTIDEREF) {
15294+
/* find this padsv item (the first) and set MDEREF_INDEX_uoob */
15295+
if (loop->op_targ && S_mderef_uoob_targ(o2, loop->op_targ)) {
15296+
DEBUG_k(Perl_deb(aTHX_ "loop oob: multideref %s[my %s] => MDEREF_INDEX_uoob\n",
15297+
aname, iname));
15298+
} else if (!loop->op_targ
15299+
&& S_mderef_uoob_gv(aTHX_ o2, idx)) {
15300+
DEBUG_k(Perl_deb(aTHX_ "loop oob: multideref %s[$%s] => MDEREF_INDEX_uoob\n",
1523815301
aname, iname));
15239-
OpTYPE_set(o2, OP_AELEMFAST_LEX_U);
1524015302
}
15303+
}
1524115304
#if 0
15242-
else if (!o2->op_targ && idx) {
15243-
OP* ixop = cBINOPx(o2)->op_last;
15244-
if ((OP_TYPE_IS(ixop, OP_RV2SV)
15245-
&& idx == cSVOPx(cUNOPx(ixop)->op_first)->op_sv)) {
15246-
DEBUG_k(Perl_deb(aTHX_ "loop oob: aelemfast %s[$%s] => aelemfast_u\n",
15247-
aname, iname));
15248-
OpTYPE_set(o2, OP_AELEMFAST_U);
15249-
}
15250-
}
15251-
#endif
15252-
#endif
15305+
else if (type == OP_AELEMFAST_LEX
15306+
/* same array */
15307+
&& o2->op_targ && o2->op_targ == loop->op_targ) {
15308+
/* constant index cannot exceed shape. */
15309+
DEBUG_k(Perl_deb(aTHX_ "loop oob: aelemfast_lex %s[%s] => aelemfast_lex_u\n",
15310+
aname, iname));
15311+
OpTYPE_set(o2, OP_AELEMFAST_LEX_U);
1525315312
}
15313+
#endif
1525415314
}
1525515315
break;
1525615316
}

op.h

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1043,12 +1043,12 @@ C<sib> is non-null. For a higher-level interface, see C<L</op_sibling_splice>>.
10431043
#define MDEREF_INDEX_const 0x10 /* index is const PV/UV */
10441044
#define MDEREF_INDEX_padsv 0x20 /* index is lexical var */
10451045
#define MDEREF_INDEX_gvsv 0x30 /* index is GV */
1046-
#define MDEREF_INDEX_uoob 0x40 /* index needs no out-of-bounds check */
10471046

1048-
#define MDEREF_INDEX_MASK 0x70
1047+
#define MDEREF_INDEX_MASK (MDEREF_INDEX_const|MDEREF_INDEX_padsv|MDEREF_INDEX_gvsv)
10491048

10501049
/* bit flags */
10511050

1051+
#define MDEREF_INDEX_uoob 0x40 /* index needs no out-of-bounds check */
10521052
#define MDEREF_FLAG_last 0x80 /* the last [ah]elem; PL_op flags apply */
10531053

10541054
#define MDEREF_MASK 0x10F

pod/perlcdelta.pod

Lines changed: 13 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -35,17 +35,19 @@ L</Selected Bug Fixes> section.
3535

3636
=item *
3737

38-
The C<multideref> OP has a new C<MDEREF_INDEX_uoob> flag, which can
39-
only appear together with C<MDEREF_INDEX_const>. This is used for
40-
unchecked out-of-bounds checks for arrays, to use the previous
41-
AvSHAPED array optimizations with multideref OPs also.
42-
43-
But multideref ops in loops are not yet compiled to use
44-
C<MDEREF_INDEX_uoob> when the index is ensured to be inside the
45-
array. This oob optimization is expected soon.
46-
47-
C<MDEREF_INDEX_MASK> changed to 0x70, C<MDEREF_MASK> to 0x10F, the
48-
C<MDEREF_SHIFT> size from 7 to 8.
38+
The C<multideref> OP has a new C<MDEREF_INDEX_uoob> flag. This is
39+
used for unchecked out-of-bounds checks for arrays, to use the
40+
previous AvSHAPED array optimizations (aelem_u, aelemfast_lex_u) or
41+
loop out-of-bounds elimination with multideref OPs also. Such
42+
multideref ops appear pretty often even with single indices. E.g. in
43+
C<my @b=(0..4); for (0..$#b) { $b[$_] = 0; }> C<$b[$_]> is converted
44+
to a multideref, which previously was not optimized.
45+
46+
Those optimized indices are marked with a new " _u" suffix in the dumped
47+
multideref stringification.
48+
49+
C<MDEREF_MASK> changed to 0x10F, the C<MDEREF_SHIFT> size from 7 to 8.
50+
The shift can also use faster intrinsics now.
4951

5052
=item *
5153

pp_hot.c

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2418,7 +2418,6 @@ PP(pp_multideref)
24182418
switch (actions & MDEREF_INDEX_MASK) {
24192419
case MDEREF_INDEX_none:
24202420
goto finish;
2421-
case MDEREF_INDEX_const|MDEREF_INDEX_uoob:
24222421
case MDEREF_INDEX_const:
24232422
elem = (++items)->iv;
24242423
break;
@@ -2452,6 +2451,7 @@ PP(pp_multideref)
24522451
if (!(actions & MDEREF_FLAG_last)) {
24532452
if (UNLIKELY((actions & MDEREF_INDEX_uoob) && !SvRMAGICAL(sv))) {
24542453
SV* av = sv;
2454+
DEBUG_kv(Perl_deb(aTHX_ "mderef oob [%ld]\n", elem));
24552455
sv = AvARRAY(av)[elem];
24562456
if (!sv) { /* always lval */
24572457
AvARRAY(av)[elem] = sv = newSV(0);

t/op/aelem_u.t

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -74,16 +74,22 @@ is($a[3][0], 2, "negative multi mderef_u");
7474
eval '$a[5][1];';
7575
like ($@, qr/^Array index out of bounds \@a\[5\]/, "compile-time mderef oob");
7676

77-
# eliminating loop out-of-bounds:
77+
# eliminating loop out-of-bounds checks.
78+
# how to test this? via dump/-Dt?
7879
my @b = (0..4);
7980
for (0..$#b) { $b[$_] }; # _u
8081
for (0..$#b) { $a[$_] }; # wrong array
8182
for my $i (0..$#b) { $b[$i] }; # _u
8283
my $j = 0;
8384
for my $i (0..$#b) { $b[$j] }; # wrong index: lex
84-
for my $our (0..$#b) { $b[$i] }; # _u
85+
for my $our (0..$#b) { $b[$i] }; # wrong index: lex
8586
for (0..$#b) { $b[$_+1] }; # wrong index: expr
8687
{ no strict;
8788
for $k (0..$#b) { $b[$k] }; # _u
8889
for $k (0..$#b) { $b[$j] }; # wrong index: glob
8990
}
91+
92+
for (0..$#b) { $b[$_] = 0; } # mderef_u gvsv
93+
for my $i (0..$#b) { $b[$i] = 0; } # mderef_u padsv
94+
95+
for (0..$#a) { $a[$_] }; # shaped + mderef_u

0 commit comments

Comments
 (0)