From: Charles Bailey <bailey@newman.upenn.edu>
Date: Thu, 26 Mar 1998 15:11:50 +0000 (-0500)
Subject: Next wave of _63 VMS patches
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=17f28c40fa08b585b95d4a2531b1cd975d11e986;p=p5sagit%2Fp5-mst-13.2.git

Next wave of _63 VMS patches

p4raw-id: //depot/perl@854
---

diff --git a/EXTERN.h b/EXTERN.h
index a48d0d3..8b0584e 100644
--- a/EXTERN.h
+++ b/EXTERN.h
@@ -18,6 +18,10 @@
 #undef EXTCONST
 #undef dEXTCONST
 #if defined(VMS) && !defined(__GNUC__)
+    /* Suppress portability warnings from DECC for VMS-specific extensions */
+#  ifdef __DECC
+#    pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT)
+#  endif
 #  define EXT globalref
 #  define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
 #  define EXTCONST globalref
diff --git a/INTERN.h b/INTERN.h
index 22e42c5..6ce0367 100644
--- a/INTERN.h
+++ b/INTERN.h
@@ -18,6 +18,10 @@
 #undef EXTCONST
 #undef dEXTCONST
 #if defined(VMS) && !defined(__GNUC__)
+    /* Suppress portability warnings from DECC for VMS-specific extensions */
+#  ifdef __DECC
+#    pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT)
+#  endif
 #  define EXT globaldef {"$GLOBAL_RW_VARS"} noshare
 #  define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
 #  define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
diff --git a/ext/SDBM_File/Makefile.PL b/ext/SDBM_File/Makefile.PL
index c0daa06..b639b29 100644
--- a/ext/SDBM_File/Makefile.PL
+++ b/ext/SDBM_File/Makefile.PL
@@ -6,13 +6,8 @@ use ExtUtils::MakeMaker;
 # which perform the corresponding actions in the subdirectory.
 
 $define = ($^O eq 'MSWin32') ? '-DMSDOS' : '';
