PP(pp_substr)
{
    dVAR; dSP; dTARGET;
    SV *sv;
    STRLEN curlen;
    STRLEN utf8_curlen;
    SV *   pos_sv;
    IV     pos1_iv;
    int    pos1_is_uv;
    IV     pos2_iv;
    int    pos2_is_uv;
    SV *   len_sv;
    IV     len_iv = 0;
    int    len_is_uv = 1;
    const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
    const char *tmps;
    const IV arybase = CopARYBASE_get(PL_curcop);
    SV *repl_sv = NULL;
    const char *repl = NULL;
    STRLEN repl_len;
    const int num_args = PL_op->op_private & 7;
    bool repl_need_utf8_upgrade = FALSE;
    bool repl_is_utf8 = FALSE;

    SvTAINTED_off(TARG);			/* decontaminate */
    SvUTF8_off(TARG);				/* decontaminate */
    if (num_args > 2) {
	if (num_args > 3) {
	    repl_sv = POPs;
	    repl = SvPV_const(repl_sv, repl_len);
	    repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
	}
	len_sv    = POPs;
	len_iv    = SvIV(len_sv);
	len_is_uv = SvIOK_UV(len_sv);
    }
    pos_sv     = POPs;
    pos1_iv    = SvIV(pos_sv);
    pos1_is_uv = SvIOK_UV(pos_sv);
    sv = POPs;
    PUTBACK;
    if (repl_sv) {
	if (repl_is_utf8) {
	    if (!DO_UTF8(sv))
		sv_utf8_upgrade(sv);
	}
	else if (DO_UTF8(sv))
	    repl_need_utf8_upgrade = TRUE;
    }
    tmps = SvPV_const(sv, curlen);
    if (DO_UTF8(sv)) {
        utf8_curlen = sv_len_utf8(sv);
	if (utf8_curlen == curlen)
	    utf8_curlen = 0;
	else
	    curlen = utf8_curlen;
    }
    else
	utf8_curlen = 0;

    if ( (pos1_is_uv && arybase < 0) || (pos1_iv >= arybase) ) { /* pos >= $[ */
	UV pos1_uv = pos1_iv-arybase;
	/* Overflow can occur when $[ < 0 */
	if (arybase < 0 && pos1_uv < (UV)pos1_iv)
	    goto bound_fail;
	pos1_iv = pos1_uv;
	pos1_is_uv = 1;
    }
    else if (pos1_is_uv ? (UV)pos1_iv > 0 : pos1_iv > 0) {
	goto bound_fail;  /* $[=3; substr($_,2,...) */
    }
    else { /* pos < $[ */
	if (pos1_iv == 0) { /* $[=1; substr($_,0,...) */
	    pos1_iv = curlen;
	    pos1_is_uv = 1;
	} else {
	    if (curlen) {
		pos1_is_uv = curlen-1 > ~(UV)pos1_iv;
		pos1_iv += curlen;
	   }
	}
    }
    if (pos1_is_uv || pos1_iv > 0) {
	if ((UV)pos1_iv > curlen)
	    goto bound_fail;
    }

    if (num_args > 2) {
	if (!len_is_uv && len_iv < 0) {
	    pos2_iv = curlen + len_iv;
	    if (curlen)
		pos2_is_uv = curlen-1 > ~(UV)len_iv;
	    else
		pos2_is_uv = 0;
	} else {  /* len_iv >= 0 */
	    if (!pos1_is_uv && pos1_iv < 0) {
		pos2_iv = pos1_iv + len_iv;
		pos2_is_uv = (UV)len_iv > (UV)IV_MAX;
	    } else {
		if ((UV)len_iv > curlen-(UV)pos1_iv)
		    pos2_iv = curlen;
		else
		    pos2_iv = pos1_iv+len_iv;
		pos2_is_uv = 1;
	    }
	}
    }
    else {
	pos2_iv = curlen;
	pos2_is_uv = 1;
    }

    if (!pos2_is_uv && pos2_iv < 0) {
	if (!pos1_is_uv && pos1_iv < 0)
	    goto bound_fail;
	pos2_iv = 0;
    }
    else if (!pos1_is_uv && pos1_iv < 0)
	pos1_iv = 0;

    if ((UV)pos2_iv < (UV)pos1_iv)
	pos2_iv = pos1_iv;
    if ((UV)pos2_iv > curlen)
	pos2_iv = curlen;

    {
	/* pos1_iv and pos2_iv both in 0..curlen, so the cast is safe */
	const STRLEN pos = (STRLEN)( (UV)pos1_iv );
	const STRLEN len = (STRLEN)( (UV)pos2_iv - (UV)pos1_iv );
	STRLEN byte_len = len;
	STRLEN byte_pos = utf8_curlen
	    ? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos;

	tmps += byte_pos;
	/* we either return a PV or an LV. If the TARG hasn't been used
	 * before, or is of that type, reuse it; otherwise use a mortal
	 * instead. Note that LVs can have an extended lifetime, so also
	 * dont reuse if refcount > 1 (bug #20933) */
	if (SvTYPE(TARG) > SVt_NULL) {
	    if ( (SvTYPE(TARG) == SVt_PVLV)
		    ? (!lvalue || SvREFCNT(TARG) > 1)
		    : lvalue)
	    {
		TARG = sv_newmortal();
	    }
	}

	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);
		repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
	    }
	    if (!SvOK(sv))
		sv_setpvs(sv, "");
	    sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
	    if (repl_is_utf8)
		SvUTF8_on(sv);
	    SvREFCNT_dec(repl_sv_copy);
	}
	else if (lvalue) {		/* it's an lvalue! */
	    if (!SvGMAGICAL(sv)) {
		if (SvROK(sv)) {
		    SvPV_force_nolen(sv);
		    Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
				   "Attempt to use reference as lvalue in substr");
		}
		if (isGV_with_GP(sv))
		    SvPV_force_nolen(sv);
		else if (SvOK(sv))	/* is it defined ? */
		    (void)SvPOK_only_UTF8(sv);
		else
		    sv_setpvs(sv, ""); /* avoid lexical reincarnation */
	    }

	    if (SvTYPE(TARG) < SVt_PVLV) {
		sv_upgrade(TARG, SVt_PVLV);
		sv_magic(TARG, NULL, PERL_MAGIC_substr, NULL, 0);
	    }

	    LvTYPE(TARG) = 'x';
	    if (LvTARG(TARG) != sv) {
		SvREFCNT_dec(LvTARG(TARG));
		LvTARG(TARG) = SvREFCNT_inc_simple(sv);
	    }
	    LvTARGOFF(TARG) = pos;
	    LvTARGLEN(TARG) = len;
	}
    }
    SPAGAIN;
    PUSHs(TARG);		/* avoid SvSETMAGIC here */
    RETURN;

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