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