Use HAS_LLRINTL, HAS_LLROUNDL, HAS_LRINTL, HAS_LROUNDL

[perl5.git] / ext / POSIX / POSIX.xs

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 9d41bf0..f374e16 100644 (file)
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -276,14 +276,14 @@
 #  define c99_log1p    log1pl
 #  define c99_log2     log2l
 #  define c99_logb     logbl
-#  if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
-#   define c99_lrint   llrintl
-#  else
+#  if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LLRINTL)
+#    define c99_lrint  llrintl
+#  elif defined(HAS_LRINTL)
 #    define c99_lrint  lrintl
 #  endif
-#  if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
+#  if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LLROUNDL)
 #    define c99_lround llroundl
-#  else
+#  elif defined(HAS_LROUNDL)
 #    define c99_lround lroundl
 #  endif
 #  define c99_nan      nanl
@@ -803,7 +803,7 @@ static NV my_tgamma(NV x)
     if (x < 1.0)
       y += 1.0;
     else {
-      n = Perl_floor(y) - 1;
+      n = (int)Perl_floor(y) - 1;
       y -= n;
     }
     z = y - 1;
@@ -1134,7 +1134,9 @@ char *tzname[] = { "" , "" };
 #  define setuid(a)            not_here("setuid")
 #  define setgid(a)            not_here("setgid")
 #endif /* NETWARE */
+#ifndef USE_LONG_DOUBLE
 #  define strtold(s1,s2)       not_here("strtold")
+#endif  /* USE_LONG_DOUBLE */
 #else
 
 #  ifndef HAS_MKFIFO
@@ -1578,7 +1580,7 @@ static XSPROTO(is_common)
                 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
                             "Calling POSIX::%"HEKf"() is deprecated",
                             HEKfARG(GvNAME_HEK(CvGV(cv))));
-               hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
+               (void)hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
             }
         }
 
@@ -1975,9 +1977,9 @@ localeconv()
                                       strlen(value),
 
                                       /* We mark it as UTF-8 if a utf8 locale
-                                       * and is valid, non-ascii UTF-8 */
+                                       * and is valid and variant under UTF-8 */
                                       is_utf8_locale
-                                        && ! is_ascii_string((U8 *) value, 0)
+                                        && ! is_invariant_string((U8 *) value, 0)
                                         && is_utf8_string((U8 *) value, 0)),
                         0);
                   }
@@ -2137,6 +2139,7 @@ acos(x)
        y0 = 29
        y1 = 30
     CODE:
+       PERL_UNUSED_VAR(x);
        RETVAL = NV_NAN;
        switch (ix) {
        case 0:
@@ -2358,6 +2361,7 @@ fesetround(x)
         default: RETVAL = -1; break;
        }
 #else
+       PERL_UNUSED_VAR(x);
        RETVAL = -1;
        not_here("fesetround");
 #endif
@@ -2377,6 +2381,7 @@ fpclassify(x)
        lround = 7
         signbit = 8
     CODE:
+        PERL_UNUSED_VAR(x);
        RETVAL = -1;
        switch (ix) {
        case 0:
@@ -2455,6 +2460,8 @@ copysign(x,y)
        nexttoward = 13
        remainder = 14
     CODE:
+        PERL_UNUSED_VAR(x);
+        PERL_UNUSED_VAR(y);
        RETVAL = NV_NAN;
        switch (ix) {
        case 0:
@@ -2554,9 +2561,9 @@ copysign(x,y)
        case 14:
        default:
 #ifdef c99_remainder
-           RETVAL = c99_remainder(x, y);
+          RETVAL = c99_remainder(x, y);
 #else
-           not_here("remainder");
+          not_here("remainder");
 #endif
            break;
        }
@@ -2596,6 +2603,8 @@ remquo(x,y)
         PUSHs(sv_2mortal(newSVnv(c99_remquo(x,y,&intvar))));
         PUSHs(sv_2mortal(newSVnv(intvar)));
 #else
+       PERL_UNUSED_VAR(x);
+       PERL_UNUSED_VAR(y);
        not_here("remquo");
 #endif
 
@@ -2607,6 +2616,8 @@ scalbn(x,y)
 #ifdef c99_scalbn
        RETVAL = c99_scalbn(x, y);
 #else
+       PERL_UNUSED_VAR(x);
+       PERL_UNUSED_VAR(y);
        RETVAL = NV_NAN;
        not_here("scalbn");
 #endif
@@ -2620,6 +2631,9 @@ fma(x,y,z)
        NV              z
     CODE:
 #ifdef c99_fma
+       PERL_UNUSED_VAR(x);
+       PERL_UNUSED_VAR(y);
+       PERL_UNUSED_VAR(z);
        RETVAL = c99_fma(x, y, z);
 #endif
     OUTPUT:
@@ -2629,12 +2643,47 @@ NV
 nan(s = 0)
        char*   s;
     CODE:
+       PERL_UNUSED_VAR(s);
 #ifdef c99_nan
        RETVAL = c99_nan(s ? s : "");
 #elif defined(NV_NAN)
-       PERL_UNUSED_VAR(s);
        /* XXX if s != NULL, warn about unused argument,
          * or implement the nan payload setting. */
+        /* NVSIZE == 8: the NaN "header" (the exponent) is 0x7FF (the 0x800
+         * is the sign bit, which should be irrelevant for NaN, so really
+         * also 0xFFF), leaving 64 - 12 = 52 bits for the NaN payload
+         * (6.5 bytes, note about infinities below).
+         *
+         * (USE_LONG_DOUBLE and)
+         * LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN:
+         * the NaN "header" is still 0x7FF, leaving 80 - 12 = 68 bits
+         * for the payload (8.5 bytes, note about infinities below).
+         *
+         * doubledouble? aargh. Maybe like doubles, 52 + 52 = 104 bits?
+         *
+         * NVSIZE == 16:
+         * the NaN "header" is still 0x7FF, leaving 128 - 12 = 116 bits
+         * for the payload (14.5 bytes, note about infinities below)
+         *
+         * Which ones of the NaNs are 'signaling' and which are 'quiet',
+         * depends.  In the IEEE-754 1985, nothing was specified.  But the
+         * majority of companies decided that the MSB of the mantissa was
+         * the bit for 'quiet'.  (Only PA-RISC and MIPS were different,
+         * using the MSB as 'signaling'.)  The IEEE-754 2008 *recommended*
+         * (but did not dictate) the MSB as the 'quiet' bit.
+         *
+         * In other words, on most platforms, and for 64-bit doubles:
+         * [7FF8000000000000, 7FFFFFFFFFFFFFFF] quiet
+         * [FFF8000000000000, FFFFFFFFFFFFFFFF] quiet
+         * [7FF0000000000001, 7FF7FFFFFFFFFFFF] signaling
+         * [FFF0000000000001, FFF7FFFFFFFFFFFF] signaling
+         *
+         * The C99 nan() is supposed to generate *quiet* NaNs.
+         *
+         * Note the asymmetry:
+         * The 7FF0000000000000 is positive infinity,
+         * the FFF0000000000000 is negative infinity.
+         */
        RETVAL = NV_NAN;
 #else
        not_here("nan");
@@ -2649,21 +2698,23 @@ jn(x,y)
     ALIAS:
        yn = 1
     CODE:
+       PERL_UNUSED_VAR(x);
+       PERL_UNUSED_VAR(y);
        RETVAL = NV_NAN;
         switch (ix) {
        case 0:
 #ifdef bessel_jn
-           RETVAL = bessel_jn(x, y);
+          RETVAL = bessel_jn(x, y);
 #else
-           not_here("jn");
+          not_here("jn");
 #endif
             break;
        case 1:
        default:
 #ifdef bessel_yn
-           RETVAL = bessel_yn(x, y);
+          RETVAL = bessel_yn(x, y);
 #else
-           not_here("yn");
+          not_here("yn");
 #endif
             break;
        }
@@ -3022,7 +3073,7 @@ tmpnam()
            HV *warned = get_hv("POSIX::_warned", GV_ADD | GV_ADDMULTI);
             if (! hv_exists(warned, (const char *)&PL_op, sizeof(PL_op))) {
                 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Calling POSIX::tmpnam() is deprecated");
-                hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
+                (void)hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
             }
         }
        len = strlen(tmpnam(SvPV(RETVAL, i)));