-if ($^O eq 'MSWin32') {
-  $myextlib = 'sdbm\\libsdbm$(LIB_EXT)';
-} elsif ($^O eq 'VMS') {
-  $myextlib = 'sdbm/libsdbm$(LIB_EXT)';
-} else {
-  $myextlib = 'sdbm/libsdbm$(LIB_EXT)';  
-}
+if ($^O eq 'MSWin32') { $myextlib = 'sdbm\\libsdbm$(LIB_EXT)'; }
+else                  { $myextlib = 'sdbm/libsdbm$(LIB_EXT)';  }
 
 WriteMakefile(
               NAME	=> 'SDBM_File',
@@ -21,8 +16,6 @@ WriteMakefile(
               XSPROTOARG => '-noprototypes', 		# XXX remove later?
               VERSION_FROM => 'SDBM_File.pm',
               DEFINE => $define,
-#              NORECURS => $^O eq 'VMS',
-#              SKIP => $^O eq 'VMS' ? 'subdirs' : '', # Don't do the subdirs section for VMS
              );
 
 sub MY::postamble {
@@ -33,7 +26,7 @@ $(MYEXTLIB): sdbm/Makefile
 ';
   } else {
   '   
-$(MYEXTLIB): [.sdbm]descrip.mms
+$(MYEXTLIB) : [.sdbm]descrip.mms
 	set def [.sdbm]
     $(MMS) all
     set def [-]
diff --git a/ext/SDBM_File/sdbm/Makefile.PL b/ext/SDBM_File/sdbm/Makefile.PL
index e9d4dcd..96f5b7a 100644
--- a/ext/SDBM_File/sdbm/Makefile.PL
+++ b/ext/SDBM_File/sdbm/Makefile.PL
@@ -3,13 +3,19 @@ use ExtUtils::MakeMaker;
 $define = '-DSDBM -DDUFF';
 $define .= ' -DWIN32' if ($^O eq 'MSWin32');
 
+if ($^O eq 'VMS') {  # Old VAXC compiler can't handle Duff's device
+    require Config;
+    $define =~ s/\s+-DDUFF// if $Config::Config{'vms_cc_type'} eq 'vaxc';
+}
+
 WriteMakefile(
     NAME      => 'sdbm', # (doesn't matter what the name is here) oh yes it does
 #    LINKTYPE  => 'static',
     DEFINE    => $define,
     INC       => '-I$(PERL_INC)', # force PERL_INC dir ahead of system -I's
-    SKIP      => [qw(dynamic dynamic_lib)],
-    OBJECT    => ($^O eq 'VMS') ? 'sdbm.obj pair.obj hash.obj' : '$(O_FILES)',
+    INST_ARCHLIB => '.',
+    SKIP      => [qw(dynamic dynamic_lib dlsyms)],
+    OBJECT    => '$(O_FILES)',
     clean     => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'},
     H         => [qw(tune.h sdbm.h pair.h $(PERL_INC)/config.h)],
     C         => [qw(sdbm.c pair.c hash.c)]
@@ -24,8 +30,10 @@ INST_STATIC = libsdbm$(LIB_EXT)
 sub MY::top_targets {
 	'
 all :: static
+	$(NOECHO) $(NOOP)
 
 config ::
+	$(NOECHO) $(NOOP)
 
 lint:
 	lint -abchx $(LIBSRCS)
diff --git a/ext/SDBM_File/sdbm/dba.c b/ext/SDBM_File/sdbm/dba.c
index 4f227e5..05e70c8 100644
--- a/ext/SDBM_File/sdbm/dba.c
+++ b/ext/SDBM_File/sdbm/dba.c
@@ -4,6 +4,7 @@
 
 #include <stdio.h>
 #include <sys/file.h>
+#include "EXTERN.h"
 #include "sdbm.h"
 
 char *progname;
diff --git a/ext/SDBM_File/sdbm/dbd.c b/ext/SDBM_File/sdbm/dbd.c
index 697a547..04ab842 100644
--- a/ext/SDBM_File/sdbm/dbd.c
+++ b/ext/SDBM_File/sdbm/dbd.c
@@ -4,6 +4,7 @@
 
 #include <stdio.h>
 #include <sys/file.h>
+#include "EXTERN.h"
 #include "sdbm.h"
 
 char *progname;
diff --git a/ext/SDBM_File/sdbm/dbu.c b/ext/SDBM_File/sdbm/dbu.c
index 1062628..a3c0004 100644
--- a/ext/SDBM_File/sdbm/dbu.c
+++ b/ext/SDBM_File/sdbm/dbu.c
@@ -1,6 +1,7 @@
 #include <stdio.h>
 #include <sys/file.h>
 #ifdef SDBM
+#include "EXTERN.h"
 #include "sdbm.h"
 #else
 #include <ndbm.h>
diff --git a/ext/SDBM_File/sdbm/hash.c b/ext/SDBM_File/sdbm/hash.c
index 514bb5e..9b27648 100644
--- a/ext/SDBM_File/sdbm/hash.c
+++ b/ext/SDBM_File/sdbm/hash.c
@@ -8,6 +8,7 @@
  */
 
 #include "config.h"
+#include "EXTERN.h"
 #include "sdbm.h"
 /*
  * polynomial conversion ignoring overflows
diff --git a/ext/SDBM_File/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c
index e1a6ee6..6b41f88 100644
--- a/ext/SDBM_File/sdbm/pair.c
+++ b/ext/SDBM_File/sdbm/pair.c
@@ -12,6 +12,7 @@ static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $";
 #endif
 
 #include "config.h"
+#include "EXTERN.h"
 #include "sdbm.h"
 #include "tune.h"
 #include "pair.h"
diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c
index 7fbba0f..7bf9d3a 100644
--- a/ext/SDBM_File/sdbm/sdbm.c
+++ b/ext/SDBM_File/sdbm/sdbm.c
@@ -11,6 +11,7 @@
 static char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $";
 #endif
 
+#include "INTERN.h"
 #include "config.h"
 #include "sdbm.h"
 #include "tune.h"
@@ -39,7 +40,7 @@ extern int errno;
 
 extern Malloc_t malloc proto((MEM_SIZE));
 extern Free_t free proto((Malloc_t));
-extern Off_t lseek(int, off_t, int);
+extern Off_t lseek(int, Off_t, int);
 #endif
 
 /*
@@ -72,8 +73,6 @@ static long masks[] = {
 	001777777777, 003777777777, 007777777777, 017777777777
 };
 
-datum nullitem = {NULL, 0};
-
 DBM *
 sdbm_open(register char *file, register int flags, register int mode)
 {
diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h
index b3ed2d4..591ff24 100644
--- a/ext/SDBM_File/sdbm/sdbm.h
+++ b/ext/SDBM_File/sdbm/sdbm.h
@@ -51,7 +51,11 @@ typedef struct {
 	int dsize;
 } datum;
 
-extern datum nullitem;
+EXTCONST datum nullitem
+#ifdef DOINIT
+                        = {NULL, 0}
+#endif
+                                   ;
 
 #if defined(__STDC__) || defined(__cplusplus) || defined(CAN_PROTOTYPE)
 #define proto(p) p
@@ -120,12 +124,13 @@ extern long sdbm_hash proto((char *, int));
 #include <ctype.h>
 #include <setjmp.h>
 
-#if defined(I_UNISTD) || defined(VMS)
+#if defined(I_UNISTD)
 #include <unistd.h>
 #endif
 
 #ifdef VMS
-# include <fcntl.h>
+#  include <file.h>
+#  include <unixio.h>
 #endif
 
 #if !defined(MSDOS) && !defined(WIN32) && !defined(VMS)
diff --git a/ext/Thread/io.t b/ext/Thread/io.t
index 8ade265..6012008 100644
--- a/ext/Thread/io.t
+++ b/ext/Thread/io.t
@@ -1,5 +1,13 @@
 use Thread;
 
+sub counter {
+$count = 10;
+while ($count--) {
+    sleep 1;
+    print "ping $count\n";
+}
+}
+
 sub reader {
     my $line;
     while ($line = <STDIN>) {
@@ -17,7 +25,13 @@ finished counting down and the I/O thread has seen end-of-file on
 the terminal/stdin.
 EOT
 
-$r = new Thread \&reader;
+$r = new Thread \&counter;
+
+&reader;
+
+__END__
+
+
 $count = 10;
 while ($count--) {
     sleep 1;
diff --git a/installperl b/installperl
index 4c87f55..fe168c9 100755
--- a/installperl
+++ b/installperl
@@ -5,6 +5,8 @@ BEGIN {
     chdir '..' if !-d 'lib' and -d '..\lib';
     @INC = 'lib';
     $ENV{PERL5LIB} = 'lib';
+    $Is_VMS = $^O eq 'VMS';
+    if ($Is_VMS) { eval 'use VMS::Filespec;' }
 }
 
 use File::Find;
@@ -30,13 +32,15 @@ while (@ARGV) {
     shift;
 }
 
-umask 022;
+umask 022 unless $Is_VMS;
 
 @scripts = qw(	utils/c2ph utils/h2ph utils/h2xs
 		utils/perlbug utils/perldoc utils/pl2pm utils/splain
 		x2p/s2p x2p/find2perl
 		pod/pod2man pod/pod2html pod/pod2latex pod/pod2text);
 
+if ($Is_VMS) { @scripts = map { "$_.Com" } @scripts; }
+
 @pods = (<pod/*.pod>);
 
 %archpms = (Config => 1, FileHandle => 1, overload => 1);
@@ -77,6 +81,14 @@ $dlext = $Config{dlext};
 $d_dosuid = $Config{d_dosuid};
 $binexp = $Config{binexp};
 
+if ($Is_VMS) {  # Hang in there until File::Spec hits the big time
+    foreach ( \$installbin,     \$installscript,  \$installprivlib,
+              \$installarchlib, \$installsitelib, \$installsitearch,
+              \$installman1dir ) {
+      $$_ = unixify($$_);  $$_ =~ s:/$::;
+    }
+}
+
 # Do some quick sanity checks.
 
 if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
@@ -110,7 +122,15 @@ $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
 
 # First we install the version-numbered executables.
 
-if ($^O ne 'dos') {
+if ($Is_VMS) {
+    safe_unlink("$installbin/perl$exe_ext");
+    copy("perl$exe_ext", "$installbin/perl$exe_ext");
+    chmod(0755, "$installbin/perl$exe_ext");
+    safe_unlink("$installbin/perlshr$exe_ext");
+    copy("perlshr$exe_ext", "$installbin/perlshr$exe_ext");
+    chmod(0755, "$installbin/perlshr$exe_ext");
+}
+elsif ($^O ne 'dos') {
     safe_unlink("$installbin/perl$ver$exe_ext");
     copy("perl$exe_ext", "$installbin/perl$ver$exe_ext");
     chmod(0755, "$installbin/perl$ver$exe_ext");
@@ -150,11 +170,18 @@ else {
 
 # Install header files and libraries.
 mkpath("$installarchlib/CORE", 1, 0777);
-@corefiles = <*.h libperl*.*>;
-# AIX needs perl.exp installed as well.
-push(@corefiles,'perl.exp') if $^O eq 'aix';
-# If they have built sperl.o...
-push(@corefiles,'sperl.o') if -f 'sperl.o';
+if ($Is_VMS) {  # We did core file selection during build
+    my $coredir = "lib/$Config{'arch'}/$]";
+    $coredir =~ tr/./_/;
+    @corefiles = <$coredir/*.*>;
+}
+else {
+    @corefiles = <*.h libperl*.*>;
+    # AIX needs perl.exp installed as well.
+    push(@corefiles,'perl.exp') if $^O eq 'aix';
+    # If they have built sperl.o...
+    push(@corefiles,'sperl.o') if -f 'sperl.o';
+}
 foreach $file (@corefiles) {
     # HP-UX (at least) needs to maintain execute permissions
     # on dynamically-loadable libraries. So we do it for all.
@@ -166,7 +193,7 @@ foreach $file (@corefiles) {
 # Install main perl executables
 # Make links to ordinary names if installbin directory isn't current directory.
 
-if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) {
+if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) {
     safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext");
     link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext");
     link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") 
@@ -177,7 +204,7 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) {
 
 $mainperl_is_instperl = 0;
 
-if (!$versiononly && !$nonono && $^O ne 'MSWin32' && -t STDIN && -t STDERR
+if (!$versiononly && !$nonono && $^O ne 'MSWin32' && !$Is_VMS && -t STDIN && -t STDERR
 	&& -w $mainperldir && ! samepath($mainperldir, $installbin)) {
     local($usrbinperl)	= "$mainperldir/perl$exe_ext";
     local($instperl)	= "$installbin/perl$exe_ext";
@@ -241,9 +268,10 @@ if (! $versiononly) {
 # pstruct should be a link to c2ph
 
 if (! $versiononly) {
-    safe_unlink("$installscript/pstruct");
-    if ($^O eq 'dos') {
-        copy("$installscript/c2ph","$installscript/pstruct"); 
+    safe_unlink("$installscript/pstruct" . ($Is_VMS ? '.Com' : ''));
+    if ($^O eq 'dos' or $Is_VMS) {
+        copy("$installscript/c2ph" . ($Is_VMS ? '.Com' : ''),
+             "$installscript/pstruct" . ($Is_VMS ? '.Com' : '')); 
     } else {
         link("$installscript/c2ph","$installscript/pstruct");
     }
@@ -296,6 +324,13 @@ if (!$versiononly) {
     $dirsep = ($^O eq 'os2' || $^O eq 'MSWin32') ? ';' : ':' ;
     ($path = $ENV{"PATH"}) =~ s:\\:/:g ;
     @path = split(/$dirsep/, $path);
+    if ($Is_VMS) {
+        my $i = 0;
+        while (exists $ENV{'DCL$PATH' . $i}) {
+            $dir = unixpath($ENV{'DCL$PATH' . $i});  $dir =~ s-/$--;
+            push(@path,$dir);
+        }
+    }
     @otherperls = ();
     for (@path) {
 	next unless m,^/,;
@@ -338,6 +373,8 @@ sub unlink {
     local(@names) = @_;
     my($cnt) = 0;
 
+    return scalar(@names) if $Is_VMS;
+
     foreach $name (@names) {
 	next unless -e $name;
 	chmod 0777, $name if ($^O eq 'os2' || $^O eq 'MSWin32');
@@ -349,7 +386,7 @@ sub unlink {
 }
 
 sub safe_unlink {
-    return if $nonono;
+    return if $nonono or $Is_VMS;
     local @names = @_;
     foreach $name (@names) {
 	next unless -e $name;
@@ -394,6 +431,7 @@ sub link {
         $packlist->{$to} = { from => $from, type => 'link' };
     };
     if ($@) {
+	print STDERR "  creating new version of $to\n" if $Is_VMS and -e $to;
 	File::Copy::copy($from, $to)
 	    ? $success++
 	    : warn "Couldn't copy $from to $to: $!\n"
@@ -417,6 +455,7 @@ sub copy {
     my($from,$to) = @_;
 
     print STDERR "  cp $from $to\n";
+    print STDERR "  creating new version of $to\n" if $Is_VMS and -e $to;
     File::Copy::copy($from, $to)
 	|| warn "Couldn't copy $from to $to: $!\n"
       unless $nonono;
diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm
index 87c27df..29bfaf2 100644
--- a/lib/ExtUtils/MM_VMS.pm
+++ b/lib/ExtUtils/MM_VMS.pm
@@ -61,15 +61,22 @@ sub eliminate_macros {
         if ($self->{$2}) {
             ($head,$macro,$tail) = ($1,$2,$3);
             if (ref $self->{$macro}) {
-              carp "Can't expand macro containing " . ref $self->{$macro};
-              $npath = "$head\cB$macro\cB$tail";
-              $complex = 1;
+                if (ref $self->{$macro} eq 'ARRAY') {
+                    print "Note: expanded array macro \$($macro) in $path\n" if $Verbose;
+                    $macro = join ' ', @{$self->{$macro}};
+                }
+                else {
+                    print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
+                          "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
+                    $macro = "\cB$macro\cB";
+                    $complex = 1;
+                }
             }
             else { ($macro = unixify($self->{$macro})) =~ s#/$##; }
             $npath = "$head$macro$tail";
         }
     }
-    if ($complex) { $npath =~ s#\cB(.*?)\cB#\$($1)#g; }
+    if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#g; }
     print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3;
     $npath;
 }
@@ -193,7 +200,7 @@ sub wraplist {
       # traversing array (scalar(@array) doesn't show them, but
       # foreach(@array) does) (5.00307)
       next unless $word =~ /\w/;
-      $line .= ', ' if length($line);
+      $line .= ' ' if length($line);
       if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
       $line .= $word;
       $hlen += length($word) + 2;
@@ -632,9 +639,9 @@ sub constants {
 
     if ($self->{OBJECT} =~ /\s/) {
 	$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
-	$self->{OBJECT} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT})));
+	$self->{OBJECT} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT})));
     }
-    $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
+    $self->{LDFROM} = $self->wraplist(map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
 
 
     # Fix up directory specs
@@ -726,12 +733,12 @@ MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
     push @m,'
 
 # Handy lists of source code files:
-XS_FILES = ',$self->wraplist(', ', sort keys %{$self->{XS}}),'
-C_FILES  = ',$self->wraplist(', ', @{$self->{C}}),'
-O_FILES  = ',$self->wraplist(', ', @{$self->{O_FILES}} ),'
-H_FILES  = ',$self->wraplist(', ', @{$self->{H}}),'
-MAN1PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN1PODS}}),'
-MAN3PODS = ',$self->wraplist(', ', sort keys %{$self->{MAN3PODS}}),'
+XS_FILES = ',$self->wraplist(sort keys %{$self->{XS}}),'
+C_FILES  = ',$self->wraplist(@{$self->{C}}),'
+O_FILES  = ',$self->wraplist(@{$self->{O_FILES}} ),'
+H_FILES  = ',$self->wraplist(@{$self->{H}}),'
+MAN1PODS = ',$self->wraplist(sort keys %{$self->{MAN1PODS}}),'
+MAN3PODS = ',$self->wraplist(sort keys %{$self->{MAN3PODS}}),'
 
 ';
 
@@ -764,21 +771,22 @@ INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT)
 INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs
 ';
     } else {
+	my $shr = $Config{'dbgprefix'} . 'PERLSHR';
 	push @m,'
 INST_STATIC =
 INST_DYNAMIC =
 INST_BOOT =
 EXPORT_LIST = $(BASEEXT).opt
-PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : "Sys\$Share:PerlShr.$Config{'dlext'}"),'
+PERL_ARCHIVE = ',($ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}"),'
 ';
     }
 
     $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ];
     $self->{PM_TO_BLIB} = [ %{$self->{PM}} ];
     push @m,'
-TO_INST_PM = ',$self->wraplist(', ',@{$self->{TO_INST_PM}}),'
+TO_INST_PM = ',$self->wraplist(@{$self->{TO_INST_PM}}),'
 
-PM_TO_BLIB = ',$self->wraplist(', ',@{$self->{PM_TO_BLIB}}),'
+PM_TO_BLIB = ',$self->wraplist(@{$self->{PM_TO_BLIB}}),'
 ';
 
     join('',@m);
@@ -1365,6 +1373,7 @@ sub dynamic_lib {
 
     my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
+    my $shr = $Config{'dbgprefix'} . 'PerlShr';
     my(@m);
     push @m,"
 
@@ -1375,7 +1384,7 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep
     push @m, '
 $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
 	$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
-	$(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config{'dlext'},'
+	$(NOECHO) If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
 	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
 ';
 
@@ -1436,27 +1445,20 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
 ';
     # If this extension has it's own library (eg SDBM_File)
     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
-    push(@m, '	$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
+    push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
+
+    push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
 
-    push(@m,'
-	If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
-');
     # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
     # 'cause it's a library and you can't stick them in other libraries.
     # In that case, we use $OBJECT instead and hope for the best
     if ($self->{MYEXTLIB}) {
-      push(@m,'
-	Library/Object/Replace $(MMS$TARGET) $(OBJECT)
-'); 
+      push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); 
     } else {
-      push(@m,'
-	Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
-'); 
+      push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
     }
     
-    push(@m, '
-	$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
-');
+    push(@m,"\t",'$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"',"\n");
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
 }
@@ -1679,6 +1681,9 @@ clean ::
     push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
     my($file,$line);
     $line = '';  #avoid unitialized var warning
+    # Occasionally files are repeated several times from different sources
+    { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; }
+    
     foreach $file (@otherfiles) {
 	$file = $self->fixpath($file);
 	if (length($line) + length($file) > 80) {
@@ -1723,6 +1728,8 @@ realclean :: clean
     }
     push(@files, values %{$self->{PM}});
     $line = '';  #avoid unitialized var warning
+    # Occasionally files are repeated several times from different sources
+    { my(%f) = map { ($_,1) } @files; @files = keys %f; }
     foreach $file (@files) {
 	$file = $self->fixpath($file);
 	if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
@@ -1744,6 +1751,8 @@ realclean :: clean
 	    else { push(@allfiles, $attribs{FILES}); }
 	}
 	$line = '';
+	# Occasionally files are repeated several times from different sources
+	{ my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; }
 	foreach $file (@allfiles) {
 	    $file = $self->fixpath($file);
 	    if (length($line) + length($file) > 80) {
diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm
index 91077dd..495b82f 100644
--- a/lib/Net/Ping.pm
+++ b/lib/Net/Ping.pm
@@ -106,7 +106,7 @@ sub new
     }
     elsif ($self->{"proto"} eq "icmp")
     {
-        croak("icmp ping requires root privilege") if $>;
+        croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
         $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
                     croak("Can't get icmp protocol by name");
         $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
diff --git a/perldir.h b/perldir.h
index 23d20ac..e3e68ff 100644
--- a/perldir.h
+++ b/perldir.h
@@ -4,7 +4,11 @@
 #ifdef PERL_OBJECT
 #else
 #define PerlDir_mkdir(name, mode) Mkdir((name), (mode))
-#define PerlDir_chdir(name) chdir((name))
+#ifdef VMS
+#  define PerlDir_chdir(name) chdir(((name) && *(name)) ? (name) : "SYS$LOGIN")
+#else 
+#  define PerlDir_chdir(name) chdir((name))
+#endif
 #define PerlDir_rmdir(name) rmdir((name))
 #define PerlDir_close(dir) closedir((dir))
 #define PerlDir_open(name) opendir((name))
diff --git a/perlsdio.h b/perlsdio.h
index 9825f8e..a539a0a 100644
--- a/perlsdio.h
+++ b/perlsdio.h
@@ -55,7 +55,12 @@
 #define PerlIO_clearerr(f)		clearerr(f)
 #define PerlIO_flush(f)			Fflush(f)
 #define PerlIO_tell(f)			ftell(f)
-#define PerlIO_seek(f,o,w)		fseek(f,o,w)
+#if defined(VMS) && !defined(__DECC)
+   /* Old VAXC RTL doesn't reset EOF on seek; Perl folk seem to expect this */
+#  define PerlIO_seek(f,o,w)	(((f) && (*f) && ((*f)->_flag &= ~_IOEOF)),fseek(f,o,w))
+#else
+#  define PerlIO_seek(f,o,w)		fseek(f,o,w)
+#endif
 #ifdef HAS_FGETPOS
 #define PerlIO_getpos(f,p)		fgetpos(f,p)
 #endif
diff --git a/t/lib/english.t b/t/lib/english.t
index 1a96c77..9691229 100755
--- a/t/lib/english.t
+++ b/t/lib/english.t
@@ -5,7 +5,7 @@ print "1..16\n";
 BEGIN { @INC = '../lib' }
 use English;
 use Config;
-my $threads = $Config{archname} =~ /-thread$/;
+my $threads = $Config{'usethreads'} || 0;
 
 print $PID == $$ ? "ok 1\n" : "not ok 1\n";
 
diff --git a/vms/config.vms b/vms/config.vms
index 24a3906..35abbdb 100644
--- a/vms/config.vms
+++ b/vms/config.vms
@@ -76,7 +76,7 @@
  * 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_00462"  /**/
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_00463"  /**/
 
 
 #define ARCHLIB ARCHLIB_EXP	/*config-skip*/
@@ -177,6 +177,7 @@
  *	This symbol, if defined, indicates that the C-shell exists.
  *	If defined, contains the full pathname of csh.
  */
+#undef HAS_CSH		/**/
 #undef CSH 		/**/
 
 /* HAS_DUP2:
@@ -242,6 +243,26 @@
 #  define Timeval struct timeval /*config-skip*/
 #endif
 
+/* HAS_LONG_DOUBLE:
+ *	This symbol will be defined if the C compiler supports long
+ *	doubles.
+ */
+/* LONG_DOUBLESIZE:
+ *	This symbol contains the size of a long double, so that the 
+ *	C preprocessor can make decisions based on it.  It is only
+ *	defined if the system supports long doubles.
+ */
+#undef HAS_LONG_DOUBLE		/**/
+#ifdef HAS_LONG_DOUBLE
+#  define LONG_DOUBLESIZE 8		/**/
+#endif
+
+/* HAS_MKSTEMP:
+ *	This symbol, if defined, indicates that the mkstemp routine is
+ *	available to create and open a unique temporary file.
+ */
+#undef HAS_MKSTEMP		/**/
+
 /* HAS_GETGROUPS:
  *	This symbol, if defined, indicates that the getgroups() routine is
  *	available to get the list of process groups.  If unavailable, multiple
@@ -1847,6 +1868,13 @@
  */
 #undef	USE_PERLIO		/**/
 
+/* HAS_SETVBUF:
+ *	This symbol, if defined, indicates that the setvbuf routine is
+ *	available to change buffering on an open stdio stream.
+ *	to a line-buffered mode.
+ */
+#define HAS_SETVBUF		/**/
+
 /* VOIDFLAGS:
  *	This symbol indicates how much support of the void type is given by this
  *	compiler.  What various bits mean:
@@ -1916,8 +1944,8 @@
  *	This symbol, if defined, indicates that the getprotobynumber()
  *	routine is available to look up protocols by their number.
  */
-#define HAS_GETPROTOBYNAME		/**/
-#define HAS_GETPROTOBYNUMBER		/**/
+#define HAS_GETPROTOBYNAME		/*config-skip*/
+#define HAS_GETPROTOBYNUMBER		/*config-skip*/
 
 /* HAS_GETHOSTBYNAME:
  *	This symbol, if defined, indicates that the gethostbyname routine is
@@ -1952,9 +1980,30 @@
  *	available to lookup networks by their names.
  */
 #define HAS_GETNETBYNAME		/*config-skip*/
+
+/* HAS_GETNETENT:
+ *	This symbol, if defined, indicates that the getnetent() routine is
+ *	available to look up network names in some data base or another.
+ */
+#define HAS_GETNETENT		/*config-skip*/
+
+/* HAS_SETNETENT:
+ *	This symbol, if defined, indicates that the setnetent() routine is
+ *	available.
+ */
+#define HAS_SETNETENT		/*config-skip*/
+
+/* HAS_ENDNETENT:
+ *	This symbol, if defined, indicates that the endnetent() routine is
+ *	available to close whatever was being used for network queries.
+ */
+#define HAS_ENDNETENT		/*config-skip*/
 #else
-#undef HAS_GETNETBYADDR			/*config-skip*/
+#undef HAS_GETNETBYADDR		/*config-skip*/
 #undef HAS_GETNETBYNAME		/*config-skip*/
+#undef HAS_GETNETENT		/*config-skip*/
+#undef HAS_SETNETENT		/*config-skip*/
+#undef HAS_ENDNETENT		/*config-skip*/
 #endif
 
 /* HAS_GETPROTOBYNAME:
@@ -2014,6 +2063,48 @@
  */
 #define HAS_SELECT	/**/              /* config-skip */
 
+/* HAS_ENDHOSTENT:
+ *	This symbol, if defined, indicates that the endhostent() routine is
+ *	available to close whatever was being used for host queries.
+ */
+#define HAS_ENDHOSTENT		/*config-skip*/
+
+/* HAS_GETPROTOENT:
+ *	This symbol, if defined, indicates that the getprotoent() routine is
+ *	available to look up protocols in some data base or another.
+ */
+#define HAS_GETPROTOENT		/*config-skip*/
+
+/* HAS_ENDPROTOENT:
+ *	This symbol, if defined, indicates that the endprotoent() routine is
+ *	available to close whatever was being used for protocol queries.
+ */
+#define HAS_ENDPROTOENT		/*config-skip*/
+
+/* HAS_SETPROTOENT:
+ *	This symbol, if defined, indicates that the setprotoent() routine is
+ *	available.
+ */
+#define HAS_SETPROTOENT		/*config-skip*/
+
+/* HAS_GETSERVENT:
+ *	This symbol, if defined, indicates that the getservent() routine is
+ *	available to look up network services in some data base or another.
+ */
+#define HAS_GETSERVENT		/*config-skip*/
+
+/* HAS_SETSERVENT:
+ *	This symbol, if defined, indicates that the setservent() routine is
+ *	available.
+ */
+#define HAS_SETSERVENT		/*config-skip*/
+
+/* HAS_ENDSERVENT:
+ *	This symbol, if defined, indicates that the endservent() routine is
+ *	available to close whatever was being used for service queries.
+ */
+#define HAS_ENDSERVENT		/*config-skip*/
+
 #else /* VMS_DO_SOCKETS */
 
 #undef HAS_SOCKET				/*config-skip*/
@@ -2026,12 +2117,22 @@
 #undef HAS_SELECT				/*config-skip*/
 #undef HAS_GETHOSTBYADDR		/*config-skip*/
 #undef HAS_GETNETBYADDR			/*config-skip*/
+#undef HAS_GETNETENT			/*config-skip*/
+#undef HAS_SETNETENT			/*config-skip*/
+#undef HAS_ENDNETENT			/*config-skip*/
 #undef HAS_GETHOSTBYNAME		/*config-skip*/
 #undef HAS_GETNETBYNAME			/*config-skip*/
 #undef HAS_GETPROTOBYNAME		/*config-skip*/
 #undef HAS_GETPROTOBYNUMBER		/*config-skip*/
 #undef HAS_GETSERVBYNAME		/*config-skip*/
 #undef HAS_GETSERVBYPORT		/*config-skip*/
+#undef HAS_ENDHOSTENT			/*config-skip*/
+#undef HAS_GETPROTOENT			/*config-skip*/
+#undef HAS_SETPROTOENT			/*config-skip*/
+#undef HAS_ENDPROTOENT			/*config-skip*/
+#undef HAS_GETSERVENT			/*config-skip*/
+#undef HAS_SETSERVENT			/*config-skip*/
+#undef HAS_ENDSERVENT			/*config-skip*/
 
 #endif /* !VMS_DO_SOCKETS */
 
diff --git a/vms/descrip.mms b/vms/descrip.mms
index 683f40d..00a5c0b 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_00462#
+PERL_VERSION = 5_00463#
 
 .ifdef DECC_SOCKETS
 SOCKET=1
@@ -395,8 +395,8 @@ byteperl.c : [.ext.B]byteperl.c
 .ifdef __DEBUG__
 # Link an extra perl that doesn't invoke the debugger
 perl : $(DBG)perl$(E) $(DBG)byteperl$(E)
-	Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoCross/NoFull/Exe=N$(DBG)perl$(E) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option
-	Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoCross/NoFull/Exe=N$(DBG)byteperl$(E) byteperl$(O), perlshr.opt/Option, perlshr_attr.opt/Option
+	Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoCross/NoFull/Exe=N$(DBG)perl$(E) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option $(CRTLOPTS)
+	Link $(LINKFLAGS)/NoDebug/Trace/NoMap/NoCross/NoFull/Exe=N$(DBG)byteperl$(E) byteperl$(O), perlshr.opt/Option, perlshr_attr.opt/Option $(CRTLOPTS)
 .else
 perl : $(DBG)perl$(E) $(DBG)byteperl$(E)
 	@ Continue
@@ -404,11 +404,11 @@ perl : $(DBG)perl$(E) $(DBG)byteperl$(E)
 
 $(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE)
 	@ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share"
-	Link $(LINKFLAGS)/Exe=$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option
+	Link $(LINKFLAGS)/Exe=$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option $(CRTLOPTS)
 
 $(DBG)byteperl$(E) : byteperl$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE)
 	@ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share"
-	Link $(LINKFLAGS)/Exe=$(MMS$TARGET) byteperl$(O), perlshr.opt/Option, perlshr_attr.opt/Option
+	Link $(LINKFLAGS)/Exe=$(MMS$TARGET) byteperl$(O), perlshr.opt/Option, perlshr_attr.opt/Option $(CRTLOPTS)
 
 $(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts
 	Link $(LINKFLAGS)/Share=$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option
@@ -1342,6 +1342,17 @@ clean : tidy
 	Set Default [.ext.Opcode]
 	- $(MMS) clean
 	Set Default [--]
+	Set Default [.ext.attrs]
+	- $(MMS) clean
+	Set Default [--]
+	Set Default [.ext.B]
+	- $(MMS) clean
+	Set Default [--]
+.ifdef THREAD
+	Set Default [.ext.Thread]
+	- $(MMS) realclean
+	Set Default [--]
+.endif
 .ifdef DECC
 	Set Default [.ext.POSIX]
 	- $(MMS) clean
@@ -1384,6 +1395,9 @@ realclean : clean
 	Set Default [.ext.attrs]
 	- $(MMS) realclean
 	Set Default [--]
+	Set Default [.ext.B]
+	- $(MMS) realclean
+	Set Default [--]
 .ifdef THREAD
 	Set Default [.ext.Thread]
 	- $(MMS) realclean
diff --git a/vms/ext/Filespec.pm b/vms/ext/Filespec.pm
index db3283c..b0b1414 100644
--- a/vms/ext/Filespec.pm
+++ b/vms/ext/Filespec.pm
@@ -12,7 +12,7 @@ VMS::Filespec - convert between VMS and Unix file specification syntax
 =head1 SYNOPSIS
 
 use VMS::Filespec;
-$fullspec = rmsexpand('[.VMS]file.specification');
+$fullspec = rmsexpand('[.VMS]file.specification'[, 'default:[file.spec]']);
 $vmsspec = vmsify('/my/Unix/file/specification');
 $unixspec = unixify('my:[VMS]file.specification');
 $path = pathify('my:[VMS.or.Unix.directory]specification.dir');
@@ -65,9 +65,11 @@ The routines provided are:
 =head2 rmsexpand
 
 Uses the RMS $PARSE and $SEARCH services to expand the input
-specification to its fully qualified form.  (If the file does
-not exist, the input specification is expanded as much as
-possible.)  If an error occurs, returns C<undef> and sets C<$!>
+specification to its fully qualified form, except that a null type
+or version is not added unless it was present in either the original
+file specification or the default specification passed to C<rmsexpand>.
+(If the file does not exist, the input specification is expanded as much
+as possible.)  If an error occurs, returns C<undef> and sets C<$!>
 and C<$^E>.
 
 =head2 vmsify
diff --git a/vms/ext/Stdio/0README.txt b/vms/ext/Stdio/0README.txt
index 28f82b3..25329f9 100644
--- a/vms/ext/Stdio/0README.txt
+++ b/vms/ext/Stdio/0README.txt
@@ -3,26 +3,6 @@ VMS::Stdio, which provides access from Perl to VMS-specific
 stdio functions.  For more specific documentation of its
 function, please see the pod section of Stdio.pm.
 
-                       *** Please Note ***
-
-This package is the direct descendant of VMS::stdio, but as of Perl
-5.002, the name has been changed to VMS::Stdio, in order to conform
-to the Perl naming convention that extensions whose name begins
-with a lowercase letter represent compile-time "pragmas", while
-extensions which provide added functionality have names whose parts
-begin with uppercase letters.  In addition, the functions
-vmsfopen and fgetname have been renamed vmsopen and getname,
-respectively, in order to more closely resemble related Perl
-I/O operators, which do not retain the 'f' from corresponding
-C routine names.
-
-A transitional interface to the old routine names has been
-provided, so that calls to these routines will generate a
-warning, and be routed to the corresponding VMS::Stdio
-routine.  This interface will be removed in a future release,
-so please update your code to use the new names.
-
-
 ===> Installation
 
 This extension, like most Perl extensions, should be installed
@@ -45,3 +25,6 @@ the Perl distribution tree, and then saying
 2.0  28-Feb-1996  Charles Bailey  bailey@genetics.upenn.edu
      major rewrite for Perl 5.002: name changed to VMS::Stdio,
      new functions added, and prototypes incorporated
+2.1  24-Mar-1998  Charles Bailey  bailey@newman.upenn.edu
+     Added writeof()
+     Removed old VMs::stdio compatibility interface
diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm
index 01ff32d..ea5d907 100644
--- a/vms/ext/Stdio/Stdio.pm
+++ b/vms/ext/Stdio/Stdio.pm
@@ -1,8 +1,8 @@
 #   VMS::Stdio - VMS extensions to Perl's stdio calls
 #
 #   Author:  Charles Bailey  bailey@genetics.upenn.edu
-#   Version: 2.02
-#   Revised: 15-Feb-1997
+#   Version: 2.1
+#   Revised: 24-Mar-1998
 
 package VMS::Stdio;
 
@@ -12,17 +12,18 @@ use Carp '&croak';
 use DynaLoader ();
 use Exporter ();
  
-$VERSION = '2.02';
+$VERSION = '2.1';
 @ISA = qw( Exporter DynaLoader IO::File );
 @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY &O_NOWAIT
               &O_RDONLY &O_RDWR  &O_TRUNC &O_WRONLY );
-@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &tmpnam
-                 &vmsopen &vmssysopen &waitfh );
+@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &setdef &tmpnam
+                 &vmsopen &vmssysopen &waitfh &writeof );
 %EXPORT_TAGS = ( CONSTANTS => [ qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY
                                     &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC
                                     &O_WRONLY ) ],
-                 FUNCTIONS => [ qw( &flush &getname &remove &rewind &sync
-                                     &tmpnam &vmsopen &vmssysopen &waitfh ) ] );
+                 FUNCTIONS => [ qw( &flush &getname &remove &rewind &setdef
+                                    &sync &tmpnam &vmsopen &vmssysopen
+                                    &waitfh &writeof ) ] );
 
 bootstrap VMS::Stdio $VERSION;
 
