From: John E. Malmberg <wb8tyw@qsl.net>
Date: Wed, 10 Aug 2005 00:37:13 +0000 (-0400)
Subject: patch@25279 VMS error handling and const fixes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2fbb330f9938ff7e61d0006c9b3a662963250509;p=p5sagit%2Fp5-mst-13.2.git

patch@25279 VMS error handling and const fixes
From: "John E. Malmberg" <wb8tyw@qsl.net>
Message-ID: <42F98479.6030207@qsl.net>

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

diff --git a/doio.c b/doio.c
index b84a56e..91ef7a2 100644
--- a/doio.c
+++ b/doio.c
@@ -59,7 +59,7 @@
 #include <signal.h>
 
 bool
-Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
 	     int rawmode, int rawperm, PerlIO *supplied_fp)
 {
     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
@@ -67,7 +67,7 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 }
 
 bool
-Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
 	      int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 	      I32 num_svs)
 {
@@ -77,7 +77,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 }
 
 bool
-Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	      int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
 	      I32 num_svs)
 {
@@ -194,7 +194,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
         IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
-	namesv = sv_2mortal(newSVpvn(name,strlen(name)));
+	namesv = sv_2mortal(newSVpvn(oname,strlen(oname)));
 	num_svs = 1;
 	svp = &namesv;
         type = Nullch;
@@ -202,13 +202,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
     else {
 	/* Regular (non-sys) open */
-	char *oname = name;
+	char *name;
 	STRLEN olen = len;
 	char *tend;
 	int dodup = 0;
 	PerlIO *that_fp = NULL;
 
-	type = savepvn(name, len);
+	type = savepvn(oname, len);
 	tend = type+len;
 	SAVEFREEPV(type);
 
@@ -220,7 +220,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	if (num_svs) {
 	    /* New style explicit name, type is just mode and layer info */
 #ifdef USE_STDIO
-	    if (SvROK(*svp) && !strchr(name,'&')) {
+	    if (SvROK(*svp) && !strchr(oname,'&')) {
 		if (ckWARN(WARN_IO))
 		    Perl_warner(aTHX_ packWARN(WARN_IO),
 			    "Can't open a reference");
@@ -567,7 +567,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
     if (!fp) {
 	if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
-	    && strchr(name, '\n')
+	    && strchr(oname, '\n')
 	    
 	)
 	    Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
@@ -1509,17 +1509,25 @@ Perl_do_execfree(pTHX)
 #if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(SYMBIAN) && !defined(MACOS_TRADITIONAL)
 
 bool
-Perl_do_exec(pTHX_ char *cmd)
+Perl_do_exec(pTHX_ const char *cmd)
 {
     return do_exec3(cmd,0,0);
 }
 
 bool
-Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
+Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 {
     dVAR;
     register char **a;
     register char *s;
+    char *cmd;
+    int cmdlen;
+
+    /* Make a copy so we can change it */
+    cmdlen = strlen(incmd);
+    Newx(cmd, cmdlen+1, char);
+    strncpy(cmd, incmd, cmdlen);
+    cmd[cmdlen] = 0;
 
     while (*cmd && isSPACE(*cmd))
 	cmd++;
@@ -1560,6 +1568,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 		  PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0);
 		  PERL_FPU_POST_EXEC
 		  *s = '\'';
+		  Safefree(cmd);
 		  return FALSE;
 	      }
 	  }
@@ -1604,6 +1613,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 	    PERL_FPU_PRE_EXEC
 	    PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0);
 	    PERL_FPU_POST_EXEC
+	    Safefree(cmd);
 	    return FALSE;
 	}
     }
@@ -1640,6 +1650,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 	}
     }
     do_execfree();
+    Safefree(cmd);
     return FALSE;
 }
 
