This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PerlIO #include and #ifdef re-work.
[perl5.git] / perlio.c
index 8d54f77..7dc895c 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -88,6 +88,8 @@ PerlIO_init(void)
 /* Implement all the PerlIO interface ourselves.
  */
 
+#include "perliol.h"
+
 /* We _MUST_ have <unistd.h> if we are using lseek() and may have large files */
 #ifdef I_UNISTD
 #include <unistd.h>
@@ -98,8 +100,7 @@ PerlIO_init(void)
 
 #include "XSUB.h"
 
-#undef printf
-void PerlIO_debug(char *fmt,...) __attribute__((format(printf,1,2)));
+void PerlIO_debug(char *fmt,...) __attribute__((format(__printf__,1,2)));
 
 void
 PerlIO_debug(char *fmt,...)
@@ -136,69 +137,6 @@ PerlIO_debug(char *fmt,...)
 
 /*--------------------------------------------------------------------------------------*/
 
-typedef struct _PerlIO_funcs PerlIO_funcs;
-struct _PerlIO_funcs
-{
- char *                name;
- Size_t                size;
- IV            kind;
- IV            (*Fileno)(PerlIO *f);
- PerlIO *      (*Fdopen)(PerlIO_funcs *tab, int fd, const char *mode);
- PerlIO *      (*Open)(PerlIO_funcs *tab, const char *path, const char *mode);
- int           (*Reopen)(const char *path, const char *mode, PerlIO *f);
- IV            (*Pushed)(PerlIO *f,const char *mode);
- IV            (*Popped)(PerlIO *f);
- /* Unix-like functions - cf sfio line disciplines */
- SSize_t       (*Read)(PerlIO *f, void *vbuf, Size_t count);
- SSize_t       (*Unread)(PerlIO *f, const void *vbuf, Size_t count);
- SSize_t       (*Write)(PerlIO *f, const void *vbuf, Size_t count);
- IV            (*Seek)(PerlIO *f, Off_t offset, int whence);
- Off_t         (*Tell)(PerlIO *f);
- IV            (*Close)(PerlIO *f);
- /* Stdio-like buffered IO functions */
- IV            (*Flush)(PerlIO *f);
- IV            (*Fill)(PerlIO *f);
- IV            (*Eof)(PerlIO *f);
- IV            (*Error)(PerlIO *f);
- void          (*Clearerr)(PerlIO *f);
- void          (*Setlinebuf)(PerlIO *f);
- /* Perl's snooping functions */
- STDCHAR *     (*Get_base)(PerlIO *f);
- Size_t                (*Get_bufsiz)(PerlIO *f);
- STDCHAR *     (*Get_ptr)(PerlIO *f);
- SSize_t       (*Get_cnt)(PerlIO *f);
- void          (*Set_ptrcnt)(PerlIO *f,STDCHAR *ptr,SSize_t cnt);
-};
-
-struct _PerlIO
-{
- PerlIOl *     next;       /* Lower layer */
- PerlIO_funcs *        tab;        /* Functions for this layer */
- IV            flags;      /* Various flags for state */
-};
-
-/*--------------------------------------------------------------------------------------*/
-
-/* Flag values */
-#define PERLIO_F_EOF           0x00010000
-#define PERLIO_F_CANWRITE      0x00020000
-#define PERLIO_F_CANREAD       0x00040000
-#define PERLIO_F_ERROR         0x00080000
-#define PERLIO_F_TRUNCATE      0x00100000
-#define PERLIO_F_APPEND                0x00200000
-#define PERLIO_F_BINARY                0x00400000
-#define PERLIO_F_UTF8          0x00800000
-#define PERLIO_F_LINEBUF       0x01000000
-#define PERLIO_F_WRBUF         0x02000000
-#define PERLIO_F_RDBUF         0x04000000
-#define PERLIO_F_TEMP          0x08000000
-#define PERLIO_F_OPEN          0x10000000
-
-#define PerlIOBase(f)      (*(f))
-#define PerlIOSelf(f,type) ((type *)PerlIOBase(f))
-#define PerlIONext(f)      (&(PerlIOBase(f)->next))
-
-/*--------------------------------------------------------------------------------------*/
 /* Inner level routines */
 
 /* Table of pointers to the PerlIO structs (malloc'ed) */
@@ -293,14 +231,6 @@ PerlIO_fileno(PerlIO *f)
  return (*PerlIOBase(f)->tab->Fileno)(f);
 }
 
-
-extern PerlIO_funcs PerlIO_unix;
-extern PerlIO_funcs PerlIO_perlio;
-extern PerlIO_funcs PerlIO_stdio;
-#ifdef HAS_MMAP
-extern PerlIO_funcs PerlIO_mmap;
-#endif
-
 XS(XS_perlio_import)
 {
  dXSARGS;
@@ -430,6 +360,26 @@ PerlIO_stdstreams()
   }
 }
 
+PerlIO *
+PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
+{
+ PerlIOl *l = NULL;
+ Newc('L',l,tab->size,char,PerlIOl);
+ if (l)
+  {
+   Zero(l,tab->size,char);
+   l->next = *f;
+   l->tab  = tab;
+   *f      = l;
+   if ((*l->tab->Pushed)(f,mode) != 0)
+    {
+     PerlIO_pop(f);
+     return NULL;
+    }
+  }
+ return f;
+}
+
 #undef PerlIO_fdopen
 PerlIO *
 PerlIO_fdopen(int fd, const char *mode)
@@ -450,57 +400,6 @@ PerlIO_open(const char *path, const char *mode)
  return (*tab->Open)(tab,path,mode);
 }
 
-IV
-PerlIOBase_pushed(PerlIO *f, const char *mode)
-{
- PerlIOl *l = PerlIOBase(f);
- l->flags  &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE|
-                PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY);
- if (mode)
-  {
-   switch (*mode++)
-    {
-     case 'r':
-      l->flags = PERLIO_F_CANREAD;
-      break;
-     case 'a':
-      l->flags = PERLIO_F_APPEND|PERLIO_F_CANWRITE;
-      break;
-     case 'w':
-      l->flags = PERLIO_F_TRUNCATE|PERLIO_F_CANWRITE;
-      break;
-     default:
-      errno = EINVAL;
-      return -1;
-    }
-   while (*mode)
-    {
-     switch (*mode++)
-      {
-       case '+':
-        l->flags |= PERLIO_F_CANREAD|PERLIO_F_CANWRITE;
-        break;
-       case 'b':
-        l->flags |= PERLIO_F_BINARY;
-        break;
-      default:
-       errno = EINVAL;
-       return -1;
-      }
-    }
-  }
- else
-  {
-   if (l->next)
-    {
-     l->flags |= l->next->flags &
-                 (PERLIO_F_CANREAD|PERLIO_F_CANWRITE|
-                   PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY);
-    }
-  }
- return 0;
-}
-
 #undef PerlIO_reopen
 PerlIO *
 PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
@@ -721,24 +620,61 @@ PerlIOBase_fileno(PerlIO *f)
  return PerlIO_fileno(PerlIONext(f));
 }
 
