/* #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) ((o)->op_targ--)
+#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
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)
+ if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
SvPADTMP_off(PL_curpad[po]);
+#ifdef USE_ITHREADS
+ SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
+#endif
+ }
if ((I32)po < PL_padix)
PL_padix = po - 1;
}
OP_REFCNT_UNLOCK;
return;
}
- o->op_targ = 0; /* XXXXXX */
OP_REFCNT_UNLOCK;
break;
default:
PL_op = curop = LINKLIST(o);
o->op_next = 0;
+ peep(curop);
pp_pushmark();
CALLRUNOPS(aTHX);
PL_op = curop;
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;
}
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));
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 (kkid && kkid->op_type == OP_PADSV
&& !(kkid->op_private & OPpLVAL_INTRO))
{
- /* Concat has problems if target is equal to right arg. */
- if (kid->op_type == OP_CONCAT) {
- if (kLISTOP->op_first->op_sibling->op_type == OP_PADSV
- && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ)
- return o;
- }
- else if (kid->op_type == OP_JOIN) {
- /* do_join has problems if the arguments coincide with target.
- In fact the second argument *can* safely coincide,
- but ignore=pessimize this rare occasion. */
- OP *arg = kLISTOP->op_first->op_sibling; /* Skip PUSHMARK */
-
- while (arg) {
- if (arg->op_type == OP_PADSV
- && arg->op_targ == kkid->op_targ)
- return o;
- arg = arg->op_sibling;
- }
- }
- else if (kid->op_type == OP_QUOTEMETA) {
- /* quotemeta has problems if the argument coincides with target. */
- if (kLISTOP->op_first->op_type == OP_PADSV
- && kLISTOP->op_first->op_targ == kkid->op_targ)
- return o;
- }
kid->op_targ = kkid->op_targ;
kkid->op_targ = 0;
/* Now we do not need PADSV and SASSIGN. */
case OP_UCFIRST:
case OP_LC:
case OP_LCFIRST:
- if ( o->op_next && o->op_next->op_type == OP_STRINGIFY
- && !(o->op_next->op_private & OPpTARGET_MY) )
- null(o->op_next);
- o->op_seq = PL_op_seqmax++;
- break;
case OP_CONCAT:
case OP_JOIN:
case OP_QUOTEMETA:
if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
if (o->op_next->op_private & OPpTARGET_MY) {
- if ((o->op_flags & OPf_STACKED) /* chained concats */
- || (o->op_type == OP_CONCAT
- /* Concat has problems if target is equal to right arg. */
- && (((LISTOP*)o)->op_first->op_sibling->op_type
- == OP_PADSV)
- && (((LISTOP*)o)->op_first->op_sibling->op_targ
- == o->op_next->op_targ)))
- {
+ if (o->op_flags & OPf_STACKED) /* chained concats */
goto ignore_optimization;
- }
else {
o->op_targ = o->op_next->op_targ;
o->op_next->op_targ = 0;
projects / p5sagit/p5-mst-13.2.git / blobdiff