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.
18 #define PERLIO_NOT_STDIO 0
19 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
23 * This file provides those parts of PerlIO abstraction
24 * which are not #defined in iperlsys.h.
25 * Which these are depends on various Configure #ifdef's
29 #define PERL_IN_PERLIO_C
32 #if !defined(PERL_IMPLICIT_SYS)
34 #ifdef PERLIO_IS_STDIO
39 /* Does nothing (yet) except force this file to be included
40 in perl binary. That allows this file to force inclusion
41 of other functions that may be required by loadable
42 extensions e.g. for FileHandle::tmpfile
53 #else /* PERLIO_IS_STDIO */
60 /* This section is just to make sure these functions
61 get pulled in from libsfio.a
74 /* Force this file to be included in perl binary. Which allows
75 * this file to force inclusion of other functions that may be
76 * required by loadable extensions e.g. for FileHandle::tmpfile
80 * sfio does its own 'autoflush' on stdout in common cases.
81 * Flush results in a lot of lseek()s to regular files and
82 * lot of small writes to pipes.
84 sfset(sfstdout,SF_SHARE,0);
89 /* Implement all the PerlIO interface using stdio.
90 - this should be only file to include <stdio.h>
97 return (PerlIO *) stderr;
104 return (PerlIO *) stdin;
111 return (PerlIO *) stdout;
114 #undef PerlIO_fast_gets
116 PerlIO_fast_gets(PerlIO *f)
118 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
125 #undef PerlIO_has_cntptr
127 PerlIO_has_cntptr(PerlIO *f)
129 #if defined(USE_STDIO_PTR)
136 #undef PerlIO_canset_cnt
138 PerlIO_canset_cnt(PerlIO *f)
140 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
147 #undef PerlIO_set_cnt
149 PerlIO_set_cnt(PerlIO *f, int cnt)
152 if (cnt < -1 && ckWARN_d(WARN_INTERNAL))
153 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d\n",cnt);
154 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
157 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
161 #undef PerlIO_set_ptrcnt
163 PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
167 STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
169 if (ptr > e + 1 && ckWARN_d(WARN_INTERNAL))
170 Perl_warner(aTHX_ WARN_INTERNAL, "Setting ptr %p > end+1 %p\n", ptr, e + 1);
171 if (cnt != ec && ckWARN_d(WARN_INTERNAL))
172 Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d, ptr implies %d\n",cnt,ec);
174 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
177 Perl_croak(aTHX_ "Cannot set 'ptr' of FILE * on this system");
179 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE) && defined (STDIO_PTR_LVAL_NOCHANGE_CNT)
182 #if defined(STDIO_PTR_LVAL_SETS_CNT)
183 assert (FILE_cnt(f) == cnt);
185 Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system when setting 'ptr'");
190 #undef PerlIO_get_cnt
192 PerlIO_get_cnt(PerlIO *f)
198 Perl_croak(aTHX_ "Cannot get 'cnt' of FILE * on this system");
203 #undef PerlIO_get_bufsiz
205 PerlIO_get_bufsiz(PerlIO *f)
208 return FILE_bufsiz(f);
211 Perl_croak(aTHX_ "Cannot get 'bufsiz' of FILE * on this system");
216 #undef PerlIO_get_ptr
218 PerlIO_get_ptr(PerlIO *f)
224 Perl_croak(aTHX_ "Cannot get 'ptr' of FILE * on this system");
229 #undef PerlIO_get_base
231 PerlIO_get_base(PerlIO *f)
237 Perl_croak(aTHX_ "Cannot get 'base' of FILE * on this system");
242 #undef PerlIO_has_base
244 PerlIO_has_base(PerlIO *f)
255 PerlIO_puts(PerlIO *f, const char *s)
262 PerlIO_open(const char *path, const char *mode)
264 return fopen(path,mode);
269 PerlIO_fdopen(int fd, const char *mode)
271 return fdopen(fd,mode);
276 PerlIO_reopen(const char *name, const char *mode, PerlIO *f)
278 return freopen(name,mode,f);
283 PerlIO_close(PerlIO *f)
290 PerlIO_eof(PerlIO *f)
295 #undef PerlIO_getname
297 PerlIO_getname(PerlIO *f, char *buf)
300 return fgetname(f,buf);
303 Perl_croak(aTHX_ "Don't know how to get file name");
310 PerlIO_getc(PerlIO *f)
317 PerlIO_error(PerlIO *f)
322 #undef PerlIO_clearerr
324 PerlIO_clearerr(PerlIO *f)
331 PerlIO_flush(PerlIO *f)
338 PerlIO_fileno(PerlIO *f)
343 #undef PerlIO_setlinebuf
345 PerlIO_setlinebuf(PerlIO *f)
347 #ifdef HAS_SETLINEBUF
350 # ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
351 setvbuf(f, Nullch, _IOLBF, BUFSIZ);
353 setvbuf(f, Nullch, _IOLBF, 0);
360 PerlIO_putc(PerlIO *f, int ch)
367 PerlIO_ungetc(PerlIO *f, int ch)
374 PerlIO_read(PerlIO *f, void *buf, Size_t count)
376 return fread(buf,1,count,f);
381 PerlIO_write(PerlIO *f, const void *buf, Size_t count)
383 return fwrite1(buf,1,count,f);
386 #undef PerlIO_vprintf
388 PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
390 return vfprintf(f,fmt,ap);
395 PerlIO_tell(PerlIO *f)
397 #if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64)
406 PerlIO_seek(PerlIO *f, Off_t offset, int whence)
408 #if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64)
409 return fseeko(f,offset,whence);
411 return fseek(f,offset,whence);
417 PerlIO_rewind(PerlIO *f)
424 PerlIO_printf(PerlIO *f,const char *fmt,...)
429 result = vfprintf(f,fmt,ap);
434 #undef PerlIO_stdoutf
436 PerlIO_stdoutf(const char *fmt,...)
441 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
446 #undef PerlIO_tmpfile
453 #undef PerlIO_importFILE
455 PerlIO_importFILE(FILE *f, int fl)
460 #undef PerlIO_exportFILE
462 PerlIO_exportFILE(PerlIO *f, int fl)
467 #undef PerlIO_findFILE
469 PerlIO_findFILE(PerlIO *f)
474 #undef PerlIO_releaseFILE
476 PerlIO_releaseFILE(PerlIO *p, FILE *f)
483 /* Does nothing (yet) except force this file to be included
484 in perl binary. That allows this file to force inclusion
485 of other functions that may be required by loadable
486 extensions e.g. for FileHandle::tmpfile
490 #endif /* USE_SFIO */
491 #endif /* PERLIO_IS_STDIO */
496 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
498 return PerlIO_seek(f,*pos,0);
501 #ifndef PERLIO_IS_STDIO
504 PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
506 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
507 return fsetpos64(f, pos);
509 return fsetpos(f, pos);
518 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
520 *pos = PerlIO_tell(f);
524 #ifndef PERLIO_IS_STDIO
527 PerlIO_getpos(PerlIO *f, Fpos_t *pos)
529 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
530 return fgetpos64(f, pos);
532 return fgetpos(f, pos);
538 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
541 vprintf(char *pat, char *args)
543 _doprnt(pat, args, stdout);
544 return 0; /* wrong, but perl doesn't use the return value */
548 vfprintf(FILE *fd, char *pat, char *args)
550 _doprnt(pat, args, fd);
551 return 0; /* wrong, but perl doesn't use the return value */
556 #ifndef PerlIO_vsprintf
558 PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
560 int val = vsprintf(s, fmt, ap);
563 if (strlen(s) >= (STRLEN)n)
566 PerlIO_puts(Perl_error_log,"panic: sprintf overflow - memory corrupted!\n");
574 #ifndef PerlIO_sprintf
576 PerlIO_sprintf(char *s, int n, const char *fmt,...)
581 result = PerlIO_vsprintf(s, n, fmt, ap);
587 #endif /* !PERL_IMPLICIT_SYS */