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