alow = aiv;
auvok = TRUE; /* effectively it's a UV now */
} else {
- alow = -aiv; /* abs, auvok == false records sign */
+ /* abs, auvok == false records sign */
+ alow = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
}
}
if (buvok) {
blow = biv;
buvok = TRUE; /* effectively it's a UV now */
} else {
- blow = -biv; /* abs, buvok == false records sign */
+ /* abs, buvok == false records sign */
+ blow = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
}
}
/* 2s complement assumption that (UV)-IV_MIN is correct. */
/* -ve result, which could overflow an IV */
SP--;
+ /* can't negate IV_MIN, but there are aren't two
+ * integers such that !ahigh && !bhigh, where the
+ * product equals 0x800....000 */
+ assert(product != (UV)IV_MIN);
SETi( -(IV)product );
RETURN;
} /* else drop to NVs below. */
/* 2s complement assumption again */
/* -ve result, which could overflow an IV */
SP--;
- SETi( -(IV)product_low );
+ SETi(product_low == (UV)IV_MIN
+ ? IV_MIN : -(IV)product_low);
RETURN;
} /* else drop to NVs below. */
}
right_non_neg = TRUE; /* effectively it's a UV now */
}
else {
- right = -biv;
+ right = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
}
}
/* historically undef()/0 gives a "Use of uninitialized value"
left_non_neg = TRUE; /* effectively it's a UV now */
}
else {
- left = -aiv;
+ left = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
}
}
}
/* 2s complement assumption */
if (result <= (UV)IV_MIN)
- SETi( -(IV)result );
+ SETi(result == (UV)IV_MIN ? IV_MIN : -(IV)result);
else {
/* It's exact but too negative for IV. */
SETn( -(NV)result );
right = biv;
right_neg = FALSE; /* effectively it's a UV now */
} else {
- right = -biv;
+ right = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
}
}
}
left = aiv;
left_neg = FALSE; /* effectively it's a UV now */
} else {
- left = -aiv;
+ left = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
}
}
}
dSP; dATARGET;
IV count;
SV *sv;
+ bool infnan = FALSE;
if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
/* TODO: think of some way of doing list-repeat overloading ??? */
}
}
else if (SvNOKp(sv)) {
- const NV nv = SvNV_nomg(sv);
- if (nv < 0.0)
- count = -1; /* An arbitrary negative integer */
- else
- count = (IV)nv;
+ const NV nv = SvNV_nomg(sv);
+ infnan = Perl_isinfnan(nv);
+ if (UNLIKELY(infnan)) {
+ count = 0;
+ } else {
+ if (nv < 0.0)
+ count = -1; /* An arbitrary negative integer */
+ else
+ count = (IV)nv;
+ }
}
else
- count = SvIV_nomg(sv);
+ count = SvIV_nomg(sv);
- if (count < 0) {
+ if (infnan) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
+ "Non-finite repeat count does nothing");
+ } else if (count < 0) {
count = 0;
Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
- "Negative repeat count does nothing");
+ "Negative repeat count does nothing");
}
if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
auv = aiv;
auvok = 1; /* Now acting as a sign flag. */
} else { /* 2s complement assumption for IV_MIN */
- auv = (UV)-aiv;
+ auv = (aiv == IV_MIN) ? (UV)aiv : (UV)-aiv;
}
}
a_valid = 1;
buv = biv;
buvok = 1;
} else
- buv = (UV)-biv;
+ buv = (biv == IV_MIN) ? (UV)biv : (UV)-biv;
}
/* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
else "IV" now, independent of how it came in.
else {
/* Negate result */
if (result <= (UV)IV_MIN)
- SETi( -(IV)result );
+ SETi(result == (UV)IV_MIN
+ ? IV_MIN : -(IV)result);
else {
/* result valid, but out of range for IV. */
SETn( -(NV)result );
}
}
+PP(pp_nbit_and)
+{
+ dSP;
+ tryAMAGICbin_MG(band_amg, AMGf_assign);
+ {
+ dATARGET; dPOPTOPssrl;
+ if (PL_op->op_private & HINT_INTEGER) {
+ const IV i = SvIV_nomg(left) & SvIV_nomg(right);
+ SETi(i);
+ }
+ else {
+ const UV u = SvUV_nomg(left) & SvUV_nomg(right);
+ SETu(u);
+ }
+ }
+ RETURN;
+}
+
+PP(pp_sbit_and)
+{
+ dSP;
+ tryAMAGICbin_MG(sband_amg, AMGf_assign);
+ {
+ dATARGET; dPOPTOPssrl;
+ do_vop(OP_BIT_AND, TARG, left, right);
+ RETSETTARG;
+ }
+}
/* also used for: pp_bit_xor() */
}
}
+/* also used for: pp_nbit_xor() */
+
+PP(pp_nbit_or)
+{
+ dSP;
+ const int op_type = PL_op->op_type;
+
+ tryAMAGICbin_MG((op_type == OP_NBIT_OR ? bor_amg : bxor_amg),
+ AMGf_assign);
+ {
+ dATARGET; dPOPTOPssrl;
+ if (PL_op->op_private & HINT_INTEGER) {
+ const IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0);
+ const IV r = SvIV_nomg(right);
+ const IV result = op_type == OP_NBIT_OR ? (l | r) : (l ^ r);
+ SETi(result);
+ }
+ else {
+ const UV l = (USE_LEFT(left) ? SvUV_nomg(left) : 0);
+ const UV r = SvUV_nomg(right);
+ const UV result = op_type == OP_NBIT_OR ? (l | r) : (l ^ r);
+ SETu(result);
+ }
+ }
+ RETURN;
+}
+
+/* also used for: pp_sbit_xor() */
+
+PP(pp_sbit_or)
+{
+ dSP;
+ const int op_type = PL_op->op_type;
+
+ tryAMAGICbin_MG((op_type == OP_SBIT_OR ? sbor_amg : sbxor_amg),
+ AMGf_assign);
+ {
+ dATARGET; dPOPTOPssrl;
+ do_vop(op_type == OP_SBIT_OR ? OP_BIT_OR : OP_BIT_XOR, TARG, left,
+ right);
+ RETSETTARG;
+ }
+}
+
PERL_STATIC_INLINE bool
S_negate_string(pTHX)
{
*SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-';
}
else return FALSE;
- SETTARG; PUTBACK;
+ SETTARG;
return TRUE;
}
/* 2s complement assumption. */
SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) ==
IV_MIN */
- RETURN;
+ return NORMAL;
}
else if (SvUVX(sv) <= IV_MAX) {
SETi(-SvIVX(sv));
- RETURN;
+ return NORMAL;
}
}
else if (SvIVX(sv) != IV_MIN) {
SETi(-SvIVX(sv));
- RETURN;
+ return NORMAL;
}
#ifdef PERL_PRESERVE_IVUV
else {
SETu((UV)IV_MIN);
- RETURN;
+ return NORMAL;
}
#endif
}
else
SETn(-SvNV_nomg(sv));
}
- RETURN;
+ return NORMAL;
}
PP(pp_not)
return NORMAL;
}
-PP(pp_complement)
+static void
+S_scomplement(pTHX_ SV *targ, SV *sv)
{
- dSP; dTARGET;
- tryAMAGICun_MG(compl_amg, AMGf_numeric);
- {
- dTOPss;
- if (SvNIOKp(sv)) {
- if (PL_op->op_private & HINT_INTEGER) {
- const IV i = ~SvIV_nomg(sv);
- SETi(i);
- }
- else {
- const UV u = ~SvUV_nomg(sv);
- SETu(u);
- }
- }
- else {
U8 *tmps;
I32 anum;
STRLEN len;
sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
SvUTF8_off(TARG);
}
- SETTARG;
- RETURN;
+ return;
}
#ifdef LIBERAL
{
#endif
for ( ; anum > 0; anum--, tmps++)
*tmps = ~*tmps;
+}
+
+PP(pp_complement)
+{
+ dSP; dTARGET;
+ tryAMAGICun_MG(compl_amg, AMGf_numeric);
+ {
+ dTOPss;
+ if (SvNIOKp(sv)) {
+ if (PL_op->op_private & HINT_INTEGER) {
+ const IV i = ~SvIV_nomg(sv);
+ SETi(i);
+ }
+ else {
+ const UV u = ~SvUV_nomg(sv);
+ SETu(u);
+ }
+ }
+ else {
+ S_scomplement(aTHX_ TARG, sv);
SETTARG;
}
- RETURN;
+ return NORMAL;
+ }
+}
+
+PP(pp_ncomplement)
+{
+ dSP;
+ tryAMAGICun_MG(compl_amg, AMGf_numeric);
+ {
+ dTARGET; dTOPss;
+ if (PL_op->op_private & HINT_INTEGER) {
+ const IV i = ~SvIV_nomg(sv);
+ SETi(i);
+ }
+ else {
+ const UV u = ~SvUV_nomg(sv);
+ SETu(u);
+ }
+ }
+ return NORMAL;
+}
+
+PP(pp_scomplement)
+{
+ dSP;
+ tryAMAGICun_MG(scompl_amg, AMGf_numeric);
+ {
+ dTARGET; dTOPss;
+ S_scomplement(aTHX_ TARG, sv);
+ SETTARG;
+ return NORMAL;
}
}
SV * const sv = TOPs;
IV const i = SvIV_nomg(sv);
SETi(-i);
- RETURN;
+ return NORMAL;
}
}
tryAMAGICun_MG(amg_type, 0);
{
- SV * const arg = POPs;
+ SV * const arg = TOPs;
const NV value = SvNV_nomg(arg);
NV result = NV_NAN;
if (neg_report) { /* log or sqrt */
case OP_LOG: result = Perl_log(value); break;
case OP_SQRT: result = Perl_sqrt(value); break;
}
- XPUSHn(result);
- RETURN;
+ SETn(result);
+ return NORMAL;
}
}
}
}
}
- RETURN;
+ return NORMAL;
}
PP(pp_abs)
SETn(value);
}
}
- RETURN;
+ return NORMAL;
}
STRLEN len;
NV result_nv;
UV result_uv;
- SV* const sv = POPs;
+ SV* const sv = TOPs;
tmps = (SvPV_const(sv, len));
if (DO_UTF8(sv)) {
result_uv = grok_oct (tmps, &len, &flags, &result_nv);
if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
- XPUSHn(result_nv);
+ SETn(result_nv);
}
else {
- XPUSHu(result_uv);
+ SETu(result_uv);
}
- RETURN;
+ return NORMAL;
}
/* String stuff. */
assert(!repl_sv);
repl_sv = POPs;
}
- PUTBACK;
if (lvalue && !repl_sv) {
SV * ret;
ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
? (STRLEN)(UV)len_iv
: (LvFLAGS(ret) |= 2, (STRLEN)(UV)-len_iv);
- SPAGAIN;
PUSHs(ret); /* avoid SvSETMAGIC here */
RETURN;
}
SvREFCNT_dec(repl_sv_copy);
}
}
- SPAGAIN;
if (PL_op->op_private & OPpSUBSTR_REPL_FIRST)
SP++;
else if (rvalue) {
}
RETURN;
-bound_fail:
+ bound_fail:
if (repl)
Perl_croak(aTHX_ "substr outside of string");
Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
{
dSP; dTARGET;
- SV *argsv = POPs;
+ SV *argsv = TOPs;
STRLEN len;
const U8 *s = (U8*)SvPV_const(argsv, len);
argsv = tmpsv;
}
- XPUSHu(DO_UTF8(argsv)
+ SETu(DO_UTF8(argsv)
? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV)
: (UV)(*s));
- RETURN;
+ return NORMAL;
}
PP(pp_chr)
dSP; dTARGET;
char *tmps;
UV value;
- SV *top = POPs;
+ SV *top = TOPs;
SvGETMAGIC(top);
if (UNLIKELY(SvAMAGIC(top)))
*tmps = '\0';
(void)SvPOK_only(TARG);
SvUTF8_on(TARG);
- XPUSHTARG;
- RETURN;
+ SETTARG;
+ return NORMAL;
}
SvGROW(TARG,2);
}
}
- XPUSHTARG;
- RETURN;
+ SETTARG;
+ return NORMAL;
}
PP(pp_crypt)
if (op_type == OP_LCFIRST) {
/* lower case the first letter: no trickiness for any character */
- *tmpbuf =
#ifdef USE_LOCALE_CTYPE
- (IN_LC_RUNTIME(LC_CTYPE))
- ? toLOWER_LC(*s)
- :
+ if (IN_LC_RUNTIME(LC_CTYPE)) {
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ *tmpbuf = toLOWER_LC(*s);
+ }
+ else
#endif
- (IN_UNI_8_BIT)
- ? toLOWER_LATIN1(*s)
- : toLOWER(*s);
+ {
+ *tmpbuf = (IN_UNI_8_BIT)
+ ? toLOWER_LATIN1(*s)
+ : toLOWER(*s);
+ }
}
- /* is ucfirst() */
#ifdef USE_LOCALE_CTYPE
+ /* is ucfirst() */
else if (IN_LC_RUNTIME(LC_CTYPE)) {
if (IN_UTF8_CTYPE_LOCALE) {
goto do_uni_rules;
}
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
*tmpbuf = (U8) toUPPER_LC(*s); /* This would be a bug if any
locales have upper and title case
different */
if (dest != source && SvTAINTED(source))
SvTAINT(dest);
SvSETMAGIC(dest);
- RETURN;
+ return NORMAL;
}
/* There's so much setup/teardown code common between uc and lc, I wonder if
if (IN_UTF8_CTYPE_LOCALE) {
goto do_uni_rules;
}
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
for (; s < send; d++, s++)
*d = (U8) toUPPER_LC(*s);
}
if (dest != source && SvTAINTED(source))
SvTAINT(dest);
SvSETMAGIC(dest);
- RETURN;
+ return NORMAL;
}
PP(pp_lc)
* whole thing in a tight loop, for speed, */
#ifdef USE_LOCALE_CTYPE
if (IN_LC_RUNTIME(LC_CTYPE)) {
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
for (; s < send; d++, s++)
*d = toLOWER_LC(*s);
}
if (dest != source && SvTAINTED(source))
SvTAINT(dest);
SvSETMAGIC(dest);
- RETURN;
+ return NORMAL;
}
PP(pp_quotemeta)
else
sv_setpvn(TARG, s, len);
SETTARG;
- RETURN;
+ return NORMAL;
}
PP(pp_fc)
if (IN_UTF8_CTYPE_LOCALE) {
goto do_uni_folding;
}
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
for (; s < send; d++, s++)
*d = (U8) toFOLD_LC(*s);
}
HE *entry;
const I32 gimme = GIMME_V;
- PUTBACK;
- /* might clobber stack_sp */
entry = hv_iternext(hash);
- SPAGAIN;
EXTEND(SP, 2);
if (entry) {
SV* const sv = hv_iterkeysv(entry);
- PUSHs(sv); /* won't clobber stack_sp */
+ PUSHs(sv);
if (gimme == G_ARRAY) {
SV *val;
- PUTBACK;
- /* might clobber stack_sp */
val = hv_iterval(hash, entry);
- SPAGAIN;
PUSHs(val);
}
}
MARK++;
SvGETMAGIC(*MARK);
val = newSV(0);
- sv_setsv(val, *MARK);
+ sv_setsv_nomg(val, *MARK);
}
else
{
#ifdef USE_ITHREADS
if (pm->op_pmreplrootu.op_pmtargetoff) {
ary = GvAVn(MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff)));
+ goto have_av;
}
#else
if (pm->op_pmreplrootu.op_pmtargetgv) {
ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
+ goto have_av;
}
#endif
else if (pm->op_targ)
ary = (AV *)PAD_SVl(pm->op_targ);
if (ary) {
+ have_av:
realarray = 1;
PUTBACK;
av_extend(ary,0);
}
}
+PP(pp_anonconst)
+{
+ dSP;
+ dTOPss;
+ SETs(sv_2mortal((SV *)newCONSTSUB(SvTYPE(CopSTASH(PL_curcop))==SVt_PVHV
+ ? CopSTASH(PL_curcop)
+ : NULL,
+ NULL, SvREFCNT_inc_simple_NN(sv))));
+ RETURN;
+}
+
/*
* Local variables:
* c-indentation-style: bsd
https://perl5.git.perl.org / perl5.git / blobdiff