/* #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;
}
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;