diff --git a/embed.fnc b/embed.fnc
index ea29b06..3f00817 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -181,14 +181,14 @@ Ap	|int	|do_binmode	|NN PerlIO *fp|int iotype|int mode
 p	|void	|do_chop	|NN SV* asv|NN SV* sv
 Ap	|bool	|do_close	|NN GV* gv|bool not_implicit
 p	|bool	|do_eof		|NN GV* gv
-p	|bool	|do_exec	|NN char* cmd
+p	|bool	|do_exec	|NN const char* cmd
 #if defined(WIN32) || defined(SYMBIAN)
 Ap	|int	|do_aspawn	|NN SV* really|NN SV** mark|NN SV** sp
 Ap	|int	|do_spawn	|NN char* cmd
 Ap	|int	|do_spawn_nowait|NN char* cmd
 #endif
 #if !defined(WIN32)
-p	|bool	|do_exec3	|NN char* cmd|int fd|int flag
+p	|bool	|do_exec3	|NN const char* cmd|int fd|int flag
 #endif
 p	|void	|do_execfree
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
@@ -201,12 +201,12 @@ p	|I32	|do_shmio	|I32 optype|SV** mark|SV** sp
 #endif
 Ap	|void	|do_join	|NN SV* sv|NN SV* del|NN SV** mark|NN SV** sp
 p	|OP*	|do_kv
-Ap	|bool	|do_open	|NN GV* gv|NN char* name|I32 len|int as_raw \
+Ap	|bool	|do_open	|NN GV* gv|NN const char* name|I32 len|int as_raw \
 				|int rawmode|int rawperm|NULLOK PerlIO* supplied_fp
-Ap	|bool	|do_open9	|NN GV *gv|NN char *name|I32 len|int as_raw \
+Ap	|bool	|do_open9	|NN GV *gv|NN const char *name|I32 len|int as_raw \
 				|int rawmode|int rawperm|NULLOK PerlIO *supplied_fp \
 				|NN SV *svs|I32 num
-Ap	|bool	|do_openn	|NN GV *gv|NN char *name|I32 len|int as_raw \
+Ap	|bool	|do_openn	|NN GV *gv|NN const char *name|I32 len|int as_raw \
 				|int rawmode|int rawperm|NULLOK PerlIO *supplied_fp \
 				|NULLOK SV **svp|I32 num
 p	|void	|do_pipe	|NN SV* sv|NULLOK GV* rgv|NULLOK GV* wgv
@@ -483,7 +483,7 @@ AnpP	|I32	|my_memcmp	|NN const char* s1|NN const char* s2|I32 len
 Anp	|void*	|my_memset	|NN char* loc|I32 ch|I32 len
 #endif
 Ap	|I32	|my_pclose	|PerlIO* ptr
-Ap	|PerlIO*|my_popen	|char* cmd|char* mode
+Ap	|PerlIO*|my_popen	|const char* cmd|const char* mode
 Ap	|PerlIO*|my_popen_list	|char* mode|int n|SV ** args
 Ap	|void	|my_setenv	|const char* nam|const char* val
 Ap	|I32	|my_stat
