X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=f269dcdb1ded38f14712c5cf98af40d36e56d73d;hb=1d64a758d60d7ded97c59c753fea85d3365ca0df;hp=2da92c24d763795c6b99bf1d0379d9cc59868715;hpb=760ac839baf413929cd31cc32ffd6dba6b781a81;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index 2da92c2..f269dcd 100644
--- a/perlio.c
+++ b/perlio.c
@@ -35,6 +35,13 @@ PerlIO_init()
  */
 }
 
+#undef PerlIO_tmpfile
+PerlIO *
+PerlIO_tmpfile()
+{
+ return tmpfile();
+}
+
 #else /* PERLIO_IS_STDIO */
 
 #ifdef USE_SFIO
@@ -96,10 +103,6 @@ PerlIO_stdout()
  return (PerlIO *) stdout;
 }
 
-#ifdef HAS_SETLINEBUF
-extern void setlinebuf _((FILE *iop));
-#endif
-
 #undef PerlIO_fast_gets
 int 
 PerlIO_fast_gets(f)
@@ -142,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;
@@ -155,17 +158,19 @@ int cnt;
 void
 PerlIO_set_ptrcnt(f,ptr,cnt)
 PerlIO *f;
-char *ptr;
+STDCHAR *ptr;
 int cnt;
 {
- 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));
+#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);
+#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
@@ -203,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;
@@ -216,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;
@@ -267,6 +272,15 @@ const char *mode;
  return fdopen(fd,mode);
 }
 
+#undef PerlIO_reopen
+PerlIO * 
+PerlIO_reopen(name, mode, f)
+const char *name;
+const char *mode;
+PerlIO *f;
+{
+ return freopen(name,mode,f);
+}
 
 #undef PerlIO_close
 int      
@@ -284,6 +298,20 @@ PerlIO *f;
  return feof(f);
 }
 
+#undef PerlIO_getname
+char *
+PerlIO_getname(f,buf)
+PerlIO *f;
+char *buf;
+{
+#ifdef VMS
+ return fgetname(f,buf);
+#else
+ croak("Don't know how to get file name");
+ return NULL;
+#endif
+}
+
 #undef PerlIO_getc
 int      
 PerlIO_getc(f)
@@ -332,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
 }
 
@@ -342,7 +374,7 @@ PerlIO_putc(f,ch)
 PerlIO *f;
 int ch;
 {
- putc(ch,f);
+ return putc(ch,f);
 }
 
 #undef PerlIO_ungetc
@@ -351,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);
 }
@@ -519,6 +551,17 @@ const Fpos_t *pos;
 {
  return PerlIO_seek(f,*pos,0); 
 }
+#else
+#ifndef PERLIO_IS_STDIO
+#undef PerlIO_setpos
+int
+PerlIO_setpos(f,pos)
+PerlIO *f;
+const Fpos_t *pos;
+{
+ return fsetpos(f, pos);
+}
+#endif
 #endif
 
 #ifndef HAS_FGETPOS
@@ -531,12 +574,31 @@ Fpos_t *pos;
  *pos = PerlIO_tell(f);
  return 0;
 }
+#else
+#ifndef PERLIO_IS_STDIO
+#undef PerlIO_getpos
+int
+PerlIO_getpos(f,pos)
+PerlIO *f;
+Fpos_t *pos;
+{
+ return fgetpos(f, pos);
+}
+#endif
 #endif
 
 #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;
 {
@@ -557,7 +619,7 @@ 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");
      my_exit(1);