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 I_FLOAT
  32 #include <float.h>
  33 #endif
  34 #ifdef I_LIMITS
  35 #include <limits.h>
  36 #endif
  37 #include <locale.h>
  38 #include <math.h>
  39 #ifdef I_PWD
  40 #include <pwd.h>
  41 #endif
  42 #include <setjmp.h>
  43 #include <signal.h>
  44 #include <stdarg.h>
  45
  46 #ifdef I_STDDEF
  47 #include <stddef.h>
  48 #endif
  49
  50 #ifdef I_UNISTD
  51 #include <unistd.h>
  52 #endif
  53
  54 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
  55    metaconfig for future extension writers.  We don't use them in POSIX.
  56    (This is really sneaky :-)  --AD
  57 */
  58 #if defined(I_TERMIOS)
  59 #include <termios.h>
  60 #endif
  61 #ifdef I_STDLIB
  62 #include <stdlib.h>
  63 #endif
  64 #ifndef __ultrix__
  65 #include <string.h>
  66 #endif
  67 #include <sys/stat.h>
  68 #include <sys/types.h>
  69 #include <time.h>
  70 #ifdef I_UNISTD
  71 #include <unistd.h>
  72 #endif
  73 #include <fcntl.h>
  74
  75 #ifdef HAS_TZNAME
  76 #  if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
  77 extern char *tzname[];
  78 #  endif
  79 #else
  80 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
  81 char *tzname[] = { "" , "" };
  82 #endif
  83 #endif
  84
  85 #ifndef PERL_UNUSED_DECL
  86 #  ifdef HASATTRIBUTE
  87 #    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
  88 #      define PERL_UNUSED_DECL
  89 #    else
  90 #      define PERL_UNUSED_DECL __attribute__((unused))
  91 #    endif
  92 #  else
  93 #    define PERL_UNUSED_DECL
  94 #  endif
  95 #endif
  96
  97 #ifndef dNOOP
  98 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
  99 #endif
 100
 101 #ifndef dVAR
 102 #define dVAR dNOOP
 103 #endif
 104
 105 #if defined(__VMS) && !defined(__POSIX_SOURCE)
 106 #  include <libdef.h>       /* LIB$_INVARG constant */
 107 #  include <lib$routines.h> /* prototype for lib$ediv() */
 108 #  include <starlet.h>      /* prototype for sys$gettim() */
 109 #  if DECC_VERSION < 50000000
 110 #    define pid_t int       /* old versions of DECC miss this in types.h */
 111 #  endif
 112
 113 #  undef mkfifo
 114 #  define mkfifo(a,b) (not_here("mkfifo"),-1)
 115 #  define tzset() not_here("tzset")
 116
 117 #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
 118 #    define HAS_TZNAME  /* shows up in VMS 7.0 or Dec C 5.6 */
 119 #    include <utsname.h>
 120 #  endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
 121
 122    /* The POSIX notion of ttyname() is better served by getname() under VMS */
 123    static char ttnambuf[64];
 124 #  define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
 125
 126    /* The non-POSIX CRTL times() has void return type, so we just get the
 127       current time directly */
 128    clock_t vms_times(struct tms *bufptr) {
 129         dTHX;
 130         clock_t retval;
 131         /* Get wall time and convert to 10 ms intervals to
 132          * produce the return value that the POSIX standard expects */
 133 #  if defined(__DECC) && defined (__ALPHA)
 134 #    include <ints.h>
 135         uint64 vmstime;
 136         _ckvmssts(sys$gettim(&vmstime));
 137         vmstime /= 100000;
 138         retval = vmstime & 0x7fffffff;
 139 #  else
 140         /* (Older hw or ccs don't have an atomic 64-bit type, so we
 141          * juggle 32-bit ints (and a float) to produce a time_t result
 142          * with minimal loss of information.) */
 143         long int vmstime[2],remainder,divisor = 100000;
 144         _ckvmssts(sys$gettim((unsigned long int *)vmstime));
 145         vmstime[1] &= 0x7fff;  /* prevent overflow in EDIV */
 146         _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
 147 #  endif
 148         /* Fill in the struct tms using the CRTL routine . . .*/
 149         times((tbuffer_t *)bufptr);
 150         return (clock_t) retval;
 151    }
 152 #  define times(t) vms_times(t)
 153 #else
 154 #if defined (__CYGWIN__)
 155 #    define tzname _tzname
 156 #endif
 157 #if defined (WIN32) || defined (NETWARE)
 158 #  undef mkfifo
 159 #  define mkfifo(a,b) not_here("mkfifo")
 160 #  define ttyname(a) (char*)not_here("ttyname")
 161 #  define sigset_t long
 162 #  define pid_t long
 163 #  ifdef __BORLANDC__
 164 #    define tzname _tzname
 165 #  endif
 166 #  ifdef _MSC_VER
 167 #    define mode_t short
 168 #  endif
 169 #  ifdef __MINGW32__
 170 #    define mode_t short
 171 #    ifndef tzset
 172 #      define tzset()           not_here("tzset")
 173 #    endif
 174 #    ifndef _POSIX_OPEN_MAX
 175 #      define _POSIX_OPEN_MAX   FOPEN_MAX       /* XXX bogus ? */
 176 #    endif
 177 #  endif
 178 #  define sigaction(a,b,c)      not_here("sigaction")
 179 #  define sigpending(a)         not_here("sigpending")
 180 #  define sigprocmask(a,b,c)    not_here("sigprocmask")
 181 #  define sigsuspend(a)         not_here("sigsuspend")
 182 #  define sigemptyset(a)        not_here("sigemptyset")
 183 #  define sigaddset(a,b)        not_here("sigaddset")
 184 #  define sigdelset(a,b)        not_here("sigdelset")
 185 #  define sigfillset(a)         not_here("sigfillset")
 186 #  define sigismember(a,b)      not_here("sigismember")
 187 #ifndef NETWARE
 188 #  undef setuid
 189 #  undef setgid
 190 #  define setuid(a)             not_here("setuid")
 191 #  define setgid(a)             not_here("setgid")
 192 #endif  /* NETWARE */
 193 #else
 194
 195 #  ifndef HAS_MKFIFO
 196 #    if defined(OS2)
 197 #      define mkfifo(a,b) not_here("mkfifo")
 198 #    else       /* !( defined OS2 ) */
 199 #      ifndef mkfifo
 200 #        define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
 201 #      endif
 202 #    endif
 203 #  endif /* !HAS_MKFIFO */
 204
 205 #  ifdef I_GRP
 206 #    include <grp.h>
 207 #  endif
 208 #  include <sys/times.h>
 209 #  ifdef HAS_UNAME
 210 #    include <sys/utsname.h>
 211 #  endif
 212 #  include <sys/wait.h>
 213 #  ifdef I_UTIME
 214 #    include <utime.h>
 215 #  endif
 216 #endif /* WIN32 || NETWARE */
 217 #endif /* __VMS */
 218
 219 #ifdef WIN32
 220    /* Perl on Windows assigns WSAGetLastError() return values to errno
 221     * (in win32/win32sck.c).  Therefore we need to map these values
 222     * back to standard symbolic names, as long as the same name isn't
 223     * already defined by errno.h itself.  The Errno.pm module does
 224     * a similar mapping.
 225     */
 226 #  ifndef EWOULDBLOCK
 227 #    define EWOULDBLOCK WSAEWOULDBLOCK
 228 #  endif
 229 #  ifndef EINPROGRESS
 230 #    define EINPROGRESS WSAEINPROGRESS
 231 #  endif
 232 #  ifndef EALREADY
 233 #    define EALREADY WSAEALREADY
 234 #  endif
 235 #  ifndef ENOTSOCK
 236 #    define ENOTSOCK WSAENOTSOCK
 237 #  endif
 238 #  ifndef EDESTADDRREQ
 239 #    define EDESTADDRREQ WSAEDESTADDRREQ
 240 #  endif
 241 #  ifndef EMSGSIZE
 242 #    define EMSGSIZE WSAEMSGSIZE
 243 #  endif
 244 #  ifndef EPROTOTYPE
 245 #    define EPROTOTYPE WSAEPROTOTYPE
 246 #  endif
 247 #  ifndef ENOPROTOOPT
 248 #    define ENOPROTOOPT WSAENOPROTOOPT
 249 #  endif
 250 #  ifndef EPROTONOSUPPORT
 251 #    define EPROTONOSUPPORT WSAEPROTONOSUPPORT
 252 #  endif
 253 #  ifndef ESOCKTNOSUPPORT
 254 #    define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
 255 #  endif
 256 #  ifndef EOPNOTSUPP
 257 #    define EOPNOTSUPP WSAEOPNOTSUPP
 258 #  endif
 259 #  ifndef EPFNOSUPPORT
 260 #    define EPFNOSUPPORT WSAEPFNOSUPPORT
 261 #  endif
 262 #  ifndef EAFNOSUPPORT
 263 #    define EAFNOSUPPORT WSAEAFNOSUPPORT
 264 #  endif
 265 #  ifndef EADDRINUSE
 266 #    define EADDRINUSE WSAEADDRINUSE
 267 #  endif
 268 #  ifndef EADDRNOTAVAIL
 269 #    define EADDRNOTAVAIL WSAEADDRNOTAVAIL
 270 #  endif
 271 #  ifndef ENETDOWN
 272 #    define ENETDOWN WSAENETDOWN
 273 #  endif
 274 #  ifndef ENETUNREACH
 275 #    define ENETUNREACH WSAENETUNREACH
 276 #  endif
 277 #  ifndef ENETRESET
 278 #    define ENETRESET WSAENETRESET
 279 #  endif
 280 #  ifndef ECONNABORTED
 281 #    define ECONNABORTED WSAECONNABORTED
 282 #  endif
 283 #  ifndef ECONNRESET
 284 #    define ECONNRESET WSAECONNRESET
 285 #  endif
 286 #  ifndef ENOBUFS
 287 #    define ENOBUFS WSAENOBUFS
 288 #  endif
 289 #  ifndef EISCONN
 290 #    define EISCONN WSAEISCONN
 291 #  endif
 292 #  ifndef ENOTCONN
 293 #    define ENOTCONN WSAENOTCONN
 294 #  endif
 295 #  ifndef ESHUTDOWN
 296 #    define ESHUTDOWN WSAESHUTDOWN
 297 #  endif
 298 #  ifndef ETOOMANYREFS
 299 #    define ETOOMANYREFS WSAETOOMANYREFS
 300 #  endif
 301 #  ifndef ETIMEDOUT
 302 #    define ETIMEDOUT WSAETIMEDOUT
 303 #  endif
 304 #  ifndef ECONNREFUSED
 305 #    define ECONNREFUSED WSAECONNREFUSED
 306 #  endif
 307 #  ifndef ELOOP
 308 #    define ELOOP WSAELOOP
 309 #  endif
 310 #  ifndef ENAMETOOLONG
 311 #    define ENAMETOOLONG WSAENAMETOOLONG
 312 #  endif
 313 #  ifndef EHOSTDOWN
 314 #    define EHOSTDOWN WSAEHOSTDOWN
 315 #  endif
 316 #  ifndef EHOSTUNREACH
 317 #    define EHOSTUNREACH WSAEHOSTUNREACH
 318 #  endif
 319 #  ifndef ENOTEMPTY
 320 #    define ENOTEMPTY WSAENOTEMPTY
 321 #  endif
 322 #  ifndef EPROCLIM
 323 #    define EPROCLIM WSAEPROCLIM
 324 #  endif
 325 #  ifndef EUSERS
 326 #    define EUSERS WSAEUSERS
 327 #  endif
 328 #  ifndef EDQUOT
 329 #    define EDQUOT WSAEDQUOT
 330 #  endif
 331 #  ifndef ESTALE
 332 #    define ESTALE WSAESTALE
 333 #  endif
 334 #  ifndef EREMOTE
 335 #    define EREMOTE WSAEREMOTE
 336 #  endif
 337 #  ifndef EDISCON
 338 #    define EDISCON WSAEDISCON
 339 #  endif
 340 #endif
 341
 342 typedef int SysRet;
 343 typedef long SysRetLong;
 344 typedef sigset_t* POSIX__SigSet;
 345 typedef HV* POSIX__SigAction;
 346 #ifdef I_TERMIOS
 347 typedef struct termios* POSIX__Termios;
 348 #else /* Define termios types to int, and call not_here for the functions.*/
 349 #define POSIX__Termios int
 350 #define speed_t int
 351 #define tcflag_t int
 352 #define cc_t int
 353 #define cfgetispeed(x) not_here("cfgetispeed")
 354 #define cfgetospeed(x) not_here("cfgetospeed")
 355 #define tcdrain(x) not_here("tcdrain")
 356 #define tcflush(x,y) not_here("tcflush")
 357 #define tcsendbreak(x,y) not_here("tcsendbreak")
 358 #define cfsetispeed(x,y) not_here("cfsetispeed")
 359 #define cfsetospeed(x,y) not_here("cfsetospeed")
 360 #define ctermid(x) (char *) not_here("ctermid")
 361 #define tcflow(x,y) not_here("tcflow")
 362 #define tcgetattr(x,y) not_here("tcgetattr")
 363 #define tcsetattr(x,y,z) not_here("tcsetattr")
 364 #endif
 365
 366 /* Possibly needed prototypes */
 367 #ifndef WIN32
 368 double strtod (const char *, char **);
 369 long strtol (const char *, char **, int);
 370 unsigned long strtoul (const char *, char **, int);
 371 #endif
 372
 373 #ifndef HAS_DIFFTIME
 374 #ifndef difftime
 375 #define difftime(a,b) not_here("difftime")
 376 #endif
 377 #endif
 378 #ifndef HAS_FPATHCONF
 379 #define fpathconf(f,n)  (SysRetLong) not_here("fpathconf")
 380 #endif
 381 #ifndef HAS_MKTIME
 382 #define mktime(a) not_here("mktime")
 383 #endif
 384 #ifndef HAS_NICE
 385 #define nice(a) not_here("nice")
 386 #endif
 387 #ifndef HAS_PATHCONF
 388 #define pathconf(f,n)   (SysRetLong) not_here("pathconf")
 389 #endif
 390 #ifndef HAS_SYSCONF
 391 #define sysconf(n)      (SysRetLong) not_here("sysconf")
 392 #endif
 393 #ifndef HAS_READLINK
 394 #define readlink(a,b,c) not_here("readlink")
 395 #endif
 396 #ifndef HAS_SETPGID
 397 #define setpgid(a,b) not_here("setpgid")
 398 #endif
 399 #ifndef HAS_SETSID
 400 #define setsid() not_here("setsid")
 401 #endif
 402 #ifndef HAS_STRCOLL
 403 #define strcoll(s1,s2) not_here("strcoll")
 404 #endif
 405 #ifndef HAS_STRTOD
 406 #define strtod(s1,s2) not_here("strtod")
 407 #endif
 408 #ifndef HAS_STRTOL
 409 #define strtol(s1,s2,b) not_here("strtol")
 410 #endif
 411 #ifndef HAS_STRTOUL
 412 #define strtoul(s1,s2,b) not_here("strtoul")
 413 #endif
 414 #ifndef HAS_STRXFRM
 415 #define strxfrm(s1,s2,n) not_here("strxfrm")
 416 #endif
 417 #ifndef HAS_TCGETPGRP
 418 #define tcgetpgrp(a) not_here("tcgetpgrp")
 419 #endif
 420 #ifndef HAS_TCSETPGRP
 421 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
 422 #endif
 423 #ifndef HAS_TIMES
 424 #ifndef NETWARE
 425 #define times(a) not_here("times")
 426 #endif  /* NETWARE */
 427 #endif
 428 #ifndef HAS_UNAME
 429 #define uname(a) not_here("uname")
 430 #endif
 431 #ifndef HAS_WAITPID
 432 #define waitpid(a,b,c) not_here("waitpid")
 433 #endif
 434
 435 #ifndef HAS_MBLEN
 436 #ifndef mblen
 437 #define mblen(a,b) not_here("mblen")
 438 #endif
 439 #endif
 440 #ifndef HAS_MBSTOWCS
 441 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
 442 #endif
 443 #ifndef HAS_MBTOWC
 444 #define mbtowc(pwc, s, n) not_here("mbtowc")
 445 #endif
 446 #ifndef HAS_WCSTOMBS
 447 #define wcstombs(s, pwcs, n) not_here("wcstombs")
 448 #endif
 449 #ifndef HAS_WCTOMB
 450 #define wctomb(s, wchar) not_here("wcstombs")
 451 #endif
 452 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
 453 /* If we don't have these functions, then we wouldn't have gotten a typedef
 454    for wchar_t, the wide character type.  Defining wchar_t allows the
 455    functions referencing it to compile.  Its actual type is then meaningless,
 456    since without the above functions, all sections using it end up calling
 457    not_here() and croak.  --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
 458 #ifndef wchar_t
 459 #define wchar_t char
 460 #endif
 461 #endif
 462
 463 #ifndef HAS_LOCALECONV
 464 #define localeconv() not_here("localeconv")
 465 #endif
 466
 467 #ifdef HAS_LONG_DOUBLE
 468 #  if LONG_DOUBLESIZE > NVSIZE
 469 #    undef HAS_LONG_DOUBLE  /* XXX until we figure out how to use them */
 470 #  endif
 471 #endif
 472
 473 #ifndef HAS_LONG_DOUBLE
 474 #ifdef LDBL_MAX
 475 #undef LDBL_MAX
 476 #endif
 477 #ifdef LDBL_MIN
 478 #undef LDBL_MIN
 479 #endif
 480 #ifdef LDBL_EPSILON
 481 #undef LDBL_EPSILON
 482 #endif
 483 #endif
 484
 485 /* Background: in most systems the low byte of the wait status
 486  * is the signal (the lowest 7 bits) and the coredump flag is
 487  * the eight bit, and the second lowest byte is the exit status.
 488  * BeOS bucks the trend and has the bytes in different order.
 489  * See beos/beos.c for how the reality is bent even in BeOS
 490  * to follow the traditional.  However, to make the POSIX
 491  * wait W*() macros to work in BeOS, we need to unbend the
 492  * reality back in place. --jhi */
 493 /* In actual fact the code below is to blame here. Perl has an internal
 494  * representation of the exit status ($?), which it re-composes from the
 495  * OS's representation using the W*() POSIX macros. The code below
 496  * incorrectly uses the W*() macros on the internal representation,
 497  * which fails for OSs that have a different representation (namely BeOS
 498  * and Haiku). WMUNGE() is a hack that converts the internal
 499  * representation into the OS specific one, so that the W*() macros work
 500  * as expected. The better solution would be not to use the W*() macros
 501  * in the first place, though. -- Ingo Weinhold
 502  */
 503 #if defined(__BEOS__) || defined(__HAIKU__)
 504 #    define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
 505 #else
 506 #    define WMUNGE(x) (x)
 507 #endif
 508
 509 static int
 510 not_here(const char *s)
 511 {
 512     croak("POSIX::%s not implemented on this architecture", s);
 513     return -1;
 514 }
 515
 516 #include "const-c.inc"
 517
 518 static void
 519 restore_sigmask(pTHX_ SV *osset_sv)
 520 {
 521      /* Fortunately, restoring the signal mask can't fail, because
 522       * there's nothing we can do about it if it does -- we're not
 523       * supposed to return -1 from sigaction unless the disposition
 524       * was unaffected.
 525       */
 526      sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
 527      (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
 528 }
 529
 530 #ifdef WIN32
 531
 532 /*
 533  * (1) The CRT maintains its own copy of the environment, separate from
 534  * the Win32API copy.
 535  *
 536  * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
 537  * copy, and then calls SetEnvironmentVariableA() to update the Win32API
 538  * copy.
 539  *
 540  * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
 541  * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
 542  * environment.
 543  *
 544  * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
 545  * calls CRT tzset(), but only the first time it is called, and in turn
 546  * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
 547  * local copy of the environment and hence gets the original setting as
 548  * perl never updates the CRT copy when assigning to $ENV{TZ}.
 549  *
 550  * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
 551  * putenv() to update the CRT copy of the environment (if it is different)
 552  * whenever we're about to call tzset().
 553  *
 554  * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
 555  * defined:
 556  *
 557  * (a) Each interpreter has its own copy of the environment inside the
 558  * perlhost structure. That allows applications that host multiple
 559  * independent Perl interpreters to isolate environment changes from
 560  * each other. (This is similar to how the perlhost mechanism keeps a
 561  * separate working directory for each Perl interpreter, so that calling
 562  * chdir() will not affect other interpreters.)
 563  *
 564  * (b) Only the first Perl interpreter instantiated within a process will
 565  * "write through" environment changes to the process environment.
 566  *
 567  * (c) Even the primary Perl interpreter won't update the CRT copy of the
 568  * the environment, only the Win32API copy (it calls win32_putenv()).
 569  *
 570  * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
 571  * sense to only update the process environment when inside the main
 572  * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
 573  * from here so we'll just have to check PL_curinterp instead.
 574  *
 575  * Therefore, we can simply #undef getenv() and putenv() so that those names
 576  * always refer to the CRT functions, and explicitly call win32_getenv() to
 577  * access perl's %ENV.
 578  *
 579  * We also #undef malloc() and free() to be sure we are using the CRT
 580  * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
 581  * into VMem::Malloc() and VMem::Free() and all allocations will be freed
 582  * when the Perl interpreter is being destroyed so we'd end up with a pointer
 583  * into deallocated memory in environ[] if a program embedding a Perl
 584  * interpreter continues to operate even after the main Perl interpreter has
 585  * been destroyed.
 586  *
 587  * Note that we don't free() the malloc()ed memory unless and until we call
 588  * malloc() again ourselves because the CRT putenv() function simply puts its
 589  * pointer argument into the environ[] arrary (it doesn't make a copy of it)
 590  * so this memory must otherwise be leaked.
 591  */
 592
 593 #undef getenv
 594 #undef putenv
 595 #undef malloc
 596 #undef free
 597
 598 static void
 599 fix_win32_tzenv(void)
 600 {
 601     static char* oldenv = NULL;
 602     char* newenv;
 603     const char* perl_tz_env = win32_getenv("TZ");
 604     const char* crt_tz_env = getenv("TZ");
 605     if (perl_tz_env == NULL)
 606         perl_tz_env = "";
 607     if (crt_tz_env == NULL)
 608         crt_tz_env = "";
 609     if (strcmp(perl_tz_env, crt_tz_env) != 0) {
 610         newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
 611         if (newenv != NULL) {
 612             sprintf(newenv, "TZ=%s", perl_tz_env);
 613             putenv(newenv);
 614             if (oldenv != NULL)
 615                 free(oldenv);
 616             oldenv = newenv;
 617         }
 618     }
 619 }
 620
 621 #endif
 622
 623 /*
 624  * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
 625  * This code is duplicated in the Time-Piece module, so any changes made here
 626  * should be made there too.
 627  */
 628 static void
 629 my_tzset(pTHX)
 630 {
 631 #ifdef WIN32
 632 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
 633     if (PL_curinterp == aTHX)
 634 #endif
 635         fix_win32_tzenv();
 636 #endif
 637     tzset();
 638 }
 639
 640 MODULE = SigSet         PACKAGE = POSIX::SigSet         PREFIX = sig
 641
 642 POSIX::SigSet
 643 new(packname = "POSIX::SigSet", ...)
 644     const char *        packname
 645     CODE:
 646         {
 647             int i;
 648             Newx(RETVAL, 1, sigset_t);
 649             sigemptyset(RETVAL);
 650             for (i = 1; i < items; i++)
 651                 sigaddset(RETVAL, SvIV(ST(i)));
 652         }
 653     OUTPUT:
 654         RETVAL
 655
 656 void
 657 DESTROY(sigset)
 658         POSIX::SigSet   sigset
 659     CODE:
 660         Safefree(sigset);
 661
 662 SysRet
 663 sigaddset(sigset, sig)
 664         POSIX::SigSet   sigset
 665         int             sig
 666
 667 SysRet
 668 sigdelset(sigset, sig)
 669         POSIX::SigSet   sigset
 670         int             sig
 671
 672 SysRet
 673 sigemptyset(sigset)
 674         POSIX::SigSet   sigset
 675
 676 SysRet
 677 sigfillset(sigset)
 678         POSIX::SigSet   sigset
 679
 680 int
 681 sigismember(sigset, sig)
 682         POSIX::SigSet   sigset
 683         int             sig
 684
 685 MODULE = Termios        PACKAGE = POSIX::Termios        PREFIX = cf
 686
 687 POSIX::Termios
 688 new(packname = "POSIX::Termios", ...)
 689     const char *        packname
 690     CODE:
 691         {
 692 #ifdef I_TERMIOS
 693             Newx(RETVAL, 1, struct termios);
 694 #else
 695             not_here("termios");
 696         RETVAL = 0;
 697 #endif
 698         }
 699     OUTPUT:
 700         RETVAL
 701
 702 void
 703 DESTROY(termios_ref)
 704         POSIX::Termios  termios_ref
 705     CODE:
 706 #ifdef I_TERMIOS
 707         Safefree(termios_ref);
 708 #else
 709             not_here("termios");
 710 #endif
 711
 712 SysRet
 713 getattr(termios_ref, fd = 0)
 714         POSIX::Termios  termios_ref
 715         int             fd
 716     CODE:
 717         RETVAL = tcgetattr(fd, termios_ref);
 718     OUTPUT:
 719         RETVAL
 720
 721 SysRet
 722 setattr(termios_ref, fd = 0, optional_actions = 0)
 723         POSIX::Termios  termios_ref
 724         int             fd
 725         int             optional_actions
 726     CODE:
 727         RETVAL = tcsetattr(fd, optional_actions, termios_ref);
 728     OUTPUT:
 729         RETVAL
 730
 731 speed_t
 732 cfgetispeed(termios_ref)
 733         POSIX::Termios  termios_ref
 734
 735 speed_t
 736 cfgetospeed(termios_ref)
 737         POSIX::Termios  termios_ref
 738
 739 tcflag_t
 740 getiflag(termios_ref)
 741         POSIX::Termios  termios_ref
 742     CODE:
 743 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 744         RETVAL = termios_ref->c_iflag;
 745 #else
 746      not_here("getiflag");
 747      RETVAL = 0;
 748 #endif
 749     OUTPUT:
 750         RETVAL
 751
 752 tcflag_t
 753 getoflag(termios_ref)
 754         POSIX::Termios  termios_ref
 755     CODE:
 756 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 757         RETVAL = termios_ref->c_oflag;
 758 #else
 759      not_here("getoflag");
 760      RETVAL = 0;
 761 #endif
 762     OUTPUT:
 763         RETVAL
 764
 765 tcflag_t
 766 getcflag(termios_ref)
 767         POSIX::Termios  termios_ref
 768     CODE:
 769 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 770         RETVAL = termios_ref->c_cflag;
 771 #else
 772      not_here("getcflag");
 773      RETVAL = 0;
 774 #endif
 775     OUTPUT:
 776         RETVAL
 777
 778 tcflag_t
 779 getlflag(termios_ref)
 780         POSIX::Termios  termios_ref
 781     CODE:
 782 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 783         RETVAL = termios_ref->c_lflag;
 784 #else
 785      not_here("getlflag");
 786      RETVAL = 0;
 787 #endif
 788     OUTPUT:
 789         RETVAL
 790
 791 cc_t
 792 getcc(termios_ref, ccix)
 793         POSIX::Termios  termios_ref
 794         unsigned int    ccix
 795     CODE:
 796 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 797         if (ccix >= NCCS)
 798             croak("Bad getcc subscript");
 799         RETVAL = termios_ref->c_cc[ccix];
 800 #else
 801      not_here("getcc");
 802      RETVAL = 0;
 803 #endif
 804     OUTPUT:
 805         RETVAL
 806
 807 SysRet
 808 cfsetispeed(termios_ref, speed)
 809         POSIX::Termios  termios_ref
 810         speed_t         speed
 811
 812 SysRet
 813 cfsetospeed(termios_ref, speed)
 814         POSIX::Termios  termios_ref
 815         speed_t         speed
 816
 817 void
 818 setiflag(termios_ref, iflag)
 819         POSIX::Termios  termios_ref
 820         tcflag_t        iflag
 821     CODE:
 822 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 823         termios_ref->c_iflag = iflag;
 824 #else
 825             not_here("setiflag");
 826 #endif
 827
 828 void
 829 setoflag(termios_ref, oflag)
 830         POSIX::Termios  termios_ref
 831         tcflag_t        oflag
 832     CODE:
 833 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 834         termios_ref->c_oflag = oflag;
 835 #else
 836             not_here("setoflag");
 837 #endif
 838
 839 void
 840 setcflag(termios_ref, cflag)
 841         POSIX::Termios  termios_ref
 842         tcflag_t        cflag
 843     CODE:
 844 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 845         termios_ref->c_cflag = cflag;
 846 #else
 847             not_here("setcflag");
 848 #endif
 849
 850 void
 851 setlflag(termios_ref, lflag)
 852         POSIX::Termios  termios_ref
 853         tcflag_t        lflag
 854     CODE:
 855 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 856         termios_ref->c_lflag = lflag;
 857 #else
 858             not_here("setlflag");
 859 #endif
 860
 861 void
 862 setcc(termios_ref, ccix, cc)
 863         POSIX::Termios  termios_ref
 864         unsigned int    ccix
 865         cc_t            cc
 866     CODE:
 867 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 868         if (ccix >= NCCS)
 869             croak("Bad setcc subscript");
 870         termios_ref->c_cc[ccix] = cc;
 871 #else
 872             not_here("setcc");
 873 #endif
 874
 875
 876 MODULE = POSIX          PACKAGE = POSIX
 877
 878 INCLUDE: const-xs.inc
 879
 880 int
 881 WEXITSTATUS(status)
 882         int status
 883     ALIAS:
 884         POSIX::WIFEXITED = 1
 885         POSIX::WIFSIGNALED = 2
 886         POSIX::WIFSTOPPED = 3
 887         POSIX::WSTOPSIG = 4
 888         POSIX::WTERMSIG = 5
 889     CODE:
 890 #if !(defined(WEXITSTATUS) || defined(WIFEXITED) || defined(WIFSIGNALED) \
 891       || defined(WIFSTOPPED) || defined(WSTOPSIG) || defined (WTERMSIG))
 892         RETVAL = 0; /* Silence compilers that notice this, but don't realise
 893                        that not_here() can't return.  */
 894 #endif
 895         switch(ix) {
 896         case 0:
 897 #ifdef WEXITSTATUS
 898             RETVAL = WEXITSTATUS(WMUNGE(status));
 899 #else
 900             not_here("WEXITSTATUS");
 901 #endif
 902             break;
 903         case 1:
 904 #ifdef WIFEXITED
 905             RETVAL = WIFEXITED(WMUNGE(status));
 906 #else
 907             not_here("WIFEXITED");
 908 #endif
 909             break;
 910         case 2:
 911 #ifdef WIFSIGNALED
 912             RETVAL = WIFSIGNALED(WMUNGE(status));
 913 #else
 914             not_here("WIFSIGNALED");
 915 #endif
 916             break;
 917         case 3:
 918 #ifdef WIFSTOPPED
 919             RETVAL = WIFSTOPPED(WMUNGE(status));
 920 #else
 921             not_here("WIFSTOPPED");
 922 #endif
 923             break;
 924         case 4:
 925 #ifdef WSTOPSIG
 926             RETVAL = WSTOPSIG(WMUNGE(status));
 927 #else
 928             not_here("WSTOPSIG");
 929 #endif
 930             break;
 931         case 5:
 932 #ifdef WTERMSIG
 933             RETVAL = WTERMSIG(WMUNGE(status));
 934 #else
 935             not_here("WTERMSIG");
 936 #endif
 937             break;
 938         default:
 939             Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", ix);
 940         }
 941     OUTPUT:
 942         RETVAL
 943
 944 int
 945 isalnum(charstring)
 946         SV *    charstring
 947     PREINIT:
 948         STRLEN  len;
 949     CODE:
 950         unsigned char *s = (unsigned char *) SvPV(charstring, len);
 951         unsigned char *e = s + len;
 952         for (RETVAL = 1; RETVAL && s < e; s++)
 953             if (!isalnum(*s))
 954                 RETVAL = 0;
 955     OUTPUT:
 956         RETVAL
 957
 958 int
 959 isalpha(charstring)
 960         SV *    charstring
 961     PREINIT:
 962         STRLEN  len;
 963     CODE:
 964         unsigned char *s = (unsigned char *) SvPV(charstring, len);
 965         unsigned char *e = s + len;
 966         for (RETVAL = 1; RETVAL && s < e; s++)
 967             if (!isalpha(*s))
 968                 RETVAL = 0;
 969     OUTPUT:
 970         RETVAL
 971
 972 int
 973 iscntrl(charstring)
 974         SV *    charstring
 975     PREINIT:
 976         STRLEN  len;
 977     CODE:
 978         unsigned char *s = (unsigned char *) SvPV(charstring, len);
 979         unsigned char *e = s + len;
 980         for (RETVAL = 1; RETVAL && s < e; s++)
 981             if (!iscntrl(*s))
 982                 RETVAL = 0;
 983     OUTPUT:
 984         RETVAL
 985
 986 int
 987 isdigit(charstring)
 988         SV *    charstring
 989     PREINIT:
 990         STRLEN  len;
 991     CODE:
 992         unsigned char *s = (unsigned char *) SvPV(charstring, len);
 993         unsigned char *e = s + len;
 994         for (RETVAL = 1; RETVAL && s < e; s++)
 995             if (!isdigit(*s))
 996                 RETVAL = 0;
 997     OUTPUT:
 998         RETVAL
 999
