Change PL_perlio_fd_refcnt from a fixed size static array to a pointer

to a dynamic array.

p4raw-id: //depot/perl@27059

diff --git a/embedvar.h b/embedvar.h
index f699cc2..9b7fe7d 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -882,6 +882,8 @@
 #define PL_Gperlio_debug_fd    (my_vars->Gperlio_debug_fd)
 #define PL_perlio_fd_refcnt    (my_vars->Gperlio_fd_refcnt)
 #define PL_Gperlio_fd_refcnt   (my_vars->Gperlio_fd_refcnt)
+#define PL_perlio_fd_refcnt_size       (my_vars->Gperlio_fd_refcnt_size)
+#define PL_Gperlio_fd_refcnt_size      (my_vars->Gperlio_fd_refcnt_size)
 #define PL_ppaddr              (my_vars->Gppaddr)
 #define PL_Gppaddr             (my_vars->Gppaddr)
 #define PL_sh_path             (my_vars->Gsh_path)
@@ -931,6 +933,7 @@
 #define PL_Gpatleave           PL_patleave
 #define PL_Gperlio_debug_fd    PL_perlio_debug_fd
 #define PL_Gperlio_fd_refcnt   PL_perlio_fd_refcnt
+#define PL_Gperlio_fd_refcnt_size      PL_perlio_fd_refcnt_size
 #define PL_Gppaddr             PL_ppaddr
 #define PL_Gsh_path            PL_sh_path
 #define PL_Gsig_defaulting     PL_sig_defaulting

diff --git a/perlapi.h b/perlapi.h
index 8c13d01..1fc4e08 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -946,6 +946,8 @@ END_EXTERN_C
 #define PL_perlio_debug_fd     (*Perl_Gperlio_debug_fd_ptr(NULL))
 #undef  PL_perlio_fd_refcnt
 #define PL_perlio_fd_refcnt    (*Perl_Gperlio_fd_refcnt_ptr(NULL))
+#undef  PL_perlio_fd_refcnt_size
+#define PL_perlio_fd_refcnt_size       (*Perl_Gperlio_fd_refcnt_size_ptr(NULL))
 #undef  PL_ppaddr
 #define PL_ppaddr              (*Perl_Gppaddr_ptr(NULL))
 #undef  PL_sh_path

diff --git a/perlio.c b/perlio.c
index bee91ee..c2633f9 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -56,8 +56,6 @@
 
 #include "XSUB.h"
 
-#define PERLIO_MAX_REFCOUNTABLE_FD 2048
-
 #ifdef __Lynx__
 /* Missing proto on LynxOS */
 int mkstemp(char*);
@@ -2247,6 +2245,42 @@ perl_mutex PerlIO_mutex;
 
 /* PL_perlio_fd_refcnt[] is in intrpvar.h */
 
+/* Must be called with PerlIO_mutex locked.  */
+static void
+S_more_refcounted_fds(pTHX_ const int new_fd) {
+    const int old_max = PL_perlio_fd_refcnt_size;
+    const int new_max = 16 + (new_fd & 15);
+    int *new_array;
+
+    PerlIO_debug("More fds - old=%d, need %d, new=%d\n",
+                old_max, new_fd, new_max);
+
+    if (new_fd < old_max) {
+       return;
+    }
+
+    new_array
+       = PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
+
+    if (!new_array) {
+#ifdef USE_THREADS
+       MUTEX_UNLOCK(&PerlIO_mutex);
+#endif
+       /* Can't use PerlIO to write as it allocates memory */
+       PerlLIO_write(PerlIO_fileno(Perl_error_log),
+                     PL_no_mem, strlen(PL_no_mem));
+       my_exit(1);
+    }
+
+    PL_perlio_fd_refcnt_size = new_max;
+    PL_perlio_fd_refcnt = new_array;
+
+    PerlIO_debug("Zeroing %p, %d\n", new_array + old_max, new_max - old_max);
+
+    Zero(new_array + old_max, new_max - old_max, int);
+}
+
+
 void
 PerlIO_init(pTHX)
 {
@@ -2260,13 +2294,18 @@ void
 PerlIOUnix_refcnt_inc(int fd)
 {
     dTHX;
-    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+    if (fd >= 0) {
        dVAR;
+
 #ifdef USE_THREADS
        MUTEX_LOCK(&PerlIO_mutex);
 #endif
+       if (fd >= PL_perlio_fd_refcnt_size)
+           S_more_refcounted_fds(aTHX_ fd);
+
        PL_perlio_fd_refcnt[fd]++;
        PerlIO_debug("fd %d refcnt=%d\n",fd,PL_perlio_fd_refcnt[fd]);
+
 #ifdef USE_THREADS
        MUTEX_UNLOCK(&PerlIO_mutex);
 #endif
@@ -2278,11 +2317,16 @@ PerlIOUnix_refcnt_dec(int fd)
 {
     dTHX;
     int cnt = 0;
-    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+    if (fd >= 0) {
        dVAR;
 #ifdef USE_THREADS
        MUTEX_LOCK(&PerlIO_mutex);
 #endif
+       /* XXX should this be a panic?  */
+       if (fd >= PL_perlio_fd_refcnt_size)
+           S_more_refcounted_fds(aTHX_ fd);
+
+       /* XXX should this be a panic if it drops below 0?  */
        cnt = --PL_perlio_fd_refcnt[fd];
        PerlIO_debug("fd %d refcnt=%d\n",fd,cnt);
 #ifdef USE_THREADS
@@ -2512,7 +2556,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
     if (flags & PERLIO_DUP_FD) {
        fd = PerlLIO_dup(fd);
     }
-    if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+    if (fd >= 0) {
        f = PerlIOBase_dup(aTHX_ f, o, param, flags);
        if (f) {
            /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */

diff --git a/perlvars.h b/perlvars.h
index 21bd46e..67ee5fd 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -76,7 +76,8 @@ PERLVARI(Guse_safe_putenv, int, 1)
 #endif
 
 #ifdef USE_PERLIO
-PERLVARA(Gperlio_fd_refcnt, 2048, int) /* PERLIO_MAX_REFCOUNTABLE_FD */
+PERLVARI(Gperlio_fd_refcnt, int*, 0) /* Pointer to array of fd refcounts.  */
+PERLVARI(Gperlio_fd_refcnt_size, int, 0) /* Size of the array */
 PERLVARI(Gperlio_debug_fd, int, 0) /* the fd to write perlio debug into, 0 means not set yet */
 #endif