This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lib/perl5db.pl: Remove code now moved to OS2::Process
[perl5.git] / perlio.c
index 06a360b..0d4231c 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -2278,8 +2278,9 @@ S_more_refcounted_fds(pTHX_ const int new_fd) {
 
     assert (new_max > new_fd);
 
-    new_array =
-       (int*) PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
+    /* Use plain realloc() since we need this memory to be really
+     * global and visible to all the interpreters and/or threads. */
+    new_array = (int*) realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
 
     if (!new_array) {
 #ifdef USE_ITHREADS
@@ -2398,6 +2399,7 @@ PerlIO_cleanup(pTHX)
 
 void PerlIO_teardown(pTHX) /* Call only from PERL_SYS_TERM(). */
 {
+    
 #ifdef DEBUGGING
     {
        /* By now all filehandles should have been closed, so any
@@ -2411,27 +2413,14 @@ void PerlIO_teardown(pTHX) /* Call only from PERL_SYS_TERM(). */
        }
     }
 #endif
-#ifdef USE_ITHREADS
-    MUTEX_LOCK(&PL_perlio_mutex);
-#endif
+    /* Not bothering with PL_perlio_mutex since by now
+     * all the interpreters are gone. */
     if (PL_perlio_fd_refcnt_size /* Assuming initial size of zero. */
         && PL_perlio_fd_refcnt) {
-#ifdef PERL_TRACK_MEMPOOL
-        Malloc_t ptr = (Malloc_t)((char*)PL_perlio_fd_refcnt-sTHX);
-        struct perl_memory_debug_header *const header
-            = (struct perl_memory_debug_header *)ptr;
-        /* Only the thread that allocated us can free us. */
-        if (header->interpreter == aTHX)
-#endif
-           {
-               PerlMemShared_free(PL_perlio_fd_refcnt); /* Not Safefree() because was allocated with PerlMemShared_realloc(). */
-               PL_perlio_fd_refcnt = NULL;
-               PL_perlio_fd_refcnt_size = 0;
-           }
+       free(PL_perlio_fd_refcnt); /* To match realloc() in S_more_refcounted_fds(). */
+       PL_perlio_fd_refcnt = NULL;
+       PL_perlio_fd_refcnt_size = 0;
     }
-#ifdef USE_ITHREADS
-    MUTEX_UNLOCK(&PL_perlio_mutex);
-#endif
 }
 
 
@@ -3375,7 +3364,7 @@ PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (ptr != NULL) {
 #ifdef STDIO_PTR_LVALUE
-       PerlSIO_set_ptr(stdio, (void*)ptr); /* LHS STDCHAR* cast non-portable */
+       PerlSIO_set_ptr(stdio, ptr); /* LHS STDCHAR* cast non-portable */
 #ifdef STDIO_PTR_LVAL_SETS_CNT
        if (PerlSIO_get_cnt(stdio) != (cnt)) {
            assert(PerlSIO_get_cnt(stdio) == (cnt));
@@ -4627,7 +4616,7 @@ PerlIOMmap_map(pTHX_ PerlIO *f)
                }
                posn = (b->posn / PL_mmap_page_size) * PL_mmap_page_size;
                len = st.st_size - posn;
-               m->mptr = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn);
+               m->mptr = (Mmap_t)mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn);
                if (m->mptr && m->mptr != (Mmap_t) - 1) {
 #if 0 && defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
                    madvise(m->mptr, len, MADV_SEQUENTIAL);
@@ -5090,16 +5079,9 @@ PerlIO_tmpfile(void)
 #    else      /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
      FILE * const stdio = PerlSIO_tmpfile();
 
-     if (stdio) {
-         if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
-                               PERLIO_FUNCS_CAST(&PerlIO_stdio),
-                              "w+", NULL))) {
-              PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
+     if (stdio)
+         f = PerlIO_fdopen(fileno(stdio), "w+");
 
-               if (s)
-                    s->stdio = stdio;
-          }
-     }
 #    endif /* else HAS_MKSTEMP */
 #endif /* else WIN32 */
      return f;