1000 int
1001 isgraph(charstring)
1002         SV *    charstring
1003     PREINIT:
1004         STRLEN  len;
1005     CODE:
1006         unsigned char *s = (unsigned char *) SvPV(charstring, len);
1007         unsigned char *e = s + len;
1008         for (RETVAL = 1; RETVAL && s < e; s++)
1009             if (!isgraph(*s))
1010                 RETVAL = 0;
1011     OUTPUT:
1012         RETVAL
1013
1014 int
1015 islower(charstring)
1016         SV *    charstring
1017     PREINIT:
1018         STRLEN  len;
1019     CODE:
1020         unsigned char *s = (unsigned char *) SvPV(charstring, len);
1021         unsigned char *e = s + len;
1022         for (RETVAL = 1; RETVAL && s < e; s++)
1023             if (!islower(*s))
1024                 RETVAL = 0;
1025     OUTPUT:
1026         RETVAL
1027
1028 int
1029 isprint(charstring)
1030         SV *    charstring
1031     PREINIT:
1032         STRLEN  len;
1033     CODE:
1034         unsigned char *s = (unsigned char *) SvPV(charstring, len);
1035         unsigned char *e = s + len;
1036         for (RETVAL = 1; RETVAL && s < e; s++)
1037             if (!isprint(*s))
1038                 RETVAL = 0;
1039     OUTPUT:
1040         RETVAL
1041
1042 int
1043 ispunct(charstring)
1044         SV *    charstring
1045     PREINIT:
1046         STRLEN  len;
1047     CODE:
1048         unsigned char *s = (unsigned char *) SvPV(charstring, len);
1049         unsigned char *e = s + len;
1050         for (RETVAL = 1; RETVAL && s < e; s++)
1051             if (!ispunct(*s))
1052                 RETVAL = 0;
1053     OUTPUT:
1054         RETVAL
1055
1056 int
1057 isspace(charstring)
1058         SV *    charstring
1059     PREINIT:
1060         STRLEN  len;
1061     CODE:
1062         unsigned char *s = (unsigned char *) SvPV(charstring, len);
1063         unsigned char *e = s + len;
1064         for (RETVAL = 1; RETVAL && s < e; s++)
1065             if (!isspace(*s))
1066                 RETVAL = 0;
1067     OUTPUT:
1068         RETVAL
1069
1070 int
1071 isupper(charstring)
1072         SV *    charstring
1073     PREINIT:
1074         STRLEN  len;
1075     CODE:
1076         unsigned char *s = (unsigned char *) SvPV(charstring, len);
1077         unsigned char *e = s + len;
1078         for (RETVAL = 1; RETVAL && s < e; s++)
1079             if (!isupper(*s))
1080                 RETVAL = 0;
1081     OUTPUT:
1082         RETVAL
1083
1084 int
1085 isxdigit(charstring)
1086         SV *    charstring
1087     PREINIT:
1088         STRLEN  len;
1089     CODE:
1090         unsigned char *s = (unsigned char *) SvPV(charstring, len);
1091         unsigned char *e = s + len;
1092         for (RETVAL = 1; RETVAL && s < e; s++)
1093             if (!isxdigit(*s))
1094                 RETVAL = 0;
1095     OUTPUT:
1096         RETVAL
1097
1098 SysRet
1099 open(filename, flags = O_RDONLY, mode = 0666)
1100         char *          filename
1101         int             flags
1102         Mode_t          mode
1103     CODE:
1104         if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
1105             TAINT_PROPER("open");
1106         RETVAL = open(filename, flags, mode);
1107     OUTPUT:
1108         RETVAL
1109
1110
1111 HV *
1112 localeconv()
1113     CODE:
1114 #ifdef HAS_LOCALECONV
1115         struct lconv *lcbuf;
1116         RETVAL = newHV();
1117         sv_2mortal((SV*)RETVAL);
1118         if ((lcbuf = localeconv())) {
1119             /* the strings */
1120             if (lcbuf->decimal_point && *lcbuf->decimal_point)
1121                 hv_store(RETVAL, "decimal_point", 13,
1122                     newSVpv(lcbuf->decimal_point, 0), 0);
1123             if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
1124                 hv_store(RETVAL, "thousands_sep", 13,
1125                     newSVpv(lcbuf->thousands_sep, 0), 0);
1126 #ifndef NO_LOCALECONV_GROUPING
1127             if (lcbuf->grouping && *lcbuf->grouping)
1128                 hv_store(RETVAL, "grouping", 8,
1129                     newSVpv(lcbuf->grouping, 0), 0);
1130 #endif
1131             if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1132                 hv_store(RETVAL, "int_curr_symbol", 15,
1133                     newSVpv(lcbuf->int_curr_symbol, 0), 0);
1134             if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1135                 hv_store(RETVAL, "currency_symbol", 15,
1136                     newSVpv(lcbuf->currency_symbol, 0), 0);
1137             if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1138                 hv_store(RETVAL, "mon_decimal_point", 17,
1139                     newSVpv(lcbuf->mon_decimal_point, 0), 0);
1140 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1141             if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1142                 hv_store(RETVAL, "mon_thousands_sep", 17,
1143                     newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1144 #endif
1145 #ifndef NO_LOCALECONV_MON_GROUPING
1146             if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1147                 hv_store(RETVAL, "mon_grouping", 12,
1148                     newSVpv(lcbuf->mon_grouping, 0), 0);
1149 #endif
1150             if (lcbuf->positive_sign && *lcbuf->positive_sign)
1151                 hv_store(RETVAL, "positive_sign", 13,
1152                     newSVpv(lcbuf->positive_sign, 0), 0);
1153             if (lcbuf->negative_sign && *lcbuf->negative_sign)
1154                 hv_store(RETVAL, "negative_sign", 13,
1155                     newSVpv(lcbuf->negative_sign, 0), 0);
1156             /* the integers */
1157             if (lcbuf->int_frac_digits != CHAR_MAX)
1158                 hv_store(RETVAL, "int_frac_digits", 15,
1159                     newSViv(lcbuf->int_frac_digits), 0);
1160             if (lcbuf->frac_digits != CHAR_MAX)
1161                 hv_store(RETVAL, "frac_digits", 11,
1162                     newSViv(lcbuf->frac_digits), 0);
1163             if (lcbuf->p_cs_precedes != CHAR_MAX)
1164                 hv_store(RETVAL, "p_cs_precedes", 13,
1165                     newSViv(lcbuf->p_cs_precedes), 0);
1166             if (lcbuf->p_sep_by_space != CHAR_MAX)
1167                 hv_store(RETVAL, "p_sep_by_space", 14,
1168                     newSViv(lcbuf->p_sep_by_space), 0);
1169             if (lcbuf->n_cs_precedes != CHAR_MAX)
1170                 hv_store(RETVAL, "n_cs_precedes", 13,
1171                     newSViv(lcbuf->n_cs_precedes), 0);
1172             if (lcbuf->n_sep_by_space != CHAR_MAX)
1173                 hv_store(RETVAL, "n_sep_by_space", 14,
1174                     newSViv(lcbuf->n_sep_by_space), 0);
1175             if (lcbuf->p_sign_posn != CHAR_MAX)
1176                 hv_store(RETVAL, "p_sign_posn", 11,
1177                     newSViv(lcbuf->p_sign_posn), 0);
1178             if (lcbuf->n_sign_posn != CHAR_MAX)
1179                 hv_store(RETVAL, "n_sign_posn", 11,
1180                     newSViv(lcbuf->n_sign_posn), 0);
1181         }
1182 #else
1183         localeconv(); /* A stub to call not_here(). */
1184 #endif
1185     OUTPUT:
1186         RETVAL
1187
1188 char *
1189 setlocale(category, locale = 0)
1190         int             category
1191         char *          locale
1192     PREINIT:
1193         char *          retval;
1194     CODE:
1195         retval = setlocale(category, locale);
1196         if (retval) {
1197             /* Save retval since subsequent setlocale() calls
1198              * may overwrite it. */
1199             RETVAL = savepv(retval);
1200 #ifdef USE_LOCALE_CTYPE
1201             if (category == LC_CTYPE
1202 #ifdef LC_ALL
1203                 || category == LC_ALL
1204 #endif
1205                 )
1206             {
1207                 char *newctype;
1208 #ifdef LC_ALL
1209                 if (category == LC_ALL)
1210                     newctype = setlocale(LC_CTYPE, NULL);
1211                 else
1212 #endif
1213                     newctype = RETVAL;
1214                 new_ctype(newctype);
1215             }
1216 #endif /* USE_LOCALE_CTYPE */
1217 #ifdef USE_LOCALE_COLLATE
1218             if (category == LC_COLLATE
1219 #ifdef LC_ALL
1220                 || category == LC_ALL
1221 #endif
1222                 )
1223             {
1224                 char *newcoll;
1225 #ifdef LC_ALL
1226                 if (category == LC_ALL)
1227                     newcoll = setlocale(LC_COLLATE, NULL);
1228                 else
1229 #endif
1230                     newcoll = RETVAL;
1231                 new_collate(newcoll);
1232             }
1233 #endif /* USE_LOCALE_COLLATE */
1234 #ifdef USE_LOCALE_NUMERIC
1235             if (category == LC_NUMERIC
1236 #ifdef LC_ALL
1237                 || category == LC_ALL
1238 #endif
1239                 )
1240             {
1241                 char *newnum;
1242 #ifdef LC_ALL
1243                 if (category == LC_ALL)
1244                     newnum = setlocale(LC_NUMERIC, NULL);
1245                 else
1246 #endif
1247                     newnum = RETVAL;
1248                 new_numeric(newnum);
1249             }
1250 #endif /* USE_LOCALE_NUMERIC */
1251         }
1252         else
1253             RETVAL = NULL;
1254     OUTPUT:
1255         RETVAL
1256     CLEANUP:
1257         if (RETVAL)
1258             Safefree(RETVAL);
1259
1260 NV
1261 acos(x)
1262         NV              x
1263
1264 NV
1265 asin(x)
1266         NV              x
1267
1268 NV
1269 atan(x)
1270         NV              x
1271
1272 NV
1273 ceil(x)
1274         NV              x
1275
1276 NV
1277 cosh(x)
1278         NV              x
1279
1280 NV
1281 floor(x)
1282         NV              x
1283
1284 NV
1285 fmod(x,y)
1286         NV              x
1287         NV              y
1288
1289 void
1290 frexp(x)
1291         NV              x
1292     PPCODE:
1293         int expvar;
1294         /* (We already know stack is long enough.) */
1295         PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1296         PUSHs(sv_2mortal(newSViv(expvar)));
1297
1298 NV
1299 ldexp(x,exp)
1300         NV              x
1301         int             exp
1302
1303 NV
1304 log10(x)
1305         NV              x
1306
1307 void
1308 modf(x)
1309         NV              x
1310     PPCODE:
1311         NV intvar;
1312         /* (We already know stack is long enough.) */
1313         PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1314         PUSHs(sv_2mortal(newSVnv(intvar)));
1315
1316 NV
1317 sinh(x)
1318         NV              x
1319
1320 NV
1321 tan(x)
1322         NV              x
1323
1324 NV
1325 tanh(x)
1326         NV              x
1327
1328 SysRet
1329 sigaction(sig, optaction, oldaction = 0)
1330         int                     sig
1331         SV *                    optaction
1332         POSIX::SigAction        oldaction
1333     CODE:
1334 #if defined(WIN32) || defined(NETWARE)
1335         RETVAL = not_here("sigaction");
1336 #else
1337 # This code is really grody because we're trying to make the signal
1338 # interface look beautiful, which is hard.
1339
1340         {
1341             dVAR;
1342             POSIX__SigAction action;
1343             GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
1344             struct sigaction act;
1345             struct sigaction oact;
1346             sigset_t sset;
1347             SV *osset_sv;
1348             sigset_t osset;
1349             POSIX__SigSet sigset;
1350             SV** svp;
1351             SV** sigsvp;
1352
1353             if (sig < 0) {
1354                 croak("Negative signals are not allowed");
1355             }
1356
1357             if (sig == 0 && SvPOK(ST(0))) {
1358                 const char *s = SvPVX_const(ST(0));
1359                 int i = whichsig(s);
1360
1361                 if (i < 0 && memEQ(s, "SIG", 3))
1362                     i = whichsig(s + 3);
1363                 if (i < 0) {
1364                     if (ckWARN(WARN_SIGNAL))
1365                         Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1366                                     "No such signal: SIG%s", s);
1367                     XSRETURN_UNDEF;
1368                 }
1369                 else
1370                     sig = i;
1371             }
1372 #ifdef NSIG
1373             if (sig > NSIG) { /* NSIG - 1 is still okay. */
1374                 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1375                             "No such signal: %d", sig);
1376                 XSRETURN_UNDEF;
1377             }
1378 #endif
1379             sigsvp = hv_fetch(GvHVn(siggv),
1380                               PL_sig_name[sig],
1381                               strlen(PL_sig_name[sig]),
1382                               TRUE);
1383
1384             /* Check optaction and set action */
1385             if(SvTRUE(optaction)) {
1386                 if(sv_isa(optaction, "POSIX::SigAction"))
1387                         action = (HV*)SvRV(optaction);
1388                 else
1389                         croak("action is not of type POSIX::SigAction");
1390             }
1391             else {
1392                 action=0;
1393             }
1394
1395             /* sigaction() is supposed to look atomic. In particular, any
1396              * signal handler invoked during a sigaction() call should
1397              * see either the old or the new disposition, and not something
1398              * in between. We use sigprocmask() to make it so.
1399              */
1400             sigfillset(&sset);
1401             RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1402             if(RETVAL == -1)
1403                XSRETURN_UNDEF;
1404             ENTER;
1405             /* Restore signal mask no matter how we exit this block. */
1406             osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
1407             SAVEFREESV( osset_sv );
1408             SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1409
1410             RETVAL=-1; /* In case both oldaction and action are 0. */
1411
1412             /* Remember old disposition if desired. */
1413             if (oldaction) {
1414                 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1415                 if(!svp)
1416                     croak("Can't supply an oldaction without a HANDLER");
1417                 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1418                         sv_setsv(*svp, *sigsvp);
1419                 }
1420                 else {
1421                         sv_setpvs(*svp, "DEFAULT");
1422                 }
1423                 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1424                 if(RETVAL == -1) {
1425                    LEAVE;
1426                    XSRETURN_UNDEF;
1427                 }
1428                 /* Get back the mask. */
1429                 svp = hv_fetchs(oldaction, "MASK", TRUE);
1430                 if (sv_isa(*svp, "POSIX::SigSet")) {
1431                     IV tmp = SvIV((SV*)SvRV(*svp));
1432                     sigset = INT2PTR(sigset_t*, tmp);
1433                 }
1434                 else {
1435                     Newx(sigset, 1, sigset_t);
1436                     sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1437                 }
1438                 *sigset = oact.sa_mask;
1439
1440                 /* Get back the flags. */
1441                 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1442                 sv_setiv(*svp, oact.sa_flags);
1443
1444                 /* Get back whether the old handler used safe signals. */
1445                 svp = hv_fetchs(oldaction, "SAFE", TRUE);
1446                 sv_setiv(*svp,
1447                 /* compare incompatible pointers by casting to integer */
1448                     PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
1449             }
1450
1451             if (action) {
1452                 /* Safe signals use "csighandler", which vectors through the
1453                    PL_sighandlerp pointer when it's safe to do so.
1454                    (BTW, "csighandler" is very different from "sighandler".) */
1455                 svp = hv_fetchs(action, "SAFE", FALSE);
1456                 act.sa_handler =
1457                         DPTR2FPTR(
1458                             void (*)(int),
1459                             (*svp && SvTRUE(*svp))
1460                                 ? PL_csighandlerp : PL_sighandlerp
1461                         );
1462
1463                 /* Vector new Perl handler through %SIG.
1464                    (The core signal handlers read %SIG to dispatch.) */
1465                 svp = hv_fetchs(action, "HANDLER", FALSE);
1466                 if (!svp)
1467                     croak("Can't supply an action without a HANDLER");
1468                 sv_setsv(*sigsvp, *svp);
1469
1470                 /* This call actually calls sigaction() with almost the
1471                    right settings, including appropriate interpretation
1472                    of DEFAULT and IGNORE.  However, why are we doing
1473                    this when we're about to do it again just below?  XXX */
1474                 mg_set(*sigsvp);
1475
1476                 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1477                 if(SvPOK(*svp)) {
1478                         const char *s=SvPVX_const(*svp);
1479                         if(strEQ(s,"IGNORE")) {
1480                                 act.sa_handler = SIG_IGN;
1481                         }
1482                         else if(strEQ(s,"DEFAULT")) {
1483                                 act.sa_handler = SIG_DFL;
1484                         }
1485                 }
1486
1487                 /* Set up any desired mask. */
1488                 svp = hv_fetchs(action, "MASK", FALSE);
1489                 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1490                     IV tmp = SvIV((SV*)SvRV(*svp));
1491                     sigset = INT2PTR(sigset_t*, tmp);
1492                     act.sa_mask = *sigset;
1493                 }
1494                 else
1495                     sigemptyset(& act.sa_mask);
1496
1497                 /* Set up any desired flags. */
1498                 svp = hv_fetchs(action, "FLAGS", FALSE);
1499                 act.sa_flags = svp ? SvIV(*svp) : 0;
1500
1501                 /* Don't worry about cleaning up *sigsvp if this fails,
1502                  * because that means we tried to disposition a
1503                  * nonblockable signal, in which case *sigsvp is
1504                  * essentially meaningless anyway.
1505                  */
1506                 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1507                 if(RETVAL == -1) {
1508                     LEAVE;
1509                     XSRETURN_UNDEF;
1510                 }
1511             }
1512
1513             LEAVE;
1514         }
1515 #endif
1516     OUTPUT:
1517         RETVAL
1518
1519 SysRet
1520 sigpending(sigset)
1521         POSIX::SigSet           sigset
1522
1523 SysRet
1524 sigprocmask(how, sigset, oldsigset = 0)
1525         int                     how
1526         POSIX::SigSet           sigset = NO_INIT
1527         POSIX::SigSet           oldsigset = NO_INIT
1528 INIT:
1529         if (! SvOK(ST(1))) {
1530             sigset = NULL;
1531         } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1532             IV tmp = SvIV((SV*)SvRV(ST(1)));
1533             sigset = INT2PTR(POSIX__SigSet,tmp);
1534         } else {
1535             croak("sigset is not of type POSIX::SigSet");
1536         }
1537
1538         if (items < 3 || ! SvOK(ST(2))) {
1539             oldsigset = NULL;
1540         } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1541             IV tmp = SvIV((SV*)SvRV(ST(2)));
1542             oldsigset = INT2PTR(POSIX__SigSet,tmp);
1543         } else {
1544             croak("oldsigset is not of type POSIX::SigSet");
1545         }
1546
1547 SysRet
1548 sigsuspend(signal_mask)
1549         POSIX::SigSet           signal_mask
1550
1551 void
1552 _exit(status)
1553         int             status
1554
1555 SysRet
1556 close(fd)
1557         int             fd
1558
1559 SysRet
1560 dup(fd)
1561         int             fd
1562
1563 SysRet
1564 dup2(fd1, fd2)
1565         int             fd1
1566         int             fd2
1567
1568 SV *
1569 lseek(fd, offset, whence)
1570         int             fd
1571         Off_t           offset
1572         int             whence
1573     CODE:
1574         Off_t pos = PerlLIO_lseek(fd, offset, whence);
1575         RETVAL = sizeof(Off_t) > sizeof(IV)
1576                  ? newSVnv((NV)pos) : newSViv((IV)pos);
1577     OUTPUT:
1578         RETVAL
1579
1580 void
1581 nice(incr)
1582         int             incr
1583     PPCODE:
1584         errno = 0;
1585         if ((incr = nice(incr)) != -1 || errno == 0) {
1586             if (incr == 0)
1587                 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
1588             else
1589                 XPUSHs(sv_2mortal(newSViv(incr)));
1590         }
1591
1592 void
1593 pipe()
1594     PPCODE:
1595         int fds[2];
1596         if (pipe(fds) != -1) {
1597             EXTEND(SP,2);
1598             PUSHs(sv_2mortal(newSViv(fds[0])));
1599             PUSHs(sv_2mortal(newSViv(fds[1])));
1600         }
1601
1602 SysRet
1603 read(fd, buffer, nbytes)
1604     PREINIT:
1605         SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1606     INPUT:
1607         int             fd
1608         size_t          nbytes
1609         char *          buffer = sv_grow( sv_buffer, nbytes+1 );
1610     CLEANUP:
1611         if (RETVAL >= 0) {
1612             SvCUR_set(sv_buffer, RETVAL);
1613             SvPOK_only(sv_buffer);
1614             *SvEND(sv_buffer) = '\0';
1615             SvTAINTED_on(sv_buffer);
1616         }
1617
1618 SysRet
1619 setpgid(pid, pgid)
1620         pid_t           pid
1621         pid_t           pgid
1622
1623 pid_t
1624 setsid()
1625
1626 pid_t
1627 tcgetpgrp(fd)
1628         int             fd
1629
1630 SysRet
1631 tcsetpgrp(fd, pgrp_id)
1632         int             fd
1633         pid_t           pgrp_id
1634
1635 void
1636 uname()
1637     PPCODE:
1638 #ifdef HAS_UNAME
1639         struct utsname buf;
1640         if (uname(&buf) >= 0) {
1641             EXTEND(SP, 5);
1642             PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
1643             PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
1644             PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
1645             PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
1646             PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
1647         }
1648 #else
1649         uname((char *) 0); /* A stub to call not_here(). */
1650 #endif
1651
1652 SysRet
1653 write(fd, buffer, nbytes)
1654         int             fd
1655         char *          buffer
1656         size_t          nbytes
1657
1658 SV *
1659 tmpnam()
1660     PREINIT:
1661         STRLEN i;
1662         int len;
1663     CODE:
1664         RETVAL = newSVpvn("", 0);
1665         SvGROW(RETVAL, L_tmpnam);
1666         len = strlen(tmpnam(SvPV(RETVAL, i)));
1667         SvCUR_set(RETVAL, len);
1668     OUTPUT:
1669         RETVAL
1670
1671 void
1672 abort()
1673
1674 int
1675 mblen(s, n)
1676         char *          s
1677         size_t          n
1678
1679 size_t
1680 mbstowcs(s, pwcs, n)
1681         wchar_t *       s
1682         char *          pwcs
1683         size_t          n
1684
1685 int
1686 mbtowc(pwc, s, n)
1687         wchar_t *       pwc
1688         char *          s
1689         size_t          n
1690
1691 int
1692 wcstombs(s, pwcs, n)
1693         char *          s
1694         wchar_t *       pwcs
1695         size_t          n
1696
1697 int
1698 wctomb(s, wchar)
1699         char *          s
1700         wchar_t         wchar
1701
1702 int
1703 strcoll(s1, s2)
1704         char *          s1
1705         char *          s2
1706
1707 void
1708 strtod(str)
1709         char *          str
1710     PREINIT:
1711         double num;
1712         char *unparsed;
1713     PPCODE:
1714         SET_NUMERIC_LOCAL();
1715         num = strtod(str, &unparsed);
1716         PUSHs(sv_2mortal(newSVnv(num)));
1717         if (GIMME == G_ARRAY) {
1718             EXTEND(SP, 1);
1719             if (unparsed)
1720                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1721             else
1722                 PUSHs(&PL_sv_undef);
1723         }
1724
1725 void
1726 strtol(str, base = 0)
1727         char *          str
1728         int             base
1729     PREINIT:
1730         long num;
1731         char *unparsed;
1732     PPCODE:
1733         num = strtol(str, &unparsed, base);
1734 #if IVSIZE <= LONGSIZE
1735         if (num < IV_MIN || num > IV_MAX)
1736             PUSHs(sv_2mortal(newSVnv((double)num)));
1737         else
1738 #endif
1739             PUSHs(sv_2mortal(newSViv((IV)num)));
1740         if (GIMME == G_ARRAY) {
1741             EXTEND(SP, 1);
1742             if (unparsed)
1743                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1744             else
1745                 PUSHs(&PL_sv_undef);
1746         }
1747
1748 void
1749 strtoul(str, base = 0)
1750         const char *    str
1751         int             base
1752     PREINIT:
1753         unsigned long num;
1754         char *unparsed;
1755     PPCODE:
1756         num = strtoul(str, &unparsed, base);
1757 #if IVSIZE <= LONGSIZE
1758         if (num > IV_MAX)
1759             PUSHs(sv_2mortal(newSVnv((double)num)));
1760         else
1761 #endif
1762             PUSHs(sv_2mortal(newSViv((IV)num)));
1763         if (GIMME == G_ARRAY) {
1764             EXTEND(SP, 1);
1765             if (unparsed)
1766                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1767             else
1768                 PUSHs(&PL_sv_undef);
1769         }
1770
1771 void
1772 strxfrm(src)
1773         SV *            src
1774     CODE:
1775         {
1776           STRLEN srclen;
1777           STRLEN dstlen;
1778           char *p = SvPV(src,srclen);
1779           srclen++;
1780           ST(0) = sv_2mortal(newSV(srclen*4+1));
1781           dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1782           if (dstlen > srclen) {
1783               dstlen++;
1784               SvGROW(ST(0), dstlen);
1785               strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1786               dstlen--;
1787           }
1788           SvCUR_set(ST(0), dstlen);
1789             SvPOK_only(ST(0));
1790         }
1791
1792 SysRet
1793 mkfifo(filename, mode)
1794         char *          filename
1795         Mode_t          mode
1796     CODE:
1797         TAINT_PROPER("mkfifo");
1798         RETVAL = mkfifo(filename, mode);
1799     OUTPUT:
1800         RETVAL
1801
1802 SysRet
1803 tcdrain(fd)
1804         int             fd
1805
1806
1807 SysRet
1808 tcflow(fd, action)
1809         int             fd
1810         int             action
1811
1812
1813 SysRet
1814 tcflush(fd, queue_selector)
1815         int             fd
1816         int             queue_selector
1817
1818 SysRet
1819 tcsendbreak(fd, duration)
1820         int             fd
1821         int             duration
1822
1823 char *
1824 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1825         int             sec
1826         int             min
1827         int             hour
1828         int             mday
1829         int             mon
1830         int             year
1831         int             wday
1832         int             yday
1833         int             isdst
1834     CODE:
1835         {
1836             struct tm mytm;
1837             init_tm(&mytm);     /* XXX workaround - see init_tm() above */
1838             mytm.tm_sec = sec;
1839             mytm.tm_min = min;
1840             mytm.tm_hour = hour;
1841             mytm.tm_mday = mday;
1842             mytm.tm_mon = mon;
1843             mytm.tm_year = year;
1844             mytm.tm_wday = wday;
1845             mytm.tm_yday = yday;
1846             mytm.tm_isdst = isdst;
1847             RETVAL = asctime(&mytm);
1848         }
1849     OUTPUT:
1850         RETVAL
1851
1852 long
1853 clock()
1854
1855 char *
1856 ctime(time)
1857         Time_t          &time
1858
1859 void
1860 times()
1861         PPCODE:
1862         struct tms tms;
1863         clock_t realtime;
1864         realtime = times( &tms );
1865         EXTEND(SP,5);
1866         PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1867         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1868         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1869         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1870         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1871
1872 double
1873 difftime(time1, time2)
1874         Time_t          time1
1875         Time_t          time2
1876
1877 SysRetLong
1878 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1879         int             sec
1880         int             min
1881         int             hour
1882         int             mday
1883         int             mon
1884         int             year
1885         int             wday
1886         int             yday
1887         int             isdst
1888     CODE:
1889         {
1890             struct tm mytm;
1891             init_tm(&mytm);     /* XXX workaround - see init_tm() above */
1892             mytm.tm_sec = sec;
1893             mytm.tm_min = min;
1894             mytm.tm_hour = hour;
1895             mytm.tm_mday = mday;
1896             mytm.tm_mon = mon;
1897             mytm.tm_year = year;
1898             mytm.tm_wday = wday;
1899             mytm.tm_yday = yday;
1900             mytm.tm_isdst = isdst;
1901             RETVAL = (SysRetLong) mktime(&mytm);
1902         }
1903     OUTPUT:
1904         RETVAL
1905
1906 #XXX: if $xsubpp::WantOptimize is always the default
1907 #     sv_setpv(TARG, ...) could be used rather than
1908 #     ST(0) = sv_2mortal(newSVpv(...))
1909 void
1910 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1911         SV *            fmt
1912         int             sec
1913         int             min
1914         int             hour
1915         int             mday
1916         int             mon
1917         int             year
1918         int             wday
1919         int             yday
1920         int             isdst
1921     CODE:
1922         {
1923             char *buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
1924             if (buf) {
1925                 SV *const sv = sv_newmortal();
1926                 sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
1927                 if (SvUTF8(fmt)) {
1928                     SvUTF8_on(sv);
1929                 }
1930                 ST(0) = sv;
1931             }
1932         }
1933
1934 void
1935 tzset()
1936   PPCODE:
1937     my_tzset(aTHX);
1938
1939 void
1940 tzname()
1941     PPCODE:
1942         EXTEND(SP,2);
1943         PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
1944         PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
1945
1946 SysRet
1947 access(filename, mode)
1948         char *          filename
1949         Mode_t          mode
1950
1951 char *
1952 ctermid(s = 0)
1953         char *          s = 0;
1954     CODE:
1955 #ifdef HAS_CTERMID_R
1956         s = (char *) safemalloc((size_t) L_ctermid);
1957 #endif
1958         RETVAL = ctermid(s);
1959     OUTPUT:
1960         RETVAL
1961     CLEANUP:
1962 #ifdef HAS_CTERMID_R
1963         Safefree(s);
1964 #endif
1965
1966 char *
1967 cuserid(s = 0)
1968         char *          s = 0;
1969     CODE:
1970 #ifdef HAS_CUSERID
1971   RETVAL = cuserid(s);
1972 #else
1973   RETVAL = 0;
1974   not_here("cuserid");
1975 #endif
1976     OUTPUT:
1977   RETVAL
1978
1979 SysRetLong
1980 fpathconf(fd, name)
1981         int             fd
1982         int             name
1983
1984 SysRetLong
1985 pathconf(filename, name)
1986         char *          filename
1987         int             name
1988
1989 SysRet
1990 pause()
1991
1992 SysRet
1993 setgid(gid)
1994         Gid_t           gid
1995     CLEANUP:
1996 #ifndef WIN32
1997         if (RETVAL >= 0) {
1998             PL_gid  = getgid();
1999             PL_egid = getegid();
2000         }
2001 #endif
2002
2003 SysRet
2004 setuid(uid)
2005         Uid_t           uid
2006     CLEANUP:
2007 #ifndef WIN32
2008         if (RETVAL >= 0) {
2009             PL_uid  = getuid();
2010             PL_euid = geteuid();
2011         }
2012 #endif
2013
2014 SysRetLong
2015 sysconf(name)
2016         int             name
2017
2018 char *
2019 ttyname(fd)
2020         int             fd
2021
2022 void
2023 getcwd()
2024     PPCODE:
2025       {
2026         dXSTARG;
2027         getcwd_sv(TARG);
2028         XSprePUSH; PUSHTARG;
2029       }
2030
2031 SysRet
2032 lchown(uid, gid, path)
2033        Uid_t           uid
2034        Gid_t           gid
2035        char *          path
2036     CODE:
2037 #ifdef HAS_LCHOWN
2038        /* yes, the order of arguments is different,
2039         * but consistent with CORE::chown() */
2040        RETVAL = lchown(path, uid, gid);
2041 #else
2042        RETVAL = not_here("lchown");
2043 #endif
2044     OUTPUT:
2045        RETVAL