djSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
useleft = USE_LEFT(TOPm1s);
#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.
- If either argument hasn't had a numeric conversion yet attempt to get
- the IV. It's important to do this now, rather than just assuming that
- it's not IOK as a PV of "9223372036854775806" may not take well to NV
- addition, and an SV which is NOK, NV=6.0 ought to be coerced to
- integer in case the second argument is IV=9223372036854775806
- We can (now) rely on sv_2iv to do the right thing, only setting the
- public IOK flag if the value in the NV (or PV) slot is truly integer.
-
- A side effect is that this also aggressively prefers integer maths over
- fp maths for integer values. */
+ /* 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)) {
/* 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;
+ bool auvok;
+ bool a_valid = 0;
+
if (!useleft) {
- /* left operand is undef, treat as zero. + 0 is identity. */
- if (SvUOK(TOPs)) {
- dPOPuv; /* Scary macros. Lets put a sequence point (;) here */
- if (value <= (UV)IV_MIN) {
- /* 2s complement assumption. */
- SETi(-(IV)value);
- RETURN;
- } /* else drop through into NVs below */
- } else {
- dPOPiv;
- SETu((UV)-value);
- RETURN;
- }
+ auv = 0;
+ a_valid = auvok = 1;
+ /* left operand is undef, treat as zero. */
} else {
/* Left operand is defined, so is it IV? */
SvIV_please(TOPm1s);
if (SvIOK(TOPm1s)) {
- bool auvok = SvUOK(TOPm1s);
- bool buvok = SvUOK(TOPs);
-
- if (!auvok && !buvok) { /* ## IV - IV ## */
- IV aiv = SvIVX(TOPm1s);
- IV biv = SvIVX(TOPs);
- IV result = aiv - biv;
-
- if (biv >= 0 ? (result < aiv) : (result >= aiv)) {
- SP--;
- SETi( result );
- RETURN;
- }
- /* +ve - +ve can't overflow. (worst case 0 - IV_MAX) */
- /* -ve - -ve can't overflow. (worst case -1 - IV_MIN) */
- /* -ve - +ve can only overflow too negative. */
- /* leaving +ve - -ve, which will go UV */
- if (aiv >= 0 && biv < 0) { /* assert don't need biv <0 */
- /* 2s complement assumption for IV_MIN */
- UV result = (UV)aiv + (UV)-biv;
- /* UV + UV must get bigger. +ve IV + +ve IV +1 can't
- overflow UV (2s complement assumption */
- assert (result >= (UV) aiv);
- SP--;
- SETu( result );
- RETURN;
- }
- /* Overflow, drop through to NVs */
- } else if (auvok && buvok) { /* ## UV - UV ## */
- UV auv = SvUVX(TOPm1s);
- UV buv = SvUVX(TOPs);
- IV result;
-
- if (auv >= buv) {
- SP--;
- SETu( auv - buv );
- RETURN;
- }
- /* Blatant 2s complement assumption. */
- result = (IV)(auv - buv);
- if (result < 0) {
- SP--;
- SETi( result );
- RETURN;
+ if ((auvok = SvUOK(TOPm1s)))
+ auv = SvUVX(TOPm1s);
+ else {
+ register IV aiv = SvIVX(TOPm1s);
+ if (aiv >= 0) {
+ auv = aiv;
+ auvok = 1; /* Now acting as a sign flag. */
+ } else { /* 2s complement assumption for IV_MIN */
+ auv = (UV)-aiv;
}
- /* Overflow on IV - IV, drop through to NVs */
- } else if (auvok) { /* ## Mixed UV - IV ## */
- UV auv = SvUVX(TOPm1s);
- IV biv = SvIVX(TOPs);
-
- if (biv < 0) {
- /* 2s complement assumptions for IV_MIN */
- UV result = auv + ((UV)-biv);
- /* UV + UV can only get bigger... */
- if (result >= auv) {
- SP--;
- SETu( result );
- RETURN;
- }
- /* and if it gets too big for UV then it's NV time. */
- } else if (auv > (UV)IV_MAX) {
- /* I think I'm making an implicit 2s complement
- assumption that IV_MIN == -IV_MAX - 1 */
- /* biv is >= 0 */
- UV result = auv - (UV)biv;
- assert (result <= auv);
- SP--;
- SETu( result );
- RETURN;
- } else {
- /* biv is >= 0 */
- IV result = (IV)auv - biv;
- assert (result <= (IV)auv);
- SP--;
- SETi( result );
- RETURN;
+ }
+ a_valid = 1;
+ }
+ }
+ if (a_valid) {
+ bool result_good = 0;
+ UV result;
+ register UV buv;
+ bool buvok = SvUOK(TOPs);
+
+ if (buvok)
+ buv = SvUVX(TOPs);
+ else {
+ register IV biv = SvIVX(TOPs);
+ if (biv >= 0) {
+ buv = biv;
+ buvok = 1;
+ } else
+ buv = (UV)-biv;
+ }
+ /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
+ else "IV" now, independant of how it came in.
+ if a, b represents positive, A, B negative, a maps to -A etc
+ a - b => (a - b)
+ A - b => -(a + b)
+ a - B => (a + b)
+ A - B => -(a - b)
+ all UV maths. negate result if A negative.
+ subtract if signs same, add if signs differ. */
+
+ if (auvok ^ buvok) {
+ /* Signs differ. */
+ result = auv + buv;
+ if (result >= auv)
+ result_good = 1;
+ } else {
+ /* Signs same */
+ if (auv >= buv) {
+ result = auv - buv;
+ /* Must get smaller */
+ if (result <= auv)
+ result_good = 1;
+ } else {
+ result = buv - auv;
+ if (result <= buv) {
+ /* result really should be -(auv-buv). as its negation
+ of true value, need to swap our result flag */
+ auvok = !auvok;
+ result_good = 1;
}
- } else { /* ## Mixed IV - UV ## */
- IV aiv = SvIVX(TOPm1s);
- UV buv = SvUVX(TOPs);
- IV result = aiv - (IV)buv; /* 2s complement assumption. */
-
- /* result must not get larger. */
- if (result <= aiv) {
- SP--;
- SETi( result );
- RETURN;
- } /* end of IV-IV / UV-UV / UV-IV / IV-UV */
}
}
+ if (result_good) {
+ SP--;
+ if (auvok)
+ SETu( result );
+ else {
+ /* Negate result */
+ if (result <= (UV)IV_MIN)
+ SETi( -(IV)result );
+ else {
+ /* result valid, but out of range for IV. */
+ SETn( -(NV)result );
+ }
+ }
+ RETURN;
+ } /* Overflow, drop through to NVs. */
}
}
#endif
+ useleft = USE_LEFT(TOPm1s);
{
dPOPnv;
if (!useleft) {
#define TOPs (*sp)
#define TOPm1s (*(sp-1))
+#define TOPp1s (*(sp+1))
#define TOPp (SvPV(TOPs, PL_na)) /* deprecated */
#define TOPpx (SvPV(TOPs, n_a))
#define TOPn (SvNV(TOPs))
public IOK flag if the value in the NV (or PV) slot is truly integer.
A side effect is that this also aggressively prefers integer maths over
- fp maths for integer values. */
+ fp maths for integer values.
+
+ How to detect overflow?
+
+ C 99 section 6.2.6.1 says
+
+ The range of nonnegative values of a signed integer type is a subrange
+ of the corresponding unsigned integer type, and the representation of
+ the same value in each type is the same. A computation involving
+ unsigned operands can never overflow, because a result that cannot be
+ represented by the resulting unsigned integer type is reduced modulo
+ the number that is one greater than the largest value that can be
+ represented by the resulting type.
+
+ (the 9th paragraph)
+
+ which I read as "unsigned ints wrap."
+
+ signed integer overflow seems to be classed as "exception condition"
+
+ If an exceptional condition occurs during the evaluation of an
+ expression (that is, if the result is not mathematically defined or not
+ in the range of representable values for its type), the behavior is
+ undefined.
+
+ (6.5, the 5th paragraph)
+
+ I had assumed that on 2s complement machines signed arithmetic would
+ wrap, hence coded pp_add and pp_subtract on the assumption that
+ everything perl builds on would be happy. After much wailing and
+ gnashing of teeth it would seem that irix64 knows its ANSI spec well,
+ knows that it doesn't need to, and doesn't. Bah. Anyway, the all-
+ unsigned code below is actually shorter than the old code. :-)
+ */
+
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
/* 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;
+ bool auvok;
+ bool a_valid = 0;
+
if (!useleft) {
- /* left operand is undef, treat as zero. + 0 is identity. */
- if (SvUOK(TOPs)) {
- dPOPuv; /* Scary macros. Lets put a sequence point (;) here */
- SETu(value);
- RETURN;
- } else {
- dPOPiv;
- SETi(value);
- RETURN;
+ auv = 0;
+ a_valid = auvok = 1;
+ /* left operand is undef, treat as zero. + 0 is identity,
+ Could SETi or SETu right now, but space optimise by not adding
+ 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);
+ else {
+ register IV aiv = SvIVX(TOPm1s);
+ if (aiv >= 0) {
+ auv = aiv;
+ auvok = 1; /* Now acting as a sign flag. */
+ } else { /* 2s complement assumption for IV_MIN */
+ auv = (UV)-aiv;
+ }
+ }
+ a_valid = 1;
}
}
- /* Left operand is defined, so is it IV? */
- SvIV_please(TOPm1s);
- if (SvIOK(TOPm1s)) {
- bool auvok = SvUOK(TOPm1s);
+ if (a_valid) {
+ bool result_good = 0;
+ UV result;
+ register UV buv;
bool buvok = SvUOK(TOPs);
-
- if (!auvok && !buvok) { /* ## IV + IV ## */
- IV aiv = SvIVX(TOPm1s);
- IV biv = SvIVX(TOPs);
- IV result = aiv + biv;
-
- if (biv >= 0 ? (result >= aiv) : (result < aiv)) {
- SP--;
- SETi( result );
- RETURN;
- }
- if (biv >=0 && aiv >= 0) {
- UV result = (UV)aiv + (UV)biv;
- /* UV + UV can only get bigger... */
- if (result >= (UV) aiv) {
- SP--;
- SETu( result );
- RETURN;
+
+ if (buvok)
+ buv = SvUVX(TOPs);
+ else {
+ register IV biv = SvIVX(TOPs);
+ if (biv >= 0) {
+ buv = biv;
+ buvok = 1;
+ } else
+ buv = (UV)-biv;
+ }
+ /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
+ else "IV" now, independant of how it came in.
+ if a, b represents positive, A, B negative, a maps to -A etc
+ a + b => (a + b)
+ A + b => -(a - b)
+ a + B => (a - b)
+ A + B => -(a + b)
+ all UV maths. negate result if A negative.
+ add if signs same, subtract if signs differ. */
+
+ if (auvok ^ buvok) {
+ /* Signs differ. */
+ if (auv >= buv) {
+ result = auv - buv;
+ /* Must get smaller */
+ if (result <= auv)
+ result_good = 1;
+ } else {
+ result = buv - auv;
+ if (result <= buv) {
+ /* result really should be -(auv-buv). as its negation
+ of true value, need to swap our result flag */
+ auvok = !auvok;
+ result_good = 1;
}
}
- /* Overflow, drop through to NVs (beyond next if () else ) */
- } else if (auvok && buvok) { /* ## UV + UV ## */
- UV auv = SvUVX(TOPm1s);
- UV buv = SvUVX(TOPs);
- UV result = auv + buv;
- if (result >= auv) {
- SP--;
+ } else {
+ /* Signs same */
+ result = auv + buv;
+ if (result >= auv)
+ result_good = 1;
+ }
+ if (result_good) {
+ SP--;
+ if (auvok)
SETu( result );
- RETURN;
- }
- /* Overflow, drop through to NVs (beyond next if () else ) */
- } else { /* ## Mixed IV,UV ## */
- IV aiv;
- UV buv;
-
- /* addition is commutative so swap if needed (save code) */
- if (buvok) {
- aiv = SvIVX(TOPm1s);
- buv = SvUVX(TOPs);
- } else {
- aiv = SvIVX(TOPs);
- buv = SvUVX(TOPm1s);
- }
-
- if (aiv >= 0) {
- UV result = (UV)aiv + buv;
- if (result >= buv) {
- SP--;
- SETu( result );
- RETURN;
- }
- } else if (buv > (UV) IV_MAX) {
- /* assuming 2s complement means that IV_MIN == -IV_MIN,
- and (UV)-IV_MIN *is* the value -IV_MIN (or IV_MAX + 1)
- as buv > IV_MAX, it is >= (IV_MAX + 1), and therefore
- as the value we can be subtracting from it only lies in
- the range (-IV_MIN to -1) it can't overflow a UV */
- SP--;
- SETu( buv - (UV)-aiv );
- RETURN;
- } else {
- IV result = (IV) buv + aiv;
- /* aiv < 0 so it must get smaller. */
- if (result < (IV) buv) {
- SP--;
- SETi( result );
- RETURN;
+ else {
+ /* Negate result */
+ if (result <= (UV)IV_MIN)
+ SETi( -(IV)result );
+ else {
+ /* result valid, but out of range for IV. */
+ SETn( -(NV)result );
}
}
- } /* end of IV+IV / UV+UV / mixed */
+ RETURN;
+ } /* Overflow, drop through to NVs. */
}
}
#endif
-#!./perl
+#!./perl -w
-print "1..12\n";
+print "1..109\n";
sub try ($$) {
print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
}
+sub tryeq ($$$) {
+ if ($_[1] == $_[2]) {
+ print "ok $_[0]\n";
+ } else {
+ print "not ok $_[0] # $_[1] != $_[2]\n";
+ }
+}
-try 1, 13 % 4 == 1;
-try 2, -13 % 4 == 3;
-try 3, 13 % -4 == -3;
-try 4, -13 % -4 == -1;
+tryeq 1, 13 % 4, 1;
+tryeq 2, -13 % 4, 3;
+tryeq 3, 13 % -4, -3;
+tryeq 4, -13 % -4, -1;
my $limit = 1e6;
# UVs should behave properly
-try 9, 4063328477 % 65535 == 27407;
-try 10, 4063328477 % 4063328476 == 1;
-try 11, 4063328477 % 2031664238 == 1;
-try 12, 2031664238 % 4063328477 == 2031664238;
+tryeq 9, 4063328477 % 65535, 27407;
+tryeq 10, 4063328477 % 4063328476, 1;
+tryeq 11, 4063328477 % 2031664238, 1;
+tryeq 12, 2031664238 % 4063328477, 2031664238;
+
+# These should trigger wrapping on 32 bit IVs and UVs
+
+tryeq 13, 2147483647 + 0, 2147483647;
+
+# IV + IV promote to UV
+tryeq 14, 2147483647 + 1, 2147483648;
+tryeq 15, 2147483640 + 10, 2147483650;
+tryeq 16, 2147483647 + 2147483647, 4294967294;
+# IV + UV promote to NV
+tryeq 17, 2147483647 + 2147483649, 4294967296;
+# UV + IV promote to NV
+tryeq 18, 4294967294 + 2, 4294967296;
+# UV + UV promote to NV
+tryeq 19, 4294967295 + 4294967295, 8589934590;
+
+# UV + IV to IV
+tryeq 20, 2147483648 + -1, 2147483647;
+tryeq 21, 2147483650 + -10, 2147483640;
+# IV + UV to IV
+tryeq 22, -1 + 2147483648, 2147483647;
+tryeq 23, -10 + 4294967294, 4294967284;
+# IV + IV to NV
+tryeq 24, -2147483648 + -2147483648, -4294967296;
+tryeq 25, -2147483640 + -10, -2147483650;
+
+# Hmm. Don't forget the simple stuff
+tryeq 26, 1 + 1, 2;
+tryeq 27, 4 + -2, 2;
+tryeq 28, -10 + 100, 90;
+tryeq 29, -7 + -9, -16;
+tryeq 30, -63 + +2, -61;
+tryeq 31, 4 + -1, 3;
+tryeq 32, -1 + 1, 0;
+tryeq 33, +29 + -29, 0;
+tryeq 34, -1 + 4, 3;
+tryeq 35, +4 + -17, -13;
+
+# subtraction
+tryeq 36, 3 - 1, 2;
+tryeq 37, 3 - 15, -12;
+tryeq 38, 3 - -7, 10;
+tryeq 39, -156 - 5, -161;
+tryeq 40, -156 - -5, -151;
+tryeq 41, -5 - -12, 7;
+tryeq 42, -3 - -3, 0;
+tryeq 43, 15 - 15, 0;
+
+tryeq 44, 2147483647 - 0, 2147483647;
+tryeq 45, 2147483648 - 0, 2147483648;
+tryeq 46, -2147483648 - 0, -2147483648;
+
+tryeq 47, 0 - -2147483647, 2147483647;
+tryeq 48, -1 - -2147483648, 2147483647;
+tryeq 49, 2 - -2147483648, 2147483650;
+
+tryeq 50, 4294967294 - 3, 4294967291;
+tryeq 51, -2147483648 - -1, -2147483647;
+
+# IV - IV promote to UV
+tryeq 52, 2147483647 - -1, 2147483648;
+tryeq 53, 2147483647 - -2147483648, 4294967295;
+# UV - IV promote to NV
+tryeq 54, 4294967294 - -3, 4294967297;
+# IV - IV promote to NV
+tryeq 55, -2147483648 - +1, -2147483649;
+# UV - UV promote to IV
+tryeq 56, 2147483648 - 2147483650, -2;
+# IV - UV promote to IV
+tryeq 57, 2000000000 - 4000000000, -2000000000;
+
+# No warnings should appear;
+my $a;
+$a += 1;
+tryeq 58, $a, 1;
+undef $a;
+$a += -1;
+tryeq 59, $a, -1;
+undef $a;
+$a += 4294967290;
+tryeq 60, $a, 4294967290;
+undef $a;
+$a += -4294967290;
+tryeq 61, $a, -4294967290;
+undef $a;
+$a += 4294967297;
+tryeq 62, $a, 4294967297;
+undef $a;
+$a += -4294967297;
+tryeq 63, $a, -4294967297;
+
+my $s;
+$s -= 1;
+tryeq 64, $s, -1;
+undef $s;
+$s -= -1;
+tryeq 65, $s, +1;
+undef $s;
+$s -= -4294967290;
+tryeq 66, $s, +4294967290;
+undef $s;
+$s -= 4294967290;
+tryeq 67, $s, -4294967290;
+undef $s;
+$s -= 4294967297;
+tryeq 68, $s, -4294967297;
+undef $s;
+$s -= -4294967297;
+tryeq 69, $s, +4294967297;
+
+# Multiplication
+
+tryeq 70, 1 * 3, 3;
+tryeq 71, -2 * 3, -6;
+tryeq 72, 3 * -3, -9;
+tryeq 73, -4 * -3, 12;
+
+# check with 0xFFFF and 0xFFFF
+tryeq 74, 65535 * 65535, 4294836225;
+tryeq 75, 65535 * -65535, -4294836225;
+tryeq 76, -65535 * 65535, -4294836225;
+tryeq 77, -65535 * -65535, 4294836225;
+
+# check with 0xFFFF and 0x10001
+tryeq 78, 65535 * 65537, 4294967295;
+tryeq 79, 65535 * -65537, -4294967295;
+tryeq 80, -65535 * 65537, -4294967295;
+tryeq 81, -65535 * -65537, 4294967295;
+
+# check with 0x10001 and 0xFFFF
+tryeq 82, 65537 * 65535, 4294967295;
+tryeq 83, 65537 * -65535, -4294967295;
+tryeq 84, -65537 * 65535, -4294967295;
+tryeq 85, -65537 * -65535, 4294967295;
+
+# These should all be dones as NVs
+tryeq 86, 65537 * 65537, 4295098369;
+tryeq 87, 65537 * -65537, -4295098369;
+tryeq 88, -65537 * 65537, -4295098369;
+tryeq 89, -65537 * -65537, 4295098369;
+
+# will overflow an IV (in 32-bit)
+tryeq 90, 46340 * 46342, 0x80001218;
+tryeq 91, 46340 * -46342, -0x80001218;
+tryeq 92, -46340 * 46342, -0x80001218;
+tryeq 93, -46340 * -46342, 0x80001218;
+
+tryeq 94, 46342 * 46340, 0x80001218;
+tryeq 95, 46342 * -46340, -0x80001218;
+tryeq 96, -46342 * 46340, -0x80001218;
+tryeq 97, -46342 * -46340, 0x80001218;
+
+# will overflow a positive IV (in 32-bit)
+tryeq 98, 65536 * 32768, 0x80000000;
+tryeq 99, 65536 * -32768, -0x80000000;
+tryeq 100, -65536 * 32768, -0x80000000;
+tryeq 101, -65536 * -32768, 0x80000000;
+
+tryeq 102, 32768 * 65536, 0x80000000;
+tryeq 103, 32768 * -65536, -0x80000000;
+tryeq 104, -32768 * 65536, -0x80000000;
+tryeq 105, -32768 * -65536, 0x80000000;
+
+# 2147483647 is prime. bah.
+
+tryeq 106, 46339 * 46341, 0x7ffea80f;
+tryeq 107, 46339 * -46341, -0x7ffea80f;
+tryeq 108, -46339 * 46341, -0x7ffea80f;
+tryeq 109, -46339 * -46341, 0x7ffea80f;
projects / p5sagit/p5-mst-13.2.git / commitdiff