@@ -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 }
0 commit comments