X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=d796ede318b71b2bf4a9051216985e6536a2a8e8;hb=cf21f3c64baee1fc09bbeb991ec292f2b276bce6;hp=79255a68b93f9b56949f52e5ab2ff81f9ebe2b1a;hpb=743e66e61aecff1c9998bd0ff719a1d679b03e9f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 79255a6..d796ede 100644
--- a/op.c
+++ b/op.c
@@ -23,10 +23,17 @@
 /* #define PL_OP_SLAB_ALLOC */
 
 /* XXXXXX testing */
-#define OP_REFCNT_LOCK		NOOP
-#define OP_REFCNT_UNLOCK	NOOP
-#define OpREFCNT_set(o,n)	NOOP
-#define OpREFCNT_dec(o)		0
+#ifdef USE_ITHREADS
+#  define OP_REFCNT_LOCK		NOOP
+#  define OP_REFCNT_UNLOCK		NOOP
+#  define OpREFCNT_set(o,n)		((o)->op_targ = (n))
+#  define OpREFCNT_dec(o)		(--(o)->op_targ)
+#else
+#  define OP_REFCNT_LOCK		NOOP
+#  define OP_REFCNT_UNLOCK		NOOP
+#  define OpREFCNT_set(o,n)		NOOP
+#  define OpREFCNT_dec(o)		0
+#endif
 
 #ifdef PL_OP_SLAB_ALLOC 
 #define SLAB_SIZE 8192
@@ -105,7 +112,7 @@ S_no_bareword_allowed(pTHX_ OP *o)
 {
     qerror(Perl_mess(aTHX_
 		     "Bareword \"%s\" not allowed while \"strict subs\" in use",
-		     SvPV_nolen(cSVOPo->op_sv)));
+		     SvPV_nolen(cSVOPo_sv)));
 }
 
 /* "register" allocation */
@@ -319,6 +326,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 		return 0;
 	    }
 	    break;
+	case CXt_FORMAT:
 	case CXt_SUB:
 	    if (!saweval)
 		return 0;
@@ -475,13 +483,13 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
     dTHR;
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" sv %d\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), po));
+			  "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
+			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
     if (!po)
 	Perl_croak(aTHX_ "panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %d\n",
-			  PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n",
+			  PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     return PL_curpad[po];		/* eventually we'll turn this into a macro */
 }
@@ -498,11 +506,11 @@ Perl_pad_free(pTHX_ PADOFFSET po)
 	Perl_croak(aTHX_ "panic: pad_free po");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" free %d\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), po));
+			  "0x%"UVxf" Pad 0x%"UVxf" free %"IVdf"\n",
+			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %d\n",
-			  PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n",
+			  PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
 	SvPADTMP_off(PL_curpad[po]);
@@ -520,11 +528,11 @@ Perl_pad_swipe(pTHX_ PADOFFSET po)
 	Perl_croak(aTHX_ "panic: pad_swipe po");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf" Pad 0x%"UVxf" swipe %d\n",
-			  PTR2UV(thr), PTR2UV(PL_curpad), po));
+			  "0x%"UVxf" Pad 0x%"UVxf" swipe %"IVdf"\n",
+			  PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %d\n",
-			  PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %"IVdf"\n",
+			  PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     SvPADTMP_off(PL_curpad[po]);
     PL_curpad[po] = NEWSV(1107,0);
@@ -718,16 +726,18 @@ S_op_clear(pTHX_ OP *o)
     case OP_GV:
     case OP_AELEMFAST:
 #ifdef USE_ITHREADS
-	if (PL_curpad) {
-	    GV *gv = cGVOPo;
-	    pad_swipe(cPADOPo->op_padix);
-	    /* No GvIN_PAD_off(gv) here, because other references may still
-	     * exist on the pad */
-	    SvREFCNT_dec(gv);
-	}
-	cPADOPo->op_padix = 0;
+	if (cPADOPo->op_padix > 0) {
+	    if (PL_curpad) {
+		GV *gv = cGVOPo_gv;
+		pad_swipe(cPADOPo->op_padix);
+		/* No GvIN_PAD_off(gv) here, because other references may still
+		 * exist on the pad */
+		SvREFCNT_dec(gv);
+	    }
+	    cPADOPo->op_padix = 0;
+	}
 #else
