This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate perlio:
authorJarkko Hietaniemi <jhi@iki.fi>
Tue, 14 Nov 2000 17:54:56 +0000 (17:54 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Tue, 14 Nov 2000 17:54:56 +0000 (17:54 +0000)
[  7684]
PerlIO #include and #ifdef re-work.

p4raw-link: @7684 on //depot/perlio: 76ced9add7b621dfc9d4ecb534aeea8e131a418a

p4raw-id: //depot/perl@7685

1  2 
MANIFEST
perlio.c

diff --combined MANIFEST
+++ b/MANIFEST
@@@ -437,12 -437,12 +437,13 @@@ ext/attrs/attrs.xs      attrs extension exte
  ext/re/Makefile.PL    re extension makefile writer
  ext/re/hints/aix.pl   Hints for re for named architecture
  ext/re/hints/mpeix.pl Hints for re for named architecture
 +ext/re/hints/MSWin32.pl       Hints for re for named architecture
  ext/re/re.pm          re extension Perl module
  ext/re/re.xs          re extension external subroutines
  ext/util/make_ext     Used by Makefile to execute extension Makefiles
  ext/util/mkbootstrap  Turns ext/*/*_BS into bootstrap info
  fakethr.h             Fake threads header
+ fakesdio.h            stdio in terms of PerlIO
  form.h                        Public declarations for the above
  global.sym            Symbols that need hiding when embedded
  globals.c             File to declare global symbols (for shared library)
@@@ -1148,7 -1148,8 +1149,8 @@@ perl.h                  Global declaration
  perlapi.c             Perl API functions
  perlapi.h             Perl API function declarations
  perlio.c              C code for PerlIO abstraction
- perlio.h              compatibility stub
+ perlio.h              PerlIO abstraction
+ perliol.h             PerlIO Layer definition
  perlio.sym            Symbols for PerlIO abstraction
  perlsdio.h            Fake stdio using perlio
  perlsfio.h            Prototype sfio mapping for PerlIO
@@@ -1723,7 -1724,6 +1725,7 @@@ warnings.h              The warning number
  warnings.pl           Program to write warnings.h and lib/warnings.pm
  win32/Makefile                Win32 makefile for NMAKE (Visual C++ build)
  win32/bin/exetype.pl  Set executable type to CONSOLE or WINDOWS
 +win32/bin/mdelete.bat multifile delete
  win32/bin/perlglob.pl Win32 globbing
  win32/bin/pl2bat.pl   wrap perl scripts into batch files
  win32/bin/runperl.pl  run perl script via batch file namesake
diff --combined perlio.c
+++ b/perlio.c
@@@ -88,6 -88,8 +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>
  
  #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,...)
   static int dbg = 0;
   if (!dbg)
    {
 -   char *s = getenv("PERLIO_DEBUG");
 +   char *s = PerlEnv_getenv("PERLIO_DEBUG");
     if (s && *s)
 -    dbg = open(s,O_WRONLY|O_CREAT|O_APPEND,0666);
 +    dbg = PerlLIO_open3(s,O_WRONLY|O_CREAT|O_APPEND,0666);
     else
      dbg = -1;
    }
     Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
  
     s = SvPV(sv,len);
 -   write(dbg,s,len);
 +   PerlLIO_write(dbg,s,len);
     va_end(ap);
     SvREFCNT_dec(sv);
    }
  
  /*--------------------------------------------------------------------------------------*/
  
- 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 +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;
@@@ -354,7 -284,7 +284,7 @@@ PerlIO_default_layer(I32 n
   int len;
   if (!PerlIO_layer_hv)
    {
 -   char *s  = getenv("PERLIO");
 +   char *s  = PerlEnv_getenv("PERLIO");
     newXS("perlio::import",XS_perlio_import,__FILE__);
     newXS("perlio::unimport",XS_perlio_unimport,__FILE__);
     PerlIO_layer_hv = get_hv("perlio::layers",GV_ADD|GV_ADDMULTI);
      {
       while (*s)
        {
 -       while (*s && isspace((unsigned char)*s))
 +       while (*s && isSPACE((unsigned char)*s))
          s++;
         if (*s)
          {
           char *e = s;
           SV *layer;
 -         while (*e && !isspace((unsigned char)*e))
 +         while (*e && !isSPACE((unsigned char)*e))
            e++;
           layer = PerlIO_find_layer(s,e-s);
           if (layer)
@@@ -430,6 -360,26 +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 +400,6 @@@ PerlIO_open(const char *path, const cha
   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 +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 +748,6 @@@ PerlIOBase_setlinebuf(PerlIO *f
  
  }
  
  /*--------------------------------------------------------------------------------------*/
  /* Bottom-most level for UNIX-like case */
  
@@@ -902,7 -836,7 +836,7 @@@ PerlIOUnix_open(PerlIO_funcs *self, con
   int oflags = PerlIOUnix_oflags(mode);
   if (oflags != -1)
    {
 -   int fd = open(path,oflags,0666);
 +   int fd = PerlLIO_open3(path,oflags,0666);
     if (fd >= 0)
      {
       PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix);
@@@ -923,7 -857,7 +857,7 @@@ PerlIOUnix_reopen(const char *path, con
    (*PerlIOBase(f)->tab->Close)(f);
   if (oflags != -1)
    {
 -   int fd = open(path,oflags,0666);
 +   int fd = PerlLIO_open3(path,oflags,0666);
     if (fd >= 0)
      {
       s->fd = fd;
@@@ -943,7 -877,7 +877,7 @@@ PerlIOUnix_read(PerlIO *f, void *vbuf, 
    return 0;
   while (1)
    {
 -   SSize_t len = read(fd,vbuf,count);
 +   SSize_t len = PerlLIO_read(fd,vbuf,count);
     if (len >= 0 || errno != EINTR)
      {
       if (len < 0)
@@@ -961,7 -895,7 +895,7 @@@ PerlIOUnix_write(PerlIO *f, const void 
   int fd = PerlIOSelf(f,PerlIOUnix)->fd;
   while (1)
    {
 -   SSize_t len = write(fd,vbuf,count);
 +   SSize_t len = PerlLIO_write(fd,vbuf,count);
     if (len >= 0 || errno != EINTR)
      {
       if (len < 0)
  IV
  PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
  {
 - Off_t new = lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence);
 + Off_t new = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence);
   PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
   return (new == (Off_t) -1) ? -1 : 0;
  }
  Off_t
  PerlIOUnix_tell(PerlIO *f)
  {
 - return lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
 + return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
  }
  
  IV
@@@ -990,7 -924,7 +924,7 @@@ PerlIOUnix_close(PerlIO *f
  {
   int fd = PerlIOSelf(f,PerlIOUnix)->fd;
   int code = 0;
 - while (close(fd) != 0)
 + while (PerlLIO_close(fd) != 0)
    {
     if (errno != EINTR)
      {
@@@ -1021,8 -955,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,
  /*--------------------------------------------------------------------------------------*/
  /* 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 +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)
  {
   return f;
  }
  
  PerlIO *
  PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
  {
@@@ -1700,17 -1612,6 +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 +2012,6 @@@ PerlIO_funcs PerlIO_mmap = 
  
  #endif /* HAS_MMAP */
  
  void
  PerlIO_init(void)
  {
@@@ -2269,7 -2168,7 +2168,7 @@@ PerlIO_tmpfile(void
      {
       PerlIOBase(f)->flags |= PERLIO_F_TEMP;
      }
 -   unlink(SvPVX(sv));
 +   PerlLIO_unlink(SvPVX(sv));
     SvREFCNT_dec(sv);
    }
   return f;