X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=numeric.c;h=761239a1cb20d76937f22dbb618124c90bace02f;hb=0642d82a230efbe169e4a441b6943c36ff880a90;hp=6720726cfbe28d7cb7ce966a83dd15afd14e621f;hpb=96a5add60f1f39d38341c09c11f0542e68f782b0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/numeric.c b/numeric.c
index 6720726..761239a 100644
--- a/numeric.c
+++ b/numeric.c
@@ -1,7 +1,7 @@
 /*    numeric.c
  *
- *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+ *    2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -132,7 +132,8 @@ number may use '_' characters to separate digits.
  */
 
 UV
-Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) {
+Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
     const char *s = start;
     STRLEN len = *len_p;
     UV value = 0;
@@ -143,6 +144,8 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) {
     bool overflowed = FALSE;
     char bit;
 
+    PERL_ARGS_ASSERT_GROK_BIN;
+
     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
         /* strip off leading b or 0b.
            for compatibility silently suffer "b" and "0b" as valid binary
@@ -248,17 +251,19 @@ number may use '_' characters to separate digits.
  */
 
 UV
-Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) {
+Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
     dVAR;
     const char *s = start;
     STRLEN len = *len_p;
     UV value = 0;
     NV value_nv = 0;
-
     const UV max_div_16 = UV_MAX / 16;
     const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
     bool overflowed = FALSE;
 
+    PERL_ARGS_ASSERT_GROK_HEX;
+
     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
         /* strip off leading x or 0x.
            for compatibility silently suffer "x" and "0x" as valid hex numbers.
@@ -363,16 +368,18 @@ number may use '_' characters to separate digits.
  */
 
 UV
-Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) {
+Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
     const char *s = start;
     STRLEN len = *len_p;
     UV value = 0;
     NV value_nv = 0;
-
     const UV max_div_8 = UV_MAX / 8;
     const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
     bool overflowed = FALSE;
 
+    PERL_ARGS_ASSERT_GROK_OCT;
+
     for (; len-- && *s; s++) {
          /* gcc 2.95 optimiser not smart enough to figure that this subtraction
             out front allows slicker code.  */
@@ -465,6 +472,8 @@ Perl_scan_bin(pTHX_ const char *start, STRLEN len, STRLEN *retlen)
     I32 flags = *retlen ? PERL_SCAN_ALLOW_UNDERSCORES : 0;
     const UV ruv = grok_bin (start, &len, &flags, &rnv);
 
+    PERL_ARGS_ASSERT_SCAN_BIN;
+
     *retlen = len;
     return (flags & PERL_SCAN_GREATER_THAN_UV_MAX) ? rnv : (NV)ruv;
 }
@@ -476,6 +485,8 @@ Perl_scan_oct(pTHX_ const char *start, STRLEN len, STRLEN *retlen)
     I32 flags = *retlen ? PERL_SCAN_ALLOW_UNDERSCORES : 0;
     const UV ruv = grok_oct (start, &len, &flags, &rnv);
 
+    PERL_ARGS_ASSERT_SCAN_OCT;
+
     *retlen = len;
     return (flags & PERL_SCAN_GREATER_THAN_UV_MAX) ? rnv : (NV)ruv;
 }
@@ -487,6 +498,8 @@ Perl_scan_hex(pTHX_ const char *start, STRLEN len, STRLEN *retlen)
     I32 flags = *retlen ? PERL_SCAN_ALLOW_UNDERSCORES : 0;
     const UV ruv = grok_hex (start, &len, &flags, &rnv);
 
+    PERL_ARGS_ASSERT_SCAN_HEX;
+
     *retlen = len;
     return (flags & PERL_SCAN_GREATER_THAN_UV_MAX) ? rnv : (NV)ruv;
 }
@@ -503,6 +516,9 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 {
 #ifdef USE_LOCALE_NUMERIC
     dVAR;
+
+    PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
+
     if (PL_numeric_radix_sv && IN_LOCALE) { 
         STRLEN len;
         const char * const radix = SvPV(PL_numeric_radix_sv, len);
@@ -514,6 +530,9 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
     /* always try "." if numeric radix didn't match because
      * we may have data from different locales mixed */
 #endif
+
+    PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
+
     if (*sp < send && **sp == '.') {
         ++*sp;
         return TRUE;
@@ -555,6 +574,8 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
   int sawinf = 0;
   int sawnan = 0;
 
+  PERL_ARGS_ASSERT_GROK_NUMBER;
+
   while (s < send && isSPACE(*s))
     s++;
   if (s == send) {
@@ -809,6 +830,9 @@ Perl_my_atof(pTHX_ const char* s)
     NV x = 0.0;
 #ifdef USE_LOCALE_NUMERIC
     dVAR;
+
+    PERL_ARGS_ASSERT_MY_ATOF;
+
     if (PL_numeric_local && IN_LOCALE) {
 	NV y;
 
@@ -848,6 +872,8 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     I32 old_digit = 0;
     I32 sig_digits = 0; /* noof significant digits seen so far */
 
+    PERL_ARGS_ASSERT_MY_ATOF2;
+
 /* There is no point in processing more significant digits
  * than the NV can hold. Note that NV_DIG is a lower-bound value,
  * while we need an upper-bound value. We add 2 to account for this;
@@ -953,10 +979,9 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 	else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) {
 	    seen_dp = 1;
 	    if (sig_digits > MAX_SIG_DIGITS) {
-		++s;
-		while (isDIGIT(*s)) {
+		do {
 		    ++s;
-		}
+		} while (isDIGIT(*s));
 		break;
 	    }
 	}
@@ -1024,6 +1049,38 @@ Perl_my_frexpl(long double x, int *e) {
 #endif
 
 /*
+=for apidoc Perl_signbit
+
+Return a non-zero integer if the sign bit on an NV is set, and 0 if
+it is not.  
+
+If Configure detects this system has a signbit() that will work with
+our NVs, then we just use it via the #define in perl.h.  Otherwise,
+fall back on this implementation.  As a first pass, this gets everything
+right except -0.0.  Alas, catching -0.0 is the main use for this function,
+so this is not too helpful yet.  Still, at least we have the scaffolding
+in place to support other systems, should that prove useful.
+
+
+Configure notes:  This function is called 'Perl_signbit' instead of a
+plain 'signbit' because it is easy to imagine a system having a signbit()
+function or macro that doesn't happen to work with our particular choice
+of NVs.  We shouldn't just re-#define signbit as Perl_signbit and expect
+the standard system headers to be happy.  Also, this is a no-context
+function (no pTHX_) because Perl_signbit() is usually re-#defined in
+perl.h as a simple macro call to the system's signbit().
+Users should just always call Perl_signbit().
+
+=cut
+*/
+#if !defined(HAS_SIGNBIT)
+int
+Perl_signbit(NV x) {
+    return (x < 0.0) ? 1 : 0;
+}
+#endif
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4