-	SvREFCNT_dec(cGVOPo);
+	SvREFCNT_dec(cSVOPo->op_sv);
 	cSVOPo->op_sv = Nullsv;
 #endif
 	break;
@@ -754,11 +764,26 @@ S_op_clear(pTHX_ OP *o)
 	break;
     case OP_SUBST:
 	op_free(cPMOPo->op_pmreplroot);
-	cPMOPo->op_pmreplroot = Nullop;
-	/* FALL THROUGH */
+	goto clear_pmop;
     case OP_PUSHRE:
+#ifdef USE_ITHREADS
+	if ((PADOFFSET)cPMOPo->op_pmreplroot) {
+	    if (PL_curpad) {
+		GV *gv = (GV*)PL_curpad[(PADOFFSET)cPMOPo->op_pmreplroot];
+		pad_swipe((PADOFFSET)cPMOPo->op_pmreplroot);
+		/* No GvIN_PAD_off(gv) here, because other references may still
+		 * exist on the pad */
+		SvREFCNT_dec(gv);
+	    }
+	}
+#else
+	SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot);
+#endif
+	/* FALL THROUGH */
     case OP_MATCH:
     case OP_QR:
+clear_pmop:
+	cPMOPo->op_pmreplroot = Nullop;
 	ReREFCNT_dec(cPMOPo->op_pmregexp);
 	cPMOPo->op_pmregexp = (REGEXP*)NULL;
 	break;
@@ -774,7 +799,13 @@ STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
     Safefree(cop->cop_label);
+#ifdef USE_ITHREADS
+    Safefree(CopFILE(cop));		/* XXXXX share in a pvtable? */
+    Safefree(CopSTASHPV(cop));		/* XXXXX share in a pvtable? */
+#else
+    /* NOTE: COP.cop_stash is not refcounted */
     SvREFCNT_dec(CopFILEGV(cop));
+#endif
     if (! specialWARN(cop->cop_warnings))
 	SvREFCNT_dec(cop->cop_warnings);
 }
@@ -835,12 +866,12 @@ S_scalarboolean(pTHX_ OP *o)
     if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
 	dTHR;
 	if (ckWARN(WARN_SYNTAX)) {
-	    line_t oldline = PL_curcop->cop_line;
+	    line_t oldline = CopLINE(PL_curcop);
 
 	    if (PL_copline != NOLINE)
-		PL_curcop->cop_line = PL_copline;
+		CopLINE_set(PL_curcop, PL_copline);
 	    Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
-	    PL_curcop->cop_line = oldline;
+	    CopLINE_set(PL_curcop, oldline);
 	}
     }
     return scalar(o);
@@ -1045,7 +1076,7 @@ Perl_scalarvoid(pTHX_ OP *o)
 	break;
 
     case OP_CONST:
