X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/de6cd452fde5aaf57e339f71b33b6a0852f0f96d..406c51eefa6c9c4f403ef7f86adb46a627701935:/doio.c

diff --git a/doio.c b/doio.c
index 0da9856..84d2aaa 100644
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,6 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -51,23 +51,12 @@
 #include <signal.h>
 #endif
 
-#ifdef SOCKS_64BIT_BUG
-typedef struct __s64_iobuffer {
-    struct __s64_iobuffer *next, *last;		/* Queue pointer */
-    PerlIO *fp;					/* assigned file pointer */
-    int cnt;					/* Buffer counter */
-    int size;					/* Buffer size */
-    int *buffer;				/* the buffer */
-} S64_IOB;
-
-#endif
-
 bool
 Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	     int rawmode, int rawperm, PerlIO *supplied_fp)
 {
-    return do_open9(gv, name, len, as_raw, rawmode, rawperm,
-		    supplied_fp, Nullsv, 0);
+    return do_openn(gv, name, len, as_raw, rawmode, rawperm,
+		    supplied_fp, (SV **) NULL, 0);
 }
 
 bool
@@ -75,9 +64,19 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	      int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 	      I32 num_svs)
 {
+    return do_openn(gv, name, len, as_raw, rawmode, rawperm,
+		    supplied_fp, &svs, 1);
+}
+
+bool
+Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+	      int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
+	      I32 num_svs)
+{
     register IO *io = GvIOn(gv);
     PerlIO *saveifp = Nullfp;
     PerlIO *saveofp = Nullfp;
+    int savefd = -1;
     char savetype = IoTYPE_CLOSED;
     int writing = 0;
     PerlIO *fp;
@@ -86,8 +85,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     bool was_fdopen = FALSE;
     bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
     char *type  = NULL;
-    char *deftype = NULL;
-    char mode[4];		/* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
+    char mode[8];		/* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
+    SV *namesv;
 
     Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;		/* assume true if no fork */
@@ -105,13 +104,17 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     /* If currently open - close before we re-open */
     if (IoIFP(io)) {
 	fd = PerlIO_fileno(IoIFP(io));
-	if (IoTYPE(io) == IoTYPE_STD)
+	if (IoTYPE(io) == IoTYPE_STD) {
+	    /* This is a clone of one of STD* handles */
 	    result = 0;
-	else if (fd <= PL_maxsysfd) {
-	    saveifp = IoIFP(io);
-	    saveofp = IoOFP(io);
+	}
+	else if (fd >= 0 && fd <= PL_maxsysfd) {
+	    /* This is one of the original STD* handles */
+	    saveifp  = IoIFP(io);
+	    saveofp  = IoOFP(io);
 	    savetype = IoTYPE(io);
-	    result = 0;
+	    savefd   = fd;
+	    result   = 0;
 	}
 	else if (IoTYPE(io) == IoTYPE_PIPE)
 	    result = PerlProc_pclose(IoIFP(io));
@@ -125,18 +128,34 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	}
 	else
 	    result = PerlIO_close(IoIFP(io));
-	if (result == EOF && fd > PL_maxsysfd)
+	if (result == EOF && fd > PL_maxsysfd) {
+	    /* Why is this not Perl_warn*() call ? */
 	    PerlIO_printf(Perl_error_log,
 			  "Warning: unable to close filehandle %s properly.\n",
 			  GvENAME(gv));
+	}
 	IoOFP(io) = IoIFP(io) = Nullfp;
     }
 
     if (as_raw) {
         /* sysopen style args, i.e. integer mode and permissions */
+	STRLEN ix = 0;
+	if (num_svs != 0) {
+	     Perl_croak(aTHX_ "panic: sysopen with multiple args");
+	}
+	if (rawmode & (O_WRONLY|O_RDWR|O_CREAT
+#ifdef O_APPEND	/* Not fully portable. */
+		       |O_APPEND
+#endif
+#ifdef O_TRUNC	/* Not fully portable. */
+		       |O_TRUNC
+#endif
+		       ))
+	    TAINT_PROPER("sysopen");
+	mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
 
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
-	rawmode |= O_LARGEFILE;
+	rawmode |= O_LARGEFILE;	/* Transparently largefiley. */
 #endif
 
 #ifndef O_ACCMODE
@@ -155,39 +174,35 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	     IoTYPE(io) = IoTYPE_RDWR;
 	     break;
 	}
-
 	writing = (result > 0);
-	fd = PerlLIO_open3(name, rawmode, rawperm);
 
-	if (fd == -1)
-	    fp = NULL;
-	else {
-	    STRLEN ix = 0;
-	    if (result == O_RDONLY) {
-		mode[ix++] = 'r';
-	    }
+	if (result == O_RDONLY) {
+	    mode[ix++] = 'r';
+	}
 #ifdef O_APPEND
-	    else if (rawmode & O_APPEND) {
-		mode[ix++] = 'a';
-		if (result != O_WRONLY)
-		    mode[ix++] = '+';
-	    }
+	else if (rawmode & O_APPEND) {
+	    mode[ix++] = 'a';
+	    if (result != O_WRONLY)
+		mode[ix++] = '+';
+	}
 #endif
+	else {
+	    if (result == O_WRONLY)
+		mode[ix++] = 'w';
 	    else {
-		if (result == O_WRONLY)
-		    mode[ix++] = 'w';
-		else {
-		    mode[ix++] = 'r';
-		    mode[ix++] = '+';
-		}
+		mode[ix++] = 'r';
+		mode[ix++] = '+';
 	    }
-	    if (rawmode & O_BINARY)
-		mode[ix++] = 'b';
-	    mode[ix] = '\0';
-	    fp = PerlIO_fdopen(fd, mode);
-	    if (!fp)
-		PerlLIO_close(fd);
 	}
+	if (rawmode & O_BINARY)
+	    mode[ix++] = 'b';
+	mode[ix] = '\0';
+
+	namesv = sv_2mortal(newSVpvn(name,strlen(name)));
+	num_svs = 1;
+	svp = &namesv;
+        type = Nullch;
+	fp = PerlIO_openn(aTHX_ type, mode, -1, rawmode, rawperm, NULL, num_svs, svp);
     }
     else {
 	/* Regular (non-sys) open */
@@ -204,8 +219,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    *tend-- = '\0';
 	if (num_svs) {
 	    /* New style explict name, type is just mode and discipline/layer info */
-	    STRLEN l;
-	    name = SvPV(svs, l) ;
+	    STRLEN l = 0;
+	    name = SvOK(*svp) ? SvPV(*svp, l) : "";
 	    len = (I32)l;
 	    name = savepvn(name, len);
 	    SAVEFREEPV(name);
@@ -217,7 +232,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    len  = tend-type;
 	}
 	IoTYPE(io) = *type;
-	if (*type == IoTYPE_RDWR && (!num_svs || tend > type+1 && tend[-1] != IoTYPE_PIPE)) { /* scary */
+	if ((*type == IoTYPE_RDWR) && /* scary */
+	    ((!num_svs || (tend > type+1 && tend[-1] != IoTYPE_PIPE)))) {
 	    mode[1] = *type++;
 	    writing = 1;
 	}
@@ -236,8 +252,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		name = type;
 		len = tend-type;
 	    }
-	    if (*name == '\0') { /* command is missing 19990114 */
-		dTHR;
+	    if (*name == '\0') {
+		/* command is missing 19990114 */
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
 		errno = EPIPE;
@@ -247,7 +263,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		TAINT_ENV();
 	    TAINT_PROPER("piped open");
 	    if (!num_svs && name[len-1] == '|') {
-		dTHR;
 		name[--len] = '\0' ;
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe");
@@ -258,7 +273,12 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		strcat(mode, "b");
 	    else if (out_crlf)
 		strcat(mode, "t");
-	    fp = PerlProc_popen(name,mode);
+	    if (num_svs > 1) {
+		fp = PerlProc_popen_list(mode, num_svs, svp);
+	    }
+	    else {
+		fp = PerlProc_popen(name,mode);
+	    }
 	}
 	else if (*type == IoTYPE_WRONLY) {
 	    TAINT_PROPER("open");
@@ -268,8 +288,9 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		mode[0] = IoTYPE(io) = IoTYPE_APPEND;
 		type++;
 	    }
-	    else
+	    else {
 		mode[0] = 'w';
+	    }
 	    writing = 1;
 
 	    if (out_raw)
@@ -278,27 +299,41 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		strcat(mode, "t");
 
 	    if (*type == '&') {
-		name = type;
 	      duplicity:
-		if (num_svs)
-		    goto unknown_desr;
 		dodup = 1;
-		name++;
-		if (*name == '=') {
+		type++;
+		if (*type == '=') {
 		    dodup = 0;
-		    name++;
+		    type++;
 		}
-		if (!*name && supplied_fp)
+		if (!num_svs && !*type && supplied_fp) {
+		    /* "<+&" etc. is used by typemaps */
 		    fp = supplied_fp;
+		}
 		else {
-		    /*SUPPRESS 530*/
-		    for (; isSPACE(*name); name++) ;
-		    if (isDIGIT(*name))
-			fd = atoi(name);
+		    if (num_svs > 1) {
+			Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
+		    }
+		    if (num_svs && SvIOK(*svp)) {
+			fd = SvUV(*svp);
+		    }
+		    else if (isDIGIT(*type)) {
+			/*SUPPRESS 530*/
+			for (; isSPACE(*type); type++) ;
+			fd = atoi(type);
+		    }
 		    else {
 			IO* thatio;
-			gv = gv_fetchpv(name,FALSE,SVt_PVIO);
-			thatio = GvIO(gv);
+			if (num_svs) {
+			    thatio = sv_2io(*svp);
+			}
+			else {
+			    GV *thatgv;
+			    /*SUPPRESS 530*/
+			    for (; isSPACE(*type); type++) ;
+			    thatgv = gv_fetchpv(type,FALSE,SVt_PVIO);
+			    thatio = GvIO(thatgv);
+			}
 			if (!thatio) {
 #ifdef EINVAL
 			    SETERRNO(EINVAL,SS$_IVCHAN);
@@ -344,13 +379,18 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 			fd = PerlLIO_dup(fd);
 		    else
 			was_fdopen = TRUE;
-		    if (!(fp = PerlIO_fdopen(fd,mode))) {
+		    if (!num_svs)
+			type = Nullch;
+		    if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
 			if (dodup)
 			    PerlLIO_close(fd);
 		    }
 		}
-	    }
+	    } /* & */
 	    else {
+		if (num_svs > 1) {
+		    Perl_croak(aTHX_ "More than one argument to '>' open");
+		}
 		/*SUPPRESS 530*/
 		for (; isSPACE(*type); type++) ;
 		if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
@@ -360,11 +400,20 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		    IoTYPE(io) = IoTYPE_STD;
 		}
 		else  {
-		    fp = PerlIO_open((num_svs ? name : type), mode);
+		    if (!num_svs) {
+			namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+			num_svs = 1;
+			svp = &namesv;
+		        type = Nullch;
+		    }
+		    fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
 		}
-	    }
+	    } /* !& */
 	}
 	else if (*type == IoTYPE_RDONLY) {
+	    if (num_svs > 1) {
+		Perl_croak(aTHX_ "More than one argument to '<' open");
+	    }
 	    /*SUPPRESS 530*/
 	    for (type++; isSPACE(*type); type++) ;
 	    mode[0] = 'r';
@@ -374,7 +423,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		strcat(mode, "t");
 
 	    if (*type == '&') {
-		name = type;
 		goto duplicity;
 	    }
 	    if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
@@ -383,8 +431,15 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		fp = PerlIO_stdin();
 		IoTYPE(io) = IoTYPE_STD;
 	    }
-	    else
-		fp = PerlIO_open((num_svs ? name : type), mode);
+	    else {
+		if (!num_svs) {
+		    namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+		    num_svs = 1;
+		    svp = &namesv;
+		    type = Nullch;
+		}
+		fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
+	    }
 	}
 	else if ((num_svs && type[0] == IoTYPE_STD && type[1] == IoTYPE_PIPE) ||
 	         (!num_svs && tend > type+1 && tend[-1] == IoTYPE_PIPE)) {
@@ -400,8 +455,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		name = type;
 	        len  = tend-type;
 	    }
-	    if (*name == '\0') { /* command is missing 19990114 */
-		dTHR;
+	    if (*name == '\0') {
+		/* command is missing 19990114 */
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
 		errno = EPIPE;
@@ -415,7 +470,12 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		strcat(mode, "b");
 	    else if (in_crlf)
 		strcat(mode, "t");
-	    fp = PerlProc_popen(name,mode);
+	    if (num_svs > 1) {
+		fp = PerlProc_popen_list(mode,num_svs,svp);
+	    }
+	    else {
+		fp = PerlProc_popen(name,mode);
+	    }
 	    IoTYPE(io) = IoTYPE_PIPE;
 	}
 	else {
@@ -435,18 +495,38 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		IoTYPE(io) = IoTYPE_STD;
 	    }
 	    else {
-		fp = PerlIO_open(name,mode);
+		if (!num_svs) {
+		    namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+		    num_svs = 1;
+		    svp = &namesv;
+		    type = Nullch;
+		}
+		fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
 	    }
 	}
     }
     if (!fp) {
-	dTHR;
 	if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n'))
 	    Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
 	goto say_false;
     }
-    if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) {
-	dTHR;
+
+    if (ckWARN(WARN_IO)) {
+	if ((IoTYPE(io) == IoTYPE_RDONLY) &&
+	    (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle STD%s opened only for input",
+			    (fp == PerlIO_stdout()) ? "OUT" : "ERR");
+	}
+	else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle STDIN opened only for output");
+	}
+    }
+
+    if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD &&
+	/* FIXME: This next term is a hack to avoid fileno on PerlIO::Scalar */
+	!(num_svs && SvROK(*svp))) {
 	if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
 	    (void)PerlIO_close(fp);
 	    goto say_false;
@@ -474,32 +554,43 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 #endif
     }
     if (saveifp) {		/* must use old fp? */
-	fd = PerlIO_fileno(saveifp);
+        /* If fd is less that PL_maxsysfd i.e. STDIN..STDERR
+           then dup the new fileno down
+         */
+        fd = PerlIO_fileno(fp);
 	if (saveofp) {
-	    PerlIO_flush(saveofp);		/* emulate PerlIO_close() */
+	    PerlIO_flush(saveofp);	/* emulate PerlIO_close() */
 	    if (saveofp != saveifp) {	/* was a socket? */
 		PerlIO_close(saveofp);
-		if (fd > 2)
-		    Safefree(saveofp);
 	    }
 	}
-	if (fd != PerlIO_fileno(fp)) {
+	if (savefd != fd) {
 	    Pid_t pid;
 	    SV *sv;
-
-	    PerlLIO_dup2(PerlIO_fileno(fp), fd);
+	    if (PerlLIO_dup2(fd, savefd) < 0) {
+		(void)PerlIO_close(fp);
+		goto say_false;
+	    }
+#ifdef VMS
+	    if (savefd != PerlIO_fileno(PerlIO_stdin())) {
+	      char newname[FILENAME_MAX+1];
+             if (PerlIO_getname(fp, newname)) {
+ 	        if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT", newname);
+ 	        if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm(aTHX_ "SYS$ERROR",  newname);
+	      }
+	    }
+#endif
 	    LOCK_FDPID_MUTEX;
-	    sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
+	    sv = *av_fetch(PL_fdpid,fd,TRUE);
 	    (void)SvUPGRADE(sv, SVt_IV);
 	    pid = SvIVX(sv);
 	    SvIVX(sv) = 0;
-	    sv = *av_fetch(PL_fdpid,fd,TRUE);
+	    sv = *av_fetch(PL_fdpid,savefd,TRUE);
 	    UNLOCK_FDPID_MUTEX;
 	    (void)SvUPGRADE(sv, SVt_IV);
 	    SvIVX(sv) = pid;
 	    if (!was_fdopen)
 		PerlIO_close(fp);
-
 	}
 	fp = saveifp;
 	PerlIO_clearerr(fp);
@@ -513,55 +604,17 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
 #endif
     IoIFP(io) = fp;
-    if (!num_svs) {
-	/* Need to supply default type info from open.pm */
-	SV *layers = PL_curcop->cop_io;
-	type = NULL;
-	if (layers) {
-	    STRLEN len;
-	    type = SvPV(layers,len);
-	    if (type && mode[0] != 'r') {
-		/* Skip to write part */
-		char *s = strchr(type,0);
-		if (s && (s-type) < len) {
-		    type = s+1;
-		}
-	    }
-	}
-	else if (O_BINARY != O_TEXT && IoTYPE(io) != IoTYPE_STD && !saveifp) {
-	    type = ":crlf";
-	}
-    }
-    if (type) {
-	while (isSPACE(*type)) type++;
-	if (*type) {
-	   if (PerlIO_apply_layers(aTHX_ IoIFP(io),mode,type) != 0) {
-		goto say_false;
-	   }
-	}
-    }
 
     IoFLAGS(io) &= ~IOf_NOLINE;
     if (writing) {
-	dTHR;
 	if (IoTYPE(io) == IoTYPE_SOCKET
-	    || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) )
-	{
+	    || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) ) {
 	    mode[0] = 'w';
-	    if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),mode))) {
+	    if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,mode,PerlIO_fileno(fp),0,0,NULL,num_svs,svp))) {
 		PerlIO_close(fp);
 		IoIFP(io) = Nullfp;
 		goto say_false;
 	    }
