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