PP(pp_substr)
{
    dSP; dTARGET;
    SV *sv;
    STRLEN curlen;
    STRLEN utf8_curlen;
    SV *   pos_sv;
    IV     pos1_iv;
    int    pos1_is_uv;
    SV *   len_sv;
    IV     len_iv = 0;
    int    len_is_uv = 0;
    I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
    const bool rvalue = (GIMME_V != G_VOID);
    const char *tmps;
    SV *repl_sv = NULL;
    const char *repl = NULL;
    STRLEN repl_len;
    int num_args = PL_op->op_private & 7;
    bool repl_need_utf8_upgrade = FALSE;

    if (num_args > 2) {
	if (num_args > 3) {
	  if(!(repl_sv = POPs)) num_args--;
	}
	if ((len_sv = POPs)) {
	    len_iv    = SvIV(len_sv);
	    len_is_uv = len_iv ? SvIOK_UV(len_sv) : 1;
	}
	else num_args--;
    }
    pos_sv     = POPs;
    pos1_iv    = SvIV(pos_sv);
    pos1_is_uv = SvIOK_UV(pos_sv);
    sv = POPs;
    if (PL_op->op_private & OPpSUBSTR_REPL_FIRST) {
	assert(!repl_sv);
	repl_sv = POPs;
    }
    if (lvalue && !repl_sv) {
	SV * ret;
	ret = sv_2mortal(newSV_type(SVt_PVLV));  /* Not TARG RT#67838 */
	sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0);
	LvTYPE(ret) = 'x';
	LvTARG(ret) = SvREFCNT_inc_simple(sv);
	LvTARGOFF(ret) =
	    pos1_is_uv || pos1_iv >= 0
		? (STRLEN)(UV)pos1_iv
		: (LvFLAGS(ret) |= 1, (STRLEN)(UV)-pos1_iv);
	LvTARGLEN(ret) =
	    len_is_uv || len_iv > 0
		? (STRLEN)(UV)len_iv
		: (LvFLAGS(ret) |= 2, (STRLEN)(UV)-len_iv);

	PUSHs(ret);    /* avoid SvSETMAGIC here */
	RETURN;
    }
    if (repl_sv) {
	repl = SvPV_const(repl_sv, repl_len);
	SvGETMAGIC(sv);
	if (SvROK(sv))
	    Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
			    "Attempt to use reference as lvalue in substr"
	    );
	tmps = SvPV_force_nomg(sv, curlen);
	if (DO_UTF8(repl_sv) && repl_len) {
	    if (!DO_UTF8(sv)) {
		sv_utf8_upgrade_nomg(sv);
		curlen = SvCUR(sv);
	    }
	}
	else if (DO_UTF8(sv))
	    repl_need_utf8_upgrade = TRUE;
    }
    else tmps = SvPV_const(sv, curlen);
    if (DO_UTF8(sv)) {
        utf8_curlen = sv_or_pv_len_utf8(sv, tmps, curlen);
	if (utf8_curlen == curlen)
	    utf8_curlen = 0;
	else
	    curlen = utf8_curlen;
    }
    else
	utf8_curlen = 0;

    {
	STRLEN pos, len, byte_len, byte_pos;

	if (!translate_substr_offsets(
		curlen, pos1_iv, pos1_is_uv, len_iv, len_is_uv, &pos, &len
	)) goto bound_fail;

	byte_len = len;
	byte_pos = utf8_curlen
	    ? sv_or_pv_pos_u2b(sv, tmps, pos, &byte_len) : pos;

	tmps += byte_pos;

	if (rvalue) {
	    SvTAINTED_off(TARG);			/* decontaminate */
	    SvUTF8_off(TARG);			/* decontaminate */
	    sv_setpvn(TARG, tmps, byte_len);
#ifdef USE_LOCALE_COLLATE
	    sv_unmagic(TARG, PERL_MAGIC_collxfrm);
#endif
	    if (utf8_curlen)
		SvUTF8_on(TARG);
	}

	if (repl) {
	    SV* repl_sv_copy = NULL;

	    if (repl_need_utf8_upgrade) {
		repl_sv_copy = newSVsv(repl_sv);
		sv_utf8_upgrade(repl_sv_copy);
		repl = SvPV_const(repl_sv_copy, repl_len);
	    }
	    if (!SvOK(sv))
                SvPVCLEAR(sv);
	    sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
	    SvREFCNT_dec(repl_sv_copy);
	}
    }
    if (PL_op->op_private & OPpSUBSTR_REPL_FIRST)
	SP++;
    else if (rvalue) {
	SvSETMAGIC(TARG);
	PUSHs(TARG);
    }
    RETURN;

  bound_fail:
    if (repl)
	Perl_croak(aTHX_ "substr outside of string");
    Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
    RETPUSHUNDEF;
}