X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=8d54f77f42411457385835a8ef6447730568b8d2;hb=a17c7222566eaf13f314408f16003962518296ed;hp=ee6aa4c78efee9e5712cf114d08fa325cbd718e9;hpb=0eb1d8a4ffdcb76578ec5c9d0c24fa8c80eb3222;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index ee6aa4c..8d54f77 100644
--- a/perlio.c
+++ b/perlio.c
@@ -340,7 +340,7 @@ PerlIO_define_layer(PerlIO_funcs *tab)
 {
  dTHX;
  HV *stash = gv_stashpv("perlio::Layer", TRUE);
- SV *sv = sv_bless(newRV_noinc(newSViv((IV) tab)),stash);
+ SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))),stash);
  hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),sv,0);
 }
 
@@ -385,7 +385,7 @@ PerlIO_default_layer(I32 n)
            av_push(PerlIO_layer_av,SvREFCNT_inc(layer));
           }
          else
-          Perl_warn(aTHX_ "Unknown layer %.*s",(e-s),s);
+          Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(e-s),s);
          s = e;
         }
       }
@@ -409,7 +409,7 @@ PerlIO_default_layer(I32 n)
  svp = av_fetch(PerlIO_layer_av,n,0);
  if (svp && (layer = *svp) && SvROK(layer) && SvIOK((layer = SvRV(layer))))
   {
-   tab = (PerlIO_funcs *) SvIV(layer);
+   tab = INT2PTR(PerlIO_funcs *, SvIV(layer));
   }
  /* PerlIO_debug("Layer %d is %s\n",n,tab->name); */
  return tab;
@@ -1037,6 +1037,15 @@ PerlIO_funcs PerlIO_unix = {
 /*--------------------------------------------------------------------------------------*/
 /* stdio as a layer */
 
+#if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64)
+#define fseek fseeko
+#endif
+
+#if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64)
+#define ftell ftello
+#endif
+
+
 typedef struct
 {
  struct _PerlIO	base;
@@ -1413,6 +1422,7 @@ PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
  return f;
 }
 
+
 PerlIO *
 PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
 {
@@ -1421,15 +1431,24 @@ PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
  if (f)
   {
    PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,NULL),PerlIOBuf);
-   b->posn = 0;
+   b->posn = PerlIO_tell(PerlIONext(f));
   }
  return f;
 }
 
 int
-PerlIOBase_reopen(const char *path, const char *mode, PerlIO *f)
+PerlIOBuf_reopen(const char *path, const char *mode, PerlIO *f)
 {
- return (*PerlIOBase(f)->tab->Reopen)(path,mode,PerlIONext(f));
+ PerlIO *next = PerlIONext(f);
+ int code = (*PerlIOBase(next)->tab->Reopen)(path,mode,next);
+ if (code = 0)
+  code = (*PerlIOBase(f)->tab->Pushed)(f,mode);
+ if (code == 0)
+  {
+   PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+   b->posn = PerlIO_tell(PerlIONext(f));
+  }
+ return code;
 }
 
 /* This "flush" is akin to sfio's sync in that it handles files in either
@@ -1764,7 +1783,7 @@ PerlIO_funcs PerlIO_perlio = {
  PerlIOBase_fileno,
  PerlIOBuf_fdopen,
  PerlIOBuf_open,
- PerlIOBase_reopen,
+ PerlIOBuf_reopen,
  PerlIOBase_pushed,
  PerlIOBase_noop_ok,
  PerlIOBuf_read,
@@ -1793,13 +1812,18 @@ PerlIO_funcs PerlIO_perlio = {
 typedef struct
 {
  PerlIOBuf	base;         /* PerlIOBuf stuff */
+ Mmap_t		mptr;        /* Mapped address */
  Size_t		len;          /* mapped length */
  STDCHAR	*bbuf;        /* malloced buffer if map fails */
+
 } PerlIOMmap;
 
