X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2e9cdb626b076c27574f57758300ad2c7afaa8b3..ddc7c5c7d33132a836845f632085f65497425023:/ext/POSIX/POSIX.xs

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 0dcf43e..570658f 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -89,44 +89,63 @@
 
 #else
 
+#  ifdef USE_LONG_DOUBLE
+#    undef M_E
+#    undef M_LOG2E
+#    undef M_LOG10E
+#    undef M_LN2
+#    undef M_LN10
+#    undef M_PI
+#    undef M_PI_2
+#    undef M_PI_4
+#    undef M_1_PI
+#    undef M_2_PI
+#    undef M_2_SQRTPI
+#    undef M_SQRT2
+#    undef M_SQRT1_2
+#    define FLOAT_C(c) CAT2(c,L)
+#  else
+#    define FLOAT_C(c) (c)
+#  endif
+
 #  ifndef M_E
-#    define M_E		2.71828182845904523536028747135266250
+#    define M_E		FLOAT_C(2.71828182845904523536028747135266250)
 #  endif
 #  ifndef M_LOG2E
-#    define M_LOG2E	1.44269504088896340735992468100189214
+#    define M_LOG2E	FLOAT_C(1.44269504088896340735992468100189214)
 #  endif
 #  ifndef M_LOG10E
-#    define M_LOG10E	0.434294481903251827651128918916605082
+#    define M_LOG10E	FLOAT_C(0.434294481903251827651128918916605082)
 #  endif
 #  ifndef M_LN2
-#    define M_LN2	0.693147180559945309417232121458176568
+#    define M_LN2	FLOAT_C(0.693147180559945309417232121458176568)
 #  endif
 #  ifndef M_LN10
-#    define M_LN10	2.30258509299404568401799145468436421
+#    define M_LN10	FLOAT_C(2.30258509299404568401799145468436421)
 #  endif
 #  ifndef M_PI
-#    define M_PI	3.14159265358979323846264338327950288
+#    define M_PI	FLOAT_C(3.14159265358979323846264338327950288)
 #  endif
 #  ifndef M_PI_2
-#    define M_PI_2	1.57079632679489661923132169163975144
+#    define M_PI_2	FLOAT_C(1.57079632679489661923132169163975144)
 #  endif
 #  ifndef M_PI_4
-#    define M_PI_4	0.785398163397448309615660845819875721
+#    define M_PI_4	FLOAT_C(0.785398163397448309615660845819875721)
 #  endif
 #  ifndef M_1_PI
-#    define M_1_PI	0.318309886183790671537767526745028724
+#    define M_1_PI	FLOAT_C(0.318309886183790671537767526745028724)
 #  endif
 #  ifndef M_2_PI
-#    define M_2_PI	0.636619772367581343075535053490057448
+#    define M_2_PI	FLOAT_C(0.636619772367581343075535053490057448)
 #  endif
 #  ifndef M_2_SQRTPI
-#    define M_2_SQRTPI	1.12837916709551257389615890312154517
+#    define M_2_SQRTPI	FLOAT_C(1.12837916709551257389615890312154517)
 #  endif
 #  ifndef M_SQRT2
-#    define M_SQRT2	1.41421356237309504880168872420969808
+#    define M_SQRT2	FLOAT_C(1.41421356237309504880168872420969808)
 #  endif
 #  ifndef M_SQRT1_2
-#    define M_SQRT1_2	0.707106781186547524400844362104849039
+#    define M_SQRT1_2	FLOAT_C(0.707106781186547524400844362104849039)
 #  endif
 
 #endif
@@ -231,10 +250,13 @@
 #  define c99_log1p	log1pq
 #  define c99_log2	log2q
 /* no logbq */
-/* no llrintq */
-/* no llroundq */
-#  define c99_lrint	lrintq
-#  define c99_lround	lroundq
+#  if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
+#    define c99_lrint	llrintq
+#    define c99_lround	llroundq
+#  else
+#    define c99_lrint	lrintq
+#    define c99_lround	lroundq
+#  endif
 #  define c99_nan	nanq
 #  define c99_nearbyint	nearbyintq
 #  define c99_nextafter	nextafterq
@@ -276,14 +298,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
@@ -347,6 +369,45 @@
 #  define c99_trunc	trunc
 #endif
 
+/* AIX xlc (__IBMC__) really doesn't have the following long double
+ * math interfaces (no __acoshl128 aka acoshl, etc.), see
+ * hints/aix.sh.  These are in the -lc128 but fail to be found
+ * during dynamic linking/loading.
+ *
+ * XXX1 Better Configure scans
+ * XXX2 Is this xlc version dependent? */
+#if defined(USE_LONG_DOUBLE) && defined(__IBMC__)
+#  undef c99_acosh
+#  undef c99_asinh
+#  undef c99_atanh
+#  undef c99_cbrt
+#  undef c99_copysign
+#  undef c99_exp2
+#  undef c99_expm1
+#  undef c99_fdim
+#  undef c99_fma
+#  undef c99_fmax
+#  undef c99_fmin
+#  undef c99_hypot
+#  undef c99_ilogb
+#  undef c99_lrint
+#  undef c99_lround
+#  undef c99_log1p
+#  undef c99_log2
+#  undef c99_logb
+#  undef c99_nan
+#  undef c99_nearbyint
+#  undef c99_nextafter
+#  undef c99_nexttoward
+#  undef c99_remainder
+#  undef c99_remquo
+#  undef c99_rint
+#  undef c99_round
+#  undef c99_scalbn
+#  undef c99_tgamma
+#  undef c99_trunc
+#endif
+
 #ifndef isunordered
 #  ifdef Perl_isnan
 #    define isunordered(x, y) (Perl_isnan(x) || Perl_isnan(y))