diff --git a/perl.h b/perl.h
index 6889fce..efdf7ed 100644
--- a/perl.h
+++ b/perl.h
@@ -2547,17 +2547,25 @@ typedef pthread_key_t	perl_key;
 #   define STATUS_NATIVE	PL_statusvalue_vms
 #   define STATUS_NATIVE_EXPORT \
 	(((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0))
-#   define STATUS_NATIVE_SET(n)						\
+#   define STATUS_NATIVE_SET(n) STATUS_NATIVE_SET_PORC(n, 0)
+#   define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET_PORC(n, 1)
+#   define STATUS_NATIVE_SET_PORC(n, _x)				\
 	STMT_START {							\
-	    PL_statusvalue_vms = (n);					\
-	    if ((I32)PL_statusvalue_vms == -1)				\
+	    I32 evalue = (I32)n;					\
+	    if (evalue == EVMSERR) {					\
+	      PL_statusvalue_vms = vaxc$errno;				\
+	      PL_statusvalue = evalue;					\
+	    }								\
+	    else {							\
+	      PL_statusvalue_vms = evalue;				\
+	      if ((I32)PL_statusvalue_vms == -1)			\
 		PL_statusvalue = -1;					\
-	    else if (PL_statusvalue_vms & STS$M_SUCCESS)		\
-		PL_statusvalue = 0;					\
-	    else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0)	\
-		PL_statusvalue = 1 << 8;				\
-	    else							\
-		PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8;	\
+	      else							\
+		PL_statusvalue = vms_status_to_unix(evalue);		\
+	      set_vaxc_errno(evalue);					\
+	      set_errno(PL_statusvalue);				\
+	      if (_x) PL_statusvalue = PL_statusvalue << 8;		\
+	    }								\
 	} STMT_END
 #   ifdef VMSISH_STATUS
 #	define STATUS_CURRENT	(VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX)
@@ -2568,8 +2576,13 @@ typedef pthread_key_t	perl_key;
 	STMT_START {					\
 	    PL_statusvalue = (n);				\
 	    if (PL_statusvalue != -1) {			\
-		PL_statusvalue &= 0xFFFF;			\
-		PL_statusvalue_vms = PL_statusvalue ? 44 : 1;	\
+		if (PL_statusvalue != EVMSERR) {		\
+		  PL_statusvalue &= 0xFFFF;			\
+		  PL_statusvalue_vms = PL_statusvalue ? 44 : 1;	\
+		}						\
+		else {						\
+		  PL_statusvalue_vms = vaxc$errno;		\
+		}						\
 	    }						\
 	    else PL_statusvalue_vms = -1;			\
 	} STMT_END
@@ -2579,6 +2592,7 @@ typedef pthread_key_t	perl_key;
 #   define STATUS_NATIVE	PL_statusvalue_posix
 #   define STATUS_NATIVE_EXPORT	STATUS_NATIVE
 #   if defined(WCOREDUMP)
+#       define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n)
 #       define STATUS_NATIVE_SET(n)                        \
             STMT_START {                                   \
                 PL_statusvalue_posix = (n);                \
@@ -2592,6 +2606,7 @@ typedef pthread_key_t	perl_key;
                 }                                          \
             } STMT_END
 #   elif defined(WIFEXITED)
+#       define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n)
 #       define STATUS_NATIVE_SET(n)                        \
             STMT_START {                                   \
                 PL_statusvalue_posix = (n);                \
@@ -2604,6 +2619,7 @@ typedef pthread_key_t	perl_key;
                 }                                          \
             } STMT_END
 #   else
+#       define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n)
 #       define STATUS_NATIVE_SET(n)                        \
             STMT_START {                                   \
                 PL_statusvalue_posix = (n);                \
diff --git a/pp_sys.c b/pp_sys.c
index 7b33376..f082b4c 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -339,7 +339,7 @@ PP(pp_backtick)
 	mode = "rb";
     else if (PL_op->op_private & OPpOPEN_IN_CRLF)
 	mode = "rt";
-    fp = PerlProc_popen((char*)tmps, (char *)mode);
+    fp = PerlProc_popen(tmps, mode);
     if (fp) {
         const char *type = NULL;
 	if (PL_curcop->cop_io) {
@@ -378,7 +378,7 @@ PP(pp_backtick)
 		SvTAINTED_on(sv);
 	    }
 	}
-	STATUS_NATIVE_SET(PerlProc_pclose(fp));
+	STATUS_NATIVE_CHILD_SET(PerlProc_pclose(fp));
 	TAINT;		/* "I believe that this is not gratuitous!" */
     }
     else {
@@ -571,7 +571,7 @@ PP(pp_open)
     }
 
     tmps = SvPV_const(sv, len);
