diff options
author | David Mitchell <davem@iabyn.com> | 2010-05-21 14:18:21 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2010-05-21 14:18:21 +0100 |
commit | 6f1401dc2acd2a2b85df22b0a74e5f7e6e0a33aa (patch) | |
tree | 390fdb0620b4c8885249eab601f135442fe97ef6 /pp.c | |
parent | c4648999f2aa0b971b46a580c1258b719394072a (diff) | |
download | perl-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.c | 395 |
1 files changed, 221 insertions, 174 deletions
@@ -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 |