X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/37e77c235a1d9e646643ada8d96154d9ae4d5137..dc4b20bdf34f180d3017bda09b1fd225ad2b19d4:/perl.c?ds=sidebyside

diff --git a/perl.c b/perl.c
index 0864e34..65b0a1c 100644
--- a/perl.c
+++ b/perl.c
@@ -242,29 +242,7 @@ perl_construct(pTHXx)
 #endif
     PL_curcop = &PL_compiling;	/* needed by ckWARN, right away */
 
-    /* set read-only and try to insure than we wont see REFCNT==0
-       very often */
-
-    SvREADONLY_on(&PL_sv_undef);
-    SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
-
-    sv_setpv(&PL_sv_no,PL_No);
-    /* value lookup in void context - happens to have the side effect
-       of caching the numeric forms. However, as &PL_sv_no doesn't contain
-       a string that is a valid numer, we have to turn the public flags by
-       hand:  */
-    SvNV(&PL_sv_no);
-    SvIV(&PL_sv_no);
-    SvIOK_on(&PL_sv_no);
-    SvNOK_on(&PL_sv_no);
-    SvREADONLY_on(&PL_sv_no);
-    SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
-
-    sv_setpv(&PL_sv_yes,PL_Yes);
-    SvNV(&PL_sv_yes);
-    SvIV(&PL_sv_yes);
-    SvREADONLY_on(&PL_sv_yes);
-    SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+    init_constants();
 
     SvREADONLY_on(&PL_sv_placeholder);
     SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
@@ -991,6 +969,7 @@ perl_destruct(pTHXx)
     /* clear utf8 character classes */
     SvREFCNT_dec(PL_utf8_alnum);
     SvREFCNT_dec(PL_utf8_alpha);
+    SvREFCNT_dec(PL_utf8_blank);
     SvREFCNT_dec(PL_utf8_space);
     SvREFCNT_dec(PL_utf8_graph);
     SvREFCNT_dec(PL_utf8_digit);
@@ -1009,6 +988,7 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_utf8_foldclosures);
     PL_utf8_alnum	= NULL;
     PL_utf8_alpha	= NULL;
+    PL_utf8_blank	= NULL;
     PL_utf8_space	= NULL;
     PL_utf8_graph	= NULL;
     PL_utf8_digit	= NULL;
@@ -1216,12 +1196,6 @@ perl_destruct(pTHXx)
 #endif
     PL_sv_count = 0;
 
-#ifdef PERL_DEBUG_READONLY_OPS
-    free(PL_slabs);
-    PL_slabs = NULL;
-    PL_slab_count = 0;
-#endif
-
 #if defined(PERLIO_LAYERS)
     /* No more IO - including error messages ! */
     PerlIO_cleanup(aTHX);
@@ -2218,7 +2192,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #ifdef PERL_MAD
     {
 	const char *s;
-    if ((s = PerlEnv_getenv("PERL_XMLDUMP"))) {
+    if (!PL_tainting &&
+        (s = PerlEnv_getenv("PERL_XMLDUMP"))) {
 	PL_madskills = 1;
 	PL_minus_c = 1;
 	if (!s || !s[0])
@@ -2392,7 +2367,8 @@ S_run_body(pTHX_ I32 oldscope)
 	    call_list(oldscope, PL_initav);
 	}
 #ifdef PERL_DEBUG_READONLY_OPS
-	Perl_pending_Slabs_to_ro(aTHX);
+	if (PL_main_root && PL_main_root->op_slabbed)
+	    Slab_to_ro(OpSLAB(PL_main_root));
 #endif
     }
 
@@ -2412,7 +2388,7 @@ S_run_body(pTHX_ I32 oldscope)
 	CALLRUNOPS(aTHX);
     }
     my_exit(0);
-    /* NOTREACHED */
+    assert(0); /* NOTREACHED */
 }
 
 /*
@@ -2527,10 +2503,7 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
      * It has the same effect as "sub name;", i.e. just a forward
      * declaration! */
     if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
-	SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
-    	return newSUB(start_subparse(FALSE, 0),
-		      newSVOP(OP_CONST, 0, sv),
-		      NULL, NULL);
+    	return newSTUB(gv,0);
     }
     if (gv)
 	return GvCVu(gv);
@@ -2727,7 +2700,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
 	    FREETMPS;
 	    JMPENV_POP;
 	    my_exit_jump();
-	    /* NOTREACHED */
+	    assert(0); /* NOTREACHED */
 	case 3:
 	    if (PL_restartop) {
 		PL_restartjmpenv = NULL;
@@ -2836,7 +2809,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	FREETMPS;
 	JMPENV_POP;
 	my_exit_jump();
-	/* NOTREACHED */
+	assert(0); /* NOTREACHED */
     case 3:
 	if (PL_restartop) {
 	    PL_restartjmpenv = NULL;
@@ -3003,6 +2976,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
       "  H  Hash dump -- usurps values()\n"
       "  X  Scratchpad allocation\n"
       "  D  Cleaning up\n"
+      "  S  Op slab allocation\n"
       "  T  Tokenising\n"
       "  R  Include reference counts of dumped variables (eg when using -Ds)\n",
       "  J  Do not s,t,P-debug (Jump over) opcodes within package DB\n"
@@ -3459,10 +3433,6 @@ S_minus_v(pTHX)
 		      "\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
 		      "Version 5 port Copyright (c) 1994-2002, Andreas Kaiser, Ilya Zakharevich\n");
 #endif
-#ifdef atarist
-	PerlIO_printf(PerlIO_stdout(),
-		      "atariST series port, ++jrb  bammi@cadence.com\n");
-#endif
 #ifdef __BEOS__
 	PerlIO_printf(PerlIO_stdout(),
 		      "BeOS port Copyright Tom Spindler, 1997-1999\n");
@@ -4153,6 +4123,11 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 		 (void)sv_utf8_decode(sv);
 	}
     }
+
+    if (PL_inplace && (!PL_argvgv || AvFILL(GvAV(PL_argvgv)) == -1))
+        Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
+                         "-i used with no filenames on the command line, "
+                         "reading from STDIN");
 }
 
 STATIC void
@@ -4163,9 +4138,9 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 
     PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
 
-    PL_toptarget = newSV_type(SVt_PVFM);
+    PL_toptarget = newSV_type(SVt_PVIV);
     sv_setpvs(PL_toptarget, "");
-    PL_bodytarget = newSV_type(SVt_PVFM);
+    PL_bodytarget = newSV_type(SVt_PVIV);
     sv_setpvs(PL_bodytarget, "");
     PL_formtarget = PL_bodytarget;
 
@@ -4832,7 +4807,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 	    CopLINE_set(PL_curcop, oldline);
 	    JMPENV_POP;
 	    my_exit_jump();
-	    /* NOTREACHED */
+	    assert(0); /* NOTREACHED */
 	case 3:
 	    if (PL_restartop) {
 		PL_curcop = &PL_compiling;