-	sv = cSVOPo->op_sv;
+	sv = cSVOPo_sv;
 	if (cSVOPo->op_private & OPpCONST_STRICT)
 	    no_bareword_allowed(o);
 	else {
@@ -1275,7 +1306,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	if (!(o->op_private & (OPpCONST_ARYBASE)))
 	    goto nomod;
 	if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
-	    PL_compiling.cop_arybase = (I32)SvIV(((SVOP*)PL_eval_start)->op_sv);
+	    PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
 	    PL_eval_start = 0;
 	}
 	else if (!type) {
@@ -1302,7 +1333,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	}
 	else {				/* lvalue subroutine call */
 	    o->op_private |= OPpLVAL_INTRO;
-	    if (type == OP_GREPSTART || type == OP_ENTERSUB) {
+	    if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) {
 		/* Backward compatibility mode: */
 		o->op_private |= OPpENTERSUB_INARGS;
 		break;
@@ -1378,7 +1409,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		    break;
 		}
 		
-		cv = GvCV(kGVOP);
+		cv = GvCV(kGVOP_gv);
 		if (!cv) 
 		    goto restore_2cv;
 		if (CvLVALUE(cv))
@@ -1955,7 +1986,7 @@ Perl_block_start(pTHX_ int full)
     PL_pad_reset_pending = FALSE;
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    SAVEPPTR(PL_compiling.cop_warnings); 
+    SAVESPTR(PL_compiling.cop_warnings); 
     if (! specialWARN(PL_compiling.cop_warnings)) {
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
         SAVEFREESV(PL_compiling.cop_warnings) ;
@@ -2811,8 +2842,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	OP *curop;
 	if (pm->op_pmflags & PMf_EVAL) {
 	    curop = 0;
-	    if (PL_curcop->cop_line < PL_multi_end)
-		PL_curcop->cop_line = PL_multi_end;
+	    if (CopLINE(PL_curcop) < PL_multi_end)
+		CopLINE_set(PL_curcop, PL_multi_end);
 	}
 #ifdef USE_THREADS
 	else if (repl->op_type == OP_THREADSV
@@ -2836,7 +2867,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 		    }
 #else
 		    if (curop->op_type == OP_GV) {
-			GV *gv = cGVOPx(curop);
+			GV *gv = cGVOPx_gv(curop);
 			repl_has_vars = 1;
 			if (strchr("&`'123456789+", *GvENAME(gv)))
 			    break;
@@ -2924,7 +2955,9 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
     padop->op_type = type;
     padop->op_ppaddr = PL_ppaddr[type];
     padop->op_padix = pad_alloc(type, SVs_PADTMP);
+    SvREFCNT_dec(PL_curpad[padop->op_padix]);
     PL_curpad[padop->op_padix] = sv;
+    SvPADTMP_on(sv);
     padop->op_next = (OP*)padop;
     padop->op_flags = flags;
     if (PL_opargs[type] & OA_RETSCALAR)
@@ -3182,7 +3215,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	    for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
 		if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
 		    if (curop->op_type == OP_GV) {
-			GV *gv = cGVOPx(curop);
+			GV *gv = cGVOPx_gv(curop);
 			if (gv == PL_defgv || SvCUR(gv) == PL_generation)
 			    break;
 			SvCUR(gv) = PL_generation;
@@ -3234,7 +3267,13 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		{
 		    tmpop = ((UNOP*)left)->op_first;
 		    if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
-			pm->op_pmreplroot = (OP*)cGVOPx(tmpop);
+#ifdef USE_ITHREADS
+			pm->op_pmreplroot = (OP*)cPADOPx(tmpop)->op_padix;
+			cPADOPx(tmpop)->op_padix = 0;	/* steal it */
+#else
+			pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
+			cSVOPx(tmpop)->op_sv = Nullsv;	/* steal it */
+#endif
 			pm->op_pmflags |= PMf_ONCE;
 			tmpop = cUNOPo->op_first;	/* to list (nulled) */
 			tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
@@ -3287,7 +3326,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     register COP *cop;
 
     NewOp(1101, cop, 1, COP);
-    if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
+    if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
 	cop->op_type = OP_DBSTATE;
 	cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
     }
@@ -3316,20 +3355,23 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 
 
     if (PL_copline == NOLINE)
-        cop->cop_line = PL_curcop->cop_line;
+        CopLINE_set(cop, CopLINE(PL_curcop));
     else {
-	cop->cop_line = PL_copline;
+	CopLINE_set(cop, PL_copline);
         PL_copline = NOLINE;
     }
+#ifdef USE_ITHREADS
+    CopFILE_set(cop, CopFILE(PL_curcop));	/* XXXXX share in a pvtable? */
+#else
     CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
-    cop->cop_stash = PL_curstash;
+#endif
+    CopSTASH_set(cop, PL_curstash);
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
 	SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE);
 	if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
 	    (void)SvIOK_on(*svp);
-	    SvIVX(*svp) = 1;
-	    SvSTASH(*svp) = (HV*)cop;
+	    SvIVX(*svp) = PTR2IV(cop);
 	}
     }
 
@@ -3441,14 +3483,14 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	    break;
 	}
 	if (warnop) {
-	    line_t oldline = PL_curcop->cop_line;
-	    PL_curcop->cop_line = PL_copline;
+	    line_t oldline = CopLINE(PL_curcop);
+	    CopLINE_set(PL_curcop, PL_copline);
 	    Perl_warner(aTHX_ WARN_UNSAFE,
 		 "Value of %s%s can be \"0\"; test with defined()",
 		 PL_op_desc[warnop],
 		 ((warnop == OP_READLINE || warnop == OP_GLOB)
 		  ? " construct" : "() operator"));
-	    PL_curcop->cop_line = oldline;
+	    CopLINE_set(PL_curcop, oldline);
 	}
     }
 