@@ -80,8 +81,9 @@ VMS::Stdio - standard I/O functions via VMS extensions
 
 =head1 SYNOPSIS
 
-use VMS::Stdio qw( &flush &getname &remove &rewind &sync &tmpnam
-                   &vmsopen &vmssysopen &waitfh );
+use VMS::Stdio qw( &flush &getname &remove &rewind &setdef &sync &tmpnam
+                   &vmsopen &vmssysopen &waitfh &writeof );
+setdef("new:[default.dir]");
 $uniquename = tmpnam;
 $fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!;
 $name = getname($fh);
@@ -96,7 +98,7 @@ sysread($fh,$data,128);
 waitfh($fh);
 close($fh);
 remove("another.file");
-
+writeof($pipefh);
 =head1 DESCRIPTION
 
 This package gives Perl scripts access via VMS extensions to several
@@ -175,6 +177,13 @@ to the beginning of the file.  It's really just a convenience
 method equivalent in effect to C<seek($fh,0,0)>.  It returns a
 true value if successful, and C<undef> if it fails.
 
+=item setdef
+
+This function sets the default device and directory for the process.
+It is identical to the built-in chdir() operator, except that the change
+persists after Perl exits.  It returns a true value on success, and
+C<undef> if it encounters and error.
+
 =item sync
 
 This function flushes buffered data for the specified file handle
