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