@@ -648,6 +709,14 @@ static NV my_fdim(NV x, NV y)
 #  define c99_fdim my_fdim
 #endif
 
+#ifndef c99_fma
+static NV my_fma(NV x, NV y, NV z)
+{
+  return (x * y) + z;
+}
+#  define c99_fma my_fma
+#endif
+
 #ifndef c99_fmax
 static NV my_fmax(NV x, NV y)
 {
@@ -721,23 +790,32 @@ static IV my_ilogb(NV x)
 #  define c99_ilogb my_ilogb
 #endif
 
-/* tgamma and lgamma emulations based on http://www.johndcook.com/cpp_gamma.html,
+/* tgamma and lgamma emulations based on
+ * http://www.johndcook.com/cpp_gamma.html,
  * code placed in public domain.
  *
  * Note that these implementations (neither the johndcook originals
  * nor these) do NOT set the global signgam variable.  This is not
  * necessarily a bad thing. */
 
-/* Note that tgamma() and lgamma() depend on each other. */
-#if !defined(c99_tgamma) || !defined(c99_lgamma)
+/* Note that the tgamma() and lgamma() implementations
+ * here depend on each other. */
+
+#if !defined(HAS_TGAMMA) || !defined(c99_tgamma)
 static NV my_tgamma(NV x);
+#  define c99_tgamma my_tgamma
+#  define USE_MY_TGAMMA
+#endif
+#if !defined(HAS_LGAMMA) || !defined(c99_lgamma)
 static NV my_lgamma(NV x);
+#  define c99_lgamma my_lgamma
+#  define USE_MY_LGAMMA
 #endif
 
-#if !defined(c99_tgamma) || !defined(c99_lgamma)
+#ifdef USE_MY_TGAMMA
 static NV my_tgamma(NV x)
 {
-  const NV gamma = 0.577215664901532860606512090; // Euler's gamma constant.
+  const NV gamma = 0.577215664901532860606512090; /* Euler's gamma constant. */
   if (Perl_isnan(x) || x < 0.0)
     return NV_NAN;
   if (x == 0.0 || x == NV_INF)
@@ -747,7 +825,7 @@ static NV my_tgamma(NV x)
    * (0, 0.001), [0.001, 12), and (12, infinity) */
 
   /* First interval: (0, 0.001)
-   * For small values, 1/tgamma(x) has power series x + gamma x^2  ,
+   * For small values, 1/tgamma(x) has power series x + gamma x^2,
    * so in this range, 1/tgamma(x) = x + gamma x^2 with error on the order of x^3.
    * The relative error over this interval is less than 6e-7. */
   if (x < 0.001)
@@ -788,7 +866,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;
@@ -814,18 +892,21 @@ static NV my_tgamma(NV x)
   }
 
   /* Third interval: [12, +Inf) */
-  if (x > 171.624) { /* XXX Too low for quad precision */
+#if LDBL_MANT_DIG == 113 /* IEEE quad prec */
+  if (x > 1755.548) {
+    return NV_INF;
+  }
+#else
+  if (x > 171.624) {
     return NV_INF;
   }
+#endif
 
-  return Perl_exp(my_lgamma(x));
+  return Perl_exp(c99_lgamma(x));
 }
-#  ifndef c99_tgamma
-#    define c99_tgamma my_tgamma
-#  endif
 #endif
 
-#if !defined(c99_lgamma) || !defined(c99_tgamma)
+#ifdef USE_MY_LGAMMA
 static NV my_lgamma(NV x)
 {
   if (Perl_isnan(x))
@@ -835,11 +916,11 @@ static NV my_lgamma(NV x)
   if (x == 1.0 || x == 2.0)
     return 0;
   if (x < 12.0)
-    return Perl_log(PERL_ABS(my_tgamma(x)));
-  // Abramowitz and Stegun 6.1.41
-  // Asymptotic series should be good to at least 11 or 12 figures
-  // For error analysis, see Whittiker and Watson
-  // A Course in Modern Analysis (1927), page 252
+    return Perl_log(PERL_ABS(c99_tgamma(x)));
+  /* Abramowitz and Stegun 6.1.41
+   * Asymptotic series should be good to at least 11 or 12 figures
+   * For error analysis, see Whittiker and Watson
+   * A Course in Modern Analysis (1927), page 252 */
   {
     static const NV c[8] = {
       1.0/12.0,
@@ -865,9 +946,6 @@ static NV my_lgamma(NV x)
     return (x - 0.5) * Perl_log(x) - x + half_log_of_two_pi + series;
   }
 }
-#  ifndef c99_lgamma
-#    define c99_lgamma my_lgamma
-#  endif
 #endif
 
 #ifndef c99_log1p
@@ -1040,6 +1118,169 @@ static NV my_trunc(NV x)
 #  define c99_trunc my_trunc
 #endif
 
+#undef NV_PAYLOAD_DEBUG
+
+/* NOTE: the NaN payload API implementation is hand-rolled, since the
+ * APIs are only proposed ones as of June 2015, so very few, if any,
+ * platforms have implementations yet, so HAS_SETPAYLOAD and such are
+ * unlikely to be helpful.
+ *
+ * XXX - if the core numification wants to actually generate
+ * the nan payload in "nan(123)", and maybe "nans(456)", for
+ * signaling payload", this needs to be moved to e.g. numeric.c
+ * (look for grok_infnan)
+ *
+ * Conversely, if the core stringification wants the nan payload
+ * and/or the nan quiet/signaling distinction, S_getpayload()
+ * from this file needs to be moved, to e.g. sv.c (look for S_infnan_2pv),
+ * and the (trivial) functionality of issignaling() copied
+ * (for generating "NaNS", or maybe even "NaNQ") -- or maybe there
+ * are too many formatting parameters for simple stringification?
+ */
+
+/* While it might make sense for the payload to be UV or IV,
+ * to avoid conversion loss, the proposed ISO interfaces use
+ * a floating point input, which is then truncated to integer,
+ * and only the integer part being used.  This is workable,
+ * except for: (1) the conversion loss (2) suboptimal for
+ * 32-bit integer platforms.  A workaround API for (2) and
+ * in general for bit-honesty would be an array of integers
+ * as the payload... but the proposed C API does nothing of
+ * the kind. */
+#if NVSIZE == UVSIZE
+#  define NV_PAYLOAD_TYPE UV
+#else
+#  define NV_PAYLOAD_TYPE NV
+#endif
+
+#ifdef LONGDOUBLE_DOUBLEDOUBLE
+#  define NV_PAYLOAD_SIZEOF_ASSERT(a) assert(sizeof(a) == NVSIZE / 2)
+#else
+#  define NV_PAYLOAD_SIZEOF_ASSERT(a) assert(sizeof(a) == NVSIZE)
+#endif
+
+static void S_setpayload(NV* nvp, NV_PAYLOAD_TYPE payload, bool signaling)
+{
+  dTHX;
+  static const U8 m[] = { NV_NAN_PAYLOAD_MASK };
+  static const U8 p[] = { NV_NAN_PAYLOAD_PERM };
+  UV a[(NVSIZE + UVSIZE - 1) / UVSIZE] = { 0 };
+  int i;
+  NV_PAYLOAD_SIZEOF_ASSERT(m);
+  NV_PAYLOAD_SIZEOF_ASSERT(p);
+  *nvp = NV_NAN;
+  /* Divide the input into the array in "base unsigned integer" in
+   * little-endian order.  Note that the integer might be smaller than
+   * an NV (if UV is U32, for example). */
+#if NVSIZE == UVSIZE
+  a[0] = payload;  /* The trivial case. */
+#else
+  {
+    NV t1 = c99_trunc(payload); /* towards zero (drop fractional) */
+#ifdef NV_PAYLOAD_DEBUG
+    Perl_warn(aTHX_ "t1 = %"NVgf" (payload %"NVgf")\n", t1, payload);
+#endif
+    if (t1 <= UV_MAX) {
+      a[0] = (UV)t1;  /* Fast path, also avoids rounding errors (right?) */
+    } else {
+      /* UVSIZE < NVSIZE or payload > UV_MAX.
+       *
+       * This may happen for example if:
+       * (1) UVSIZE == 32 and common 64-bit double NV
+       *     (32-bit system not using -Duse64bitint)
+       * (2) UVSIZE == 64 and the x86-style 80-bit long double NV
+       *     (note that here the room for payload is actually the 64 bits)
+       * (3) UVSIZE == 64 and the 128-bit IEEE 764 quadruple NV
+       *     (112 bits in mantissa, 111 bits room for payload)
+       *
+       * NOTE: this is very sensitive to correctly functioning
+       * fmod()/fmodl(), and correct casting of big-unsigned-integer to NV.
+       * If these don't work right, especially the low order bits
+       * are in danger.  For example Solaris and AIX seem to have issues
+       * here, especially if using 32-bit UVs. */
+      NV t2;
+      for (i = 0, t2 = t1; i < (int)C_ARRAY_LENGTH(a); i++) {
+        a[i] = (UV)Perl_fmod(t2, (NV)UV_MAX);
+        t2 = Perl_floor(t2 / (NV)UV_MAX);
+      }
+    }
+  }
+#endif
+#ifdef NV_PAYLOAD_DEBUG
+  for (i = 0; i < (int)C_ARRAY_LENGTH(a); i++) {
+    Perl_warn(aTHX_ "a[%d] = 0x%"UVxf"\n", i, a[i]);
+  }
+#endif
+  for (i = 0; i < (int)sizeof(p); i++) {
+    if (m[i] && p[i] < sizeof(p)) {
+      U8 s = (p[i] % UVSIZE) << 3;
+      UV u = a[p[i] / UVSIZE] & ((UV)0xFF << s);
+      U8 b = (U8)((u >> s) & m[i]);
+      ((U8 *)(nvp))[i] &= ~m[i]; /* For NaNs with non-zero payload bits. */
+      ((U8 *)(nvp))[i] |= b;
+#ifdef NV_PAYLOAD_DEBUG
+      Perl_warn(aTHX_ "set p[%2d] = %02x (i = %d, m = %02x, s = %2d, b = %02x, u = %08"UVxf")\n", i, ((U8 *)(nvp))[i], i, m[i], s, b, u);
+#endif
+      a[p[i] / UVSIZE] &= ~u;
+    }
+  }
+  if (signaling) {
+    NV_NAN_SET_SIGNALING(nvp);
+  }
+#ifdef USE_LONG_DOUBLE
+# if LONG_DOUBLEKIND == 3 || LONG_DOUBLEKIND == 4
+#  if LONG_DOUBLESIZE > 10
+  memset((char *)nvp + 10, '\0', LONG_DOUBLESIZE - 10); /* x86 long double */
+#  endif
+# endif
+#endif
+  for (i = 0; i < (int)C_ARRAY_LENGTH(a); i++) {
+    if (a[i]) {
+      Perl_warn(aTHX_ "payload lost bits (%"UVxf")", a[i]);
+      break;
+    }
+  }
+#ifdef NV_PAYLOAD_DEBUG
+  for (i = 0; i < NVSIZE; i++) {
+    PerlIO_printf(Perl_debug_log, "%02x ", ((U8 *)(nvp))[i]);
+  }
+  PerlIO_printf(Perl_debug_log, "\n");
+#endif
+}
+
+static NV_PAYLOAD_TYPE S_getpayload(NV nv)
+{
+  dTHX;
+  static const U8 m[] = { NV_NAN_PAYLOAD_MASK };
+  static const U8 p[] = { NV_NAN_PAYLOAD_PERM };
+  UV a[(NVSIZE + UVSIZE - 1) / UVSIZE] = { 0 };
+  int i;
+  NV payload;
+  NV_PAYLOAD_SIZEOF_ASSERT(m);
+  NV_PAYLOAD_SIZEOF_ASSERT(p);
+  payload = 0;
+  for (i = 0; i < (int)sizeof(p); i++) {
+    if (m[i] && p[i] < NVSIZE) {
+      U8 s = (p[i] % UVSIZE) << 3;
+      a[p[i] / UVSIZE] |= (UV)(((U8 *)(&nv))[i] & m[i]) << s;
+    }
+  }
+  for (i = (int)C_ARRAY_LENGTH(a) - 1; i >= 0; i--) {
+#ifdef NV_PAYLOAD_DEBUG
+    Perl_warn(aTHX_ "a[%d] = %"UVxf"\n", i, a[i]);
+#endif
+    payload *= UV_MAX;
+    payload += a[i];
+  }
+#ifdef NV_PAYLOAD_DEBUG
+  for (i = 0; i < NVSIZE; i++) {
+    PerlIO_printf(Perl_debug_log, "%02x ", ((U8 *)(&nv))[i]);
+  }
+  PerlIO_printf(Perl_debug_log, "\n");
+#endif
+  return payload;
+}
+
 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
    metaconfig for future extension writers.  We don't use them in POSIX.
    (This is really sneaky :-)  --AD
@@ -1119,11 +1360,13 @@ 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
-#    if defined(OS2)
+#    if defined(OS2) || defined(__amigaos4__)
 #      define mkfifo(a,b) not_here("mkfifo")
 #    else	/* !( defined OS2 ) */
 #      ifndef mkfifo
@@ -1139,7 +1382,9 @@ char *tzname[] = { "" , "" };
 #  ifdef HAS_UNAME
 #    include <sys/utsname.h>
 #  endif
-#  include <sys/wait.h>
+#  ifndef __amigaos4__
+#    include <sys/wait.h>
+#  endif
 #  ifdef I_UTIME
 #    include <utime.h>
 #  endif
@@ -1150,6 +1395,8 @@ typedef int SysRet;
 typedef long SysRetLong;
 typedef sigset_t* POSIX__SigSet;
 typedef HV* POSIX__SigAction;
+typedef int POSIX__SigNo;
+typedef int POSIX__Fd;
 #ifdef I_TERMIOS
 typedef struct termios* POSIX__Termios;
 #else /* Define termios types to int, and call not_here for the functions.*/
@@ -1283,7 +1530,7 @@ struct lconv_offset {
     size_t offset;
 };
 
-const struct lconv_offset lconv_strings[] = {
+static const struct lconv_offset lconv_strings[] = {
 #ifdef USE_LOCALE_NUMERIC
     {"decimal_point",     STRUCT_OFFSET(struct lconv, decimal_point)},
     {"thousands_sep",     STRUCT_OFFSET(struct lconv, thousands_sep)},
@@ -1322,7 +1569,7 @@ const struct lconv_offset lconv_strings[] = {
 #   define isLC_NUMERIC_STRING(name) (0)
 #endif
 
-const struct lconv_offset lconv_integers[] = {
+static const struct lconv_offset lconv_integers[] = {
 #ifdef USE_LOCALE_MONETARY
     {"int_frac_digits",   STRUCT_OFFSET(struct lconv, int_frac_digits)},
     {"frac_digits",       STRUCT_OFFSET(struct lconv, frac_digits)},
@@ -1405,8 +1652,10 @@ restore_sigmask(pTHX_ SV *osset_sv)
       * supposed to return -1 from sigaction unless the disposition
       * was unaffected.
       */
+#if !(defined(__amigaos4__) && defined(__NEWLIB__))
      sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
      (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
+#endif
 }
 
 static void *
@@ -1563,7 +1812,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);
             }
         }
 
@@ -1583,7 +1832,6 @@ MODULE = POSIX		PACKAGE = POSIX
 BOOT:
 {
     CV *cv;
-    const char *file = __FILE__;
 
 
     /* silence compiler warning about not_here() defined but not used */
@@ -1592,37 +1840,37 @@ BOOT:
     /* Ensure we get the function, not a macro implementation. Like the C89
        standard says we can...  */
 #undef isalnum
-    cv = newXS("POSIX::isalnum", is_common, file);
+    cv = newXS_deffile("POSIX::isalnum", is_common);
     XSANY.any_dptr = (any_dptr_t) &isalnum;
 #undef isalpha
-    cv = newXS("POSIX::isalpha", is_common, file);
+    cv = newXS_deffile("POSIX::isalpha", is_common);
     XSANY.any_dptr = (any_dptr_t) &isalpha;
 #undef iscntrl
-    cv = newXS("POSIX::iscntrl", is_common, file);
+    cv = newXS_deffile("POSIX::iscntrl", is_common);
     XSANY.any_dptr = (any_dptr_t) &iscntrl;
 #undef isdigit
-    cv = newXS("POSIX::isdigit", is_common, file);
+    cv = newXS_deffile("POSIX::isdigit", is_common);
     XSANY.any_dptr = (any_dptr_t) &isdigit;
 #undef isgraph
-    cv = newXS("POSIX::isgraph", is_common, file);
+    cv = newXS_deffile("POSIX::isgraph", is_common);
     XSANY.any_dptr = (any_dptr_t) &isgraph;
 #undef islower
-    cv = newXS("POSIX::islower", is_common, file);
+    cv = newXS_deffile("POSIX::islower", is_common);
     XSANY.any_dptr = (any_dptr_t) &islower;
 #undef isprint
-    cv = newXS("POSIX::isprint", is_common, file);
+    cv = newXS_deffile("POSIX::isprint", is_common);
     XSANY.any_dptr = (any_dptr_t) &isprint;
 #undef ispunct
-    cv = newXS("POSIX::ispunct", is_common, file);
+    cv = newXS_deffile("POSIX::ispunct", is_common);
     XSANY.any_dptr = (any_dptr_t) &ispunct;
 #undef isspace
-    cv = newXS("POSIX::isspace", is_common, file);
+    cv = newXS_deffile("POSIX::isspace", is_common);
     XSANY.any_dptr = (any_dptr_t) &isspace;
 #undef isupper
-    cv = newXS("POSIX::isupper", is_common, file);
+    cv = newXS_deffile("POSIX::isupper", is_common);
     XSANY.any_dptr = (any_dptr_t) &isupper;
 #undef isxdigit
-    cv = newXS("POSIX::isxdigit", is_common, file);
+    cv = newXS_deffile("POSIX::isxdigit", is_common);
     XSANY.any_dptr = (any_dptr_t) &isxdigit;
 }
 
@@ -1647,7 +1895,7 @@ new(packname = "POSIX::SigSet", ...)
 SysRet
 addset(sigset, sig)
 	POSIX::SigSet	sigset
-	int		sig
+	POSIX::SigNo	sig
    ALIAS:
 	delset = 1
    CODE:
@@ -1668,7 +1916,7 @@ emptyset(sigset)
 int
 sigismember(sigset, sig)
 	POSIX::SigSet	sigset
-	int		sig
+	POSIX::SigNo	sig
 
 MODULE = Termios	PACKAGE = POSIX::Termios	PREFIX = cf
 
@@ -1694,7 +1942,7 @@ new(packname = "POSIX::Termios", ...)
 SysRet
 getattr(termios_ref, fd = 0)
 	POSIX::Termios	termios_ref
-	int		fd
+	POSIX::Fd		fd
     CODE:
 	RETVAL = tcgetattr(fd, termios_ref);
     OUTPUT:
@@ -1710,14 +1958,19 @@ getattr(termios_ref, fd = 0)
 SysRet
 setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
 	POSIX::Termios	termios_ref
-	int		fd
+	POSIX::Fd	fd
 	int		optional_actions
     CODE:
 	/* The second argument to the call is mandatory, but we'd like to give
 	   it a useful default. 0 isn't valid on all operating systems - on
-	   Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
-	   values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF.  */
-	RETVAL = tcsetattr(fd, optional_actions, termios_ref);
+           Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
+           values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF.  */
+	if (optional_actions < 0) {
+            SETERRNO(EINVAL, LIB_INVARG);
+            RETVAL = -1;
+        } else {
+            RETVAL = tcsetattr(fd, optional_actions, termios_ref);
+        }
     OUTPUT:
 	RETVAL
 
@@ -1897,7 +2150,7 @@ WEXITSTATUS(status)
 #endif
 	    break;
 	default:
-	    Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
+	    croak("Illegal alias %d for POSIX::W*", (int)ix);
 	}
     OUTPUT:
 	RETVAL
@@ -1925,7 +2178,8 @@ localeconv()
 
         /* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
          * LC_MONETARY is already in the correct locale */
-        STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+        STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
 
 	RETVAL = newHV();
 	sv_2mortal((SV*)RETVAL);
@@ -1934,7 +2188,7 @@ localeconv()
 	    const struct lconv_offset *integers = lconv_integers;
 	    const char *ptr = (const char *) lcbuf;
 
-	    do {
+	    while (strings->name) {
                 /* This string may be controlled by either LC_NUMERIC, or
                  * LC_MONETARY */
                 bool is_utf8_locale
@@ -1960,23 +2214,25 @@ 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);
-                  }
-	    } while ((++strings)->name);
+                }
+                strings++;
+	    }
 
