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.)

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 8c5988f..3ba3c5b 100644 (file)
--- 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;