This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POSIX math: Configure scan d_fegetround and i_fenv.
[perl5.git] / ext / POSIX / POSIX.xs
1 #define PERL_EXT_POSIX
2
3 #ifdef NETWARE
4         #define _POSIX_
5         /*
6          * Ideally this should be somewhere down in the includes
7          * but putting it in other places is giving compiler errors.
8          * Also here I am unable to check for HAS_UNAME since it wouldn't have
9          * yet come into the file at this stage - sgp 18th Oct 2000
10          */
11         #include <sys/utsname.h>
12 #endif  /* NETWARE */
13
14 #define PERL_NO_GET_CONTEXT
15
16 #include "EXTERN.h"
17 #define PERLIO_NOT_STDIO 1
18 #include "perl.h"
19 #include "XSUB.h"
20 #if defined(PERL_IMPLICIT_SYS)
21 #  undef signal
22 #  undef open
23 #  undef setmode
24 #  define open PerlLIO_open3
25 #endif
26 #include <ctype.h>
27 #ifdef I_DIRENT    /* XXX maybe better to just rely on perl.h? */
28 #include <dirent.h>
29 #endif
30 #include <errno.h>
31 #ifdef WIN32
32 #include <sys/errno2.h>
33 #endif
34 #ifdef I_FLOAT
35 #include <float.h>
36 #endif
37 #ifdef I_LIMITS
38 #include <limits.h>
39 #endif
40 #include <locale.h>
41 #include <math.h>
42 #ifdef I_PWD
43 #include <pwd.h>
44 #endif
45 #include <setjmp.h>
46 #include <signal.h>
47 #include <stdarg.h>
48
49 #ifdef I_STDDEF
50 #include <stddef.h>
51 #endif
52
53 #ifdef I_UNISTD
54 #include <unistd.h>
55 #endif
56
57 #ifndef M_E
58 #  define M_E           2.71828182845904523536028747135266250
59 #endif
60 #ifndef M_LOG2E
61 #  define M_LOG2E       1.44269504088896340735992468100189214
62 #endif
63 #ifndef M_LOG10E
64 #  define M_LOG10E      0.434294481903251827651128918916605082
65 #endif
66 #ifndef M_LN2
67 #  define M_LN2         0.693147180559945309417232121458176568
68 #endif
69 #ifndef M_LN10
70 #  define M_LN10        2.30258509299404568401799145468436421
71 #endif
72 #ifndef M_PI
73 #  define M_PI          3.14159265358979323846264338327950288
74 #endif
75 #ifndef M_PI_2
76 #  define M_PI_2        1.57079632679489661923132169163975144
77 #endif
78 #ifndef M_PI_4
79 #  define M_PI_4        0.785398163397448309615660845819875721
80 #endif
81 #ifndef M_1_PI
82 #  define M_1_PI        0.318309886183790671537767526745028724
83 #endif
84 #ifndef M_2_PI
85 #  define M_2_PI        0.636619772367581343075535053490057448
86 #endif
87 #ifndef M_2_SQRTPI
88 #  define M_2_SQRTPI    1.12837916709551257389615890312154517
89 #endif
90 #ifndef M_SQRT2
91 #  define M_SQRT2       1.41421356237309504880168872420969808
92 #endif
93 #ifndef M_SQRT1_2
94 #  define M_SQRT1_2     0.707106781186547524400844362104849039
95 #endif
96
97 /* We will have an emulation. */
98 #if !defined(HAS_FPCLASSIFY) && !defined(FP_INFINITE)
99 #  define FP_INFINITE   0
100 #  define FP_NAN        1
101 #  define FP_NORMAL     2
102 #  define FP_SUBNORMAL  3
103 #  define FP_ZERO       4
104 #endif
105
106 /* C89 math.h:
107
108    acos asin atan atan2 ceil cos cosh exp fabs floor fmod frexp ldexp
109    log log10 modf pow sin sinh sqrt tan tanh
110
111  * Implemented in core:
112
113    atan2 cos exp log pow sin sqrt
114
115   * Berkeley/SVID extensions:
116
117     j0 j1 jn y0 y1 yn
118
119  * C99 math.h added:
120
121    acosh asinh atanh cbrt copysign cosh erf erfc exp2 expm1 fdim fma
122    fmax fmin fpclassify hypot ilogb isfinite isgreater isgreaterequal
123    isinf isless islessequal islessgreater isnan isnormal isunordered
124    lgamma log1p log2 logb lrint nan nearbyint nextafter nexttoward remainder
125    remquo rint round scalbn signbit sinh tanh tgamma trunc
126
127   * Configure already (5.21.0) scans for:
128
129     fpclassify isfinite isinf isnan ilogb*l* signbit
130
131 */
132
133 /* XXX Add ldiv(), lldiv()?  It's C99, but from stdlib.h, not math.h  */
134
135 /* XXX Beware old gamma() -- one cannot know whether that is the
136    gamma or the log of gamma, that's why the new tgamma and lgamma. */
137
138 /* XXX The truthiness of acosh() is the canary for all of the
139  * C99 math.  This is very likely wrong, especially in non-UNIX lands
140  * like Win32 and VMS, but also older UNIXes have issues.  For Win32
141  * we later do some undefines for these interfaces.
142  *
143  * But we are very trying very hard to avoid introducing separate Configure
144  * symbols for all the 40-ish new math symbols.  Especially since the set
145  * of missing functions doesn't seem to follow any patterns. */
146
147 #ifdef HAS_ACOSH
148 #  if defined(USE_LONG_DOUBLE) && defined(HAS_ILOGBL)
149 /* There's already a symbol for ilogbl, we will use its truthiness
150  * as the canary for all the *l variants being defined. */
151 #    define c99_acosh   acoshl
152 #    define c99_asinh   asinhl
153 #    define c99_atanh   atanhl
154 #    define c99_cbrt    cbrtl
155 #    define c99_copysign        copysignl
156 #    define c99_erf     erfl
157 #    define c99_erfc    erfcl
158 #    define c99_exp2    exp2l
159 #    define c99_expm1   expm1l
160 #    define c99_fdim    fdiml
161 #    define c99_fma     fmal
162 #    define c99_fmax    fmaxl
163 #    define c99_fmin    fminl
164 #    define c99_hypot   hypotl
165 #    define c99_ilogb   ilogbl
166 #    define c99_lgamma  gammal
167 #    define c99_log1p   log1pl
168 #    define c99_log2    log2l
169 #    define c99_logb    logbl
170 #    if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
171 #      define c99_lrint llrintl
172 #    else
173 #      define c99_lrint lrintl
174 #    endif
175 #    define c99_nan     nanl
176 #    define c99_nearbyint       nearbyintl
177 #    define c99_nextafter       nextafterl
178 #    define c99_nexttoward      nexttowardl
179 #    define c99_remainder       remainderl
180 #    define c99_remquo  remquol
181 #    define c99_rint    rintl
182 #    define c99_round   roundl
183 #    define c99_scalbn  scalbnl
184 #    ifdef HAS_SIGNBIT /* possibly bad assumption */
185 #      define c99_signbit       signbitl
186 #    endif
187 #    define c99_tgamma  tgammal
188 #    define c99_trunc   truncl
189 #  else
190 #    define c99_acosh   acosh
191 #    define c99_asinh   asinh
192 #    define c99_atanh   atanh
193 #    define c99_cbrt    cbrt
194 #    define c99_copysign        copysign
195 #    define c99_erf     erf
196 #    define c99_erfc    erfc
197 #    define c99_exp2    exp2
198 #    define c99_expm1   expm1
199 #    define c99_fdim    fdim
200 #    define c99_fma     fma
201 #    define c99_fmax    fmax
202 #    define c99_fmin    fmin
203 #    define c99_hypot   hypot
204 #    define c99_ilogb   ilogb
205 #    define c99_lgamma  lgamma
206 #    define c99_log1p   log1p
207 #    define c99_log2    log2
208 #    define c99_logb    logb
209 #    if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
210 #      define c99_lrint llrint
211 #    else
212 #      define c99_lrint lrint
213 #    endif
214 #    define c99_nan     nan
215 #    define c99_nearbyint       nearbyint
216 #    define c99_nextafter       nextafter
217 #    define c99_nexttoward      nexttoward
218 #    define c99_remainder       remainder
219 #    define c99_remquo  remquo
220 #    define c99_rint    rint
221 #    define c99_round   round
222 #    define c99_scalbn  scalbn
223 /* We already define Perl_signbit in perl.h. */
224 #    ifdef HAS_SIGNBIT
225 #      define c99_signbit       signbit
226 #    endif
227 #    define c99_tgamma  tgamma
228 #    define c99_trunc   trunc
229 #  endif
230
231 /* Check both the Configure symbol and the macro-ness (like C99 promises). */ 
232 #  if defined(HAS_FPCLASSIFY) && defined(fpclassify)
233 #    define c99_fpclassify      fpclassify
234 #  endif
235 /* Like isnormal(), the isfinite(), isinf(), and isnan() are also C99
236    and also (sizeof-arg-aware) macros, but they are already well taken
237    care of by Configure et al, and defined in perl.h as
238    Perl_isfinite(), Perl_isinf(), and Perl_isnan(). */
239 #  ifdef isnormal
240 #    define c99_isnormal        isnormal
241 #  endif
242 #  ifdef isgreater /* canary for all the C99 is*<cmp>* macros. */
243 #    define c99_isgreater       isgreater
244 #    define c99_isgreaterequal  isgreaterequal
245 #    define c99_isless          isless
246 #    define c99_islessequal     islessequal
247 #    define c99_islessgreater   islessgreater
248 #    define c99_isunordered     isunordered
249 #  endif
250 #endif
251
252 /* HP-UX on PA-RISC is missing certain C99 math functions,
253  * but on IA64 (Integrity) these do exist. */
254 #if defined(__hpux) && defined(__hppa)
255 #  undef c99_fma
256 #  undef c99_nexttoward
257 #  undef c99_tgamma
258 #endif
259
260 /* XXX Regarding C99 math.h, Win32 seems to be missing these:
261
262   exp2 fdim fma fmax fmin fpclassify ilogb lgamma log1p log2 lrint
263   remquo rint signbit tgamma trunc
264
265   Win32 does seem to have these:
266
267   acosh asinh atanh cbrt copysign cosh erf erfc expm1 hypot log10 nan
268   nearbyint nextafter nexttoward remainder round scalbn
269
270   And the Bessel functions are defined like _this.
271 */
272
273 #ifdef WIN32
274 #  undef c99_exp2
275 #  undef c99_fdim
276 #  undef c99_fma
277 #  undef c99_fmax
278 #  undef c99_fmin
279 #  undef c99_ilogb
280 #  undef c99_lgamma
281 #  undef c99_log1p
282 #  undef c99_log2
283 #  undef c99_lrint
284 #  undef c99_remquo
285 #  undef c99_rint
286 #  undef c99_signbit
287 #  undef c99_tgamma
288 #  undef c99_trunc
289
290 /* Some APIs exist under Win32 with "underbar" names. */
291 #  undef c99_hypot
292 #  undef c99_logb
293 #  undef c99_nextafter
294 #  define c99_hypot _hypot
295 #  define c99_logb _logb
296 #  define c99_nextafter _nextafter
297
298 #endif
299
300 /* The Bessel functions: BSD, SVID, XPG4, and POSIX.  But not C99. */
301 #ifdef HAS_J0
302 #  if defined(USE_LONG_DOUBLE) && defined(HAS_J0L)
303 #    define bessel_j0 j0l
304 #    define bessel_j1 j1l
305 #    define bessel_jn jnl
306 #    define bessel_y0 y0l
307 #    define bessel_y1 y1l
308 #    define bessel_yn ynl
309 #  else
310 #    ifdef WIN32
311 #      define bessel_j0 _j0
312 #      define bessel_j1 _j1
313 #      define bessel_jn _jn
314 #      define bessel_y0 _y0
315 #      define bessel_y1 _y1
316 #      define bessel_yn _yn
317 #    else
318 #      define bessel_j0 j0
319 #      define bessel_j1 j1
320 #      define bessel_jn jn
321 #      define bessel_y0 y0
322 #      define bessel_y1 y1
323 #      define bessel_yn yn
324 #    endif
325 #  endif
326 #endif
327
328 /* Emulations for missing math APIs.
329  *
330  * Keep in mind that the point of many of these functions is that
331  * they, if available, are supposed to give more precise/more
332  * numerically stable results.
333  *
334  * See e.g. http://www.johndcook.com/math_h.html
335  */
336
337 /* XXX cosh sinh tanh */
338
339 #ifndef c99_acosh
340 static NV my_acosh(NV x)
341 {
342   return Perl_log(x + Perl_sqrt(x * x - 1));
343 }
344 #  define c99_acosh my_acosh
345 #endif
346
347 #ifndef c99_asinh
348 static NV my_asinh(NV x)
349 {
350   return Perl_log(x + Perl_sqrt(x * x + 1));
351 }
352 #  define c99_asinh my_asinh
353 #endif
354
355 #ifndef c99_atanh
356 static NV my_atanh(NV x)
357 {
358   return (Perl_log(1 + x) - Perl_log(1 - x)) / 2;
359 }
360 #  define c99_atanh my_atanh
361 #endif
362
363 #ifndef c99_cbrt
364 static NV my_cbrt(NV x)
365 {
366   static const NV one_third = (NV)1.0/3;
367   return x >= 0.0 ? Perl_pow(x, one_third) : -Perl_pow(-x, one_third);
368 }
369 #  define c99_cbrt my_cbrt
370 #endif
371
372 #ifndef c99_copysign
373 static NV my_copysign(NV x, NV y)
374 {
375   return y >= 0 ? (x < 0 ? -x : x) : (x < 0 ? x : -x);
376 }
377 #  define c99_copysign my_copysign
378 #endif
379
380 #ifndef c99_exp2
381 static NV my_exp2(NV x)
382 {
383   return Perl_pow((NV)2.0, x);
384 }
385 #  define c99_exp2 my_exp2
386 #endif
387
388 #ifndef c99_expm1
389 static NV my_expm1(NV x)
390 {
391   if (PERL_ABS(x) < 1e-5)
392     /* Probably not enough for long doubles. */
393     return x * (1.0 + x * (0.5 + x / 6.0)); /* Taylor series */
394   else
395     return Perl_exp(x) - 1;
396 }
397 #  define c99_expm1 my_expm1
398 #endif
399
400 #ifndef c99_fdim
401 static NV my_fdim(NV x, NV y)
402 {
403   return x > y ? x - y : 0;
404 }
405 #  define c99_fdim my_fdim
406 #endif
407
408 #ifndef c99_fmax
409 static NV my_fmax(NV x, NV y)
410 {
411   if (Perl_isnan(x)) {
412     return Perl_isnan(y) ? NV_NAN : y;
413   } else if (Perl_isnan(y)) {
414     return x;
415   }
416   return x > y ? x : y;
417 }
418 #  define c99_fmax my_fmax
419 #endif
420
421 #ifndef c99_fmin
422 static NV my_fmin(NV x, NV y)
423 {
424   if (Perl_isnan(x)) {
425     return Perl_isnan(y) ? NV_NAN : y;
426   } else if (Perl_isnan(y)) {
427     return x;
428   }
429   return x < y ? x : y;
430 }
431 #  define c99_fmin my_fmin
432 #endif
433
434 #ifndef HAS_FPCLASSIFY
435 static NV my_fpclassify(NV x)
436 {
437 #if (defined(HAS_FPCLASS) || defined(HAS_FPCLASSL)) && defined(FP_CLASS_SNAN)
438   switch (Perl_fp_class(x)) {
439   case FP_CLASS_NINF:    case FP_CLASS_PINF:    return FP_INFINITE;
440   case FP_CLASS_SNAN:    case FP_CLASS_QNAN:    return FP_NAN;
441   case FP_CLASS_NNORM:   case FP_CLASS_PNORM:   return FP_NORMAL;
442   case FP_CLASS_NDENORM: case FP_CLASS_PDENORM: return FP_SUBNORMAL;
443   case FP_CLASS_NZERO:   case FP_CLASS_PZERO:   return FP_ZERO;
444   default: return -1;
445   }
446 #  define c99_fpclassify my_fpclassify
447 #elif (defined(HAS_FPCLASS) || defined(HAS_FP_CLASSL)) && defined(FP_SNAN)
448   switch (Perl_fp_class(x)) {
449   case FP_NINF:    case FP_PINF:    return FP_INFINITE;
450   case FP_SNAN:    case FP_QNAN:    return FP_NAN;
451   case FP_NNORM:   case FP_PNORM:   return FP_NORMAL;
452   case FP_NDENORM: case FP_PDENORM: return FP_SUBNORMAL;
453   case FP_NZERO:   case FP_PZERO:   return FP_ZERO;
454   default: return -1;
455   }
456 #  define c99_fpclassify my_fpclassify
457 #elif defined(HAS_FP_CLASS) && defined(FP_POS_INF)
458   switch (Perl_fp_class(x)) {
459   case FP_NEG_INF:    case FP_POS_INF:    return FP_INFINITE;
460   case FP_SNAN:       case FP_QNAN:       return FP_NAN;
461   case FP_NEG_NORM:   case FP_POS_NORM:   return FP_NORMAL;
462   case FP_NEG_DENORM: case FP_POS_DENORM: return FP_SUBNORMAL;
463   case FP_NEG_ZERO:   case FP_POS_ZERO:   return FP_ZERO;
464   default: return -1;
465   }
466 #  define c99_fpclassify my_fpclassify
467 #elif defined(HAS_CLASS) && defined(FP_PLUS_INF)
468   switch (Perl_fp_class(x)) {
469   case FP_MINUS_INF:    case FP_PLUS_INF:    return FP_INFINITE;
470   case FP_SNAN:         case FP_QNAN:        return FP_NAN;
471   case FP_MINUS_NORM:   case FP_PLUS_NORM:   return FP_NORMAL;
472   case FP_MINUS_DENORM: case FP_PLUS_DENORM: return FP_SUBNORMAL;
473   case FP_MINUS_ZERO:   case FP_PLUS_ZERO:   return FP_ZERO;
474   default: return -1;
475   }
476 #  define c99_fpclassify my_fpclassify
477 #elif defined(HAS_FP_CLASSIFY)
478   return Perl_fp_class(x);
479 #  define c99_fpclassify my_fpclassify
480 #elif defined(WIN32)
481   int fpclass = _fpclass(x);
482   if (Perl_fp_class_inf(x))    return FP_INFINITE;
483   if (Perl_fp_class_nan(x))    return FP_NAN;
484   if (Perl_fp_class_norm(x))   return FP_NORMAL;
485   if (Perl_fp_class_denorm(x)) return FP_SUBNORMAL;
486   if (Perl_fp_class_zero(x))   return FP_ZERO;
487   return -1;
488 #  define c99_fpclassify my_fpclassify
489 #endif
490 }
491 #endif
492
493 #ifndef c99_hypot
494 static NV my_hypot(NV x, NV y)
495 {
496   if (x > 0.0) {
497     NV t = y / x;
498     return PERL_ABS(x) * Perl_sqrt(1 + t * t);
499   }
500   return NV_NAN;
501 }
502 #  define c99_hypot my_hypot
503 #endif
504
505 #ifndef c99_ilogb
506 static IV my_ilogb(NV x)
507 {
508   return (IV)(Perl_log(x) * M_LOG2E);
509 }
510 #  define c99_ilogb my_ilogb
511 #endif
512
513 #ifndef c99_log1p
514 static NV my_log1p(NV x)
515 {
516   if (PERL_ABS(x) > 1e-4)
517     return Perl_log(1.0 + x);
518   else
519     /* Probably not enough for long doubles. */
520     return x * (1.0 - x * (-x / 2.0 + x / 3.0)); /* Taylor series */
521 }
522 #  define c99_log1p my_log1p
523 #endif
524
525 #ifndef c99_log2
526 static NV my_log2(NV x)
527 {
528   return Perl_log(x) * M_LOG2E;
529 }
530 #  define c99_log2 my_log2
531 #endif
532
533 #ifndef c99_round
534 static NV my_round(NV x)
535 {
536   return (NV)((IV)(x >= 0.0 ? x + 0.5 : x - 0.5));
537 }
538 #  define c99_round my_round
539 #endif
540
541 #ifndef c99_scalbn
542 #   if defined(Perl_ldexpl) && FLT_RADIX == 2
543 static NV my_scalbn(NV x)
544 {
545   return Perl_ldexp(x, y);
546 }
547 #    define c99_scalbn my_scalbn
548 #  endif
549 #endif
550
551 #ifndef c99_trunc
552 static NV my_trunc(NV x)
553 {
554   return (NV)((IV)(x));
555 }
556 #  define c99_trunc my_trunc
557 #endif
558
559 #ifndef c99_tgamma
560 #  ifdef c99_lgamma
561 static NV my_tgamma(NV x)
562 {
563   double l = c99_lgamma(x);
564   return signgam * Perl_exp(l); /* XXX evil global signgam, need lgamma_r */
565 }
566 #  define c99_tgamma my_tgamma
567 #  endif
568 #endif
569
570 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
571    metaconfig for future extension writers.  We don't use them in POSIX.
572    (This is really sneaky :-)  --AD
573 */
574 #if defined(I_TERMIOS)
575 #include <termios.h>
576 #endif
577 #ifdef I_STDLIB
578 #include <stdlib.h>
579 #endif
580 #ifndef __ultrix__
581 #include <string.h>
582 #endif
583 #include <sys/stat.h>
584 #include <sys/types.h>
585 #include <time.h>
586 #ifdef I_UNISTD
587 #include <unistd.h>
588 #endif
589 #include <fcntl.h>
590
591 #ifdef HAS_TZNAME
592 #  if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
593 extern char *tzname[];
594 #  endif
595 #else
596 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
597 char *tzname[] = { "" , "" };
598 #endif
599 #endif
600
601 #if defined(__VMS) && !defined(__POSIX_SOURCE)
602
603 #  include <utsname.h>
604
605 #  undef mkfifo
606 #  define mkfifo(a,b) (not_here("mkfifo"),-1)
607
608    /* The POSIX notion of ttyname() is better served by getname() under VMS */
609    static char ttnambuf[64];
610 #  define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
611
612 #else
613 #if defined (__CYGWIN__)
614 #    define tzname _tzname
615 #endif
616 #if defined (WIN32) || defined (NETWARE)
617 #  undef mkfifo
618 #  define mkfifo(a,b) not_here("mkfifo")
619 #  define ttyname(a) (char*)not_here("ttyname")
620 #  define sigset_t long
621 #  define pid_t long
622 #  ifdef _MSC_VER
623 #    define mode_t short
624 #  endif
625 #  ifdef __MINGW32__
626 #    define mode_t short
627 #    ifndef tzset
628 #      define tzset()           not_here("tzset")
629 #    endif
630 #    ifndef _POSIX_OPEN_MAX
631 #      define _POSIX_OPEN_MAX   FOPEN_MAX       /* XXX bogus ? */
632 #    endif
633 #  endif
634 #  define sigaction(a,b,c)      not_here("sigaction")
635 #  define sigpending(a)         not_here("sigpending")
636 #  define sigprocmask(a,b,c)    not_here("sigprocmask")
637 #  define sigsuspend(a)         not_here("sigsuspend")
638 #  define sigemptyset(a)        not_here("sigemptyset")
639 #  define sigaddset(a,b)        not_here("sigaddset")
640 #  define sigdelset(a,b)        not_here("sigdelset")
641 #  define sigfillset(a)         not_here("sigfillset")
642 #  define sigismember(a,b)      not_here("sigismember")
643 #ifndef NETWARE
644 #  undef setuid
645 #  undef setgid
646 #  define setuid(a)             not_here("setuid")
647 #  define setgid(a)             not_here("setgid")
648 #endif  /* NETWARE */
649 #  define strtold(s1,s2)        not_here("strtold")
650 #else
651
652 #  ifndef HAS_MKFIFO
653 #    if defined(OS2)
654 #      define mkfifo(a,b) not_here("mkfifo")
655 #    else       /* !( defined OS2 ) */
656 #      ifndef mkfifo
657 #        define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
658 #      endif
659 #    endif
660 #  endif /* !HAS_MKFIFO */
661
662 #  ifdef I_GRP
663 #    include <grp.h>
664 #  endif
665 #  include <sys/times.h>
666 #  ifdef HAS_UNAME
667 #    include <sys/utsname.h>
668 #  endif
669 #  include <sys/wait.h>
670 #  ifdef I_UTIME
671 #    include <utime.h>
672 #  endif
673 #endif /* WIN32 || NETWARE */
674 #endif /* __VMS */
675
676 typedef int SysRet;
677 typedef long SysRetLong;
678 typedef sigset_t* POSIX__SigSet;
679 typedef HV* POSIX__SigAction;
680 #ifdef I_TERMIOS
681 typedef struct termios* POSIX__Termios;
682 #else /* Define termios types to int, and call not_here for the functions.*/
683 #define POSIX__Termios int
684 #define speed_t int
685 #define tcflag_t int
686 #define cc_t int
687 #define cfgetispeed(x) not_here("cfgetispeed")
688 #define cfgetospeed(x) not_here("cfgetospeed")
689 #define tcdrain(x) not_here("tcdrain")
690 #define tcflush(x,y) not_here("tcflush")
691 #define tcsendbreak(x,y) not_here("tcsendbreak")
692 #define cfsetispeed(x,y) not_here("cfsetispeed")
693 #define cfsetospeed(x,y) not_here("cfsetospeed")
694 #define ctermid(x) (char *) not_here("ctermid")
695 #define tcflow(x,y) not_here("tcflow")
696 #define tcgetattr(x,y) not_here("tcgetattr")
697 #define tcsetattr(x,y,z) not_here("tcsetattr")
698 #endif
699
700 /* Possibly needed prototypes */
701 #ifndef WIN32
702 START_EXTERN_C
703 double strtod (const char *, char **);
704 long strtol (const char *, char **, int);
705 unsigned long strtoul (const char *, char **, int);
706 #ifdef HAS_STRTOLD
707 long double strtold (const char *, char **);
708 #endif
709 END_EXTERN_C
710 #endif
711
712 #ifndef HAS_DIFFTIME
713 #ifndef difftime
714 #define difftime(a,b) not_here("difftime")
715 #endif
716 #endif
717 #ifndef HAS_FPATHCONF
718 #define fpathconf(f,n)  (SysRetLong) not_here("fpathconf")
719 #endif
720 #ifndef HAS_MKTIME
721 #define mktime(a) not_here("mktime")
722 #endif
723 #ifndef HAS_NICE
724 #define nice(a) not_here("nice")
725 #endif
726 #ifndef HAS_PATHCONF
727 #define pathconf(f,n)   (SysRetLong) not_here("pathconf")
728 #endif
729 #ifndef HAS_SYSCONF
730 #define sysconf(n)      (SysRetLong) not_here("sysconf")
731 #endif
732 #ifndef HAS_READLINK
733 #define readlink(a,b,c) not_here("readlink")
734 #endif
735 #ifndef HAS_SETPGID
736 #define setpgid(a,b) not_here("setpgid")
737 #endif
738 #ifndef HAS_SETSID
739 #define setsid() not_here("setsid")
740 #endif
741 #ifndef HAS_STRCOLL
742 #define strcoll(s1,s2) not_here("strcoll")
743 #endif
744 #ifndef HAS_STRTOD
745 #define strtod(s1,s2) not_here("strtod")
746 #endif
747 #ifndef HAS_STRTOLD
748 #define strtold(s1,s2) not_here("strtold")
749 #endif
750 #ifndef HAS_STRTOL
751 #define strtol(s1,s2,b) not_here("strtol")
752 #endif
753 #ifndef HAS_STRTOUL
754 #define strtoul(s1,s2,b) not_here("strtoul")
755 #endif
756 #ifndef HAS_STRXFRM
757 #define strxfrm(s1,s2,n) not_here("strxfrm")
758 #endif
759 #ifndef HAS_TCGETPGRP
760 #define tcgetpgrp(a) not_here("tcgetpgrp")
761 #endif
762 #ifndef HAS_TCSETPGRP
763 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
764 #endif
765 #ifndef HAS_TIMES
766 #ifndef NETWARE
767 #define times(a) not_here("times")
768 #endif  /* NETWARE */
769 #endif
770 #ifndef HAS_UNAME
771 #define uname(a) not_here("uname")
772 #endif
773 #ifndef HAS_WAITPID
774 #define waitpid(a,b,c) not_here("waitpid")
775 #endif
776
777 #ifndef HAS_MBLEN
778 #ifndef mblen
779 #define mblen(a,b) not_here("mblen")
780 #endif
781 #endif
782 #ifndef HAS_MBSTOWCS
783 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
784 #endif
785 #ifndef HAS_MBTOWC
786 #define mbtowc(pwc, s, n) not_here("mbtowc")
787 #endif
788 #ifndef HAS_WCSTOMBS
789 #define wcstombs(s, pwcs, n) not_here("wcstombs")
790 #endif
791 #ifndef HAS_WCTOMB
792 #define wctomb(s, wchar) not_here("wcstombs")
793 #endif
794 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
795 /* If we don't have these functions, then we wouldn't have gotten a typedef
796    for wchar_t, the wide character type.  Defining wchar_t allows the
797    functions referencing it to compile.  Its actual type is then meaningless,
798    since without the above functions, all sections using it end up calling
799    not_here() and croak.  --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
800 #ifndef wchar_t
801 #define wchar_t char
802 #endif
803 #endif
804
805 #ifndef HAS_LOCALECONV
806 #   define localeconv() not_here("localeconv")
807 #else
808 struct lconv_offset {
809     const char *name;
810     size_t offset;
811 };
812
813 const struct lconv_offset lconv_strings[] = {
814 #ifdef USE_LOCALE_NUMERIC
815     {"decimal_point",     STRUCT_OFFSET(struct lconv, decimal_point)},
816     {"thousands_sep",     STRUCT_OFFSET(struct lconv, thousands_sep)},
817 #  ifndef NO_LOCALECONV_GROUPING
818     {"grouping",          STRUCT_OFFSET(struct lconv, grouping)},
819 #  endif
820 #endif
821 #ifdef USE_LOCALE_MONETARY
822     {"int_curr_symbol",   STRUCT_OFFSET(struct lconv, int_curr_symbol)},
823     {"currency_symbol",   STRUCT_OFFSET(struct lconv, currency_symbol)},
824     {"mon_decimal_point", STRUCT_OFFSET(struct lconv, mon_decimal_point)},
825 #  ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
826     {"mon_thousands_sep", STRUCT_OFFSET(struct lconv, mon_thousands_sep)},
827 #  endif
828 #  ifndef NO_LOCALECONV_MON_GROUPING
829     {"mon_grouping",      STRUCT_OFFSET(struct lconv, mon_grouping)},
830 #  endif
831     {"positive_sign",     STRUCT_OFFSET(struct lconv, positive_sign)},
832     {"negative_sign",     STRUCT_OFFSET(struct lconv, negative_sign)},
833 #endif
834     {NULL, 0}
835 };
836
837 #ifdef USE_LOCALE_NUMERIC
838
839 /* The Linux man pages say these are the field names for the structure
840  * components that are LC_NUMERIC; the rest being LC_MONETARY */
841 #   define isLC_NUMERIC_STRING(name) (strcmp(name, "decimal_point")     \
842                                       || strcmp(name, "thousands_sep")  \
843                                                                         \
844                                       /* There should be no harm done   \
845                                        * checking for this, even if     \
846                                        * NO_LOCALECONV_GROUPING */      \
847                                       || strcmp(name, "grouping"))
848 #else
849 #   define isLC_NUMERIC_STRING(name) (0)
850 #endif
851
852 const struct lconv_offset lconv_integers[] = {
853 #ifdef USE_LOCALE_MONETARY
854     {"int_frac_digits",   STRUCT_OFFSET(struct lconv, int_frac_digits)},
855     {"frac_digits",       STRUCT_OFFSET(struct lconv, frac_digits)},
856     {"p_cs_precedes",     STRUCT_OFFSET(struct lconv, p_cs_precedes)},
857     {"p_sep_by_space",    STRUCT_OFFSET(struct lconv, p_sep_by_space)},
858     {"n_cs_precedes",     STRUCT_OFFSET(struct lconv, n_cs_precedes)},
859     {"n_sep_by_space",    STRUCT_OFFSET(struct lconv, n_sep_by_space)},
860     {"p_sign_posn",       STRUCT_OFFSET(struct lconv, p_sign_posn)},
861     {"n_sign_posn",       STRUCT_OFFSET(struct lconv, n_sign_posn)},
862 #endif
863     {NULL, 0}
864 };
865
866 #endif /* HAS_LOCALECONV */
867
868 #ifdef HAS_LONG_DOUBLE
869 #  if LONG_DOUBLESIZE > NVSIZE
870 #    undef HAS_LONG_DOUBLE  /* XXX until we figure out how to use them */
871 #  endif
872 #endif
873
874 #ifndef HAS_LONG_DOUBLE
875 #ifdef LDBL_MAX
876 #undef LDBL_MAX
877 #endif
878 #ifdef LDBL_MIN
879 #undef LDBL_MIN
880 #endif
881 #ifdef LDBL_EPSILON
882 #undef LDBL_EPSILON
883 #endif
884 #endif
885
886 /* Background: in most systems the low byte of the wait status
887  * is the signal (the lowest 7 bits) and the coredump flag is
888  * the eight bit, and the second lowest byte is the exit status.
889  * BeOS bucks the trend and has the bytes in different order.
890  * See beos/beos.c for how the reality is bent even in BeOS
891  * to follow the traditional.  However, to make the POSIX
892  * wait W*() macros to work in BeOS, we need to unbend the
893  * reality back in place. --jhi */
894 /* In actual fact the code below is to blame here. Perl has an internal
895  * representation of the exit status ($?), which it re-composes from the
896  * OS's representation using the W*() POSIX macros. The code below
897  * incorrectly uses the W*() macros on the internal representation,
898  * which fails for OSs that have a different representation (namely BeOS
899  * and Haiku). WMUNGE() is a hack that converts the internal
900  * representation into the OS specific one, so that the W*() macros work
901  * as expected. The better solution would be not to use the W*() macros
902  * in the first place, though. -- Ingo Weinhold
903  */
904 #if defined(__HAIKU__)
905 #    define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
906 #else
907 #    define WMUNGE(x) (x)
908 #endif
909
910 static int
911 not_here(const char *s)
912 {
913     croak("POSIX::%s not implemented on this architecture", s);
914     return -1;
915 }
916
917 #include "const-c.inc"
918
919 static void
920 restore_sigmask(pTHX_ SV *osset_sv)
921 {
922      /* Fortunately, restoring the signal mask can't fail, because
923       * there's nothing we can do about it if it does -- we're not
924       * supposed to return -1 from sigaction unless the disposition
925       * was unaffected.
926       */
927      sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
928      (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
929 }
930
931 static void *
932 allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
933     SV *const t = newSVrv(rv, packname);
934     void *const p = sv_grow(t, size + 1);
935
936     SvCUR_set(t, size);
937     SvPOK_on(t);
938     return p;
939 }
940
941 #ifdef WIN32
942
943 /*
944  * (1) The CRT maintains its own copy of the environment, separate from
945  * the Win32API copy.
946  *
947  * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
948  * copy, and then calls SetEnvironmentVariableA() to update the Win32API
949  * copy.
950  *
951  * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
952  * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
953  * environment.
954  *
955  * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
956  * calls CRT tzset(), but only the first time it is called, and in turn
957  * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
958  * local copy of the environment and hence gets the original setting as
959  * perl never updates the CRT copy when assigning to $ENV{TZ}.
960  *
961  * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
962  * putenv() to update the CRT copy of the environment (if it is different)
963  * whenever we're about to call tzset().
964  *
965  * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
966  * defined:
967  *
968  * (a) Each interpreter has its own copy of the environment inside the
969  * perlhost structure. That allows applications that host multiple
970  * independent Perl interpreters to isolate environment changes from
971  * each other. (This is similar to how the perlhost mechanism keeps a
972  * separate working directory for each Perl interpreter, so that calling
973  * chdir() will not affect other interpreters.)
974  *
975  * (b) Only the first Perl interpreter instantiated within a process will
976  * "write through" environment changes to the process environment.
977  *
978  * (c) Even the primary Perl interpreter won't update the CRT copy of the
979  * the environment, only the Win32API copy (it calls win32_putenv()).
980  *
981  * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
982  * sense to only update the process environment when inside the main
983  * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
984  * from here so we'll just have to check PL_curinterp instead.
985  *
986  * Therefore, we can simply #undef getenv() and putenv() so that those names
987  * always refer to the CRT functions, and explicitly call win32_getenv() to
988  * access perl's %ENV.
989  *
990  * We also #undef malloc() and free() to be sure we are using the CRT
991  * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
992  * into VMem::Malloc() and VMem::Free() and all allocations will be freed
993  * when the Perl interpreter is being destroyed so we'd end up with a pointer
994  * into deallocated memory in environ[] if a program embedding a Perl
995  * interpreter continues to operate even after the main Perl interpreter has
996  * been destroyed.
997  *
998  * Note that we don't free() the malloc()ed memory unless and until we call
999  * malloc() again ourselves because the CRT putenv() function simply puts its
1000  * pointer argument into the environ[] array (it doesn't make a copy of it)
1001  * so this memory must otherwise be leaked.
1002  */
1003
1004 #undef getenv
1005 #undef putenv
1006 #undef malloc
1007 #undef free
1008
1009 static void
1010 fix_win32_tzenv(void)
1011 {
1012     static char* oldenv = NULL;
1013     char* newenv;
1014     const char* perl_tz_env = win32_getenv("TZ");
1015     const char* crt_tz_env = getenv("TZ");
1016     if (perl_tz_env == NULL)
1017         perl_tz_env = "";
1018     if (crt_tz_env == NULL)
1019         crt_tz_env = "";
1020     if (strcmp(perl_tz_env, crt_tz_env) != 0) {
1021         newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
1022         if (newenv != NULL) {
1023             sprintf(newenv, "TZ=%s", perl_tz_env);
1024             putenv(newenv);
1025             if (oldenv != NULL)
1026                 free(oldenv);
1027             oldenv = newenv;
1028         }
1029     }
1030 }
1031
1032 #endif
1033
1034 /*
1035  * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
1036  * This code is duplicated in the Time-Piece module, so any changes made here
1037  * should be made there too.
1038  */
1039 static void
1040 my_tzset(pTHX)
1041 {
1042 #ifdef WIN32
1043 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
1044     if (PL_curinterp == aTHX)
1045 #endif
1046         fix_win32_tzenv();
1047 #endif
1048     tzset();
1049 }
1050
1051 typedef int (*isfunc_t)(int);
1052 typedef void (*any_dptr_t)(void *);
1053
1054 /* This needs to be ALIASed in a custom way, hence can't easily be defined as
1055    a regular XSUB.  */
1056 static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
1057 static XSPROTO(is_common)
1058 {
1059     dXSARGS;
1060
1061     if (items != 1)
1062        croak_xs_usage(cv,  "charstring");
1063
1064     {
1065         dXSTARG;
1066         STRLEN  len;
1067         /*int   RETVAL = 0;   YYY means uncomment this to return false on an
1068                             * empty string input */
1069         int     RETVAL;
1070         unsigned char *s = (unsigned char *) SvPV(ST(0), len);
1071         unsigned char *e = s + len;
1072         isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
1073
1074         if (ckWARN_d(WARN_DEPRECATED)) {
1075
1076             /* Warn exactly once for each lexical place this function is
1077              * called.  See thread at
1078              * http://markmail.org/thread/jhqcag5njmx7jpyu */
1079
1080             HV *warned = get_hv("POSIX::_warned", GV_ADD | GV_ADDMULTI);
1081             if (! hv_exists(warned, (const char *)&PL_op, sizeof(PL_op))) {
1082                 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
1083                             "Calling POSIX::%"HEKf"() is deprecated",
1084                             HEKfARG(GvNAME_HEK(CvGV(cv))));
1085                 hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
1086             }
1087         }
1088
1089         /*if (e > s) { YYY */
1090         for (RETVAL = 1; RETVAL && s < e; s++)
1091             if (!isfunc(*s))
1092                 RETVAL = 0;
1093         /*} YYY */
1094         XSprePUSH;
1095         PUSHi((IV)RETVAL);
1096     }
1097     XSRETURN(1);
1098 }
1099
1100 MODULE = POSIX          PACKAGE = POSIX
1101
1102 BOOT:
1103 {
1104     CV *cv;
1105     const char *file = __FILE__;
1106
1107
1108     /* silence compiler warning about not_here() defined but not used */
1109     if (0) not_here("");
1110
1111     /* Ensure we get the function, not a macro implementation. Like the C89
1112        standard says we can...  */
1113 #undef isalnum
1114     cv = newXS("POSIX::isalnum", is_common, file);
1115     XSANY.any_dptr = (any_dptr_t) &isalnum;
1116 #undef isalpha
1117     cv = newXS("POSIX::isalpha", is_common, file);
1118     XSANY.any_dptr = (any_dptr_t) &isalpha;
1119 #undef iscntrl
1120     cv = newXS("POSIX::iscntrl", is_common, file);
1121     XSANY.any_dptr = (any_dptr_t) &iscntrl;
1122 #undef isdigit
1123     cv = newXS("POSIX::isdigit", is_common, file);
1124     XSANY.any_dptr = (any_dptr_t) &isdigit;
1125 #undef isgraph
1126     cv = newXS("POSIX::isgraph", is_common, file);
1127     XSANY.any_dptr = (any_dptr_t) &isgraph;
1128 #undef islower
1129     cv = newXS("POSIX::islower", is_common, file);
1130     XSANY.any_dptr = (any_dptr_t) &islower;
1131 #undef isprint
1132     cv = newXS("POSIX::isprint", is_common, file);
1133     XSANY.any_dptr = (any_dptr_t) &isprint;
1134 #undef ispunct
1135     cv = newXS("POSIX::ispunct", is_common, file);
1136     XSANY.any_dptr = (any_dptr_t) &ispunct;
1137 #undef isspace
1138     cv = newXS("POSIX::isspace", is_common, file);
1139     XSANY.any_dptr = (any_dptr_t) &isspace;
1140 #undef isupper
1141     cv = newXS("POSIX::isupper", is_common, file);
1142     XSANY.any_dptr = (any_dptr_t) &isupper;
1143 #undef isxdigit
1144     cv = newXS("POSIX::isxdigit", is_common, file);
1145     XSANY.any_dptr = (any_dptr_t) &isxdigit;
1146 }
1147
1148 MODULE = SigSet         PACKAGE = POSIX::SigSet         PREFIX = sig
1149
1150 void
1151 new(packname = "POSIX::SigSet", ...)
1152     const char *        packname
1153     CODE:
1154         {
1155             int i;
1156             sigset_t *const s
1157                 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
1158                                                sizeof(sigset_t),
1159                                                packname);
1160             sigemptyset(s);
1161             for (i = 1; i < items; i++)
1162                 sigaddset(s, SvIV(ST(i)));
1163             XSRETURN(1);
1164         }
1165
1166 SysRet
1167 addset(sigset, sig)
1168         POSIX::SigSet   sigset
1169         int             sig
1170    ALIAS:
1171         delset = 1
1172    CODE:
1173         RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
1174    OUTPUT:
1175         RETVAL
1176
1177 SysRet
1178 emptyset(sigset)
1179         POSIX::SigSet   sigset
1180    ALIAS:
1181         fillset = 1
1182    CODE:
1183         RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
1184    OUTPUT:
1185         RETVAL
1186
1187 int
1188 sigismember(sigset, sig)
1189         POSIX::SigSet   sigset
1190         int             sig
1191
1192 MODULE = Termios        PACKAGE = POSIX::Termios        PREFIX = cf
1193
1194 void
1195 new(packname = "POSIX::Termios", ...)
1196     const char *        packname
1197     CODE:
1198         {
1199 #ifdef I_TERMIOS
1200             void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
1201                                             sizeof(struct termios), packname);
1202             /* The previous implementation stored a pointer to an uninitialised
1203                struct termios. Seems safer to initialise it, particularly as
1204                this implementation exposes the struct to prying from perl-space.
1205             */
1206             memset(p, 0, 1 + sizeof(struct termios));
1207             XSRETURN(1);
1208 #else
1209             not_here("termios");
1210 #endif
1211         }
1212
1213 SysRet
1214 getattr(termios_ref, fd = 0)
1215         POSIX::Termios  termios_ref
1216         int             fd
1217     CODE:
1218         RETVAL = tcgetattr(fd, termios_ref);
1219     OUTPUT:
1220         RETVAL
1221
1222 # If we define TCSANOW here then both a found and not found constant sub
1223 # are created causing a Constant subroutine TCSANOW redefined warning
1224 #ifndef TCSANOW
1225 #  define DEF_SETATTR_ACTION 0
1226 #else
1227 #  define DEF_SETATTR_ACTION TCSANOW
1228 #endif
1229 SysRet
1230 setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
1231         POSIX::Termios  termios_ref
1232         int             fd
1233         int             optional_actions
1234     CODE:
1235         /* The second argument to the call is mandatory, but we'd like to give
1236            it a useful default. 0 isn't valid on all operating systems - on
1237            Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
1238            values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF.  */
1239         RETVAL = tcsetattr(fd, optional_actions, termios_ref);
1240     OUTPUT:
1241         RETVAL
1242
1243 speed_t
1244 getispeed(termios_ref)
1245         POSIX::Termios  termios_ref
1246     ALIAS:
1247         getospeed = 1
1248     CODE:
1249         RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
1250     OUTPUT:
1251         RETVAL
1252
1253 tcflag_t
1254 getiflag(termios_ref)
1255         POSIX::Termios  termios_ref
1256     ALIAS:
1257         getoflag = 1
1258         getcflag = 2
1259         getlflag = 3
1260     CODE:
1261 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
1262         switch(ix) {
1263         case 0:
1264             RETVAL = termios_ref->c_iflag;
1265             break;
1266         case 1:
1267             RETVAL = termios_ref->c_oflag;
1268             break;
1269         case 2:
1270             RETVAL = termios_ref->c_cflag;
1271             break;
1272         case 3:
1273             RETVAL = termios_ref->c_lflag;
1274             break;
1275         default:
1276             RETVAL = 0; /* silence compiler warning */
1277         }
1278 #else
1279         not_here(GvNAME(CvGV(cv)));
1280         RETVAL = 0;
1281 #endif
1282     OUTPUT:
1283         RETVAL
1284
1285 cc_t
1286 getcc(termios_ref, ccix)
1287         POSIX::Termios  termios_ref
1288         unsigned int    ccix
1289     CODE:
1290 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
1291         if (ccix >= NCCS)
1292             croak("Bad getcc subscript");
1293         RETVAL = termios_ref->c_cc[ccix];
1294 #else
1295      not_here("getcc");
1296      RETVAL = 0;
1297 #endif
1298     OUTPUT:
1299         RETVAL
1300
1301 SysRet
1302 setispeed(termios_ref, speed)
1303         POSIX::Termios  termios_ref
1304         speed_t         speed
1305     ALIAS:
1306         setospeed = 1
1307     CODE:
1308         RETVAL = ix
1309             ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
1310     OUTPUT:
1311         RETVAL
1312
1313 void
1314 setiflag(termios_ref, flag)
1315         POSIX::Termios  termios_ref
1316         tcflag_t        flag
1317     ALIAS:
1318         setoflag = 1
1319         setcflag = 2
1320         setlflag = 3
1321     CODE:
1322 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
1323         switch(ix) {
1324         case 0:
1325             termios_ref->c_iflag = flag;
1326             break;
1327         case 1:
1328             termios_ref->c_oflag = flag;
1329             break;
1330         case 2:
1331             termios_ref->c_cflag = flag;
1332             break;
1333         case 3:
1334             termios_ref->c_lflag = flag;
1335             break;
1336         }
1337 #else
1338         not_here(GvNAME(CvGV(cv)));
1339 #endif
1340
1341 void
1342 setcc(termios_ref, ccix, cc)
1343         POSIX::Termios  termios_ref
1344         unsigned int    ccix
1345         cc_t            cc
1346     CODE:
1347 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
1348         if (ccix >= NCCS)
1349             croak("Bad setcc subscript");
1350         termios_ref->c_cc[ccix] = cc;
1351 #else
1352             not_here("setcc");
1353 #endif
1354
1355
1356 MODULE = POSIX          PACKAGE = POSIX
1357
1358 INCLUDE: const-xs.inc
1359
1360 int
1361 WEXITSTATUS(status)
1362         int status
1363     ALIAS:
1364         POSIX::WIFEXITED = 1
1365         POSIX::WIFSIGNALED = 2
1366         POSIX::WIFSTOPPED = 3
1367         POSIX::WSTOPSIG = 4
1368         POSIX::WTERMSIG = 5
1369     CODE:
1370 #if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
1371       || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
1372         RETVAL = 0; /* Silence compilers that notice this, but don't realise
1373                        that not_here() can't return.  */
1374 #endif
1375         switch(ix) {
1376         case 0:
1377 #ifdef WEXITSTATUS
1378             RETVAL = WEXITSTATUS(WMUNGE(status));
1379 #else
1380             not_here("WEXITSTATUS");
1381 #endif
1382             break;
1383         case 1:
1384 #ifdef WIFEXITED
1385             RETVAL = WIFEXITED(WMUNGE(status));
1386 #else
1387             not_here("WIFEXITED");
1388 #endif
1389             break;
1390         case 2:
1391 #ifdef WIFSIGNALED
1392             RETVAL = WIFSIGNALED(WMUNGE(status));
1393 #else
1394             not_here("WIFSIGNALED");
1395 #endif
1396             break;
1397         case 3:
1398 #ifdef WIFSTOPPED
1399             RETVAL = WIFSTOPPED(WMUNGE(status));
1400 #else
1401             not_here("WIFSTOPPED");
1402 #endif
1403             break;
1404         case 4:
1405 #ifdef WSTOPSIG
1406             RETVAL = WSTOPSIG(WMUNGE(status));
1407 #else
1408             not_here("WSTOPSIG");
1409 #endif
1410             break;
1411         case 5:
1412 #ifdef WTERMSIG
1413             RETVAL = WTERMSIG(WMUNGE(status));
1414 #else
1415             not_here("WTERMSIG");
1416 #endif
1417             break;
1418         default:
1419             Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
1420         }
1421     OUTPUT:
1422         RETVAL
1423
1424 SysRet
1425 open(filename, flags = O_RDONLY, mode = 0666)
1426         char *          filename
1427         int             flags
1428         Mode_t          mode
1429     CODE:
1430         if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
1431             TAINT_PROPER("open");
1432         RETVAL = open(filename, flags, mode);
1433     OUTPUT:
1434         RETVAL
1435
1436
1437 HV *
1438 localeconv()
1439     CODE:
1440 #ifndef HAS_LOCALECONV
1441         localeconv(); /* A stub to call not_here(). */
1442 #else
1443         struct lconv *lcbuf;
1444
1445         /* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
1446          * LC_MONETARY is already in the correct locale */
1447         STORE_NUMERIC_STANDARD_FORCE_LOCAL();
1448
1449         RETVAL = newHV();
1450         sv_2mortal((SV*)RETVAL);
1451         if ((lcbuf = localeconv())) {
1452             const struct lconv_offset *strings = lconv_strings;
1453             const struct lconv_offset *integers = lconv_integers;
1454             const char *ptr = (const char *) lcbuf;
1455
1456             do {
1457                 /* This string may be controlled by either LC_NUMERIC, or
1458                  * LC_MONETARY */
1459                 bool is_utf8_locale
1460 #if defined(USE_LOCALE_NUMERIC) && defined(USE_LOCALE_MONETARY)
1461                  = _is_cur_LC_category_utf8((isLC_NUMERIC_STRING(strings->name))
1462                                              ? LC_NUMERIC
1463                                              : LC_MONETARY);
1464 #elif defined(USE_LOCALE_NUMERIC)
1465                  = _is_cur_LC_category_utf8(LC_NUMERIC);
1466 #elif defined(USE_LOCALE_MONETARY)
1467                  = _is_cur_LC_category_utf8(LC_MONETARY);
1468 #else
1469                  = FALSE;
1470 #endif
1471
1472                 const char *value = *((const char **)(ptr + strings->offset));
1473
1474                 if (value && *value) {
1475                     (void) hv_store(RETVAL,
1476                         strings->name,
1477                         strlen(strings->name),
1478                         newSVpvn_utf8(value,
1479                                       strlen(value),
1480
1481                                       /* We mark it as UTF-8 if a utf8 locale
1482                                        * and is valid, non-ascii UTF-8 */
1483                                       is_utf8_locale
1484                                         && ! is_ascii_string((U8 *) value, 0)
1485                                         && is_utf8_string((U8 *) value, 0)),
1486                         0);
1487                   }
1488             } while ((++strings)->name);
1489
1490             do {
1491                 const char value = *((const char *)(ptr + integers->offset));
1492
1493                 if (value != CHAR_MAX)
1494                     (void) hv_store(RETVAL, integers->name,
1495                                     strlen(integers->name), newSViv(value), 0);
1496             } while ((++integers)->name);
1497         }
1498         RESTORE_NUMERIC_STANDARD();
1499 #endif  /* HAS_LOCALECONV */
1500     OUTPUT:
1501         RETVAL
1502
1503 char *
1504 setlocale(category, locale = 0)
1505         int             category
1506         const char *    locale
1507     PREINIT:
1508         char *          retval;
1509     CODE:
1510 #ifdef USE_LOCALE_NUMERIC
1511         /* A 0 (or NULL) locale means only query what the current one is.  We
1512          * have the LC_NUMERIC name saved, because we are normally switched
1513          * into the C locale for it.  Switch back so an LC_ALL query will yield
1514          * the correct results; all other categories don't require special
1515          * handling */
1516         if (locale == 0) {
1517             if (category == LC_NUMERIC) {
1518                 XSRETURN_PV(PL_numeric_name);
1519             }
1520 #   ifdef LC_ALL
1521             else if (category == LC_ALL) {
1522                 SET_NUMERIC_LOCAL();
1523             }
1524 #   endif
1525         }
1526 #endif
1527 #ifdef WIN32    /* Use wrapper on Windows */
1528         retval = Perl_my_setlocale(aTHX_ category, locale);
1529 #else
1530         retval = setlocale(category, locale);
1531 #endif
1532         if (! retval) {
1533             /* Should never happen that a query would return an error, but be
1534              * sure and reset to C locale */
1535             if (locale == 0) {
1536                 SET_NUMERIC_STANDARD();
1537             }
1538             XSRETURN_UNDEF;
1539         }
1540
1541         /* Save retval since subsequent setlocale() calls may overwrite it. */
1542         retval = savepv(retval);
1543
1544         /* For locale == 0, we may have switched to NUMERIC_LOCAL.  Switch back
1545          * */
1546         if (locale == 0) {
1547             SET_NUMERIC_STANDARD();
1548             XSRETURN_PV(retval);
1549         }
1550         else {
1551             RETVAL = retval;
1552 #ifdef USE_LOCALE_CTYPE
1553             if (category == LC_CTYPE
1554 #ifdef LC_ALL
1555                 || category == LC_ALL
1556 #endif
1557                 )
1558             {
1559                 char *newctype;
1560 #ifdef LC_ALL
1561                 if (category == LC_ALL)
1562                     newctype = setlocale(LC_CTYPE, NULL);
1563                 else
1564 #endif
1565                     newctype = RETVAL;
1566                 new_ctype(newctype);
1567             }
1568 #endif /* USE_LOCALE_CTYPE */
1569 #ifdef USE_LOCALE_COLLATE
1570             if (category == LC_COLLATE
1571 #ifdef LC_ALL
1572                 || category == LC_ALL
1573 #endif
1574                 )
1575             {
1576                 char *newcoll;
1577 #ifdef LC_ALL
1578                 if (category == LC_ALL)
1579                     newcoll = setlocale(LC_COLLATE, NULL);
1580                 else
1581 #endif
1582                     newcoll = RETVAL;
1583                 new_collate(newcoll);
1584             }
1585 #endif /* USE_LOCALE_COLLATE */
1586 #ifdef USE_LOCALE_NUMERIC
1587             if (category == LC_NUMERIC
1588 #ifdef LC_ALL
1589                 || category == LC_ALL
1590 #endif
1591                 )
1592             {
1593                 char *newnum;
1594 #ifdef LC_ALL
1595                 if (category == LC_ALL)
1596                     newnum = setlocale(LC_NUMERIC, NULL);
1597                 else
1598 #endif
1599                     newnum = RETVAL;
1600                 new_numeric(newnum);
1601             }
1602 #endif /* USE_LOCALE_NUMERIC */
1603         }
1604     OUTPUT:
1605         RETVAL
1606     CLEANUP:
1607         Safefree(RETVAL);
1608
1609 NV
1610 acos(x)
1611         NV              x
1612     ALIAS:
1613         acosh = 1
1614         asin = 2
1615         asinh = 3
1616         atan = 4
1617         atanh = 5
1618         cbrt = 6
1619         ceil = 7
1620         cosh = 8
1621         erf = 9
1622         erfc = 10
1623         exp2 = 11
1624         expm1 = 12
1625         floor = 13
1626         j0 = 14
1627         j1 = 15
1628         lgamma = 16
1629         log10 = 17
1630         log1p = 18
1631         log2 = 19
1632         logb = 20
1633         nearbyint = 21
1634         rint = 22
1635         round = 23
1636         sinh = 24
1637         tan = 25
1638         tanh = 26
1639         tgamma = 27
1640         trunc = 28
1641         y0 = 29
1642         y1 = 30
1643     CODE:
1644         switch (ix) {
1645         case 0:
1646             RETVAL = acos(x); /* C89 math */
1647             break;
1648         case 1:
1649 #ifdef c99_acosh
1650             RETVAL = c99_acosh(x);
1651 #else
1652             not_here("acosh");
1653 #endif
1654             break;
1655         case 2:
1656             RETVAL = asin(x); /* C89 math */
1657             break;
1658         case 3:
1659 #ifdef c99_asinh
1660             RETVAL = c99_asinh(x);
1661 #else
1662             not_here("asinh");
1663 #endif
1664             break;
1665         case 4:
1666             RETVAL = atan(x); /* C89 math */
1667             break;
1668         case 5:
1669 #ifdef c99_atanh
1670             RETVAL = c99_atanh(x);
1671 #else
1672             not_here("atanh");
1673 #endif
1674             break;
1675         case 6:
1676 #ifdef c99_cbrt
1677             RETVAL = c99_cbrt(x);
1678 #else
1679             not_here("cbrt");
1680 #endif
1681             break;
1682         case 7:
1683             RETVAL = ceil(x); /* C89 math */
1684             break;
1685         case 8:
1686             RETVAL = cosh(x); /* C89 math */
1687             break;
1688         case 9:
1689 #ifdef c99_erf
1690             RETVAL = c99_erf(x);
1691 #else
1692             not_here("erf");
1693 #endif
1694             break;
1695         case 10:
1696 #ifdef c99_erfc
1697             RETVAL = erfc(x);
1698 #else
1699             not_here("erfc");
1700 #endif
1701             break;
1702         case 11:
1703 #ifdef c99_exp2
1704             RETVAL = c99_exp2(x);
1705 #else
1706             not_here("exp2");
1707 #endif
1708             break;
1709         case 12:
1710 #ifdef c99_expm1
1711             RETVAL = c99_expm1(x);
1712 #else
1713             not_here("expm1");
1714 #endif
1715             break;
1716         case 13:
1717             RETVAL = floor(x); /* C89 math */
1718             break;
1719         case 14:
1720 #ifdef bessel_j0
1721             RETVAL = bessel_j0(x);
1722 #else
1723             not_here("bessel_j0");
1724 #endif
1725             break;
1726         case 15:
1727 #ifdef bessel_j1
1728             RETVAL = bessel_j1(x);
1729 #else
1730             not_here("bessel_j1");
1731 #endif
1732             break;
1733         case 16:
1734         /* XXX lgamma_r */
1735 #ifdef c99_lgamma
1736             RETVAL = c99_lgamma(x);
1737 #else
1738             not_here("lgamma");
1739 #endif
1740             break;
1741         case 17:
1742             RETVAL = log10(x); /* C89 math */
1743             break;
1744         case 18:
1745 #ifdef c99_log1p
1746             RETVAL = c99_log1p(x);
1747 #else
1748             not_here("log1p");
1749 #endif
1750             break;
1751         case 19:
1752 #ifdef c99_log2
1753             RETVAL = c99_log2(x);
1754 #else
1755             not_here("log2");
1756 #endif
1757             break;
1758         case 20:
1759 #ifdef c99_logb
1760             RETVAL = c99_logb(x);
1761 #else
1762             not_here("logb");
1763 #endif
1764             break;
1765         case 21:
1766 #ifdef c99_nearbyint
1767             RETVAL = c99_nearbyint(x);
1768 #else
1769             not_here("nearbyint");
1770 #endif
1771             break;
1772         case 22:
1773 #ifdef c99_rint
1774             RETVAL = c99_rint(x);
1775 #else
1776             not_here("rint");
1777 #endif
1778             break;
1779         case 23:
1780 #ifdef c99_round
1781             RETVAL = c99_round(x);
1782 #else
1783             not_here("round");
1784 #endif
1785             break;
1786         case 24:
1787             RETVAL = sinh(x); /* C89 math */
1788             break;
1789         case 25:
1790             RETVAL = tan(x); /* C89 math */
1791             break;
1792         case 26:
1793             RETVAL = tanh(x); /* C89 math */
1794             break;
1795         case 27:
1796         /* XXX tgamma_r */
1797 #ifdef c99_tgamma
1798             RETVAL = c99_tgamma(x);
1799 #else
1800             not_here("tgamma");
1801 #endif
1802             break;
1803         case 28:
1804 #ifdef c99_trunc
1805             RETVAL = c99_trunc(x);
1806 #else
1807             not_here("trunc");
1808 #endif
1809             break;
1810         case 29:
1811 #ifdef bessel_y0
1812             RETVAL = bessel_y0(x);
1813 #else
1814             not_here("bessel_y0");
1815 #endif
1816             break;
1817         case 30:
1818         default:
1819 #ifdef bessel_y1
1820             RETVAL = bessel_y1(x);
1821 #else
1822             not_here("bessel_y1");
1823 #endif
1824         }
1825     OUTPUT:
1826         RETVAL
1827
1828 IV
1829 fpclassify(x)
1830         NV              x
1831     ALIAS:
1832         ilogb = 1
1833         isfinite = 2
1834         isinf = 3
1835         isnan = 4
1836         isnormal = 5
1837         signbit = 6
1838     CODE:
1839         switch (ix) {
1840         case 0:
1841 #ifdef c99_fpclassify
1842             RETVAL = c99_fpclassify(x);
1843 #else
1844             not_here("fpclassify");
1845 #endif
1846             break;
1847         case 1:
1848 #ifdef c99_ilogb
1849             RETVAL = c99_ilogb(x);
1850 #else
1851             not_here("ilogb");
1852 #endif
1853             break;
1854         case 2:
1855             RETVAL = Perl_isfinite(x);
1856             break;
1857         case 3:
1858             RETVAL = Perl_isinf(x);
1859             break;
1860         case 4:
1861             RETVAL = Perl_isnan(x);
1862             break;
1863         case 5:
1864 #ifdef c99_isnormal
1865             RETVAL = c99_isnormal(x);
1866 #else
1867             not_here("isnormal");
1868 #endif
1869             break;
1870         case 6:
1871         default:
1872 #ifdef Perl_signbit
1873             RETVAL = Perl_signbit(x);
1874 #endif
1875             break;
1876         }
1877     OUTPUT:
1878         RETVAL
1879
1880 NV
1881 copysign(x,y)
1882         NV              x
1883         NV              y
1884     ALIAS:
1885         fdim = 1
1886         fmax = 2
1887         fmin = 3
1888         fmod = 4
1889         hypot = 5
1890         isgreater = 6
1891         isgreaterequal = 7
1892         isless = 8
1893         islessequal = 9
1894         islessgreater = 10
1895         isunordered = 11
1896         nextafter = 12
1897         nexttoward = 13
1898         remainder = 14
1899     CODE:
1900         switch (ix) {
1901         case 0:
1902 #ifdef c99_copysign
1903             RETVAL = c99_copysign(x, y);
1904 #else
1905             not_here("copysign");
1906 #endif
1907             break;
1908         case 1:
1909 #ifdef c99_fdim
1910             RETVAL = c99_fdim(x, y);
1911 #else
1912             not_here("fdim");
1913 #endif
1914             break;
1915         case 2:
1916 #ifdef c99_fmax
1917             RETVAL = c99_fmax(x, y);
1918 #else
1919             not_here("fmax");
1920 #endif
1921             break;
1922         case 3:
1923 #ifdef c99_fmin
1924             RETVAL = c99_fmin(x, y);
1925 #else
1926             not_here("fmin");
1927 #endif
1928             break;
1929         case 4:
1930             RETVAL = fmod(x, y); /* C89 math */
1931             break;
1932         case 5:
1933 #ifdef c99_hypot
1934             RETVAL = c99_hypot(x, y);
1935 #else
1936             not_here("hypot");
1937 #endif
1938             break;
1939         case 6:
1940 #ifdef c99_isgreater
1941             RETVAL = c99_isgreater(x, y);
1942 #else
1943             not_here("isgreater");
1944 #endif
1945             break;
1946         case 7:
1947 #ifdef c99_isgreaterequal
1948             RETVAL = c99_isgreaterequal(x, y);
1949 #else
1950             not_here("isgreaterequal");
1951 #endif
1952             break;
1953         case 8:
1954 #ifdef c99_isless
1955             RETVAL = c99_isless(x, y);
1956 #else
1957             not_here("isless");
1958 #endif
1959             break;
1960         case 9:
1961 #ifdef c99_islessequal
1962             RETVAL = c99_islessequal(x, y);
1963 #else
1964             not_here("islessequal");
1965 #endif
1966             break;
1967         case 10:
1968 #ifdef c99_islessgreater
1969             RETVAL = c99_islessgreater(x, y);
1970 #else
1971             not_here("islessgreater");
1972 #endif
1973             break;
1974         case 11:
1975 #ifdef c99_isunordered
1976             RETVAL = c99_isunordered(x, y);
1977 #else
1978             not_here("isunordered");
1979 #endif
1980             break;
1981         case 12:
1982 #ifdef c99_nextafter
1983             RETVAL = c99_nextafter(x, y);
1984 #else
1985             not_here("nextafter");
1986 #endif
1987             break;
1988         case 13:
1989 #ifdef c99_nexttoward
1990             RETVAL = c99_nexttoward(x, y);
1991 #else
1992             not_here("nexttoward");
1993 #endif
1994             break;
1995         case 14:
1996         default:
1997 #ifdef c99_remainder
1998             RETVAL = c99_remainder(x, y);
1999 #else
2000             not_here("remainder");
2001 #endif
2002             break;
2003         }
2004         OUTPUT:
2005             RETVAL
2006
2007 void
2008 frexp(x)
2009         NV              x
2010     PPCODE:
2011         int expvar;
2012         /* (We already know stack is long enough.) */
2013         PUSHs(sv_2mortal(newSVnv(Perl_frexp(x,&expvar)))); /* C89 math */
2014         PUSHs(sv_2mortal(newSViv(expvar)));
2015
2016 NV
2017 ldexp(x,exp)
2018         NV              x
2019         int             exp
2020
2021 void
2022 modf(x)
2023         NV              x
2024     PPCODE:
2025         NV intvar;
2026         /* (We already know stack is long enough.) */
2027         PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar)))); /* C89 math */
2028         PUSHs(sv_2mortal(newSVnv(intvar)));
2029
2030 void
2031 remquo(x,y)
2032         NV              x
2033         NV              y
2034     PPCODE:
2035 #ifdef c99_remquo
2036         int intvar;
2037         PUSHs(sv_2mortal(newSVnv(c99_remquo(x,y,&intvar))));
2038         PUSHs(sv_2mortal(newSVnv(intvar)));
2039 #else
2040         not_here("remquo");
2041 #endif
2042
2043 NV
2044 scalbn(x,y)
2045         NV              x
2046         IV              y
2047     CODE:
2048 #ifdef c99_scalbn
2049         RETVAL = c99_scalbn(x, y);
2050 #else
2051         not_here("scalbn");
2052 #endif
2053     OUTPUT:
2054         RETVAL
2055
2056 NV
2057 fma(x,y,z)
2058         NV              x
2059         NV              y
2060         NV              z
2061     CODE:
2062 #ifdef c99_fma
2063         RETVAL = c99_fma(x, y, z);
2064 #else
2065         not_here("fma");
2066 #endif
2067     OUTPUT:
2068         RETVAL
2069
2070 NV
2071 nan(s = 0)
2072         char*   s;
2073     CODE:
2074 #ifdef c99_nan
2075         RETVAL = c99_nan(s);
2076 #else
2077         not_here("nan");
2078 #endif
2079     OUTPUT:
2080         RETVAL
2081
2082 NV
2083 jn(x,y)
2084         IV              x
2085         NV              y
2086     ALIAS:
2087         yn = 1
2088     CODE:
2089         switch (ix) {
2090         case 0:
2091 #ifdef bessel_jn
2092             RETVAL = bessel_jn(x, y);
2093 #else
2094             not_here("jn");
2095 #endif
2096             break;
2097         case 1:
2098         default:
2099 #ifdef bessel_yn
2100             RETVAL = bessel_yn(x, y);
2101 #else
2102             not_here("yn");
2103 #endif
2104             break;
2105         }
2106     OUTPUT:
2107         RETVAL
2108
2109 SysRet
2110 sigaction(sig, optaction, oldaction = 0)
2111         int                     sig
2112         SV *                    optaction
2113         POSIX::SigAction        oldaction
2114     CODE:
2115 #if defined(WIN32) || defined(NETWARE)
2116         RETVAL = not_here("sigaction");
2117 #else
2118 # This code is really grody because we're trying to make the signal
2119 # interface look beautiful, which is hard.
2120
2121         {
2122             dVAR;
2123             POSIX__SigAction action;
2124             GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
2125             struct sigaction act;
2126             struct sigaction oact;
2127             sigset_t sset;
2128             SV *osset_sv;
2129             sigset_t osset;
2130             POSIX__SigSet sigset;
2131             SV** svp;
2132             SV** sigsvp;
2133
2134             if (sig < 0) {
2135                 croak("Negative signals are not allowed");
2136             }
2137
2138             if (sig == 0 && SvPOK(ST(0))) {
2139                 const char *s = SvPVX_const(ST(0));
2140                 int i = whichsig(s);
2141
2142                 if (i < 0 && memEQ(s, "SIG", 3))
2143                     i = whichsig(s + 3);
2144                 if (i < 0) {
2145                     if (ckWARN(WARN_SIGNAL))
2146                         Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
2147                                     "No such signal: SIG%s", s);
2148                     XSRETURN_UNDEF;
2149                 }
2150                 else
2151                     sig = i;
2152             }
2153 #ifdef NSIG
2154             if (sig > NSIG) { /* NSIG - 1 is still okay. */
2155                 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
2156                             "No such signal: %d", sig);
2157                 XSRETURN_UNDEF;
2158             }
2159 #endif
2160             sigsvp = hv_fetch(GvHVn(siggv),
2161                               PL_sig_name[sig],
2162                               strlen(PL_sig_name[sig]),
2163                               TRUE);
2164
2165             /* Check optaction and set action */
2166             if(SvTRUE(optaction)) {
2167                 if(sv_isa(optaction, "POSIX::SigAction"))
2168                         action = (HV*)SvRV(optaction);
2169                 else
2170                         croak("action is not of type POSIX::SigAction");
2171             }
2172             else {
2173                 action=0;
2174             }
2175
2176             /* sigaction() is supposed to look atomic. In particular, any
2177              * signal handler invoked during a sigaction() call should
2178              * see either the old or the new disposition, and not something
2179              * in between. We use sigprocmask() to make it so.
2180              */
2181             sigfillset(&sset);
2182             RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
2183             if(RETVAL == -1)
2184                XSRETURN_UNDEF;
2185             ENTER;
2186             /* Restore signal mask no matter how we exit this block. */
2187             osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
2188             SAVEFREESV( osset_sv );
2189             SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
2190
2191             RETVAL=-1; /* In case both oldaction and action are 0. */
2192
2193             /* Remember old disposition if desired. */
2194             if (oldaction) {
2195                 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
2196                 if(!svp)
2197                     croak("Can't supply an oldaction without a HANDLER");
2198                 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
2199                         sv_setsv(*svp, *sigsvp);
2200                 }
2201                 else {
2202                         sv_setpvs(*svp, "DEFAULT");
2203                 }
2204                 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
2205                 if(RETVAL == -1) {
2206                    LEAVE;
2207                    XSRETURN_UNDEF;
2208                 }
2209                 /* Get back the mask. */
2210                 svp = hv_fetchs(oldaction, "MASK", TRUE);
2211                 if (sv_isa(*svp, "POSIX::SigSet")) {
2212                     sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
2213                 }
2214                 else {
2215                     sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
2216                                                           sizeof(sigset_t),
2217                                                           "POSIX::SigSet");
2218                 }
2219                 *sigset = oact.sa_mask;
2220
2221                 /* Get back the flags. */
2222                 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
2223                 sv_setiv(*svp, oact.sa_flags);
2224
2225                 /* Get back whether the old handler used safe signals. */
2226                 svp = hv_fetchs(oldaction, "SAFE", TRUE);
2227                 sv_setiv(*svp,
2228                 /* compare incompatible pointers by casting to integer */
2229                     PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
2230             }
2231
2232             if (action) {
2233                 /* Safe signals use "csighandler", which vectors through the
2234                    PL_sighandlerp pointer when it's safe to do so.
2235                    (BTW, "csighandler" is very different from "sighandler".) */
2236                 svp = hv_fetchs(action, "SAFE", FALSE);
2237                 act.sa_handler =
2238                         DPTR2FPTR(
2239                             void (*)(int),
2240                             (*svp && SvTRUE(*svp))
2241                                 ? PL_csighandlerp : PL_sighandlerp
2242                         );
2243
2244                 /* Vector new Perl handler through %SIG.
2245                    (The core signal handlers read %SIG to dispatch.) */
2246                 svp = hv_fetchs(action, "HANDLER", FALSE);
2247                 if (!svp)
2248                     croak("Can't supply an action without a HANDLER");
2249                 sv_setsv(*sigsvp, *svp);
2250
2251                 /* This call actually calls sigaction() with almost the
2252                    right settings, including appropriate interpretation
2253                    of DEFAULT and IGNORE.  However, why are we doing
2254                    this when we're about to do it again just below?  XXX */
2255                 SvSETMAGIC(*sigsvp);
2256
2257                 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
2258                 if(SvPOK(*svp)) {
2259                         const char *s=SvPVX_const(*svp);
2260                         if(strEQ(s,"IGNORE")) {
2261                                 act.sa_handler = SIG_IGN;
2262                         }
2263                         else if(strEQ(s,"DEFAULT")) {
2264                                 act.sa_handler = SIG_DFL;
2265                         }
2266                 }
2267
2268                 /* Set up any desired mask. */
2269                 svp = hv_fetchs(action, "MASK", FALSE);
2270                 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
2271                     sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
2272                     act.sa_mask = *sigset;
2273                 }
2274                 else
2275                     sigemptyset(& act.sa_mask);
2276
2277                 /* Set up any desired flags. */
2278                 svp = hv_fetchs(action, "FLAGS", FALSE);
2279                 act.sa_flags = svp ? SvIV(*svp) : 0;
2280
2281                 /* Don't worry about cleaning up *sigsvp if this fails,
2282                  * because that means we tried to disposition a
2283                  * nonblockable signal, in which case *sigsvp is
2284                  * essentially meaningless anyway.
2285                  */
2286                 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
2287                 if(RETVAL == -1) {
2288                     LEAVE;
2289                     XSRETURN_UNDEF;
2290                 }
2291             }
2292
2293             LEAVE;
2294         }
2295 #endif
2296     OUTPUT:
2297         RETVAL
2298
2299 SysRet
2300 sigpending(sigset)
2301         POSIX::SigSet           sigset
2302     ALIAS:
2303         sigsuspend = 1
2304     CODE:
2305         RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
2306     OUTPUT:
2307         RETVAL
2308     CLEANUP:
2309     PERL_ASYNC_CHECK();
2310
2311 SysRet
2312 sigprocmask(how, sigset, oldsigset = 0)
2313         int                     how
2314         POSIX::SigSet           sigset = NO_INIT
2315         POSIX::SigSet           oldsigset = NO_INIT
2316 INIT:
2317         if (! SvOK(ST(1))) {
2318             sigset = NULL;
2319         } else if (sv_isa(ST(1), "POSIX::SigSet")) {
2320             sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
2321         } else {
2322             croak("sigset is not of type POSIX::SigSet");
2323         }
2324
2325         if (items < 3 || ! SvOK(ST(2))) {
2326             oldsigset = NULL;
2327         } else if (sv_isa(ST(2), "POSIX::SigSet")) {
2328             oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
2329         } else {
2330             croak("oldsigset is not of type POSIX::SigSet");
2331         }
2332
2333 void
2334 _exit(status)
2335         int             status
2336
2337 SysRet
2338 dup2(fd1, fd2)
2339         int             fd1
2340         int             fd2
2341     CODE:
2342 #ifdef WIN32
2343         /* RT #98912 - More Microsoft muppetry - failing to actually implemented
2344            the well known documented POSIX behaviour for a POSIX API.
2345            http://msdn.microsoft.com/en-us/library/8syseb29.aspx   */
2346         RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
2347 #else
2348         RETVAL = dup2(fd1, fd2);
2349 #endif
2350     OUTPUT:
2351         RETVAL
2352
2353 SV *
2354 lseek(fd, offset, whence)
2355         int             fd
2356         Off_t           offset
2357         int             whence
2358     CODE:
2359         Off_t pos = PerlLIO_lseek(fd, offset, whence);
2360         RETVAL = sizeof(Off_t) > sizeof(IV)
2361                  ? newSVnv((NV)pos) : newSViv((IV)pos);
2362     OUTPUT:
2363         RETVAL
2364
2365 void
2366 nice(incr)
2367         int             incr
2368     PPCODE:
2369         errno = 0;
2370         if ((incr = nice(incr)) != -1 || errno == 0) {
2371             if (incr == 0)
2372                 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
2373             else
2374                 XPUSHs(sv_2mortal(newSViv(incr)));
2375         }
2376
2377 void
2378 pipe()
2379     PPCODE:
2380         int fds[2];
2381         if (pipe(fds) != -1) {
2382             EXTEND(SP,2);
2383             PUSHs(sv_2mortal(newSViv(fds[0])));
2384             PUSHs(sv_2mortal(newSViv(fds[1])));
2385         }
2386
2387 SysRet
2388 read(fd, buffer, nbytes)
2389     PREINIT:
2390         SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
2391     INPUT:
2392         int             fd
2393         size_t          nbytes
2394         char *          buffer = sv_grow( sv_buffer, nbytes+1 );
2395     CLEANUP:
2396         if (RETVAL >= 0) {
2397             SvCUR_set(sv_buffer, RETVAL);
2398             SvPOK_only(sv_buffer);
2399             *SvEND(sv_buffer) = '\0';
2400             SvTAINTED_on(sv_buffer);
2401         }
2402
2403 SysRet
2404 setpgid(pid, pgid)
2405         pid_t           pid
2406         pid_t           pgid
2407
2408 pid_t
2409 setsid()
2410
2411 pid_t
2412 tcgetpgrp(fd)
2413         int             fd
2414
2415 SysRet
2416 tcsetpgrp(fd, pgrp_id)
2417         int             fd
2418         pid_t           pgrp_id
2419
2420 void
2421 uname()
2422     PPCODE:
2423 #ifdef HAS_UNAME
2424         struct utsname buf;
2425         if (uname(&buf) >= 0) {
2426             EXTEND(SP, 5);
2427             PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
2428             PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
2429             PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
2430             PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
2431             PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
2432         }
2433 #else
2434         uname((char *) 0); /* A stub to call not_here(). */
2435 #endif
2436
2437 SysRet
2438 write(fd, buffer, nbytes)
2439         int             fd
2440         char *          buffer
2441         size_t          nbytes
2442
2443 SV *
2444 tmpnam()
2445     PREINIT:
2446         STRLEN i;
2447         int len;
2448     CODE:
2449         RETVAL = newSVpvs("");
2450         SvGROW(RETVAL, L_tmpnam);
2451         /* Yes, we know tmpnam() is bad.  So bad that some compilers
2452          * and linkers warn against using it.  But it is here for
2453          * completeness.  POSIX.pod warns against using it.
2454          *
2455          * Then again, maybe this should be removed at some point.
2456          * No point in enabling dangerous interfaces. */
2457         len = strlen(tmpnam(SvPV(RETVAL, i)));
2458         SvCUR_set(RETVAL, len);
2459     OUTPUT:
2460         RETVAL
2461
2462 void
2463 abort()
2464
2465 int
2466 mblen(s, n)
2467         char *          s
2468         size_t          n
2469
2470 size_t
2471 mbstowcs(s, pwcs, n)
2472         wchar_t *       s
2473         char *          pwcs
2474         size_t          n
2475
2476 int
2477 mbtowc(pwc, s, n)
2478         wchar_t *       pwc
2479         char *          s
2480         size_t          n
2481
2482 int
2483 wcstombs(s, pwcs, n)
2484         char *          s
2485         wchar_t *       pwcs
2486         size_t          n
2487
2488 int
2489 wctomb(s, wchar)
2490         char *          s
2491         wchar_t         wchar
2492
2493 int
2494 strcoll(s1, s2)
2495         char *          s1
2496         char *          s2
2497
2498 void
2499 strtod(str)
2500         char *          str
2501     PREINIT:
2502         double num;
2503         char *unparsed;
2504     PPCODE:
2505         STORE_NUMERIC_STANDARD_FORCE_LOCAL();
2506         num = strtod(str, &unparsed);
2507         PUSHs(sv_2mortal(newSVnv(num)));
2508         if (GIMME == G_ARRAY) {
2509             EXTEND(SP, 1);
2510             if (unparsed)
2511                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2512             else
2513                 PUSHs(&PL_sv_undef);
2514         }
2515         RESTORE_NUMERIC_STANDARD();
2516
2517 #ifdef HAS_STRTOLD
2518
2519 void
2520 strtold(str)
2521         char *          str
2522     PREINIT:
2523         long double num;
2524         char *unparsed;
2525     PPCODE:
2526         STORE_NUMERIC_STANDARD_FORCE_LOCAL();
2527         num = strtold(str, &unparsed);
2528         PUSHs(sv_2mortal(newSVnv(num)));
2529         if (GIMME == G_ARRAY) {
2530             EXTEND(SP, 1);
2531             if (unparsed)
2532                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2533             else
2534                 PUSHs(&PL_sv_undef);
2535         }
2536         RESTORE_NUMERIC_STANDARD();
2537
2538 #endif
2539
2540 void
2541 strtol(str, base = 0)
2542         char *          str
2543         int             base
2544     PREINIT:
2545         long num;
2546         char *unparsed;
2547     PPCODE:
2548         num = strtol(str, &unparsed, base);
2549 #if IVSIZE <= LONGSIZE
2550         if (num < IV_MIN || num > IV_MAX)
2551             PUSHs(sv_2mortal(newSVnv((double)num)));
2552         else
2553 #endif
2554             PUSHs(sv_2mortal(newSViv((IV)num)));
2555         if (GIMME == G_ARRAY) {
2556             EXTEND(SP, 1);
2557             if (unparsed)
2558                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2559             else
2560                 PUSHs(&PL_sv_undef);
2561         }
2562
2563 void
2564 strtoul(str, base = 0)
2565         const char *    str
2566         int             base
2567     PREINIT:
2568         unsigned long num;
2569         char *unparsed;
2570     PPCODE:
2571         num = strtoul(str, &unparsed, base);
2572 #if IVSIZE <= LONGSIZE
2573         if (num > IV_MAX)
2574             PUSHs(sv_2mortal(newSVnv((double)num)));
2575         else
2576 #endif
2577             PUSHs(sv_2mortal(newSViv((IV)num)));
2578         if (GIMME == G_ARRAY) {
2579             EXTEND(SP, 1);
2580             if (unparsed)
2581                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2582             else
2583                 PUSHs(&PL_sv_undef);
2584         }
2585
2586 void
2587 strxfrm(src)
2588         SV *            src
2589     CODE:
2590         {
2591           STRLEN srclen;
2592           STRLEN dstlen;
2593           STRLEN buflen;
2594           char *p = SvPV(src,srclen);
2595           srclen++;
2596           buflen = srclen * 4 + 1;
2597           ST(0) = sv_2mortal(newSV(buflen));
2598           dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)buflen);
2599           if (dstlen >= buflen) {
2600               dstlen++;
2601               SvGROW(ST(0), dstlen);
2602               strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
2603               dstlen--;
2604           }
2605           SvCUR_set(ST(0), dstlen);
2606             SvPOK_only(ST(0));
2607         }
2608
2609 SysRet
2610 mkfifo(filename, mode)
2611         char *          filename
2612         Mode_t          mode
2613     ALIAS:
2614         access = 1
2615     CODE:
2616         if(ix) {
2617             RETVAL = access(filename, mode);
2618         } else {
2619             TAINT_PROPER("mkfifo");
2620             RETVAL = mkfifo(filename, mode);
2621         }
2622     OUTPUT:
2623         RETVAL
2624
2625 SysRet
2626 tcdrain(fd)
2627         int             fd
2628     ALIAS:
2629         close = 1
2630         dup = 2
2631     CODE:
2632         RETVAL = ix == 1 ? close(fd)
2633             : (ix < 1 ? tcdrain(fd) : dup(fd));
2634     OUTPUT:
2635         RETVAL
2636
2637
2638 SysRet
2639 tcflow(fd, action)
2640         int             fd
2641         int             action
2642     ALIAS:
2643         tcflush = 1
2644         tcsendbreak = 2
2645     CODE:
2646         RETVAL = ix == 1 ? tcflush(fd, action)
2647             : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
2648     OUTPUT:
2649         RETVAL
2650
2651 void
2652 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
2653         int             sec
2654         int             min
2655         int             hour
2656         int             mday
2657         int             mon
2658         int             year
2659         int             wday
2660         int             yday
2661         int             isdst
2662     ALIAS:
2663         mktime = 1
2664     PPCODE:
2665         {
2666             dXSTARG;
2667             struct tm mytm;
2668             init_tm(&mytm);     /* XXX workaround - see init_tm() in core util.c */
2669             mytm.tm_sec = sec;
2670             mytm.tm_min = min;
2671             mytm.tm_hour = hour;
2672             mytm.tm_mday = mday;
2673             mytm.tm_mon = mon;
2674             mytm.tm_year = year;
2675             mytm.tm_wday = wday;
2676             mytm.tm_yday = yday;
2677             mytm.tm_isdst = isdst;
2678             if (ix) {
2679                 const time_t result = mktime(&mytm);
2680                 if (result == (time_t)-1)
2681                     SvOK_off(TARG);
2682                 else if (result == 0)
2683                     sv_setpvn(TARG, "0 but true", 10);
2684                 else
2685                     sv_setiv(TARG, (IV)result);
2686             } else {
2687                 sv_setpv(TARG, asctime(&mytm));
2688             }
2689             ST(0) = TARG;
2690             XSRETURN(1);
2691         }
2692
2693 long
2694 clock()
2695
2696 char *
2697 ctime(time)
2698         Time_t          &time
2699
2700 void
2701 times()
2702         PPCODE:
2703         struct tms tms;
2704         clock_t realtime;
2705         realtime = times( &tms );
2706         EXTEND(SP,5);
2707         PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
2708         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
2709         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
2710         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
2711         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
2712
2713 double
2714 difftime(time1, time2)
2715         Time_t          time1
2716         Time_t          time2
2717
2718 #XXX: if $xsubpp::WantOptimize is always the default
2719 #     sv_setpv(TARG, ...) could be used rather than
2720 #     ST(0) = sv_2mortal(newSVpv(...))
2721 void
2722 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
2723         SV *            fmt
2724         int             sec
2725         int             min
2726         int             hour
2727         int             mday
2728         int             mon
2729         int             year
2730         int             wday
2731         int             yday
2732         int             isdst
2733     CODE:
2734         {
2735             char *buf;
2736             SV *sv;
2737
2738             /* allowing user-supplied (rather than literal) formats
2739              * is normally frowned upon as a potential security risk;
2740              * but this is part of the API so we have to allow it */
2741             GCC_DIAG_IGNORE(-Wformat-nonliteral);
2742             buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
2743             GCC_DIAG_RESTORE;
2744             sv = sv_newmortal();
2745             if (buf) {
2746                 STRLEN len = strlen(buf);
2747                 sv_usepvn_flags(sv, buf, len, SV_HAS_TRAILING_NUL);
2748                 if (SvUTF8(fmt)
2749                     || (! is_ascii_string((U8*) buf, len)
2750                         && is_utf8_string((U8*) buf, len)
2751 #ifdef USE_LOCALE_TIME
2752                         && _is_cur_LC_category_utf8(LC_TIME)
2753 #endif
2754                 )) {
2755                     SvUTF8_on(sv);
2756                 }
2757             }
2758             else {  /* We can't distinguish between errors and just an empty
2759                      * return; in all cases just return an empty string */
2760                 SvUPGRADE(sv, SVt_PV);
2761                 SvPV_set(sv, (char *) "");
2762                 SvPOK_on(sv);
2763                 SvCUR_set(sv, 0);
2764                 SvLEN_set(sv, 0);   /* Won't attempt to free the string when sv
2765                                        gets destroyed */
2766             }
2767             ST(0) = sv;
2768         }
2769
2770 void
2771 tzset()
2772   PPCODE:
2773     my_tzset(aTHX);
2774
2775 void
2776 tzname()
2777     PPCODE:
2778         EXTEND(SP,2);
2779         PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
2780         PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
2781
2782 char *
2783 ctermid(s = 0)
2784         char *          s = 0;
2785     CODE:
2786 #ifdef HAS_CTERMID_R
2787         s = (char *) safemalloc((size_t) L_ctermid);
2788 #endif
2789         RETVAL = ctermid(s);
2790     OUTPUT:
2791         RETVAL
2792     CLEANUP:
2793 #ifdef HAS_CTERMID_R
2794         Safefree(s);
2795 #endif
2796
2797 char *
2798 cuserid(s = 0)
2799         char *          s = 0;
2800     CODE:
2801 #ifdef HAS_CUSERID
2802   RETVAL = cuserid(s);
2803 #else
2804   RETVAL = 0;
2805   not_here("cuserid");
2806 #endif
2807     OUTPUT:
2808   RETVAL
2809
2810 SysRetLong
2811 fpathconf(fd, name)
2812         int             fd
2813         int             name
2814
2815 SysRetLong
2816 pathconf(filename, name)
2817         char *          filename
2818         int             name
2819
2820 SysRet
2821 pause()
2822     CLEANUP:
2823     PERL_ASYNC_CHECK();
2824
2825 unsigned int
2826 sleep(seconds)
2827         unsigned int    seconds
2828     CODE:
2829         RETVAL = PerlProc_sleep(seconds);
2830     OUTPUT:
2831         RETVAL
2832
2833 SysRet
2834 setgid(gid)
2835         Gid_t           gid
2836
2837 SysRet
2838 setuid(uid)
2839         Uid_t           uid
2840
2841 SysRetLong
2842 sysconf(name)
2843         int             name
2844
2845 char *
2846 ttyname(fd)
2847         int             fd
2848
2849 void
2850 getcwd()
2851     PPCODE:
2852       {
2853         dXSTARG;
2854         getcwd_sv(TARG);
2855         XSprePUSH; PUSHTARG;
2856       }
2857
2858 SysRet
2859 lchown(uid, gid, path)
2860        Uid_t           uid
2861        Gid_t           gid
2862        char *          path
2863     CODE:
2864 #ifdef HAS_LCHOWN
2865        /* yes, the order of arguments is different,
2866         * but consistent with CORE::chown() */
2867        RETVAL = lchown(path, uid, gid);
2868 #else
2869        RETVAL = not_here("lchown");
2870 #endif
2871     OUTPUT:
2872        RETVAL