-	    do {
+	    while (integers->name) {
 		const char value = *((const char *)(ptr + integers->offset));
 
 		if (value != CHAR_MAX)
 		    (void) hv_store(RETVAL, integers->name,
 				    strlen(integers->name), newSViv(value), 0);
-	    } while ((++integers)->name);
+                integers++;
+            }
 	}
-        RESTORE_NUMERIC_STANDARD();
+        RESTORE_LC_NUMERIC_STANDARD();
 #endif  /* HAS_LOCALECONV */
     OUTPUT:
 	RETVAL
@@ -2000,7 +2256,7 @@ setlocale(category, locale = 0)
             }
 #   ifdef LC_ALL
             else if (category == LC_ALL) {
-                SET_NUMERIC_LOCAL();
+                SET_NUMERIC_UNDERLYING();
             }
 #   endif
         }
@@ -2010,6 +2266,9 @@ setlocale(category, locale = 0)
 #else
 	retval = setlocale(category, locale);
 #endif
+        DEBUG_L(PerlIO_printf(Perl_debug_log,
+            "%s:%d: %s\n", __FILE__, __LINE__,
+                _setlocale_debug_string(category, locale, retval)));
 	if (! retval) {
             /* Should never happen that a query would return an error, but be
              * sure and reset to C locale */
@@ -2022,8 +2281,8 @@ setlocale(category, locale = 0)
         /* Save retval since subsequent setlocale() calls may overwrite it. */
         retval = savepv(retval);
 
-        /* For locale == 0, we may have switched to NUMERIC_LOCAL.  Switch back
-         * */
+        /* For locale == 0, we may have switched to NUMERIC_UNDERLYING.  Switch
+         * back */
         if (locale == 0) {
             SET_NUMERIC_STANDARD();
             XSRETURN_PV(retval);
@@ -2039,8 +2298,12 @@ setlocale(category, locale = 0)
 	    {
 		char *newctype;
 #ifdef LC_ALL
-		if (category == LC_ALL)
+		if (category == LC_ALL) {
 		    newctype = setlocale(LC_CTYPE, NULL);
+                    DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+                        "%s:%d: %s\n", __FILE__, __LINE__,
+                        _setlocale_debug_string(LC_CTYPE, NULL, newctype)));
+                }
 		else
 #endif
 		    newctype = RETVAL;
@@ -2056,8 +2319,12 @@ setlocale(category, locale = 0)
 	    {
 		char *newcoll;
 #ifdef LC_ALL
-		if (category == LC_ALL)
+		if (category == LC_ALL) {
 		    newcoll = setlocale(LC_COLLATE, NULL);
+                    DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+                        "%s:%d: %s\n", __FILE__, __LINE__,
+                        _setlocale_debug_string(LC_COLLATE, NULL, newcoll)));
+                }
 		else
 #endif
 		    newcoll = RETVAL;
