X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/eed5d6a149b02c1699ad94ea14e2bef36a34fdfa..449de3c2d9bd4f128b1ac6f08de7d29326bc285d:/vms/vms.c

diff --git a/vms/vms.c b/vms/vms.c
index 8fbac26..32a40af 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1,15 +1,28 @@
-/* vms.c
+/*    vms.c
  *
- * VMS-specific routines for perl5
- * Version: 5.7.0
+ *    VMS-specific routines for perl5
  *
- * August 2005 Convert VMS status code to UNIX status codes
- * August 2000 tweaks to vms_image_init, my_flush, my_fwrite, cando_by_name, 
- *             and Perl_cando by Craig Berry
- * 29-Aug-2000 Charles Lane's piping improvements rolled in
- * 20-Aug-1999 revisions by Charles Bailey  bailey@newman.upenn.edu
+ *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+ *    2002, 2003, 2004, 2005, 2006, 2007 by Charles Bailey and others.
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ *    Please see Changes*.* or the Perl Repository Browser for revision history.
  */
 
+/*
+ *   Yet small as was their hunted band
+ *   still fell and fearless was each hand,
+ *   and strong deeds they wrought yet oft,
+ *   and loved the woods, whose ways more soft
+ *   them seemed than thralls of that black throne
+ *   to live and languish in halls of stone.
+ *        "The Lay of Leithian", Canto II, lines 135-40
+ *
+ *     [p.162 of _The Lays of Beleriand_]
+ */
+ 
 #include <acedef.h>
 #include <acldef.h>
 #include <armdef.h>
@@ -271,6 +284,7 @@ struct vs_str_st {
 #define do_tovmspath(a,b,c,d)		mp_do_tovmspath(aTHX_ a,b,c,d)
 #define do_rmsexpand(a,b,c,d,e,f,g)	mp_do_rmsexpand(aTHX_ a,b,c,d,e,f,g)
 #define do_vms_realpath(a,b,c)		mp_do_vms_realpath(aTHX_ a,b,c)
+#define do_vms_realname(a,b,c)		mp_do_vms_realname(aTHX_ a,b,c)
 #define do_tounixspec(a,b,c,d)		mp_do_tounixspec(aTHX_ a,b,c,d)
 #define do_tounixpath(a,b,c,d)		mp_do_tounixpath(aTHX_ a,b,c,d)
 #define do_vms_case_tolerant(a)		mp_do_vms_case_tolerant(a)
@@ -330,6 +344,7 @@ static int decc_disable_to_vms_logname_translation = 1;
 static int decc_disable_posix_root = 1;
 int decc_efs_case_preserve = 0;
 static int decc_efs_charset = 0;
+static int decc_efs_charset_index = -1;
 static int decc_filename_unix_no_version = 0;
 static int decc_filename_unix_only = 0;
 int decc_filename_unix_report = 0;
@@ -339,14 +354,48 @@ static int vms_process_case_tolerant = 1;
 int vms_vtf7_filenames = 0;
 int gnv_unix_shell = 0;
 static int vms_unlink_all_versions = 0;
+static int vms_posix_exit = 0;
 
 /* bug workarounds if needed */
-int decc_bug_readdir_efs1 = 0;
 int decc_bug_devnull = 1;
-int decc_bug_fgetname = 0;
 int decc_dir_barename = 0;
+int vms_bug_stat_filename = 0;
 
 static int vms_debug_on_exception = 0;
+static int vms_debug_fileify = 0;
+
+/* Simple logical name translation */
+static int simple_trnlnm
+   (const char * logname,
+    char * value,
+    int value_len)
+{
+    const $DESCRIPTOR(table_dsc, "LNM$FILE_DEV");
+    const unsigned long attr = LNM$M_CASE_BLIND;
+    struct dsc$descriptor_s name_dsc;
+    int status;
+    unsigned short result;
+    struct itmlst_3 itlst[2] = {{value_len, LNM$_STRING, value, &result},
+                                {0, 0, 0, 0}};
+
+    name_dsc.dsc$w_length = strlen(logname);
+    name_dsc.dsc$a_pointer = (char *)logname;
+    name_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
+    name_dsc.dsc$b_class = DSC$K_CLASS_S;
+
+    status = sys$trnlnm(&attr, &table_dsc, &name_dsc, 0, itlst);
+
+    if ($VMS_STATUS_SUCCESS(status)) {
+
+	 /* Null terminate and return the string */
+	/*--------------------------------------*/
+	value[result] = 0;
+        return result;
+    }
+
+    return 0;
+}
+
 
 /* Is this a UNIX file specification?
  *   No longer a simple check with EFS file specs
@@ -581,10 +630,11 @@ int utf8_flag;
     case ']':
     case '%':
     case '^':
+    case '\\':
         /* Don't escape again if following character is 
          * already something we escape.
          */
-        if (strchr(".~!#&\'`()+@{},;[]%^=_", *(inspec+1))) {
+        if (strchr(".~!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) {
 	    *outspec = *inspec;
 	    *output_cnt = 1;
 	    return 1;
@@ -953,7 +1003,13 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
           int i;
           if (!environ) {
             ivenv = 1; 
-            Perl_warn(aTHX_ "Can't read CRTL environ\n");
+#if defined(PERL_IMPLICIT_CONTEXT)
+            if (aTHX == NULL) {
+                fprintf(stderr,
+                    "%%PERL-W-VMS_INIT Can't read CRTL environ\n");
+            } else
+#endif
+                Perl_warn(aTHX_ "Can't read CRTL environ\n");
             continue;
           }
           retsts = SS$_NOLOGNAM;
@@ -977,7 +1033,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
           unsigned short int deflen = LNM$C_NAMLENGTH;
           struct dsc$descriptor_d eqvdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
           /* dynamic dsc to accomodate possible long value */
-          _ckvmssts(lib$sget1_dd(&deflen,&eqvdsc));
+          _ckvmssts_noperl(lib$sget1_dd(&deflen,&eqvdsc));
           retsts = lib$get_symbol(&lnmdsc,&eqvdsc,&eqvlen,0);
           if (retsts & 1) { 
             if (eqvlen > MAX_DCL_SYMBOL) {
@@ -993,7 +1049,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
             }
             strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen);
           }
-          _ckvmssts(lib$sfree1_dd(&eqvdsc));
+          _ckvmssts_noperl(lib$sfree1_dd(&eqvdsc));
           if (retsts == LIB$_INVSYMNAM) { ivsym = 1; continue; }
           if (retsts == LIB$_NOSUCHSYM) continue;
           break;
@@ -1043,7 +1099,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
              retsts == SS$_NOLOGNAM) {
       set_errno(EINVAL);  set_vaxc_errno(retsts);
     }
-    else _ckvmssts(retsts);
+    else _ckvmssts_noperl(retsts);
     return 0;
 }  /* end of vmstrnenv */
 /*}}}*/
@@ -1165,7 +1221,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
        * for an optional name, and this "error" often shows up as the
        * (bogus) exit status for a die() call later on.  */
       if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
-      return success ? eqv : Nullch;
+      return success ? eqv : NULL;
     }
 
 }  /* end of my_getenv() */
@@ -1271,7 +1327,7 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys)
        * for an optional name, and this "error" often shows up as the
        * (bogus) exit status for a die() call later on.  */
       if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
-      return *len ? buf : Nullch;
+      return *len ? buf : NULL;
     }
 
 }  /* end of my_getenv_len() */
@@ -1291,7 +1347,7 @@ prime_env_iter(void)
   static int primed = 0;
   HV *seenhv = NULL, *envhv;
   SV *sv = NULL;
-  char cmd[LNM$C_NAMLENGTH+24], mbxnam[LNM$C_NAMLENGTH], *buf = Nullch;
+  char cmd[LNM$C_NAMLENGTH+24], mbxnam[LNM$C_NAMLENGTH], *buf = NULL;
   unsigned short int chan;
 #ifndef CLI$M_TRUSTED
 #  define CLI$M_TRUSTED 0x40  /* Missing from VAXC headers */
@@ -1321,6 +1377,12 @@ prime_env_iter(void)
     if (PL_curinterp) {
       aTHX = PERL_GET_INTERP;
     } else {
+      /* we never get here because the NULL pointer will cause the */
+      /* several of the routines called by this routine to access violate */
+
+      /* This routine is only called by hv.c/hv_iterinit which has a */
+      /* context, so the real fix may be to pass it through instead of */
+      /* the hoops above */
       aTHX = NULL;
     }
 #endif
@@ -1853,7 +1915,7 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag)
      * system services won't do this by themselves, so we may miss
      * a file "hiding" behind a logical name or search list. */
     vmsname = PerlMem_malloc(NAM$C_MAXRSS+1);
-    if (vmsname == NULL) _ckvmssts(SS$_INSFMEM);
+    if (vmsname == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
     rslt = do_rmsexpand(name,
 			vmsname,
@@ -1887,7 +1949,7 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag)
      * and the insert an ACE at the head of the ACL which allows us
      * to delete the file.
      */
-    _ckvmssts(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
+    _ckvmssts_noperl(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
     fildsc.dsc$w_length = strlen(vmsname);
     fildsc.dsc$a_pointer = vmsname;
     cxt = 0;
@@ -1906,7 +1968,7 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag)
         case RMS$_PRV:
           set_errno(EACCES); break;
         default:
-          _ckvmssts(aclsts);
+          _ckvmssts_noperl(aclsts);
       }
       set_vaxc_errno(aclsts);
       PerlMem_free(vmsname);
@@ -2107,7 +2169,7 @@ Perl_my_chmod(pTHX_ const char *file_spec, mode_t mode)
     /* First convert this to a VMS format specification */
     vms_src = PerlMem_malloc(VMS_MAXRSS);
     if (vms_src == NULL)
-	_ckvmssts(SS$_INSFMEM);
+	_ckvmssts_noperl(SS$_INSFMEM);
 
     rslt = do_tovmsspec(file_spec, vms_src, 0, NULL);
     if (rslt == NULL) {
@@ -2120,7 +2182,7 @@ Perl_my_chmod(pTHX_ const char *file_spec, mode_t mode)
     /* Now make it a directory spec so chmod is happy */
     vms_dir = PerlMem_malloc(VMS_MAXRSS + 1);
     if (vms_dir == NULL)
-	_ckvmssts(SS$_INSFMEM);
+	_ckvmssts_noperl(SS$_INSFMEM);
     rslt = do_fileify_dirspec(vms_src, vms_dir, 0, NULL);
     PerlMem_free(vms_src);
 
@@ -2359,7 +2421,7 @@ Perl_my_kill(int pid, int sig)
       case SS$_INSFMEM:
         set_errno(ENOMEM); break;
       default:
-        _ckvmssts(iss);
+        _ckvmssts_noperl(iss);
         set_errno(EVMSERR);
     } 
     set_vaxc_errno(iss);
@@ -2555,6 +2617,9 @@ int unix_status;
 	case RMS$_WLK:	/* Device write locked */
 		unix_status = EACCES;
 		break;
+	case RMS$_MKD:  /* Failed to mark for delete */
+		unix_status = EPERM;
+		break;
 	/* case RMS$_NMF: */  /* No more files */
 	}
     }
@@ -2717,7 +2782,7 @@ create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
      * keep the size between 128 and MAXBUF.
      *
      */
-    _ckvmssts(lib$getsyi(&syiitm, &syssize, 0, 0, 0, 0));
+    _ckvmssts_noperl(lib$getsyi(&syiitm, &syssize, 0, 0, 0, 0));
   }
 
   if (vmstrnenv("PERL_MBX_SIZE", csize, 0, fildev, 0)) {
@@ -2728,9 +2793,10 @@ create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
   if (mbxbufsiz < 128) mbxbufsiz = 128;
   if (mbxbufsiz > syssize) mbxbufsiz = syssize;
 
-  _ckvmssts(sts = sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
+  _ckvmssts_noperl(sts = sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
 
-  _ckvmssts(sts = lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length));
+  sts = lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length);
+  _ckvmssts_noperl(sts);
   namdsc->dsc$a_pointer[namdsc->dsc$w_length] = '\0';
 
 }  /* end of create_mbx() */
@@ -2853,7 +2919,7 @@ static $DESCRIPTOR(nl_desc, "NL:");
 
 
 static unsigned long int
-pipe_exit_routine(pTHX)
+pipe_exit_routine()
 {
     pInfo info;
     unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT;
@@ -2867,6 +2933,17 @@ pipe_exit_routine(pTHX)
     info = open_pipes;
     while (info) {
         if (info->fp) {
+#if defined(PERL_IMPLICIT_CONTEXT)
+           /* We need to use the Perl context of the thread that created */
+           /* the pipe. */
+           pTHX;
+           if (info->err)
+               aTHX = info->err->thx;
+           else if (info->out)
+               aTHX = info->out->thx;
+           else if (info->in)
+               aTHX = info->in->thx;
+#endif
            if (!info->useFILE
 #if defined(USE_ITHREADS)
              && my_perl
@@ -2891,7 +2968,7 @@ pipe_exit_routine(pTHX)
       _ckvmssts_noperl(sys$setast(0));
       if (info->in && !info->in->shut_on_empty) {
         _ckvmssts_noperl(sys$qio(0,info->in->chan_in,IO$_WRITEOF,0,0,0,
-                          0, 0, 0, 0, 0, 0));
+                                 0, 0, 0, 0, 0, 0));
         info->waiting = 1;
         did_stuff = 1;
       }
@@ -2961,6 +3038,18 @@ pipe_exit_routine(pTHX)
     }
 
     while(open_pipes) {
+
+#if defined(PERL_IMPLICIT_CONTEXT)
+      /* We need to use the Perl context of the thread that created */
+      /* the pipe. */
+      pTHX;
+      if (info->err)
+          aTHX = info->err->thx;
+      else if (info->out)
+          aTHX = info->out->thx;
+      else if (info->in)
+          aTHX = info->in->thx;
+#endif
       if ((sts = my_pclose(open_pipes->fp)) == -1) retsts = vaxc$errno;
       else if (!(sts & 1)) retsts = sts;
     }
@@ -3123,11 +3212,11 @@ pipe_tochild_setup(pTHX_ char *rmbx, char *wmbx)
     int j, n;
 
     n = sizeof(Pipe);
-    _ckvmssts(lib$get_vm(&n, &p));
+    _ckvmssts_noperl(lib$get_vm(&n, &p));
 
     create_mbx(aTHX_ &p->chan_in , &d_mbx1);
     create_mbx(aTHX_ &p->chan_out, &d_mbx2);
-    _ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
+    _ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
 
     p->buf           = 0;
     p->shut_on_empty = FALSE;
@@ -3148,9 +3237,9 @@ pipe_tochild_setup(pTHX_ char *rmbx, char *wmbx)
     n = sizeof(CBuf) + p->bufsize;
 
     for (j = 0; j < INITIAL_TOCHILDQUEUE; j++) {
-        _ckvmssts(lib$get_vm(&n, &b));
+        _ckvmssts_noperl(lib$get_vm(&n, &b));
         b->buf = (char *) b + sizeof(CBuf);
-        _ckvmssts(lib$insqhi(b, &p->free));
+        _ckvmssts_noperl(lib$insqhi(b, &p->free));
     }
 
     pipe_tochild2_ast(p);
@@ -3177,17 +3266,17 @@ pipe_tochild1_ast(pPipe p)
         if (eof) {
             p->shut_on_empty = TRUE;
             b->eof     = TRUE;
-            _ckvmssts(sys$dassgn(p->chan_in));
+            _ckvmssts_noperl(sys$dassgn(p->chan_in));
         } else  {
-            _ckvmssts(iss);
+            _ckvmssts_noperl(iss);
         }
 
         b->eof  = eof;
         b->size = p->iosb.count;
-        _ckvmssts(sts = lib$insqhi(b, &p->wait));
+        _ckvmssts_noperl(sts = lib$insqhi(b, &p->wait));
         if (p->need_wake) {
             p->need_wake = FALSE;
-            _ckvmssts(sys$dclast(pipe_tochild2_ast,p,0));
+            _ckvmssts_noperl(sys$dclast(pipe_tochild2_ast,p,0));
         }
     } else {
         p->retry = 1;   /* initial call */
@@ -3198,18 +3287,18 @@ pipe_tochild1_ast(pPipe p)
         while (1) {
             iss = lib$remqti(&p->free, &b);
             if (iss == LIB$_QUEWASEMP) return;
-            _ckvmssts(iss);
-            _ckvmssts(lib$free_vm(&n, &b));
+            _ckvmssts_noperl(iss);
+            _ckvmssts_noperl(lib$free_vm(&n, &b));
         }
     }
 
     iss = lib$remqti(&p->free, &b);
     if (iss == LIB$_QUEWASEMP) {
         int n = sizeof(CBuf) + p->bufsize;
-        _ckvmssts(lib$get_vm(&n, &b));
+        _ckvmssts_noperl(lib$get_vm(&n, &b));
         b->buf = (char *) b + sizeof(CBuf);
     } else {
-       _ckvmssts(iss);
+       _ckvmssts_noperl(iss);
     }
 
     p->curr = b;
