+#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 <sys/utsname.h>
+#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
#include <fcntl.h>
#ifdef HAS_TZNAME
-# if !defined(WIN32) && !defined(__CYGWIN__)
+# if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE)
extern char *tzname[];
# endif
#else
#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")
# 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
# ifdef I_UTIME
# include <utime.h>
# endif
-#endif /* WIN32 */
+#endif /* WIN32 || NETWARE */
#endif /* __VMS */
typedef int SysRet;
/* 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")
#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")
#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)
{
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. */
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;
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;
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;
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;
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;
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;
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
MODULE = POSIX PACKAGE = POSIX
-INCLUDE: constants.xs
+INCLUDE: const-xs.inc
void
int_macro_int(sv, iv)
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
struct sigaction act;
struct sigaction oact;
sigset_t sset;
+ SV *osset_sv;
sigset_t osset;
POSIX__SigSet sigset;
SV** svp;
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. */
}
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")) {
* essentially meaningless anyway.
*/
RETVAL = sigaction(sig, & act, (struct sigaction *)0);
+ if(RETVAL == -1)
+ XSRETURN_UNDEF;
}
LEAVE;
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;
+ }
+
projects / p5sagit/p5-mst-13.2.git / blobdiff