@@ -231,6 +240,14 @@ operation on the file handle specified as its argument.  It is
 used with handles opened for asynchronous I/O, and performs its
 task by calling the CRTL routine fwait().
 
+=item writeof
+
+This function writes an EOF to a file handle, if the device driver
+supports this operation.  Its primary use is to send an EOF to a
+subprocess through a pipe opened for writing without closing the
+pipe.  It returns a true value if successful, and C<undef> if
+it encounters an error.
+
 =head1 REVISION
 
 This document was last revised on 10-Dec-1996, for Perl 5.004.
diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs
index b10fec0..0a7b47e 100644
--- a/vms/ext/Stdio/Stdio.xs
+++ b/vms/ext/Stdio/Stdio.xs
@@ -1,8 +1,8 @@
 /* VMS::Stdio - VMS extensions to stdio routines 
  *
- * Version:  2.02
+ * Version:  2.1
  * Author:   Charles Bailey  bailey@genetics.upenn.edu
- * Revised:  15-Feb-1997
+ * Revised:  24-Mar-1998
  *
  */
 
@@ -10,6 +10,9 @@
 #include "perl.h"
 #include "XSUB.h"
 #include <file.h>
+#include <iodef.h>
+#include <rms.h>
+#include <starlet.h>
 
 static bool
 constant(name, pval)