@@ -3218,7 +3307,7 @@ pipe_tochild1_ast(pPipe p)
              &p->iosb,
              pipe_tochild1_ast, p, b->buf, p->bufsize, 0, 0, 0, 0);
     if (iss == SS$_ENDOFFILE && p->shut_on_empty) iss = SS$_NORMAL;
-    _ckvmssts(iss);
+    _ckvmssts_noperl(iss);
 }
 
 
@@ -3240,9 +3329,9 @@ pipe_tochild2_ast(pPipe p)
     do {
         if (p->type) {         /* type=1 has old buffer, dispose */
             if (p->shut_on_empty) {
-                _ckvmssts(lib$free_vm(&n, &b));
+                _ckvmssts_noperl(lib$free_vm(&n, &b));
             } else {
-                _ckvmssts(lib$insqhi(b, &p->free));
+                _ckvmssts_noperl(lib$insqhi(b, &p->free));
             }
             p->type = 0;
         }
@@ -3251,11 +3340,11 @@ pipe_tochild2_ast(pPipe p)
         if (iss == LIB$_QUEWASEMP) {
             if (p->shut_on_empty) {
                 if (done) {
-                    _ckvmssts(sys$dassgn(p->chan_out));
+                    _ckvmssts_noperl(sys$dassgn(p->chan_out));
                     *p->pipe_done = TRUE;
-                    _ckvmssts(sys$setef(pipe_ef));
+                    _ckvmssts_noperl(sys$setef(pipe_ef));
                 } else {
-                    _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEOF,
+                    _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEOF,
                         &p->iosb2, pipe_tochild2_ast, p, 0, 0, 0, 0, 0, 0));
                 }
                 return;
@@ -3263,17 +3352,17 @@ pipe_tochild2_ast(pPipe p)
             p->need_wake = TRUE;
             return;
         }
-        _ckvmssts(iss);
+        _ckvmssts_noperl(iss);
         p->type = 1;
     } while (done);
 
 
     p->curr2 = b;
     if (b->eof) {
-        _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEOF,
+        _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEOF,
             &p->iosb2, pipe_tochild2_ast, p, 0, 0, 0, 0, 0, 0));
     } else {
-        _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEVBLK,
+        _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEVBLK,
             &p->iosb2, pipe_tochild2_ast, p, b->buf, b->size, 0, 0, 0, 0));
     }
 
@@ -3294,13 +3383,13 @@ pipe_infromchild_setup(pTHX_ char *rmbx, char *wmbx)
     unsigned int dviitm = DVI$_DEVBUFSIZ;
 
     int n = sizeof(Pipe);
-    _ckvmssts(lib$get_vm(&n, &p));
+    _ckvmssts_noperl(lib$get_vm(&n, &p));
     create_mbx(aTHX_ &p->chan_in , &d_mbx1);
     create_mbx(aTHX_ &p->chan_out, &d_mbx2);
 
-    _ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
+    _ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
     n = p->bufsize * sizeof(char);
-    _ckvmssts(lib$get_vm(&n, &p->buf));
+    _ckvmssts_noperl(lib$get_vm(&n, &p->buf));
     p->shut_on_empty = FALSE;
     p->info   = 0;
     p->type   = 0;
@@ -3327,7 +3416,7 @@ pipe_infromchild_ast(pPipe p)
 #endif
 
     if (p->info && p->info->closing && p->chan_out)  {           /* output shutdown */
-        _ckvmssts(sys$dassgn(p->chan_out));
+        _ckvmssts_noperl(sys$dassgn(p->chan_out));
         p->chan_out = 0;
     }
 
@@ -3341,22 +3430,22 @@ pipe_infromchild_ast(pPipe p)
     if (p->type == 1) {
         p->type = 0;
         if (myeof && p->chan_in) {                  /* input shutdown */
-            _ckvmssts(sys$dassgn(p->chan_in));
+            _ckvmssts_noperl(sys$dassgn(p->chan_in));
             p->chan_in = 0;
         }
 
         if (p->chan_out) {
             if (myeof || kideof) {      /* pass EOF to parent */
-                _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEOF, &p->iosb,
-                              pipe_infromchild_ast, p,
-                              0, 0, 0, 0, 0, 0));
+                _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEOF, &p->iosb,
+                                         pipe_infromchild_ast, p,
+                                         0, 0, 0, 0, 0, 0));
                 return;
             } else if (eof) {       /* eat EOF --- fall through to read*/
 
             } else {                /* transmit data */
-                _ckvmssts(sys$qio(0,p->chan_out,IO$_WRITEVBLK,&p->iosb,
-                              pipe_infromchild_ast,p,
-                              p->buf, p->iosb.count, 0, 0, 0, 0));
+                _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_WRITEVBLK,&p->iosb,
+                                         pipe_infromchild_ast,p,
+                                         p->buf, p->iosb.count, 0, 0, 0, 0));
                 return;
             }
         }
@@ -3366,7 +3455,7 @@ pipe_infromchild_ast(pPipe p)
 
     if (!p->chan_in && !p->chan_out) {
         *p->pipe_done = TRUE;
-        _ckvmssts(sys$setef(pipe_ef));
+        _ckvmssts_noperl(sys$setef(pipe_ef));
         return;
     }
 
@@ -3384,13 +3473,13 @@ pipe_infromchild_ast(pPipe p)
                           pipe_infromchild_ast,p,
                           p->buf, p->bufsize, 0, 0, 0, 0);
             if (p->shut_on_empty && iss == SS$_ENDOFFILE) iss = SS$_NORMAL;
-            _ckvmssts(iss);
+            _ckvmssts_noperl(iss);
         } else {           /* send EOFs for extra reads */
             p->iosb.status = SS$_ENDOFFILE;
             p->iosb.dvispec = 0;
-            _ckvmssts(sys$qio(0,p->chan_out,IO$_SETMODE|IO$M_READATTN,
-                      0, 0, 0,
-                      pipe_infromchild_ast, p, 0, 0, 0, 0));
+            _ckvmssts_noperl(sys$qio(0,p->chan_out,IO$_SETMODE|IO$M_READATTN,
+                                     0, 0, 0,
+                                     pipe_infromchild_ast, p, 0, 0, 0, 0));
         }
     }
 }
@@ -3418,7 +3507,7 @@ pipe_mbxtofd_setup(pTHX_ int fd, char *out)
 	unsigned short dvi_iosb[4];
 
 	cptr = getname(fd, out, 1);
-	if (cptr == NULL) _ckvmssts(SS$_NOSUCHDEV);
+	if (cptr == NULL) _ckvmssts_noperl(SS$_NOSUCHDEV);
 	d_dev.dsc$a_pointer = out;
 	d_dev.dsc$w_length = strlen(out);
 	d_dev.dsc$b_dtype = DSC$K_DTYPE_T;
@@ -3437,7 +3526,7 @@ pipe_mbxtofd_setup(pTHX_ int fd, char *out)
 
 	status = sys$getdviw
 	        (NO_EFN, 0, &d_dev, items, dvi_iosb, NULL, NULL, NULL);
-	_ckvmssts(status);
+	_ckvmssts_noperl(status);
 	if ($VMS_STATUS_SUCCESS(dvi_iosb[0])) {
 	    device[dev_len] = 0;
 
@@ -3448,20 +3537,20 @@ pipe_mbxtofd_setup(pTHX_ int fd, char *out)
 	}
     }
 
-    _ckvmssts(lib$get_vm(&n, &p));
+    _ckvmssts_noperl(lib$get_vm(&n, &p));
     p->fd_out = dup(fd);
     create_mbx(aTHX_ &p->chan_in, &d_mbx);
-    _ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
+    _ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
     n = (p->bufsize+1) * sizeof(char);
-    _ckvmssts(lib$get_vm(&n, &p->buf));
+    _ckvmssts_noperl(lib$get_vm(&n, &p->buf));
     p->shut_on_empty = FALSE;
     p->retry = 0;
     p->info  = 0;
     strcpy(out, mbx);
 
-    _ckvmssts(sys$qio(0, p->chan_in, IO$_READVBLK, &p->iosb,
-                  pipe_mbxtofd_ast, p,
-                  p->buf, p->bufsize, 0, 0, 0, 0));
+    _ckvmssts_noperl(sys$qio(0, p->chan_in, IO$_READVBLK, &p->iosb,
+                             pipe_mbxtofd_ast, p,
+                             p->buf, p->bufsize, 0, 0, 0, 0));
 
     return p;
 }
@@ -3483,7 +3572,7 @@ pipe_mbxtofd_ast(pPipe p)
         close(p->fd_out);
         sys$dassgn(p->chan_in);
         *p->pipe_done = TRUE;
-        _ckvmssts(sys$setef(pipe_ef));
+        _ckvmssts_noperl(sys$setef(pipe_ef));
         return;
     }
 
@@ -3493,13 +3582,13 @@ pipe_mbxtofd_ast(pPipe p)
         if (iss2 < 0) {
             p->retry++;
             if (p->retry < MAX_RETRY) {
-                _ckvmssts(sys$setimr(0,delaytime,pipe_mbxtofd_ast,p));
+                _ckvmssts_noperl(sys$setimr(0,delaytime,pipe_mbxtofd_ast,p));
                 return;
             }
         }
         p->retry = 0;
     } else if (err) {
-        _ckvmssts(iss);
+        _ckvmssts_noperl(iss);
     }
 
 
@@ -3507,7 +3596,7 @@ pipe_mbxtofd_ast(pPipe p)
           pipe_mbxtofd_ast, p,
           p->buf, p->bufsize, 0, 0, 0, 0);
     if (p->shut_on_empty && (iss == SS$_ENDOFFILE)) iss = SS$_NORMAL;
-    _ckvmssts(iss);
+    _ckvmssts_noperl(iss);
 }
 
 
@@ -3554,7 +3643,7 @@ store_pipelocs(pTHX)
 /*  the . directory from @INC comes last */
 
     p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
-    if (p == NULL) _ckvmssts(SS$_INSFMEM);
+    if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     p->next = head_PLOC;
     head_PLOC = p;
     strcpy(p->dir,"./");
@@ -3562,7 +3651,7 @@ store_pipelocs(pTHX)
 /*  get the directory from $^X */
 
     unixdir = PerlMem_malloc(VMS_MAXRSS);
-    if (unixdir == NULL) _ckvmssts(SS$_INSFMEM);
+    if (unixdir == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
 #ifdef PERL_IMPLICIT_CONTEXT
     if (aTHX && PL_origargv && PL_origargv[0]) {    /* maybe nul if embedded Perl */
@@ -3586,9 +3675,9 @@ store_pipelocs(pTHX)
 	  temp[1] = '\0';
 	}
 
-        if ((tounixpath_utf8(temp, unixdir, NULL)) != Nullch) {
+        if ((tounixpath_utf8(temp, unixdir, NULL)) != NULL) {
             p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
-	    if (p == NULL) _ckvmssts(SS$_INSFMEM);
+	    if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM);
             p->next = head_PLOC;
             head_PLOC = p;
             strncpy(p->dir,unixdir,sizeof(p->dir)-1);
@@ -3609,7 +3698,7 @@ store_pipelocs(pTHX)
         if (SvROK(dirsv)) continue;
         dir = SvPVx(dirsv,n_a);
         if (strcmp(dir,".") == 0) continue;
-        if ((tounixpath_utf8(dir, unixdir, NULL)) == Nullch)
+        if ((tounixpath_utf8(dir, unixdir, NULL)) == NULL)
             continue;
 
         p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
@@ -3622,9 +3711,9 @@ store_pipelocs(pTHX)
 /* most likely spot (ARCHLIB) put first in the list */
 
 #ifdef ARCHLIB_EXP
-    if ((tounixpath_utf8(ARCHLIB_EXP, unixdir, NULL)) != Nullch) {
+    if ((tounixpath_utf8(ARCHLIB_EXP, unixdir, NULL)) != NULL) {
         p = (pPLOC) PerlMem_malloc(sizeof(PLOC));
-	if (p == NULL) _ckvmssts(SS$_INSFMEM);
+	if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM);
         p->next = head_PLOC;
         head_PLOC = p;
         strncpy(p->dir,unixdir,sizeof(p->dir)-1);
@@ -4000,7 +4089,7 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode)
     info->in         = 0;
     info->out        = 0;
     info->err        = 0;
-    info->fp         = Nullfp;
+    info->fp         = NULL;
     info->useFILE    = 0;
     info->waiting    = 0;
     info->in_done    = TRUE;
@@ -4041,7 +4130,7 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode)
     /* If any errors, then clean up */
     if (!info->fp) {
        	n = sizeof(Info);
-	_ckvmssts(lib$free_vm(&n, &info));
+	_ckvmssts_noperl(lib$free_vm(&n, &info));
 	return NULL;
         }
 
@@ -4049,10 +4138,13 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode)
     return info->fp;
 }
 
+static I32 my_pclose_pinfo(pTHX_ pInfo info);
+
 static PerlIO *
 safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 {
     static int handler_set_up = FALSE;
+    PerlIO * ret_fp;
     unsigned long int sts, flags = CLI$M_NOWAIT;
     /* The use of a GLOBAL table (as was done previously) rendered
      * Perl's qx() or `` unusable from a C<$ SET SYMBOL/SCOPE=NOGLOBAL> DCL
@@ -4085,7 +4177,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         PerlIO * xterm_fd;
 
 	xterm_fd = create_forked_xterm(aTHX_ cmd, in_mode);
-	if (xterm_fd != Nullfp)
+	if (xterm_fd != NULL)
 	    return xterm_fd;
     }
 
@@ -4102,19 +4194,19 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     */
 
     if (!pipe_ef) {
-        _ckvmssts(sys$setast(0));
+        _ckvmssts_noperl(sys$setast(0));
         if (!pipe_ef) {
             unsigned long int pidcode = JPI$_PID;
             $DESCRIPTOR(d_delay, RETRY_DELAY);
-            _ckvmssts(lib$get_ef(&pipe_ef));
-            _ckvmssts(lib$getjpi(&pidcode,0,0,&mypid,0,0));
-            _ckvmssts(sys$bintim(&d_delay, delaytime));
+            _ckvmssts_noperl(lib$get_ef(&pipe_ef));
+            _ckvmssts_noperl(lib$getjpi(&pidcode,0,0,&mypid,0,0));
+            _ckvmssts_noperl(sys$bintim(&d_delay, delaytime));
         }
         if (!handler_set_up) {
-          _ckvmssts(sys$dclexh(&pipe_exitblock));
+          _ckvmssts_noperl(sys$dclexh(&pipe_exitblock));
           handler_set_up = TRUE;
         }
-        _ckvmssts(sys$setast(1));
+        _ckvmssts_noperl(sys$setast(1));
     }
 
     /* see if we can find a VMSPIPE.COM */
@@ -4129,7 +4221,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
             if (ckWARN(WARN_PIPE)) {
                 Perl_warner(aTHX_ packWARN(WARN_PIPE),"unable to find VMSPIPE.COM for i/o piping");
             }
-        return Nullfp;
+        return NULL;
         }
         fgetname(tpipe,tfilebuf+1,1);
     }
@@ -4152,7 +4244,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         case CLI$_BUFOVF: case RMS$_RTB: case CLI$_TKNOVF: case CLI$_RSLOVF:
           set_errno(E2BIG); break;
         case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
-          _ckvmssts(sts); /* fall through */
+          _ckvmssts_noperl(sts); /* fall through */
         default:  /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
           set_errno(EVMSERR); 
       }
@@ -4161,10 +4253,10 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         Perl_warner(aTHX_ packWARN(WARN_PIPE),"Can't pipe \"%*s\": %s", strlen(cmd), cmd, Strerror(errno));
       }
       *psts = sts;
-      return Nullfp; 
+      return NULL; 
     }
     n = sizeof(Info);
-    _ckvmssts(lib$get_vm(&n, &info));
+    _ckvmssts_noperl(lib$get_vm(&n, &info));
         
     strcpy(mode,in_mode);
     info->mode = *mode;
@@ -4174,7 +4266,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     info->in         = 0;
     info->out        = 0;
     info->err        = 0;
