1 /* 2 * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the 3 * contents of POSIX.xs. Do not edit this file, edit POSIX.xs instead. 4 * 5 * ANY CHANGES MADE HERE WILL BE LOST! 6 * 7 */ 8 9 #line 1 "POSIX.xs" 10 #define PERL_EXT_POSIX 11 12 #ifdef NETWARE 13 #define _POSIX_ 14 /* 15 * Ideally this should be somewhere down in the includes 16 * but putting it in other places is giving compiler errors. 17 * Also here I am unable to check for HAS_UNAME since it wouldn't have 18 * yet come into the file at this stage - sgp 18th Oct 2000 19 */ 20 #include 21 #endif /* NETWARE */ 22 23 #define PERL_NO_GET_CONTEXT 24 25 #include "EXTERN.h" 26 #define PERLIO_NOT_STDIO 1 27 #include "perl.h" 28 #include "XSUB.h" 29 #if defined(PERL_IMPLICIT_SYS) 30 # undef signal 31 # undef open 32 # undef setmode 33 # define open PerlLIO_open3 34 #endif 35 #include 36 #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */ 37 #include 38 #endif 39 #include 40 #ifdef I_FLOAT 41 #include 42 #endif 43 #ifdef I_LIMITS 44 #include 45 #endif 46 #include 47 #include 48 #ifdef I_PWD 49 #include 50 #endif 51 #include 52 #include 53 #include 54 55 #ifdef I_STDDEF 56 #include 57 #endif 58 59 #ifdef I_UNISTD 60 #include 61 #endif 62 63 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to 64 metaconfig for future extension writers. We don't use them in POSIX. 65 (This is really sneaky :-) --AD 66 */ 67 #if defined(I_TERMIOS) 68 #include 69 #endif 70 #ifdef I_STDLIB 71 #include 72 #endif 73 #ifndef __ultrix__ 74 #include 75 #endif 76 #include 77 #include 78 #include 79 #ifdef I_UNISTD 80 #include 81 #endif 82 #ifdef MACOS_TRADITIONAL 83 #undef fdopen 84 #endif 85 #include 86 87 #ifdef HAS_TZNAME 88 # if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__) 89 extern char *tzname[]; 90 # endif 91 #else 92 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname)) 93 char *tzname[] = { "" , "" }; 94 #endif 95 #endif 96 97 #ifndef PERL_UNUSED_DECL 98 # ifdef HASATTRIBUTE 99 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) 100 # define PERL_UNUSED_DECL 101 # else 102 # define PERL_UNUSED_DECL __attribute__((unused)) 103 # endif 104 # else 105 # define PERL_UNUSED_DECL 106 # endif 107 #endif 108 109 #ifndef dNOOP 110 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL 111 #endif 112 113 #ifndef dVAR 114 #define dVAR dNOOP 115 #endif 116 117 #if defined(__VMS) && !defined(__POSIX_SOURCE) 118 # include /* LIB$_INVARG constant */ 119 # include /* prototype for lib$ediv() */ 120 # include /* prototype for sys$gettim() */ 121 # if DECC_VERSION < 50000000 122 # define pid_t int /* old versions of DECC miss this in types.h */ 123 # endif 124 125 # undef mkfifo 126 # define mkfifo(a,b) (not_here("mkfifo"),-1) 127 # define tzset() not_here("tzset") 128 129 #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) 130 # define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */ 131 # include 132 # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */ 133 134 /* The POSIX notion of ttyname() is better served by getname() under VMS */ 135 static char ttnambuf[64]; 136 # define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL) 137 138 /* The non-POSIX CRTL times() has void return type, so we just get the 139 current time directly */ 140 clock_t vms_times(struct tms *bufptr) { 141 dTHX; 142 clock_t retval; 143 /* Get wall time and convert to 10 ms intervals to 144 * produce the return value that the POSIX standard expects */ 145 # if defined(__DECC) && defined (__ALPHA) 146 # include 147 uint64 vmstime; 148 _ckvmssts(sys$gettim(&vmstime)); 149 vmstime /= 100000; 150 retval = vmstime & 0x7fffffff; 151 # else 152 /* (Older hw or ccs don't have an atomic 64-bit type, so we 153 * juggle 32-bit ints (and a float) to produce a time_t result 154 * with minimal loss of information.) */ 155 long int vmstime[2],remainder,divisor = 100000; 156 _ckvmssts(sys$gettim((unsigned long int *)vmstime)); 157 vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */ 158 _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder)); 159 # endif 160 /* Fill in the struct tms using the CRTL routine . . .*/ 161 times((tbuffer_t *)bufptr); 162 return (clock_t) retval; 163 } 164 # define times(t) vms_times(t) 165 #else 166 #if defined (__CYGWIN__) 167 # define tzname _tzname 168 #endif 169 #if defined (WIN32) || defined (NETWARE) 170 # undef mkfifo 171 # define mkfifo(a,b) not_here("mkfifo") 172 # define ttyname(a) (char*)not_here("ttyname") 173 # define sigset_t long 174 # define pid_t long 175 # ifdef __BORLANDC__ 176 # define tzname _tzname 177 # endif 178 # ifdef _MSC_VER 179 # define mode_t short 180 # endif 181 # ifdef __MINGW32__ 182 # define mode_t short 183 # ifndef tzset 184 # define tzset() not_here("tzset") 185 # endif 186 # ifndef _POSIX_OPEN_MAX 187 # define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */ 188 # endif 189 # endif 190 # define sigaction(a,b,c) not_here("sigaction") 191 # define sigpending(a) not_here("sigpending") 192 # define sigprocmask(a,b,c) not_here("sigprocmask") 193 # define sigsuspend(a) not_here("sigsuspend") 194 # define sigemptyset(a) not_here("sigemptyset") 195 # define sigaddset(a,b) not_here("sigaddset") 196 # define sigdelset(a,b) not_here("sigdelset") 197 # define sigfillset(a) not_here("sigfillset") 198 # define sigismember(a,b) not_here("sigismember") 199 #ifndef NETWARE 200 # undef setuid 201 # undef setgid 202 # define setuid(a) not_here("setuid") 203 # define setgid(a) not_here("setgid") 204 #endif /* NETWARE */ 205 #else 206 207 # ifndef HAS_MKFIFO 208 # if defined(OS2) || defined(MACOS_TRADITIONAL) 209 # define mkfifo(a,b) not_here("mkfifo") 210 # else /* !( defined OS2 ) */ 211 # ifndef mkfifo 212 # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0)) 213 # endif 214 # endif 215 # endif /* !HAS_MKFIFO */ 216 217 # ifdef MACOS_TRADITIONAL 218 # define ttyname(a) (char*)not_here("ttyname") 219 # define tzset() not_here("tzset") 220 # else 221 # ifdef I_GRP 222 # include 223 # endif 224 # include 225 # ifdef HAS_UNAME 226 # include 227 # endif 228 # include 229 # endif 230 # ifdef I_UTIME 231 # include 232 # endif 233 #endif /* WIN32 || NETWARE */ 234 #endif /* __VMS */ 235 236 typedef int SysRet; 237 typedef long SysRetLong; 238 typedef sigset_t* POSIX__SigSet; 239 typedef HV* POSIX__SigAction; 240 #ifdef I_TERMIOS 241 typedef struct termios* POSIX__Termios; 242 #else /* Define termios types to int, and call not_here for the functions.*/ 243 #define POSIX__Termios int 244 #define speed_t int 245 #define tcflag_t int 246 #define cc_t int 247 #define cfgetispeed(x) not_here("cfgetispeed") 248 #define cfgetospeed(x) not_here("cfgetospeed") 249 #define tcdrain(x) not_here("tcdrain") 250 #define tcflush(x,y) not_here("tcflush") 251 #define tcsendbreak(x,y) not_here("tcsendbreak") 252 #define cfsetispeed(x,y) not_here("cfsetispeed") 253 #define cfsetospeed(x,y) not_here("cfsetospeed") 254 #define ctermid(x) (char *) not_here("ctermid") 255 #define tcflow(x,y) not_here("tcflow") 256 #define tcgetattr(x,y) not_here("tcgetattr") 257 #define tcsetattr(x,y,z) not_here("tcsetattr") 258 #endif 259 260 /* Possibly needed prototypes */ 261 char *cuserid (char *); 262 #ifndef WIN32 263 double strtod (const char *, char **); 264 long strtol (const char *, char **, int); 265 unsigned long strtoul (const char *, char **, int); 266 #endif 267 268 #ifndef HAS_CUSERID 269 #define cuserid(a) (char *) not_here("cuserid") 270 #endif 271 #ifndef HAS_DIFFTIME 272 #ifndef difftime 273 #define difftime(a,b) not_here("difftime") 274 #endif 275 #endif 276 #ifndef HAS_FPATHCONF 277 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf") 278 #endif 279 #ifndef HAS_MKTIME 280 #define mktime(a) not_here("mktime") 281 #endif 282 #ifndef HAS_NICE 283 #define nice(a) not_here("nice") 284 #endif 285 #ifndef HAS_PATHCONF 286 #define pathconf(f,n) (SysRetLong) not_here("pathconf") 287 #endif 288 #ifndef HAS_SYSCONF 289 #define sysconf(n) (SysRetLong) not_here("sysconf") 290 #endif 291 #ifndef HAS_READLINK 292 #define readlink(a,b,c) not_here("readlink") 293 #endif 294 #ifndef HAS_SETPGID 295 #define setpgid(a,b) not_here("setpgid") 296 #endif 297 #ifndef HAS_SETSID 298 #define setsid() not_here("setsid") 299 #endif 300 #ifndef HAS_STRCOLL 301 #define strcoll(s1,s2) not_here("strcoll") 302 #endif 303 #ifndef HAS_STRTOD 304 #define strtod(s1,s2) not_here("strtod") 305 #endif 306 #ifndef HAS_STRTOL 307 #define strtol(s1,s2,b) not_here("strtol") 308 #endif 309 #ifndef HAS_STRTOUL 310 #define strtoul(s1,s2,b) not_here("strtoul") 311 #endif 312 #ifndef HAS_STRXFRM 313 #define strxfrm(s1,s2,n) not_here("strxfrm") 314 #endif 315 #ifndef HAS_TCGETPGRP 316 #define tcgetpgrp(a) not_here("tcgetpgrp") 317 #endif 318 #ifndef HAS_TCSETPGRP 319 #define tcsetpgrp(a,b) not_here("tcsetpgrp") 320 #endif 321 #ifndef HAS_TIMES 322 #ifndef NETWARE 323 #define times(a) not_here("times") 324 #endif /* NETWARE */ 325 #endif 326 #ifndef HAS_UNAME 327 #define uname(a) not_here("uname") 328 #endif 329 #ifndef HAS_WAITPID 330 #define waitpid(a,b,c) not_here("waitpid") 331 #endif 332 333 #ifndef HAS_MBLEN 334 #ifndef mblen 335 #define mblen(a,b) not_here("mblen") 336 #endif 337 #endif 338 #ifndef HAS_MBSTOWCS 339 #define mbstowcs(s, pwcs, n) not_here("mbstowcs") 340 #endif 341 #ifndef HAS_MBTOWC 342 #define mbtowc(pwc, s, n) not_here("mbtowc") 343 #endif 344 #ifndef HAS_WCSTOMBS 345 #define wcstombs(s, pwcs, n) not_here("wcstombs") 346 #endif 347 #ifndef HAS_WCTOMB 348 #define wctomb(s, wchar) not_here("wcstombs") 349 #endif 350 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB) 351 /* If we don't have these functions, then we wouldn't have gotten a typedef 352 for wchar_t, the wide character type. Defining wchar_t allows the 353 functions referencing it to compile. Its actual type is then meaningless, 354 since without the above functions, all sections using it end up calling 355 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */ 356 #ifndef wchar_t 357 #define wchar_t char 358 #endif 359 #endif 360 361 #ifndef HAS_LOCALECONV 362 #define localeconv() not_here("localeconv") 363 #endif 364 365 #ifdef HAS_LONG_DOUBLE 366 # if LONG_DOUBLESIZE > NVSIZE 367 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */ 368 # endif 369 #endif 370 371 #ifndef HAS_LONG_DOUBLE 372 #ifdef LDBL_MAX 373 #undef LDBL_MAX 374 #endif 375 #ifdef LDBL_MIN 376 #undef LDBL_MIN 377 #endif 378 #ifdef LDBL_EPSILON 379 #undef LDBL_EPSILON 380 #endif 381 #endif 382 383 /* Background: in most systems the low byte of the wait status 384 * is the signal (the lowest 7 bits) and the coredump flag is 385 * the eight bit, and the second lowest byte is the exit status. 386 * BeOS bucks the trend and has the bytes in different order. 387 * See beos/beos.c for how the reality is bent even in BeOS 388 * to follow the traditional. However, to make the POSIX 389 * wait W*() macros to work in BeOS, we need to unbend the 390 * reality back in place. --jhi */ 391 #ifdef __BEOS__ 392 # define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8) 393 #else 394 # define WMUNGE(x) (x) 395 #endif 396 397 static int 398 not_here(char *s) 399 { 400 croak("POSIX::%s not implemented on this architecture", s); 401 return -1; 402 } 403 404 #include "const-c.inc" 405 406 /* These were implemented in the old "constant" subroutine. They are actually 407 macros that take an integer argument and return an integer result. */ 408 static int 409 int_macro_int (const char *name, STRLEN len, IV *arg_result) { 410 /* Initially switch on the length of the name. */ 411 /* This code has been edited from a "constant" function generated by: 412 413 use ExtUtils::Constant qw (constant_types C_constant XS_constant); 414 415 my $types = {map {($_, 1)} qw(IV)}; 416 my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED 417 WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG)); 418 419 print constant_types(); # macro defs 420 foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) { 421 print $_, "\n"; # C constant subs 422 } 423 print "#### XS Section:\n"; 424 print XS_constant ("POSIX", $types); 425 */ 426 427 switch (len) { 428 case 7: 429 /* Names all of length 7. */ 430 /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */ 431 /* Offset 5 gives the best switch position. */ 432 switch (name[5]) { 433 case 'E': 434 if (memEQ(name, "S_ISREG", 7)) { 435 /* ^ */ 436 #ifdef S_ISREG 437 *arg_result = S_ISREG(*arg_result); 438 return PERL_constant_ISIV; 439 #else 440 return PERL_constant_NOTDEF; 441 #endif 442 } 443 break; 444 case 'H': 445 if (memEQ(name, "S_ISCHR", 7)) { 446 /* ^ */ 447 #ifdef S_ISCHR 448 *arg_result = S_ISCHR(*arg_result); 449 return PERL_constant_ISIV; 450 #else 451 return PERL_constant_NOTDEF; 452 #endif 453 } 454 break; 455 case 'I': 456 if (memEQ(name, "S_ISDIR", 7)) { 457 /* ^ */ 458 #ifdef S_ISDIR 459 *arg_result = S_ISDIR(*arg_result); 460 return PERL_constant_ISIV; 461 #else 462 return PERL_constant_NOTDEF; 463 #endif 464 } 465 break; 466 case 'L': 467 if (memEQ(name, "S_ISBLK", 7)) { 468 /* ^ */ 469 #ifdef S_ISBLK 470 *arg_result = S_ISBLK(*arg_result); 471 return PERL_constant_ISIV; 472 #else 473 return PERL_constant_NOTDEF; 474 #endif 475 } 476 break; 477 } 478 break; 479 case 8: 480 /* Names all of length 8. */ 481 /* S_ISFIFO WSTOPSIG WTERMSIG */ 482 /* Offset 3 gives the best switch position. */ 483 switch (name[3]) { 484 case 'O': 485 if (memEQ(name, "WSTOPSIG", 8)) { 486 /* ^ */ 487 #ifdef WSTOPSIG 488 int i = *arg_result; 489 *arg_result = WSTOPSIG(WMUNGE(i)); 490 return PERL_constant_ISIV; 491 #else 492 return PERL_constant_NOTDEF; 493 #endif 494 } 495 break; 496 case 'R': 497 if (memEQ(name, "WTERMSIG", 8)) { 498 /* ^ */ 499 #ifdef WTERMSIG 500 int i = *arg_result; 501 *arg_result = WTERMSIG(WMUNGE(i)); 502 return PERL_constant_ISIV; 503 #else 504 return PERL_constant_NOTDEF; 505 #endif 506 } 507 break; 508 case 'S': 509 if (memEQ(name, "S_ISFIFO", 8)) { 510 /* ^ */ 511 #ifdef S_ISFIFO 512 *arg_result = S_ISFIFO(*arg_result); 513 return PERL_constant_ISIV; 514 #else 515 return PERL_constant_NOTDEF; 516 #endif 517 } 518 break; 519 } 520 break; 521 case 9: 522 if (memEQ(name, "WIFEXITED", 9)) { 523 #ifdef WIFEXITED 524 int i = *arg_result; 525 *arg_result = WIFEXITED(WMUNGE(i)); 526 return PERL_constant_ISIV; 527 #else 528 return PERL_constant_NOTDEF; 529 #endif 530 } 531 break; 532 case 10: 533 if (memEQ(name, "WIFSTOPPED", 10)) { 534 #ifdef WIFSTOPPED 535 int i = *arg_result; 536 *arg_result = WIFSTOPPED(WMUNGE(i)); 537 return PERL_constant_ISIV; 538 #else 539 return PERL_constant_NOTDEF; 540 #endif 541 } 542 break; 543 case 11: 544 /* Names all of length 11. */ 545 /* WEXITSTATUS WIFSIGNALED */ 546 /* Offset 1 gives the best switch position. */ 547 switch (name[1]) { 548 case 'E': 549 if (memEQ(name, "WEXITSTATUS", 11)) { 550 /* ^ */ 551 #ifdef WEXITSTATUS 552 int i = *arg_result; 553 *arg_result = WEXITSTATUS(WMUNGE(i)); 554 return PERL_constant_ISIV; 555 #else 556 return PERL_constant_NOTDEF; 557 #endif 558 } 559 break; 560 case 'I': 561 if (memEQ(name, "WIFSIGNALED", 11)) { 562 /* ^ */ 563 #ifdef WIFSIGNALED 564 int i = *arg_result; 565 *arg_result = WIFSIGNALED(WMUNGE(i)); 566 return PERL_constant_ISIV; 567 #else 568 return PERL_constant_NOTDEF; 569 #endif 570 } 571 break; 572 } 573 break; 574 } 575 return PERL_constant_NOTFOUND; 576 } 577 578 static void 579 restore_sigmask(pTHX_ SV *osset_sv) 580 { 581 /* Fortunately, restoring the signal mask can't fail, because 582 * there's nothing we can do about it if it does -- we're not 583 * supposed to return -1 from sigaction unless the disposition 584 * was unaffected. 585 */ 586 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv ); 587 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0); 588 } 589 590 #ifndef PERL_UNUSED_VAR 591 # define PERL_UNUSED_VAR(var) if (0) var = var 592 #endif 593 594 #line 595 "POSIX.c" 595 596 XS(XS_POSIX__SigSet_new); /* prototype to pass -Wmissing-prototypes */ 597 XS(XS_POSIX__SigSet_new) 598 2 { 599 2 dXSARGS; 600 2 PERL_UNUSED_VAR(cv); /* -W */ 601 { 602 2 char * packname; 603 2 POSIX__SigSet RETVAL; 604 605 2 if (items < 1) 606 ###### packname = "POSIX::SigSet"; 607 else { 608 2 packname = (char *)SvPV_nolen(ST(0)); 609 } 610 #line 587 "POSIX.xs" 611 { 612 int i; 613 New(0, RETVAL, 1, sigset_t); 614 sigemptyset(RETVAL); 615 for (i = 1; i < items; i++) 616 sigaddset(RETVAL, SvIV(ST(i))); 617 } 618 #line 619 "POSIX.c" 619 2 ST(0) = sv_newmortal(); 620 2 sv_setref_pv(ST(0), "POSIX::SigSet", (void*)RETVAL); 621 } 622 2 XSRETURN(1); 623 } 624 625 626 XS(XS_POSIX__SigSet_DESTROY); /* prototype to pass -Wmissing-prototypes */ 627 XS(XS_POSIX__SigSet_DESTROY) 628 3 { 629 3 dXSARGS; 630 3 if (items != 1) 631 ###### Perl_croak(aTHX_ "Usage: POSIX::SigSet::DESTROY(sigset)"); 632 3 PERL_UNUSED_VAR(cv); /* -W */ 633 { 634 3 POSIX__SigSet sigset; 635 636 3 if (SvROK(ST(0))) { 637 3 IV tmp = SvIV((SV*)SvRV(ST(0))); 638 3 sigset = INT2PTR(POSIX__SigSet,tmp); 639 } 640 else 641 ###### Perl_croak(aTHX_ "sigset is not a reference"); 642 #line 601 "POSIX.xs" 643 Safefree(sigset); 644 #line 645 "POSIX.c" 645 } 646 3 XSRETURN_EMPTY; 647 } 648 649 650 XS(XS_POSIX__SigSet_addset); /* prototype to pass -Wmissing-prototypes */ 651 XS(XS_POSIX__SigSet_addset) 652 ###### { 653 ###### dXSARGS; 654 ###### if (items != 2) 655 ###### Perl_croak(aTHX_ "Usage: POSIX::SigSet::addset(sigset, sig)"); 656 ###### PERL_UNUSED_VAR(cv); /* -W */ 657 { 658 ###### POSIX__SigSet sigset; 659 ###### int sig = (int)SvIV(ST(1)); 660 ###### SysRet RETVAL; 661 662 ###### if (sv_derived_from(ST(0), "POSIX::SigSet")) { 663 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 664 ###### sigset = INT2PTR(POSIX__SigSet,tmp); 665 } 666 else 667 ###### Perl_croak(aTHX_ "sigset is not of type POSIX::SigSet"); 668 669 ###### RETVAL = sigaddset(sigset, sig); 670 ###### ST(0) = sv_newmortal(); 671 ###### if (RETVAL != -1) { 672 ###### if (RETVAL == 0) 673 ###### sv_setpvn(ST(0), "0 but true", 10); 674 else 675 ###### sv_setiv(ST(0), (IV)RETVAL); 676 } 677 } 678 ###### XSRETURN(1); 679 } 680 681 682 XS(XS_POSIX__SigSet_delset); /* prototype to pass -Wmissing-prototypes */ 683 XS(XS_POSIX__SigSet_delset) 684 ###### { 685 ###### dXSARGS; 686 ###### if (items != 2) 687 ###### Perl_croak(aTHX_ "Usage: POSIX::SigSet::delset(sigset, sig)"); 688 ###### PERL_UNUSED_VAR(cv); /* -W */ 689 { 690 ###### POSIX__SigSet sigset; 691 ###### int sig = (int)SvIV(ST(1)); 692 ###### SysRet RETVAL; 693 694 ###### if (sv_derived_from(ST(0), "POSIX::SigSet")) { 695 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 696 ###### sigset = INT2PTR(POSIX__SigSet,tmp); 697 } 698 else 699 ###### Perl_croak(aTHX_ "sigset is not of type POSIX::SigSet"); 700 701 ###### RETVAL = sigdelset(sigset, sig); 702 ###### ST(0) = sv_newmortal(); 703 ###### if (RETVAL != -1) { 704 ###### if (RETVAL == 0) 705 ###### sv_setpvn(ST(0), "0 but true", 10); 706 else 707 ###### sv_setiv(ST(0), (IV)RETVAL); 708 } 709 } 710 ###### XSRETURN(1); 711 } 712 713 714 XS(XS_POSIX__SigSet_emptyset); /* prototype to pass -Wmissing-prototypes */ 715 XS(XS_POSIX__SigSet_emptyset) 716 ###### { 717 ###### dXSARGS; 718 ###### if (items != 1) 719 ###### Perl_croak(aTHX_ "Usage: POSIX::SigSet::emptyset(sigset)"); 720 ###### PERL_UNUSED_VAR(cv); /* -W */ 721 { 722 ###### POSIX__SigSet sigset; 723 ###### SysRet RETVAL; 724 725 ###### if (sv_derived_from(ST(0), "POSIX::SigSet")) { 726 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 727 ###### sigset = INT2PTR(POSIX__SigSet,tmp); 728 } 729 else 730 ###### Perl_croak(aTHX_ "sigset is not of type POSIX::SigSet"); 731 732 ###### RETVAL = sigemptyset(sigset); 733 ###### ST(0) = sv_newmortal(); 734 ###### if (RETVAL != -1) { 735 ###### if (RETVAL == 0) 736 ###### sv_setpvn(ST(0), "0 but true", 10); 737 else 738 ###### sv_setiv(ST(0), (IV)RETVAL); 739 } 740 } 741 ###### XSRETURN(1); 742 } 743 744 745 XS(XS_POSIX__SigSet_fillset); /* prototype to pass -Wmissing-prototypes */ 746 XS(XS_POSIX__SigSet_fillset) 747 ###### { 748 ###### dXSARGS; 749 ###### if (items != 1) 750 ###### Perl_croak(aTHX_ "Usage: POSIX::SigSet::fillset(sigset)"); 751 ###### PERL_UNUSED_VAR(cv); /* -W */ 752 { 753 ###### POSIX__SigSet sigset; 754 ###### SysRet RETVAL; 755 756 ###### if (sv_derived_from(ST(0), "POSIX::SigSet")) { 757 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 758 ###### sigset = INT2PTR(POSIX__SigSet,tmp); 759 } 760 else 761 ###### Perl_croak(aTHX_ "sigset is not of type POSIX::SigSet"); 762 763 ###### RETVAL = sigfillset(sigset); 764 ###### ST(0) = sv_newmortal(); 765 ###### if (RETVAL != -1) { 766 ###### if (RETVAL == 0) 767 ###### sv_setpvn(ST(0), "0 but true", 10); 768 else 769 ###### sv_setiv(ST(0), (IV)RETVAL); 770 } 771 } 772 ###### XSRETURN(1); 773 } 774 775 776 XS(XS_POSIX__SigSet_ismember); /* prototype to pass -Wmissing-prototypes */ 777 XS(XS_POSIX__SigSet_ismember) 778 1 { 779 1 dXSARGS; 780 1 if (items != 2) 781 ###### Perl_croak(aTHX_ "Usage: POSIX::SigSet::ismember(sigset, sig)"); 782 1 PERL_UNUSED_VAR(cv); /* -W */ 783 { 784 1 POSIX__SigSet sigset; 785 1 int sig = (int)SvIV(ST(1)); 786 1 int RETVAL; 787 1 dXSTARG; 788 789 1 if (sv_derived_from(ST(0), "POSIX::SigSet")) { 790 1 IV tmp = SvIV((SV*)SvRV(ST(0))); 791 1 sigset = INT2PTR(POSIX__SigSet,tmp); 792 } 793 else 794 ###### Perl_croak(aTHX_ "sigset is not of type POSIX::SigSet"); 795 796 1 RETVAL = sigismember(sigset, sig); 797 1 XSprePUSH; PUSHi((IV)RETVAL); 798 } 799 1 XSRETURN(1); 800 } 801 802 803 XS(XS_POSIX__Termios_new); /* prototype to pass -Wmissing-prototypes */ 804 XS(XS_POSIX__Termios_new) 805 1 { 806 1 dXSARGS; 807 1 PERL_UNUSED_VAR(cv); /* -W */ 808 { 809 1 char * packname; 810 1 POSIX__Termios RETVAL; 811 812 1 if (items < 1) 813 ###### packname = "POSIX::Termios"; 814 else { 815 1 packname = (char *)SvPV_nolen(ST(0)); 816 } 817 #line 632 "POSIX.xs" 818 { 819 #ifdef I_TERMIOS 820 New(0, RETVAL, 1, struct termios); 821 #else 822 not_here("termios"); 823 RETVAL = 0; 824 #endif 825 } 826 #line 827 "POSIX.c" 827 1 ST(0) = sv_newmortal(); 828 1 sv_setref_pv(ST(0), "POSIX::Termios", (void*)RETVAL); 829 } 830 1 XSRETURN(1); 831 } 832 833 834 XS(XS_POSIX__Termios_DESTROY); /* prototype to pass -Wmissing-prototypes */ 835 XS(XS_POSIX__Termios_DESTROY) 836 1 { 837 1 dXSARGS; 838 1 if (items != 1) 839 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::DESTROY(termios_ref)"); 840 1 PERL_UNUSED_VAR(cv); /* -W */ 841 { 842 1 POSIX__Termios termios_ref; 843 844 1 if (SvROK(ST(0))) { 845 1 IV tmp = SvIV((SV*)SvRV(ST(0))); 846 1 termios_ref = INT2PTR(POSIX__Termios,tmp); 847 } 848 else 849 ###### Perl_croak(aTHX_ "termios_ref is not a reference"); 850 #line 647 "POSIX.xs" 851 #ifdef I_TERMIOS 852 Safefree(termios_ref); 853 #else 854 not_here("termios"); 855 #endif 856 #line 857 "POSIX.c" 857 } 858 1 XSRETURN_EMPTY; 859 } 860 861 862 XS(XS_POSIX__Termios_getattr); /* prototype to pass -Wmissing-prototypes */ 863 XS(XS_POSIX__Termios_getattr) 864 1 { 865 1 dXSARGS; 866 1 if (items < 1 || items > 2) 867 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::getattr(termios_ref, fd = 0)"); 868 1 PERL_UNUSED_VAR(cv); /* -W */ 869 { 870 1 POSIX__Termios termios_ref; 871 1 int fd; 872 1 SysRet RETVAL; 873 874 1 if (sv_derived_from(ST(0), "POSIX::Termios")) { 875 1 IV tmp = SvIV((SV*)SvRV(ST(0))); 876 1 termios_ref = INT2PTR(POSIX__Termios,tmp); 877 } 878 else 879 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 880 881 1 if (items < 2) 882 1 fd = 0; 883 else { 884 ###### fd = (int)SvIV(ST(1)); 885 } 886 #line 658 "POSIX.xs" 887 RETVAL = tcgetattr(fd, termios_ref); 888 #line 889 "POSIX.c" 889 1 ST(0) = sv_newmortal(); 890 1 if (RETVAL != -1) { 891 1 if (RETVAL == 0) 892 1 sv_setpvn(ST(0), "0 but true", 10); 893 else 894 ###### sv_setiv(ST(0), (IV)RETVAL); 895 } 896 } 897 1 XSRETURN(1); 898 } 899 900 901 XS(XS_POSIX__Termios_setattr); /* prototype to pass -Wmissing-prototypes */ 902 XS(XS_POSIX__Termios_setattr) 903 ###### { 904 ###### dXSARGS; 905 ###### if (items < 1 || items > 3) 906 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::setattr(termios_ref, fd = 0, optional_actions = 0)"); 907 ###### PERL_UNUSED_VAR(cv); /* -W */ 908 { 909 ###### POSIX__Termios termios_ref; 910 ###### int fd; 911 ###### int optional_actions; 912 ###### SysRet RETVAL; 913 914 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 915 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 916 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 917 } 918 else 919 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 920 921 ###### if (items < 2) 922 ###### fd = 0; 923 else { 924 ###### fd = (int)SvIV(ST(1)); 925 } 926 927 ###### if (items < 3) 928 ###### optional_actions = 0; 929 else { 930 ###### optional_actions = (int)SvIV(ST(2)); 931 } 932 #line 668 "POSIX.xs" 933 RETVAL = tcsetattr(fd, optional_actions, termios_ref); 934 #line 935 "POSIX.c" 935 ###### ST(0) = sv_newmortal(); 936 ###### if (RETVAL != -1) { 937 ###### if (RETVAL == 0) 938 ###### sv_setpvn(ST(0), "0 but true", 10); 939 else 940 ###### sv_setiv(ST(0), (IV)RETVAL); 941 } 942 } 943 ###### XSRETURN(1); 944 } 945 946 947 XS(XS_POSIX__Termios_getispeed); /* prototype to pass -Wmissing-prototypes */ 948 XS(XS_POSIX__Termios_getispeed) 949 ###### { 950 ###### dXSARGS; 951 ###### if (items != 1) 952 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::getispeed(termios_ref)"); 953 ###### PERL_UNUSED_VAR(cv); /* -W */ 954 { 955 ###### POSIX__Termios termios_ref; 956 ###### speed_t RETVAL; 957 ###### dXSTARG; 958 959 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 960 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 961 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 962 } 963 else 964 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 965 966 ###### RETVAL = cfgetispeed(termios_ref); 967 ###### XSprePUSH; PUSHi((IV)RETVAL); 968 } 969 ###### XSRETURN(1); 970 } 971 972 973 XS(XS_POSIX__Termios_getospeed); /* prototype to pass -Wmissing-prototypes */ 974 XS(XS_POSIX__Termios_getospeed) 975 1 { 976 1 dXSARGS; 977 1 if (items != 1) 978 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::getospeed(termios_ref)"); 979 1 PERL_UNUSED_VAR(cv); /* -W */ 980 { 981 1 POSIX__Termios termios_ref; 982 1 speed_t RETVAL; 983 1 dXSTARG; 984 985 1 if (sv_derived_from(ST(0), "POSIX::Termios")) { 986 1 IV tmp = SvIV((SV*)SvRV(ST(0))); 987 1 termios_ref = INT2PTR(POSIX__Termios,tmp); 988 } 989 else 990 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 991 992 1 RETVAL = cfgetospeed(termios_ref); 993 1 XSprePUSH; PUSHi((IV)RETVAL); 994 } 995 1 XSRETURN(1); 996 } 997 998 999 XS(XS_POSIX__Termios_getiflag); /* prototype to pass -Wmissing-prototypes */ 1000 XS(XS_POSIX__Termios_getiflag) 1001 ###### { 1002 ###### dXSARGS; 1003 ###### if (items != 1) 1004 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::getiflag(termios_ref)"); 1005 ###### PERL_UNUSED_VAR(cv); /* -W */ 1006 { 1007 ###### POSIX__Termios termios_ref; 1008 ###### tcflag_t RETVAL; 1009 ###### dXSTARG; 1010 1011 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1012 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1013 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1014 } 1015 else 1016 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1017 #line 684 "POSIX.xs" 1018 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1019 RETVAL = termios_ref->c_iflag; 1020 #else 1021 not_here("getiflag"); 1022 RETVAL = 0; 1023 #endif 1024 #line 1025 "POSIX.c" 1025 ###### XSprePUSH; PUSHi((IV)RETVAL); 1026 } 1027 ###### XSRETURN(1); 1028 } 1029 1030 1031 XS(XS_POSIX__Termios_getoflag); /* prototype to pass -Wmissing-prototypes */ 1032 XS(XS_POSIX__Termios_getoflag) 1033 ###### { 1034 ###### dXSARGS; 1035 ###### if (items != 1) 1036 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::getoflag(termios_ref)"); 1037 ###### PERL_UNUSED_VAR(cv); /* -W */ 1038 { 1039 ###### POSIX__Termios termios_ref; 1040 ###### tcflag_t RETVAL; 1041 ###### dXSTARG; 1042 1043 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1044 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1045 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1046 } 1047 else 1048 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1049 #line 697 "POSIX.xs" 1050 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1051 RETVAL = termios_ref->c_oflag; 1052 #else 1053 not_here("getoflag"); 1054 RETVAL = 0; 1055 #endif 1056 #line 1057 "POSIX.c" 1057 ###### XSprePUSH; PUSHi((IV)RETVAL); 1058 } 1059 ###### XSRETURN(1); 1060 } 1061 1062 1063 XS(XS_POSIX__Termios_getcflag); /* prototype to pass -Wmissing-prototypes */ 1064 XS(XS_POSIX__Termios_getcflag) 1065 ###### { 1066 ###### dXSARGS; 1067 ###### if (items != 1) 1068 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::getcflag(termios_ref)"); 1069 ###### PERL_UNUSED_VAR(cv); /* -W */ 1070 { 1071 ###### POSIX__Termios termios_ref; 1072 ###### tcflag_t RETVAL; 1073 ###### dXSTARG; 1074 1075 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1076 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1077 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1078 } 1079 else 1080 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1081 #line 710 "POSIX.xs" 1082 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1083 RETVAL = termios_ref->c_cflag; 1084 #else 1085 not_here("getcflag"); 1086 RETVAL = 0; 1087 #endif 1088 #line 1089 "POSIX.c" 1089 ###### XSprePUSH; PUSHi((IV)RETVAL); 1090 } 1091 ###### XSRETURN(1); 1092 } 1093 1094 1095 XS(XS_POSIX__Termios_getlflag); /* prototype to pass -Wmissing-prototypes */ 1096 XS(XS_POSIX__Termios_getlflag) 1097 ###### { 1098 ###### dXSARGS; 1099 ###### if (items != 1) 1100 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::getlflag(termios_ref)"); 1101 ###### PERL_UNUSED_VAR(cv); /* -W */ 1102 { 1103 ###### POSIX__Termios termios_ref; 1104 ###### tcflag_t RETVAL; 1105 ###### dXSTARG; 1106 1107 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1108 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1109 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1110 } 1111 else 1112 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1113 #line 723 "POSIX.xs" 1114 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1115 RETVAL = termios_ref->c_lflag; 1116 #else 1117 not_here("getlflag"); 1118 RETVAL = 0; 1119 #endif 1120 #line 1121 "POSIX.c" 1121 ###### XSprePUSH; PUSHi((IV)RETVAL); 1122 } 1123 ###### XSRETURN(1); 1124 } 1125 1126 1127 XS(XS_POSIX__Termios_getcc); /* prototype to pass -Wmissing-prototypes */ 1128 XS(XS_POSIX__Termios_getcc) 1129 ###### { 1130 ###### dXSARGS; 1131 ###### if (items != 2) 1132 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::getcc(termios_ref, ccix)"); 1133 ###### PERL_UNUSED_VAR(cv); /* -W */ 1134 { 1135 ###### POSIX__Termios termios_ref; 1136 ###### int ccix = (int)SvIV(ST(1)); 1137 ###### cc_t RETVAL; 1138 ###### dXSTARG; 1139 1140 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1141 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1142 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1143 } 1144 else 1145 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1146 #line 737 "POSIX.xs" 1147 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1148 if (ccix >= NCCS) 1149 croak("Bad getcc subscript"); 1150 RETVAL = termios_ref->c_cc[ccix]; 1151 #else 1152 not_here("getcc"); 1153 RETVAL = 0; 1154 #endif 1155 #line 1156 "POSIX.c" 1156 ###### XSprePUSH; PUSHi((IV)RETVAL); 1157 } 1158 ###### XSRETURN(1); 1159 } 1160 1161 1162 XS(XS_POSIX__Termios_setispeed); /* prototype to pass -Wmissing-prototypes */ 1163 XS(XS_POSIX__Termios_setispeed) 1164 ###### { 1165 ###### dXSARGS; 1166 ###### if (items != 2) 1167 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::setispeed(termios_ref, speed)"); 1168 ###### PERL_UNUSED_VAR(cv); /* -W */ 1169 { 1170 ###### POSIX__Termios termios_ref; 1171 ###### speed_t speed = (speed_t)SvIV(ST(1)); 1172 ###### SysRet RETVAL; 1173 1174 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1175 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1176 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1177 } 1178 else 1179 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1180 1181 ###### RETVAL = cfsetispeed(termios_ref, speed); 1182 ###### ST(0) = sv_newmortal(); 1183 ###### if (RETVAL != -1) { 1184 ###### if (RETVAL == 0) 1185 ###### sv_setpvn(ST(0), "0 but true", 10); 1186 else 1187 ###### sv_setiv(ST(0), (IV)RETVAL); 1188 } 1189 } 1190 ###### XSRETURN(1); 1191 } 1192 1193 1194 XS(XS_POSIX__Termios_setospeed); /* prototype to pass -Wmissing-prototypes */ 1195 XS(XS_POSIX__Termios_setospeed) 1196 ###### { 1197 ###### dXSARGS; 1198 ###### if (items != 2) 1199 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::setospeed(termios_ref, speed)"); 1200 ###### PERL_UNUSED_VAR(cv); /* -W */ 1201 { 1202 ###### POSIX__Termios termios_ref; 1203 ###### speed_t speed = (speed_t)SvIV(ST(1)); 1204 ###### SysRet RETVAL; 1205 1206 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1207 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1208 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1209 } 1210 else 1211 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1212 1213 ###### RETVAL = cfsetospeed(termios_ref, speed); 1214 ###### ST(0) = sv_newmortal(); 1215 ###### if (RETVAL != -1) { 1216 ###### if (RETVAL == 0) 1217 ###### sv_setpvn(ST(0), "0 but true", 10); 1218 else 1219 ###### sv_setiv(ST(0), (IV)RETVAL); 1220 } 1221 } 1222 ###### XSRETURN(1); 1223 } 1224 1225 1226 XS(XS_POSIX__Termios_setiflag); /* prototype to pass -Wmissing-prototypes */ 1227 XS(XS_POSIX__Termios_setiflag) 1228 ###### { 1229 ###### dXSARGS; 1230 ###### if (items != 2) 1231 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::setiflag(termios_ref, iflag)"); 1232 ###### PERL_UNUSED_VAR(cv); /* -W */ 1233 { 1234 ###### POSIX__Termios termios_ref; 1235 ###### tcflag_t iflag = (tcflag_t)SvIV(ST(1)); 1236 1237 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1238 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1239 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1240 } 1241 else 1242 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1243 #line 763 "POSIX.xs" 1244 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1245 termios_ref->c_iflag = iflag; 1246 #else 1247 not_here("setiflag"); 1248 #endif 1249 #line 1250 "POSIX.c" 1250 } 1251 ###### XSRETURN_EMPTY; 1252 } 1253 1254 1255 XS(XS_POSIX__Termios_setoflag); /* prototype to pass -Wmissing-prototypes */ 1256 XS(XS_POSIX__Termios_setoflag) 1257 ###### { 1258 ###### dXSARGS; 1259 ###### if (items != 2) 1260 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::setoflag(termios_ref, oflag)"); 1261 ###### PERL_UNUSED_VAR(cv); /* -W */ 1262 { 1263 ###### POSIX__Termios termios_ref; 1264 ###### tcflag_t oflag = (tcflag_t)SvIV(ST(1)); 1265 1266 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1267 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1268 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1269 } 1270 else 1271 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1272 #line 774 "POSIX.xs" 1273 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1274 termios_ref->c_oflag = oflag; 1275 #else 1276 not_here("setoflag"); 1277 #endif 1278 #line 1279 "POSIX.c" 1279 } 1280 ###### XSRETURN_EMPTY; 1281 } 1282 1283 1284 XS(XS_POSIX__Termios_setcflag); /* prototype to pass -Wmissing-prototypes */ 1285 XS(XS_POSIX__Termios_setcflag) 1286 ###### { 1287 ###### dXSARGS; 1288 ###### if (items != 2) 1289 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::setcflag(termios_ref, cflag)"); 1290 ###### PERL_UNUSED_VAR(cv); /* -W */ 1291 { 1292 ###### POSIX__Termios termios_ref; 1293 ###### tcflag_t cflag = (tcflag_t)SvIV(ST(1)); 1294 1295 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1296 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1297 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1298 } 1299 else 1300 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1301 #line 785 "POSIX.xs" 1302 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1303 termios_ref->c_cflag = cflag; 1304 #else 1305 not_here("setcflag"); 1306 #endif 1307 #line 1308 "POSIX.c" 1308 } 1309 ###### XSRETURN_EMPTY; 1310 } 1311 1312 1313 XS(XS_POSIX__Termios_setlflag); /* prototype to pass -Wmissing-prototypes */ 1314 XS(XS_POSIX__Termios_setlflag) 1315 ###### { 1316 ###### dXSARGS; 1317 ###### if (items != 2) 1318 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::setlflag(termios_ref, lflag)"); 1319 ###### PERL_UNUSED_VAR(cv); /* -W */ 1320 { 1321 ###### POSIX__Termios termios_ref; 1322 ###### tcflag_t lflag = (tcflag_t)SvIV(ST(1)); 1323 1324 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1325 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1326 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1327 } 1328 else 1329 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1330 #line 796 "POSIX.xs" 1331 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1332 termios_ref->c_lflag = lflag; 1333 #else 1334 not_here("setlflag"); 1335 #endif 1336 #line 1337 "POSIX.c" 1337 } 1338 ###### XSRETURN_EMPTY; 1339 } 1340 1341 1342 XS(XS_POSIX__Termios_setcc); /* prototype to pass -Wmissing-prototypes */ 1343 XS(XS_POSIX__Termios_setcc) 1344 ###### { 1345 ###### dXSARGS; 1346 ###### if (items != 3) 1347 ###### Perl_croak(aTHX_ "Usage: POSIX::Termios::setcc(termios_ref, ccix, cc)"); 1348 ###### PERL_UNUSED_VAR(cv); /* -W */ 1349 { 1350 ###### POSIX__Termios termios_ref; 1351 ###### int ccix = (int)SvIV(ST(1)); 1352 ###### cc_t cc = (cc_t)SvIV(ST(2)); 1353 1354 ###### if (sv_derived_from(ST(0), "POSIX::Termios")) { 1355 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 1356 ###### termios_ref = INT2PTR(POSIX__Termios,tmp); 1357 } 1358 else 1359 ###### Perl_croak(aTHX_ "termios_ref is not of type POSIX::Termios"); 1360 #line 808 "POSIX.xs" 1361 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ 1362 if (ccix >= NCCS) 1363 croak("Bad setcc subscript"); 1364 termios_ref->c_cc[ccix] = cc; 1365 #else 1366 not_here("setcc"); 1367 #endif 1368 #line 1369 "POSIX.c" 1369 } 1370 ###### XSRETURN_EMPTY; 1371 } 1372 1373 1374 /* INCLUDE: Including 'const-xs.inc' from 'POSIX.xs' */ 1375 1376 1377 XS(XS_POSIX_constant); /* prototype to pass -Wmissing-prototypes */ 1378 XS(XS_POSIX_constant) 1379 75 { 1380 75 dXSARGS; 1381 75 if (items != 1) 1382 ###### Perl_croak(aTHX_ "Usage: POSIX::constant(sv)"); 1383 75 PERL_UNUSED_VAR(cv); /* -W */ 1384 75 PERL_UNUSED_VAR(ax); /* -Wall */ 1385 75 SP -= items; 1386 { 1387 #line 4 "POSIX.xs" 1388 #ifdef dXSTARG 1389 dXSTARG; /* Faster if we have it. */ 1390 #else 1391 dTARGET; 1392 #endif 1393 STRLEN len; 1394 int type; 1395 IV iv; 1396 NV nv; 1397 /* const char *pv; Uncomment this if you need to return PVs */ 1398 #line 1399 "POSIX.c" 1399 75 SV * sv = ST(0); 1400 75 const char * s = SvPV(sv, len); 1401 #line 18 "POSIX.xs" 1402 type = constant(aTHX_ s, len, &iv, &nv); 1403 /* Return 1 or 2 items. First is error message, or undef if no error. 1404 Second, if present, is found value */ 1405 switch (type) { 1406 case PERL_constant_NOTFOUND: 1407 sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s)); 1408 PUSHs(sv); 1409 break; 1410 case PERL_constant_NOTDEF: 1411 sv = sv_2mortal(newSVpvf( 1412 "Your vendor has not defined POSIX macro %s, used", s)); 1413 PUSHs(sv); 1414 break; 1415 case PERL_constant_ISIV: 1416 EXTEND(SP, 1); 1417 PUSHs(&PL_sv_undef); 1418 PUSHi(iv); 1419 break; 1420 /* Uncomment this if you need to return NOs 1421 case PERL_constant_ISNO: 1422 EXTEND(SP, 1); 1423 PUSHs(&PL_sv_undef); 1424 PUSHs(&PL_sv_no); 1425 break; */ 1426 case PERL_constant_ISNV: 1427 EXTEND(SP, 1); 1428 PUSHs(&PL_sv_undef); 1429 PUSHn(nv); 1430 break; 1431 /* Uncomment this if you need to return PVs 1432 case PERL_constant_ISPV: 1433 EXTEND(SP, 1); 1434 PUSHs(&PL_sv_undef); 1435 PUSHp(pv, strlen(pv)); 1436 break; */ 1437 /* Uncomment this if you need to return PVNs 1438 case PERL_constant_ISPVN: 1439 EXTEND(SP, 1); 1440 PUSHs(&PL_sv_undef); 1441 PUSHp(pv, iv); 1442 break; */ 1443 /* Uncomment this if you need to return SVs 1444 case PERL_constant_ISSV: 1445 EXTEND(SP, 1); 1446 PUSHs(&PL_sv_undef); 1447 PUSHs(sv); 1448 break; */ 1449 /* Uncomment this if you need to return UNDEFs 1450 case PERL_constant_ISUNDEF: 1451 break; */ 1452 case PERL_constant_ISUV: 1453 EXTEND(SP, 1); 1454 PUSHs(&PL_sv_undef); 1455 PUSHu((UV)iv); 1456 break; 1457 case PERL_constant_ISYES: 1458 EXTEND(SP, 1); 1459 PUSHs(&PL_sv_undef); 1460 PUSHs(&PL_sv_yes); 1461 break; 1462 default: 1463 sv = sv_2mortal(newSVpvf( 1464 "Unexpected return type %d while processing POSIX macro %s, used", 1465 type, s)); 1466 PUSHs(sv); 1467 } 1468 #line 1469 "POSIX.c" 1469 75 PUTBACK; 1470 return; 1471 } 1472 } 1473 1474 1475 /* INCLUDE: Returning to 'POSIX.xs' from 'const-xs.inc' */ 1476 1477 1478 XS(XS_POSIX_int_macro_int); /* prototype to pass -Wmissing-prototypes */ 1479 XS(XS_POSIX_int_macro_int) 1480 1142 { 1481 1142 dXSARGS; 1482 1142 if (items != 2) 1483 ###### Perl_croak(aTHX_ "Usage: POSIX::int_macro_int(sv, iv)"); 1484 1142 PERL_UNUSED_VAR(cv); /* -W */ 1485 1142 PERL_UNUSED_VAR(ax); /* -Wall */ 1486 1142 SP -= items; 1487 { 1488 #line 824 "POSIX.xs" 1489 dXSTARG; 1490 STRLEN len; 1491 int type; 1492 #line 1493 "POSIX.c" 1493 1142 SV * sv = ST(0); 1494 1142 const char * s = SvPV(sv, len); 1495 1142 IV iv = (IV)SvIV(ST(1)); 1496 #line 832 "POSIX.xs" 1497 /* Change this to int_macro_int(s, len, &iv, &nv); 1498 if you need to return both NVs and IVs */ 1499 type = int_macro_int(s, len, &iv); 1500 /* Return 1 or 2 items. First is error message, or undef if no error. 1501 Second, if present, is found value */ 1502 switch (type) { 1503 case PERL_constant_NOTFOUND: 1504 sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s)); 1505 EXTEND(SP, 1); 1506 PUSHs(&PL_sv_undef); 1507 PUSHs(sv); 1508 break; 1509 case PERL_constant_NOTDEF: 1510 sv = sv_2mortal(newSVpvf( 1511 "Your vendor has not defined POSIX macro %s, used", s)); 1512 EXTEND(SP, 1); 1513 PUSHs(&PL_sv_undef); 1514 PUSHs(sv); 1515 break; 1516 case PERL_constant_ISIV: 1517 PUSHi(iv); 1518 break; 1519 default: 1520 sv = sv_2mortal(newSVpvf( 1521 "Unexpected return type %d while processing POSIX macro %s, used", 1522 type, s)); 1523 EXTEND(SP, 1); 1524 PUSHs(&PL_sv_undef); 1525 PUSHs(sv); 1526 } 1527 #line 1528 "POSIX.c" 1528 1142 PUTBACK; 1529 return; 1530 } 1531 } 1532 1533 1534 XS(XS_POSIX_isalnum); /* prototype to pass -Wmissing-prototypes */ 1535 XS(XS_POSIX_isalnum) 1536 19 { 1537 19 dXSARGS; 1538 19 if (items != 1) 1539 ###### Perl_croak(aTHX_ "Usage: POSIX::isalnum(charstring)"); 1540 19 PERL_UNUSED_VAR(cv); /* -W */ 1541 { 1542 19 SV * charstring = ST(0); 1543 #line 867 "POSIX.xs" 1544 STRLEN len; 1545 #line 1546 "POSIX.c" 1546 19 int RETVAL; 1547 19 dXSTARG; 1548 #line 869 "POSIX.xs" 1549 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1550 unsigned char *e = s + len; 1551 for (RETVAL = 1; RETVAL && s < e; s++) 1552 if (!isalnum(*s)) 1553 RETVAL = 0; 1554 #line 1555 "POSIX.c" 1555 19 XSprePUSH; PUSHi((IV)RETVAL); 1556 } 1557 19 XSRETURN(1); 1558 } 1559 1560 1561 XS(XS_POSIX_isalpha); /* prototype to pass -Wmissing-prototypes */ 1562 XS(XS_POSIX_isalpha) 1563 19 { 1564 19 dXSARGS; 1565 19 if (items != 1) 1566 ###### Perl_croak(aTHX_ "Usage: POSIX::isalpha(charstring)"); 1567 19 PERL_UNUSED_VAR(cv); /* -W */ 1568 { 1569 19 SV * charstring = ST(0); 1570 #line 881 "POSIX.xs" 1571 STRLEN len; 1572 #line 1573 "POSIX.c" 1573 19 int RETVAL; 1574 19 dXSTARG; 1575 #line 883 "POSIX.xs" 1576 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1577 unsigned char *e = s + len; 1578 for (RETVAL = 1; RETVAL && s < e; s++) 1579 if (!isalpha(*s)) 1580 RETVAL = 0; 1581 #line 1582 "POSIX.c" 1582 19 XSprePUSH; PUSHi((IV)RETVAL); 1583 } 1584 19 XSRETURN(1); 1585 } 1586 1587 1588 XS(XS_POSIX_iscntrl); /* prototype to pass -Wmissing-prototypes */ 1589 XS(XS_POSIX_iscntrl) 1590 19 { 1591 19 dXSARGS; 1592 19 if (items != 1) 1593 ###### Perl_croak(aTHX_ "Usage: POSIX::iscntrl(charstring)"); 1594 19 PERL_UNUSED_VAR(cv); /* -W */ 1595 { 1596 19 SV * charstring = ST(0); 1597 #line 895 "POSIX.xs" 1598 STRLEN len; 1599 #line 1600 "POSIX.c" 1600 19 int RETVAL; 1601 19 dXSTARG; 1602 #line 897 "POSIX.xs" 1603 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1604 unsigned char *e = s + len; 1605 for (RETVAL = 1; RETVAL && s < e; s++) 1606 if (!iscntrl(*s)) 1607 RETVAL = 0; 1608 #line 1609 "POSIX.c" 1609 19 XSprePUSH; PUSHi((IV)RETVAL); 1610 } 1611 19 XSRETURN(1); 1612 } 1613 1614 1615 XS(XS_POSIX_isdigit); /* prototype to pass -Wmissing-prototypes */ 1616 XS(XS_POSIX_isdigit) 1617 19 { 1618 19 dXSARGS; 1619 19 if (items != 1) 1620 ###### Perl_croak(aTHX_ "Usage: POSIX::isdigit(charstring)"); 1621 19 PERL_UNUSED_VAR(cv); /* -W */ 1622 { 1623 19 SV * charstring = ST(0); 1624 #line 909 "POSIX.xs" 1625 STRLEN len; 1626 #line 1627 "POSIX.c" 1627 19 int RETVAL; 1628 19 dXSTARG; 1629 #line 911 "POSIX.xs" 1630 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1631 unsigned char *e = s + len; 1632 for (RETVAL = 1; RETVAL && s < e; s++) 1633 if (!isdigit(*s)) 1634 RETVAL = 0; 1635 #line 1636 "POSIX.c" 1636 19 XSprePUSH; PUSHi((IV)RETVAL); 1637 } 1638 19 XSRETURN(1); 1639 } 1640 1641 1642 XS(XS_POSIX_isgraph); /* prototype to pass -Wmissing-prototypes */ 1643 XS(XS_POSIX_isgraph) 1644 19 { 1645 19 dXSARGS; 1646 19 if (items != 1) 1647 ###### Perl_croak(aTHX_ "Usage: POSIX::isgraph(charstring)"); 1648 19 PERL_UNUSED_VAR(cv); /* -W */ 1649 { 1650 19 SV * charstring = ST(0); 1651 #line 923 "POSIX.xs" 1652 STRLEN len; 1653 #line 1654 "POSIX.c" 1654 19 int RETVAL; 1655 19 dXSTARG; 1656 #line 925 "POSIX.xs" 1657 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1658 unsigned char *e = s + len; 1659 for (RETVAL = 1; RETVAL && s < e; s++) 1660 if (!isgraph(*s)) 1661 RETVAL = 0; 1662 #line 1663 "POSIX.c" 1663 19 XSprePUSH; PUSHi((IV)RETVAL); 1664 } 1665 19 XSRETURN(1); 1666 } 1667 1668 1669 XS(XS_POSIX_islower); /* prototype to pass -Wmissing-prototypes */ 1670 XS(XS_POSIX_islower) 1671 19 { 1672 19 dXSARGS; 1673 19 if (items != 1) 1674 ###### Perl_croak(aTHX_ "Usage: POSIX::islower(charstring)"); 1675 19 PERL_UNUSED_VAR(cv); /* -W */ 1676 { 1677 19 SV * charstring = ST(0); 1678 #line 937 "POSIX.xs" 1679 STRLEN len; 1680 #line 1681 "POSIX.c" 1681 19 int RETVAL; 1682 19 dXSTARG; 1683 #line 939 "POSIX.xs" 1684 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1685 unsigned char *e = s + len; 1686 for (RETVAL = 1; RETVAL && s < e; s++) 1687 if (!islower(*s)) 1688 RETVAL = 0; 1689 #line 1690 "POSIX.c" 1690 19 XSprePUSH; PUSHi((IV)RETVAL); 1691 } 1692 19 XSRETURN(1); 1693 } 1694 1695 1696 XS(XS_POSIX_isprint); /* prototype to pass -Wmissing-prototypes */ 1697 XS(XS_POSIX_isprint) 1698 19 { 1699 19 dXSARGS; 1700 19 if (items != 1) 1701 ###### Perl_croak(aTHX_ "Usage: POSIX::isprint(charstring)"); 1702 19 PERL_UNUSED_VAR(cv); /* -W */ 1703 { 1704 19 SV * charstring = ST(0); 1705 #line 951 "POSIX.xs" 1706 STRLEN len; 1707 #line 1708 "POSIX.c" 1708 19 int RETVAL; 1709 19 dXSTARG; 1710 #line 953 "POSIX.xs" 1711 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1712 unsigned char *e = s + len; 1713 for (RETVAL = 1; RETVAL && s < e; s++) 1714 if (!isprint(*s)) 1715 RETVAL = 0; 1716 #line 1717 "POSIX.c" 1717 19 XSprePUSH; PUSHi((IV)RETVAL); 1718 } 1719 19 XSRETURN(1); 1720 } 1721 1722 1723 XS(XS_POSIX_ispunct); /* prototype to pass -Wmissing-prototypes */ 1724 XS(XS_POSIX_ispunct) 1725 19 { 1726 19 dXSARGS; 1727 19 if (items != 1) 1728 ###### Perl_croak(aTHX_ "Usage: POSIX::ispunct(charstring)"); 1729 19 PERL_UNUSED_VAR(cv); /* -W */ 1730 { 1731 19 SV * charstring = ST(0); 1732 #line 965 "POSIX.xs" 1733 STRLEN len; 1734 #line 1735 "POSIX.c" 1735 19 int RETVAL; 1736 19 dXSTARG; 1737 #line 967 "POSIX.xs" 1738 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1739 unsigned char *e = s + len; 1740 for (RETVAL = 1; RETVAL && s < e; s++) 1741 if (!ispunct(*s)) 1742 RETVAL = 0; 1743 #line 1744 "POSIX.c" 1744 19 XSprePUSH; PUSHi((IV)RETVAL); 1745 } 1746 19 XSRETURN(1); 1747 } 1748 1749 1750 XS(XS_POSIX_isspace); /* prototype to pass -Wmissing-prototypes */ 1751 XS(XS_POSIX_isspace) 1752 19 { 1753 19 dXSARGS; 1754 19 if (items != 1) 1755 ###### Perl_croak(aTHX_ "Usage: POSIX::isspace(charstring)"); 1756 19 PERL_UNUSED_VAR(cv); /* -W */ 1757 { 1758 19 SV * charstring = ST(0); 1759 #line 979 "POSIX.xs" 1760 STRLEN len; 1761 #line 1762 "POSIX.c" 1762 19 int RETVAL; 1763 19 dXSTARG; 1764 #line 981 "POSIX.xs" 1765 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1766 unsigned char *e = s + len; 1767 for (RETVAL = 1; RETVAL && s < e; s++) 1768 if (!isspace(*s)) 1769 RETVAL = 0; 1770 #line 1771 "POSIX.c" 1771 19 XSprePUSH; PUSHi((IV)RETVAL); 1772 } 1773 19 XSRETURN(1); 1774 } 1775 1776 1777 XS(XS_POSIX_isupper); /* prototype to pass -Wmissing-prototypes */ 1778 XS(XS_POSIX_isupper) 1779 19 { 1780 19 dXSARGS; 1781 19 if (items != 1) 1782 ###### Perl_croak(aTHX_ "Usage: POSIX::isupper(charstring)"); 1783 19 PERL_UNUSED_VAR(cv); /* -W */ 1784 { 1785 19 SV * charstring = ST(0); 1786 #line 993 "POSIX.xs" 1787 STRLEN len; 1788 #line 1789 "POSIX.c" 1789 19 int RETVAL; 1790 19 dXSTARG; 1791 #line 995 "POSIX.xs" 1792 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1793 unsigned char *e = s + len; 1794 for (RETVAL = 1; RETVAL && s < e; s++) 1795 if (!isupper(*s)) 1796 RETVAL = 0; 1797 #line 1798 "POSIX.c" 1798 19 XSprePUSH; PUSHi((IV)RETVAL); 1799 } 1800 19 XSRETURN(1); 1801 } 1802 1803 1804 XS(XS_POSIX_isxdigit); /* prototype to pass -Wmissing-prototypes */ 1805 XS(XS_POSIX_isxdigit) 1806 19 { 1807 19 dXSARGS; 1808 19 if (items != 1) 1809 ###### Perl_croak(aTHX_ "Usage: POSIX::isxdigit(charstring)"); 1810 19 PERL_UNUSED_VAR(cv); /* -W */ 1811 { 1812 19 SV * charstring = ST(0); 1813 #line 1007 "POSIX.xs" 1814 STRLEN len; 1815 #line 1816 "POSIX.c" 1816 19 int RETVAL; 1817 19 dXSTARG; 1818 #line 1009 "POSIX.xs" 1819 unsigned char *s = (unsigned char *) SvPV(charstring, len); 1820 unsigned char *e = s + len; 1821 for (RETVAL = 1; RETVAL && s < e; s++) 1822 if (!isxdigit(*s)) 1823 RETVAL = 0; 1824 #line 1825 "POSIX.c" 1825 19 XSprePUSH; PUSHi((IV)RETVAL); 1826 } 1827 19 XSRETURN(1); 1828 } 1829 1830 1831 XS(XS_POSIX_open); /* prototype to pass -Wmissing-prototypes */ 1832 XS(XS_POSIX_open) 1833 2 { 1834 2 dXSARGS; 1835 2 if (items < 1 || items > 3) 1836 ###### Perl_croak(aTHX_ "Usage: POSIX::open(filename, flags = O_RDONLY, mode = 0666)"); 1837 2 PERL_UNUSED_VAR(cv); /* -W */ 1838 { 1839 2 char * filename = (char *)SvPV_nolen(ST(0)); 1840 2 int flags; 1841 2 Mode_t mode; 1842 2 SysRet RETVAL; 1843 1844 2 if (items < 2) 1845 ###### flags = O_RDONLY; 1846 else { 1847 2 flags = (int)SvIV(ST(1)); 1848 } 1849 1850 2 if (items < 3) 1851 ###### mode = 0666; 1852 else { 1853 2 mode = (Mode_t)SvNV(ST(2)); 1854 } 1855 #line 1023 "POSIX.xs" 1856 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL)) 1857 TAINT_PROPER("open"); 1858 RETVAL = open(filename, flags, mode); 1859 #line 1860 "POSIX.c" 1860 1 ST(0) = sv_newmortal(); 1861 1 if (RETVAL != -1) { 1862 1 if (RETVAL == 0) 1863 ###### sv_setpvn(ST(0), "0 but true", 10); 1864 else 1865 1 sv_setiv(ST(0), (IV)RETVAL); 1866 } 1867 } 1868 1 XSRETURN(1); 1869 } 1870 1871 1872 XS(XS_POSIX_localeconv); /* prototype to pass -Wmissing-prototypes */ 1873 XS(XS_POSIX_localeconv) 1874 ###### { 1875 ###### dXSARGS; 1876 ###### if (items != 0) 1877 ###### Perl_croak(aTHX_ "Usage: POSIX::localeconv()"); 1878 ###### PERL_UNUSED_VAR(cv); /* -W */ 1879 { 1880 ###### HV * RETVAL; 1881 #line 1033 "POSIX.xs" 1882 #ifdef HAS_LOCALECONV 1883 struct lconv *lcbuf; 1884 RETVAL = newHV(); 1885 sv_2mortal((SV*)RETVAL); 1886 if ((lcbuf = localeconv())) { 1887 /* the strings */ 1888 if (lcbuf->decimal_point && *lcbuf->decimal_point) 1889 hv_store(RETVAL, "decimal_point", 13, 1890 newSVpv(lcbuf->decimal_point, 0), 0); 1891 if (lcbuf->thousands_sep && *lcbuf->thousands_sep) 1892 hv_store(RETVAL, "thousands_sep", 13, 1893 newSVpv(lcbuf->thousands_sep, 0), 0); 1894 #ifndef NO_LOCALECONV_GROUPING 1895 if (lcbuf->grouping && *lcbuf->grouping) 1896 hv_store(RETVAL, "grouping", 8, 1897 newSVpv(lcbuf->grouping, 0), 0); 1898 #endif 1899 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol) 1900 hv_store(RETVAL, "int_curr_symbol", 15, 1901 newSVpv(lcbuf->int_curr_symbol, 0), 0); 1902 if (lcbuf->currency_symbol && *lcbuf->currency_symbol) 1903 hv_store(RETVAL, "currency_symbol", 15, 1904 newSVpv(lcbuf->currency_symbol, 0), 0); 1905 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point) 1906 hv_store(RETVAL, "mon_decimal_point", 17, 1907 newSVpv(lcbuf->mon_decimal_point, 0), 0); 1908 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP 1909 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep) 1910 hv_store(RETVAL, "mon_thousands_sep", 17, 1911 newSVpv(lcbuf->mon_thousands_sep, 0), 0); 1912 #endif 1913 #ifndef NO_LOCALECONV_MON_GROUPING 1914 if (lcbuf->mon_grouping && *lcbuf->mon_grouping) 1915 hv_store(RETVAL, "mon_grouping", 12, 1916 newSVpv(lcbuf->mon_grouping, 0), 0); 1917 #endif 1918 if (lcbuf->positive_sign && *lcbuf->positive_sign) 1919 hv_store(RETVAL, "positive_sign", 13, 1920 newSVpv(lcbuf->positive_sign, 0), 0); 1921 if (lcbuf->negative_sign && *lcbuf->negative_sign) 1922 hv_store(RETVAL, "negative_sign", 13, 1923 newSVpv(lcbuf->negative_sign, 0), 0); 1924 /* the integers */ 1925 if (lcbuf->int_frac_digits != CHAR_MAX) 1926 hv_store(RETVAL, "int_frac_digits", 15, 1927 newSViv(lcbuf->int_frac_digits), 0); 1928 if (lcbuf->frac_digits != CHAR_MAX) 1929 hv_store(RETVAL, "frac_digits", 11, 1930 newSViv(lcbuf->frac_digits), 0); 1931 if (lcbuf->p_cs_precedes != CHAR_MAX) 1932 hv_store(RETVAL, "p_cs_precedes", 13, 1933 newSViv(lcbuf->p_cs_precedes), 0); 1934 if (lcbuf->p_sep_by_space != CHAR_MAX) 1935 hv_store(RETVAL, "p_sep_by_space", 14, 1936 newSViv(lcbuf->p_sep_by_space), 0); 1937 if (lcbuf->n_cs_precedes != CHAR_MAX) 1938 hv_store(RETVAL, "n_cs_precedes", 13, 1939 newSViv(lcbuf->n_cs_precedes), 0); 1940 if (lcbuf->n_sep_by_space != CHAR_MAX) 1941 hv_store(RETVAL, "n_sep_by_space", 14, 1942 newSViv(lcbuf->n_sep_by_space), 0); 1943 if (lcbuf->p_sign_posn != CHAR_MAX) 1944 hv_store(RETVAL, "p_sign_posn", 11, 1945 newSViv(lcbuf->p_sign_posn), 0); 1946 if (lcbuf->n_sign_posn != CHAR_MAX) 1947 hv_store(RETVAL, "n_sign_posn", 11, 1948 newSViv(lcbuf->n_sign_posn), 0); 1949 } 1950 #else 1951 localeconv(); /* A stub to call not_here(). */ 1952 #endif 1953 #line 1954 "POSIX.c" 1954 ###### ST(0) = newRV((SV*)RETVAL); 1955 ###### sv_2mortal(ST(0)); 1956 } 1957 ###### XSRETURN(1); 1958 } 1959 1960 1961 XS(XS_POSIX_setlocale); /* prototype to pass -Wmissing-prototypes */ 1962 XS(XS_POSIX_setlocale) 1963 1625 { 1964 1625 dXSARGS; 1965 1625 if (items < 1 || items > 2) 1966 ###### Perl_croak(aTHX_ "Usage: POSIX::setlocale(category, locale = 0)"); 1967 1625 PERL_UNUSED_VAR(cv); /* -W */ 1968 { 1969 1625 int category = (int)SvIV(ST(0)); 1970 1625 char * locale; 1971 1625 char * RETVAL; 1972 1625 dXSTARG; 1973 1974 1625 if (items < 2) 1975 ###### locale = 0; 1976 else { 1977 1625 locale = (char *)SvPV_nolen(ST(1)); 1978 } 1979 #line 1112 "POSIX.xs" 1980 RETVAL = setlocale(category, locale); 1981 if (RETVAL) { 1982 #ifdef USE_LOCALE_CTYPE 1983 if (category == LC_CTYPE 1984 #ifdef LC_ALL 1985 || category == LC_ALL 1986 #endif 1987 ) 1988 { 1989 char *newctype; 1990 #ifdef LC_ALL 1991 if (category == LC_ALL) 1992 newctype = setlocale(LC_CTYPE, NULL); 1993 else 1994 #endif 1995 newctype = RETVAL; 1996 new_ctype(newctype); 1997 } 1998 #endif /* USE_LOCALE_CTYPE */ 1999 #ifdef USE_LOCALE_COLLATE 2000 if (category == LC_COLLATE 2001 #ifdef LC_ALL 2002 || category == LC_ALL 2003 #endif 2004 ) 2005 { 2006 char *newcoll; 2007 #ifdef LC_ALL 2008 if (category == LC_ALL) 2009 newcoll = setlocale(LC_COLLATE, NULL); 2010 else 2011 #endif 2012 newcoll = RETVAL; 2013 new_collate(newcoll); 2014 } 2015 #endif /* USE_LOCALE_COLLATE */ 2016 #ifdef USE_LOCALE_NUMERIC 2017 if (category == LC_NUMERIC 2018 #ifdef LC_ALL 2019 || category == LC_ALL 2020 #endif 2021 ) 2022 { 2023 char *newnum; 2024 #ifdef LC_ALL 2025 if (category == LC_ALL) 2026 newnum = setlocale(LC_NUMERIC, NULL); 2027 else 2028 #endif 2029 newnum = RETVAL; 2030 new_numeric(newnum); 2031 } 2032 #endif /* USE_LOCALE_NUMERIC */ 2033 } 2034 #line 2035 "POSIX.c" 2035 1625 sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG; 2036 } 2037 1625 XSRETURN(1); 2038 } 2039 2040 2041 XS(XS_POSIX_acos); /* prototype to pass -Wmissing-prototypes */ 2042 XS(XS_POSIX_acos) 2043 ###### { 2044 ###### dXSARGS; 2045 ###### if (items != 1) 2046 ###### Perl_croak(aTHX_ "Usage: POSIX::acos(x)"); 2047 ###### PERL_UNUSED_VAR(cv); /* -W */ 2048 { 2049 ###### NV x = (NV)SvNV(ST(0)); 2050 ###### NV RETVAL; 2051 ###### dXSTARG; 2052 2053 ###### RETVAL = acos(x); 2054 ###### XSprePUSH; PUSHn((NV)RETVAL); 2055 } 2056 ###### XSRETURN(1); 2057 } 2058 2059 2060 XS(XS_POSIX_asin); /* prototype to pass -Wmissing-prototypes */ 2061 XS(XS_POSIX_asin) 2062 ###### { 2063 ###### dXSARGS; 2064 ###### if (items != 1) 2065 ###### Perl_croak(aTHX_ "Usage: POSIX::asin(x)"); 2066 ###### PERL_UNUSED_VAR(cv); /* -W */ 2067 { 2068 ###### NV x = (NV)SvNV(ST(0)); 2069 ###### NV RETVAL; 2070 ###### dXSTARG; 2071 2072 ###### RETVAL = asin(x); 2073 ###### XSprePUSH; PUSHn((NV)RETVAL); 2074 } 2075 ###### XSRETURN(1); 2076 } 2077 2078 2079 XS(XS_POSIX_atan); /* prototype to pass -Wmissing-prototypes */ 2080 XS(XS_POSIX_atan) 2081 ###### { 2082 ###### dXSARGS; 2083 ###### if (items != 1) 2084 ###### Perl_croak(aTHX_ "Usage: POSIX::atan(x)"); 2085 ###### PERL_UNUSED_VAR(cv); /* -W */ 2086 { 2087 ###### NV x = (NV)SvNV(ST(0)); 2088 ###### NV RETVAL; 2089 ###### dXSTARG; 2090 2091 ###### RETVAL = atan(x); 2092 ###### XSprePUSH; PUSHn((NV)RETVAL); 2093 } 2094 ###### XSRETURN(1); 2095 } 2096 2097 2098 XS(XS_POSIX_ceil); /* prototype to pass -Wmissing-prototypes */ 2099 XS(XS_POSIX_ceil) 2100 1 { 2101 1 dXSARGS; 2102 1 if (items != 1) 2103 ###### Perl_croak(aTHX_ "Usage: POSIX::ceil(x)"); 2104 1 PERL_UNUSED_VAR(cv); /* -W */ 2105 { 2106 1 NV x = (NV)SvNV(ST(0)); 2107 1 NV RETVAL; 2108 1 dXSTARG; 2109 2110 1 RETVAL = ceil(x); 2111 1 XSprePUSH; PUSHn((NV)RETVAL); 2112 } 2113 1 XSRETURN(1); 2114 } 2115 2116 2117 XS(XS_POSIX_cosh); /* prototype to pass -Wmissing-prototypes */ 2118 XS(XS_POSIX_cosh) 2119 ###### { 2120 ###### dXSARGS; 2121 ###### if (items != 1) 2122 ###### Perl_croak(aTHX_ "Usage: POSIX::cosh(x)"); 2123 ###### PERL_UNUSED_VAR(cv); /* -W */ 2124 { 2125 ###### NV x = (NV)SvNV(ST(0)); 2126 ###### NV RETVAL; 2127 ###### dXSTARG; 2128 2129 ###### RETVAL = cosh(x); 2130 ###### XSprePUSH; PUSHn((NV)RETVAL); 2131 } 2132 ###### XSRETURN(1); 2133 } 2134 2135 2136 XS(XS_POSIX_floor); /* prototype to pass -Wmissing-prototypes */ 2137 XS(XS_POSIX_floor) 2138 ###### { 2139 ###### dXSARGS; 2140 ###### if (items != 1) 2141 ###### Perl_croak(aTHX_ "Usage: POSIX::floor(x)"); 2142 ###### PERL_UNUSED_VAR(cv); /* -W */ 2143 { 2144 ###### NV x = (NV)SvNV(ST(0)); 2145 ###### NV RETVAL; 2146 ###### dXSTARG; 2147 2148 ###### RETVAL = floor(x); 2149 ###### XSprePUSH; PUSHn((NV)RETVAL); 2150 } 2151 ###### XSRETURN(1); 2152 } 2153 2154 2155 XS(XS_POSIX_fmod); /* prototype to pass -Wmissing-prototypes */ 2156 XS(XS_POSIX_fmod) 2157 ###### { 2158 ###### dXSARGS; 2159 ###### if (items != 2) 2160 ###### Perl_croak(aTHX_ "Usage: POSIX::fmod(x, y)"); 2161 ###### PERL_UNUSED_VAR(cv); /* -W */ 2162 { 2163 ###### NV x = (NV)SvNV(ST(0)); 2164 ###### NV y = (NV)SvNV(ST(1)); 2165 ###### NV RETVAL; 2166 ###### dXSTARG; 2167 2168 ###### RETVAL = fmod(x, y); 2169 ###### XSprePUSH; PUSHn((NV)RETVAL); 2170 } 2171 ###### XSRETURN(1); 2172 } 2173 2174 2175 XS(XS_POSIX_frexp); /* prototype to pass -Wmissing-prototypes */ 2176 XS(XS_POSIX_frexp) 2177 ###### { 2178 ###### dXSARGS; 2179 ###### if (items != 1) 2180 ###### Perl_croak(aTHX_ "Usage: POSIX::frexp(x)"); 2181 ###### PERL_UNUSED_VAR(cv); /* -W */ 2182 ###### PERL_UNUSED_VAR(ax); /* -Wall */ 2183 ###### SP -= items; 2184 { 2185 ###### NV x = (NV)SvNV(ST(0)); 2186 #line 1203 "POSIX.xs" 2187 int expvar; 2188 /* (We already know stack is long enough.) */ 2189 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar)))); 2190 PUSHs(sv_2mortal(newSViv(expvar))); 2191 #line 2192 "POSIX.c" 2192 ###### PUTBACK; 2193 return; 2194 } 2195 } 2196 2197 2198 XS(XS_POSIX_ldexp); /* prototype to pass -Wmissing-prototypes */ 2199 XS(XS_POSIX_ldexp) 2200 ###### { 2201 ###### dXSARGS; 2202 ###### if (items != 2) 2203 ###### Perl_croak(aTHX_ "Usage: POSIX::ldexp(x, exp)"); 2204 ###### PERL_UNUSED_VAR(cv); /* -W */ 2205 { 2206 ###### NV x = (NV)SvNV(ST(0)); 2207 ###### int exp = (int)SvIV(ST(1)); 2208 ###### NV RETVAL; 2209 ###### dXSTARG; 2210 2211 ###### RETVAL = ldexp(x, exp); 2212 ###### XSprePUSH; PUSHn((NV)RETVAL); 2213 } 2214 ###### XSRETURN(1); 2215 } 2216 2217 2218 XS(XS_POSIX_log10); /* prototype to pass -Wmissing-prototypes */ 2219 XS(XS_POSIX_log10) 2220 ###### { 2221 ###### dXSARGS; 2222 ###### if (items != 1) 2223 ###### Perl_croak(aTHX_ "Usage: POSIX::log10(x)"); 2224 ###### PERL_UNUSED_VAR(cv); /* -W */ 2225 { 2226 ###### NV x = (NV)SvNV(ST(0)); 2227 ###### NV RETVAL; 2228 ###### dXSTARG; 2229 2230 ###### RETVAL = log10(x); 2231 ###### XSprePUSH; PUSHn((NV)RETVAL); 2232 } 2233 ###### XSRETURN(1); 2234 } 2235 2236 2237 XS(XS_POSIX_modf); /* prototype to pass -Wmissing-prototypes */ 2238 XS(XS_POSIX_modf) 2239 ###### { 2240 ###### dXSARGS; 2241 ###### if (items != 1) 2242 ###### Perl_croak(aTHX_ "Usage: POSIX::modf(x)"); 2243 ###### PERL_UNUSED_VAR(cv); /* -W */ 2244 ###### PERL_UNUSED_VAR(ax); /* -Wall */ 2245 ###### SP -= items; 2246 { 2247 ###### NV x = (NV)SvNV(ST(0)); 2248 #line 1221 "POSIX.xs" 2249 NV intvar; 2250 /* (We already know stack is long enough.) */ 2251 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar)))); 2252 PUSHs(sv_2mortal(newSVnv(intvar))); 2253 #line 2254 "POSIX.c" 2254 ###### PUTBACK; 2255 return; 2256 } 2257 } 2258 2259 2260 XS(XS_POSIX_sinh); /* prototype to pass -Wmissing-prototypes */ 2261 XS(XS_POSIX_sinh) 2262 ###### { 2263 ###### dXSARGS; 2264 ###### if (items != 1) 2265 ###### Perl_croak(aTHX_ "Usage: POSIX::sinh(x)"); 2266 ###### PERL_UNUSED_VAR(cv); /* -W */ 2267 { 2268 ###### NV x = (NV)SvNV(ST(0)); 2269 ###### NV RETVAL; 2270 ###### dXSTARG; 2271 2272 ###### RETVAL = sinh(x); 2273 ###### XSprePUSH; PUSHn((NV)RETVAL); 2274 } 2275 ###### XSRETURN(1); 2276 } 2277 2278 2279 XS(XS_POSIX_tan); /* prototype to pass -Wmissing-prototypes */ 2280 XS(XS_POSIX_tan) 2281 ###### { 2282 ###### dXSARGS; 2283 ###### if (items != 1) 2284 ###### Perl_croak(aTHX_ "Usage: POSIX::tan(x)"); 2285 ###### PERL_UNUSED_VAR(cv); /* -W */ 2286 { 2287 ###### NV x = (NV)SvNV(ST(0)); 2288 ###### NV RETVAL; 2289 ###### dXSTARG; 2290 2291 ###### RETVAL = tan(x); 2292 ###### XSprePUSH; PUSHn((NV)RETVAL); 2293 } 2294 ###### XSRETURN(1); 2295 } 2296 2297 2298 XS(XS_POSIX_tanh); /* prototype to pass -Wmissing-prototypes */ 2299 XS(XS_POSIX_tanh) 2300 ###### { 2301 ###### dXSARGS; 2302 ###### if (items != 1) 2303 ###### Perl_croak(aTHX_ "Usage: POSIX::tanh(x)"); 2304 ###### PERL_UNUSED_VAR(cv); /* -W */ 2305 { 2306 ###### NV x = (NV)SvNV(ST(0)); 2307 ###### NV RETVAL; 2308 ###### dXSTARG; 2309 2310 ###### RETVAL = tanh(x); 2311 ###### XSprePUSH; PUSHn((NV)RETVAL); 2312 } 2313 ###### XSRETURN(1); 2314 } 2315 2316 2317 XS(XS_POSIX_sigaction); /* prototype to pass -Wmissing-prototypes */ 2318 XS(XS_POSIX_sigaction) 2319 21 { 2320 21 dXSARGS; 2321 21 if (items < 2 || items > 3) 2322 ###### Perl_croak(aTHX_ "Usage: POSIX::sigaction(sig, optaction, oldaction = 0)"); 2323 21 PERL_UNUSED_VAR(cv); /* -W */ 2324 { 2325 21 int sig = (int)SvIV(ST(0)); 2326 21 SV * optaction = ST(1); 2327 21 POSIX__SigAction oldaction; 2328 21 SysRet RETVAL; 2329 2330 21 if (items < 3) 2331 11 oldaction = 0; 2332 else { 2333 10 if (SvROK(ST(2)) && SvTYPE(SvRV(ST(2)))==SVt_PVHV) 2334 10 oldaction = (HV*)SvRV(ST(2)); 2335 else 2336 ###### Perl_croak(aTHX_ "oldaction is not a hash reference"); 2337 } 2338 #line 1244 "POSIX.xs" 2339 #if defined(WIN32) || defined(NETWARE) 2340 RETVAL = not_here("sigaction"); 2341 #else 2342 2343 { 2344 dVAR; 2345 POSIX__SigAction action; 2346 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV); 2347 struct sigaction act; 2348 struct sigaction oact; 2349 sigset_t sset; 2350 SV *osset_sv; 2351 sigset_t osset; 2352 POSIX__SigSet sigset; 2353 SV** svp; 2354 SV** sigsvp; 2355 if (sig == 0 && SvPOK(ST(0))) { 2356 const char *s = SvPVX_const(ST(0)); 2357 int i = whichsig(s); 2358 2359 if (i < 0 && memEQ(s, "SIG", 3)) 2360 i = whichsig(s + 3); 2361 if (i < 0) { 2362 if (ckWARN(WARN_SIGNAL)) 2363 Perl_warner(aTHX_ packWARN(WARN_SIGNAL), 2364 "No such signal: SIG%s", s); 2365 XSRETURN_UNDEF; 2366 } 2367 else 2368 sig = i; 2369 } 2370 sigsvp = hv_fetch(GvHVn(siggv), 2371 PL_sig_name[sig], 2372 strlen(PL_sig_name[sig]), 2373 TRUE); 2374 2375 /* Check optaction and set action */ 2376 if(SvTRUE(optaction)) { 2377 if(sv_isa(optaction, "POSIX::SigAction")) 2378 action = (HV*)SvRV(optaction); 2379 else 2380 croak("action is not of type POSIX::SigAction"); 2381 } 2382 else { 2383 action=0; 2384 } 2385 2386 /* sigaction() is supposed to look atomic. In particular, any 2387 * signal handler invoked during a sigaction() call should 2388 * see either the old or the new disposition, and not something 2389 * in between. We use sigprocmask() to make it so. 2390 */ 2391 sigfillset(&sset); 2392 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset); 2393 if(RETVAL == -1) 2394 XSRETURN_UNDEF; 2395 ENTER; 2396 /* Restore signal mask no matter how we exit this block. */ 2397 osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t)); 2398 SAVEFREESV( osset_sv ); 2399 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv); 2400 2401 RETVAL=-1; /* In case both oldaction and action are 0. */ 2402 2403 /* Remember old disposition if desired. */ 2404 if (oldaction) { 2405 svp = hv_fetch(oldaction, "HANDLER", 7, TRUE); 2406 if(!svp) 2407 croak("Can't supply an oldaction without a HANDLER"); 2408 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */ 2409 sv_setsv(*svp, *sigsvp); 2410 } 2411 else { 2412 sv_setpv(*svp, "DEFAULT"); 2413 } 2414 RETVAL = sigaction(sig, (struct sigaction *)0, & oact); 2415 if(RETVAL == -1) 2416 XSRETURN_UNDEF; 2417 /* Get back the mask. */ 2418 svp = hv_fetch(oldaction, "MASK", 4, TRUE); 2419 if (sv_isa(*svp, "POSIX::SigSet")) { 2420 IV tmp = SvIV((SV*)SvRV(*svp)); 2421 sigset = INT2PTR(sigset_t*, tmp); 2422 } 2423 else { 2424 New(0, sigset, 1, sigset_t); 2425 sv_setptrobj(*svp, sigset, "POSIX::SigSet"); 2426 } 2427 *sigset = oact.sa_mask; 2428 2429 /* Get back the flags. */ 2430 svp = hv_fetch(oldaction, "FLAGS", 5, TRUE); 2431 sv_setiv(*svp, oact.sa_flags); 2432 2433 /* Get back whether the old handler used safe signals. */ 2434 svp = hv_fetch(oldaction, "SAFE", 4, TRUE); 2435 sv_setiv(*svp, oact.sa_handler == PL_csighandlerp); 2436 } 2437 2438 if (action) { 2439 /* Safe signals use "csighandler", which vectors through the 2440 PL_sighandlerp pointer when it's safe to do so. 2441 (BTW, "csighandler" is very different from "sighandler".) */ 2442 svp = hv_fetch(action, "SAFE", 4, FALSE); 2443 act.sa_handler = (*svp && SvTRUE(*svp)) 2444 ? PL_csighandlerp : PL_sighandlerp; 2445 2446 /* Vector new Perl handler through %SIG. 2447 (The core signal handlers read %SIG to dispatch.) */ 2448 svp = hv_fetch(action, "HANDLER", 7, FALSE); 2449 if (!svp) 2450 croak("Can't supply an action without a HANDLER"); 2451 sv_setsv(*sigsvp, *svp); 2452 2453 /* This call actually calls sigaction() with almost the 2454 right settings, including appropriate interpretation 2455 of DEFAULT and IGNORE. However, why are we doing 2456 this when we're about to do it again just below? XXX */ 2457 mg_set(*sigsvp); 2458 2459 /* And here again we duplicate -- DEFAULT/IGNORE checking. */ 2460 if(SvPOK(*svp)) { 2461 const char *s=SvPVX_const(*svp); 2462 if(strEQ(s,"IGNORE")) { 2463 act.sa_handler = SIG_IGN; 2464 } 2465 else if(strEQ(s,"DEFAULT")) { 2466 act.sa_handler = SIG_DFL; 2467 } 2468 } 2469 2470 /* Set up any desired mask. */ 2471 svp = hv_fetch(action, "MASK", 4, FALSE); 2472 if (svp && sv_isa(*svp, "POSIX::SigSet")) { 2473 IV tmp = SvIV((SV*)SvRV(*svp)); 2474 sigset = INT2PTR(sigset_t*, tmp); 2475 act.sa_mask = *sigset; 2476 } 2477 else 2478 sigemptyset(& act.sa_mask); 2479 2480 /* Set up any desired flags. */ 2481 svp = hv_fetch(action, "FLAGS", 5, FALSE); 2482 act.sa_flags = svp ? SvIV(*svp) : 0; 2483 2484 /* Don't worry about cleaning up *sigsvp if this fails, 2485 * because that means we tried to disposition a 2486 * nonblockable signal, in which case *sigsvp is 2487 * essentially meaningless anyway. 2488 */ 2489 RETVAL = sigaction(sig, & act, (struct sigaction *)0); 2490 if(RETVAL == -1) 2491 XSRETURN_UNDEF; 2492 } 2493 2494 LEAVE; 2495 } 2496 #endif 2497 #line 2498 "POSIX.c" 2498 17 ST(0) = sv_newmortal(); 2499 17 if (RETVAL != -1) { 2500 17 if (RETVAL == 0) 2501 17 sv_setpvn(ST(0), "0 but true", 10); 2502 else 2503 ###### sv_setiv(ST(0), (IV)RETVAL); 2504 } 2505 } 2506 17 XSRETURN(1); 2507 } 2508 2509 2510 XS(XS_POSIX_sigpending); /* prototype to pass -Wmissing-prototypes */ 2511 XS(XS_POSIX_sigpending) 2512 ###### { 2513 ###### dXSARGS; 2514 ###### if (items != 1) 2515 ###### Perl_croak(aTHX_ "Usage: POSIX::sigpending(sigset)"); 2516 ###### PERL_UNUSED_VAR(cv); /* -W */ 2517 { 2518 ###### POSIX__SigSet sigset; 2519 ###### SysRet RETVAL; 2520 2521 ###### if (sv_derived_from(ST(0), "POSIX::SigSet")) { 2522 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 2523 ###### sigset = INT2PTR(POSIX__SigSet,tmp); 2524 } 2525 else 2526 ###### Perl_croak(aTHX_ "sigset is not of type POSIX::SigSet"); 2527 2528 ###### RETVAL = sigpending(sigset); 2529 ###### ST(0) = sv_newmortal(); 2530 ###### if (RETVAL != -1) { 2531 ###### if (RETVAL == 0) 2532 ###### sv_setpvn(ST(0), "0 but true", 10); 2533 else 2534 ###### sv_setiv(ST(0), (IV)RETVAL); 2535 } 2536 } 2537 ###### XSRETURN(1); 2538 } 2539 2540 2541 XS(XS_POSIX_sigprocmask); /* prototype to pass -Wmissing-prototypes */ 2542 XS(XS_POSIX_sigprocmask) 2543 ###### { 2544 ###### dXSARGS; 2545 ###### if (items < 2 || items > 3) 2546 ###### Perl_croak(aTHX_ "Usage: POSIX::sigprocmask(how, sigset, oldsigset = 0)"); 2547 ###### PERL_UNUSED_VAR(cv); /* -W */ 2548 { 2549 ###### int how = (int)SvIV(ST(0)); 2550 ###### POSIX__SigSet sigset; 2551 ###### POSIX__SigSet oldsigset; 2552 ###### SysRet RETVAL; 2553 #line 1417 "POSIX.xs" 2554 if (! SvOK(ST(1))) { 2555 sigset = NULL; 2556 } else if (sv_isa(ST(1), "POSIX::SigSet")) { 2557 IV tmp = SvIV((SV*)SvRV(ST(1))); 2558 sigset = INT2PTR(POSIX__SigSet,tmp); 2559 } else { 2560 croak("sigset is not of type POSIX::SigSet"); 2561 } 2562 2563 if (items < 3 || ! SvOK(ST(2))) { 2564 oldsigset = NULL; 2565 } else if (sv_isa(ST(2), "POSIX::SigSet")) { 2566 IV tmp = SvIV((SV*)SvRV(ST(2))); 2567 oldsigset = INT2PTR(POSIX__SigSet,tmp); 2568 } else { 2569 croak("oldsigset is not of type POSIX::SigSet"); 2570 } 2571 #line 2572 "POSIX.c" 2572 2573 ###### RETVAL = sigprocmask(how, sigset, oldsigset); 2574 ###### ST(0) = sv_newmortal(); 2575 ###### if (RETVAL != -1) { 2576 ###### if (RETVAL == 0) 2577 ###### sv_setpvn(ST(0), "0 but true", 10); 2578 else 2579 ###### sv_setiv(ST(0), (IV)RETVAL); 2580 } 2581 } 2582 ###### XSRETURN(1); 2583 } 2584 2585 2586 XS(XS_POSIX_sigsuspend); /* prototype to pass -Wmissing-prototypes */ 2587 XS(XS_POSIX_sigsuspend) 2588 ###### { 2589 ###### dXSARGS; 2590 ###### if (items != 1) 2591 ###### Perl_croak(aTHX_ "Usage: POSIX::sigsuspend(signal_mask)"); 2592 ###### PERL_UNUSED_VAR(cv); /* -W */ 2593 { 2594 ###### POSIX__SigSet signal_mask; 2595 ###### SysRet RETVAL; 2596 2597 ###### if (sv_derived_from(ST(0), "POSIX::SigSet")) { 2598 ###### IV tmp = SvIV((SV*)SvRV(ST(0))); 2599 ###### signal_mask = INT2PTR(POSIX__SigSet,tmp); 2600 } 2601 else 2602 ###### Perl_croak(aTHX_ "signal_mask is not of type POSIX::SigSet"); 2603 2604 ###### RETVAL = sigsuspend(signal_mask); 2605 ###### ST(0) = sv_newmortal(); 2606 ###### if (RETVAL != -1) { 2607 ###### if (RETVAL == 0) 2608 ###### sv_setpvn(ST(0), "0 but true", 10); 2609 else 2610 ###### sv_setiv(ST(0), (IV)RETVAL); 2611 } 2612 } 2613 ###### XSRETURN(1); 2614 } 2615 2616 2617 XS(XS_POSIX__exit); /* prototype to pass -Wmissing-prototypes */ 2618 XS(XS_POSIX__exit) 2619 ###### { 2620 ###### dXSARGS; 2621 ###### if (items != 1) 2622 ###### Perl_croak(aTHX_ "Usage: POSIX::_exit(status)"); 2623 ###### PERL_UNUSED_VAR(cv); /* -W */ 2624 { 2625 ###### int status = (int)SvIV(ST(0)); 2626 2627 ###### _exit(status); 2628 } 2629 XSRETURN_EMPTY; 2630 } 2631 2632 2633 XS(XS_POSIX_close); /* prototype to pass -Wmissing-prototypes */ 2634 XS(XS_POSIX_close) 2635 ###### { 2636 ###### dXSARGS; 2637 ###### if (items != 1) 2638 ###### Perl_croak(aTHX_ "Usage: POSIX::close(fd)"); 2639 ###### PERL_UNUSED_VAR(cv); /* -W */ 2640 { 2641 ###### int fd = (int)SvIV(ST(0)); 2642 ###### SysRet RETVAL; 2643 2644 ###### RETVAL = close(fd); 2645 ###### ST(0) = sv_newmortal(); 2646 ###### if (RETVAL != -1) { 2647 ###### if (RETVAL == 0) 2648 ###### sv_setpvn(ST(0), "0 but true", 10); 2649 else 2650 ###### sv_setiv(ST(0), (IV)RETVAL); 2651 } 2652 } 2653 ###### XSRETURN(1); 2654 } 2655 2656 2657 XS(XS_POSIX_dup); /* prototype to pass -Wmissing-prototypes */ 2658 XS(XS_POSIX_dup) 2659 ###### { 2660 ###### dXSARGS; 2661 ###### if (items != 1) 2662 ###### Perl_croak(aTHX_ "Usage: POSIX::dup(fd)"); 2663 ###### PERL_UNUSED_VAR(cv); /* -W */ 2664 { 2665 ###### int fd = (int)SvIV(ST(0)); 2666 ###### SysRet RETVAL; 2667 2668 ###### RETVAL = dup(fd); 2669 ###### ST(0) = sv_newmortal(); 2670 ###### if (RETVAL != -1) { 2671 ###### if (RETVAL == 0) 2672 ###### sv_setpvn(ST(0), "0 but true", 10); 2673 else 2674 ###### sv_setiv(ST(0), (IV)RETVAL); 2675 } 2676 } 2677 ###### XSRETURN(1); 2678 } 2679 2680 2681 XS(XS_POSIX_dup2); /* prototype to pass -Wmissing-prototypes */ 2682 XS(XS_POSIX_dup2) 2683 ###### { 2684 ###### dXSARGS; 2685 ###### if (items != 2) 2686 ###### Perl_croak(aTHX_ "Usage: POSIX::dup2(fd1, fd2)"); 2687 ###### PERL_UNUSED_VAR(cv); /* -W */ 2688 { 2689 ###### int fd1 = (int)SvIV(ST(0)); 2690 ###### int fd2 = (int)SvIV(ST(1)); 2691 ###### SysRet RETVAL; 2692 2693 ###### RETVAL = dup2(fd1, fd2); 2694 ###### ST(0) = sv_newmortal(); 2695 ###### if (RETVAL != -1) { 2696 ###### if (RETVAL == 0) 2697 ###### sv_setpvn(ST(0), "0 but true", 10); 2698 else 2699 ###### sv_setiv(ST(0), (IV)RETVAL); 2700 } 2701 } 2702 ###### XSRETURN(1); 2703 } 2704 2705 2706 XS(XS_POSIX_lseek); /* prototype to pass -Wmissing-prototypes */ 2707 XS(XS_POSIX_lseek) 2708 ###### { 2709 ###### dXSARGS; 2710 ###### if (items != 3) 2711 ###### Perl_croak(aTHX_ "Usage: POSIX::lseek(fd, offset, whence)"); 2712 ###### PERL_UNUSED_VAR(cv); /* -W */ 2713 { 2714 ###### int fd = (int)SvIV(ST(0)); 2715 ###### Off_t offset = (Off_t)SvNV(ST(1)); 2716 ###### int whence = (int)SvIV(ST(2)); 2717 ###### SV * RETVAL; 2718 #line 1462 "POSIX.xs" 2719 Off_t pos = PerlLIO_lseek(fd, offset, whence); 2720 RETVAL = sizeof(Off_t) > sizeof(IV) 2721 ? newSVnv((NV)pos) : newSViv((IV)pos); 2722 #line 2723 "POSIX.c" 2723 ###### ST(0) = RETVAL; 2724 ###### sv_2mortal(ST(0)); 2725 } 2726 ###### XSRETURN(1); 2727 } 2728 2729 2730 XS(XS_POSIX_nice); /* prototype to pass -Wmissing-prototypes */ 2731 XS(XS_POSIX_nice) 2732 ###### { 2733 ###### dXSARGS; 2734 ###### if (items != 1) 2735 ###### Perl_croak(aTHX_ "Usage: POSIX::nice(incr)"); 2736 ###### PERL_UNUSED_VAR(cv); /* -W */ 2737 ###### PERL_UNUSED_VAR(ax); /* -Wall */ 2738 ###### SP -= items; 2739 { 2740 ###### int incr = (int)SvIV(ST(0)); 2741 #line 1472 "POSIX.xs" 2742 errno = 0; 2743 if ((incr = nice(incr)) != -1 || errno == 0) { 2744 if (incr == 0) 2745 XPUSHs(sv_2mortal(newSVpvn("0 but true", 10))); 2746 else 2747 XPUSHs(sv_2mortal(newSViv(incr))); 2748 } 2749 #line 2750 "POSIX.c" 2750 ###### PUTBACK; 2751 return; 2752 } 2753 } 2754 2755 2756 XS(XS_POSIX_pipe); /* prototype to pass -Wmissing-prototypes */ 2757 XS(XS_POSIX_pipe) 2758 ###### { 2759 ###### dXSARGS; 2760 ###### if (items != 0) 2761 ###### Perl_croak(aTHX_ "Usage: POSIX::pipe()"); 2762 ###### PERL_UNUSED_VAR(cv); /* -W */ 2763 ###### PERL_UNUSED_VAR(ax); /* -Wall */ 2764 ###### SP -= items; 2765 { 2766 #line 1483 "POSIX.xs" 2767 int fds[2]; 2768 if (pipe(fds) != -1) { 2769 EXTEND(SP,2); 2770 PUSHs(sv_2mortal(newSViv(fds[0]))); 2771 PUSHs(sv_2mortal(newSViv(fds[1]))); 2772 } 2773 #line 2774 "POSIX.c" 2774 ###### PUTBACK; 2775 return; 2776 } 2777 } 2778 2779 2780 XS(XS_POSIX_read); /* prototype to pass -Wmissing-prototypes */ 2781 XS(XS_POSIX_read) 2782 2 { 2783 2 dXSARGS; 2784 2 if (items != 3) 2785 ###### Perl_croak(aTHX_ "Usage: POSIX::read(fd, buffer, nbytes)"); 2786 2 PERL_UNUSED_VAR(cv); /* -W */ 2787 { 2788 #line 1493 "POSIX.xs" 2789 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1); 2790 #line 2791 "POSIX.c" 2791 2 int fd = (int)SvIV(ST(0)); 2792 2 size_t nbytes = (size_t)SvUV(ST(2)); 2793 2 char * buffer = sv_grow( sv_buffer, nbytes+1 ); 2794 2 SysRet RETVAL; 2795 2796 2 RETVAL = read(fd, buffer, nbytes); 2797 2 ST(0) = sv_newmortal(); 2798 2 if (RETVAL != -1) { 2799 2 if (RETVAL == 0) 2800 ###### sv_setpvn(ST(0), "0 but true", 10); 2801 else 2802 2 sv_setiv(ST(0), (IV)RETVAL); 2803 } 2804 #line 1499 "POSIX.xs" 2805 if (RETVAL >= 0) { 2806 SvCUR_set(sv_buffer, RETVAL); 2807 SvPOK_only(sv_buffer); 2808 *SvEND(sv_buffer) = '\0'; 2809 SvTAINTED_on(sv_buffer); 2810 } 2811 #line 2812 "POSIX.c" 2812 } 2813 2 XSRETURN(1); 2814 } 2815 2816 2817 XS(XS_POSIX_setpgid); /* prototype to pass -Wmissing-prototypes */ 2818 XS(XS_POSIX_setpgid) 2819 ###### { 2820 ###### dXSARGS; 2821 ###### if (items != 2) 2822 ###### Perl_croak(aTHX_ "Usage: POSIX::setpgid(pid, pgid)"); 2823 ###### PERL_UNUSED_VAR(cv); /* -W */ 2824 { 2825 ###### pid_t pid = (pid_t)SvNV(ST(0)); 2826 ###### pid_t pgid = (pid_t)SvNV(ST(1)); 2827 ###### SysRet RETVAL; 2828 2829 ###### RETVAL = setpgid(pid, pgid); 2830 ###### ST(0) = sv_newmortal(); 2831 ###### if (RETVAL != -1) { 2832 ###### if (RETVAL == 0) 2833 ###### sv_setpvn(ST(0), "0 but true", 10); 2834 else 2835 ###### sv_setiv(ST(0), (IV)RETVAL); 2836 } 2837 } 2838 ###### XSRETURN(1); 2839 } 2840 2841 2842 XS(XS_POSIX_setsid); /* prototype to pass -Wmissing-prototypes */ 2843 XS(XS_POSIX_setsid) 2844 ###### { 2845 ###### dXSARGS; 2846 ###### if (items != 0) 2847 ###### Perl_croak(aTHX_ "Usage: POSIX::setsid()"); 2848 ###### PERL_UNUSED_VAR(cv); /* -W */ 2849 { 2850 ###### pid_t RETVAL; 2851 ###### dXSTARG; 2852 2853 ###### RETVAL = setsid(); 2854 ###### XSprePUSH; PUSHn((NV)RETVAL); 2855 } 2856 ###### XSRETURN(1); 2857 } 2858 2859 2860 XS(XS_POSIX_tcgetpgrp); /* prototype to pass -Wmissing-prototypes */ 2861 XS(XS_POSIX_tcgetpgrp) 2862 ###### { 2863 ###### dXSARGS; 2864 ###### if (items != 1) 2865 ###### Perl_croak(aTHX_ "Usage: POSIX::tcgetpgrp(fd)"); 2866 ###### PERL_UNUSED_VAR(cv); /* -W */ 2867 { 2868 ###### int fd = (int)SvIV(ST(0)); 2869 ###### pid_t RETVAL; 2870 ###### dXSTARG; 2871 2872 ###### RETVAL = tcgetpgrp(fd); 2873 ###### XSprePUSH; PUSHn((NV)RETVAL); 2874 } 2875 ###### XSRETURN(1); 2876 } 2877 2878 2879 XS(XS_POSIX_tcsetpgrp); /* prototype to pass -Wmissing-prototypes */ 2880 XS(XS_POSIX_tcsetpgrp) 2881 ###### { 2882 ###### dXSARGS; 2883 ###### if (items != 2) 2884 ###### Perl_croak(aTHX_ "Usage: POSIX::tcsetpgrp(fd, pgrp_id)"); 2885 ###### PERL_UNUSED_VAR(cv); /* -W */ 2886 { 2887 ###### int fd = (int)SvIV(ST(0)); 2888 ###### pid_t pgrp_id = (pid_t)SvNV(ST(1)); 2889 ###### SysRet RETVAL; 2890 2891 ###### RETVAL = tcsetpgrp(fd, pgrp_id); 2892 ###### ST(0) = sv_newmortal(); 2893 ###### if (RETVAL != -1) { 2894 ###### if (RETVAL == 0) 2895 ###### sv_setpvn(ST(0), "0 but true", 10); 2896 else 2897 ###### sv_setiv(ST(0), (IV)RETVAL); 2898 } 2899 } 2900 ###### XSRETURN(1); 2901 } 2902 2903 2904 XS(XS_POSIX_uname); /* prototype to pass -Wmissing-prototypes */ 2905 XS(XS_POSIX_uname) 2906 1 { 2907 1 dXSARGS; 2908 1 if (items != 0) 2909 ###### Perl_croak(aTHX_ "Usage: POSIX::uname()"); 2910 1 PERL_UNUSED_VAR(cv); /* -W */ 2911 1 PERL_UNUSED_VAR(ax); /* -Wall */ 2912 1 SP -= items; 2913 { 2914 #line 1526 "POSIX.xs" 2915 #ifdef HAS_UNAME 2916 struct utsname buf; 2917 if (uname(&buf) >= 0) { 2918 EXTEND(SP, 5); 2919 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0))); 2920 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0))); 2921 PUSHs(sv_2mortal(newSVpv(buf.release, 0))); 2922 PUSHs(sv_2mortal(newSVpv(buf.version, 0))); 2923 PUSHs(sv_2mortal(newSVpv(buf.machine, 0))); 2924 } 2925 #else 2926 uname((char *) 0); /* A stub to call not_here(). */ 2927 #endif 2928 #line 2929 "POSIX.c" 2929 1 PUTBACK; 2930 return; 2931 } 2932 } 2933 2934 2935 XS(XS_POSIX_write); /* prototype to pass -Wmissing-prototypes */ 2936 XS(XS_POSIX_write) 2937 ###### { 2938 ###### dXSARGS; 2939 ###### if (items != 3) 2940 ###### Perl_croak(aTHX_ "Usage: POSIX::write(fd, buffer, nbytes)"); 2941 ###### PERL_UNUSED_VAR(cv); /* -W */ 2942 { 2943 ###### int fd = (int)SvIV(ST(0)); 2944 ###### char * buffer = (char *)SvPV_nolen(ST(1)); 2945 ###### size_t nbytes = (size_t)SvUV(ST(2)); 2946 ###### SysRet RETVAL; 2947 2948 ###### RETVAL = write(fd, buffer, nbytes); 2949 ###### ST(0) = sv_newmortal(); 2950 ###### if (RETVAL != -1) { 2951 ###### if (RETVAL == 0) 2952 ###### sv_setpvn(ST(0), "0 but true", 10); 2953 else 2954 ###### sv_setiv(ST(0), (IV)RETVAL); 2955 } 2956 } 2957 ###### XSRETURN(1); 2958 } 2959 2960 2961 XS(XS_POSIX_tmpnam); /* prototype to pass -Wmissing-prototypes */ 2962 XS(XS_POSIX_tmpnam) 2963 ###### { 2964 ###### dXSARGS; 2965 ###### if (items != 0) 2966 ###### Perl_croak(aTHX_ "Usage: POSIX::tmpnam()"); 2967 ###### PERL_UNUSED_VAR(cv); /* -W */ 2968 { 2969 #line 1549 "POSIX.xs" 2970 STRLEN i; 2971 int len; 2972 #line 2973 "POSIX.c" 2973 ###### SV * RETVAL; 2974 #line 1552 "POSIX.xs" 2975 RETVAL = newSVpvn("", 0); 2976 SvGROW(RETVAL, L_tmpnam); 2977 len = strlen(tmpnam(SvPV(RETVAL, i))); 2978 SvCUR_set(RETVAL, len); 2979 #line 2980 "POSIX.c" 2980 ###### ST(0) = RETVAL; 2981 ###### sv_2mortal(ST(0)); 2982 } 2983 ###### XSRETURN(1); 2984 } 2985 2986 2987 XS(XS_POSIX_abort); /* prototype to pass -Wmissing-prototypes */ 2988 XS(XS_POSIX_abort) 2989 ###### { 2990 ###### dXSARGS; 2991 ###### if (items != 0) 2992 ###### Perl_croak(aTHX_ "Usage: POSIX::abort()"); 2993 ###### PERL_UNUSED_VAR(cv); /* -W */ 2994 { 2995 2996 ###### abort(); 2997 } 2998 XSRETURN_EMPTY; 2999 } 3000 3001 3002 XS(XS_POSIX_mblen); /* prototype to pass -Wmissing-prototypes */ 3003 XS(XS_POSIX_mblen) 3004 ###### { 3005 ###### dXSARGS; 3006 ###### if (items != 2) 3007 ###### Perl_croak(aTHX_ "Usage: POSIX::mblen(s, n)"); 3008 ###### PERL_UNUSED_VAR(cv); /* -W */ 3009 { 3010 ###### char * s = (char *)SvPV_nolen(ST(0)); 3011 ###### size_t n = (size_t)SvUV(ST(1)); 3012 ###### int RETVAL; 3013 ###### dXSTARG; 3014 3015 ###### RETVAL = mblen(s, n); 3016 ###### XSprePUSH; PUSHi((IV)RETVAL); 3017 } 3018 ###### XSRETURN(1); 3019 } 3020 3021 3022 XS(XS_POSIX_mbstowcs); /* prototype to pass -Wmissing-prototypes */ 3023 XS(XS_POSIX_mbstowcs) 3024 ###### { 3025 ###### dXSARGS; 3026 ###### if (items != 3) 3027 ###### Perl_croak(aTHX_ "Usage: POSIX::mbstowcs(s, pwcs, n)"); 3028 ###### PERL_UNUSED_VAR(cv); /* -W */ 3029 { 3030 ###### wchar_t * s = (wchar_t *)SvPV_nolen(ST(0)); 3031 ###### char * pwcs = (char *)SvPV_nolen(ST(1)); 3032 ###### size_t n = (size_t)SvUV(ST(2)); 3033 ###### size_t RETVAL; 3034 ###### dXSTARG; 3035 3036 ###### RETVAL = mbstowcs(s, pwcs, n); 3037 ###### XSprePUSH; PUSHu((UV)RETVAL); 3038 } 3039 ###### XSRETURN(1); 3040 } 3041 3042 3043 XS(XS_POSIX_mbtowc); /* prototype to pass -Wmissing-prototypes */ 3044 XS(XS_POSIX_mbtowc) 3045 ###### { 3046 ###### dXSARGS; 3047 ###### if (items != 3) 3048 ###### Perl_croak(aTHX_ "Usage: POSIX::mbtowc(pwc, s, n)"); 3049 ###### PERL_UNUSED_VAR(cv); /* -W */ 3050 { 3051 ###### wchar_t * pwc = (wchar_t *)SvPV_nolen(ST(0)); 3052 ###### char * s = (char *)SvPV_nolen(ST(1)); 3053 ###### size_t n = (size_t)SvUV(ST(2)); 3054 ###### int RETVAL; 3055 ###### dXSTARG; 3056 3057 ###### RETVAL = mbtowc(pwc, s, n); 3058 ###### XSprePUSH; PUSHi((IV)RETVAL); 3059 } 3060 ###### XSRETURN(1); 3061 } 3062 3063 3064 XS(XS_POSIX_wcstombs); /* prototype to pass -Wmissing-prototypes */ 3065 XS(XS_POSIX_wcstombs) 3066 ###### { 3067 ###### dXSARGS; 3068 ###### if (items != 3) 3069 ###### Perl_croak(aTHX_ "Usage: POSIX::wcstombs(s, pwcs, n)"); 3070 ###### PERL_UNUSED_VAR(cv); /* -W */ 3071 { 3072 ###### char * s = (char *)SvPV_nolen(ST(0)); 3073 ###### wchar_t * pwcs = (wchar_t *)SvPV_nolen(ST(1)); 3074 ###### size_t n = (size_t)SvUV(ST(2)); 3075 ###### int RETVAL; 3076 ###### dXSTARG; 3077 3078 ###### RETVAL = wcstombs(s, pwcs, n); 3079 ###### XSprePUSH; PUSHi((IV)RETVAL); 3080 } 3081 ###### XSRETURN(1); 3082 } 3083 3084 3085 XS(XS_POSIX_wctomb); /* prototype to pass -Wmissing-prototypes */ 3086 XS(XS_POSIX_wctomb) 3087 ###### { 3088 ###### dXSARGS; 3089 ###### if (items != 2) 3090 ###### Perl_croak(aTHX_ "Usage: POSIX::wctomb(s, wchar)"); 3091 ###### PERL_UNUSED_VAR(cv); /* -W */ 3092 { 3093 ###### char * s = (char *)SvPV_nolen(ST(0)); 3094 ###### wchar_t wchar = (wchar_t)SvIV(ST(1)); 3095 ###### int RETVAL; 3096 ###### dXSTARG; 3097 3098 ###### RETVAL = wctomb(s, wchar); 3099 ###### XSprePUSH; PUSHi((IV)RETVAL); 3100 } 3101 ###### XSRETURN(1); 3102 } 3103 3104 3105 XS(XS_POSIX_strcoll); /* prototype to pass -Wmissing-prototypes */ 3106 XS(XS_POSIX_strcoll) 3107 ###### { 3108 ###### dXSARGS; 3109 ###### if (items != 2) 3110 ###### Perl_croak(aTHX_ "Usage: POSIX::strcoll(s1, s2)"); 3111 ###### PERL_UNUSED_VAR(cv); /* -W */ 3112 { 3113 ###### char * s1 = (char *)SvPV_nolen(ST(0)); 3114 ###### char * s2 = (char *)SvPV_nolen(ST(1)); 3115 ###### int RETVAL; 3116 ###### dXSTARG; 3117 3118 ###### RETVAL = strcoll(s1, s2); 3119 ###### XSprePUSH; PUSHi((IV)RETVAL); 3120 } 3121 ###### XSRETURN(1); 3122 } 3123 3124 3125 XS(XS_POSIX_strtod); /* prototype to pass -Wmissing-prototypes */ 3126 XS(XS_POSIX_strtod) 3127 ###### { 3128 ###### dXSARGS; 3129 ###### if (items != 1) 3130 ###### Perl_croak(aTHX_ "Usage: POSIX::strtod(str)"); 3131 ###### PERL_UNUSED_VAR(cv); /* -W */ 3132 ###### PERL_UNUSED_VAR(ax); /* -Wall */ 3133 ###### SP -= items; 3134 { 3135 ###### char * str = (char *)SvPV_nolen(ST(0)); 3136 #line 1599 "POSIX.xs" 3137 double num; 3138 char *unparsed; 3139 #line 3140 "POSIX.c" 3140 #line 1602 "POSIX.xs" 3141 SET_NUMERIC_LOCAL(); 3142 num = strtod(str, &unparsed); 3143 PUSHs(sv_2mortal(newSVnv(num))); 3144 if (GIMME == G_ARRAY) { 3145 EXTEND(SP, 1); 3146 if (unparsed) 3147 PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); 3148 else 3149 PUSHs(&PL_sv_undef); 3150 } 3151 #line 3152 "POSIX.c" 3152 ###### PUTBACK; 3153 return; 3154 } 3155 } 3156 3157 3158 XS(XS_POSIX_strtol); /* prototype to pass -Wmissing-prototypes */ 3159 XS(XS_POSIX_strtol) 3160 ###### { 3161 ###### dXSARGS; 3162 ###### if (items < 1 || items > 2) 3163 ###### Perl_croak(aTHX_ "Usage: POSIX::strtol(str, base = 0)"); 3164 ###### PERL_UNUSED_VAR(cv); /* -W */ 3165 ###### PERL_UNUSED_VAR(ax); /* -Wall */ 3166 ###### SP -= items; 3167 { 3168 ###### char * str = (char *)SvPV_nolen(ST(0)); 3169 ###### int base; 3170 #line 1618 "POSIX.xs" 3171 long num; 3172 char *unparsed; 3173 #line 3174 "POSIX.c" 3174 3175 ###### if (items < 2) 3176 ###### base = 0; 3177 else { 3178 ###### base = (int)SvIV(ST(1)); 3179 } 3180 #line 1621 "POSIX.xs" 3181 num = strtol(str, &unparsed, base); 3182 #if IVSIZE <= LONGSIZE 3183 if (num < IV_MIN || num > IV_MAX) 3184 PUSHs(sv_2mortal(newSVnv((double)num))); 3185 else 3186 #endif 3187 PUSHs(sv_2mortal(newSViv((IV)num))); 3188 if (GIMME == G_ARRAY) { 3189 EXTEND(SP, 1); 3190 if (unparsed) 3191 PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); 3192 else 3193 PUSHs(&PL_sv_undef); 3194 } 3195 #line 3196 "POSIX.c" 3196 ###### PUTBACK; 3197 return; 3198 } 3199 } 3200 3201 3202 XS(XS_POSIX_strtoul); /* prototype to pass -Wmissing-prototypes */ 3203 XS(XS_POSIX_strtoul) 3204 ###### { 3205 ###### dXSARGS; 3206 ###### if (items < 1 || items > 2) 3207 ###### Perl_croak(aTHX_ "Usage: POSIX::strtoul(str, base = 0)"); 3208 ###### PERL_UNUSED_VAR(cv); /* -W */ 3209 ###### PERL_UNUSED_VAR(ax); /* -Wall */ 3210 ###### SP -= items; 3211 { 3212 ###### char * str = (char *)SvPV_nolen(ST(0)); 3213 ###### int base; 3214 #line 1641 "POSIX.xs" 3215 unsigned long num; 3216 char *unparsed; 3217 #line 3218 "POSIX.c" 3218 3219 ###### if (items < 2) 3220 ###### base = 0; 3221 else { 3222 ###### base = (int)SvIV(ST(1)); 3223 } 3224 #line 1644 "POSIX.xs" 3225 num = strtoul(str, &unparsed, base); 3226 #if IVSIZE <= LONGSIZE 3227 if (num > IV_MAX) 3228 PUSHs(sv_2mortal(newSVnv((double)num))); 3229 else 3230 #endif 3231 PUSHs(sv_2mortal(newSViv((IV)num))); 3232 if (GIMME == G_ARRAY) { 3233 EXTEND(SP, 1); 3234 if (unparsed) 3235 PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); 3236 else 3237 PUSHs(&PL_sv_undef); 3238 } 3239 #line 3240 "POSIX.c" 3240 ###### PUTBACK; 3241 return; 3242 } 3243 } 3244 3245 3246 XS(XS_POSIX_strxfrm); /* prototype to pass -Wmissing-prototypes */ 3247 XS(XS_POSIX_strxfrm) 3248 2 { 3249 2 dXSARGS; 3250 2 if (items != 1) 3251 ###### Perl_croak(aTHX_ "Usage: POSIX::strxfrm(src)"); 3252 2 PERL_UNUSED_VAR(cv); /* -W */ 3253 { 3254 2 SV * src = ST(0); 3255 #line 1663 "POSIX.xs" 3256 { 3257 STRLEN srclen; 3258 STRLEN dstlen; 3259 char *p = SvPV(src,srclen); 3260 srclen++; 3261 ST(0) = sv_2mortal(NEWSV(800,srclen*4+1)); 3262 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen); 3263 if (dstlen > srclen) { 3264 dstlen++; 3265 SvGROW(ST(0), dstlen); 3266 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen); 3267 dstlen--; 3268 } 3269 SvCUR_set(ST(0), dstlen); 3270 SvPOK_only(ST(0)); 3271 } 3272 #line 3273 "POSIX.c" 3273 } 3274 2 XSRETURN(1); 3275 } 3276 3277 3278 XS(XS_POSIX_mkfifo); /* prototype to pass -Wmissing-prototypes */ 3279 XS(XS_POSIX_mkfifo) 3280 1 { 3281 1 dXSARGS; 3282 1 if (items != 2) 3283 ###### Perl_croak(aTHX_ "Usage: POSIX::mkfifo(filename, mode)"); 3284 1 PERL_UNUSED_VAR(cv); /* -W */ 3285 { 3286 1 char * filename = (char *)SvPV_nolen(ST(0)); 3287 1 Mode_t mode = (Mode_t)SvNV(ST(1)); 3288 1 SysRet RETVAL; 3289 #line 1685 "POSIX.xs" 3290 TAINT_PROPER("mkfifo"); 3291 RETVAL = mkfifo(filename, mode); 3292 #line 3293 "POSIX.c" 3293 ###### ST(0) = sv_newmortal(); 3294 ###### if (RETVAL != -1) { 3295 ###### if (RETVAL == 0) 3296 ###### sv_setpvn(ST(0), "0 but true", 10); 3297 else 3298 ###### sv_setiv(ST(0), (IV)RETVAL); 3299 } 3300 } 3301 ###### XSRETURN(1); 3302 } 3303 3304 3305 XS(XS_POSIX_tcdrain); /* prototype to pass -Wmissing-prototypes */ 3306 XS(XS_POSIX_tcdrain) 3307 ###### { 3308 ###### dXSARGS; 3309 ###### if (items != 1) 3310 ###### Perl_croak(aTHX_ "Usage: POSIX::tcdrain(fd)"); 3311 ###### PERL_UNUSED_VAR(cv); /* -W */ 3312 { 3313 ###### int fd = (int)SvIV(ST(0)); 3314 ###### SysRet RETVAL; 3315 3316 ###### RETVAL = tcdrain(fd); 3317 ###### ST(0) = sv_newmortal(); 3318 ###### if (RETVAL != -1) { 3319 ###### if (RETVAL == 0) 3320 ###### sv_setpvn(ST(0), "0 but true", 10); 3321 else 3322 ###### sv_setiv(ST(0), (IV)RETVAL); 3323 } 3324 } 3325 ###### XSRETURN(1); 3326 } 3327 3328 3329 XS(XS_POSIX_tcflow); /* prototype to pass -Wmissing-prototypes */ 3330 XS(XS_POSIX_tcflow) 3331 ###### { 3332 ###### dXSARGS; 3333 ###### if (items != 2) 3334 ###### Perl_croak(aTHX_ "Usage: POSIX::tcflow(fd, action)"); 3335 ###### PERL_UNUSED_VAR(cv); /* -W */ 3336 { 3337 ###### int fd = (int)SvIV(ST(0)); 3338 ###### int action = (int)SvIV(ST(1)); 3339 ###### SysRet RETVAL; 3340 3341 ###### RETVAL = tcflow(fd, action); 3342 ###### ST(0) = sv_newmortal(); 3343 ###### if (RETVAL != -1) { 3344 ###### if (RETVAL == 0) 3345 ###### sv_setpvn(ST(0), "0 but true", 10); 3346 else 3347 ###### sv_setiv(ST(0), (IV)RETVAL); 3348 } 3349 } 3350 ###### XSRETURN(1); 3351 } 3352 3353 3354 XS(XS_POSIX_tcflush); /* prototype to pass -Wmissing-prototypes */ 3355 XS(XS_POSIX_tcflush) 3356 ###### { 3357 ###### dXSARGS; 3358 ###### if (items != 2) 3359 ###### Perl_croak(aTHX_ "Usage: POSIX::tcflush(fd, queue_selector)"); 3360 ###### PERL_UNUSED_VAR(cv); /* -W */ 3361 { 3362 ###### int fd = (int)SvIV(ST(0)); 3363 ###### int queue_selector = (int)SvIV(ST(1)); 3364 ###### SysRet RETVAL; 3365 3366 ###### RETVAL = tcflush(fd, queue_selector); 3367 ###### ST(0) = sv_newmortal(); 3368 ###### if (RETVAL != -1) { 3369 ###### if (RETVAL == 0) 3370 ###### sv_setpvn(ST(0), "0 but true", 10); 3371 else 3372 ###### sv_setiv(ST(0), (IV)RETVAL); 3373 } 3374 } 3375 ###### XSRETURN(1); 3376 } 3377 3378 3379 XS(XS_POSIX_tcsendbreak); /* prototype to pass -Wmissing-prototypes */ 3380 XS(XS_POSIX_tcsendbreak) 3381 ###### { 3382 ###### dXSARGS; 3383 ###### if (items != 2) 3384 ###### Perl_croak(aTHX_ "Usage: POSIX::tcsendbreak(fd, duration)"); 3385 ###### PERL_UNUSED_VAR(cv); /* -W */ 3386 { 3387 ###### int fd = (int)SvIV(ST(0)); 3388 ###### int duration = (int)SvIV(ST(1)); 3389 ###### SysRet RETVAL; 3390 3391 ###### RETVAL = tcsendbreak(fd, duration); 3392 ###### ST(0) = sv_newmortal(); 3393 ###### if (RETVAL != -1) { 3394 ###### if (RETVAL == 0) 3395 ###### sv_setpvn(ST(0), "0 but true", 10); 3396 else 3397 ###### sv_setiv(ST(0), (IV)RETVAL); 3398 } 3399 } 3400 ###### XSRETURN(1); 3401 } 3402 3403 3404 XS(XS_POSIX_asctime); /* prototype to pass -Wmissing-prototypes */ 3405 XS(XS_POSIX_asctime) 3406 ###### { 3407 ###### dXSARGS; 3408 ###### if (items < 6 || items > 9) 3409 ###### Perl_croak(aTHX_ "Usage: POSIX::asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)"); 3410 ###### PERL_UNUSED_VAR(cv); /* -W */ 3411 { 3412 ###### int sec = (int)SvIV(ST(0)); 3413 ###### int min = (int)SvIV(ST(1)); 3414 ###### int hour = (int)SvIV(ST(2)); 3415 ###### int mday = (int)SvIV(ST(3)); 3416 ###### int mon = (int)SvIV(ST(4)); 3417 ###### int year = (int)SvIV(ST(5)); 3418 ###### int wday; 3419 ###### int yday; 3420 ###### int isdst; 3421 ###### char * RETVAL; 3422 ###### dXSTARG; 3423 3424 ###### if (items < 7) 3425 ###### wday = 0; 3426 else { 3427 ###### wday = (int)SvIV(ST(6)); 3428 } 3429 3430 ###### if (items < 8) 3431 ###### yday = 0; 3432 else { 3433 ###### yday = (int)SvIV(ST(7)); 3434 } 3435 3436 ###### if (items < 9) 3437 ###### isdst = 0; 3438 else { 3439 ###### isdst = (int)SvIV(ST(8)); 3440 } 3441 #line 1723 "POSIX.xs" 3442 { 3443 struct tm mytm; 3444 init_tm(&mytm); /* XXX workaround - see init_tm() above */ 3445 mytm.tm_sec = sec; 3446 mytm.tm_min = min; 3447 mytm.tm_hour = hour; 3448 mytm.tm_mday = mday; 3449 mytm.tm_mon = mon; 3450 mytm.tm_year = year; 3451 mytm.tm_wday = wday; 3452 mytm.tm_yday = yday; 3453 mytm.tm_isdst = isdst; 3454 RETVAL = asctime(&mytm); 3455 } 3456 #line 3457 "POSIX.c" 3457 ###### sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG; 3458 } 3459 ###### XSRETURN(1); 3460 } 3461 3462 3463 XS(XS_POSIX_clock); /* prototype to pass -Wmissing-prototypes */ 3464 XS(XS_POSIX_clock) 3465 ###### { 3466 ###### dXSARGS; 3467 ###### if (items != 0) 3468 ###### Perl_croak(aTHX_ "Usage: POSIX::clock()"); 3469 ###### PERL_UNUSED_VAR(cv); /* -W */ 3470 { 3471 ###### long RETVAL; 3472 ###### dXSTARG; 3473 3474 ###### RETVAL = clock(); 3475 ###### XSprePUSH; PUSHi((IV)RETVAL); 3476 } 3477 ###### XSRETURN(1); 3478 } 3479 3480 3481 XS(XS_POSIX_ctime); /* prototype to pass -Wmissing-prototypes */ 3482 XS(XS_POSIX_ctime) 3483 ###### { 3484 ###### dXSARGS; 3485 ###### if (items != 1) 3486 ###### Perl_croak(aTHX_ "Usage: POSIX::ctime(time)"); 3487 ###### PERL_UNUSED_VAR(cv); /* -W */ 3488 { 3489 ###### Time_t time = (Time_t)SvNV(ST(0)); 3490 ###### char * RETVAL; 3491 ###### dXSTARG; 3492 3493 ###### RETVAL = ctime(&time); 3494 ###### sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG; 3495 } 3496 ###### XSRETURN(1); 3497 } 3498 3499 3500 XS(XS_POSIX_times); /* prototype to pass -Wmissing-prototypes */ 3501 XS(XS_POSIX_times) 3502 ###### { 3503 ###### dXSARGS; 3504 ###### if (items != 0) 3505 ###### Perl_croak(aTHX_ "Usage: POSIX::times()"); 3506 ###### PERL_UNUSED_VAR(cv); /* -W */ 3507 ###### PERL_UNUSED_VAR(ax); /* -Wall */ 3508 ###### SP -= items; 3509 { 3510 #line 1750 "POSIX.xs" 3511 struct tms tms; 3512 clock_t realtime; 3513 realtime = times( &tms ); 3514 EXTEND(SP,5); 3515 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) ); 3516 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) ); 3517 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) ); 3518 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) ); 3519 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) ); 3520 #line 3521 "POSIX.c" 3521 ###### PUTBACK; 3522 return; 3523 } 3524 } 3525 3526 3527 XS(XS_POSIX_difftime); /* prototype to pass -Wmissing-prototypes */ 3528 XS(XS_POSIX_difftime) 3529 ###### { 3530 ###### dXSAR