Patches for VMS [Dan Sugalski]

p4raw-id: //depot/perl@173

4 files changed, 193 insertions, 3 deletions

diff --git a/vms/descrip.mms b/vms/descrip.mms
index 7681f21586..47e192e9b0 100644
--- a/vms/descrip.mms
+++ b/vms/descrip.mms
@@ -28,6 +28,12 @@
 #:                           SOCKETSHR socket support.
 #:                           /Macro="DECC_SOCKETS=1" to include UCX (or
 #:                           compatible) socket support
+#:			     /Macro="OLDTHREADED=1" to compile with the old
+#:			     pthreads API (VMS version 6.2 and previous)
+#:                           /Macro="THREADED=1" to compile with full POSIX
+#:                           threads. (VMS 7.0 and above)
+#:                           /Macro="FAKETHREADED=1" to compile with the
+#:                           fake threads package
 #
 #	tidy      -- purge files generated by executing this file
 #	clean     -- remove all intermediate (e.g. object files, C files generated
@@ -202,8 +208,33 @@ SOCKOBJ =
 SOCKPM =
 .endif
 
+THREADH = 
+THREAD = 
+
+.ifdef THREADED
+THREADDEF = ,USE_THREADS,MULTIPLICITY
+THREADH = thread.h
+THREAD = THREAD
+.endif
+
+.ifdef OLDTHREADED
+THREADDEF = ,USE_THREADS,MULTIPLICITY,OLD_PTHREADS_API
+THREADH = thread.h
+THREAD = THREAD
+LIBS2 = sys$share:cma$lib_shr/share,cma$rtl/share
+.ifdef __AXP__
+LIBS2 = $(LIBS2),sys$share:cma$open_lib_shr/share,cma$open_rtl/share
+.endif
+.endif
+
+.ifdef FAKETHREADED
+THREADDEF = ,USE_THREADS,MULTIPLICITY,FAKE_THREADS
+THREADH = thread.h fakethr.h
+THREAD = THREAD
+.endif
+
 # C preprocessor manifest "DEBUGGING" ==> perl -D, not the VMS debugger
-CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS)
+CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF)$(THREADDEF))$(XTRACCFLAGS)$(DBGCCFLAGS)
 LINKFLAGS = $(DBGLINKFLAGS)
 
 MAKE = $(MMS)
@@ -246,7 +277,7 @@ h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h
 h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h
 h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h
 h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h, perlio.h, perlsdio.h
-h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS)
+h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS) $(THREADH)
 
 c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c, universal.c, perlio.c
 c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c
@@ -311,7 +342,7 @@ all : base extras x2p archcorefiles preplibrary perlpods
 .endif
 base : miniperl perl
 	@ $(NOOP)
-extras : Fcntl IO Opcode $(POSIX) libmods utils podxform
+extras : Fcntl IO Opcode attrs $(POSIX) $(THREAD) libmods utils podxform
 	@ $(NOOP)
 libmods : $(LIBPREREQ)
 	@ $(NOOP)
@@ -466,6 +497,25 @@ Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E)
 [.ext.Fcntl]Descrip.MMS : [.ext.Fcntl]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
 	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
 
+attrs : [.lib]attrs.pm [.lib.auto.attrs]attrs$(E)
+	@ $(NOOP)
+
+[.lib]attrs.pm : [.ext.attrs]Descrip.MMS
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.attrs]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto.attrs]attrs$(E) : [.ext.attrs]Descrip.MMS
+	@ Set Default [.ext.attrs]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.attrs]Descrip.MMS : [.ext.Fcntl]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.attrs]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
 POSIX : [.lib]POSIX.pm [.lib.auto.POSIX]POSIX$(E)
 	@ $(NOOP)
 
@@ -485,6 +535,25 @@ POSIX : [.lib]POSIX.pm [.lib.auto.POSIX]POSIX$(E)
 [.ext.POSIX]Descrip.MMS : [.ext.POSIX]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
 	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.POSIX]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
 
+THREAD : [.lib]THREAD.pm [.lib.auto.THREAD]THREAD$(E)
+	@ $(NOOP)
+
+[.lib]THREAD.pm : [.ext.THREAD]Descrip.MMS
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.THREAD]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto.THREAD]THREAD$(E) : [.ext.THREAD]Descrip.MMS
+	@ Set Default [.ext.THREAD]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.THREAD]Descrip.MMS : [.ext.THREAD]Makefile.PL $(LIBPREREQ) $(DBG)perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.THREAD]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
 IO : [.lib]IO.pm [.lib.IO]File.pm [.lib.IO]Handle.pm [.lib.IO]Pipe.pm [.lib.IO]Seekable.pm [.lib.IO]Socket.pm [.lib.auto.IO]IO$(E)
 	@ $(NOOP)
 
@@ -1783,6 +1852,14 @@ realclean : clean
 	Set Default [.ext.Opcode]
 	- $(MMS) realclean
 	Set Default [--]
+	Set Default [.ext.attrs]
+	- $(MMS) realclean
+	Set Default [--]
+.ifdef THREAD
+	Set Default [.ext.Thread]
+	- $(MMS) realclean
+	Set Default [--]
+.endif
 .ifdef DECC
 	Set Default [.ext.POSIX]
 	- $(MMS) realclean
diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index e451e1826b..5767c5f73f 100644
--- a/vms/gen_shrfls.pl
+++ b/vms/gen_shrfls.pl
@@ -150,6 +150,7 @@ sub scan_var {
   $line =~ s/\[.*//;
   $line =~ s/=.*//;
   $line =~ s/\W*;?\s*$//;
+  $line =~ s/\(void//;
   print "\tfiltered to \\$line\\\n" if $debug > 1;
   if ($line =~ /(\w+)$/) {
     print "\tvar name is \\$1\\" . ($const ? ' (const)' : '') . "\n" if $debug > 1;
diff --git a/vms/vms.c b/vms/vms.c
index d4f3f30124..84330e2f98 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -3179,6 +3179,79 @@ void my_endpwent()
 /*}}}*/
 
 #if __VMS_VER < 70000000 || __DECC_VER < 50200000
+/* Signal handling routines, pulled into the core from POSIX.xs.
+ *
+ * We need these for threads, so they've been rolled into the core,
+ * rather than left in POSIX.xs.
+ *
+ * (DRS, Oct 23, 1997)
+ */
+
+/* sigset_t is atomic under VMS, so these routines are easy */
+int my_sigemptyset(sigset_t *set) {
+  if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+  *set = 0; return 0;
+}
+int my_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 my_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 my_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 my_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));
+}
+int my_sigprocmask(int how, sigset_t *set, sigset_t *oset) {
+  sigset_t tempmask;
+
+  /* If set and oset are both null, then things are badky wrong. Bail */
+  if ((oset == NULL) && (set == NULL)) {
+    set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO);
+    return -1;
+  }
+
+  /* If set's null, then we're just handling a fetch. */
+  if (set == NULL) {
+    tempmask = sigblock(0);
+  } else {
+    switch (how) {
+    case SIG_SETMASK:
+      tempmask = sigsetmask(*set);
+      break;
+    case SIG_BLOCK:
+      tempmask = sigblock(*set);
+      break;
+    case SIG_UNBLOCK:
+      tempmask = sigblock(0);
+      sigsetmask(*oset & ~tempmask);
+      break;
+    default:
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      return -1;
+    }
+  }
+
+  /* Did they pass us an oset? If so, stick our holding mask into it */
+  if (oset)
+    *oset = tempmask;
+  
+  return 0;
+}
+
 /* Used for UTC calculation in my_gmtime(), my_localtime(), my_time(),
  * my_utime(), and flex_stat(), all of which operate on UTC unless
  * VMSISH_TIMES is true.
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 2da1639baa..410031cca3 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -115,6 +115,12 @@
 #  define my_gmtime		Perl_my_gmtime
 #  define my_localtime		Perl_my_localtime
 #  define my_time		Perl_my_time
+#  define my_sigemptyset        Perl_my_sigemptyset
+#  define my_sigfillset         Perl_my_sigfillset
+#  define my_sigaddset          Perl_my_sigaddset
+#  define my_sigdelset          Perl_my_sigdelset
+#  define my_sigismember        Perl_my_sigismember
+#  define my_sigprocmask        Perl_my_sigprocmask
 #endif
 #  define cando_by_name		Perl_cando_by_name
 #  define flex_fstat		Perl_flex_fstat
@@ -336,6 +342,29 @@ struct utimbuf {
 #define gmtime(t) my_gmtime(t)
 #define localtime(t) my_localtime(t)
 #define time(t) my_time(t)
+#define sigemptyset(t) my_sigemptyset(t)
+#define sigfillset(t) my_sigfillset(t)
+#define sigaddset(t, u) my_sigaddset(t, u)
+#define sigdelset(t, u) my_sigdelset(t, u)
+#define sigismember(t, u) my_sigismember(t, u)
+#define sigprocmask(t, u, v) my_sigprocmask(t, u, v)
+typedef int sigset_t;
+/* 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
+#    define sigaction sigvec
+#    define sa_flags sv_onstack
+#    define sa_handler sv_handler
+#    define sa_mask sv_mask
+#    define sigsuspend(set) sigpause(*set)
+#    define sigpending(a) (not_here("sigpending"),0)
 #endif
 
 /* VMS doesn't use a real sys_nerr, but we need this when scanning for error
@@ -541,6 +570,16 @@ struct tm *	my_gmtime _((const time_t *));
 struct tm *	my_localtime _((const time_t *));
 time_t	my_time _((time_t *));
 #endif /* We're assuming these three come as a package */
+/* We're just gonna assume that if we've got an antique here that we */
+/* need the signal functions */
+#if __VMS_VER < 70000000 || __DECC_VER < 50200000
+int     my_sigemptyset _((sigset_t *));
+int     my_sigfillset  _((sigset_t *));
+int     my_sigaddset   _((sigset_t *, int));
+int     my_sigdelset   _((sigset_t *, int));
+int     my_sigismember _((sigset_t *, int));
+int     my_sigprocmask _((int, sigset_t *, sigset_t *));
+#endif
 I32	cando_by_name _((I32, I32, char *));
 int	flex_fstat _((int, struct mystat *));
 int	flex_stat _((char *, struct mystat *));