new_body_type doesn't need to subtract the offset, that's what

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

diff --git a/perlio.c b/perlio.c
index bee91ee..fa993ec 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*);
@@ -623,7 +621,7 @@ PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param)
        int i;
        list = PerlIO_list_alloc(aTHX);
        for (i=0; i < proto->cur; i++) {
-           SV *arg = Nullsv;
+           SV *arg = NULL;
            if (proto->array[i].arg)
                arg = PerlIO_sv_dup(aTHX_ proto->array[i].arg,param);
            PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg);
@@ -778,7 +776,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
            /*
             * The two SVs are magically freed by load_module
             */
-           Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv);
+           Perl_load_module(aTHX_ 0, pkgsv, NULL, layer, NULL);
            PL_in_load_module--;
            LEAVE;
            return PerlIO_find_layer(aTHX_ name, len, 0);
@@ -912,7 +910,7 @@ PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
     dVAR;
     if (!PL_known_layers)
        PL_known_layers = PerlIO_list_alloc(aTHX);
-    PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv);
+    PerlIO_list_push(aTHX_ PL_known_layers, tab, NULL);
     PerlIO_debug("define %s %p\n", tab->name, (void*)tab);
 }
 
@@ -1357,7 +1355,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
        /* Legacy binmode is now _defined_ as being equivalent to pushing :raw
           So code that used to be here is now in PerlIORaw_pushed().
         */
-       return PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), NULL, Nullsv) ? TRUE : FALSE;
+       return PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), NULL, NULL) ? TRUE : FALSE;
     }
 }
 
@@ -2071,7 +2069,7 @@ PerlIOBase_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
      * Save the position as current head considers it
      */
     const Off_t old = PerlIO_tell(f);
-    PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_pending), "r", Nullsv);
+    PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_pending), "r", NULL);
     PerlIOSelf(f, PerlIOBuf)->posn = old;
     return PerlIOBuf_unread(aTHX_ f, vbuf, count);
 }
@@ -2197,7 +2195,7 @@ SV *
 PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param)
 {
     if (!arg)
-       return Nullsv;
+       return NULL;
 #ifdef sv_dup
     if (param) {
        return sv_dup(arg, param);
@@ -2231,7 +2229,7 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
        if (self->Getarg)
            arg = (*self->Getarg)(aTHX_ o, param, flags);
        else {
-           arg = Nullsv;
+           arg = NULL;
        }
        f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
        if (arg) {
@@ -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 */
@@ -2752,7 +2796,7 @@ PerlIO_importFILE(FILE *stdio, const char *mode)
            }
            fclose(f2);
        }
-       if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, Nullsv))) {
+       if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) {
            s = PerlIOSelf(f, PerlIOStdio);
            s->stdio = stdio;
        }
@@ -3433,7 +3477,7 @@ PerlIO_exportFILE(PerlIO * f, const char *mode)
            PerlIO *f2;
            /* De-link any lower layers so new :stdio sticks */
            *f = NULL;
-           if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, Nullsv))) {
+           if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, NULL))) {
                PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio);
                s->stdio = stdio;
                /* Link previous lower layers under new one */
@@ -4957,7 +5001,7 @@ PerlIO_tmpfile(void)
      if (stdio) {
          if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
                                PERLIO_FUNCS_CAST(&PerlIO_stdio),
-                              "w+", Nullsv))) {
+                              "w+", NULL))) {
               PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
 
                if (s)