-    info->fp         = Nullfp;
+    info->fp         = NULL;
     info->useFILE    = 0;
     info->waiting    = 0;
     info->in_done    = TRUE;
@@ -4184,11 +4276,11 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     info->xchan_valid = 0;
 
     in = PerlMem_malloc(VMS_MAXRSS);
-    if (in == NULL) _ckvmssts(SS$_INSFMEM);
+    if (in == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     out = PerlMem_malloc(VMS_MAXRSS);
-    if (out == NULL) _ckvmssts(SS$_INSFMEM);
+    if (out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     err = PerlMem_malloc(VMS_MAXRSS);
-    if (err == NULL) _ckvmssts(SS$_INSFMEM);
+    if (err == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
     in[0] = out[0] = err[0] = '\0';
 
@@ -4221,23 +4313,23 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         
             while (!info->out_done) {
                 int done;
-                _ckvmssts(sys$setast(0));
+                _ckvmssts_noperl(sys$setast(0));
                 done = info->out_done;
-                if (!done) _ckvmssts(sys$clref(pipe_ef));
-                _ckvmssts(sys$setast(1));
-                if (!done) _ckvmssts(sys$waitfr(pipe_ef));
+                if (!done) _ckvmssts_noperl(sys$clref(pipe_ef));
+                _ckvmssts_noperl(sys$setast(1));
+                if (!done) _ckvmssts_noperl(sys$waitfr(pipe_ef));
             }
 
             if (info->out->buf) {
                 n = info->out->bufsize * sizeof(char);
-                _ckvmssts(lib$free_vm(&n, &info->out->buf));
+                _ckvmssts_noperl(lib$free_vm(&n, &info->out->buf));
             }
             n = sizeof(Pipe);
-            _ckvmssts(lib$free_vm(&n, &info->out));
+            _ckvmssts_noperl(lib$free_vm(&n, &info->out));
             n = sizeof(Info);
-            _ckvmssts(lib$free_vm(&n, &info));
+            _ckvmssts_noperl(lib$free_vm(&n, &info));
             *psts = RMS$_FNF;
-            return Nullfp;
+            return NULL;
         }
 
         info->err = pipe_mbxtofd_setup(aTHX_ fileno(stderr), err);
@@ -4280,28 +4372,28 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
         /* error cleanup */
         if (!info->fp && info->in) {
             info->done = TRUE;
-            _ckvmssts(sys$qiow(0,info->in->chan_in, IO$_WRITEOF, 0,
-                              0, 0, 0, 0, 0, 0, 0, 0));
+            _ckvmssts_noperl(sys$qiow(0,info->in->chan_in, IO$_WRITEOF, 0,
+                                      0, 0, 0, 0, 0, 0, 0, 0));
 
             while (!info->in_done) {
                 int done;
-                _ckvmssts(sys$setast(0));
+                _ckvmssts_noperl(sys$setast(0));
                 done = info->in_done;
-                if (!done) _ckvmssts(sys$clref(pipe_ef));
-                _ckvmssts(sys$setast(1));
-                if (!done) _ckvmssts(sys$waitfr(pipe_ef));
+                if (!done) _ckvmssts_noperl(sys$clref(pipe_ef));
+                _ckvmssts_noperl(sys$setast(1));
+                if (!done) _ckvmssts_noperl(sys$waitfr(pipe_ef));
             }
 
             if (info->in->buf) {
                 n = info->in->bufsize * sizeof(char);
-                _ckvmssts(lib$free_vm(&n, &info->in->buf));
+                _ckvmssts_noperl(lib$free_vm(&n, &info->in->buf));
             }
             n = sizeof(Pipe);
-            _ckvmssts(lib$free_vm(&n, &info->in));
+            _ckvmssts_noperl(lib$free_vm(&n, &info->in));
             n = sizeof(Info);
-            _ckvmssts(lib$free_vm(&n, &info));
+            _ckvmssts_noperl(lib$free_vm(&n, &info));
             *psts = RMS$_FNF;
-            return Nullfp;
+            return NULL;
         }
         
 
@@ -4325,15 +4417,15 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 
     strncpy(symbol, in, MAX_DCL_SYMBOL);
     d_symbol.dsc$w_length = strlen(symbol);
-    _ckvmssts(lib$set_symbol(&d_sym_in, &d_symbol, &table));
+    _ckvmssts_noperl(lib$set_symbol(&d_sym_in, &d_symbol, &table));
 
     strncpy(symbol, err, MAX_DCL_SYMBOL);
     d_symbol.dsc$w_length = strlen(symbol);
-    _ckvmssts(lib$set_symbol(&d_sym_err, &d_symbol, &table));
+    _ckvmssts_noperl(lib$set_symbol(&d_sym_err, &d_symbol, &table));
 
     strncpy(symbol, out, MAX_DCL_SYMBOL);
     d_symbol.dsc$w_length = strlen(symbol);
-    _ckvmssts(lib$set_symbol(&d_sym_out, &d_symbol, &table));
+    _ckvmssts_noperl(lib$set_symbol(&d_sym_out, &d_symbol, &table));
 
     /* Done with the names for the pipes */
     PerlMem_free(err);
@@ -4351,7 +4443,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 
     strncpy(symbol, p, MAX_DCL_SYMBOL);
     d_symbol.dsc$w_length = strlen(symbol);
-    _ckvmssts(lib$set_symbol(&d_sym_cmd, &d_symbol, &table));
+    _ckvmssts_noperl(lib$set_symbol(&d_sym_cmd, &d_symbol, &table));
 
         if (strlen(p) > MAX_DCL_SYMBOL) {
             p += MAX_DCL_SYMBOL;
@@ -4359,15 +4451,15 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
             p += strlen(p);
         }
     }
-    _ckvmssts(sys$setast(0));
+    _ckvmssts_noperl(sys$setast(0));
     info->next=open_pipes;  /* prepend to list */
     open_pipes=info;
-    _ckvmssts(sys$setast(1));
+    _ckvmssts_noperl(sys$setast(1));
     /* Omit arg 2 (input file) so the child will get the parent's SYS$INPUT
      * and SYS$COMMAND.  vmspipe.com will redefine SYS$INPUT, but we'll still
      * have SYS$COMMAND if we need it.
      */
-    _ckvmssts(lib$spawn(&vmspipedsc, 0, &nl_desc, &flags,
+    _ckvmssts_noperl(lib$spawn(&vmspipedsc, 0, &nl_desc, &flags,
                       0, &info->pid, &info->completion,
                       0, popen_completion_ast,info,0,0,0));
 
@@ -4381,11 +4473,11 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
     for (j = 0; j < 4; j++) {
         sprintf(cmd_sym_name,"PERL_POPEN_CMD%d",j);
         d_sym_cmd.dsc$w_length = strlen(cmd_sym_name);
-    _ckvmssts(lib$delete_symbol(&d_sym_cmd, &table));
+    _ckvmssts_noperl(lib$delete_symbol(&d_sym_cmd, &table));
     }
-    _ckvmssts(lib$delete_symbol(&d_sym_in,  &table));
-    _ckvmssts(lib$delete_symbol(&d_sym_err, &table));
-    _ckvmssts(lib$delete_symbol(&d_sym_out, &table));
+    _ckvmssts_noperl(lib$delete_symbol(&d_sym_in,  &table));
+    _ckvmssts_noperl(lib$delete_symbol(&d_sym_err, &table));
+    _ckvmssts_noperl(lib$delete_symbol(&d_sym_out, &table));
     vms_execfree(vmscmd);
         
 #ifdef PERL_IMPLICIT_CONTEXT
@@ -4393,23 +4485,34 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 #endif
     PL_forkprocess = info->pid;
 
+    ret_fp = info->fp;
     if (wait) {
+         dSAVEDERRNO;
          int done = 0;
          while (!done) {
-             _ckvmssts(sys$setast(0));
+             _ckvmssts_noperl(sys$setast(0));
              done = info->done;
-             if (!done) _ckvmssts(sys$clref(pipe_ef));
-             _ckvmssts(sys$setast(1));
-             if (!done) _ckvmssts(sys$waitfr(pipe_ef));
+             if (!done) _ckvmssts_noperl(sys$clref(pipe_ef));
+             _ckvmssts_noperl(sys$setast(1));
+             if (!done) _ckvmssts_noperl(sys$waitfr(pipe_ef));
          }
         *psts = info->completion;
 /* Caller thinks it is open and tries to close it. */
 /* This causes some problems, as it changes the error status */
 /*        my_pclose(info->fp); */
+
+         /* If we did not have a file pointer open, then we have to */
+         /* clean up here or eventually we will run out of something */
+         SAVE_ERRNO;
+         if (info->fp == NULL) {
+             my_pclose_pinfo(aTHX_ info);
+         }
+         RESTORE_ERRNO;
+
     } else { 
         *psts = info->pid;
     }
-    return info->fp;
+    return ret_fp;
 }  /* end of safe_popen */
 
 
@@ -4426,22 +4529,15 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 
 /*}}}*/
 
-/*{{{  I32 my_pclose(PerlIO *fp)*/
-I32 Perl_my_pclose(pTHX_ PerlIO *fp)
-{
-    pInfo info, last = NULL;
+
+/* Routine to close and cleanup a pipe info structure */
+
+static I32 my_pclose_pinfo(pTHX_ pInfo info) {
+
     unsigned long int retsts;
     int done, iss, n;
     int status;
-    
-    for (info = open_pipes; info != NULL; last = info, info = info->next)
-        if (info->fp == fp) break;
-
-    if (info == NULL) {  /* no such pipe open */
-      set_errno(ECHILD); /* quoth POSIX */
-      set_vaxc_errno(SS$_NONEXPR);
-      return -1;
-    }
+    pInfo next, last;
 
     /* If we were writing to a subprocess, insure that someone reading from
      * the mailbox gets an EOF.  It looks like a simple fclose() doesn't
@@ -4504,8 +4600,16 @@ I32 Perl_my_pclose(pTHX_ PerlIO *fp)
 
     /* remove from list of open pipes */
     _ckvmssts(sys$setast(0));
-    if (last) last->next = info->next;
-    else open_pipes = info->next;
+    last = NULL;
+    for (next = open_pipes; next != NULL; last = next, next = next->next) {
+        if (next == info)
+            break;
+    }
+
+    if (last)
+        last->next = info->next;
+    else
+        open_pipes = info->next;
     _ckvmssts(sys$setast(1));
 
     /* free buffers and structures */
@@ -4538,6 +4642,28 @@ I32 Perl_my_pclose(pTHX_ PerlIO *fp)
     _ckvmssts(lib$free_vm(&n, &info));
 
     return retsts;
+}
+
+
+/*{{{  I32 my_pclose(PerlIO *fp)*/
+I32 Perl_my_pclose(pTHX_ PerlIO *fp)
+{
+    pInfo info, last = NULL;
+    I32 ret_status;
+    
+    /* Fixme - need ast and mutex protection here */
+    for (info = open_pipes; info != NULL; last = info, info = info->next)
+        if (info->fp == fp) break;
+
+    if (info == NULL) {  /* no such pipe open */
+      set_errno(ECHILD); /* quoth POSIX */
+      set_vaxc_errno(SS$_NONEXPR);
+      return -1;
+    }
+
+    ret_status = my_pclose_pinfo(aTHX_ info);
+
+    return ret_status;
 
 }  /* end of my_pclose() */
 
@@ -4740,7 +4866,7 @@ struct NAM * nam;
 #define rms_set_dna(fab, nam, name, size) \
 	{ fab.fab$b_dns = size; fab.fab$l_dna = name; }
 #define rms_nam_dns(fab, nam) fab.fab$b_dns
-#define rms_set_esa(fab, nam, name, size) \
+#define rms_set_esa(nam, name, size) \
 	{ nam.nam$b_ess = size; nam.nam$l_esa = name; }
 #define rms_set_esal(nam, s_name, s_size, l_name, l_size) \
 	{ nam.nam$l_esa = s_name; nam.nam$b_ess = s_size;}
@@ -4790,7 +4916,7 @@ struct NAML * nam;
 	nam.naml$l_long_defname_size = size; \
 	nam.naml$l_long_defname = name; }
 #define rms_nam_dns(fab, nam) nam.naml$l_long_defname_size
-#define rms_set_esa(fab, nam, name, size) \
+#define rms_set_esa(nam, name, size) \
 	{ nam.naml$b_ess = 0; nam.naml$l_esa = (char *) -1; \
 	nam.naml$l_long_expand_alloc = size; \
 	nam.naml$l_long_expand = name; }
@@ -4907,7 +5033,7 @@ struct item_list_3
      * and the insert an ACE at the head of the ACL which allows us
      * to delete the file.
      */
-    _ckvmssts(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
+    _ckvmssts_noperl(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
 
     fildsc.dsc$w_length = strlen(vmsname);
     fildsc.dsc$a_pointer = vmsname;
@@ -5111,7 +5237,7 @@ Stat_t dst_st;
 
 	vms_src = PerlMem_malloc(VMS_MAXRSS);
 	if (vms_src == NULL)
-	    _ckvmssts(SS$_INSFMEM);
+	    _ckvmssts_noperl(SS$_INSFMEM);
 
 	/* Source is always a VMS format file */
 	ret_str = do_tovmsspec(src, vms_src, 0, NULL);
@@ -5123,7 +5249,7 @@ Stat_t dst_st;
 
 	vms_dst = PerlMem_malloc(VMS_MAXRSS);
 	if (vms_dst == NULL)
-	    _ckvmssts(SS$_INSFMEM);
+	    _ckvmssts_noperl(SS$_INSFMEM);
 
 	if (S_ISDIR(src_st.st_mode)) {
 	char * ret_str;
@@ -5131,7 +5257,7 @@ Stat_t dst_st;
 
 	    vms_dir_file = PerlMem_malloc(VMS_MAXRSS);
 	    if (vms_dir_file == NULL)
-		_ckvmssts(SS$_INSFMEM);
+		_ckvmssts_noperl(SS$_INSFMEM);
 
 	    /* The source must be a file specification */
 	    ret_str = do_fileify_dirspec(vms_src, vms_dir_file, 0, NULL);
@@ -5171,7 +5297,7 @@ Stat_t dst_st;
 	    /* The source must be a file specification */
 	    vms_dir_file = PerlMem_malloc(VMS_MAXRSS);
 	    if (vms_dir_file == NULL)
-		_ckvmssts(SS$_INSFMEM);
+		_ckvmssts_noperl(SS$_INSFMEM);
 
 	    ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL);
 	    if (ret_str == NULL) {
@@ -5221,7 +5347,7 @@ Stat_t dst_st;
 
 	flags = 0;
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
-	flags |= 2; /* LIB$M_FIL_LONG_NAMES */
+	flags |= 4; /* LIB$M_FIL_LONG_NAMES (bit 2) */
 #endif
 
 	sts = lib$rename_file(&old_file_dsc,
@@ -5330,7 +5456,7 @@ mp_do_rmsexpand
     isunix = is_unix_filespec(filespec);
     if (isunix) {
       vmsfspec = PerlMem_malloc(VMS_MAXRSS);
-      if (vmsfspec == NULL) _ckvmssts(SS$_INSFMEM);
+      if (vmsfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
       if (do_tovmsspec(filespec,vmsfspec,0,fs_utf8) == NULL) {
 	PerlMem_free(vmsfspec);
 	if (out)
@@ -5342,13 +5468,14 @@ mp_do_rmsexpand
       /* Unless we are forcing to VMS format, a UNIX input means
        * UNIX output, and that requires long names to be used
        */
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
       if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
 	opts |= PERL_RMSEXPAND_M_LONG;
-      else {
+      else
+#endif
 	isunix = 0;
       }
     }
-  }
 
   rms_set_fna(myfab, mynam, (char *)filespec, strlen(filespec)); /* cast ok */
   rms_bind_fab_nam(myfab, mynam);
@@ -5358,7 +5485,7 @@ mp_do_rmsexpand
     t_isunix = is_unix_filespec(defspec);
     if (t_isunix) {
       tmpfspec = PerlMem_malloc(VMS_MAXRSS);
-      if (tmpfspec == NULL) _ckvmssts(SS$_INSFMEM);
+      if (tmpfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
       if (do_tovmsspec(defspec,tmpfspec,0,dfs_utf8) == NULL) {
 	PerlMem_free(tmpfspec);
 	if (vmsfspec != NULL)
@@ -5373,25 +5500,21 @@ mp_do_rmsexpand
   }
 
   esa = PerlMem_malloc(NAM$C_MAXRSS + 1);
-  if (esa == NULL) _ckvmssts(SS$_INSFMEM);
+  if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
   esal = PerlMem_malloc(VMS_MAXRSS);
-  if (esal == NULL) _ckvmssts(SS$_INSFMEM);
+  if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
   rms_set_esal(mynam, esa, NAM$C_MAXRSS, esal, VMS_MAXRSS-1);
 
-  if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
-    rms_set_rsa(mynam, outbuf, (VMS_MAXRSS - 1));
-  }
-  else {
+  /* If a NAML block is used RMS always writes to the long and short
+   * addresses unless you suppress the short name.
+   */
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
-    outbufl = PerlMem_malloc(VMS_MAXRSS);
-    if (outbufl == NULL) _ckvmssts(SS$_INSFMEM);
-    rms_set_rsal(mynam, outbuf, NAM$C_MAXRSS, outbufl, (VMS_MAXRSS - 1));
-#else
-    rms_set_rsa(mynam, outbuf, NAM$C_MAXRSS);
+  outbufl = PerlMem_malloc(VMS_MAXRSS);
+  if (outbufl == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
-  }
+   rms_set_rsal(mynam, outbuf, NAM$C_MAXRSS, outbufl, (VMS_MAXRSS - 1));
 
 #ifdef NAM$M_NO_SHORT_UPCASE
   if (decc_efs_case_preserve)
@@ -5466,7 +5589,7 @@ mp_do_rmsexpand
   /*------------------------------------*/
   if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
     if (rms_nam_rsll(mynam)) {
-	tbuf = outbuf;
+	tbuf = outbufl;
 	speclen = rms_nam_rsll(mynam);
     }
     else {
@@ -5502,8 +5625,13 @@ mp_do_rmsexpand
   if (trimver || trimtype) {
     if (defspec && *defspec) {
       char *defesal = NULL;
-      defesal = PerlMem_malloc(VMS_MAXRSS + 1);
-      if (defesal != NULL) {
+      char *defesa = NULL;
+      defesa = PerlMem_malloc(VMS_MAXRSS + 1);
+      if (defesa != NULL) {
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+        defesal = PerlMem_malloc(VMS_MAXRSS + 1);
+        if (defesal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+#endif
 	struct FAB deffab = cc$rms_fab;
 	rms_setup_nam(defnam);
      
@@ -5513,7 +5641,8 @@ mp_do_rmsexpand
 	rms_set_fna
 	    (deffab, defnam, (char *)defspec, rms_nam_dns(myfab, mynam)); 
 
-	rms_set_esa(deffab, defnam, defesal, VMS_MAXRSS - 1);
+	/* RMS needs the esa/esal as a work area if wildcards are involved */
+	rms_set_esal(defnam, defesa, NAM$C_MAXRSS, defesal, VMS_MAXRSS - 1);
 
 	rms_clear_nam_nop(defnam);
 	rms_set_nam_nop(defnam, NAM$M_SYNCHK);
@@ -5533,7 +5662,9 @@ mp_do_rmsexpand
 	    trimtype = !rms_is_nam_fnb(defnam, NAM$M_EXP_TYPE); 
 	  }
 	}
-	PerlMem_free(defesal);
+	if (defesal != NULL)
+	    PerlMem_free(defesal);
+	PerlMem_free(defesa);
       }
     }
     if (trimver) {
@@ -5576,13 +5707,16 @@ mp_do_rmsexpand
 
   /* If we just had a directory spec on input, $PARSE "helpfully"
    * adds an empty name and type for us */
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
   if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
     if (rms_nam_namel(mynam) == rms_nam_typel(mynam) &&
 	rms_nam_verl(mynam)  == rms_nam_typel(mynam) + 1 &&
 	!(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME)))
       speclen = rms_nam_namel(mynam) - tbuf;
   }
-  else {
+  else
+#endif
+  {
     if (rms_nam_name(mynam) == rms_nam_type(mynam) &&
 	rms_nam_ver(mynam)  == rms_nam_ver(mynam) + 1 &&
 	!(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME)))
@@ -5603,25 +5737,35 @@ mp_do_rmsexpand
 
   /* Have we been working with an expanded, but not resultant, spec? */
   /* Also, convert back to Unix syntax if necessary. */
+  {
+  int rsl;
 
-  if (!rms_nam_rsll(mynam)) {
-    if (isunix) {
-      if (do_tounixspec(tbuf, outbuf ,0 , fs_utf8) == NULL) {
-	if (out) Safefree(out);
-	if (esal != NULL)
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+    if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
+      rsl = rms_nam_rsll(mynam);
+    } else
+#endif
+    {
+      rsl = rms_nam_rsl(mynam);
+    }
+    if (!rsl) {
+      if (isunix) {
+        if (do_tounixspec(tbuf, outbuf ,0 , fs_utf8) == NULL) {
+	  if (out) Safefree(out);
+	  if (esal != NULL)
 	    PerlMem_free(esal);
-	PerlMem_free(esa);
-	if (outbufl != NULL)
+	  PerlMem_free(esa);
+	  if (outbufl != NULL)
 	    PerlMem_free(outbufl);
-	return NULL;
+	  return NULL;
+        }
       }
+      else strcpy(outbuf, tbuf);
     }
-    else strcpy(outbuf, tbuf);
-  }
-  else if (isunix) {
-    tmpfspec = PerlMem_malloc(VMS_MAXRSS);
-    if (tmpfspec == NULL) _ckvmssts(SS$_INSFMEM);
-    if (do_tounixspec(outbuf,tmpfspec,0,fs_utf8) == NULL) {
+    else if (isunix) {
+      tmpfspec = PerlMem_malloc(VMS_MAXRSS);
+      if (tmpfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+      if (do_tounixspec(tbuf,tmpfspec,0,fs_utf8) == NULL) {
 	if (out) Safefree(out);
 	PerlMem_free(esa);
 	if (esal != NULL)
@@ -5630,11 +5774,11 @@ mp_do_rmsexpand
 	if (outbufl != NULL)
 	    PerlMem_free(outbufl);
 	return NULL;
+      }
+      strcpy(outbuf,tmpfspec);
+      PerlMem_free(tmpfspec);
     }
-    strcpy(outbuf,tmpfspec);
-    PerlMem_free(tmpfspec);
   }
-
   rms_set_rsal(mynam, NULL, 0, NULL, 0);
   sts = rms_free_search_context(&myfab); /* Free search context */
   PerlMem_free(esa);
@@ -5725,12 +5869,12 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       return NULL;
     }
     trndir = PerlMem_malloc(VMS_MAXRSS + 1);
-    if (trndir == NULL) _ckvmssts(SS$_INSFMEM);
+    if (trndir == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     if (!strpbrk(dir+1,"/]>:")  &&
 	(!decc_posix_compliant_pathnames && decc_disable_posix_root)) {
       strcpy(trndir,*dir == '/' ? dir + 1: dir);
       trnlnm_iter_count = 0;
-      while (!strpbrk(trndir,"/]>:") && my_trnlnm(trndir,trndir,0)) {
+      while (!strpbrk(trndir,"/]>:") && simple_trnlnm(trndir,trndir,0)) {
         trnlnm_iter_count++; 
         if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
       }
@@ -5781,7 +5925,7 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
     }
 
     vmsdir = PerlMem_malloc(VMS_MAXRSS + 1);
-    if (vmsdir == NULL) _ckvmssts(SS$_INSFMEM);
+    if (vmsdir == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     cp1 = strpbrk(trndir,"]:>");
     if (hasfilename || !cp1) { /* Unix-style path or filename */
       if (trndir[0] == '.') {
@@ -5929,7 +6073,9 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
     }
     else {  /* VMS-style directory spec */
 
-      char *esa, term, *cp;
+      char *esa, *esal, term, *cp;
+      char *my_esa;
+      int my_esa_len;
       unsigned long int sts, cmplen, haslower = 0;
       unsigned int nam_fnb;
       char * nam_type;
@@ -5937,12 +6083,17 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       rms_setup_nam(savnam);
       rms_setup_nam(dirnam);
 
-      esa = PerlMem_malloc(VMS_MAXRSS + 1);
-      if (esa == NULL) _ckvmssts(SS$_INSFMEM);
+      esa = PerlMem_malloc(NAM$C_MAXRSS + 1);
+      if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+      esal = NULL;
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+      esal = PerlMem_malloc(VMS_MAXRSS);
+      if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+#endif
       rms_set_fna(dirfab, dirnam, trndir, strlen(trndir));
       rms_bind_fab_nam(dirfab, dirnam);
       rms_set_dna(dirfab, dirnam, ".DIR;1", 6);
-      rms_set_esa(dirfab, dirnam, esa, (VMS_MAXRSS - 1));
+      rms_set_esal(dirnam, esa, NAM$C_MAXRSS, esal, (VMS_MAXRSS - 1));
 #ifdef NAM$M_NO_SHORT_UPCASE
       if (decc_efs_case_preserve)
 	rms_set_nam_nop(dirnam, NAM$M_NO_SHORT_UPCASE);
@@ -5957,6 +6108,8 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
         }
         if (!sts) {
 	  PerlMem_free(esa);
+	  if (esal != NULL)
+	      PerlMem_free(esal);
 	  PerlMem_free(trndir);
 	  PerlMem_free(vmsdir);
           set_errno(EVMSERR);
@@ -5978,6 +6131,8 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
 	    fab_sts = dirfab.fab$l_sts;
 	    sts = rms_free_search_context(&dirfab);
 	    PerlMem_free(esa);
+	    if (esal != NULL)
+		PerlMem_free(esal);
 	    PerlMem_free(trndir);
 	    PerlMem_free(vmsdir);
             set_errno(EVMSERR);  set_vaxc_errno(fab_sts);
@@ -5985,13 +6140,22 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
           }
         }
       }
-      esa[rms_nam_esll(dirnam)] = '\0';
+
+      /* Make sure we are using the right buffer */
+      if (esal != NULL) {
+	my_esa = esal;
+	my_esa_len = rms_nam_esll(dirnam);
+      } else {
+	my_esa = esa;
+        my_esa_len = rms_nam_esl(dirnam);
+      }
+      my_esa[my_esa_len] = '\0';
       if (!rms_is_nam_fnb(dirnam, (NAM$M_EXP_DEV | NAM$M_EXP_DIR))) {
-        cp1 = strchr(esa,']');
-        if (!cp1) cp1 = strchr(esa,'>');
+        cp1 = strchr(my_esa,']');
+        if (!cp1) cp1 = strchr(my_esa,'>');
         if (cp1) {  /* Should always be true */
-          rms_nam_esll(dirnam) -= cp1 - esa - 1;
-          memmove(esa,cp1 + 1, rms_nam_esll(dirnam));
+          my_esa_len -= cp1 - my_esa - 1;
+          memmove(my_esa, cp1 + 1, my_esa_len);
         }
       }
       if (rms_is_nam_fnb(dirnam, NAM$M_EXP_TYPE)) {  /* Was type specified? */
@@ -6001,6 +6165,8 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
           /* Something other than .DIR[;1].  Bzzt. */
 	  sts = rms_free_search_context(&dirfab);
 	  PerlMem_free(esa);
+	  if (esal != NULL)
+	     PerlMem_free(esal);
 	  PerlMem_free(trndir);
 	  PerlMem_free(vmsdir);
           set_errno(ENOTDIR);
@@ -6012,43 +6178,47 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       if (rms_is_nam_fnb(dirnam, NAM$M_EXP_NAME)) {
         /* They provided at least the name; we added the type, if necessary, */
         if (buf) retspec = buf;                            /* in sys$parse() */
-        else if (ts) Newx(retspec, rms_nam_esll(dirnam)+1, char);
+        else if (ts) Newx(retspec, my_esa_len + 1, char);
         else retspec = __fileify_retbuf;
-        strcpy(retspec,esa);
+        strcpy(retspec,my_esa);
 	sts = rms_free_search_context(&dirfab);
 	PerlMem_free(trndir);
 	PerlMem_free(esa);
+	if (esal != NULL)
+	    PerlMem_free(esal);
 	PerlMem_free(vmsdir);
         return retspec;
       }
       if ((cp1 = strstr(esa,".][000000]")) != NULL) {
         for (cp2 = cp1 + 9; *cp2; cp1++,cp2++) *cp1 = *cp2;
         *cp1 = '\0';
-        rms_nam_esll(dirnam) -= 9;
+        my_esa_len -= 9;
       }
-      if ((cp1 = strrchr(esa,']')) == NULL) cp1 = strrchr(esa,'>');
+      if ((cp1 = strrchr(my_esa,']')) == NULL) cp1 = strrchr(my_esa,'>');
       if (cp1 == NULL) { /* should never happen */
 	sts = rms_free_search_context(&dirfab);
 	PerlMem_free(trndir);
 	PerlMem_free(esa);
+	if (esal != NULL)
+	    PerlMem_free(esal);
 	PerlMem_free(vmsdir);
         return NULL;
       }
       term = *cp1;
       *cp1 = '\0';
-      retlen = strlen(esa);
-      cp1 = strrchr(esa,'.');
+      retlen = strlen(my_esa);
+      cp1 = strrchr(my_esa,'.');
       /* ODS-5 directory specifications can have extra "." in them. */
       /* Fix-me, can not scan EFS file specifications backwards */
       while (cp1 != NULL) {
-        if ((cp1-1 == esa) || (*(cp1-1) != '^'))
+        if ((cp1-1 == my_esa) || (*(cp1-1) != '^'))
 	  break;
 	else {
 	   cp1--;
-	   while ((cp1 > esa) && (*cp1 != '.'))
+	   while ((cp1 > my_esa) && (*cp1 != '.'))
 	     cp1--;
 	}
-	if (cp1 == esa)
+	if (cp1 == my_esa)
 	  cp1 = NULL;
       }
 
@@ -6058,7 +6228,7 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
         if (buf) retspec = buf;
         else if (ts) Newx(retspec,retlen+7,char);
         else retspec = __fileify_retbuf;
-        strcpy(retspec,esa);
+        strcpy(retspec,my_esa);
       }
       else {
         if (rms_is_nam_fnb(dirnam, NAM$M_ROOT_DIR)) {
@@ -6071,20 +6241,30 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
           if (!(sys$parse(&dirfab) & STS$K_SUCCESS)) {
 	    sts = rms_free_search_context(&dirfab);
 	    PerlMem_free(esa);
+	    if (esal != NULL)
+		PerlMem_free(esal);
 	    PerlMem_free(trndir);
 	    PerlMem_free(vmsdir);
             set_errno(EVMSERR);
             set_vaxc_errno(dirfab.fab$l_sts);
             return NULL;
           }
-          retlen = rms_nam_esll(dirnam) - 9; /* esa - '][' - '].DIR;1' */
+
+	  /* This changes the length of the string of course */
+	  if (esal != NULL) {
+	      my_esa_len = rms_nam_esll(dirnam);
+	  } else {
+	      my_esa_len = rms_nam_esl(dirnam);
+	  }
+
+          retlen = my_esa_len - 9; /* esa - '][' - '].DIR;1' */
           if (buf) retspec = buf;
           else if (ts) Newx(retspec,retlen+16,char);
           else retspec = __fileify_retbuf;
-          cp1 = strstr(esa,"][");
-          if (!cp1) cp1 = strstr(esa,"]<");
-          dirlen = cp1 - esa;
-          memcpy(retspec,esa,dirlen);
+          cp1 = strstr(my_esa,"][");
+          if (!cp1) cp1 = strstr(my_esa,"]<");
+          dirlen = cp1 - my_esa;
+          memcpy(retspec,my_esa,dirlen);
           if (!strncmp(cp1+2,"000000]",7)) {
             retspec[dirlen-1] = '\0';
 	    /* fix-me Not full ODS-5, just extra dots in directories for now */
@@ -6129,7 +6309,7 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
           if (buf) retspec = buf;
           else if (ts) Newx(retspec,retlen+16,char);
           else retspec = __fileify_retbuf;
-          cp1 = esa;
+          cp1 = my_esa;
           cp2 = retspec;
           while ((*cp1 != ':')  && (*cp1 != '\0')) *(cp2++) = *(cp1++);
           strcpy(cp2,":[000000]");
@@ -6147,6 +6327,8 @@ static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts, int *
       if (haslower && !decc_efs_case_preserve) __mystrtolower(retspec);
       PerlMem_free(trndir);
       PerlMem_free(esa);
+      if (esal != NULL)
+	PerlMem_free(esal);
       PerlMem_free(vmsdir);
       return retspec;
     }
@@ -6179,13 +6361,13 @@ static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int
     }
 
     trndir = PerlMem_malloc(VMS_MAXRSS);
-    if (trndir == NULL) _ckvmssts(SS$_INSFMEM);
+    if (trndir == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     if (*dir) strcpy(trndir,dir);
     else getcwd(trndir,VMS_MAXRSS - 1);
 
     trnlnm_iter_count = 0;
     while (!strpbrk(trndir,"/]:>") && !no_translate_barewords
-	   && my_trnlnm(trndir,trndir,0)) {
+	   && simple_trnlnm(trndir,trndir,0)) {
       trnlnm_iter_count++; 
       if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
       trnlen = strlen(trndir);
@@ -6268,7 +6450,9 @@ static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int
       else retpath[retlen-1] = '\0';
     }
     else {  /* VMS-style directory spec */
-      char *esa, *cp;
+      char *esa, *esal, *cp;
+      char *my_esa;
+      int my_esa_len;
       unsigned long int sts, cmplen, haslower;
       struct FAB dirfab = cc$rms_fab;
       int dirlen;
@@ -6329,10 +6513,15 @@ static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int
       }
       rms_set_fna(dirfab, dirnam, trndir, dirlen);
       esa = PerlMem_malloc(VMS_MAXRSS);
-      if (esa == NULL) _ckvmssts(SS$_INSFMEM);
+      if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+      esal = NULL;
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+      esal = PerlMem_malloc(VMS_MAXRSS);
+      if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+#endif
       rms_set_dna(dirfab, dirnam, ".DIR;1", 6);
       rms_bind_fab_nam(dirfab, dirnam);
-      rms_set_esa(dirfab, dirnam, esa, VMS_MAXRSS - 1);
+      rms_set_esal(dirnam, esa, NAM$C_MAXRSS, esal, VMS_MAXRSS-1);
 #ifdef NAM$M_NO_SHORT_UPCASE
       if (decc_efs_case_preserve)
 	  rms_set_nam_nop(dirnam, NAM$M_NO_SHORT_UPCASE);
@@ -6349,6 +6538,8 @@ static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int
         if (!sts) {
 	  PerlMem_free(trndir);
 	  PerlMem_free(esa);
+	  if (esal != NULL)
+	    PerlMem_free(esal);
           set_errno(EVMSERR);
           set_vaxc_errno(dirfab.fab$l_sts);
           return NULL;
@@ -6363,6 +6554,8 @@ static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int
 	    sts1 = rms_free_search_context(&dirfab);
 	    PerlMem_free(trndir);
 	    PerlMem_free(esa);
+	    if (esal != NULL)
+		PerlMem_free(esal);
             set_errno(EVMSERR);
             set_vaxc_errno(dirfab.fab$l_sts);
             return NULL;
@@ -6379,26 +6572,43 @@ static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int
 	  sts2 = rms_free_search_context(&dirfab);
 	  PerlMem_free(trndir);
 	  PerlMem_free(esa);
+	  if (esal != NULL)
+	     PerlMem_free(esal);
           set_errno(ENOTDIR);
           set_vaxc_errno(RMS$_DIR);
           return NULL;
         }
       }
+      /* Make sure we are using the right buffer */
+      if (esal != NULL) {
+	/* We only need one, clean up the other */
+	my_esa = esal;
+	my_esa_len = rms_nam_esll(dirnam);
+      } else {
+	my_esa = esa;
+        my_esa_len = rms_nam_esl(dirnam);
+      }
+
+      /* Null terminate the buffer */
+      my_esa[my_esa_len] = '\0';
+
       /* OK, the type was fine.  Now pull any file name into the
          directory path. */
-      if ((cp1 = strrchr(esa,']'))) *(rms_nam_typel(dirnam)) = ']';
+      if ((cp1 = strrchr(my_esa,']'))) *(rms_nam_typel(dirnam)) = ']';
       else {
-        cp1 = strrchr(esa,'>');
+        cp1 = strrchr(my_esa,'>');
         *(rms_nam_typel(dirnam)) = '>';
       }
       *cp1 = '.';
       *(rms_nam_typel(dirnam) + 1) = '\0';
-      retlen = (rms_nam_typel(dirnam)) - esa + 2;
+      retlen = (rms_nam_typel(dirnam)) - my_esa + 2;
       if (buf) retpath = buf;
       else if (ts) Newx(retpath,retlen,char);
       else retpath = __pathify_retbuf;
-      strcpy(retpath,esa);
+      strcpy(retpath,my_esa);
       PerlMem_free(esa);
+      if (esal != NULL)
+	  PerlMem_free(esal);
       sts = rms_free_search_context(&dirfab);
       /* $PARSE may have upcased filespec, so convert output to lower
        * case if input contained any lowercase characters. */
@@ -6451,7 +6661,7 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
       int nl_flag;
 
       tunix = PerlMem_malloc(VMS_MAXRSS);
-      if (tunix == NULL) _ckvmssts(SS$_INSFMEM);
+      if (tunix == NULL) _ckvmssts_noperl(SS$_INSFMEM);
       strcpy(tunix, spec);
       tunix_len = strlen(tunix);
       nl_flag = 0;
@@ -6564,11 +6774,11 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
   cmp_rslt = strncasecmp(spec,"SYS$SCRATCH:", 12);
 #endif
   tmp = PerlMem_malloc(VMS_MAXRSS);
-  if (tmp == NULL) _ckvmssts(SS$_INSFMEM);
+  if (tmp == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   if (cmp_rslt == 0) {
   int islnm;
 
-    islnm = my_trnlnm(tmp, "TMP", 0);
+    islnm = simple_trnlnm(tmp, "TMP", 0);
     if (!islnm) {
       strcpy(rslt, "/tmp");
       cp1 = cp1 + 4;
@@ -6743,21 +6953,22 @@ char *Perl_tounixspec_utf8_ts(pTHX_ const char *spec, char *buf, int * utf8_fl)
 static int posix_root_to_vms
   (char *vmspath, int vmspath_len,
    const char *unixpath,
-   const int * utf8_fl) {
+   const int * utf8_fl)
+{
 int sts;
 struct FAB myfab = cc$rms_fab;
-struct NAML mynam = cc$rms_naml;
+rms_setup_nam(mynam);
 struct dsc$descriptor_s dvidsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
- struct dsc$descriptor_s specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
-char *esa;
+struct dsc$descriptor_s specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+char * esa, * esal, * rsa, * rsal;
 char *vms_delim;
 int dir_flag;
 int unixlen;
 
     dir_flag = 0;
+    vmspath[0] = '\0';
     unixlen = strlen(unixpath);
     if (unixlen == 0) {
-      vmspath[0] = '\0';
       return RMS$_FNF;
     }
 
@@ -6825,17 +7036,18 @@ int unixlen;
   vmspath[vmspath_len] = 0;
   if (unixpath[unixlen - 1] == '/')
   dir_flag = 1;
-  esa = PerlMem_malloc(VMS_MAXRSS);
+  esal = PerlMem_malloc(VMS_MAXRSS);
+  if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+  esa = PerlMem_malloc(NAM$C_MAXRSS + 1);
   if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
-  myfab.fab$l_fna = vmspath;
-  myfab.fab$b_fns = strlen(vmspath);
-  myfab.fab$l_naml = &mynam;
-  mynam.naml$l_esa = NULL;
-  mynam.naml$b_ess = 0;
-  mynam.naml$l_long_expand = esa;
-  mynam.naml$l_long_expand_alloc = (unsigned char) VMS_MAXRSS - 1;
-  mynam.naml$l_rsa = NULL;
-  mynam.naml$b_rss = 0;
+  rsal = PerlMem_malloc(VMS_MAXRSS);
+  if (rsal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+  rsa = PerlMem_malloc(NAM$C_MAXRSS + 1);
+  if (rsa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+  rms_set_fna(myfab, mynam, (char *) vmspath, strlen(vmspath)); /* cast ok */
+  rms_bind_fab_nam(myfab, mynam);
+  rms_set_esal(mynam, esa, NAM$C_MAXRSS, esal, VMS_MAXRSS - 1);
+  rms_set_rsal(mynam, rsa, NAM$C_MAXRSS, rsal, VMS_MAXRSS - 1);
   if (decc_efs_case_preserve)
     mynam.naml$b_nop |= NAM$M_NO_SHORT_UPCASE;
 #ifdef NAML$M_OPEN_SPECIAL
@@ -6847,15 +7059,24 @@ int unixlen;
 
   /* It failed! Try again as a UNIX filespec */
   if (!(sts & 1)) {
+    PerlMem_free(esal);
     PerlMem_free(esa);
+    PerlMem_free(rsal);
+    PerlMem_free(rsa);
     return sts;
   }
 
    /* get the Device ID and the FID */
    sts = sys$search(&myfab);
+
+   /* These are no longer needed */
+   PerlMem_free(esa);
+   PerlMem_free(rsal);
+   PerlMem_free(rsa);
+
    /* on any failure, returned the POSIX ^UP^ filespec */
    if (!(sts & 1)) {
-      PerlMem_free(esa);
+      PerlMem_free(esal);
       return sts;
    }
    specdsc.dsc$a_pointer = vmspath;
@@ -6929,7 +7150,7 @@ int unixlen;
       }
     }
   }
-  PerlMem_free(esa);
+  PerlMem_free(esal);
   return sts;
 }
 
@@ -7868,8 +8089,8 @@ static char *mp_do_tovmsspec
     while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
     *cp1 = '\0';
     trndev = PerlMem_malloc(VMS_MAXRSS);
-    if (trndev == NULL) _ckvmssts(SS$_INSFMEM);
-    islnm =  my_trnlnm(rslt,trndev,0);
+    if (trndev == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    islnm =  simple_trnlnm(rslt,trndev,0);
 
      /* DECC special handling */
     if (!islnm) {
@@ -7877,13 +8098,13 @@ static char *mp_do_tovmsspec
 	strcpy(rslt,"sys$system");
 	cp1 = rslt + 10;
 	*cp1 = 0;
-	islnm =  my_trnlnm(rslt,trndev,0);
+	islnm = simple_trnlnm(rslt,trndev,0);
       }
       else if (strcmp(rslt,"tmp") == 0) {
 	strcpy(rslt,"sys$scratch");
 	cp1 = rslt + 11;
 	*cp1 = 0;
-	islnm =  my_trnlnm(rslt,trndev,0);
+	islnm = simple_trnlnm(rslt,trndev,0);
       }
       else if (!decc_disable_posix_root) {
         strcpy(rslt, "sys$posix_root");
@@ -7891,7 +8112,7 @@ static char *mp_do_tovmsspec
 	*cp1 = 0;
 	cp2 = path;
         while (*(cp2+1) == '/') cp2++;  /* Skip multiple /s */
-	islnm =  my_trnlnm(rslt,trndev,0);
+	islnm = simple_trnlnm(rslt,trndev,0);
       }
       else if (strcmp(rslt,"dev") == 0) {
 	if (strncmp(cp2,"/null", 5) == 0) {
@@ -7900,7 +8121,7 @@ static char *mp_do_tovmsspec
 	    cp1 = rslt + 4;
 	    *cp1 = 0;
 	    cp2 = cp2 + 5;
-	    islnm =  my_trnlnm(rslt,trndev,0);
+	    islnm = simple_trnlnm(rslt,trndev,0);
 	  }
 	}
       }
@@ -8795,7 +9016,7 @@ pipe_and_fork(pTHX_ char **cmargv)
     *p = '\0';
 
     fp = safe_popen(aTHX_ subcmd,"wbF",&sts);
-    if (fp == Nullfp) {
+    if (fp == NULL) {
         PerlIO_printf(Perl_debug_log,"Can't open output pipe (status %d)",sts);
     }
 }
@@ -8861,6 +9082,8 @@ int len;
 void
 vms_image_init(int *argcp, char ***argvp)
 {
+  int status;
+  char val_str[10];
   char eqv[LNM$C_NAMLENGTH+1] = "";
   unsigned int len, tabct = 8, tabidx = 0;
   unsigned long int *mask, iosb[2], i, rlst[128], rsz;
@@ -8879,6 +9102,35 @@ vms_image_init(int *argcp, char ***argvp)
     Perl_csighandler_init();
 #endif
 
+    /* This was moved from the pre-image init handler because on threaded */
+    /* Perl it was always returning 0 for the default value. */
+    status = simple_trnlnm("SYS$POSIX_ROOT", val_str, sizeof(val_str));
+    if (status > 0) {
+        int s;
+	s = decc$feature_get_index("DECC$DISABLE_POSIX_ROOT");
+	if (s > 0) {
+            int initial;
+	    initial = decc$feature_get_value(s, 4);
+	    if (initial >= 0) {
+                /* initial is -1 if nothing has set the feature */
+                /* initial is 1 if the logical name is present */
+		decc_disable_posix_root = decc$feature_get_value(s, 1);
+
+                /* If the value is not valid, force the feature off */
+		if (decc_disable_posix_root < 0) {
+		    decc$feature_set_value(s, 1, 1);
+		    decc_disable_posix_root = 1;
+		}
+	    }
+	    else {
+		/* Traditionally Perl assumes this is off */
+		decc_disable_posix_root = 1;
+		decc$feature_set_value(s, 1, 1);
+	    }
+	}
+    }
+
+
   _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
   _ckvmssts_noperl(iosb[0]);
   for (i = 0; i < sizeof iprv / sizeof(unsigned long int); i++) {
@@ -9044,9 +9296,10 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
        *template, *base, *end, *cp1, *cp2;
   register int tmplen, reslen = 0, dirs = 0;
 
-  unixwild = PerlMem_malloc(VMS_MAXRSS);
-  if (unixwild == NULL) _ckvmssts(SS$_INSFMEM);
   if (!wildspec || !fspec) return 0;
+
+  unixwild = PerlMem_malloc(VMS_MAXRSS);
+  if (unixwild == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   template = unixwild;
   if (strpbrk(wildspec,"]>:") != NULL) {
     if (do_tounixspec(wildspec,unixwild,0,NULL) == NULL) {
@@ -9059,7 +9312,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
     unixwild[VMS_MAXRSS-1] = 0;
   }
   unixified = PerlMem_malloc(VMS_MAXRSS);
-  if (unixified == NULL) _ckvmssts(SS$_INSFMEM);
+  if (unixified == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   if (strpbrk(fspec,"]>:") != NULL) {
     if (do_tounixspec(fspec,unixified,0,NULL) == NULL) {
         PerlMem_free(unixwild);
@@ -9113,7 +9366,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
     totells = ells;
     for (cp1 = ellipsis+4; *cp1; cp1++) if (*cp1 == '/') dirs++;
     tpl = PerlMem_malloc(VMS_MAXRSS);
-    if (tpl == NULL) _ckvmssts(SS$_INSFMEM);
+    if (tpl == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     if (ellipsis == template && opts & 1) {
       /* Template begins with an ellipsis.  Since we can't tell how many
        * directory names at the front of the resultant to keep for an
@@ -9149,7 +9402,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
          if (*front == '/' && !dirs--) { front++; break; }
     }
     lcres = PerlMem_malloc(VMS_MAXRSS);
-    if (lcres == NULL) _ckvmssts(SS$_INSFMEM);
+    if (lcres == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + (VMS_MAXRSS - 1);
          cp1++,cp2++) {
 	    if (!decc_efs_case_preserve) {
@@ -9232,10 +9485,10 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
         char def[NAM$C_MAXRSS+1], *st;
 
         if (getcwd(def, sizeof def,0) == NULL) {
-	    Safefree(unixified);
-	    Safefree(unixwild);
-	    Safefree(lcres);
-	    Safefree(tpl);
+	    PerlMem_free(unixified);
+	    PerlMem_free(unixwild);
+	    PerlMem_free(lcres);
+	    PerlMem_free(tpl);
 	    return 0;
 	}
 	if (!decc_efs_case_preserve) {
@@ -9494,16 +9747,13 @@ Perl_readdir(pTHX_ DIR *dd)
     }
     dd->count++;
     /* Force the buffer to end with a NUL, and downcase name to match C convention. */
+    buff[res.dsc$w_length] = '\0';
+    p = buff + res.dsc$w_length;
+    while (--p >= buff) if (!isspace(*p)) break;  
+    *p = '\0';
     if (!decc_efs_case_preserve) {
-      buff[VMS_MAXRSS - 1] = '\0';
       for (p = buff; *p; p++) *p = _tolower(*p);
     }
-    else {
-      /* we don't want to force to lowercase, just null terminate */
-      buff[res.dsc$w_length] = '\0';
-    }
-    while (--p >= buff) if (!isspace(*p)) break;  /* Do we really need this? */
-    *p = '\0';
 
     /* Skip any directory component and just copy the name. */
     sts = vms_split_path
@@ -9521,11 +9771,32 @@ Perl_readdir(pTHX_ DIR *dd)
 	&vs_spec,
 	&vs_len);
 
-    /* Drop NULL extensions on UNIX file specification */
-    if ((dd->flags & PERL_VMSDIR_M_UNIXSPECS &&
-	(e_len == 1) && decc_readdir_dropdotnotype)) {
-	e_len = 0;
-	e_spec[0] = '\0';
+    if (dd->flags & PERL_VMSDIR_M_UNIXSPECS) {
+
+        /* In Unix report mode, remove the ".dir;1" from the name */
+        /* if it is a real directory. */
+        if (decc_filename_unix_report || decc_efs_charset) {
+            if ((e_len == 4) && (vs_len == 2) && (vs_spec[1] == '1')) {
+                if ((toupper(e_spec[1]) == 'D') &&
+                    (toupper(e_spec[2]) == 'I') &&
+                    (toupper(e_spec[3]) == 'R')) {
+                    Stat_t statbuf;
+                    int ret_sts;
+
+                    ret_sts = stat(buff, (stat_t *)&statbuf);
+                    if ((ret_sts == 0) && S_ISDIR(statbuf.st_mode)) {
+                        e_len = 0;
+                        e_spec[0] = 0;
+                    }
+                }
+            }
+        }
+
+        /* Drop NULL extensions on UNIX file specification */
+	if ((e_len == 1) && decc_readdir_dropdotnotype) {
+	    e_len = 0;
+	    e_spec[0] = '\0';
+        }
     }
 
     strncpy(dd->entry.d_name, n_spec, n_len + e_len);
@@ -9683,7 +9954,7 @@ vms_execfree(struct dsc$descriptor_s *vmscmd)
 static char *
 setup_argstr(pTHX_ SV *really, SV **mark, SV **sp)
 {
-  char *junk, *tmps = Nullch;
+  char *junk, *tmps = NULL;
   register size_t cmdlen = 0;
   size_t rlen;
   register SV **idx;
@@ -9743,12 +10014,12 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
   register int isdcl;
 
   vmscmd = PerlMem_malloc(sizeof(struct dsc$descriptor_s));
-  if (vmscmd == NULL) _ckvmssts(SS$_INSFMEM);
+  if (vmscmd == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
   /* Make a copy for modification */
   cmdlen = strlen(incmd);
   cmd = PerlMem_malloc(cmdlen+1);
-  if (cmd == NULL) _ckvmssts(SS$_INSFMEM);
+  if (cmd == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   strncpy(cmd, incmd, cmdlen);
   cmd[cmdlen] = 0;
   image_name[0] = 0;
@@ -9784,6 +10055,19 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
     *cp2 = '\0';
     if (do_tovmsspec(resspec,cp,0,NULL)) { 
       s = vmsspec;
+
+      /* When a UNIX spec with no file type is translated to VMS, */
+      /* A trailing '.' is appended under ODS-5 rules.            */
+      /* Here we do not want that trailing "." as it prevents     */
+      /* Looking for a implied ".exe" type. */
+      if (decc_efs_charset) {
+          int i;
+          i = strlen(vmsspec);
+          if (vmsspec[i-1] == '.') {
+              vmsspec[i-1] = '\0';
+          }
+      }
+
       if (*rest) {
         for (cp2 = vmsspec + strlen(vmsspec);
              *rest && cp2 - vmsspec < sizeof vmsspec;
@@ -9817,19 +10101,19 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
     imgdsc.dsc$w_length = wordbreak - s;
     retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,&rsts,&flags);
     if (!(retsts&1)) {
-        _ckvmssts(lib$find_file_end(&cxt));
+        _ckvmssts_noperl(lib$find_file_end(&cxt));
         retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,&rsts,&flags);
       if (!(retsts & 1) && *s == '$') {
-        _ckvmssts(lib$find_file_end(&cxt));
+        _ckvmssts_noperl(lib$find_file_end(&cxt));
 	imgdsc.dsc$a_pointer++; imgdsc.dsc$w_length--;
 	retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,&rsts,&flags);
 	if (!(retsts&1)) {
-	  _ckvmssts(lib$find_file_end(&cxt));
+	  _ckvmssts_noperl(lib$find_file_end(&cxt));
           retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,&rsts,&flags);
         }
       }
     }
-    _ckvmssts(lib$find_file_end(&cxt));
+    _ckvmssts_noperl(lib$find_file_end(&cxt));
 
     if (retsts & 1) {
       FILE *fp;
@@ -9951,7 +10235,7 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
 
       if (cando_by_name(S_IXUSR,0,resspec)) {
         vmscmd->dsc$a_pointer = PerlMem_malloc(MAX_DCL_LINE_LENGTH);
-	if (vmscmd->dsc$a_pointer == NULL) _ckvmssts(SS$_INSFMEM);
+	if (vmscmd->dsc$a_pointer == NULL) _ckvmssts_noperl(SS$_INSFMEM);
         if (!isdcl) {
             strcpy(vmscmd->dsc$a_pointer,"$ MCR ");
 	    if (image_name[0] != 0) {
@@ -10021,7 +10305,7 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
     if (retsts == RMS$_FNF || retsts == RMS$_DNF || retsts == RMS$_PRV ||
         retsts == RMS$_DEV || retsts == RMS$_DIR || retsts == RMS$_SYN ||
        (retsts & STS$M_CODE) == (SHR$_NOWILD & STS$M_CODE)) return retsts;
-    else { _ckvmssts(retsts); }
+    else { _ckvmssts_noperl(retsts); }
   }
 
   return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts);
@@ -10093,7 +10377,7 @@ Perl_vms_do_exec(pTHX_ const char *cmd)
       case CLI$_BUFOVF: case RMS$_RTB: case CLI$_TKNOVF: case CLI$_RSLOVF:
         set_errno(E2BIG); break;
       case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
-        _ckvmssts(retsts); /* fall through */
+        _ckvmssts_noperl(retsts); /* fall through */
       default:  /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
         set_errno(EVMSERR); 
     }
@@ -10110,12 +10394,10 @@ Perl_vms_do_exec(pTHX_ const char *cmd)
 }  /* end of vms_do_exec() */
 /*}}}*/
 
-unsigned long int Perl_do_spawn(pTHX_ const char *);
-unsigned long int do_spawn2(pTHX_ const char *, int);
+int do_spawn2(pTHX_ const char *, int);
 
-/* {{{ unsigned long int do_aspawn(void *really,void **mark,void **sp) */
-unsigned long int
-Perl_do_aspawn(pTHX_ void *really,void **mark,void **sp)
+int
+Perl_do_aspawn(pTHX_ SV* really, SV** mark, SV** sp)
 {
 unsigned long int sts;
 char * cmd;
@@ -10128,9 +10410,9 @@ int flags = 0;
      * through do_aspawn is a value of 1, which means spawn without
      * waiting for completion -- other values are ignored.
      */
-    if (SvNIOKp(*((SV**)mark+1)) && !SvPOKp(*((SV**)mark+1))) {
+    if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
 	++mark;
-	flags = SvIVx(*(SV**)mark);
+	flags = SvIVx(*mark);
     }
 
     if (flags && flags == 1)     /* the Win32 P_NOWAIT value */
@@ -10138,7 +10420,7 @@ int flags = 0;
     else
         flags = 0;
 
-    cmd = setup_argstr(aTHX_ (SV *)really,(SV **)mark,(SV **)sp);
+    cmd = setup_argstr(aTHX_ really, mark, sp);
     sts = do_spawn2(aTHX_ cmd, flags);
     /* pp_sys will clean up cmd */
     return sts;
@@ -10148,16 +10430,28 @@ int flags = 0;
 /*}}}*/
 
 
-/* {{{unsigned long int do_spawn(char *cmd) */
-unsigned long int
-Perl_do_spawn(pTHX_ const char *cmd)
+/* {{{int do_spawn(char* cmd) */
+int
+Perl_do_spawn(pTHX_ char* cmd)
 {
+    PERL_ARGS_ASSERT_DO_SPAWN;
+
     return do_spawn2(aTHX_ cmd, 0);
 }
 /*}}}*/
 
-/* {{{unsigned long int do_spawn2(char *cmd) */
-unsigned long int
+/* {{{int do_spawn_nowait(char* cmd) */
+int
+Perl_do_spawn_nowait(pTHX_ char* cmd)
+{
+    PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT;
+
+    return do_spawn2(aTHX_ cmd, CLI$M_NOWAIT);
+}
+/*}}}*/
+
+/* {{{int do_spawn2(char *cmd) */
+int
 do_spawn2(pTHX_ const char *cmd, int flags)
 {
   unsigned long int sts, substs;
@@ -10184,7 +10478,7 @@ do_spawn2(pTHX_ const char *cmd, int flags)
         case CLI$_BUFOVF: case RMS$_RTB: case CLI$_TKNOVF: case CLI$_RSLOVF:
           set_errno(E2BIG); break;
         case LIB$_INVARG: case LIB$_INVSTRDES: case SS$_ACCVIO: /* shouldn't happen */
-          _ckvmssts(sts); /* fall through */
+          _ckvmssts_noperl(sts); /* fall through */
         default:  /* SS$_DUPLNAM, SS$_CLI, resource exhaustion, etc. */
           set_errno(EVMSERR);
       }
@@ -10256,7 +10550,7 @@ int my_fclose(FILE *fp) {
     unsigned int fd = fileno(fp);
     unsigned int fdoff = fd / sizeof(unsigned int);
 
-    if (sockflagsize && fdoff <= sockflagsize)
+    if (sockflagsize && fdoff < sockflagsize)
       sockflags[fdoff] &= ~(1 << fd % sizeof(unsigned int));
   }
   return fclose(fp);
@@ -10318,7 +10612,7 @@ Perl_my_flush(pTHX_ FILE *fp)
     if ((res = fflush(fp)) == 0 && fp) {
 #ifdef VMS_DO_SOCKETS
 	Stat_t s;
-	if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode))
+	if (fstat(fileno(fp), &s.crtl_stat) == 0 && !S_ISSOCK(s.st_mode))
 #endif
 	    res = fsync(fileno(fp));
     }
@@ -11535,7 +11829,7 @@ Perl_cando_by_name_int
 
   /* Make sure we expand logical names, since sys$check_access doesn't */
   fileified = PerlMem_malloc(VMS_MAXRSS);
-  if (fileified == NULL) _ckvmssts(SS$_INSFMEM);
+  if (fileified == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   if (!strpbrk(fname,"/]>:")) {
       strcpy(fileified,fname);
       trnlnm_iter_count = 0;
@@ -11547,7 +11841,7 @@ Perl_cando_by_name_int
   }
 
   vmsname = PerlMem_malloc(VMS_MAXRSS);
-  if (vmsname == NULL) _ckvmssts(SS$_INSFMEM);
+  if (vmsname == NULL) _ckvmssts_noperl(SS$_INSFMEM);
   if ( !(opts & PERL_RMSEXPAND_M_VMS_IN) ) {
     /* Don't know if already in VMS format, so make sure */
     if (!do_rmsexpand(fname, vmsname, 0, NULL, PERL_RMSEXPAND_M_VMS, NULL, NULL)) {
@@ -11618,19 +11912,19 @@ Perl_cando_by_name_int
    */
 
   /* get current process privs and username */
-  _ckvmssts(sys$getjpiw(0,0,0,jpilst,iosb,0,0));
-  _ckvmssts(iosb[0]);
+  _ckvmssts_noperl(sys$getjpiw(0,0,0,jpilst,iosb,0,0));
+  _ckvmssts_noperl(iosb[0]);
 
 #if defined(__VMS_VER) && __VMS_VER >= 60000000
 
   /* find out the space required for the profile */
-  _ckvmssts(sys$create_user_profile(&usrdsc,&usrprolst,0,0,
+  _ckvmssts_noperl(sys$create_user_profile(&usrdsc,&usrprolst,0,0,
                                     &usrprodsc.dsc$w_length,&profile_context));
 
   /* allocate space for the profile and get it filled in */
   usrprodsc.dsc$a_pointer = PerlMem_malloc(usrprodsc.dsc$w_length);
-  if (usrprodsc.dsc$a_pointer == NULL) _ckvmssts(SS$_INSFMEM);
-  _ckvmssts(sys$create_user_profile(&usrdsc,&usrprolst,0,usrprodsc.dsc$a_pointer,
+  if (usrprodsc.dsc$a_pointer == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+  _ckvmssts_noperl(sys$create_user_profile(&usrdsc,&usrprolst,0,usrprodsc.dsc$a_pointer,
                                     &usrprodsc.dsc$w_length,&profile_context));
 
   /* use the profile to check access to the file; free profile & analyze results */
@@ -11664,7 +11958,7 @@ Perl_cando_by_name_int
       PerlMem_free(vmsname);
     return TRUE;
   }
-  _ckvmssts(retsts);
+  _ckvmssts_noperl(retsts);
 
   if (fileified != NULL)
     PerlMem_free(fileified);
@@ -11779,10 +12073,10 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
     char temp_fspec[VMS_MAXRSS];
     char *save_spec;
     int retval = -1;
-    int saved_errno, saved_vaxc_errno;
+    dSAVEDERRNO;
 
     if (!fspec) return retval;
-    saved_errno = errno; saved_vaxc_errno = vaxc$errno;
+    SAVE_ERRNO;
     strcpy(temp_fspec, fspec);
 
     if (decc_bug_devnull != 0) {
@@ -11874,8 +12168,14 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
 
     if (!retval) {
     char * cptr;
+    int rmsex_flags = PERL_RMSEXPAND_M_VMS;
+
+      /* If this is an lstat, do not follow the link */
+      if (lstat_flag)
+	rmsex_flags |= PERL_RMSEXPAND_M_SYMLINK;
+
       cptr = do_rmsexpand
-       (save_spec, statbufp->st_devnam, 0, NULL, PERL_RMSEXPAND_M_VMS, NULL, NULL);
+       (save_spec, statbufp->st_devnam, 0, NULL, rmsex_flags, NULL, NULL);
       if (cptr == NULL)
 	statbufp->st_devnam[0] = 0;
 
@@ -11903,7 +12203,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag)
 #     endif
     }
     /* If we were successful, leave errno where we found it */
-    if (retval == 0) { errno = saved_errno; vaxc$errno = saved_vaxc_errno; }
+    if (retval == 0) RESTORE_ERRNO;
     return retval;
 
 }  /* end of flex_stat_int() */
@@ -11965,8 +12265,8 @@ my_getlogin(void)
 int
 Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates)
 {
-    char *vmsin, * vmsout, *esa, *esa_out,
-         *rsa, *ubf;
+    char *vmsin, * vmsout, *esa, *esal, *esa_out, *esal_out,
+         *rsa, *rsal, *rsa_out, *rsal_out, *ubf;
     unsigned long int i, sts, sts2;
     int dna_len;
     struct FAB fab_in, fab_out;
@@ -11979,9 +12279,9 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     struct XABSUM xabsum;
 
     vmsin = PerlMem_malloc(VMS_MAXRSS);
-    if (vmsin == NULL) _ckvmssts(SS$_INSFMEM);
+    if (vmsin == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     vmsout = PerlMem_malloc(VMS_MAXRSS);
-    if (vmsout == NULL) _ckvmssts(SS$_INSFMEM);
+    if (vmsout == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     if (!spec_in  || !*spec_in  || !do_tovmsspec(spec_in,vmsin,1,NULL) ||
         !spec_out || !*spec_out || !do_tovmsspec(spec_out,vmsout,1,NULL)) {
       PerlMem_free(vmsin);
@@ -11991,7 +12291,12 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     }
 
     esa = PerlMem_malloc(VMS_MAXRSS);
-    if (esa == NULL) _ckvmssts(SS$_INSFMEM);
+    if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    esal = NULL;
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+    esal = PerlMem_malloc(VMS_MAXRSS);
+    if (esal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+#endif
     fab_in = cc$rms_fab;
     rms_set_fna(fab_in, nam, vmsin, strlen(vmsin));
     fab_in.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI;
@@ -12001,9 +12306,14 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     fab_in.fab$l_xab = (void *) &xabdat;
 
     rsa = PerlMem_malloc(VMS_MAXRSS);
-    if (rsa == NULL) _ckvmssts(SS$_INSFMEM);
-    rms_set_rsa(nam, rsa, (VMS_MAXRSS-1));
-    rms_set_esa(fab_in, nam, esa, (VMS_MAXRSS-1));
+    if (rsa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    rsal = NULL;
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+    rsal = PerlMem_malloc(VMS_MAXRSS);
+    if (rsal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+#endif
+    rms_set_rsal(nam, rsa, NAM$C_MAXRSS, rsal, (VMS_MAXRSS - 1));
+    rms_set_esal(nam, esa, NAM$C_MAXRSS, esal, (VMS_MAXRSS - 1));
     rms_nam_esl(nam) = 0;
     rms_nam_rsl(nam) = 0;
     rms_nam_esll(nam) = 0;
@@ -12025,7 +12335,11 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
       PerlMem_free(vmsin);
       PerlMem_free(vmsout);
       PerlMem_free(esa);
+      if (esal != NULL)
+	PerlMem_free(esal);
       PerlMem_free(rsa);
+      if (rsal != NULL)
+	PerlMem_free(rsal);
       set_vaxc_errno(sts);
       switch (sts) {
         case RMS$_FNF: case RMS$_DNF:
@@ -12054,10 +12368,20 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     rms_set_fna(fab_out, nam_out, vmsout, strlen(vmsout));
     dna_len = rms_nam_namel(nam) ? rms_nam_name_type_l_size(nam) : 0;
     rms_set_dna(fab_out, nam_out, rms_nam_namel(nam), dna_len);
-    esa_out = PerlMem_malloc(VMS_MAXRSS);
-    if (esa_out == NULL) _ckvmssts(SS$_INSFMEM);
-    rms_set_rsa(nam_out, NULL, 0);
-    rms_set_esa(fab_out, nam_out, esa_out, (VMS_MAXRSS - 1));
+    esa_out = PerlMem_malloc(NAM$C_MAXRSS + 1);
+    if (esa_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    rsa_out = PerlMem_malloc(NAM$C_MAXRSS + 1);
+    if (rsa_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    esal_out = NULL;
+    rsal_out = NULL;
+#if !defined(__VAX) && defined(NAML$C_MAXRSS)
+    esal_out = PerlMem_malloc(VMS_MAXRSS);
+    if (esal_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+    rsal_out = PerlMem_malloc(VMS_MAXRSS);
+    if (rsal_out == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+#endif
+    rms_set_rsal(nam_out, rsa_out, NAM$C_MAXRSS, rsal_out, (VMS_MAXRSS - 1));
+    rms_set_esal(nam_out, esa_out, NAM$C_MAXRSS, esal_out, (VMS_MAXRSS - 1));
 
     if (preserve_dates == 0) {  /* Act like DCL COPY */
       rms_set_nam_nop(nam_out, NAM$M_SYNCHK);
@@ -12066,8 +12390,17 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
 	PerlMem_free(vmsin);
 	PerlMem_free(vmsout);
 	PerlMem_free(esa);
+	if (esal != NULL)
+	    PerlMem_free(esal);
 	PerlMem_free(rsa);
+	if (rsal != NULL)
+	    PerlMem_free(rsal);
 	PerlMem_free(esa_out);
+	if (esal_out != NULL)
+	    PerlMem_free(esal_out);
+	PerlMem_free(rsa_out);
+	if (rsal_out != NULL)
+	    PerlMem_free(rsal_out);
         set_errno(sts == RMS$_SYN ? EINVAL : EVMSERR);
         set_vaxc_errno(sts);
         return 0;
@@ -12084,8 +12417,17 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
       PerlMem_free(vmsin);
       PerlMem_free(vmsout);
       PerlMem_free(esa);
+      if (esal != NULL)
+	  PerlMem_free(esal);
       PerlMem_free(rsa);
+      if (rsal != NULL)
+	  PerlMem_free(rsal);
       PerlMem_free(esa_out);
+      if (esal_out != NULL)
+	  PerlMem_free(esal_out);
+      PerlMem_free(rsa_out);
+      if (rsal_out != NULL)
+	  PerlMem_free(rsal_out);
       set_vaxc_errno(sts);
       switch (sts) {
         case RMS$_DNF:
@@ -12118,7 +12460,7 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     }
 
     ubf = PerlMem_malloc(32256);
-    if (ubf == NULL) _ckvmssts(SS$_INSFMEM);
+    if (ubf == NULL) _ckvmssts_noperl(SS$_INSFMEM);
     rab_in = cc$rms_rab;
     rab_in.rab$l_fab = &fab_in;
     rab_in.rab$l_rop = RAB$M_BIO;
@@ -12128,10 +12470,19 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
       sys$close(&fab_in); sys$close(&fab_out);
       PerlMem_free(vmsin);
       PerlMem_free(vmsout);
-      PerlMem_free(esa);
       PerlMem_free(ubf);
+      PerlMem_free(esa);
+      if (esal != NULL)
+	  PerlMem_free(esal);
       PerlMem_free(rsa);
+      if (rsal != NULL)
+	  PerlMem_free(rsal);
       PerlMem_free(esa_out);
+      if (esal_out != NULL)
+	  PerlMem_free(esal_out);
+      PerlMem_free(rsa_out);
+      if (rsal_out != NULL)
+	  PerlMem_free(rsal_out);
       set_errno(EVMSERR); set_vaxc_errno(sts);
       return 0;
     }
@@ -12143,10 +12494,19 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
       sys$close(&fab_in); sys$close(&fab_out);
       PerlMem_free(vmsin);
       PerlMem_free(vmsout);
-      PerlMem_free(esa);
       PerlMem_free(ubf);
+      PerlMem_free(esa);
+      if (esal != NULL)
+	  PerlMem_free(esal);
       PerlMem_free(rsa);
+      if (rsal != NULL)
+	  PerlMem_free(rsal);
       PerlMem_free(esa_out);
+      if (esal_out != NULL)
+	  PerlMem_free(esal_out);
+      PerlMem_free(rsa_out);
+      if (rsal_out != NULL)
+	  PerlMem_free(rsal_out);
       set_errno(EVMSERR); set_vaxc_errno(sts);
       return 0;
     }
@@ -12158,10 +12518,19 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
         sys$close(&fab_in); sys$close(&fab_out);
 	PerlMem_free(vmsin);
 	PerlMem_free(vmsout);
-	PerlMem_free(esa);
 	PerlMem_free(ubf);
+	PerlMem_free(esa);
+	if (esal != NULL)
+	    PerlMem_free(esal);
 	PerlMem_free(rsa);
+	if (rsal != NULL)
+	    PerlMem_free(rsal);
 	PerlMem_free(esa_out);
+ 	if (esal_out != NULL)
+	    PerlMem_free(esal_out);
+	PerlMem_free(rsa_out);
+ 	if (rsal_out != NULL)
+	    PerlMem_free(rsal_out);
         set_errno(EVMSERR); set_vaxc_errno(sts);
         return 0;
       }
@@ -12171,23 +12540,28 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates
     fab_out.fab$l_fop &= ~FAB$M_DLT;  /* We got this far; keep the output */
     sys$close(&fab_in);  sys$close(&fab_out);
     sts = (fab_in.fab$l_sts & 1) ? fab_out.fab$l_sts : fab_in.fab$l_sts;
-    if (!(sts & 1)) {
-      PerlMem_free(vmsin);
-      PerlMem_free(vmsout);
-      PerlMem_free(esa);
-      PerlMem_free(ubf);
-      PerlMem_free(rsa);
-      PerlMem_free(esa_out);
-      set_errno(EVMSERR); set_vaxc_errno(sts);
-      return 0;
-    }
 
     PerlMem_free(vmsin);
     PerlMem_free(vmsout);
-    PerlMem_free(esa);
     PerlMem_free(ubf);
+    PerlMem_free(esa);
+    if (esal != NULL)
+	PerlMem_free(esal);
     PerlMem_free(rsa);
+    if (rsal != NULL)
+	PerlMem_free(rsal);
     PerlMem_free(esa_out);
+    if (esal_out != NULL)
+	PerlMem_free(esal_out);
+    PerlMem_free(rsa_out);
+    if (rsal_out != NULL)
+	PerlMem_free(rsal_out);
+
+    if (!(sts & 1)) {
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
     return 1;
 
 }  /* end of rmscopy() */
@@ -12488,8 +12862,7 @@ mod2fname(pTHX_ CV *cv)
     if (counter) {
       strcat(work_name, "__");
     }
-    strcat(work_name, SvPV(*av_fetch(in_array, counter, FALSE),
-			   PL_na));
+    strcat(work_name, SvPV_nolen(*av_fetch(in_array, counter, FALSE)));
   }
 
   /* Check to see if we actually have to bother...*/
@@ -12571,6 +12944,11 @@ Perl_vms_start_glob
     unsigned long int lff_flags = 0;
     int rms_sts;
 
+    if (!SvOK(tmpglob)) {
+        SETERRNO(ENOENT,RMS$_FNF);
+        return NULL;
+    }
+
 #ifdef VMS_LONGNAME_SUPPORT
     lff_flags = LIB$M_FIL_LONG_NAMES;
 #endif
@@ -12701,9 +13079,9 @@ Perl_vms_start_glob
 
 	if (!found) {
 	    /* Be POSIXish: return the input pattern when no matches */
-	    begin = SvPVX(tmpglob);
-	    strcat(begin,"\n");
-	    ok = (PerlIO_puts(tmpfp,begin) != EOF);
+	    strcpy(rstr,SvPVX(tmpglob));
+	    strcat(rstr,"\n");
+	    ok = (PerlIO_puts(tmpfp,rstr) != EOF);
 	}
 
 	if (ok && sts != RMS$_NMF &&
@@ -12728,69 +13106,129 @@ Perl_vms_start_glob
 }
 
 
-#ifdef HAS_SYMLINK
 static char *
 mp_do_vms_realpath(pTHX_ const char *filespec, char * rslt_spec,
-		   const int *utf8_fl);
+		   int *utf8_fl);
 
 void
-vms_realpath_fromperl(pTHX_ CV *cv)
+unixrealpath_fromperl(pTHX_ CV *cv)
 {
-  dXSARGS;
-  char *fspec, *rslt_spec, *rslt;
-  STRLEN n_a;
+    dXSARGS;
+    char *fspec, *rslt_spec, *rslt;
+    STRLEN n_a;
 
-  if (!items || items != 1)
-    Perl_croak(aTHX_ "Usage: VMS::Filespec::vms_realpath(spec)");
+    if (!items || items != 1)
+	Perl_croak(aTHX_ "Usage: VMS::Filespec::unixrealpath(spec)");
 
-  fspec = SvPV(ST(0),n_a);
-  if (!fspec || !*fspec) XSRETURN_UNDEF;
+    fspec = SvPV(ST(0),n_a);
+    if (!fspec || !*fspec) XSRETURN_UNDEF;
 
-  Newx(rslt_spec, VMS_MAXRSS + 1, char);
-  rslt = do_vms_realpath(fspec, rslt_spec, NULL);
-  ST(0) = sv_newmortal();
-  if (rslt != NULL)
-    sv_usepvn(ST(0),rslt,strlen(rslt));
-  else
-    Safefree(rslt_spec);
-  XSRETURN(1);
+    Newx(rslt_spec, VMS_MAXRSS + 1, char);
+    rslt = do_vms_realpath(fspec, rslt_spec, NULL);
+
+    ST(0) = sv_newmortal();
+    if (rslt != NULL)
+	sv_usepvn(ST(0),rslt,strlen(rslt));
+    else
+	Safefree(rslt_spec);
+	XSRETURN(1);
 }
 
+static char *
+mp_do_vms_realname(pTHX_ const char *filespec, char * rslt_spec,
+		   int *utf8_fl);
+
+void
+vmsrealpath_fromperl(pTHX_ CV *cv)
+{
+    dXSARGS;
+    char *fspec, *rslt_spec, *rslt;
+    STRLEN n_a;
+
+    if (!items || items != 1)
+	Perl_croak(aTHX_ "Usage: VMS::Filespec::vmsrealpath(spec)");
+
+    fspec = SvPV(ST(0),n_a);
+    if (!fspec || !*fspec) XSRETURN_UNDEF;
+
+    Newx(rslt_spec, VMS_MAXRSS + 1, char);
+    rslt = do_vms_realname(fspec, rslt_spec, NULL);
+
+    ST(0) = sv_newmortal();
+    if (rslt != NULL)
+	sv_usepvn(ST(0),rslt,strlen(rslt));
+    else
+	Safefree(rslt_spec);
+	XSRETURN(1);
+}
+
+#ifdef HAS_SYMLINK
 /*
  * A thin wrapper around decc$symlink to make sure we follow the 
  * standard and do not create a symlink with a zero-length name.
+ *
+ * Also in ODS-2 mode, existing tests assume that the link target
+ * will be converted to UNIX format.
  */
-/*{{{ int my_symlink(const char *path1, const char *path2)*/
-int my_symlink(const char *path1, const char *path2) {
-  if (!path2 || !*path2) {
+/*{{{ int my_symlink(pTHX_ const char *contents, const char *link_name)*/
+int Perl_my_symlink(pTHX_ const char *contents, const char *link_name) {
+  if (!link_name || !*link_name) {
     SETERRNO(ENOENT, SS$_NOSUCHFILE);
     return -1;
   }
-  return symlink(path1, path2);
+
+  if (decc_efs_charset) {
+      return symlink(contents, link_name);
+  } else {
+      int sts;
+      char * utarget;
+
+      /* Unless we are in ODS-5 mode, convert the symlink target to UNIX */
+      /* because in order to work, the symlink target must be in UNIX format */
+
+      /* As symbolic links can hold things other than files, we will only do */
+      /* the conversion in in ODS-2 mode */
+
+      Newx(utarget, VMS_MAXRSS + 1, char);
+      if (do_tounixspec(contents, utarget, 0, NULL) == NULL) {
+
+          /* This should not fail, as an untranslatable filename */
+          /* should be passed through */
+          utarget = (char *)contents;
+      }
+      sts = symlink(utarget, link_name);
+      Safefree(utarget);
+      return sts;
+  }
+
 }
 /*}}}*/
 
 #endif /* HAS_SYMLINK */
 
-#if __CRTL_VER >= 70301000 && !defined(__VAX)
 int do_vms_case_tolerant(void);
 
 void
-vms_case_tolerant_fromperl(pTHX_ CV *cv)
+case_tolerant_process_fromperl(pTHX_ CV *cv)
 {
   dXSARGS;
   ST(0) = boolSV(do_vms_case_tolerant());
   XSRETURN(1);
 }
-#endif
+
+#ifdef USE_ITHREADS
 
 void  
 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, 
                           struct interp_intern *dst)
 {
+    PERL_ARGS_ASSERT_SYS_INTERN_DUP;
+
     memcpy(dst,src,sizeof(struct interp_intern));
 }
 
+#endif
+
 void  
 Perl_sys_intern_clear(pTHX)
 {
@@ -12804,9 +13242,7 @@ Perl_sys_intern_init(pTHX)
 
     VMSISH_HUSHED = 0;
 
-    /* fix me later to track running under GNV */
-    /* this allows some limited testing */
-    MY_POSIX_EXIT = decc_filename_unix_report;
+    MY_POSIX_EXIT = vms_posix_exit;
 
     x = (float)ix;
     MY_INV_RAND_MAX = 1./x;
@@ -12834,20 +13270,16 @@ init_os_extras(void)
   newXSproto("DynaLoader::mod2fname", mod2fname, file, "$");
   newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
   newXSproto("vmsish::hushed",hushexit_fromperl,file,";$");
-#ifdef HAS_SYMLINK
-  newXSproto("VMS::Filespec::vms_realpath",vms_realpath_fromperl,file,"$;$");
-#endif
-#if __CRTL_VER >= 70301000 && !defined(__VAX)
-  newXSproto("VMS::Filespec::case_tolerant",vms_case_tolerant_fromperl,file,"$;$");
-#endif
+  newXSproto("VMS::Filespec::unixrealpath",unixrealpath_fromperl,file,"$;$");
+  newXSproto("VMS::Filespec::vmsrealpath",vmsrealpath_fromperl,file,"$;$");
+  newXSproto("VMS::Filespec::case_tolerant_process",
+      case_tolerant_process_fromperl,file,"");
 
   store_pipelocs(aTHX);         /* will redo any earlier attempts */
 
   return;
 }
   
-#ifdef HAS_SYMLINK
-
 #if __CRTL_VER == 80200000
 /* This missed getting in to the DECC SDK for 8.2 */
 char *realpath(const char *file_name, char * resolved_name, ...);
@@ -12858,24 +13290,285 @@ char *realpath(const char *file_name, char * resolved_name, ...);
  * The perl fallback routine to provide realpath() is not as efficient
  * on OpenVMS.
  */
+
+/* Hack, use old stat() as fastest way of getting ino_t and device */
+int decc$stat(const char *name, void * statbuf);
+
+
+/* Realpath is fragile.  In 8.3 it does not work if the feature
+ * DECC$POSIX_COMPLIANT_PATHNAMES is not enabled, even though symbolic
+ * links are implemented in RMS, not the CRTL. It also can fail if the 
+ * user does not have read/execute access to some of the directories.
+ * So in order for Do What I Mean mode to work, if realpath() fails,
+ * fall back to looking up the filename by the device name and FID.
+ */
+
+int vms_fid_to_name(char * outname, int outlen, const char * name)
+{
+struct statbuf_t {
+    char	   * st_dev;
+    unsigned short st_ino[3];
+    unsigned short padw;
+    unsigned long  padl[30];  /* plenty of room */
+} statbuf;
+int sts;
+struct dsc$descriptor_s dvidsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+struct dsc$descriptor_s specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+
+    sts = decc$stat(name, &statbuf);
+    if (sts == 0) {
+
+	dvidsc.dsc$a_pointer=statbuf.st_dev;
+       dvidsc.dsc$w_length=strlen(statbuf.st_dev);
+
+	specdsc.dsc$a_pointer = outname;
+	specdsc.dsc$w_length = outlen-1;
+
+       sts = lib$fid_to_name
+	    (&dvidsc, statbuf.st_ino, &specdsc, &specdsc.dsc$w_length);
+       if ($VMS_STATUS_SUCCESS(sts)) {
+	    outname[specdsc.dsc$w_length] = 0;
+	    return 0;
+	}
+    }
+    return sts;
+}
+
+
+
 static char *
 mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
-		   const int *utf8_fl)
+		   int *utf8_fl)
+{
+    char * rslt = NULL;
+
+#ifdef HAS_SYMLINK
+    if (decc_posix_compliant_pathnames > 0 ) {
+	/* realpath currently only works if posix compliant pathnames are
+	 * enabled.  It may start working when they are not, but in that
+	 * case we still want the fallback behavior for backwards compatibility
+	 */
+        rslt = realpath(filespec, outbuf);
+    }
+#endif
+
+    if (rslt == NULL) {
+        char * vms_spec;
+        char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
+        int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
+        int file_len;
+
+	/* Fall back to fid_to_name */
+
+        Newx(vms_spec, VMS_MAXRSS + 1, char);
+
+	sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec);
+	if (sts == 0) {
+
+
+	    /* Now need to trim the version off */
+	    sts = vms_split_path
+		  (vms_spec,
+		   &v_spec,
+		   &v_len,
+		   &r_spec,
+		   &r_len,
+		   &d_spec,
+		   &d_len,
+		   &n_spec,
+		   &n_len,
+		   &e_spec,
+		   &e_len,
+		   &vs_spec,
+		   &vs_len);
+
+
+		if (sts == 0) {
+	            int haslower = 0;
+	            const char *cp;
+
+	            /* Trim off the version */
+	            int file_len = v_len + r_len + d_len + n_len + e_len;
+	            vms_spec[file_len] = 0;
+
+	            /* The result is expected to be in UNIX format */
+		    rslt = do_tounixspec(vms_spec, outbuf, 0, utf8_fl);
+
+                    /* Downcase if input had any lower case letters and 
+	             * case preservation is not in effect. 
+	             */
+	            if (!decc_efs_case_preserve) {
+	                for (cp = filespec; *cp; cp++)
+	                    if (islower(*cp)) { haslower = 1; break; }
+
+	                if (haslower) __mystrtolower(rslt);
+	            }
+	        }
+	} else {
+
+	    /* Now for some hacks to deal with backwards and forward */
+	    /* compatibilty */
+	    if (!decc_efs_charset) {
+
+		/* 1. ODS-2 mode wants to do a syntax only translation */
+		rslt = do_rmsexpand(filespec, outbuf,
+				    0, NULL, 0, NULL, utf8_fl);
+
+	    } else {
+		if (decc_filename_unix_report) {
+		    char * dir_name;
+		    char * vms_dir_name;
+		    char * file_name;
+
+		    /* 2. ODS-5 / UNIX report mode should return a failure */
+		    /*    if the parent directory also does not exist */
+		    /*    Otherwise, get the real path for the parent */
+		    /*    and add the child to it.
+
+		    /* basename / dirname only available for VMS 7.0+ */
+		    /* So we may need to implement them as common routines */
+
+		    Newx(dir_name, VMS_MAXRSS + 1, char);
+		    Newx(vms_dir_name, VMS_MAXRSS + 1, char);
+		    dir_name[0] = '\0';
+		    file_name = NULL;
+
+		    /* First try a VMS parse */
+		    sts = vms_split_path
+			  (filespec,
+			   &v_spec,
+			   &v_len,
+			   &r_spec,
+			   &r_len,
+			   &d_spec,
+			   &d_len,
+			   &n_spec,
+			   &n_len,
+			   &e_spec,
+			   &e_len,
+			   &vs_spec,
+			   &vs_len);
+
+		    if (sts == 0) {
+			/* This is VMS */
+
+			int dir_len = v_len + r_len + d_len + n_len;
+			if (dir_len > 0) {
+			   strncpy(dir_name, filespec, dir_len);
+			   dir_name[dir_len] = '\0';
+			   file_name = (char *)&filespec[dir_len + 1];
+			}
+		    } else {
+			/* This must be UNIX */
+			char * tchar;
+
+			tchar = strrchr(filespec, '/');
+
+			if (tchar != NULL) {
+			    int dir_len = tchar - filespec;
+			    strncpy(dir_name, filespec, dir_len);
+			    dir_name[dir_len] = '\0';
+			    file_name = (char *) &filespec[dir_len + 1];
+			}
+		    }
+
+		    /* Dir name is defaulted */
+		    if (dir_name[0] == 0) {
+			dir_name[0] = '.';
+			dir_name[1] = '\0';
+		    }
+
+		    /* Need realpath for the directory */
+		    sts = vms_fid_to_name(vms_dir_name,
+					  VMS_MAXRSS + 1,
+					  dir_name);
+
+		    if (sts == 0) {
+		        /* Now need to pathify it.
+		        char *tdir = do_pathify_dirspec(vms_dir_name,
+							outbuf, utf8_fl);
+
+			/* And now add the original filespec to it */
+			if (file_name != NULL) {
+			    strcat(outbuf, file_name);
+			}
+			return outbuf;
+		    }
+		    Safefree(vms_dir_name);
+		    Safefree(dir_name);
+		}
+            }
+        }
+        Safefree(vms_spec);
+    }
+    return rslt;
+}
+
+static char *
+mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf,
+		   int *utf8_fl)
 {
-    return realpath(filespec, outbuf);
+    char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
+    int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
+    int file_len;
+
+    /* Fall back to fid_to_name */
+
+    sts = vms_fid_to_name(outbuf, VMS_MAXRSS + 1, filespec);
+    if (sts != 0) {
+	return NULL;
+    }
+    else {
+
+
+	/* Now need to trim the version off */
+	sts = vms_split_path
+		  (outbuf,
+		   &v_spec,
+		   &v_len,
+		   &r_spec,
+		   &r_len,
+		   &d_spec,
+		   &d_len,
+		   &n_spec,
+		   &n_len,
+		   &e_spec,
+		   &e_len,
+		   &vs_spec,
+		   &vs_len);
+
+
+	if (sts == 0) {
+	    int haslower = 0;
+	    const char *cp;
+
+	    /* Trim off the version */
+	    int file_len = v_len + r_len + d_len + n_len + e_len;
+	    outbuf[file_len] = 0;
+
+	    /* Downcase if input had any lower case letters and 
+	     * case preservation is not in effect. 
+	     */
+	    if (!decc_efs_case_preserve) {
+	        for (cp = filespec; *cp; cp++)
+	            if (islower(*cp)) { haslower = 1; break; }
+
+	        if (haslower) __mystrtolower(outbuf);
+	    }
+	}
+    }
+    return outbuf;
 }
 
+
 /*}}}*/
 /* External entry points */
 char *Perl_vms_realpath(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
 { return do_vms_realpath(filespec, outbuf, utf8_fl); }
-#else
-char *Perl_vms_realpath(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
-{ return NULL; }
-#endif
 
+char *Perl_vms_realname(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
+{ return do_vms_realname(filespec, outbuf, utf8_fl); }
 
-#if __CRTL_VER >= 70301000 && !defined(__VAX)
 /* case_tolerant */
 
 /*{{{int do_vms_case_tolerant(void)*/
@@ -12888,6 +13581,7 @@ int do_vms_case_tolerant(void)
 }
 /*}}}*/
 /* External entry points */
+#if __CRTL_VER >= 70301000 && !defined(__VAX)
 int Perl_vms_case_tolerant(void)
 { return do_vms_case_tolerant(); }
 #else
@@ -12975,7 +13669,6 @@ static int set_features
 {
     int status;
     int s;
-    int dflt;
     char* str;
     char val_str[10];
 #if defined(JPI$_CASE_LOOKUP_PERM) && !defined(__VAX)
@@ -12989,28 +13682,62 @@ static int set_features
     vms_debug_on_exception = 0;
     status = sys_trnlnm("PERL_VMS_EXCEPTION_DEBUG", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
 	 vms_debug_on_exception = 1;
        else
 	 vms_debug_on_exception = 0;
     }
 
+    /* Debug unix/vms file translation routines */
+    vms_debug_fileify = 0;
+    status = sys_trnlnm("PERL_VMS_FILEIFY_DEBUG", val_str, sizeof(val_str));
+    if ($VMS_STATUS_SUCCESS(status)) {
+	val_str[0] = _toupper(val_str[0]);
+        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
+	    vms_debug_fileify = 1;
+        else
+	    vms_debug_fileify = 0;
+    }
+
+
+    /* Historically PERL has been doing vmsify / stat differently than */
+    /* the CRTL.  In particular, under some conditions the CRTL will   */
+    /* remove some illegal characters like spaces from filenames       */
+    /* resulting in some differences.  The stat()/lstat() wrapper has  */
+    /* been reporting such file names as invalid and fails to stat them */
+    /* fixing this bug so that stat()/lstat() accept these like the     */
+    /* CRTL does will result in several tests failing.                  */
+    /* This should really be fixed, but for now, set up a feature to    */
+    /* enable it so that the impact can be studied.                     */
+    vms_bug_stat_filename = 0;
+    status = sys_trnlnm("PERL_VMS_BUG_STAT_FILENAME", val_str, sizeof(val_str));
+    if ($VMS_STATUS_SUCCESS(status)) {
+	val_str[0] = _toupper(val_str[0]);
+        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
+	    vms_bug_stat_filename = 1;
+        else
+	    vms_bug_stat_filename = 0;
+    }
+
+
     /* Create VTF-7 filenames from Unicode instead of UTF-8 */
     vms_vtf7_filenames = 0;
     status = sys_trnlnm("PERL_VMS_VTF7_FILENAMES", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
 	 vms_vtf7_filenames = 1;
        else
 	 vms_vtf7_filenames = 0;
     }
 
-
     /* unlink all versions on unlink() or rename() */
-    vms_vtf7_filenames = 0;
+    vms_unlink_all_versions = 0;
     status = sys_trnlnm
 	("PERL_VMS_UNLINK_ALL_VERSIONS", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
 	 vms_unlink_all_versions = 1;
        else
@@ -13022,7 +13749,6 @@ static int set_features
     gnv_unix_shell = 0;
     status = sys_trnlnm("GNV$UNIX_SHELL", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
-       if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
 	 gnv_unix_shell = 1;
 	 set_feature_default("DECC$EFS_CASE_PRESERVE", 1);
 	 set_feature_default("DECC$EFS_CHARSET", 1);
@@ -13031,48 +13757,28 @@ static int set_features
 	 set_feature_default("DECC$READDIR_DROPDOTNOTYPE", 1);
 	 set_feature_default("DECC$DISABLE_POSIX_ROOT", 0);
 	 vms_unlink_all_versions = 1;
-       }
-       else
-	 gnv_unix_shell = 0;
+	 vms_posix_exit = 1;
     }
 #endif
 
     /* hacks to see if known bugs are still present for testing */
 
-    /* Readdir is returning filenames in VMS syntax always */
-    decc_bug_readdir_efs1 = 1;
-    status = sys_trnlnm("DECC_BUG_READDIR_EFS1", val_str, sizeof(val_str));
-    if ($VMS_STATUS_SUCCESS(status)) {
-       if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
-         decc_bug_readdir_efs1 = 1;
-       else
-	 decc_bug_readdir_efs1 = 0;
-    }
-
     /* PCP mode requires creating /dev/null special device file */
     decc_bug_devnull = 0;
     status = sys_trnlnm("DECC_BUG_DEVNULL", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
        if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
           decc_bug_devnull = 1;
        else
 	  decc_bug_devnull = 0;
     }
 
-    /* fgetname returning a VMS name in UNIX mode */
-    decc_bug_fgetname = 1;
-    status = sys_trnlnm("DECC_BUG_FGETNAME", val_str, sizeof(val_str));
-    if ($VMS_STATUS_SUCCESS(status)) {
-      if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
-	decc_bug_fgetname = 1;
-      else
-	decc_bug_fgetname = 0;
-    }
-
     /* UNIX directory names with no paths are broken in a lot of places */
     decc_dir_barename = 1;
     status = sys_trnlnm("DECC_DIR_BARENAME", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {
+      val_str[0] = _toupper(val_str[0]);
       if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
 	decc_dir_barename = 1;
       else
@@ -13095,6 +13801,7 @@ static int set_features
     }
 
     s = decc$feature_get_index("DECC$EFS_CHARSET");
+    decc_efs_charset_index = s;
     if (s >= 0) {
 	decc_efs_charset = decc$feature_get_value(s, 1);
 	if (decc_efs_charset < 0)
@@ -13104,8 +13811,10 @@ static int set_features
     s = decc$feature_get_index("DECC$FILENAME_UNIX_REPORT");
     if (s >= 0) {
 	decc_filename_unix_report = decc$feature_get_value(s, 1);
-	if (decc_filename_unix_report > 0)
+	if (decc_filename_unix_report > 0) {
 	    decc_filename_unix_report = 1;
+	    vms_posix_exit = 1;
+	}
 	else
 	    decc_filename_unix_report = 0;
     }
@@ -13135,26 +13844,6 @@ static int set_features
 	    decc_readdir_dropdotnotype = 0;
     }
 
-    status = sys_trnlnm("SYS$POSIX_ROOT", val_str, sizeof(val_str));
-    if ($VMS_STATUS_SUCCESS(status)) {
-	s = decc$feature_get_index("DECC$DISABLE_POSIX_ROOT");
-	if (s >= 0) {
-	    dflt = decc$feature_get_value(s, 4);
-	    if (dflt > 0) {
-		decc_disable_posix_root = decc$feature_get_value(s, 1);
-		if (decc_disable_posix_root <= 0) {
-		    decc$feature_set_value(s, 1, 1);
-		    decc_disable_posix_root = 1;
-		}
-	    }
-	    else {
-		/* Traditionally Perl assumes this is off */
-		decc_disable_posix_root = 1;
-		decc$feature_set_value(s, 1, 1);
-	    }
-	}
-    }
-
 #if __CRTL_VER >= 80200000
     s = decc$feature_get_index("DECC$POSIX_COMPLIANT_PATHNAMES");
     if (s >= 0) {
@@ -13217,7 +13906,7 @@ static int set_features
     }
 #endif
 
-#if defined(JPI$_CASE_LOOKUP_PERM) && !defined(__VAX)
+#if defined(JPI$_CASE_LOOKUP_PERM) && defined(PPROP$K_CASE_BLIND) && !defined(__VAX)
 
      /* Report true case tolerance */
     /*----------------------------*/
@@ -13233,6 +13922,18 @@ static int set_features
 
 #endif
 
+    /* USE POSIX/DCL Exit codes - Recommended, but needs to default to  */
+    /* for strict backward compatibilty */
+    status = sys_trnlnm
+	("PERL_VMS_POSIX_EXIT", val_str, sizeof(val_str));
+    if ($VMS_STATUS_SUCCESS(status)) {
+       val_str[0] = _toupper(val_str[0]);
+       if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
+	 vms_posix_exit = 1;
+       else
+	 vms_posix_exit = 0;
+    }
+
 
     /* CRTL can be initialized past this point, but not before. */
 /*    DECC$CRTL_INIT(); */