X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=0d4231c9a02511760ef32d50b79de70df88eaf83;hb=e9b37efe4ad36ff6af8f88cfcf6b4f4d152c37c0;hp=c7543d25c5f2934fd747a37b37df3d15813b6d74;hpb=42d9b98d3f03094883cfc4bb765785a6d4396077;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index c7543d2..0d4231c 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1,5 +1,5 @@
 /*
- * perlio.c Copyright (c) 1996-2005, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2006, 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.
  */
@@ -30,7 +30,11 @@
 #ifdef PERL_MICRO
 #   include "uconfig.h"
 #else
-#   include "config.h"
+#   ifndef USE_CROSS_COMPILE
+#       include "config.h"
+#   else
+#       include "xconfig.h"
+#   endif
 #endif
 
 #define PERLIO_NOT_STDIO 0
@@ -56,8 +60,6 @@
 
 #include "XSUB.h"
 
-#define PERLIO_MAX_REFCOUNTABLE_FD 2048
-
 #ifdef __Lynx__
 /* Missing proto on LynxOS */
 int mkstemp(char*);
@@ -112,7 +114,15 @@ int mkstemp(char*);
 	else							\
 		SETERRNO(EBADF, SS_IVCHAN)
 
+#if defined(__osf__) && _XOPEN_SOURCE < 500
+extern int   fseeko(FILE *, off_t, int);
+extern off_t ftello(FILE *);
+#endif
+
 #ifndef USE_SFIO
+
+EXTERN_C int perlsio_binmode(FILE *fp, int iotype, int mode);
+
 int
 perlsio_binmode(FILE *fp, int iotype, int mode)
 {
@@ -360,6 +370,7 @@ Perl_boot_core_PerlIO(pTHX)
 void
 PerlIO_init(pTHX)
 {
+    PERL_UNUSED_CONTEXT;
     /*
      * Does nothing (yet) except force this file to be included in perl
      * binary. That allows this file to force inclusion of other functions
@@ -397,6 +408,7 @@ PerlIO_tmpfile(void)
 void
 PerlIO_init(pTHX)
 {
+    PERL_UNUSED_CONTEXT;
     /*
      * Force this file to be included in perl binary. Which allows this
      * file to force inclusion of other functions that may be required by
@@ -461,12 +473,19 @@ PerlIO_debug(const char *fmt, ...)
     va_list ap;
     dSYS;
     va_start(ap, fmt);
-    if (!PL_perlio_debug_fd && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
-	const char * const s = PerlEnv_getenv("PERLIO_DEBUG");
-	if (s && *s)
-	    PL_perlio_debug_fd = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
-	else
+    if (!PL_perlio_debug_fd) {
+	if (!PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
+	    const char * const s = PerlEnv_getenv("PERLIO_DEBUG");
+	    if (s && *s)
+		PL_perlio_debug_fd
+		    = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
+	    else
+		PL_perlio_debug_fd = -1;
+	} else {
+	    /* tainting or set*id, so ignore the environment, and ensure we
+	       skip these tests next time through.  */
 	    PL_perlio_debug_fd = -1;
+	}
     }
     if (PL_perlio_debug_fd > 0) {
 	dTHX;
@@ -474,13 +493,13 @@ PerlIO_debug(const char *fmt, ...)
 	const char * const s = CopFILE(PL_curcop);
 	/* Use fixed buffer as sv_catpvf etc. needs SVs */
 	char buffer[1024];
-	const STRLEN len = my_sprintf(buffer, "%.40s:%" IVdf " ", s ? s : "(none)", (IV) CopLINE(PL_curcop));
-	const STRLEN len2 = vsprintf(buffer+len, fmt, ap);
-	PerlLIO_write(PL_perlio_debug_fd, buffer, len + len2);
+	const STRLEN len1 = my_snprintf(buffer, sizeof(buffer), "%.40s:%" IVdf " ", s ? s : "(none)", (IV) CopLINE(PL_curcop));
+	const STRLEN len2 = my_vsnprintf(buffer + len1, sizeof(buffer) - len1, fmt, ap);
+	PerlLIO_write(PL_perlio_debug_fd, buffer, len1 + len2);
 #else
 	const char *s = CopFILE(PL_curcop);
 	STRLEN len;
-	SV * const sv = newSVpvn("", 0);
+	SV * const sv = newSVpvs("");
 	Perl_sv_catpvf(aTHX_ sv, "%s:%" IVdf " ", s ? s : "(none)",
 		       (IV) CopLINE(PL_curcop));
 	Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
@@ -507,6 +526,7 @@ PerlIO_debug(const char *fmt, ...)
 PerlIO *
 PerlIO_allocate(pTHX)
 {
+    dVAR;
     /*
      * Find a free slot in the table, allocating new table as necessary
      */
@@ -572,6 +592,7 @@ PerlIO_list_t *
 PerlIO_list_alloc(pTHX)
 {
     PerlIO_list_t *list;
+    PERL_UNUSED_CONTEXT;
     Newxz(list, 1, PerlIO_list_t);
     list->refcnt = 1;
     return list;
@@ -598,7 +619,10 @@ PerlIO_list_free(pTHX_ PerlIO_list_t *list)
 void
 PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
 {
+    dVAR;
     PerlIO_pair_t *p;
+    PERL_UNUSED_CONTEXT;
+
     if (list->cur >= list->len) {
 	list->len += 8;
 	if (list->array)
@@ -609,19 +633,19 @@ PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
     p = &(list->array[list->cur++]);
     p->funcs = funcs;
     if ((p->arg = arg)) {
-	(void)SvREFCNT_inc(arg);
+	SvREFCNT_inc_simple_void_NN(arg);
     }
 }
 
 PerlIO_list_t *
 PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param)
 {
-    PerlIO_list_t *list = (PerlIO_list_t *) NULL;
+    PerlIO_list_t *list = NULL;
     if (proto) {
 	int i;
 	list = PerlIO_list_alloc(aTHX);
 	for (i=0; i < proto->cur; i++) {
-	    SV *arg = Nullsv;
+	    SV *arg = NULL;
 	    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);
@@ -640,7 +664,7 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
     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);
+    PerlIO_debug("Clone %p from %p\n",(void*)aTHX,(void*)proto);
     while ((f = *table)) {
 	    int i;
 	    table = (PerlIO **) (f++);
@@ -652,6 +676,7 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
 	    }
 	}
 #else
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(proto);
     PERL_UNUSED_ARG(param);
 #endif
@@ -660,10 +685,11 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
 void
 PerlIO_destruct(pTHX)
 {
+    dVAR;
     PerlIO **table = &PL_perlio;
     PerlIO *f;
 #ifdef USE_ITHREADS
-    PerlIO_debug("Destruct %p\n",aTHX);
+    PerlIO_debug("Destruct %p\n",(void*)aTHX);
 #endif
     while ((f = *table)) {
 	int i;
@@ -715,6 +741,7 @@ PerlIO_pop(pTHX_ PerlIO *f)
 AV *
 PerlIO_get_layers(pTHX_ PerlIO *f)
 {
+    dVAR;
     AV * const av = newAV();
 
     if (PerlIOValid(f)) {
@@ -760,21 +787,20 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
 	    Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer");
 	    return NULL;
 	} else {
-	    SV * const pkgsv = newSVpvn("PerlIO", 6);
+	    SV * const pkgsv = newSVpvs("PerlIO");
 	    SV * const layer = newSVpvn(name, len);
 	    CV * const cv    = get_cv("PerlIO::Layer::NoWarnings", FALSE);
 	    ENTER;
 	    SAVEINT(PL_in_load_module);
 	    if (cv) {
 		SAVEGENERICSV(PL_warnhook);
-		(void)SvREFCNT_inc(cv);
-		PL_warnhook = (SV *) cv;
+		PL_warnhook = (SV *) (SvREFCNT_inc_simple_NN(cv));
 	    }
 	    PL_in_load_module++;
 	    /*
 	     * The two SVs are magically freed by load_module
 	     */
-	    Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv);
+	    Perl_load_module(aTHX_ 0, pkgsv, NULL, layer, NULL);
 	    PL_in_load_module--;
 	    LEAVE;
 	    return PerlIO_find_layer(aTHX_ name, len, 0);
@@ -851,7 +877,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
 	const char * const name = SvPV_const(ST(i), len);
 	SV * const layer = PerlIO_find_layer(aTHX_ name, len, 1);
 	if (layer) {
-	    av_push(av, SvREFCNT_inc(layer));
+	    av_push(av, SvREFCNT_inc_simple_NN(layer));
 	}
 	else {
 	    ST(count) = ST(i);
@@ -867,7 +893,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
 SV *
 PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
 {
-    HV * const stash = gv_stashpv("PerlIO::Layer", TRUE);
+    HV * const stash = gv_stashpvs("PerlIO::Layer", TRUE);
     SV * const sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))), stash);
     return sv;
 }
@@ -877,6 +903,7 @@ XS(XS_PerlIO__Layer__NoWarnings)
     /* This is used as a %SIG{__WARN__} handler to supress warnings
        during loading of layers.
      */
+    dVAR;
     dXSARGS;
     if (items)
     	PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0)));
