ext/POSIX/POSIX.xs

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