@@ -3076,7 +3127,7 @@ strtod(str)
         STORE_NUMERIC_STANDARD_FORCE_LOCAL();
        num = strtod(str, &unparsed);
        PUSHs(sv_2mortal(newSVnv(num)));
-       if (GIMME == G_ARRAY) {
+       if (GIMME_V == G_ARRAY) {
            EXTEND(SP, 1);
            if (unparsed)
                PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
@@ -3097,7 +3148,7 @@ strtold(str)
         STORE_NUMERIC_STANDARD_FORCE_LOCAL();
        num = strtold(str, &unparsed);
        PUSHs(sv_2mortal(newSVnv(num)));
-       if (GIMME == G_ARRAY) {
+       if (GIMME_V == G_ARRAY) {
            EXTEND(SP, 1);
            if (unparsed)
                PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
@@ -3123,7 +3174,7 @@ strtol(str, base = 0)
        else
 #endif
            PUSHs(sv_2mortal(newSViv((IV)num)));
-       if (GIMME == G_ARRAY) {
+       if (GIMME_V == G_ARRAY) {
            EXTEND(SP, 1);
            if (unparsed)
                PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
@@ -3139,6 +3190,8 @@ strtoul(str, base = 0)
        unsigned long num;
        char *unparsed;
     PPCODE:
+       PERL_UNUSED_VAR(str);
+       PERL_UNUSED_VAR(base);
        num = strtoul(str, &unparsed, base);
 #if IVSIZE <= LONGSIZE
        if (num > IV_MAX)
@@ -3146,7 +3199,7 @@ strtoul(str, base = 0)
        else
 #endif
            PUSHs(sv_2mortal(newSViv((IV)num)));
-       if (GIMME == G_ARRAY) {
+       if (GIMME_V == G_ARRAY) {
            EXTEND(SP, 1);
            if (unparsed)
                PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
@@ -3317,7 +3370,7 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
                 STRLEN len = strlen(buf);
                sv_usepvn_flags(sv, buf, len, SV_HAS_TRAILING_NUL);
                if (SvUTF8(fmt)
-                    || (! is_ascii_string((U8*) buf, len)
+                    || (! is_invariant_string((U8*) buf, len)
                         && is_utf8_string((U8*) buf, len)
 #ifdef USE_LOCALE_TIME
                         && _is_cur_LC_category_utf8(LC_TIME)
@@ -3372,6 +3425,7 @@ cuserid(s = 0)
 #ifdef HAS_CUSERID
   RETVAL = cuserid(s);
 #else
+  PERL_UNUSED_VAR(s);
   RETVAL = 0;
   not_here("cuserid");
 #endif
@@ -3437,6 +3491,9 @@ lchown(uid, gid, path)
         * but consistent with CORE::chown() */
        RETVAL = lchown(path, uid, gid);
 #else
+       PERL_UNUSED_VAR(uid);
+       PERL_UNUSED_VAR(gid);
+       PERL_UNUSED_VAR(path);
        RETVAL = not_here("lchown");
 #endif
     OUTPUT: