X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=9f12be62735db4bc0c470dedcbac7e9828675adb;hb=918426be7f3660c63cebe082bf8eac82a38bf756;hp=4ffcc2ec575f2298a01f2cddd67ef12afd9fdbba;hpb=5b3035ed4d02db655cf5d2d62ab1ebb11c131def;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index 4ffcc2e..9f12be6 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1,6 +1,6 @@
 /*    perlio.c
  *
- *    Copyright (c) 1996-2000, Nick Ing-Simmons
+ *    Copyright (c) 1996-2001, 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.
@@ -33,20 +33,6 @@
 #undef PerlMemShared_free
 #define PerlMemShared_free(x) free(x)
 
-
-#ifndef PERLIO_LAYERS
-int
-PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
-{
- if (!names || !*names || strEQ(names,":crlf") || strEQ(names,":raw"))
-  {
-   return 0;
-  }
- Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl",names);
- /* NOTREACHED */
- return -1;
-}
-
 int
 perlsio_binmode(FILE *fp, int iotype, int mode)
 {
@@ -62,6 +48,7 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
     }
     return 0;
 #  else
+    dTHX;
     if (PerlLIO_setmode(fileno(fp), mode) != -1) {
 #    if defined(WIN32) && defined(__BORLANDC__)
 	/* The translation mode of the stream is maintained independent
@@ -93,6 +80,19 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
 #endif
 }
 
+#ifndef PERLIO_LAYERS
+int
+PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
+{
+ if (!names || !*names || strEQ(names,":crlf") || strEQ(names,":raw"))
+  {
+   return 0;
+  }
+ Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl",names);
+ /* NOTREACHED */
+ return -1;
+}
+
 int
 PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
 {
@@ -239,7 +239,7 @@ PerlIO_allocate(pTHX)
  if (!f)
   {
    return NULL;
-  } 
+  }
  *last = f;
  return f+1;
 }
@@ -283,7 +283,8 @@ PerlIO_pop(PerlIO *f)
  if (l)
   {
    PerlIO_debug("PerlIO_pop f=%p %s\n",f,l->tab->name);
-   (*l->tab->Popped)(f);
+   if (l->tab->Popped)
+    (*l->tab->Popped)(f);
    *f = l->next;
    PerlMemShared_free(l);
   }
@@ -318,7 +319,7 @@ PerlIO_find_layer(const char *name, STRLEN len)
  dTHX;
  SV **svp;
  SV *sv;
- if (len <= 0)
+ if ((SSize_t) len <= 0)
   len = strlen(name);
  svp  = hv_fetch(PerlIO_layer_hv,name,len,0);
  if (svp && (sv = *svp) && SvROK(sv))
@@ -416,9 +417,34 @@ PerlIO_define_layer(PerlIO_funcs *tab)
  dTHX;
  HV *stash = gv_stashpv("perlio::Layer", TRUE);
  SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))),stash);
+ if (!PerlIO_layer_hv)
+  {
+   PerlIO_layer_hv = get_hv("open::layers",GV_ADD|GV_ADDMULTI);
+  }
  hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),sv,0);
+ PerlIO_debug("define %s %p\n",tab->name,tab);
 }
 
+void
+PerlIO_default_buffer(pTHX)
+{
+ PerlIO_funcs *tab = &PerlIO_perlio;
+ if (O_BINARY != O_TEXT)
+  {
+   tab = &PerlIO_crlf;
+  }
+ else
+  {
+   if (PerlIO_stdio.Set_ptrcnt)
+    {
+     tab = &PerlIO_stdio;
+    }
+  }
+ PerlIO_debug("Pushing %s\n",tab->name);
+ av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(tab->name,0)));
+}
+
+
 PerlIO_funcs *
 PerlIO_default_layer(I32 n)
 {
@@ -427,16 +453,16 @@ PerlIO_default_layer(I32 n)
  SV *layer;
  PerlIO_funcs *tab = &PerlIO_stdio;
  int len;
- if (!PerlIO_layer_hv)
+ if (!PerlIO_layer_av)
   {
    const char *s  = PerlEnv_getenv("PERLIO");
+   PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI);
    newXS("perlio::import",XS_perlio_import,__FILE__);
    newXS("perlio::unimport",XS_perlio_unimport,__FILE__);
 #if 0
    newXS("io::MODIFY_SCALAR_ATTRIBUTES",XS_io_MODIFY_SCALAR_ATTRIBUTES,__FILE__);
 #endif
-   PerlIO_layer_hv = get_hv("open::layers",GV_ADD|GV_ADDMULTI);
-   PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI);
+   PerlIO_define_layer(&PerlIO_raw);
    PerlIO_define_layer(&PerlIO_unix);
    PerlIO_define_layer(&PerlIO_perlio);
    PerlIO_define_layer(&PerlIO_stdio);
@@ -444,9 +470,12 @@ PerlIO_default_layer(I32 n)
 #ifdef HAS_MMAP
    PerlIO_define_layer(&PerlIO_mmap);
 #endif
+   PerlIO_define_layer(&PerlIO_utf8);
+   PerlIO_define_layer(&PerlIO_byte);
    av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_unix.name,0)));
    if (s)
     {
+     IV buffered = 0;
      while (*s)
       {
        while (*s && isSPACE((unsigned char)*s))
@@ -462,8 +491,15 @@ PerlIO_default_layer(I32 n)
          layer = PerlIO_find_layer(s,e-s);
          if (layer)
           {
+           PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
+           if ((tab->kind & PERLIO_K_DUMMY) && (tab->kind & PERLIO_K_BUFFERED))
+            {
+             if (!buffered)
+              PerlIO_default_buffer(aTHX);
+            }
            PerlIO_debug("Pushing %.*s\n",(e-s),s);
            av_push(PerlIO_layer_av,SvREFCNT_inc(layer));
+           buffered |= (tab->kind & PERLIO_K_BUFFERED);
           }
          else
           Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(e-s),s);
@@ -475,21 +511,7 @@ PerlIO_default_layer(I32 n)
  len  = av_len(PerlIO_layer_av);
  if (len < 1)
   {
-   if (O_BINARY != O_TEXT)
-    {
-     av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_crlf.name,0)));
-    }
-   else
-    {
-     if (PerlIO_stdio.Set_ptrcnt)
-      {
-       av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_stdio.name,0)));
-      }
-     else
-      {
-       av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_perlio.name,0)));
-      }
-    }
+   PerlIO_default_buffer(aTHX);
    len  = av_len(PerlIO_layer_av);
   }
  if (n < 0)
@@ -520,7 +542,7 @@ PerlIO_stdstreams()
 }
 
 PerlIO *
-PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
+PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,STRLEN len)
 {
  dTHX;
  PerlIOl *l = NULL;
@@ -531,8 +553,9 @@ PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
    l->next = *f;
    l->tab  = tab;
    *f      = l;
-   PerlIO_debug("PerlIO_push f=%p %s %s\n",f,tab->name,(mode) ? mode : "(Null)");
-   if ((*l->tab->Pushed)(f,mode) != 0)
+   PerlIO_debug("PerlIO_push f=%p %s %s '%.*s'\n",
+                 f,tab->name,(mode) ? mode : "(Null)",(int) len,arg);
+   if ((*l->tab->Pushed)(f,mode,arg,len) != 0)
     {
      PerlIO_pop(f);
      return NULL;
@@ -541,6 +564,51 @@ PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
  return f;
 }
 
+IV
+PerlIOPop_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
+{
+ PerlIO_pop(f);
+ if (*f)
+  {
+   PerlIO_flush(f);
+   PerlIO_pop(f);
+   return 0;
+  }
+ return -1;
+}
+
+IV
+PerlIORaw_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
+{
+ /* Remove the dummy layer */
+ PerlIO_pop(f);
+ /* Pop back to bottom layer */
+ if (f && *f)
+  {
+   int code = 0;
+   PerlIO_flush(f);
+   while (!(PerlIOBase(f)->tab->kind & PERLIO_K_RAW))
+    {
+     if (*PerlIONext(f))
+      {
+       PerlIO_pop(f);
+      }
+     else
+      {
+       /* Nothing bellow - push unix on top then remove it */
+       if (PerlIO_push(f,PerlIO_default_btm(),mode,arg,len))
+        {
+         PerlIO_pop(PerlIONext(f));
+        }
+       break;
+      }
+    }
+   PerlIO_debug(":raw f=%p :%s\n",f,PerlIOBase(f)->tab->name);
+   return 0;
+  }
+ return -1;
+}
+
 int
 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
 {
@@ -549,45 +617,77 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
    const char *s = names;
    while (*s)
     {
-     while (isSPACE(*s))
-      s++;
-     if (*s == ':')
+     while (isSPACE(*s) || *s == ':')
       s++;
      if (*s)
       {
+       STRLEN llen = 0;
        const char *e = s;
-       while (*e && *e != ':' && !isSPACE(*e))
-        e++;
-       if (e > s)
+       const char *as = Nullch;
+       STRLEN alen = 0;
+       if (!isIDFIRST(*s))
+        {
+         /* Message is consistent with how attribute lists are passed.
+            Even though this means "foo : : bar" is seen as an invalid separator
+            character.  */
+         char q = ((*s == '\'') ? '"' : '\'');
+         Perl_warn(aTHX_ "perlio: invalid separator character %c%c%c in layer specification list", q, *s, q);
+         return -1;
+        }
+       do
         {
-         if ((e - s) == 3 && strncmp(s,"raw",3) == 0)
+         e++;
+        } while (isALNUM(*e));
+       llen = e-s;
+       if (*e == '(')
+        {
+         int nesting = 1;
+         as = ++e;
+         while (nesting)
           {
-           /* Pop back to bottom layer */
-           if (PerlIONext(f))
+           switch (*e++)
             {
-             PerlIO_flush(f);
-             while (PerlIONext(f))
-              {
-               PerlIO_pop(f);
-              }
+             case ')':
+              if (--nesting == 0)
+               alen = (e-1)-as;
+              break;
+             case '(':
+              ++nesting;
+              break;
+             case '\\':
+              /* It's a nul terminated string, not allowed to \ the terminating null.
+                 Anything other character is passed over.  */
+              if (*e++)
+               {
+                break;
+               }
+              /* Drop through */
+             case '\0':
+              e--;
+              Perl_warn(aTHX_ "perlio: argument list not closed for layer \"%.*s\"",(int)(e - s),s);
+              return -1;
+             default:
+              /* boring.  */
+              break;
             }
           }
-         else
+        }
+       if (e > s)
+        {
+         SV *layer = PerlIO_find_layer(s,llen);
+         if (layer)
           {
-           SV *layer = PerlIO_find_layer(s,e-s);
-           if (layer)
+           PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
+           if (tab)
             {
-             PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
-             if (tab)
-              {
-               PerlIO *new = PerlIO_push(f,tab,mode);
-               if (!new)
-                return -1;
-              }
+             if (!PerlIO_push(f,tab,mode,as,alen))
+              return -1;
             }
-           else
-            Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)(e-s),s);
           }
+         else {
+          Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)llen,s);
+	  return -1;
+	 }
         }
        s = e;
       }
@@ -606,7 +706,7 @@ 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, (names) ? names : "(Null)");
- if (!names || (O_TEXT != O_BINARY && mode & O_BINARY))
+ if (!names && (O_TEXT != O_BINARY && (mode & O_BINARY)))
   {
    PerlIO *top = f;
    PerlIOl *l;
@@ -643,7 +743,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f)
    Off_t posn = PerlIO_tell(f);
    PerlIO_seek(new,posn,SEEK_SET);
   }
- return new; 
+ return new;
 }
 
 #undef PerlIO_close
@@ -696,7 +796,7 @@ PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
    PerlIO_flush(f);
    if ((*PerlIOBase(f)->tab->Reopen)(path,mode,f) == 0)
     {
-     if ((*PerlIOBase(f)->tab->Pushed)(f,mode) == 0)
+     if ((*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0) == 0)
       return f;
     }
    return NULL;
@@ -746,7 +846,17 @@ PerlIO_flush(PerlIO *f)
 {
  if (f)
   {
-   return (*PerlIOBase(f)->tab->Flush)(f);
+   PerlIO_funcs *tab = PerlIOBase(f)->tab;
+   if (tab && tab->Flush)
+    {
+     return (*tab->Flush)(f);
+    }
+   else
+    {
+     PerlIO_debug("Cannot flush f=%p :%s\n",f,tab->name);
+     errno = EINVAL;
+     return -1;
+    }
   }
  else
   {
@@ -912,6 +1022,158 @@ PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
 }
 
 /*--------------------------------------------------------------------------------------*/
+/* utf8 and raw dummy layers */
+
+IV
+PerlIOUtf8_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
+{
+ if (PerlIONext(f))
+  {
+   PerlIO_funcs *tab = PerlIOBase(f)->tab;
+   PerlIO_pop(f);
+   if (tab->kind & PERLIO_K_UTF8)
+    PerlIOBase(f)->flags |= PERLIO_F_UTF8;
+   else
+    PerlIOBase(f)->flags &= ~PERLIO_F_UTF8;
+   return 0;
+  }
+ return -1;
+}
+
+PerlIO *
+PerlIOUtf8_fdopen(PerlIO_funcs *self, int fd,const char *mode)
+{
+ PerlIO_funcs *tab = PerlIO_default_layer(-2);
+ PerlIO *f = (*tab->Fdopen)(tab,fd,mode);
+ if (f)
+  {
+   PerlIOl *l = PerlIOBase(f);
+   if (tab->kind & PERLIO_K_UTF8)
+    l->flags |= PERLIO_F_UTF8;
+   else
+    l->flags &= ~PERLIO_F_UTF8;
+ }
+ return f;
+}
+
+PerlIO *
+PerlIOUtf8_open(PerlIO_funcs *self, const char *path,const char *mode)
+{
+ PerlIO_funcs *tab = PerlIO_default_layer(-2);
+ PerlIO *f = (*tab->Open)(tab,path,mode);
+ if (f)
+  {
+   PerlIOl *l = PerlIOBase(f);
+   if (tab->kind & PERLIO_K_UTF8)
+    l->flags |= PERLIO_F_UTF8;
+   else
+    l->flags &= ~PERLIO_F_UTF8;
+  }
+ return f;
+}
+
+PerlIO_funcs PerlIO_utf8 = {
+ "utf8",
+ sizeof(PerlIOl),
+ PERLIO_K_DUMMY|PERLIO_F_UTF8,
+ NULL,
+ PerlIOUtf8_fdopen,
+ PerlIOUtf8_open,
+ NULL,
+ PerlIOUtf8_pushed,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL, /* flush */
+ NULL, /* fill */
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL, /* get_base */
+ NULL, /* get_bufsiz */
+ NULL, /* get_ptr */
+ NULL, /* get_cnt */
+ NULL, /* set_ptrcnt */
+};
+
+PerlIO_funcs PerlIO_byte = {
+ "bytes",
+ sizeof(PerlIOl),
+ PERLIO_K_DUMMY,
+ NULL,
+ PerlIOUtf8_fdopen,
+ PerlIOUtf8_open,
+ NULL,
+ PerlIOUtf8_pushed,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL, /* flush */
+ NULL, /* fill */
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL, /* get_base */
+ NULL, /* get_bufsiz */
+ NULL, /* get_ptr */
+ NULL, /* get_cnt */
+ NULL, /* set_ptrcnt */
+};
+
+PerlIO *
+PerlIORaw_fdopen(PerlIO_funcs *self, int fd,const char *mode)
+{
+ PerlIO_funcs *tab = PerlIO_default_btm();
+ return (*tab->Fdopen)(tab,fd,mode);
+}
+
+PerlIO *
+PerlIORaw_open(PerlIO_funcs *self, const char *path,const char *mode)
+{
+ PerlIO_funcs *tab = PerlIO_default_btm();
+ return (*tab->Open)(tab,path,mode);
+}
+
+PerlIO_funcs PerlIO_raw = {
+ "raw",
+ sizeof(PerlIOl),
+ PERLIO_K_DUMMY,
+ NULL,
+ PerlIORaw_fdopen,
+ PerlIORaw_open,
+ NULL,
+ PerlIORaw_pushed,
+ PerlIOBase_popped,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL, /* flush */
+ NULL, /* fill */
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL, /* get_base */
+ NULL, /* get_bufsiz */
+ NULL, /* get_ptr */
+ NULL, /* get_cnt */
+ NULL, /* set_ptrcnt */
+};
+/*--------------------------------------------------------------------------------------*/
+/*--------------------------------------------------------------------------------------*/
 /* "Methods" of the "base class" */
 
 IV
@@ -932,7 +1194,7 @@ PerlIO_modestr(PerlIO *f,char *buf)
     {
      *s++ = '+';
     }
-  } 
+  }
  else if (flags & PERLIO_F_CANREAD)
   {
    *s++ = 'r';
@@ -956,7 +1218,7 @@ PerlIO_modestr(PerlIO *f,char *buf)
 }
 
 IV
-PerlIOBase_pushed(PerlIO *f, const char *mode)
+PerlIOBase_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
 {
  PerlIOl *l = PerlIOBase(f);
  const char *omode = mode;
@@ -1024,26 +1286,15 @@ PerlIOBase_popped(PerlIO *f)
  return 0;
 }
 
-extern PerlIO_funcs PerlIO_pending;
-
 SSize_t
 PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
 {
-#if 0
  Off_t old = PerlIO_tell(f);
- if (0 && PerlIO_seek(f,-((Off_t)count),SEEK_CUR) == 0)
-  {
-   Off_t new = PerlIO_tell(f);
-   return old - new;
-  }
- else
-  {
-   return 0;
-  }
-#else
- PerlIO_push(f,&PerlIO_pending,"r");
- return PerlIOBuf_unread(f,vbuf,count);
-#endif
+ SSize_t done;
+ PerlIO_push(f,&PerlIO_pending,"r",Nullch,0);
+ done = PerlIOBuf_unread(f,vbuf,count);
+ PerlIOSelf(f,PerlIOBuf)->posn = old - done;
+ return done;
 }
 
 IV
@@ -1184,6 +1435,20 @@ PerlIOUnix_fileno(PerlIO *f)
  return PerlIOSelf(f,PerlIOUnix)->fd;
 }
 
+IV
+PerlIOUnix_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
+{
+ IV code = PerlIOBase_pushed(f,mode,arg,len);
+ if (*PerlIONext(f))
+  {
+   PerlIOUnix *s = PerlIOSelf(f,PerlIOUnix);
+   s->fd     = PerlIO_fileno(PerlIONext(f));
+   s->oflags = PerlIOUnix_oflags(mode);
+  }
+ PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+ return code;
+}
+
 PerlIO *
 PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode)
 {
@@ -1196,10 +1461,9 @@ PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode)
    int oflags = PerlIOUnix_oflags(mode);
    if (oflags != -1)
     {
-     PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOUnix);
+     PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOUnix);
      s->fd     = fd;
      s->oflags = oflags;
-     PerlIOBase(f)->flags |= PERLIO_F_OPEN;
     }
   }
  return f;
@@ -1216,7 +1480,7 @@ PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode)
    int fd = PerlLIO_open3(path,oflags,0666);
    if (fd >= 0)
     {
-     PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOUnix);
+     PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOUnix);
      s->fd     = fd;
      s->oflags = oflags;
      PerlIOBase(f)->flags |= PERLIO_F_OPEN;
@@ -1265,6 +1529,7 @@ PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
       PerlIOBase(f)->flags |= PERLIO_F_EOF;
      return len;
     }
+   PERL_ASYNC_CHECK();
   }
 }
 
@@ -1282,6 +1547,7 @@ PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count)
       PerlIOBase(f)->flags |= PERLIO_F_ERROR;
      return len;
     }
+   PERL_ASYNC_CHECK();
   }
 }
 
@@ -1298,6 +1564,7 @@ Off_t
 PerlIOUnix_tell(PerlIO *f)
 {
  dTHX;
+ Off_t posn = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
  return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
 }
 
@@ -1314,6 +1581,7 @@ PerlIOUnix_close(PerlIO *f)
      code = -1;
      break;
     }
+   PERL_ASYNC_CHECK();
   }
  if (code == 0)
   {
@@ -1330,7 +1598,7 @@ PerlIO_funcs PerlIO_unix = {
  PerlIOUnix_fdopen,
  PerlIOUnix_open,
  PerlIOUnix_reopen,
- PerlIOBase_pushed,
+ PerlIOUnix_pushed,
  PerlIOBase_noop_ok,
  PerlIOUnix_read,
  PerlIOBase_unread,
@@ -1367,20 +1635,19 @@ PerlIOStdio_fileno(PerlIO *f)
  return PerlSIO_fileno(PerlIOSelf(f,PerlIOStdio)->stdio);
 }
 
-const char *
+char *
 PerlIOStdio_mode(const char *mode,char *tmode)
 {
- const char *ret = mode;
+ char *ret = tmode;
+ while (*mode)
+  {
+   *tmode++ = *mode++;
+  }
  if (O_BINARY != O_TEXT)
   {
-   ret = (const char *) tmode;
-   while (*mode)
-    {
-     *tmode++ = *mode++;
-    }
    *tmode++ = 'b';
-   *tmode = '\0';
   }
+ *tmode = '\0';
  return ret;
 }
 
@@ -1420,13 +1687,31 @@ PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode)
     }
    if (stdio)
     {
-     PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOStdio);
+     PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOStdio);
      s->stdio  = stdio;
     }
   }
  return f;
 }
 
+/* This isn't used yet ... */
+IV
+PerlIOStdio_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
+{
+ dTHX;
+ if (*PerlIONext(f))
+  {
+   PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
+   char tmode[8];
+   FILE *stdio = PerlSIO_fdopen(PerlIO_fileno(PerlIONext(f)),mode = PerlIOStdio_mode(mode,tmode));
+   if (stdio)
+    s->stdio = stdio;
+   else
+    return -1;
+  }
+ return PerlIOBase_pushed(f,mode,arg,len);
+}
+
 #undef PerlIO_importFILE
 PerlIO *
 PerlIO_importFILE(FILE *stdio, int fl)
@@ -1435,7 +1720,7 @@ PerlIO_importFILE(FILE *stdio, int fl)
  PerlIO *f = NULL;
  if (stdio)
   {
-   PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"r+"),PerlIOStdio);
+   PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"r+",Nullch,0),PerlIOStdio);
    s->stdio  = stdio;
   }
  return f;
@@ -1451,7 +1736,7 @@ PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode)
   {
    char tmode[8];
    PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX), self,
-                               (mode = PerlIOStdio_mode(mode,tmode))),
+                               (mode = PerlIOStdio_mode(mode,tmode)),Nullch,0),
                                PerlIOStdio);
    s->stdio  = stdio;
   }
@@ -1753,15 +2038,31 @@ PerlIO_funcs PerlIO_stdio = {
 FILE *
 PerlIO_exportFILE(PerlIO *f, int fl)
 {
+ FILE *stdio;
  PerlIO_flush(f);
- /* Should really push stdio discipline when we have them */
- return fdopen(PerlIO_fileno(f),"r+");
+ stdio = fdopen(PerlIO_fileno(f),"r+");
+ if (stdio)
+  {
+   PerlIOStdio *s = PerlIOSelf(PerlIO_push(f,&PerlIO_stdio,"r+",Nullch,0),PerlIOStdio);
+   s->stdio  = stdio;
+  }
+ return stdio;
 }
 
 #undef PerlIO_findFILE
 FILE *
 PerlIO_findFILE(PerlIO *f)
 {
+ PerlIOl *l = *f;
+ while (l)
+  {
+   if (l->tab == &PerlIO_stdio)
+    {
+     PerlIOStdio *s = PerlIOSelf(&l,PerlIOStdio);
+     return s->stdio;
+    }
+   l = *PerlIONext(&l);
+  }
  return PerlIO_exportFILE(f,0);
 }
 
@@ -1775,11 +2076,11 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
 /* perlio buffer layer */
 
 IV
-PerlIOBuf_pushed(PerlIO *f, const char *mode)
+PerlIOBuf_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
 {
  PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
  b->posn = PerlIO_tell(PerlIONext(f));
- return PerlIOBase_pushed(f,mode);
+ return PerlIOBase_pushed(f,mode,arg,len);
 }
 
 PerlIO *
@@ -1801,7 +2102,7 @@ PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
  f = (*tab->Fdopen)(tab,fd,mode);
  if (f)
   {
-   PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,mode),PerlIOBuf);
+   PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,mode,Nullch,0),PerlIOBuf);
    if (init && fd == 2)
     {
      /* Initial stderr is unbuffered */
@@ -1822,7 +2123,7 @@ PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
  PerlIO *f = (*tab->Open)(tab,path,mode);
  if (f)
   {
-   PerlIO_push(f,self,mode);
+   PerlIO_push(f,self,mode,Nullch,0);
   }
  return f;
 }
@@ -1833,7 +2134,7 @@ PerlIOBuf_reopen(const char *path, const char *mode, PerlIO *f)
  PerlIO *next = PerlIONext(f);
  int code = (*PerlIOBase(next)->tab->Reopen)(path,mode,next);
  if (code = 0)
-  code = (*PerlIOBase(f)->tab->Pushed)(f,mode);
+  code = (*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0);
  return code;
 }
 
@@ -1848,12 +2149,12 @@ PerlIOBuf_flush(PerlIO *f)
  if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
   {
    /* write() the buffer */
-   STDCHAR *p = b->buf;
-   int count;
+   STDCHAR *buf = b->buf;
+   STDCHAR *p = buf;
    PerlIO *n = PerlIONext(f);
    while (p < b->ptr)
     {
-     count = PerlIO_write(n,p,b->ptr - p);
+     SSize_t count = PerlIO_write(n,p,b->ptr - p);
      if (count > 0)
       {
        p += count;
@@ -1865,12 +2166,13 @@ PerlIOBuf_flush(PerlIO *f)
        break;
       }
     }
-   b->posn += (p - b->buf);
+   b->posn += (p - buf);
   }
  else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
   {
+   STDCHAR *buf = PerlIO_get_base(f);
    /* Note position change */
-   b->posn += (b->ptr - b->buf);
+   b->posn += (b->ptr - buf);
    if (b->ptr < b->end)
     {
      /* We did not consume all of it */
@@ -1905,6 +2207,9 @@ PerlIOBuf_fill(PerlIO *f)
  if (PerlIO_flush(f) != 0)
   return -1;
 
+ if (!b->buf)
+  PerlIO_get_base(f); /* allocate via vtable */
+
  b->ptr = b->end = b->buf;
  if (PerlIO_fast_gets(n))
   {
@@ -2283,16 +2588,16 @@ PerlIOPending_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
 }
 
 IV
-PerlIOPending_pushed(PerlIO *f,const char *mode)
+PerlIOPending_pushed(PerlIO *f,const char *mode,const char *arg,STRLEN len)
 {
- IV code    = PerlIOBuf_pushed(f,mode);
+ IV code    = PerlIOBase_pushed(f,mode,arg,len);
  PerlIOl *l = PerlIOBase(f);
  /* Our PerlIO_fast_gets must match what we are pushed on,
     or sv_gets() etc. get muddled when it changes mid-string
     when we auto-pop.
   */
- l->flags   = (l->flags & ~PERLIO_F_FASTGETS) |
-              (PerlIOBase(PerlIONext(f))->flags & PERLIO_F_FASTGETS);
+ l->flags   = (l->flags & ~(PERLIO_F_FASTGETS|PERLIO_F_UTF8)) |
+              (PerlIOBase(PerlIONext(f))->flags & (PERLIO_F_FASTGETS|PERLIO_F_UTF8));
  return code;
 }
 
@@ -2356,11 +2661,11 @@ typedef struct
 } PerlIOCrlf;
 
 IV
-PerlIOCrlf_pushed(PerlIO *f, const char *mode)
+PerlIOCrlf_pushed(PerlIO *f, const char *mode,const char *arg,STRLEN len)
 {
  IV code;
  PerlIOBase(f)->flags |= PERLIO_F_CRLF;
- code = PerlIOBuf_pushed(f,mode);
+ code = PerlIOBuf_pushed(f,mode,arg,len);
 #if 0
  PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08"UVxf"\n",
               f,PerlIOBase(f)->tab->name,(mode) ? mode : "(Null)",
@@ -2724,12 +3029,15 @@ PerlIOMmap_map(PerlIO *f)
         }
        posn = (b->posn / page_size) * page_size;
        len  = st.st_size - posn;
-       m->mptr = mmap(NULL, len, PROT_READ, MAP_PRIVATE, fd, posn);
+       m->mptr = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn);
        if (m->mptr && m->mptr != (Mmap_t) -1)
         {
-#if defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
+#if 0 && defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
          madvise(m->mptr, len, MADV_SEQUENTIAL);
 #endif
+#if 0 && defined(HAS_MADVISE) && defined(MADV_WILLNEED)
+         madvise(m->mptr, len, MADV_WILLNEED);
+#endif
          PerlIOBase(f)->flags = (flags & ~PERLIO_F_EOF) | PERLIO_F_RDBUF;
          b->end  = ((STDCHAR *)m->mptr) + len;
          b->buf  = ((STDCHAR *)m->mptr) + (b->posn - posn);
@@ -2957,10 +3265,14 @@ PerlIO_init(void)
 {
  if (!_perlio)
   {
+#ifndef WIN32
    atexit(&PerlIO_cleanup);
+#endif
   }
 }
 
+
+
 #undef PerlIO_stdin
 PerlIO *
 PerlIO_stdin(void)
@@ -3109,7 +3421,7 @@ PerlIO_tmpfile(void)
  FILE *stdio = PerlSIO_tmpfile();
  if (stdio)
   {
-   PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"w+"),PerlIOStdio);
+   PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"w+",Nullch,0),PerlIOStdio);
    s->stdio  = stdio;
   }
  return f;
@@ -3146,47 +3458,70 @@ PerlIO_tmpfile(void)
 #ifndef HAS_FSETPOS
 #undef PerlIO_setpos
 int
-PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
+PerlIO_setpos(PerlIO *f, SV *pos)
 {
- return PerlIO_seek(f,*pos,0);
+ dTHX;
+ if (SvOK(pos))
+  {
+   STRLEN len;
+   Off_t *posn = (Off_t *) SvPV(pos,len);
+   if (f && len == sizeof(Off_t))
+    return PerlIO_seek(f,*posn,SEEK_SET);
+  }
+ errno = EINVAL;
+ return -1;
 }
 #else
-#ifndef PERLIO_IS_STDIO
 #undef PerlIO_setpos
 int
-PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
+PerlIO_setpos(PerlIO *f, SV *pos)
 {
+ dTHX;
+ if (SvOK(pos))
+  {
+   STRLEN len;
+   Fpos_t *fpos = (Fpos_t *) SvPV(pos,len);
+   if (f && len == sizeof(Fpos_t))
+    {
 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
- return fsetpos64(f, pos);
+     return fsetpos64(f, fpos);
 #else
- return fsetpos(f, pos);
+     return fsetpos(f, fpos);
 #endif
+    }
+  }
+ errno = EINVAL;
+ return -1;
 }
 #endif
-#endif
 
 #ifndef HAS_FGETPOS
 #undef PerlIO_getpos
 int
-PerlIO_getpos(PerlIO *f, Fpos_t *pos)
+PerlIO_getpos(PerlIO *f, SV *pos)
 {
- *pos = PerlIO_tell(f);
- return *pos == -1 ? -1 : 0;
+ dTHX;
+ Off_t posn = PerlIO_tell(f);
+ sv_setpvn(pos,(char *)&posn,sizeof(posn));
+ return (posn == (Off_t)-1) ? -1 : 0;
 }
 #else
-#ifndef PERLIO_IS_STDIO
 #undef PerlIO_getpos
 int
-PerlIO_getpos(PerlIO *f, Fpos_t *pos)
+PerlIO_getpos(PerlIO *f, SV *pos)
 {
+ dTHX;
+ Fpos_t fpos;
+ int code;
 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
- return fgetpos64(f, pos);
+ code = fgetpos64(f, &fpos);
 #else
- return fgetpos(f, pos);
+ code = fgetpos(f, &fpos);
 #endif
+ sv_setpvn(pos,(char *)&fpos,sizeof(fpos));
+ return code;
 }
 #endif
-#endif
 
 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)