@@ -121,12 +124,10 @@ constant(name)
 	    ST(0) = &sv_undef;
 
 void
-flush(sv)
-	SV *	sv
+flush(fp)
+	FILE *	fp
 	PROTOTYPE: $
 	CODE:
-	    FILE *fp = Nullfp;
-	    if (SvOK(sv)) fp = IoIFP(sv_2io(sv));
 	    if (fflush(fp)) { ST(0) = &sv_undef; }
 	    else            { clearerr(fp); ST(0) = &sv_yes; }
 
@@ -135,7 +136,7 @@ getname(fp)
 	FILE *	fp
 	PROTOTYPE: $
 	CODE:
-	    char fname[257];
+	    char fname[NAM$C_MAXRSS+1];
 	    ST(0) = sv_newmortal();
 	    if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname);
 
@@ -154,6 +155,59 @@ remove(name)
 	    ST(0) = remove(name) ? &sv_undef : &sv_yes;
 
 void
+setdef(...)
+	PROTOTYPE: @
+	CODE:
+	    char vmsdef[NAM$C_MAXRSS+1], es[NAM$C_MAXRSS], sep;
+	    unsigned long int retsts;
+	    struct FAB deffab = cc$rms_fab;
+	    struct NAM defnam = cc$rms_nam;
+	    struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+	    if (items) {
+		SV *defsv = ST(items-1);  /* mimic chdir() */
+		ST(0) = &sv_undef;
+		if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); }
+		if (tovmsspec(SvPV(defsv,na),vmsdef) == NULL) { XSRETURN(1); }
+		deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef);
+	    }
+	    else {
+		deffab.fab$l_fna = "SYS$LOGIN"; deffab.fab$b_fns = 9;
+		EXTEND(sp,1);  ST(0) = &sv_undef;
+	    }
+	    defnam.nam$l_esa = es;  defnam.nam$b_ess = sizeof es;
+	    deffab.fab$l_nam = &defnam;
+	    retsts = sys$parse(&deffab,0,0);
+	    if (retsts & 1) {
+		if (defnam.nam$v_wildcard) retsts = RMS$_WLD;
+		else if (defnam.nam$b_name || defnam.nam$b_type > 1 ||
+	             defnam.nam$b_ver > 1) retsts = RMS$_DIR;
+		}
+	    defnam.nam$b_nop |= NAM$M_SYNCHK; defnam.nam$l_rlf = NULL; deffab.fab$b_dns = 0;
+	    if (!(retsts & 1)) {
+		set_vaxc_errno(retsts);
+		switch (retsts) {
+		    case RMS$_DNF:
+			set_errno(ENOENT); break;
+		    case RMS$_SYN: case RMS$_DIR: case RMS$_DEV:
+			set_errno(EINVAL); break;
+		    case RMS$_PRV:
+			set_errno(EACCES); break;
+		    default:
+			set_errno(EVMSERR); break;
+		}
+		(void) sys$parse(&deffab,0,0);  /* free up context */
+		XSRETURN(1);
+	    }
+	    sep = *defnam.nam$l_dir;
+	    *defnam.nam$l_dir = '\0';
+	    my_setenv("SYS$DISK",defnam.nam$b_node ? defnam.nam$l_node : defnam.nam$l_dev);
+	    *defnam.nam$l_dir = sep;
+	    dirdsc.dsc$a_pointer = defnam.nam$l_dir; dirdsc.dsc$w_length = defnam.nam$b_dir;
+	    if ((retsts = sys$setddir(&dirdsc,0,0)) & 1) ST(0) = &sv_yes;
+	    else { set_errno(EVMSERR); set_vaxc_errno(retsts); }
+	    (void) sys$parse(&deffab,0,0);  /* free up context */
+
+void
 sync(fp)
 	FILE *	fp
 	PROTOTYPE: $
