Lots of VMS changes. vms/gen_shrfls.pl (which parses header files)

needs rewriting now that we use perlvars.h and foovar.h:
	Subject: [PATCH] 5.004_54 under VMS (fwd)

p4raw-id: //depot/perl@374

25 files changed, 507 insertions, 209 deletions

diff --git a/dosish.h b/dosish.h
index ec7b85a4f6..c71ecd5e22 100644
--- a/dosish.h
+++ b/dosish.h
@@ -75,6 +75,14 @@
  */
 #undef USEMYBINMODE
 
+/* Stat_t:
+ *	This symbol holds the type used to declare buffers for information
+ *	returned by stat().  It's usually just struct stat.  It may be necessary
+ *	to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ *	information.
+ */
+#define Stat_t struct stat
+
 /* USE_STAT_RDEV:
  *	This symbol is defined if this system has a stat structure declaring
  *	st_rdev
diff --git a/handy.h b/handy.h
index 379fab8b04..de3028f121 100644
--- a/handy.h
+++ b/handy.h
@@ -65,7 +65,7 @@
 #endif /* NeXT */
 
 #ifndef HAS_BOOL
-# ifdef UTS
+# if defined(UTS) || defined(VMS)
 #  define bool int
 # else
 #  define bool char
diff --git a/intrpvar.h b/intrpvar.h
index b724e414e6..f3014cbb14 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -51,7 +51,7 @@ PERLVAR(Istatusvalue,	I32)		/* $? */
 PERLVAR(Istatusvalue_vms,	U32)		
 #endif
 
-PERLVAR(Istatcache,	struct stat)	/* _ */
+PERLVAR(Istatcache,	Stat_t)	/* _ */
 PERLVAR(Istatgv,	GV *)		
 PERLVARI(Istatname,	SV *,	Nullsv)	
 
diff --git a/os2/os2ish.h b/os2/os2ish.h
index 4895538d6e..4506bb4fb2 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -25,6 +25,14 @@
  */
 #undef USEMYBINMODE
 
+/* Stat_t:
+ *	This symbol holds the type used to declare buffers for information
+ *	returned by stat().  It's usually just struct stat.  It may be necessary
+ *	to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ *	information.
+ */
+#define Stat_t struct stat
+
 /* USE_STAT_RDEV:
  *	This symbol is defined if this system has a stat structure declaring
  *	st_rdev
diff --git a/perl.c b/perl.c
index d5811e0b35..c0fa69f021 100644
--- a/perl.c
+++ b/perl.c
@@ -913,6 +913,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     /* now parse the script */
 