@@ -3868,7 +3910,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 #endif /* USE_THREADS */
 	ENTER;
 
-	SAVESPTR(PL_curpad);
+	SAVEVPTR(PL_curpad);
 	PL_curpad = 0;
 
 	if (!CvCLONED(cv))
@@ -3905,10 +3947,10 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
 }
 
-#ifdef DEBUGGING
 STATIC void
 S_cv_dump(pTHX_ CV *cv)
 {
+#ifdef DEBUGGING
     CV *outside = CvOUTSIDE(cv);
     AV* padlist = CvPADLIST(cv);
     AV* pad_name;
@@ -3949,8 +3991,8 @@ S_cv_dump(pTHX_ CV *cv)
 			  (IV)I_32(SvNVX(pname[ix])),
 			  SvIVX(pname[ix]));
     }
-}
 #endif /* DEBUGGING */
+}
 
 STATIC CV *
 S_cv_clone2(pTHX_ CV *proto, CV *outside)
@@ -3971,7 +4013,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     assert(!CvUNIQUE(proto));
 
     ENTER;
-    SAVESPTR(PL_curpad);
+    SAVEVPTR(PL_curpad);
     SAVESPTR(PL_comppad);
     SAVESPTR(PL_comppad_name);
     SAVESPTR(PL_compcv);
@@ -3987,6 +4029,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv)		= 0;
 #endif /* USE_THREADS */
+    CvFILE(cv)		= CvFILE(proto);
     CvGV(cv)		= (GV*)SvREFCNT_inc(CvGV(proto));
     CvSTASH(cv)		= CvSTASH(proto);
     CvROOT(cv)		= CvROOT(proto);
@@ -4045,7 +4088,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
 		PL_curpad[ix] = sv;
 	    }
 	}
-	else if (IS_PADGV(ppad[ix])) {
+	else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
 	    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
 	}
 	else {
@@ -4090,9 +4133,9 @@ CV *
 Perl_cv_clone(pTHX_ CV *proto)
 {
     CV *cv;
-    MUTEX_LOCK(&PL_cred_mutex);		/* XXX create separate mutex */
+    LOCK_CRED_MUTEX;			/* XXX create separate mutex */
     cv = cv_clone2(proto, CvOUTSIDE(proto));
-    MUTEX_UNLOCK(&PL_cred_mutex);	/* XXX create separate mutex */
+    UNLOCK_CRED_MUTEX;			/* XXX create separate mutex */
     return cv;
 }
 
@@ -4151,9 +4194,9 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 	    break;
 	if (sv)
 	    return Nullsv;
-	if (type == OP_CONST)
+	if (type == OP_CONST && cSVOPo->op_sv)
 	    sv = cSVOPo->op_sv;
-	else if (type == OP_PADSV && cv) {
+	else if ((type == OP_PADSV || type == OP_CONST) && cv) {
 	    AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
 	    sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
 	    if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
@@ -4252,12 +4295,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 					&& HvNAME(GvSTASH(CvGV(cv)))
 					&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
 						 "autouse"))) {
-		line_t oldline = PL_curcop->cop_line;
-		PL_curcop->cop_line = PL_copline;
+		line_t oldline = CopLINE(PL_curcop);
+		CopLINE_set(PL_curcop, PL_copline);
 		Perl_warner(aTHX_ WARN_REDEFINE,
 			const_sv ? "Constant subroutine %s redefined"
 				 : "Subroutine %s redefined", name);
-		PL_curcop->cop_line = oldline;
+		CopLINE_set(PL_curcop, oldline);
 	    }
 	    SvREFCNT_dec(cv);
 	    cv = Nullcv;
@@ -4315,6 +4358,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	}
     }
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+    CvFILE(cv) = CopFILE(PL_curcop);
     CvSTASH(cv) = PL_curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
@@ -4356,12 +4400,25 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
 	av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
 
