Fix overloading for 64-bit ints (revised)

From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <1ff86f510710181149s1c096dd9qffa8fe42046e675b@mail.gmail.com>

p4raw-id: //depot/perl@32141

10 files changed, 395 insertions, 101 deletions

diff --git a/MANIFEST b/MANIFEST
index d85ca32c4f..e25143ab3c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2287,6 +2287,7 @@ lib/open2.pl			Open a two-ended pipe (uses IPC::Open2)
 lib/open3.pl			Open a three-ended pipe (uses IPC::Open3)
 lib/open.pm			Pragma to specify default I/O layers
 lib/open.t			See if the open pragma works
+lib/overload64.t		See if operator overloading works with 64-bit ints
 lib/overload.pm			Module for overloading perl operators
 lib/overload.t			See if operator overloading works
 lib/Package/Constants.pm	Package::Constants
diff --git a/embed.fnc b/embed.fnc
index 89fa7ea8a9..fd145ad455 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -815,6 +815,7 @@ Amb	|IV	|sv_2iv		|NN SV* sv
 Apd	|IV	|sv_2iv_flags	|NN SV* sv|I32 flags
 Apd	|SV*	|sv_2mortal	|NULLOK SV* sv
 Apd	|NV	|sv_2nv		|NN SV* sv
+pMd	|SV*	|sv_2num	|NN SV* sv
 Amb	|char*	|sv_2pv		|NN SV* sv|NULLOK STRLEN* lp
 Apd	|char*	|sv_2pv_flags	|NN SV* sv|NULLOK STRLEN* lp|I32 flags
 Apd	|char*	|sv_2pvutf8	|NN SV* sv|NULLOK STRLEN* lp
diff --git a/embed.h b/embed.h
index 57f6185ea1..eba13051de 100644
--- a/embed.h
+++ b/embed.h
@@ -835,6 +835,9 @@
 #define sv_2iv_flags		Perl_sv_2iv_flags
 #define sv_2mortal		Perl_sv_2mortal
 #define sv_2nv			Perl_sv_2nv
+#ifdef PERL_CORE
+#define sv_2num			Perl_sv_2num
+#endif
 #define sv_2pv_flags		Perl_sv_2pv_flags
 #define sv_2pvutf8		Perl_sv_2pvutf8
 #define sv_2pvbyte		Perl_sv_2pvbyte
@@ -3117,6 +3120,9 @@
 #define sv_2iv_flags(a,b)	Perl_sv_2iv_flags(aTHX_ a,b)
 #define sv_2mortal(a)		Perl_sv_2mortal(aTHX_ a)
 #define sv_2nv(a)		Perl_sv_2nv(aTHX_ a)
+#ifdef PERL_CORE
+#define sv_2num(a)		Perl_sv_2num(aTHX_ a)
+#endif
 #define sv_2pv_flags(a,b,c)	Perl_sv_2pv_flags(aTHX_ a,b,c)
 #define sv_2pvutf8(a,b)		Perl_sv_2pvutf8(aTHX_ a,b)
 #define sv_2pvbyte(a,b)		Perl_sv_2pvbyte(aTHX_ a,b)
diff --git a/lib/overload.t b/lib/overload.t
index 29411e1a4b..94cd296b44 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
 package main;
 
 $| = 1;
-use Test::More tests => 536;
+use Test::More tests => 556;
 
 
 $a = new Oscalar "087";