@@ -2073,8 +2340,12 @@ setlocale(category, locale = 0)
 	    {
 		char *newnum;
 #ifdef LC_ALL
-		if (category == LC_ALL)
+		if (category == LC_ALL) {
 		    newnum = setlocale(LC_NUMERIC, NULL);
+                    DEBUG_Lv(PerlIO_printf(Perl_debug_log,
+                        "%s:%d: %s\n", __FILE__, __LINE__,
+                        _setlocale_debug_string(LC_NUMERIC, NULL, newnum)));
+                }
 		else
 #endif
 		    newnum = RETVAL;
@@ -2122,6 +2393,7 @@ acos(x)
 	y0 = 29
 	y1 = 30
     CODE:
+	PERL_UNUSED_VAR(x);
 	RETVAL = NV_NAN;
 	switch (ix) {
 	case 0:
@@ -2242,6 +2514,8 @@ acos(x)
 	case 20:
 #ifdef c99_logb
 	    RETVAL = c99_logb(x);
+#elif defined(c99_log2) && FLT_RADIX == 2
+	    RETVAL = Perl_floor(c99_log2(PERL_ABS(x)));
 #else
 	    not_here("logb");
 #endif
@@ -2343,6 +2617,7 @@ fesetround(x)
         default: RETVAL = -1; break;
 	}
 #else
+	PERL_UNUSED_VAR(x);
 	RETVAL = -1;
 	not_here("fesetround");
 #endif
@@ -2362,6 +2637,7 @@ fpclassify(x)
 	lround = 7
         signbit = 8
     CODE:
+        PERL_UNUSED_VAR(x);
 	RETVAL = -1;
 	switch (ix) {
 	case 0:
@@ -2421,6 +2697,41 @@ fpclassify(x)
 	RETVAL
 
 NV
+getpayload(nv)
+	NV nv
+    CODE:
+	RETVAL = S_getpayload(nv);
+    OUTPUT:
+	RETVAL
+
+void
+setpayload(nv, payload)
+	NV nv
+	NV payload
+    CODE:
+	S_setpayload(&nv, payload, FALSE);
+    OUTPUT:
+	nv
+
+void
+setpayloadsig(nv, payload)
+	NV nv
+	NV payload
+    CODE:
+	nv = NV_NAN;
+	S_setpayload(&nv, payload, TRUE);
+    OUTPUT:
+	nv
+
+int
+issignaling(nv)
+	NV nv
+    CODE:
+	RETVAL = Perl_isnan(nv) && NV_NAN_IS_SIGNALING(&nv);
+    OUTPUT:
+	RETVAL
+
+NV
 copysign(x,y)
 	NV		x
 	NV		y
@@ -2440,6 +2751,8 @@ copysign(x,y)
 	nexttoward = 13
 	remainder = 14
     CODE:
+        PERL_UNUSED_VAR(x);
+        PERL_UNUSED_VAR(y);
 	RETVAL = NV_NAN;
 	switch (ix) {
 	case 0:
@@ -2539,9 +2852,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;
 	}
@@ -2581,6 +2894,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
 
@@ -2592,6 +2907,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
@@ -2607,22 +2924,36 @@ fma(x,y,z)
 #ifdef c99_fma
 	RETVAL = c99_fma(x, y, z);
 #else
-	RETVAL = NV_NAN;
+	PERL_UNUSED_VAR(x);
+	PERL_UNUSED_VAR(y);
+	PERL_UNUSED_VAR(z);
 	not_here("fma");
 #endif
     OUTPUT:
 	RETVAL
 
 NV
-nan(s = 0)
-	char*	s;
+nan(payload = 0)
+	NV payload
     CODE:
-#ifdef c99_nan
-	RETVAL = c99_nan(s ? s : "");
-#elif defined(NV_NAN)
-	/* XXX if s != NULL, warn about unused argument,
-         * or implement the nan payload setting. */
-	RETVAL = NV_NAN;
+#ifdef NV_NAN
+        /* If no payload given, just return the default NaN.
+         * This makes a difference in platforms where the default
+         * NaN is not all zeros. */
+	if (items == 0) {
+          RETVAL = NV_NAN;
+	} else {
+          S_setpayload(&RETVAL, payload, FALSE);
+        }
+#elif defined(c99_nan)
+	{
+	  STRLEN elen = my_snprintf(PL_efloatbuf, PL_efloatsize, "%g", nv);
+          if ((IV)elen == -1) {
+	    RETVAL = NV_NAN;
+          } else {
+            RETVAL = c99_nan(PL_efloatbuf);
+          }
+        }
 #else
 	not_here("nan");
 #endif
@@ -2640,17 +2971,21 @@ jn(x,y)
         switch (ix) {
 	case 0:
 #ifdef bessel_jn
-	    RETVAL = bessel_jn(x, y);
+          RETVAL = bessel_jn(x, y);
 #else
-	    not_here("jn");
+	  PERL_UNUSED_VAR(x);
+	  PERL_UNUSED_VAR(y);
+          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");
+	  PERL_UNUSED_VAR(x);
+	  PERL_UNUSED_VAR(y);
+          not_here("yn");
 #endif
             break;
 	}
@@ -2663,10 +2998,10 @@ sigaction(sig, optaction, oldaction = 0)
 	SV *			optaction
 	POSIX::SigAction	oldaction
     CODE:
-#if defined(WIN32) || defined(NETWARE)
+#if defined(WIN32) || defined(NETWARE) || (defined(__amigaos4__) && defined(__NEWLIB__))
 	RETVAL = not_here("sigaction");
 #else
-# This code is really grody because we're trying to make the signal
+# This code is really grody because we are trying to make the signal
 # interface look beautiful, which is hard.
 
 	{
@@ -2853,7 +3188,11 @@ sigpending(sigset)
     ALIAS:
 	sigsuspend = 1
     CODE:
+#ifdef __amigaos4__
+	RETVAL = not_here("sigpending");
+#else
 	RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
+#endif
     OUTPUT:
 	RETVAL
     CLEANUP:
@@ -2890,26 +3229,34 @@ dup2(fd1, fd2)
 	int		fd1
 	int		fd2
     CODE:
+	if (fd1 >= 0 && fd2 >= 0) {
 #ifdef WIN32
-	/* RT #98912 - More Microsoft muppetry - failing to actually implemented
-	   the well known documented POSIX behaviour for a POSIX API.
-	   http://msdn.microsoft.com/en-us/library/8syseb29.aspx   */
-	RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
+            /* RT #98912 - More Microsoft muppetry - failing to
+               actually implemented the well known documented POSIX
+               behaviour for a POSIX API.
+               http://msdn.microsoft.com/en-us/library/8syseb29.aspx  */
+            RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
 #else
-	RETVAL = dup2(fd1, fd2);
+            RETVAL = dup2(fd1, fd2);
 #endif
+        } else {
+            SETERRNO(EBADF,RMS_IFI);
+            RETVAL = -1;
+        }
     OUTPUT:
 	RETVAL
 
 SV *
 lseek(fd, offset, whence)
-	int		fd
+	POSIX::Fd	fd
 	Off_t		offset
 	int		whence
     CODE:
-	Off_t pos = PerlLIO_lseek(fd, offset, whence);
-	RETVAL = sizeof(Off_t) > sizeof(IV)
-		 ? newSVnv((NV)pos) : newSViv((IV)pos);
+	{
+              Off_t pos = PerlLIO_lseek(fd, offset, whence);
+              RETVAL = sizeof(Off_t) > sizeof(IV)
+                ? newSVnv((NV)pos) : newSViv((IV)pos);
+        }
     OUTPUT:
 	RETVAL
 
@@ -2940,7 +3287,7 @@ read(fd, buffer, nbytes)
     PREINIT:
         SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
     INPUT:
-        int             fd
+	POSIX::Fd	fd
         size_t          nbytes
         char *          buffer = sv_grow( sv_buffer, nbytes+1 );
     CLEANUP:
@@ -2961,11 +3308,11 @@ setsid()
 
 pid_t
 tcgetpgrp(fd)
-	int		fd
+	POSIX::Fd	fd
 
 SysRet
 tcsetpgrp(fd, pgrp_id)
-	int		fd
+	POSIX::Fd	fd
 	pid_t		pgrp_id
 
 void
@@ -2987,7 +3334,7 @@ uname()
 
 SysRet
 write(fd, buffer, nbytes)
-	int		fd
+	POSIX::Fd	fd
 	char *		buffer
 	size_t		nbytes
 
@@ -3009,7 +3356,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)));
@@ -3060,17 +3407,18 @@ strtod(str)
 	double num;
 	char *unparsed;
     PPCODE:
-        STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+        STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
 	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))));
 	    else
 		PUSHs(&PL_sv_undef);
 	}
-        RESTORE_NUMERIC_STANDARD();
+        RESTORE_LC_NUMERIC_STANDARD();
 
 #ifdef HAS_STRTOLD
 
@@ -3081,17 +3429,18 @@ strtold(str)
 	long double num;
 	char *unparsed;
     PPCODE:
-        STORE_NUMERIC_STANDARD_FORCE_LOCAL();
+        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+        STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
 	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))));
 	    else
 		PUSHs(&PL_sv_undef);
 	}
-        RESTORE_NUMERIC_STANDARD();
+        RESTORE_LC_NUMERIC_STANDARD();
 
 #endif
 
@@ -3103,20 +3452,29 @@ strtol(str, base = 0)
 	long num;
 	char *unparsed;
     PPCODE:
-	num = strtol(str, &unparsed, base);
-#if IVSIZE <= LONGSIZE
-	if (num < IV_MIN || num > IV_MAX)
-	    PUSHs(sv_2mortal(newSVnv((double)num)));
-	else
-#endif
-	    PUSHs(sv_2mortal(newSViv((IV)num)));
-	if (GIMME == G_ARRAY) {
-	    EXTEND(SP, 1);
-	    if (unparsed)
-		PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
-	    else
-		PUSHs(&PL_sv_undef);
-	}
+	if (base == 0 || (base >= 2 && base <= 36)) {
+            num = strtol(str, &unparsed, base);
+#if IVSIZE < LONGSIZE
+            if (num < IV_MIN || num > IV_MAX)
+                PUSHs(sv_2mortal(newSVnv((double)num)));
+            else
+#endif
+                PUSHs(sv_2mortal(newSViv((IV)num)));
+            if (GIMME_V == G_ARRAY) {
+                EXTEND(SP, 1);
+                if (unparsed)
+                    PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
+                else
+                    PUSHs(&PL_sv_undef);
+            }
+        } else {
+	    SETERRNO(EINVAL, LIB_INVARG);
+            PUSHs(&PL_sv_undef);
+            if (GIMME_V == G_ARRAY) {
+               EXTEND(SP, 1);
+               PUSHs(&PL_sv_undef);
+            }
+        }
 
 void
 strtoul(str, base = 0)