+    if (CvLVALUE(cv)) {
+	CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
+    }
+    else {
+	CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+    }
+    CvROOT(cv)->op_private |= OPpREFCOUNTED;
+    OpREFCNT_set(CvROOT(cv), 1);
+    CvSTART(cv) = LINKLIST(CvROOT(cv));
+    CvROOT(cv)->op_next = 0;
+    peep(CvSTART(cv));
+
+    /* now that optimizer has done its work, adjust pad values */
     if (CvCLONE(cv)) {
 	SV **namep = AvARRAY(PL_comppad_name);
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	    SV *namesv;
 
-	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]))
+	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
 		continue;
 	    /*
 	     * The only things that a clonable function needs in its
@@ -4385,25 +4442,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	AvFLAGS(av) = AVf_REIFY;
 
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
-	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]))
+	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
 		continue;
 	    if (!SvPADMY(PL_curpad[ix]))
 		SvPADTMP_on(PL_curpad[ix]);
 	}
     }
 
-    if (CvLVALUE(cv)) {
-	CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
-    }
-    else {
-	CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
-    }
-    CvROOT(cv)->op_private |= OPpREFCOUNTED;
-    OpREFCNT_set(CvROOT(cv), 1);
-    CvSTART(cv) = LINKLIST(CvROOT(cv));
-    CvROOT(cv)->op_next = 0;
-    peep(CvSTART(cv));
-
     if (name) {
 	char *s;
 
@@ -4414,8 +4459,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    CV *cv;
 	    HV *hv;
 
-	    Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld",
-			   CopFILESV(PL_curcop),
+	    Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld",
+			   CopFILE(PL_curcop),
 			   (long)PL_subline, (long)CopLINE(PL_curcop));
 	    gv_efullname3(tmpstr, gv, Nullch);
 	    hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
@@ -4434,18 +4479,22 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    s++;
 	else
 	    s = name;
+
+	if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I')
+	    goto done;
+
 	if (strEQ(s, "BEGIN")) {
 	    I32 oldscope = PL_scopestack_ix;
 	    ENTER;
-	    SAVESPTR(CopFILEGV(&PL_compiling));
-	    SAVEI16(PL_compiling.cop_line);
+	    SAVECOPFILE(&PL_compiling);
+	    SAVECOPLINE(&PL_compiling);
 	    save_svref(&PL_rs);
 	    sv_setsv(PL_rs, PL_nrs);
 
 	    if (!PL_beginav)
 		PL_beginav = newAV();
 	    DEBUG_x( dump_sub(gv) );
-	    av_push(PL_beginav, (SV *)cv);
+	    av_push(PL_beginav, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	    call_list(oldscope, PL_beginav);
 
@@ -4456,20 +4505,23 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	else if (strEQ(s, "END") && !PL_error_count) {
 	    if (!PL_endav)
 		PL_endav = newAV();
+	    DEBUG_x( dump_sub(gv) );
 	    av_unshift(PL_endav, 1);
-	    av_store(PL_endav, 0, (SV *)cv);
+	    av_store(PL_endav, 0, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
 	else if (strEQ(s, "STOP") && !PL_error_count) {
 	    if (!PL_stopav)
 		PL_stopav = newAV();
+	    DEBUG_x( dump_sub(gv) );
 	    av_unshift(PL_stopav, 1);
-	    av_store(PL_stopav, 0, (SV *)cv);
+	    av_store(PL_stopav, 0, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
 	else if (strEQ(s, "INIT") && !PL_error_count) {
 	    if (!PL_initav)
 		PL_initav = newAV();
+	    DEBUG_x( dump_sub(gv) );
 	    av_push(PL_initav, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
@@ -4486,15 +4538,24 @@ void
 Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 {
     dTHR;
-    U32 oldhints = PL_hints;
-    HV *old_cop_stash = PL_curcop->cop_stash;
-    HV *old_curstash = PL_curstash;
-    line_t oldline = PL_curcop->cop_line;
-    PL_curcop->cop_line = PL_copline;
 
+    ENTER;
+    SAVECOPLINE(PL_curcop);
+    SAVEHINTS();
+
+    CopLINE_set(PL_curcop, PL_copline);
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    if(stash)
-	PL_curstash = PL_curcop->cop_stash = stash;
+
+    if (stash) {
+	SAVESPTR(PL_curstash);
+	SAVECOPSTASH(PL_curcop);
+	PL_curstash = stash;
+#ifdef USE_ITHREADS
+	CopSTASHPV(PL_curcop) = stash ? HvNAME(stash) : Nullch;
+#else
+	CopSTASH(PL_curcop) = stash;
+#endif
+    }
 
     newATTRSUB(
 	start_subparse(FALSE, 0),
@@ -4504,10 +4565,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 	newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
     );
 
-    PL_hints = oldhints;
-    PL_curcop->cop_stash = old_cop_stash;
-    PL_curstash = old_curstash;
-    PL_curcop->cop_line = oldline;
+    LEAVE;
 }
 
 CV *
@@ -4528,11 +4586,11 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 	    if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
 			    && HvNAME(GvSTASH(CvGV(cv)))
 			    && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
-		line_t oldline = PL_curcop->cop_line;
+		line_t oldline = CopLINE(PL_curcop);
 		if (PL_copline != NOLINE)
-		    PL_curcop->cop_line = PL_copline;
+		    CopLINE_set(PL_curcop, PL_copline);
 		Perl_warner(aTHX_ WARN_REDEFINE, "Subroutine %s redefined",name);
-		PL_curcop->cop_line = oldline;
+		CopLINE_set(PL_curcop, oldline);
 	    }
 	    SvREFCNT_dec(cv);
 	    cv = 0;
@@ -4557,6 +4615,8 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
     CvOWNER(cv) = 0;
 #endif /* USE_THREADS */
     (void)gv_fetchfile(filename);
