add workaround for dlopen() bug on OpenBSD (relative paths that
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 4f8ab08..383e917 100644 (file)
--- a/op.c
+++ b/op.c
 /* #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
@@ -505,8 +512,12 @@ Perl_pad_free(pTHX_ PADOFFSET 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)
+    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;
 }
@@ -660,7 +671,6 @@ Perl_op_free(pTHX_ OP *o)
                OP_REFCNT_UNLOCK;
                return;
            }
-           o->op_targ = 0;             /* XXXXXX */
            OP_REFCNT_UNLOCK;
            break;
        default:
@@ -2230,6 +2240,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     PL_op = curop = LINKLIST(o);
     o->op_next = 0;
+    peep(curop);
     pp_pushmark();
     CALLRUNOPS(aTHX);
     PL_op = curop;
@@ -4127,9 +4138,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;
 }
 
@@ -5587,31 +5598,6 @@ Perl_ck_sassign(pTHX_ OP *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. */
@@ -6195,26 +6181,13 @@ Perl_peep(pTHX_ register OP *o)
        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;