/* 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.
*/
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;
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
*/
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.
*/
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. */
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;
}
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;
}
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;
}
{
#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);
/* 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;
int sawinf = 0;
int sawnan = 0;
+ PERL_ARGS_ASSERT_GROK_NUMBER;
+
while (s < send && isSPACE(*s))
s++;
if (s == send) {
NV x = 0.0;
#ifdef USE_LOCALE_NUMERIC
dVAR;
+
+ PERL_ARGS_ASSERT_MY_ATOF;
+
if (PL_numeric_local && IN_LOCALE) {
NV y;
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;
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;
}
}
#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