Neither is 0xff illegal UTF-EBCDIC since it's the last C1.

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

diff --git a/perlio.c b/perlio.c
index 6f585a1..62f0d37 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -552,12 +552,6 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
 }
 
 void
-PerlIO_cleanup(pTHX)
-{
-    PerlIO_cleantable(aTHX_ &PL_perlio);
-}
-
-void
 PerlIO_destruct(pTHX)
 {
     PerlIO **table = &PL_perlio;
@@ -1992,20 +1986,61 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
 }
 
 #define PERLIO_MAX_REFCOUNTABLE_FD 2048
-#ifdef USE_ITHREADS
+#ifdef USE_THREADS
 perl_mutex PerlIO_mutex;
-int PerlIO_fd_refcnt[PERLIO_MAX_REFCOUNTABLE_FD] = {1,1,1};
 #endif
+int PerlIO_fd_refcnt[PERLIO_MAX_REFCOUNTABLE_FD];
 
 void
 PerlIO_init(pTHX)
 {
  /* Place holder for stdstreams call ??? */
-#ifdef USE_ITHREADS
+#ifdef USE_THREADS
  MUTEX_INIT(&PerlIO_mutex);
 #endif
 }
 
+void
+PerlIOUnix_refcnt_inc(int fd)
+{
+    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+#ifdef USE_THREADS
+       MUTEX_LOCK(&PerlIO_mutex);
+#endif
+       PerlIO_fd_refcnt[fd]++;
+       PerlIO_debug("fd %d refcnt=%d\n",fd,PerlIO_fd_refcnt[fd]);
+#ifdef USE_THREADS
+       MUTEX_UNLOCK(&PerlIO_mutex);
+#endif
+    }
+}
+
+void
+PerlIO_cleanup(pTHX)
+{
+    PerlIOUnix_refcnt_inc(0);
+    PerlIOUnix_refcnt_inc(1);
+    PerlIOUnix_refcnt_inc(2);
+    PerlIO_cleantable(aTHX_ &PL_perlio);
+}
+
+int
+PerlIOUnix_refcnt_dec(int fd)
+{
+    int cnt = 0;
+    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+#ifdef USE_THREADS
+       MUTEX_LOCK(&PerlIO_mutex);
+#endif
+       cnt = --PerlIO_fd_refcnt[fd];
+       PerlIO_debug("fd %d refcnt=%d\n",fd,cnt);
+#ifdef USE_THREADS
+       MUTEX_UNLOCK(&PerlIO_mutex);
+#endif
+    }
+    return cnt;
+}
+
 /*--------------------------------------------------------------------------------------*/
 /*
  * Bottom-most level for UNIX-like case
@@ -2079,20 +2114,6 @@ PerlIOUnix_fileno(PerlIO *f)
     return PerlIOSelf(f, PerlIOUnix)->fd;
 }
 
-void
-PerlIOUnix_refcnt_inc(int fd)
-{
-#ifdef USE_ITHREADS
-    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
-       MUTEX_LOCK(&PerlIO_mutex);
-       PerlIO_fd_refcnt[fd]++;
-       PerlIO_debug("fd %d refcnt=%d\n",fd,PerlIO_fd_refcnt[fd]);
-       MUTEX_UNLOCK(&PerlIO_mutex);
-    }
-#endif
-}
-
-
 IV
 PerlIOUnix_pushed(PerlIO *f, const char *mode, SV *arg)
 {
@@ -2238,23 +2259,16 @@ PerlIOUnix_close(PerlIO *f)
     dTHX;
     int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     int code = 0;
-#ifdef USE_ITHREADS
-    if ((PerlIOBase(f)->flags & PERLIO_F_OPEN) && fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
-       MUTEX_LOCK(&PerlIO_mutex); 
-       if (--PerlIO_fd_refcnt[fd] > 0) {
-           PerlIO_debug("fd %d refcnt=%d\n",fd,PerlIO_fd_refcnt[fd]);
-           MUTEX_UNLOCK(&PerlIO_mutex); 
+    if (PerlIOBase(f)->flags & PERLIO_F_OPEN) {
+       if (PerlIOUnix_refcnt_dec(fd) > 0) {
            PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
            return 0;
         }
-       PerlIO_debug("fd %d refcnt=%d\n",fd,PerlIO_fd_refcnt[fd]);
-       MUTEX_UNLOCK(&PerlIO_mutex); 
     }
     else {
        SETERRNO(EBADF,SS$_IVCHAN);
        return -1;
     }
-#endif
     while (PerlLIO_close(fd) != 0) {
        if (errno != EINTR) {
            code = -1;
@@ -2374,12 +2388,14 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     if (f) {
        char *path = SvPV_nolen(*args);
        PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
-       FILE *stdio =
-           PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
+       FILE *stdio;
+       PerlIOUnix_refcnt_dec(fileno(s->stdio));
+       stdio = PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
                            s->stdio);
        if (!s->stdio)
            return NULL;
        s->stdio = stdio;
+       PerlIOUnix_refcnt_inc(fileno(s->stdio));
        return f;
     }
     else {
@@ -2399,6 +2415,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                                    PerlIOArg),
                                   PerlIOStdio);
                    s->stdio = stdio;
+                   PerlIOUnix_refcnt_inc(fileno(s->stdio));
                }
                return f;
            }
@@ -2433,6 +2450,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                               (aTHX_(f = PerlIO_allocate(aTHX)), self,
                                mode, PerlIOArg), PerlIOStdio);
                s->stdio = stdio;
+               PerlIOUnix_refcnt_inc(fileno(s->stdio));
                return f;
            }
        }
@@ -2440,6 +2458,60 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     return NULL;
 }
 
+PerlIO *
+PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+{
+    /* This assumes no layers underneath - which is what
+       happens, but is not how I remember it. NI-S 2001/10/16
+     */
+    int fd = PerlIO_fileno(o);
+    if (fd >= 0) {
+       char buf[8];
+       FILE *stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o, buf));
+       if (stdio) {
+           if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
+               PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+               PerlIOUnix_refcnt_inc(fd);
+           }
+           else {
+               PerlSIO_fclose(stdio);
+           }
+       }
+       else {
+           PerlLIO_close(fd);
+           f = NULL;
+       }
+    }
+    return f;
+}
+
+IV
+PerlIOStdio_close(PerlIO *f)
+{
+    dSYS;
+#ifdef SOCKS5_VERSION_NAME
+    int optval;
+    Sock_size_t optlen = sizeof(int);
+#endif
+    FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+    if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
+       return 0;
+    }
+    return (
+#ifdef SOCKS5_VERSION_NAME
+              (getsockopt
+               (PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
+                &optlen) <
+               0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f))
+#else
+              PerlSIO_fclose(stdio)
+#endif
+       );
+
+}
+
+
+
 SSize_t
 PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
 {
@@ -2505,28 +2577,6 @@ PerlIOStdio_tell(PerlIO *f)
 }
 
 IV
