X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=197e73727417220dc6644f7d57a061a7566eacd4;hb=a29d06eddb19ab1d6c524328bb98500ebb28dcdb;hp=801dbe15f2b669836badbf84c5719e6e5ce984b6;hpb=f4dd75d9918abbf789a5eca453b89168cad18ff0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index 801dbe1..197e737 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 */
@@ -657,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,
@@ -706,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)
@@ -716,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 ? */
     
@@ -725,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);
@@ -737,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) {
@@ -1185,6 +1193,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     validate_suid(validarg, scriptname,fdscript);
 
+#ifndef PERL_MICRO
 #if defined(SIGCHLD) || defined(SIGCLD)
     {
 #ifndef SIGCHLD
@@ -1199,6 +1208,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 	}
     }
 #endif
+#endif
 
 #ifdef MACOS_TRADITIONAL
     if (PL_doextract || gMacPerl_AlwaysExtract) {
@@ -1244,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]);
@@ -1784,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);
@@ -1908,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);
 
@@ -2049,9 +2060,25 @@ Perl_moreswitches(pTHX_ char *s)
     case 'd':
 	forbid_setid("-d");
 	s++;
-	if (*s == ':' || *s == '=')  {
-	    my_setenv("PERL5DB", Perl_form(aTHX_ "use Devel::%s;", ++s));
+	/* The following permits -d:Mod to accepts arguments following an =
+	   in the fashion that -MSome::Mod does. */
+	if (*s == ':' || *s == '=') {
+	    char *start;
+	    SV *sv;
+	    sv = newSVpv("use Devel::", 0);
+	    start = ++s;
+	    /* We now allow -d:Module=Foo,Bar */
+	    while(isALNUM(*s) || *s==':') ++s;
+	    if (*s != '=')
+		sv_catpv(sv, start);
+	    else {
+		sv_catpvn(sv, start, s-start);
+		sv_catpv(sv, " split(/,/,q{");
+		sv_catpv(sv, ++s);
+		sv_catpv(sv,    "})");
+	    }
 	    s += strlen(s);
+	    my_setenv("PERL5DB", SvPV(sv, PL_na));
 	}
 	if (!PL_perldb) {
 	    PL_perldb = PERLDB_ALL;
@@ -2230,6 +2257,10 @@ Perl_moreswitches(pTHX_ char *s)
 
 	PerlIO_printf(PerlIO_stdout(),
 		      "\n\nCopyright 1987-2000, Larry Wall\n");
+#ifdef MACOS_TRADITIONAL
+	PerlIO_printf(PerlIO_stdout(),
+		      "\nMacOS port Copyright (c) 1991-2000, Matthias Neeracher\n");
+#endif
 #ifdef MSDOS
 	PerlIO_printf(PerlIO_stdout(),
 		      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -2836,16 +2867,6 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 	    if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
 		tmpstatbuf.st_ino != PL_statbuf.st_ino) {
 		(void)PerlIO_close(PL_rsfp);
-		if (PL_rsfp = PerlProc_popen("/bin/mail root","w")) {	/* heh, heh */
-		    PerlIO_printf(PL_rsfp,
-"User %"Uid_t_f" tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
-(Filename of set-id script was %s, uid %"Uid_t_f" gid %"Gid_t_f".)\n\nSincerely,\nperl\n",
-			PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
-			(long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino,
-			CopFILE(PL_curcop),
-			PL_statbuf.st_uid, PL_statbuf.st_gid);
-		    (void)PerlProc_pclose(PL_rsfp);
-		}
 		Perl_croak(aTHX_ "Permission denied\n");
 	    }
 	    if (