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.
13 #define PERLIO_NOT_STDIO 0
14 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
18 * This file provides those parts of PerlIO abstraction
19 * which are not #defined in iperlsys.h.
20 * Which these are depends on various Configure #ifdef's
24 #define PERL_IN_PERLIO_C
27 #ifdef PERLIO_IS_STDIO
32 /* Does nothing (yet) except force this file to be included
33 in perl binary. That allows this file to force inclusion
34 of other functions that may be required by loadable
35 extensions e.g. for FileHandle::tmpfile
46 #else /* PERLIO_IS_STDIO */
53 /* This section is just to make sure these functions
54 get pulled in from libsfio.a
67 /* Force this file to be included in perl binary. Which allows
68 * this file to force inclusion of other functions that may be
69 * required by loadable extensions e.g. for FileHandle::tmpfile
73 * sfio does its own 'autoflush' on stdout in common cases.
74 * Flush results in a lot of lseek()s to regular files and
75 * lot of small writes to pipes.
77 sfset(sfstdout,SF_SHARE,0);
82 /* Implement all the PerlIO interface using stdio.
83 - this should be only file to include <stdio.h>
90 return (PerlIO *) stderr;
97 return (PerlIO *) stdin;
104 return (PerlIO *) stdout;
107 #undef PerlIO_fast_gets
109 PerlIO_fast_gets(PerlIO *f)
111 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
118 #undef PerlIO_has_cntptr
120 PerlIO_has_cntptr(PerlIO *f)
122 #if defined(USE_STDIO_PTR)
129 #undef PerlIO_canset_cnt
131 PerlIO_canset_cnt(PerlIO *f)
133 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
140 #undef PerlIO_set_cnt
142 PerlIO_set_cnt(PerlIO *f, int cnt)
144 if (cnt < -1 && ckWARN_s(WARN_INTERNAL))
145 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d\n",cnt);
146 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
149 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
153 #undef PerlIO_set_ptrcnt
155 PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
158 STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
160 if (ptr > e + 1 && ckWARN_s(WARN_INTERNAL))
161 Perl_warner(aTHX_ WARN_INTERNAL, "Setting ptr %p > end+1 %p\n", ptr, e + 1);
162 if (cnt != ec && ckWARN_s(WARN_INTERNAL))
163 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d, ptr implies %d\n",cnt,ec);
165 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
168 Perl_croak(aTHX_ "Cannot set 'ptr' of FILE * on this system");
170 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
173 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
177 #undef PerlIO_get_cnt
179 PerlIO_get_cnt(PerlIO *f)
184 Perl_croak(aTHX_ "Cannot get 'cnt' of FILE * on this system");
189 #undef PerlIO_get_bufsiz
191 PerlIO_get_bufsiz(PerlIO *f)
194 return FILE_bufsiz(f);
196 Perl_croak(aTHX_ "Cannot get 'bufsiz' of FILE * on this system");
201 #undef PerlIO_get_ptr
203 PerlIO_get_ptr(PerlIO *f)
208 Perl_croak(aTHX_ "Cannot get 'ptr' of FILE * on this system");
213 #undef PerlIO_get_base
215 PerlIO_get_base(PerlIO *f)
220 Perl_croak(aTHX_ "Cannot get 'base' of FILE * on this system");
225 #undef PerlIO_has_base
227 PerlIO_has_base(PerlIO *f)
238 PerlIO_puts(PerlIO *f, const char *s)
245 PerlIO_open(const char *path, const char *mode)
247 return fopen(path,mode);
252 PerlIO_fdopen(int fd, const char *mode)
254 return fdopen(fd,mode);
259 PerlIO_reopen(const char *name, const char *mode, PerlIO *f)
261 return freopen(name,mode,f);
266 PerlIO_close(PerlIO *f)
273 PerlIO_eof(PerlIO *f)
278 #undef PerlIO_getname
280 PerlIO_getname(PerlIO *f, char *buf)
283 return fgetname(f,buf);
285 Perl_croak(aTHX_ "Don't know how to get file name");
292 PerlIO_getc(PerlIO *f)
299 PerlIO_error(PerlIO *f)
304 #undef PerlIO_clearerr
306 PerlIO_clearerr(PerlIO *f)
313 PerlIO_flush(PerlIO *f)
320 PerlIO_fileno(PerlIO *f)
325 #undef PerlIO_setlinebuf
327 PerlIO_setlinebuf(PerlIO *f)
329 #ifdef HAS_SETLINEBUF
332 # ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
333 setvbuf(f, Nullch, _IOLBF, BUFSIZ);
335 setvbuf(f, Nullch, _IOLBF, 0);
342 PerlIO_putc(PerlIO *f, int ch)
349 PerlIO_ungetc(PerlIO *f, int ch)
356 PerlIO_read(PerlIO *f, void *buf, Size_t count)
358 return fread(buf,1,count,f);
363 PerlIO_write(PerlIO *f, const void *buf, Size_t count)
365 return fwrite1(buf,1,count,f);
368 #undef PerlIO_vprintf
370 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
372 return vfprintf(f,fmt,ap);
377 PerlIO_tell(PerlIO *f)
388 PerlIO_seek(PerlIO *f, Off_t offset, int whence)
391 return fseeko(f,offset,whence);
393 return fseek(f,offset,whence);
399 PerlIO_rewind(PerlIO *f)
406 PerlIO_printf(PerlIO *f,const char *fmt,...)
411 result = vfprintf(f,fmt,ap);
416 #undef PerlIO_stdoutf
418 PerlIO_stdoutf(const char *fmt,...)
423 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
428 #undef PerlIO_tmpfile
435 #undef PerlIO_importFILE
437 PerlIO_importFILE(FILE *f, int fl)
442 #undef PerlIO_exportFILE
444 PerlIO_exportFILE(PerlIO *f, int fl)
449 #undef PerlIO_findFILE
451 PerlIO_findFILE(PerlIO *f)
456 #undef PerlIO_releaseFILE
458 PerlIO_releaseFILE(PerlIO *p, FILE *f)
465 /* Does nothing (yet) except force this file to be included
466 in perl binary. That allows this file to force inclusion
467 of other functions that may be required by loadable
468 extensions e.g. for FileHandle::tmpfile
472 #endif /* USE_SFIO */
473 #endif /* PERLIO_IS_STDIO */
478 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
480 return PerlIO_seek(f,*pos,0);
483 #ifndef PERLIO_IS_STDIO
486 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
488 return fsetpos(f, pos);
496 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
498 *pos = PerlIO_tell(f);
502 #ifndef PERLIO_IS_STDIO
505 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
507 return fgetpos(f, pos);
512 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
515 vprintf(char *pat, char *args)
517 _doprnt(pat, args, stdout);
518 return 0; /* wrong, but perl doesn't use the return value */
522 vfprintf(FILE *fd, char *pat, char *args)
524 _doprnt(pat, args, fd);
525 return 0; /* wrong, but perl doesn't use the return value */
530 #ifndef PerlIO_vsprintf
532 PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
534 int val = vsprintf(s, fmt, ap);
537 if (strlen(s) >= (STRLEN)n)
539 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
550 #ifndef PerlIO_sprintf
552 PerlIO_sprintf(char *s, int n, const char *fmt,...)
557 result = PerlIO_vsprintf(s, n, fmt, ap);