Tru64, gcc -O3, datasize

[p5sagit/p5-mst-13.2.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 925920d..e645f84 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -214,7 +214,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
        return NULL;
     }
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
     }
 #endif
     return NULL;
@@ -337,12 +337,13 @@ PerlIO_init(pTHX)
     sfset(sfstdout, SF_SHARE, 0);
 }
 
+/* This is not the reverse of PerlIO_exportFILE(), PerlIO_releaseFILE() is. */
 PerlIO *
 PerlIO_importFILE(FILE *stdio, const char *mode)
 {
     int fd = fileno(stdio);
     if (!mode || !*mode) {
-       mmode = "r+";
+       mode = "r+";
     }
     return PerlIO_fdopen(fd, mode);
 }
@@ -480,7 +481,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
        return new;
     }
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return NULL;
     }
 }
@@ -811,7 +812,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                        Perl_warner(aTHX_ packWARN(WARN_LAYER),
                              "perlio: invalid separator character %c%c%c in layer specification list %s",
                              q, *s, q, s);
-                   SETERRNO(EINVAL, LIB$_INVARG);
+                   SETERRNO(EINVAL, LIB_INVARG);
                    return -1;
                }
                do {
@@ -915,6 +916,46 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def)
     return def;
 }
 
+IV
+PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+{
+    if (PerlIOValid(f)) {
+       PerlIO_flush(f);
+       PerlIO_pop(aTHX_ f);
+       return 0;
+    }
+    return -1;
+}
+
+PerlIO_funcs PerlIO_remove = {
+    sizeof(PerlIO_funcs),
+    "pop",
+    0,
+    PERLIO_K_DUMMY | PERLIO_K_UTF8,
+    PerlIOPop_pushed,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,                       /* flush */
+    NULL,                       /* fill */
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,                       /* get_base */
+    NULL,                       /* get_bufsiz */
+    NULL,                       /* get_ptr */
+    NULL,                       /* get_cnt */
+    NULL,                       /* set_ptrcnt */
+};
+
 PerlIO_list_t *
 PerlIO_default_layers(pTHX)
 {
@@ -937,6 +978,7 @@ PerlIO_default_layers(pTHX)
        PerlIO_define_layer(aTHX_ & PerlIO_mmap);
 #endif
        PerlIO_define_layer(aTHX_ & PerlIO_utf8);
+       PerlIO_define_layer(aTHX_ & PerlIO_remove);
        PerlIO_define_layer(aTHX_ & PerlIO_byte);
        PerlIO_list_push(aTHX_ PL_def_layerlist,
                         PerlIO_find_layer(aTHX_ osLayer->name, 0, 0),
@@ -1026,18 +1068,6 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
 }
 
 IV
-PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
-{
-    PerlIO_pop(aTHX_ f);
-    if (*f) {
-       PerlIO_flush(f);
-       PerlIO_pop(aTHX_ f);
-       return 0;
-    }
-    return -1;
-}
-
-IV
 PerlIOBase_binmode(pTHX_ PerlIO *f)
 {
    if (PerlIOValid(f)) {
@@ -1193,7 +1223,7 @@ PerlIO__close(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1217,7 +1247,7 @@ Perl_PerlIO_fileno(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Fileno) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1255,7 +1285,7 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
      * For any scalar type load the handler which is bundled with perl
      */
     if (SvTYPE(sv) < SVt_PVAV)
-       return PerlIO_find_layer(aTHX_ "Scalar", 6, 1);
+       return PerlIO_find_layer(aTHX_ "scalar", 6, 1);
 
     /*
      * For other types allow if layer is known but don't try and load it
@@ -1295,7 +1325,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
                incdef = 0;
            }
            /*
-            * Don't fail if handler cannot be found :Via(...) etc. may do
+            * Don't fail if handler cannot be found :via(...) etc. may do
             * something sensible else we will just stringfy and open
             * resulting string.
             */
@@ -1418,7 +1448,7 @@ Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Read) (aTHX_ f, vbuf, count);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1429,7 +1459,7 @@ Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Unread) (aTHX_ f, vbuf, count);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1440,7 +1470,7 @@ Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Write) (aTHX_ f, vbuf, count);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1451,7 +1481,7 @@ Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Seek) (aTHX_ f, offset, whence);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1462,7 +1492,7 @@ Perl_PerlIO_tell(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Tell) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1478,13 +1508,13 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f)
            }
            else {
                PerlIO_debug("Cannot flush f=%p :%s\n", (void*)f, tab->name);
-               SETERRNO(EBADF, SS$_IVCHAN);
+               SETERRNO(EBADF, SS_IVCHAN);
                return -1;
            }
        }
        else {
            PerlIO_debug("Cannot flush f=%p\n", (void*)f);
-           SETERRNO(EBADF, SS$_IVCHAN);
+           SETERRNO(EBADF, SS_IVCHAN);
            return -1;
        }
     }
@@ -1536,7 +1566,7 @@ Perl_PerlIO_fill(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Fill) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1547,7 +1577,7 @@ PerlIO_isutf8(PerlIO *f)
     if (PerlIOValid(f))
        return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1558,7 +1588,7 @@ Perl_PerlIO_eof(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Eof) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1569,7 +1599,7 @@ Perl_PerlIO_error(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        return (*PerlIOBase(f)->tab->Error) (aTHX_ f);
     else {
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
        return -1;
     }
 }
@@ -1580,7 +1610,7 @@ Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        (*PerlIOBase(f)->tab->Clearerr) (aTHX_ f);
     else
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
 }
 
 void
@@ -1589,7 +1619,7 @@ Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
     if (PerlIOValid(f))
        (*PerlIOBase(f)->tab->Setlinebuf) (aTHX_ f);
     else
-       SETERRNO(EBADF, SS$_IVCHAN);
+       SETERRNO(EBADF, SS_IVCHAN);
 }
 
 int
@@ -1691,6 +1721,7 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
     }
 }
 
+
 /*--------------------------------------------------------------------------------------*/
 /*
  * utf8 and raw dummy layers
@@ -1818,35 +1849,38 @@ PerlIOBase_fileno(pTHX_ PerlIO *f)
 }
 
 char *
-PerlIO_modestr(PerlIO *f, char *buf)
+PerlIO_modestr(PerlIO * f, char *buf)
 {
     char *s = buf;
-    IV flags = PerlIOBase(f)->flags;
-    if (flags & PERLIO_F_APPEND) {
-       *s++ = 'a';
-       if (flags & PERLIO_F_CANREAD) {
-           *s++ = '+';
+    if (PerlIOValid(f)) {
+       IV flags = PerlIOBase(f)->flags;
+       if (flags & PERLIO_F_APPEND) {
+           *s++ = 'a';
+           if (flags & PERLIO_F_CANREAD) {
+               *s++ = '+';
+           }
        }
-    }
-    else if (flags & PERLIO_F_CANREAD) {
-       *s++ = 'r';
-       if (flags & PERLIO_F_CANWRITE)
-           *s++ = '+';
-    }
-    else if (flags & PERLIO_F_CANWRITE) {
-       *s++ = 'w';
-       if (flags & PERLIO_F_CANREAD) {
-           *s++ = '+';
+       else if (flags & PERLIO_F_CANREAD) {
+           *s++ = 'r';
+           if (flags & PERLIO_F_CANWRITE)
+               *s++ = '+';
+       }
+       else if (flags & PERLIO_F_CANWRITE) {
+           *s++ = 'w';
+           if (flags & PERLIO_F_CANREAD) {
+               *s++ = '+';
+           }
        }
-    }
 #ifdef PERLIO_USING_CRLF
-    if (!(flags & PERLIO_F_CRLF))
-       *s++ = 'b';
+       if (!(flags & PERLIO_F_CRLF))
+           *s++ = 'b';
 #endif
+    }
     *s = '\0';
     return buf;
 }
 
+
 IV
 PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
@@ -1873,7 +1907,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
            l->flags |= PERLIO_F_TRUNCATE | PERLIO_F_CANWRITE;
            break;
        default:
-           SETERRNO(EINVAL, LIB$_INVARG);
+           SETERRNO(EINVAL, LIB_INVARG);
            return -1;
        }
        while (*mode) {
@@ -1888,7 +1922,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
                l->flags |= PERLIO_F_CRLF;
                break;
            default:
-               SETERRNO(EINVAL, LIB$_INVARG);
+               SETERRNO(EINVAL, LIB_INVARG);
                return -1;
            }
        }
@@ -2199,7 +2233,7 @@ PerlIOUnix_oflags(const char *mode)
      */
     oflags |= O_BINARY;
     if (*mode || oflags == -1) {
-       SETERRNO(EINVAL, LIB$_INVARG);
+       SETERRNO(EINVAL, LIB_INVARG);
        oflags = -1;
     }
     return oflags;
@@ -2307,7 +2341,7 @@ SSize_t
 PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     int fd = PerlIOSelf(f, PerlIOUnix)->fd;
-    if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) || 
+    if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) ||
          PerlIOBase(f)->flags & (PERLIO_F_EOF|PERLIO_F_ERROR)) {
        return 0;
     }
@@ -2367,7 +2401,7 @@ PerlIOUnix_close(pTHX_ PerlIO *f)
        }
     }
     else {
-       SETERRNO(EBADF,SS$_IVCHAN);
+       SETERRNO(EBADF,SS_IVCHAN);
        return -1;
     }
     while (PerlLIO_close(fd) != 0) {
@@ -2436,7 +2470,7 @@ IV
 PerlIOStdio_fileno(pTHX_ PerlIO *f)
 {
     FILE *s;
-    if (PerlIOValid(f) && (s = PerlIOSelf(f, PerlIOStdio)->stdio)) {    
+    if (PerlIOValid(f) && (s = PerlIOSelf(f, PerlIOStdio)->stdio)) {
        return PerlSIO_fileno(s);
     }
     errno = EBADF;
@@ -2471,12 +2505,12 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab
            int fd = PerlIO_fileno(n);
            char tmode[8];
            FILE *stdio;
-           if (fd >= 0 && (stdio  = PerlSIO_fdopen(fd, 
+           if (fd >= 0 && (stdio  = PerlSIO_fdopen(fd,
                            mode = PerlIOStdio_mode(mode, tmode)))) {
                PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
                /* We never call down so do any pending stuff now */
                PerlIO_flush(PerlIONext(f));
-           } 
+           }
            else {
                return -1;
            }
@@ -2564,8 +2598,11 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                        s->stdio = stdio;
                        PerlIOUnix_refcnt_inc(fileno(s->stdio));
                    }
+                   return f;
+               }
+               else {
+                   return NULL;
                }
-               return f;
            }
        }
        if (fd >= 0) {
@@ -3002,26 +3039,40 @@ PerlIO_funcs PerlIO_stdio = {
 #endif                          /* USE_STDIO_PTR */
 };
 
+/* Note that calls to PerlIO_exportFILE() are reversed using
+ * PerlIO_releaseFILE(), not importFILE. */
 FILE *
-PerlIO_exportFILE(PerlIO *f, const char *mode)
+PerlIO_exportFILE(PerlIO * f, const char *mode)
 {
     dTHX;
-    FILE *stdio;
-    char buf[8];
-    PerlIO_flush(f);
-    if (!mode || !*mode) {
-       mode = PerlIO_modestr(f,buf);
-    }
-    stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode);
-    if (stdio) {
-       if ((f = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
-           PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
-           s->stdio = stdio;
+    FILE *stdio = NULL;
+    if (PerlIOValid(f)) {
+       char buf[8];
+       PerlIO_flush(f);
+       if (!mode || !*mode) {
+           mode = PerlIO_modestr(f, buf);
+       }
+       stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode);
+       if (stdio) {
+           PerlIOl *l = *f;
+           /* De-link any lower layers so new :stdio sticks */
+           *f = NULL;
+           if ((f = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
+               PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+               s->stdio = stdio;
+               /* Link previous lower layers under new one */
+               *PerlIONext(f) = l;
+           }
+           else {
+               /* restore layers list */
+               *f = l;
+           }
        }
     }
     return stdio;
 }
 
+
 FILE *
 PerlIO_findFILE(PerlIO *f)
 {
@@ -3037,6 +3088,7 @@ PerlIO_findFILE(PerlIO *f)
     return PerlIO_exportFILE(f, Nullch);
 }
 
+/* Use this to reverse PerlIO_exportFILE calls. */
 void
 PerlIO_releaseFILE(PerlIO *p, FILE *f)
 {
@@ -4009,7 +4061,7 @@ PerlIOMmap_map(pTHX_ PerlIO *f)
                if (!page_size) {
 #if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_PAGE_SIZE))
                    {
-                       SETERRNO(0, SS$_NORMAL);
+                       SETERRNO(0, SS_NORMAL);
 #   ifdef _SC_PAGESIZE
                        page_size = sysconf(_SC_PAGESIZE);
 #   else
@@ -4528,7 +4580,7 @@ PerlIO_setpos(PerlIO *f, SV *pos)
        if (f && len == sizeof(Off_t))
            return PerlIO_seek(f, *posn, SEEK_SET);
     }
-    SETERRNO(EINVAL, SS$_IVCHAN);
+    SETERRNO(EINVAL, SS_IVCHAN);
     return -1;
 }
 #else
@@ -4548,7 +4600,7 @@ PerlIO_setpos(PerlIO *f, SV *pos)
 #endif
        }
     }
-    SETERRNO(EINVAL, SS$_IVCHAN);
+    SETERRNO(EINVAL, SS_IVCHAN);
     return -1;
 }
 #endif
@@ -4637,3 +4689,4 @@ PerlIO_sprintf(char *s, int n, const char *fmt, ...)
 
 
 
+