-PerlIO *
-PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
+IV
+PerlIOBase_pushed(PerlIO *f, const char *mode)
 {
- PerlIOl *l = NULL;
- Newc('L',l,tab->size,char,PerlIOl);
- if (l)
+ PerlIOl *l = PerlIOBase(f);
+ l->flags  &= ~(PERLIO_F_CANREAD|PERLIO_F_CANWRITE|
+                PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY);
+ if (mode)
   {
-   Zero(l,tab->size,char);
-   l->next = *f;
-   l->tab  = tab;
-   *f      = l;
-   if ((*l->tab->Pushed)(f,mode) != 0)
+   switch (*mode++)
     {
-     PerlIO_pop(f);
-     return NULL;
+     case 'r':
+      l->flags = PERLIO_F_CANREAD;
+      break;
+     case 'a':
+      l->flags = PERLIO_F_APPEND|PERLIO_F_CANWRITE;
+      break;
+     case 'w':
+      l->flags = PERLIO_F_TRUNCATE|PERLIO_F_CANWRITE;
+      break;
+     default:
+      errno = EINVAL;
+      return -1;
+    }
+   while (*mode)
+    {
+     switch (*mode++)
+      {
+       case '+':
+        l->flags |= PERLIO_F_CANREAD|PERLIO_F_CANWRITE;
+        break;
+       case 'b':
+        l->flags |= PERLIO_F_BINARY;
+        break;
+      default:
+       errno = EINVAL;
+       return -1;
+      }
     }
   }
- return f;
+ else
+  {
+   if (l->next)
+    {
+     l->flags |= l->next->flags &
+                 (PERLIO_F_CANREAD|PERLIO_F_CANWRITE|
+                   PERLIO_F_TRUNCATE|PERLIO_F_APPEND|PERLIO_F_BINARY);
+    }
+  }
+ return 0;
+}
+
+IV
+PerlIOBase_popped(PerlIO *f)
+{
+ return 0;
 }
 
 SSize_t
@@ -812,8 +748,6 @@ PerlIOBase_setlinebuf(PerlIO *f)
 
 }
 
-
-
 /*--------------------------------------------------------------------------------------*/
 /* Bottom-most level for UNIX-like case */
 
@@ -1021,8 +955,8 @@ PerlIO_funcs PerlIO_unix = {
  PerlIOUnix_seek,
  PerlIOUnix_tell,
  PerlIOUnix_close,
- PerlIOBase_noop_ok,
- PerlIOBase_noop_fail,
+ PerlIOBase_noop_ok,   /* flush */
+ PerlIOBase_noop_fail, /* fill */
  PerlIOBase_eof,
  PerlIOBase_error,
  PerlIOBase_clearerr,
@@ -1037,15 +971,6 @@ PerlIO_funcs PerlIO_unix = {
 /*--------------------------------------------------------------------------------------*/
 /* stdio as a layer */
 
-#if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64)
-#define fseek fseeko
-#endif
-
-#if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64)
-#define ftell ftello
-#endif
-
-
 typedef struct
 {
  struct _PerlIO        base;
@@ -1386,18 +1311,6 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
 /*--------------------------------------------------------------------------------------*/
 /* perlio buffer layer */
 
-typedef struct
-{
- struct _PerlIO base;
- Off_t         posn;       /* Offset of buf into the file */
- STDCHAR *     buf;        /* Start of buffer */
- STDCHAR *     end;        /* End of valid part of buffer */
- STDCHAR *     ptr;        /* Current position in buffer */
- Size_t                bufsiz;     /* Size of buffer */
- IV            oneword;    /* Emergency buffer */
-} PerlIOBuf;
-
-
 PerlIO *
 PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
 {
@@ -1422,7 +1335,6 @@ PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
  return f;
 }
 
-
 PerlIO *
 PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
 {
@@ -1700,17 +1612,6 @@ PerlIOBuf_setlinebuf(PerlIO *f)
   }
 }
 
-void
-PerlIOBuf_set_cnt(PerlIO *f, int cnt)
-{
- PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
- dTHX;
- if (!b->buf)
-  PerlIO_get_base(f);
- b->ptr = b->end - cnt;
- assert(b->ptr >= b->buf);
-}
-
 STDCHAR *
 PerlIOBuf_get_ptr(PerlIO *f)
 {
@@ -2111,8 +2012,6 @@ PerlIO_funcs PerlIO_mmap = {
 
 #endif /* HAS_MMAP */
 
-
-
 void
 PerlIO_init(void)
 {