X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=8d54f77f42411457385835a8ef6447730568b8d2;hb=a17c7222566eaf13f314408f16003962518296ed;hp=9774c3c583338aec6ca152a7d442605814be89e5;hpb=313ca112ae76354c03e7aff0a3e35062e8173ef0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perlio.c b/perlio.c index 9774c3c..8d54f77 100644 --- a/perlio.c +++ b/perlio.c @@ -92,6 +92,10 @@ PerlIO_init(void) #ifdef I_UNISTD #include #endif +#ifdef HAS_MMAP +#include +#endif + #include "XSUB.h" #undef printf @@ -132,15 +136,18 @@ PerlIO_debug(char *fmt,...) /*--------------------------------------------------------------------------------------*/ -typedef struct +typedef struct _PerlIO_funcs PerlIO_funcs; +struct _PerlIO_funcs { char * name; Size_t size; IV kind; IV (*Fileno)(PerlIO *f); - PerlIO * (*Fdopen)(int fd, const char *mode); - PerlIO * (*Open)(const char *path, const char *mode); + PerlIO * (*Fdopen)(PerlIO_funcs *tab, int fd, const char *mode); + PerlIO * (*Open)(PerlIO_funcs *tab, const char *path, const char *mode); int (*Reopen)(const char *path, const char *mode, PerlIO *f); + IV (*Pushed)(PerlIO *f,const char *mode); + IV (*Popped)(PerlIO *f); /* Unix-like functions - cf sfio line disciplines */ SSize_t (*Read)(PerlIO *f, void *vbuf, Size_t count); SSize_t (*Unread)(PerlIO *f, const void *vbuf, Size_t count); @@ -150,6 +157,7 @@ typedef struct IV (*Close)(PerlIO *f); /* Stdio-like buffered IO functions */ IV (*Flush)(PerlIO *f); + IV (*Fill)(PerlIO *f); IV (*Eof)(PerlIO *f); IV (*Error)(PerlIO *f); void (*Clearerr)(PerlIO *f); @@ -160,8 +168,7 @@ typedef struct STDCHAR * (*Get_ptr)(PerlIO *f); SSize_t (*Get_cnt)(PerlIO *f); void (*Set_ptrcnt)(PerlIO *f,STDCHAR *ptr,SSize_t cnt); -} PerlIO_funcs; - +}; struct _PerlIO { @@ -242,6 +249,9 @@ PerlIO_cleantable(PerlIO **tablep) } } +HV *PerlIO_layer_hv; +AV *PerlIO_layer_av; + void PerlIO_cleanup(void) { @@ -254,6 +264,7 @@ PerlIO_pop(PerlIO *f) PerlIOl *l = *f; if (l) { + (*l->tab->Popped)(f); *f = l->next; Safefree(l); } @@ -286,6 +297,9 @@ PerlIO_fileno(PerlIO *f) extern PerlIO_funcs PerlIO_unix; extern PerlIO_funcs PerlIO_perlio; extern PerlIO_funcs PerlIO_stdio; +#ifdef HAS_MMAP +extern PerlIO_funcs PerlIO_mmap; +#endif XS(XS_perlio_import) { @@ -307,9 +321,6 @@ XS(XS_perlio_unimport) XSRETURN_EMPTY; } -HV *PerlIO_layer_hv; -AV *PerlIO_layer_av; - SV * PerlIO_find_layer(char *name, STRLEN len) { @@ -329,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); } @@ -349,9 +360,11 @@ PerlIO_default_layer(I32 n) PerlIO_layer_hv = get_hv("perlio::layers",GV_ADD|GV_ADDMULTI); PerlIO_layer_av = get_av("perlio::layers",GV_ADD|GV_ADDMULTI); PerlIO_define_layer(&PerlIO_unix); - PerlIO_define_layer(&PerlIO_unix); PerlIO_define_layer(&PerlIO_perlio); PerlIO_define_layer(&PerlIO_stdio); +#ifdef HAS_MMAP + PerlIO_define_layer(&PerlIO_mmap); +#endif av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_unix.name,0))); if (s) { @@ -372,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; } } @@ -396,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; @@ -424,7 +437,7 @@ PerlIO_fdopen(int fd, const char *mode) PerlIO_funcs *tab = PerlIO_default_top(); if (!_perlio) PerlIO_stdstreams(); - return (*tab->Fdopen)(fd,mode); + return (*tab->Fdopen)(tab,fd,mode); } #undef PerlIO_open @@ -434,11 +447,11 @@ PerlIO_open(const char *path, const char *mode) PerlIO_funcs *tab = PerlIO_default_top(); if (!_perlio) PerlIO_stdstreams(); - return (*tab->Open)(path,mode); + return (*tab->Open)(tab,path,mode); } IV -PerlIOBase_init(PerlIO *f, const char *mode) +PerlIOBase_pushed(PerlIO *f, const char *mode) { PerlIOl *l = PerlIOBase(f); l->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE| @@ -497,8 +510,8 @@ PerlIO_reopen(const char *path, const char *mode, PerlIO *f) PerlIO_flush(f); if ((*PerlIOBase(f)->tab->Reopen)(path,mode,f) == 0) { - PerlIOBase_init(f,mode); - return f; + if ((*PerlIOBase(f)->tab->Pushed)(f,mode) == 0) + return f; } return NULL; } @@ -568,6 +581,13 @@ PerlIO_flush(PerlIO *f) } } +#undef PerlIO_fill +int +PerlIO_fill(PerlIO *f) +{ + return (*PerlIOBase(f)->tab->Fill)(f); +} + #undef PerlIO_isutf8 int PerlIO_isutf8(PerlIO *f) @@ -712,7 +732,11 @@ PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode) l->next = *f; l->tab = tab; *f = l; - PerlIOBase_init(f,mode); + if ((*l->tab->Pushed)(f,mode) != 0) + { + PerlIO_pop(f); + return NULL; + } } return f; } @@ -730,12 +754,18 @@ PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count) } IV -PerlIOBase_sync(PerlIO *f) +PerlIOBase_noop_ok(PerlIO *f) { return 0; } IV +PerlIOBase_noop_fail(PerlIO *f) +{ + return -1; +} + +IV PerlIOBase_close(PerlIO *f) { IV code = 0; @@ -846,7 +876,7 @@ PerlIOUnix_fileno(PerlIO *f) } PerlIO * -PerlIOUnix_fdopen(int fd,const char *mode) +PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode) { PerlIO *f = NULL; if (*mode == 'I') @@ -856,7 +886,7 @@ PerlIOUnix_fdopen(int fd,const char *mode) int oflags = PerlIOUnix_oflags(mode); if (oflags != -1) { - PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_unix,mode),PerlIOUnix); + PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix); s->fd = fd; s->oflags = oflags; PerlIOBase(f)->flags |= PERLIO_F_OPEN; @@ -866,7 +896,7 @@ PerlIOUnix_fdopen(int fd,const char *mode) } PerlIO * -PerlIOUnix_open(const char *path,const char *mode) +PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode) { PerlIO *f = NULL; int oflags = PerlIOUnix_oflags(mode); @@ -875,7 +905,7 @@ PerlIOUnix_open(const char *path,const char *mode) int fd = open(path,oflags,0666); if (fd >= 0) { - PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_unix,mode),PerlIOUnix); + PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix); s->fd = fd; s->oflags = oflags; PerlIOBase(f)->flags |= PERLIO_F_OPEN; @@ -909,11 +939,19 @@ SSize_t PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count) { int fd = PerlIOSelf(f,PerlIOUnix)->fd; + if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) + return 0; while (1) { SSize_t len = read(fd,vbuf,count); if (len >= 0 || errno != EINTR) - return len; + { + if (len < 0) + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + else if (len == 0 && count != 0) + PerlIOBase(f)->flags |= PERLIO_F_EOF; + return len; + } } } @@ -925,7 +963,11 @@ PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count) { SSize_t len = write(fd,vbuf,count); if (len >= 0 || errno != EINTR) - return len; + { + if (len < 0) + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + return len; + } } } @@ -933,6 +975,7 @@ IV PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence) { Off_t new = lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence); + PerlIOBase(f)->flags &= ~PERLIO_F_EOF; return (new == (Off_t) -1) ? -1 : 0; } @@ -970,13 +1013,16 @@ PerlIO_funcs PerlIO_unix = { PerlIOUnix_fdopen, PerlIOUnix_open, PerlIOUnix_reopen, + PerlIOBase_pushed, + PerlIOBase_noop_ok, PerlIOUnix_read, PerlIOBase_unread, PerlIOUnix_write, PerlIOUnix_seek, PerlIOUnix_tell, PerlIOUnix_close, - PerlIOBase_sync, + PerlIOBase_noop_ok, + PerlIOBase_noop_fail, PerlIOBase_eof, PerlIOBase_error, PerlIOBase_clearerr, @@ -991,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; @@ -1005,7 +1060,7 @@ PerlIOStdio_fileno(PerlIO *f) PerlIO * -PerlIOStdio_fdopen(int fd,const char *mode) +PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode) { PerlIO *f = NULL; int init = 0; @@ -1036,7 +1091,7 @@ PerlIOStdio_fdopen(int fd,const char *mode) stdio = fdopen(fd,mode); if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,mode),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOStdio); s->stdio = stdio; } } @@ -1057,13 +1112,13 @@ PerlIO_importFILE(FILE *stdio, int fl) } PerlIO * -PerlIOStdio_open(const char *path,const char *mode) +PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode) { PerlIO *f = NULL; FILE *stdio = fopen(path,mode); if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,mode),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOStdio); s->stdio = stdio; } return f; @@ -1154,6 +1209,19 @@ PerlIOStdio_flush(PerlIO *f) } IV +PerlIOStdio_fill(PerlIO *f) +{ + FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio; + int c; + if (fflush(stdio) != 0) + return EOF; + c = fgetc(stdio); + if (c == EOF || ungetc(c,stdio) != c) + return EOF; + return 0; +} + +IV PerlIOStdio_eof(PerlIO *f) { return feof(PerlIOSelf(f,PerlIOStdio)->stdio); @@ -1257,6 +1325,8 @@ PerlIO_funcs PerlIO_stdio = { PerlIOStdio_fdopen, PerlIOStdio_open, PerlIOStdio_reopen, + PerlIOBase_pushed, + PerlIOBase_noop_ok, PerlIOStdio_read, PerlIOStdio_unread, PerlIOStdio_write, @@ -1264,6 +1334,7 @@ PerlIO_funcs PerlIO_stdio = { PerlIOStdio_tell, PerlIOStdio_close, PerlIOStdio_flush, + PerlIOStdio_fill, PerlIOStdio_eof, PerlIOStdio_error, PerlIOStdio_clearerr, @@ -1278,8 +1349,7 @@ PerlIO_funcs PerlIO_stdio = { #ifdef USE_STDIO_PTR PerlIOStdio_get_ptr, PerlIOStdio_get_cnt, -#if (defined(STDIO_PTR_LVALUE) && \ - (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT))) +#if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT))) PerlIOStdio_set_ptrcnt #else /* STDIO_PTR_LVALUE */ NULL @@ -1329,7 +1399,7 @@ typedef struct PerlIO * -PerlIOBuf_fdopen(int fd, const char *mode) +PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode) { PerlIO_funcs *tab = PerlIO_default_btm(); int init = 0; @@ -1339,51 +1409,46 @@ PerlIOBuf_fdopen(int fd, const char *mode) init = 1; mode++; } - f = (*tab->Fdopen)(fd,mode); + f = (*tab->Fdopen)(tab,fd,mode); if (f) { /* Initial stderr is unbuffered */ if (!init || fd != 2) { - PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,&PerlIO_perlio,NULL),PerlIOBuf); + PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,NULL),PerlIOBuf); b->posn = PerlIO_tell(PerlIONext(f)); } } return f; } + PerlIO * -PerlIOBuf_open(const char *path, const char *mode) +PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode) { PerlIO_funcs *tab = PerlIO_default_btm(); - PerlIO *f = (*tab->Open)(path,mode); + PerlIO *f = (*tab->Open)(tab,path,mode); if (f) { - PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,&PerlIO_perlio,NULL),PerlIOBuf); - b->posn = 0; + PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,NULL),PerlIOBuf); + b->posn = PerlIO_tell(PerlIONext(f)); } return f; } int -PerlIOBase_reopen(const char *path, const char *mode, PerlIO *f) -{ - return (*PerlIOBase(f)->tab->Reopen)(path,mode,PerlIONext(f)); -} - -void -PerlIOBuf_alloc_buf(PerlIOBuf *b) +PerlIOBuf_reopen(const char *path, const char *mode, PerlIO *f) { - if (!b->bufsiz) - b->bufsiz = 4096; - New('B',b->buf,b->bufsiz,STDCHAR); - if (!b->buf) + 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) { - b->buf = (STDCHAR *)&b->oneword; - b->bufsiz = sizeof(b->oneword); + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + b->posn = PerlIO_tell(PerlIONext(f)); } - b->ptr = b->buf; - b->end = b->ptr; + return code; } /* This "flush" is akin to sfio's sync in that it handles files in either @@ -1435,6 +1500,28 @@ PerlIOBuf_flush(PerlIO *f) return code; } +IV +PerlIOBuf_fill(PerlIO *f) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + SSize_t avail; + if (PerlIO_flush(f) != 0) + return -1; + b->ptr = b->end = b->buf; + avail = PerlIO_read(PerlIONext(f),b->ptr,b->bufsiz); + if (avail <= 0) + { + if (avail == 0) + PerlIOBase(f)->flags |= PERLIO_F_EOF; + else + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + return -1; + } + b->end = b->buf+avail; + PerlIOBase(f)->flags |= PERLIO_F_RDBUF; + return 0; +} + SSize_t PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count) { @@ -1444,7 +1531,7 @@ PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count) { Size_t got = 0; if (!b->ptr) - PerlIOBuf_alloc_buf(b); + PerlIO_get_base(f); if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) return 0; while (count > 0) @@ -1462,19 +1549,8 @@ PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count) } if (count && (b->ptr >= b->end)) { - PerlIO_flush(f); - b->ptr = b->end = b->buf; - avail = PerlIO_read(PerlIONext(f),b->ptr,b->bufsiz); - if (avail <= 0) - { - if (avail == 0) - PerlIOBase(f)->flags |= PERLIO_F_EOF; - else - PerlIOBase(f)->flags |= PERLIO_F_ERROR; - break; - } - b->end = b->buf+avail; - PerlIOBase(f)->flags |= PERLIO_F_RDBUF; + if (PerlIO_fill(f) != 0) + break; } } return got; @@ -1489,10 +1565,10 @@ PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count) PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); SSize_t unread = 0; SSize_t avail; - if (!b->buf) - PerlIOBuf_alloc_buf(b); if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) PerlIO_flush(f); + if (!b->buf) + PerlIO_get_base(f); if (b->buf) { if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) @@ -1531,7 +1607,7 @@ PerlIOBuf_write(PerlIO *f, const void *vbuf, Size_t count) const STDCHAR *buf = (const STDCHAR *) vbuf; Size_t written = 0; if (!b->buf) - PerlIOBuf_alloc_buf(b); + PerlIO_get_base(f); if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) return 0; while (count > 0) @@ -1577,8 +1653,7 @@ IV PerlIOBuf_seek(PerlIO *f, Off_t offset, int whence) { PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); - int code; - code = PerlIO_flush(f); + int code = PerlIO_flush(f); if (code == 0) { PerlIOBase(f)->flags &= ~PERLIO_F_EOF; @@ -1631,7 +1706,7 @@ PerlIOBuf_set_cnt(PerlIO *f, int cnt) PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); dTHX; if (!b->buf) - PerlIOBuf_alloc_buf(b); + PerlIO_get_base(f); b->ptr = b->end - cnt; assert(b->ptr >= b->buf); } @@ -1641,7 +1716,7 @@ PerlIOBuf_get_ptr(PerlIO *f) { PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); if (!b->buf) - PerlIOBuf_alloc_buf(b); + PerlIO_get_base(f); return b->ptr; } @@ -1650,7 +1725,7 @@ PerlIOBuf_get_cnt(PerlIO *f) { PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); if (!b->buf) - PerlIOBuf_alloc_buf(b); + PerlIO_get_base(f); if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) return (b->end - b->ptr); return 0; @@ -1661,7 +1736,18 @@ PerlIOBuf_get_base(PerlIO *f) { PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); if (!b->buf) - PerlIOBuf_alloc_buf(b); + { + if (!b->bufsiz) + b->bufsiz = 4096; + New('B',b->buf,b->bufsiz,STDCHAR); + if (!b->buf) + { + b->buf = (STDCHAR *)&b->oneword; + b->bufsiz = sizeof(b->oneword); + } + b->ptr = b->buf; + b->end = b->ptr; + } return b->buf; } @@ -1670,7 +1756,7 @@ PerlIOBuf_bufsiz(PerlIO *f) { PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); if (!b->buf) - PerlIOBuf_alloc_buf(b); + PerlIO_get_base(f); return (b->end - b->buf); } @@ -1679,7 +1765,7 @@ PerlIOBuf_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt) { PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); if (!b->buf) - PerlIOBuf_alloc_buf(b); + PerlIO_get_base(f); b->ptr = ptr; if (PerlIO_get_cnt(f) != cnt || b->ptr < b->buf) { @@ -1697,7 +1783,9 @@ PerlIO_funcs PerlIO_perlio = { PerlIOBase_fileno, PerlIOBuf_fdopen, PerlIOBuf_open, - PerlIOBase_reopen, + PerlIOBuf_reopen, + PerlIOBase_pushed, + PerlIOBase_noop_ok, PerlIOBuf_read, PerlIOBuf_unread, PerlIOBuf_write, @@ -1705,6 +1793,7 @@ PerlIO_funcs PerlIO_perlio = { PerlIOBuf_tell, PerlIOBuf_close, PerlIOBuf_flush, + PerlIOBuf_fill, PerlIOBase_eof, PerlIOBase_error, PerlIOBase_clearerr, @@ -1716,6 +1805,314 @@ PerlIO_funcs PerlIO_perlio = { PerlIOBuf_set_ptrcnt, }; +#ifdef HAS_MMAP +/*--------------------------------------------------------------------------------------*/ +/* mmap as "buffer" layer */ + +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; + IV code = 0; + if (m->len) + abort(); + if (flags & PERLIO_F_CANREAD) + { + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + int fd = PerlIO_fileno(f); + struct stat st; + code = fstat(fd,&st); + if (code == 0 && S_ISREG(st.st_mode)) + { + SSize_t len = st.st_size - b->posn; + if (len > 0) + { + 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(m->mptr, len, MADV_SEQUENTIAL); +#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); + b->ptr = b->buf; + m->len = len; + } + else + { + b->buf = NULL; + } + } + else + { + PerlIOBase(f)->flags = flags | PERLIO_F_EOF | PERLIO_F_RDBUF; + b->buf = NULL; + b->ptr = b->end = b->ptr; + code = -1; + } + } + } + return code; +} + +IV +PerlIOMmap_unmap(PerlIO *f) +{ + PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap); + PerlIOBuf *b = &m->base; + IV code = 0; + if (m->len) + { + if (b->buf) + { + 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; + } + b->ptr = b->end = b->buf; + PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF); + } + return code; +} + +STDCHAR * +PerlIOMmap_get_base(PerlIO *f) +{ + PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap); + PerlIOBuf *b = &m->base; + if (b->buf && (PerlIOBase(f)->flags & PERLIO_F_RDBUF)) + { + /* Already have a readbuffer in progress */ + return b->buf; + } + if (b->buf) + { + /* We have a write buffer or flushed PerlIOBuf read buffer */ + m->bbuf = b->buf; /* save it in case we need it again */ + b->buf = NULL; /* Clear to trigger below */ + } + if (!b->buf) + { + PerlIOMmap_map(f); /* Try and map it */ + if (!b->buf) + { + /* Map did not work - recover PerlIOBuf buffer if we have one */ + b->buf = m->bbuf; + } + } + b->ptr = b->end = b->buf; + if (b->buf) + return b->buf; + return PerlIOBuf_get_base(f); +} + +SSize_t +PerlIOMmap_unread(PerlIO *f, const void *vbuf, Size_t count) +{ + PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap); + PerlIOBuf *b = &m->base; + if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) + PerlIO_flush(f); + if (b->ptr && (b->ptr - count) >= b->buf && memEQ(b->ptr - count,vbuf,count)) + { + b->ptr -= count; + PerlIOBase(f)->flags &= ~ PERLIO_F_EOF; + return count; + } + if (m->len) + { + /* 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); +} + +SSize_t +PerlIOMmap_write(PerlIO *f, const void *vbuf, Size_t count) +{ + PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap); + PerlIOBuf *b = &m->base; + if (!b->buf || !(PerlIOBase(f)->flags & PERLIO_F_WRBUF)) + { + /* No, or wrong sort of, buffer */ + if (m->len) + { + if (PerlIOMmap_unmap(f) != 0) + return 0; + } + /* If unmap 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_write(f,vbuf,count); +} + +IV +PerlIOMmap_flush(PerlIO *f) +{ + PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap); + PerlIOBuf *b = &m->base; + IV code = PerlIOBuf_flush(f); + /* Now we are "synced" at PerlIOBuf level */ + if (b->buf) + { + if (m->len) + { + /* Unmap the buffer */ + if (PerlIOMmap_unmap(f) != 0) + code = -1; + } + else + { + /* We seem to have a PerlIOBuf buffer which was not mapped + * remember it in case we need one later + */ + m->bbuf = b->buf; + } + } + return code; +} + +IV +PerlIOMmap_fill(PerlIO *f) +{ + PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); + IV code = PerlIO_flush(f); + if (code == 0 && !b->buf) + { + code = PerlIOMmap_map(f); + } + if (code == 0 && !(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) + { + code = PerlIOBuf_fill(f); + } + return code; +} + +IV +PerlIOMmap_close(PerlIO *f) +{ + PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap); + PerlIOBuf *b = &m->base; + IV code = PerlIO_flush(f); + if (m->bbuf) + { + b->buf = m->bbuf; + m->bbuf = NULL; + b->ptr = b->end = b->buf; + } + if (PerlIOBuf_close(f) != 0) + code = -1; + return code; +} + + +PerlIO_funcs PerlIO_mmap = { + "mmap", + sizeof(PerlIOMmap), + 0, + PerlIOBase_fileno, + PerlIOBuf_fdopen, + PerlIOBuf_open, + PerlIOBuf_reopen, + PerlIOBase_pushed, + PerlIOBase_noop_ok, + PerlIOBuf_read, + PerlIOMmap_unread, + PerlIOMmap_write, + PerlIOBuf_seek, + PerlIOBuf_tell, + PerlIOBuf_close, + PerlIOMmap_flush, + PerlIOMmap_fill, + PerlIOBase_eof, + PerlIOBase_error, + PerlIOBase_clearerr, + PerlIOBuf_setlinebuf, + PerlIOMmap_get_base, + PerlIOBuf_bufsiz, + PerlIOBuf_get_ptr, + PerlIOBuf_get_cnt, + PerlIOBuf_set_ptrcnt, +}; + +#endif /* HAS_MMAP */ + + + void PerlIO_init(void) { @@ -1917,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 @@ -1962,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); } }