+    SETERRNO(0,SS$_NORMAL);
     error_count = 0;
     if (yyparse() || error_count) {
 	if (minus_c)
@@ -1823,7 +1824,7 @@ SV *sv;
      *
      * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search
      * proceeds as follows:
-     *   If DOSISH:
+     *   If DOSISH or VMSISH:
      *     + look for ./scriptname{,.foo,.bar}
      *     + search the PATH for scriptname{,.foo,.bar}
      *
@@ -1833,11 +1834,20 @@ SV *sv;
      */
 
 #ifdef VMS
+#  ifdef ALWAYS_DEFTYPES
+    len = strlen(scriptname);
+    if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') {
+	int hasdir, idx = 0, deftypes = 1;
+	bool seen_dot = 1;
+
+	hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ;
+#  else
     if (dosearch) {
 	int hasdir, idx = 0, deftypes = 1;
 	bool seen_dot = 1;
 
 	hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
+#  endif
 	/* The first time through, just add SEARCH_EXTS to whatever we
 	 * already have, so we can check for default file types. */
 	while (deftypes ||
diff --git a/perl.h b/perl.h
index 67a171afa3..60c60d998f 100644
--- a/perl.h
+++ b/perl.h
@@ -75,7 +75,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 
 #define NOOP (void)0
 
-#define WITH_THR(s) do { dTHR; s; } while (0)
+#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
 
 /*
  * SOFT_CAST can be used for args to prototyped functions to retain some
diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h
index 9c8bd5049f..d984e4f4a2 100644
--- a/plan9/plan9ish.h
+++ b/plan9/plan9ish.h
@@ -60,6 +60,14 @@
  */
 #undef USEMYBINMODE
 
+/* Stat_t:
+ *	This symbol holds the type used to declare buffers for information
+ *	returned by stat().  It's usually just struct stat.  It may be necessary
+ *	to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ *	information.
+ */
+#define Stat_t struct stat
+
 /* USE_STAT_RDEV:
 *	This symbol is defined if this system has a stat structure declaring
 *	st_rdev
diff --git a/pp.c b/pp.c
index 39349844d8..7864089313 100644
--- a/pp.c
+++ b/pp.c
@@ -3526,7 +3526,7 @@ is_an_int(char *s, STRLEN l)
 }
 
 static int
-div128(SV *pnum, char *done)
+div128(SV *pnum, bool *done)
                           		    /* must be '\0' terminated */
                           
 {
diff --git a/proto.h b/proto.h
index a454a51f1e..97f3db2460 100644
--- a/proto.h
+++ b/proto.h
@@ -48,7 +48,7 @@ I32	block_gimme _((void));
 int	block_start _((int full));
 void	boot_core_UNIVERSAL _((void));
 void	call_list _((I32 oldscope, AV* list));
-I32	cando _((I32 bit, I32 effective, struct stat* statbufp));
+I32	cando _((I32 bit, I32 effective, Stat_t* statbufp));
 #ifndef CASTNEGFLOAT
 U32	cast_ulong _((double f));
 #endif
diff --git a/t/lib/thread.t b/t/lib/thread.t
index 5ac9e5bf71..9810ae48d9 100755
--- a/t/lib/thread.t
+++ b/t/lib/thread.t
@@ -4,7 +4,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require Config; import Config;
-    if ($Config{'ccflags'} !~ /-DUSE_THREADS\b/) {
+    if ($Config{'ccflags'} !~ /USE_THREADS\b/) {
 	print "1..0\n";
 	exit 0;
     }
@@ -49,6 +49,6 @@ join $t;
 
 # test that sleep lets other thread run
 $t = new Thread \&islocked,"ok 8\n";
-sleep 2;
+sleep 6;
 print "ok 9";
 join $t;
diff --git a/t/lib/timelocal.t b/t/lib/timelocal.t
index adc1b1b061..938ca695b1 100755
--- a/t/lib/timelocal.t
+++ b/t/lib/timelocal.t
@@ -19,6 +19,9 @@ use Time::Local;
    [2010, 10, 12, 14, 13, 12],
   );
 
+# use vmsish 'time' makes for oddness around the Unix epoch
+if ($^O eq 'VMS') { $time[0][2]++ }
+
 print "1..", @time * 2 + 5, "\n";
 
 $count = 1;
diff --git a/t/op/nothread.t b/t/op/nothread.t
index acc20890ae..7d42d276c8 100755
--- a/t/op/nothread.t
+++ b/t/op/nothread.t
@@ -9,7 +9,7 @@ BEGIN
   @INC = "../lib";
   require Config;
   import Config;
-  if ($Config{'ccflags'} =~ /-DUSE_THREADS\b/)
+  if ($Config{'ccflags'} =~ /USE_THREADS\b/)
    {
     print "1..0\n";
     exit 0;
diff --git a/taint.c b/taint.c
index 2dc43a4ab4..3ce09423d8 100644
--- a/taint.c
+++ b/taint.c
@@ -55,10 +55,12 @@ taint_env(void)
 	if (!svp || *svp == &sv_undef)
 	    break;
 	if (SvTAINTED(*svp)) {
+	    dTHR;
 	    TAINT;
 	    taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
 	}
 	if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) {
+	    dTHR;
 	    TAINT;
 	    taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
 	}
diff --git a/thrdvar.h b/thrdvar.h
index 4c698368a4..33419dea4e 100644
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -30,7 +30,7 @@ PERLVAR(Tmarkstack_max,	I32 *)
 
 PERLVAR(TSv,		SV *)		
 PERLVAR(TXpv,		XPV *)		
-PERLVAR(Tstatbuf,	struct stat)		
+PERLVAR(Tstatbuf,	Stat_t)		
 #ifdef HAS_TIMES
 PERLVAR(Ttimesbuf,	struct tms)		
 #endif
@@ -66,7 +66,7 @@ PERLVARI(Tcurcop,	COP * VOL,	&compiling)
 PERLVAR(Tin_eval,	VOL int)	/* trap "fatal" errors? */
 PERLVAR(Tdelaymagic,	int)		/* ($<,$>) = ... */
 PERLVAR(Tdirty,		bool)		/* In the middle of tearing things down? */
-PERLVAR(Tlocalizing,	U8)		/* are we processing a local() list? */
+PERLVAR(Tlocalizing,	int)		/* are we processing a local() list? */
 
 PERLVAR(Tcxstack,	PERL_CONTEXT *)		
 PERLVARI(Tcxstack_ix,	I32,	-1)	
diff --git a/toke.c b/toke.c
index dbb273a263..6773f3f13c 100644
--- a/toke.c
+++ b/toke.c
@@ -1068,6 +1068,7 @@ incl_perldb(void)
 
 	if (pdb)
 	    return pdb;
+	SETERRNO(0,SS$_NORMAL);
 	return "BEGIN { require 'perl5db.pl' }";
     }
     return "";
diff --git a/unixish.h b/unixish.h
index e4687ce50f..6cb748f4e3 100644
--- a/unixish.h
+++ b/unixish.h
@@ -42,6 +42,14 @@
  */
 #undef USEMYBINMODE
 
+/* Stat_t:
+ *	This symbol holds the type used to declare buffers for information
+ *	returned by stat().  It's usually just struct stat.  It may be necessary
+ *	to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ *	information.
+ */
+#define Stat_t struct stat
+
 /* USE_STAT_RDEV:
  *	This symbol is defined if this system has a stat structure declaring
  *	st_rdev
diff --git a/vms/config.vms b/vms/config.vms
index d6453ba34a..9aad64e493 100644
--- a/vms/config.vms
+++ b/vms/config.vms
@@ -76,7 +76,8 @@
  * when Perl is built.  Please do not change it by hand; make
  * any changes to FndVers.Com instead.
  */
-#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_004"     /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00454"   /**/
+
 #define ARCHLIB ARCHLIB_EXP	/*config-skip*/
 
 /* ARCHNAME:
diff --git a/vms/descrip.mms b/vms/descrip.mms
index 47e192e9b0..f26e0b6bb0 100644
--- a/vms/descrip.mms
+++ b/vms/descrip.mms
@@ -74,7 +74,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O)
 .endif
 
 # Updated by fndvers.com -- do not edit by hand
-PERL_VERSION = 5_004  #
+PERL_VERSION = 5_00454#
 
 .ifdef DECC_SOCKETS
 SOCKET=1
@@ -130,7 +130,7 @@ POSIX =
 .else
 XTRAOBJS = 
 LIBS1 = $(XTRAOBJS)
-DBGSPECFLAGS = /Show=(Source,Include,Expansion)
+DBGSPECFLAGS = /Show=All
 .ifdef decc
 # Some versions of DECCRTL on AXP have a bug in chdir() which causes the change
 # to persist after the image exits, even when this was not requested, iff
@@ -370,10 +370,9 @@ archcorefiles :  $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9)
 
 miniperl : $(DBG)miniperl$(E)
 	@ Continue
-miniperl_objs = miniperlmain$(O), $(obj)
 $(MINIPERL_EXE) :  miniperlmain$(O), $(DBG)libperl$(OLB) $(CRTL)
 	Link $(LINKFLAGS)/NoDebug/NoMap/NoFull/NoCross/Exe=$(MMS$TARGET) miniperlmain$(O), $(DBG)libperl$(OLB)/Library/Include=globals $(CRTLOPTS)
-$(DBG)miniperl$(E) :  $(miniperl_objs), $(DBG)libperl$(OLB) $(CRTL)
+$(DBG)miniperl$(E) :  miniperlmain$(O), $(DBG)libperl$(OLB) $(CRTL)
 	Link $(LINKFLAGS)/Exe=$(MMS$TARGET) miniperlmain$(O),$(DBG)libperl$(OLB)/Library/Include=globals  $(CRTLOPTS)
 
 $(DBG)libperl$(OLB) : $(obj)
diff --git a/vms/fndvers.com b/vms/fndvers.com
index 2e49ae6fcb..f668666956 100755
--- a/vms/fndvers.com
+++ b/vms/fndvers.com
@@ -58,7 +58,7 @@ $ If .not.teststs Then Exit teststs
 $!
 $ If teststs.ne.1 ! current values in config.vms are appropriate
 $ Then
-$   token = """""""""VMS_''arch'  /**/"""""""""
+$   token = """""""""VMS_''arch'""""""""  /**/"
 $   Call update_file "''p2'" "#define ARCHNAME" "''token'"
 $   teststs = $Status
 $   If .not.teststs Then Exit teststs
diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index 5767c5f73f..807ce59a90 100644
--- a/vms/gen_shrfls.pl
+++ b/vms/gen_shrfls.pl
@@ -39,7 +39,7 @@ require 5.000;
 
 $debug = $ENV{'GEN_SHRFLS_DEBUG'};
 
-print "gen_shrfls.pl Rev. 14-Dec-1996\n" if $debug;
+print "gen_shrfls.pl Rev. 03-Nov-1997\n" if $debug;
 
 if ($ARGV[0] eq '-f') {
   open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n";
@@ -150,7 +150,7 @@ sub scan_var {
   $line =~ s/\[.*//;
   $line =~ s/=.*//;
   $line =~ s/\W*;?\s*$//;
-  $line =~ s/\(void//;
+  $line =~ s/\W*\)\s*\(.*$//; # closing paren for args stripped in previous stmt
   print "\tfiltered to \\$line\\\n" if $debug > 1;
   if ($line =~ /(\w+)$/) {
     print "\tvar name is \\$1\\" . ($const ? ' (const)' : '') . "\n" if $debug > 1;
@@ -216,6 +216,12 @@ LINE: while (<CPP>) {
     &scan_enum($_);
     last LINE unless $_ = <CPP>;
   }
+  while (/^#.*thread\.h/i .. /^#.*perl\.h/i) {
+    print "thread.h>> $_" if $debug > 2;
+    if (/\s*^EXT/) { &scan_var($_);  }
+    else        { &scan_func($_); }
+    last LINE unless $_ = <CPP>;
+  }
   while (/^#.*proto\.h/i .. /^#.*perl\.h/i) {
     print "proto.h>> $_" if $debug > 2;
     if (/\s*^EXT/) { &scan_var($_);  }
@@ -373,7 +379,7 @@ if ($ENV{PERLSHR_USE_GSMATCH}) {
   my $minor = int(($] * 1000 - $major) * 100 + 0.5) & 0xFF;  # range 0..255
   print OPTBLD "GSMATCH=LEQUAL,$major,$minor\n";
   foreach (@symfiles) {
-    print OPTBLD "CLUSTER=\$\$TRANSFER_VECTOR,,,$_.$objsuffix\n";
+    print OPTBLD "CLUSTER=\$\$TRANSFER_VECTOR,,,$_$objsuffix\n";
   }
 }
 elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); }
diff --git a/vms/genconfig.pl b/vms/genconfig.pl
index d2e514b1c9..3b88be529b 100644
--- a/vms/genconfig.pl
+++ b/vms/genconfig.pl
@@ -6,7 +6,7 @@
 # that went into your perl binary.  In addition, values which change from run
 # to run may be supplied on the command line as key=val pairs.
 #
-# Rev.  3-Dec-1996  Charles Bailey  bailey@genetics.upenn.edu
+# Rev. 10-Nov-1997  Charles Bailey  bailey@newman.upenn.edu
 #
 
 #==== Locations of installed Perl components
@@ -78,10 +78,9 @@ ar=''
 eunicefix=':'
 hint='none'
 hintfile=''
-shrplib='define'
+useshrplib='define'
 usemymalloc='n'
 usevfork='true'
-useposix='false'
 spitshell='write sys\$output '
 dlsrc='dl_vms.c'
 binexp='$installbin'
@@ -146,7 +145,21 @@ foreach (@ARGV) {
       # object file suffix if it's not .obj.
       $ccflags =~ s#/obj(?:ect)?=[^/\s]+##i;
     }
+    $debug = $optimize = '';
+    while ( ($qual) = $ccflags =~ m|(/(No)?Deb[^/]*)|i ) {
+      $debug = $qual;
+      $ccflags =~ s/$qual//;
+    }
+    while ( ($qual) = $ccflags =~ m|(/(No)?Opt[^/]*)|i ) {
+      $optimize = $qual;
+      $ccflags =~ s/$qual//;
+    }
+    $optimize = "$debug$optimize";
     print OUT "ccflags='$ccflags'\n";
+    print OUT "optimize='$optimize'\n";
+    $usethreads = ($ccflags =~ m!/DEF[^/]+USE_THREADS!i and
+                   $ccflags !~ m!/UND[^/]+USE_THREADS!i);
+    print OUT "usethreads='$usethreads'\n";
     $dosock = ($ccflags =~ m!/DEF[^/]+VMS_DO_SOCKETS!i and
                $ccflags !~ m!/UND[^/]+VMS_DO_SOCKETS!i);
     print OUT "d_vms_do_sockets=",$dosock ? "'define'\n" : "'undef'\n";
@@ -156,9 +169,13 @@ foreach (@ARGV) {
     print OUT "d_select=",$dosock ? "'define'\n" : "'undef'\n";
     print OUT "i_niin=",$dosock ? "'define'\n" : "'undef'\n";
     print OUT "i_neterrno=",$dosock ? "'define'\n" : "'undef'\n";
+    if ($dosock and $cctype eq 'decc' and $ccflags =~ /DECCRTL_SOCKETS/) {
+      print OUT "selecttype=fd_set\n";
+    }
+    else { print OUT "selecttype=int\n"; }
 
-    if ($cctype eq 'decc') { $rtlhas  = 'define'; }
-    else                   { $rtlhas  = 'undef';  }
+    if ($cctype eq 'decc') { $rtlhas  = 'define'; print OUT "useposix='true'\n";  }
+    else                   { $rtlhas  = 'undef';  print OUT "useposix='false'\n"; }
     foreach (qw[ d_stdstdio d_stdio_ptr_lval d_stdio_cnt_lval d_stdiobase
                  d_locconv d_setlocale i_locale d_mbstowcs d_mbtowc
                  d_wcstombs d_wctomb d_mblen d_mktime d_strcoll d_strxfrm ]) {
diff --git a/vms/test.com b/vms/test.com
index 114cb24a40..201b5f57d6 100644
--- a/vms/test.com
+++ b/vms/test.com
@@ -111,7 +111,7 @@ $| = 1;
 
 @ARGV = grep($_,@ARGV);  # remove empty elements due to "''p1'" syntax
 
-if ($ARGV[0] eq '-v') {
+if (lc($ARGV[0]) eq '-v') {
     $verbose = 1;
     shift;
 }
diff --git a/vms/vms.c b/vms/vms.c
index 84330e2f98..b55681984a 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -2,8 +2,8 @@
  *
  * VMS-specific routines for perl5
  *
- * Last revised: 11-Apr-1997 by Charles Bailey  bailey@genetics.upenn.edu
- * Version: 5.3.97c
+ * Last revised:  9-Nov-1997 by Charles Bailey  bailey@newman.upenn.edu
+ * Version: 5.4.53a
  */
 
 #include <acedef.h>
@@ -19,6 +19,7 @@
 #include <fscndef.h>
 #include <iodef.h>
 #include <jpidef.h>
+#include <kgbdef.h>
 #include <libdef.h>
 #include <lib$routines.h>
 #include <lnmdef.h>
@@ -113,37 +114,48 @@ my_trnlnm(char *lnm, char *eqv, unsigned long int idx)
  * domain (mostly - my_getenv() need not return a translation from
  * the process logical name table)
  *
- * Note: Uses static buffer -- not thread-safe!
+ * Note: Uses Perl temp to store result so char * can be returned to
+ * caller; this pointer will be invalidated at next Perl statement
+ * transition.
  */
 /*{{{ char *my_getenv(char *lnm)*/
 char *
 my_getenv(char *lnm)
 {
     static char __my_getenv_eqv[LNM$C_NAMLENGTH+1];
-    char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2;
+    char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2, *eqv;
     unsigned long int idx = 0;
     int trnsuccess;
-
+    SV *tmpsv;
+
+    if (curinterp) {  /* Perl interpreter running -- may be threaded */
+      /* Set up a temporary buffer for the return value; Perl will
+       * clean it up at the next statement transition */
+      tmpsv = sv_2mortal(newSVpv("",LNM$C_NAMLENGTH+1));
+      if (!tmpsv) return NULL;
+      eqv = SvPVX(tmpsv);
+    }
+    else eqv = __my_getenv_eqv;  /* Assume no interpreter ==> single thread */
     for (cp1 = lnm, cp2= uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1);
     *cp2 = '\0';
     if (cp1 - lnm == 7 && !strncmp(uplnm,"DEFAULT",7)) {
-      getcwd(__my_getenv_eqv,sizeof __my_getenv_eqv);
-      return __my_getenv_eqv;
+      getcwd(eqv,LNM$C_NAMLENGTH);
+      return eqv;
     }
     else {
       if ((cp2 = strchr(uplnm,';')) != NULL) {
         *cp2 = '\0';
         idx = strtoul(cp2+1,NULL,0);
       }
-      trnsuccess = my_trnlnm(uplnm,__my_getenv_eqv,idx);
+      trnsuccess = my_trnlnm(uplnm,eqv,idx);
       /* If we had a translation index, we're only interested in lnms */
       if (!trnsuccess && cp2 != NULL) return Nullch;
-      if (trnsuccess) return __my_getenv_eqv;
+      if (trnsuccess) return eqv;
       else {
         unsigned long int retsts;
         struct dsc$descriptor_s symdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
-                                valdsc = {sizeof __my_getenv_eqv,DSC$K_DTYPE_T,
-                                          DSC$K_CLASS_S, __my_getenv_eqv};
+                                valdsc = {LNM$C_NAMLENGTH,DSC$K_DTYPE_T,
+                                          DSC$K_CLASS_S, eqv};
         symdsc.dsc$w_length = cp1 - lnm;
         symdsc.dsc$a_pointer = uplnm;
         retsts = lib$get_symbol(&symdsc,&valdsc,&(valdsc.dsc$w_length),0);
@@ -171,14 +183,20 @@ prime_env_iter(void)
  * find, in preparation for iterating over it.
  */
 {
+  dTHR;
   static int primed = 0;  /* XXX Not thread-safe!!! */
   HV *envhv = GvHVn(envgv);
   FILE *sholog;
   char eqv[LNM$C_NAMLENGTH+1],*start,*end;
   STRLEN eqvlen;
   SV *oldrs, *linesv, *eqvsv;
+#ifdef USE_THREADS
+  static perl_mutex primenv_mutex = PTHREAD_MUTEX_INITIALIZER;
+#endif
 
   if (primed) return;
+  MUTEX_LOCK(&primenv_mutex);
+  if (primed) { MUTEX_UNLOCK(&primenv_mutex); return; }
   /* Perform a dummy fetch as an lval to insure that the hash table is
    * set up.  Otherwise, the hv_store() will turn into a nullop */
   (void) hv_fetch(envhv,"DEFAULT",7,TRUE);
@@ -190,8 +208,10 @@ prime_env_iter(void)
   (void) hv_fetch(envhv,"USER",4,TRUE);
 
   /* Now, go get the logical names */
-  if ((sholog = safe_popen("$ Show Logical *","r")) == Nullfp)
+  if ((sholog = safe_popen("$ Show Logical *","r")) == Nullfp) {
+    MUTEX_UNLOCK(&primenv_mutex);
     _ckvmssts(vaxc$errno);
+  }
   /* We use Perl's sv_gets to read from the pipe, since safe_popen is
    * tied to Perl's I/O layer, so it may not return a simple FILE * */
   oldrs = rs;
@@ -202,6 +222,7 @@ prime_env_iter(void)
       my_pclose(sholog);
       SvREFCNT_dec(linesv); SvREFCNT_dec(rs); rs = oldrs;
       primed = 1;
+      MUTEX_UNLOCK(&primenv_mutex);
       return;
     }
     while (*start != '"' && *start != '=' && *start) start++;
@@ -215,7 +236,7 @@ prime_env_iter(void)
           warn("Ill-formed logical name |%s| in prime_env_iter",start);
         continue;
       }
-      else _ckvmssts(vaxc$errno);
+      else { MUTEX_UNLOCK(&primenv_mutex); _ckvmssts(vaxc$errno); }
     }
     else {
       eqvsv = newSVpv(eqv,eqvlen);
@@ -335,7 +356,7 @@ do_rmdir(char *name)
 {
     char dirfile[NAM$C_MAXRSS+1];
     int retval;
-    struct mystat st;
+    Stat_t st;
 
     if (do_fileify_dirspec(name,dirfile,0) == NULL) return -1;
     if (flex_stat(dirfile,&st) || !S_ISDIR(st.st_mode)) retval = -1;
@@ -924,17 +945,20 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts)
     static char __fileify_retbuf[NAM$C_MAXRSS+1];
     unsigned long int dirlen, retlen, addmfd = 0, hasfilename = 0;
     char *retspec, *cp1, *cp2, *lastdir;
-    char trndir[NAM$C_MAXRSS+1], vmsdir[NAM$C_MAXRSS+1];
+    char trndir[NAM$C_MAXRSS+2], vmsdir[NAM$C_MAXRSS+1];
 
     if (!dir || !*dir) {
       set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
     }
     dirlen = strlen(dir);
-    if (dir[dirlen-1] == '/') --dirlen;
-    if (!dirlen) {
-      set_errno(ENOTDIR);
-      set_vaxc_errno(RMS$_DIR);
-      return NULL;
+    while (dir[dirlen-1] == '/') --dirlen;
+    if (!dirlen) { /* We had Unixish '/' -- substitute top of current tree */
+      strcpy(trndir,"/sys$disk/000000");
+      dir = trndir;
+      dirlen = 16;
+    }
+    if (dirlen > NAM$C_MAXRSS) {
+      set_errno(ENAMETOOLONG); set_vaxc_errno(RMS$_SYN); return NULL;
     }
     if (!strpbrk(dir+1,"/]>:")) {
       strcpy(trndir,*dir == '/' ? dir + 1: dir);
@@ -1001,6 +1025,14 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts)
           cp1++;
         } while ((cp1 = strstr(cp1,"/.")) != NULL);
       }
+      else if (!strcmp(&dir[dirlen-7],"/000000")) {
+        /* Ditto for specs that end in an MFD -- let the VMS code
+         * figure out whether it's a real device or a rooted logical. */
+        dir[dirlen] = '/'; dir[dirlen+1] = '\0';
+        if (do_tovmsspec(dir,vmsdir,0) == NULL) return NULL;
+        if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) return NULL;
+        return do_tounixspec(trndir,buf,ts);
+      }
       else {
         if ( !(lastdir = cp1 = strrchr(dir,'/')) &&
              !(lastdir = cp1 = strrchr(dir,']')) &&
@@ -1544,6 +1576,11 @@ static char *do_tovmsspec(char *path, char *buf, int ts) {
     STRLEN trnend;
 
     while (*(cp2+1) == '/') cp2++;  /* Skip multiple /s */
+    if (!*(cp2+1)) {
+      if (!buf & ts) Renew(rslt,18,char);
+      strcpy(rslt,"sys$disk:[000000]");
+      return rslt;
+    }
     while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
     *cp1 = '\0';
     islnm =  my_trnlnm(rslt,trndev,0);
@@ -2223,26 +2260,76 @@ unsigned long int flags = 17, one = 1, retsts;
 
 
 /* OS-specific initialization at image activation (not thread startup) */
+/* Older VAXC header files lack these constants */
+#ifndef JPI$_RIGHTS_SIZE
+#  define JPI$_RIGHTS_SIZE 817
+#endif
+#ifndef KGB$M_SUBSYSTEM
+#  define KGB$M_SUBSYSTEM 0x8
+#endif
+
 /*{{{void vms_image_init(int *, char ***)*/
 void
 vms_image_init(int *argcp, char ***argvp)
 {
-  unsigned long int *mask, iosb[2], i;
-  unsigned short int dummy;
-  union prvdef iprv;
-  struct itmlst_3 jpilist[2] = { {sizeof iprv, JPI$_IMAGPRIV, &iprv, &dummy},
-                                 {          0,             0,     0,      0} };
+  unsigned long int *mask, iosb[2], i, rlst[128], rsz, add_taint = FALSE;
+  unsigned long int iprv[(sizeof(union prvdef) + sizeof(unsigned long int) - 1) / sizeof(unsigned long int)];
+  unsigned short int dummy, rlen;
+  struct itmlst_3 jpilist[4] = { {sizeof iprv,    JPI$_IMAGPRIV, iprv, &dummy},
+                                 {sizeof rlst,  JPI$_RIGHTSLIST, rlst,  &rlen},
+                                 { sizeof rsz, JPI$_RIGHTS_SIZE, &rsz, &dummy},
+                                 {          0,                0,    0,      0} };
 
   _ckvmssts(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
   _ckvmssts(iosb[0]);
-  mask = (unsigned long int *) &iprv;  /* Quick change of view */;
-  for (i = 0; i < (sizeof iprv + sizeof(unsigned long int) - 1) / sizeof(unsigned long int); i++) {
-    if (mask[i]) {           /* Running image installed with privs? */
-      _ckvmssts(sys$setprv(0,&iprv,0,NULL));       /* Turn 'em off. */
-      tainting = TRUE;
+  for (i = 0; i < sizeof iprv / sizeof(unsigned long int); i++) {
+    if (iprv[i]) {           /* Running image installed with privs? */
+      _ckvmssts(sys$setprv(0,iprv,0,NULL));       /* Turn 'em off. */
+      add_taint = TRUE;
       break;
     }
   }
+  /* Rights identifiers might trigger tainting as well. */
+  if (!add_taint && (rlen || rsz)) {
+    while (rlen < rsz) {
+      /* We didn't get all the identifiers on the first pass.  Allocate a
+       * buffer much larger than $GETJPI wants (rsz is size in bytes that
+       * were needed to hold all identifiers at time of last call; we'll
+       * allocate that many unsigned long ints), and go back and get 'em.
+       */
+      if (jpilist[1].bufadr != rlst) Safefree(jpilist[1].bufadr);
+      jpilist[1].bufadr = New(1320,mask,rsz,unsigned long int);
+      jpilist[1].buflen = rsz * sizeof(unsigned long int);
+      _ckvmssts(sys$getjpiw(0,NULL,NULL,&jpilist[1],iosb,NULL,NULL));
+      _ckvmssts(iosb[0]);
+    }
+    mask = jpilist[1].bufadr;
+    /* Check attribute flags for each identifier (2nd longword); protected
+     * subsystem identifiers trigger tainting.
+     */
+    for (i = 1; i < (rlen + sizeof(unsigned long int) - 1) / sizeof(unsigned long int); i += 2) {
+      if (mask[i] & KGB$M_SUBSYSTEM) {
+        add_taint = TRUE;
+        break;
+      }
+    }
+    if (mask != rlst) Safefree(mask);
+  }
+  /* We need to use this hack to tell Perl it should run with tainting,
+   * since its tainting flag may be part of the curinterp struct, which
+   * hasn't been allocated when vms_image_init() is called.
+   */
+  if (add_taint) {
+    char ***newap;
+    New(1320,newap,*argcp+2,char **);
+    newap[0] = argvp[0];
+    *newap[1] = "-T";
+    Copy(argvp[1],newap[2],*argcp-1,char **);
+    /* We orphan the old argv, since we don't know where it's come from,
+     * so we don't know how to free it.
+     */
+    *argcp++; argvp = newap;
+  }
   getredirection(argcp,argvp);
   return;
 }
@@ -2429,13 +2516,22 @@ opendir(char *name)
 {
     DIR *dd;
     char dir[NAM$C_MAXRSS+1];
-      
-    /* Get memory for the handle, and the pattern. */
-    New(1306,dd,1,DIR);
+    Stat_t sb;
+
     if (do_tovmspath(name,dir,0) == NULL) {
-      Safefree((char *)dd);
-      return(NULL);
+      return NULL;
+    }
+    if (flex_stat(dir,&sb) == -1) return NULL;
+    if (!S_ISDIR(sb.st_mode)) {
+      set_errno(ENOTDIR);  set_vaxc_errno(RMS$_DIR);
+      return NULL;
     }
+    if (!cando_by_name(S_IRUSR,0,dir)) {
+      set_errno(EACCES); set_vaxc_errno(RMS$_PRV);
+      return NULL;
+    }
+    /* Get memory for the handle, and the pattern. */
+    New(1306,dd,1,DIR);
     New(1307,dd->pattern,strlen(dir)+sizeof "*.*" + 1,char);
 
     /* Fill in the fields; mainly playing with the descriptor. */
@@ -2791,6 +2887,7 @@ setup_cmddsc(char *cmd, int check_img)
 bool
 vms_do_aexec(SV *really,SV **mark,SV **sp)
 {
+  dTHR;
   if (sp > mark) {
     if (vfork_called) {           /* this follows a vfork - act Unixish */
       vfork_called--;
@@ -2845,11 +2942,12 @@ vms_do_exec(char *cmd)
 
 unsigned long int do_spawn(char *);
 
-/* {{{ unsigned long int do_aspawn(SV *really,SV **mark,SV **sp) */
+/* {{{ unsigned long int do_aspawn(void *really,void **mark,void **sp) */
 unsigned long int
-do_aspawn(SV *really,SV **mark,SV **sp)
+do_aspawn(void *really,void **mark,void **sp)
 {
-  if (sp > mark) return do_spawn(setup_argstr(really,mark,sp));
+  dTHR;
+  if (sp > mark) return do_spawn(setup_argstr((SV *)really,(SV **)mark,(SV **)sp));
 
   return SS$_ABORT;
 }  /* end of do_aspawn() */
@@ -2916,7 +3014,7 @@ my_flush(FILE *fp)
     int res;
     if ((res = fflush(fp)) == 0) {
 #ifdef VMS_DO_SOCKETS
-	struct mystat s;
+	Stat_t s;
 	if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
 #endif
 	    res = fsync(fileno(fp));
@@ -3178,79 +3276,104 @@ 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)
- */
+#ifdef HOMEGROWN_POSIX_SIGNALS
+  /* 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 */
+  /* sigset_t is atomic under VMS, so these routines are easy */
+/*{{{int my_sigemptyset(sigset_t *) */
 int my_sigemptyset(sigset_t *set) {
-  if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
-  *set = 0; return 0;
+    if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+    *set = 0; return 0;
 }
+/*}}}*/
+
+
+/*{{{int my_sigfillset(sigset_t *)*/
 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 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)*/
 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;
+    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)*/
 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;
+    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)*/
 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));
+    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);
+/*{{{int my_sigprocmask(int how, sigset_t *set, sigset_t *oset)*/
+int my_sigprocmask(int how, sigset_t *set, sigset_t *oset) {
+    sigset_t tempmask;
+
+    /* If set and oset are both null, then things are badly wrong. Bail out. */
+    if ((oset == NULL) && (set == NULL)) {
+      set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO);
       return -1;
     }
-  }
 
-  /* Did they pass us an oset? If so, stick our holding mask into it */
-  if (oset)
-    *oset = tempmask;
+    /* 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;
+    return 0;
 }
+/*}}}*/
+#endif  /* HOMEGROWN_POSIX_SIGNALS */
+
 
 /* Used for UTC calculation in my_gmtime(), my_localtime(), my_time(),
  * my_utime(), and flex_stat(), all of which operate on UTC unless
@@ -3271,9 +3394,43 @@ static long int utc_offset_secs;
 #undef localtime
 #undef time
 
+#if defined(__VMS_VER) && __VMS_VER >= 70000000 && __DECC_VER >= 50200000
+#  define RTL_USES_UTC 1
+#endif
+
+static time_t toutc_dst(time_t loc) {
+  struct tm *rsltmp;
+
+  if ((rsltmp = localtime(&loc)) == NULL) return -1;
+  loc -= utc_offset_secs;
+  if (rsltmp->tm_isdst) loc -= 3600;
+  return loc;
+}
+#define _toutc(secs)  ((secs) == -1 ? -1 : \
+       ((gmtime_emulation_type || my_time(NULL)), \
+       (gmtime_emulation_type == 1 ? toutc_dst(secs) : \
+       ((secs) - utc_offset_secs))))
+
+static time_t toloc_dst(time_t utc) {
+  struct tm *rsltmp;
+
+  utc += utc_offset_secs;
+  if ((rsltmp = localtime(&utc)) == NULL) return -1;
+  if (rsltmp->tm_isdst) utc += 3600;
+  return utc;
+}
+#define _toloc(secs)  ((secs) == -1 ? -1 : \
+       ((gmtime_emulation_type || my_time(NULL)), \
+       (gmtime_emulation_type == 1 ? toloc_dst(secs) : \
+       ((secs) + utc_offset_secs))))
+
+
 /* my_time(), my_localtime(), my_gmtime()
- * By default traffic in UTC time values, suing CRTL gmtime() or
+ * By default traffic in UTC time values, using CRTL gmtime() or
  * SYS$TIMEZONE_DIFFERENTIAL to determine offset from local time zone.
+ * Note: We need to use these functions even when the CRTL has working
+ * UTC support, since they also handle C<use vmsish qw(times);>
+ *
  * Contributed by Chuck Lane  <lane@duphy4.physics.drexel.edu>
  * Modified by Charles Bailey <bailey@genetics.upenn.edu>
  */
@@ -3283,10 +3440,13 @@ time_t my_time(time_t *timep)
 {
   dTHR;
   time_t when;
+  struct tm *tm_p;
 
   if (gmtime_emulation_type == 0) {
-    struct tm *tm_p;
-    time_t base = 15 * 86400; /* 15jan71; to avoid month ends */
+    int dstnow;
+    time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between    */
+                              /* results of calls to gmtime() and localtime() */
+                              /* for same &base */
 
     gmtime_emulation_type++;
     if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */
@@ -3313,11 +3473,13 @@ time_t my_time(time_t *timep)
   }
 
   when = time(NULL);
-  if (
-#     ifdef VMSISH_TIME
-      !VMSISH_TIME &&
-#     endif
-                       when != -1) when -= utc_offset_secs;
+# ifdef VMSISH_TIME
+# ifdef RTL_USES_UTC
+  if (VMSISH_TIME) when = _toloc(when);
+# else
+  if (!VMSISH_TIME) when = _toutc(when);
+# endif
+# endif
   if (timep != NULL) *timep = when;
   return when;
 
@@ -3332,21 +3494,26 @@ my_gmtime(const time_t *timep)
   dTHR;
   char *p;
   time_t when;
+  struct tm *rsltmp;
 
   if (timep == NULL) {
     set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
     return NULL;
   }
   if (*timep == 0) gmtime_emulation_type = 0;  /* possibly reset TZ */
-  if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */
 
   when = *timep;
 # ifdef VMSISH_TIME
-  if (VMSISH_TIME) when -= utc_offset_secs; /* Input was local time */
-# endif
+  if (VMSISH_TIME) when = _toutc(when); /* Input was local time */
+#  endif
+# ifdef RTL_USES_UTC  /* this implies that the CRTL has a working gmtime() */
+  return gmtime(&when);
+# else
   /* CRTL localtime() wants local time as input, so does no tz correction */
-  return localtime(&when);
-
+  rsltmp = localtime(&when);
+  if (rsltmp) rsltmp->tm_isdst = 0;  /* We already took DST into account */
+  return rsltmp;
+#endif
 }  /* end of my_gmtime() */
 /*}}}*/
 
@@ -3357,6 +3524,7 @@ my_localtime(const time_t *timep)
 {
   dTHR;
   time_t when;
+  struct tm *rsltmp;
 
   if (timep == NULL) {
     set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
@@ -3366,11 +3534,21 @@ my_localtime(const time_t *timep)
   if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */
 
   when = *timep;
+# ifdef RTL_USES_UTC
 # ifdef VMSISH_TIME
-  if (!VMSISH_TIME) when += utc_offset_secs;  /*  Input was UTC */
+  if (VMSISH_TIME) when = _toutc(when);
 # endif
-  /* CRTL localtime() wants local time as input, so does no tz correction */
+  /* CRTL localtime() wants UTC as input, does tz correction itself */
   return localtime(&when);
+# else
+# ifdef VMSISH_TIME
+  if (!VMSISH_TIME) when = _toloc(when);   /*  Input was UTC */
+# endif
+# endif
+  /* CRTL localtime() wants local time as input, so does no tz correction */
+  rsltmp = localtime(&when);
+  if (rsltmp && gmtime_emulation_type != 1) rsltmp->tm_isdst = -1;
+  return rsltmp;
 
 } /*  end of my_localtime() */
 /*}}}*/
@@ -3380,7 +3558,6 @@ my_localtime(const time_t *timep)
 #define localtime(t) my_localtime(t)
 #define time(t)      my_time(t)
 
-#endif /* VMS VER < 7.0 || Dec C < 5.2
 
 /* my_utime - update modification time of a file
  * calling sequence is identical to POSIX utime(), but under
@@ -3445,11 +3622,9 @@ int my_utime(char *file, struct utimbuf *utimes)
      */
     lowbit = (utimes->modtime & 1) ? secscale : 0;
     unixtime = (long int) utimes->modtime;
-#if defined(VMSISH_TIME) && (__VMS_VER < 70000000 || __DECC_VER < 50200000)
-    if (!VMSISH_TIME) {  /* Input was UTC; convert to local for sys svc */
-      if (!gmtime_emulation_type) (void) time(NULL);  /* Initialize UTC */
-      unixtime += utc_offset_secs;
-    }
+#   ifdef VMSISH_TIME
+    /* If input was UTC; convert to local for sys svc */
+    if (!VMSISH_TIME) unixtime = _toloc(unixtime);
 #   endif
     unixtime >> 1;  secscale << 1;
     retsts = lib$emul(&secscale, &unixtime, &lowbit, bintime);
@@ -3649,13 +3824,11 @@ is_null_device(name)
 
 /* Do the permissions allow some operation?  Assumes statcache already set. */
 /* Do this via $Check_Access on VMS, since the CRTL stat() returns only a
- * subset of the applicable information.  (We have to stick with struct
- * stat instead of struct mystat in the prototype since we have to match
- * the one in proto.h.)
+ * subset of the applicable information.
  */
 /*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/
 I32
-cando(I32 bit, I32 effective, struct stat *statbufp)
+cando(I32 bit, I32 effective, Stat_t *statbufp)
 {
   if (statbufp == &statcache) return cando_by_name(bit,effective,namecache);
   else {
@@ -3666,12 +3839,12 @@ cando(I32 bit, I32 effective, struct stat *statbufp)
 
     /* If the struct mystat is stale, we're OOL; stat() overwrites the
        device name on successive calls */
-    devdsc.dsc$a_pointer = ((struct mystat *)statbufp)->st_devnam;
-    devdsc.dsc$w_length = strlen(((struct mystat *)statbufp)->st_devnam);
+    devdsc.dsc$a_pointer = ((Stat_t *)statbufp)->st_devnam;
+    devdsc.dsc$w_length = strlen(((Stat_t *)statbufp)->st_devnam);
     namdsc.dsc$a_pointer = fname;
     namdsc.dsc$w_length = sizeof fname - 1;
 
-    retsts = lib$fid_to_name(&devdsc,&(((struct mystat *)statbufp)->st_ino),
+    retsts = lib$fid_to_name(&devdsc,&(((Stat_t *)statbufp)->st_ino),
                              &namdsc,&namdsc.dsc$w_length,0,0);
     if (retsts & 1) {
       fname[namdsc.dsc$w_length] = '\0';
@@ -3754,7 +3927,7 @@ cando_by_name(I32 bit, I32 effective, char *fname)
 
   retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst);
   if (retsts == SS$_NOPRIV      || retsts == SS$_NOSUCHOBJECT ||
-      retsts == SS$_INVFILFOROP || retsts == RMS$_FNF    ||
+      retsts == SS$_INVFILFOROP || retsts == RMS$_FNF || retsts == RMS$_SYN ||
       retsts == RMS$_DIR        || retsts == RMS$_DEV) {
     set_vaxc_errno(retsts);
     if (retsts == SS$_NOPRIV) set_errno(EACCES);
@@ -3783,27 +3956,33 @@ cando_by_name(I32 bit, I32 effective, char *fname)
 /*}}}*/
 
 
-/*{{{ int flex_fstat(int fd, struct mystat *statbuf)*/
+/*{{{ int flex_fstat(int fd, Stat_t *statbuf)*/
 int
-flex_fstat(int fd, struct mystat *statbufp)
+flex_fstat(int fd, Stat_t *statbufp)
 {
   dTHR;
-
   if (!fstat(fd,(stat_t *) statbufp)) {
-    if (statbufp == (struct mystat *) &statcache) *namecache == '\0';
+    if (statbufp == (Stat_t *) &statcache) *namecache == '\0';
     statbufp->st_dev = encode_dev(statbufp->st_devnam);
+#   ifdef RTL_USES_UTC
+#   ifdef VMSISH_TIME
+    if (VMSISH_TIME) {
+      statbufp->st_mtime = _toloc(statbufp->st_mtime);
+      statbufp->st_atime = _toloc(statbufp->st_atime);
+      statbufp->st_ctime = _toloc(statbufp->st_ctime);
+    }
+#   endif
+#   else
 #   ifdef VMSISH_TIME
     if (!VMSISH_TIME) { /* Return UTC instead of local time */
 #   else
     if (1) {
 #   endif
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
-      if (!gmtime_emulation_type) (void)time(NULL);
-      statbufp->st_mtime -= utc_offset_secs;
-      statbufp->st_atime -= utc_offset_secs;
-      statbufp->st_ctime -= utc_offset_secs;
-#endif
+      statbufp->st_mtime = _toutc(statbufp->st_mtime);
+      statbufp->st_atime = _toutc(statbufp->st_atime);
+      statbufp->st_ctime = _toutc(statbufp->st_ctime);
     }
+#endif
     return 0;
   }
   return -1;
@@ -3811,15 +3990,15 @@ flex_fstat(int fd, struct mystat *statbufp)
 }  /* end of flex_fstat() */
 /*}}}*/
 
-/*{{{ int flex_stat(char *fspec, struct mystat *statbufp)*/
+/*{{{ int flex_stat(char *fspec, Stat_t *statbufp)*/
 int
-flex_stat(char *fspec, struct mystat *statbufp)
+flex_stat(char *fspec, Stat_t *statbufp)
 {
     dTHR;
     char fileified[NAM$C_MAXRSS+1];
     int retval = -1;
 
-    if (statbufp == (struct mystat *) &statcache)
+    if (statbufp == (Stat_t *) &statcache)
       do_tovmsspec(fspec,namecache,0);
     if (is_null_device(fspec)) { /* Fake a stat() for the null device */
       memset(statbufp,0,sizeof *statbufp);
@@ -3833,7 +4012,7 @@ flex_stat(char *fspec, struct mystat *statbufp)
     }
 
     /* Try for a directory name first.  If fspec contains a filename without
-     * a type (e.g. sea:[dark.dark]water), and both sea:[wine.dark]water.dir
+     * a type (e.g. sea:[wine.dark]water), and both sea:[wine.dark]water.dir
      * and sea:[wine.dark]water. exist, we prefer the directory here.
      * Similarly, sea:[wine.dark] returns the result for sea:[wine]dark.dir,
      * not sea:[wine.dark]., if the latter exists.  If the intended target is
@@ -3842,24 +4021,31 @@ flex_stat(char *fspec, struct mystat *statbufp)
      */
     if (do_fileify_dirspec(fspec,fileified,0) != NULL) {
       retval = stat(fileified,(stat_t *) statbufp);
-      if (!retval && statbufp == (struct mystat *) &statcache)
+      if (!retval && statbufp == (Stat_t *) &statcache)
         strcpy(namecache,fileified);
     }
     if (retval) retval = stat(fspec,(stat_t *) statbufp);
     if (!retval) {
       statbufp->st_dev = encode_dev(statbufp->st_devnam);
+#     ifdef RTL_USES_UTC
+#     ifdef VMSISH_TIME
+      if (VMSISH_TIME) {
+        statbufp->st_mtime = _toloc(statbufp->st_mtime);
+        statbufp->st_atime = _toloc(statbufp->st_atime);
+        statbufp->st_ctime = _toloc(statbufp->st_ctime);
+      }
+#     endif
+#     else
 #     ifdef VMSISH_TIME
       if (!VMSISH_TIME) { /* Return UTC instead of local time */
 #     else
       if (1) {
 #     endif
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
-        if (!gmtime_emulation_type) (void)time(NULL);
-        statbufp->st_mtime -= utc_offset_secs;
-        statbufp->st_atime -= utc_offset_secs;
-        statbufp->st_ctime -= utc_offset_secs;
-#endif
+        statbufp->st_mtime = _toutc(statbufp->st_mtime);
+        statbufp->st_atime = _toutc(statbufp->st_atime);
+        statbufp->st_ctime = _toutc(statbufp->st_ctime);
       }
+#     endif
     }
     return retval;
 
diff --git a/vms/vms_yfix.pl b/vms/vms_yfix.pl
index f57ea1d515..08a8dbffb1 100644
--- a/vms/vms_yfix.pl
+++ b/vms/vms_yfix.pl
@@ -27,6 +27,11 @@ while (<C>) {
     # accomodate old VAXC's macro susbstitution pecularities
     $_ = "#   ifndef getenv\n$_#   endif\n";
   }
+  elsif ( /getenv\("YYDEBUG"\)/ ) {
+    # Reset the "error" status if an optional lookup fails
+    while (not /^\s+\}/) { print COUT; $_ = <C>; }
+    $_ .= "\telse SETERRNO(0,SS\$_NORMAL);\n";
+  }
   else {
     # add the dEXT tag to definitions of global vars, so we'll insert
     # a globaldef when perly.c is compiled
diff --git a/vms/vmsish.h b/vms/vmsish.h
index f0de807920..c994140dab 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -77,6 +77,12 @@
 #endif
 #define waitpid my_waitpid
 
+/* Don't redeclare standard RTL routines in Perl's header files;
+ * VMS history or extensions makes some of the formal protoypes
+ * differ from the common Unix forms.
+ */
+#define DONT_DECLARE_STD 1
+
 /* Our own contribution to PerlShr's global symbols . . . */
 #ifdef EMBED
 #  define my_trnlnm		Perl_my_trnlnm
@@ -111,7 +117,6 @@
 #  define seekdir		Perl_seekdir
 #  define closedir		Perl_closedir
 #  define vmsreaddirversions	Perl_vmsreaddirversions
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
 #  define my_gmtime		Perl_my_gmtime
 #  define my_localtime		Perl_my_localtime
 #  define my_time		Perl_my_time
@@ -121,7 +126,6 @@
 #  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
 #  define flex_stat		Perl_flex_stat
@@ -284,6 +288,30 @@
  */
 #define USEMYBINMODE
 
+/* Stat_t:
+ *	This symbol holds the type used to declare buffers for information
+ *	returned by stat().  It's usually just struct stat.  It may be necessary
+ *	to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ *	information.
+ */
+/* VMS:
+ * We need this typedef to point to the new type even if DONT_MASK_RTL_CALLS
+ * is in effect, since Perl's thread.h embeds one of these structs in its
+ * thread data struct, and our struct mystat is a different size from the
+ * regular struct stat (cf. note above about having to pad struct to work
+ * around bug in compiler.)
+ * It's OK to pass one of these to the RTL's stat(), though, since the
+ * fields it fills are the same in each struct.
+ */
+#define Stat_t struct mystat
+
+/* USE_STAT_RDEV:
+*	This symbol is defined if this system has a stat structure declaring
+*	st_rdev
+*	VMS: Field exists in POSIXish version of struct stat(), but is not used.
+*/
+#undef USE_STAT_RDEV		/**/
+
 /*
  * fwrite1() should be a routine with the same calling sequence as fwrite(),
  * but which outputs all of the bytes requested as a single stream (unlike
@@ -332,39 +360,44 @@ struct utimbuf {
 #  define tbuffer_t struct tms
 #endif
 
-/* Prior to VMS 7.0, the CRTL gmtime() routine was a stub which always
- * returned NULL.  Substitute our own routine, which uses the logical
- * SYS$TIMEZONE_DIFFERENTIAL, whcih the native UTC support routines
- * in VMS 6.0 or later use.  We also add shims for time() and localtime()
- * so we can run on UTC by default.
+/* Substitute our own routines for gmtime(), localtime(), and time(),
+ * which allow us to implement the vmsish 'time' pragma, and work
+ * around absence of system-level UTC support on old versions of VMS.
  */
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
 #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)
+
+/* If we're using an older version of VMS whose Unix signal emulation
+ * isn't very POSIXish, then roll our own.
+ */
+#if __VMS_VER < 70000000 || __DECC_VER < 50200000
+#  define HOMEGROWN_POSIX_SIGNALS
+#endif
+#ifdef HOMEGROWN_POSIX_SIGNALS
+#  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
@@ -480,6 +513,13 @@ struct mystat
         char	st_fab_rat;	/* record attributes */
         char	st_fab_fsz;	/* fixed header size */
         unsigned st_dev;	/* encoded device name */
+        /* Pad struct out to integral number of longwords, since DECC 5.6/VAX
+         * has a bug in dealing with offsets in structs in which are embedded
+         * other structs whose size is an odd number of bytes.  (An even
+         * number of bytes is enough to make it happy, but we go for natural
+         * alignment anyhow.)
+         */
+        char	st_fill1[sizeof(void *) - (3*sizeof(unsigned short) + 3*sizeof(char))%sizeof(void *)];
 };
 typedef unsigned mydev_t;
 typedef unsigned myino_t;
@@ -565,14 +605,10 @@ long	telldir _((DIR *));
 void	seekdir _((DIR *, long));
 void	closedir _((DIR *));
 void	vmsreaddirversions _((DIR *, int));
-#ifdef my_gmtime
 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
+#ifdef HOMEGROWN_POSIX_SIGNALS
 int     my_sigemptyset _((sigset_t *));
 int     my_sigfillset  _((sigset_t *));
 int     my_sigaddset   _((sigset_t *, int));
@@ -581,13 +617,13 @@ 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 *));
+int	flex_fstat _((int, Stat_t *));
+int	flex_stat _((char *, Stat_t *));
 int	trim_unixpath _((char *, char*, int));
 int	my_vfork _(());
 bool	vms_do_aexec _((SV *, SV **, SV **));
 bool	vms_do_exec _((char *));
-unsigned long int	do_aspawn _((SV *, SV **, SV **));
+unsigned long int	do_aspawn _((void *, void **, void **));
 unsigned long int	do_spawn _((char *));
 int	my_fwrite _((void *, size_t, size_t, FILE *));
 int	my_flush _((FILE *));