-	    if (type && *type) {
-		if (PerlIO_apply_layers(aTHX_ IoOFP(io),mode,type) != 0) {
-		    PerlIO_close(IoOFP(io));
-		    PerlIO_close(fp);
-		    IoIFP(io) = Nullfp;
-		    IoOFP(io) = Nullfp;
-		    goto say_false;
-		}
-	    }
 	}
 	else
 	    IoOFP(io) = fp;
@@ -607,7 +660,6 @@ Perl_nextargv(pTHX_ register GV *gv)
     }
     PL_filemode = 0;
     while (av_len(GvAV(gv)) >= 0) {
-	dTHR;
 	STRLEN oldlen;
 	sv = av_shift(GvAV(gv));
 	SAVEFREESV(sv);
@@ -756,7 +808,6 @@ Perl_nextargv(pTHX_ register GV *gv)
 	    return IoIFP(GvIOp(gv));
 	}
 	else {
-	    dTHR;
 	    if (ckWARN_d(WARN_INPLACE)) {
 		int eno = errno;
 		if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
@@ -851,7 +902,6 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
     io = GvIO(gv);
     if (!io) {		/* never opened */
 	if (not_implicit) {
-	    dTHR;
 	    if (ckWARN(WARN_UNOPENED)) /* no check for closed here */
 		report_evil_fh(gv, io, PL_op->op_type);
 	    SETERRNO(EBADF,SS$_IVCHAN);
@@ -907,7 +957,6 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
 bool
 Perl_do_eof(pTHX_ GV *gv)
 {
-    dTHR;
     register IO *io;
     int ch;
 
@@ -915,9 +964,7 @@ Perl_do_eof(pTHX_ GV *gv)
 
     if (!io)
 	return TRUE;
-    else if (ckWARN(WARN_IO)
-	     && (IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
-		 || IoIFP(io) == PerlIO_stderr()))
+    else if (ckWARN(WARN_IO) && (IoTYPE(io) == IoTYPE_WRONLY))
     {
 	/* integrate to report_evil_fh()? */
         char *name = NULL;
@@ -964,7 +1011,7 @@ Perl_do_eof(pTHX_ GV *gv)
 Off_t
 Perl_do_tell(pTHX_ GV *gv)
 {
-    register IO *io;
+    register IO *io = 0;
     register PerlIO *fp;
 
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
@@ -974,11 +1021,8 @@ Perl_do_tell(pTHX_ GV *gv)
 #endif
 	return PerlIO_tell(fp);
     }
-    {
-	dTHR;
-	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-	    report_evil_fh(gv, io, PL_op->op_type);
-    }
+    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,RMS$_IFI);
     return (Off_t)-1;
 }
@@ -986,7 +1030,7 @@ Perl_do_tell(pTHX_ GV *gv)
 bool
 Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
 {
-    register IO *io;
+    register IO *io = 0;
     register PerlIO *fp;
 
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
@@ -996,11 +1040,8 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
 #endif
 	return PerlIO_seek(fp, pos, whence) >= 0;
     }
-    {
-	dTHR;
-	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-	    report_evil_fh(gv, io, PL_op->op_type);
-    }
+    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,RMS$_IFI);
     return FALSE;
 }
@@ -1008,16 +1049,13 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
 Off_t
 Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
 {
-    register IO *io;
+    register IO *io = 0;
     register PerlIO *fp;
 
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
 	return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
-    {
-	dTHR;
-	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-	    report_evil_fh(gv, io, PL_op->op_type);
-    }
+    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,RMS$_IFI);
     return (Off_t)-1;
 }
@@ -1162,11 +1200,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
     }
     switch (SvTYPE(sv)) {
     case SVt_NULL:
-	{
-	    dTHR;
-	    if (ckWARN(WARN_UNINITIALIZED))
-		report_uninit();
-	}
+	if (ckWARN(WARN_UNINITIALIZED))
+	    report_uninit();
 	return TRUE;
     case SVt_IV:
 	if (SvIOK(sv)) {
@@ -1180,11 +1215,15 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 	}
 	/* FALL THROUGH */
     default:
-#if 0
-	/* XXX Fix this when the I/O disciplines arrive. XXX */
-	if (DO_UTF8(sv))
-	    sv_utf8_downgrade(sv, FALSE);
-#endif
+	if (PerlIO_isutf8(fp)) {
+	    if (!SvUTF8(sv))
+		sv_utf8_upgrade(sv = sv_mortalcopy(sv));
+	}
+	else if (DO_UTF8(sv)) {
+	    if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)) {
+		Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
+	    }
+	}
 	tmps = SvPV(sv, len);
 	break;
     }
@@ -1202,7 +1241,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 I32
 Perl_my_stat(pTHX)
 {
-    djSP;
+    dSP;
     IO *io;
     GV* gv;
 
@@ -1255,7 +1294,7 @@ Perl_my_stat(pTHX)
 I32
 Perl_my_lstat(pTHX)
 {
-    djSP;
+    dSP;
     SV *sv;
     STRLEN n_a;
     if (PL_op->op_flags & OPf_REF) {
@@ -1293,11 +1332,10 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
     register char **a;
-    char *tmps;
+    char *tmps = Nullch;
     STRLEN n_a;
 
     if (sp > mark) {
-	dTHR;
 	New(401,PL_Argv, sp - mark + 1, char*);
 	a = PL_Argv;
 	while (++mark <= sp) {
@@ -1307,15 +1345,18 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 		*a++ = "";
 	}
 	*a = Nullch;
-	if (*PL_Argv[0] != '/')	/* will execvp use PATH? */
+	if (really)
+	    tmps = SvPV(really, n_a);
+	if ((!really && *PL_Argv[0] != '/') ||
+	    (really && *tmps != '/'))		/* will execvp use PATH? */
 	    TAINT_ENV();		/* testing IFS here is overkill, probably */
-	if (really && *(tmps = SvPV(really, n_a)))
-	    PerlProc_execvp(tmps,PL_Argv);
+	if (really && *tmps)
+	    PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
 	else
-	    PerlProc_execvp(PL_Argv[0],PL_Argv);
+	    PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
 	if (ckWARN(WARN_EXEC))
 	    Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s",
-		PL_Argv[0], Strerror(errno));
+		(really ? tmps : PL_Argv[0]), Strerror(errno));
 	if (do_report) {
 	    int e = errno;
 
@@ -1354,7 +1395,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 {
     register char **a;
     register char *s;
-    char flags[10];
 
     while (*cmd && isSPACE(*cmd))
 	cmd++;
@@ -1362,28 +1402,32 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
     /* save an extra exec if possible */
 
 #ifdef CSH
-    if (strnEQ(cmd,PL_cshname,PL_cshlen) && strnEQ(cmd+PL_cshlen," -c",3)) {
-	strcpy(flags,"-c");
-	s = cmd+PL_cshlen+3;
-	if (*s == 'f') {
-	    s++;
-	    strcat(flags,"f");
-	}
-	if (*s == ' ')
-	    s++;
-	if (*s++ == '\'') {
-	    char *ncmd = s;
-
-	    while (*s)
-		s++;
-	    if (s[-1] == '\n')
-		*--s = '\0';
-	    if (s[-1] == '\'') {
-		*--s = '\0';
-		PerlProc_execl(PL_cshname,"csh", flags,ncmd,(char*)0);
-		*s = '\'';
-		return FALSE;
-	    }
+    {
+        char flags[10];
+	if (strnEQ(cmd,PL_cshname,PL_cshlen) &&
+	    strnEQ(cmd+PL_cshlen," -c",3)) {
+	  strcpy(flags,"-c");
+	  s = cmd+PL_cshlen+3;
+	  if (*s == 'f') {
+	      s++;
+	      strcat(flags,"f");
+	  }
+	  if (*s == ' ')
+	      s++;
+	  if (*s++ == '\'') {
+	      char *ncmd = s;
+
+	      while (*s)
+		  s++;
+	      if (s[-1] == '\n')
+		  *--s = '\0';
+	      if (s[-1] == '\'') {
+		  *--s = '\0';
+		  PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0);
+		  *s = '\'';
+		  return FALSE;
+	      }
+	  }
 	}
     }
 #endif /* CSH */
@@ -1401,7 +1445,8 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 	goto doshell;
 
     for (s = cmd; *s; s++) {
-	if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+	if (*s != ' ' && !isALPHA(*s) &&
+	    strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
 	    if (*s == '\n' && !s[1]) {
 		*s = '\0';
 		break;
@@ -1445,7 +1490,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 	    goto doshell;
 	}
 	{
-	    dTHR;
 	    int e = errno;
 
 	    if (ckWARN(WARN_EXEC))
@@ -1466,7 +1510,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 I32
 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 {
-    dTHR;
     register I32 val;
     register I32 val2;
     register I32 tot = 0;
@@ -1636,20 +1679,31 @@ nothing in the core.
 	    } utbuf;
 #endif
 
+           SV* accessed = *++mark;
+           SV* modified = *++mark;
+           void * utbufp = &utbuf;
+
+           /* be like C, and if both times are undefined, let the C
+              library figure out what to do.  This usually means
+              "current time" */
+
+           if ( accessed == &PL_sv_undef && modified == &PL_sv_undef )
+             utbufp = NULL;
+           
 	    Zero(&utbuf, sizeof utbuf, char);
 #ifdef BIG_TIME
-	    utbuf.actime = (Time_t)SvNVx(*++mark);	/* time accessed */
-	    utbuf.modtime = (Time_t)SvNVx(*++mark);	/* time modified */
+           utbuf.actime = (Time_t)SvNVx(accessed);     /* time accessed */
+           utbuf.modtime = (Time_t)SvNVx(modified);    /* time modified */
 #else
-	    utbuf.actime = (Time_t)SvIVx(*++mark);	/* time accessed */
-	    utbuf.modtime = (Time_t)SvIVx(*++mark);	/* time modified */
+           utbuf.actime = (Time_t)SvIVx(accessed);     /* time accessed */
+           utbuf.modtime = (Time_t)SvIVx(modified);    /* time modified */
 #endif
 	    APPLY_TAINT_PROPER();
 	    tot = sp - mark;
 	    while (++mark <= sp) {
 		char *name = SvPVx(*mark, n_a);
 		APPLY_TAINT_PROPER();
-		if (PerlLIO_utime(name, &utbuf))
+               if (PerlLIO_utime(name, utbufp))
 		    tot--;
 	    }
 	}
@@ -1751,7 +1805,6 @@ Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective)
 I32
 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 {
-    dTHR;
     key_t key;
     I32 n, flags;
 
@@ -1784,7 +1837,6 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 I32
 Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 {
-    dTHR;
     SV *astr;
     char *a;
     I32 id, n, cmd, infosize, getinfo;
@@ -1909,7 +1961,6 @@ I32
 Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_MSG
-    dTHR;
     SV *mstr;
     char *mbuf;
     I32 id, msize, flags;
@@ -1932,7 +1983,6 @@ I32
 Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_MSG
-    dTHR;
     SV *mstr;
     char *mbuf;
     long mtype;
@@ -1970,7 +2020,6 @@ I32
 Perl_do_semop(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_SEM
-    dTHR;
     SV *opstr;
     char *opbuf;
     I32 id;
@@ -1995,7 +2044,6 @@ I32
 Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 {
 #ifdef HAS_SHM
-    dTHR;
     SV *mstr;
     char *mbuf, *shm;
     I32 id, mpos, msize;
@@ -2050,152 +2098,147 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 
 #endif /* SYSV IPC */
 
-#ifdef SOCKS_64BIT_BUG
-
-/**
- ** getc and ungetc wrappers for the 64 bit problems with SOCKS 5 support
- ** Workaround to the problem, that SOCKS maps a socket 'getc' to revc
- ** without checking the ungetc buffer.
- **/
-
-static S64_IOB *s64_buffer = (S64_IOB *) NULL;
-
-/* initialize the buffer area */
-/* required after a fork(2) call in order to remove side effects */
-void Perl_do_s64_init_buffer() {
-    s64_buffer = (S64_IOB *) NULL;
-}
-
-/* get a buffered stream pointer */
-static S64_IOB *S_s64_get_buffer( PerlIO *fp) {
-    S64_IOB *ptr = s64_buffer;
-    while( ptr && ptr->fp != fp)
-	ptr = ptr->next;
-    return( ptr);
-}
-
-/* create a buffered stream pointer */
-static S64_IOB *S_s64_create_buffer( PerlIO *f) {
-    S64_IOB *ptr = malloc( sizeof( S64_IOB));
-    if( ptr) {
-	ptr->fp = f;
-	ptr->cnt = ptr->size = 0;
-	ptr->buffer = (int *) NULL;
-	ptr->next = s64_buffer;
-	ptr->last = (S64_IOB *) NULL;
-	if( s64_buffer) s64_buffer->last = ptr;
-	s64_buffer = ptr;
-    }
-    return( ptr);
-}
-
-/* delete a buffered stream pointer */
-void Perl_do_s64_delete_buffer( PerlIO *f) {
-    S64_IOB *ptr = _s64_get_buffer(f);
-    if( ptr) {
-	/* fix the stream pointer according to the bytes buffered */
-	/* required, if this is called in a seek-context */
-	if( ptr->cnt) fseek(f,-ptr->cnt,SEEK_CUR);
-	if( ptr->buffer) free( ptr->buffer);
-	if( ptr->last)
-	    ptr->last->next = ptr->next;
-	else
-	    s64_buffer = ptr->next;
-	free( ptr);
-    }
-}
-
-/* internal buffer management */
-#define _S64_BUFFER_SIZE 32
-static int S_s64_malloc( S64_IOB *ptr) {
-    if( ptr) {
-	if( !ptr->buffer) {
-	    ptr->buffer = (int *) calloc( _S64_BUFFER_SIZE, sizeof( int));
-	    ptr->size = ptr->cnt = 0;
-	} else {
-	    ptr->buffer = (int *) realloc( ptr->buffer, ptr->size + _S64_BUFFER_SIZE);
-	}
-	
-	if( !ptr->buffer)
-	    return( 0);
-	
-	ptr->size += _S64_BUFFER_SIZE;
-	
-	return( 1);
-    }
-
-    return( 0);
-}
-
-/* SOCKS 64 bit getc replacement */
-int Perl_do_s64_getc( PerlIO *f) {
-    S64_IOB *ptr = _s64_get_buffer(f);
-    if( ptr) {
-	if( ptr->cnt)
-	    return( ptr->buffer[--ptr->cnt]);
-    }
-    return( getc(f));
-}
-
-/* SOCKS 64 bit ungetc replacement */
-int Perl_do_s64_ungetc( int ch, PerlIO *f) {
-    S64_IOB *ptr = _s64_get_buffer(f);
+/*
+=for apidoc start_glob
 
-    if( !ptr) ptr=_s64_create_buffer(f);
-    if( !ptr) return( EOF);
-    if( !ptr->buffer || (ptr->buffer && ptr->cnt >= ptr->size))
-	if( !_s64_malloc( ptr)) return( EOF);
-    ptr->buffer[ptr->cnt++] = ch;
+Function called by C<do_readline> to spawn a glob (or do the glob inside
+perl on VMS). This code used to be inline, but now perl uses C<File::Glob>
+this glob starter is only used by miniperl during the build proccess.
+Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
 
-    return( ch);
-}
+=cut
+*/
 
-/* SOCKS 64 bit fread replacement */
-SSize_t	Perl_do_s64_fread(void *buf, SSize_t count, PerlIO* f) {
-    SSize_t len = 0;
-    char *bufptr = (char *) buf;
-    S64_IOB *ptr = _s64_get_buffer(f);
-    if( ptr) {
-	while( ptr->cnt && count) {
-	    *bufptr++ = ptr->buffer[--ptr->cnt];
-	    count--, len++;
+PerlIO *
+Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
+{
+    SV *tmpcmd = NEWSV(55, 0);
+    PerlIO *fp;
+    ENTER;
+    SAVEFREESV(tmpcmd);
+#ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
+           /* since spawning off a process is a real performance hit */
+    {
+#include <descrip.h>
+#include <lib$routines.h>
+#include <nam.h>
+#include <rmsdef.h>
+	char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
+	char vmsspec[NAM$C_MAXRSS+1];
+	char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
+	$DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
+	PerlIO *tmpfp;
+	STRLEN i;
+	struct dsc$descriptor_s wilddsc
+	    = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+	struct dsc$descriptor_vs rsdsc
+	    = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt};
+	unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0;
+
+	/* We could find out if there's an explicit dev/dir or version
+	   by peeking into lib$find_file's internal context at
+	   ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
+	   but that's unsupported, so I don't want to do it now and
+	   have it bite someone in the future. */
+	cp = SvPV(tmpglob,i);
+	for (; i; i--) {
+	    if (cp[i] == ';') hasver = 1;
+	    if (cp[i] == '.') {
+		if (sts) hasver = 1;
+		else sts = 1;
+	    }
+	    if (cp[i] == '/') {
+		hasdir = isunix = 1;
+		break;
+	    }
+	    if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') {
+		hasdir = 1;
+		break;
+	    }
 	}
-    }
-    if( count)
-	len += (SSize_t)fread(bufptr,1,count,f);
-
-    return( len);
-}
-
-/* SOCKS 64 bit fseek replacement */
-int	Perl_do_s64_seek(PerlIO* f, Off_t offset, int whence) {
-    S64_IOB *ptr = _s64_get_buffer(f);
-
-    /* Simply clear the buffer and seek if the position is absolute */
-    if( SEEK_SET == whence || SEEK_END == whence) {
-	if( ptr) ptr->cnt = 0;
-
-    /* In case of relative positioning clear the buffer and calculate */
-    /* a fixed offset */
-    } else if( SEEK_CUR == whence) {
-	if( ptr) {
-	    offset -= (Off_t)ptr->cnt;
-	    ptr->cnt = 0;
+       if ((tmpfp = PerlIO_tmpfile()) != NULL) {
+	    Stat_t st;
+	    if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode))
+		ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
+	    else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
+	    if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
+	    while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
+					       &dfltdsc,NULL,NULL,NULL))&1)) {
+		end = rstr + (unsigned long int) *rslt;
+		if (!hasver) while (*end != ';') end--;
+		*(end++) = '\n';  *end = '\0';
+		for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
+		if (hasdir) {
+		    if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1);
+		    begin = rstr;
+		}
+		else {
+		    begin = end;
+		    while (*(--begin) != ']' && *begin != '>') ;
+		    ++begin;
+		}
+		ok = (PerlIO_puts(tmpfp,begin) != EOF);
+	    }
+	    if (cxt) (void)lib$find_file_end(&cxt);
+	    if (ok && sts != RMS$_NMF &&
+		sts != RMS$_DNF && sts != RMS$_FNF) ok = 0;
+	    if (!ok) {
+		if (!(sts & 1)) {
+		    SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts);
+		}
+		PerlIO_close(tmpfp);
+		fp = NULL;
+	    }
+	    else {
+		PerlIO_rewind(tmpfp);
+		IoTYPE(io) = IoTYPE_RDONLY;
+		IoIFP(io) = fp = tmpfp;
+		IoFLAGS(io) &= ~IOf_UNTAINT;  /* maybe redundant */
+	    }
 	}
     }
-
-    /* leave out buffer untouched otherwise, because fseek will fail */
-    /* seek now */
-    return( fseeko( f, offset, whence));
-}
-
-/* SOCKS 64 bit ftell replacement */
-Off_t	Perl_do_s64_tell(PerlIO* f) {
-    Off_t offset = 0;
-    S64_IOB *ptr = _s64_get_buffer(f);
-    if( ptr)
-	offset = ptr->cnt;
-    return( ftello(f) - offset);
+#else /* !VMS */
+#ifdef MACOS_TRADITIONAL
+    sv_setpv(tmpcmd, "glob ");
+    sv_catsv(tmpcmd, tmpglob);
+    sv_catpv(tmpcmd, " |");
+#else
+#ifdef DOSISH
+#ifdef OS2
+    sv_setpv(tmpcmd, "for a in ");
+    sv_catsv(tmpcmd, tmpglob);
+    sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |");
+#else
+#ifdef DJGPP
+    sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */
+    sv_catsv(tmpcmd, tmpglob);
+#else
+    sv_setpv(tmpcmd, "perlglob ");
+    sv_catsv(tmpcmd, tmpglob);
+    sv_catpv(tmpcmd, " |");
+#endif /* !DJGPP */
+#endif /* !OS2 */
+#else /* !DOSISH */
+#if defined(CSH)
+    sv_setpvn(tmpcmd, PL_cshname, PL_cshlen);
+    sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
+    sv_catsv(tmpcmd, tmpglob);
+    sv_catpv(tmpcmd, "' 2>/dev/null |");
+#else
+    sv_setpv(tmpcmd, "echo ");
+    sv_catsv(tmpcmd, tmpglob);
+#if 'z' - 'a' == 25
+    sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
+#else
+    sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
+#endif
+#endif /* !CSH */
+#endif /* !DOSISH */
+#endif /* MACOS_TRADITIONAL */
+    (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
+		  FALSE, O_RDONLY, 0, Nullfp);
+    fp = IoIFP(io);
+#endif /* !VMS */
+    LEAVE;
+    return fp;
 }
-
-#endif