3 * Copyright (c) 1996-1999, 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.
10 #if !defined(PERL_IMPLICIT_SYS)
15 #define PERLIO_NOT_STDIO 0
16 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
20 * This file provides those parts of PerlIO abstraction
21 * which are not #defined in iperlsys.h.
22 * Which these are depends on various Configure #ifdef's
26 #define PERL_IN_PERLIO_C
29 #ifdef PERLIO_IS_STDIO
34 /* Does nothing (yet) except force this file to be included
35 in perl binary. That allows this file to force inclusion
36 of other functions that may be required by loadable
37 extensions e.g. for FileHandle::tmpfile
48 #else /* PERLIO_IS_STDIO */
55 /* This section is just to make sure these functions
56 get pulled in from libsfio.a
69 /* Force this file to be included in perl binary. Which allows
70 * this file to force inclusion of other functions that may be
71 * required by loadable extensions e.g. for FileHandle::tmpfile
75 * sfio does its own 'autoflush' on stdout in common cases.
76 * Flush results in a lot of lseek()s to regular files and
77 * lot of small writes to pipes.
79 sfset(sfstdout,SF_SHARE,0);
84 /* Implement all the PerlIO interface using stdio.
85 - this should be only file to include <stdio.h>
92 return (PerlIO *) stderr;
99 return (PerlIO *) stdin;
106 return (PerlIO *) stdout;
109 #undef PerlIO_fast_gets
111 PerlIO_fast_gets(PerlIO *f)
113 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
120 #undef PerlIO_has_cntptr
122 PerlIO_has_cntptr(PerlIO *f)
124 #if defined(USE_STDIO_PTR)
131 #undef PerlIO_canset_cnt
133 PerlIO_canset_cnt(PerlIO *f)
135 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
142 #undef PerlIO_set_cnt
144 PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt)
147 if (cnt < -1 && ckWARN_d(WARN_INTERNAL))
148 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d\n",cnt);
149 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
152 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
156 #undef PerlIO_set_ptrcnt
158 PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, int cnt)
162 STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
164 if (ptr > e + 1 && ckWARN_d(WARN_INTERNAL))
165 Perl_warner(aTHX_ WARN_INTERNAL, "Setting ptr %p > end+1 %p\n", ptr, e + 1);
166 if (cnt != ec && ckWARN_d(WARN_INTERNAL))
167 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d, ptr implies %d\n",cnt,ec);
169 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
173 Perl_croak(aTHX_ "Cannot set 'ptr' of FILE * on this system");
175 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
179 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
183 #undef PerlIO_get_cnt
185 PerlIO_get_cnt(pTHX_ PerlIO *f)
191 Perl_croak(aTHX_ "Cannot get 'cnt' of FILE * on this system");
196 #undef PerlIO_get_bufsiz
198 PerlIO_get_bufsiz(pTHX_ PerlIO *f)
201 return FILE_bufsiz(f);
204 Perl_croak(aTHX_ "Cannot get 'bufsiz' of FILE * on this system");
209 #undef PerlIO_get_ptr
211 PerlIO_get_ptr(pTHX_ PerlIO *f)
217 Perl_croak(aTHX_ "Cannot get 'ptr' of FILE * on this system");
222 #undef PerlIO_get_base
224 PerlIO_get_base(pTHX_ PerlIO *f)
230 Perl_croak(aTHX_ "Cannot get 'base' of FILE * on this system");
235 #undef PerlIO_has_base
237 PerlIO_has_base(PerlIO *f)
248 PerlIO_puts(PerlIO *f, const char *s)
255 PerlIO_open(const char *path, const char *mode)
257 return fopen(path,mode);
262 PerlIO_fdopen(int fd, const char *mode)
264 return fdopen(fd,mode);
269 PerlIO_reopen(const char *name, const char *mode, PerlIO *f)
271 return freopen(name,mode,f);
276 PerlIO_close(PerlIO *f)
283 PerlIO_eof(PerlIO *f)
288 #undef PerlIO_getname
290 PerlIO_getname(pTHX_ PerlIO *f, char *buf)
293 return fgetname(f,buf);
296 Perl_croak(aTHX_ "Don't know how to get file name");
303 PerlIO_getc(PerlIO *f)
310 PerlIO_error(PerlIO *f)
315 #undef PerlIO_clearerr
317 PerlIO_clearerr(PerlIO *f)
324 PerlIO_flush(PerlIO *f)
331 PerlIO_fileno(PerlIO *f)
336 #undef PerlIO_setlinebuf
338 PerlIO_setlinebuf(PerlIO *f)
340 #ifdef HAS_SETLINEBUF
343 # ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
344 setvbuf(f, Nullch, _IOLBF, BUFSIZ);
346 setvbuf(f, Nullch, _IOLBF, 0);
353 PerlIO_putc(PerlIO *f, int ch)
360 PerlIO_ungetc(PerlIO *f, int ch)
367 PerlIO_read(PerlIO *f, void *buf, Size_t count)
369 return fread(buf,1,count,f);
374 PerlIO_write(PerlIO *f, const void *buf, Size_t count)
376 return fwrite1(buf,1,count,f);
379 #undef PerlIO_vprintf
381 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
383 return vfprintf(f,fmt,ap);
388 PerlIO_tell(PerlIO *f)
399 PerlIO_seek(PerlIO *f, Off_t offset, int whence)
402 return fseeko(f,offset,whence);
404 return fseek(f,offset,whence);
410 PerlIO_rewind(PerlIO *f)
417 PerlIO_printf(PerlIO *f,const char *fmt,...)
422 result = vfprintf(f,fmt,ap);
427 #undef PerlIO_stdoutf
429 PerlIO_stdoutf(const char *fmt,...)
434 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
439 #undef PerlIO_tmpfile
446 #undef PerlIO_importFILE
448 PerlIO_importFILE(FILE *f, int fl)
453 #undef PerlIO_exportFILE
455 PerlIO_exportFILE(PerlIO *f, int fl)
460 #undef PerlIO_findFILE
462 PerlIO_findFILE(PerlIO *f)
467 #undef PerlIO_releaseFILE
469 PerlIO_releaseFILE(PerlIO *p, FILE *f)
476 /* Does nothing (yet) except force this file to be included
477 in perl binary. That allows this file to force inclusion
478 of other functions that may be required by loadable
479 extensions e.g. for FileHandle::tmpfile
483 #endif /* USE_SFIO */
484 #endif /* PERLIO_IS_STDIO */
489 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
491 return PerlIO_seek(f,*pos,0);
494 #ifndef PERLIO_IS_STDIO
497 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
499 return fsetpos(f, pos);
507 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
509 *pos = PerlIO_tell(f);
513 #ifndef PERLIO_IS_STDIO
516 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
518 return fgetpos(f, pos);
523 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
526 vprintf(char *pat, char *args)
528 _doprnt(pat, args, stdout);
529 return 0; /* wrong, but perl doesn't use the return value */
533 vfprintf(FILE *fd, char *pat, char *args)
535 _doprnt(pat, args, fd);
536 return 0; /* wrong, but perl doesn't use the return value */
541 #ifndef PerlIO_vsprintf
543 PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
545 int val = vsprintf(s, fmt, ap);
548 if (strlen(s) >= (STRLEN)n)
550 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
561 #ifndef PerlIO_sprintf
563 PerlIO_sprintf(char *s, int n, const char *fmt,...)
568 result = PerlIO_vsprintf(s, n, fmt, ap);
574 #endif /* !PERL_IMPLICIT_SYS */