X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/5b54f415353cb889898fb25391f5dff73990f3f2..a4b82a6f432d8ee296977d1ecd6955ece52324d0:/perlio.c

diff --git a/perlio.c b/perlio.c
index 0a0625c..6945a75 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1,12 +1,13 @@
 /*    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"
 
@@ -16,17 +17,20 @@
 #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
@@ -37,7 +41,7 @@ PerlIO_init()
 
 #undef PerlIO_tmpfile
 PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(void)
 {
  return tmpfile();
 }
@@ -55,13 +59,13 @@ PerlIO_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 
@@ -76,7 +80,7 @@ PerlIO_init()
  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>
@@ -84,29 +88,28 @@ PerlIO_init()
 
 #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;
 }
 
 #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;
@@ -117,8 +120,7 @@ PerlIO *f;
 
 #undef PerlIO_has_cntptr
 int 
-PerlIO_has_cntptr(f)
-PerlIO *f;
+PerlIO_has_cntptr(PerlIO *f)
 {
 #if defined(USE_STDIO_PTR)
  return 1;
@@ -129,8 +131,7 @@ PerlIO *f;
 
 #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;
@@ -141,102 +142,98 @@ PerlIO *f;
 
 #undef PerlIO_set_cnt
 void
-PerlIO_set_cnt(f,cnt)
-PerlIO *f;
-int cnt;
+PerlIO_set_cnt(PerlIO *f, int cnt)
 {
- if (cnt < -1)
-  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;
-STDCHAR *ptr;
-int cnt;
+PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
 {
+ dTHX;
 #ifdef FILE_bufsiz
  STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
  int ec = e - ptr;
- if (ptr > e + 1)
-  warn("Setting ptr %p > end+1 %p\n", ptr, e + 1);
- if (cnt != ec)
-  warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
+ 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) = 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
 STDCHAR *
-PerlIO_get_ptr(f)
-PerlIO *f;
+PerlIO_get_ptr(PerlIO *f)
 {
 #ifdef FILE_ptr
  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
 STDCHAR *
-PerlIO_get_base(f)
-PerlIO *f;
+PerlIO_get_base(PerlIO *f)
 {
 #ifdef FILE_base
  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;
@@ -247,215 +244,180 @@ PerlIO *f;
 
 #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(name, mode, f)
-const char *name;
-const char *mode;
-PerlIO *f;
+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(f,buf)
-PerlIO *f;
-char *buf;
+PerlIO_getname(PerlIO *f, char *buf)
 {
 #ifdef VMS
  return fgetname(f,buf);
 #else
- croak("Don't know how to get file name");
+ 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
 SSize_t
-PerlIO_read(f,buf,count)
-PerlIO *f;
-void *buf;
-Size_t count;
+PerlIO_read(PerlIO *f, void *buf, Size_t count)
 {
  return fread(buf,1,count,f);
 }
 
 #undef PerlIO_write
 SSize_t
-PerlIO_write(f,buf,count)
-PerlIO *f;
-const void *buf;
-Size_t count;
+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;
@@ -463,21 +425,11 @@ va_dcl
 
 #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;
@@ -485,47 +437,40 @@ va_dcl
 
 #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
@@ -540,9 +485,7 @@ PerlIO_init()
 #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); 
 }
@@ -550,11 +493,13 @@ const Fpos_t *pos;
 #ifndef PERLIO_IS_STDIO
 #undef PerlIO_setpos
 int
-PerlIO_setpos(f,pos)
-PerlIO *f;
-const Fpos_t *pos;
+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
@@ -562,9 +507,7 @@ const Fpos_t *pos;
 #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;
@@ -573,11 +516,13 @@ Fpos_t *pos;
 #ifndef PERLIO_IS_STDIO
 #undef PerlIO_getpos
 int
-PerlIO_getpos(f,pos)
-PerlIO *f;
-Fpos_t *pos;
+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
@@ -585,17 +530,14 @@ Fpos_t *pos;
 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
 
 int
-vprintf(pat, args)
-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(fd, pat, args)
-FILE *fd;
-char *pat, *args;
+vfprintf(FILE *fd, char *pat, char *args)
 {
     _doprnt(pat, args, fd);
     return 0;		/* wrong, but perl doesn't use the return value */
@@ -605,18 +547,15 @@ char *pat, *args;
 
 #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) >= (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);
     }
   }
@@ -626,26 +565,16 @@ va_list ap;
 
 #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 */
+