diff options
| -rw-r--r-- | dump.c | 6 | ||||
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 2 | ||||
| -rw-r--r-- | op.c | 64 | ||||
| -rw-r--r-- | op.h | 2 | ||||
| -rw-r--r-- | opcode.h | 3 | ||||
| -rw-r--r-- | pp.c | 33 | ||||
| -rw-r--r-- | pp_hot.c | 8 | ||||
| -rw-r--r-- | pp_proto.h | 1 | ||||
| -rw-r--r-- | proto.h | 5 | ||||
| -rwxr-xr-x | regen/opcode.pl | 3 |
12 files changed, 40 insertions, 89 deletions
@@ -943,9 +943,11 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) if (o->op_private & OPpLVAL_DEFER) sv_catpv(tmpsv, ",LVAL_DEFER"); } - else if ((optype == OP_RV2HV || optype == OP_PADHV) - && o->op_private & OpMAYBE_TRUEBOOL) { + else if (optype == OP_RV2HV || optype == OP_PADHV) { + if (o->op_private & OpMAYBE_TRUEBOOL) sv_catpvs(tmpsv, ",OpMAYBE_TRUEBOOL"); + if (o->op_private & OPpTRUEBOOL) + sv_catpvs(tmpsv, ",OPpTRUEBOOL"); } else { if (o->op_private & HINT_STRICT_REFS) @@ -675,7 +675,6 @@ p |OP* |jmaybe |NN OP *o : Used in pp.c pP |I32 |keyword |NN const char *name|I32 len|bool all_keywords #if defined(PERL_IN_OP_C) -s |OP* |opt_scalarhv |NN OP* rep_op s |void |inplace_aassign |NN OP* o #endif Ap |void |leave_scope |I32 base @@ -1426,7 +1426,6 @@ #define no_fh_allowed(a) S_no_fh_allowed(aTHX_ a) #define op_integerize(a) S_op_integerize(aTHX_ a) #define op_std_init(a) S_op_std_init(aTHX_ a) -#define opt_scalarhv(a) S_opt_scalarhv(aTHX_ a) #define pmtrans(a,b,c) S_pmtrans(aTHX_ a,b,c) #define process_special_blocks(a,b,c) S_process_special_blocks(aTHX_ a,b,c) #define ref_array_or_hash(a) S_ref_array_or_hash(aTHX_ a) diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 1b4bd9c0bb..7de36dfe58 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -629,7 +629,7 @@ $priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv", "enteriter"); $priv{$_}{8} = 'LVSUB' for qw(rv2av rv2gv rv2hv padav padhv aelem helem aslice hslice av2arylen keys rkeys substr pos vec); -$priv{$_}{64} = 'BOOL' for 'rv2hv', 'padhv'; +@{$priv{$_}}{32,64} = ('BOOL','BOOL?') for 'rv2hv', 'padhv'; $priv{substr}{16} = 'REPL1ST'; $priv{$_}{16} = "TARGMY" for (map(($_,"s$_"),"chop", "chomp"), @@ -10206,34 +10206,6 @@ Perl_ck_length(pTHX_ OP *o) return o; } -/* caller is supposed to assign the return to the - container of the rep_op var */ -STATIC OP * -S_opt_scalarhv(pTHX_ OP *rep_op) { - dVAR; - UNOP *unop; - - PERL_ARGS_ASSERT_OPT_SCALARHV; - - NewOp(1101, unop, 1, UNOP); - unop->op_type = (OPCODE)OP_BOOLKEYS; - unop->op_ppaddr = PL_ppaddr[OP_BOOLKEYS]; - unop->op_flags = (U8)(OPf_WANT_SCALAR | OPf_KIDS ); - unop->op_private = (U8)(1 | ((OPf_WANT_SCALAR | OPf_KIDS) >> 8)); - unop->op_first = rep_op; - unop->op_next = rep_op->op_next; - rep_op->op_next = (OP*)unop; - rep_op->op_flags|=(OPf_REF | OPf_MOD); - unop->op_sibling = rep_op->op_sibling; - rep_op->op_sibling = NULL; - unop->op_targ = pad_alloc(OP_BOOLKEYS, SVs_PADTMP); - if (rep_op->op_type == OP_PADHV) { - rep_op->op_flags &= ~OPf_WANT_SCALAR; - rep_op->op_flags |= OPf_WANT_LIST; - } - return (OP*)unop; -} - /* Check for in place reverse and sort assignments like "@a = reverse @a" and modify the optree to make them work inplace */ @@ -10524,7 +10496,6 @@ Perl_rpeep(pTHX_ register OP *o) { OP *fop; OP *sop; - bool fopishv, sopishv; case OP_NOT: fop = cUNOP->op_first; @@ -10548,13 +10519,16 @@ Perl_rpeep(pTHX_ register OP *o) o->op_opt = 1; #define HV_OR_SCALARHV(op) \ ( (op)->op_type == OP_PADHV || (op)->op_type == OP_RV2HV \ - || ( (op)->op_type == OP_SCALAR && (op)->op_flags & OPf_KIDS \ + ? (op) \ + : (op)->op_type == OP_SCALAR && (op)->op_flags & OPf_KIDS \ && ( cUNOPx(op)->op_first->op_type == OP_PADHV \ - || cUNOPx(op)->op_first->op_type == OP_RV2HV))) \ + || cUNOPx(op)->op_first->op_type == OP_RV2HV) \ + ? cUNOPx(op)->op_first \ + : NULL) - fopishv = HV_OR_SCALARHV(fop); - sopishv = sop && HV_OR_SCALARHV(sop); - if (fopishv || sopishv + fop = HV_OR_SCALARHV(fop); + if (sop) sop = HV_OR_SCALARHV(sop); + if (fop || sop ){ OP * nop = o; OP * lop = o; @@ -10576,29 +10550,27 @@ Perl_rpeep(pTHX_ register OP *o) } } } - if ( ( (lop->op_flags & OPf_WANT) == OPf_WANT_VOID + if (fop) { + if ( (lop->op_flags & OPf_WANT) == OPf_WANT_VOID || o->op_type == OP_AND ) - && fopishv) - cLOGOP->op_first = opt_scalarhv(fop); - else if (!(lop->op_flags & OPf_WANT)) { - if (fop->op_type == OP_SCALAR) - fop = cUNOPx(fop)->op_first; - fop->op_private |= OpMAYBE_TRUEBOOL; + fop->op_private |= OPpTRUEBOOL; + else if (!(lop->op_flags & OPf_WANT)) + fop->op_private |= OpMAYBE_TRUEBOOL; } if ( (lop->op_flags & OPf_WANT) == OPf_WANT_VOID - && sopishv) - cLOGOP->op_first->op_sibling = opt_scalarhv(sop); + && sop) + sop->op_private |= OPpTRUEBOOL; } break; - } case OP_COND_EXPR: - if (HV_OR_SCALARHV(cLOGOP->op_first)) - cLOGOP->op_first = opt_scalarhv(cLOGOP->op_first); + if ((fop = HV_OR_SCALARHV(cLOGOP->op_first))) + fop->op_private |= OpMAYBE_TRUEBOOL; #undef HV_OR_SCALARHV /* GERONIMO! */ + } case OP_MAPWHILE: case OP_GREPWHILE: @@ -222,6 +222,8 @@ Deprecated. Use C<GIMME_V> instead. OP_R?KEYS, OP_SUBSTR, OP_POS, OP_VEC */ #define OPpMAYBE_LVSUB 8 /* We might be an lvalue to return */ /* OP_RV2HV and OP_PADHV */ +#define OPpTRUEBOOL 32 /* %hash in (%hash || $foo) in + void context */ #define OpMAYBE_TRUEBOOL 64 /* %hash in (%hash || $foo) where cx is not known till run time */ @@ -43,6 +43,7 @@ #define Perl_pp_values Perl_do_kv #define Perl_pp_keys Perl_do_kv #define Perl_pp_rv2hv Perl_pp_rv2av +#define Perl_pp_boolkeys Perl_unimplemented_op #define Perl_pp_pop Perl_pp_shift #define Perl_pp_mapstart Perl_unimplemented_op #define Perl_pp_dor Perl_pp_defined @@ -1069,7 +1070,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_rv2hv, /* implemented by Perl_pp_rv2av */ Perl_pp_helem, Perl_pp_hslice, - Perl_pp_boolkeys, + Perl_pp_boolkeys, /* implemented by Perl_unimplemented_op */ Perl_pp_unpack, Perl_pp_pack, Perl_pp_split, @@ -131,9 +131,11 @@ PP(pp_padhv) if (gimme == G_ARRAY) { RETURNOP(Perl_do_kv(aTHX)); } - else if (PL_op->op_private & OpMAYBE_TRUEBOOL - && block_gimme() == G_VOID) - SETs(boolSV(HvUSEDKEYS(TARG))); + else if ((PL_op->op_private & OPpTRUEBOOL + || ( PL_op->op_private & OpMAYBE_TRUEBOOL + && block_gimme() == G_VOID )) + && (!SvRMAGICAL(TARG) || !mg_find(TARG, PERL_MAGIC_tied))) + SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : sv_2mortal(newSViv(0))); else if (gimme == G_SCALAR) { SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG)); SETs(sv); @@ -281,8 +283,7 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what, } if (!SvOK(sv)) { if ( - PL_op->op_flags & OPf_REF && - PL_op->op_next->op_type != OP_BOOLKEYS + PL_op->op_flags & OPf_REF ) Perl_die(aTHX_ PL_no_usym, what); if (ckWARN(WARN_UNINITIALIZED)) @@ -5721,28 +5722,6 @@ PP(unimplemented_op) DIE(aTHX_ "panic: unimplemented op %s (#%d) called", name, op_type); } -PP(pp_boolkeys) -{ - dVAR; - dSP; - dTARGET; - HV * const hv = (HV*)TOPs; - - if (SvTYPE(hv) != SVt_PVHV) RETSETNO; - - if (SvRMAGICAL(hv)) { - MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied); - if (mg) { - SETs(magic_scalarpack(hv, mg)); - RETURN; - } - } - - if (HvUSEDKEYS(hv) != 0) RETSETYES; - else SETi(0); /* for $ret = %hash && foo() */ - RETURN; -} - /* For sorting out arguments passed to a &CORE:: subroutine */ PP(pp_coreargs) { @@ -873,9 +873,11 @@ PP(pp_rv2av) *PL_stack_sp = sv; return Perl_do_kv(aTHX); } - else if (PL_op->op_private & OpMAYBE_TRUEBOOL - && block_gimme() == G_VOID) - SETs(boolSV(HvUSEDKEYS(sv))); + else if ((PL_op->op_private & OPpTRUEBOOL + || ( PL_op->op_private & OpMAYBE_TRUEBOOL + && block_gimme() == G_VOID )) + && (!SvRMAGICAL(sv) || !mg_find(sv, PERL_MAGIC_tied))) + SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : sv_2mortal(newSViv(0))); else if (gimme == G_SCALAR) { dTARGET; TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv)); diff --git a/pp_proto.h b/pp_proto.h index 52011dadd3..833738d5dd 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -27,7 +27,6 @@ PERL_CALLCONV OP *Perl_pp_binmode(pTHX); PERL_CALLCONV OP *Perl_pp_bit_and(pTHX); PERL_CALLCONV OP *Perl_pp_bit_or(pTHX); PERL_CALLCONV OP *Perl_pp_bless(pTHX); -PERL_CALLCONV OP *Perl_pp_boolkeys(pTHX); PERL_CALLCONV OP *Perl_pp_break(pTHX); PERL_CALLCONV OP *Perl_pp_caller(pTHX); PERL_CALLCONV OP *Perl_pp_chdir(pTHX); @@ -5894,11 +5894,6 @@ PERL_STATIC_INLINE OP* S_op_std_init(pTHX_ OP *o) #define PERL_ARGS_ASSERT_OP_STD_INIT \ assert(o) -STATIC OP* S_opt_scalarhv(pTHX_ OP* rep_op) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_OPT_SCALARHV \ - assert(rep_op) - STATIC OP* S_pmtrans(pTHX_ OP* o, OP* expr, OP* repl) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) diff --git a/regen/opcode.pl b/regen/opcode.pl index 2ef64ec59d..a776582407 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -67,7 +67,8 @@ my %alias; # Format is "this function" => "does these op names" my @raw_alias = ( Perl_do_kv => [qw( keys values )], - Perl_unimplemented_op => [qw(padany mapstart custom)], + Perl_unimplemented_op => [qw(padany mapstart custom + boolkeys)], # All the ops with a body of { return NORMAL; } Perl_pp_null => [qw(scalar regcmaybe lineseq scope)], |