X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=35a982ecc100670aace75df25ce91d8a49fba982;hb=8bbf3450a1ff0a3996dade29a4194cc0939d871f;hp=a9228b4766066684cca77a204a8489f1a1c16dfb;hpb=673c27c1f741b8f21e9f8e87048c7df824507930;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index a9228b4..35a982e 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1,5 +1,5 @@
 /*
- * perlio.c Copyright (c) 1996-2002, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2004, Nick Ing-Simmons You may distribute
  * under the terms of either the GNU General Public License or the
  * Artistic License, as specified in the README file.
  */
@@ -50,6 +50,60 @@
 
 #include "XSUB.h"
 
+#ifdef __Lynx__
+/* Missing proto on LynxOS */
+int mkstemp(char*);
+#endif
+
+/* Call the callback or PerlIOBase, and return failure. */
+#define Perl_PerlIO_or_Base(f, callback, base, failure, args) 	\
+	if (PerlIOValid(f)) {					\
+		PerlIO_funcs *tab = PerlIOBase(f)->tab; 	\
+		if (tab && tab->callback)			\
+			return (*tab->callback) args;		\
+		else						\
+			return PerlIOBase_ ## base args;	\
+	}							\
+	else							\
+		SETERRNO(EBADF, SS_IVCHAN);			\
+	return failure
+
+/* Call the callback or fail, and return failure. */
+#define Perl_PerlIO_or_fail(f, callback, failure, args) 	\
+	if (PerlIOValid(f)) {					\
+		PerlIO_funcs *tab = PerlIOBase(f)->tab; 	\
+		if (tab && tab->callback)			\
+			return (*tab->callback) args;		\
+		SETERRNO(EINVAL, LIB_INVARG);			\
+	}							\
+	else							\
+		SETERRNO(EBADF, SS_IVCHAN);			\
+	return failure
+
+/* Call the callback or PerlIOBase, and be void. */
+#define Perl_PerlIO_or_Base_void(f, callback, base, args) 	\
+	if (PerlIOValid(f)) {					\
+		PerlIO_funcs *tab = PerlIOBase(f)->tab; 	\
+		if (tab && tab->callback)			\
+			(*tab->callback) args;			\
+		else						\
+			PerlIOBase_ ## base args;		\
+	}							\
+	else							\
+		SETERRNO(EBADF, SS_IVCHAN)
+
+/* Call the callback or fail, and be void. */
+#define Perl_PerlIO_or_fail_void(f, callback, args) 		\
+	if (PerlIOValid(f)) {					\
+		PerlIO_funcs *tab = PerlIOBase(f)->tab; 	\
+		if (tab && tab->callback)			\
+			(*tab->callback) args;			\
+		else						\
+			SETERRNO(EINVAL, LIB_INVARG);		\
+	}							\
+	else							\
+		SETERRNO(EBADF, SS_IVCHAN)
+
 int
 perlsio_binmode(FILE *fp, int iotype, int mode)
 {
@@ -239,7 +293,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	    return PerlIO_tmpfile();
 	else {
 	    char *name = SvPV_nolen(*args);
-	    if (*mode == '#') {
+	    if (*mode == IoTYPE_NUMERIC) {
 		fd = PerlLIO_open3(name, imode, perm);
 		if (fd >= 0)
 		    return PerlIO_fdopen(fd, (char *) mode + 1);
@@ -381,9 +435,11 @@ PerlIO_findFILE(PerlIO *pio)
 #include <sys/mman.h>
 #endif
 
-
+/*
+ * Why is this here - not in perlio.h?  RMB
+ */
 void PerlIO_debug(const char *fmt, ...)
-    __attribute__ ((format(__printf__, 1, 2)));
+    __attribute__format__(__printf__, 1, 2);
 
 void
 PerlIO_debug(const char *fmt, ...)
@@ -475,15 +531,17 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 {
     if (PerlIOValid(f)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	PerlIO *new;
 	PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param);
-	new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param, flags);
-	return new;
-    }
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return NULL;
+	if (tab && tab->Dup)
+	     return (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX), f, param, flags);
+	else {
+	     return PerlIOBase_dup(aTHX_ PerlIO_allocate(aTHX), f, param, flags);
+	}
     }
+    else
+	 SETERRNO(EBADF, SS_IVCHAN);
+
+    return NULL;
 }
 
 void
@@ -640,6 +698,35 @@ PerlIO_pop(pTHX_ PerlIO *f)
     }
 }
 
+/* Return as an array the stack of layers on a filehandle.  Note that
+ * the stack is returned top-first in the array, and there are three
+ * times as many array elements as there are layers in the stack: the
+ * first element of a layer triplet is the name, the second one is the
+ * arguments, and the third one is the flags. */
+
+AV *
+PerlIO_get_layers(pTHX_ PerlIO *f)
+{
+     AV *av = newAV();
+
+     if (PerlIOValid(f)) {
+	  PerlIOl *l = PerlIOBase(f);
+
+	  while (l) {
+	       SV *name = l->tab && l->tab->name ?
+		    newSVpv(l->tab->name, 0) : &PL_sv_undef;
+	       SV *arg = l->tab && l->tab->Getarg ?
+		    (*l->tab->Getarg)(aTHX_ &l, 0, 0) : &PL_sv_undef;
+	       av_push(av, name);
+	       av_push(av, arg);
+	       av_push(av, newSViv((IV)l->flags));
+	       l = l->next;
+	  }
+     }
+
+     return av;
+}
+
 /*--------------------------------------------------------------------------------------*/
 /*
  * XS Interface for perl code
@@ -653,7 +740,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
 	len = strlen(name);
     for (i = 0; i < PL_known_layers->cur; i++) {
 	PerlIO_funcs *f = PL_known_layers->array[i].funcs;
-	if (memEQ(f->name, name, len)) {
+	if (memEQ(f->name, name, len) && f->name[len] == 0) {
 	    PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f);
 	    return f;
 	}
@@ -777,7 +864,7 @@ PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
 
 XS(XS_PerlIO__Layer__NoWarnings)
 {
-    /* This is used as a %SIG{__WARN__} handler to supress warnings 
+    /* This is used as a %SIG{__WARN__} handler to supress warnings
        during loading of layers.
      */
     dXSARGS;
@@ -834,7 +921,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 		    char q = ((*s == '\'') ? '"' : '\'');
 		    if (ckWARN(WARN_LAYER))
 			Perl_warner(aTHX_ packWARN(WARN_LAYER),
-			      "perlio: invalid separator character %c%c%c in layer specification list %s",
+			      "Invalid separator character %c%c%c in PerlIO layer specification %s",
 			      q, *s, q, s);
 		    SETERRNO(EINVAL, LIB_INVARG);
 		    return -1;
@@ -871,7 +958,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 			    e--;
 			    if (ckWARN(WARN_LAYER))
 				Perl_warner(aTHX_ packWARN(WARN_LAYER),
-				      "perlio: argument list not closed for layer \"%.*s\"",
+				      "Argument list not closed for PerlIO layer \"%.*s\"",
 				      (int) (e - s), s);
 			    return -1;
 			default:
@@ -894,7 +981,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 		    }
 		    else {
 			if (warn_layer)
-			    Perl_warner(aTHX_ packWARN(WARN_LAYER), "perlio: unknown layer \"%.*s\"",
+			    Perl_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"",
 				  (int) llen, s);
 			return -1;
 		    }
@@ -988,7 +1075,7 @@ PerlIO_default_layers(pTHX)
 	PerlIO_funcs *osLayer = &PerlIO_unix;
 	PL_def_layerlist = PerlIO_list_alloc(aTHX);
 	PerlIO_define_layer(aTHX_ & PerlIO_unix);
-#if defined(WIN32) && !defined(UNDER_CE)
+#if defined(WIN32)
 	PerlIO_define_layer(aTHX_ & PerlIO_win32);
 #if 0
 	osLayer = &PerlIO_win32;
@@ -1075,7 +1162,8 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 	    *f = l;
 	    PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
 			(mode) ? mode : "(Null)", (void*)arg);
-	    if ((*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+	    if (*l->tab->Pushed &&
+		(*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
 		PerlIO_pop(aTHX_ f);
 		return NULL;
 	    }
@@ -1085,8 +1173,9 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 	/* Pseudo-layer where push does its own stack adjust */
 	PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
 		     (mode) ? mode : "(Null)", (void*)arg);
-	if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
-	    return NULL;
+	if (tab->Pushed &&
+	    (*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+	     return NULL;
 	}
     }
     return f;
@@ -1245,8 +1334,13 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
 int
 PerlIO__close(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
+    if (PerlIOValid(f)) {
+	PerlIO_funcs *tab = PerlIOBase(f)->tab;
+	if (tab && tab->Close)
+	    return (*tab->Close)(aTHX_ f);
+	else
+	    return PerlIOBase_close(aTHX_ f);
+    }
     else {
 	SETERRNO(EBADF, SS_IVCHAN);
 	return -1;
@@ -1256,12 +1350,9 @@ PerlIO__close(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_close(pTHX_ PerlIO *f)
 {
-    int code = -1;
-    if (PerlIOValid(f)) {
-	code = (*PerlIOBase(f)->tab->Close) (aTHX_ f);
-	while (*f) {
-	    PerlIO_pop(aTHX_ f);
-	}
+    int code = PerlIO__close(aTHX_ f);
+    while (PerlIOValid(f)) {
+	PerlIO_pop(aTHX_ f);
     }
     return code;
 }
@@ -1269,12 +1360,7 @@ Perl_PerlIO_close(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_fileno(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Fileno) (aTHX_ f);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
 }
 
 static const char *
@@ -1445,8 +1531,13 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	    PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
 			 tab->name, layers, mode, fd, imode, perm,
 			 (void*)f, narg, (void*)args);
-	    f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
-			      f, narg, args);
+	    if (tab->Open)
+		 f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
+				   f, narg, args);
+	    else {
+		 SETERRNO(EINVAL, LIB_INVARG);
+		 f = NULL;
+	    }
 	    if (f) {
 		if (n + 1 < layera->cur) {
 		    /*
@@ -1470,56 +1561,31 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 SSize_t
 Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Read) (aTHX_ f, vbuf, count);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_Base(f, Read, read, -1, (aTHX_ f, vbuf, count));
 }
 
 SSize_t
 Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Unread) (aTHX_ f, vbuf, count);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_Base(f, Unread, unread, -1, (aTHX_ f, vbuf, count));
 }
 
 SSize_t
 Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Write) (aTHX_ f, vbuf, count);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_fail(f, Write, -1, (aTHX_ f, vbuf, count));
 }
 
 int
 Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Seek) (aTHX_ f, offset, whence);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_fail(f, Seek, -1, (aTHX_ f, offset, whence));
 }
 
 Off_t
 Perl_PerlIO_tell(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Tell) (aTHX_ f);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_fail(f, Tell, -1, (aTHX_ f));
 }
 
 int
@@ -1528,14 +1594,11 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f)
     if (f) {
 	if (*f) {
 	    PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	    if (tab && tab->Flush) {
+
+	    if (tab && tab->Flush)
 		return (*tab->Flush) (aTHX_ f);
-	    }
-	    else {
-		PerlIO_debug("Cannot flush f=%p :%s\n", (void*)f, tab->name);
-		SETERRNO(EBADF, SS_IVCHAN);
-		return -1;
-	    }
+	    else
+		 return 0; /* If no Flush defined, silently succeed. */
 	}
 	else {
 	    PerlIO_debug("Cannot flush f=%p\n", (void*)f);
@@ -1588,81 +1651,73 @@ PerlIOBase_flush_linebuf(pTHX)
 int
 Perl_PerlIO_fill(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Fill) (aTHX_ f);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_fail(f, Fill, -1, (aTHX_ f));
 }
 
 int
 PerlIO_isutf8(PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     if (PerlIOValid(f))
+	  return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
+     else
+	  SETERRNO(EBADF, SS_IVCHAN);
+
+     return -1;
 }
 
 int
 Perl_PerlIO_eof(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Eof) (aTHX_ f);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_Base(f, Eof, eof, -1, (aTHX_ f));
 }
 
 int
 Perl_PerlIO_error(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Error) (aTHX_ f);
-    else {
-	SETERRNO(EBADF, SS_IVCHAN);
-	return -1;
-    }
+     Perl_PerlIO_or_Base(f, Error, error, -1, (aTHX_ f));
 }
 
 void
 Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	(*PerlIOBase(f)->tab->Clearerr) (aTHX_ f);
-    else
-	SETERRNO(EBADF, SS_IVCHAN);
+     Perl_PerlIO_or_Base_void(f, Clearerr, clearerr, (aTHX_ f));
 }
 
 void
 Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	(*PerlIOBase(f)->tab->Setlinebuf) (aTHX_ f);
-    else
-	SETERRNO(EBADF, SS_IVCHAN);
+     Perl_PerlIO_or_Base_void(f, Setlinebuf, setlinebuf, (aTHX_ f));
 }
 
 int
 PerlIO_has_base(PerlIO *f)
 {
-    if (PerlIOValid(f)) {
-	return (PerlIOBase(f)->tab->Get_base != NULL);
-    }
-    return 0;
+     if (PerlIOValid(f)) {
+	  PerlIO_funcs *tab = PerlIOBase(f)->tab;
+
+	  if (tab)
+	       return (tab->Get_base != NULL);
+	  SETERRNO(EINVAL, LIB_INVARG);
+     }
+     else
+	  SETERRNO(EBADF, SS_IVCHAN);
+
+     return 0;
 }
 
 int
 PerlIO_fast_gets(PerlIO *f)
 {
     if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
-	PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	return (tab->Set_ptrcnt != NULL);
+	 PerlIO_funcs *tab = PerlIOBase(f)->tab;
+
+	 if (tab)
+	      return (tab->Set_ptrcnt != NULL);
+	 SETERRNO(EINVAL, LIB_INVARG);
     }
+    else
+	 SETERRNO(EBADF, SS_IVCHAN);
+
     return 0;
 }
 
@@ -1671,8 +1726,14 @@ PerlIO_has_cntptr(PerlIO *f)
 {
     if (PerlIOValid(f)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
+
+	if (tab)
+	     return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
+	  SETERRNO(EINVAL, LIB_INVARG);
     }
+    else
+	 SETERRNO(EBADF, SS_IVCHAN);
+
     return 0;
 }
 
@@ -1680,70 +1741,52 @@ int
 PerlIO_canset_cnt(PerlIO *f)
 {
     if (PerlIOValid(f)) {
-	PerlIOl *l = PerlIOBase(f);
-	return (l->tab->Set_ptrcnt != NULL);
+	  PerlIO_funcs *tab = PerlIOBase(f)->tab;
+
+	  if (tab)
+	       return (tab->Set_ptrcnt != NULL);
+	  SETERRNO(EINVAL, LIB_INVARG);
     }
+    else
+	 SETERRNO(EBADF, SS_IVCHAN);
+
     return 0;
 }
 
 STDCHAR *
 Perl_PerlIO_get_base(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Get_base) (aTHX_ f);
-    return NULL;
+     Perl_PerlIO_or_fail(f, Get_base, NULL, (aTHX_ f));
 }
 
 int
 Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-	return (*PerlIOBase(f)->tab->Get_bufsiz) (aTHX_ f);
-    return 0;
+     Perl_PerlIO_or_fail(f, Get_bufsiz, -1, (aTHX_ f));
 }
 
 STDCHAR *
 Perl_PerlIO_get_ptr(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f)) {
-	PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	if (tab->Get_ptr == NULL)
-	    return NULL;
-	return (*tab->Get_ptr) (aTHX_ f);
-    }
-    return NULL;
+     Perl_PerlIO_or_fail(f, Get_ptr, NULL, (aTHX_ f));
 }
 
 int
 Perl_PerlIO_get_cnt(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f)) {
-	PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	if (tab->Get_cnt == NULL)
-	   return 0;
-	return (*tab->Get_cnt) (aTHX_ f);
-    }
-    return 0;
+     Perl_PerlIO_or_fail(f, Get_cnt, -1, (aTHX_ f));
 }
 
 void
 Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt)
 {
-    if (PerlIOValid(f)) {
-	(*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, NULL, cnt);
-    }
+     Perl_PerlIO_or_fail_void(f, Set_ptrcnt, (aTHX_ f, NULL, cnt));
 }
 
 void
 Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
 {
-    if (PerlIOValid(f)) {
-	PerlIO_funcs *tab = PerlIOBase(f)->tab;
-	if (tab->Set_ptrcnt == NULL) {
-	    Perl_croak(aTHX_ "PerlIO buffer snooping abuse");
-	}
-	(*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, ptr, cnt);
-    }
+     Perl_PerlIO_or_fail_void(f, Set_ptrcnt, (aTHX_ f, ptr, cnt));
 }
 
 
@@ -1829,8 +1872,11 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	       PerlIO *old, int narg, SV **args)
 {
     PerlIO_funcs *tab = PerlIO_default_btm();
-    return (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-			 old, narg, args);
+    if (tab && tab->Open)
+	 return (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+			      old, narg, args);
+    SETERRNO(EINVAL, LIB_INVARG);
+    return NULL;
 }
 
 PerlIO_funcs PerlIO_raw = {
@@ -1919,7 +1965,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
     if (tab->Set_ptrcnt != NULL)
 	l->flags |= PERLIO_F_FASTGETS;
     if (mode) {
-	if (*mode == '#' || *mode == 'I')
+	if (*mode == IoTYPE_NUMERIC || *mode == IoTYPE_IMPLICIT)
 	    mode++;
 	switch (*mode++) {
 	case 'r':
@@ -1992,8 +2038,11 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     STDCHAR *buf = (STDCHAR *) vbuf;
     if (f) {
-	if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
+        if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
+	    PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+	    SETERRNO(EBADF, SS_IVCHAN);
 	    return 0;
+	}
 	while (count > 0) {
 	    SSize_t avail = PerlIO_get_cnt(f);
 	    SSize_t take = 0;
@@ -2031,14 +2080,29 @@ PerlIOBase_noop_fail(pTHX_ PerlIO *f)
 IV
 PerlIOBase_close(pTHX_ PerlIO *f)
 {
-    IV code = 0;
-    PerlIO *n = PerlIONext(f);
-    if (PerlIO_flush(f) != 0)
-	code = -1;
-    if (PerlIOValid(n) && (*PerlIOBase(n)->tab->Close)(aTHX_ n) != 0)
-	code = -1;
-    PerlIOBase(f)->flags &=
-	~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
+    IV code = -1;
+    if (PerlIOValid(f)) {
+	PerlIO *n = PerlIONext(f);
+	code = PerlIO_flush(f);
+	PerlIOBase(f)->flags &=
+	   ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
+	while (PerlIOValid(n)) {
+	    PerlIO_funcs *tab = PerlIOBase(n)->tab;
+	    if (tab && tab->Close) {
+		if ((*tab->Close)(aTHX_ n) != 0)
+		    code = -1;
+		break;
+	    }
+	    else {
+		PerlIOBase(n)->flags &=
+		    ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
+	    }
+	    n = PerlIONext(n);
+	}
+    }
+    else {
+	SETERRNO(EBADF, SS_IVCHAN);
+    }
     return code;
 }
 
@@ -2102,16 +2166,21 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
     PerlIO *nexto = PerlIONext(o);
     if (PerlIOValid(nexto)) {
 	PerlIO_funcs *tab = PerlIOBase(nexto)->tab;
-	f = (*tab->Dup)(aTHX_ f, nexto, param, flags);
+	if (tab && tab->Dup)
+	    f = (*tab->Dup)(aTHX_ f, nexto, param, flags);
+	else
+	    f = PerlIOBase_dup(aTHX_ f, nexto, param, flags);
     }
     if (f) {
 	PerlIO_funcs *self = PerlIOBase(o)->tab;
-	SV *arg = Nullsv;
+	SV *arg;
 	char buf[8];
 	PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
 		     self->name, (void*)f, (void*)o, (void*)param);
-	if (self->Getarg) {
-	    arg = (*self->Getarg)(aTHX_ o,param,flags);
+	if (self->Getarg)
+	    arg = (*self->Getarg)(aTHX_ o, param, flags);
+	else {
+	    arg = Nullsv;
 	}
 	f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
 	if (arg) {
@@ -2212,7 +2281,7 @@ int
 PerlIOUnix_oflags(const char *mode)
 {
     int oflags = -1;
-    if (*mode == 'I' || *mode == '#')
+    if (*mode == IoTYPE_IMPLICIT || *mode == IoTYPE_NUMERIC)
 	mode++;
     switch (*mode) {
     case 'r':
@@ -2270,26 +2339,69 @@ PerlIOUnix_fileno(pTHX_ PerlIO *f)
     return PerlIOSelf(f, PerlIOUnix)->fd;
 }
 
+static void
+PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode)
+{
+    PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
+#if defined(WIN32)
+    Stat_t st;
+    if (PerlLIO_fstat(fd, &st) == 0) {
+	if (!S_ISREG(st.st_mode)) {
+	    PerlIO_debug("%d is not regular file\n",fd);
+    	    PerlIOBase(f)->flags |= PERLIO_F_NOTREG;
+	}
+	else {
+	    PerlIO_debug("%d _is_ a regular file\n",fd);
+	}
+    }
+#endif
+    s->fd = fd;
+    s->oflags = imode;
+    PerlIOUnix_refcnt_inc(fd);
+}
+
 IV
 PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
-    PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
     if (*PerlIONext(f)) {
 	/* We never call down so do any pending stuff now */
 	PerlIO_flush(PerlIONext(f));
-	s->fd = PerlIO_fileno(PerlIONext(f));
 	/*
 	 * XXX could (or should) we retrieve the oflags from the open file
 	 * handle rather than believing the "mode" we are passed in? XXX
 	 * Should the value on NULL mode be 0 or -1?
 	 */
-	s->oflags = mode ? PerlIOUnix_oflags(mode) : -1;
+        PerlIOUnix_setfd(aTHX_ f, PerlIO_fileno(PerlIONext(f)),
+                         mode ? PerlIOUnix_oflags(mode) : -1);
     }
     PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+
     return code;
 }
 
+IV
+PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
+{
+    int fd = PerlIOSelf(f, PerlIOUnix)->fd;
+    Off_t new;
+    if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) {
+#ifdef  ESPIPE
+	SETERRNO(ESPIPE, LIB_INVARG);
+#else
+	SETERRNO(EINVAL, LIB_INVARG);
+#endif
+	return -1;
+    }
+    new  = PerlLIO_lseek(fd, offset, whence);
+    if (new == (Off_t) - 1)
+     {
+      return -1;
+     }
+    PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
+    return  0;
+}
+
 PerlIO *
 PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 		IV n, const char *mode, int fd, int imode,
@@ -2301,7 +2413,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     }
     if (narg > 0) {
 	char *path = SvPV_nolen(*args);
-	if (*mode == '#')
+	if (*mode == IoTYPE_NUMERIC)
 	    mode++;
 	else {
 	    imode = PerlIOUnix_oflags(mode);
@@ -2312,8 +2424,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	}
     }
     if (fd >= 0) {
-	PerlIOUnix *s;
-	if (*mode == 'I')
+	if (*mode == IoTYPE_IMPLICIT)
 	    mode++;
 	if (!f) {
 	    f = PerlIO_allocate(aTHX);
@@ -2323,11 +2434,10 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 		return NULL;
 	    }
 	}
-	s = PerlIOSelf(f, PerlIOUnix);
-	s->fd = fd;
-	s->oflags = imode;
+        PerlIOUnix_setfd(aTHX_ f, fd, imode);
 	PerlIOBase(f)->flags |= PERLIO_F_OPEN;
-	PerlIOUnix_refcnt_inc(fd);
+	if (*mode == IoTYPE_APPEND)
+	    PerlIOUnix_seek(aTHX_ f, 0, SEEK_END);
 	return f;
     }
     else {
@@ -2352,9 +2462,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 	f = PerlIOBase_dup(aTHX_ f, o, param, flags);
 	if (f) {
 	    /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */
-	    PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
-	    s->fd = fd;
-	    PerlIOUnix_refcnt_inc(fd);
+	    PerlIOUnix_setfd(aTHX_ f, fd, os->oflags);
 	    return f;
 	}
     }
@@ -2373,10 +2481,15 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     while (1) {
 	SSize_t len = PerlLIO_read(fd, vbuf, count);
 	if (len >= 0 || errno != EINTR) {
-	    if (len < 0)
-		PerlIOBase(f)->flags |= PERLIO_F_ERROR;
-	    else if (len == 0 && count != 0)
+	    if (len < 0) {
+		if (errno != EAGAIN) {
+		    PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+		}
+	    }
+	    else if (len == 0 && count != 0) {
 		PerlIOBase(f)->flags |= PERLIO_F_EOF;
+		SETERRNO(0,0);
+	    }
 	    return len;
 	}
 	PERL_ASYNC_CHECK();
@@ -2390,23 +2503,17 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     while (1) {
 	SSize_t len = PerlLIO_write(fd, vbuf, count);
 	if (len >= 0 || errno != EINTR) {
-	    if (len < 0)
-		PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+	    if (len < 0) {
+		if (errno != EAGAIN) {
+		    PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+		}
+	    }
 	    return len;
 	}
 	PERL_ASYNC_CHECK();
     }
 }
 
-IV
-PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
-{
-    Off_t new =
-	PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, offset, whence);
-    PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
-    return (new == (Off_t) - 1) ? -1 : 0;
-}
-
 Off_t
 PerlIOUnix_tell(pTHX_ PerlIO *f)
 {
@@ -2506,10 +2613,12 @@ char *
 PerlIOStdio_mode(const char *mode, char *tmode)
 {
     char *ret = tmode;
-    while (*mode) {
-	*tmode++ = *mode++;
+    if (mode) {
+	while (*mode) {
+	    *tmode++ = *mode++;
+	}
     }
-#ifdef PERLIO_USING_CRLF
+#if defined(PERLIO_USING_CRLF) || defined(__CYGWIN__)
     *tmode++ = 'b';
 #endif
     *tmode = '\0';
@@ -2605,20 +2714,28 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     else {
 	if (narg > 0) {
 	    char *path = SvPV_nolen(*args);
-	    if (*mode == '#') {
+	    if (*mode == IoTYPE_NUMERIC) {
 		mode++;
 		fd = PerlLIO_open3(path, imode, perm);
 	    }
 	    else {
-		FILE *stdio = PerlSIO_fopen(path, mode);
+	        FILE *stdio;
+	        bool appended = FALSE;
+#ifdef __CYGWIN__
+		/* Cygwin wants its 'b' early. */
+		appended = TRUE;
+		mode = PerlIOStdio_mode(mode, tmode);
+#endif
+		stdio = PerlSIO_fopen(path, mode);
 		if (stdio) {
 		    PerlIOStdio *s;
 		    if (!f) {
 			f = PerlIO_allocate(aTHX);
 		    }
-		    if ((f = PerlIO_push(aTHX_ f, self,
-				    (mode = PerlIOStdio_mode(mode, tmode)),
-				    PerlIOArg))) {
+		    if (!appended)
+		        mode = PerlIOStdio_mode(mode, tmode);
+		    f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg);
+		    if (f) {
 			s = PerlIOSelf(f, PerlIOStdio);
 			s->stdio = stdio;
 			PerlIOUnix_refcnt_inc(fileno(s->stdio));
@@ -2633,7 +2750,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	if (fd >= 0) {
 	    FILE *stdio = NULL;
 	    int init = 0;
-	    if (*mode == 'I') {
+	    if (*mode == IoTYPE_IMPLICIT) {
 		init = 1;
 		mode++;
 	    }
@@ -2705,11 +2822,11 @@ static int
 PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
 {
     /* XXX this could use PerlIO_canset_fileno() and
-     * PerlIO_set_fileno() support from Configure 
+     * PerlIO_set_fileno() support from Configure
      */
 #  if defined(__GLIBC__)
     /* There may be a better way for GLIBC:
-    	- libio.h defines a flag to not close() on cleanup 
+    	- libio.h defines a flag to not close() on cleanup
      */	
     f->_fileno = -1;
     return 1;
@@ -2721,7 +2838,7 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
      *      long __pad[16];
      *  };
      *
-     * It turns out that the fd is stored in the top 32 bits of 
+     * It turns out that the fd is stored in the top 32 bits of
      * file->__pad[4]. The lower 32 bits contain flags. file->pad[5] appears
      * to contain a pointer or offset into another structure. All the
      * remaining fields are zero.
@@ -2731,9 +2848,9 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
     f->__pad[4] |= 0xffffffff00000000L;
     assert(fileno(f) == 0xffffffff);
 #    else /* !defined(_LP64) */
-    /* _file is just a unsigned char :-( 
-       Not clear why we dup() rather than using -1 
-       even if that would be treated as 0xFF - so will 
+    /* _file is just a unsigned char :-(
+       Not clear why we dup() rather than using -1
+       even if that would be treated as 0xFF - so will
        a dup fail ...
      */
     f->_file = PerlLIO_dup(fileno(f));
@@ -2744,39 +2861,47 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
     f->__fileL = 0xff;
     return 1;
    /* Next one ->_file seems to be a reasonable fallback, i.e. if
-      your platform does not have special entry try this one.       
+      your platform does not have special entry try this one.
       [For OSF only have confirmation for Tru64 (alpha)
       but assume other OSFs will be similar.]
-    */    
+    */
 #  elif defined(_AIX) || defined(__osf__) || defined(__irix__)
     f->_file = -1;
     return 1;
 #  elif defined(__FreeBSD__)
     /* There may be a better way on FreeBSD:
-        - we could insert a dummy func in the _close function entry 
-	f->_close = (int (*)(void *)) dummy_close; 
+        - we could insert a dummy func in the _close function entry
+	f->_close = (int (*)(void *)) dummy_close;
      */
     f->_file = -1;
     return 1;
+#  elif defined(__EMX__)
+    /* f->_flags &= ~_IOOPEN; */	/* Will leak stream->_buffer */
+    f->_handle = -1;
+    return 1;
 #  elif defined(__CYGWIN__)
     /* There may be a better way on CYGWIN:
-        - we could insert a dummy func in the _close function entry 
-	f->_close = (int (*)(void *)) dummy_close; 
+        - we could insert a dummy func in the _close function entry
+	f->_close = (int (*)(void *)) dummy_close;
      */
     f->_file = -1;
     return 1;
 #  elif defined(WIN32)
 #    if defined(__BORLANDC__)
     f->fd = PerlLIO_dup(fileno(f));
+#    elif defined(UNDER_CE)
+    /* WIN_CE does not have access to FILE internals, it hardly has FILE
+       structure at all
+     */
 #    else
     f->_file = -1;
 #    endif
     return 1;
 #  else
 #if 0
-    /* Sarathy's code did this - we fall back to a dup/dup2 hack 
+    /* Sarathy's code did this - we fall back to a dup/dup2 hack
        (which isn't thread safe) instead
-     */  
+     */
 #    error "Don't know how to set FILE.fileno on your platform"
 #endif
     return 0;
@@ -2795,29 +2920,29 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
         int fd = fileno(stdio);
 	int socksfd = 0;
 	int invalidate = 0;
-	IV result;
+	IV result = 0;
 	int saveerr = 0;
 	int dupfd = 0;
 #ifdef SOCKS5_VERSION_NAME
-    	/* Socks lib overrides close() but stdio isn't linked to 
-	   that library (though we are) - so we must call close() 
-	   on sockets on stdio's behalf. 
-	 */   
+    	/* Socks lib overrides close() but stdio isn't linked to
+	   that library (though we are) - so we must call close()
+	   on sockets on stdio's behalf.
+	 */
     	int optval;
     	Sock_size_t optlen = sizeof(int);
     	if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) {
             socksfd = 1;
-	    invalidate = 1;  
+	    invalidate = 1;
     	}
 #endif
     	if (PerlIOUnix_refcnt_dec(fd) > 0) {
 	    /* File descriptor still in use */
 	    invalidate = 1;
 	    socksfd = 0;
-	}    
+	}
 	if (invalidate) {
-   	    /* For STD* handles don't close the stdio at all 
-	       this is because we have shared the FILE * too 
+   	    /* For STD* handles don't close the stdio at all
+	       this is because we have shared the FILE * too
    	     */
 	    if (stdio == stdin) {
 	    	/* Some stdios are buggy fflush-ing inputs */
@@ -2826,33 +2951,34 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
 	    else if (stdio == stdout || stdio == stderr) {
 	    	return PerlIO_flush(f);
 	    }
-            /* Tricky - must fclose(stdio) to free memory but not close(fd) 
-	       Use Sarathy's trick from maint-5.6 to invalidate the 
-	       fileno slot of the FILE * 
-	    */ 
+            /* Tricky - must fclose(stdio) to free memory but not close(fd)
+	       Use Sarathy's trick from maint-5.6 to invalidate the
+	       fileno slot of the FILE *
+	    */
+	    result = PerlIO_flush(f);
 	    saveerr = errno;
     	    if (!(invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio))) {
 	    	dupfd = PerlLIO_dup(fd);
 	    }
-	} 
+	}
         result = PerlSIO_fclose(stdio);
-	/* We treat error from stdio as success if we invalidated 
-	   errno may NOT be expected EBADF 
+	/* We treat error from stdio as success if we invalidated
+	   errno may NOT be expected EBADF
 	 */
 	if (invalidate && result != 0) {
 	    errno = saveerr;
 	    result = 0;
-	} 
+	}
 	if (socksfd) {
 	    /* in SOCKS case let close() determine return value */
 	    result = close(fd);
 	}
 	if (dupfd) {
 	    PerlLIO_dup2(dupfd,fd);
-	    close(dupfd);
+	    PerlLIO_close(dupfd);
 	}
 	return result;
-    } 
+    }
 }
 
 SSize_t
@@ -2860,20 +2986,28 @@ PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
     SSize_t got = 0;
-    if (count == 1) {
-	STDCHAR *buf = (STDCHAR *) vbuf;
-	/*
-	 * Perl is expecting PerlIO_getc() to fill the buffer Linux's
-	 * stdio does not do that for fread()
-	 */
-	int ch = PerlSIO_fgetc(s);
-	if (ch != EOF) {
-	    *buf = ch;
-	    got = 1;
+    for (;;) {
+	if (count == 1) {
+	    STDCHAR *buf = (STDCHAR *) vbuf;
+	    /*
+	     * Perl is expecting PerlIO_getc() to fill the buffer Linux's
+	     * stdio does not do that for fread()
+	     */
+	    int ch = PerlSIO_fgetc(s);
+	    if (ch != EOF) {
+		*buf = ch;
+		got = 1;
+	    }
 	}
+	else
+	    got = PerlSIO_fread(vbuf, 1, count, s);
+	if (got == 0 && PerlSIO_ferror(s))
+	    got = -1;
+	if (got >= 0 || errno != EINTR)
+	    break;
+	PERL_ASYNC_CHECK();
+	SETERRNO(0,0);	/* just in case */
     }
-    else
-	got = PerlSIO_fread(vbuf, 1, count, s);
     return got;
 }
 
@@ -2938,8 +3072,16 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 SSize_t
 PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    return PerlSIO_fwrite(vbuf, 1, count,
-			  PerlIOSelf(f, PerlIOStdio)->stdio);
+    SSize_t got;
+    for (;;) {
+	got = PerlSIO_fwrite(vbuf, 1, count,
+			      PerlIOSelf(f, PerlIOStdio)->stdio);
+	if (got >= 0 || errno != EINTR)
+	    break;
+	PERL_ASYNC_CHECK();
+	SETERRNO(0,0);	/* just in case */
+    }
+    return got;
 }
 
 IV
@@ -3179,16 +3321,16 @@ PerlIO_funcs PerlIO_stdio = {
 #ifdef USE_STDIO_PTR
     PerlIOStdio_get_ptr,
     PerlIOStdio_get_cnt,
-#if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT)))
-    PerlIOStdio_set_ptrcnt
-#else                           /* STDIO_PTR_LVALUE */
-    NULL
-#endif                          /* STDIO_PTR_LVALUE */
-#else                           /* USE_STDIO_PTR */
+#   if defined(HAS_FAST_STDIO) && defined(USE_FAST_STDIO)
+    PerlIOStdio_set_ptrcnt,
+#   else
+    NULL,
+#   endif /* HAS_FAST_STDIO && USE_FAST_STDIO */
+#else
     NULL,
     NULL,
-    NULL
-#endif                          /* USE_STDIO_PTR */
+    NULL,
+#endif /* USE_STDIO_PTR */
 };
 
 /* Note that calls to PerlIO_exportFILE() are reversed using
@@ -3207,10 +3349,11 @@ PerlIO_exportFILE(PerlIO * f, const char *mode)
 	stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode);
 	if (stdio) {
 	    PerlIOl *l = *f;
+	    PerlIO *f2;
 	    /* De-link any lower layers so new :stdio sticks */
 	    *f = NULL;
-	    if ((f = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
-		PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+	    if ((f2 = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
+		PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio);
 		s->stdio = stdio;
 		/* Link previous lower layers under new one */
 		*PerlIONext(f) = l;
@@ -3288,9 +3431,12 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 {
     if (PerlIOValid(f)) {
 	PerlIO *next = PerlIONext(f);
-	PerlIO_funcs *tab =  PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
-	next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-			  next, narg, args);
+	PerlIO_funcs *tab =
+	     PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
+	if (tab && tab->Open)
+	     next =
+		  (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+			       next, narg, args);
 	if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) {
 	    return NULL;
 	}
@@ -3298,14 +3444,17 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     else {
 	PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm());
 	int init = 0;
-	if (*mode == 'I') {
+	if (*mode == IoTYPE_IMPLICIT) {
 	    init = 1;
 	    /*
 	     * mode++;
 	     */
 	}
-	f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-			  f, narg, args);
+	if (tab && tab->Open)
+	     f = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+			      f, narg, args);
+	else
+	     SETERRNO(EINVAL, LIB_INVARG);
 	if (f) {
 	    if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
 		/*
@@ -3324,7 +3473,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 #ifdef PERLIO_USING_CRLF
 #  ifdef PERLIO_IS_BINMODE_FD
 		if (PERLIO_IS_BINMODE_FD(fd))
-		    PerlIO_binmode(f,  '<'/*not used*/, O_BINARY, Nullch);
+		    PerlIO_binmode(aTHX_ f,  '<'/*not used*/, O_BINARY, Nullch);
 		else
 #  endif
 		/*
@@ -3542,6 +3691,7 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     const STDCHAR *buf = (const STDCHAR *) vbuf;
+    const STDCHAR *flushptr = buf;
     Size_t written = 0;
     if (!b->buf)
 	PerlIO_get_base(f);
@@ -3552,32 +3702,26 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 	    return 0;
 	}
     }	
+    if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) {
+	flushptr = buf + count;
+	while (flushptr > buf && *(flushptr - 1) != '\n')
+	    --flushptr;
+    }
     while (count > 0) {
 	SSize_t avail = b->bufsiz - (b->ptr - b->buf);
 	if ((SSize_t) count < avail)
 	    avail = count;
+	if (flushptr > buf && flushptr <= buf + avail)
+	    avail = flushptr - buf;
 	PerlIOBase(f)->flags |= PERLIO_F_WRBUF;
-	if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) {
-	    while (avail > 0) {
-		int ch = *buf++;
-		*(b->ptr)++ = ch;
-		count--;
-		avail--;
-		written++;
-		if (ch == '\n') {
-		    PerlIO_flush(f);
-		    break;
-		}
-	    }
-	}
-	else {
-	    if (avail) {
-		Copy(buf, b->ptr, avail, STDCHAR);
-		count -= avail;
-		buf += avail;
-		written += avail;
-		b->ptr += avail;
-	    }
+	if (avail) {
+	    Copy(buf, b->ptr, avail, STDCHAR);
+	    count -= avail;
+	    buf += avail;
+	    written += avail;
+	    b->ptr += avail;
+	    if (buf == flushptr)
+		PerlIO_flush(f);
 	}
 	if (b->ptr >= (b->buf + b->bufsiz))
 	    PerlIO_flush(f);
@@ -3610,7 +3754,7 @@ PerlIOBuf_tell(pTHX_ PerlIO *f)
      * b->posn is file position where b->buf was read, or will be written
      */
     Off_t posn = b->posn;
-    if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) && 
+    if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) &&
         (PerlIOBase(f)->flags & PERLIO_F_WRBUF)) {
 #if 1
     	/* As O_APPEND files are normally shared in some sense it is better
@@ -3618,7 +3762,7 @@ PerlIOBuf_tell(pTHX_ PerlIO *f)
 	 */  	
 	PerlIO_flush(f);
 #else	
-        /* when file is NOT shared then this is sufficient */ 
+        /* when file is NOT shared then this is sufficient */
 	PerlIO_seek(PerlIONext(f),0, SEEK_END);
 #endif
 	posn = b->posn = PerlIO_tell(PerlIONext(f));
@@ -3910,6 +4054,23 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 		 f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
 		 PerlIOBase(f)->flags);
 #endif
+    {
+      /* Enable the first CRLF capable layer you can find, but if none
+       * found, the one we just pushed is fine.  This results in at
+       * any given moment at most one CRLF-capable layer being enabled
+       * in the whole layer stack. */
+	 PerlIO *g = PerlIONext(f);
+	 while (g && *g) {
+	      PerlIOl *b = PerlIOBase(g);
+	      if (b && b->tab == &PerlIO_crlf) {
+		   if (!(b->flags & PERLIO_F_CRLF))
+			b->flags |= PERLIO_F_CRLF;
+		   PerlIO_pop(aTHX_ f);
+		   return code;
+	      }		  
+	      g = PerlIONext(g);
+	 }
+    }
     return code;
 }
 
@@ -4552,9 +4713,16 @@ PerlIO_getname(PerlIO *f, char *buf)
     dTHX;
     char *name = NULL;
 #ifdef VMS
+    bool exported = FALSE;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    if (stdio)
+    if (!stdio) {
+	stdio = PerlIO_exportFILE(f,0);
+	exported = TRUE;
+    }
+    if (stdio) {
 	name = fgetname(stdio, buf);
+	if (exported) PerlIO_releaseFILE(f,stdio);
+    }
 #else
     Perl_croak(aTHX_ "Don't know how to get file name");
 #endif
@@ -4698,35 +4866,43 @@ PerlIO_stdoutf(const char *fmt, ...)
 PerlIO *
 PerlIO_tmpfile(void)
 {
-    /*
-     * I have no idea how portable mkstemp() is ...
-     */
-#if defined(WIN32) || !defined(HAVE_MKSTEMP)
-    dTHX;
-    PerlIO *f = NULL;
-    FILE *stdio = PerlSIO_tmpfile();
-    if (stdio) {
-	if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), &PerlIO_stdio, "w+", Nullsv))) {
-	    PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
-	    s->stdio = stdio;
-	}
-    }
-    return f;
-#else
-    dTHX;
-    SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
-    int fd = mkstemp(SvPVX(sv));
-    PerlIO *f = NULL;
-    if (fd >= 0) {
-	f = PerlIO_fdopen(fd, "w+");
-	if (f) {
-	    PerlIOBase(f)->flags |= PERLIO_F_TEMP;
-	}
-	PerlLIO_unlink(SvPVX(sv));
-	SvREFCNT_dec(sv);
-    }
-    return f;
-#endif
+     dTHX;
+     PerlIO *f = NULL;
+     int fd = -1;
+#ifdef WIN32
+     fd = win32_tmpfd();
+     if (fd >= 0)
+	  f = PerlIO_fdopen(fd, "w+b");
+#else /* WIN32 */
+#    if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
+     SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
+
+     /*
+      * I have no idea how portable mkstemp() is ... NI-S
+      */
+     fd = mkstemp(SvPVX(sv));
+     if (fd >= 0) {
+	  f = PerlIO_fdopen(fd, "w+");
+	  if (f)
+	       PerlIOBase(f)->flags |= PERLIO_F_TEMP;
+	  PerlLIO_unlink(SvPVX(sv));
+	  SvREFCNT_dec(sv);
+     }
+#    else	/* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
+     FILE *stdio = PerlSIO_tmpfile();
+
+     if (stdio) {
+	  if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
+                               &PerlIO_stdio, "w+", Nullsv))) {
+               PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+
+               if (s)
+                    s->stdio = stdio;
+          }
+     }
+#    endif /* else HAS_MKSTEMP */
+#endif /* else WIN32 */
+     return f;
 }
 
 #undef HAS_FSETPOS