@@ -1384,7 +1384,7 @@ foreach my $op (qw(<=> == != < <= > >=)) {
     package numify_other;
     use overload "0+" => sub { $_[0][0]++; $_[0][1] = bless [], 'numify_int' };
     package numify_by_fallback;
-    use overload "-" => sub { 1 }, fallback => 1;
+    use overload fallback => 1;
 
     package main;
     my $o = bless [], 'numify_int';
@@ -1404,4 +1404,27 @@ foreach my $op (qw(<=> == != < <= > >=)) {
 
     my $m = bless $aref, 'numify_by_fallback';
     is(int($m), $num_val, 'numifies to usual reference value');
+    is(abs($m), $num_val, 'numifies to usual reference value');
+    is(-$m, -$num_val, 'numifies to usual reference value');
+    is(0+$m, $num_val, 'numifies to usual reference value');
+    is($m+0, $num_val, 'numifies to usual reference value');
+    is($m+$m, 2*$num_val, 'numifies to usual reference value');
+    is(0-$m, -$num_val, 'numifies to usual reference value');
+    is(1*$m, $num_val, 'numifies to usual reference value');
+    is($m/1, $num_val, 'numifies to usual reference value');
+    is($m%100, $num_val%100, 'numifies to usual reference value');
+    is($m**1, $num_val, 'numifies to usual reference value');
+
+    is(abs($aref), $num_val, 'abs() of ref');
+    is(-$aref, -$num_val, 'negative of ref');
+    is(0+$aref, $num_val, 'ref addition');
+    is($aref+0, $num_val, 'ref addition');
+    is($aref+$aref, 2*$num_val, 'ref addition');
+    is(0-$aref, -$num_val, 'subtraction of ref');
+    is(1*$aref, $num_val, 'multiplicaton of ref');
+    is($aref/1, $num_val, 'division of ref');
+    is($aref%100, $num_val%100, 'modulo of ref');
+    is($aref**1, $num_val, 'exponentiation of ref');
 }
+
+# EOF
diff --git a/lib/overload64.t b/lib/overload64.t
new file mode 100644
index 0000000000..f4b0cb050f
--- /dev/null
+++ b/lib/overload64.t
@@ -0,0 +1,216 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config;
+    if ($Config::Config{'uvsize'} != 8) {
+        print "1..0 # Skip -- Perl configured with 32-bit ints\n";
+        exit 0;
+    }
+}
+
+$| = 1;
+use Test::More 'tests' => 100;
+
+
+my $ii = 36028797018963971;  # 2^55 + 3
+
+
+### Tests with numerifying large positive int
+{ package Oobj;
+    use overload '0+' => sub { ${$_[0]} += 1; $ii },
+                 'fallback' => 1;
+}
+my $oo = bless(\do{my $x = 0}, 'Oobj');
+my $cnt = 1;
+
+is("$oo", "$ii", '0+ overload with stringification');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo>>3, $ii>>3, '0+ overload with bit shift right');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo<<2, $ii<<2, '0+ overload with bit shift left');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo|0xFF00, $ii|0xFF00, '0+ overload with bitwise or');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo&0xFF03, $ii&0xFF03, '0+ overload with bitwise and');
+is($$oo, $cnt++, 'overload called once');
+
+ok($oo == $ii, '0+ overload with equality');
+is($$oo, $cnt++, 'overload called once');
+
+is(int($oo), $ii, '0+ overload with int()');
+is($$oo, $cnt++, 'overload called once');
+
+is(abs($oo), $ii, '0+ overload with abs()');
+is($$oo, $cnt++, 'overload called once');
+
+is(-$oo, -$ii, '0+ overload with unary minus');
+is($$oo, $cnt++, 'overload called once');
+
+is(0+$oo, $ii, '0+ overload with addition');
+is($$oo, $cnt++, 'overload called once');
+is($oo+0, $ii, '0+ overload with addition');
+is($$oo, $cnt++, 'overload called once');
+is($oo+$oo, 2*$ii, '0+ overload with addition');
+$cnt++;
+is($$oo, $cnt++, 'overload called once');
+
+is(0-$oo, -$ii, '0+ overload with subtraction');
+is($$oo, $cnt++, 'overload called once');
+is($oo-99, $ii-99, '0+ overload with subtraction');
+is($$oo, $cnt++, 'overload called once');
+
+is(2*$oo, 2*$ii, '0+ overload with multiplication');
+is($$oo, $cnt++, 'overload called once');
+is($oo*3, 3*$ii, '0+ overload with multiplication');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo/1, $ii, '0+ overload with division');
+is($$oo, $cnt++, 'overload called once');
+is($ii/$oo, 1, '0+ overload with division');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo%100, $ii%100, '0+ overload with modulo');
+is($$oo, $cnt++, 'overload called once');
+is($ii%$oo, 0, '0+ overload with modulo');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo**1, $ii, '0+ overload with exponentiation');
+is($$oo, $cnt++, 'overload called once');
+
+
+### Tests with numerifying large negative int
+{ package Oobj2;
+    use overload '0+' => sub { ${$_[0]} += 1; -$ii },
+                 'fallback' => 1;
+}
+$oo = bless(\do{my $x = 0}, 'Oobj2');
+$cnt = 1;
+
+is(int($oo), -$ii, '0+ overload with int()');
+is($$oo, $cnt++, 'overload called once');
+
+is(abs($oo), $ii, '0+ overload with abs()');
+is($$oo, $cnt++, 'overload called once');
+
+is(-$oo, $ii, '0+ overload with unary -');
+is($$oo, $cnt++, 'overload called once');
+
+is(0+$oo, -$ii, '0+ overload with addition');
+is($$oo, $cnt++, 'overload called once');
+is($oo+0, -$ii, '0+ overload with addition');
+is($$oo, $cnt++, 'overload called once');
+is($oo+$oo, -2*$ii, '0+ overload with addition');
+$cnt++;
+is($$oo, $cnt++, 'overload called once');
+
+is(0-$oo, $ii, '0+ overload with subtraction');
+is($$oo, $cnt++, 'overload called once');
+
+is(2*$oo, -2*$ii, '0+ overload with multiplication');
+is($$oo, $cnt++, 'overload called once');
+is($oo*3, -3*$ii, '0+ overload with multiplication');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo/1, -$ii, '0+ overload with division');
+is($$oo, $cnt++, 'overload called once');
+is($ii/$oo, -1, '0+ overload with division');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo%100, (-$ii)%100, '0+ overload with modulo');
+is($$oo, $cnt++, 'overload called once');
+is($ii%$oo, 0, '0+ overload with modulo');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo**1, -$ii, '0+ overload with exponentiation');
+is($$oo, $cnt++, 'overload called once');
+
+### Tests with overloading but no fallback
+{ package Oobj3;
+    use overload
+        'int' => sub { ${$_[0]} += 1; $ii },
+        'abs' => sub { ${$_[0]} += 1; $ii },
+        'neg' => sub { ${$_[0]} += 1; -$ii },
+        '+' => sub {
+            ${$_[0]} += 1;
+            my $res = (ref($_[0]) eq __PACKAGE__) ? $ii : $_[0];
+            $res   += (ref($_[1]) eq __PACKAGE__) ? $ii : $_[1];
+        },
+        '-' => sub {
+            ${$_[0]} += 1;
+            my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1);
+            my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l];
+            $res   -= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r];
+        },
+        '*' => sub {
+            ${$_[0]} += 1;
+            my $res = (ref($_[0]) eq __PACKAGE__) ? $ii : $_[0];
+            $res   *= (ref($_[1]) eq __PACKAGE__) ? $ii : $_[1];
+        },
+        '/' => sub {
+            ${$_[0]} += 1;
+            my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1);
+            my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii+1 : $_[$l];
+            $res   /= (ref($_[$r]) eq __PACKAGE__) ? $ii+1 : $_[$r];
+        },
+        '%' => sub {
+            ${$_[0]} += 1;
+            my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1);
+            my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l];
+            $res   %= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r];
+        },
+        '**' => sub {
+            ${$_[0]} += 1;
+            my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1);
+            my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l];
+            $res  **= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r];
+        },
+}
+$oo = bless(\do{my $x = 0}, 'Oobj3');
+$cnt = 1;
+
+is(int($oo), $ii, 'int() overload');
+is($$oo, $cnt++, 'overload called once');
+
+is(abs($oo), $ii, 'abs() overload');
+is($$oo, $cnt++, 'overload called once');
+
+is(-$oo, -$ii, 'neg overload');
+is($$oo, $cnt++, 'overload called once');
+
+is(0+$oo, $ii, '+ overload');
+is($$oo, $cnt++, 'overload called once');
+is($oo+0, $ii, '+ overload');
+is($$oo, $cnt++, 'overload called once');
+is($oo+$oo, 2*$ii, '+ overload');
+is($$oo, $cnt++, 'overload called once');
+
+is(0-$oo, -$ii, '- overload');
+is($$oo, $cnt++, 'overload called once');
+is($oo-99, $ii-99, '- overload');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo*2, 2*$ii, '* overload');
+is($$oo, $cnt++, 'overload called once');
+is(-3*$oo, -3*$ii, '* overload');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo/2, ($ii+1)/2, '/ overload');
+is($$oo, $cnt++, 'overload called once');
+is(($ii+1)/$oo, 1, '/ overload');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo%100, $ii%100, '% overload');
+is($$oo, $cnt++, 'overload called once');
+is($ii%$oo, 0, '% overload');
+is($$oo, $cnt++, 'overload called once');
+
+is($oo**1, $ii, '** overload');
+is($$oo, $cnt++, 'overload called once');
+
+# EOF
diff --git a/pod/perlintern.pod b/pod/perlintern.pod
index 54fffe694b..272e5d4fb5 100644
--- a/pod/perlintern.pod
+++ b/pod/perlintern.pod
@@ -1038,6 +1038,24 @@ Found in file sv.c
 
 =back
 
