X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPOSIX%2FPOSIX.xs;h=238c5285ef242ef4fd7c8585f4fe6d74379ddcf0;hb=1cb0fb506639f41107792256805556ee04e5463a;hp=030a68cc4daed001607242bcdf4e51b5bc22e110;hpb=ee96af8ff6e9f715a42440fa2eb3e1834eb07e91;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 030a68c..238c528 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1,14 +1,27 @@ +#define PERL_EXT_POSIX + #ifdef WIN32 #define _POSIX_ #endif +#ifdef NETWARE + #define _POSIX_ + /* + * Ideally this should be somewhere down in the includes + * but putting it in other places is giving compiler errors. + * Also here I am unable to check for HAS_UNAME since it wouldn't have + * yet come into the file at this stage - sgp 18th Oct 2000 + */ + #include +#endif /* NETWARE */ + #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #define PERLIO_NOT_STDIO 1 #include "perl.h" #include "XSUB.h" -#if defined(PERL_OBJECT) || defined(PERL_CAPI) || defined(PERL_IMPLICIT_SYS) +#if defined(PERL_IMPLICIT_SYS) # undef signal # undef open # undef setmode @@ -65,7 +78,7 @@ #include #ifdef HAS_TZNAME -# if !defined(WIN32) && !defined(__CYGWIN__) +# if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) extern char *tzname[]; # endif #else @@ -126,7 +139,7 @@ char *tzname[] = { "" , "" }; #if defined (__CYGWIN__) # define tzname _tzname #endif -#if defined (WIN32) +#if defined (WIN32) || defined (NETWARE) # undef mkfifo # define mkfifo(a,b) not_here("mkfifo") # define ttyname(a) (char*)not_here("ttyname") @@ -156,6 +169,12 @@ char *tzname[] = { "" , "" }; # define sigdelset(a,b) not_here("sigdelset") # define sigfillset(a) not_here("sigfillset") # define sigismember(a,b) not_here("sigismember") +#ifndef NETWARE +# undef setuid +# undef setgid +# define setuid(a) not_here("setuid") +# define setgid(a) not_here("setgid") +#endif /* NETWARE */ #else # ifndef HAS_MKFIFO @@ -182,7 +201,7 @@ char *tzname[] = { "" , "" }; # ifdef I_UTIME # include # endif -#endif /* WIN32 */ +#endif /* WIN32 || NETWARE */ #endif /* __VMS */ typedef int SysRet; @@ -211,9 +230,11 @@ typedef struct termios* POSIX__Termios; /* Possibly needed prototypes */ char *cuserid (char *); +#ifndef WIN32 double strtod (const char *, char **); long strtol (const char *, char **, int); unsigned long strtoul (const char *, char **, int); +#endif #ifndef HAS_CUSERID #define cuserid(a) (char *) not_here("cuserid") @@ -269,7 +290,9 @@ unsigned long strtoul (const char *, char **, int); #define tcsetpgrp(a,b) not_here("tcsetpgrp") #endif #ifndef HAS_TIMES +#ifndef NETWARE #define times(a) not_here("times") +#endif /* NETWARE */ #endif #ifndef HAS_UNAME #define uname(a) not_here("uname") @@ -328,6 +351,20 @@ unsigned long strtoul (const char *, char **, int); #endif #endif +/* Background: in most systems the low byte of the wait status + * is the signal (the lowest 7 bits) and the coredump flag is + * the eight bit, and the second lowest byte is the exit status. + * BeOS bucks the trend and has the bytes in different order. + * See beos/beos.c for how the reality is bent even in BeOS + * to follow the traditional. However, to make the POSIX + * wait W*() macros to work in BeOS, we need to unbend the + * reality back in place. --jhi */ +#ifdef __BEOS__ +# define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8) +#else +# define WMUNGE(x) (x) +#endif + static int not_here(char *s) { @@ -335,16 +372,7 @@ not_here(char *s) return -1; } -#define PERL_constant_NOTFOUND 1 -#define PERL_constant_NOTDEF 2 -#define PERL_constant_ISIV 3 -#define PERL_constant_ISNO 4 -#define PERL_constant_ISNV 5 -#define PERL_constant_ISPV 6 -#define PERL_constant_ISPVN 7 -#define PERL_constant_ISUNDEF 8 -#define PERL_constant_ISUV 9 -#define PERL_constant_ISYES 10 +#include "const-c.inc" /* These were implemented in the old "constant" subroutine. They are actually macros that take an integer argument and return an integer result. */ @@ -429,7 +457,7 @@ __END__ if (memEQ(name, "WSTOPSIG", 8)) { /* ^ */ #ifdef WSTOPSIG - *arg_result = WSTOPSIG(*arg_result); + *arg_result = WSTOPSIG(WMUNGE(*arg_result)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -440,7 +468,7 @@ __END__ if (memEQ(name, "WTERMSIG", 8)) { /* ^ */ #ifdef WTERMSIG - *arg_result = WTERMSIG(*arg_result); + *arg_result = WTERMSIG(WMUNGE(*arg_result)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -463,7 +491,7 @@ __END__ case 9: if (memEQ(name, "WIFEXITED", 9)) { #ifdef WIFEXITED - *arg_result = WIFEXITED(*arg_result); + *arg_result = WIFEXITED(WMUNGE(*arg_result)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -473,7 +501,7 @@ __END__ case 10: if (memEQ(name, "WIFSTOPPED", 10)) { #ifdef WIFSTOPPED - *arg_result = WIFSTOPPED(*arg_result); + *arg_result = WIFSTOPPED(WMUNGE(*arg_result)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -489,7 +517,7 @@ __END__ if (memEQ(name, "WEXITSTATUS", 11)) { /* ^ */ #ifdef WEXITSTATUS - *arg_result = WEXITSTATUS(*arg_result); + *arg_result = WEXITSTATUS(WMUNGE(*arg_result)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -500,7 +528,7 @@ __END__ if (memEQ(name, "WIFSIGNALED", 11)) { /* ^ */ #ifdef WIFSIGNALED - *arg_result = WIFSIGNALED(*arg_result); + *arg_result = WIFSIGNALED(WMUNGE(*arg_result)); return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -513,17 +541,16 @@ __END__ return PERL_constant_NOTFOUND; } -#include "constants.c" - static void -restore_sigmask(sigset_t *ossetp) +restore_sigmask(pTHX_ SV *osset_sv) { - /* Fortunately, restoring the signal mask can't fail, because - * there's nothing we can do about it if it does -- we're not - * supposed to return -1 from sigaction unless the disposition - * was unaffected. - */ - (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0); + /* Fortunately, restoring the signal mask can't fail, because + * there's nothing we can do about it if it does -- we're not + * supposed to return -1 from sigaction unless the disposition + * was unaffected. + */ + sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv ); + (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0); } MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig @@ -765,7 +792,7 @@ setcc(termios_ref, ccix, cc) MODULE = POSIX PACKAGE = POSIX -INCLUDE: constants.xs +INCLUDE: const-xs.inc void int_macro_int(sv, iv) @@ -1167,7 +1194,7 @@ sigaction(sig, optaction, oldaction = 0) SV * optaction POSIX::SigAction oldaction CODE: -#ifdef WIN32 +#if defined(WIN32) || defined(NETWARE) RETVAL = not_here("sigaction"); #else # This code is really grody because we're trying to make the signal @@ -1179,6 +1206,7 @@ sigaction(sig, optaction, oldaction = 0) struct sigaction act; struct sigaction oact; sigset_t sset; + SV *osset_sv; sigset_t osset; POSIX__SigSet sigset; SV** svp; @@ -1206,10 +1234,12 @@ sigaction(sig, optaction, oldaction = 0) sigfillset(&sset); RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset); if(RETVAL == -1) - XSRETURN(1); + XSRETURN_UNDEF; ENTER; /* Restore signal mask no matter how we exit this block. */ - SAVEDESTRUCTOR(restore_sigmask, &osset); + osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t)); + SAVEFREESV( osset_sv ); + SAVEDESTRUCTOR_X(restore_sigmask, osset_sv); RETVAL=-1; /* In case both oldaction and action are 0. */ @@ -1226,7 +1256,7 @@ sigaction(sig, optaction, oldaction = 0) } RETVAL = sigaction(sig, (struct sigaction *)0, & oact); if(RETVAL == -1) - XSRETURN(1); + XSRETURN_UNDEF; /* Get back the mask. */ svp = hv_fetch(oldaction, "MASK", 4, TRUE); if (sv_isa(*svp, "POSIX::SigSet")) { @@ -1288,6 +1318,8 @@ sigaction(sig, optaction, oldaction = 0) * essentially meaningless anyway. */ RETVAL = sigaction(sig, & act, (struct sigaction *)0); + if(RETVAL == -1) + XSRETURN_UNDEF; } LEAVE; @@ -1738,40 +1770,12 @@ char * ttyname(fd) int fd -#XXX: use sv_getcwd() void getcwd() - PPCODE: -#ifdef HAS_GETCWD - char * buf; - int buflen = 128; - - New(0, buf, buflen, char); - /* Many getcwd()s know how to automatically allocate memory - * for the directory if the buffer argument is NULL but... - * (1) we cannot assume all getcwd()s do that - * (2) this may interfere with Perl's malloc - * So let's not. --jhi */ - while ((getcwd(buf, buflen) == NULL) && errno == ERANGE) { - buflen += 128; - if (buflen > MAXPATHLEN) { - Safefree(buf); - buf = NULL; - break; - } - Renew(buf, buflen, char); - } - if (buf) { - PUSHs(sv_2mortal(newSVpv(buf, 0))); - Safefree(buf); - } - else - PUSHs(&PL_sv_undef); -#else - require_pv("Cwd.pm"); - /* Module require may have grown the stack */ - SPAGAIN; - PUSHMARK(sp); - PUTBACK; - XSRETURN(call_pv("Cwd::cwd", GIMME_V)); -#endif + PPCODE: + { + dXSTARG; + getcwd_sv(TARG); + XSprePUSH; PUSHTARG; + } +