perl 5.002_01: ext/POSIX/POSIX.xs

VMS update: emulate several near misses in signal handling, and
slightly different header file structure.  (Yes, it's not strictly
POSIX, but it's close.)

1 files changed, 123 insertions, 11 deletions

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 8c5988f7d9..3ba3c5b426 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -6,11 +6,9 @@
 #include <dirent.h>
 #endif
 #include <errno.h>
-#include <fcntl.h>
 #ifdef I_FLOAT
 #include <float.h>
 #endif
-#include <grp.h>
 #ifdef I_LIMITS
 #include <limits.h>
 #endif
@@ -40,16 +38,130 @@
 #endif
 #include <string.h>
 #include <sys/stat.h>
-#include <sys/times.h>
 #include <sys/types.h>
-#ifdef HAS_UNAME
-#include <sys/utsname.h>
-#endif
-#include <sys/wait.h>
 #include <time.h>
 #include <unistd.h>
-#ifdef I_UTIME
-#include <utime.h>
+#if defined(__VMS) && !defined(__POSIX_SOURCE)
+#  include <file.h>         /* == fcntl.h for DECC; no fcntl.h for VAXC */
+#  include <libdef.h>       /* LIB$_INVARG constant */
+#  include <lib$routines.h> /* prototype for lib$ediv() */
+#  include <starlet.h>      /* prototype for sys$gettim() */
+
+#  undef mkfifo  /* #defined in perl.h */
+#  define mkfifo(a,b) (not_here("mkfifo"),-1)
+#  define tzset() not_here("tzset")
+
+   /* The default VMS emulation of Unix signals isn't very POSIXish */
+   typedef int sigset_t;
+#  define sigpending(a) (not_here("sigpending"),0)
+
+   /* sigset_t is atomic under VMS, so these routines are easy */
+   int sigemptyset(sigset_t *set) {
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	*set = 0; return 0;
+   }
+   int sigfillset(sigset_t *set) {
+	int i;
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	for (i = 0; i < NSIG; i++) *set |= (1 << i);
+	return 0;
+   }
+   int sigaddset(sigset_t *set, int sig) {
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+	*set |= (1 << (sig - 1));
+	return 0;
+   }
+   int sigdelset(sigset_t *set, int sig) {
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+	*set &= ~(1 << (sig - 1));
+	return 0;
+   }
+   int sigismember(sigset_t *set, int sig) {
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+	*set & (1 << (sig - 1));
+   }
+   /* The tools for sigprocmask() are there, just not the routine itself */
+#  ifndef SIG_UNBLOCK
+#    define SIG_UNBLOCK 1
+#  endif
+#  ifndef SIG_BLOCK
+#    define SIG_BLOCK 2
+#  endif
+#  ifndef SIG_SETMASK
+#    define SIG_SETMASK 3
+#  endif
+   int sigprocmask(int how, sigset_t *set, sigset_t *oset) {
+	if (!set || !oset) {
+	  set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO);
+	  return -1;
+	}
+	switch (how) {
+	  case SIG_SETMASK:
+	    *oset = sigsetmask(*set);
+	    break;
+	  case SIG_BLOCK:
+	    *oset = sigblock(*set);
+	    break;
+	  case SIG_UNBLOCK:
+	    *oset = sigblock(0);
+	    sigsetmask(*oset & ~*set);
+	    break;
+	  default:
+	    set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+	    return -1;
+	}
+	return 0;
+    }
+#  define sigaction sigvec
+#  define sa_flags sv_onstack
+#  define sa_handler sv_handler
+#  define sa_mask sv_mask
+#  define sigsuspend(set) sigpause(*set)
+
+   /* The POSIX notion of ttyname() is better served by getname() under VMS */
+   static char ttnambuf[64];
+#  define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
+
+   /* The non-POSIX CRTL times() has void return type, so we just get the
+      current time directly */
+   clock_t vms_times(struct tms *bufptr) {
+	clock_t retval;
+	/* Get wall time and convert to 10 ms intervals to
+	 * produce the return value that the POSIX standard expects */
+#  if defined(__DECC) && defined (__ALPHA)
+#    include <ints.h>
+	uint64 vmstime;
+	_ckvmssts(sys$gettim(&vmstime));
+	vmstime /= 100000;
+	retval = vmstime & 0x7fffffff;
+#  else
+	/* (Older hw or ccs don't have an atomic 64-bit type, so we
+	 * juggle 32-bit ints (and a float) to produce a time_t result
+	 * with minimal loss of information.) */
+	long int vmstime[2],remainder,divisor = 100000;
+	_ckvmssts(sys$gettim((unsigned long int *)vmstime));
+	vmstime[1] &= 0x7fff;  /* prevent overflow in EDIV */
+	_ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
+#  endif
+	/* Fill in the struct tms using the CRTL routine . . .*/
+	times((tbuffer_t *)bufptr);
+	return (clock_t) retval;
+   }
+#  define times(t) vms_times(t)
+#else
+#  include <fcntl.h>
+#  include <grp.h>
+#  include <sys/times.h>
+#  ifdef HAS_UNAME
+#    include <sys/utsname.h>
+#  endif
+#  include <sys/wait.h>
+#  ifdef I_UTIME
+#    include <utime.h>
+#  endif
 #endif
 
 typedef int SysRet;
@@ -2745,9 +2857,9 @@ sigaction(sig, action, oldaction = 0)
 	    if (action && oldaction)
 		RETVAL = sigaction(sig, & act, & oact);
 	    else if (action)
-		RETVAL = sigaction(sig, & act, (struct sigaction*)0);
+		RETVAL = sigaction(sig, & act, (struct sigaction *)0);
 	    else if (oldaction)
-		RETVAL = sigaction(sig, (struct sigaction*)0, & oact);
+		RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
 	    else
 		RETVAL = -1;