+static void
+S_localise_aelem_lval(pTHX_ AV * const av, SV * const keysv,
+ const bool can_preserve)
+{
+ const SSize_t ix = SvIV(keysv);
+ if (can_preserve ? av_exists(av, ix) : TRUE) {
+ SV ** const svp = av_fetch(av, ix, 1);
+ if (!svp || !*svp)
+ Perl_croak(aTHX_ PL_no_aelem, ix);
+ save_aelem(av, ix, svp);
+ }
+ else
+ SAVEADELETE(av, ix);
+}
+
+static void
+S_localise_helem_lval(pTHX_ HV * const hv, SV * const keysv,
+ const bool can_preserve)
+{
+ if (can_preserve ? hv_exists_ent(hv, keysv, 0) : TRUE) {
+ HE * const he = hv_fetch_ent(hv, keysv, 1, 0);
+ SV ** const svp = he ? &HeVAL(he) : NULL;
+ if (!svp || !*svp)
+ Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(keysv));
+ save_helem_flags(hv, keysv, svp, 0);
+ }
+ else
+ SAVEHDELETE(hv, keysv);
+}
+
+static void
+S_localise_gv_slot(pTHX_ GV *gv, U8 type)
+{
+ if (type == OPpLVREF_SV) {
+ save_pushptrptr(gv, SvREFCNT_inc_simple(GvSV(gv)), SAVEt_GVSV);
+ GvSV(gv) = 0;
+ }
+ else if (type == OPpLVREF_AV)
+ /* XXX Inefficient, as it creates a new AV, which we are
+ about to clobber. */
+ save_ary(gv);
+ else {
+ assert(type == OPpLVREF_HV);
+ /* XXX Likewise inefficient. */
+ save_hash(gv);
+ }
+}
+
+
+PP(pp_refassign)
+{
+ dSP;
+ SV * const key = PL_op->op_private & OPpLVREF_ELEM ? POPs : NULL;
+ SV * const left = PL_op->op_flags & OPf_STACKED ? POPs : NULL;
+ dTOPss;
+ const char *bad = NULL;
+ const U8 type = PL_op->op_private & OPpLVREF_TYPE;
+ if (!SvROK(sv)) DIE(aTHX_ "Assigned value is not a reference");
+ switch (type) {
+ case OPpLVREF_SV:
+ if (SvTYPE(SvRV(sv)) > SVt_PVLV)
+ bad = " SCALAR";
+ break;
+ case OPpLVREF_AV:
+ if (SvTYPE(SvRV(sv)) != SVt_PVAV)
+ bad = "n ARRAY";
+ break;
+ case OPpLVREF_HV:
+ if (SvTYPE(SvRV(sv)) != SVt_PVHV)
+ bad = " HASH";
+ break;
+ case OPpLVREF_CV:
+ if (SvTYPE(SvRV(sv)) != SVt_PVCV)
+ bad = " CODE";
+ }
+ if (bad)
+ /* diag_listed_as: Assigned value is not %s reference */
+ DIE(aTHX_ "Assigned value is not a%s reference", bad);
+ switch (left ? SvTYPE(left) : 0) {
+ MAGIC *mg;
+ HV *stash;
+ case 0:
+ {
+ SV * const old = PAD_SV(ARGTARG);
+ PAD_SETSV(ARGTARG, SvREFCNT_inc_NN(SvRV(sv)));
+ SvREFCNT_dec(old);
+ if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE))
+ == OPpLVAL_INTRO)
+ SAVECLEARSV(PAD_SVl(ARGTARG));
+ break;
+ }
+ case SVt_PVGV:
+ if (PL_op->op_private & OPpLVAL_INTRO) {
+ S_localise_gv_slot(aTHX_ (GV *)left, type);
+ }
+ gv_setref(left, sv);
+ SvSETMAGIC(left);
+ break;
+ case SVt_PVAV:
+ if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
+ S_localise_aelem_lval(aTHX_ (AV *)left, key,
+ SvCANEXISTDELETE(left));
+ }
+ av_store((AV *)left, SvIV(key), SvREFCNT_inc_simple_NN(SvRV(sv)));
+ break;
+ case SVt_PVHV:
+ if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO))
+ S_localise_helem_lval(aTHX_ (HV *)left, key,
+ SvCANEXISTDELETE(left));
+ (void)hv_store_ent((HV *)left, key, SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
+ }
+ if (PL_op->op_flags & OPf_MOD)
+ SETs(sv_2mortal(newSVsv(sv)));
+ /* XXX else can weak references go stale before they are read, e.g.,
+ in leavesub? */
+ RETURN;
+}
+
+PP(pp_lvref)
+{
+ dSP;
+ SV * const ret = sv_2mortal(newSV_type(SVt_PVMG));
+ SV * const elem = PL_op->op_private & OPpLVREF_ELEM ? POPs : NULL;
+ SV * const arg = PL_op->op_flags & OPf_STACKED ? POPs : NULL;
+ MAGIC * const mg = sv_magicext(ret, arg, PERL_MAGIC_lvref,
+ &PL_vtbl_lvref, (char *)elem,
+ elem ? HEf_SVKEY : (I32)ARGTARG);
+ mg->mg_private = PL_op->op_private;
+ if (PL_op->op_private & OPpLVREF_ITER)
+ mg->mg_flags |= MGf_PERSIST;
+ if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
+ if (elem) {
+ MAGIC *mg;
+ HV *stash;
+ const bool can_preserve = SvCANEXISTDELETE(arg);
+ if (SvTYPE(arg) == SVt_PVAV)
+ S_localise_aelem_lval(aTHX_ (AV *)arg, elem, can_preserve);
+ else
+ S_localise_helem_lval(aTHX_ (HV *)arg, elem, can_preserve);
+ }
+ else if (arg) {
+ S_localise_gv_slot(aTHX_ (GV *)arg,
+ PL_op->op_private & OPpLVREF_TYPE);
+ }
+ else if (!(PL_op->op_private & OPpPAD_STATE))
+ SAVECLEARSV(PAD_SVl(ARGTARG));
+ }
+ XPUSHs(ret);
+ RETURN;
+}
+
+PP(pp_lvrefslice)
+{
+ dSP; dMARK;
+ AV * const av = (AV *)POPs;
+ const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+ bool can_preserve = FALSE;
+
+ if (UNLIKELY(localizing)) {
+ MAGIC *mg;
+ HV *stash;
+ SV **svp;
+
+ can_preserve = SvCANEXISTDELETE(av);
+
+ if (SvTYPE(av) == SVt_PVAV) {
+ SSize_t max = -1;
+
+ for (svp = MARK + 1; svp <= SP; svp++) {
+ const SSize_t elem = SvIV(*svp);
+ if (elem > max)
+ max = elem;
+ }
+ if (max > AvMAX(av))
+ av_extend(av, max);
+ }
+ }
+
+ while (++MARK <= SP) {
+ SV * const elemsv = *MARK;
+ if (SvTYPE(av) == SVt_PVAV)
+ S_localise_aelem_lval(aTHX_ av, elemsv, can_preserve);
+ else
+ S_localise_helem_lval(aTHX_ (HV *)av, elemsv, can_preserve);
+ *MARK = sv_2mortal(newSV_type(SVt_PVMG));
+ sv_magic(*MARK,(SV *)av,PERL_MAGIC_lvref,(char *)elemsv,HEf_SVKEY);
+ }
+ RETURN;
+}
+
+PP(pp_lvavref)
+{
+ if (PL_op->op_flags & OPf_STACKED)
+ Perl_pp_rv2av(aTHX);
+ else
+ Perl_pp_padav(aTHX);
+ {
+ dSP;
+ dTOPss;
+ SETs(0); /* special alias marker that aassign recognises */
+ XPUSHs(sv);
+ RETURN;
+ }
+}