@@ -885,6 +912,7 @@ XS(XS_PerlIO__Layer__NoWarnings)
 
 XS(XS_PerlIO__Layer__find)
 {
+    dVAR;
     dXSARGS;
     if (items < 2)
 	Perl_croak(aTHX_ "Usage class->find(name[,load])");
@@ -903,15 +931,17 @@ XS(XS_PerlIO__Layer__find)
 void
 PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
 {
+    dVAR;
     if (!PL_known_layers)
 	PL_known_layers = PerlIO_list_alloc(aTHX);
-    PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv);
+    PerlIO_list_push(aTHX_ PL_known_layers, tab, NULL);
     PerlIO_debug("define %s %p\n", tab->name, (void*)tab);
 }
 
 int
 PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 {
+    dVAR;
     if (names) {
 	const char *s = names;
 	while (*s) {
@@ -920,7 +950,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 	    if (*s) {
 		STRLEN llen = 0;
 		const char *e = s;
-		const char *as = Nullch;
+		const char *as = NULL;
 		STRLEN alen = 0;
 		if (!isIDFIRST(*s)) {
 		    /*
@@ -1005,6 +1035,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
 void
 PerlIO_default_buffer(pTHX_ PerlIO_list_t *av)
 {
+    dVAR;
     PERLIO_FUNCS_DECL(*tab) = &PerlIO_perlio;
 #ifdef PERLIO_USING_CRLF
     tab = &PerlIO_crlf;
@@ -1084,8 +1115,9 @@ PERLIO_FUNCS_DECL(PerlIO_remove) = {
 PerlIO_list_t *
 PerlIO_default_layers(pTHX)
 {
+    dVAR;
     if (!PL_def_layerlist) {
-	const char * const s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
+	const char * const s = (PL_tainting) ? NULL : PerlEnv_getenv("PERLIO");
 	PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix;
 	PL_def_layerlist = PerlIO_list_alloc(aTHX);
 	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_unix));
@@ -1135,6 +1167,7 @@ Perl_boot_core_PerlIO(pTHX)
 PerlIO_funcs *
 PerlIO_default_layer(pTHX_ I32 n)
 {
+    dVAR;
     PerlIO_list_t * const av = PerlIO_default_layers(aTHX);
     if (n < 0)
 	n += av->cur;
@@ -1147,6 +1180,7 @@ PerlIO_default_layer(pTHX_ I32 n)
 void
 PerlIO_stdstreams(pTHX)
 {
+    dVAR;
     if (!PL_perlio) {
 	PerlIO_allocate(aTHX);
 	PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT);
@@ -1168,19 +1202,26 @@ PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg)
 	    goto mismatch;
 	}
 	/* Real layer with a data area */
-	Newxc(l,tab->size,char,PerlIOl);
-	if (l && f) {
-	    Zero(l, tab->size, char);
-	    l->next = *f;
-	    l->tab = (PerlIO_funcs*) tab;
-	    *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 &&
-		(*l->tab->Pushed) (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) {
-		PerlIO_pop(aTHX_ f);
-		return NULL;
+	if (f) {
+	    char *temp;
+	    Newxz(temp, tab->size, char);
+	    l = (PerlIOl*)temp;
+	    if (l) {
+		l->next = *f;
+		l->tab = (PerlIO_funcs*) tab;
+		*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 &&
+		    (*l->tab->Pushed)
+		      (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) {
+		    PerlIO_pop(aTHX_ f);
+		    return NULL;
+		}
 	    }
+	    else
+		return NULL;
 	}
     }
     else if (f) {
@@ -1296,9 +1337,10 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
 int
 PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
 {
-    PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n",
-		 (void*)f, PerlIOBase(f)->tab->name, iotype, mode,
-		 (names) ? names : "(Null)");
+    PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n", (void*)f,
+                 (PerlIOBase(f)) ? PerlIOBase(f)->tab->name : "(Null)",
+                 iotype, mode, (names) ? names : "(Null)");
+
     if (names) {
 	/* Do not flush etc. if (e.g.) switching encodings.
 	   if a pushed layer knows it needs to flush lower layers
@@ -1344,7 +1386,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
 	/* Legacy binmode is now _defined_ as being equivalent to pushing :raw
 	   So code that used to be here is now in PerlIORaw_pushed().
 	 */
-	return PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), Nullch, Nullsv) ? TRUE : FALSE;
+	return PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), NULL, NULL) ? TRUE : FALSE;
     }
 }
 
@@ -1377,64 +1419,49 @@ Perl_PerlIO_close(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_fileno(pTHX_ PerlIO *f)
 {
+    dVAR;
      Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
 }
 
-static const char *
-PerlIO_context_layers(pTHX_ const char *mode)
-{
-    const char *type = NULL;
-    /*
-     * Need to supply default layer info from open.pm
-     */
-    if (PL_curcop) {
-	SV * const layers = PL_curcop->cop_io;
-	if (layers) {
-	    STRLEN len;
-	    type = SvPV_const(layers, len);
-	    if (type && mode[0] != 'r') {
-		/*
-		 * Skip to write part
-		 */
-		const char * const s = strchr(type, 0);
-		if (s && (STRLEN)(s - type) < len) {
-		    type = s + 1;
-		}
-	    }
-	}
-    }
-    return type;
-}
 
 static PerlIO_funcs *
 PerlIO_layer_from_ref(pTHX_ SV *sv)
 {
+    dVAR;
     /*
      * For any scalar type load the handler which is bundled with perl
      */
-    if (SvTYPE(sv) < SVt_PVAV)
-	return PerlIO_find_layer(aTHX_ "scalar", 6, 1);
+    if (SvTYPE(sv) < SVt_PVAV) {
+	PerlIO_funcs *f = PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1);
+	/* This isn't supposed to happen, since PerlIO::scalar is core,
+	 * but could happen anyway in smaller installs or with PAR */
+	if (!f && ckWARN(WARN_LAYER))
+	    Perl_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"scalar\"");
+	return f;
+    }
 
     /*
      * For other types allow if layer is known but don't try and load it
      */
     switch (SvTYPE(sv)) {
     case SVt_PVAV:
-	return PerlIO_find_layer(aTHX_ "Array", 5, 0);
+	return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Array"), 0);
     case SVt_PVHV:
-	return PerlIO_find_layer(aTHX_ "Hash", 4, 0);
+	return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Hash"), 0);
     case SVt_PVCV:
-	return PerlIO_find_layer(aTHX_ "Code", 4, 0);
+	return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0);
     case SVt_PVGV:
-	return PerlIO_find_layer(aTHX_ "Glob", 4, 0);
+	return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0);
+    default:
+	return NULL;
     }
