X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=969b8d1c6d24062beaf2c00e72cab59972d9c283;hb=a6c71b5b9462db13c7bb2cd263cee5995315784c;hp=e1f4353a9b00a4fa3f41a97865a5aad690cc2a3b;hpb=4eb8286e4c6ac94fdae21a64c54a936bc836983e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index e1f4353..969b8d1 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1,14 +1,19 @@
 /*    perlio.c
  *
- *    Copyright (c) 1996-1999, 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"
+#ifdef PERL_MICRO
+#   include "uconfig.h"
+#else
+#   include "config.h"
+#endif
 
 #define PERLIO_NOT_STDIO 0 
 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
@@ -21,8 +26,11 @@
  */
 
 #include "EXTERN.h"
+#define PERL_IN_PERLIO_C
 #include "perl.h"
 
+#if !defined(PERL_IMPLICIT_SYS)
+
 #ifdef PERLIO_IS_STDIO 
 
 void
@@ -140,12 +148,13 @@ PerlIO_canset_cnt(PerlIO *f)
 void
 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
 }
 
@@ -153,23 +162,28 @@ PerlIO_set_cnt(PerlIO *f, int cnt)
 void
 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;
+#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE) && defined (STDIO_PTR_LVAL_NOCHANGE_CNT)
+  FILE_cnt(f) = cnt;
+#else
+#if defined(STDIO_PTR_LVAL_SETS_CNT)
+  assert (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 when setting 'ptr'");
+#endif
 #endif
 }
 
@@ -180,7 +194,8 @@ 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
 }
@@ -192,7 +207,8 @@ 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
 }
@@ -204,7 +220,8 @@ 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
 }
@@ -216,7 +233,8 @@ 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
 }
@@ -281,7 +299,8 @@ 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
 }
@@ -375,7 +394,7 @@ PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
 Off_t
 PerlIO_tell(PerlIO *f)
 {
-#ifdef HAS_FTELLO
+#if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64)
  return ftello(f);
 #else
  return ftell(f);
@@ -386,7 +405,7 @@ PerlIO_tell(PerlIO *f)
 int
 PerlIO_seek(PerlIO *f, Off_t offset, int whence)
 {
-#ifdef HAS_FSEEKO
+#if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64)
  return fseeko(f,offset,whence);
 #else
  return fseek(f,offset,whence);
@@ -484,7 +503,11 @@ PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
 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
@@ -503,7 +526,11 @@ PerlIO_getpos(PerlIO *f, Fpos_t *pos)
 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
@@ -535,7 +562,8 @@ PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
   {
    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);
     }
   }
@@ -556,3 +584,5 @@ PerlIO_sprintf(char *s, int n, const char *fmt,...)
 }
 #endif
 
+#endif /* !PERL_IMPLICIT_SYS */
+