/* perlio.c
*
- * Copyright (c) 1996, Nick Ing-Simmons
+ * Copyright (c) 1996-2000, Nick Ing-Simmons
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
+
#define VOIDUSED 1
#include "config.h"
#endif
/*
* This file provides those parts of PerlIO abstraction
- * which are not #defined in perlio.h.
+ * which are not #defined in iperlsys.h.
* Which these are depends on various Configure #ifdef's
*/
#include "EXTERN.h"
+#define PERL_IN_PERLIO_C
#include "perl.h"
+#if !defined(PERL_IMPLICIT_SYS)
+
#ifdef PERLIO_IS_STDIO
void
-PerlIO_init()
+PerlIO_init(void)
{
/* Does nothing (yet) except force this file to be included
in perl binary. That allows this file to force inclusion
#undef PerlIO_tmpfile
PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(void)
{
return tmpfile();
}
#undef PerlIO_tmpfile
PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(void)
{
return sftmp(0);
}
void
-PerlIO_init()
+PerlIO_init(void)
{
/* Force this file to be included in perl binary. Which allows
* this file to force inclusion of other functions that may be
sfset(sfstdout,SF_SHARE,0);
}
-#else
+#else /* USE_SFIO */
/* Implement all the PerlIO interface using stdio.
- this should be only file to include <stdio.h>
#undef PerlIO_stderr
PerlIO *
-PerlIO_stderr()
+PerlIO_stderr(void)
{
return (PerlIO *) stderr;
}
#undef PerlIO_stdin
PerlIO *
-PerlIO_stdin()
+PerlIO_stdin(void)
{
return (PerlIO *) stdin;
}
#undef PerlIO_stdout
PerlIO *
-PerlIO_stdout()
+PerlIO_stdout(void)
{
return (PerlIO *) stdout;
}
-#ifdef HAS_SETLINEBUF
-extern void setlinebuf _((FILE *iop));
-#endif
-
#undef PerlIO_fast_gets
int
-PerlIO_fast_gets(f)
-PerlIO *f;
+PerlIO_fast_gets(PerlIO *f)
{
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
return 1;
#undef PerlIO_has_cntptr
int
-PerlIO_has_cntptr(f)
-PerlIO *f;
+PerlIO_has_cntptr(PerlIO *f)
{
#if defined(USE_STDIO_PTR)
return 1;
#undef PerlIO_canset_cnt
int
-PerlIO_canset_cnt(f)
-PerlIO *f;
+PerlIO_canset_cnt(PerlIO *f)
{
#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
return 1;
#undef PerlIO_set_cnt
void
-PerlIO_set_cnt(f,cnt)
-PerlIO *f;
-int cnt;
+PerlIO_set_cnt(PerlIO *f, int cnt)
{
- if (cnt < 0)
- warn("Setting cnt to %d\n",cnt);
+ dTHX;
+ if (cnt < -1 && ckWARN_d(WARN_INTERNAL))
+ Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d\n",cnt);
#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
FILE_cnt(f) = cnt;
#else
- croak("Cannot set 'cnt' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
#endif
}
#undef PerlIO_set_ptrcnt
void
-PerlIO_set_ptrcnt(f,ptr,cnt)
-PerlIO *f;
-char *ptr;
-int cnt;
+PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
{
+ dTHX;
#ifdef FILE_bufsiz
- char *e = (char *)(FILE_base(f) + FILE_bufsiz(f));
- int ec = e - ptr;
- if (ptr > e)
- warn("Setting ptr %p > base %p\n",ptr, FILE_base(f)+FILE_bufsiz(f));
- if (cnt != ec)
- warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
+ STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
+ int ec = e - ptr;
+ if (ptr > e + 1 && ckWARN_d(WARN_INTERNAL))
+ Perl_warner(aTHX_ WARN_INTERNAL, "Setting ptr %p > end+1 %p\n", ptr, e + 1);
+ if (cnt != ec && ckWARN_d(WARN_INTERNAL))
+ Perl_warner(aTHX_ WARN_INTERNAL, "Setting cnt to %d, ptr implies %d\n",cnt,ec);
#endif
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
- FILE_ptr(f) = (STDCHAR *) ptr;
+ FILE_ptr(f) = ptr;
#else
- croak("Cannot set 'ptr' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot set 'ptr' of FILE * on this system");
#endif
#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
- FILE_cnt(f) = cnt;
+ FILE_cnt(f) = cnt;
#else
- croak("Cannot set 'cnt' of FILE * on this system");
+ Perl_croak(aTHX_ "Cannot set 'cnt' of FILE * on this system");
#endif
}
#undef PerlIO_get_cnt
int
-PerlIO_get_cnt(f)
-PerlIO *f;
+PerlIO_get_cnt(PerlIO *f)
{
#ifdef FILE_cnt
return FILE_cnt(f);
#else
- croak("Cannot get 'cnt' of FILE * on this system");
+ dTHX;
+ Perl_croak(aTHX_ "Cannot get 'cnt' of FILE * on this system");
return -1;
#endif
}
#undef PerlIO_get_bufsiz
int
-PerlIO_get_bufsiz(f)
-PerlIO *f;
+PerlIO_get_bufsiz(PerlIO *f)
{
#ifdef FILE_bufsiz
return FILE_bufsiz(f);
#else
- croak("Cannot get 'bufsiz' of FILE * on this system");
+ dTHX;
+ Perl_croak(aTHX_ "Cannot get 'bufsiz' of FILE * on this system");
return -1;
#endif
}
#undef PerlIO_get_ptr
-char *
-PerlIO_get_ptr(f)
-PerlIO *f;
+STDCHAR *
+PerlIO_get_ptr(PerlIO *f)
{
#ifdef FILE_ptr
- return (char *) FILE_ptr(f);
+ return FILE_ptr(f);
#else
- croak("Cannot get 'ptr' of FILE * on this system");
+ dTHX;
+ Perl_croak(aTHX_ "Cannot get 'ptr' of FILE * on this system");
return NULL;
#endif
}
#undef PerlIO_get_base
-char *
-PerlIO_get_base(f)
-PerlIO *f;
+STDCHAR *
+PerlIO_get_base(PerlIO *f)
{
#ifdef FILE_base
- return (char *) FILE_base(f);
+ return FILE_base(f);
#else
- croak("Cannot get 'base' of FILE * on this system");
+ dTHX;
+ Perl_croak(aTHX_ "Cannot get 'base' of FILE * on this system");
return NULL;
#endif
}
#undef PerlIO_has_base
int
-PerlIO_has_base(f)
-PerlIO *f;
+PerlIO_has_base(PerlIO *f)
{
#ifdef FILE_base
return 1;
#undef PerlIO_puts
int
-PerlIO_puts(f,s)
-PerlIO *f;
-const char *s;
+PerlIO_puts(PerlIO *f, const char *s)
{
return fputs(s,f);
}
#undef PerlIO_open
PerlIO *
-PerlIO_open(path,mode)
-const char *path;
-const char *mode;
+PerlIO_open(const char *path, const char *mode)
{
return fopen(path,mode);
}
#undef PerlIO_fdopen
PerlIO *
-PerlIO_fdopen(fd,mode)
-int fd;
-const char *mode;
+PerlIO_fdopen(int fd, const char *mode)
{
return fdopen(fd,mode);
}
+#undef PerlIO_reopen
+PerlIO *
+PerlIO_reopen(const char *name, const char *mode, PerlIO *f)
+{
+ return freopen(name,mode,f);
+}
#undef PerlIO_close
int
-PerlIO_close(f)
-PerlIO *f;
+PerlIO_close(PerlIO *f)
{
return fclose(f);
}
#undef PerlIO_eof
int
-PerlIO_eof(f)
-PerlIO *f;
+PerlIO_eof(PerlIO *f)
{
return feof(f);
}
+#undef PerlIO_getname
+char *
+PerlIO_getname(PerlIO *f, char *buf)
+{
+#ifdef VMS
+ return fgetname(f,buf);
+#else
+ dTHX;
+ Perl_croak(aTHX_ "Don't know how to get file name");
+ return NULL;
+#endif
+}
+
#undef PerlIO_getc
int
-PerlIO_getc(f)
-PerlIO *f;
+PerlIO_getc(PerlIO *f)
{
return fgetc(f);
}
#undef PerlIO_error
int
-PerlIO_error(f)
-PerlIO *f;
+PerlIO_error(PerlIO *f)
{
return ferror(f);
}
#undef PerlIO_clearerr
void
-PerlIO_clearerr(f)
-PerlIO *f;
+PerlIO_clearerr(PerlIO *f)
{
clearerr(f);
}
#undef PerlIO_flush
int
-PerlIO_flush(f)
-PerlIO *f;
+PerlIO_flush(PerlIO *f)
{
return Fflush(f);
}
#undef PerlIO_fileno
int
-PerlIO_fileno(f)
-PerlIO *f;
+PerlIO_fileno(PerlIO *f)
{
return fileno(f);
}
#undef PerlIO_setlinebuf
void
-PerlIO_setlinebuf(f)
-PerlIO *f;
+PerlIO_setlinebuf(PerlIO *f)
{
#ifdef HAS_SETLINEBUF
setlinebuf(f);
#else
+# ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
+ setvbuf(f, Nullch, _IOLBF, BUFSIZ);
+# else
setvbuf(f, Nullch, _IOLBF, 0);
+# endif
#endif
}
#undef PerlIO_putc
int
-PerlIO_putc(f,ch)
-PerlIO *f;
-int ch;
+PerlIO_putc(PerlIO *f, int ch)
{
- putc(ch,f);
+ return putc(ch,f);
}
#undef PerlIO_ungetc
int
-PerlIO_ungetc(f,ch)
-PerlIO *f;
-int ch;
+PerlIO_ungetc(PerlIO *f, int ch)
{
- ungetc(ch,f);
+ return ungetc(ch,f);
}
#undef PerlIO_read
-int
-PerlIO_read(f,buf,count)
-PerlIO *f;
-void *buf;
-size_t count;
+SSize_t
+PerlIO_read(PerlIO *f, void *buf, Size_t count)
{
return fread(buf,1,count,f);
}
#undef PerlIO_write
-int
-PerlIO_write(f,buf,count)
-PerlIO *f;
-const void *buf;
-size_t count;
+SSize_t
+PerlIO_write(PerlIO *f, const void *buf, Size_t count)
{
return fwrite1(buf,1,count,f);
}
#undef PerlIO_vprintf
int
-PerlIO_vprintf(f,fmt,ap)
-PerlIO *f;
-const char *fmt;
-va_list ap;
+PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
{
return vfprintf(f,fmt,ap);
}
-
#undef PerlIO_tell
-long
-PerlIO_tell(f)
-PerlIO *f;
+Off_t
+PerlIO_tell(PerlIO *f)
{
+#if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64)
+ return ftello(f);
+#else
return ftell(f);
+#endif
}
#undef PerlIO_seek
int
-PerlIO_seek(f,offset,whence)
-PerlIO *f;
-off_t offset;
-int whence;
+PerlIO_seek(PerlIO *f, Off_t offset, int whence)
{
+#if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64)
+ return fseeko(f,offset,whence);
+#else
return fseek(f,offset,whence);
+#endif
}
#undef PerlIO_rewind
void
-PerlIO_rewind(f)
-PerlIO *f;
+PerlIO_rewind(PerlIO *f)
{
rewind(f);
}
#undef PerlIO_printf
int
-#ifdef I_STDARG
PerlIO_printf(PerlIO *f,const char *fmt,...)
-#else
-PerlIO_printf(f,fmt,va_alist)
-PerlIO *f;
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = vfprintf(f,fmt,ap);
va_end(ap);
return result;
#undef PerlIO_stdoutf
int
-#ifdef I_STDARG
PerlIO_stdoutf(const char *fmt,...)
-#else
-PerlIO_stdoutf(fmt, va_alist)
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
va_end(ap);
return result;
#undef PerlIO_tmpfile
PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(void)
{
return tmpfile();
}
#undef PerlIO_importFILE
PerlIO *
-PerlIO_importFILE(f,fl)
-FILE *f;
-int fl;
+PerlIO_importFILE(FILE *f, int fl)
{
return f;
}
#undef PerlIO_exportFILE
FILE *
-PerlIO_exportFILE(f,fl)
-PerlIO *f;
-int fl;
+PerlIO_exportFILE(PerlIO *f, int fl)
{
return f;
}
#undef PerlIO_findFILE
FILE *
-PerlIO_findFILE(f)
-PerlIO *f;
+PerlIO_findFILE(PerlIO *f)
{
return f;
}
#undef PerlIO_releaseFILE
void
-PerlIO_releaseFILE(p,f)
-PerlIO *p;
-FILE *f;
+PerlIO_releaseFILE(PerlIO *p, FILE *f)
{
}
void
-PerlIO_init()
+PerlIO_init(void)
{
/* Does nothing (yet) except force this file to be included
in perl binary. That allows this file to force inclusion
#ifndef HAS_FSETPOS
#undef PerlIO_setpos
int
-PerlIO_setpos(f,pos)
-PerlIO *f;
-const Fpos_t *pos;
+PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
{
return PerlIO_seek(f,*pos,0);
}
+#else
+#ifndef PERLIO_IS_STDIO
+#undef PerlIO_setpos
+int
+PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
+{
+#if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
+ return fsetpos64(f, pos);
+#else
+ return fsetpos(f, pos);
+#endif
+}
+#endif
#endif
#ifndef HAS_FGETPOS
#undef PerlIO_getpos
int
-PerlIO_getpos(f,pos)
-PerlIO *f;
-Fpos_t *pos;
+PerlIO_getpos(PerlIO *f, Fpos_t *pos)
{
*pos = PerlIO_tell(f);
return 0;
}
+#else
+#ifndef PERLIO_IS_STDIO
+#undef PerlIO_getpos
+int
+PerlIO_getpos(PerlIO *f, Fpos_t *pos)
+{
+#if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
+ return fgetpos64(f, pos);
+#else
+ return fgetpos(f, pos);
+#endif
+}
+#endif
#endif
#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
int
-vprintf(fd, pat, args)
-FILE *fd;
-char *pat, *args;
+vprintf(char *pat, char *args)
+{
+ _doprnt(pat, args, stdout);
+ return 0; /* wrong, but perl doesn't use the return value */
+}
+
+int
+vfprintf(FILE *fd, char *pat, char *args)
{
_doprnt(pat, args, fd);
return 0; /* wrong, but perl doesn't use the return value */
#ifndef PerlIO_vsprintf
int
-PerlIO_vsprintf(s,n,fmt,ap)
-char *s;
-const char *fmt;
-int n;
-va_list ap;
+PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
{
int val = vsprintf(s, fmt, ap);
if (n >= 0)
{
- if (strlen(s) >= n)
+ if (strlen(s) >= (STRLEN)n)
{
- PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
+ dTHX;
+ PerlIO_puts(Perl_error_log,"panic: sprintf overflow - memory corrupted!\n");
my_exit(1);
}
}
#ifndef PerlIO_sprintf
int
-#ifdef I_STDARG
PerlIO_sprintf(char *s, int n, const char *fmt,...)
-#else
-PerlIO_sprintf(s, n, fmt, va_alist)
-char *s;
-int n;
-const char *fmt;
-va_dcl
-#endif
{
va_list ap;
int result;
-#ifdef I_STDARG
va_start(ap,fmt);
-#else
- va_start(ap);
-#endif
result = PerlIO_vsprintf(s, n, fmt, ap);
va_end(ap);
return result;
}
#endif
+#endif /* !PERL_IMPLICIT_SYS */
+
https://perl5.git.perl.org / perl5.git / blobdiff