#include "keywords.h"
#include "reentr.h"
+#include "regcharclass.h"
/* XXX I can't imagine anyone who doesn't have this actually _needs_
it, since pid_t is an integral type.
}
gimme = GIMME_V;
if (gimme == G_ARRAY) {
+ /* XXX see also S_pushav in pp_hot.c */
const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
EXTEND(SP, maxarg);
if (SvMAGICAL(TARG)) {
if (gimme == G_ARRAY) {
RETURNOP(Perl_do_kv(aTHX));
}
+ else if ((PL_op->op_private & OPpTRUEBOOL
+ || ( PL_op->op_private & OPpMAYBE_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);
RETURN;
}
+PP(pp_padcv)
+{
+ dVAR; dSP; dTARGET;
+ assert(SvTYPE(TARG) == SVt_PVCV);
+ XPUSHs(TARG);
+ RETURN;
+}
+
+PP(pp_introcv)
+{
+ dVAR; dTARGET;
+ SvPADSTALE_off(TARG);
+ return NORMAL;
+}
+
+PP(pp_clonecv)
+{
+ dVAR; dTARGET;
+ MAGIC * const mg =
+ mg_find(PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG],
+ PERL_MAGIC_proto);
+ assert(SvTYPE(TARG) == SVt_PVCV);
+ assert(mg);
+ assert(mg->mg_obj);
+ if (CvISXSUB(mg->mg_obj)) { /* constant */
+ /* XXX Should we clone it here? */
+ /* If this changes to use SAVECLEARSV, we can move the SAVECLEARSV
+ to introcv and remove the SvPADSTALE_off. */
+ SAVEPADSVANDMORTALIZE(ARGTARG);
+ PAD_SVl(ARGTARG) = SvREFCNT_inc_simple_NN(mg->mg_obj);
+ }
+ else {
+ if (CvROOT(mg->mg_obj)) {
+ assert(CvCLONE(mg->mg_obj));
+ assert(!CvCLONED(mg->mg_obj));
+ }
+ cv_clone_into((CV *)mg->mg_obj,(CV *)TARG);
+ SAVECLEARSV(PAD_SVl(ARGTARG));
+ }
+ return NORMAL;
+}
+
/* Translations. */
static const char S_no_symref_sv[] =
if (vivify_sv && sv != &PL_sv_undef) {
GV *gv;
if (SvREADONLY(sv))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (cUNOP->op_targ) {
SV * const namesv = PAD_SV(cUNOP->op_targ);
gv = MUTABLE_GV(newSV(0));
else {
const char * const name = CopSTASHPV(PL_curcop);
gv = newGVgen_flags(name,
- HvNAMEUTF8(CopSTASH(PL_curcop)) ? SVf_UTF8 : 0 );
+ HvNAMEUTF8(CopSTASH(PL_curcop)) ? SVf_UTF8 : 0 );
}
prepare_SV_for_RV(sv);
SvRV_set(sv, MUTABLE_SV(gv));
}
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))
dVAR; dSP; dPOPss;
if (PL_op->op_flags & OPf_MOD || LVRET) {
- SV * const ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
+ SV * const ret = sv_2mortal(newSV_type(SVt_PVLV));/* Not TARG RT#67838 */
sv_magic(ret, NULL, PERL_MAGIC_pos, NULL, 0);
LvTYPE(ret) = '.';
LvTARG(ret) = SvREFCNT_inc_simple(sv);
HV *stash_unused;
const I32 flags = (PL_op->op_flags & OPf_SPECIAL)
? GV_ADDMG
- : ((PL_op->op_private & (OPpLVAL_INTRO|OPpMAY_RETURN_CONSTANT)) == OPpMAY_RETURN_CONSTANT)
+ : ((PL_op->op_private & (OPpLVAL_INTRO|OPpMAY_RETURN_CONSTANT))
+ == OPpMAY_RETURN_CONSTANT)
? GV_ADD|GV_NOEXPAND
: GV_ADD;
/* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
if (!code || code == -KEY_CORE)
DIE(aTHX_ "Can't find an opnumber for \"%"SVf"\"",
SVfARG(newSVpvn_flags(
- s+6, SvCUR(TOPs)-6, SvFLAGS(TOPs) & SVf_UTF8
+ s+6, SvCUR(TOPs)-6,
+ (SvFLAGS(TOPs) & SVf_UTF8)|SVs_TEMP
)));
{
SV * const sv = core_prototype(NULL, s + 6, code, NULL);
switch (*elem) {
case 'A':
if (len == 5 && strEQ(second_letter, "RRAY"))
+ {
tmpRef = MUTABLE_SV(GvAV(gv));
+ if (tmpRef && !AvREAL((const AV *)tmpRef)
+ && AvREIFY((const AV *)tmpRef))
+ av_reify(MUTABLE_AV(tmpRef));
+ }
break;
case 'C':
if (len == 4 && strEQ(second_letter, "ODE"))
PP(pp_study)
{
dVAR; dSP; dPOPss;
- register unsigned char *s;
STRLEN len;
- s = (unsigned char*)(SvPV(sv, len));
+ (void)SvPV(sv, len);
if (len == 0 || len > I32_MAX || !SvPOK(sv) || SvUTF8(sv) || SvVALID(sv)) {
/* Historically, study was skipped in these cases. */
RETPUSHNO;
sv = DEFSV;
EXTEND(SP,1);
}
- TARG = sv_newmortal();
if(PL_op->op_type == OP_TRANSR) {
STRLEN len;
const char * const pv = SvPV(sv,len);
do_trans(newsv);
PUSHs(newsv);
}
- else PUSHi(do_trans(sv));
+ else {
+ TARG = sv_newmortal();
+ PUSHi(do_trans(sv));
+ }
RETURN;
}
return;
}
else if (SvREADONLY(sv)) {
- if (SvFAKE(sv)) {
- /* SV is copy-on-write */
- sv_force_normal_flags(sv, 0);
- }
- else
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
+ }
+ else if (SvIsCOW(sv)) {
+ sv_force_normal_flags(sv, 0);
}
if (PL_encoding) {
{
/* let user-undef'd sub keep its identity */
GV* const gv = CvGV((const CV *)sv);
+ HEK * const hek = CvNAME_HEK((CV *)sv);
+ if (hek) share_hek_hek(hek);
cv_undef(MUTABLE_CV(sv));
- CvGV_set(MUTABLE_CV(sv), gv);
+ if (gv) CvGV_set(MUTABLE_CV(sv), gv);
+ else if (hek) {
+ SvANY((CV *)sv)->xcv_gv_u.xcv_hek = hek;
+ CvNAMED_on(sv);
+ }
}
break;
case SVt_PVGV:
- if (SvFAKE(sv)) {
- SvSetMagicSV(sv, &PL_sv_undef);
- break;
- }
- else if (isGV_with_GP(sv)) {
+ assert(isGV_with_GP(sv));
+ assert(!SvFAKE(sv));
+ {
GP *gp;
HV *stash;
break;
}
- /* FALL THROUGH */
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
SvPV_free(sv);
const bool inc =
PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (SvROK(TOPs))
TARG = sv_newmortal();
sv_setsv(TARG, TOPs);
- if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
+ if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
{
SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1));
SvIV_please_nomg(svr);
RETURN;
} else {
- register unsigned int highbit = 8 * sizeof(UV);
- register unsigned int diff = 8 * sizeof(UV);
+ unsigned int highbit = 8 * sizeof(UV);
+ unsigned int diff = 8 * sizeof(UV);
while (diff >>= 1) {
highbit -= diff;
if (baseuv >> highbit) {
if (power * highbit <= 8 * sizeof(UV)) {
/* result will definitely fit in UV, so use UV math
on same algorithm as above */
- register UV result = 1;
- register UV base = baseuv;
+ UV result = 1;
+ UV base = baseuv;
const bool odd_power = cBOOL(power & 1);
if (odd_power) {
result *= base;
PP(pp_repeat)
{
dVAR; dSP; dATARGET;
- register IV count;
+ IV count;
SV *sv;
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
- static const char oom_list_extend[] = "Out of memory during list extend";
+ static const char* const oom_list_extend = "Out of memory during list extend";
const I32 items = SP - MARK;
const I32 max = items * count;
MEM_WRAP_CHECK_1(max, SV*, oom_list_extend);
/* Did the max computation overflow? */
if (items > 0 && max > 0 && (max < items || max < count))
- Perl_croak(aTHX_ oom_list_extend);
+ Perl_croak(aTHX_ "%s", oom_list_extend);
MEXTEND(MARK, max);
if (count > 1) {
while (SP > MARK) {
SV * const tmpstr = POPs;
STRLEN len;
bool isutf;
- static const char oom_string_extend[] =
+ static const char* const oom_string_extend =
"Out of memory during string extend";
if (TARG != tmpstr)
else {
const STRLEN max = (UV)count * len;
if (len > MEM_SIZE_MAX / count)
- Perl_croak(aTHX_ oom_string_extend);
+ Perl_croak(aTHX_ "%s", oom_string_extend);
MEM_WRAP_CHECK_1(max, char, oom_string_extend);
SvGROW(TARG, max + 1);
repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
/* Unless the left argument is integer in range we are going to have to
use NV maths. Hence only attempt to coerce the right argument if
we know the left is integer. */
- register UV auv = 0;
+ UV auv = 0;
bool auvok = FALSE;
bool a_valid = 0;
if ((auvok = SvUOK(svl)))
auv = SvUVX(svl);
else {
- register const IV aiv = SvIVX(svl);
+ const IV aiv = SvIVX(svl);
if (aiv >= 0) {
auv = aiv;
auvok = 1; /* Now acting as a sign flag. */
if (a_valid) {
bool result_good = 0;
UV result;
- register UV buv;
+ UV buv;
bool buvok = SvUOK(svr);
if (buvok)
buv = SvUVX(svr);
else {
- register const IV biv = SvIVX(svr);
+ const IV biv = SvIVX(svr);
if (biv >= 0) {
buv = biv;
buvok = 1;
}
}
+PERL_STATIC_INLINE bool
+S_negate_string(pTHX)
+{
+ dTARGET; dSP;
+ STRLEN len;
+ const char *s;
+ SV * const sv = TOPs;
+ if (!SvPOKp(sv) || SvNIOK(sv) || (!SvPOK(sv) && SvNIOKp(sv)))
+ return FALSE;
+ s = SvPV_nomg_const(sv, len);
+ if (isIDFIRST(*s)) {
+ sv_setpvs(TARG, "-");
+ sv_catsv(TARG, sv);
+ }
+ else if (*s == '+' || (*s == '-' && !looks_like_number(sv))) {
+ sv_setsv_nomg(TARG, sv);
+ *SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-';
+ }
+ else return FALSE;
+ SETTARG; PUTBACK;
+ return TRUE;
+}
+
PP(pp_negate)
{
dVAR; dSP; dTARGET;
tryAMAGICun_MG(neg_amg, AMGf_numeric);
+ if (S_negate_string(aTHX)) return NORMAL;
{
SV * const sv = TOPs;
- if (SvIOK(sv) || (SvGMAGICAL(sv) && SvIOKp(sv))) {
+ if (SvIOK(sv)) {
/* It's publicly an integer */
oops_its_an_int:
if (SvIsUV(sv)) {
if (SvIVX(sv) == IV_MIN) {
/* 2s complement assumption. */
- SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) == IV_MIN */
+ SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) ==
+ IV_MIN */
RETURN;
}
else if (SvUVX(sv) <= IV_MAX) {
}
if (SvNIOKp(sv) && (SvNIOK(sv) || !SvPOK(sv)))
SETn(-SvNV_nomg(sv));
- else if (SvPOKp(sv)) {
- STRLEN len;
- const char * const s = SvPV_nomg_const(sv, len);
- if (isIDFIRST(*s)) {
- sv_setpvs(TARG, "-");
- sv_catsv(TARG, sv);
- }
- else if (*s == '+' || (*s == '-' && !looks_like_number(sv))) {
- sv_setsv_nomg(TARG, sv);
- *SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-';
- }
- else if (SvIV_please_nomg(sv))
+ else if (SvPOKp(sv) && SvIV_please_nomg(sv))
goto oops_its_an_int;
- else
- sv_setnv(TARG, -SvNV_nomg(sv));
- SETTARG;
- }
else
SETn(-SvNV_nomg(sv));
}
}
}
else {
- register U8 *tmps;
- register I32 anum;
+ U8 *tmps;
+ I32 anum;
STRLEN len;
(void)SvPV_nomg_const(sv,len); /* force check for uninit var */
}
#ifdef LIBERAL
{
- register long *tmpl;
+ long *tmpl;
for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
*tmps = ~*tmps;
tmpl = (long*)tmps;
}
}
-#if defined(__GLIBC__) && IVSIZE == 8
+#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS)
STATIC
PP(pp_i_modulo_0)
#else
}
}
-#if defined(__GLIBC__) && IVSIZE == 8
+#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS)
STATIC
PP(pp_i_modulo_1)
{
dVAR; dSP; dTARGET;
tryAMAGICun_MG(neg_amg, 0);
+ if (S_negate_string(aTHX)) return NORMAL;
{
SV * const sv = TOPs;
IV const i = SvIV_nomg(sv);
PP(pp_rand)
{
- dVAR; dSP; dTARGET;
- NV value;
- if (MAXARG < 1)
- value = 1.0;
- else if (!TOPs) {
- value = 1.0; (void)POPs;
- }
- else
- value = POPn;
- if (value == 0.0)
- value = 1.0;
+ dVAR;
if (!PL_srand_called) {
(void)seedDrand01((Rand_seed_t)seed());
PL_srand_called = TRUE;
}
- value *= Drand01();
- XPUSHn(value);
- RETURN;
+ {
+ dSP;
+ NV value;
+ EXTEND(SP, 1);
+
+ if (MAXARG < 1)
+ value = 1.0;
+ else {
+ SV * const sv = POPs;
+ if(!sv)
+ value = 1.0;
+ else
+ value = SvNV(sv);
+ }
+ /* 1 of 2 things can be carried through SvNV, SP or TARG, SP was carried */
+ if (value == 0.0)
+ value = 1.0;
+ {
+ dTARGET;
+ PUSHs(TARG);
+ PUTBACK;
+ value *= Drand01();
+ sv_setnv_mg(TARG, value);
+ }
+ }
+ return NORMAL;
}
PP(pp_srand)
{
dVAR; dSP; dTARGET;
- const UV anum = (MAXARG < 1 || (!TOPs && !POPs)) ? seed() : POPu;
+ UV anum;
+
+ if (MAXARG >= 1 && (TOPs || POPs)) {
+ SV *top;
+ char *pv;
+ STRLEN len;
+ int flags;
+
+ top = POPs;
+ pv = SvPV(top, len);
+ flags = grok_number(pv, len, &anum);
+
+ if (!(flags & IS_NUMBER_IN_UV)) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
+ "Integer overflow in srand");
+ anum = UV_MAX;
+ }
+ }
+ else {
+ anum = seed();
+ }
+
(void)seedDrand01((Rand_seed_t)anum);
PL_srand_called = TRUE;
if (anum)
dVAR; dSP; dTARGET;
SV * const sv = TOPs;
- if (SvGAMAGIC(sv)) {
- /* For an overloaded or magic scalar, we can't know in advance if
- it's going to be UTF-8 or not. Also, we can't call sv_len_utf8 as
- it likes to cache the length. Maybe that should be a documented
- feature of it.
- */
- STRLEN len;
- const char *const p
- = sv_2pv_flags(sv, &len,
- SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
-
- if (!p) {
- if (!SvPADTMP(TARG)) {
- sv_setsv(TARG, &PL_sv_undef);
- SETTARG;
- }
- SETs(&PL_sv_undef);
- }
- else if (DO_UTF8(sv)) {
- SETi(utf8_length((U8*)p, (U8*)p + len));
- }
+ SvGETMAGIC(sv);
+ if (SvOK(sv)) {
+ if (!IN_BYTES)
+ SETi(sv_len_utf8_nomg(sv));
else
+ {
+ STRLEN len;
+ (void)SvPV_nomg_const(sv,len);
SETi(len);
- } else if (SvOK(sv)) {
- /* Neither magic nor overloaded. */
- if (DO_UTF8(sv))
- SETi(sv_len_utf8(sv));
- else
- SETi(sv_len(sv));
+ }
} else {
if (!SvPADTMP(TARG)) {
sv_setsv_nomg(TARG, &PL_sv_undef);
STRLEN repl_len;
int num_args = PL_op->op_private & 7;
bool repl_need_utf8_upgrade = FALSE;
- bool repl_is_utf8 = FALSE;
if (num_args > 2) {
if (num_args > 3) {
repl_sv = POPs;
}
PUTBACK;
- if (repl_sv) {
- repl = SvPV_const(repl_sv, repl_len);
- repl_is_utf8 = DO_UTF8(repl_sv) && repl_len;
- if (repl_is_utf8) {
- if (!DO_UTF8(sv))
- sv_utf8_upgrade(sv);
- }
- else if (DO_UTF8(sv))
- repl_need_utf8_upgrade = TRUE;
- }
- else if (lvalue) {
+ 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);
PUSHs(ret); /* avoid SvSETMAGIC here */
RETURN;
}
- tmps = SvPV_const(sv, curlen);
+ 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_len_utf8(sv);
+ utf8_curlen = sv_or_pv_len_utf8(sv, tmps, curlen);
if (utf8_curlen == curlen)
utf8_curlen = 0;
else
byte_len = len;
byte_pos = utf8_curlen
- ? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos;
+ ? sv_or_pv_pos_u2b(sv, tmps, pos, &byte_len) : pos;
tmps += byte_pos;
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) && repl_len;
}
- if (SvROK(sv))
- Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
- "Attempt to use reference as lvalue in substr"
- );
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);
}
}
PP(pp_vec)
{
dVAR; dSP;
- register const IV size = POPi;
- register const IV offset = POPi;
- register SV * const src = POPs;
+ const IV size = POPi;
+ const IV offset = POPi;
+ SV * const src = POPs;
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
SV * ret;
dVAR; dSP; dTARGET;
char *tmps;
UV value;
+ SV *top = POPs;
- if (((SvIOK_notUV(TOPs) && SvIV(TOPs) < 0)
+ SvGETMAGIC(top);
+ if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */
+ && ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0)
||
- (SvNOK(TOPs) && SvNV(TOPs) < 0.0))) {
- if (IN_BYTES) {
- value = POPu; /* chr(-1) eq chr(0xff), etc. */
- } else {
- (void) POPs; /* Ignore the argument value. */
+ ((SvNOKp(top) || (SvOK(top) && !SvIsUV(top)))
+ && SvNV_nomg(top) < 0.0))) {
+ if (ckWARN(WARN_UTF8)) {
+ if (SvGMAGICAL(top)) {
+ SV *top2 = sv_newmortal();
+ sv_setsv_nomg(top2, top);
+ top = top2;
+ }
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
+ "Invalid negative number (%"SVf") in chr", top);
+ }
value = UNICODE_REPLACEMENT;
- }
} else {
- value = POPu;
+ value = SvUV_nomg(top);
}
SvUPGRADE(TARG,SVt_PV);
* replace just the first character in place. */
inplace = FALSE;
- /* If the result won't fit in a byte, the entire result will
- * have to be in UTF-8. Assume worst case sizing in
- * conversion. (all latin1 characters occupy at most two bytes
- * in utf8) */
+ /* If the result won't fit in a byte, the entire result
+ * will have to be in UTF-8. Assume worst case sizing in
+ * conversion. (all latin1 characters occupy at most two
+ * bytes in utf8) */
if (title_ord > 255) {
doing_utf8 = TRUE;
convert_source_to_utf8 = TRUE;
STRLEN u;
STRLEN ulen;
UV uv;
- if (in_iota_subscript && ! is_utf8_mark(s)) {
+ if (in_iota_subscript && ! _is_utf8_mark(s)) {
/* A non-mark. Time to output the iota subscript */
#define GREEK_CAPITAL_LETTER_IOTA 0x0399
else {
for (; s < send; d++, s++) {
*d = toUPPER_LATIN1_MOD(*s);
- if (LIKELY(*d != LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) continue;
+ if (LIKELY(*d != LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) {
+ continue;
+ }
/* The mainstream case is the tight loop above. To avoid
* extra tests in that, all three characters that require
dVAR; dSP; dTARGET;
SV * const sv = TOPs;
STRLEN len;
- register const char *s = SvPV_const(sv,len);
+ const char *s = SvPV_const(sv,len);
SvUTF8_off(TARG); /* decontaminate */
if (len) {
- register char *d;
+ char *d;
SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
d = SvPVX(TARG);
to_quote = TRUE;
}
}
- else if (_is_utf8_quotemeta((U8 *) s)) {
+ else if (is_QUOTEMETA_high(s)) {
to_quote = TRUE;
}
}
} /* Unflagged string */
else if (len) {
- /* For locale, bytes, and nothing, the behavior is supposed to be the
- * same as lc().
- */
if ( IN_LOCALE_RUNTIME ) { /* Under locale */
TAINT;
SvTAINTED_on(dest);
for (; s < send; d++, s++)
- *d = toLOWER_LC(*s);
+ *d = toFOLD_LC(*s);
}
else if ( !IN_UNI_8_BIT ) { /* Under nothing, or bytes */
for (; s < send; d++, s++)
- *d = toLOWER(*s);
+ *d = toFOLD(*s);
}
else {
- /* For ASCII and the Latin-1 range, there's only two troublesome folds,
- * \x{DF} (\N{LATIN SMALL LETTER SHARP S}), which under full casefolding
- * becomes 'ss', and \x{B5} (\N{MICRO SIGN}), which under any fold becomes
- * \x{3BC} (\N{GREEK SMALL LETTER MU}) -- For the rest, the casefold is
- * their lowercase.
- */
+ /* For ASCII and the Latin-1 range, there's only two troublesome
+ * folds, \x{DF} (\N{LATIN SMALL LETTER SHARP S}), which under full
+ * casefolding becomes 'ss'; and \x{B5} (\N{MICRO SIGN}), which
+ * under any fold becomes \x{3BC} (\N{GREEK SMALL LETTER MU}) --
+ * For the rest, the casefold is their lowercase. */
for (; s < send; d++, s++) {
if (*s == MICRO_SIGN) {
- /* \N{MICRO SIGN}'s casefold is \N{GREEK SMALL LETTER MU}, which
- * is outside of the latin-1 range. There's a couple of ways to
- * deal with this -- khw discusses them in pp_lc/uc, so go there :)
- * What we do here is upgrade what we had already casefolded,
- * then enter an inner loop that appends the rest of the characters
- * as UTF-8.
- */
+ /* \N{MICRO SIGN}'s casefold is \N{GREEK SMALL LETTER MU},
+ * which is outside of the latin-1 range. There's a couple
+ * of ways to deal with this -- khw discusses them in
+ * pp_lc/uc, so go there :) What we do here is upgrade what
+ * we had already casefolded, then enter an inner loop that
+ * appends the rest of the characters as UTF-8. */
len = d - (U8*)SvPVX_const(dest);
SvCUR_set(dest, len);
len = sv_utf8_upgrade_flags_grow(dest,
STRLEN ulen;
UV fc = _to_uni_fold_flags(*s, tmpbuf, &ulen, flags);
if UNI_IS_INVARIANT(fc) {
- if ( full_folding && *s == LATIN_SMALL_LETTER_SHARP_S) {
+ if (full_folding
+ && *s == LATIN_SMALL_LETTER_SHARP_S)
+ {
*d++ = 's';
*d++ = 's';
}
break;
}
else if (full_folding && *s == LATIN_SMALL_LETTER_SHARP_S) {
- /* Under full casefolding, LATIN SMALL LETTER SHARP S becomes "ss",
- * which may require growing the SV.
- */
+ /* Under full casefolding, LATIN SMALL LETTER SHARP S
+ * becomes "ss", which may require growing the SV. */
if (SvLEN(dest) < ++min) {
const UV o = d - (U8*)SvPVX_const(dest);
SvGROW(dest, min);
*(d)++ = 's';
*d = 's';
}
- else { /* If it's not one of those two, the fold is their lower case */
+ else { /* If it's not one of those two, the fold is their lower
+ case */
*d = toLOWER_LATIN1(*s);
}
}
PP(pp_aslice)
{
dVAR; dSP; dMARK; dORIGMARK;
- register AV *const av = MUTABLE_AV(POPs);
- register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
+ AV *const av = MUTABLE_AV(POPs);
+ const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
if (SvTYPE(av) == SVt_PVAV) {
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
}
if (lval && localizing) {
- register SV **svp;
+ SV **svp;
I32 max = -1;
for (svp = MARK + 1; svp <= SP; svp++) {
const I32 elem = SvIV(*svp);
}
while (++MARK <= SP) {
- register SV **svp;
+ SV **svp;
I32 elem = SvIV(*MARK);
bool preeminent = TRUE;
return (SvTYPE(sv) == SVt_PVHV) ? Perl_do_kv(aTHX) : Perl_pp_akeys(aTHX);
}
else {
- return (SvTYPE(sv) == SVt_PVHV) ? Perl_pp_each(aTHX) : Perl_pp_aeach(aTHX);
+ return (SvTYPE(sv) == SVt_PVHV)
+ ? Perl_pp_each(aTHX)
+ : Perl_pp_aeach(aTHX);
}
}
const I32 gimme = GIMME_V;
const MAGIC *mg;
HV *stash;
-
- if (PL_op->op_private & OPpSLICE) {
- dMARK; dORIGMARK;
- SV * const osv = POPs;
- const bool tied = SvRMAGICAL(osv)
+ const bool sliced = !!(PL_op->op_private & OPpSLICE);
+ SV *unsliced_keysv = sliced ? NULL : POPs;
+ SV * const osv = POPs;
+ SV **mark = sliced ? PL_stack_base + POPMARK : &unsliced_keysv-1;
+ dORIGMARK;
+ const bool tied = SvRMAGICAL(osv)
&& mg_find((const SV *)osv, PERL_MAGIC_tied);
- const bool can_preserve = SvCANEXISTDELETE(osv)
- || mg_find((const SV *)osv, PERL_MAGIC_env);
- const U32 type = SvTYPE(osv);
- if (type == SVt_PVHV) { /* hash element */
+ const bool can_preserve = SvCANEXISTDELETE(osv);
+ const U32 type = SvTYPE(osv);
+ SV ** const end = sliced ? SP : &unsliced_keysv;
+
+ if (type == SVt_PVHV) { /* hash element */
HV * const hv = MUTABLE_HV(osv);
- while (++MARK <= SP) {
+ while (++MARK <= end) {
SV * const keysv = *MARK;
SV *sv = NULL;
bool preeminent = TRUE;
SvREFCNT_inc_simple_void(sv); /* De-mortalize */
}
if (preeminent) {
+ if (!sv) DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM);
if (tied) {
*MARK = sv_mortalcopy(sv);
*MARK = &PL_sv_undef;
}
}
- }
- else if (type == SVt_PVAV) { /* array element */
+ }
+ else if (type == SVt_PVAV) { /* array element */
if (PL_op->op_flags & OPf_SPECIAL) {
AV * const av = MUTABLE_AV(osv);
- while (++MARK <= SP) {
+ while (++MARK <= end) {
I32 idx = SvIV(*MARK);
SV *sv = NULL;
bool preeminent = TRUE;
}
}
}
- }
- else
+ else
+ DIE(aTHX_ "panic: avhv_delete no longer supported");
+ }
+ else
DIE(aTHX_ "Not a HASH reference");
+ if (sliced) {
if (gimme == G_VOID)
SP = ORIGMARK;
else if (gimme == G_SCALAR) {
SP = MARK;
}
}
- else {
- SV * const keysv = POPs;
- SV * const osv = POPs;
- const bool tied = SvRMAGICAL(osv)
- && mg_find((const SV *)osv, PERL_MAGIC_tied);
- const bool can_preserve = SvCANEXISTDELETE(osv)
- || mg_find((const SV *)osv, PERL_MAGIC_env);
- const U32 type = SvTYPE(osv);
- SV *sv = NULL;
- if (type == SVt_PVHV) {
- HV * const hv = MUTABLE_HV(osv);
- bool preeminent = TRUE;
- if (can_preserve)
- preeminent = hv_exists_ent(hv, keysv, 0);
- if (tied) {
- HE *he = hv_fetch_ent(hv, keysv, 1, 0);
- if (he)
- sv = HeVAL(he);
- else
- preeminent = FALSE;
- }
- else {
- sv = hv_delete_ent(hv, keysv, 0, 0);
- SvREFCNT_inc_simple_void(sv); /* De-mortalize */
- }
- if (preeminent) {
- save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM);
- if (tied) {
- SV *nsv = sv_mortalcopy(sv);
- mg_clear(sv);
- sv = nsv;
- }
- }
- else
- SAVEHDELETE(hv, keysv);
- }
- else if (type == SVt_PVAV) {
- if (PL_op->op_flags & OPf_SPECIAL) {
- AV * const av = MUTABLE_AV(osv);
- I32 idx = SvIV(keysv);
- bool preeminent = TRUE;
- if (can_preserve)
- preeminent = av_exists(av, idx);
- if (tied) {
- SV **svp = av_fetch(av, idx, 1);
- if (svp)
- sv = *svp;
- else
- preeminent = FALSE;
- }
- else {
- sv = av_delete(av, idx, 0);
- SvREFCNT_inc_simple_void(sv); /* De-mortalize */
- }
- if (preeminent) {
- save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM);
- if (tied) {
- SV *nsv = sv_mortalcopy(sv);
- mg_clear(sv);
- sv = nsv;
- }
- }
- else
- SAVEADELETE(av, idx);
- }
- else
- DIE(aTHX_ "panic: avhv_delete no longer supported");
- }
- else
- DIE(aTHX_ "Not a HASH reference");
- if (!sv)
- sv = &PL_sv_undef;
- if (gimme != G_VOID)
- PUSHs(sv);
- }
+ else if (gimme != G_VOID)
+ PUSHs(unsliced_keysv);
RETURN;
}
PP(pp_hslice)
{
dVAR; dSP; dMARK; dORIGMARK;
- register HV * const hv = MUTABLE_HV(POPs);
- register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
+ HV * const hv = MUTABLE_HV(POPs);
+ const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
bool can_preserve = FALSE;
MAGIC *mg;
HV *stash;
- if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+ if (SvCANEXISTDELETE(hv))
can_preserve = TRUE;
}
SV ** const lastrelem = PL_stack_sp;
SV ** const lastlelem = PL_stack_base + POPMARK;
SV ** const firstlelem = PL_stack_base + POPMARK + 1;
- register SV ** const firstrelem = lastlelem + 1;
+ SV ** const firstrelem = lastlelem + 1;
I32 is_something_there = FALSE;
- register const I32 max = lastrelem - lastlelem;
- register SV **lelem;
+ const I32 max = lastrelem - lastlelem;
+ SV **lelem;
if (GIMME != G_ARRAY) {
I32 ix = SvIV(*lastlelem);
PP(pp_anonhash)
{
dVAR; dSP; dMARK; dORIGMARK;
- HV* const hv = newHV();
+ HV* const hv = (HV *)sv_2mortal((SV *)newHV());
while (MARK < SP) {
- SV * const key = *++MARK;
- SV * const val = newSV(0);
+ SV * const key =
+ (MARK++, SvGMAGICAL(*MARK) ? sv_mortalcopy(*MARK) : *MARK);
+ SV *val;
if (MARK < SP)
- sv_setsv(val, *++MARK);
+ {
+ MARK++;
+ SvGETMAGIC(*MARK);
+ val = newSV(0);
+ sv_setsv(val, *MARK);
+ }
else
+ {
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
+ val = newSV(0);
+ }
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
- mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
- ? newRV_noinc(MUTABLE_SV(hv)) : MUTABLE_SV(hv));
+ if (PL_op->op_flags & OPf_SPECIAL)
+ mXPUSHs(newRV_inc(MUTABLE_SV(hv)));
+ else XPUSHs(MUTABLE_SV(hv));
RETURN;
}
{
dVAR; dSP; dMARK; dORIGMARK;
int num_args = (SP - MARK);
- register AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
- register SV **src;
- register SV **dst;
- register I32 i;
- register I32 offset;
- register I32 length;
+ AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+ SV **src;
+ SV **dst;
+ I32 i;
+ I32 offset;
+ I32 length;
I32 newlen;
I32 after;
I32 diff;
PP(pp_push)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
- register AV * const ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+ AV * const ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
if (mg) {
SPAGAIN;
}
else {
+ if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify();
PL_delaymagic = DM_DELAY;
for (++MARK; MARK <= SP; MARK++) {
- SV * const sv = newSV(0);
+ SV *sv;
+ if (*MARK) SvGETMAGIC(*MARK);
+ sv = newSV(0);
if (*MARK)
- sv_setsv(sv, *MARK);
+ sv_setsv_nomg(sv, *MARK);
av_store(ary, AvFILLp(ary)+1, sv);
}
if (PL_delaymagic & DM_ARRAY_ISA)
PP(pp_unshift)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
- register AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+ AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
if (mg) {
SPAGAIN;
}
else {
- register I32 i = 0;
+ I32 i = 0;
av_unshift(ary, SP - MARK);
while (MARK < SP) {
SV * const sv = newSVsv(*++MARK);
if (SvMAGICAL(av)) {
I32 i, j;
- register SV *tmp = sv_newmortal();
+ SV *tmp = sv_newmortal();
/* For SvCANEXISTDELETE */
HV *stash;
const MAGIC *mg;
bool can_preserve = SvCANEXISTDELETE(av);
for (i = 0, j = av_len(av); i < j; ++i, --j) {
- register SV *begin, *end;
+ SV *begin, *end;
if (can_preserve) {
if (!av_exists(av, i)) {
if (av_exists(av, j)) {
- register SV *sv = av_delete(av, j, 0);
+ SV *sv = av_delete(av, j, 0);
begin = *av_fetch(av, i, TRUE);
sv_setsv_mg(begin, sv);
}
continue;
}
else if (!av_exists(av, j)) {
- register SV *sv = av_delete(av, i, 0);
+ SV *sv = av_delete(av, i, 0);
end = *av_fetch(av, j, TRUE);
sv_setsv_mg(end, sv);
continue;
SV **end = begin + AvFILLp(av);
while (begin < end) {
- register SV * const tmp = *begin;
+ SV * const tmp = *begin;
*begin++ = *end;
*end-- = tmp;
}
SV **oldsp = SP;
MARK++;
while (MARK < SP) {
- register SV * const tmp = *MARK;
+ SV * const tmp = *MARK;
*MARK++ = *SP;
*SP-- = tmp;
}
}
}
else {
- register char *up;
- register char *down;
- register I32 tmp;
+ char *up;
+ char *down;
+ I32 tmp;
dTARGET;
STRLEN len;
{
dVAR; dSP; dTARG;
AV *ary;
- register IV limit = POPi; /* note, negative is forever */
+ IV limit = POPi; /* note, negative is forever */
SV * const sv = POPs;
STRLEN len;
- register const char *s = SvPV_const(sv, len);
+ const char *s = SvPV_const(sv, len);
const bool do_utf8 = DO_UTF8(sv);
const char *strend = s + len;
- register PMOP *pm;
- register REGEXP *rx;
- register SV *dstr;
- register const char *m;
+ PMOP *pm;
+ REGEXP *rx;
+ SV *dstr;
+ const char *m;
I32 iters = 0;
- const STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (STRLEN)(strend - s);
+ const STRLEN slen = do_utf8
+ ? utf8_length((U8*)s, (U8*)strend)
+ : (STRLEN)(strend - s);
I32 maxiters = slen + 10;
I32 trailing_empty = 0;
const char *orig;
rx = PM_GETRE(pm);
TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
- (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
+ (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
RX_MATCH_UTF8_set(rx, do_utf8);
#endif
else
ary = NULL;
- if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
+ if (ary) {
realarray = 1;
PUTBACK;
av_extend(ary,0);
AvREAL_on(ary);
AvREIFY_off(ary);
for (i = AvFILLp(ary); i >= 0; i--)
- AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
+ AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
}
/* temporarily switch stacks */
SAVESWITCHSTACK(PL_curstack, ary);
orig = s;
if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
if (do_utf8) {
- while (*s == ' ' || is_utf8_space((U8*)s))
+ while (isSPACE_utf8(s))
s += UTF8SKIP(s);
}
else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
m = s;
/* this one uses 'm' and is a negative test */
if (do_utf8) {
- while (m < strend && !( *m == ' ' || is_utf8_space((U8*)m) )) {
+ while (m < strend && ! isSPACE_utf8(m) ) {
const int t = UTF8SKIP(m);
- /* is_utf8_space returns FALSE for malform utf8 */
+ /* isSPACE_utf8 returns FALSE for malform utf8 */
if (strend - m < t)
m = strend;
else
m += t;
}
}
- else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
+ else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET)
+ {
while (m < strend && !isSPACE_LC(*m))
++m;
} else {
/* this one uses 's' and is a positive test */
if (do_utf8) {
- while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
+ while (s < strend && isSPACE_utf8(s) )
s += UTF8SKIP(s);
}
- else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
+ else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET)
+ {
while (s < strend && isSPACE_LC(*s))
++s;
} else {
trailing_empty = 0;
} else {
dstr = newSVpvn_flags(s, m-s,
- (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
}
/* The rx->minlen is in characters but we want to step
trailing_empty = 0;
} else {
dstr = newSVpvn_flags(s, m-s,
- (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
}
/* The rx->minlen is in characters but we want to step
{
I32 rex_return;
PUTBACK;
- rex_return = CALLREGEXEC(rx, (char*)s, (char*)strend, (char*)orig, 1 ,
+ rex_return = CALLREGEXEC(rx, (char*)s, (char*)strend, (char*)orig, 1,
sv, NULL, 0);
SPAGAIN;
if (rex_return == 0)
break;
TAINT_IF(RX_MATCH_TAINTED(rx));
- if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
- m = s;
- s = orig;
- orig = RX_SUBBEG(rx);
- s = orig + (m - s);
- strend = s + (strend - m);
- }
+ /* we never pass the REXEC_COPY_STR flag, so it should
+ * never get copied */
+ assert(!RX_MATCH_COPIED(rx));
m = RX_OFFS(rx)[0].start + orig;
if (gimme_scalar) {
DIE(aTHX_ "panic: unimplemented op %s (#%d) called", name, op_type);
}
-PP(pp_boolkeys)
-{
- dVAR;
- dSP;
- HV * const hv = (HV*)POPs;
-
- if (SvTYPE(hv) != SVt_PVHV) { XPUSHs(&PL_sv_no); RETURN; }
-
- if (SvRMAGICAL(hv)) {
- MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
- if (mg) {
- XPUSHs(magic_scalarpack(hv, mg));
- RETURN;
- }
- }
-
- XPUSHs(boolSV(HvUSEDKEYS(hv) != 0));
- RETURN;
-}
-
/* For sorting out arguments passed to a &CORE:: subroutine */
PP(pp_coreargs)
{
case OA_SCALAR:
try_defsv:
if (!numargs && defgv && whicharg == minargs + 1) {
- PERL_SI * const oldsi = PL_curstackinfo;
- I32 const oldcxix = oldsi->si_cxix;
- CV *caller;
- if (oldcxix) oldsi->si_cxix--;
- else PL_curstackinfo = oldsi->si_prev;
- caller = find_runcv(NULL);
- PL_curstackinfo = oldsi;
- oldsi->si_cxix = oldcxix;
PUSHs(find_rundefsv2(
- caller,cxstack[cxstack_ix].blk_oldcop->cop_seq
+ find_runcv_where(FIND_RUNCV_level_eq, 1, NULL),
+ cxstack[cxstack_ix].blk_oldcop->cop_seq
));
}
else PUSHs(numargs ? svp && *svp ? *svp : &PL_sv_undef : NULL);
dSP;
CV *cv;
if (PL_op->op_private & OPpOFFBYONE) {
- PERL_SI * const oldsi = PL_curstackinfo;
- I32 const oldcxix = oldsi->si_cxix;
- if (oldcxix) oldsi->si_cxix--;
- else PL_curstackinfo = oldsi->si_prev;
- cv = find_runcv(NULL);
- PL_curstackinfo = oldsi;
- oldsi->si_cxix = oldcxix;
+ cv = find_runcv_where(FIND_RUNCV_level_eq, 1, NULL);
}
else cv = find_runcv(NULL);
XPUSHs(CvEVAL(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv)));
https://perl5.git.perl.org / perl5.git / blobdiff