-    return NULL;
 }
 
 PerlIO_list_t *
 PerlIO_resolve_layers(pTHX_ const char *layers,
 		      const char *mode, int narg, SV **args)
 {
+    dVAR;
     PerlIO_list_t *def = PerlIO_default_layers(aTHX);
     int incdef = 1;
     if (!PL_perlio)
@@ -1460,7 +1487,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 	}
     }
     if (!layers || !*layers)
-	layers = PerlIO_context_layers(aTHX_ mode);
+	layers = Perl_PerlIO_context_layers(aTHX_ mode);
     if (layers && *layers) {
 	PerlIO_list_t *av;
 	if (incdef) {
@@ -1479,7 +1506,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 	}
 	else {
 	    PerlIO_list_free(aTHX_ av);
-	    return (PerlIO_list_t *) NULL;
+	    return NULL;
 	}
     }
     else {
@@ -1493,10 +1520,11 @@ PerlIO *
 PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 	     int imode, int perm, PerlIO *f, int narg, SV **args)
 {
+    dVAR;
     if (!f && narg == 1 && *args == &PL_sv_undef) {
 	if ((f = PerlIO_tmpfile())) {
 	    if (!layers || !*layers)
-		layers = PerlIO_context_layers(aTHX_ mode);
+		layers = Perl_PerlIO_context_layers(aTHX_ mode);
 	    if (layers && *layers)
 		PerlIO_apply_layers(aTHX_ f, mode, layers);
 	}
@@ -1546,8 +1574,8 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 		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,
-			 (void*)f, narg, (void*)args);
+			 tab->name, layers ? layers : "(Null)", mode, fd,
+			 imode, perm, (void*)f, narg, (void*)args);
 	    if (tab->Open)
 		 f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
 				   f, narg, args);
@@ -1608,6 +1636,7 @@ Perl_PerlIO_tell(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_flush(pTHX_ PerlIO *f)
 {
+    dVAR;
     if (f) {
 	if (*f) {
 	    const PerlIO_funcs *tab = PerlIOBase(f)->tab;
@@ -1649,6 +1678,7 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f)
 void
 PerlIOBase_flush_linebuf(pTHX)
 {
+    dVAR;
     PerlIO **table = &PL_perlio;
     PerlIO *f;
     while ((f = *table)) {
@@ -1815,6 +1845,7 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
 IV
 PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(mode);
     PERL_UNUSED_ARG(arg);
     if (PerlIOValid(f)) {
@@ -1982,6 +2013,7 @@ IV
 PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     PerlIOl * const l = PerlIOBase(f);
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(arg);
 
     l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE |
@@ -2040,6 +2072,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 IV
 PerlIOBase_popped(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(f);
     return 0;
 }
@@ -2051,7 +2084,7 @@ PerlIOBase_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
      * Save the position as current head considers it
      */
     const Off_t old = PerlIO_tell(f);
-    PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_pending), "r", Nullsv);
+    PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_pending), "r", NULL);
     PerlIOSelf(f, PerlIOBuf)->posn = old;
     return PerlIOBuf_unread(aTHX_ f, vbuf, count);
 }
@@ -2072,7 +2105,7 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 	    SSize_t avail = PerlIO_get_cnt(f);
 	    SSize_t take = 0;
 	    if (avail > 0)
-		take = ((SSize_t)count < avail) ? count : avail;
+		take = ((SSize_t)count < avail) ? (SSize_t)count : avail;
 	    if (take > 0) {
 		STDCHAR *ptr = PerlIO_get_ptr(f);
 		Copy(ptr, buf, take, STDCHAR);
@@ -2096,6 +2129,7 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 IV
 PerlIOBase_noop_ok(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(f);
     return 0;
 }
@@ -2103,6 +2137,7 @@ PerlIOBase_noop_ok(pTHX_ PerlIO *f)
 IV
 PerlIOBase_noop_fail(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(f);
     return -1;
 }
@@ -2139,6 +2174,7 @@ PerlIOBase_close(pTHX_ PerlIO *f)
 IV
 PerlIOBase_eof(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
     if (PerlIOValid(f)) {
 	return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0;
     }
@@ -2148,6 +2184,7 @@ PerlIOBase_eof(pTHX_ PerlIO *f)
 IV
 PerlIOBase_error(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
     if (PerlIOValid(f)) {
 	return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0;
     }
@@ -2168,6 +2205,7 @@ PerlIOBase_clearerr(pTHX_ PerlIO *f)
 void
 PerlIOBase_setlinebuf(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
     if (PerlIOValid(f)) {
 	PerlIOBase(f)->flags |= PERLIO_F_LINEBUF;
     }
@@ -2177,7 +2215,7 @@ SV *
 PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param)
 {
     if (!arg)
-	return Nullsv;
+	return NULL;
 #ifdef sv_dup
     if (param) {
 	return sv_dup(arg, param);
@@ -2211,7 +2249,7 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 	if (self->Getarg)
 	    arg = (*self->Getarg)(aTHX_ o, param, flags);
 	else {
-	    arg = Nullsv;
+	    arg = NULL;
 	}
 	f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
 	if (arg) {
@@ -2221,34 +2259,83 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
     return f;
 }
 
-#ifdef USE_THREADS
-perl_mutex PerlIO_mutex;
+/* PL_perlio_fd_refcnt[] is in intrpvar.h */
+
+/* Must be called with PL_perlio_mutex locked. */
+static void
+S_more_refcounted_fds(pTHX_ const int new_fd) {
+    dVAR;
+    const int old_max = PL_perlio_fd_refcnt_size;
+    const int new_max = 16 + (new_fd & ~15);
+    int *new_array;
+
+    PerlIO_debug("More fds - old=%d, need %d, new=%d\n",
+		 old_max, new_fd, new_max);
+
+    if (new_fd < old_max) {
+	return;
+    }
+
+    assert (new_max > new_fd);
+
+    /* Use plain realloc() since we need this memory to be really
+     * global and visible to all the interpreters and/or threads. */
+    new_array = (int*) realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
+
+    if (!new_array) {
+#ifdef USE_ITHREADS
+	MUTEX_UNLOCK(&PL_perlio_mutex);
 #endif
+	/* Can't use PerlIO to write as it allocates memory */
+	PerlLIO_write(PerlIO_fileno(Perl_error_log),
+		      PL_no_mem, strlen(PL_no_mem));
+	my_exit(1);
+    }
+
+    PL_perlio_fd_refcnt_size = new_max;
+    PL_perlio_fd_refcnt = new_array;
+
+    PerlIO_debug("Zeroing %p, %d\n",
+		 (void*)(new_array + old_max),
+		 new_max - old_max);
+
+    Zero(new_array + old_max, new_max - old_max, int);
+}
 
-/* PL_perlio_fd_refcnt[] is in intrpvar.h */
 
 void
 PerlIO_init(pTHX)
 {
- /* Place holder for stdstreams call ??? */
-#ifdef USE_THREADS
-    MUTEX_INIT(&PerlIO_mutex);
-#endif
+    /* MUTEX_INIT(&PL_perlio_mutex) is done in PERL_SYS_INIT3(). */
+    PERL_UNUSED_CONTEXT;
 }
 
 void
 PerlIOUnix_refcnt_inc(int fd)
 {
     dTHX;
-    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
-#ifdef USE_THREADS
-	MUTEX_LOCK(&PerlIO_mutex);
+    if (fd >= 0) {
+	dVAR;
+
+#ifdef USE_ITHREADS
+	MUTEX_LOCK(&PL_perlio_mutex);
 #endif
+	if (fd >= PL_perlio_fd_refcnt_size)
+	    S_more_refcounted_fds(aTHX_ fd);
+
 	PL_perlio_fd_refcnt[fd]++;
-	PerlIO_debug("fd %d refcnt=%d\n",fd,PL_perlio_fd_refcnt[fd]);
-#ifdef USE_THREADS
-	MUTEX_UNLOCK(&PerlIO_mutex);
+	if (PL_perlio_fd_refcnt[fd] <= 0) {
+	    Perl_croak(aTHX_ "refcnt_inc: fd %d: %d <= 0\n",
+		       fd, PL_perlio_fd_refcnt[fd]);
+	}
+	PerlIO_debug("refcnt_inc: fd %d refcnt=%d\n",
+		     fd, PL_perlio_fd_refcnt[fd]);
+
+#ifdef USE_ITHREADS
+	MUTEX_UNLOCK(&PL_perlio_mutex);
 #endif
+    } else {
+	Perl_croak(aTHX_ "refcnt_inc: fd %d < 0\n", fd);
     }
 }
 
@@ -2257,15 +2344,26 @@ PerlIOUnix_refcnt_dec(int fd)
 {
     dTHX;
     int cnt = 0;
-    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
-#ifdef USE_THREADS
-	MUTEX_LOCK(&PerlIO_mutex);
+    if (fd >= 0) {
+	dVAR;
+#ifdef USE_ITHREADS
+	MUTEX_LOCK(&PL_perlio_mutex);
 #endif
+	if (fd >= PL_perlio_fd_refcnt_size) {
+	    Perl_croak(aTHX_ "refcnt_dec: fd %d >= refcnt_size %d\n",
+		       fd, PL_perlio_fd_refcnt_size);
+	}
+	if (PL_perlio_fd_refcnt[fd] <= 0) {
+	    Perl_croak(aTHX_ "refcnt_dec: fd %d: %d <= 0\n",
+		       fd, PL_perlio_fd_refcnt[fd]);
+	}
 	cnt = --PL_perlio_fd_refcnt[fd];
-	PerlIO_debug("fd %d refcnt=%d\n",fd,cnt);
-#ifdef USE_THREADS
-	MUTEX_UNLOCK(&PerlIO_mutex);
+	PerlIO_debug("refcnt_dec: fd %d refcnt=%d\n", fd, cnt);
+#ifdef USE_ITHREADS
+	MUTEX_UNLOCK(&PL_perlio_mutex);
 #endif
+    } else {
+	Perl_croak(aTHX_ "refcnt_dec: fd %d < 0\n", fd);
     }
     return cnt;
 }
@@ -2273,12 +2371,14 @@ PerlIOUnix_refcnt_dec(int fd)
 void
 PerlIO_cleanup(pTHX)
 {
+    dVAR;
     int i;
 #ifdef USE_ITHREADS
-    PerlIO_debug("Cleanup layers for %p\n",aTHX);
+    PerlIO_debug("Cleanup layers for %p\n",(void*)aTHX);
 #else
     PerlIO_debug("Cleanup layers\n");
 #endif
+
     /* Raise STDIN..STDERR refcount so we don't close them */
     for (i=0; i < 3; i++)
 	PerlIOUnix_refcnt_inc(i);
@@ -2297,6 +2397,32 @@ PerlIO_cleanup(pTHX)
     }
 }
 
+void PerlIO_teardown(pTHX) /* Call only from PERL_SYS_TERM(). */
+{
+    
+#ifdef DEBUGGING
+    {
+	/* By now all filehandles should have been closed, so any
+	 * stray (non-STD-)filehandles indicate *possible* (PerlIO)
+	 * errors. */
+	int i;
+	for (i = 3; i < PL_perlio_fd_refcnt_size; i++) {
+	    if (PL_perlio_fd_refcnt[i])
+		PerlIO_debug("PerlIO_cleanup: fd %d refcnt=%d\n",
+			     i, PL_perlio_fd_refcnt[i]);
+	}
+    }
+#endif
+    /* Not bothering with PL_perlio_mutex since by now
+     * all the interpreters are gone. */
+    if (PL_perlio_fd_refcnt_size /* Assuming initial size of zero. */
+        && PL_perlio_fd_refcnt) {
+	free(PL_perlio_fd_refcnt); /* To match realloc() in S_more_refcounted_fds(). */
+	PL_perlio_fd_refcnt = NULL;
+	PL_perlio_fd_refcnt_size = 0;
+    }
+}
+
 
 
 /*--------------------------------------------------------------------------------------*/
@@ -2369,6 +2495,7 @@ PerlIOUnix_oflags(const char *mode)
 IV
 PerlIOUnix_fileno(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
     return PerlIOSelf(f, PerlIOUnix)->fd;
 }
 
@@ -2391,6 +2518,7 @@ PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode)
     s->fd = fd;
     s->oflags = imode;
     PerlIOUnix_refcnt_inc(fd);
+    PERL_UNUSED_CONTEXT;
 }
 
 IV
@@ -2418,6 +2546,7 @@ PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     Off_t new_loc;
+    PERL_UNUSED_CONTEXT;
     if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) {
 #ifdef  ESPIPE
 	SETERRNO(ESPIPE, LIB_INVARG);
@@ -2473,6 +2602,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     }
     else {
 	if (f) {
+	    NOOP;
 	    /*
 	     * FIXME: pop layers ???
 	     */
@@ -2489,7 +2619,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
     if (flags & PERLIO_DUP_FD) {
 	fd = PerlLIO_dup(fd);
     }
-    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+    if (fd >= 0) {
 	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 */
@@ -2504,6 +2634,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 SSize_t
 PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
+    dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
 #ifdef PERLIO_STD_SPECIAL
     if (fd == 0)
@@ -2535,6 +2666,7 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 SSize_t
 PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
+    dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
 #ifdef PERLIO_STD_SPECIAL
     if (fd == 1 || fd == 2)
@@ -2558,6 +2690,8 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 Off_t
 PerlIOUnix_tell(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
+
     return PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, 0, SEEK_CUR);
 }
 
@@ -2565,6 +2699,7 @@ PerlIOUnix_tell(pTHX_ PerlIO *f)
 IV
 PerlIOUnix_close(pTHX_ PerlIO *f)
 {
+    dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     int code = 0;
     if (PerlIOBase(f)->flags & PERLIO_F_OPEN) {
@@ -2642,6 +2777,8 @@ typedef struct {
 IV
 PerlIOStdio_fileno(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
+
     if (PerlIOValid(f)) {
 	FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
 	if (s)
@@ -2726,7 +2863,7 @@ PerlIO_importFILE(FILE *stdio, const char *mode)
 	    }
 	    fclose(f2);
 	}
-	if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, Nullsv))) {
+	if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) {
 	    s = PerlIOSelf(f, PerlIOStdio);
 	    s->stdio = stdio;
 	}
@@ -2770,7 +2907,6 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 #endif
 		stdio = PerlSIO_fopen(path, mode);
 		if (stdio) {
-		    PerlIOStdio *s;
 		    if (!f) {
 			f = PerlIO_allocate(aTHX);
 		    }
@@ -2778,9 +2914,10 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 		        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));
+			PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+			PerlIOUnix_refcnt_inc(fileno(stdio));
+		    } else {
+			PerlSIO_fclose(stdio);
 		    }
 		    return f;
 		}
@@ -2818,9 +2955,8 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 		    f = PerlIO_allocate(aTHX);
 		}
 		if ((f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) {
-		    PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
-		    s->stdio = stdio;
-		    PerlIOUnix_refcnt_inc(fileno(s->stdio));
+		    PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+		    PerlIOUnix_refcnt_inc(fileno(stdio));
 		}
 		return f;
 	    }