-    ok = do_openn(gv, (char *)tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
+    ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
     SP = ORIGMARK;
     if (ok)
 	PUSHi( (I32)PL_forkprocess );
@@ -1537,7 +1537,7 @@ PP(pp_sysopen)
     /* Need TIEHANDLE method ? */
     const char * const tmps = SvPV_const(sv, len);
     /* FIXME? do_open should do const  */
-    if (do_open(gv, (char*)tmps, len, TRUE, mode, perm, Nullfp)) {
+    if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
 	IoLINES(GvIOp(gv)) = 0;
 	PUSHs(&PL_sv_yes);
     }
@@ -1971,7 +1971,7 @@ PP(pp_eof)
 		if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
 		    IoLINES(io) = 0;
 		    IoFLAGS(io) &= ~IOf_START;
-		    do_open(gv, (char *)"-", 1, FALSE, O_RDONLY, 0, Nullfp);
+		    do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp);
 		    sv_setpvn(GvSV(gv), "-", 1);
 		    SvSETMAGIC(GvSV(gv));
 		}
@@ -2760,7 +2760,7 @@ PP(pp_getpeername)
 	    static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
 	    /* If the call succeeded, make sure we don't have a zeroed port/addr */
 	    if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET &&
-		!memcmp((char *)SvPVX_const(sv) + sizeof(u_short), nowhere,
+		!memcmp(SvPVX_const(sv) + sizeof(u_short), nowhere,
 			sizeof(u_short) + sizeof(struct in_addr))) {
 		goto nuts2;	
 	    }
@@ -4152,9 +4152,9 @@ PP(pp_wait)
     }
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
-    STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+    STATUS_NATIVE_CHILD_SET((childpid && childpid != -1) ? argflags : -1);
 #  else
-    STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+    STATUS_NATIVE_CHILD_SET((childpid > 0) ? argflags : -1);
 #  endif
     XPUSHi(childpid);
     RETURN;
@@ -4184,9 +4184,9 @@ PP(pp_waitpid)
     }
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
-    STATUS_NATIVE_SET((result && result != -1) ? argflags : -1);
+    STATUS_NATIVE_CHILD_SET((result && result != -1) ? argflags : -1);
 #  else
-    STATUS_NATIVE_SET((result > 0) ? argflags : -1);
+    STATUS_NATIVE_CHILD_SET((result > 0) ? argflags : -1);
 #  endif
     SETi(result);
     RETURN;
@@ -4316,7 +4316,7 @@ PP(pp_system)
     }
     if (PL_statusvalue == -1)	/* hint that value must be returned as is */
 	result = 1;
-    STATUS_NATIVE_SET(value);
+    STATUS_NATIVE_CHILD_SET(value);
     do_execfree();
     SP = ORIGMARK;
     PUSHi(result ? value : STATUS_CURRENT);
diff --git a/proto.h b/proto.h
index 41b553a..4870a8c 100644
--- a/proto.h
+++ b/proto.h
@@ -357,7 +357,7 @@ PERL_CALLCONV bool	Perl_do_close(pTHX_ GV* gv, bool not_implicit)
 PERL_CALLCONV bool	Perl_do_eof(pTHX_ GV* gv)
 			__attribute__nonnull__(pTHX_1);
 
-PERL_CALLCONV bool	Perl_do_exec(pTHX_ char* cmd)
+PERL_CALLCONV bool	Perl_do_exec(pTHX_ const char* cmd)
 			__attribute__nonnull__(pTHX_1);
 
 #if defined(WIN32) || defined(SYMBIAN)
@@ -374,7 +374,7 @@ PERL_CALLCONV int	Perl_do_spawn_nowait(pTHX_ char* cmd)
 
 #endif
 #if !defined(WIN32)
-PERL_CALLCONV bool	Perl_do_exec3(pTHX_ char* cmd, int fd, int flag)
+PERL_CALLCONV bool	Perl_do_exec3(pTHX_ const char* cmd, int fd, int flag)
 			__attribute__nonnull__(pTHX_1);
 
 #endif