@@ -295,3 +349,43 @@ waitfh(fp)
 	PROTOTYPE: $
 	CODE:
 	    ST(0) = fwait(fp) ? &sv_undef : &sv_yes;
+
+void
+writeof(mysv)
+	SV *	mysv
+	PROTOTYPE: $
+	CODE:
+	    char devnam[257], *cp;
+	    unsigned long int chan, iosb[2], retsts, retsts2;
+	    struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
+	    IO *io = sv_2io(mysv);
+	    FILE *fp = io ? IoOFP(io) : NULL;
+	    if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == Nullch) {
+	      set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN);
+	      ST(0) = &sv_undef;  XSRETURN(1);
+	    }
+	    if (fgetname(fp,devnam) == Nullch) { ST(0) = &sv_undef; XSRETURN(1); }
+	    if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
+	    devdsc.dsc$w_length = strlen(devnam);
+	    retsts = sys$assign(&devdsc,&chan,0,0);
+	    if (retsts & 1) retsts = sys$qiow(0,chan,IO$_WRITEOF,iosb,0,0,0,0,0,0,0,0);
+	    if (retsts & 1) retsts = iosb[0];
+	    retsts2 = sys$dassgn(chan);  /* Be sure to deassign the channel */
+	    if (retsts & 1) retsts = retsts2;
+	    if (retsts & 1) { ST(0) = &sv_yes; }
+	    else {
+	      set_vaxc_errno(retsts);
+	      switch (retsts) {
+	        case SS$_EXQUOTA:  case SS$_INSFMEM:  case SS$_MBFULL:
+	        case SS$_MBTOOSML: case SS$_NOIOCHAN: case SS$_NOLINKS:
+	        case SS$_BUFFEROVF:
+	          set_errno(ENOSPC); break;
+	        case SS$_ILLIOFUNC: case SS$_DEVOFFLINE: case SS$_NOSUCHDEV:
+	          set_errno(EBADF);  break;
+	        case SS$_NOPRIV:
+	          set_errno(EACCES); break;
+	        default:  /* Includes "shouldn't happen" cases that might map */
+	          set_errno(EVMSERR); break;         /* to other errno values */
+	      }
+	      ST(0) = &sv_undef;
+	    }
diff --git a/vms/ext/Stdio/test.pl b/vms/ext/Stdio/test.pl
index 0b50d63..36353d9 100755
--- a/vms/ext/Stdio/test.pl
+++ b/vms/ext/Stdio/test.pl
@@ -1,8 +1,8 @@
-# Tests for VMS::Stdio v2.01
+# Tests for VMS::Stdio v2.1
 use VMS::Stdio;
