This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PERL_BADLANG wrongly documented.
[perl5.git] / perlio.c
index b9a3a22..a1af870 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -16,7 +16,7 @@
 #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 
  */
 
@@ -26,7 +26,7 @@
 #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 +37,7 @@ PerlIO_init()
 
 #undef PerlIO_tmpfile
 PerlIO *
-PerlIO_tmpfile()
+PerlIO_tmpfile(void)
 {
  return tmpfile();
 }
@@ -76,7 +76,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>
@@ -145,7 +145,7 @@ PerlIO_set_cnt(f,cnt)
 PerlIO *f;
 int cnt;
 {
- if (cnt < 0)
+ if (cnt < -1)
   warn("Setting cnt to %d\n",cnt);
 #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
  FILE_cnt(f) = cnt;
@@ -158,19 +158,19 @@ int cnt;
 void
 PerlIO_set_ptrcnt(f,ptr,cnt)
 PerlIO *f;
-char *ptr;
+STDCHAR *ptr;
 int cnt;
 {
 #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));
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);
 #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");
 #endif
@@ -208,12 +208,12 @@ PerlIO *f;
 }
 
 #undef PerlIO_get_ptr
-char *
+STDCHAR *
 PerlIO_get_ptr(f)
 PerlIO *f;
 {
 #ifdef FILE_ptr
- return (char *) FILE_ptr(f);
+ return FILE_ptr(f);
 #else
  croak("Cannot get 'ptr' of FILE * on this system");
  return NULL;
@@ -221,12 +221,12 @@ PerlIO *f;
 }
 
 #undef PerlIO_get_base
-char *
+STDCHAR *
 PerlIO_get_base(f)
 PerlIO *f;
 {
 #ifdef FILE_base
- return (char *) FILE_base(f);
+ return FILE_base(f);
 #else
  croak("Cannot get 'base' of FILE * on this system");
  return NULL;
@@ -274,11 +274,10 @@ const char *mode;
 
 #undef PerlIO_reopen
 PerlIO * 
-PerlIO_reopen(fd,mode)
-char *name;
-char *mode;
-PerlIO *f;
+PerlIO_reopen(name, mode, f)
+const char *name;
 const char *mode;
+PerlIO *f;
 {
  return freopen(name,mode,f);
 }
@@ -309,6 +308,7 @@ char *buf;
  return fgetname(f,buf);
 #else
  croak("Don't know how to get file name");
+ return NULL;
 #endif
 }
 
@@ -360,7 +360,11 @@ 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
 }
 
@@ -370,7 +374,7 @@ PerlIO_putc(f,ch)
 PerlIO *f;
 int ch;
 {
- putc(ch,f);
return putc(ch,f);
 }
 
 #undef PerlIO_ungetc
@@ -379,25 +383,25 @@ PerlIO_ungetc(f,ch)
 PerlIO *f;
 int ch;
 {
- ungetc(ch,f);
return ungetc(ch,f);
 }
 
 #undef PerlIO_read
-int      
+SSize_t
 PerlIO_read(f,buf,count)
 PerlIO *f;
 void *buf;
-size_t count;
+Size_t count;
 {
  return fread(buf,1,count,f);
 }
 
 #undef PerlIO_write
-int      
+SSize_t
 PerlIO_write(f,buf,count)
 PerlIO *f;
 const void *buf;
-size_t count;
+Size_t count;
 {
  return fwrite1(buf,1,count,f);
 }
@@ -412,23 +416,30 @@ va_list ap;
  return vfprintf(f,fmt,ap);
 }
 
-
 #undef PerlIO_tell
-long
+Off_t
 PerlIO_tell(f)
 PerlIO *f;
 {
+#ifdef HAS_FTELLO
+ return ftello(f);
+#else
  return ftell(f);
+#endif
 }
 
 #undef PerlIO_seek
 int
 PerlIO_seek(f,offset,whence)
 PerlIO *f;
-off_t offset;
+Off_t offset;
 int whence;
 {
+#ifdef HAS_FSEEKO
+ return fseeko(f,offset,whence);
+#else
  return fseek(f,offset,whence);
+#endif
 }
 
 #undef PerlIO_rewind
@@ -441,22 +452,11 @@ PerlIO *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;
@@ -464,21 +464,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;
@@ -586,7 +576,15 @@ Fpos_t *pos;
 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
 
 int
-vprintf(fd, pat, args)
+vprintf(pat, args)
+char *pat, *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;
 {
@@ -598,11 +596,7 @@ 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)
@@ -619,23 +613,11 @@ 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;