use libdbm.nfs.a if available (libdbm.a is missing dbmclose())

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

diff --git a/perl.c b/perl.c
index 3c3a629..74884b2 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -14,6 +14,7 @@
 #include "EXTERN.h"
 #define PERL_IN_PERL_C
 #include "perl.h"
+#include "patchlevel.h"                        /* for local_patches */
 
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
@@ -74,7 +75,7 @@ perl_construct(pTHXx)
 #ifdef USE_THREADS
     int i;
 #ifndef FAKE_THREADS
-    struct perl_thread *thr;
+    struct perl_thread *thr = NULL;
 #endif /* FAKE_THREADS */
 #endif /* USE_THREADS */
     
@@ -219,7 +220,7 @@ perl_destruct(pTHXx)
     /* Pass 1 on any remaining threads: detach joinables, join zombies */
   retry_cleanup:
     MUTEX_LOCK(&PL_threads_mutex);
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
                          "perl_destruct: waiting for %d threads...\n",
                          PL_nthreads - 1));
     for (t = thr->next; t != thr; t = t->next) {
@@ -227,7 +228,7 @@ perl_destruct(pTHXx)
        switch (ThrSTATE(t)) {
            AV *av;
        case THRf_ZOMBIE:
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "perl_destruct: joining zombie %p\n", t));
            ThrSETSTATE(t, THRf_DEAD);
            MUTEX_UNLOCK(&t->mutex);
@@ -241,11 +242,11 @@ perl_destruct(pTHXx)
            MUTEX_UNLOCK(&PL_threads_mutex);
            JOIN(t, &av);
            SvREFCNT_dec((SV*)av);
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "perl_destruct: joined zombie %p OK\n", t));
            goto retry_cleanup;
        case THRf_R_JOINABLE:
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "perl_destruct: detaching thread %p\n", t));
            ThrSETSTATE(t, THRf_R_DETACHED);
            /* 
@@ -259,7 +260,7 @@ perl_destruct(pTHXx)
            MUTEX_UNLOCK(&t->mutex);
            goto retry_cleanup;
        default:
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "perl_destruct: ignoring %p (state %u)\n",
                                  t, ThrSTATE(t)));
            MUTEX_UNLOCK(&t->mutex);
@@ -271,14 +272,14 @@ perl_destruct(pTHXx)
     /* Pass 2 on remaining threads: wait for the thread count to drop to one */
     while (PL_nthreads > 1)
     {
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+       DEBUG_S(PerlIO_printf(Perl_debug_log,
                              "perl_destruct: final wait for %d threads\n",
                              PL_nthreads - 1));
        COND_WAIT(&PL_nthreads_cond, &PL_threads_mutex);
     }
     /* At this point, we're the last thread */
     MUTEX_UNLOCK(&PL_threads_mutex);
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n"));
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: armageddon has arrived\n"));
     MUTEX_DESTROY(&PL_threads_mutex);
     COND_DESTROY(&PL_nthreads_cond);
 #endif /* !defined(FAKE_THREADS) */
@@ -327,8 +328,6 @@ perl_destruct(pTHXx)
     PL_warnhook = Nullsv;
     SvREFCNT_dec(PL_diehook);
     PL_diehook = Nullsv;
-    SvREFCNT_dec(PL_parsehook);
-    PL_parsehook = Nullsv;
 
     /* call exit list functions */
     while (PL_exitlistlen-- > 0)
@@ -408,6 +407,11 @@ perl_destruct(pTHXx)
     Safefree(PL_screamnext);
     PL_screamnext  = 0;
 
+    /* float buffer */
+    Safefree(PL_efloatbuf);
+    PL_efloatbuf = Nullch;
+    PL_efloatsize = 0;
+
     /* startup and shutdown function lists */
     SvREFCNT_dec(PL_beginav);
     SvREFCNT_dec(PL_endav);
@@ -425,6 +429,7 @@ perl_destruct(pTHXx)
     PL_argvgv = Nullgv;
     PL_argvoutgv = Nullgv;
     PL_stdingv = Nullgv;
+    PL_stderrgv = Nullgv;
     PL_last_in_gv = Nullgv;
     PL_replgv = Nullgv;
 
@@ -437,6 +442,10 @@ perl_destruct(pTHXx)
     PL_defstash = 0;
     SvREFCNT_dec(hv);
 
+    /* clear queued errors */
+    SvREFCNT_dec(PL_errors);
+    PL_errors = Nullsv;
+
     FREETMPS;
     if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
        if (PL_scopestack_ix != 0)
@@ -642,11 +651,11 @@ setuid perl scripts securely.\n");
            LEAVE;
        FREETMPS;
        PL_curstash = PL_defstash;
-       if (PL_endav)
+       if (PL_endav && !PL_minus_c)
            call_list(oldscope, PL_endav);
        return STATUS_NATIVE_EXPORT;
     case 3:
-       PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");
+       PerlIO_printf(Perl_error_log, "panic: top_env\n");
        return 1;
     }
     return 0;
@@ -1014,7 +1023,7 @@ perl_run(pTHXx)
            LEAVE;
        FREETMPS;
        PL_curstash = PL_defstash;
-       if (PL_endav)
+       if (PL_endav && !PL_minus_c)
            call_list(oldscope, PL_endav);
 #ifdef MYMALLOC
        if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
@@ -1026,7 +1035,7 @@ perl_run(pTHXx)
            POPSTACK_TO(PL_mainstack);
            goto redo_body;
        }
-       PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+       PerlIO_printf(Perl_error_log, "panic: restartop\n");
        FREETMPS;
        return 1;
     }
@@ -1051,7 +1060,7 @@ S_run_body(pTHX_ va_list args)
                              (unsigned long) thr));
 
        if (PL_minus_c) {
-           PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", PL_origfilename);
+           PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
            my_exit(0);
        }
        if (PERLDB_SINGLE && PL_DBsingle)
@@ -2628,9 +2637,9 @@ S_init_predump_symbols(pTHX)
     GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
-    othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
-    GvMULTI_on(othergv);
-    io = GvIOp(othergv);
+    PL_stderrgv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
+    GvMULTI_on(PL_stderrgv);
+    io = GvIOp(PL_stderrgv);
     IoOFP(io) = IoIFP(io) = PerlIO_stderr();
     tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
@@ -2869,7 +2878,7 @@ S_incpush(pTHX_ char *p, int addsubdirs)
                sv_usepvn(libdir,unix,len);
            }
            else
-               PerlIO_printf(PerlIO_stderr(),
+               PerlIO_printf(Perl_error_log,
                              "Failed to unixify @INC element \"%s\"\n",
                              SvPV(libdir,len));
 #endif
@@ -2911,7 +2920,6 @@ S_init_main_thread(pTHX)
     thr->threadsv = newAV();
     /* thr->threadsvp is set when find_threadsv is called */
     thr->specific = newAV();
-    thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
     /* Handcraft thrsv similarly to mess_sv */
@@ -3011,7 +3019,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
                LEAVE;
            FREETMPS;
            PL_curstash = PL_defstash;
-           if (PL_endav)
+           if (PL_endav && !PL_minus_c)
                call_list(oldscope, PL_endav);
            PL_curcop = &PL_compiling;
            PL_curcop->cop_line = oldline;
@@ -3029,7 +3037,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
                PL_curcop->cop_line = oldline;
                JMPENV_JUMP(3);
            }
-           PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+           PerlIO_printf(Perl_error_log, "panic: restartop\n");
            FREETMPS;
            break;
        }