+static size_t page_size = 0;
+
 IV
 PerlIOMmap_map(PerlIO *f)
 {
+ dTHX;
  PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
  PerlIOBuf  *b = &m->base;
  IV flags = PerlIOBase(f)->flags;
@@ -1817,16 +1841,59 @@ PerlIOMmap_map(PerlIO *f)
      SSize_t len = st.st_size - b->posn;
      if (len > 0)
       {
-       b->buf = (STDCHAR *) mmap(NULL, len, PROT_READ, MAP_PRIVATE, fd, b->posn);
-       if (b->buf && b->buf != (STDCHAR *) -1)
+       Off_t posn;
+       if (!page_size) {
+#if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_PAGE_SIZE))
+	   {
+	       SETERRNO(0,SS$_NORMAL);
+#   ifdef _SC_PAGESIZE
+	       page_size = sysconf(_SC_PAGESIZE);
+#   else
+	       page_size = sysconf(_SC_PAGE_SIZE);
+#   endif
+	       if ((long)page_size < 0) {
+		   if (errno) {
+		       SV *error = ERRSV;
+		       char *msg;
+		       STRLEN n_a;
+		       (void)SvUPGRADE(error, SVt_PV);
+		       msg = SvPVx(error, n_a);
+		       Perl_croak(aTHX_ "panic: sysconf: %s", msg);
+		   }
+		   else
+		       Perl_croak(aTHX_ "panic: sysconf: pagesize unknown");
+	       }
+	   }
+#else
+#   ifdef HAS_GETPAGESIZE
+        page_size = getpagesize();
+#   else
+#       if defined(I_SYS_PARAM) && defined(PAGESIZE)
+        page_size = PAGESIZE; /* compiletime, bad */
+#       endif
+#   endif
+#endif
+	if ((IV)page_size <= 0)
+	    Perl_croak(aTHX_ "panic: bad pagesize %"IVdf, (IV)page_size);
+       }
+       if (b->posn < 0)
+        {
+         /* This is a hack - should never happen - open should have set it ! */
+         b->posn = PerlIO_tell(PerlIONext(f));
+        }
+       posn = (b->posn / page_size) * page_size;
+       len  = st.st_size - posn;
+       m->mptr = mmap(NULL, len, PROT_READ, MAP_PRIVATE, fd, posn);
+       if (m->mptr && m->mptr != (Mmap_t) -1)
         {
 #if defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
-         madvise((Mmap_t) b->buf, len, MADV_SEQUENTIAL);
+         madvise(m->mptr, len, MADV_SEQUENTIAL);
 #endif
-         PerlIOBase(f)->flags = flags | PERLIO_F_RDBUF;
-         b->end = b->buf+len;
-         b->ptr = b->buf;
-         m->len = len;
+         PerlIOBase(f)->flags = (flags & ~PERLIO_F_EOF) | PERLIO_F_RDBUF;
+         b->end  = ((STDCHAR *)m->mptr) + len;
+         b->buf  = ((STDCHAR *)m->mptr) + (b->posn - posn);
+         b->ptr  = b->buf;
+         m->len  = len;
         }
        else
         {
@@ -1855,9 +1922,10 @@ PerlIOMmap_unmap(PerlIO *f)
   {
    if (b->buf)
     {
-     code = munmap((Mmap_t) b->buf, m->len);
-     b->buf = NULL;
-     m->len = 0;
+     code = munmap(m->mptr, m->len);
+     b->buf  = NULL;
+     m->len  = 0;
+     m->mptr = NULL;
      if (PerlIO_seek(PerlIONext(f),b->posn,SEEK_SET) != 0)
       code = -1;
     }
@@ -1915,6 +1983,14 @@ PerlIOMmap_unread(PerlIO *f, const void *vbuf, Size_t count)
   {
    /* Loose the unwritable mapped buffer */
    PerlIO_flush(f);
+   /* If flush took the "buffer" see if we have one from before */
+   if (!b->buf && m->bbuf)
+    b->buf = m->bbuf;
+   if (!b->buf)
+    {
+     PerlIOBuf_get_base(f);
+     m->bbuf = b->buf;
+    }
   }
  return PerlIOBuf_unread(f,vbuf,count);
 }
@@ -2011,7 +2087,7 @@ PerlIO_funcs PerlIO_mmap = {
  PerlIOBase_fileno,
  PerlIOBuf_fdopen,
  PerlIOBuf_open,
- PerlIOBase_reopen,
+ PerlIOBuf_reopen,
  PerlIOBase_pushed,
  PerlIOBase_noop_ok,
  PerlIOBuf_read,
@@ -2238,7 +2314,7 @@ int
 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
 {
  *pos = PerlIO_tell(f);
- return 0;
+ return *pos == -1 ? -1 : 0;
 }
 #else
 #ifndef PERLIO_IS_STDIO
@@ -2283,7 +2359,8 @@ PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
    if (strlen(s) >= (STRLEN)n)
     {
      dTHX;
-     PerlIO_puts(Perl_error_log,"panic: sprintf overflow - memory corrupted!\n");
+     (void)PerlIO_puts(Perl_error_log,
+		       "panic: sprintf overflow - memory corrupted!\n");
      my_exit(1);
     }
   }