#undef printf
void PerlIO_debug(char *fmt,...) __attribute__((format(printf,1,2)));
-#ifndef __GNUC__
-#define __FUNCTION__ "PerlIO_debug"
-#endif
void
PerlIO_debug(char *fmt,...)
}
}
+HV *PerlIO_layer_hv;
+AV *PerlIO_layer_av;
+
void
PerlIO_cleanup(void)
{
XSRETURN_EMPTY;
}
-HV *PerlIO_layer_hv;
-AV *PerlIO_layer_av;
-
SV *
PerlIO_find_layer(char *name, STRLEN len)
{
{
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);
}
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;
}
}
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;
/*--------------------------------------------------------------------------------------*/
/* 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;
return f;
}
+
PerlIO *
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
if (code == 0)
{
b->posn = PerlIO_tell(PerlIONext(f));
- PerlIO_debug(__FUNCTION__ " f=%p posn=%ld\n",f,(long) b->posn);
}
}
- if (code)
- PerlIO_debug(__FUNCTION__ " f=%p code%d\n",f,code);
return code;
}
Off_t posn = b->posn;
if (b->buf)
posn += (b->ptr - b->buf);
- PerlIO_debug(__FUNCTION__ " f=%p posn=%ld\n",f,(long) posn);
return posn;
}
PerlIOBase_fileno,
PerlIOBuf_fdopen,
PerlIOBuf_open,
- PerlIOBase_reopen,
+ PerlIOBuf_reopen,
PerlIOBase_pushed,
PerlIOBase_noop_ok,
PerlIOBuf_read,
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;
SSize_t len = st.st_size - b->posn;
if (len > 0)
{
- b->buf = (STDCHAR *) mmap(NULL, len, PROT_READ, MAP_PRIVATE, fd, b->posn);
- PerlIO_debug(__FUNCTION__ " f=%p b=%p for %ld @ %ld\n",
- f, b->buf, (long) len, (long) 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("panic: sysconf: %s", msg);
+ }
+ else
+ Perl_croak("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("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
{
{
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;
- PerlIO_debug(__FUNCTION__ " f=%p b=%p c=%ld posn=%ld\n",
- f,b->buf,(long)m->len,(long) b->posn);
}
b->ptr = b->end = b->buf;
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
}
if (m->len)
{
- PerlIO_debug(__FUNCTION__ " f=%p %d '%.*s'\n",f,count,count,(char *)vbuf);
+ /* 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);
}
m->bbuf = b->buf;
}
}
- if (code)
- PerlIO_debug(__FUNCTION__ " f=%p %d\n",f,code);
return code;
}
{
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
IV code = PerlIO_flush(f);
- PerlIO_debug(__FUNCTION__ " f=%p flush posn=%ld\n",f,(long)b->posn);
if (code == 0 && !b->buf)
{
code = PerlIOMmap_map(f);
- PerlIO_debug(__FUNCTION__ " f=%p mmap code=%d posn=%ld\n",f,code,(long)b->posn);
}
if (code == 0 && !(PerlIOBase(f)->flags & PERLIO_F_RDBUF))
{
code = PerlIOBuf_fill(f);
- PerlIO_debug(__FUNCTION__ " f=%p fill code=%d posn=%ld\n",f,code,(long)b->posn);
}
return code;
}
}
if (PerlIOBuf_close(f) != 0)
code = -1;
- PerlIO_debug(__FUNCTION__ " f=%p %d\n",f,code);
return code;
}
PerlIOBase_fileno,
PerlIOBuf_fdopen,
PerlIOBuf_open,
- PerlIOBase_reopen,
+ PerlIOBuf_reopen,
PerlIOBase_pushed,
PerlIOBase_noop_ok,
PerlIOBuf_read,