From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 3 Feb 2006 13:06:00 +0000 (+0000)
Subject: Change PL_perlio_fd_refcnt from a fixed size static array to a pointer
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=22c96fc102ce8ee52778a2d8a7fced27b492c1ee;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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