X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=vms%2Fvms.c;h=f4a4ee81aeaa8007c1ea926a392b6bbd6b503fc6;hb=0ee1060bc7f323c193867d7f04e45058f219516b;hp=f0e41213b79b257d2d7d8820c887ce908e62fb93;hpb=baf3cf9c09c529e1ab56c4c24a7a8bb4dba12542;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/vms/vms.c b/vms/vms.c
index f0e4121..f4a4ee8 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -3,6 +3,7 @@
  * VMS-specific routines for perl5
  * Version: 5.7.0
  *
+ * 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
@@ -30,6 +31,9 @@
 #include <lib$routines.h>
 #include <lnmdef.h>
 #include <msgdef.h>
+#if __CRTL_VER >= 70301000 && !defined(__VAX)
+#include <ppropdef.h>
+#endif
 #include <prvdef.h>
 #include <psldef.h>
 #include <rms.h>
@@ -41,6 +45,61 @@
 #include <syidef.h>
 #include <uaidef.h>
 #include <uicdef.h>
+#include <stsdef.h>
+#include <rmsdef.h>
+
+/* Set the maximum filespec size here as it is larger for EFS file
+ * specifications.
+ * Not fully implemented at this time because the larger size
+ * will likely impact the stack local storage requirements of
+ * threaded code, and probably cause hard to diagnose failures.
+ * To implement the larger sizes, all places where filename
+ * storage is put on the stack need to be changed to use
+ * New()/SafeFree() instead.
+ */
+#define VMS_MAXRSS NAM$C_MAXRSS
+#ifndef __VAX
+#if 0
+#ifdef NAML$C_MAXRSS
+#undef VMS_MAXRSS
+#define VMS_MAXRSS NAML$C_MAXRSS
+#endif
+#endif
+#endif
+
+#if  __CRTL_VER < 70301000 && __CRTL_VER >= 70300000
+int   decc$feature_get_index(const char *name);
+char* decc$feature_get_name(int index);
+int   decc$feature_get_value(int index, int mode);
+int   decc$feature_set_value(int index, int mode, int value);
+#else
+#include <unixlib.h>
+#endif
+
+#ifndef __VAX
+#if __CRTL_VER >= 70300000
+
+static int set_feature_default(const char *name, int value)
+{
+    int status;
+    int index;
+
+    index = decc$feature_get_index(name);
+
+    status = decc$feature_set_value(index, 1, value);
+    if (index == -1 || (status == -1)) {
+      return -1;
+    }
+
+    status = decc$feature_get_value(index, 1);
+    if (status != value) {
+      return -1;
+    }
+
+return 0;
+}
+#endif
+#endif
 
 /* Older versions of ssdef.h don't have these */
 #ifndef SS$_INVFILFOROP
@@ -85,23 +144,41 @@
 dEXT int h_errno;
 #endif
 
+#ifdef __DECC
+#pragma message disable pragma
+#pragma member_alignment save
+#pragma nomember_alignment longword
+#pragma message save
+#pragma message disable misalgndmem
+#endif
 struct itmlst_3 {
   unsigned short int buflen;
   unsigned short int itmcode;
   void *bufadr;
   unsigned short int *retlen;
 };
+#ifdef __DECC
+#pragma message restore
+#pragma member_alignment restore
+#endif
 
 #define do_fileify_dirspec(a,b,c)	mp_do_fileify_dirspec(aTHX_ a,b,c)
 #define do_pathify_dirspec(a,b,c)	mp_do_pathify_dirspec(aTHX_ a,b,c)
 #define do_tovmsspec(a,b,c)		mp_do_tovmsspec(aTHX_ a,b,c)
 #define do_tovmspath(a,b,c)		mp_do_tovmspath(aTHX_ a,b,c)
 #define do_rmsexpand(a,b,c,d,e)		mp_do_rmsexpand(aTHX_ a,b,c,d,e)
+#define do_vms_realpath(a,b)		mp_do_vms_realpath(aTHX_ a,b)
 #define do_tounixspec(a,b,c)		mp_do_tounixspec(aTHX_ a,b,c)
 #define do_tounixpath(a,b,c)		mp_do_tounixpath(aTHX_ a,b,c)
+#define do_vms_case_tolerant(a)		mp_do_vms_case_tolerant(a)
 #define expand_wild_cards(a,b,c,d)	mp_expand_wild_cards(aTHX_ a,b,c,d)
 #define getredirection(a,b)		mp_getredirection(aTHX_ a,b)
 
+static char *mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts);
+static char *mp_do_tounixpath(pTHX_ const char *path, char *buf, int ts);
+static char *mp_do_tounixspec(pTHX_ const char *, char *, int);
+static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts);
+
 /* see system service docs for $TRNLNM -- NOT the same as LNM$_MAX_INDEX */
 #define PERL_LNM_MAX_ALLOWED_INDEX 127
 
@@ -137,14 +214,91 @@ static int no_translate_barewords;
 static int tz_updated = 1;
 #endif
 