+=head1 SV-Body Allocation
+
+=over 8
+
+=item sv_2num
+X<sv_2num>
+
+Return an SV with the numeric value of the source SV, doing any necessary
+reference or overload conversion.
+
+	SV*	sv_2num(SV* sv)
+
+=for hackers
+Found in file sv.c
+
+
+=back
+
 =head1 Unicode Support
 
 =over 8
diff --git a/pp.c b/pp.c
index d5337384b5..cd04198351 100644
--- a/pp.c
+++ b/pp.c
@@ -921,28 +921,30 @@ PP(pp_postdec)
 
 PP(pp_pow)
 {
-    dVAR; dSP; dATARGET;
+    dVAR; dSP; dATARGET; SV *svl, *svr;
 #ifdef PERL_PRESERVE_IVUV
     bool is_int = 0;
 #endif
     tryAMAGICbin(pow,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
 #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(TOPs);
-	if (SvIOK(TOPs)) {
-	    SvIV_please(TOPm1s);
-	    if (SvIOK(TOPm1s)) {
+	SvIV_please(svr);
+	if (SvIOK(svr)) {
+	    SvIV_please(svl);
+	    if (SvIOK(svl)) {
 		UV power;
 		bool baseuok;
 		UV baseuv;
 
-		if (SvUOK(TOPs)) {
-		    power = SvUVX(TOPs);
+		if (SvUOK(svr)) {
+		    power = SvUVX(svr);
 		} else {
-		    const IV iv = SvIVX(TOPs);
+		    const IV iv = SvIVX(svr);
 		    if (iv >= 0) {
 			power = iv;
 		    } else {
@@ -950,11 +952,11 @@ PP(pp_pow)
 		    }
 		}
 
-		baseuok = SvUOK(TOPm1s);
+		baseuok = SvUOK(svl);
 		if (baseuok) {
-		    baseuv = SvUVX(TOPm1s);
+		    baseuv = SvUVX(svl);
 		} else {
-		    const IV iv = SvIVX(TOPm1s);
+		    const IV iv = SvIVX(svl);
 		    if (iv >= 0) {
 			baseuv = iv;
 			baseuok = TRUE; /* effectively it's a UV now */
@@ -989,7 +991,7 @@ PP(pp_pow)
 		    }
                     SP--;
                     SETn( result );
-                    SvIV_please(TOPs);
+                    SvIV_please(svr);
                     RETURN;
 		} else {
 		    register unsigned int highbit = 8 * sizeof(UV);
@@ -1082,7 +1084,7 @@ PP(pp_pow)
 
 #ifdef PERL_PRESERVE_IVUV
 	if (is_int)
-	    SvIV_please(TOPs);
+	    SvIV_please(svr);
 #endif
 	RETURN;
     }
@@ -1090,18 +1092,21 @@ PP(pp_pow)
 
 PP(pp_multiply)
 {
-    dVAR; dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+    dVAR; dSP; dATARGET; SV *svl, *svr;
+    tryAMAGICbin(mult,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
 #ifdef PERL_PRESERVE_IVUV
-    SvIV_please(TOPs);
-    if (SvIOK(TOPs)) {
+    SvIV_please(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(TOPm1s);
-	if (SvIOK(TOPm1s)) {
-	    bool auvok = SvUOK(TOPm1s);
-	    bool buvok = SvUOK(TOPs);
+	SvIV_please(svl);
+	if (SvIOK(svl)) {
+	    bool auvok = SvUOK(svl);
+	    bool buvok = SvUOK(svr);
 	    const UV topmask = (~ (UV)0) << (4 * sizeof (UV));
 	    const UV botmask = ~((~ (UV)0) << (4 * sizeof (UV)));
 	    UV alow;
@@ -1110,9 +1115,9 @@ PP(pp_multiply)
 	    UV bhigh;
 
 	    if (auvok) {
-		alow = SvUVX(TOPm1s);
+		alow = SvUVX(svl);
 	    } else {
-		const IV aiv = SvIVX(TOPm1s);
+		const IV aiv = SvIVX(svl);
 		if (aiv >= 0) {
 		    alow = aiv;
 		    auvok = TRUE; /* effectively it's a UV now */
@@ -1121,9 +1126,9 @@ PP(pp_multiply)
 		}
 	    }
 	    if (buvok) {
-		blow = SvUVX(TOPs);
+		blow = SvUVX(svr);
 	    } else {
-		const IV biv = SvIVX(TOPs);
+		const IV biv = SvIVX(svr);
 		if (biv >= 0) {
 		    blow = biv;
 		    buvok = TRUE; /* effectively it's a UV now */
@@ -1197,8 +1202,8 @@ PP(pp_multiply)
 		    }
 		} /* product_middle too large */
 	    } /* ahigh && bhigh */
-	} /* SvIOK(TOPm1s) */
-    } /* SvIOK(TOPs) */
+	} /* SvIOK(svl) */
+    } /* SvIOK(svr) */
 #endif
     {
       dPOPTOPnnrl;
@@ -1209,7 +1214,10 @@ PP(pp_multiply)
 
 PP(pp_divide)
 {
-    dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+    dVAR; dSP; dATARGET; SV *svl, *svr;
+    tryAMAGICbin(div,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
     /* 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
@@ -1232,20 +1240,20 @@ PP(pp_divide)
 #endif
 
 #ifdef PERL_TRY_UV_DIVIDE
-    SvIV_please(TOPs);
-    if (SvIOK(TOPs)) {
-        SvIV_please(TOPm1s);
-        if (SvIOK(TOPm1s)) {
-            bool left_non_neg = SvUOK(TOPm1s);
-            bool right_non_neg = SvUOK(TOPs);
+    SvIV_please(svr);
+    if (SvIOK(svr)) {
+        SvIV_please(svl);
+        if (SvIOK(svl)) {
+            bool left_non_neg = SvUOK(svl);
+            bool right_non_neg = SvUOK(svr);
             UV left;
             UV right;
 
             if (right_non_neg) {
-                right = SvUVX(TOPs);
+                right = SvUVX(svr);
             }
 	    else {
-		const IV biv = SvIVX(TOPs);
+		const IV biv = SvIVX(svr);
                 if (biv >= 0) {
                     right = biv;
                     right_non_neg = TRUE; /* effectively it's a UV now */
@@ -1263,10 +1271,10 @@ PP(pp_divide)
                 DIE(aTHX_ "Illegal division by zero");
 
             if (left_non_neg) {
-                left = SvUVX(TOPm1s);
+                left = SvUVX(svl);
             }
 	    else {
-		const IV aiv = SvIVX(TOPm1s);
+		const IV aiv = SvIVX(svl);
                 if (aiv >= 0) {
                     left = aiv;
                     left_non_neg = TRUE; /* effectively it's a UV now */
@@ -1338,14 +1346,15 @@ PP(pp_modulo)
 	bool dright_valid = FALSE;
 	NV dright = 0.0;
 	NV dleft  = 0.0;
-
-        SvIV_please(TOPs);
-        if (SvIOK(TOPs)) {
-            right_neg = !SvUOK(TOPs);
+        SV * svl;
+        SV * const svr = sv_2num(TOPs);
+        SvIV_please(svr);
+        if (SvIOK(svr)) {
+            right_neg = !SvUOK(svr);
             if (!right_neg) {
-                right = SvUVX(POPs);
+                right = SvUVX(svr);
             } else {
-		const IV biv = SvIVX(POPs);
+		const IV biv = SvIVX(svr);
                 if (biv >= 0) {
                     right = biv;
                     right_neg = FALSE; /* effectively it's a UV now */
@@ -1353,6 +1362,7 @@ PP(pp_modulo)
                     right = -biv;
                 }
             }
+            sp--;
         }
         else {
 	    dright = POPn;
@@ -1370,14 +1380,15 @@ PP(pp_modulo)
         /* 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.  */
-        SvIV_please(TOPs);
-	if (!use_double && SvIOK(TOPs)) {
-            if (SvIOK(TOPs)) {
-                left_neg = !SvUOK(TOPs);
+        svl = sv_2num(TOPs);
+        SvIV_please(svl);
+	if (!use_double && SvIOK(svl)) {
+            if (SvIOK(svl)) {
+                left_neg = !SvUOK(svl);
                 if (!left_neg) {
-                    left = SvUVX(POPs);
+                    left = SvUVX(svl);
                 } else {
-		    const IV aiv = SvIVX(POPs);
+		    const IV aiv = SvIVX(svl);
                     if (aiv >= 0) {
                         left = aiv;
                         left_neg = FALSE; /* effectively it's a UV now */
@@ -1385,6 +1396,7 @@ PP(pp_modulo)
                         left = -aiv;
                     }
                 }
+                sp--;
             }
         }
 	else {
@@ -1581,13 +1593,16 @@ PP(pp_repeat)
 
 PP(pp_subtract)
 {
-    dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
-    useleft = USE_LEFT(TOPm1s);
+    dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr;
+    tryAMAGICbin(subtr,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
+    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(TOPs);
-    if (SvIOK(TOPs)) {
+    SvIV_please(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.  */
@@ -1601,12 +1616,12 @@ PP(pp_subtract)
 	    /* left operand is undef, treat as zero.  */
 	} else {
 	    /* Left operand is defined, so is it IV? */
-	    SvIV_please(TOPm1s);
-	    if (SvIOK(TOPm1s)) {
-		if ((auvok = SvUOK(TOPm1s)))
-		    auv = SvUVX(TOPm1s);
+	    SvIV_please(svl);
+	    if (SvIOK(svl)) {
+		if ((auvok = SvUOK(svl)))
+		    auv = SvUVX(svl);
 		else {
-		    register const IV aiv = SvIVX(TOPm1s);
+		    register const IV aiv = SvIVX(svl);
 		    if (aiv >= 0) {
 			auv = aiv;
 			auvok = 1;	/* Now acting as a sign flag.  */
@@ -1621,12 +1636,12 @@ PP(pp_subtract)
 	    bool result_good = 0;
 	    UV result;
 	    register UV buv;
-	    bool buvok = SvUOK(TOPs);
+	    bool buvok = SvUOK(svr);
 	
 	    if (buvok)
-		buv = SvUVX(TOPs);
+		buv = SvUVX(svr);
 	    else {
-		register const IV biv = SvIVX(TOPs);
+		register const IV biv = SvIVX(svr);
 		if (biv >= 0) {
 		    buv = biv;
 		    buvok = 1;
@@ -1683,7 +1698,6 @@ PP(pp_subtract)
 	}
     }
 #endif
-    useleft = USE_LEFT(TOPm1s);
     {
 	dPOPnv;
 	if (!useleft) {
@@ -2373,7 +2387,7 @@ PP(pp_negate)
 {
     dVAR; dSP; dTARGET; tryAMAGICun(neg);
     {
-	dTOPss;
+	SV * const sv = sv_2num(TOPs);
 	const int flags = SvFLAGS(sv);
 	SvGETMAGIC(sv);
 	if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
@@ -2874,26 +2888,13 @@ PP(pp_int)
 {
     dVAR; dSP; dTARGET; tryAMAGICun(int);
     {
-      dTOPss;
-      IV iv;
+      SV * const sv = sv_2num(TOPs);
+      const IV iv = SvIV(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
 	 relying on floating point to be accurate is a bug.  */
 
-      while (SvAMAGIC(sv)) {
-	SV *tsv = AMG_CALLun(sv,numer);
-	if (!tsv)
-	    break;
-	if (SvROK(tsv) && SvRV(tsv) == SvRV(sv)) {
-	    SETu(PTR2UV(SvRV(sv)));
-	    RETURN;
-	}
-	else
-	    sv = tsv;
-      }
-      iv = SvIV(sv); /* attempt to convert to IV if possible. */
-
       if (!SvOK(sv)) {
         SETu(0);
       }
@@ -2903,9 +2904,6 @@ PP(pp_int)
 	else
 	    SETi(iv);
       }
-      else if (SvROK(sv)) {
-	    SETu(PTR2UV(SvRV(sv)));
-      }
       else {
 	  const NV value = SvNV(sv);
 	  if (value >= 0.0) {
@@ -2931,15 +2929,17 @@ PP(pp_abs)
 {
     dVAR; dSP; dTARGET; tryAMAGICun(abs);
     {
+      SV * const sv = sv_2num(TOPs);
       /* This will cache the NV value if string isn't actually integer  */
-      const IV iv = TOPi;
+      const IV iv = SvIV(sv);
 
-      if (!SvOK(TOPs))
+      if (!SvOK(sv)) {
         SETu(0);
-      else if (SvIOK(TOPs)) {
+      }
+      else if (SvIOK(sv)) {
 	/* IVX is precise  */
-	if (SvIsUV(TOPs)) {
-	  SETu(TOPu);	/* force it to be numeric only */
+	if (SvIsUV(sv)) {
+	  SETu(SvUV(sv));	/* force it to be numeric only */
 	} else {
 	  if (iv >= 0) {
 	    SETi(iv);
@@ -2954,7 +2954,7 @@ PP(pp_abs)
 	  }
 	}
       } else{
-	const NV value = TOPn;
+	const NV value = SvNV(sv);
 	if (value < 0.0)
 	  SETn(-value);
 	else
diff --git a/pp_hot.c b/pp_hot.c
index 423c4c8e76..17eb6f2917 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -496,8 +496,11 @@ PP(pp_defined)
 
 PP(pp_add)
 {
-    dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN);
-    useleft = USE_LEFT(TOPm1s);
+    dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr;
+    tryAMAGICbin(add,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
+    useleft = USE_LEFT(svl);
 #ifdef PERL_PRESERVE_IVUV
     /* We must see if we can perform the addition with integers if possible,
        as the integer code detects overflow while the NV code doesn't.
@@ -545,8 +548,8 @@ PP(pp_add)
        unsigned code below is actually shorter than the old code. :-)
     */
 
-    SvIV_please(TOPs);
-    if (SvIOK(TOPs)) {
+    SvIV_please(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.  */
@@ -562,12 +565,12 @@ PP(pp_add)
 	       lots of code to speed up what is probably a rarish case.  */
 	} else {
 	    /* Left operand is defined, so is it IV? */
-	    SvIV_please(TOPm1s);
-	    if (SvIOK(TOPm1s)) {
-		if ((auvok = SvUOK(TOPm1s)))
-		    auv = SvUVX(TOPm1s);
+	    SvIV_please(svl);
+	    if (SvIOK(svl)) {
+		if ((auvok = SvUOK(svl)))
+		    auv = SvUVX(svl);
 		else {
-		    register const IV aiv = SvIVX(TOPm1s);
+		    register const IV aiv = SvIVX(svl);
 		    if (aiv >= 0) {
 			auv = aiv;
 			auvok = 1;	/* Now acting as a sign flag.  */
@@ -582,12 +585,12 @@ PP(pp_add)
 	    bool result_good = 0;
 	    UV result;
 	    register UV buv;
-	    bool buvok = SvUOK(TOPs);
+	    bool buvok = SvUOK(svr);
 	
 	    if (buvok)
-		buv = SvUVX(TOPs);
+		buv = SvUVX(svr);
 	    else {
-		register const IV biv = SvIVX(TOPs);
+		register const IV biv = SvIVX(svr);
 		if (biv >= 0) {
 		    buv = biv;
 		    buvok = 1;
diff --git a/proto.h b/proto.h
index 7adaac7b17..19cfb10223 100644
--- a/proto.h
+++ b/proto.h
@@ -2179,6 +2179,9 @@ PERL_CALLCONV SV*	Perl_sv_2mortal(pTHX_ SV* sv);
 PERL_CALLCONV NV	Perl_sv_2nv(pTHX_ SV* sv)
 			__attribute__nonnull__(pTHX_1);
 
+PERL_CALLCONV SV*	Perl_sv_2num(pTHX_ SV* sv)
+			__attribute__nonnull__(pTHX_1);
+
 /* PERL_CALLCONV char*	Perl_sv_2pv(pTHX_ SV* sv, STRLEN* lp)
 			__attribute__nonnull__(pTHX_1); */
 
diff --git a/sv.c b/sv.c
index df7a1b85a4..f418b058a9 100644
--- a/sv.c
+++ b/sv.c
@@ -2501,6 +2501,29 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     return SvNVX(sv);
 }
 
+/*
+=for apidoc sv_2num
+
+Return an SV with the numeric value of the source SV, doing any necessary
+reference or overload conversion.
+
+=cut
+*/
+
+SV *
+Perl_sv_2num(pTHX_ register SV *sv)
+{
+    if (!SvROK(sv))
+	return sv;
+
+    if (SvAMAGIC(sv)) {
+	SV * const tmpsv = AMG_CALLun(sv,numer);
+	if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
+	    return sv_2num(tmpsv);
+    }
+    return sv_2mortal(newSVuv(PTR2UV(SvRV(sv))));
+}
+
 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.