3 * Copyright (c) 1996-2000, Nick Ing-Simmons
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
17 #define PERLIO_NOT_STDIO 0
18 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
19 /* #define PerlIO FILE */
22 * This file provides those parts of PerlIO abstraction
23 * which are not #defined in perlio.h.
24 * Which these are depends on various Configure #ifdef's
28 #define PERL_IN_PERLIO_C
33 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
35 if (!names || !*names || strEQ(names,":crlf") || strEQ(names,":raw"))
39 Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl",names);
45 #if !defined(PERL_IMPLICIT_SYS)
47 #ifdef PERLIO_IS_STDIO
52 /* Does nothing (yet) except force this file to be included
53 in perl binary. That allows this file to force inclusion
54 of other functions that may be required by loadable
55 extensions e.g. for FileHandle::tmpfile
66 #else /* PERLIO_IS_STDIO */
73 /* This section is just to make sure these functions
74 get pulled in from libsfio.a
87 /* Force this file to be included in perl binary. Which allows
88 * this file to force inclusion of other functions that may be
89 * required by loadable extensions e.g. for FileHandle::tmpfile
93 * sfio does its own 'autoflush' on stdout in common cases.
94 * Flush results in a lot of lseek()s to regular files and
95 * lot of small writes to pipes.
97 sfset(sfstdout,SF_SHARE,0);
101 /*======================================================================================*/
102 /* Implement all the PerlIO interface ourselves.
107 /* We _MUST_ have <unistd.h> if we are using lseek() and may have large files */
112 #include <sys/mman.h>
117 void PerlIO_debug(const char *fmt,...) __attribute__((format(__printf__,1,2)));
120 PerlIO_debug(const char *fmt,...)
127 char *s = PerlEnv_getenv("PERLIO_DEBUG");
129 dbg = PerlLIO_open3(s,O_WRONLY|O_CREAT|O_APPEND,0666);
136 SV *sv = newSVpvn("",0);
139 s = CopFILE(PL_curcop);
142 Perl_sv_catpvf(aTHX_ sv, "%s:%"IVdf" ", s, (IV)CopLINE(PL_curcop));
143 Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
146 PerlLIO_write(dbg,s,len);
152 /*--------------------------------------------------------------------------------------*/
154 /* Inner level routines */
156 /* Table of pointers to the PerlIO structs (malloc'ed) */
157 PerlIO *_perlio = NULL;
158 #define PERLIO_TABLE_SIZE 64
161 PerlIO_allocate(void)
163 /* Find a free slot in the table, allocating new table as necessary */
164 PerlIO **last = &_perlio;
169 last = (PerlIO **)(f);
170 for (i=1; i < PERLIO_TABLE_SIZE; i++)
178 Newz('I',f,PERLIO_TABLE_SIZE,PerlIO);
186 PerlIO_cleantable(PerlIO **tablep)
188 PerlIO *table = *tablep;
192 PerlIO_cleantable((PerlIO **) &(table[0]));
193 for (i=PERLIO_TABLE_SIZE-1; i > 0; i--)
210 PerlIO_cleantable(&_perlio);
214 PerlIO_pop(PerlIO *f)
219 (*l->tab->Popped)(f);
225 /*--------------------------------------------------------------------------------------*/
226 /* XS Interface for perl code */
232 char *s = GvNAME(gv);
233 STRLEN l = GvNAMELEN(gv);
234 PerlIO_debug("%.*s\n",(int) l,s);
238 XS(XS_perlio_unimport)
242 char *s = GvNAME(gv);
243 STRLEN l = GvNAMELEN(gv);
244 PerlIO_debug("%.*s\n",(int) l,s);
249 PerlIO_find_layer(const char *name, STRLEN len)
256 svp = hv_fetch(PerlIO_layer_hv,name,len,0);
257 if (svp && (sv = *svp) && SvROK(sv))
264 perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
268 IO *io = GvIOn((GV *)SvRV(sv));
269 PerlIO *ifp = IoIFP(io);
270 PerlIO *ofp = IoOFP(io);
271 AV *av = (AV *) mg->mg_obj;
272 Perl_warn(aTHX_ "set %_ %p %p %p",sv,io,ifp,ofp);
278 perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
282 IO *io = GvIOn((GV *)SvRV(sv));
283 PerlIO *ifp = IoIFP(io);
284 PerlIO *ofp = IoOFP(io);
285 AV *av = (AV *) mg->mg_obj;
286 Perl_warn(aTHX_ "get %_ %p %p %p",sv,io,ifp,ofp);
292 perlio_mg_clear(pTHX_ SV *sv, MAGIC *mg)
294 Perl_warn(aTHX_ "clear %_",sv);
299 perlio_mg_free(pTHX_ SV *sv, MAGIC *mg)
301 Perl_warn(aTHX_ "free %_",sv);
305 MGVTBL perlio_vtab = {
313 XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
316 SV *sv = SvRV(ST(1));
321 sv_magic(sv, (SV *)av, '~', NULL, 0);
323 mg = mg_find(sv,'~');
324 mg->mg_virtual = &perlio_vtab;
326 Perl_warn(aTHX_ "attrib %_",sv);
327 for (i=2; i < items; i++)
330 const char *name = SvPV(ST(i),len);
331 SV *layer = PerlIO_find_layer(name,len);
334 av_push(av,SvREFCNT_inc(layer));
347 PerlIO_define_layer(PerlIO_funcs *tab)
350 HV *stash = gv_stashpv("perlio::Layer", TRUE);
351 SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))),stash);
352 hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),sv,0);
356 PerlIO_default_layer(I32 n)
361 PerlIO_funcs *tab = &PerlIO_stdio;
363 if (!PerlIO_layer_hv)
365 const char *s = PerlEnv_getenv("PERLIO");
366 newXS("perlio::import",XS_perlio_import,__FILE__);
367 newXS("perlio::unimport",XS_perlio_unimport,__FILE__);
369 newXS("io::MODIFY_SCALAR_ATTRIBUTES",XS_io_MODIFY_SCALAR_ATTRIBUTES,__FILE__);
371 PerlIO_layer_hv = get_hv("open::layers",GV_ADD|GV_ADDMULTI);
372 PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI);
373 PerlIO_define_layer(&PerlIO_unix);
374 PerlIO_define_layer(&PerlIO_perlio);
375 PerlIO_define_layer(&PerlIO_stdio);
376 PerlIO_define_layer(&PerlIO_crlf);
378 PerlIO_define_layer(&PerlIO_mmap);
380 av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_unix.name,0)));
385 while (*s && isSPACE((unsigned char)*s))
391 while (*e && !isSPACE((unsigned char)*e))
395 layer = PerlIO_find_layer(s,e-s);
398 PerlIO_debug("Pushing %.*s\n",(e-s),s);
399 av_push(PerlIO_layer_av,SvREFCNT_inc(layer));
402 Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(e-s),s);
408 len = av_len(PerlIO_layer_av);
411 if (PerlIO_stdio.Set_ptrcnt)
413 av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_stdio.name,0)));
417 av_push(PerlIO_layer_av,SvREFCNT_inc(PerlIO_find_layer(PerlIO_perlio.name,0)));
419 len = av_len(PerlIO_layer_av);
423 svp = av_fetch(PerlIO_layer_av,n,0);
424 if (svp && (layer = *svp) && SvROK(layer) && SvIOK((layer = SvRV(layer))))
426 tab = INT2PTR(PerlIO_funcs *, SvIV(layer));
428 /* PerlIO_debug("Layer %d is %s\n",n,tab->name); */
433 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
437 const char *s = names;
447 while (*e && *e != ':' && !isSPACE(*e))
451 SV *layer = PerlIO_find_layer(s,e-s);
454 PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
457 PerlIO *new = PerlIO_push(f,tab,mode);
463 Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(e-s),s);
472 #define PerlIO_default_top() PerlIO_default_layer(-1)
473 #define PerlIO_default_btm() PerlIO_default_layer(0)
481 PerlIO_fdopen(0,"Ir");
482 PerlIO_fdopen(1,"Iw");
483 PerlIO_fdopen(2,"Iw");
488 PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
491 Newc('L',l,tab->size,char,PerlIOl);
494 Zero(l,tab->size,char);
498 if ((*l->tab->Pushed)(f,mode) != 0)
507 /*--------------------------------------------------------------------------------------*/
508 /* Given the abstraction above the public API functions */
512 PerlIO_close(PerlIO *f)
514 int code = (*PerlIOBase(f)->tab->Close)(f);
524 PerlIO_fileno(PerlIO *f)
526 return (*PerlIOBase(f)->tab->Fileno)(f);
533 PerlIO_fdopen(int fd, const char *mode)
535 PerlIO_funcs *tab = PerlIO_default_top();
538 return (*tab->Fdopen)(tab,fd,mode);
543 PerlIO_open(const char *path, const char *mode)
545 PerlIO_funcs *tab = PerlIO_default_top();
548 return (*tab->Open)(tab,path,mode);
553 PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
558 if ((*PerlIOBase(f)->tab->Reopen)(path,mode,f) == 0)
560 if ((*PerlIOBase(f)->tab->Pushed)(f,mode) == 0)
566 return PerlIO_open(path,mode);
571 PerlIO_read(PerlIO *f, void *vbuf, Size_t count)
573 return (*PerlIOBase(f)->tab->Read)(f,vbuf,count);
578 PerlIO_unread(PerlIO *f, const void *vbuf, Size_t count)
580 return (*PerlIOBase(f)->tab->Unread)(f,vbuf,count);
585 PerlIO_write(PerlIO *f, const void *vbuf, Size_t count)
587 return (*PerlIOBase(f)->tab->Write)(f,vbuf,count);
592 PerlIO_seek(PerlIO *f, Off_t offset, int whence)
594 return (*PerlIOBase(f)->tab->Seek)(f,offset,whence);
599 PerlIO_tell(PerlIO *f)
601 return (*PerlIOBase(f)->tab->Tell)(f);
606 PerlIO_flush(PerlIO *f)
610 return (*PerlIOBase(f)->tab->Flush)(f);
614 PerlIO **table = &_perlio;
619 table = (PerlIO **)(f++);
620 for (i=1; i < PERLIO_TABLE_SIZE; i++)
622 if (*f && PerlIO_flush(f) != 0)
633 PerlIO_fill(PerlIO *f)
635 return (*PerlIOBase(f)->tab->Fill)(f);
640 PerlIO_isutf8(PerlIO *f)
642 return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
647 PerlIO_eof(PerlIO *f)
649 return (*PerlIOBase(f)->tab->Eof)(f);
654 PerlIO_error(PerlIO *f)
656 return (*PerlIOBase(f)->tab->Error)(f);
659 #undef PerlIO_clearerr
661 PerlIO_clearerr(PerlIO *f)
663 (*PerlIOBase(f)->tab->Clearerr)(f);
666 #undef PerlIO_setlinebuf
668 PerlIO_setlinebuf(PerlIO *f)
670 (*PerlIOBase(f)->tab->Setlinebuf)(f);
673 #undef PerlIO_has_base
675 PerlIO_has_base(PerlIO *f)
679 return (PerlIOBase(f)->tab->Get_base != NULL);
684 #undef PerlIO_fast_gets
686 PerlIO_fast_gets(PerlIO *f)
690 PerlIOl *l = PerlIOBase(f);
691 return (l->tab->Set_ptrcnt != NULL);
696 #undef PerlIO_has_cntptr
698 PerlIO_has_cntptr(PerlIO *f)
702 PerlIO_funcs *tab = PerlIOBase(f)->tab;
703 return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
708 #undef PerlIO_canset_cnt
710 PerlIO_canset_cnt(PerlIO *f)
714 PerlIOl *l = PerlIOBase(f);
715 return (l->tab->Set_ptrcnt != NULL);
720 #undef PerlIO_get_base
722 PerlIO_get_base(PerlIO *f)
724 return (*PerlIOBase(f)->tab->Get_base)(f);
727 #undef PerlIO_get_bufsiz
729 PerlIO_get_bufsiz(PerlIO *f)
731 return (*PerlIOBase(f)->tab->Get_bufsiz)(f);
734 #undef PerlIO_get_ptr
736 PerlIO_get_ptr(PerlIO *f)
738 return (*PerlIOBase(f)->tab->Get_ptr)(f);
741 #undef PerlIO_get_cnt
743 PerlIO_get_cnt(PerlIO *f)
745 return (*PerlIOBase(f)->tab->Get_cnt)(f);
748 #undef PerlIO_set_cnt
750 PerlIO_set_cnt(PerlIO *f,int cnt)
752 (*PerlIOBase(f)->tab->Set_ptrcnt)(f,NULL,cnt);
755 #undef PerlIO_set_ptrcnt
757 PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
759 (*PerlIOBase(f)->tab->Set_ptrcnt)(f,ptr,cnt);
762 /*--------------------------------------------------------------------------------------*/
763 /* "Methods" of the "base class" */
766 PerlIOBase_fileno(PerlIO *f)
768 return PerlIO_fileno(PerlIONext(f));
772 PerlIOBase_pushed(PerlIO *f, const char *mode)
774 PerlIOl *l = PerlIOBase(f);
775 l->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE|
776 PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY);
782 l->flags = PERLIO_F_CANREAD;
785 l->flags = PERLIO_F_APPEND|PERLIO_F_CANWRITE;
788 l->flags = PERLIO_F_TRUNCATE|PERLIO_F_CANWRITE;
799 l->flags |= PERLIO_F_CANREAD|PERLIO_F_CANWRITE;
802 l->flags |= PERLIO_F_BINARY;
814 l->flags |= l->next->flags &
815 (PERLIO_F_CANREAD|PERLIO_F_CANWRITE|
816 PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY);
823 PerlIOBase_popped(PerlIO *f)
829 PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
831 Off_t old = PerlIO_tell(f);
832 if (PerlIO_seek(f,-((Off_t)count),SEEK_CUR) == 0)
834 Off_t new = PerlIO_tell(f);
841 PerlIOBase_noop_ok(PerlIO *f)
847 PerlIOBase_noop_fail(PerlIO *f)
853 PerlIOBase_close(PerlIO *f)
856 if (PerlIO_flush(f) != 0)
858 if (PerlIO_close(PerlIONext(f)) != 0)
860 PerlIOBase(f)->flags &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE|PERLIO_F_OPEN);
865 PerlIOBase_eof(PerlIO *f)
869 return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0;
875 PerlIOBase_error(PerlIO *f)
879 return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0;
885 PerlIOBase_clearerr(PerlIO *f)
889 PerlIOBase(f)->flags &= ~PERLIO_F_ERROR;
894 PerlIOBase_setlinebuf(PerlIO *f)
899 /*--------------------------------------------------------------------------------------*/
900 /* Bottom-most level for UNIX-like case */
904 struct _PerlIO base; /* The generic part */
905 int fd; /* UNIX like file descriptor */
906 int oflags; /* open/fcntl flags */
910 PerlIOUnix_oflags(const char *mode)
925 oflags = O_CREAT|O_TRUNC;
936 oflags = O_CREAT|O_APPEND;
951 if (*mode || oflags == -1)
960 PerlIOUnix_fileno(PerlIO *f)
962 return PerlIOSelf(f,PerlIOUnix)->fd;
966 PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode)
973 int oflags = PerlIOUnix_oflags(mode);
976 PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix);
979 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
986 PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode)
989 int oflags = PerlIOUnix_oflags(mode);
992 int fd = PerlLIO_open3(path,oflags,0666);
995 PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix);
998 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
1005 PerlIOUnix_reopen(const char *path, const char *mode, PerlIO *f)
1007 PerlIOUnix *s = PerlIOSelf(f,PerlIOUnix);
1008 int oflags = PerlIOUnix_oflags(mode);
1009 if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
1010 (*PerlIOBase(f)->tab->Close)(f);
1013 int fd = PerlLIO_open3(path,oflags,0666);
1018 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
1026 PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
1028 int fd = PerlIOSelf(f,PerlIOUnix)->fd;
1029 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
1033 SSize_t len = PerlLIO_read(fd,vbuf,count);
1034 if (len >= 0 || errno != EINTR)
1037 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
1038 else if (len == 0 && count != 0)
1039 PerlIOBase(f)->flags |= PERLIO_F_EOF;
1046 PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count)
1048 int fd = PerlIOSelf(f,PerlIOUnix)->fd;
1051 SSize_t len = PerlLIO_write(fd,vbuf,count);
1052 if (len >= 0 || errno != EINTR)
1055 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
1062 PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
1064 Off_t new = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence);
1065 PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
1066 return (new == (Off_t) -1) ? -1 : 0;
1070 PerlIOUnix_tell(PerlIO *f)
1072 return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
1076 PerlIOUnix_close(PerlIO *f)
1078 int fd = PerlIOSelf(f,PerlIOUnix)->fd;
1080 while (PerlLIO_close(fd) != 0)
1090 PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
1095 PerlIO_funcs PerlIO_unix = {
1111 PerlIOBase_noop_ok, /* flush */
1112 PerlIOBase_noop_fail, /* fill */
1115 PerlIOBase_clearerr,
1116 PerlIOBase_setlinebuf,
1117 NULL, /* get_base */
1118 NULL, /* get_bufsiz */
1121 NULL, /* set_ptrcnt */
1124 /*--------------------------------------------------------------------------------------*/
1125 /* stdio as a layer */
1129 struct _PerlIO base;
1130 FILE * stdio; /* The stream */
1134 PerlIOStdio_fileno(PerlIO *f)
1136 return fileno(PerlIOSelf(f,PerlIOStdio)->stdio);
1141 PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode)
1169 stdio = fdopen(fd,mode);
1172 PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOStdio);
1179 #undef PerlIO_importFILE
1181 PerlIO_importFILE(FILE *stdio, int fl)
1186 PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"r+"),PerlIOStdio);
1193 PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode)
1196 FILE *stdio = fopen(path,mode);
1199 PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOStdio);
1206 PerlIOStdio_reopen(const char *path, const char *mode, PerlIO *f)
1208 PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
1209 FILE *stdio = freopen(path,mode,s->stdio);
1217 PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
1219 FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
1223 STDCHAR *buf = (STDCHAR *) vbuf;
1224 /* Perl is expecting PerlIO_getc() to fill the buffer
1225 * Linux's stdio does not do that for fread()
1235 got = fread(vbuf,1,count,s);
1240 PerlIOStdio_unread(PerlIO *f, const void *vbuf, Size_t count)
1242 FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
1243 STDCHAR *buf = ((STDCHAR *)vbuf)+count-1;
1247 int ch = *buf-- & 0xff;
1248 if (ungetc(ch,s) != ch)
1257 PerlIOStdio_write(PerlIO *f, const void *vbuf, Size_t count)
1259 return fwrite(vbuf,1,count,PerlIOSelf(f,PerlIOStdio)->stdio);
1263 PerlIOStdio_seek(PerlIO *f, Off_t offset, int whence)
1265 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1266 return fseek(stdio,offset,whence);
1270 PerlIOStdio_tell(PerlIO *f)
1272 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1273 return ftell(stdio);
1277 PerlIOStdio_close(PerlIO *f)
1279 return fclose(PerlIOSelf(f,PerlIOStdio)->stdio);
1283 PerlIOStdio_flush(PerlIO *f)
1285 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1286 if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
1288 return fflush(stdio);
1293 /* FIXME: This discards ungetc() and pre-read stuff which is
1294 not right if this is just a "sync" from a layer above
1295 Suspect right design is to do _this_ but not have layer above
1296 flush this layer read-to-read
1298 /* Not writeable - sync by attempting a seek */
1300 if (fseek(stdio,(Off_t) 0, SEEK_CUR) != 0)
1308 PerlIOStdio_fill(PerlIO *f)
1310 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1312 if (fflush(stdio) != 0)
1315 if (c == EOF || ungetc(c,stdio) != c)
1321 PerlIOStdio_eof(PerlIO *f)
1323 return feof(PerlIOSelf(f,PerlIOStdio)->stdio);
1327 PerlIOStdio_error(PerlIO *f)
1329 return ferror(PerlIOSelf(f,PerlIOStdio)->stdio);
1333 PerlIOStdio_clearerr(PerlIO *f)
1335 clearerr(PerlIOSelf(f,PerlIOStdio)->stdio);
1339 PerlIOStdio_setlinebuf(PerlIO *f)
1341 #ifdef HAS_SETLINEBUF
1342 setlinebuf(PerlIOSelf(f,PerlIOStdio)->stdio);
1344 setvbuf(PerlIOSelf(f,PerlIOStdio)->stdio, Nullch, _IOLBF, 0);
1350 PerlIOStdio_get_base(PerlIO *f)
1352 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1353 return FILE_base(stdio);
1357 PerlIOStdio_get_bufsiz(PerlIO *f)
1359 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1360 return FILE_bufsiz(stdio);
1364 #ifdef USE_STDIO_PTR
1366 PerlIOStdio_get_ptr(PerlIO *f)
1368 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1369 return FILE_ptr(stdio);
1373 PerlIOStdio_get_cnt(PerlIO *f)
1375 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1376 return FILE_cnt(stdio);
1380 PerlIOStdio_set_ptrcnt(PerlIO *f,STDCHAR *ptr,SSize_t cnt)
1382 FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
1385 #ifdef STDIO_PTR_LVALUE
1386 FILE_ptr(stdio) = ptr;
1387 #ifdef STDIO_PTR_LVAL_SETS_CNT
1388 if (FILE_cnt(stdio) != (cnt))
1391 assert(FILE_cnt(stdio) == (cnt));
1394 #if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT))
1395 /* Setting ptr _does_ change cnt - we are done */
1398 #else /* STDIO_PTR_LVALUE */
1400 #endif /* STDIO_PTR_LVALUE */
1402 /* Now (or only) set cnt */
1403 #ifdef STDIO_CNT_LVALUE
1404 FILE_cnt(stdio) = cnt;
1405 #else /* STDIO_CNT_LVALUE */
1406 #if (defined(STDIO_PTR_LVALUE) && defined(STDIO_PTR_LVAL_SETS_CNT))
1407 FILE_ptr(stdio) = FILE_ptr(stdio)+(FILE_cnt(stdio)-cnt);
1408 #else /* STDIO_PTR_LVAL_SETS_CNT */
1410 #endif /* STDIO_PTR_LVAL_SETS_CNT */
1411 #endif /* STDIO_CNT_LVALUE */
1416 PerlIO_funcs PerlIO_stdio = {
1418 sizeof(PerlIOStdio),
1436 PerlIOStdio_clearerr,
1437 PerlIOStdio_setlinebuf,
1439 PerlIOStdio_get_base,
1440 PerlIOStdio_get_bufsiz,
1445 #ifdef USE_STDIO_PTR
1446 PerlIOStdio_get_ptr,
1447 PerlIOStdio_get_cnt,
1448 #if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT)))
1449 PerlIOStdio_set_ptrcnt
1450 #else /* STDIO_PTR_LVALUE */
1452 #endif /* STDIO_PTR_LVALUE */
1453 #else /* USE_STDIO_PTR */
1457 #endif /* USE_STDIO_PTR */
1460 #undef PerlIO_exportFILE
1462 PerlIO_exportFILE(PerlIO *f, int fl)
1465 /* Should really push stdio discipline when we have them */
1466 return fdopen(PerlIO_fileno(f),"r+");
1469 #undef PerlIO_findFILE
1471 PerlIO_findFILE(PerlIO *f)
1473 return PerlIO_exportFILE(f,0);
1476 #undef PerlIO_releaseFILE
1478 PerlIO_releaseFILE(PerlIO *p, FILE *f)
1482 /*--------------------------------------------------------------------------------------*/
1483 /* perlio buffer layer */
1486 PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
1488 PerlIO_funcs *tab = PerlIO_default_btm();
1496 f = (*tab->Fdopen)(tab,fd,mode);
1499 /* Initial stderr is unbuffered */
1500 if (!init || fd != 2)
1502 PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,NULL),PerlIOBuf);
1503 b->posn = PerlIO_tell(PerlIONext(f));
1510 PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
1512 PerlIO_funcs *tab = PerlIO_default_btm();
1513 PerlIO *f = (*tab->Open)(tab,path,mode);
1516 PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,NULL),PerlIOBuf);
1517 b->posn = PerlIO_tell(PerlIONext(f));
1523 PerlIOBuf_reopen(const char *path, const char *mode, PerlIO *f)
1525 PerlIO *next = PerlIONext(f);
1526 int code = (*PerlIOBase(next)->tab->Reopen)(path,mode,next);
1528 code = (*PerlIOBase(f)->tab->Pushed)(f,mode);
1531 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1532 b->posn = PerlIO_tell(PerlIONext(f));
1537 /* This "flush" is akin to sfio's sync in that it handles files in either
1541 PerlIOBuf_flush(PerlIO *f)
1543 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1545 if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
1547 /* write() the buffer */
1548 STDCHAR *p = b->buf;
1552 count = PerlIO_write(PerlIONext(f),p,b->ptr - p);
1559 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
1564 b->posn += (p - b->buf);
1566 else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
1568 /* Note position change */
1569 b->posn += (b->ptr - b->buf);
1570 if (b->ptr < b->end)
1572 /* We did not consume all of it */
1573 if (PerlIO_seek(PerlIONext(f),b->posn,SEEK_SET) == 0)
1575 b->posn = PerlIO_tell(PerlIONext(f));
1579 b->ptr = b->end = b->buf;
1580 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
1581 /* FIXME: Is this right for read case ? */
1582 if (PerlIO_flush(PerlIONext(f)) != 0)
1588 PerlIOBuf_fill(PerlIO *f)
1590 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1591 PerlIO *n = PerlIONext(f);
1593 /* FIXME: doing the down-stream flush is a bad idea if it causes
1594 pre-read data in stdio buffer to be discarded
1595 but this is too simplistic - as it skips _our_ hosekeeping
1596 and breaks tell tests.
1597 if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF))
1601 if (PerlIO_flush(f) != 0)
1604 b->ptr = b->end = b->buf;
1605 if (PerlIO_fast_gets(n))
1607 /* Layer below is also buffered
1608 * We do _NOT_ want to call its ->Read() because that will loop
1609 * till it gets what we asked for which may hang on a pipe etc.
1610 * Instead take anything it has to hand, or ask it to fill _once_.
1612 avail = PerlIO_get_cnt(n);
1615 avail = PerlIO_fill(n);
1617 avail = PerlIO_get_cnt(n);
1620 if (!PerlIO_error(n) && PerlIO_eof(n))
1626 STDCHAR *ptr = PerlIO_get_ptr(n);
1627 SSize_t cnt = avail;
1628 if (avail > b->bufsiz)
1630 Copy(ptr,b->buf,avail,STDCHAR);
1631 PerlIO_set_ptrcnt(n,ptr+avail,cnt-avail);
1636 avail = PerlIO_read(n,b->ptr,b->bufsiz);
1641 PerlIOBase(f)->flags |= PERLIO_F_EOF;
1643 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
1646 b->end = b->buf+avail;
1647 PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
1652 PerlIOBuf_read(PerlIO *f, void *vbuf, Size_t count)
1654 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1655 STDCHAR *buf = (STDCHAR *) vbuf;
1661 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
1665 SSize_t avail = (b->end - b->ptr);
1666 if ((SSize_t) count < avail)
1670 Copy(b->ptr,buf,avail,STDCHAR);
1676 if (count && (b->ptr >= b->end))
1678 if (PerlIO_fill(f) != 0)
1688 PerlIOBuf_unread(PerlIO *f, const void *vbuf, Size_t count)
1690 const STDCHAR *buf = (const STDCHAR *) vbuf+count;
1691 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1694 if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
1700 if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
1702 avail = (b->ptr - b->buf);
1703 if (avail > (SSize_t) count)
1710 if (avail > (SSize_t) count)
1712 b->end = b->ptr + avail;
1719 Copy(buf,b->ptr,avail,STDCHAR);
1723 PerlIOBase(f)->flags &= ~ PERLIO_F_EOF;
1730 PerlIOBuf_write(PerlIO *f, const void *vbuf, Size_t count)
1732 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1733 const STDCHAR *buf = (const STDCHAR *) vbuf;
1737 if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
1741 SSize_t avail = b->bufsiz - (b->ptr - b->buf);
1742 if ((SSize_t) count < avail)
1744 PerlIOBase(f)->flags |= PERLIO_F_WRBUF;
1745 if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF)
1765 Copy(buf,b->ptr,avail,STDCHAR);
1772 if (b->ptr >= (b->buf + b->bufsiz))
1779 PerlIOBuf_seek(PerlIO *f, Off_t offset, int whence)
1781 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1782 int code = PerlIO_flush(f);
1785 PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
1786 code = PerlIO_seek(PerlIONext(f),offset,whence);
1789 b->posn = PerlIO_tell(PerlIONext(f));
1796 PerlIOBuf_tell(PerlIO *f)
1798 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1799 Off_t posn = b->posn;
1801 posn += (b->ptr - b->buf);
1806 PerlIOBuf_close(PerlIO *f)
1808 IV code = PerlIOBase_close(f);
1809 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1810 if (b->buf && b->buf != (STDCHAR *) &b->oneword)
1815 b->ptr = b->end = b->buf;
1816 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
1821 PerlIOBuf_setlinebuf(PerlIO *f)
1825 PerlIOBase(f)->flags &= ~PERLIO_F_LINEBUF;
1830 PerlIOBuf_get_ptr(PerlIO *f)
1832 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1839 PerlIOBuf_get_cnt(PerlIO *f)
1841 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1844 if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
1845 return (b->end - b->ptr);
1850 PerlIOBuf_get_base(PerlIO *f)
1852 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1857 New('B',b->buf,b->bufsiz,STDCHAR);
1860 b->buf = (STDCHAR *)&b->oneword;
1861 b->bufsiz = sizeof(b->oneword);
1870 PerlIOBuf_bufsiz(PerlIO *f)
1872 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1875 return (b->end - b->buf);
1879 PerlIOBuf_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
1881 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1885 if (PerlIO_get_cnt(f) != cnt || b->ptr < b->buf)
1888 assert(PerlIO_get_cnt(f) == cnt);
1889 assert(b->ptr >= b->buf);
1891 PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
1894 PerlIO_funcs PerlIO_perlio = {
1914 PerlIOBase_clearerr,
1915 PerlIOBuf_setlinebuf,
1920 PerlIOBuf_set_ptrcnt,
1923 /*--------------------------------------------------------------------------------------*/
1924 /* crlf - translation currently just a copy of perlio to prove
1925 that extra buffering which real one will do is not an issue.
1928 PerlIO_funcs PerlIO_crlf = {
1948 PerlIOBase_clearerr,
1949 PerlIOBuf_setlinebuf,
1954 PerlIOBuf_set_ptrcnt,
1958 /*--------------------------------------------------------------------------------------*/
1959 /* mmap as "buffer" layer */
1963 PerlIOBuf base; /* PerlIOBuf stuff */
1964 Mmap_t mptr; /* Mapped address */
1965 Size_t len; /* mapped length */
1966 STDCHAR *bbuf; /* malloced buffer if map fails */
1970 static size_t page_size = 0;
1973 PerlIOMmap_map(PerlIO *f)
1976 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
1977 PerlIOBuf *b = &m->base;
1978 IV flags = PerlIOBase(f)->flags;
1982 if (flags & PERLIO_F_CANREAD)
1984 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
1985 int fd = PerlIO_fileno(f);
1987 code = fstat(fd,&st);
1988 if (code == 0 && S_ISREG(st.st_mode))
1990 SSize_t len = st.st_size - b->posn;
1995 #if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_PAGE_SIZE))
1997 SETERRNO(0,SS$_NORMAL);
1998 # ifdef _SC_PAGESIZE
1999 page_size = sysconf(_SC_PAGESIZE);
2001 page_size = sysconf(_SC_PAGE_SIZE);
2003 if ((long)page_size < 0) {
2008 (void)SvUPGRADE(error, SVt_PV);
2009 msg = SvPVx(error, n_a);
2010 Perl_croak(aTHX_ "panic: sysconf: %s", msg);
2013 Perl_croak(aTHX_ "panic: sysconf: pagesize unknown");
2017 # ifdef HAS_GETPAGESIZE
2018 page_size = getpagesize();
2020 # if defined(I_SYS_PARAM) && defined(PAGESIZE)
2021 page_size = PAGESIZE; /* compiletime, bad */
2025 if ((IV)page_size <= 0)
2026 Perl_croak(aTHX_ "panic: bad pagesize %"IVdf, (IV)page_size);
2030 /* This is a hack - should never happen - open should have set it ! */
2031 b->posn = PerlIO_tell(PerlIONext(f));
2033 posn = (b->posn / page_size) * page_size;
2034 len = st.st_size - posn;
2035 m->mptr = mmap(NULL, len, PROT_READ, MAP_PRIVATE, fd, posn);
2036 if (m->mptr && m->mptr != (Mmap_t) -1)
2038 #if defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
2039 madvise(m->mptr, len, MADV_SEQUENTIAL);
2041 PerlIOBase(f)->flags = (flags & ~PERLIO_F_EOF) | PERLIO_F_RDBUF;
2042 b->end = ((STDCHAR *)m->mptr) + len;
2043 b->buf = ((STDCHAR *)m->mptr) + (b->posn - posn);
2054 PerlIOBase(f)->flags = flags | PERLIO_F_EOF | PERLIO_F_RDBUF;
2056 b->ptr = b->end = b->ptr;
2065 PerlIOMmap_unmap(PerlIO *f)
2067 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2068 PerlIOBuf *b = &m->base;
2074 code = munmap(m->mptr, m->len);
2078 if (PerlIO_seek(PerlIONext(f),b->posn,SEEK_SET) != 0)
2081 b->ptr = b->end = b->buf;
2082 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
2088 PerlIOMmap_get_base(PerlIO *f)
2090 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2091 PerlIOBuf *b = &m->base;
2092 if (b->buf && (PerlIOBase(f)->flags & PERLIO_F_RDBUF))
2094 /* Already have a readbuffer in progress */
2099 /* We have a write buffer or flushed PerlIOBuf read buffer */
2100 m->bbuf = b->buf; /* save it in case we need it again */
2101 b->buf = NULL; /* Clear to trigger below */
2105 PerlIOMmap_map(f); /* Try and map it */
2108 /* Map did not work - recover PerlIOBuf buffer if we have one */
2112 b->ptr = b->end = b->buf;
2115 return PerlIOBuf_get_base(f);
2119 PerlIOMmap_unread(PerlIO *f, const void *vbuf, Size_t count)
2121 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2122 PerlIOBuf *b = &m->base;
2123 if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
2125 if (b->ptr && (b->ptr - count) >= b->buf && memEQ(b->ptr - count,vbuf,count))
2128 PerlIOBase(f)->flags &= ~ PERLIO_F_EOF;
2133 /* Loose the unwritable mapped buffer */
2135 /* If flush took the "buffer" see if we have one from before */
2136 if (!b->buf && m->bbuf)
2140 PerlIOBuf_get_base(f);
2144 return PerlIOBuf_unread(f,vbuf,count);
2148 PerlIOMmap_write(PerlIO *f, const void *vbuf, Size_t count)
2150 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2151 PerlIOBuf *b = &m->base;
2152 if (!b->buf || !(PerlIOBase(f)->flags & PERLIO_F_WRBUF))
2154 /* No, or wrong sort of, buffer */
2157 if (PerlIOMmap_unmap(f) != 0)
2160 /* If unmap took the "buffer" see if we have one from before */
2161 if (!b->buf && m->bbuf)
2165 PerlIOBuf_get_base(f);
2169 return PerlIOBuf_write(f,vbuf,count);
2173 PerlIOMmap_flush(PerlIO *f)
2175 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2176 PerlIOBuf *b = &m->base;
2177 IV code = PerlIOBuf_flush(f);
2178 /* Now we are "synced" at PerlIOBuf level */
2183 /* Unmap the buffer */
2184 if (PerlIOMmap_unmap(f) != 0)
2189 /* We seem to have a PerlIOBuf buffer which was not mapped
2190 * remember it in case we need one later
2199 PerlIOMmap_fill(PerlIO *f)
2201 PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
2202 IV code = PerlIO_flush(f);
2203 if (code == 0 && !b->buf)
2205 code = PerlIOMmap_map(f);
2207 if (code == 0 && !(PerlIOBase(f)->flags & PERLIO_F_RDBUF))
2209 code = PerlIOBuf_fill(f);
2215 PerlIOMmap_close(PerlIO *f)
2217 PerlIOMmap *m = PerlIOSelf(f,PerlIOMmap);
2218 PerlIOBuf *b = &m->base;
2219 IV code = PerlIO_flush(f);
2224 b->ptr = b->end = b->buf;
2226 if (PerlIOBuf_close(f) != 0)
2232 PerlIO_funcs PerlIO_mmap = {
2252 PerlIOBase_clearerr,
2253 PerlIOBuf_setlinebuf,
2254 PerlIOMmap_get_base,
2258 PerlIOBuf_set_ptrcnt,
2261 #endif /* HAS_MMAP */
2268 atexit(&PerlIO_cleanup);
2277 PerlIO_stdstreams();
2281 #undef PerlIO_stdout
2286 PerlIO_stdstreams();
2290 #undef PerlIO_stderr
2295 PerlIO_stdstreams();
2299 /*--------------------------------------------------------------------------------------*/
2301 #undef PerlIO_getname
2303 PerlIO_getname(PerlIO *f, char *buf)
2306 Perl_croak(aTHX_ "Don't know how to get file name");
2311 /*--------------------------------------------------------------------------------------*/
2312 /* Functions which can be called on any kind of PerlIO implemented
2318 PerlIO_getc(PerlIO *f)
2321 SSize_t count = PerlIO_read(f,buf,1);
2324 return (unsigned char) buf[0];
2329 #undef PerlIO_ungetc
2331 PerlIO_ungetc(PerlIO *f, int ch)
2336 if (PerlIO_unread(f,&buf,1) == 1)
2344 PerlIO_putc(PerlIO *f, int ch)
2347 return PerlIO_write(f,&buf,1);
2352 PerlIO_puts(PerlIO *f, const char *s)
2354 STRLEN len = strlen(s);
2355 return PerlIO_write(f,s,len);
2358 #undef PerlIO_rewind
2360 PerlIO_rewind(PerlIO *f)
2362 PerlIO_seek(f,(Off_t)0,SEEK_SET);
2366 #undef PerlIO_vprintf
2368 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
2371 SV *sv = newSVpvn("",0);
2376 Perl_va_copy(ap, apc);
2377 sv_vcatpvf(sv, fmt, &apc);
2379 sv_vcatpvf(sv, fmt, &ap);
2382 return PerlIO_write(f,s,len);
2385 #undef PerlIO_printf
2387 PerlIO_printf(PerlIO *f,const char *fmt,...)
2392 result = PerlIO_vprintf(f,fmt,ap);
2397 #undef PerlIO_stdoutf
2399 PerlIO_stdoutf(const char *fmt,...)
2404 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
2409 #undef PerlIO_tmpfile
2411 PerlIO_tmpfile(void)
2413 /* I have no idea how portable mkstemp() is ... */
2414 #if defined(WIN32) || !defined(HAVE_MKSTEMP)
2416 FILE *stdio = tmpfile();
2419 PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"w+"),PerlIOStdio);
2425 SV *sv = newSVpv("/tmp/PerlIO_XXXXXX",0);
2426 int fd = mkstemp(SvPVX(sv));
2430 f = PerlIO_fdopen(fd,"w+");
2433 PerlIOBase(f)->flags |= PERLIO_F_TEMP;
2435 PerlLIO_unlink(SvPVX(sv));
2445 #endif /* USE_SFIO */
2446 #endif /* PERLIO_IS_STDIO */
2448 /*======================================================================================*/
2449 /* Now some functions in terms of above which may be needed even if
2450 we are not in true PerlIO mode
2454 #undef PerlIO_setpos
2456 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
2458 return PerlIO_seek(f,*pos,0);
2461 #ifndef PERLIO_IS_STDIO
2462 #undef PerlIO_setpos
2464 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
2466 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
2467 return fsetpos64(f, pos);
2469 return fsetpos(f, pos);
2476 #undef PerlIO_getpos
2478 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
2480 *pos = PerlIO_tell(f);
2481 return *pos == -1 ? -1 : 0;
2484 #ifndef PERLIO_IS_STDIO
2485 #undef PerlIO_getpos
2487 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
2489 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
2490 return fgetpos64(f, pos);
2492 return fgetpos(f, pos);
2498 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
2501 vprintf(char *pat, char *args)
2503 _doprnt(pat, args, stdout);
2504 return 0; /* wrong, but perl doesn't use the return value */
2508 vfprintf(FILE *fd, char *pat, char *args)
2510 _doprnt(pat, args, fd);
2511 return 0; /* wrong, but perl doesn't use the return value */
2516 #ifndef PerlIO_vsprintf
2518 PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
2520 int val = vsprintf(s, fmt, ap);
2523 if (strlen(s) >= (STRLEN)n)
2526 (void)PerlIO_puts(Perl_error_log,
2527 "panic: sprintf overflow - memory corrupted!\n");
2535 #ifndef PerlIO_sprintf
2537 PerlIO_sprintf(char *s, int n, const char *fmt,...)
2542 result = PerlIO_vsprintf(s, n, fmt, ap);
2548 #endif /* !PERL_IMPLICIT_SYS */