+/* DECC Features that may need to affect how Perl interprets
+ * displays filename information
+ */
+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_filename_unix_no_version = 0;
+static int decc_filename_unix_only = 0;
+int decc_filename_unix_report = 0;
+int decc_posix_compliant_pathnames = 0;
+int decc_readdir_dropdotnotype = 0;
+static int vms_process_case_tolerant = 1;
+
+/* Is this a UNIX file specification?
+ *   No longer a simple check with EFS file specs
+ *   For now, not a full check, but need to
+ *   handle POSIX ^UP^ specifications
+ *   Fixing to handle ^/ cases would require
+ *   changes to many other conversion routines.
+ */
+
+static is_unix_filespec(const char *path)
+{
+int ret_val;
+const char * pch1;
+
+    ret_val = 0;
+    if (strncmp(path,"\"^UP^",5) != 0) {
+	pch1 = strchr(path, '/');
+	if (pch1 != NULL)
+	    ret_val = 1;
+	else {
+
+	    /* If the user wants UNIX files, "." needs to be treated as in UNIX */
+	    if (decc_filename_unix_report || decc_filename_unix_only) {
+	    if (strcmp(path,".") == 0)
+		ret_val = 1;
+	    }
+	}
+    }
+    return ret_val;
+}
+
+
+/* my_maxidx
+ * Routine to retrieve the maximum equivalence index for an input
+ * logical name.  Some calls to this routine have no knowledge if
+ * the variable is a logical or not.  So on error we return a max
+ * index of zero.
+ */
+/*{{{int my_maxidx(const char *lnm) */
+static int
+my_maxidx(const char *lnm)
+{
+    int status;
+    int midx;
+    int attr = LNM$M_CASE_BLIND;
+    struct dsc$descriptor lnmdsc;
+    struct itmlst_3 itlst[2] = {{sizeof(midx), LNM$_MAX_INDEX, &midx, 0},
+                                {0, 0, 0, 0}};
+
+    lnmdsc.dsc$w_length = strlen(lnm);
+    lnmdsc.dsc$b_dtype = DSC$K_DTYPE_T;
+    lnmdsc.dsc$b_class = DSC$K_CLASS_S;
+    lnmdsc.dsc$a_pointer = (char *) lnm; /* Cast ok for read only parameter */
+
+    status = sys$trnlnm(&attr, &fildevdsc, &lnmdsc, 0, itlst);
+    if ((status & 1) == 0)
+       midx = 0;
+
+    return (midx);
+}
+/*}}}*/
+
 /*{{{int vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, struct dsc$descriptor_s **tabvec, unsigned long int flags) */
 int
 Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
   struct dsc$descriptor_s **tabvec, unsigned long int flags)
 {
-    char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2;
+    const char *cp1;
+    char uplnm[LNM$C_NAMLENGTH+1], *cp2;
     unsigned short int eqvlen, curtab, ivlnm = 0, ivsym = 0, ivenv = 0, secure;
     unsigned long int retsts, attr = LNM$M_CASE_BLIND;
+    int midx;
     unsigned char acmode;
     struct dsc$descriptor_s lnmdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
                             tmpdsc = {6,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
@@ -154,30 +308,17 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
     $DESCRIPTOR(crtlenv,"CRTL_ENV");  $DESCRIPTOR(clisym,"CLISYM");
 #if defined(PERL_IMPLICIT_CONTEXT)
     pTHX = NULL;
-#  if defined(USE_5005THREADS)
-    /* We jump through these hoops because we can be called at */
-    /* platform-specific initialization time, which is before anything is */
-    /* set up--we can't even do a plain dTHX since that relies on the */
-    /* interpreter structure to be initialized */
-    if (PL_curinterp) {
-      aTHX = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
-    } else {
-      aTHX = NULL;
-    }
-# else
     if (PL_curinterp) {
       aTHX = PERL_GET_INTERP;
     } else {
       aTHX = NULL;
     }
-
-#  endif
 #endif
 
-    if (!lnm || !eqv || idx > PERL_LNM_MAX_ALLOWED_INDEX) {
+    if (!lnm || !eqv || ((idx != 0) && ((idx-1) > PERL_LNM_MAX_ALLOWED_INDEX))) {
       set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return 0;
     }
-    for (cp1 = (char *)lnm, cp2 = uplnm; *cp1; cp1++, cp2++) {
+    for (cp1 = lnm, cp2 = uplnm; *cp1; cp1++, cp2++) {
       *cp2 = _toupper(*cp1);
       if (cp1 - lnm > LNM$C_NAMLENGTH) {
         set_errno(EINVAL); set_vaxc_errno(SS$_IVLOGNAM);
@@ -204,6 +345,7 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
           retsts = SS$_NOLOGNAM;
           for (i = 0; environ[i]; i++) { 
             if ((eq = strchr(environ[i],'=')) && 
+                lnmdsc.dsc$w_length == (eq - environ[i]) &&
                 !strncmp(environ[i],uplnm,eq - environ[i])) {
               eq++;
               for (eqvlen = 0; eq[eqvlen]; eqvlen++) eqv[eqvlen] = eq[eqvlen];
@@ -231,18 +373,9 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
 	      /* fully initialized, in which case either thr or PL_curcop */
 	      /* might be bogus. We have to check, since ckWARN needs them */
 	      /* both to be valid if running threaded */
-#if defined(USE_5005THREADS)
-	      if (thr && PL_curcop) {
-#endif
 		if (ckWARN(WARN_MISC)) {
 		  Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm);
 		}
-#if defined(USE_5005THREADS)
-	      } else {
-		  Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm);
-	      }
-#endif
-	      
             }
             strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen);
           }
@@ -253,22 +386,40 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
         }
       }
       else if (!ivlnm) {
-        retsts = sys$trnlnm(&attr,tabvec[curtab],&lnmdsc,&acmode,lnmlst);
-        if (retsts == SS$_IVLOGNAM) { ivlnm = 1; continue; }
-        if (retsts == SS$_NOLOGNAM) continue;
-        /* PPFs have a prefix */
-        if (
+        if ( (idx == 0) && (flags & PERL__TRNENV_JOIN_SEARCHLIST) ) {
+          midx = my_maxidx(lnm);
+          for (idx = 0, cp2 = eqv; idx <= midx; idx++) {
+            lnmlst[1].bufadr = cp2;
+            eqvlen = 0;
+            retsts = sys$trnlnm(&attr,tabvec[curtab],&lnmdsc,&acmode,lnmlst);
+            if (retsts == SS$_IVLOGNAM) { ivlnm = 1; break; }
+            if (retsts == SS$_NOLOGNAM) break;
+            /* PPFs have a prefix */
+            if (
 #if INTSIZE == 4
-             *((int *)uplnm) == *((int *)"SYS$")                    &&
+                 *((int *)uplnm) == *((int *)"SYS$")                    &&
 #endif
-             eqvlen >= 4 && eqv[0] == 0x1b && eqv[1] == 0x00        &&
-             ( (uplnm[4] == 'O' && !strcmp(uplnm,"SYS$OUTPUT"))  ||
-               (uplnm[4] == 'I' && !strcmp(uplnm,"SYS$INPUT"))   ||
-               (uplnm[4] == 'E' && !strcmp(uplnm,"SYS$ERROR"))   ||
-               (uplnm[4] == 'C' && !strcmp(uplnm,"SYS$COMMAND")) )  ) {
-          memcpy(eqv,eqv+4,eqvlen-4);
-          eqvlen -= 4;
+                 eqvlen >= 4 && eqv[0] == 0x1b && eqv[1] == 0x00        &&
+                 ( (uplnm[4] == 'O' && !strcmp(uplnm,"SYS$OUTPUT"))  ||
+                   (uplnm[4] == 'I' && !strcmp(uplnm,"SYS$INPUT"))   ||
+                   (uplnm[4] == 'E' && !strcmp(uplnm,"SYS$ERROR"))   ||
+                   (uplnm[4] == 'C' && !strcmp(uplnm,"SYS$COMMAND")) )  ) {
+              memcpy(eqv,eqv+4,eqvlen-4);
+              eqvlen -= 4;
+            }
+            cp2 += eqvlen;
+            *cp2 = '\0';
+          }
+          if ((retsts == SS$_IVLOGNAM) ||
+              (retsts == SS$_NOLOGNAM)) { continue; }
+        }
+        else {
+          retsts = sys$trnlnm(&attr,tabvec[curtab],&lnmdsc,&acmode,lnmlst);
+          if (retsts == SS$_IVLOGNAM) { ivlnm = 1; continue; }
+          if (retsts == SS$_NOLOGNAM) continue;
+          eqv[eqvlen] = '\0';
         }
+        eqvlen = strlen(eqv);
         break;
       }
     }
@@ -309,47 +460,77 @@ int Perl_my_trnlnm(pTHX_ const char *lnm, char *eqv, unsigned long int idx)
 char *
 Perl_my_getenv(pTHX_ const char *lnm, bool sys)
 {
-    static char __my_getenv_eqv[LNM$C_NAMLENGTH+1];
-    char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2, *eqv;
+    const char *cp1;
+    static char *__my_getenv_eqv = NULL;
+    char uplnm[LNM$C_NAMLENGTH+1], *cp2, *eqv;
     unsigned long int idx = 0;
     int trnsuccess, success, secure, saverr, savvmserr;
+    int midx, flags;
     SV *tmpsv;
 
+    midx = my_maxidx(lnm) + 1;
+
     if (PL_curinterp) {  /* Perl interpreter running -- may be threaded */
       /* Set up a temporary buffer for the return value; Perl will
        * clean it up at the next statement transition */
-      tmpsv = sv_2mortal(newSVpv("",LNM$C_NAMLENGTH+1));
+      tmpsv = sv_2mortal(newSVpv("",(LNM$C_NAMLENGTH*midx)+1));
       if (!tmpsv) return NULL;
       eqv = SvPVX(tmpsv);
     }
-    else eqv = __my_getenv_eqv;  /* Assume no interpreter ==> single thread */
-    for (cp1 = (char *) lnm, cp2 = eqv; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
+    else {
+      /* Assume no interpreter ==> single thread */
+      if (__my_getenv_eqv != NULL) {
+        Renew(__my_getenv_eqv,LNM$C_NAMLENGTH*midx+1,char);
+      }
+      else {
+        Newx(__my_getenv_eqv,LNM$C_NAMLENGTH*midx+1,char);
+      }
+      eqv = __my_getenv_eqv;  
+    }
+
+    for (cp1 = lnm, cp2 = eqv; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
     if (cp1 - lnm == 7 && !strncmp(eqv,"DEFAULT",7)) {
       getcwd(eqv,LNM$C_NAMLENGTH);
       return eqv;
     }
     else {
-      if ((cp2 = strchr(lnm,';')) != NULL) {
-        strcpy(uplnm,lnm);
-        uplnm[cp2-lnm] = '\0';
-        idx = strtoul(cp2+1,NULL,0);
-        lnm = uplnm;
-      }
       /* Impose security constraints only if tainting */
       if (sys) {
         /* Impose security constraints only if tainting */
         secure = PL_curinterp ? PL_tainting : will_taint;
         saverr = errno;  savvmserr = vaxc$errno;
       }
-      else secure = 0;
-      success = vmstrnenv(lnm,eqv,idx,
-                          secure ? fildev : NULL,
+      else {
+        secure = 0;
+      }
+
+      flags = 
 #ifdef SECURE_INTERNAL_GETENV
-                          secure ? PERL__TRNENV_SECURE : 0
+              secure ? PERL__TRNENV_SECURE : 0
 #else
-			  0
+              0
 #endif
-			                                     );
+      ;
+
+      /* For the getenv interface we combine all the equivalence names
+       * of a search list logical into one value to acquire a maximum
+       * value length of 255*128 (assuming %ENV is using logicals).
+       */
+      flags |= PERL__TRNENV_JOIN_SEARCHLIST;
+
+      /* If the name contains a semicolon-delimited index, parse it
+       * off and make sure we only retrieve the equivalence name for 
+       * that index.  */
+      if ((cp2 = strchr(lnm,';')) != NULL) {
+        strcpy(uplnm,lnm);
+        uplnm[cp2-lnm] = '\0';
+        idx = strtoul(cp2+1,NULL,0);
+        lnm = uplnm;
+        flags &= ~PERL__TRNENV_JOIN_SEARCHLIST;
+      }
+
+      success = vmstrnenv(lnm,eqv,idx,secure ? fildev : NULL,flags);
+
       /* Discard NOLOGNAM on internal calls since we're often looking
        * for an optional name, and this "error" often shows up as the
        * (bogus) exit status for a die() call later on.  */
@@ -365,47 +546,97 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
 char *
 Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys)
 {
-    char *buf, *cp1, *cp2;
+    const char *cp1;
+    char *buf, *cp2;
     unsigned long idx = 0;
-    static char __my_getenv_len_eqv[LNM$C_NAMLENGTH+1];
+    int midx, flags;
+    static char *__my_getenv_len_eqv = NULL;
     int secure, saverr, savvmserr;
     SV *tmpsv;
     
+    midx = my_maxidx(lnm) + 1;
+
     if (PL_curinterp) {  /* Perl interpreter running -- may be threaded */
       /* Set up a temporary buffer for the return value; Perl will
        * clean it up at the next statement transition */
-      tmpsv = sv_2mortal(newSVpv("",LNM$C_NAMLENGTH+1));
+      tmpsv = sv_2mortal(newSVpv("",(LNM$C_NAMLENGTH*midx)+1));
       if (!tmpsv) return NULL;
       buf = SvPVX(tmpsv);
     }
-    else buf = __my_getenv_len_eqv;  /* Assume no interpreter ==> single thread */
-    for (cp1 = (char *)lnm, cp2 = buf; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
+    else {
+      /* Assume no interpreter ==> single thread */
+      if (__my_getenv_len_eqv != NULL) {
+        Renew(__my_getenv_len_eqv,LNM$C_NAMLENGTH*midx+1,char);
+      }
+      else {
+        Newx(__my_getenv_len_eqv,LNM$C_NAMLENGTH*midx+1,char);
+      }
+      buf = __my_getenv_len_eqv;  
+    }
+
+    for (cp1 = lnm, cp2 = buf; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
     if (cp1 - lnm == 7 && !strncmp(buf,"DEFAULT",7)) {
+    char * zeros;
+
       getcwd(buf,LNM$C_NAMLENGTH);
       *len = strlen(buf);
+
+      /* Get rid of "000000/ in rooted filespecs */
+      if (*len > 7) {
+      zeros = strstr(buf, "/000000/");
+      if (zeros != NULL) {
+	int mlen;
+	mlen = *len - (zeros - buf) - 7;
+	memmove(zeros, &zeros[7], mlen);
+	*len = *len - 7;
+	buf[*len] = '\0';
+	}
+      }
       return buf;
     }
     else {
-      if ((cp2 = strchr(lnm,';')) != NULL) {
-        strcpy(buf,lnm);
-        buf[cp2-lnm] = '\0';
-        idx = strtoul(cp2+1,NULL,0);
-        lnm = buf;
-      }
       if (sys) {
         /* Impose security constraints only if tainting */
         secure = PL_curinterp ? PL_tainting : will_taint;
         saverr = errno;  savvmserr = vaxc$errno;
       }
-      else secure = 0;
-      *len = vmstrnenv(lnm,buf,idx,
-                       secure ? fildev : NULL,
+      else {
+        secure = 0;
+      }
+
+      flags = 
 #ifdef SECURE_INTERNAL_GETENV
-                       secure ? PERL__TRNENV_SECURE : 0
+              secure ? PERL__TRNENV_SECURE : 0
 #else
-                                                      0
+              0
 #endif
-		                                       );
+      ;
+
+      flags |= PERL__TRNENV_JOIN_SEARCHLIST;
+
+      if ((cp2 = strchr(lnm,';')) != NULL) {
+        strcpy(buf,lnm);
+        buf[cp2-lnm] = '\0';
+        idx = strtoul(cp2+1,NULL,0);
+        lnm = buf;
+        flags &= ~PERL__TRNENV_JOIN_SEARCHLIST;
+      }
+
+      *len = vmstrnenv(lnm,buf,idx,secure ? fildev : NULL,flags);
+
+      /* Get rid of "000000/ in rooted filespecs */
+      if (*len > 7) {
+      char * zeros;
+	zeros = strstr(buf, "/000000/");
+	if (zeros != NULL) {
+	  int mlen;
+	  mlen = *len - (zeros - buf) - 7;
+	  memmove(zeros, &zeros[7], mlen);
+	  *len = *len - 7;
+	  buf[*len] = '\0';
+	}
+      }
+
       /* Discard NOLOGNAM on internal calls since we're often looking
        * for an optional name, and this "error" often shows up as the
        * (bogus) exit status for a die() call later on.  */
@@ -447,7 +678,7 @@ prime_env_iter(void)
 #if defined(PERL_IMPLICIT_CONTEXT)
   pTHX;
 #endif
-#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+#if defined(USE_ITHREADS)
   static perl_mutex primenv_mutex;
   MUTEX_INIT(&primenv_mutex);
 #endif
@@ -457,20 +688,12 @@ prime_env_iter(void)
     /* platform-specific initialization time, which is before anything is */
     /* set up--we can't even do a plain dTHX since that relies on the */
     /* interpreter structure to be initialized */
-#if defined(USE_5005THREADS)
-    if (PL_curinterp) {
-      aTHX = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
-    } else {
-      aTHX = NULL;
-    }
-#else
     if (PL_curinterp) {
       aTHX = PERL_GET_INTERP;
     } else {
       aTHX = NULL;
     }
 #endif
-#endif
 
   if (primed || !PL_envgv) return;
   MUTEX_LOCK(&primenv_mutex);
@@ -541,7 +764,7 @@ prime_env_iter(void)
       defflags &= ~CLI$M_TRUSTED;
     } while (retsts == LIB$_INVARG && (flags | CLI$M_TRUSTED));
     _ckvmssts(retsts);
-    if (!buf) New(1322,buf,mbxbufsiz + 1,char);
+    if (!buf) Newx(buf,mbxbufsiz + 1,char);
     if (seenhv) SvREFCNT_dec(seenhv);
     seenhv = newHV();
     while (1) {
@@ -594,14 +817,28 @@ prime_env_iter(void)
         continue;
       }
       PERL_HASH(hash,key,keylen);
-      sv = newSVpvn(cp2,cp1 - cp2 + 1);
+
+      if (cp1 == cp2 && *cp2 == '.') {
+        /* A single dot usually means an unprintable character, such as a null
+         * to indicate a zero-length value.  Get the actual value to make sure.
+         */
+        char lnm[LNM$C_NAMLENGTH+1];
+        char eqv[LNM$C_NAMLENGTH+1];
+        strncpy(lnm, key, keylen);
+        int trnlen = vmstrnenv(lnm, eqv, 0, fildev, 0);
+        sv = newSVpvn(eqv, strlen(eqv));
+      }
+      else {
+        sv = newSVpvn(cp2,cp1 - cp2 + 1);
+      }
+
       SvTAINTED_on(sv);
       hv_store(envhv,key,keylen,sv,hash);
       hv_store(seenhv,key,keylen,&PL_sv_yes,hash);
     }
     if (cmddsc.dsc$w_length == 14) { /* We just read LNM$FILE_DEV */
       /* get the PPFs for this process, not the subprocess */
-      char *ppfs[] = {"SYS$COMMAND", "SYS$INPUT", "SYS$OUTPUT", "SYS$ERROR", NULL};
+      const char *ppfs[] = {"SYS$COMMAND", "SYS$INPUT", "SYS$OUTPUT", "SYS$ERROR", NULL};
       char eqv[LNM$C_NAMLENGTH+1];
       int trnlen, i;
       for (i = 0; ppfs[i]; i++) {
@@ -623,7 +860,7 @@ prime_env_iter(void)
 /*}}}*/
 
 
-/*{{{ int  vmssetenv(char *lnm, char *eqv)*/
+/*{{{ int  vmssetenv(const char *lnm, const char *eqv)*/
 /* Define or delete an element in the same "environment" as
  * vmstrnenv().  If an element is to be deleted, it's removed from
  * the first place it's found.  If it's to be set, it's set in the
@@ -631,17 +868,25 @@ prime_env_iter(void)
  * Like setenv() returns 0 for success, non-zero on error.
  */
 int
-Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
+Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s **tabvec)
 {
-    char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2;
+    const char *cp1;
+    char uplnm[LNM$C_NAMLENGTH], *cp2, *c;
     unsigned short int curtab, ivlnm = 0, ivsym = 0, ivenv = 0;
+    int nseg = 0, j;
     unsigned long int retsts, usermode = PSL$C_USER;
+    struct itmlst_3 *ile, *ilist;
     struct dsc$descriptor_s lnmdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,uplnm},
                             eqvdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
                             tmpdsc = {6,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
     $DESCRIPTOR(crtlenv,"CRTL_ENV");  $DESCRIPTOR(clisym,"CLISYM");
     $DESCRIPTOR(local,"_LOCAL");
 
+    if (!lnm) {
+        set_errno(EINVAL); set_vaxc_errno(SS$_IVLOGNAM);
+        return SS$_IVLOGNAM;
+    }
+
     for (cp1 = lnm, cp2 = uplnm; *cp1; cp1++, cp2++) {
       *cp2 = _toupper(*cp1);
       if (cp1 - lnm > LNM$C_NAMLENGTH) {
@@ -656,8 +901,9 @@ Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
       for (curtab = 0; tabvec[curtab]; curtab++) {
         if (!ivenv && !str$case_blind_compare(tabvec[curtab],&crtlenv)) {
         int i;
-          for (i = 0; environ[i]; i++) { /* Iff it's an environ elt, reset */
+          for (i = 0; environ[i]; i++) { /* If it's an environ elt, reset */
             if ((cp1 = strchr(environ[i],'=')) && 
+                lnmdsc.dsc$w_length == (cp1 - environ[i]) &&
                 !strncmp(environ[i],lnm,cp1 - environ[i])) {
 #ifdef HAS_SETENV
               return setenv(lnm,"",1) ? vaxc$errno : 0;
@@ -706,7 +952,7 @@ Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
 #endif
       }
       else {
-        eqvdsc.dsc$a_pointer = eqv;
+        eqvdsc.dsc$a_pointer = (char *) eqv; /* cast ok to readonly parameter */
         eqvdsc.dsc$w_length  = strlen(eqv);
         if ((tmpdsc.dsc$a_pointer = tabvec[0]->dsc$a_pointer) &&
             !str$case_blind_compare(&tmpdsc,&clisym)) {
@@ -721,12 +967,42 @@ Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
         else {
           if (!*eqv) eqvdsc.dsc$w_length = 1;
 	  if (eqvdsc.dsc$w_length > LNM$C_NAMLENGTH) {
-	    eqvdsc.dsc$w_length = LNM$C_NAMLENGTH;
-	    if (ckWARN(WARN_MISC)) {
-	      Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of logical \"%s\" too long. Truncating to %i bytes",lnm, LNM$C_NAMLENGTH);
+
+            nseg = (eqvdsc.dsc$w_length + LNM$C_NAMLENGTH - 1) / LNM$C_NAMLENGTH;
+            if (nseg > PERL_LNM_MAX_ALLOWED_INDEX + 1) {
+	      Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of logical \"%s\" too long. Truncating to %i bytes",
+                          lnm, LNM$C_NAMLENGTH * (PERL_LNM_MAX_ALLOWED_INDEX+1));
+              eqvdsc.dsc$w_length = LNM$C_NAMLENGTH * (PERL_LNM_MAX_ALLOWED_INDEX+1);
+              nseg = PERL_LNM_MAX_ALLOWED_INDEX + 1;
 	    }
+
+            Newx(ilist,nseg+1,struct itmlst_3);
+            ile = ilist;
+            if (!ile) {
+	      set_errno(ENOMEM); set_vaxc_errno(SS$_INSFMEM);
+              return SS$_INSFMEM;
+	    }
+            memset(ilist, 0, (sizeof(struct itmlst_3) * (nseg+1)));
+
+            for (j = 0, c = eqvdsc.dsc$a_pointer; j < nseg; j++, ile++, c += LNM$C_NAMLENGTH) {
+              ile->itmcode = LNM$_STRING;
+              ile->bufadr = c;
+              if ((j+1) == nseg) {
+                ile->buflen = strlen(c);
+                /* in case we are truncating one that's too long */
+                if (ile->buflen > LNM$C_NAMLENGTH) ile->buflen = LNM$C_NAMLENGTH;
+              }
+              else {
+                ile->buflen = LNM$C_NAMLENGTH;
+              }
+            }
+
+            retsts = lib$set_logical(&lnmdsc,0,tabvec[0],0,ilist);
+            Safefree (ilist);
+	  }
+          else {
+            retsts = lib$set_logical(&lnmdsc,&eqvdsc,tabvec[0],0,0);
 	  }
-          retsts = lib$set_logical(&lnmdsc,&eqvdsc,tabvec[0],0,0);
         }
       }
     }
@@ -763,10 +1039,10 @@ Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
 }  /* end of vmssetenv() */
 /*}}}*/
 
-/*{{{ void  my_setenv(char *lnm, char *eqv)*/
+/*{{{ void  my_setenv(const char *lnm, const char *eqv)*/
 /* This has to be a function since there's a prototype for it in proto.h */
 void
-Perl_my_setenv(pTHX_ char *lnm,char *eqv)
+Perl_my_setenv(pTHX_ const char *lnm, const char *eqv)
 {
     if (lnm && *lnm) {
       int len = strlen(lnm);
@@ -800,7 +1076,7 @@ Perl_my_setenv(pTHX_ char *lnm,char *eqv)
  *  used for redirection of sys$error
  */
 void
-Perl_vmssetuserlnm(pTHX_ char *name, char *eqv)
+Perl_vmssetuserlnm(pTHX_ const char *name, const char *eqv)
 {
     $DESCRIPTOR(d_tab, "LNM$PROCESS");
     struct dsc$descriptor_d d_name = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
@@ -808,11 +1084,11 @@ Perl_vmssetuserlnm(pTHX_ char *name, char *eqv)
     unsigned char acmode = PSL$C_USER;
     struct itmlst_3 lnmlst[2] = {{0, LNM$_STRING, 0, 0},
                                  {0, 0, 0, 0}};
-    d_name.dsc$a_pointer = name;
+    d_name.dsc$a_pointer = (char *)name; /* Cast OK for read only parameter */
     d_name.dsc$w_length = strlen(name);
 
     lnmlst[0].buflen = strlen(eqv);
-    lnmlst[0].bufadr = eqv;
+    lnmlst[0].bufadr = (char *)eqv; /* Cast OK for read only parameter */
 
     iss = sys$crelnm(&attr,&d_tab,&d_name,&acmode,lnmlst);
     if (!(iss&1)) lib$signal(iss);
@@ -881,13 +1157,13 @@ Perl_my_crypt(pTHX_ const char *textpasswd, const char *usrname)
 /*}}}*/
 
 
-static char *mp_do_rmsexpand(pTHX_ char *, char *, int, char *, unsigned);
-static char *mp_do_fileify_dirspec(pTHX_ char *, char *, int);
-static char *mp_do_tovmsspec(pTHX_ char *, char *, int);
+static char *mp_do_rmsexpand(pTHX_ const char *, char *, int, const char *, unsigned);
+static char *mp_do_fileify_dirspec(pTHX_ const char *, char *, int);
+static char *mp_do_tovmsspec(pTHX_ const char *, char *, int);
 
 /*{{{int do_rmdir(char *name)*/
 int
-Perl_do_rmdir(pTHX_ char *name)
+Perl_do_rmdir(pTHX_ const char *name)
 {
     char dirfile[NAM$C_MAXRSS+1];
     int retval;
@@ -911,7 +1187,7 @@ Perl_do_rmdir(pTHX_ char *name)
  */
 /*{{{int kill_file(char *name)*/
 int
-Perl_kill_file(pTHX_ char *name)
+Perl_kill_file(pTHX_ const char *name)
 {
     char vmsname[NAM$C_MAXRSS+1], rspec[NAM$C_MAXRSS+1];
     unsigned long int jpicode = JPI$_UIC, type = ACL$C_FILE;
@@ -1012,7 +1288,7 @@ Perl_kill_file(pTHX_ char *name)
 
 /*{{{int my_mkdir(char *,Mode_t)*/
 int
-Perl_my_mkdir(pTHX_ char *dir, Mode_t mode)
+Perl_my_mkdir(pTHX_ const char *dir, Mode_t mode)
 {
   STRLEN dirlen = strlen(dir);
 
@@ -1035,19 +1311,32 @@ Perl_my_mkdir(pTHX_ char *dir, Mode_t mode)
 
 /*{{{int my_chdir(char *)*/
 int
-Perl_my_chdir(pTHX_ char *dir)
+Perl_my_chdir(pTHX_ const char *dir)
 {
   STRLEN dirlen = strlen(dir);
 
   /* zero length string sometimes gives ACCVIO */
   if (dirlen == 0) return -1;
+  const char *dir1;
+
+  /* Perl is passing the output of the DCL SHOW DEFAULT with leading spaces.
+   * This does not work if DECC$EFS_CHARSET is active.  Hack it here
+   * so that existing scripts do not need to be changed.
+   */
+  dir1 = dir;
+  while ((dirlen > 0) && (*dir1 == ' ')) {
+    dir1++;
+    dirlen--;
+  }
 
   /* some versions of CRTL chdir() doesn't tolerate trailing /, since
    * that implies
    * null file name/type.  However, it's commonplace under Unix,
    * so we'll allow it for a gain in portability.
+   *
+   * - Preview- '/' will be valid soon on VMS
    */
-  if (dir[dirlen-1] == '/') {
+  if ((dirlen > 1) && (dir1[dirlen-1] == '/')) {
     char *newdir = savepvn(dir,dirlen-1);
     int ret = chdir(newdir);
     Safefree(newdir);
@@ -1067,7 +1356,7 @@ my_tmpfile(void)
 
   if ((fp = tmpfile())) return fp;
 
-  New(1323,cp,L_tmpnam+24,char);
+  Newx(cp,L_tmpnam+24,char);
   strcpy(cp,"Sys$Scratch:");
   tmpnam(cp+strlen(cp));
   strcat(cp,".Perltmp");
@@ -1178,7 +1467,6 @@ Perl_sig_to_vmscondition(int sig)
     return sig_code[sig];
 }
 
-
 int
 Perl_my_kill(int pid, int sig)
 {
@@ -1217,6 +1505,161 @@ Perl_my_kill(int pid, int sig)
 }
 #endif
 
+/* Routine to convert a VMS status code to a UNIX status code.
+** More tricky than it appears because of conflicting conventions with
+** existing code.
+**
+** VMS status codes are a bit mask, with the least significant bit set for
+** success.
+**
+** Special UNIX status of EVMSERR indicates that no translation is currently
+** available, and programs should check the VMS status code.
+**
+** Programs compiled with _POSIX_EXIT have a special encoding that requires
+** decoding.
+*/
+
+#ifndef C_FACILITY_NO
+#define C_FACILITY_NO 0x350000
+#endif
+#ifndef DCL_IVVERB
+#define DCL_IVVERB 0x38090
+#endif
+
+int vms_status_to_unix(int vms_status)
+{
+int facility;
+int fac_sp;
+int msg_no;
+int msg_status;
+int unix_status;
+
+  /* Assume the best or the worst */
+  if (vms_status & STS$M_SUCCESS)
+    unix_status = 0;
+  else
+    unix_status = EVMSERR;
+
+  msg_status = vms_status & ~STS$M_CONTROL;
+
+  facility = vms_status & STS$M_FAC_NO;
+  fac_sp = vms_status & STS$M_FAC_SP;
+  msg_no = vms_status & (STS$M_MSG_NO | STS$M_SEVERITY);
+
+  if ((facility == 0) || (fac_sp == 0)) {
+    switch(msg_no) {
+    case SS$_NORMAL:
+	unix_status = 0;
+	break;
+    case SS$_ACCVIO:
+	unix_status = EFAULT;
+	break;
+    case SS$_IVLOGNAM:
+    case SS$_BADPARAM:
+    case SS$_IVLOGTAB:
+    case SS$_NOLOGNAM:
+    case SS$_NOLOGTAB:
+    case SS$_INVFILFOROP:
+    case SS$_INVARG:
+    case SS$_NOSUCHID:
+    case SS$_IVIDENT:
+	unix_status = EINVAL;
+	break;
+    case SS$_FILACCERR:
+    case SS$_NOGRPPRV:
+    case SS$_NOSYSPRV:
+	unix_status = EACCES;
+	break;
+    case SS$_DEVICEFULL:
+	unix_status = ENOSPC;
+	break;
+    case SS$_NOSUCHDEV:
+	unix_status = ENODEV;
+	break;
+    case SS$_NOSUCHFILE:
+    case SS$_NOSUCHOBJECT:
+	unix_status = ENOENT;
+	break;
+    case SS$_ABORT:
+	unix_status = EINTR;
+	break;
+    case SS$_BUFFEROVF:
+	unix_status = E2BIG;
+	break;
+    case SS$_INSFMEM:
+	unix_status = ENOMEM;
+	break;
+    case SS$_NOPRIV:
+	unix_status = EPERM;
+	break;
+    case SS$_NOSUCHNODE:
+    case SS$_UNREACHABLE:
+	unix_status = ESRCH;
+	break;
+    case SS$_NONEXPR:
+	unix_status = ECHILD;
+	break;
+    default:
+	if ((facility == 0) && (msg_no < 8)) {
+	  /* These are not real VMS status codes so assume that they are
+          ** already UNIX status codes
+	  */
+	  unix_status = msg_no;
+	  break;
+	}
+    }
+  }
+  else {
+    /* Translate a POSIX exit code to a UNIX exit code */
+    if ((facility == C_FACILITY_NO) && ((msg_no & 0xA000) == 0xA000))  {
+	unix_status = (msg_no & 0x0FF0) >> 3;
+    }
+    else {
+	switch(msg_status) {
+	/* case RMS$_EOF: */ /* End of File */
+	case RMS$_FNF:	/* File Not Found */
+	case RMS$_DNF:	/* Dir Not Found */
+		unix_status = ENOENT;
+		break;
+	case RMS$_RNF:	/* Record Not Found */
+		unix_status = ESRCH;
+		break;
+	case RMS$_DIR:
+		unix_status = ENOTDIR;
+		break;
+	case RMS$_DEV:
+		unix_status = ENODEV;
+		break;
+	case RMS$_SYN:
+	case RMS$_FNM:
+	case LIB$_INVSTRDES:
+	case LIB$_INVARG:
+	case LIB$_NOSUCHSYM:
+	case LIB$_INVSYMNAM:
+	case DCL_IVVERB:
+		unix_status = EINVAL;
+		break;
+	case CLI$_BUFOVF:
+	case RMS$_RTB:
+	case CLI$_TKNOVF:
+	case CLI$_RSLOVF:
+		unix_status = E2BIG;
+		break;
+	case RMS$_PRV:	/* No privilege */
+	case RMS$_ACC:	/* ACP file access failed */
+	case RMS$_WLK:	/* Device write locked */
+		unix_status = EACCES;
+		break;
+	/* case RMS$_NMF: */  /* No more files */
+	}
+    }
+  }
+
+  return unix_status;
+} 
+
+
+
 /* default piping mailbox size */
 #define PERL_BUFSIZ        512
 
@@ -1228,7 +1671,8 @@ create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
   static unsigned long int syssize = 0;
   unsigned long int dviitm = DVI$_DEVNAM;
   char csize[LNM$C_NAMLENGTH+1];
-  
+  int sts;
+
   if (!syssize) {
     unsigned long syiitm = SYI$_MAXBUF;
     /*
@@ -1250,9 +1694,9 @@ create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
   if (mbxbufsiz < 128) mbxbufsiz = 128;
   if (mbxbufsiz > syssize) mbxbufsiz = syssize;
 
-  _ckvmssts(sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
+  _ckvmssts(sts = sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
 
-  _ckvmssts(lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length));
+  _ckvmssts(sts = lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length));
   namdsc->dsc$a_pointer[namdsc->dsc$w_length] = '\0';
 
 }  /* end of create_mbx() */
@@ -1493,6 +1937,7 @@ popen_completion_ast(pInfo info)
 {
   pInfo i = open_pipes;
   int iss;
+  int sts;
   pXpipe x;
 
   info->completion &= 0x0FFFFFFF; /* strip off "control" field */
@@ -1553,7 +1998,7 @@ popen_completion_ast(pInfo info)
 
 }
 
-static unsigned long int setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote, struct dsc$descriptor_s **pvmscmd);
+static unsigned long int setup_cmddsc(pTHX_ const char *cmd, int check_img, int *suggest_quote, struct dsc$descriptor_s **pvmscmd);
 static void vms_execfree(struct dsc$descriptor_s *vmscmd);
 
 /*
@@ -1634,7 +2079,7 @@ pipe_tochild_setup(pTHX_ char *rmbx, char *wmbx)
     unsigned int dviitm = DVI$_DEVBUFSIZ;
     int j, n;
 
-    New(1368, p, 1, Pipe);
+    Newx(p, 1, Pipe);
 
     create_mbx(aTHX_ &p->chan_in , &d_mbx1);
     create_mbx(aTHX_ &p->chan_out, &d_mbx2);
@@ -1679,6 +2124,7 @@ pipe_tochild1_ast(pPipe p)
     pCBuf b = p->curr;
     int iss = p->iosb.status;
     int eof = (iss == SS$_ENDOFFILE);
+    int sts;
 #ifdef PERL_IMPLICIT_CONTEXT
     pTHX = p->thx;
 #endif
@@ -1694,7 +2140,7 @@ pipe_tochild1_ast(pPipe p)
 
         b->eof  = eof;
         b->size = p->iosb.count;
-        _ckvmssts(lib$insqhi(b, &p->wait));
+        _ckvmssts(sts = lib$insqhi(b, &p->wait));
         if (p->need_wake) {
             p->need_wake = FALSE;
             _ckvmssts(sys$dclast(pipe_tochild2_ast,p,0));
@@ -1803,12 +2249,12 @@ pipe_infromchild_setup(pTHX_ char *rmbx, char *wmbx)
                                       DSC$K_CLASS_S, mbx2};
     unsigned int dviitm = DVI$_DEVBUFSIZ;
 
-    New(1367, p, 1, Pipe);
+    Newx(p, 1, Pipe);
     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));
-    New(1367, p->buf, p->bufsize, char);
+    Newx(p->buf, p->bufsize, char);
     p->shut_on_empty = FALSE;
     p->info   = 0;
     p->type   = 0;
@@ -1926,11 +2372,11 @@ pipe_mbxtofd_setup(pTHX_ int fd, char *out)
         }
     }
 
-    New(1366, p, 1, Pipe);
+    Newx(p, 1, Pipe);
     p->fd_out = dup(fd);
     create_mbx(aTHX_ &p->chan_in, &d_mbx);
     _ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
-    New(1366, p->buf, p->bufsize+1, char);
+    Newx(p->buf, p->bufsize+1, char);
     p->shut_on_empty = FALSE;
     p->retry = 0;
     p->info  = 0;
@@ -2030,7 +2476,7 @@ store_pipelocs(pTHX)
 
 /*  the . directory from @INC comes last */
 
-    New(1370,p,1,PLOC);
+    Newx(p,1,PLOC);
     p->next = head_PLOC;
     head_PLOC = p;
     strcpy(p->dir,"./");
@@ -2047,7 +2493,7 @@ store_pipelocs(pTHX)
         if (x) x[1] = '\0';
 
         if ((unixdir = tounixpath(temp, Nullch)) != Nullch) {
-            New(1370,p,1,PLOC);
+            Newx(p,1,PLOC);
             p->next = head_PLOC;
             head_PLOC = p;
             strncpy(p->dir,unixdir,sizeof(p->dir)-1);
@@ -2071,7 +2517,7 @@ store_pipelocs(pTHX)
         if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
             continue;
 
-        New(1370,p,1,PLOC);
+        Newx(p,1,PLOC);
         p->next = head_PLOC;
         head_PLOC = p;
         strncpy(p->dir,unixdir,sizeof(p->dir)-1);
@@ -2082,7 +2528,7 @@ store_pipelocs(pTHX)
 
 #ifdef ARCHLIB_EXP
     if ((unixdir = tounixpath(ARCHLIB_EXP, Nullch)) != Nullch) {
-        New(1370,p,1,PLOC);
+        Newx(p,1,PLOC);
         p->next = head_PLOC;
         head_PLOC = p;
         strncpy(p->dir,unixdir,sizeof(p->dir)-1);
@@ -2167,7 +2613,7 @@ vmspipe_tempfile(pTHX)
     }
     if (!fp) return 0;  /* we're hosed */
 
-    fprintf(fp,"$! 'f$verify(0)\n");
+    fprintf(fp,"$! 'f$verify(0)'\n");
     fprintf(fp,"$!  ---  protect against nonstandard definitions ---\n");
     fprintf(fp,"$ perl_cfile  = f$environment(\"procedure\")\n");
     fprintf(fp,"$ perl_define = \"define/nolog\"\n");
@@ -2185,16 +2631,8 @@ vmspipe_tempfile(pTHX)
     fprintf(fp,"$c=c+perl_popen_cmd2\n"); 
     fprintf(fp,"$x=perl_popen_cmd3\n"); 
     fprintf(fp,"$c=c+x\n"); 
-    fprintf(fp,"$!  --- get rid of global symbols\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_in\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_err\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_out\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd0\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd1\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd2\n");
-    fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd3\n");
     fprintf(fp,"$ perl_on\n");
-    fprintf(fp,"$ 'c\n");
+    fprintf(fp,"$ 'c'\n");
     fprintf(fp,"$ perl_status = $STATUS\n");
     fprintf(fp,"$ perl_del  'perl_cfile'\n");
     fprintf(fp,"$ perl_exit 'perl_status'\n");
@@ -2222,11 +2660,15 @@ vmspipe_tempfile(pTHX)
 
 
 static PerlIO *
-safe_popen(pTHX_ char *cmd, char *in_mode, int *psts)
+safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
 {
     static int handler_set_up = FALSE;
     unsigned long int sts, flags = CLI$M_NOWAIT;
-    unsigned int table = LIB$K_CLI_GLOBAL_SYM;
+    /* The use of a GLOBAL table (as was done previously) rendered
+     * Perl's qx() or `` unusable from a C<$ SET SYMBOL/SCOPE=NOGLOBAL> DCL
+     * environment.  Hence we've switched to LOCAL symbol table.
+     */
+    unsigned int table = LIB$K_CLI_LOCAL_SYM;
     int j, wait = 0;
     char *p, mode[10], symbol[MAX_DCL_SYMBOL+1], *vmspipe;
     char in[512], out[512], err[512], mbx[512];
@@ -2319,7 +2761,7 @@ safe_popen(pTHX_ char *cmd, char *in_mode, int *psts)
       *psts = sts;
       return Nullfp; 
     }
-    New(1301,info,1,Info);
+    Newx(info,1,Info);
         
     strcpy(mode,in_mode);
     info->mode = *mode;
@@ -2536,7 +2978,9 @@ safe_popen(pTHX_ char *cmd, char *in_mode, int *psts)
              if (!done) _ckvmssts(sys$waitfr(pipe_ef));
          }
         *psts = info->completion;
-        my_pclose(info->fp);
+/* Caller thinks it is open and tries to close it. */
+/* This causes some problems, as it changes the error status */
+/*        my_pclose(info->fp); */
     } else { 
         *psts = SS$_NORMAL;
     }
@@ -2546,7 +2990,7 @@ safe_popen(pTHX_ char *cmd, char *in_mode, int *psts)
 
 /*{{{  PerlIO *my_popen(char *cmd, char *mode)*/
 PerlIO *
-Perl_my_popen(pTHX_ char *cmd, char *mode)
+Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 {
     int sts;
     TAINT_ENV();
@@ -2650,7 +3094,7 @@ I32 Perl_my_pclose(pTHX_ PerlIO *fp)
 
 }  /* end of my_pclose() */
 
-#if defined(__CRTL_VER) && __CRTL_VER >= 70100322
+#if defined(__CRTL_VER) && __CRTL_VER >= 70200000
   /* Roll our own prototype because we want this regardless of whether
    * _VMS_WAIT is defined.
    */
@@ -2699,7 +3143,7 @@ Perl_my_waitpid(pTHX_ Pid_t pid, int *statusp, int flags)
 
     /* fall through if this child is not one of our own pipe children */
 
-#if defined(__CRTL_VER) && __CRTL_VER >= 70100322
+#if defined(__CRTL_VER) && __CRTL_VER >= 70200000
 
       /* waitpid() became available in the CRTL as of VMS 7.0, but only
        * in 7.2 did we get a version that fills in the VMS completion
@@ -2718,7 +3162,7 @@ Perl_my_waitpid(pTHX_ Pid_t pid, int *statusp, int flags)
        * of the current process.
        */
 
-#endif /* defined(__CRTL_VER) && __CRTL_VER >= 70100322 */
+#endif /* defined(__CRTL_VER) && __CRTL_VER >= 70200000 */
 
     {
       $DESCRIPTOR(intdsc,"0 00:00:01");
@@ -2828,10 +3272,10 @@ my_gconvert(double val, int ndig, int trail, char *buf)
  * rmesexpand() returns the address of the resultant string if
  * successful, and NULL on error.
  */
-static char *mp_do_tounixspec(pTHX_ char *, char *, int);
+static char *mp_do_tounixspec(pTHX_ const char *, char *, int);
 
 static char *
-mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsigned opts)
+mp_do_rmsexpand(pTHX_ const char *filespec, char *outbuf, int ts, const char *defspec, unsigned opts)
 {
   static char __rmsexpand_retbuf[NAM$C_MAXRSS+1];
   char vmsfspec[NAM$C_MAXRSS+1], tmpfspec[NAM$C_MAXRSS+1];
@@ -2840,13 +3284,14 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
   struct NAM mynam = cc$rms_nam;
   STRLEN speclen;
   unsigned long int retsts, trimver, trimtype, haslower = 0, isunix = 0;
+  int sts;
 
   if (!filespec || !*filespec) {
     set_vaxc_errno(LIB$_INVARG); set_errno(EINVAL);
     return NULL;
   }
   if (!outbuf) {
-    if (ts) out = New(1319,outbuf,NAM$C_MAXRSS+1,char);
+    if (ts) out = Newx(outbuf,NAM$C_MAXRSS+1,char);
     else    outbuf = __rmsexpand_retbuf;
   }
   if ((isunix = (strchr(filespec,'/') != NULL))) {
@@ -2854,7 +3299,7 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
     filespec = vmsfspec;
   }
 
-  myfab.fab$l_fna = filespec;
+  myfab.fab$l_fna = (char *)filespec;  /* cast ok for read only pointer */
   myfab.fab$b_fns = strlen(filespec);
   myfab.fab$l_nam = &mynam;
 
@@ -2863,7 +3308,7 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
       if (do_tovmsspec(defspec,tmpfspec,0) == NULL) return NULL;
       defspec = tmpfspec;
     }
-    myfab.fab$l_dna = defspec;
+    myfab.fab$l_dna = (char *)defspec; /* cast ok for read only pointer */
     myfab.fab$b_dns = strlen(defspec);
   }
 
@@ -2875,12 +3320,16 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
   retsts = sys$parse(&myfab,0,0);
   if (!(retsts & 1)) {
     mynam.nam$b_nop |= NAM$M_SYNCHK;
+#ifdef NAM$M_NO_SHORT_UPCASE
+    if (decc_efs_case_preserve)
+      mynam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
+#endif
     if (retsts == RMS$_DNF || retsts == RMS$_DIR || retsts == RMS$_DEV) {
       retsts = sys$parse(&myfab,0,0);
       if (retsts & 1) goto expanded;
     }  
     mynam.nam$l_rlf = NULL; myfab.fab$b_dns = 0;
-    (void) sys$parse(&myfab,0,0);  /* Free search context */
+    sts = sys$parse(&myfab,0,0);  /* Free search context */
     if (out) Safefree(out);
     set_vaxc_errno(retsts);
     if      (retsts == RMS$_PRV) set_errno(EACCES);
@@ -2892,7 +3341,11 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
   retsts = sys$search(&myfab,0,0);
   if (!(retsts & 1) && retsts != RMS$_FNF) {
     mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
-    myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0);  /* Free search context */
+#ifdef NAM$M_NO_SHORT_UPCASE
+    if (decc_efs_case_preserve)
+      mynam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
+#endif
+    myfab.fab$b_dns = 0; sts = sys$parse(&myfab,0,0);  /* Free search context */
     if (out) Safefree(out);
     set_vaxc_errno(retsts);
     if      (retsts == RMS$_PRV) set_errno(EACCES);
@@ -2903,8 +3356,10 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
   /* If the input filespec contained any lowercase characters,
    * downcase the result for compatibility with Unix-minded code. */
   expanded:
-  for (out = myfab.fab$l_fna; *out; out++)
-    if (islower(*out)) { haslower = 1; break; }
+  if (!decc_efs_case_preserve) {
+    for (out = myfab.fab$l_fna; *out; out++)
+      if (islower(*out)) { haslower = 1; break; }
+  }
   if (mynam.nam$b_rsl) { out = outbuf; speclen = mynam.nam$b_rsl; }
   else                 { out = esa;    speclen = mynam.nam$b_esl; }
   /* Trim off null fields added by $PARSE
@@ -2921,9 +3376,14 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
       struct NAM defnam = cc$rms_nam;
      
       deffab.fab$l_nam = &defnam;
-      deffab.fab$l_fna = defspec;  deffab.fab$b_fns = myfab.fab$b_dns;
+      /* cast below ok for read only pointer */
+      deffab.fab$l_fna = (char *)defspec;  deffab.fab$b_fns = myfab.fab$b_dns;
       defnam.nam$l_esa = defesa;   defnam.nam$b_ess = sizeof defesa;
       defnam.nam$b_nop = NAM$M_SYNCHK;
+#ifdef NAM$M_NO_SHORT_UPCASE
+      if (decc_efs_case_preserve)
+	defnam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
+#endif
       if (sys$parse(&deffab,0,0) & 1) {
         if (trimver)  trimver  = !(defnam.nam$l_fnb & NAM$M_EXP_VER);
         if (trimtype) trimtype = !(defnam.nam$l_fnb & NAM$M_EXP_TYPE); 
@@ -2945,7 +3405,7 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
       !(mynam.nam$l_fnb & NAM$M_EXP_NAME))
     speclen = mynam.nam$l_name - out;
   out[speclen] = '\0';
-  if (haslower) __mystrtolower(out);
+  if (haslower && !decc_efs_case_preserve) __mystrtolower(out);
 
   /* Have we been working with an expanded, but not resultant, spec? */
   /* Also, convert back to Unix syntax if necessary. */
@@ -2960,15 +3420,19 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
     strcpy(outbuf,tmpfspec);
   }
   mynam.nam$b_nop |= NAM$M_SYNCHK; mynam.nam$l_rlf = NULL;
+#ifdef NAM$M_NO_SHORT_UPCASE
+  if (decc_efs_case_preserve)
+    mynam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
+#endif
   mynam.nam$l_rsa = NULL; mynam.nam$b_rss = 0;
-  myfab.fab$b_dns = 0; (void) sys$parse(&myfab,0,0);  /* Free search context */
+  myfab.fab$b_dns = 0; sts = sys$parse(&myfab,0,0);  /* Free search context */
   return outbuf;
 }
 /*}}}*/
 /* External entry points */
-char *Perl_rmsexpand(pTHX_ char *spec, char *buf, char *def, unsigned opt)
+char *Perl_rmsexpand(pTHX_ const char *spec, char *buf, const char *def, unsigned opt)
 { return do_rmsexpand(spec,buf,0,def,opt); }
-char *Perl_rmsexpand_ts(pTHX_ char *spec, char *buf, char *def, unsigned opt)
+char *Perl_rmsexpand_ts(pTHX_ const char *spec, char *buf, const char *def, unsigned opt)
 { return do_rmsexpand(spec,buf,1,def,opt); }
 
 
@@ -3007,13 +3471,14 @@ char *Perl_rmsexpand_ts(pTHX_ char *spec, char *buf, char *def, unsigned opt)
  */
 
 /*{{{ char *fileify_dirspec[_ts](char *path, char *buf)*/
-static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
+static char *mp_do_fileify_dirspec(pTHX_ const char *dir,char *buf,int ts)
 {
     static char __fileify_retbuf[NAM$C_MAXRSS+1];
     unsigned long int dirlen, retlen, addmfd = 0, hasfilename = 0;
     char *retspec, *cp1, *cp2, *lastdir;
     char trndir[NAM$C_MAXRSS+2], vmsdir[NAM$C_MAXRSS+1];
     unsigned short int trnlnm_iter_count;
+    int sts;
 
     if (!dir || !*dir) {
       set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
@@ -3021,80 +3486,90 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
     dirlen = strlen(dir);
     while (dirlen && dir[dirlen-1] == '/') --dirlen;
     if (!dirlen) { /* We had Unixish '/' -- substitute top of current tree */
-      strcpy(trndir,"/sys$disk/000000");
-      dir = trndir;
-      dirlen = 16;
+      if (!decc_posix_compliant_pathnames && decc_disable_posix_root) {
+        dir = "/sys$disk";
+        dirlen = 9;
+      }
+      else
+	dirlen = 1;
     }
     if (dirlen > NAM$C_MAXRSS) {
       set_errno(ENAMETOOLONG); set_vaxc_errno(RMS$_SYN); return NULL;
     }
-    if (!strpbrk(dir+1,"/]>:")) {
+    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)) {
         trnlnm_iter_count++; 
         if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
       }
-      dir = trndir;
-      dirlen = strlen(dir);
+      dirlen = strlen(trndir);
     }
     else {
       strncpy(trndir,dir,dirlen);
       trndir[dirlen] = '\0';
-      dir = trndir;
     }
+
+    /* At this point we are done with *dir and use *trndir which is a
+     * copy that can be modified.  *dir must not be modified.
+     */
+
     /* If we were handed a rooted logical name or spec, treat it like a
      * simple directory, so that
      *    $ Define myroot dev:[dir.]
      *    ... do_fileify_dirspec("myroot",buf,1) ...
      * does something useful.
      */
-    if (dirlen >= 2 && !strcmp(dir+dirlen-2,".]")) {
-      dir[--dirlen] = '\0';
-      dir[dirlen-1] = ']';
+    if (dirlen >= 2 && !strcmp(trndir+dirlen-2,".]")) {
+      trndir[--dirlen] = '\0';
+      trndir[dirlen-1] = ']';
     }
-    if (dirlen >= 2 && !strcmp(dir+dirlen-2,".>")) {
-      dir[--dirlen] = '\0';
-      dir[dirlen-1] = '>';
+    if (dirlen >= 2 && !strcmp(trndir+dirlen-2,".>")) {
+      trndir[--dirlen] = '\0';
+      trndir[dirlen-1] = '>';
     }
 
-    if ((cp1 = strrchr(dir,']')) != NULL || (cp1 = strrchr(dir,'>')) != NULL) {
+    if ((cp1 = strrchr(trndir,']')) != NULL || (cp1 = strrchr(trndir,'>')) != NULL) {
       /* If we've got an explicit filename, we can just shuffle the string. */
       if (*(cp1+1)) hasfilename = 1;
       /* Similarly, we can just back up a level if we've got multiple levels
          of explicit directories in a VMS spec which ends with directories. */
       else {
-        for (cp2 = cp1; cp2 > dir; cp2--) {
-          if (*cp2 == '.') {
-            *cp2 = *cp1; *cp1 = '\0';
-            hasfilename = 1;
-            break;
+        for (cp2 = cp1; cp2 > trndir; cp2--) {
+	  if (*cp2 == '.') {
+	    if ((cp2 - 1 > trndir) && (*(cp2 - 1) != '^')) {
+              *cp2 = *cp1; *cp1 = '\0';
+              hasfilename = 1;
+	      break;
+	    }
           }
           if (*cp2 == '[' || *cp2 == '<') break;
         }
       }
     }
 
-    if (hasfilename || !strpbrk(dir,"]:>")) { /* Unix-style path or filename */
-      if (dir[0] == '.') {
-        if (dir[1] == '\0' || (dir[1] == '/' && dir[2] == '\0'))
+    cp1 = strpbrk(trndir,"]:>"); /* Prepare for future change */
+    if (hasfilename || !cp1) { /* Unix-style path or filename */
+      if (trndir[0] == '.') {
+        if (trndir[1] == '\0' || (trndir[1] == '/' && trndir[2] == '\0'))
           return do_fileify_dirspec("[]",buf,ts);
-        else if (dir[1] == '.' &&
-                 (dir[2] == '\0' || (dir[2] == '/' && dir[3] == '\0')))
+        else if (trndir[1] == '.' &&
+                 (trndir[2] == '\0' || (trndir[2] == '/' && trndir[3] == '\0')))
           return do_fileify_dirspec("[-]",buf,ts);
       }
-      if (dirlen && dir[dirlen-1] == '/') {    /* path ends with '/'; just add .dir;1 */
+      if (dirlen && trndir[dirlen-1] == '/') {    /* path ends with '/'; just add .dir;1 */
         dirlen -= 1;                 /* to last element */
-        lastdir = strrchr(dir,'/');
+        lastdir = strrchr(trndir,'/');
       }
-      else if ((cp1 = strstr(dir,"/.")) != NULL) {
+      else if ((cp1 = strstr(trndir,"/.")) != NULL) {
         /* If we have "/." or "/..", VMSify it and let the VMS code
          * below expand it, rather than repeating the code to handle
          * relative components of a filespec here */
         do {
           if (*(cp1+2) == '.') cp1++;
           if (*(cp1+2) == '/' || *(cp1+2) == '\0') {
-            if (do_tovmsspec(dir,vmsdir,0) == NULL) return NULL;
+            if (do_tovmsspec(trndir,vmsdir,0) == NULL) return NULL;
             if (strchr(vmsdir,'/') != NULL) {
               /* If do_tovmsspec() returned it, it must have VMS syntax
                * delimiters in it, so it's a mixed VMS/Unix spec.  We take
@@ -3108,63 +3583,76 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
           }
           cp1++;
         } while ((cp1 = strstr(cp1,"/.")) != NULL);
-        lastdir = strrchr(dir,'/');
+        lastdir = strrchr(trndir,'/');
       }
-      else if (dirlen >= 7 && !strcmp(&dir[dirlen-7],"/000000")) {
+      else if (dirlen >= 7 && !strcmp(&trndir[dirlen-7],"/000000")) {
         /* Ditto for specs that end in an MFD -- let the VMS code
          * figure out whether it's a real device or a rooted logical. */
-        dir[dirlen] = '/'; dir[dirlen+1] = '\0';
-        if (do_tovmsspec(dir,vmsdir,0) == NULL) return NULL;
+
+        /* This should not happen any more.  Allowing the fake /000000
+         * in a UNIX pathname causes all sorts of problems when trying
+         * to run in UNIX emulation.  So the VMS to UNIX conversions
+         * now remove the fake /000000 directories.
+         */
+
+        trndir[dirlen] = '/'; trndir[dirlen+1] = '\0';
+        if (do_tovmsspec(trndir,vmsdir,0) == NULL) return NULL;
         if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) return NULL;
         return do_tounixspec(trndir,buf,ts);
       }
       else {
-        if ( !(lastdir = cp1 = strrchr(dir,'/')) &&
-             !(lastdir = cp1 = strrchr(dir,']')) &&
-             !(lastdir = cp1 = strrchr(dir,'>'))) cp1 = dir;
+
+        if ( !(lastdir = cp1 = strrchr(trndir,'/')) &&
+             !(lastdir = cp1 = strrchr(trndir,']')) &&
+             !(lastdir = cp1 = strrchr(trndir,'>'))) cp1 = trndir;
         if ((cp2 = strchr(cp1,'.'))) {  /* look for explicit type */
           int ver; char *cp3;
-          if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
-              !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
-              !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
-              (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-              (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
+
+	  /* For EFS or ODS-5 look for the last dot */
+	  if (decc_efs_charset) {
+	      cp2 = strrchr(cp1,'.');
+	  }
+	  if (vms_process_case_tolerant) {
+              if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
+                  !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
+                  !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
+                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
+                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
                             (ver || *cp3)))))) {
-            set_errno(ENOTDIR);
-            set_vaxc_errno(RMS$_DIR);
-            return NULL;
-          }
-          dirlen = cp2 - dir;
-        }
-      }
-      /* If we lead off with a device or rooted logical, add the MFD
-         if we're specifying a top-level directory. */
-      if (lastdir && *dir == '/') {
-        addmfd = 1;
-        for (cp1 = lastdir - 1; cp1 > dir; cp1--) {
-          if (*cp1 == '/') {
-            addmfd = 0;
-            break;
+                  set_errno(ENOTDIR);
+                  set_vaxc_errno(RMS$_DIR);
+                  return NULL;
+	      }
+	  }
+	  else {
+              if (!*(cp2+1) || *(cp2+1) != 'D' ||  /* Wrong type. */
+                  !*(cp2+2) || *(cp2+2) != 'I' ||  /* Bzzt. */
+                  !*(cp2+3) || *(cp2+3) != 'R' ||
+                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
+                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
+                            (ver || *cp3)))))) {
+                 set_errno(ENOTDIR);
+                 set_vaxc_errno(RMS$_DIR);
+                 return NULL;
+	      }
           }
+          dirlen = cp2 - trndir;
         }
       }
-      retlen = dirlen + (addmfd ? 13 : 6);
+
+      retlen = dirlen + 6;
       if (buf) retspec = buf;
-      else if (ts) New(1309,retspec,retlen+1,char);
+      else if (ts) Newx(retspec,retlen+1,char);
       else retspec = __fileify_retbuf;
-      if (addmfd) {
-        dirlen = lastdir - dir;
-        memcpy(retspec,dir,dirlen);
-        strcpy(&retspec[dirlen],"/000000");
-        strcpy(&retspec[dirlen+7],lastdir);
-      }
-      else {
-        memcpy(retspec,dir,dirlen);
-        retspec[dirlen] = '\0';
-      }
+      memcpy(retspec,trndir,dirlen);
+      retspec[dirlen] = '\0';
+
       /* We've picked up everything up to the directory file name.
          Now just add the type and version, and we're set. */
-      strcat(retspec,".dir;1");
+      if ((!decc_efs_case_preserve) && vms_process_case_tolerant)
+	strcat(retspec,".dir;1");
+      else
+	strcat(retspec,".DIR;1");
       return retspec;
     }
     else {  /* VMS-style directory spec */
@@ -3173,18 +3661,22 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
       struct FAB dirfab = cc$rms_fab;
       struct NAM savnam, dirnam = cc$rms_nam;
 
-      dirfab.fab$b_fns = strlen(dir);
-      dirfab.fab$l_fna = dir;
+      dirfab.fab$b_fns = strlen(trndir);
+      dirfab.fab$l_fna = trndir;
       dirfab.fab$l_nam = &dirnam;
       dirfab.fab$l_dna = ".DIR;1";
       dirfab.fab$b_dns = 6;
       dirnam.nam$b_ess = NAM$C_MAXRSS;
       dirnam.nam$l_esa = esa;
+#ifdef NAM$M_NO_SHORT_UPCASE
+      if (decc_efs_case_preserve)
+	dirnam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
+#endif
 
-      for (cp = dir; *cp; cp++)
+      for (cp = trndir; *cp; cp++)
         if (islower(*cp)) { haslower = 1; break; }
       if (!((sts = sys$parse(&dirfab))&1)) {
-        if (dirfab.fab$l_sts == RMS$_DIR) {
+        if ((dirfab.fab$l_sts == RMS$_DIR) || (dirfab.fab$l_sts == RMS$_DNF)) {
           dirnam.nam$b_nop |= NAM$M_SYNCHK;
           sts = sys$parse(&dirfab) & 1;
         }
@@ -3205,7 +3697,7 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
           else { 
             set_errno(EVMSERR);  set_vaxc_errno(dirfab.fab$l_sts);
             dirnam.nam$b_nop |= NAM$M_SYNCHK;  dirnam.nam$l_rlf = NULL;
-            dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+            dirfab.fab$b_dns = 0;  sts = sys$parse(&dirfab,0,0);
             return NULL;
           }
         }
@@ -3224,7 +3716,7 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
         if (strncmp(dirnam.nam$l_type,".DIR;1",cmplen)) { 
           /* Something other than .DIR[;1].  Bzzt. */
           dirnam.nam$b_nop |= NAM$M_SYNCHK;  dirnam.nam$l_rlf = NULL;
-          dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+          dirfab.fab$b_dns = 0;  sts = sys$parse(&dirfab,0,0);
           set_errno(ENOTDIR);
           set_vaxc_errno(RMS$_DIR);
           return NULL;
@@ -3234,11 +3726,11 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
       if (dirnam.nam$l_fnb & 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) New(1311,retspec,dirnam.nam$b_esl+1,char);
+        else if (ts) Newx(retspec,dirnam.nam$b_esl+1,char);
         else retspec = __fileify_retbuf;
         strcpy(retspec,esa);
         dirnam.nam$b_nop |= NAM$M_SYNCHK;  dirnam.nam$l_rlf = NULL;
-        dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+        dirfab.fab$b_dns = 0;  sts = sys$parse(&dirfab,0,0);
         return retspec;
       }
       if ((cp1 = strstr(esa,".][000000]")) != NULL) {
@@ -3249,17 +3741,31 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
       if ((cp1 = strrchr(esa,']')) == NULL) cp1 = strrchr(esa,'>');
       if (cp1 == NULL) { /* should never happen */
         dirnam.nam$b_nop |= NAM$M_SYNCHK;  dirnam.nam$l_rlf = NULL;
-        dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+        dirfab.fab$b_dns = 0;  sts = sys$parse(&dirfab,0,0);
         return NULL;
       }
       term = *cp1;
       *cp1 = '\0';
       retlen = strlen(esa);
-      if ((cp1 = strrchr(esa,'.')) != NULL) {
+      cp1 = strrchr(esa,'.');
+      /* ODS-5 directory specifications can have extra "." in them. */
+      while (cp1 != NULL) {
+        if ((cp1-1 == esa) || (*(cp1-1) != '^'))
+	  break;
+	else {
+	   cp1--;
+	   while ((cp1 > esa) && (*cp1 != '.'))
+	     cp1--;
+	}
+	if (cp1 == esa)
+	  cp1 = NULL;
+      }
+
+      if ((cp1) != NULL) {
         /* There's more than one directory in the path.  Just roll back. */
         *cp1 = term;
         if (buf) retspec = buf;
-        else if (ts) New(1311,retspec,retlen+7,char);
+        else if (ts) Newx(retspec,retlen+7,char);
         else retspec = __fileify_retbuf;
         strcpy(retspec,esa);
       }
@@ -3267,16 +3773,20 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
         if (dirnam.nam$l_fnb & NAM$M_ROOT_DIR) {
           /* Go back and expand rooted logical name */
           dirnam.nam$b_nop = NAM$M_SYNCHK | NAM$M_NOCONCEAL;
+#ifdef NAM$M_NO_SHORT_UPCASE
+	  if (decc_efs_case_preserve)
+	    dirnam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
+#endif
           if (!(sys$parse(&dirfab) & 1)) {
             dirnam.nam$l_rlf = NULL;
-            dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+            dirfab.fab$b_dns = 0;  sts = sys$parse(&dirfab,0,0);
             set_errno(EVMSERR);
             set_vaxc_errno(dirfab.fab$l_sts);
             return NULL;
           }
           retlen = dirnam.nam$b_esl - 9; /* esa - '][' - '].DIR;1' */
           if (buf) retspec = buf;
-          else if (ts) New(1312,retspec,retlen+16,char);
+          else if (ts) Newx(retspec,retlen+16,char);
           else retspec = __fileify_retbuf;
           cp1 = strstr(esa,"][");
           if (!cp1) cp1 = strstr(esa,"]<");
@@ -3284,7 +3794,18 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
           memcpy(retspec,esa,dirlen);
           if (!strncmp(cp1+2,"000000]",7)) {
             retspec[dirlen-1] = '\0';
-            for (cp1 = retspec+dirlen-1; *cp1 != '.' && *cp1 != '['; cp1--) ;
+	    /* Not full ODS-5, just extra dots in directories for now */
+	    cp1 = retspec + dirlen - 1;
+	    while (cp1 > retspec)
+	    {
+	      if (*cp1 == '[')
+		break;
+	      if (*cp1 == '.') {
+		if (*(cp1-1) != '^')
+		  break;
+	      }
+	      cp1--;
+	    }
             if (*cp1 == '.') *cp1 = ']';
             else {
               memmove(cp1+8,cp1+1,retspec+dirlen-cp1);
@@ -3295,7 +3816,15 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
             memcpy(retspec+dirlen,cp1+2,retlen-dirlen);
             retspec[retlen] = '\0';
             /* Convert last '.' to ']' */
-            for (cp1 = retspec+retlen-1; *cp1 != '.' && *cp1 != '['; cp1--) ;
+            cp1 = retspec+retlen-1;
+	    while (*cp != '[') {
+	      cp1--;
+	      if (*cp1 == '.') {
+		/* Do not trip on extra dots in ODS-5 directories */
+		if ((cp1 == retspec) || (*(cp1-1) != '^'))
+		break;
+	      }
+	    }
             if (*cp1 == '.') *cp1 = ']';
             else {
               memmove(cp1+8,cp1+1,retspec+dirlen-cp1);
@@ -3305,7 +3834,7 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
         }
         else {  /* This is a top-level dir.  Add the MFD to the path. */
           if (buf) retspec = buf;
-          else if (ts) New(1312,retspec,retlen+16,char);
+          else if (ts) Newx(retspec,retlen+16,char);
           else retspec = __fileify_retbuf;
           cp1 = esa;
           cp2 = retspec;
@@ -3316,32 +3845,33 @@ static char *mp_do_fileify_dirspec(pTHX_ char *dir,char *buf,int ts)
         }
       }
       dirnam.nam$b_nop |= NAM$M_SYNCHK;  dirnam.nam$l_rlf = NULL;
-      dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+      dirfab.fab$b_dns = 0;  sts = sys$parse(&dirfab,0,0);
       /* We've set up the string up through the filename.  Add the
          type and version, and we're done. */
       strcat(retspec,".DIR;1");
 
       /* $PARSE may have upcased filespec, so convert output to lower
        * case if input contained any lowercase characters. */
-      if (haslower) __mystrtolower(retspec);
+      if (haslower && !decc_efs_case_preserve) __mystrtolower(retspec);
       return retspec;
     }
 }  /* end of do_fileify_dirspec() */
 /*}}}*/
 /* External entry points */
-char *Perl_fileify_dirspec(pTHX_ char *dir, char *buf)
+char *Perl_fileify_dirspec(pTHX_ const char *dir, char *buf)
 { return do_fileify_dirspec(dir,buf,0); }
-char *Perl_fileify_dirspec_ts(pTHX_ char *dir, char *buf)
+char *Perl_fileify_dirspec_ts(pTHX_ const char *dir, char *buf)
 { return do_fileify_dirspec(dir,buf,1); }
 
 /*{{{ char *pathify_dirspec[_ts](char *path, char *buf)*/
-static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
+static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts)
 {
     static char __pathify_retbuf[NAM$C_MAXRSS+1];
     unsigned long int retlen;
     char *retpath, *cp1, *cp2, trndir[NAM$C_MAXRSS+1];
     unsigned short int trnlnm_iter_count;
     STRLEN trnlen;
+    int sts;
 
     if (!dir || !*dir) {
       set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
@@ -3360,49 +3890,71 @@ static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
       /* Trap simple rooted lnms, and return lnm:[000000] */
       if (!strcmp(trndir+trnlen-2,".]")) {
         if (buf) retpath = buf;
-        else if (ts) New(1318,retpath,strlen(dir)+10,char);
+        else if (ts) Newx(retpath,strlen(dir)+10,char);
         else retpath = __pathify_retbuf;
         strcpy(retpath,dir);
         strcat(retpath,":[000000]");
         return retpath;
       }
     }
-    dir = trndir;
 
-    if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain name */
-      if (*dir == '.' && (*(dir+1) == '\0' ||
-                          (*(dir+1) == '.' && *(dir+2) == '\0')))
-        retlen = 2 + (*(dir+1) != '\0');
+    /* At this point we do not work with *dir, but the copy in
+     * *trndir that is modifiable.
+     */
+
+    if (!strpbrk(trndir,"]:>")) { /* Unix-style path or plain name */
+      if (*trndir == '.' && (*(trndir+1) == '\0' ||
+                          (*(trndir+1) == '.' && *(trndir+2) == '\0')))
+        retlen = 2 + (*(trndir+1) != '\0');
       else {
-        if ( !(cp1 = strrchr(dir,'/')) &&
-             !(cp1 = strrchr(dir,']')) &&
-             !(cp1 = strrchr(dir,'>')) ) cp1 = dir;
+        if ( !(cp1 = strrchr(trndir,'/')) &&
+             !(cp1 = strrchr(trndir,']')) &&
+             !(cp1 = strrchr(trndir,'>')) ) cp1 = trndir;
         if ((cp2 = strchr(cp1,'.')) != NULL &&
             (*(cp2-1) != '/' ||                /* Trailing '.', '..', */
              !(*(cp2+1) == '\0' ||             /* or '...' are dirs.  */
               (*(cp2+1) == '.' && *(cp2+2) == '\0') ||
               (*(cp2+1) == '.' && *(cp2+2) == '.' && *(cp2+3) == '\0')))) {
           int ver; char *cp3;
-          if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
-              !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
-              !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
-              (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-              (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
+
+	  /* For EFS or ODS-5 look for the last dot */
+	  if (decc_efs_charset) {
+	    cp2 = strrchr(cp1,'.');
+	  }
+	  if (vms_process_case_tolerant) {
+              if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
+                  !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
+                  !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
+                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
+                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
                             (ver || *cp3)))))) {
-            set_errno(ENOTDIR);
-            set_vaxc_errno(RMS$_DIR);
-            return NULL;
-          }
-          retlen = cp2 - dir + 1;
+                set_errno(ENOTDIR);
+                set_vaxc_errno(RMS$_DIR);
+                return NULL;
+              }
+	  }
+	  else {
+              if (!*(cp2+1) || *(cp2+1) != 'D' ||  /* Wrong type. */
+                  !*(cp2+2) || *(cp2+2) != 'I' ||  /* Bzzt. */
+                  !*(cp2+3) || *(cp2+3) != 'R' ||
+                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
+                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
+                            (ver || *cp3)))))) {
+                set_errno(ENOTDIR);
+                set_vaxc_errno(RMS$_DIR);
+                return NULL;
+              }
+	  }
+          retlen = cp2 - trndir + 1;
         }
         else {  /* No file type present.  Treat the filename as a directory. */
-          retlen = strlen(dir) + 1;
+          retlen = strlen(trndir) + 1;
         }
       }
       if (buf) retpath = buf;
-      else if (ts) New(1313,retpath,retlen+1,char);
+      else if (ts) Newx(retpath,retlen+1,char);
       else retpath = __pathify_retbuf;
-      strncpy(retpath,dir,retlen-1);
+      strncpy(retpath, trndir, retlen-1);
       if (retpath[retlen-2] != '/') { /* If the path doesn't already end */
         retpath[retlen-1] = '/';      /* with '/', add it. */
         retpath[retlen] = '\0';
@@ -3416,20 +3968,34 @@ static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
       struct NAM savnam, dirnam = cc$rms_nam;
 
       /* If we've got an explicit filename, we can just shuffle the string. */
-      if ( ( (cp1 = strrchr(dir,']')) != NULL ||
-             (cp1 = strrchr(dir,'>')) != NULL     ) && *(cp1+1)) {
+      if ( ( (cp1 = strrchr(trndir,']')) != NULL ||
+             (cp1 = strrchr(trndir,'>')) != NULL     ) && *(cp1+1)) {
         if ((cp2 = strchr(cp1,'.')) != NULL) {
           int ver; char *cp3;
-          if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
-              !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
-              !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
-              (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
-              (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
+	  if (vms_process_case_tolerant) {
+              if (!*(cp2+1) || toupper(*(cp2+1)) != 'D' ||  /* Wrong type. */
+                  !*(cp2+2) || toupper(*(cp2+2)) != 'I' ||  /* Bzzt. */
+                  !*(cp2+3) || toupper(*(cp2+3)) != 'R' ||
+                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
+                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
                             (ver || *cp3)))))) {
-            set_errno(ENOTDIR);
-            set_vaxc_errno(RMS$_DIR);
-            return NULL;
-          }
+               set_errno(ENOTDIR);
+               set_vaxc_errno(RMS$_DIR);
+               return NULL;
+             }
+	  }
+	  else {
+              if (!*(cp2+1) || *(cp2+1) != 'D' ||  /* Wrong type. */
+                  !*(cp2+2) || *(cp2+2) != 'I' ||  /* Bzzt. */
+                  !*(cp2+3) || *(cp2+3) != 'R' ||
+                  (*(cp2+4) && ((*(cp2+4) != ';' && *(cp2+4) != '.')  ||
+                  (*(cp2+5) && ((ver = strtol(cp2+5,&cp3,10)) != 1 &&
+                            (ver || *cp3)))))) {
+               set_errno(ENOTDIR);
+               set_vaxc_errno(RMS$_DIR);
+               return NULL;
+             }
+	  }
         }
         else {  /* No file type, so just draw name into directory part */
           for (cp2 = cp1; *cp2; cp2++) ;
@@ -3439,15 +4005,15 @@ static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
         *cp1 = '.';
         /* We've now got a VMS 'path'; fall through */
       }
-      dirfab.fab$b_fns = strlen(dir);
-      dirfab.fab$l_fna = dir;
-      if (dir[dirfab.fab$b_fns-1] == ']' ||
-          dir[dirfab.fab$b_fns-1] == '>' ||
-          dir[dirfab.fab$b_fns-1] == ':') { /* It's already a VMS 'path' */
+      dirfab.fab$b_fns = strlen(trndir);
+      dirfab.fab$l_fna = trndir;
+      if (trndir[dirfab.fab$b_fns-1] == ']' ||
+          trndir[dirfab.fab$b_fns-1] == '>' ||
+          trndir[dirfab.fab$b_fns-1] == ':') { /* It's already a VMS 'path' */
         if (buf) retpath = buf;
-        else if (ts) New(1314,retpath,strlen(dir)+1,char);
+        else if (ts) Newx(retpath,strlen(trndir)+1,char);
         else retpath = __pathify_retbuf;
-        strcpy(retpath,dir);
+        strcpy(retpath,trndir);
         return retpath;
       } 
       dirfab.fab$l_dna = ".DIR;1";
@@ -3455,12 +4021,16 @@ static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
       dirfab.fab$l_nam = &dirnam;
       dirnam.nam$b_ess = (unsigned char) sizeof esa - 1;
       dirnam.nam$l_esa = esa;
+#ifdef NAM$M_NO_SHORT_UPCASE
+      if (decc_efs_case_preserve)
+	  dirnam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
+#endif
 
-      for (cp = dir; *cp; cp++)
+      for (cp = trndir; *cp; cp++)
         if (islower(*cp)) { haslower = 1; break; }
 
       if (!(sts = (sys$parse(&dirfab)&1))) {
-        if (dirfab.fab$l_sts == RMS$_DIR) {
+        if ((dirfab.fab$l_sts == RMS$_DIR) || (dirfab.fab$l_sts == RMS$_DNF)) {
           dirnam.nam$b_nop |= NAM$M_SYNCHK;
           sts = sys$parse(&dirfab) & 1;
         }
@@ -3474,8 +4044,10 @@ static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
         savnam = dirnam;
         if (!(sys$search(&dirfab)&1)) {  /* Does the file really exist? */
           if (dirfab.fab$l_sts != RMS$_FNF) {
+	    int sts1;
             dirnam.nam$b_nop |= NAM$M_SYNCHK;  dirnam.nam$l_rlf = NULL;
-            dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+            dirfab.fab$b_dns = 0;
+	    sts1 = sys$parse(&dirfab,0,0);
             set_errno(EVMSERR);
             set_vaxc_errno(dirfab.fab$l_sts);
             return NULL;
@@ -3487,9 +4059,11 @@ static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
         /* Yep; check version while we're at it, if it's there. */
         cmplen = (dirnam.nam$l_fnb & NAM$M_EXP_VER) ? 6 : 4;
         if (strncmp(dirnam.nam$l_type,".DIR;1",cmplen)) { 
+	  int sts2;
           /* Something other than .DIR[;1].  Bzzt. */
           dirnam.nam$b_nop |= NAM$M_SYNCHK;  dirnam.nam$l_rlf = NULL;
-          dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+          dirfab.fab$b_dns = 0;
+	  sts2 = sys$parse(&dirfab,0,0);
           set_errno(ENOTDIR);
           set_vaxc_errno(RMS$_DIR);
           return NULL;
@@ -3506,32 +4080,35 @@ static char *mp_do_pathify_dirspec(pTHX_ char *dir,char *buf, int ts)
       *(dirnam.nam$l_type + 1) = '\0';
       retlen = dirnam.nam$l_type - esa + 2;
       if (buf) retpath = buf;
-      else if (ts) New(1314,retpath,retlen,char);
+      else if (ts) Newx(retpath,retlen,char);
       else retpath = __pathify_retbuf;
       strcpy(retpath,esa);
       dirnam.nam$b_nop |= NAM$M_SYNCHK;  dirnam.nam$l_rlf = NULL;
-      dirfab.fab$b_dns = 0;  (void) sys$parse(&dirfab,0,0);
+      dirfab.fab$b_dns = 0;  sts = sys$parse(&dirfab,0,0);
       /* $PARSE may have upcased filespec, so convert output to lower
        * case if input contained any lowercase characters. */
-      if (haslower) __mystrtolower(retpath);
+      if (haslower && !decc_efs_case_preserve) __mystrtolower(retpath);
     }
 
     return retpath;
 }  /* end of do_pathify_dirspec() */
 /*}}}*/
 /* External entry points */
-char *Perl_pathify_dirspec(pTHX_ char *dir, char *buf)
+char *Perl_pathify_dirspec(pTHX_ const char *dir, char *buf)
 { return do_pathify_dirspec(dir,buf,0); }
-char *Perl_pathify_dirspec_ts(pTHX_ char *dir, char *buf)
+char *Perl_pathify_dirspec_ts(pTHX_ const char *dir, char *buf)
 { return do_pathify_dirspec(dir,buf,1); }
 
 /*{{{ char *tounixspec[_ts](char *path, char *buf)*/
-static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
+static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts)
 {
   static char __tounixspec_retbuf[NAM$C_MAXRSS+1];
-  char *dirend, *rslt, *cp1, *cp2, *cp3, tmp[NAM$C_MAXRSS+1];
-  int devlen, dirlen, retlen = NAM$C_MAXRSS+1, expand = 0;
+  char *dirend, *rslt, *cp1, *cp3, tmp[NAM$C_MAXRSS+1];
+  const char *cp2;
+  int devlen, dirlen, retlen = NAM$C_MAXRSS+1;
+  int expand = 1; /* guarantee room for leading and trailing slashes */
   unsigned short int trnlnm_iter_count;
+  int cmp_rslt;
 
   if (spec == NULL) return NULL;
   if (strlen(spec) > NAM$C_MAXRSS) return NULL;
@@ -3547,10 +4124,44 @@ static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
           { expand++; cp1 +=2; } /* VMS '...' ==> Unix '/.../' */
       }
     }
-    New(1315,rslt,retlen+2+2*expand,char);
+    Newx(rslt,retlen+2+2*expand,char);
   }
   else rslt = __tounixspec_retbuf;
-  if (strchr(spec,'/') != NULL) {
+
+  cmp_rslt = 0; /* Presume VMS */
+  cp1 = strchr(spec, '/');
+  if (cp1 == NULL)
+    cmp_rslt = 0;
+
+    /* Look for EFS ^/ */
+    if (decc_efs_charset) {
+      while (cp1 != NULL) {
+	cp2 = cp1 - 1;
+	if (*cp2 != '^') {
+	  /* Found illegal VMS, assume UNIX */
+	  cmp_rslt = 1;
+	  break;
+	}
+      cp1++;
+      cp1 = strchr(cp1, '/');
+    }
+  }
+
+  /* Look for "." and ".." */
+  if (decc_filename_unix_report) {
+    if (spec[0] == '.') {
+      if ((spec[1] == '\0') || (spec[1] == '\n')) {
+	cmp_rslt = 1;
+      }
+      else {
+	if ((spec[1] == '.') && ((spec[2] == '\0') || (spec[2] == '\n'))) {
+	  cmp_rslt = 1;
+	}
+      }
+    }
+  }
+  /* This is already UNIX or at least nothing VMS understands */
+  if (cmp_rslt) {
     strcpy(rslt,spec);
     return rslt;
   }
@@ -3564,6 +4175,61 @@ static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
     strcpy(rslt,spec);
     return rslt;
   }
+
+  /* Special case 1 - sys$posix_root = / */
+#if __CRTL_VER >= 70000000
+  if (!decc_disable_posix_root) {
+    if (strncasecmp(spec, "SYS$POSIX_ROOT:", 15) == 0) {
+      *cp1 = '/';
+      cp1++;
+      cp2 = cp2 + 15;
+      }
+  }
+#endif
+
+  /* Special case 2 - Convert NLA0: to /dev/null */
+#if __CRTL_VER < 70000000
+  cmp_rslt = strncmp(spec,"NLA0:", 5);
+  if (cmp_rslt != 0)
+     cmp_rslt = strncmp(spec,"nla0:", 5);
+#else
+  cmp_rslt = strncasecmp(spec,"NLA0:", 5);
+#endif
+  if (cmp_rslt == 0) {
+    strcpy(rslt, "/dev/null");
+    cp1 = cp1 + 9;
+    cp2 = cp2 + 5;
+    if (spec[6] != '\0') {
+      cp1[9] == '/';
+      cp1++;
+      cp2++;
+    }
+  }
+
+   /* Also handle special case "SYS$SCRATCH:" */
+#if __CRTL_VER < 70000000
+  cmp_rslt = strncmp(spec,"SYS$SCRATCH:", 12);
+  if (cmp_rslt != 0)
+     cmp_rslt = strncmp(spec,"sys$scratch:", 12);
+#else
+  cmp_rslt = strncasecmp(spec,"SYS$SCRATCH:", 12);
+#endif
+  if (cmp_rslt == 0) {
+  int islnm;
+
+    islnm = my_trnlnm(tmp, "TMP", 0);
+    if (!islnm) {
+      strcpy(rslt, "/tmp");
+      cp1 = cp1 + 4;
+      cp2 = cp2 + 12;
+      if (spec[12] != '\0') {
+	cp1[4] == '/';
+	cp1++;
+	cp2++;
+      }
+    }
+  }
+
   if (*cp2 != '[' && *cp2 != '<') {
     *(cp1++) = '/';
   }
@@ -3573,7 +4239,7 @@ static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
       *(cp1++) = '.'; *(cp1++) = '/'; *(cp1++) = '\0';
       return rslt;
     }
-    else if ( *cp2 != '.' && *cp2 != '-') { /* add the implied device */
+    else if ( *cp2 != '^' && *cp2 != '.' && *cp2 != '-') { /* add the implied device */
       if (getcwd(tmp,sizeof tmp,1) == NULL) {
         if (ts) Safefree(rslt);
         return NULL;
@@ -3601,6 +4267,11 @@ static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
       }
       *(cp1++) = '/';
     }
+    if ((*cp2 == '^')) {
+	/* EFS file escape, pass the next character as is */
+	/* Fix me: HEX encoding for UNICODE not implemented */
+	cp2++;
+    }
     else if ( *cp2 == '.') {
       if (*(cp2+1) == '.' && *(cp2+2) == '.') {
         *(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '/';
@@ -3610,6 +4281,12 @@ static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
     }
   }
   for (; cp2 <= dirend; cp2++) {
+    if ((*cp2 == '^')) {
+	/* EFS file escape, pass the next character as is */
+	/* Fix me: HEX encoding for UNICODE not implemented */
+	cp2++;
+	*(cp1++) = *cp2;
+    }
     if (*cp2 == ':') {
       *(cp1++) = '/';
       if (*(cp2+1) == '[') cp2++;
@@ -3617,7 +4294,7 @@ static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
     else if (*cp2 == ']' || *cp2 == '>') {
       if (*(cp1-1) != '/') *(cp1++) = '/'; /* Don't double after ellipsis */
     }
-    else if (*cp2 == '.') {
+    else if ((*cp2 == '.') && (*cp2-1 != '^')) {
       *(cp1++) = '/';
       if (*(cp2+1) == ']' || *(cp2+1) == '>') {
         while (*(cp2+1) == ']' || *(cp2+1) == '>' ||
@@ -3649,24 +4326,51 @@ static char *mp_do_tounixspec(pTHX_ char *spec, char *buf, int ts)
   while (*cp2) *(cp1++) = *(cp2++);
   *cp1 = '\0';
 
+  /* This still leaves /000000/ when working with a
+   * VMS device root or concealed root.
+   */
+  {
+  int ulen;
+  char * zeros;
+
+      ulen = strlen(rslt);
+
+      /* Get rid of "000000/ in rooted filespecs */
+      if (ulen > 7) {
+	zeros = strstr(rslt, "/000000/");
+	if (zeros != NULL) {
+	  int mlen;
+	  mlen = ulen - (zeros - rslt) - 7;
+	  memmove(zeros, &zeros[7], mlen);
+	  ulen = ulen - 7;
+	  rslt[ulen] = '\0';
+	}
+      }
+  }
+
   return rslt;
 
 }  /* end of do_tounixspec() */
 /*}}}*/
 /* External entry points */
-char *Perl_tounixspec(pTHX_ char *spec, char *buf) { return do_tounixspec(spec,buf,0); }
-char *Perl_tounixspec_ts(pTHX_ char *spec, char *buf) { return do_tounixspec(spec,buf,1); }
+char *Perl_tounixspec(pTHX_ const char *spec, char *buf) { return do_tounixspec(spec,buf,0); }
+char *Perl_tounixspec_ts(pTHX_ const char *spec, char *buf) { return do_tounixspec(spec,buf,1); }
 
 /*{{{ char *tovmsspec[_ts](char *path, char *buf)*/
-static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
+static char *mp_do_tovmsspec(pTHX_ const char *path, char *buf, int ts) {
   static char __tovmsspec_retbuf[NAM$C_MAXRSS+1];
   char *rslt, *dirend;
-  register char *cp1, *cp2;
+  char *lastdot;
+  char *vms_delim;
+  register char *cp1;
+  const char *cp2;
   unsigned long int infront = 0, hasdir = 1;
+  int rslt_len;
+  int no_type_seen;
 
   if (path == NULL) return NULL;
   if (buf) rslt = buf;
-  else if (ts) New(1316,rslt,strlen(path)+9,char);
+  else if (ts) Newx(rslt,strlen(path)+9,char);
   else rslt = __tovmsspec_retbuf;
   if (strpbrk(path,"]:>") ||
       (dirend = strrchr(path,'/')) == NULL) {
@@ -3678,13 +4382,19 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
     else strcpy(rslt,path);
     return rslt;
   }
+
+  vms_delim = strpbrk(path,"]:>");
+
+
   if (*(dirend+1) == '.') {  /* do we have trailing "/." or "/.." or "/..."? */
     if (!*(dirend+2)) dirend +=2;
     if (*(dirend+2) == '.' && !*(dirend+3)) dirend += 3;
     if (*(dirend+2) == '.' && *(dirend+3) == '.' && !*(dirend+4)) dirend += 4;
   }
+
   cp1 = rslt;
   cp2 = path;
+  lastdot = strrchr(cp2,'.');
   if (*cp2 == '/') {
     char trndev[NAM$C_MAXRSS+1];
     int islnm, rooted;
@@ -3693,12 +4403,53 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
     while (*(cp2+1) == '/') cp2++;  /* Skip multiple /s */
     if (!*(cp2+1)) {
       if (!buf & ts) Renew(rslt,18,char);
-      strcpy(rslt,"sys$disk:[000000]");
+      if (decc_disable_posix_root) {
+	strcpy(rslt,"sys$disk:[000000]");
+      }
+      else {
+	strcpy(rslt,"sys$posix_root:[000000]");
+      }
       return rslt;
     }
     while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
     *cp1 = '\0';
     islnm =  my_trnlnm(rslt,trndev,0);
+
+     /* DECC special handling */
+    if (!islnm) {
+      if (strcmp(rslt,"bin") == 0) {
+	strcpy(rslt,"sys$system");
+	cp1 = rslt + 10;
+	*cp1 = 0;
+	islnm =  my_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);
+      }
+      else if (!decc_disable_posix_root) {
+        strcpy(rslt, "sys$posix_root");
+	cp1 = rslt + 13;
+	*cp1 = 0;
+	cp2 = path;
+        while (*(cp2+1) == '/') cp2++;  /* Skip multiple /s */
+	islnm =  my_trnlnm(rslt,trndev,0);
+      }
+      else if (strcmp(rslt,"dev") == 0) {
+	if (strncmp(cp2,"/null", 5) == 0) {
+	  if ((cp2[5] == 0) || (cp2[5] == '/')) {
+	    strcpy(rslt,"NLA0");
+	    cp1 = rslt + 4;
+	    *cp1 = 0;
+	    cp2 = cp2 + 5;
+	    islnm =  my_trnlnm(rslt,trndev,0);
+	  }
+	}
+      }
+    }
+
     trnend = islnm ? strlen(trndev) - 1 : 0;
     islnm =  trnend ? (trndev[trnend] == ']' || trndev[trnend] == '>') : 0;
     rooted = islnm ? (trndev[trnend-1] == '.') : 0;
@@ -3715,12 +4466,16 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
         if (!buf && ts) Renew(rslt,strlen(path)-strlen(rslt)+trnend+4,char);
         strcpy(rslt,trndev);
         cp1 = rslt + trnend;
-        *(cp1++) = '.';
-        cp2++;
+	if (*cp2 != 0) {
+          *(cp1++) = '.';
+          cp2++;
+        }
       }
       else {
-        *(cp1++) = ':';
-        hasdir = 0;
+	if (decc_disable_posix_root) {
+	  *(cp1++) = ':';
+	  hasdir = 0;
+	}
       }
     }
   }
@@ -3741,6 +4496,10 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
         if (!*(cp2+4)) *(cp1++) = '.'; /* Simulate trailing '/' for later */
         cp2 += 4;
       }
+      else if ((cp2 != lastdot) || (lastdot < dirend)) {
+	/* Escape the extra dots in EFS file specifications */
+	*(cp1++) = '^';
+      }
       if (cp2 > dirend) cp2 = dirend;
     }
     else *(cp1++) = '.';
@@ -3778,11 +4537,25 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
         }
         else cp2 += 3;  /* Trailing '/' was there, so skip it, too */
       }
-      else *(cp1++) = '_';  /* fix up syntax - '.' in name not allowed */
+      else {
+        if (decc_efs_charset == 0)
+	  *(cp1++) = '_';  /* fix up syntax - '.' in name not allowed */
+	else {
+	  *(cp1++) = '^';  /* fix up syntax - '.' in name is allowed */
+	  *(cp1++) = '.';
+	}
+      }
     }
     else {
       if (!infront && *(cp1-1) == '-')  *(cp1++) = '.';
-      if (*cp2 == '.')      *(cp1++) = '_';
+      if (*cp2 == '.') {
+        if (decc_efs_charset == 0)
+	  *(cp1++) = '_';
+	else {
+	  *(cp1++) = '^';
+	  *(cp1++) = '.';
+	}
+      }
       else                  *(cp1++) =  *cp2;
       infront = 1;
     }
@@ -3790,7 +4563,89 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
   if (*(cp1-1) == '.') cp1--; /* Unix spec ending in '/' ==> trailing '.' */
   if (hasdir) *(cp1++) = ']';
   if (*cp2) cp2++;  /* check in case we ended with trailing '..' */
-  while (*cp2) *(cp1++) = *(cp2++);
+  /* fixme for ODS5 */
+  no_type_seen = 0;
+  if (cp2 > lastdot)
+    no_type_seen = 1;
+  while (*cp2) {
+    switch(*cp2) {
+    case '?':
+	*(cp1++) = '%';
+	cp2++;
+    case ' ':
+	*(cp1)++ = '^';
+	*(cp1)++ = '_';
+	cp2++;
+	break;
+    case '.':
+	if (((cp2 < lastdot) || (cp2[1] == '\0')) &&
+	    decc_readdir_dropdotnotype) {
+	  *(cp1)++ = '^';
+	  *(cp1)++ = '.';
+	  cp2++;
+
+	  /* trailing dot ==> '^..' on VMS */
+	  if (*cp2 == '\0') {
+	    *(cp1++) = '.';
+	    no_type_seen = 0;
+	  }
+	}
+	else {
+	  *(cp1++) = *(cp2++);
+	  no_type_seen = 0;
+	}
+	break;
+    case '\"':
+    case '~':
+    case '`':
+    case '!':
+    case '#':
+    case '%':
+    case '^':
+    case '&':
+    case '(':
+    case ')':
+    case '=':
+    case '+':
+    case '\'':
+    case '@':
+    case '[':
+    case ']':
+    case '{':
+    case '}':
+    case ':':
+    case '\\':
+    case '|':
+    case '<':
+    case '>':
+	*(cp1++) = '^';
+	*(cp1++) = *(cp2++);
+	break;
+    case ';':
+	/* FIXME: This needs fixing as Perl is putting ".dir;" on UNIX filespecs
+	 * which is wrong.  UNIX notation should be ".dir. unless
+	 * the DECC$FILENAME_UNIX_NO_VERSION is enabled.
+	 * changing this behavior could break more things at this time.
+	 */
+	if (decc_filename_unix_report != 0) {
+	  *(cp1++) = '^';
+	}
+	*(cp1++) = *(cp2++);
+	break;
+    default:
+	*(cp1++) = *(cp2++);
+    }
+  }
+  if ((no_type_seen == 1) && decc_readdir_dropdotnotype) {
+  char *lcp1;
+    lcp1 = cp1;
+    lcp1--;
+     /* Fix me for "^]", but that requires making sure that you do
+      * not back up past the start of the filename
+      */
+    if ((*lcp1 != ']') && (*lcp1 != '*') && (*lcp1 != '%'))
+      *cp1++ = '.';
+  }
   *cp1 = '\0';
 
   return rslt;
@@ -3798,11 +4653,11 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
 }  /* end of do_tovmsspec() */
 /*}}}*/
 /* External entry points */
-char *Perl_tovmsspec(pTHX_ char *path, char *buf) { return do_tovmsspec(path,buf,0); }
-char *Perl_tovmsspec_ts(pTHX_ char *path, char *buf) { return do_tovmsspec(path,buf,1); }
+char *Perl_tovmsspec(pTHX_ const char *path, char *buf) { return do_tovmsspec(path,buf,0); }
+char *Perl_tovmsspec_ts(pTHX_ const char *path, char *buf) { return do_tovmsspec(path,buf,1); }
 
 /*{{{ char *tovmspath[_ts](char *path, char *buf)*/
-static char *mp_do_tovmspath(pTHX_ char *path, char *buf, int ts) {
+static char *mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts) {
   static char __tovmspath_retbuf[NAM$C_MAXRSS+1];
   int vmslen;
   char pathified[NAM$C_MAXRSS+1], vmsified[NAM$C_MAXRSS+1], *cp;
@@ -3813,7 +4668,7 @@ static char *mp_do_tovmspath(pTHX_ char *path, char *buf, int ts) {
   if (buf) return buf;
   else if (ts) {
     vmslen = strlen(vmsified);
-    New(1317,cp,vmslen+1,char);
+    Newx(cp,vmslen+1,char);
     memcpy(cp,vmsified,vmslen);
     cp[vmslen] = '\0';
     return cp;
@@ -3826,12 +4681,12 @@ static char *mp_do_tovmspath(pTHX_ char *path, char *buf, int ts) {
 }  /* end of do_tovmspath() */
 /*}}}*/
 /* External entry points */
-char *Perl_tovmspath(pTHX_ char *path, char *buf) { return do_tovmspath(path,buf,0); }
-char *Perl_tovmspath_ts(pTHX_ char *path, char *buf) { return do_tovmspath(path,buf,1); }
+char *Perl_tovmspath(pTHX_ const char *path, char *buf) { return do_tovmspath(path,buf,0); }
+char *Perl_tovmspath_ts(pTHX_ const char *path, char *buf) { return do_tovmspath(path,buf,1); }
 
 
 /*{{{ char *tounixpath[_ts](char *path, char *buf)*/
-static char *mp_do_tounixpath(pTHX_ char *path, char *buf, int ts) {
+static char *mp_do_tounixpath(pTHX_ const char *path, char *buf, int ts) {
   static char __tounixpath_retbuf[NAM$C_MAXRSS+1];
   int unixlen;
   char pathified[NAM$C_MAXRSS+1], unixified[NAM$C_MAXRSS+1], *cp;
@@ -3842,7 +4697,7 @@ static char *mp_do_tounixpath(pTHX_ char *path, char *buf, int ts) {
   if (buf) return buf;
   else if (ts) {
     unixlen = strlen(unixified);
-    New(1317,cp,unixlen+1,char);
+    Newx(cp,unixlen+1,char);
     memcpy(cp,unixified,unixlen);
     cp[unixlen] = '\0';
     return cp;
@@ -3855,8 +4710,8 @@ static char *mp_do_tounixpath(pTHX_ char *path, char *buf, int ts) {
 }  /* end of do_tounixpath() */
 /*}}}*/
 /* External entry points */
-char *Perl_tounixpath(pTHX_ char *path, char *buf) { return do_tounixpath(path,buf,0); }
-char *Perl_tounixpath_ts(pTHX_ char *path, char *buf) { return do_tounixpath(path,buf,1); }
+char *Perl_tounixpath(pTHX_ const char *path, char *buf) { return do_tounixpath(path,buf,0); }
+char *Perl_tounixpath_ts(pTHX_ const char *path, char *buf) { return do_tounixpath(path,buf,1); }
 
 /*
  * @(#)argproc.c 2.2 94/08/16	Mark Pizzolato (mark@infocomm.com)
@@ -4060,7 +4915,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
      * Allocate and fill in the new argument vector, Some Unix's terminate
      * the list with an extra null pointer.
      */
-    New(1302, argv, item_count+1, char *);
+    Newx(argv, item_count+1, char *);
     *av = argv;
     for (j = 0; j < item_count; ++j, list_head = list_head->next)
 	argv[j] = list_head->value;
@@ -4155,11 +5010,11 @@ static void add_item(struct list_item **head,
 {
     if (*head == 0)
 	{
-	New(1303,*head,1,struct list_item);
+	Newx(*head,1,struct list_item);
 	*tail = *head;
 	}
     else {
-	New(1304,(*tail)->next,1,struct list_item);
+	Newx((*tail)->next,1,struct list_item);
 	*tail = (*tail)->next;
 	}
     (*tail)->value = value;
@@ -4174,6 +5029,7 @@ static void mp_expand_wild_cards(pTHX_ char *item,
 int expcount = 0;
 unsigned long int context = 0;
 int isunix = 0;
+int item_len = 0;
 char *had_version;
 char *had_device;
 int had_directory;
@@ -4193,6 +5049,20 @@ unsigned long int zero = 0, sts;
 	add_item(head, tail, item, count);
 	return;
 	}
+    else
+        {
+     /* "double quoted" wild card expressions pass as is */
+     /* From DCL that means using e.g.:                  */
+     /* perl program """perl.*"""                        */
+     item_len = strlen(item);
+     if ( '"' == *item && '"' == item[item_len-1] )
+       {
+       item++;
+       item[item_len-2] = '\0';
+       add_item(head, tail, item, count);
+       return;
+       }
+     }
     resultspec.dsc$b_dtype = DSC$K_DTYPE_T;
     resultspec.dsc$b_class = DSC$K_CLASS_D;
     resultspec.dsc$a_pointer = NULL;
@@ -4217,11 +5087,11 @@ unsigned long int zero = 0, sts;
 	char *string;
 	char *c;
 
-	New(1305,string,resultspec.dsc$w_length+1,char);
+	Newx(string,resultspec.dsc$w_length+1,char);
 	strncpy(string, resultspec.dsc$a_pointer, resultspec.dsc$w_length);
 	string[resultspec.dsc$w_length] = '\0';
 	if (NULL == had_version)
-	    *((char *)strrchr(string, ';')) = '\0';
+	    *(strrchr(string, ';')) = '\0';
 	if ((!had_directory) && (had_device == NULL))
 	    {
 	    if (NULL == (devdir = strrchr(string, ']')))
@@ -4232,9 +5102,11 @@ unsigned long int zero = 0, sts;
 	 * Be consistent with what the C RTL has already done to the rest of
 	 * the argv items and lowercase all of these names.
 	 */
-	for (c = string; *c; ++c)
+	if (!decc_efs_case_preserve) {
+	    for (c = string; *c; ++c)
 	    if (isupper(*c))
 		*c = tolower(*c);
+	}
 	if (isunix) trim_unixpath(string,item,1);
 	add_item(head, tail, string, count);
 	++expcount;
@@ -4427,7 +5299,7 @@ vms_image_init(int *argcp, char ***argvp)
                                  {          0,                0,    0,      0} };
 
 #ifdef KILL_BY_SIGPRC
-    (void) Perl_csighandler_init();
+    Perl_csighandler_init();
 #endif
 
   _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
@@ -4457,7 +5329,7 @@ vms_image_init(int *argcp, char ***argvp)
          exit(SS$_ABORT);
       }
       if (jpilist[1].bufadr != rlst) Safefree(jpilist[1].bufadr);
-      jpilist[1].bufadr = New(1320,mask,rsz,unsigned long int);
+      jpilist[1].bufadr = Newx(mask,rsz,unsigned long int);
       jpilist[1].buflen = rsz * sizeof(unsigned long int);
       _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,&jpilist[1],iosb,NULL,NULL));
       _ckvmssts_noperl(iosb[0]);
@@ -4474,20 +5346,51 @@ vms_image_init(int *argcp, char ***argvp)
     }
     if (mask != rlst) Safefree(mask);
   }
+
+  /* When Perl is in decc_filename_unix_report mode and is run from a concealed
+   * logical, some versions of the CRTL will add a phanthom /000000/
+   * directory.  This needs to be removed.
+   */
+  if (decc_filename_unix_report) {
+  char * zeros;
+  int ulen;
+    ulen = strlen(argvp[0][0]);
+    if (ulen > 7) {
+      zeros = strstr(argvp[0][0], "/000000/");
+      if (zeros != NULL) {
+	int mlen;
+	mlen = ulen - (zeros - argvp[0][0]) - 7;
+	memmove(zeros, &zeros[7], mlen);
+	ulen = ulen - 7;
+	argvp[0][0][ulen] = '\0';
+      }
+    }
+    /* It also may have a trailing dot that needs to be removed otherwise
+     * it will be converted to VMS mode incorrectly.
+     */
+    ulen--;
+    if ((argvp[0][0][ulen] == '.') && (decc_readdir_dropdotnotype))
+      argvp[0][0][ulen] = '\0';
+  }
+
   /* We need to use this hack to tell Perl it should run with tainting,
    * since its tainting flag may be part of the PL_curinterp struct, which
    * hasn't been allocated when vms_image_init() is called.
    */
   if (will_taint) {
-    char ***newap;
-    New(1320,newap,*argcp+2,char **);
-    newap[0] = argvp[0];
-    *newap[1] = "-T";
-    Copy(argvp[1],newap[2],*argcp-1,char **);
+    char **newargv, **oldargv;
+    oldargv = *argvp;
+    Newx(newargv,(*argcp)+2,char *);
+    newargv[0] = oldargv[0];
+    Newx(newargv[1],3,char);
+    strcpy(newargv[1], "-T");
+    Copy(&oldargv[1],&newargv[2],(*argcp)-1,char **);
+    (*argcp)++;
+    newargv[*argcp] = NULL;
     /* We orphan the old argv, since we don't know where it's come from,
      * so we don't know how to free it.
      */
-    *argcp++; argvp = newap;
+    *argvp = newargv;
   }
   else {  /* Did user explicitly request tainting? */
     int i;
@@ -4506,12 +5409,12 @@ vms_image_init(int *argcp, char ***argvp)
   for (tabidx = 0;
        len = my_trnlnm("PERL_ENV_TABLES",eqv,tabidx);
        tabidx++) {
-    if (!tabidx) New(1321,tabvec,tabct,struct dsc$descriptor_s *);
+    if (!tabidx) Newx(tabvec,tabct,struct dsc$descriptor_s *);
     else if (tabidx >= tabct) {
       tabct += 8;
       Renew(tabvec,tabct,struct dsc$descriptor_s *);
     }
-    New(1322,tabvec[tabidx],1,struct dsc$descriptor_s);
+    Newx(tabvec[tabidx],1,struct dsc$descriptor_s);
     tabvec[tabidx]->dsc$w_length  = 0;
     tabvec[tabidx]->dsc$b_dtype   = DSC$K_DTYPE_T;
     tabvec[tabidx]->dsc$b_class   = DSC$K_CLASS_D;
@@ -4521,10 +5424,10 @@ vms_image_init(int *argcp, char ***argvp)
   if (tabidx) { tabvec[tabidx] = NULL; env_tables = tabvec; }
 
   getredirection(argcp,argvp);
-#if defined(USE_5005THREADS) && ( defined(__DECC) || defined(__DECCXX) )
+#if defined(USE_ITHREADS) && ( defined(__DECC) || defined(__DECCXX) )
   {
 # include <reentrancy.h>
-  (void) decc$set_reentrancy(C$C_MULTITHREAD);
+  decc$set_reentrancy(C$C_MULTITHREAD);
   }
 #endif
   return;
@@ -4549,18 +5452,21 @@ vms_image_init(int *argcp, char ***argvp)
  */
 /*{{{int trim_unixpath(char *fspec, char *wildspec, int opts)*/
 int
-Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
+Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
 {
   char unixified[NAM$C_MAXRSS+1], unixwild[NAM$C_MAXRSS+1],
        *template, *base, *end, *cp1, *cp2;
   register int tmplen, reslen = 0, dirs = 0;
 
   if (!wildspec || !fspec) return 0;
+  template = unixwild;
   if (strpbrk(wildspec,"]>:") != NULL) {
     if (do_tounixspec(wildspec,unixwild,0) == NULL) return 0;
-    else template = unixwild;
   }
-  else template = wildspec;
+  else {
+    strncpy(unixwild, wildspec, NAM$C_MAXRSS);
+    unixwild[NAM$C_MAXRSS] = 0;
+  }
   if (strpbrk(fspec,"]>:") != NULL) {
     if (do_tounixspec(fspec,unixified,0) == NULL) return 0;
     else base = unixified;
@@ -4609,8 +5515,10 @@ Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
        * could match template).
        */
       if (getcwd(tpl, sizeof tpl,0) == NULL) return 0;
-      for (cp1 = tpl, cp2 = base; *cp1 && *cp2; cp1++,cp2++)
-        if (_tolower(*cp1) != _tolower(*cp2)) break;
+      if (!decc_efs_case_preserve) {
+ 	for (cp1 = tpl, cp2 = base; *cp1 && *cp2; cp1++,cp2++)
+	  if (_tolower(*cp1) != _tolower(*cp2)) break;
+      }
       segdirs = dirs - totells;  /* Min # of dirs we must have left */
       for (front = cp2+1; *front; front++) if (*front == '/') segdirs--;
       if (*cp1 == '\0' && *cp2 == '/' && segdirs < 1) {
@@ -4623,8 +5531,10 @@ Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
       for (front = end ; front >= base; front--)
          if (*front == '/' && !dirs--) { front++; break; }
     }
-    for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + sizeof lcres;
+    if (!decc_efs_case_preserve) {
+      for (cp1=template,cp2=lcres; *cp1 && cp2 <= lcres + sizeof lcres;
          cp1++,cp2++) *cp2 = _tolower(*cp1);  /* Make lc copy for match */
+    }
     if (cp1 != '\0') return 0;  /* Path too long. */
     lcend = cp2;
     *cp2 = '\0';  /* Pick up with memcpy later */
@@ -4644,7 +5554,14 @@ Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
            cp1 <= ellipsis - 1 && cp2 <= tpl + sizeof tpl;
            cp1++, cp2++) {
          if (*cp1 == '?') *cp2 = '%'; /* Substitute VMS' wildcard for Unix' */
-         else *cp2 = _tolower(*cp1);  /* else lowercase for match */
+         else {
+	    if (!decc_efs_case_preserve) {
+	      *cp2 = _tolower(*cp1);  /* else lowercase for match */
+	    }
+	    else {
+	      *cp2 = *cp1;  /* else preserve case for match */
+	    }
+	 }
          if (*cp2 == '/') segdirs++;
       }
       if (cp1 != ellipsis - 1) return 0; /* Path too long */
@@ -4672,8 +5589,10 @@ Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
         char def[NAM$C_MAXRSS+1], *st;
 
         if (getcwd(def, sizeof def,0) == NULL) return 0;
-        for (cp1 = def, cp2 = base; *cp1 && *cp2; cp1++,cp2++)
-          if (_tolower(*cp1) != _tolower(*cp2)) break;
+	if (!decc_efs_case_preserve) {
+	  for (cp1 = def, cp2 = base; *cp1 && *cp2; cp1++,cp2++)
+	    if (_tolower(*cp1) != _tolower(*cp2)) break;
+	}
         segdirs = dirs - totells;  /* Min # of dirs we must have left */
         for (st = cp2+1; *st; st++) if (*st == '/') segdirs--;
         if (*cp1 == '\0' && *cp2 == '/') {
@@ -4700,6 +5619,18 @@ Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
  *  Minor modifications to original routines.
  */
 
+/* readdir may have been redefined by reentr.h, so make sure we get
+ * the local version for what we do here.
+ */
+#ifdef readdir
+# undef readdir
+#endif
+#if !defined(PERL_IMPLICIT_CONTEXT)
+# define readdir Perl_readdir
+#else
+# define readdir(a) Perl_readdir(aTHX_ a)
+#endif
+
     /* Number of elements in vms_versions array */
 #define VERSIZE(e)	(sizeof e->vms_versions / sizeof e->vms_versions[0])
 
@@ -4708,7 +5639,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, char *wildspec, int opts)
  */
 /*{{{ DIR *opendir(char*name) */
 DIR *
-Perl_opendir(pTHX_ char *name)
+Perl_opendir(pTHX_ const char *name)
 {
     DIR *dd;
     char dir[NAM$C_MAXRSS+1];
@@ -4721,7 +5652,7 @@ Perl_opendir(pTHX_ char *name)
      * accurately report whether it's a directory.
      */
     if (!cando_by_name(S_IRUSR,0,dir)) {
-      set_errno(EACCES); set_vaxc_errno(RMS$_PRV);
+      /* cando_by_name has already set errno */
       return NULL;
     }
     if (flex_stat(dir,&sb) == -1) return NULL;
@@ -4730,11 +5661,11 @@ Perl_opendir(pTHX_ char *name)
       return NULL;
     }
     /* Get memory for the handle, and the pattern. */
-    New(1306,dd,1,DIR);
-    New(1307,dd->pattern,strlen(dir)+sizeof "*.*" + 1,char);
+    Newx(dd,1,DIR);
+    Newx(dd->pattern,strlen(dir)+sizeof "*.*" + 1,char);
 
     /* Fill in the fields; mainly playing with the descriptor. */
-    (void)sprintf(dd->pattern, "%s*.*",dir);
+    sprintf(dd->pattern, "%s*.*",dir);
     dd->context = 0;
     dd->count = 0;
     dd->vms_wantversions = 0;
@@ -4742,6 +5673,12 @@ Perl_opendir(pTHX_ char *name)
     dd->pat.dsc$w_length = strlen(dd->pattern);
     dd->pat.dsc$b_dtype = DSC$K_DTYPE_T;
     dd->pat.dsc$b_class = DSC$K_CLASS_S;
+#if defined(USE_ITHREADS)
+    Newx(dd->mutex,1,perl_mutex);
+    MUTEX_INIT( (perl_mutex *) dd->mutex );
+#else
+    dd->mutex = NULL;
+#endif
 
     return dd;
 }  /* end of opendir() */
@@ -4765,9 +5702,15 @@ vmsreaddirversions(DIR *dd, int flag)
 void
 closedir(DIR *dd)
 {
-    (void)lib$find_file_end(&dd->context);
+    int sts;
+
+    sts = lib$find_file_end(&dd->context);
     Safefree(dd->pattern);
-    Safefree((char *)dd);
+#if defined(USE_ITHREADS)
+    MUTEX_DESTROY( (perl_mutex *) dd->mutex );
+    Safefree(dd->mutex);
+#endif
+    Safefree(dd);
 }
 /*}}}*/
 
@@ -4789,9 +5732,9 @@ collectversions(pTHX_ DIR *dd)
 
     /* Add the version wildcard, ignoring the "*.*" put on before */
     i = strlen(dd->pattern);
-    New(1308,text,i + e->d_namlen + 3,char);
-    (void)strcpy(text, dd->pattern);
-    (void)sprintf(&text[i - 3], "%s;*", e->d_name);
+    Newx(text,i + e->d_namlen + 3,char);
+    strcpy(text, dd->pattern);
+    sprintf(&text[i - 3], "%s;*", e->d_name);
 
     /* Set up the pattern descriptor. */
     pat.dsc$a_pointer = text;
@@ -4860,14 +5803,23 @@ Perl_readdir(pTHX_ DIR *dd)
     }
     dd->count++;
     /* Force the buffer to end with a NUL, and downcase name to match C convention. */
-    buff[sizeof buff - 1] = '\0';
+    if (!decc_efs_case_preserve) {
+      buff[sizeof buff - 1] = '\0';
+      for (p = buff; *p; p++) *p = _tolower(*p);
+      while (--p >= buff) if (!isspace(*p)) break; /* Do we really need this? */
+      *p = '\0';
+    }
+    else {
+      /* we don't want to force to lowercase, just null terminate */
+      buff[res.dsc$w_length] = '\0';
+    }
     for (p = buff; *p; p++) *p = _tolower(*p);
     while (--p >= buff) if (!isspace(*p)) break;  /* Do we really need this? */
     *p = '\0';
 
     /* Skip any directory component and just copy the name. */
-    if ((p = strchr(buff, ']'))) (void)strcpy(dd->entry.d_name, p + 1);
-    else (void)strcpy(dd->entry.d_name, buff);
+    if ((p = strchr(buff, ']'))) strcpy(dd->entry.d_name, p + 1);
+    else strcpy(dd->entry.d_name, buff);
 
     /* Clobber the version. */
     if ((p = strchr(dd->entry.d_name, ';'))) *p = '\0';
@@ -4881,6 +5833,28 @@ Perl_readdir(pTHX_ DIR *dd)
 /*}}}*/
 
 /*
+ *  Read the next entry from the directory -- thread-safe version.
+ */
+/*{{{ int readdir_r(DIR *dd, struct dirent *entry, struct dirent **result)*/
+int
+Perl_readdir_r(pTHX_ DIR *dd, struct dirent *entry, struct dirent **result)
+{
+    int retval;
+
+    MUTEX_LOCK( (perl_mutex *) dd->mutex );
+
+    entry = readdir(dd);
+    *result = entry;
+    retval = ( *result == NULL ? errno : 0 );
+
+    MUTEX_UNLOCK( (perl_mutex *) dd->mutex );
+
+    return retval;
+
+}  /* end of readdir_r() */
+/*}}}*/
+
+/*
  *  Return something that can be used in a seekdir later.
  */
 /*{{{ long telldir(DIR *dd)*/
@@ -4912,7 +5886,7 @@ Perl_seekdir(pTHX_ DIR *dd, long count)
 
     /* The increment is in readdir(). */
     for (dd->count = 0; dd->count < count; )
-	(void)readdir(dd);
+	readdir(dd);
 
     dd->vms_wantversions = vms_wantversions;
 
@@ -4926,7 +5900,7 @@ Perl_seekdir(pTHX_ DIR *dd, long count)
  *
  * vms_do_aexec() and vms_do_exec() are called in response to the
  * perl 'exec' function.  If this follows a vfork call, then they
- * call out the the regular perl routines in doio.c which do an
+ * call out the regular perl routines in doio.c which do an
  * execvp (for those who really want to try this under VMS).
  * Otherwise, they do exactly what the perl docs say exec should
  * do - terminate the current script and invoke a new command
@@ -4939,7 +5913,7 @@ Perl_seekdir(pTHX_ DIR *dd, long count)
  * in 'VMSish fashion' (i.e. not after a call to vfork) The args
  * are concatenated to form a DCL command string.  If the first arg
  * begins with '$' (i.e. the perl script had "\$ Type" or some such),
- * the the command string is handed off to DCL directly.  Otherwise,
+ * the command string is handed off to DCL directly.  Otherwise,
  * the first token of the command is taken as the filespec of an image
  * to run.  The filespec is expanded using a default type of '.EXE' and
  * the process defaults for device, directory, etc., and if found, the resultant
@@ -4996,7 +5970,7 @@ setup_argstr(pTHX_ SV *really, SV **mark, SV **sp)
       cmdlen += rlen ? rlen + 1 : 0;
     }
   }
-  New(401,PL_Cmd,cmdlen+1,char);
+  Newx(PL_Cmd,cmdlen+1,char);
 
   if (tmps && *tmps) {
     strcpy(PL_Cmd,tmps);
@@ -5017,7 +5991,7 @@ setup_argstr(pTHX_ SV *really, SV **mark, SV **sp)
 
 
 static unsigned long int
-setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote,
+setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote,
                    struct dsc$descriptor_s **pvmscmd)
 {
   char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1];
@@ -5028,9 +6002,18 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote,
   struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
   unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL;
   register char *s, *rest, *cp, *wordbreak;
+  char * cmd;
+  int cmdlen;
   register int isdcl;
 
-  New(402,vmscmd,sizeof(struct dsc$descriptor_s),struct dsc$descriptor_s);
+  Newx(vmscmd,sizeof(struct dsc$descriptor_s),struct dsc$descriptor_s);
+
+  /* Make a copy for modification */
+  cmdlen = strlen(incmd);
+  Newx(cmd, cmdlen+1, char);
+  strncpy(cmd, incmd, cmdlen);
+  cmd[cmdlen] = 0;
+
   vmscmd->dsc$a_pointer = NULL;
   vmscmd->dsc$b_dtype  = DSC$K_DTYPE_T;
   vmscmd->dsc$b_class  = DSC$K_CLASS_S;
@@ -5039,9 +6022,13 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote,
 
   if (suggest_quote) *suggest_quote = 0;
 
-  if (strlen(cmd) > MAX_DCL_LINE_LENGTH)
+  if (strlen(cmd) > MAX_DCL_LINE_LENGTH) {
     return CLI$_BUFOVF;                /* continuation lines currently unsupported */
+    Safefree(cmd);
+  }
+
   s = cmd;
+
   while (*s && isspace(*s)) s++;
 
   if (*s == '@' || *s == '$') {
@@ -5110,7 +6097,7 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote,
       *s = '\0';
 
       /* check that it's really not DCL with no file extension */
-      fp = fopen(resspec,"r","ctx=bin,shr=get");
+      fp = fopen(resspec,"r","ctx=bin","shr=get");
       if (fp) {
         char b[4] = {0,0,0,0};
         read(fileno(fp),b,4);
@@ -5120,7 +6107,7 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote,
       if (check_img && isdcl) return RMS$_FNF;
 
       if (cando_by_name(S_IXUSR,0,resspec)) {
-        New(402,vmscmd->dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char);
+        Newx(vmscmd->dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char);
         if (!isdcl) {
             strcpy(vmscmd->dsc$a_pointer,"$ MCR ");
             if (suggest_quote) *suggest_quote = 1;
@@ -5131,6 +6118,7 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote,
         strcat(vmscmd->dsc$a_pointer,resspec);
         if (rest) strcat(vmscmd->dsc$a_pointer,rest);
         vmscmd->dsc$w_length = strlen(vmscmd->dsc$a_pointer);
+        Safefree(cmd);
         return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts);
       }
       else retsts = RMS$_PRV;
@@ -5145,6 +6133,8 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote,
   else  */
       vmscmd->dsc$a_pointer = savepvn(cmd,vmscmd->dsc$w_length);
 
+  Safefree(cmd);
+
   /* check if it's a symbol (for quoting purposes) */
   if (suggest_quote && !*suggest_quote) { 
     int iss;     
@@ -5192,7 +6182,7 @@ Perl_vms_do_aexec(pTHX_ SV *really,SV **mark,SV **sp)
 
 /* {{{bool vms_do_exec(char *cmd) */
 bool
-Perl_vms_do_exec(pTHX_ char *cmd)
+Perl_vms_do_exec(pTHX_ const char *cmd)
 {
   struct dsc$descriptor_s *vmscmd;
 
@@ -5244,7 +6234,7 @@ Perl_vms_do_exec(pTHX_ char *cmd)
 }  /* end of vms_do_exec() */
 /*}}}*/
 
-unsigned long int Perl_do_spawn(pTHX_ char *);
+unsigned long int Perl_do_spawn(pTHX_ const char *);
 
 /* {{{ unsigned long int do_aspawn(void *really,void **mark,void **sp) */
 unsigned long int
@@ -5258,7 +6248,7 @@ Perl_do_aspawn(pTHX_ void *really,void **mark,void **sp)
 
 /* {{{unsigned long int do_spawn(char *cmd) */
 unsigned long int
-Perl_do_spawn(pTHX_ char *cmd)
+Perl_do_spawn(pTHX_ const char *cmd)
 {
   unsigned long int sts, substs;
 
@@ -5294,7 +6284,10 @@ Perl_do_spawn(pTHX_ char *cmd)
     sts = substs;
   }
   else {
-    (void) safe_popen(aTHX_ cmd, "nW", (int *)&sts);
+    PerlIO * fp;
+    fp = safe_popen(aTHX_ cmd, "nW", (int *)&sts);
+    if (fp != NULL)
+      my_pclose(fp);
   }
   return sts;
 }  /* end of do_spawn() */
@@ -5312,14 +6305,14 @@ static unsigned int *sockflags, sockflagsize;
 /*{{{ FILE *my_fdopen(int fd, const char *mode)*/
 FILE *my_fdopen(int fd, const char *mode)
 {
-  FILE *fp = fdopen(fd, (char *) mode);
+  FILE *fp = fdopen(fd, mode);
 
   if (fp) {
     unsigned int fdoff = fd / sizeof(unsigned int);
     struct stat sbuf; /* native stat; we don't need flex_stat */
     if (!sockflagsize || fdoff > sockflagsize) {
       if (sockflags) Renew(     sockflags,fdoff+2,unsigned int);
-      else           New  (1324,sockflags,fdoff+2,unsigned int);
+      else           Newx  (sockflags,fdoff+2,unsigned int);
       memset(sockflags+sockflagsize,0,fdoff + 2 - sockflagsize);
       sockflagsize = fdoff + 2;
     }
@@ -5517,7 +6510,7 @@ static int fillpasswd (pTHX_ const char *name, struct passwd *pwd)
     name_desc.dsc$w_length=  strlen(name);
     name_desc.dsc$b_dtype=   DSC$K_DTYPE_T;
     name_desc.dsc$b_class=   DSC$K_CLASS_S;
-    name_desc.dsc$a_pointer= (char *) name;
+    name_desc.dsc$a_pointer= (char *) name; /* read only pointer */
 
 /*  Note that sys$getuai returns many fields as counted strings. */
     sts= sys$getuai(0, 0, &name_desc, &itmlst, 0, 0, 0);
@@ -5553,7 +6546,8 @@ static int fillpasswd (pTHX_ const char *name, struct passwd *pwd)
     }
     else
         strcpy(pwd->pw_unixdir, pwd->pw_dir);
-    __mystrtolower(pwd->pw_unixdir);
+    if (!decc_efs_case_preserve)
+        __mystrtolower(pwd->pw_unixdir);
     return 1;
 }
 
@@ -5561,7 +6555,7 @@ static int fillpasswd (pTHX_ const char *name, struct passwd *pwd)
  * Get information for a named user.
 */
 /*{{{struct passwd *getpwnam(char *name)*/
-struct passwd *Perl_my_getpwnam(pTHX_ char *name)
+struct passwd *Perl_my_getpwnam(pTHX_ const char *name)
 {
     struct dsc$descriptor_s name_desc;
     union uicdef uic;
@@ -6098,8 +7092,8 @@ tz_parse(pTHX_ time_t *w, int *dst, char *zone, int *gmtoff)
 
         for (j = 0; j < 12; j++) {
             w2 =localtime(&when);
-            (void) tz_parse_startend(s_start,w2,&ds);
-            (void) tz_parse_startend(s_end,w2,&de);
+            tz_parse_startend(s_start,w2,&ds);
+            tz_parse_startend(s_end,w2,&de);
             if (ds != de) break;
             when += 30*86400;
         }
@@ -6228,7 +7222,7 @@ Perl_my_localtime(pTHX_ const time_t *timep)
     return NULL;
   }
   if (*timep == 0) gmtime_emulation_type = 0;  /* possibly reset TZ */
-  if (gmtime_emulation_type == 0) (void) my_time(NULL); /* Init UTC */
+  if (gmtime_emulation_type == 0) my_time(NULL); /* Init UTC */
 
   when = *timep;
 # ifdef RTL_USES_UTC
@@ -6282,10 +7276,11 @@ Perl_my_localtime(pTHX_ const time_t *timep)
  */
 static const long int utime_baseadjust[2] = { 0x4beb4000, 0x7c9567 };
 
-/*{{{int my_utime(char *path, struct utimbuf *utimes)*/
-int Perl_my_utime(pTHX_ char *file, struct utimbuf *utimes)
+/*{{{int my_utime(const char *path, const struct utimbuf *utimes)*/
+int Perl_my_utime(pTHX_ const char *file, const struct utimbuf *utimes)
 {
   register int i;
+  int sts;
   long int bintime[2], len = 2, lowbit, unixtime,
            secscale = 10000000; /* seconds --> 100 ns intervals */
   unsigned long int chan, iosb[2], retsts;
@@ -6307,6 +7302,7 @@ int Perl_my_utime(pTHX_ char *file, struct utimbuf *utimes)
    */
 #  pragma message restore
 #endif
+  /* cast ok for read only parameter */
   struct dsc$descriptor fibdsc = {sizeof(myfib), DSC$K_DTYPE_Z, DSC$K_CLASS_S,(char *) &myfib},
                         devdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0},
                         fnmdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0};
@@ -6362,6 +7358,8 @@ int Perl_my_utime(pTHX_ char *file, struct utimbuf *utimes)
   mynam.nam$b_ess = (unsigned char) sizeof esa;
   mynam.nam$l_rsa = rsa;
   mynam.nam$b_rss = (unsigned char) sizeof rsa;
+  if (decc_efs_case_preserve)
+      mynam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
 
   /* Look for the file to be affected, letting RMS parse the file
    * specification for us as well.  I have set errno using only
@@ -6378,7 +7376,7 @@ int Perl_my_utime(pTHX_ char *file, struct utimbuf *utimes)
   retsts = sys$search(&myfab,0,0);
   if (!(retsts & 1)) {
     mynam.nam$b_nop |= NAM$M_SYNCHK;  mynam.nam$l_rlf = NULL;
-    myfab.fab$b_dns = 0;  (void) sys$parse(&myfab,0,0);
+    myfab.fab$b_dns = 0;  sts = sys$parse(&myfab,0,0);
     set_vaxc_errno(retsts);
     if      (retsts == RMS$_PRV) set_errno(EACCES);
     else if (retsts == RMS$_FNF) set_errno(ENOENT);
@@ -6387,12 +7385,13 @@ int Perl_my_utime(pTHX_ char *file, struct utimbuf *utimes)
   }
 
   devdsc.dsc$w_length = mynam.nam$b_dev;
+  /* cast ok for read only parameter */
   devdsc.dsc$a_pointer = (char *) mynam.nam$l_dev;
 
   retsts = sys$assign(&devdsc,&chan,0,0);
   if (!(retsts & 1)) {
     mynam.nam$b_nop |= NAM$M_SYNCHK;  mynam.nam$l_rlf = NULL;
-    myfab.fab$b_dns = 0;  (void) sys$parse(&myfab,0,0);
+    myfab.fab$b_dns = 0;  sts = sys$parse(&myfab,0,0);
     set_vaxc_errno(retsts);
     if      (retsts == SS$_IVDEVNAM)   set_errno(ENOTDIR);
     else if (retsts == SS$_NOPRIV)     set_errno(EACCES);
@@ -6418,7 +7417,7 @@ int Perl_my_utime(pTHX_ char *file, struct utimbuf *utimes)
 #endif
   retsts = sys$qiow(0,chan,IO$_MODIFY,iosb,0,0,&fibdsc,&fnmdsc,0,0,myatr,0);
   mynam.nam$b_nop |= NAM$M_SYNCHK;  mynam.nam$l_rlf = NULL;
-  myfab.fab$b_dns = 0;  (void) sys$parse(&myfab,0,0);
+  myfab.fab$b_dns = 0;  sts = sys$parse(&myfab,0,0);
   _ckvmssts(sys$dassgn(chan));
   if (retsts & 1) retsts = iosb[0];
   if (!(retsts & 1)) {
@@ -6487,7 +7486,7 @@ static mydev_t encode_dev (pTHX_ const char *dev)
     dev_desc.dsc$w_length =  strlen (dev);
     dev_desc.dsc$b_dtype =   DSC$K_DTYPE_T;
     dev_desc.dsc$b_class =   DSC$K_CLASS_S;
-    dev_desc.dsc$a_pointer = (char *) dev;
+    dev_desc.dsc$a_pointer = (char *) dev;  /* Read only parameter */
     _ckvmssts(lib$getdvi(&item, 0, &dev_desc, &lockid, 0, 0));
     if (lockid) return (lockid & ~LOCKID_MASK);
   }
@@ -6538,7 +7537,7 @@ is_null_device(name)
  * subset of the applicable information.
  */
 bool
-Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp)
+Perl_cando(pTHX_ Mode_t bit, Uid_t effective, const Stat_t *statbufp)
 {
   char fname_phdev[NAM$C_MAXRSS+1];
   if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache);
@@ -6582,7 +7581,7 @@ Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp)
 
 /*{{{I32 cando_by_name(I32 bit, Uid_t effective, char *fname)*/
 I32
-Perl_cando_by_name(pTHX_ I32 bit, Uid_t effective, char *fname)
+Perl_cando_by_name(pTHX_ I32 bit, Uid_t effective, const char *fname)
 {
   static char usrname[L_cuserid];
   static struct dsc$descriptor_s usrdsc =
@@ -6653,7 +7652,7 @@ Perl_cando_by_name(pTHX_ I32 bit, Uid_t effective, char *fname)
                                     &usrprodsc.dsc$w_length,0));
 
   /* allocate space for the profile and get it filled in */
-  New(1330,usrprodsc.dsc$a_pointer,usrprodsc.dsc$w_length,char);
+  Newx(usrprodsc.dsc$a_pointer,usrprodsc.dsc$w_length,char);
   _ckvmssts(sys$create_user_profile(&usrdsc,&usrprolst,0,usrprodsc.dsc$a_pointer,
                                     &usrprodsc.dsc$w_length,0));
 
@@ -6693,7 +7692,16 @@ int
 Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
 {
   if (!fstat(fd,(stat_t *) statbufp)) {
-    if (statbufp == (Stat_t *) &PL_statcache) *namecache == '\0';
+    if (statbufp == (Stat_t *) &PL_statcache) {
+    char *cptr;
+
+	/* Save name for cando by name in VMS format */
+	cptr = getname(fd, namecache, 1);
+
+	/* This should not happen, but just in case */
+	if (cptr == NULL)
+	   namecache[0] = '\0';
+    }
     statbufp->st_dev = encode_dev(aTHX_ statbufp->st_devnam);
 #   ifdef RTL_USES_UTC
 #   ifdef VMSISH_TIME
@@ -6793,7 +7801,7 @@ Perl_flex_stat(pTHX_ const char *fspec, Stat_t *statbufp)
 /*{{{char *my_getlogin()*/
 /* VMS cuserid == Unix getlogin, except calling sequence */
 char *
-my_getlogin()
+my_getlogin(void)
 {
     static char user[L_cuserid];
     return cuserid(user);
@@ -6827,7 +7835,7 @@ my_getlogin()
  */
 /*{{{int rmscopy(char *src, char *dst, int preserve_dates)*/
 int
-Perl_rmscopy(pTHX_ char *spec_in, char *spec_out, int preserve_dates)
+Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates)
 {
     char vmsin[NAM$C_MAXRSS+1], vmsout[NAM$C_MAXRSS+1], esa[NAM$C_MAXRSS],
          rsa[NAM$C_MAXRSS], ubf[32256];
@@ -6861,6 +7869,10 @@ Perl_rmscopy(pTHX_ char *spec_in, char *spec_out, int preserve_dates)
     nam.nam$l_esa = esa;
     nam.nam$b_ess = sizeof (esa);
     nam.nam$b_esl = nam.nam$b_rsl = 0;
+#ifdef NAM$M_NO_SHORT_UPCASE
+    if (decc_efs_case_preserve)
+        nam.nam$b_nop |= NAM$M_NO_SHORT_UPCASE;
+#endif
 
     xabdat = cc$rms_xabdat;        /* To get creation date */
     xabdat.xab$l_nxt = (void *) &xabfhc;
@@ -6900,7 +7912,7 @@ Perl_rmscopy(pTHX_ char *spec_in, char *spec_out, int preserve_dates)
     fab_out.fab$b_dns = nam.nam$l_name ? nam.nam$b_name + nam.nam$b_type : 0;
 
     if (preserve_dates == 0) {  /* Act like DCL COPY */
-      nam.nam$b_nop = NAM$M_SYNCHK;
+      nam.nam$b_nop |= NAM$M_SYNCHK;
       fab_out.fab$l_xab = NULL;  /* Don't disturb data from input file */
       if (!((sts = sys$parse(&fab_out)) & 1)) {
         set_errno(sts == RMS$_SYN ? EINVAL : EVMSERR);
@@ -7302,7 +8314,7 @@ Perl_sys_intern_init(pTHX)
 }
 
 void
-init_os_extras()
+init_os_extras(void)
 {
   dTHX;
   char* file = __FILE__;
@@ -7324,10 +8336,353 @@ init_os_extras()
   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 0 /* future */
+#if __CRTL_VER >= 70301000 && !defined(__VAX)
+  newXSproto("VMS::Filespec::case_tolerant",vms_case_tolerant_fromperl,file,"$;$");
+#endif
+#endif
 
   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, ...);
+#endif
+
+/*{{{char *do_vms_realpath(const char *file_name, char *resolved_name)*/
+/* wrapper for the realpath() function added with 8.2 RMS SYMLINK SDK.
+ * The perl fallback routine to provide realpath() is not as efficient
+ * on OpenVMS.
+ */
+static char *
+mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf)
+{
+    return realpath(filespec, outbuf);
+}
+
+/*}}}*/
+/* External entry points */
+char *Perl_vms_realpath(pTHX_ const char *filespec, char *outbuf)
+{ return do_vms_realpath(filespec, outbuf); }
+#else
+char *Perl_vms_realpath(pTHX_ const char *filespec, char *outbuf)
+{ return NULL; }
+#endif
+
+
+#if __CRTL_VER >= 70301000 && !defined(__VAX)
+/* case_tolerant */
+
+/*{{{int do_vms_case_tolerant(void)*/
+/* OpenVMS provides a case sensitive implementation of ODS-5 and this is
+ * controlled by a process setting.
+ */
+int do_vms_case_tolerant(void)
+{
+    return vms_process_case_tolerant;
+}
+/*}}}*/
+/* External entry points */
+int Perl_vms_case_tolerant(void)
+{ return do_vms_case_tolerant(); }
+#else
+int Perl_vms_case_tolerant(void)
+{ return vms_process_case_tolerant; }
+#endif
+
+
+ /* Start of DECC RTL Feature handling */
+
+static int sys_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 status;
+}
+
+static int sys_crelnm
+   (const char * logname,
+    const char * value)
+{
+    int ret_val;
+    const char * proc_table = "LNM$PROCESS_TABLE";
+    struct dsc$descriptor_s proc_table_dsc;
+    struct dsc$descriptor_s logname_dsc;
+    struct itmlst_3 item_list[2];
+
+    proc_table_dsc.dsc$a_pointer = (char *) proc_table;
+    proc_table_dsc.dsc$w_length = strlen(proc_table);
+    proc_table_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
+    proc_table_dsc.dsc$b_class = DSC$K_CLASS_S;
+
+    logname_dsc.dsc$a_pointer = (char *) logname;
+    logname_dsc.dsc$w_length = strlen(logname);
+    logname_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
+    logname_dsc.dsc$b_class = DSC$K_CLASS_S;
+
+    item_list[0].buflen = strlen(value);
+    item_list[0].itmcode = LNM$_STRING;
+    item_list[0].bufadr = (char *)value;
+    item_list[0].retlen = NULL;
+
+    item_list[1].buflen = 0;
+    item_list[1].itmcode = 0;
+
+    ret_val = sys$crelnm
+		       (NULL,
+			(const struct dsc$descriptor_s *)&proc_table_dsc,
+			(const struct dsc$descriptor_s *)&logname_dsc,
+			NULL,
+			(const struct item_list_3 *) item_list);
+
+    return ret_val;
+}
+
+
+/* C RTL Feature settings */
+
+static int set_features
+   (int (* init_coroutine)(int *, int *, void *),  /* Needs casts if used */
+    int (* cli_routine)(void),	/* Not documented */
+    void *image_info)		/* Not documented */
+{
+    int status;
+    int s;
+    int dflt;
+    char* str;
+    char val_str[10];
+    const unsigned long int jpicode1 = JPI$_CASE_LOOKUP_PERM;
+    const unsigned long int jpicode2 = JPI$_CASE_LOOKUP_IMAGE;
+    unsigned long case_perm;
+    unsigned long case_image;
+
+#if __CRTL_VER >= 70300000 && !defined(__VAX)
+    s = decc$feature_get_index("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION");
+    if (s >= 0) {
+	decc_disable_to_vms_logname_translation = decc$feature_get_value(s, 1);
+	if (decc_disable_to_vms_logname_translation < 0)
+	    decc_disable_to_vms_logname_translation = 0;
+    }
+
+    s = decc$feature_get_index("DECC$EFS_CASE_PRESERVE");
+    if (s >= 0) {
+	decc_efs_case_preserve = decc$feature_get_value(s, 1);
+	if (decc_efs_case_preserve < 0)
+	    decc_efs_case_preserve = 0;
+    }
+
+    s = decc$feature_get_index("DECC$EFS_CHARSET");
+    if (s >= 0) {
+	decc_efs_charset = decc$feature_get_value(s, 1);
+	if (decc_efs_charset < 0)
+	    decc_efs_charset = 0;
+    }
+
+    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)
+	    decc_filename_unix_report = 1;
+	else
+	    decc_filename_unix_report = 0;
+    }
+
+    s = decc$feature_get_index("DECC$FILENAME_UNIX_ONLY");
+    if (s >= 0) {
+	decc_filename_unix_only = decc$feature_get_value(s, 1);
+	if (decc_filename_unix_only > 0) {
+	    decc_filename_unix_only = 1;
+	}
+	else {
+	    decc_filename_unix_only = 0;
+	}
+    }
+
+    s = decc$feature_get_index("DECC$FILENAME_UNIX_NO_VERSION");
+    if (s >= 0) {
+	decc_filename_unix_no_version = decc$feature_get_value(s, 1);
+	if (decc_filename_unix_no_version < 0)
+	    decc_filename_unix_no_version = 0;
+    }
+
+    s = decc$feature_get_index("DECC$READDIR_DROPDOTNOTYPE");
+    if (s >= 0) {
+	decc_readdir_dropdotnotype = decc$feature_get_value(s, 1);
+	if (decc_readdir_dropdotnotype < 0)
+	    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) {
+	decc_posix_compliant_pathnames = decc$feature_get_value(s, 1);
+	if (decc_posix_compliant_pathnames < 0)
+	    decc_posix_compliant_pathnames = 0;
+	if (decc_posix_compliant_pathnames > 4)
+	    decc_posix_compliant_pathnames = 0;
+    }
+
+#endif
+#else
+    status = sys_trnlnm
+	("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION", 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_disable_to_vms_logname_translation = 1;
+	}
+    }
+
+#ifndef __VAX
+    status = sys_trnlnm("DECC$EFS_CASE_PRESERVE", 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_efs_case_preserve = 1;
+	}
+    }
+#endif
+
+    status = sys_trnlnm("DECC$FILENAME_UNIX_REPORT", 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_filename_unix_report = 1;
+	}
+    }
+    status = sys_trnlnm("DECC$FILENAME_UNIX_ONLY", 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_filename_unix_only = 1;
+	   decc_filename_unix_report = 1;
+	}
+    }
+    status = sys_trnlnm("DECC$FILENAME_UNIX_NO_VERSION", 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_filename_unix_no_version = 1;
+	}
+    }
+    status = sys_trnlnm("DECC$READDIR_DROPDOTNOTYPE", 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_readdir_dropdotnotype = 1;
+	}
+    }
+#endif
+
+#ifndef __VAX
+
+     /* Report true case tolerance */
+    /*----------------------------*/
+    status = lib$getjpi(&jpicode1, 0, 0, &case_perm, 0, 0);
+    if (!$VMS_STATUS_SUCCESS(status))
+	case_perm = PPROP$K_CASE_BLIND;
+    status = lib$getjpi(&jpicode2, 0, 0, &case_image, 0, 0);
+    if (!$VMS_STATUS_SUCCESS(status))
+	case_image = PPROP$K_CASE_BLIND;
+    if ((case_perm == PPROP$K_CASE_SENSITIVE) ||
+	(case_image == PPROP$K_CASE_SENSITIVE))
+	vms_process_case_tolerant = 0;
+
+#endif
+
+
+    /* CRTL can be initialized past this point, but not before. */
+/*    DECC$CRTL_INIT(); */
+
+    return SS$_NORMAL;
+}
+
+#ifdef __DECC
+/* DECC dependent attributes */
+#if __DECC_VER < 60560002
+#define relative
+#define not_executable
+#else
+#define relative ,rel
+#define not_executable ,noexe
+#endif
+#pragma nostandard
+#pragma extern_model save
+#pragma extern_model strict_refdef "LIB$INITIALIZ" nowrt
+#endif
+	const __align (LONGWORD) int spare[8] = {0};
+/* .psect LIB$INITIALIZE, NOPIC, USR, CON, REL, GBL, NOSHR, NOEXE, RD, */
+/*			  NOWRT, LONG */
+#ifdef __DECC
+#pragma extern_model strict_refdef "LIB$INITIALIZE" con, gbl,noshr, \
+	nowrt,noshr relative not_executable
+#endif
+const long vms_cc_features = (const long)set_features;
+
+/*
+** Force a reference to LIB$INITIALIZE to ensure it
+** exists in the image.
+*/
+int lib$initialize(void);
+#ifdef __DECC
+#pragma extern_model strict_refdef
+#endif
+    int lib_init_ref = (int) lib$initialize;
+
+#ifdef __DECC
+#pragma extern_model restore
+#pragma standard
+#endif
+
 /*  End of vms.c */