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