@@ -2846,6 +2982,7 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 		goto set_this;
 	    }
 	    else {
+		NOOP;
 		/* FIXME: To avoid messy error recovery if dup fails
 		   re-use the existing stdio as though flag was not set
 		 */
@@ -2862,6 +2999,8 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 static int
 PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
 {
+    PERL_UNUSED_CONTEXT;
+
     /* XXX this could use PerlIO_canset_fileno() and
      * PerlIO_set_fileno() support from Configure
      */
@@ -2876,31 +3015,8 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
     f->_fileno = -1;
     return 1;
 #  elif defined(__sun__)
-#    if defined(_LP64)
-    /* On solaris, if _LP64 is defined, the FILE structure is this:
-     *
-     *  struct FILE {
-     *      long __pad[16];
-     *  };
-     *
-     * 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.
-     *
-     * We set the top bits to -1 (0xFFFFFFFF).
-     */
-    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
-       a dup fail ...
-     */
-    f->_file = PerlLIO_dup(fileno(f));
-#    endif /* defined(_LP64) */
-    return 1;
+    PERL_UNUSED_ARG(f);
+    return 0;
 #  elif defined(__hpux)
     f->__fileH = 0xff;
     f->__fileL = 0xff;
@@ -2971,7 +3087,6 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
     }
     else {
         const int fd = fileno(stdio);
-	int socksfd = 0;
 	int invalidate = 0;
 	IV result = 0;
 	int saveerr = 0;
@@ -2983,36 +3098,26 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
 	 */
     	int optval;
     	Sock_size_t optlen = sizeof(int);
-    	if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) {
-            socksfd = 1;
+	if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0)
 	    invalidate = 1;
-    	}
 #endif