-PerlIOStdio_close(PerlIO *f)
-{
-    dSYS;
-#ifdef SOCKS5_VERSION_NAME
-    int optval;
-    Sock_size_t optlen = sizeof(int);
-#endif
-    FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
-    return (
-#ifdef SOCKS5_VERSION_NAME
-              (getsockopt
-               (PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
-                &optlen) <
-               0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f))
-#else
-              PerlSIO_fclose(stdio)
-#endif
-       );
-
-}
-
-IV
 PerlIOStdio_flush(PerlIO *f)
 {
     dSYS;
@@ -2681,32 +2731,6 @@ PerlIOStdio_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 
 #endif
 
-PerlIO *
-PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
-{
-    /* This assumes no layers underneath - which is what
-       happens, but is not how I remember it. NI-S 2001/10/16
-     */
-    int fd = PerlLIO_dup(PerlIO_fileno(o));
-    if (fd >= 0) {
-       char buf[8];
-       FILE *stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o, buf));
-       if (stdio) {
-           if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
-               PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
-           }
-           else {
-               PerlSIO_fclose(stdio);
-           }
-       }
-       else {
-           PerlLIO_close(fd);
-           f = NULL;
-       }
-    }
-    return f;
-}
-
 PerlIO_funcs PerlIO_stdio = {
     "stdio",
     sizeof(PerlIOStdio),
@@ -2843,7 +2867,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        if (f) {
            PerlIO_push(aTHX_ f, self, mode, PerlIOArg);
            fd = PerlIO_fileno(f);
-#if O_BINARY != O_TEXT
+#if (O_BINARY != O_TEXT) && !defined(__BEOS__)
            /*
             * do something about failing setmode()? --jhi
             */