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