@@ -3126,20 +3484,31 @@ strtoul(str, base = 0)
 	unsigned long num;
 	char *unparsed;
     PPCODE:
-	num = strtoul(str, &unparsed, base);
+	PERL_UNUSED_VAR(str);
+	PERL_UNUSED_VAR(base);
+	if (base == 0 || (base >= 2 && base <= 36)) {
+            num = strtoul(str, &unparsed, base);
 #if IVSIZE <= LONGSIZE
-	if (num > IV_MAX)
-	    PUSHs(sv_2mortal(newSVnv((double)num)));
-	else
-#endif
-	    PUSHs(sv_2mortal(newSViv((IV)num)));
-	if (GIMME == G_ARRAY) {
-	    EXTEND(SP, 1);
-	    if (unparsed)
-		PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
-	    else
-		PUSHs(&PL_sv_undef);
-	}
+            if (num > IV_MAX)
+                PUSHs(sv_2mortal(newSVnv((double)num)));
+            else
+#endif
+                PUSHs(sv_2mortal(newSViv((IV)num)));
+            if (GIMME_V == G_ARRAY) {
+                EXTEND(SP, 1);
+                if (unparsed)
+                    PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
+                else
+                  PUSHs(&PL_sv_undef);
+            }
+	} else {
+	    SETERRNO(EINVAL, LIB_INVARG);
+            PUSHs(&PL_sv_undef);
+            if (GIMME_V == G_ARRAY) {
+               EXTEND(SP, 1);
+               PUSHs(&PL_sv_undef);
+            }
+        }
 
 void
 strxfrm(src)
