X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=95f10fff6cea417791c407f3979d61455b04df41;hb=0df67ae6657908368da0106eaece7afb31cc07d7;hp=81287331c05c7e4181f459e269f059fac61ae91b;hpb=bf4acbe410c9fcc2bff9bfa63411be8c6c46902a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index 8128733..95f10ff 100644
--- a/perl.c
+++ b/perl.c
@@ -180,6 +180,8 @@ perl_construct(pTHXx)
 #  endif /* EMULATE_ATOMIC_REFCOUNTS */
 	
 	MUTEX_INIT(&PL_cred_mutex);
+	MUTEX_INIT(&PL_sv_lock_mutex);
+	MUTEX_INIT(&PL_fdpid_mutex);
 
 	thr = init_main_thread();
 #endif /* USE_THREADS */
@@ -600,9 +602,14 @@ perl_destruct(pTHXx)
     if (!specialWARN(PL_compiling.cop_warnings))
 	SvREFCNT_dec(PL_compiling.cop_warnings);
     PL_compiling.cop_warnings = Nullsv;
-#ifndef USE_ITHREADS
+#ifdef USE_ITHREADS
+    Safefree(CopFILE(&PL_compiling));
+    CopFILE(&PL_compiling) = Nullch;
+    Safefree(CopSTASHPV(&PL_compiling));
+#else
     SvREFCNT_dec(CopFILEGV(&PL_compiling));
-    CopFILEGV_set(&PL_compiling, Nullgv);
+    CopFILEGV(&PL_compiling) = Nullgv;
+    /* cop_stash is not refcounted */
 #endif
 
     /* Prepare to destruct main symbol table.  */
@@ -652,6 +659,10 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_fdpid);		/* needed in io_close() */
     PL_fdpid = Nullav;
 
+#ifdef HAVE_INTERP_INTERN
+    sys_intern_clear();
+#endif
+
     /* Destruct the global string table. */
     {
 	/* Yell and reset the HeVAL() slots that are still holding refcounts,
@@ -701,9 +712,6 @@ perl_destruct(pTHXx)
     if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
 	Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
 
-    sv_free_arenas();
-
-    /* No SVs have survived, need to clean out */
     Safefree(PL_origfilename);
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
@@ -711,6 +719,8 @@ perl_destruct(pTHXx)
     Safefree(PL_reg_poscache);
     Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
     Safefree(PL_op_mask);
+    Safefree(PL_psig_ptr);
+    Safefree(PL_psig_name);
     nuke_stacks();
     PL_hints = 0;		/* Reset hints. Should hints be per-interpreter ? */
     
@@ -720,6 +730,7 @@ perl_destruct(pTHXx)
     MUTEX_DESTROY(&PL_sv_mutex);
     MUTEX_DESTROY(&PL_eval_mutex);
     MUTEX_DESTROY(&PL_cred_mutex);
+    MUTEX_DESTROY(&PL_fdpid_mutex);
     COND_DESTROY(&PL_eval_cond);
 #ifdef EMULATE_ATOMIC_REFCOUNTS
     MUTEX_DESTROY(&PL_svref_mutex);
@@ -732,6 +743,8 @@ perl_destruct(pTHXx)
     PL_thrsv = Nullsv;
 #endif /* USE_THREADS */
 
+    sv_free_arenas();
+
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
@@ -1180,6 +1193,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     validate_suid(validarg, scriptname,fdscript);
 
+#ifndef PERL_MICRO
 #if defined(SIGCHLD) || defined(SIGCLD)
     {
 #ifndef SIGCHLD
@@ -1194,6 +1208,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 	}
     }
 #endif
+#endif
 
 #ifdef MACOS_TRADITIONAL
     if (PL_doextract || gMacPerl_AlwaysExtract) {
@@ -1239,9 +1254,11 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     if (xsinit)
 	(*xsinit)(aTHXo);	/* in case linked C routines want magical variables */
+#ifndef PERL_MICRO
 #if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__)
     init_os_extras();
 #endif
+#endif
 
 #ifdef USE_SOCKS
     SOCKSinit(argv[0]);
@@ -1609,7 +1626,6 @@ L<perlcall>.
 
 I32
 Perl_call_sv(pTHX_ SV *sv, I32 flags)
-       
           		/* See G_* flags in cop.h */
 {
     dSP;
@@ -1657,7 +1673,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	method_op.op_next = PL_op;
 	method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
 	myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
-	PL_op = &method_op;
+	PL_op = (OP*)&method_op;
     }
 
     if (!(flags & G_EVAL)) {
@@ -1667,7 +1683,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	CATCH_SET(oldcatch);
     }
     else {
-	cLOGOP->op_other = PL_op;
+	myop.op_other = (OP*)&myop;
 	PL_markstack_ptr--;
 	/* we're trying to emulate pp_entertry() here */
 	{
@@ -1780,9 +1796,9 @@ S_call_body(pTHX_ OP *myop, int is_eval)
 
     if (PL_op == myop) {
 	if (is_eval)
-	    PL_op = Perl_pp_entereval(aTHX);
+	    PL_op = Perl_pp_entereval(aTHX);	/* this doesn't do a POPMARK */
 	else
-	    PL_op = Perl_pp_entersub(aTHX);
+	    PL_op = Perl_pp_entersub(aTHX);	/* this does */
     }
     if (PL_op)
 	CALLRUNOPS(aTHX);
@@ -1904,7 +1920,6 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
     dSP;
     SV* sv = newSVpv(p, 0);
 
-    PUSHMARK(SP);
     eval_sv(sv, G_SCALAR);
     SvREFCNT_dec(sv);
 
@@ -2512,6 +2527,11 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 	}
     }
 
+#ifdef USE_ITHREADS
+    Safefree(CopFILE(PL_curcop));
+#else
+    SvREFCNT_dec(CopFILEGV(PL_curcop));
+#endif
     CopFILE_set(PL_curcop, PL_origfilename);
     if (strEQ(PL_origfilename,"-"))
 	scriptname = "";
@@ -3264,7 +3284,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     }
     if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV)))
 #ifdef OS2
-	sv_setpv(GvSV(tmpgv), os2_execname());
+	sv_setpv(GvSV(tmpgv), os2_execname(aTHX));
 #else
 	sv_setpv(GvSV(tmpgv),PL_origargv[0]);
 #endif
@@ -3655,7 +3675,14 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 
     while (AvFILL(paramList) >= 0) {
 	cv = (CV*)av_shift(paramList);
-	SAVEFREESV(cv);
+	if ((PL_minus_c & 0x10) && (paramList == PL_beginav)) {
+		/* save PL_beginav for compiler */
+	    if (! PL_beginav_save)
+		PL_beginav_save = newAV();
+	    av_push(PL_beginav_save, (SV*)cv);
+	} else {
+	    SAVEFREESV(cv);
+	}
 #ifdef PERL_FLEXIBLE_EXCEPTIONS
 	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_list_body), cv);
 #else