@@ -394,16 +394,16 @@ PERL_CALLCONV void	Perl_do_join(pTHX_ SV* sv, SV* del, SV** mark, SV** sp)
 			__attribute__nonnull__(pTHX_4);
 
 PERL_CALLCONV OP*	Perl_do_kv(pTHX);
-PERL_CALLCONV bool	Perl_do_open(pTHX_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp)
+PERL_CALLCONV bool	Perl_do_open(pTHX_ GV* gv, const char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
 
-PERL_CALLCONV bool	Perl_do_open9(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num)
+PERL_CALLCONV bool	Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)
 			__attribute__nonnull__(pTHX_8);
 
-PERL_CALLCONV bool	Perl_do_openn(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num)
+PERL_CALLCONV bool	Perl_do_openn(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
 
@@ -1075,7 +1075,7 @@ PERL_CALLCONV void*	Perl_my_memset(char* loc, I32 ch, I32 len)
 
 #endif
 PERL_CALLCONV I32	Perl_my_pclose(pTHX_ PerlIO* ptr);
-PERL_CALLCONV PerlIO*	Perl_my_popen(pTHX_ char* cmd, char* mode);
+PERL_CALLCONV PerlIO*	Perl_my_popen(pTHX_ const char* cmd, const char* mode);
 PERL_CALLCONV PerlIO*	Perl_my_popen_list(pTHX_ char* mode, int n, SV ** args);
 PERL_CALLCONV void	Perl_my_setenv(pTHX_ const char* nam, const char* val);
 PERL_CALLCONV I32	Perl_my_stat(pTHX);
diff --git a/vms/vms.c b/vms/vms.c
index 3cfdb71..3124c8b 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
@@ -41,6 +42,8 @@
 #include <syidef.h>
 #include <uaidef.h>
 #include <uicdef.h>
+#include <stsdef.h>
+#include <rmsdef.h>
 
 /* Older versions of ssdef.h don't have these */
 #ifndef SS$_INVFILFOROP
@@ -923,7 +926,7 @@ Perl_my_setenv(pTHX_ const char *lnm, const 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};
@@ -931,11 +934,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);
@@ -1004,7 +1007,7 @@ 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_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);
 
@@ -1301,7 +1304,6 @@ Perl_sig_to_vmscondition(int sig)
     return sig_code[sig];
 }
 