@@ -3182,27 +3551,37 @@ mkfifo(filename, mode)
 
 SysRet
 tcdrain(fd)
-	int		fd
+	POSIX::Fd	fd
     ALIAS:
 	close = 1
 	dup = 2
     CODE:
-	RETVAL = ix == 1 ? close(fd)
-	    : (ix < 1 ? tcdrain(fd) : dup(fd));
+	if (fd >= 0) {
+	    RETVAL = ix == 1 ? close(fd)
+	      : (ix < 1 ? tcdrain(fd) : dup(fd));
+	} else {
+	    SETERRNO(EBADF,RMS_IFI);
+	    RETVAL = -1;
+	}
     OUTPUT:
 	RETVAL
 
 
 SysRet
 tcflow(fd, action)
-	int		fd
+	POSIX::Fd	fd
 	int		action
     ALIAS:
 	tcflush = 1
 	tcsendbreak = 2
     CODE:
-	RETVAL = ix == 1 ? tcflush(fd, action)
-	    : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
+        if (action >= 0) {
+            RETVAL = ix == 1 ? tcflush(fd, action)
+              : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
+        } else {
+            SETERRNO(EINVAL,LIB_INVARG);
+            RETVAL = -1;
+        }
     OUTPUT:
 	RETVAL
 
@@ -3304,7 +3683,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)
@@ -3359,6 +3738,7 @@ cuserid(s = 0)
 #ifdef HAS_CUSERID
   RETVAL = cuserid(s);
 #else
+  PERL_UNUSED_VAR(s);
   RETVAL = 0;
   not_here("cuserid");
 #endif
@@ -3367,7 +3747,7 @@ cuserid(s = 0)
 
 SysRetLong
 fpathconf(fd, name)
-	int		fd
+	POSIX::Fd	fd
 	int		name
 
 SysRetLong
@@ -3402,7 +3782,7 @@ sysconf(name)
 
 char *
 ttyname(fd)
-	int		fd
+	POSIX::Fd	fd
 
 void
 getcwd()
@@ -3424,6 +3804,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: