X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a1ea730d96bcc07b3d616a92ace3927de8290cdd..26d793c1e7db50b3a71c7321e4ad69ec17847520:/perlio.c

diff --git a/perlio.c b/perlio.c
index 793a4e8..7e5a555 100644
--- a/perlio.c
+++ b/perlio.c
@@ -38,6 +38,11 @@
 #define PERL_IN_PERLIO_C
 #include "perl.h"
 
+#ifdef PERL_IMPLICIT_CONTEXT
+#undef dSYS
+#define dSYS dTHX
+#endif
+
 #include "XSUB.h"
 
 int
@@ -84,6 +89,7 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
 #  endif
 #else
 #  if defined(USEMYBINMODE)
+    dTHX;
     if (my_binmode(fp, iotype, mode) != FALSE)
 	return 1;
     else
@@ -173,8 +179,9 @@ PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
 }
 
 PerlIO *
-PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
+PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 {
+#ifndef PERL_MICRO
     if (f) {
 	int fd = PerlLIO_dup(PerlIO_fileno(f));
 	if (fd >= 0) {
@@ -189,6 +196,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
     }
+#endif
     return NULL;
 }
 
@@ -201,7 +209,10 @@ PerlIO *
 PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	     int imode, int perm, PerlIO *old, int narg, SV **args)
 {
-    if (narg == 1) {
+    if (narg) {
+	if (narg > 1) {
+	    Perl_croak(aTHX_ "More than one argument to open");
+	}
 	if (*args == &PL_sv_undef)
 	    return PerlIO_tmpfile();
 	else {
@@ -251,7 +262,7 @@ Perl_boot_core_PerlIO(pTHX)
 #ifdef PERLIO_IS_STDIO
 
 void
-PerlIO_init(void)
+PerlIO_init(pTHX)
 {
     /*
      * Does nothing (yet) except force this file to be included in perl
@@ -288,7 +299,7 @@ PerlIO_tmpfile(void)
 }
 
 void
-PerlIO_init(void)
+PerlIO_init(pTHX)
 {
     /*
      * Force this file to be included in perl binary. Which allows this
@@ -425,7 +436,7 @@ PerlIO_allocate(pTHX)
 	    }
 	}
     }
-    f = PerlMemShared_calloc(PERLIO_TABLE_SIZE, sizeof(PerlIO));
+    Newz('I',f,PERLIO_TABLE_SIZE,PerlIO);
     if (!f) {
 	return NULL;
     }
@@ -435,13 +446,13 @@ PerlIO_allocate(pTHX)
 
 #undef PerlIO_fdupopen
 PerlIO *
-PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
+PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	PerlIO *new;
-	PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
-        new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
+	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 {
@@ -451,25 +462,6 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
 }
 
 void
-PerlIO_clone(pTHX_ PerlIO *proto, CLONE_PARAMS *param)
-{
-    PerlIO **table = &proto;
-    PerlIO *f;
-    PL_perlio = NULL;
-    PerlIO_allocate(aTHX); /* root slot is never used */
-    while ((f = *table)) {
-	    int i;
-	    table = (PerlIO **) (f++);
-	    for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
-		if (*f) {
-		    PerlIO_fdupopen(aTHX_ f, param);
-		}
-		f++;
-	    }
-	}
-}
-
-void
 PerlIO_cleantable(pTHX_ PerlIO **tablep)
 {
     PerlIO *table = *tablep;
@@ -482,16 +474,14 @@ PerlIO_cleantable(pTHX_ PerlIO **tablep)
 		PerlIO_close(f);
 	    }
 	}
-	PerlMemShared_free(table);
+	Safefree(table);
 	*tablep = NULL;
     }
 }
 
-PerlIO_list_t *PerlIO_known_layers;
-PerlIO_list_t *PerlIO_def_layerlist;
 
 PerlIO_list_t *
-PerlIO_list_alloc(void)
+PerlIO_list_alloc(pTHX)
 {
     PerlIO_list_t *list;
     Newz('L', list, 1, PerlIO_list_t);
@@ -500,12 +490,11 @@ PerlIO_list_alloc(void)
 }
 
 void
-PerlIO_list_free(PerlIO_list_t *list)
+PerlIO_list_free(pTHX_ PerlIO_list_t *list)
 {
     if (list) {
 	if (--list->refcnt == 0) {
 	    if (list->array) {
-		dTHX;
 		IV i;
 		for (i = 0; i < list->cur; i++) {
 		    if (list->array[i].arg)
@@ -519,9 +508,8 @@ PerlIO_list_free(PerlIO_list_t *list)
 }
 
 void
-PerlIO_list_push(PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
+PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
 {
-    dTHX;
     PerlIO_pair_t *p;
     if (list->cur >= list->len) {
 	list->len += 8;
@@ -537,21 +525,45 @@ PerlIO_list_push(PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
     }
 }
 
-
-void
-PerlIO_cleanup_layers(pTHX_ void *data)
+PerlIO_list_t *
+PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param)
 {
-#if 0
-    PerlIO_known_layers = Nullhv;
-    PerlIO_def_layerlist = Nullav;
-#endif
+    PerlIO_list_t *list = (PerlIO_list_t *) NULL;
+    if (proto) {
+	int i;
+	list = PerlIO_list_alloc(aTHX);
+	for (i=0; i < proto->cur; i++) {
+	    SV *arg = Nullsv;
+	    if (proto->array[i].arg)
+		arg = PerlIO_sv_dup(aTHX_ proto->array[i].arg,param);
+	    PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg);
+	}
+    }
+    return list;
 }
 
 void
-PerlIO_cleanup()
+PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
 {
-    dTHX;
-    PerlIO_cleantable(aTHX_ &PL_perlio);
+#ifdef USE_ITHREADS
+    PerlIO **table = &proto->Iperlio;
+    PerlIO *f;
+    PL_perlio = NULL;
+    PL_known_layers = PerlIO_clone_list(aTHX_ proto->Iknown_layers, param);
+    PL_def_layerlist = PerlIO_clone_list(aTHX_ proto->Idef_layerlist, param);
+    PerlIO_allocate(aTHX); /* root slot is never used */
+    PerlIO_debug("Clone %p from %p\n",aTHX,proto);
+    while ((f = *table)) {
+	    int i;
+	    table = (PerlIO **) (f++);
+	    for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
+		if (*f) {
+		    (void) fp_dup(f, 0, param);
+		}
+		f++;
+	    }
+	}
+#endif
 }
 
 void
@@ -559,6 +571,9 @@ PerlIO_destruct(pTHX)
 {
     PerlIO **table = &PL_perlio;
     PerlIO *f;
+#ifdef USE_ITHREADS
+    PerlIO_debug("Destruct %p\n",aTHX);
+#endif
     while ((f = *table)) {
 	int i;
 	table = (PerlIO **) (f++);
@@ -578,6 +593,10 @@ PerlIO_destruct(pTHX)
 	    f++;
 	}
     }
+    PerlIO_list_free(aTHX_ PL_known_layers);
+    PL_known_layers = NULL;
+    PerlIO_list_free(aTHX_ PL_def_layerlist);
+    PL_def_layerlist = NULL;
 }
 
 void
@@ -585,18 +604,18 @@ PerlIO_pop(pTHX_ PerlIO *f)
 {
     PerlIOl *l = *f;
     if (l) {
-	PerlIO_debug("PerlIO_pop f=%p %s\n", f, l->tab->name);
+	PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f, l->tab->name);
 	if (l->tab->Popped) {
 	    /*
 	     * If popped returns non-zero do not free its layer structure
 	     * it has either done so itself, or it is shared and still in
 	     * use
 	     */
-	    if ((*l->tab->Popped) (f) != 0)
+	    if ((*l->tab->Popped) (aTHX_ f) != 0)
 		return;
 	}
 	*f = l->next;;
-	PerlMemShared_free(l);
+	Safefree(l);
     }
 }
 
@@ -611,15 +630,15 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
     IV i;
     if ((SSize_t) len <= 0)
 	len = strlen(name);
-    for (i = 0; i < PerlIO_known_layers->cur; i++) {
-	PerlIO_funcs *f = PerlIO_known_layers->array[i].funcs;
+    for (i = 0; i < PL_known_layers->cur; i++) {
+	PerlIO_funcs *f = PL_known_layers->array[i].funcs;
 	if (memEQ(f->name, name, len)) {
-	    PerlIO_debug("%.*s => %p\n", (int) len, name, f);
+	    PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f);
 	    return f;
 	}
     }
-    if (load && PL_subname && PerlIO_def_layerlist
-	&& PerlIO_def_layerlist->cur >= 2) {
+    if (load && PL_subname && PL_def_layerlist
+	&& PL_def_layerlist->cur >= 2) {
 	SV *pkgsv = newSVpvn("PerlIO", 6);
 	SV *layer = newSVpvn(name, len);
 	ENTER;
@@ -742,10 +761,10 @@ XS(XS_PerlIO__Layer__find)
 void
 PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
 {
-    if (!PerlIO_known_layers)
-	PerlIO_known_layers = PerlIO_list_alloc();
-    PerlIO_list_push(PerlIO_known_layers, tab, Nullsv);
-    PerlIO_debug("define %s %p\n", tab->name, tab);
+    if (!PL_known_layers)
+	PL_known_layers = PerlIO_list_alloc(aTHX);
+    PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv);
+    PerlIO_debug("define %s %p\n", tab->name, (void*)tab);
 }
 
 int
@@ -769,8 +788,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 		     */
 		    char q = ((*s == '\'') ? '"' : '\'');
 		    Perl_warn(aTHX_
-			      "perlio: invalid separator character %c%c%c in layer specification list",
-			      q, *s, q);
+			      "perlio: invalid separator character %c%c%c in layer specification list %s",
+			      q, *s, q, s);
 		    return -1;
 		}
 		do {
@@ -819,7 +838,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 		    PerlIO_funcs *layer =
 			PerlIO_find_layer(aTHX_ s, llen, 1);
 		    if (layer) {
-			PerlIO_list_push(av, layer,
+			PerlIO_list_push(aTHX_ av, layer,
 					 (as) ? newSVpvn(as,
 							 alen) :
 					 &PL_sv_undef);
@@ -841,16 +860,14 @@ void
 PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
 {
     PerlIO_funcs *tab = &PerlIO_perlio;
-    if (O_BINARY != O_TEXT) {
-	tab = &PerlIO_crlf;
-    }
-    else {
-	if (PerlIO_stdio.Set_ptrcnt) {
-	    tab = &PerlIO_stdio;
-	}
-    }
+#ifdef PERLIO_USING_CRLF
+    tab = &PerlIO_crlf;
+#else
+    if (PerlIO_stdio.Set_ptrcnt)
+        tab = &PerlIO_stdio;
+#endif
     PerlIO_debug("Pushing %s\n", tab->name);
-    PerlIO_list_push(av, PerlIO_find_layer(aTHX_ tab->name, 0, 0),
+    PerlIO_list_push(aTHX_ av, PerlIO_find_layer(aTHX_ tab->name, 0, 0),
 		     &PL_sv_undef);
 }
 
@@ -876,10 +893,10 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def)
 PerlIO_list_t *
 PerlIO_default_layers(pTHX)
 {
-    if (!PerlIO_def_layerlist) {
+    if (!PL_def_layerlist) {
 	const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
 	PerlIO_funcs *osLayer = &PerlIO_unix;
-	PerlIO_def_layerlist = PerlIO_list_alloc();
+	PL_def_layerlist = PerlIO_list_alloc(aTHX);
 	PerlIO_define_layer(aTHX_ & PerlIO_unix);
 #if defined(WIN32) && !defined(UNDER_CE)
 	PerlIO_define_layer(aTHX_ & PerlIO_win32);
@@ -896,20 +913,20 @@ PerlIO_default_layers(pTHX)
 #endif
 	PerlIO_define_layer(aTHX_ & PerlIO_utf8);
 	PerlIO_define_layer(aTHX_ & PerlIO_byte);
-	PerlIO_list_push(PerlIO_def_layerlist,
+	PerlIO_list_push(aTHX_ PL_def_layerlist,
 			 PerlIO_find_layer(aTHX_ osLayer->name, 0, 0),
 			 &PL_sv_undef);
 	if (s) {
-	    PerlIO_parse_layers(aTHX_ PerlIO_def_layerlist, s);
+	    PerlIO_parse_layers(aTHX_ PL_def_layerlist, s);
 	}
 	else {
-	    PerlIO_default_buffer(aTHX_ PerlIO_def_layerlist);
+	    PerlIO_default_buffer(aTHX_ PL_def_layerlist);
 	}
     }
-    if (PerlIO_def_layerlist->cur < 2) {
-	PerlIO_default_buffer(aTHX_ PerlIO_def_layerlist);
+    if (PL_def_layerlist->cur < 2) {
+	PerlIO_default_buffer(aTHX_ PL_def_layerlist);
     }
-    return PerlIO_def_layerlist;
+    return PL_def_layerlist;
 }
 
 void
@@ -949,15 +966,15 @@ PerlIO *
 PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 {
     PerlIOl *l = NULL;
-    l = PerlMemShared_calloc(tab->size, sizeof(char));
-    if (l) {
+    Newc('L',l,tab->size,char,PerlIOl);
+    if (l && f) {
 	Zero(l, tab->size, char);
 	l->next = *f;
 	l->tab = tab;
 	*f = l;
-	PerlIO_debug("PerlIO_push f=%p %s %s %p\n", f, tab->name,
-		     (mode) ? mode : "(Null)", arg);
-	if ((*l->tab->Pushed) (f, mode, arg) != 0) {
+	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) != 0) {
 	    PerlIO_pop(aTHX_ f);
 	    return NULL;
 	}
@@ -966,9 +983,8 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 }
 
 IV
-PerlIOPop_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
-    dTHX;
     PerlIO_pop(aTHX_ f);
     if (*f) {
 	PerlIO_flush(f);
@@ -979,17 +995,16 @@ PerlIOPop_pushed(PerlIO *f, const char *mode, SV *arg)
 }
 
 IV
-PerlIORaw_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
     /*
      * Remove the dummy layer
      */
-    dTHX;
     PerlIO_pop(aTHX_ f);
     /*
      * Pop back to bottom layer
      */
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIO_flush(f);
 	while (!(PerlIOBase(f)->tab->kind & PERLIO_K_RAW)) {
 	    if (*PerlIONext(f)) {
@@ -1005,7 +1020,7 @@ PerlIORaw_pushed(PerlIO *f, const char *mode, SV *arg)
 		break;
 	    }
 	}
-	PerlIO_debug(":raw f=%p :%s\n", f, PerlIOBase(f)->tab->name);
+	PerlIO_debug(":raw f=%p :%s\n", (void*)f, PerlIOBase(f)->tab->name);
 	return 0;
     }
     return -1;
@@ -1034,13 +1049,13 @@ int
 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
 {
     int code = 0;
-    if (names) {
-	PerlIO_list_t *layers = PerlIO_list_alloc();
+    if (f && names) {
+	PerlIO_list_t *layers = PerlIO_list_alloc(aTHX);
 	code = PerlIO_parse_layers(aTHX_ layers, names);
 	if (code == 0) {
 	    code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0);
 	}
-	PerlIO_list_free(layers);
+	PerlIO_list_free(aTHX_ layers);
     }
     return code;
 }
@@ -1055,43 +1070,94 @@ int
 PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
 {
     PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n",
-		 f, PerlIOBase(f)->tab->name, iotype, mode,
+		 (void*)f, PerlIOBase(f)->tab->name, iotype, mode,
 		 (names) ? names : "(Null)");
-    PerlIO_flush(f);
-    if (!names && (O_TEXT != O_BINARY && (mode & O_BINARY))) {
-	PerlIO *top = f;
-	while (*top) {
-	    if (PerlIOBase(top)->tab == &PerlIO_crlf) {
-		PerlIOBase(top)->flags &= ~PERLIO_F_CRLF;
-		break;
+    if (names) {
+	/* Do not flush etc. if (e.g.) switching encodings.
+	   if a pushed layer knows it needs to flush lower layers
+	   (for example :unix which is never going to call them)
+	   it can do the flush when it is pushed.
+	 */
+	return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE;
+    }
+    else {
+	/* FIXME?: Looking down the layer stack seems wrong,
+	   but is a way of reaching past (say) an encoding layer
+	   to flip CRLF-ness of the layer(s) below
+	 */
+#ifdef PERLIO_USING_CRLF
+	/* Legacy binmode only has meaning if O_TEXT has a value distinct from
+	   O_BINARY so we can look for it in mode.
+	 */
+	if (!(mode & O_BINARY)) {
+	    /* Text mode */
+	    while (*f) {
+		/* Perhaps we should turn on bottom-most aware layer
+		   e.g. Ilya's idea that UNIX TTY could serve
+		 */
+		if (PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) {
+		    if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF)) {
+			/* Not in text mode - flush any pending stuff and flip it */
+			PerlIO_flush(f);
+			PerlIOBase(f)->flags |= PERLIO_F_CRLF;
+		    }
+		    /* Only need to turn it on in one layer so we are done */
+		    return TRUE;
+		}
+		f = PerlIONext(f);
 	    }
-	    top = PerlIONext(top);
-	    PerlIO_flush(top);
+	    /* Not finding a CRLF aware layer presumably means we are binary
+	       which is not what was requested - so we failed
+	       We _could_ push :crlf layer but so could caller
+	     */
+	    return FALSE;
 	}
+#endif
+	/* Either asked for BINMODE or that is normal on this platform
+	   see if any CRLF aware layers are present and turn off the flag
+	   and possibly remove layer.
+	 */
+	while (*f) {
+	    if (PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) {
+		if ((PerlIOBase(f)->flags & PERLIO_F_CRLF)) {
+		    /* In text mode - flush any pending stuff and flip it */
+		    PerlIO_flush(f);
+		    PerlIOBase(f)->flags &= ~PERLIO_F_CRLF;
+#ifndef PERLIO_USING_CRLF
+		    /* CRLF is unusual case - if this is just the :crlf layer pop it */
+		    if (PerlIOBase(f)->tab == &PerlIO_crlf) {
+			PerlIO_pop(aTHX_ f);
+		    }
+#endif
+		    /* Normal case is only one layer doing this, so exit on first
+		       abnormal case can always do multiple binmode calls
+		     */
+		    return TRUE;
+		}
+	    }
+	    f = PerlIONext(f);
+	}
+	return TRUE;
     }
-    return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE;
 }
 
-#undef PerlIO__close
 int
-PerlIO__close(PerlIO *f)
+PerlIO__close(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Close) (f);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_close
 int
-PerlIO_close(PerlIO *f)
+Perl_PerlIO_close(pTHX_ PerlIO *f)
 {
-    dTHX;
     int code = -1;
-    if (f && *f) {
-	code = (*PerlIOBase(f)->tab->Close) (f);
+    if (PerlIOValid(f)) {
+	code = (*PerlIOBase(f)->tab->Close) (aTHX_ f);
 	while (*f) {
 	    PerlIO_pop(aTHX_ f);
 	}
@@ -1099,12 +1165,11 @@ PerlIO_close(PerlIO *f)
     return code;
 }
 
-#undef PerlIO_fileno
 int
-PerlIO_fileno(PerlIO *f)
+Perl_PerlIO_fileno(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Fileno) (f);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Fileno) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
@@ -1179,8 +1244,8 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 	if (SvROK(arg) && !sv_isobject(arg)) {
 	    PerlIO_funcs *handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
 	    if (handler) {
-		def = PerlIO_list_alloc();
-		PerlIO_list_push(def, handler, &PL_sv_undef);
+		def = PerlIO_list_alloc(aTHX);
+		PerlIO_list_push(aTHX_ def, handler, &PL_sv_undef);
 		incdef = 0;
 	    }
 	    /*
@@ -1196,9 +1261,9 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 	PerlIO_list_t *av;
 	if (incdef) {
 	    IV i = def->cur;
-	    av = PerlIO_list_alloc();
+	    av = PerlIO_list_alloc(aTHX);
 	    for (i = 0; i < def->cur; i++) {
-		PerlIO_list_push(av, def->array[i].funcs,
+		PerlIO_list_push(aTHX_ av, def->array[i].funcs,
 				 def->array[i].arg);
 	    }
 	}
@@ -1231,18 +1296,18 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	PerlIO_list_t *layera = NULL;
 	IV n;
 	PerlIO_funcs *tab = NULL;
-	if (f && *f) {
+	if (PerlIOValid(f)) {
 	    /*
 	     * This is "reopen" - it is not tested as perl does not use it
 	     * yet
 	     */
 	    PerlIOl *l = *f;
-	    layera = PerlIO_list_alloc();
+	    layera = PerlIO_list_alloc(aTHX);
 	    while (l) {
-		SV *arg =
-		    (l->tab->Getarg) ? (*l->tab->
-					Getarg) (&l) : &PL_sv_undef;
-		PerlIO_list_push(layera, l->tab, arg);
+		SV *arg = (l->tab->Getarg)
+			? (*l->tab->Getarg) (aTHX_ &l, NULL, 0)
+			: &PL_sv_undef;
+		PerlIO_list_push(aTHX_ layera, l->tab, arg);
 		l = *PerlIONext(&l);
 	    }
 	}
@@ -1265,9 +1330,12 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	    /*
 	     * Found that layer 'n' can do opens - call it
 	     */
+	    if (narg > 1 && !(tab->kind & PERLIO_K_MULTIARG)) {
+		Perl_croak(aTHX_ "More than one argument to open(,':%s')",tab->name);
+	    }
 	    PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
-			 tab->name, layers, mode, fd, imode, perm, f, narg,
-			 args);
+			 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 (f) {
@@ -1283,116 +1351,84 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 		}
 	    }
 	}
-	PerlIO_list_free(layera);
+	PerlIO_list_free(aTHX_ layera);
     }
     return f;
 }
 
 
-#undef PerlIO_fdopen
-PerlIO *
-PerlIO_fdopen(int fd, const char *mode)
-{
-    dTHX;
-    return PerlIO_openn(aTHX_ Nullch, mode, fd, 0, 0, NULL, 0, NULL);
-}
-
-#undef PerlIO_open
-PerlIO *
-PerlIO_open(const char *path, const char *mode)
-{
-    dTHX;
-    SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
-    return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, NULL, 1, &name);
-}
-
-#undef PerlIO_reopen
-PerlIO *
-PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
-{
-    dTHX;
-    SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
-    return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, f, 1, &name);
-}
-
-#undef PerlIO_read
 SSize_t
-PerlIO_read(PerlIO *f, void *vbuf, Size_t count)
+Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Read) (f, vbuf, count);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Read) (aTHX_ f, vbuf, count);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_unread
 SSize_t
-PerlIO_unread(PerlIO *f, const void *vbuf, Size_t count)
+Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Unread) (f, vbuf, count);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Unread) (aTHX_ f, vbuf, count);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_write
 SSize_t
-PerlIO_write(PerlIO *f, const void *vbuf, Size_t count)
+Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Write) (f, vbuf, count);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Write) (aTHX_ f, vbuf, count);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_seek
 int
-PerlIO_seek(PerlIO *f, Off_t offset, int whence)
+Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Seek) (f, offset, whence);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Seek) (aTHX_ f, offset, whence);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_tell
 Off_t
-PerlIO_tell(PerlIO *f)
+Perl_PerlIO_tell(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Tell) (f);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Tell) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_flush
 int
-PerlIO_flush(PerlIO *f)
+Perl_PerlIO_flush(pTHX_ PerlIO *f)
 {
     if (f) {
 	if (*f) {
 	    PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	    if (tab && tab->Flush) {
-		return (*tab->Flush) (f);
+		return (*tab->Flush) (aTHX_ f);
 	    }
 	    else {
-		PerlIO_debug("Cannot flush f=%p :%s\n", f, tab->name);
+		PerlIO_debug("Cannot flush f=%p :%s\n", (void*)f, tab->name);
 		SETERRNO(EBADF, SS$_IVCHAN);
 		return -1;
 	    }
 	}
 	else {
-	    PerlIO_debug("Cannot flush f=%p\n", f);
+	    PerlIO_debug("Cannot flush f=%p\n", (void*)f);
 	    SETERRNO(EBADF, SS$_IVCHAN);
 	    return -1;
 	}
@@ -1405,7 +1441,6 @@ PerlIO_flush(PerlIO *f)
 	 * things on fflush(NULL), but should we be bound by their design
 	 * decisions? --jhi
 	 */
-	dTHX;
 	PerlIO **table = &PL_perlio;
 	int code = 0;
 	while ((f = *table)) {
@@ -1422,9 +1457,8 @@ PerlIO_flush(PerlIO *f)
 }
 
 void
-PerlIOBase_flush_linebuf()
+PerlIOBase_flush_linebuf(pTHX)
 {
-    dTHX;
     PerlIO **table = &PL_perlio;
     PerlIO *f;
     while ((f = *table)) {
@@ -1441,23 +1475,21 @@ PerlIOBase_flush_linebuf()
     }
 }
 
-#undef PerlIO_fill
 int
-PerlIO_fill(PerlIO *f)
+Perl_PerlIO_fill(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Fill) (f);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Fill) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_isutf8
 int
 PerlIO_isutf8(PerlIO *f)
 {
-    if (f && *f)
+    if (PerlIOValid(f))
 	return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
@@ -1465,148 +1497,143 @@ PerlIO_isutf8(PerlIO *f)
     }
 }
 
-#undef PerlIO_eof
 int
-PerlIO_eof(PerlIO *f)
+Perl_PerlIO_eof(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Eof) (f);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Eof) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_error
 int
-PerlIO_error(PerlIO *f)
+Perl_PerlIO_error(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Error) (f);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Error) (aTHX_ f);
     else {
 	SETERRNO(EBADF, SS$_IVCHAN);
 	return -1;
     }
 }
 
-#undef PerlIO_clearerr
 void
-PerlIO_clearerr(PerlIO *f)
+Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	(*PerlIOBase(f)->tab->Clearerr) (f);
+    if (PerlIOValid(f))
+	(*PerlIOBase(f)->tab->Clearerr) (aTHX_ f);
     else
 	SETERRNO(EBADF, SS$_IVCHAN);
 }
 
-#undef PerlIO_setlinebuf
 void
-PerlIO_setlinebuf(PerlIO *f)
+Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	(*PerlIOBase(f)->tab->Setlinebuf) (f);
+    if (PerlIOValid(f))
+	(*PerlIOBase(f)->tab->Setlinebuf) (aTHX_ f);
     else
 	SETERRNO(EBADF, SS$_IVCHAN);
 }
 
-#undef PerlIO_has_base
 int
 PerlIO_has_base(PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	return (PerlIOBase(f)->tab->Get_base != NULL);
     }
     return 0;
 }
 
-#undef PerlIO_fast_gets
 int
 PerlIO_fast_gets(PerlIO *f)
 {
-    if (f && *f && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
+    if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	return (tab->Set_ptrcnt != NULL);
     }
     return 0;
 }
 
-#undef PerlIO_has_cntptr
 int
 PerlIO_has_cntptr(PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
     }
     return 0;
 }
 
-#undef PerlIO_canset_cnt
 int
 PerlIO_canset_cnt(PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIOl *l = PerlIOBase(f);
 	return (l->tab->Set_ptrcnt != NULL);
     }
     return 0;
 }
 
-#undef PerlIO_get_base
 STDCHAR *
-PerlIO_get_base(PerlIO *f)
+Perl_PerlIO_get_base(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Get_base) (f);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Get_base) (aTHX_ f);
     return NULL;
 }
 
-#undef PerlIO_get_bufsiz
 int
-PerlIO_get_bufsiz(PerlIO *f)
+Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f)
 {
-    if (f && *f)
-	return (*PerlIOBase(f)->tab->Get_bufsiz) (f);
+    if (PerlIOValid(f))
+	return (*PerlIOBase(f)->tab->Get_bufsiz) (aTHX_ f);
     return 0;
 }
 
-#undef PerlIO_get_ptr
 STDCHAR *
-PerlIO_get_ptr(PerlIO *f)
+Perl_PerlIO_get_ptr(pTHX_ PerlIO *f)
 {
-    PerlIO_funcs *tab = PerlIOBase(f)->tab;
-    if (tab->Get_ptr == NULL)
-	return NULL;
-    return (*tab->Get_ptr) (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;
 }
 
-#undef PerlIO_get_cnt
 int
-PerlIO_get_cnt(PerlIO *f)
+Perl_PerlIO_get_cnt(pTHX_ PerlIO *f)
 {
-    PerlIO_funcs *tab = PerlIOBase(f)->tab;
-    if (tab->Get_cnt == NULL)
-	return 0;
-    return (*tab->Get_cnt) (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;
 }
 
-#undef PerlIO_set_cnt
 void
-PerlIO_set_cnt(PerlIO *f, int cnt)
+Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt)
 {
-    (*PerlIOBase(f)->tab->Set_ptrcnt) (f, NULL, cnt);
+    if (PerlIOValid(f)) {
+	(*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, NULL, cnt);
+    }
 }
 
-#undef PerlIO_set_ptrcnt
 void
-PerlIO_set_ptrcnt(PerlIO *f, STDCHAR * ptr, int cnt)
+Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
 {
-    PerlIO_funcs *tab = PerlIOBase(f)->tab;
-    if (tab->Set_ptrcnt == NULL) {
-	dTHX;
-	Perl_croak(aTHX_ "PerlIO buffer snooping abuse");
+    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);
     }
-    (*PerlIOBase(f)->tab->Set_ptrcnt) (f, ptr, cnt);
 }
 
 /*--------------------------------------------------------------------------------------*/
@@ -1615,10 +1642,9 @@ PerlIO_set_ptrcnt(PerlIO *f, STDCHAR * ptr, int cnt)
  */
 
 IV
-PerlIOUtf8_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
-    if (PerlIONext(f)) {
-	dTHX;
+    if (*PerlIONext(f)) {
 	PerlIO_funcs *tab = PerlIOBase(f)->tab;
 	PerlIO_pop(aTHX_ f);
 	if (tab->kind & PERLIO_K_UTF8)
@@ -1730,9 +1756,9 @@ PerlIO_funcs PerlIO_raw = {
  */
 
 IV
-PerlIOBase_fileno(PerlIO *f)
+PerlIOBase_fileno(pTHX_ PerlIO *f)
 {
-    return PerlIO_fileno(PerlIONext(f));
+    return PerlIOValid(f) ? PerlIO_fileno(PerlIONext(f)) : -1;
 }
 
 char *
@@ -1757,7 +1783,7 @@ PerlIO_modestr(PerlIO *f, char *buf)
 	    *s++ = '+';
 	}
     }
-#if O_TEXT != O_BINARY
+#ifdef PERLIO_USING_CRLF
     if (!(flags & PERLIO_F_CRLF))
 	*s++ = 'b';
 #endif
@@ -1766,7 +1792,7 @@ PerlIO_modestr(PerlIO *f, char *buf)
 }
 
 IV
-PerlIOBase_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
     PerlIOl *l = PerlIOBase(f);
 #if 0
@@ -1828,15 +1854,14 @@ PerlIOBase_pushed(PerlIO *f, const char *mode, SV *arg)
 }
 
 IV
-PerlIOBase_popped(PerlIO *f)
+PerlIOBase_popped(pTHX_ PerlIO *f)
 {
     return 0;
 }
 
 SSize_t
-PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOBase_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    dTHX;
     /*
      * Save the position as current head considers it
      */
@@ -1844,12 +1869,12 @@ PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
     SSize_t done;
     PerlIO_push(aTHX_ f, &PerlIO_pending, "r", Nullsv);
     PerlIOSelf(f, PerlIOBuf)->posn = old;
-    done = PerlIOBuf_unread(f, vbuf, count);
+    done = PerlIOBuf_unread(aTHX_ f, vbuf, count);
     return done;
 }
 
 SSize_t
-PerlIOBase_read(PerlIO *f, void *vbuf, Size_t count)
+PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     STDCHAR *buf = (STDCHAR *) vbuf;
     if (f) {
@@ -1878,25 +1903,25 @@ PerlIOBase_read(PerlIO *f, void *vbuf, Size_t count)
 }
 
 IV
-PerlIOBase_noop_ok(PerlIO *f)
+PerlIOBase_noop_ok(pTHX_ PerlIO *f)
 {
     return 0;
 }
 
 IV
-PerlIOBase_noop_fail(PerlIO *f)
+PerlIOBase_noop_fail(pTHX_ PerlIO *f)
 {
     return -1;
 }
 
 IV
-PerlIOBase_close(PerlIO *f)
+PerlIOBase_close(pTHX_ PerlIO *f)
 {
     IV code = 0;
     PerlIO *n = PerlIONext(f);
     if (PerlIO_flush(f) != 0)
 	code = -1;
-    if (n && *n && (*PerlIOBase(n)->tab->Close) (n) != 0)
+    if (PerlIOValid(n) && (*PerlIOBase(n)->tab->Close)(aTHX_ n) != 0)
 	code = -1;
     PerlIOBase(f)->flags &=
 	~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
@@ -1904,42 +1929,149 @@ PerlIOBase_close(PerlIO *f)
 }
 
 IV
-PerlIOBase_eof(PerlIO *f)
+PerlIOBase_eof(pTHX_ PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0;
     }
     return 1;
 }
 
 IV
-PerlIOBase_error(PerlIO *f)
+PerlIOBase_error(pTHX_ PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0;
     }
     return 1;
 }
 
 void
-PerlIOBase_clearerr(PerlIO *f)
+PerlIOBase_clearerr(pTHX_ PerlIO *f)
 {
-    if (f && *f) {
+    if (PerlIOValid(f)) {
 	PerlIO *n = PerlIONext(f);
 	PerlIOBase(f)->flags &= ~(PERLIO_F_ERROR | PERLIO_F_EOF);
-	if (n)
+	if (PerlIOValid(n))
 	    PerlIO_clearerr(n);
     }
 }
 
 void
-PerlIOBase_setlinebuf(PerlIO *f)
+PerlIOBase_setlinebuf(pTHX_ PerlIO *f)
 {
-    if (f) {
+    if (PerlIOValid(f)) {
 	PerlIOBase(f)->flags |= PERLIO_F_LINEBUF;
     }
 }
 
+SV *
+PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param)
+{
+    if (!arg)
+	return Nullsv;
+#ifdef sv_dup
+    if (param) {
+	return sv_dup(arg, param);
+    }
+    else {
+	return newSVsv(arg);
+    }
+#else
+    return newSVsv(arg);
+#endif
+}
+
+PerlIO *
+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 (f) {
+	PerlIO_funcs *self = PerlIOBase(o)->tab;
+	SV *arg = Nullsv;
+	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);
+	}
+	f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
+	if (arg) {
+	    SvREFCNT_dec(arg);
+	}
+    }
+    return f;
+}
+
+#define PERLIO_MAX_REFCOUNTABLE_FD 2048
+#ifdef USE_THREADS
+perl_mutex PerlIO_mutex;
+#endif
+int PerlIO_fd_refcnt[PERLIO_MAX_REFCOUNTABLE_FD];
+
+void
+PerlIO_init(pTHX)
+{
+ /* Place holder for stdstreams call ??? */
+#ifdef USE_THREADS
+ MUTEX_INIT(&PerlIO_mutex);
+#endif
+}
+
+void
+PerlIOUnix_refcnt_inc(int fd)
+{
+    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+#ifdef USE_THREADS
+	MUTEX_LOCK(&PerlIO_mutex);
+#endif
+	PerlIO_fd_refcnt[fd]++;
+	PerlIO_debug("fd %d refcnt=%d\n",fd,PerlIO_fd_refcnt[fd]);
+#ifdef USE_THREADS
+	MUTEX_UNLOCK(&PerlIO_mutex);
+#endif
+    }
+}
+
+int
+PerlIOUnix_refcnt_dec(int fd)
+{
+    int cnt = 0;
+    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+#ifdef USE_THREADS
+	MUTEX_LOCK(&PerlIO_mutex);
+#endif
+	cnt = --PerlIO_fd_refcnt[fd];
+	PerlIO_debug("fd %d refcnt=%d\n",fd,cnt);
+#ifdef USE_THREADS
+	MUTEX_UNLOCK(&PerlIO_mutex);
+#endif
+    }
+    return cnt;
+}
+
+void
+PerlIO_cleanup(pTHX)
+{
+    int i;
+#ifdef USE_ITHREADS
+    PerlIO_debug("Cleanup %p\n",aTHX);
+#endif
+    /* Raise STDIN..STDERR refcount so we don't close them */
+    for (i=0; i < 3; i++)
+	PerlIOUnix_refcnt_inc(i);
+    PerlIO_cleantable(aTHX_ &PL_perlio);
+    /* Restore STDIN..STDERR refcount */
+    for (i=0; i < 3; i++)
+	PerlIOUnix_refcnt_dec(i);
+}
+
+
+
 /*--------------------------------------------------------------------------------------*/
 /*
  * Bottom-most level for UNIX-like case
@@ -2008,17 +2140,19 @@ PerlIOUnix_oflags(const char *mode)
 }
 
 IV
-PerlIOUnix_fileno(PerlIO *f)
+PerlIOUnix_fileno(pTHX_ PerlIO *f)
 {
     return PerlIOSelf(f, PerlIOUnix)->fd;
 }
 
 IV
-PerlIOUnix_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
-    IV code = PerlIOBase_pushed(f, mode, arg);
+    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
+    PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
     if (*PerlIONext(f)) {
-	PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
+	/* We never call down so 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
@@ -2038,7 +2172,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 {
     if (f) {
 	if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
-	    (*PerlIOBase(f)->tab->Close) (f);
+	    (*PerlIOBase(f)->tab->Close)(aTHX_ f);
     }
     if (narg > 0) {
 	char *path = SvPV_nolen(*args);
@@ -2066,6 +2200,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	s->fd = fd;
 	s->oflags = imode;
 	PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+        PerlIOUnix_refcnt_inc(fd);
 	return f;
     }
     else {
@@ -2078,75 +2213,31 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     }
 }
 
-SV *
-PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param)
-{
-    if (!arg)
-	return Nullsv;
-#ifdef sv_dup
-    if (param) {
-	return sv_dup(arg, param);
-    }
-    else {
-	return newSVsv(arg);
-    }
-#else
-    return newSVsv(arg);
-#endif
-}
-
 PerlIO *
-PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
-{
-    PerlIO *nexto = PerlIONext(o);
-    if (*nexto) {
-	PerlIO_funcs *tab = PerlIOBase(nexto)->tab;
-	f = (*tab->Dup)(aTHX_ f, nexto, param);
-    }
-    if (f) {
-	PerlIO_funcs *self = PerlIOBase(o)->tab;
-	SV *arg = Nullsv;
-	char buf[8];
-	PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",self->name,f,o,param);
-	if (self->Getarg) {
-	    arg = (*self->Getarg)(o);
-	    if (arg) {
-		arg = PerlIO_sv_dup(aTHX_ arg, param);
-	    }
-	}
-	f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
-	if (!f && arg) {
-	    SvREFCNT_dec(arg);
-	}
-    }
-    return f;
-}
-
-PerlIO *
-PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 {
     PerlIOUnix *os = PerlIOSelf(o, PerlIOUnix);
-    int fd = PerlLIO_dup(os->fd);
-    if (fd >= 0) {
-	f = PerlIOBase_dup(aTHX_ f, o, param);
+    int fd = os->fd;
+    if (flags & PERLIO_DUP_FD) {
+	fd = PerlLIO_dup(fd);
+    }
+    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+	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);
 	    return f;
 	}
-	else {
-	    PerlLIO_close(fd);
-	}
     }
     return NULL;
 }
 
 
 SSize_t
-PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
+PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
-    dTHX;
     int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
 	return 0;
@@ -2164,9 +2255,8 @@ PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
 }
 
 SSize_t
-PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    dTHX;
     int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     while (1) {
 	SSize_t len = PerlLIO_write(fd, vbuf, count);
@@ -2180,9 +2270,8 @@ PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 IV
-PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
+PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
-    dSYS;
     Off_t new =
 	PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, offset, whence);
     PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
@@ -2190,19 +2279,27 @@ PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
 }
 
 Off_t
-PerlIOUnix_tell(PerlIO *f)
+PerlIOUnix_tell(pTHX_ PerlIO *f)
 {
-    dSYS;
     return PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, 0, SEEK_CUR);
 }
 
 
 IV
-PerlIOUnix_close(PerlIO *f)
+PerlIOUnix_close(pTHX_ PerlIO *f)
 {
-    dTHX;
     int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     int code = 0;
+    if (PerlIOBase(f)->flags & PERLIO_F_OPEN) {
+	if (PerlIOUnix_refcnt_dec(fd) > 0) {
+	    PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
+	    return 0;
+        }
+    }
+    else {
+	SETERRNO(EBADF,SS$_IVCHAN);
+	return -1;
+    }
     while (PerlLIO_close(fd) != 0) {
 	if (errno != EINTR) {
 	    code = -1;
@@ -2256,9 +2353,8 @@ typedef struct {
 } PerlIOStdio;
 
 IV
-PerlIOStdio_fileno(PerlIO *f)
+PerlIOStdio_fileno(pTHX_ PerlIO *f)
 {
-    dSYS;
     return PerlSIO_fileno(PerlIOSelf(f, PerlIOStdio)->stdio);
 }
 
@@ -2269,9 +2365,9 @@ PerlIOStdio_mode(const char *mode, char *tmode)
     while (*mode) {
 	*tmode++ = *mode++;
     }
-    if (O_BINARY != O_TEXT) {
-	*tmode++ = 'b';
-    }
+#ifdef PERLIO_USING_CRLF
+    *tmode++ = 'b';
+#endif
     *tmode = '\0';
     return ret;
 }
@@ -2280,24 +2376,25 @@ PerlIOStdio_mode(const char *mode, char *tmode)
  * This isn't used yet ...
  */
 IV
-PerlIOStdio_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
     if (*PerlIONext(f)) {
-	dSYS;
 	PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
 	char tmode[8];
 	FILE *stdio =
 	    PerlSIO_fdopen(PerlIO_fileno(PerlIONext(f)), mode =
 			   PerlIOStdio_mode(mode, tmode));
-	if (stdio)
+	if (stdio) {
 	    s->stdio = stdio;
+	    /* We never call down so any pending stuff now */
+	    PerlIO_flush(PerlIONext(f));
+	}
 	else
 	    return -1;
     }
-    return PerlIOBase_pushed(f, mode, arg);
+    return PerlIOBase_pushed(aTHX_ f, mode, arg);
 }
 
-#undef PerlIO_importFILE
 PerlIO *
 PerlIO_importFILE(FILE *stdio, int fl)
 {
@@ -2322,12 +2419,14 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     if (f) {
 	char *path = SvPV_nolen(*args);
 	PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
-	FILE *stdio =
-	    PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
+	FILE *stdio;
+	PerlIOUnix_refcnt_dec(fileno(s->stdio));
+	stdio = PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
 			    s->stdio);
 	if (!s->stdio)
 	    return NULL;
 	s->stdio = stdio;
+	PerlIOUnix_refcnt_inc(fileno(s->stdio));
 	return f;
     }
     else {
@@ -2347,6 +2446,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 				    PerlIOArg),
 				   PerlIOStdio);
 		    s->stdio = stdio;
+		    PerlIOUnix_refcnt_inc(fileno(s->stdio));
 		}
 		return f;
 	    }
@@ -2381,6 +2481,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 			       (aTHX_(f = PerlIO_allocate(aTHX)), self,
 				mode, PerlIOArg), PerlIOStdio);
 		s->stdio = stdio;
+		PerlIOUnix_refcnt_inc(fileno(s->stdio));
 		return f;
 	    }
 	}
@@ -2388,10 +2489,63 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     return NULL;
 }
 
+PerlIO *
+PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
+{
+    /* This assumes no layers underneath - which is what
+       happens, but is not how I remember it. NI-S 2001/10/16
+     */
+    if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
+	FILE *stdio = PerlIOSelf(o, PerlIOStdio)->stdio;
+	if (flags & PERLIO_DUP_FD) {
+	    int fd = PerlLIO_dup(fileno(stdio));
+	    if (fd >= 0) {
+		char mode[8];
+		stdio = fdopen(fd, PerlIO_modestr(o,mode));
+	    }
+	    else {
+		/* FIXME: To avoid messy error recovery if dup fails
+		   re-use the existing stdio as though flag was not set
+		 */
+	    }
+	}
+	PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+	PerlIOUnix_refcnt_inc(fileno(stdio));
+    }
+    return f;
+}
+
+IV
+PerlIOStdio_close(pTHX_ PerlIO *f)
+{
+#ifdef SOCKS5_VERSION_NAME
+    int optval;
+    Sock_size_t optlen = sizeof(int);
+#endif
+    FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+    if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
+	/* Do not close it but do flush any buffers */
+	PerlIO_flush(f);
+	return 0;
+    }
+    return (
+#ifdef SOCKS5_VERSION_NAME
+	       (getsockopt
+		(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
+		 &optlen) <
+		0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f))
+#else
+	       PerlSIO_fclose(stdio)
+#endif
+	);
+
+}
+
+
+
 SSize_t
-PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
+PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
-    dSYS;
     FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
     SSize_t got = 0;
     if (count == 1) {
@@ -2412,9 +2566,8 @@ PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
 }
 
 SSize_t
-PerlIOStdio_unread(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    dSYS;
     FILE *s = PerlIOSelf(f, PerlIOStdio)->stdio;
     STDCHAR *buf = ((STDCHAR *) vbuf) + count - 1;
     SSize_t unread = 0;
@@ -2429,55 +2582,29 @@ PerlIOStdio_unread(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 SSize_t
-PerlIOStdio_write(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
-    dSYS;
     return PerlSIO_fwrite(vbuf, 1, count,
 			  PerlIOSelf(f, PerlIOStdio)->stdio);
 }
 
 IV
-PerlIOStdio_seek(PerlIO *f, Off_t offset, int whence)
+PerlIOStdio_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
-    dSYS;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     return PerlSIO_fseek(stdio, offset, whence);
 }
 
 Off_t
-PerlIOStdio_tell(PerlIO *f)
+PerlIOStdio_tell(pTHX_ PerlIO *f)
 {
-    dSYS;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     return PerlSIO_ftell(stdio);
 }
 
 IV
-PerlIOStdio_close(PerlIO *f)
+PerlIOStdio_flush(pTHX_ PerlIO *f)
 {
-    dSYS;
-#ifdef SOCKS5_VERSION_NAME
-    int optval;
-    Sock_size_t optlen = sizeof(int);
-#endif
-    FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    return (
-#ifdef SOCKS5_VERSION_NAME
-	       (getsockopt
-		(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
-		 &optlen) <
-		0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f))
-#else
-	       PerlSIO_fclose(stdio)
-#endif
-	);
-
-}
-
-IV
-PerlIOStdio_flush(PerlIO *f)
-{
-    dSYS;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
 	return PerlSIO_fflush(stdio);
@@ -2502,9 +2629,8 @@ PerlIOStdio_flush(PerlIO *f)
 }
 
 IV
-PerlIOStdio_fill(PerlIO *f)
+PerlIOStdio_fill(pTHX_ PerlIO *f)
 {
-    dSYS;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     int c;
     /*
@@ -2521,30 +2647,26 @@ PerlIOStdio_fill(PerlIO *f)
 }
 
 IV
-PerlIOStdio_eof(PerlIO *f)
+PerlIOStdio_eof(pTHX_ PerlIO *f)
 {
-    dSYS;
     return PerlSIO_feof(PerlIOSelf(f, PerlIOStdio)->stdio);
 }
 
 IV
-PerlIOStdio_error(PerlIO *f)
+PerlIOStdio_error(pTHX_ PerlIO *f)
 {
-    dSYS;
     return PerlSIO_ferror(PerlIOSelf(f, PerlIOStdio)->stdio);
 }
 
 void
-PerlIOStdio_clearerr(PerlIO *f)
+PerlIOStdio_clearerr(pTHX_ PerlIO *f)
 {
-    dSYS;
     PerlSIO_clearerr(PerlIOSelf(f, PerlIOStdio)->stdio);
 }
 
 void
-PerlIOStdio_setlinebuf(PerlIO *f)
+PerlIOStdio_setlinebuf(pTHX_ PerlIO *f)
 {
-    dSYS;
 #ifdef HAS_SETLINEBUF
     PerlSIO_setlinebuf(PerlIOSelf(f, PerlIOStdio)->stdio);
 #else
@@ -2554,17 +2676,15 @@ PerlIOStdio_setlinebuf(PerlIO *f)
 
 #ifdef FILE_base
 STDCHAR *
-PerlIOStdio_get_base(PerlIO *f)
+PerlIOStdio_get_base(pTHX_ PerlIO *f)
 {
-    dSYS;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    return PerlSIO_get_base(stdio);
+    return (STDCHAR*)PerlSIO_get_base(stdio);
 }
 
 Size_t
-PerlIOStdio_get_bufsiz(PerlIO *f)
+PerlIOStdio_get_bufsiz(pTHX_ PerlIO *f)
 {
-    dSYS;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     return PerlSIO_get_bufsiz(stdio);
 }
@@ -2572,32 +2692,28 @@ PerlIOStdio_get_bufsiz(PerlIO *f)
 
 #ifdef USE_STDIO_PTR
 STDCHAR *
-PerlIOStdio_get_ptr(PerlIO *f)
+PerlIOStdio_get_ptr(pTHX_ PerlIO *f)
 {
-    dSYS;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    return PerlSIO_get_ptr(stdio);
+    return (STDCHAR*)PerlSIO_get_ptr(stdio);
 }
 
 SSize_t
-PerlIOStdio_get_cnt(PerlIO *f)
+PerlIOStdio_get_cnt(pTHX_ PerlIO *f)
 {
-    dSYS;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     return PerlSIO_get_cnt(stdio);
 }
 
 void
-PerlIOStdio_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
+PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 {
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    dSYS;
     if (ptr != NULL) {
 #ifdef STDIO_PTR_LVALUE
-	PerlSIO_set_ptr(stdio, ptr);
+        PerlSIO_set_ptr(stdio, (void*)ptr); /* LHS STDCHAR* cast non-portable */
 #ifdef STDIO_PTR_LVAL_SETS_CNT
 	if (PerlSIO_get_cnt(stdio) != (cnt)) {
-	    dTHX;
 	    assert(PerlSIO_get_cnt(stdio) == (cnt));
 	}
 #endif
@@ -2629,32 +2745,6 @@ PerlIOStdio_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 
 #endif
 
-PerlIO *
-PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
-{
-    /* This assumes no layers underneath - which is what
-       happens, but is not how I remember it. NI-S 2001/10/16
-     */
-    int fd = PerlLIO_dup(PerlIO_fileno(o));
-    if (fd >= 0) {
-	char buf[8];
-	FILE *stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o, buf));
-	if (stdio) {
-	    if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
-		PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
-	    }
-	    else {
-		PerlSIO_fclose(stdio);
-	    }
-	}
-	else {
-	    PerlLIO_close(fd);
-	    f = NULL;
-	}
-    }
-    return f;
-}
-
 PerlIO_funcs PerlIO_stdio = {
     "stdio",
     sizeof(PerlIOStdio),
@@ -2699,15 +2789,14 @@ PerlIO_funcs PerlIO_stdio = {
 #endif				/* USE_STDIO_PTR */
 };
 
-#undef PerlIO_exportFILE
 FILE *
 PerlIO_exportFILE(PerlIO *f, int fl)
 {
+    dTHX;
     FILE *stdio;
     PerlIO_flush(f);
     stdio = fdopen(PerlIO_fileno(f), "r+");
     if (stdio) {
-	dTHX;
 	PerlIOStdio *s =
 	    PerlIOSelf(PerlIO_push(aTHX_ f, &PerlIO_stdio, "r+", Nullsv),
 		       PerlIOStdio);
@@ -2716,7 +2805,6 @@ PerlIO_exportFILE(PerlIO *f, int fl)
     return stdio;
 }
 
-#undef PerlIO_findFILE
 FILE *
 PerlIO_findFILE(PerlIO *f)
 {
@@ -2731,7 +2819,6 @@ PerlIO_findFILE(PerlIO *f)
     return PerlIO_exportFILE(f, 0);
 }
 
-#undef PerlIO_releaseFILE
 void
 PerlIO_releaseFILE(PerlIO *p, FILE *f)
 {
@@ -2743,9 +2830,8 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
  */
 
 IV
-PerlIOBuf_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
-    dSYS;
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     int fd = PerlIO_fileno(f);
     Off_t posn;
@@ -2756,7 +2842,7 @@ PerlIOBuf_pushed(PerlIO *f, const char *mode, SV *arg)
     if (posn != (Off_t) - 1) {
 	b->posn = posn;
     }
-    return PerlIOBase_pushed(f, mode, arg);
+    return PerlIOBase_pushed(aTHX_ f, mode, arg);
 }
 
 PerlIO *
@@ -2764,21 +2850,17 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	       IV n, const char *mode, int fd, int imode, int perm,
 	       PerlIO *f, int narg, SV **args)
 {
-    if (f) {
+    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,
+	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);
-	if (!next
-	    || (*PerlIOBase(f)->tab->Pushed) (f, mode, PerlIOArg) != 0) {
+	if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) {
 	    return NULL;
 	}
     }
     else {
-	PerlIO_funcs *tab =
-	    PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm());
+	PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm());
 	int init = 0;
 	if (*mode == 'I') {
 	    init = 1;
@@ -2789,19 +2871,26 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 	f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
 			  NULL, narg, args);
 	if (f) {
-	    PerlIO_push(aTHX_ f, self, mode, PerlIOArg);
-	    fd = PerlIO_fileno(f);
-#if O_BINARY != O_TEXT
-	    /*
-	     * do something about failing setmode()? --jhi
-	     */
-	    PerlLIO_setmode(fd, O_BINARY);
-#endif
-	    if (init && fd == 2) {
+            if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
+		/*
+		 * if push fails during open, open fails. close will pop us.
+		 */
+		PerlIO_close (f);
+		return NULL;
+	    } else {
+		fd = PerlIO_fileno(f);
+#ifdef PERLIO_USING_CRLF
 		/*
-		 * Initial stderr is unbuffered
+		 * do something about failing setmode()? --jhi
 		 */
-		PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+		PerlLIO_setmode(fd, O_BINARY);
+#endif
+		if (init && fd == 2) {
+		    /*
+		     * Initial stderr is unbuffered
+		     */
+		    PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+		}
 	    }
 	}
     }
@@ -2813,17 +2902,17 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
  * read or write state
  */
 IV
-PerlIOBuf_flush(PerlIO *f)
+PerlIOBuf_flush(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     int code = 0;
+    PerlIO *n = PerlIONext(f);
     if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) {
 	/*
 	 * write() the buffer
 	 */
 	STDCHAR *buf = b->buf;
 	STDCHAR *p = buf;
-	PerlIO *n = PerlIONext(f);
 	while (p < b->ptr) {
 	    SSize_t count = PerlIO_write(n, p, b->ptr - p);
 	    if (count > 0) {
@@ -2847,37 +2936,37 @@ PerlIOBuf_flush(PerlIO *f)
 	    /*
 	     * We did not consume all of it
 	     */
-	    if (PerlIO_seek(PerlIONext(f), b->posn, SEEK_SET) == 0) {
-		b->posn = PerlIO_tell(PerlIONext(f));
+	    if (PerlIO_seek(n, b->posn, SEEK_SET) == 0) {
+		/* Reload n as some layers may pop themselves on seek */
+		b->posn = PerlIO_tell(n = PerlIONext(f));
 	    }
 	}
     }
     b->ptr = b->end = b->buf;
     PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
-    /*
-     * FIXME: Is this right for read case ?
-     */
-    if (PerlIO_flush(PerlIONext(f)) != 0)
+    /* We check for Valid because of dubious decision to make PerlIO_flush(NULL) flush all */
+    /* FIXME: Doing downstream flush may be sub-optimal see PerlIOBuf_fill() below */
+    if (PerlIOValid(n) && PerlIO_flush(n) != 0)
 	code = -1;
     return code;
 }
 
 IV
-PerlIOBuf_fill(PerlIO *f)
+PerlIOBuf_fill(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     PerlIO *n = PerlIONext(f);
     SSize_t avail;
     /*
-     * FIXME: doing the down-stream flush is a bad idea if it causes
-     * pre-read data in stdio buffer to be discarded but this is too
-     * simplistic - as it skips _our_ hosekeeping and breaks tell tests.
-     * if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { }
+     * FIXME: doing the down-stream flush maybe sub-optimal if it causes
+     * pre-read data in stdio buffer to be discarded.
+     * However, skipping the flush also skips _our_ hosekeeping
+     * and breaks tell tests. So we do the flush.
      */
     if (PerlIO_flush(f) != 0)
 	return -1;
     if (PerlIOBase(f)->flags & PERLIO_F_TTY)
-	PerlIOBase_flush_linebuf();
+	PerlIOBase_flush_linebuf(aTHX);
 
     if (!b->buf)
 	PerlIO_get_base(f);	/* allocate via vtable */
@@ -2885,7 +2974,7 @@ PerlIOBuf_fill(PerlIO *f)
     b->ptr = b->end = b->buf;
     if (PerlIO_fast_gets(n)) {
 	/*
-	 * Layer below is also buffered We do _NOT_ want to call its
+	 * Layer below is also buffered. We do _NOT_ want to call its
 	 * ->Read() because that will loop till it gets what we asked for
 	 * which may hang on a pipe etc. Instead take anything it has to
 	 * hand, or ask it to fill _once_.
@@ -2925,19 +3014,19 @@ PerlIOBuf_fill(PerlIO *f)
 }
 
 SSize_t
-PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count)
+PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
-    if (f) {
+    if (PerlIOValid(f)) {
 	if (!b->ptr)
 	    PerlIO_get_base(f);
-	return PerlIOBase_read(f, vbuf, count);
+	return PerlIOBase_read(aTHX_ f, vbuf, count);
     }
     return 0;
 }
 
 SSize_t
-PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     const STDCHAR *buf = (const STDCHAR *) vbuf + count;
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
@@ -2994,7 +3083,7 @@ PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 SSize_t
-PerlIOBuf_write(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     const STDCHAR *buf = (const STDCHAR *) vbuf;
@@ -3039,7 +3128,7 @@ PerlIOBuf_write(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 IV
-PerlIOBuf_seek(PerlIO *f, Off_t offset, int whence)
+PerlIOBuf_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
     IV code;
     if ((code = PerlIO_flush(f)) == 0) {
@@ -3054,7 +3143,7 @@ PerlIOBuf_seek(PerlIO *f, Off_t offset, int whence)
 }
 
 Off_t
-PerlIOBuf_tell(PerlIO *f)
+PerlIOBuf_tell(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     /*
@@ -3071,12 +3160,12 @@ PerlIOBuf_tell(PerlIO *f)
 }
 
 IV
-PerlIOBuf_close(PerlIO *f)
+PerlIOBuf_close(pTHX_ PerlIO *f)
 {
-    IV code = PerlIOBase_close(f);
+    IV code = PerlIOBase_close(aTHX_ f);
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
-	safefree(b->buf);
+	Safefree(b->buf);
     }
     b->buf = NULL;
     b->ptr = b->end = b->buf;
@@ -3085,7 +3174,7 @@ PerlIOBuf_close(PerlIO *f)
 }
 
 STDCHAR *
-PerlIOBuf_get_ptr(PerlIO *f)
+PerlIOBuf_get_ptr(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     if (!b->buf)
@@ -3094,7 +3183,7 @@ PerlIOBuf_get_ptr(PerlIO *f)
 }
 
 SSize_t
-PerlIOBuf_get_cnt(PerlIO *f)
+PerlIOBuf_get_cnt(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     if (!b->buf)
@@ -3105,7 +3194,7 @@ PerlIOBuf_get_cnt(PerlIO *f)
 }
 
 STDCHAR *
-PerlIOBuf_get_base(PerlIO *f)
+PerlIOBuf_get_base(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     if (!b->buf) {
@@ -3124,7 +3213,7 @@ PerlIOBuf_get_base(PerlIO *f)
 }
 
 Size_t
-PerlIOBuf_bufsiz(PerlIO *f)
+PerlIOBuf_bufsiz(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     if (!b->buf)
@@ -3133,14 +3222,13 @@ PerlIOBuf_bufsiz(PerlIO *f)
 }
 
 void
-PerlIOBuf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
+PerlIOBuf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     if (!b->buf)
 	PerlIO_get_base(f);
     b->ptr = ptr;
     if (PerlIO_get_cnt(f) != cnt || b->ptr < b->buf) {
-	dTHX;
 	assert(PerlIO_get_cnt(f) == cnt);
 	assert(b->ptr >= b->buf);
     }
@@ -3148,9 +3236,9 @@ PerlIOBuf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 }
 
 PerlIO *
-PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 {
- return PerlIOBase_dup(aTHX_ f, o, param);
+ return PerlIOBase_dup(aTHX_ f, o, param, flags);
 }
 
 
@@ -3190,7 +3278,7 @@ PerlIO_funcs PerlIO_perlio = {
  */
 
 IV
-PerlIOPending_fill(PerlIO *f)
+PerlIOPending_fill(pTHX_ PerlIO *f)
 {
     /*
      * Should never happen
@@ -3200,7 +3288,7 @@ PerlIOPending_fill(PerlIO *f)
 }
 
 IV
-PerlIOPending_close(PerlIO *f)
+PerlIOPending_close(pTHX_ PerlIO *f)
 {
     /*
      * A tad tricky - flush pops us, then we close new top
@@ -3210,7 +3298,7 @@ PerlIOPending_close(PerlIO *f)
 }
 
 IV
-PerlIOPending_seek(PerlIO *f, Off_t offset, int whence)
+PerlIOPending_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
     /*
      * A tad tricky - flush pops us, then we seek new top
@@ -3221,12 +3309,11 @@ PerlIOPending_seek(PerlIO *f, Off_t offset, int whence)
 
 
 IV
-PerlIOPending_flush(PerlIO *f)
+PerlIOPending_flush(pTHX_ PerlIO *f)
 {
-    dTHX;
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
-	PerlMemShared_free(b->buf);
+	Safefree(b->buf);
 	b->buf = NULL;
     }
     PerlIO_pop(aTHX_ f);
@@ -3234,20 +3321,20 @@ PerlIOPending_flush(PerlIO *f)
 }
 
 void
-PerlIOPending_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
+PerlIOPending_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 {
     if (cnt <= 0) {
 	PerlIO_flush(f);
     }
     else {
-	PerlIOBuf_set_ptrcnt(f, ptr, cnt);
+	PerlIOBuf_set_ptrcnt(aTHX_ f, ptr, cnt);
     }
 }
 
 IV
-PerlIOPending_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
-    IV code = PerlIOBase_pushed(f, mode, arg);
+    IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
     PerlIOl *l = PerlIOBase(f);
     /*
      * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
@@ -3260,14 +3347,14 @@ PerlIOPending_pushed(PerlIO *f, const char *mode, SV *arg)
 }
 
 SSize_t
-PerlIOPending_read(PerlIO *f, void *vbuf, Size_t count)
+PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     SSize_t avail = PerlIO_get_cnt(f);
     SSize_t got = 0;
     if (count < avail)
 	avail = count;
     if (avail > 0)
-	got = PerlIOBuf_read(f, vbuf, avail);
+	got = PerlIOBuf_read(aTHX_ f, vbuf, avail);
     if (got >= 0 && got < count) {
 	SSize_t more =
 	    PerlIO_read(f, ((STDCHAR *) vbuf) + got, count - got);
@@ -3322,11 +3409,11 @@ typedef struct {
 } PerlIOCrlf;
 
 IV
-PerlIOCrlf_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
     IV code;
     PerlIOBase(f)->flags |= PERLIO_F_CRLF;
-    code = PerlIOBuf_pushed(f, mode, arg);
+    code = PerlIOBuf_pushed(aTHX_ f, mode, arg);
 #if 0
     PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n",
 		 f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
@@ -3337,7 +3424,7 @@ PerlIOCrlf_pushed(PerlIO *f, const char *mode, SV *arg)
 
 
 SSize_t
-PerlIOCrlf_unread(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
     if (c->nl) {
@@ -3345,7 +3432,7 @@ PerlIOCrlf_unread(PerlIO *f, const void *vbuf, Size_t count)
 	c->nl = NULL;
     }
     if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF))
-	return PerlIOBuf_unread(f, vbuf, count);
+	return PerlIOBuf_unread(aTHX_ f, vbuf, count);
     else {
 	const STDCHAR *buf = (const STDCHAR *) vbuf + count;
 	PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
@@ -3386,7 +3473,7 @@ PerlIOCrlf_unread(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 SSize_t
-PerlIOCrlf_get_cnt(PerlIO *f)
+PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     if (!b->buf)
@@ -3417,18 +3504,20 @@ PerlIOCrlf_get_cnt(PerlIO *f)
 		    /*
 		     * Blast - found CR as last char in buffer
 		     */
+
 		    if (b->ptr < nl) {
 			/*
 			 * They may not care, defer work as long as
 			 * possible
 			 */
+			c->nl = nl;
 			return (nl - b->ptr);
 		    }
 		    else {
 			int code;
 			b->ptr++;	/* say we have read it as far as
 					 * flush() is concerned */
-			b->buf++;	/* Leave space an front of buffer */
+			b->buf++;	/* Leave space in front of buffer */
 			b->bufsiz--;	/* Buffer is thus smaller */
 			code = PerlIO_fill(f);	/* Fetch some more */
 			b->bufsiz++;	/* Restore size for next time */
@@ -3442,6 +3531,7 @@ PerlIOCrlf_get_cnt(PerlIO *f)
 			/*
 			 * CR at EOF - just fall through
 			 */
+			/* Should we clear EOF though ??? */
 		    }
 		}
 	    }
@@ -3452,7 +3542,7 @@ PerlIOCrlf_get_cnt(PerlIO *f)
 }
 
 void
-PerlIOCrlf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
+PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
@@ -3460,12 +3550,15 @@ PerlIOCrlf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
     if (!b->buf)
 	PerlIO_get_base(f);
     if (!ptr) {
-	if (c->nl)
+	if (c->nl) {
 	    ptr = c->nl + 1;
+            if (ptr == b->end && *c->nl == 0xd) {
+		/* Defered CR at end of buffer case - we lied about count */
+		ptr--; 	
+            }
+        }
 	else {
 	    ptr = b->end;
-	    if ((flags & PERLIO_F_CRLF) && ptr > b->buf && ptr[-1] == 0xd)
-		ptr--;
 	}
 	ptr -= cnt;
     }
@@ -3473,19 +3566,15 @@ PerlIOCrlf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 	/*
 	 * Test code - delete when it works ...
 	 */
-	STDCHAR *chk;
-	if (c->nl)
-	    chk = c->nl + 1;
-	else {
-	    chk = b->end;
-	    if ((flags & PERLIO_F_CRLF) && chk > b->buf && chk[-1] == 0xd)
-		chk--;
-	}
+	STDCHAR *chk = (c->nl) ? (c->nl+1) : b->end;
+        if (ptr+cnt == c->nl && c->nl+1 == b->end && *c->nl == 0xd) {
+	  /* Defered CR at end of buffer case - we lied about count */
+	  chk--;
+        }
 	chk -= cnt;
 
-	if (ptr != chk) {
-	    dTHX;
-	    Perl_croak(aTHX_ "ptr wrong %p != %p fl=%08" UVxf
+	if (ptr != chk ) {
+	    Perl_warn(aTHX_ "ptr wrong %p != %p fl=%08" UVxf
 		       " nl=%p e=%p for %d", ptr, chk, flags, c->nl,
 		       b->end, cnt);
 	}
@@ -3505,10 +3594,10 @@ PerlIOCrlf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 }
 
 SSize_t
-PerlIOCrlf_write(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOCrlf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF))
-	return PerlIOBuf_write(f, vbuf, count);
+	return PerlIOBuf_write(aTHX_ f, vbuf, count);
     else {
 	PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
 	const STDCHAR *buf = (const STDCHAR *) vbuf;
@@ -3556,14 +3645,14 @@ PerlIOCrlf_write(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 IV
-PerlIOCrlf_flush(PerlIO *f)
+PerlIOCrlf_flush(pTHX_ PerlIO *f)
 {
     PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
     if (c->nl) {
 	*(c->nl) = 0xd;
 	c->nl = NULL;
     }
-    return PerlIOBuf_flush(f);
+    return PerlIOBuf_flush(aTHX_ f);
 }
 
 PerlIO_funcs PerlIO_crlf = {
@@ -3612,9 +3701,8 @@ typedef struct {
 static size_t page_size = 0;
 
 IV
-PerlIOMmap_map(PerlIO *f)
+PerlIOMmap_map(pTHX_ PerlIO *f)
 {
-    dTHX;
     PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
     IV flags = PerlIOBase(f)->flags;
     IV code = 0;
@@ -3623,8 +3711,8 @@ PerlIOMmap_map(PerlIO *f)
     if (flags & PERLIO_F_CANREAD) {
 	PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
 	int fd = PerlIO_fileno(f);
-	struct stat st;
-	code = fstat(fd, &st);
+	Stat_t st;
+	code = Fstat(fd, &st);
 	if (code == 0 && S_ISREG(st.st_mode)) {
 	    SSize_t len = st.st_size - b->posn;
 	    if (len > 0) {
@@ -3707,7 +3795,7 @@ PerlIOMmap_map(PerlIO *f)
 }
 
 IV
-PerlIOMmap_unmap(PerlIO *f)
+PerlIOMmap_unmap(pTHX_ PerlIO *f)
 {
     PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
     PerlIOBuf *b = &m->base;
@@ -3728,7 +3816,7 @@ PerlIOMmap_unmap(PerlIO *f)
 }
 
 STDCHAR *
-PerlIOMmap_get_base(PerlIO *f)
+PerlIOMmap_get_base(pTHX_ PerlIO *f)
 {
     PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
     PerlIOBuf *b = &m->base;
@@ -3746,7 +3834,7 @@ PerlIOMmap_get_base(PerlIO *f)
 	b->buf = NULL;		/* Clear to trigger below */
     }
     if (!b->buf) {
-	PerlIOMmap_map(f);	/* Try and map it */
+	PerlIOMmap_map(aTHX_ f);	/* Try and map it */
 	if (!b->buf) {
 	    /*
 	     * Map did not work - recover PerlIOBuf buffer if we have one
@@ -3757,11 +3845,11 @@ PerlIOMmap_get_base(PerlIO *f)
     b->ptr = b->end = b->buf;
     if (b->buf)
 	return b->buf;
-    return PerlIOBuf_get_base(f);
+    return PerlIOBuf_get_base(aTHX_ f);
 }
 
 SSize_t
-PerlIOMmap_unread(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOMmap_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
     PerlIOBuf *b = &m->base;
@@ -3784,15 +3872,15 @@ PerlIOMmap_unread(PerlIO *f, const void *vbuf, Size_t count)
 	if (!b->buf && m->bbuf)
 	    b->buf = m->bbuf;
 	if (!b->buf) {
-	    PerlIOBuf_get_base(f);
+	    PerlIOBuf_get_base(aTHX_ f);
 	    m->bbuf = b->buf;
 	}
     }
-    return PerlIOBuf_unread(f, vbuf, count);
+    return PerlIOBuf_unread(aTHX_ f, vbuf, count);
 }
 
 SSize_t
-PerlIOMmap_write(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOMmap_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
     PerlIOBuf *b = &m->base;
@@ -3801,7 +3889,7 @@ PerlIOMmap_write(PerlIO *f, const void *vbuf, Size_t count)
 	 * No, or wrong sort of, buffer
 	 */
 	if (m->len) {
-	    if (PerlIOMmap_unmap(f) != 0)
+	    if (PerlIOMmap_unmap(aTHX_ f) != 0)
 		return 0;
 	}
 	/*
@@ -3810,19 +3898,19 @@ PerlIOMmap_write(PerlIO *f, const void *vbuf, Size_t count)
 	if (!b->buf && m->bbuf)
 	    b->buf = m->bbuf;
 	if (!b->buf) {
-	    PerlIOBuf_get_base(f);
+	    PerlIOBuf_get_base(aTHX_ f);
 	    m->bbuf = b->buf;
 	}
     }
-    return PerlIOBuf_write(f, vbuf, count);
+    return PerlIOBuf_write(aTHX_ f, vbuf, count);
 }
 
 IV
-PerlIOMmap_flush(PerlIO *f)
+PerlIOMmap_flush(pTHX_ PerlIO *f)
 {
     PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
     PerlIOBuf *b = &m->base;
-    IV code = PerlIOBuf_flush(f);
+    IV code = PerlIOBuf_flush(aTHX_ f);
     /*
      * Now we are "synced" at PerlIOBuf level
      */
@@ -3831,7 +3919,7 @@ PerlIOMmap_flush(PerlIO *f)
 	    /*
 	     * Unmap the buffer
 	     */
-	    if (PerlIOMmap_unmap(f) != 0)
+	    if (PerlIOMmap_unmap(aTHX_ f) != 0)
 		code = -1;
 	}
 	else {
@@ -3846,21 +3934,21 @@ PerlIOMmap_flush(PerlIO *f)
 }
 
 IV
-PerlIOMmap_fill(PerlIO *f)
+PerlIOMmap_fill(pTHX_ PerlIO *f)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     IV code = PerlIO_flush(f);
     if (code == 0 && !b->buf) {
-	code = PerlIOMmap_map(f);
+	code = PerlIOMmap_map(aTHX_ f);
     }
     if (code == 0 && !(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {
-	code = PerlIOBuf_fill(f);
+	code = PerlIOBuf_fill(aTHX_ f);
     }
     return code;
 }
 
 IV
-PerlIOMmap_close(PerlIO *f)
+PerlIOMmap_close(pTHX_ PerlIO *f)
 {
     PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
     PerlIOBuf *b = &m->base;
@@ -3870,15 +3958,15 @@ PerlIOMmap_close(PerlIO *f)
 	m->bbuf = NULL;
 	b->ptr = b->end = b->buf;
     }
-    if (PerlIOBuf_close(f) != 0)
+    if (PerlIOBuf_close(aTHX_ f) != 0)
 	code = -1;
     return code;
 }
 
 PerlIO *
-PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 {
- return PerlIOBase_dup(aTHX_ f, o, param);
+ return PerlIOBase_dup(aTHX_ f, o, param, flags);
 }
 
 
@@ -3913,47 +4001,27 @@ PerlIO_funcs PerlIO_mmap = {
 
 #endif				/* HAS_MMAP */
 
-void
-PerlIO_init(void)
-{
-    dTHX;
-#ifndef WIN32
-    call_atexit(PerlIO_cleanup_layers, NULL);
-#endif
-    if (!PL_perlio) {
-#ifndef WIN32
-	atexit(&PerlIO_cleanup);
-#endif
-    }
-}
-
-#undef PerlIO_stdin
 PerlIO *
-PerlIO_stdin(void)
+Perl_PerlIO_stdin(pTHX)
 {
-    dTHX;
     if (!PL_perlio) {
 	PerlIO_stdstreams(aTHX);
     }
     return &PL_perlio[1];
 }
 
-#undef PerlIO_stdout
 PerlIO *
-PerlIO_stdout(void)
+Perl_PerlIO_stdout(pTHX)
 {
-    dTHX;
     if (!PL_perlio) {
 	PerlIO_stdstreams(aTHX);
     }
     return &PL_perlio[2];
 }
 
-#undef PerlIO_stderr
 PerlIO *
-PerlIO_stderr(void)
+Perl_PerlIO_stderr(pTHX)
 {
-    dTHX;
     if (!PL_perlio) {
 	PerlIO_stdstreams(aTHX);
     }
@@ -3962,7 +4030,6 @@ PerlIO_stderr(void)
 
 /*--------------------------------------------------------------------------------------*/
 
-#undef PerlIO_getname
 char *
 PerlIO_getname(PerlIO *f, char *buf)
 {
@@ -3985,10 +4052,37 @@ PerlIO_getname(PerlIO *f, char *buf)
  * terms of above
  */
 
+#undef PerlIO_fdopen
+PerlIO *
+PerlIO_fdopen(int fd, const char *mode)
+{
+    dTHX;
+    return PerlIO_openn(aTHX_ Nullch, mode, fd, 0, 0, NULL, 0, NULL);
+}
+
+#undef PerlIO_open
+PerlIO *
+PerlIO_open(const char *path, const char *mode)
+{
+    dTHX;
+    SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
+    return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, NULL, 1, &name);
+}
+
+#undef Perlio_reopen
+PerlIO *
+PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
+{
+    dTHX;
+    SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
+    return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, f, 1, &name);
+}
+
 #undef PerlIO_getc
 int
 PerlIO_getc(PerlIO *f)
 {
+    dTHX;
     STDCHAR buf[1];
     SSize_t count = PerlIO_read(f, buf, 1);
     if (count == 1) {
@@ -4001,6 +4095,7 @@ PerlIO_getc(PerlIO *f)
 int
 PerlIO_ungetc(PerlIO *f, int ch)
 {
+    dTHX;
     if (ch != EOF) {
 	STDCHAR buf = ch;
 	if (PerlIO_unread(f, &buf, 1) == 1)
@@ -4013,6 +4108,7 @@ PerlIO_ungetc(PerlIO *f, int ch)
 int
 PerlIO_putc(PerlIO *f, int ch)
 {
+    dTHX;
     STDCHAR buf = ch;
     return PerlIO_write(f, &buf, 1);
 }
@@ -4021,6 +4117,7 @@ PerlIO_putc(PerlIO *f, int ch)
 int
 PerlIO_puts(PerlIO *f, const char *s)
 {
+    dTHX;
     STRLEN len = strlen(s);
     return PerlIO_write(f, s, len);
 }
@@ -4029,6 +4126,7 @@ PerlIO_puts(PerlIO *f, const char *s)
 void
 PerlIO_rewind(PerlIO *f)
 {
+    dTHX;
     PerlIO_seek(f, (Off_t) 0, SEEK_SET);
     PerlIO_clearerr(f);
 }
@@ -4071,6 +4169,7 @@ PerlIO_printf(PerlIO *f, const char *fmt, ...)
 int
 PerlIO_stdoutf(const char *fmt, ...)
 {
+    dTHX;
     va_list ap;
     int result;
     va_start(ap, fmt);
@@ -4242,3 +4341,7 @@ PerlIO_sprintf(char *s, int n, const char *fmt, ...)
 }
 #endif
 
+
+
+
+