Retract #10874 (the hack should be unnecessary by now)

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 7bb7dee..28e8761 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -283,7 +283,13 @@ perl_construct(pTHXx)
     PL_fdpid = newAV();                        /* for remembering popen pids by fd */
     PL_modglobal = newHV();            /* pointers to per-interpreter module globals */
     PL_errors = newSVpvn("",0);
-
+#ifdef USE_ITHREADS
+        PL_regex_padav = newAV();
+#endif
+#ifdef USE_REENTRANT_API
+    New(31337, PL_reentrant_buffer,1, REBUF);
+    New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
+#endif
     ENTER;
 }
 
@@ -460,6 +466,36 @@ perl_destruct(pTHXx)
     }
 #endif
 
+#ifdef USE_ITHREADS
+    /* the syntax tree is shared between clones
+     * so op_free(PL_main_root) only ReREFCNT_dec's
+     * REGEXPs in the parent interpreter
+     * we need to manually ReREFCNT_dec for the clones
+     */
+    {
+        I32 i = AvFILLp(PL_regex_padav) + 1;
+        SV **ary = AvARRAY(PL_regex_padav);
+
+        while (i) {
+            SV *resv = ary[--i];
+            REGEXP *re = (REGEXP *)SvIVX(resv);
+
+            if (SvFLAGS(resv) & SVf_BREAK) {
+                /* this is PL_reg_curpm, already freed
+                 * flag is set in regexec.c:S_regtry
+                 */
+                SvFLAGS(resv) &= ~SVf_BREAK;
+            }
+            else {
+                ReREFCNT_dec(re);
+            }
+        }
+    }
+    SvREFCNT_dec(PL_regex_padav);
+    PL_regex_padav = Nullav;
+    PL_regex_pad = NULL;
+#endif
+
     /* loosen bonds of global variables */
 
     if(PL_rsfp) {
@@ -493,6 +529,11 @@ perl_destruct(pTHXx)
        PL_e_script = Nullsv;
     }
 
+    while (--PL_origargc >= 0) {
+        Safefree(PL_origargv[PL_origargc]);
+    }
+    Safefree(PL_origargv);
+
     /* magical thingies */
 
     SvREFCNT_dec(PL_ofs_sv);   /* $, */
@@ -776,6 +817,11 @@ perl_destruct(pTHXx)
     PL_thrsv = Nullsv;
 #endif /* USE_THREADS */
 
+#ifdef USE_REENTRANT_API
+    Safefree(PL_reentrant_buffer->tmbuff);
+    Safefree(PL_reentrant_buffer);
+#endif
+
     sv_free_arenas();
 
     /* As the absolutely last thing, free the non-arena SV for mess() */
@@ -884,8 +930,21 @@ setuid perl scripts securely.\n");
        ("__environ", (unsigned long *) &environ_pointer, NULL);
 #endif /* environ */
 
-    PL_origargv = argv;
     PL_origargc = argc;
+    {
+        /* we copy rather than point to argv
+         * since perl_clone will copy and perl_destruct
+         * has no way of knowing if we've made a copy or 
+         * just point to argv
+         */
+        int i = PL_origargc;
+        New(0, PL_origargv, i+1, char*);
+        PL_origargv[i] = '\0';
+        while (i-- > 0) {
+            PL_origargv[i] = savepv(argv[i]);
+        }
+    }
+
 #ifdef  USE_ENVIRON_ARRAY
     PL_origenviron = environ;
 #endif
@@ -2037,7 +2096,7 @@ STATIC void
 S_usage(pTHX_ char *name)              /* XXX move this out into a module ? */
 {
     /* This message really ought to be max 23 lines.
-     * Removed -h because the user already knows that opton. Others? */
+     * Removed -h because the user already knows that option. Others? */
 
     static char *usage_msg[] = {
 "-0[octal]       specify record separator (\\0, if no argument)",
@@ -2385,6 +2444,11 @@ Perl_moreswitches(pTHX_ char *s)
        PerlIO_printf(PerlIO_stdout(),
                      "EPOC port by Olaf Flebbe, 1999-2000\n");
 #endif
+#ifdef UNDER_CE
+       printf("WINCE port by Rainer Keuchel, 2001\n");
+       printf("Built on " __DATE__ " " __TIME__ "\n\n");
+       wce_hitreturn();
+#endif
 #ifdef BINARY_BUILD_NOTICE
        BINARY_BUILD_NOTICE;
 #endif
@@ -3429,7 +3493,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            } /* else what? */
        }
 #endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
-       for (; *env; env++) {
+       if (env)
+         for (; *env; env++) {
            if (!(s = strchr(*env,'=')))
                continue;
            *s++ = '\0';
@@ -3439,7 +3504,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            sv = newSVpv(s--,0);
            (void)hv_store(hv, *env, s - *env, sv, 0);
            *s = '=';
-       }
+         }
 #ifdef NEED_ENVIRON_DUP_FOR_MODIFY
        if (dup_env_base) {
            char **dup_env;
@@ -3770,6 +3835,7 @@ S_init_main_thread(pTHX)
     (void) find_threadsv("@"); /* Ensure $@ is initialised early */
 
     PL_maxscream = -1;
+    PL_peepp = MEMBER_TO_FPTR(Perl_peep);
     PL_regcompp = MEMBER_TO_FPTR(Perl_pregcomp);
     PL_regexecp = MEMBER_TO_FPTR(Perl_regexec_flags);
     PL_regint_start = MEMBER_TO_FPTR(Perl_re_intuit_start);