/* #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
{
qerror(Perl_mess(aTHX_
"Bareword \"%s\" not allowed while \"strict subs\" in use",
- SvPV_nolen(cSVOPo->op_sv)));
+ SvPV_nolen(cSVOPo_sv)));
}
/* "register" allocation */
return 0;
}
break;
+ case CXt_FORMAT:
case CXt_SUB:
if (!saweval)
return 0;
Perl_croak(aTHX_ "panic: pad_free po");
#ifdef USE_THREADS
DEBUG_X(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf" Pad 0x%"UVxf" free %"IVd"\n",
+ "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 %"IVdf"\n",
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;
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;
break;
case OP_CONST:
- sv = cSVOPo->op_sv;
+ sv = cSVOPo_sv;
if (cSVOPo->op_private & OPpCONST_STRICT)
no_bareword_allowed(o);
else {
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) {
break;
}
- cv = GvCV(kGVOP);
+ cv = GvCV(kGVOP_gv);
if (!cv)
goto restore_2cv;
if (CvLVALUE(cv))
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) ;
}
#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;
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)
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;
{
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 */
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);
}
}
#endif /* USE_THREADS */
ENTER;
- SAVESPTR(PL_curpad);
+ SAVEVPTR(PL_curpad);
PL_curpad = 0;
if (!CvCLONED(cv))
}
}
-#ifdef DEBUGGING
STATIC void
S_cv_dump(pTHX_ CV *cv)
{
+#ifdef DEBUGGING
CV *outside = CvOUTSIDE(cv);
AV* padlist = CvPADLIST(cv);
AV* pad_name;
(IV)I_32(SvNVX(pname[ix])),
SvIVX(pname[ix]));
}
-}
#endif /* DEBUGGING */
+}
STATIC CV *
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);
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 {
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;
}
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))
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
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;
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);
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;
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);
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;
}
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;
}
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);
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;
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,
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"))
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")
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;
(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);
return;
ENTER;
SAVEOP();
- SAVESPTR(PL_curcop);
+ SAVEVPTR(PL_curcop);
for (; o; o = o->op_next) {
if (o->op_seq)
break;
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:
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();
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) {
https://perl5.git.perl.org / perl5.git / blobdiff