+    CvFILE(cv) = filename;	/* NOTE: not copied, as it is expected to be
+				   an external constant string */
     CvXSUB(cv) = subaddr;
 
     if (name) {
@@ -4565,36 +4625,41 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 	    s++;
 	else
 	    s = name;
+
+	if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I')
+	    goto done;
+
 	if (strEQ(s, "BEGIN")) {
 	    if (!PL_beginav)
 		PL_beginav = newAV();
-	    av_push(PL_beginav, (SV *)cv);
+	    av_push(PL_beginav, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
 	else if (strEQ(s, "END")) {
 	    if (!PL_endav)
 		PL_endav = newAV();
 	    av_unshift(PL_endav, 1);
-	    av_store(PL_endav, 0, (SV *)cv);
+	    av_store(PL_endav, 0, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
 	else if (strEQ(s, "STOP")) {
 	    if (!PL_stopav)
 		PL_stopav = newAV();
 	    av_unshift(PL_stopav, 1);
-	    av_store(PL_stopav, 0, (SV *)cv);
+	    av_store(PL_stopav, 0, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
 	else if (strEQ(s, "INIT")) {
 	    if (!PL_initav)
 		PL_initav = newAV();
-	    av_push(PL_initav, (SV *)cv);
+	    av_push(PL_initav, SvREFCNT_inc(cv));
 	    GvCV(gv) = 0;
 	}
     }
     else
 	CvANON_on(cv);
 
+done:
     return cv;
 }
 
@@ -4616,17 +4681,18 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     GvMULTI_on(gv);
     if (cv = GvFORM(gv)) {
 	if (ckWARN(WARN_REDEFINE)) {
-	    line_t oldline = PL_curcop->cop_line;
+	    line_t oldline = CopLINE(PL_curcop);
 
-	    PL_curcop->cop_line = PL_copline;
+	    CopLINE_set(PL_curcop, PL_copline);
 	    Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
-	    PL_curcop->cop_line = oldline;
+	    CopLINE_set(PL_curcop, oldline);
 	}
 	SvREFCNT_dec(cv);
     }
     cv = PL_compcv;
     GvFORM(gv) = cv;
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+    CvFILE(cv) = CopFILE(PL_curcop);
 
     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
@@ -5054,7 +5120,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
 	    kid->op_type = OP_GV;
 	    SvREFCNT_dec(kid->op_sv);
 #ifdef USE_ITHREADS
-	    /* XXXXXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
+	    /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
 	    kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
 	    GvIN_PAD_on(gv);
 	    PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv);
@@ -5073,10 +5139,10 @@ Perl_ck_ftst(pTHX_ OP *o)
     dTHR;
     I32 type = o->op_type;
 
-    if (o->op_flags & OPf_REF)
-	return o;
-
-    if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
+    if (o->op_flags & OPf_REF) {
+	/* nothing */
+    }
+    else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
 	SVOP *kid = (SVOP*)cUNOPo->op_first;
 
 	if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
@@ -5084,17 +5150,24 @@ Perl_ck_ftst(pTHX_ OP *o)
 	    OP *newop = newGVOP(type, OPf_REF,
 		gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
 	    op_free(o);
-	    return newop;
+	    o = newop;
 	}
     }
     else {
 	op_free(o);
 	if (type == OP_FTTTY)
-           return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
+           o =  newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
 				SVt_PVIO));
 	else
-	    return newUNOP(type, 0, newDEFSVOP());
+	    o = newUNOP(type, 0, newDEFSVOP());
     }
+#ifdef USE_LOCALE
+    if (type == OP_FTTEXT || type == OP_FTBINARY) {
+	o->op_private = 0;
+	if (PL_hints & HINT_LOCALE)
+	    o->op_private |= OPpLOCALE;
+    }
+#endif
     return o;
 }
 
