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