summaryrefslogtreecommitdiff
path: root/pp.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2010-05-21 14:18:21 +0100
committerDavid Mitchell <davem@iabyn.com>2010-05-21 14:18:21 +0100
commit6f1401dc2acd2a2b85df22b0a74e5f7e6e0a33aa (patch)
tree390fdb0620b4c8885249eab601f135442fe97ef6 /pp.c
parentc4648999f2aa0b971b46a580c1258b719394072a (diff)
downloadperl-6f1401dc2acd2a2b85df22b0a74e5f7e6e0a33aa.tar.gz
make overload respect get magic
In most places, ops checked their args for overload *before* doing mg_get(). This meant that, among other issues, tied vars that returned overloaded objects wouldn't trigger calling the overloaded method. (Actually, for tied and arrays and hashes, it still often would since mg_get gets called beforehand in rvalue context). This patch does the following: Makes sure get magic is called first. Moves most of the overload code formerly included by macros at the start of each pp function into the separate helper functions Perl_try_amagic_bin, Perl_try_amagic_un, S_try_amagic_ftest, with 3 new wrapper macros: tryAMAGICbin_MG, tryAMAGICun_MG, tryAMAGICftest_MG. This made the code 3800 bytes smaller. Makes sure that FETCH is not called multiple times. Much of this bit was helped by some earlier work from Father Chrysostomos. Added new functions and macros sv_inc_nomg(), sv_dec_nomg(), dPOPnv_nomg, dPOPXiirl_ul_nomg, dPOPTOPnnrl_nomg, dPOPTOPiirl_ul_nomg dPOPTOPiirl_nomg, SvIV_please_nomg, SvNV_nomg (again, some of these were based on Father Chrysostomos's work). Fixed the list version of the repeat operator (x): it now only calls overloaded methods for the scalar version: (1,2,$overloaded) x 10 no longer erroneously calls x_method($overloaded,10)) The only thing I haven't checked/fixed yet is overloading the iterator operator, <>.
Diffstat (limited to 'pp.c')
-rw-r--r--pp.c395
1 files changed, 221 insertions, 174 deletions
diff --git a/pp.c b/pp.c
index e998e211e9..b346026893 100644
--- a/pp.c
+++ b/pp.c
@@ -911,7 +911,7 @@ PP(pp_postinc)
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
- sv_inc(TOPs);
+ sv_inc_nomg(TOPs);
SvSETMAGIC(TOPs);
/* special case for undef: see thread at 2003-03/msg00536.html in archive */
if (!SvOK(TARG))
@@ -933,7 +933,7 @@ PP(pp_postdec)
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
- sv_dec(TOPs);
+ sv_dec_nomg(TOPs);
SvSETMAGIC(TOPs);
SETs(TARG);
return NORMAL;
@@ -947,17 +947,17 @@ PP(pp_pow)
#ifdef PERL_PRESERVE_IVUV
bool is_int = 0;
#endif
- tryAMAGICbin(pow,opASSIGN);
- svl = sv_2num(TOPm1s);
- svr = sv_2num(TOPs);
+ tryAMAGICbin_MG(pow_amg, AMGf_assign|AMGf_numeric);
+ svr = TOPs;
+ svl = TOPm1s;
#ifdef PERL_PRESERVE_IVUV
/* For integer to integer power, we do the calculation by hand wherever
we're sure it is safe; otherwise we call pow() and try to convert to
integer afterwards. */
{
- SvIV_please(svr);
+ SvIV_please_nomg(svr);
if (SvIOK(svr)) {
- SvIV_please(svl);
+ SvIV_please_nomg(svl);
if (SvIOK(svl)) {
UV power;
bool baseuok;
@@ -1013,7 +1013,7 @@ PP(pp_pow)
}
SP--;
SETn( result );
- SvIV_please(svr);
+ SvIV_please_nomg(svr);
RETURN;
} else {
register unsigned int highbit = 8 * sizeof(UV);
@@ -1062,8 +1062,8 @@ PP(pp_pow)
float_it:
#endif
{
- NV right = SvNV(svr);
- NV left = SvNV(svl);
+ NV right = SvNV_nomg(svr);
+ NV left = SvNV_nomg(svl);
(void)POPs;
#if defined(USE_LONG_DOUBLE) && defined(HAS_AIX_POWL_NEG_BASE_BUG)
@@ -1108,7 +1108,7 @@ PP(pp_pow)
#ifdef PERL_PRESERVE_IVUV
if (is_int)
- SvIV_please(svr);
+ SvIV_please_nomg(svr);
#endif
RETURN;
}
@@ -1117,17 +1117,17 @@ PP(pp_pow)
PP(pp_multiply)
{
dVAR; dSP; dATARGET; SV *svl, *svr;
- tryAMAGICbin(mult,opASSIGN);
- svl = sv_2num(TOPm1s);
- svr = sv_2num(TOPs);
+ tryAMAGICbin_MG(mult_amg, AMGf_assign|AMGf_numeric);
+ svr = TOPs;
+ svl = TOPm1s;
#ifdef PERL_PRESERVE_IVUV
- SvIV_please(svr);
+ SvIV_please_nomg(svr);
if (SvIOK(svr)) {
/* 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. */
/* Left operand is defined, so is it IV? */
- SvIV_please(svl);
+ SvIV_please_nomg(svl);
if (SvIOK(svl)) {
bool auvok = SvUOK(svl);
bool buvok = SvUOK(svr);
@@ -1230,8 +1230,8 @@ PP(pp_multiply)
} /* SvIOK(svr) */
#endif
{
- NV right = SvNV(svr);
- NV left = SvNV(svl);
+ NV right = SvNV_nomg(svr);
+ NV left = SvNV_nomg(svl);
(void)POPs;
SETn( left * right );
RETURN;
@@ -1241,9 +1241,9 @@ PP(pp_multiply)
PP(pp_divide)
{
dVAR; dSP; dATARGET; SV *svl, *svr;
- tryAMAGICbin(div,opASSIGN);
- svl = sv_2num(TOPm1s);
- svr = sv_2num(TOPs);
+ tryAMAGICbin_MG(div_amg, AMGf_assign|AMGf_numeric);
+ svr = TOPs;
+ svl = TOPm1s;
/* Only try to do UV divide first
if ((SLOPPYDIVIDE is true) or
(PERL_PRESERVE_IVUV is true and one or both SV is a UV too large
@@ -1266,9 +1266,9 @@ PP(pp_divide)
#endif
#ifdef PERL_TRY_UV_DIVIDE
- SvIV_please(svr);
+ SvIV_please_nomg(svr);
if (SvIOK(svr)) {
- SvIV_please(svl);
+ SvIV_please_nomg(svl);
if (SvIOK(svl)) {
bool left_non_neg = SvUOK(svl);
bool right_non_neg = SvUOK(svr);
@@ -1348,8 +1348,8 @@ PP(pp_divide)
} /* right wasn't SvIOK */
#endif /* PERL_TRY_UV_DIVIDE */
{
- NV right = SvNV(svr);
- NV left = SvNV(svl);
+ NV right = SvNV_nomg(svr);
+ NV left = SvNV_nomg(svl);
(void)POPs;(void)POPs;
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
if (! Perl_isnan(right) && right == 0.0)
@@ -1364,7 +1364,8 @@ PP(pp_divide)
PP(pp_modulo)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(modulo_amg, AMGf_assign|AMGf_numeric);
{
UV left = 0;
UV right = 0;
@@ -1374,9 +1375,9 @@ PP(pp_modulo)
bool dright_valid = FALSE;
NV dright = 0.0;
NV dleft = 0.0;
- SV * svl;
- SV * const svr = sv_2num(TOPs);
- SvIV_please(svr);
+ SV * const svr = TOPs;
+ SV * const svl = TOPm1s;
+ SvIV_please_nomg(svr);
if (SvIOK(svr)) {
right_neg = !SvUOK(svr);
if (!right_neg) {
@@ -1392,7 +1393,7 @@ PP(pp_modulo)
}
}
else {
- dright = SvNV(svr);
+ dright = SvNV_nomg(svr);
right_neg = dright < 0;
if (right_neg)
dright = -dright;
@@ -1403,13 +1404,11 @@ PP(pp_modulo)
use_double = TRUE;
}
}
- sp--;
/* At this point use_double is only true if right is out of range for
a UV. In range NV has been rounded down to nearest UV and
use_double false. */
- svl = sv_2num(TOPs);
- SvIV_please(svl);
+ SvIV_please_nomg(svl);
if (!use_double && SvIOK(svl)) {
if (SvIOK(svl)) {
left_neg = !SvUOK(svl);
@@ -1427,7 +1426,7 @@ PP(pp_modulo)
}
}
else {
- dleft = SvNV(svl);
+ dleft = SvNV_nomg(svl);
left_neg = dleft < 0;
if (left_neg)
dleft = -dleft;
@@ -1455,7 +1454,7 @@ PP(pp_modulo)
}
}
}
- sp--;
+ sp -= 2;
if (use_double) {
NV dans;
@@ -1496,20 +1495,29 @@ PP(pp_modulo)
PP(pp_repeat)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
- {
+ dVAR; dSP; dATARGET;
register IV count;
- dPOPss;
- SvGETMAGIC(sv);
+ SV *sv;
+
+ if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
+ /* TODO: think of some way of doing list-repeat overloading ??? */
+ sv = POPs;
+ SvGETMAGIC(sv);
+ }
+ else {
+ tryAMAGICbin_MG(repeat_amg, AMGf_assign);
+ sv = POPs;
+ }
+
if (SvIOKp(sv)) {
if (SvUOK(sv)) {
- const UV uv = SvUV(sv);
+ const UV uv = SvUV_nomg(sv);
if (uv > IV_MAX)
count = IV_MAX; /* The best we can do? */
else
count = uv;
} else {
- const IV iv = SvIV(sv);
+ const IV iv = SvIV_nomg(sv);
if (iv < 0)
count = 0;
else
@@ -1517,14 +1525,15 @@ PP(pp_repeat)
}
}
else if (SvNOKp(sv)) {
- const NV nv = SvNV(sv);
+ const NV nv = SvNV_nomg(sv);
if (nv < 0.0)
count = 0;
else
count = (IV)nv;
}
else
- count = SvIV(sv);
+ count = SvIV_nomg(sv);
+
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
static const char oom_list_extend[] = "Out of memory during list extend";
@@ -1582,8 +1591,9 @@ PP(pp_repeat)
static const char oom_string_extend[] =
"Out of memory during string extend";
- SvSetSV(TARG, tmpstr);
- SvPV_force(TARG, len);
+ if (TARG != tmpstr)
+ sv_setsv_nomg(TARG, tmpstr);
+ SvPV_force_nomg(TARG, len);
isutf = DO_UTF8(TARG);
if (count != 1) {
if (count < 1)
@@ -1616,20 +1626,19 @@ PP(pp_repeat)
PUSHTARG;
}
RETURN;
- }
}
PP(pp_subtract)
{
dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr;
- tryAMAGICbin(subtr,opASSIGN);
- svl = sv_2num(TOPm1s);
- svr = sv_2num(TOPs);
+ tryAMAGICbin_MG(subtr_amg, AMGf_assign|AMGf_numeric);
+ svr = TOPs;
+ svl = TOPm1s;
useleft = USE_LEFT(svl);
#ifdef PERL_PRESERVE_IVUV
/* See comments in pp_add (in pp_hot.c) about Overflow, and how
"bad things" happen if you rely on signed integers wrapping. */
- SvIV_please(svr);
+ SvIV_please_nomg(svr);
if (SvIOK(svr)) {
/* 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
@@ -1644,7 +1653,7 @@ PP(pp_subtract)
/* left operand is undef, treat as zero. */
} else {
/* Left operand is defined, so is it IV? */
- SvIV_please(svl);
+ SvIV_please_nomg(svl);
if (SvIOK(svl)) {
if ((auvok = SvUOK(svl)))
auv = SvUVX(svl);
@@ -1727,7 +1736,7 @@ PP(pp_subtract)
}
#endif
{
- NV value = SvNV(svr);
+ NV value = SvNV_nomg(svr);
(void)POPs;
if (!useleft) {
@@ -1735,22 +1744,25 @@ PP(pp_subtract)
SETn(-value);
RETURN;
}
- SETn( SvNV(svl) - value );
+ SETn( SvNV_nomg(svl) - value );
RETURN;
}
}
PP(pp_left_shift)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
+ dVAR; dSP; dATARGET; SV *svl, *svr;
+ tryAMAGICbin_MG(lshift_amg, AMGf_assign);
+ svr = POPs;
+ svl = TOPs;
{
- const IV shift = POPi;
+ const IV shift = SvIV_nomg(svr);
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = TOPi;
+ const IV i = SvIV_nomg(svl);
SETi(i << shift);
}
else {
- const UV u = TOPu;
+ const UV u = SvUV_nomg(svl);
SETu(u << shift);
}
RETURN;
@@ -1759,15 +1771,18 @@ PP(pp_left_shift)
PP(pp_right_shift)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
+ dVAR; dSP; dATARGET; SV *svl, *svr;
+ tryAMAGICbin_MG(rshift_amg, AMGf_assign);
+ svr = POPs;
+ svl = TOPs;
{
- const IV shift = POPi;
+ const IV shift = SvIV_nomg(svr);
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = TOPi;
+ const IV i = SvIV_nomg(svl);
SETi(i >> shift);
}
else {
- const UV u = TOPu;
+ const UV u = SvUV_nomg(svl);
SETu(u >> shift);
}
RETURN;
@@ -1776,11 +1791,12 @@ PP(pp_right_shift)
PP(pp_lt)
{
- dVAR; dSP; tryAMAGICbinSET(lt,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(lt_amg, AMGf_set);
#ifdef PERL_PRESERVE_IVUV
- SvIV_please(TOPs);
+ SvIV_please_nomg(TOPs);
if (SvIOK(TOPs)) {
- SvIV_please(TOPm1s);
+ SvIV_please_nomg(TOPm1s);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
@@ -1836,7 +1852,7 @@ PP(pp_lt)
#ifdef PERL_PRESERVE_IVUV
else
#endif
- if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s)));
RETURN;
@@ -1844,13 +1860,13 @@ PP(pp_lt)
#endif
{
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- dPOPTOPnnrl;
+ dPOPTOPnnrl_nomg;
if (Perl_isnan(left) || Perl_isnan(right))
RETSETNO;
SETs(boolSV(left < right));
#else
- dPOPnv;
- SETs(boolSV(TOPn < value));
+ dPOPnv_nomg;
+ SETs(boolSV(SvNV_nomg(TOPs) < value));
#endif
RETURN;
}
@@ -1858,11 +1874,12 @@ PP(pp_lt)
PP(pp_gt)
{
- dVAR; dSP; tryAMAGICbinSET(gt,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(gt_amg, AMGf_set);
#ifdef PERL_PRESERVE_IVUV
- SvIV_please(TOPs);
+ SvIV_please_nomg(TOPs);
if (SvIOK(TOPs)) {
- SvIV_please(TOPm1s);
+ SvIV_please_nomg(TOPm1s);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
@@ -1919,7 +1936,7 @@ PP(pp_gt)
#ifdef PERL_PRESERVE_IVUV
else
#endif
- if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) > SvRV(TOPp1s)));
RETURN;
@@ -1927,13 +1944,13 @@ PP(pp_gt)
#endif
{
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- dPOPTOPnnrl;
+ dPOPTOPnnrl_nomg;
if (Perl_isnan(left) || Perl_isnan(right))
RETSETNO;
SETs(boolSV(left > right));
#else
- dPOPnv;
- SETs(boolSV(TOPn > value));
+ dPOPnv_nomg;
+ SETs(boolSV(SvNV_nomg(TOPs) > value));
#endif
RETURN;
}
@@ -1941,11 +1958,12 @@ PP(pp_gt)
PP(pp_le)
{
- dVAR; dSP; tryAMAGICbinSET(le,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(le_amg, AMGf_set);
#ifdef PERL_PRESERVE_IVUV
- SvIV_please(TOPs);
+ SvIV_please_nomg(TOPs);
if (SvIOK(TOPs)) {
- SvIV_please(TOPm1s);
+ SvIV_please_nomg(TOPm1s);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
@@ -2002,7 +2020,7 @@ PP(pp_le)
#ifdef PERL_PRESERVE_IVUV
else
#endif
- if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) <= SvRV(TOPp1s)));
RETURN;
@@ -2010,13 +2028,13 @@ PP(pp_le)
#endif
{
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- dPOPTOPnnrl;
+ dPOPTOPnnrl_nomg;
if (Perl_isnan(left) || Perl_isnan(right))
RETSETNO;
SETs(boolSV(left <= right));
#else
- dPOPnv;
- SETs(boolSV(TOPn <= value));
+ dPOPnv_nomg;
+ SETs(boolSV(SvNV_nomg(TOPs) <= value));
#endif
RETURN;
}
@@ -2024,11 +2042,12 @@ PP(pp_le)
PP(pp_ge)
{
- dVAR; dSP; tryAMAGICbinSET(ge,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(ge_amg,AMGf_set);
#ifdef PERL_PRESERVE_IVUV
- SvIV_please(TOPs);
+ SvIV_please_nomg(TOPs);
if (SvIOK(TOPs)) {
- SvIV_please(TOPm1s);
+ SvIV_please_nomg(TOPm1s);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
@@ -2085,7 +2104,7 @@ PP(pp_ge)
#ifdef PERL_PRESERVE_IVUV
else
#endif
- if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) >= SvRV(TOPp1s)));
RETURN;
@@ -2093,13 +2112,13 @@ PP(pp_ge)
#endif
{
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- dPOPTOPnnrl;
+ dPOPTOPnnrl_nomg;
if (Perl_isnan(left) || Perl_isnan(right))
RETSETNO;
SETs(boolSV(left >= right));
#else
- dPOPnv;
- SETs(boolSV(TOPn >= value));
+ dPOPnv_nomg;
+ SETs(boolSV(SvNV_nomg(TOPs) >= value));
#endif
RETURN;
}
@@ -2107,18 +2126,19 @@ PP(pp_ge)
PP(pp_ne)
{
- dVAR; dSP; tryAMAGICbinSET(ne,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(ne_amg,AMGf_set);
#ifndef NV_PRESERVES_UV
- if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) != SvRV(TOPp1s)));
RETURN;
}
#endif
#ifdef PERL_PRESERVE_IVUV
- SvIV_please(TOPs);
+ SvIV_please_nomg(TOPs);
if (SvIOK(TOPs)) {
- SvIV_please(TOPm1s);
+ SvIV_please_nomg(TOPm1s);
if (SvIOK(TOPm1s)) {
const bool auvok = SvUOK(TOPm1s);
const bool buvok = SvUOK(TOPs);
@@ -2169,13 +2189,13 @@ PP(pp_ne)
#endif
{
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- dPOPTOPnnrl;
+ dPOPTOPnnrl_nomg;
if (Perl_isnan(left) || Perl_isnan(right))
RETSETYES;
SETs(boolSV(left != right));
#else
- dPOPnv;
- SETs(boolSV(TOPn != value));
+ dPOPnv_nomg;
+ SETs(boolSV(SvNV_nomg(TOPs) != value));
#endif
RETURN;
}
@@ -2183,9 +2203,10 @@ PP(pp_ne)
PP(pp_ncmp)
{
- dVAR; dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ dVAR; dSP; dTARGET;
+ tryAMAGICbin_MG(ncmp_amg, 0);
#ifndef NV_PRESERVES_UV
- if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
+ if (SvROK(TOPs) && SvROK(TOPm1s) ) {
const UV right = PTR2UV(SvRV(POPs));
const UV left = PTR2UV(SvRV(TOPs));
SETi((left > right) - (left < right));
@@ -2194,9 +2215,9 @@ PP(pp_ncmp)
#endif
#ifdef PERL_PRESERVE_IVUV
/* Fortunately it seems NaN isn't IOK */
- SvIV_please(TOPs);
+ SvIV_please_nomg(TOPs);
if (SvIOK(TOPs)) {
- SvIV_please(TOPm1s);
+ SvIV_please_nomg(TOPm1s);
if (SvIOK(TOPm1s)) {
const bool leftuvok = SvUOK(TOPm1s);
const bool rightuvok = SvUOK(TOPs);
@@ -2259,7 +2280,7 @@ PP(pp_ncmp)
}
#endif
{
- dPOPTOPnnrl;
+ dPOPTOPnnrl_nomg;
I32 value;
#ifdef Perl_isnan
@@ -2312,7 +2333,7 @@ PP(pp_sle)
break;
}
- tryAMAGICbinSET_var(amg_type,0);
+ tryAMAGICbin_MG(amg_type, AMGf_set);
{
dPOPTOPssrl;
const int cmp = (IN_LOCALE_RUNTIME
@@ -2325,7 +2346,8 @@ PP(pp_sle)
PP(pp_seq)
{
- dVAR; dSP; tryAMAGICbinSET(seq,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(seq_amg, AMGf_set);
{
dPOPTOPssrl;
SETs(boolSV(sv_eq(left, right)));
@@ -2335,7 +2357,8 @@ PP(pp_seq)
PP(pp_sne)
{
- dVAR; dSP; tryAMAGICbinSET(sne,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(sne_amg, AMGf_set);
{
dPOPTOPssrl;
SETs(boolSV(!sv_eq(left, right)));
@@ -2345,7 +2368,8 @@ PP(pp_sne)
PP(pp_scmp)
{
- dVAR; dSP; dTARGET; tryAMAGICbin(scmp,0);
+ dVAR; dSP; dTARGET;
+ tryAMAGICbin_MG(scmp_amg, 0);
{
dPOPTOPssrl;
const int cmp = (IN_LOCALE_RUNTIME
@@ -2358,11 +2382,10 @@ PP(pp_scmp)
PP(pp_bit_and)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(band_amg, AMGf_assign);
{
dPOPTOPssrl;
- SvGETMAGIC(left);
- SvGETMAGIC(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
const IV i = SvIV_nomg(left) & SvIV_nomg(right);
@@ -2386,11 +2409,9 @@ PP(pp_bit_or)
dVAR; dSP; dATARGET;
const int op_type = PL_op->op_type;
- tryAMAGICbin_var((op_type == OP_BIT_OR ? bor_amg : bxor_amg), opASSIGN);
+ tryAMAGICbin_MG((op_type == OP_BIT_OR ? bor_amg : bxor_amg), AMGf_assign);
{
dPOPTOPssrl;
- SvGETMAGIC(left);
- SvGETMAGIC(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
const IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0);
@@ -2415,11 +2436,11 @@ PP(pp_bit_or)
PP(pp_negate)
{
- dVAR; dSP; dTARGET; tryAMAGICun(neg);
+ dVAR; dSP; dTARGET;
+ tryAMAGICun_MG(neg_amg, AMGf_numeric);
{
- SV * const sv = sv_2num(TOPs);
+ SV * const sv = TOPs;
const int flags = SvFLAGS(sv);
- SvGETMAGIC(sv);
if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
/* It's publicly an integer, or privately an integer-not-float */
oops_its_an_int:
@@ -2446,56 +2467,57 @@ PP(pp_negate)
#endif
}
if (SvNIOKp(sv))
- SETn(-SvNV(sv));
+ SETn(-SvNV_nomg(sv));
else if (SvPOKp(sv)) {
STRLEN len;
- const char * const s = SvPV_const(sv, len);
+ const char * const s = SvPV_nomg_const(sv, len);
if (isIDFIRST(*s)) {
sv_setpvs(TARG, "-");
sv_catsv(TARG, sv);
}
else if (*s == '+' || *s == '-') {
- sv_setsv(TARG, sv);
- *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
+ sv_setsv_nomg(TARG, sv);
+ *SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-';
}
else if (DO_UTF8(sv)) {
- SvIV_please(sv);
+ SvIV_please_nomg(sv);
if (SvIOK(sv))
goto oops_its_an_int;
if (SvNOK(sv))
- sv_setnv(TARG, -SvNV(sv));
+ sv_setnv(TARG, -SvNV_nomg(sv));
else {
sv_setpvs(TARG, "-");
sv_catsv(TARG, sv);
}
}
else {
- SvIV_please(sv);
+ SvIV_please_nomg(sv);
if (SvIOK(sv))
goto oops_its_an_int;
- sv_setnv(TARG, -SvNV(sv));
+ sv_setnv(TARG, -SvNV_nomg(sv));
}
SETTARG;
}
else
- SETn(-SvNV(sv));
+ SETn(-SvNV_nomg(sv));
}
RETURN;
}
PP(pp_not)
{
- dVAR; dSP; tryAMAGICunSET_var(not_amg);
+ dVAR; dSP;
+ tryAMAGICun_MG(not_amg, AMGf_set);
*PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
return NORMAL;
}
PP(pp_complement)
{
- dVAR; dSP; dTARGET; tryAMAGICun_var(compl_amg);
+ dVAR; dSP; dTARGET;
+ tryAMAGICun_MG(compl_amg, 0);
{
dTOPss;
- SvGETMAGIC(sv);
if (SvNIOKp(sv)) {
if (PL_op->op_private & HINT_INTEGER) {
const IV i = ~SvIV_nomg(sv);
@@ -2513,7 +2535,7 @@ PP(pp_complement)
(void)SvPV_nomg_const(sv,len); /* force check for uninit var */
sv_setsv_nomg(TARG, sv);
- tmps = (U8*)SvPV_force(TARG, len);
+ tmps = (U8*)SvPV_force_nomg(TARG, len);
anum = len;
if (SvUTF8(TARG)) {
/* Calculate exact length, let's not estimate. */
@@ -2594,9 +2616,10 @@ PP(pp_complement)
PP(pp_i_multiply)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(mult_amg, AMGf_assign);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
SETi( left * right );
RETURN;
}
@@ -2605,19 +2628,21 @@ PP(pp_i_multiply)
PP(pp_i_divide)
{
IV num;
- dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(div_amg, AMGf_assign);
{
- dPOPiv;
+ dPOPTOPssrl;
+ IV value = SvIV_nomg(right);
if (value == 0)
DIE(aTHX_ "Illegal division by zero");
- num = POPi;
+ num = SvIV_nomg(left);
/* avoid FPE_INTOVF on some platforms when num is IV_MIN */
if (value == -1)
value = - num;
else
value = num / value;
- PUSHi( value );
+ SETi(value);
RETURN;
}
}
@@ -2630,9 +2655,10 @@ PP(pp_i_modulo)
#endif
{
/* This is the vanilla old i_modulo. */
- dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(modulo_amg, AMGf_assign);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
if (!right)
DIE(aTHX_ "Illegal modulus zero");
/* avoid FPE_INTOVF on some platforms when left is IV_MIN */
@@ -2652,9 +2678,10 @@ PP(pp_i_modulo_1)
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
* See below for pp_i_modulo. */
- dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(modulo_amg, AMGf_assign);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
if (!right)
DIE(aTHX_ "Illegal modulus zero");
/* avoid FPE_INTOVF on some platforms when left is IV_MIN */
@@ -2668,9 +2695,10 @@ PP(pp_i_modulo_1)
PP(pp_i_modulo)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(modulo_amg, AMGf_assign);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
if (!right)
DIE(aTHX_ "Illegal modulus zero");
/* The assumption is to use hereafter the old vanilla version... */
@@ -2711,9 +2739,10 @@ PP(pp_i_modulo)
PP(pp_i_add)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(add_amg, AMGf_assign);
{
- dPOPTOPiirl_ul;
+ dPOPTOPiirl_ul_nomg;
SETi( left + right );
RETURN;
}
@@ -2721,9 +2750,10 @@ PP(pp_i_add)
PP(pp_i_subtract)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ dVAR; dSP; dATARGET;
+ tryAMAGICbin_MG(subtr_amg, AMGf_assign);
{
- dPOPTOPiirl_ul;
+ dPOPTOPiirl_ul_nomg;
SETi( left - right );
RETURN;
}
@@ -2731,9 +2761,10 @@ PP(pp_i_subtract)
PP(pp_i_lt)
{
- dVAR; dSP; tryAMAGICbinSET(lt,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(lt_amg, AMGf_set);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
SETs(boolSV(left < right));
RETURN;
}
@@ -2741,9 +2772,10 @@ PP(pp_i_lt)
PP(pp_i_gt)
{
- dVAR; dSP; tryAMAGICbinSET(gt,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(gt_amg, AMGf_set);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
SETs(boolSV(left > right));
RETURN;
}
@@ -2751,9 +2783,10 @@ PP(pp_i_gt)
PP(pp_i_le)
{
- dVAR; dSP; tryAMAGICbinSET(le,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(le_amg, AMGf_set);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
SETs(boolSV(left <= right));
RETURN;
}
@@ -2761,9 +2794,10 @@ PP(pp_i_le)
PP(pp_i_ge)
{
- dVAR; dSP; tryAMAGICbinSET(ge,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(ge_amg, AMGf_set);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
SETs(boolSV(left >= right));
RETURN;
}
@@ -2771,9 +2805,10 @@ PP(pp_i_ge)
PP(pp_i_eq)
{
- dVAR; dSP; tryAMAGICbinSET(eq,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(eq_amg, AMGf_set);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
SETs(boolSV(left == right));
RETURN;
}
@@ -2781,9 +2816,10 @@ PP(pp_i_eq)
PP(pp_i_ne)
{
- dVAR; dSP; tryAMAGICbinSET(ne,0);
+ dVAR; dSP;
+ tryAMAGICbin_MG(ne_amg, AMGf_set);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
SETs(boolSV(left != right));
RETURN;
}
@@ -2791,9 +2827,10 @@ PP(pp_i_ne)
PP(pp_i_ncmp)
{
- dVAR; dSP; dTARGET; tryAMAGICbin(ncmp,0);
+ dVAR; dSP; dTARGET;
+ tryAMAGICbin_MG(ncmp_amg, 0);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_nomg;
I32 value;
if (left > right)
@@ -2809,18 +2846,24 @@ PP(pp_i_ncmp)
PP(pp_i_negate)
{
- dVAR; dSP; dTARGET; tryAMAGICun(neg);
- SETi(-TOPi);
- RETURN;
+ dVAR; dSP; dTARGET;
+ tryAMAGICun_MG(neg_amg, 0);
+ {
+ SV * const sv = TOPs;
+ IV const i = SvIV_nomg(sv);
+ SETi(-i);
+ RETURN;
+ }
}
/* High falutin' math. */
PP(pp_atan2)
{
- dVAR; dSP; dTARGET; tryAMAGICbin(atan2,0);
+ dVAR; dSP; dTARGET;
+ tryAMAGICbin_MG(atan2_amg, 0);
{
- dPOPTOPnnrl;
+ dPOPTOPnnrl_nomg;
SETn(Perl_atan2(left, right));
RETURN;
}
@@ -2855,9 +2898,11 @@ PP(pp_sin)
break;
}
- tryAMAGICun_var(amg_type);
+
+ tryAMAGICun_MG(amg_type, 0);
{
- const NV value = POPn;
+ SV * const arg = POPs;
+ const NV value = SvNV_nomg(arg);
if (neg_report) {
if (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)) {
SET_NUMERIC_STANDARD();
@@ -2915,10 +2960,11 @@ PP(pp_srand)
PP(pp_int)
{
- dVAR; dSP; dTARGET; tryAMAGICun(int);
+ dVAR; dSP; dTARGET;
+ tryAMAGICun_MG(int_amg, AMGf_numeric);
{
- SV * const sv = sv_2num(TOPs);
- const IV iv = SvIV(sv);
+ SV * const sv = TOPs;
+ const IV iv = SvIV_nomg(sv);
/* XXX it's arguable that compiler casting to IV might be subtly
different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
else preferring IV has introduced a subtle behaviour change bug. OTOH
@@ -2929,12 +2975,12 @@ PP(pp_int)
}
else if (SvIOK(sv)) {
if (SvIsUV(sv))
- SETu(SvUV(sv));
+ SETu(SvUV_nomg(sv));
else
SETi(iv);
}
else {
- const NV value = SvNV(sv);
+ const NV value = SvNV_nomg(sv);
if (value >= 0.0) {
if (value < (NV)UV_MAX + 0.5) {
SETu(U_V(value));
@@ -2956,11 +3002,12 @@ PP(pp_int)
PP(pp_abs)
{
- dVAR; dSP; dTARGET; tryAMAGICun(abs);
+ dVAR; dSP; dTARGET;
+ tryAMAGICun_MG(abs_amg, AMGf_numeric);
{
- SV * const sv = sv_2num(TOPs);
+ SV * const sv = TOPs;
/* This will cache the NV value if string isn't actually integer */
- const IV iv = SvIV(sv);
+ const IV iv = SvIV_nomg(sv);
if (!SvOK(sv)) {
SETu(0);
@@ -2968,7 +3015,7 @@ PP(pp_abs)
else if (SvIOK(sv)) {
/* IVX is precise */
if (SvIsUV(sv)) {
- SETu(SvUV(sv)); /* force it to be numeric only */
+ SETu(SvUV_nomg(sv)); /* force it to be numeric only */
} else {
if (iv >= 0) {
SETi(iv);
@@ -2983,7 +3030,7 @@ PP(pp_abs)
}
}
} else{
- const NV value = SvNV(sv);
+ const NV value = SvNV_nomg(sv);
if (value < 0.0)
SETn(-value);
else