-
 int
 Perl_my_kill(int pid, int sig)
 {
@@ -1340,6 +1342,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
 
@@ -1676,7 +1833,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);
 
 /*
@@ -2337,7 +2494,7 @@ 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;
@@ -2655,7 +2812,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;
     }
@@ -2665,7 +2824,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();
@@ -2950,7 +3109,7 @@ my_gconvert(double val, int ndig, int trail, char *buf)
 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];
@@ -2973,7 +3132,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;
 
@@ -2982,7 +3141,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);
   }
 
@@ -3040,7 +3199,7 @@ 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;
+      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;
       if (sys$parse(&deffab,0,0) & 1) {
@@ -3085,9 +3244,9 @@ mp_do_rmsexpand(pTHX_ char *filespec, char *outbuf, int ts, char *defspec, unsig
 }
 /*}}}*/
 /* 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); }
 
 
@@ -3927,8 +4086,8 @@ static char *mp_do_tovmsspec(pTHX_ const 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_ const char *path, char *buf, int ts) {
@@ -4697,18 +4856,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;
@@ -5209,7 +5371,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];
@@ -5220,9 +5382,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;
 
   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;
@@ -5231,9 +5402,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 == '$') {
@@ -5323,6 +5498,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;
@@ -5337,6 +5513,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;     
@@ -5384,7 +5562,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;
 
@@ -5436,7 +5614,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
@@ -5450,7 +5628,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;
 
@@ -5486,7 +5664,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() */
@@ -5753,7 +5934,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;
@@ -6774,7 +6955,7 @@ Perl_cando(pTHX_ Mode_t bit, Uid_t effective, const 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 =
@@ -6985,7 +7166,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);
@@ -7019,7 +7200,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];
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 45e831a..e4e9595 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -347,6 +347,7 @@ struct interp_intern {
  *	This symbol, if defined, indicates that the program is running under
  *	VMS.  It's a symbol automagically defined by all VMS C compilers I've seen.
  * Just in case, however . . . */
+/* Note that code really should be using __VMS to comply with ANSI */
 #ifndef VMS
 #define VMS		/**/
 #endif
@@ -760,7 +761,8 @@ typedef unsigned myino_t;
 #endif
 
 void	prime_env_iter (void);
-void	init_os_extras ();
+void	init_os_extras (void);
+int	vms_status_to_unix(int vms_status);
 /* prototype section start marker; `typedef' passes through cpp */
 typedef char  __VMS_PROTOTYPES__;
 int	Perl_vmstrnenv (const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int);
@@ -769,8 +771,8 @@ char *	Perl_my_getenv (const char *, bool);
 int	Perl_my_trnlnm (const char *, char *, unsigned long int);
 char *	Perl_tounixspec (const char *, char *);
 char *	Perl_tounixspec_ts (const char *, char *);
-char *	Perl_tovmsspec (char *, char *);
-char *	Perl_tovmsspec_ts (char *, char *);
+char *	Perl_tovmsspec (const char *, char *);
+char *	Perl_tovmsspec_ts (const char *, char *);
 char *	Perl_tounixpath (const char *, char *);
 char *	Perl_tounixpath_ts (const char *, char *);
 char *	Perl_tovmspath (const char *, char *);
@@ -780,11 +782,11 @@ char *	Perl_fileify_dirspec (const char *, char *);
 char *	Perl_fileify_dirspec_ts (const char *, char *);
 char *	Perl_pathify_dirspec (const char *, char *);
 char *	Perl_pathify_dirspec_ts (const char *, char *);
-char *	Perl_rmsexpand (char *, char *, char *, unsigned);
-char *	Perl_rmsexpand_ts (char *, char *, char *, unsigned);
-int	Perl_trim_unixpath (char *, char*, int);
+char *	Perl_rmsexpand (const char *, char *, const char *, unsigned);
+char *	Perl_rmsexpand_ts (const char *, char *, const char *, unsigned);
+int	Perl_trim_unixpath (char *, const char*, int);
 DIR *	Perl_opendir (const char *);
-int	Perl_rmscopy (char *, char *, int);
+int	Perl_rmscopy (const char *, const char *, int);
 int	Perl_my_mkdir (const char *, Mode_t);
 bool	Perl_vms_do_aexec (SV *, SV **, SV **);
 #else
@@ -792,8 +794,8 @@ char *	Perl_my_getenv (pTHX_ const char *, bool);
 int	Perl_my_trnlnm (pTHX_ const char *, char *, unsigned long int);
 char *	Perl_tounixspec (pTHX_ const char *, char *);
 char *	Perl_tounixspec_ts (pTHX_ const char *, char *);
-char *	Perl_tovmsspec (pTHX_ char *, char *);
-char *	Perl_tovmsspec_ts (pTHX_ char *, char *);
+char *	Perl_tovmsspec (pTHX_ const char *, char *);
+char *	Perl_tovmsspec_ts (pTHX_ const char *, char *);
 char *	Perl_tounixpath (pTHX_ const char *, char *);
 char *	Perl_tounixpath_ts (pTHX_ const char *, char *);
 char *	Perl_tovmspath (pTHX_ const char *, char *);
@@ -803,23 +805,23 @@ char *	Perl_fileify_dirspec (pTHX_ const char *, char *);
 char *	Perl_fileify_dirspec_ts (pTHX_ const char *, char *);
 char *	Perl_pathify_dirspec (pTHX_ const char *, char *);
 char *	Perl_pathify_dirspec_ts (pTHX_ const char *, char *);
-char *	Perl_rmsexpand (pTHX_ char *, char *, char *, unsigned);
-char *	Perl_rmsexpand_ts (pTHX_ char *, char *, char *, unsigned);
-int	Perl_trim_unixpath (pTHX_ char *, char*, int);
+char *	Perl_rmsexpand (pTHX_ const char *, char *, const char *, unsigned);
+char *	Perl_rmsexpand_ts (pTHX_ const char *, char *, const char *, unsigned);
+int	Perl_trim_unixpath (pTHX_ char *, const char*, int);
 DIR *	Perl_opendir (pTHX_ const char *);
-int	Perl_rmscopy (pTHX_ char *, char *, int);
+int	Perl_rmscopy (pTHX_ const char *, const char *, int);
 int	Perl_my_mkdir (pTHX_ const char *, Mode_t);
 bool	Perl_vms_do_aexec (pTHX_ SV *, SV **, SV **);
 #endif
 char *	Perl_my_getenv_len (pTHX_ const char *, unsigned long *, bool);
 int	Perl_vmssetenv (pTHX_ const char *, const char *, struct dsc$descriptor_s **);
-void	Perl_vmssetuserlnm(pTHX_ char *name, char *eqv);
+void	Perl_vmssetuserlnm(pTHX_ const char *name, const char *eqv);
 char *	Perl_my_crypt (pTHX_ const char *, const char *);
 Pid_t	Perl_my_waitpid (pTHX_ Pid_t, int *, int);
 char *	my_gconvert (double, int, int, char *);
 int	Perl_kill_file (pTHX_ const char *);
 int	Perl_my_chdir (pTHX_ const char *);
-FILE *	Perl_my_tmpfile ();
+FILE *	Perl_my_tmpfile (void);
 #ifndef HOMEGROWN_POSIX_SIGNALS
 int	Perl_my_sigaction (pTHX_ int, const struct sigaction*, struct sigaction*);
 #endif
@@ -847,21 +849,21 @@ int     my_sigdelset   (sigset_t *, int);
 int     my_sigismember (sigset_t *, int);
 int     my_sigprocmask (int, sigset_t *, sigset_t *);
 #endif
-I32	Perl_cando_by_name (pTHX_ I32, Uid_t, char *);
+I32	Perl_cando_by_name (pTHX_ I32, Uid_t, const char *);
 int	Perl_flex_fstat (pTHX_ int, Stat_t *);
 int	Perl_flex_stat (pTHX_ const char *, Stat_t *);
-int	my_vfork ();
-bool	Perl_vms_do_exec (pTHX_ char *);
+int	my_vfork (void);
+bool	Perl_vms_do_exec (pTHX_ const char *);
 unsigned long int	Perl_do_aspawn (pTHX_ void *, void **, void **);
-unsigned long int	Perl_do_spawn (pTHX_ char *);
+unsigned long int	Perl_do_spawn (pTHX_ const char *);
 FILE *  my_fdopen (int, const char *);
 int     my_fclose (FILE *);
 int    my_fwrite (const void *, size_t, size_t, FILE *);
 int	Perl_my_flush (pTHX_ FILE *);
-struct passwd *	Perl_my_getpwnam (pTHX_ char *name);
+struct passwd *	Perl_my_getpwnam (pTHX_ const char *name);
 struct passwd *	Perl_my_getpwuid (pTHX_ Uid_t uid);
-void	my_endpwent ();
-char *	my_getlogin ();
+void	my_endpwent (pTHX);
+char *	my_getlogin (void);
 typedef char __VMS_SEPYTOTORP__;
 /* prototype section end marker; `typedef' passes through cpp */