-import VMS::Stdio qw(&flush &getname &rewind &sync);
+import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);
 
-print "1..14\n";
+print "1..19\n";
 print +(defined(&getname) ? '' : 'not '), "ok 1\n";
 
 $name = "test$$";
@@ -42,3 +42,27 @@ undef $sfh;
 print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n";
 
 print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n";
+
+if (open(P, qq[| MCR $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) {
+  print P "Baz\nQuux\n";
+  print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n";
+  print P "Baz\nQuux\n";
+  print +(close(P) ? '' : 'not '),"ok 16\n";
+  $fh = VMS::Stdio::vmsopen("$name.tmp");
+  chomp($line = <$fh>);
+  close $fh;
+  unlink("$name.tmp");
+  print +($line eq 'FooBar' ? '' : 'not '),"ok 17\n";
+}
+else { print "not ok 15\nnot ok 16\nnot ok 17\n"; }
+
+$sfh = VMS::Stdio::vmsopen(">$name.tmp");
+$setuperl = "\$ MCR $^X\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);";
+print $sfh qq[\$ here = F\$Environment("Default")\n];
+print $sfh "$setuperl\nsetdef();\n\$ Show Default\n\$ Set Default 'here'\n";
+print $sfh "$setuperl\nsetdef('..');\n\$ Show Default\n";
+close $sfh;
+@defs = map { /(\S+)/ && $1 } `\@$name.tmp`;
+unlink("$name.tmp");
+print +($defs[0] eq uc($ENV{'SYS$LOGIN'}) ? '' : "not ($defs[0]) "),"ok 18\n";
+print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n";
diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t
index 1b31f06..0564491 100644
--- a/vms/ext/filespec.t
+++ b/vms/ext/filespec.t
@@ -10,7 +10,7 @@ foreach (<DATA>) {
   next if /^\s*$/;
   push(@tests,$_);
 }
-print '1..',scalar(@tests)+5,"\n";
+print '1..',scalar(@tests)+6,"\n";
 
 foreach $test (@tests) {
   ($arg,$func,$expect) = split(/\t+/,$test);
@@ -25,14 +25,17 @@ foreach $test (@tests) {
   }
 }
 
+$defwarn = <<'EOW';
+# Note: This failure may have occurred because your default device
+# was set using a non-concealed logical name.  If this is the case,
+# you will need to determine by inspection that the two resultant
+# file specifications shwn above are in fact equivalent.
+EOW
+
 if (rmsexpand('[]') eq "\U$ENV{DEFAULT}") { print 'ok ',++$idx,"\n"; }
 else {
   print 'not ok ', ++$idx, ": rmsexpand('[]') = |", rmsexpand('[]'),
-        "|, \$ENV{DEFAULT} = |\U$ENV{DEFAULT}|\n";
-  print "# Note: This failure may have occurred because your default device\n";
-  print "# was set using a non-concealed logical name.  If this is the case,\n";
-  print "# you will need to determine by inspection that the two resultant\n";
-  print "# file specifications shwn above are in fact equivalent.\n";
+        "|, \$ENV{DEFAULT} = |\U$ENV{DEFAULT}|\n$defwarn";
 }
 if (rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here") {
    print 'ok ', ++$idx, "\n";
@@ -40,11 +43,15 @@ if (rmsexpand('from.here') eq "\L$ENV{DEFAULT}from.here") {
 else {
   print 'not ok ', ++$idx, ": rmsexpand('from.here') = |",
         rmsexpand('from.here'),
-        "|, \$ENV{DEFAULT}from.here = |\L$ENV{DEFAULT}from.here|\n";
-  print "# Note: This failure may have occurred because your default device\n";
-  print "# was set using a non-concealed logical name.  If this is the case,\n";
-  print "# you will need to determine by inspection that the two resultant\n";
-  print "# file specifications shwn above are in fact equivalent.\n";
+        "|, \$ENV{DEFAULT}from.here = |\L$ENV{DEFAULT}from.here|\n$defwarn";
+}
+if (rmsexpand('from') eq "\L$ENV{DEFAULT}from") {
+   print 'ok ', ++$idx, "\n";
+}
+else {
+  print 'not ok ', ++$idx, ": rmsexpand('from') = |",
+        rmsexpand('from'),
+        "|, \$ENV{DEFAULT}from = |\L$ENV{DEFAULT}from|\n$defwarn";
 }
 if (rmsexpand('from.here','cant:[get.there];2') eq
     'cant:[get.there]from.here;2')                 { print 'ok ',++$idx,"\n"; }
diff --git a/vms/genconfig.pl b/vms/genconfig.pl
index 94fcdd7..4e0cf31 100644
--- a/vms/genconfig.pl
+++ b/vms/genconfig.pl
@@ -180,6 +180,13 @@ foreach (@ARGV) {
     print OUT "d_getpbynumber=",$dosock ? "'define'\n" : "'undef'\n";
     print OUT "d_getsbyname=",$dosock ? "'define'\n" : "'undef'\n";
     print OUT "d_getsbyport=",$dosock ? "'define'\n" : "'undef'\n";
+    print OUT "d_endhent=",$dosock ? "'define'\n" : "'undef'\n";
+    print OUT "d_getpent=",$dosock ? "'define'\n" : "'undef'\n";
+    print OUT "d_setpent=",$dosock ? "'define'\n" : "'undef'\n";
+    print OUT "d_endpent=",$dosock ? "'define'\n" : "'undef'\n";
+    print OUT "d_getsent=",$dosock ? "'define'\n" : "'undef'\n";
+    print OUT "d_setsent=",$dosock ? "'define'\n" : "'undef'\n";
+    print OUT "d_endsent=",$dosock ? "'define'\n" : "'undef'\n";
     print OUT "netdb_name_type=",$dosock ? "'char *'\n" : "'undef'\n";
     print OUT "netdb_host_type=",$dosock ? "'char *'\n" : "'undef'\n";
     print OUT "netdb_hlen_type=",$dosock ? "'int'\n" : "'undef'\n";
@@ -188,12 +195,18 @@ foreach (@ARGV) {
       print OUT "selecttype='fd_set'\n";
       print OUT "d_getnbyaddr='define'\n";
       print OUT "d_getnbyname='define'\n";
+      print OUT "d_getnent='define'\n";
+      print OUT "d_setnent='define'\n";
+      print OUT "d_endnent='define'\n";
       print OUT "netdb_net_type='long'\n";
     }
     else {
       print OUT "selecttype='int'\n";
       print OUT "d_getnybname='undef'\n";
       print OUT "d_getnybaddr='undef'\n";
+      print OUT "d_getnent='undef'\n";
+      print OUT "d_setnent='undef'\n";
+      print OUT "d_endnent='undef'\n";
       print OUT "netdb_net_type='undef'\n";
     }
 
diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index 2e68d12..5f2a6f9 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1276,7 +1276,7 @@ dEXT YYSTYPE yyval;
 dEXT YYSTYPE yylval;
 #line 636 "perly.y"
  /* PROGRAM */
-#line 1349 "y_tab.c"
+#line 1349 "perly.c"
 #define YYABORT goto yyabort
 #define YYACCEPT goto yyaccept
 #define YYERROR goto yyerrlab
@@ -1375,7 +1375,7 @@ yyloop:
             yys = 0;
             if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
             if (!yys) yys = "illegal-symbol";
-            fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate,
+            PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate,
                     yychar, yys);
         }
 #endif
@@ -1385,7 +1385,7 @@ yyloop:
     {
 #if YYDEBUG
         if (yydebug)
-            fprintf(stderr, "yydebug: state %d, shifting to state %d\n",
+            PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n",
                     yystate, yytable[yyn]);
 #endif
         if (yyssp >= yyss + yystacksize - 1)
@@ -1440,7 +1440,7 @@ yyinrecovery:
             {
 #if YYDEBUG
                 if (yydebug)
-                    fprintf(stderr,
+                    PerlIO_printf(Perl_debug_log,
 		     "yydebug: state %d, error recovery shifting to state %d\n",
 		     *yyssp, yytable[yyn]);
 #endif
@@ -1470,7 +1470,7 @@ yyinrecovery:
             {
 #if YYDEBUG
                 if (yydebug)
-                    fprintf(stderr,
+                    PerlIO_printf(Perl_debug_log,
 			"yydebug: error recovery discarding state %d\n",
 			*yyssp);
 #endif
@@ -1489,7 +1489,7 @@ yyinrecovery:
             yys = 0;
             if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
             if (!yys) yys = "illegal-symbol";
-            fprintf(stderr,
+            PerlIO_printf(Perl_debug_log,
 		"yydebug: state %d, error recovery discards token %d (%s)\n",
 		yystate, yychar, yys);
         }
@@ -1500,7 +1500,7 @@ yyinrecovery:
 yyreduce:
 #if YYDEBUG
     if (yydebug)
-        fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n",
+        PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n",
                 yystate, yyn, yyrule[yyn]);
 #endif
     yym = yylen[yyn];
@@ -2285,7 +2285,7 @@ case 176:
 #line 633 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-#line 2267 "y_tab.c"
+#line 2267 "perly.c"
     }
     yyssp -= yym;
     yystate = *yyssp;
@@ -2295,7 +2295,7 @@ break;
     {
 #if YYDEBUG
         if (yydebug)
-            fprintf(stderr,
+            PerlIO_printf(Perl_debug_log,
 		"yydebug: after reduction, shifting from state 0 to state %d\n",
 		YYFINAL);
 #endif
@@ -2311,7 +2311,7 @@ break;
                 yys = 0;
                 if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
                 if (!yys) yys = "illegal-symbol";
-                fprintf(stderr, "yydebug: state %d, reading %d (%s)\n",
+                PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n",
                         YYFINAL, yychar, yys);
             }
 #endif
@@ -2326,7 +2326,7 @@ break;
         yystate = yydgoto[yym];
 #if YYDEBUG
     if (yydebug)
-        fprintf(stderr,
+        PerlIO_printf(Perl_debug_log,
 	    "yydebug: after reduction, shifting from state %d to state %d\n",
 	    *yyssp, yystate);
 #endif
diff --git a/vms/vms.c b/vms/vms.c
index 91ec8af..f57762e 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -184,7 +184,7 @@ prime_env_iter(void)
  */
 {
   dTHR;
-  static int primed = 0;  /* XXX Not thread-safe!!! */
+  static int primed = 0;
   HV *envhv = GvHVn(envgv);
   FILE *sholog;
   char eqv[LNM$C_NAMLENGTH+1],*start,*end;
@@ -841,12 +841,14 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
 
   retsts = sys$parse(&myfab,0,0);
   if (!(retsts & 1)) {
+    mynam.nam$b_nop |= NAM$M_SYNCHK;
     if (retsts == RMS$_DNF || retsts == RMS$_DIR ||
         retsts == RMS$_DEV || retsts == RMS$_DEV) {
-      mynam.nam$b_nop |= NAM$M_SYNCHK;
       retsts = sys$parse(&myfab,0,0);
       if (retsts & 1) goto expanded;
     }  
+    mynam.nam$l_rlf = NULL; myfab.fab$b_dns = 0;
+    (void) sys$parse(&myfab,0,0);  /* Free search context */
     if (out) Safefree(out);
     set_vaxc_errno(retsts);
     if      (retsts == RMS$_PRV) set_errno(EACCES);
@@ -857,6 +859,8 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
   }
   retsts = sys$search(&myfab,0,0);
   if (!(retsts & 1) && retsts != RMS$_FNF) {
+    mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
+    myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0);  /* Free search context */
     if (out) Safefree(out);
     set_vaxc_errno(retsts);
     if      (retsts == RMS$_PRV) set_errno(EACCES);
@@ -874,6 +878,10 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
   if (!(mynam.nam$l_fnb & NAM$M_EXP_VER) &&
       (!defspec || !*defspec || !strchr(myfab.fab$l_dna,';')))
     speclen = mynam.nam$l_ver - out;
+  if (!(mynam.nam$l_fnb & NAM$M_EXP_TYPE) &&
+      (!defspec || !*defspec || defspec[myfab.fab$b_dns-1] != '.' ||
+       defspec[myfab.fab$b_dns-2] == '.'))
+    speclen = mynam.nam$l_type - out;
   /* If we just had a directory spec on input, $PARSE "helpfully"
    * adds an empty name and type for us */
   if (mynam.nam$l_name == mynam.nam$l_type &&
@@ -895,6 +903,9 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
     if (do_tounixspec(outbuf,tmpfspec,0) == NULL) return NULL;
     strcpy(outbuf,tmpfspec);
   }
+  mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
+  mynam.nam$l_rsa = NULL; mynam.nam$b_rss = 0;
+  myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0);  /* Free search context */
   return outbuf;
 }
 /*}}}*/
@@ -1032,6 +1043,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts)
           }
           cp1++;
         } while ((cp1 = strstr(cp1,"/.")) != NULL);
+        lastdir = strrchr(dir,'/');
       }
       else if (!strcmp(&dir[dirlen-7],"/000000")) {
         /* Ditto for specs that end in an MFD -- let the VMS code
@@ -2441,7 +2453,7 @@ trim_unixpath(char *fspec, char *wildspec, int opts)
       for (front = end ; front >= base; front--)
          if (*front == '/' && !dirs--) { front++; break; }
     }
-    for (cp1=template,cp2=lcres; *cp1; 
+    for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + sizeof lcres;
          cp1++,cp2++) *cp2 = _tolower(*cp1);  /* Make lc copy for match */
     if (cp1 != '\0') return 0;  /* Path too long. */
     lcend = cp2;
@@ -4119,11 +4131,11 @@ my_binmode(FILE *fp, char iotype)
     if (iotype != '-'&& (ret = fgetpos(fp, &pos)) == -1 && dirend) return NULL;
     switch (iotype) {
       case '<': case 'r':           acmode = "rb";                      break;
-      case '>': case 'w':
+      case '>': case 'w': case '|':
         /* use 'a' instead of 'w' to avoid creating new file;
            fsetpos below will take care of restoring file position */
       case 'a':                     acmode = "ab";                      break;
-      case '+': case '|': case 's': acmode = "rb+";                     break;
+      case '+':  case 's':          acmode = "rb+";                     break;
       case '-':                     acmode = fileno(fp) ? "ab" : "rb";  break;
       default:
         warn("Unrecognized iotype %c in my_binmode",iotype);
@@ -4538,6 +4550,11 @@ init_os_extras()
   newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$");
   newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");
   newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
+
+#ifdef PRIME_ENV_AT_STARTUP
+  prime_env_iter();
+#endif
+
   return;
 }
   
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 31a42d9..1cda1e2 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -16,12 +16,11 @@
 #include <stsdef.h>  /* bitmasks for exit status testing */
 
 /* Suppress compiler warnings from DECC for VMS-specific extensions:
- * GLOBALEXT, NOSHAREEXT, READONLYEXT: global[dr]ef declarations
  * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values
  *                            (e.g. pointer fields of descriptors)
  */
 #ifdef __DECC
-#  pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT,ADDRCONSTEXT,NEEDCONSTEXT)
+#  pragma message disable (ADDRCONSTEXT,NEEDCONSTEXT)
 #endif
 
 /* DEC's C compilers and gcc use incompatible definitions of _to(upp|low)er() */
@@ -75,11 +74,6 @@
 
 /* DECC introduces this routine in the RTL as of VMS 7.0; for now,
  * we'll use ours, since it gives us the full VMS exit status. */
-#ifdef __PID_T
-#  define Pid_t pid_t
-#else
-#  define Pid_t unsigned int
-#endif
 #define waitpid my_waitpid
 
 /* Don't redeclare standard RTL routines in Perl's header files;