@@ -5219,26 +5292,46 @@ Perl_ck_fun(pTHX_ OP *o)
 		    else {
 			I32 flags = OPf_SPECIAL;
 			I32 priv = 0;
+			PADOFFSET targ = 0;
+
 			/* is this op a FH constructor? */
 			if (is_handle_constructor(o,numargs)) {
-			    flags   = 0;                         
-			    /* Set a flag to tell rv2gv to vivify 
+			    char *name = Nullch;
+			    STRLEN len;
+
+			    flags = 0;
+			    /* Set a flag to tell rv2gv to vivify
 			     * need to "prove" flag does not mean something
 			     * else already - NI-S 1999/05/07
-			     */ 
-			    priv = OPpDEREF; 
-#if 0
-			    /* Helps with open($array[$n],...) 
-			       but is too simplistic - need to do selectively
-			    */
-			    mod(kid,type);
-#endif
+			     */
+			    priv = OPpDEREF;
+			    if (kid->op_type == OP_PADSV) {
+				SV **namep = av_fetch(PL_comppad_name,
+						      kid->op_targ, 4);
+				if (namep && *namep)
+				    name = SvPV(*namep, len);
+			    }
+			    else if (kid->op_type == OP_RV2SV
+				     && kUNOP->op_first->op_type == OP_GV)
+			    {
+				GV *gv = cGVOPx_gv(kUNOP->op_first);
+				name = GvNAME(gv);
+				len = GvNAMELEN(gv);
+			    }
+			    if (name) {
+				SV *namesv;
+				targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
+				namesv = PL_curpad[targ];
+				SvUPGRADE(namesv, SVt_PV);
+				if (*name != '$')
+				    sv_setpvn(namesv, "$", 1);
+				sv_catpvn(namesv, name, len);
+			    }
 			}
 			kid->op_sibling = 0;
 			kid = newUNOP(OP_RV2GV, flags, scalar(kid));
-			if (priv) {
-			    kid->op_private |= priv;
-			}
+			kid->op_targ = targ;
+			kid->op_private |= priv;
 		    }
 		    kid->op_sibling = sibl;
 		    *tokid = kid;
@@ -5283,18 +5376,18 @@ Perl_ck_glob(pTHX_ OP *o)
     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
 	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
-#if defined(PERL_INTERNAL_GLOB) && !defined(MINIPERL_BUILD)
+#if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
     if (!gv) {
 	OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10));
 	modname->op_private |= OPpCONST_BARE;
 	ENTER;
 	utilize(1, start_subparse(FALSE, 0), Nullop, modname,
-		newSVOP(OP_CONST, 0, newSVpvn("globally", 8)));
+		newSVOP(OP_CONST, 0, newSVpvn(":globally", 9)));
 	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 	LEAVE;
     }
-#endif /* PERL_INTERNAL_GLOB && !MINIPERL_BUILD */
+#endif /* PERL_EXTERNAL_GLOB */
 
     if (gv && GvIMPORTED_CV(gv)) {
 	append_elem(OP_GLOB, o,
@@ -5759,7 +5852,7 @@ S_simplify_sort(pTHX_ OP *o)
     if (kUNOP->op_first->op_type != OP_GV)
 	return;
     kid = kUNOP->op_first;				/* get past rv2sv */
-    gv = kGVOP;
+    gv = kGVOP_gv;
     if (GvSTASH(gv) != PL_curstash)
 	return;
     if (strEQ(GvNAME(gv), "a"))
@@ -5775,7 +5868,7 @@ S_simplify_sort(pTHX_ OP *o)
     if (kUNOP->op_first->op_type != OP_GV)
 	return;
     kid = kUNOP->op_first;				/* get past rv2sv */
-    gv = kGVOP;
+    gv = kGVOP_gv;
     if (GvSTASH(gv) != PL_curstash
 	|| ( reversed
 	    ? strNE(GvNAME(gv), "a")
@@ -5885,7 +5978,7 @@ Perl_ck_subr(pTHX_ OP *o)
 	null(cvop);		/* disable rv2cv */
 	tmpop = (SVOP*)((UNOP*)cvop)->op_first;
 	if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
-	    GV *gv = cGVOPx(tmpop);
+	    GV *gv = cGVOPx_gv(tmpop);
 	    cv = GvCVu(gv);
 	    if (!cv)
 		tmpop->op_private |= OPpEARLY_CV;
@@ -5953,7 +6046,7 @@ Perl_ck_subr(pTHX_ OP *o)
 				(gvop = ((UNOP*)gvop)->op_first) &&
 				gvop->op_type == OP_GV)
 			    {
-				GV *gv = cGVOPx(gvop);
+				GV *gv = cGVOPx_gv(gvop);
 				OP *sibling = o2->op_sibling;
 				SV *n = newSVpvn("",0);
 				op_free(o2);
@@ -6071,7 +6164,7 @@ Perl_peep(pTHX_ register OP *o)
 	return;
     ENTER;
     SAVEOP();
-    SAVESPTR(PL_curcop);
+    SAVEVPTR(PL_curcop);
     for (; o; o = o->op_next) {
 	if (o->op_seq)
 	    break;
@@ -6090,6 +6183,19 @@ Perl_peep(pTHX_ register OP *o)
 	case OP_CONST:
 	    if (cSVOPo->op_private & OPpCONST_STRICT)
 		no_bareword_allowed(o);
+#ifdef USE_ITHREADS
+	    /* Relocate sv to the pad for thread safety.
+	     * Despite being a "constant", the SV is written to,
+	     * for reference counts, sv_upgrade() etc. */
+	    if (cSVOP->op_sv) {
+		PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
+		SvREFCNT_dec(PL_curpad[ix]);
+		SvPADTMP_on(cSVOPo->op_sv);
+		PL_curpad[ix] = cSVOPo->op_sv;
+		cSVOPo->op_sv = Nullsv;
+		o->op_targ = ix;
+	    }
+#endif
 	    /* FALL THROUGH */
 	case OP_UC:
 	case OP_UCFIRST:
@@ -6182,12 +6288,12 @@ Perl_peep(pTHX_ register OP *o)
 		    o->op_type = OP_AELEMFAST;
 		    o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
 		    o->op_private = (U8)i;
-		    gv = cGVOPo;
+		    gv = cGVOPo_gv;
 		    GvAVn(gv);
 		}
 	    }
 	    else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
-		GV *gv = cGVOPo;
+		GV *gv = cGVOPo_gv;
 		if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
 		    /* XXX could check prototype here instead of just carping */
 		    SV *sv = sv_newmortal();
@@ -6237,12 +6343,12 @@ Perl_peep(pTHX_ register OP *o)
 			o->op_next->op_sibling->op_type != OP_EXIT &&
 			o->op_next->op_sibling->op_type != OP_WARN &&
 			o->op_next->op_sibling->op_type != OP_DIE) {
-		    line_t oldline = PL_curcop->cop_line;
+		    line_t oldline = CopLINE(PL_curcop);
 
-		    PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
+		    CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
 		    Perl_warner(aTHX_ WARN_SYNTAX, "Statement unlikely to be reached");
 		    Perl_warner(aTHX_ WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n");
-		    PL_curcop->cop_line = oldline;
+		    CopLINE_set(PL_curcop, oldline);
 		}
 	    }
 	    break;
@@ -6268,7 +6374,7 @@ Perl_peep(pTHX_ register OP *o)
 	    fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
 	    if (!fields || !GvHV(*fields))
 		break;
-	    svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
+	    svp = cSVOPx_svp(((BINOP*)o)->op_last);
 	    key = SvPV(*svp, keylen);
 	    indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
 	    if (!indsvp) {