-    	if (PerlIOUnix_refcnt_dec(fd) > 0) {
-	    /* File descriptor still in use */
+	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
-   	     */
-	    if (stdio == stdin) {
-	    	/* Some stdios are buggy fflush-ing inputs */
-	    	return 0;
-	    }
-	    else if (stdio == stdout || stdio == stderr) {
-	    	return PerlIO_flush(f);
-	    }
+	    /* For STD* handles, don't close stdio, since we shared the FILE *, too. */
+	    if (stdio == stdin) /* Some stdios are buggy fflush-ing inputs */
+		return 0;
+	    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 *
 	    */
 	    result = PerlIO_flush(f);
 	    saveerr = errno;
-    	    if (!(invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio))) {
-	    	dupfd = PerlLIO_dup(fd);
-	    }
+	    invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio);
+	    if (!invalidate)
+		dupfd = PerlLIO_dup(fd);
 	}
         result = PerlSIO_fclose(stdio);
 	/* We treat error from stdio as success if we invalidated
@@ -3022,10 +3127,10 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
 	    errno = saveerr;
 	    result = 0;
 	}
-	if (socksfd) {
-	    /* in SOCKS case let close() determine return value */
-	    result = close(fd);
-	}
+#ifdef SOCKS5_VERSION_NAME
+	/* in SOCKS' case, let close() determine return value */
+	result = close(fd);
+#endif
 	if (dupfd) {
 	    PerlLIO_dup2(dupfd,fd);
 	    PerlLIO_close(dupfd);
@@ -3037,6 +3142,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
 SSize_t
 PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
+    dVAR;
     FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio;
     SSize_t got = 0;
     for (;;) {
@@ -3125,6 +3231,7 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 SSize_t
 PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
+    dVAR;
     SSize_t got;
     for (;;) {
 	got = PerlSIO_fwrite(vbuf, 1, count,
@@ -3141,6 +3248,8 @@ IV
 PerlIOStdio_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+    PERL_UNUSED_CONTEXT;
+
     return PerlSIO_fseek(stdio, offset, whence);
 }
 
@@ -3148,6 +3257,8 @@ Off_t
 PerlIOStdio_tell(pTHX_ PerlIO *f)
 {
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+    PERL_UNUSED_CONTEXT;
+
     return PerlSIO_ftell(stdio);
 }
 
@@ -3155,10 +3266,13 @@ IV
 PerlIOStdio_flush(pTHX_ PerlIO *f)
 {
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+    PERL_UNUSED_CONTEXT;
+
     if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
 	return PerlSIO_fflush(stdio);
     }
     else {
+	NOOP;
 #if 0
 	/*
 	 * FIXME: This discards ungetc() and pre-read stuff which is not
@@ -3169,7 +3283,7 @@ PerlIOStdio_flush(pTHX_ PerlIO *f)
 	/*
 	 * Not writeable - sync by attempting a seek
 	 */
-	int err = errno;
+	const int err = errno;
 	if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0)
 	    errno = err;
 #endif
@@ -3180,28 +3294,36 @@ PerlIOStdio_flush(pTHX_ PerlIO *f)
 IV
 PerlIOStdio_eof(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
+
     return PerlSIO_feof(PerlIOSelf(f, PerlIOStdio)->stdio);
 }
 
 IV
 PerlIOStdio_error(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
+
     return PerlSIO_ferror(PerlIOSelf(f, PerlIOStdio)->stdio);
 }
 
 void
 PerlIOStdio_clearerr(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
+
     PerlSIO_clearerr(PerlIOSelf(f, PerlIOStdio)->stdio);
 }
 
 void
 PerlIOStdio_setlinebuf(pTHX_ PerlIO *f)
 {
+    PERL_UNUSED_CONTEXT;
+
 #ifdef HAS_SETLINEBUF
     PerlSIO_setlinebuf(PerlIOSelf(f, PerlIOStdio)->stdio);
 #else
-    PerlSIO_setvbuf(PerlIOSelf(f, PerlIOStdio)->stdio, Nullch, _IOLBF, 0);
+    PerlSIO_setvbuf(PerlIOSelf(f, PerlIOStdio)->stdio, NULL, _IOLBF, 0);
 #endif
 }
 
@@ -3242,7 +3364,7 @@ PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (ptr != NULL) {
 #ifdef STDIO_PTR_LVALUE
-	PerlSIO_set_ptr(stdio, (void*)ptr); /* LHS STDCHAR* cast non-portable */
+	PerlSIO_set_ptr(stdio, ptr); /* LHS STDCHAR* cast non-portable */
 #ifdef STDIO_PTR_LVAL_SETS_CNT
 	if (PerlSIO_get_cnt(stdio) != (cnt)) {
 	    assert(PerlSIO_get_cnt(stdio) == (cnt));
@@ -3282,6 +3404,8 @@ PerlIOStdio_fill(pTHX_ PerlIO *f)
 {
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     int c;
+    PERL_UNUSED_CONTEXT;
+
     /*
      * fflush()ing read-only streams can cause trouble on some stdio-s
      */
@@ -3405,7 +3529,7 @@ PerlIO_exportFILE(PerlIO * f, const char *mode)
 	    PerlIO *f2;
 	    /* De-link any lower layers so new :stdio sticks */
 	    *f = NULL;
-	    if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, Nullsv))) {
+	    if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, NULL))) {
 		PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio);
 		s->stdio = stdio;
 		/* Link previous lower layers under new one */
@@ -3433,7 +3557,7 @@ PerlIO_findFILE(PerlIO *f)
 	l = *PerlIONext(&l);
     }
     /* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */
-    return PerlIO_exportFILE(f, Nullch);
+    return PerlIO_exportFILE(f, NULL);
 }
 
 /* Use this to reverse PerlIO_exportFILE calls. */
@@ -3527,7 +3651,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(aTHX_ f,  '<'/*not used*/, O_BINARY, Nullch);
+		    PerlIO_binmode(aTHX_ f,  '<'/*not used*/, O_BINARY, NULL);
 		else
 #  endif
 		/*
@@ -3628,6 +3752,8 @@ PerlIOBuf_fill(pTHX_ PerlIO *f)
     if (!b->buf)
 	PerlIO_get_base(f);     /* allocate via vtable */
 
+    assert(b->buf); /* The b->buf does get allocated via the vtable system. */
+
     b->ptr = b->end = b->buf;
 
     if (!PerlIOValid(n)) {
@@ -3888,6 +4014,8 @@ STDCHAR *
 PerlIOBuf_get_base(pTHX_ PerlIO *f)
 {
     PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
+    PERL_UNUSED_CONTEXT;
+
     if (!b->buf) {
 	if (!b->bufsiz)
 	    b->bufsiz = 4096;
@@ -4109,6 +4237,21 @@ typedef struct {
 				 * buffer */
 } PerlIOCrlf;
 
+/* Inherit the PERLIO_F_UTF8 flag from previous layer.
+ * Otherwise the :crlf layer would always revert back to
+ * raw mode.
+ */
+static void
+S_inherit_utf8_flag(PerlIO *f)
+{
+    PerlIO *g = PerlIONext(f);
+    if (PerlIOValid(g)) {
+	if (PerlIOBase(g)->flags & PERLIO_F_UTF8) {
+	    PerlIOBase(f)->flags |= PERLIO_F_UTF8;
+	}
+    }
+}
+
 IV
 PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
@@ -4126,17 +4269,19 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
        * any given moment at most one CRLF-capable layer being enabled
        * in the whole layer stack. */
 	 PerlIO *g = PerlIONext(f);
-	 while (g && *g) {
+	 while (PerlIOValid(g)) {
 	      PerlIOl *b = PerlIOBase(g);
 	      if (b && b->tab == &PerlIO_crlf) {
 		   if (!(b->flags & PERLIO_F_CRLF))
 			b->flags |= PERLIO_F_CRLF;
+		   S_inherit_utf8_flag(g);
 		   PerlIO_pop(aTHX_ f);
 		   return code;
 	      }		  
 	      g = PerlIONext(g);
 	 }
     }
+    S_inherit_utf8_flag(f);
     return code;
 }
 
@@ -4286,6 +4431,7 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 	ptr -= cnt;
     }
     else {
+	NOOP;
 #if 0
 	/*
 	 * Test code - delete when it works ...
@@ -4470,7 +4616,7 @@ PerlIOMmap_map(pTHX_ PerlIO *f)
 		}
 		posn = (b->posn / PL_mmap_page_size) * PL_mmap_page_size;
 		len = st.st_size - posn;
-		m->mptr = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn);
+		m->mptr = (Mmap_t)mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn);
 		if (m->mptr && m->mptr != (Mmap_t) - 1) {
 #if 0 && defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
 		    madvise(m->mptr, len, MADV_SEQUENTIAL);
@@ -4509,7 +4655,14 @@ PerlIOMmap_unmap(pTHX_ PerlIO *f)
     if (m->len) {
 	PerlIOBuf * const b = &m->base;
 	if (b->buf) {
-	    code = munmap(m->mptr, m->len);
+	    /* The munmap address argument is tricky: depending on the
+	     * standard it is either "void *" or "caddr_t" (which is
+	     * usually "char *" (signed or unsigned).  If we cast it
+	     * to "void *", those that have it caddr_t and an uptight
+	     * C++ compiler, will freak out.  But casting it as char*
+	     * should work.  Maybe.  (Using Mmap_t figured out by
+	     * Configure doesn't always work, apparently.) */
+	    code = munmap((char*)m->mptr, m->len);
 	    b->buf = NULL;
 	    m->len = 0;
 	    m->mptr = NULL;
@@ -4714,6 +4867,7 @@ PERLIO_FUNCS_DECL(PerlIO_mmap) = {
 PerlIO *
 Perl_PerlIO_stdin(pTHX)
 {
+    dVAR;
     if (!PL_perlio) {
 	PerlIO_stdstreams(aTHX);
     }
@@ -4723,6 +4877,7 @@ Perl_PerlIO_stdin(pTHX)
 PerlIO *
 Perl_PerlIO_stdout(pTHX)
 {
+    dVAR;
     if (!PL_perlio) {
 	PerlIO_stdstreams(aTHX);
     }
@@ -4732,6 +4887,7 @@ Perl_PerlIO_stdout(pTHX)
 PerlIO *
 Perl_PerlIO_stderr(pTHX)
 {
+    dVAR;
     if (!PL_perlio) {
 	PerlIO_stdstreams(aTHX);
     }
@@ -4761,7 +4917,7 @@ PerlIO_getname(PerlIO *f, char *buf)
     PERL_UNUSED_ARG(f);
     PERL_UNUSED_ARG(buf);
     Perl_croak(aTHX_ "Don't know how to get file name");
-    return Nullch;
+    return NULL;
 #endif
 }
 
@@ -4777,7 +4933,7 @@ PerlIO *
 PerlIO_fdopen(int fd, const char *mode)
 {
     dTHX;
-    return PerlIO_openn(aTHX_ Nullch, mode, fd, 0, 0, NULL, 0, NULL);
+    return PerlIO_openn(aTHX_ NULL, mode, fd, 0, 0, NULL, 0, NULL);
 }
 
 #undef PerlIO_open
@@ -4786,7 +4942,7 @@ PerlIO_open(const char *path, const char *mode)
 {
     dTHX;
     SV *name = sv_2mortal(newSVpv(path, 0));
-    return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, NULL, 1, &name);
+    return PerlIO_openn(aTHX_ NULL, mode, -1, 0, 0, NULL, 1, &name);
 }
 
 #undef Perlio_reopen
@@ -4795,7 +4951,7 @@ PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
 {
     dTHX;
     SV *name = sv_2mortal(newSVpv(path,0));
-    return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, f, 1, &name);
+    return PerlIO_openn(aTHX_ NULL, mode, -1, 0, 0, f, 1, &name);
 }
 
 #undef PerlIO_getc
@@ -4854,7 +5010,7 @@ int
 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
 {
     dTHX;
-    SV * const sv = newSVpvn("", 0);
+    SV * const sv = newSVpvs("");
     const char *s;
     STRLEN len;
     SSize_t wrote;
@@ -4908,7 +5064,7 @@ PerlIO_tmpfile(void)
 	  f = PerlIO_fdopen(fd, "w+b");
 #else /* WIN32 */
 #    if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
-     SV * const sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
+     SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX");
      /*
       * I have no idea how portable mkstemp() is ... NI-S
       */
@@ -4923,16 +5079,9 @@ PerlIO_tmpfile(void)
 #    else	/* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
      FILE * const stdio = PerlSIO_tmpfile();
 
-     if (stdio) {
-	  if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
-                               PERLIO_FUNCS_CAST(&PerlIO_stdio),
-			       "w+", Nullsv))) {
-	       PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
+     if (stdio)
+	  f = PerlIO_fdopen(fileno(stdio), "w+");
 
-               if (s)
-                    s->stdio = stdio;
-          }
-     }
 #    endif /* else HAS_MKSTEMP */
 #endif /* else WIN32 */
      return f;
@@ -4949,6 +5098,36 @@ PerlIO_tmpfile(void)
  * Now some functions in terms of above which may be needed even if we are
  * not in true PerlIO mode
  */
+const char *
+Perl_PerlIO_context_layers(pTHX_ const char *mode)
+{
+    dVAR;
+    const char *type = NULL;
+    /*
+     * Need to supply default layer info from open.pm
+     */
+    if (PL_curcop && PL_curcop->cop_hints & HINT_LEXICAL_IO) {
+	SV * const layers
+	    = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0,
+				       "open", 4, 0, 0);
+	assert(layers);
+	if (SvOK(layers)) {
+	    STRLEN len;
+	    type = SvPV_const(layers, len);
+	    if (type && mode && mode[0] != 'r') {
+		/*
+		 * Skip to write part, which is separated by a '\0'
+		 */
+		STRLEN read_len = strlen(type);
+		if (read_len < len) {
+		    type += read_len + 1;
+		}
+	    }
+	}
+    }
+    return type;
+}
+
 
 #ifndef HAS_FSETPOS
 #undef PerlIO_setpos
@@ -5039,16 +5218,15 @@ vfprintf(FILE *fd, char *pat, char *args)
 int
 PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
 {
-    dVAR;
-    const int val = vsprintf(s, fmt, ap);
-    if (n >= 0) {
-	if (strlen(s) >= (STRLEN) n) {
-	    dTHX;
-	    (void) PerlIO_puts(Perl_error_log,
-			       "panic: sprintf overflow - memory corrupted!\n");
-	    my_exit(1);
-	}
+    dTHX; 
+    const int val = my_vsnprintf(s, n > 0 ? n : 0, fmt, ap);
+    PERL_UNUSED_CONTEXT;
+
+#ifndef PERL_MY_VSNPRINTF_GUARDED
+    if (val < 0 || (n > 0 ? val >= n : 0)) {
+	Perl_croak(aTHX_ "panic: my_vsnprintf overflow in PerlIO_vsprintf\n");
     }
+#endif
     return val;
 }
 #endif