remove VIRTUAL tag, PERL_OBJECT doesn't need it anymore
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index d088021..cb868a4 100644 (file)
--- a/op.c
+++ b/op.c
 #include "keywords.h"
 
 /* #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 PL_OP_SLAB_ALLOC 
 #define SLAB_SIZE 8192
 static char    *PL_OpPtr  = NULL;
@@ -450,12 +456,14 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     SvFLAGS(sv) |= tmptype;
     PL_curpad = AvARRAY(PL_comppad);
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad,
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad),
                          (long) retval, PL_op_name[optype]));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n",
-                         (unsigned long) PL_curpad,
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "Pad 0x%"UVxf" alloc %ld for %s\n",
+                         PTR2UV(PL_curpad),
                          (long) retval, PL_op_name[optype]));
 #endif /* USE_THREADS */
     return (PADOFFSET)retval;
@@ -466,13 +474,14 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
 {
     dTHR;
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" sv %d\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), po));
 #else
     if (!po)
        Perl_croak(aTHX_ "panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %d\n",
+                         PTR2UV(PL_curpad), po));
 #endif /* USE_THREADS */
     return PL_curpad[po];              /* eventually we'll turn this into a macro */
 }
@@ -488,11 +497,12 @@ Perl_pad_free(pTHX_ PADOFFSET po)
     if (!po)
        Perl_croak(aTHX_ "panic: pad_free po");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" free %d\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %d\n",
+                         PTR2UV(PL_curpad), po));
 #endif /* USE_THREADS */
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
        SvPADTMP_off(PL_curpad[po]);
@@ -509,11 +519,12 @@ Perl_pad_swipe(pTHX_ PADOFFSET po)
     if (!po)
        Perl_croak(aTHX_ "panic: pad_swipe po");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" swipe %d\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %d\n",
+                         PTR2UV(PL_curpad), po));
 #endif /* USE_THREADS */
     SvPADTMP_off(PL_curpad[po]);
     PL_curpad[po] = NEWSV(1107,0);
@@ -538,11 +549,12 @@ Perl_pad_reset(pTHX)
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" reset\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad)));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
-                         (unsigned long) PL_curpad));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n",
+                         PTR2UV(PL_curpad)));
 #endif /* USE_THREADS */
     if (!PL_tainting) {        /* Can't mix tainted and non-tainted temporaries. */
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
@@ -634,6 +646,26 @@ Perl_op_free(pTHX_ OP *o)
     if (!o || o->op_seq == (U16)-1)
        return;
 
+    if (o->op_private & OPpREFCOUNTED) {
+       switch (o->op_type) {
+       case OP_LEAVESUB:
+       case OP_LEAVESUBLV:
+       case OP_LEAVEEVAL:
+       case OP_LEAVE:
+       case OP_SCOPE:
+       case OP_LEAVEWRITE:
+           OP_REFCNT_LOCK;
+           if (OpREFCNT_dec(o)) {
+               OP_REFCNT_UNLOCK;
+               return;
+           }
+           OP_REFCNT_UNLOCK;
+           break;
+       default:
+           break;
+       }
+    }
+
     if (o->op_flags & OPf_KIDS) {
        for (kid = cUNOPo->op_first; kid; kid = nextkid) {
            nextkid = kid->op_sibling; /* Get before next freeing kid */
@@ -685,8 +717,8 @@ S_op_clear(pTHX_ OP *o)
     case OP_GVSV:
     case OP_GV:
     case OP_AELEMFAST:
-       SvREFCNT_dec(cGVOPo->op_gv);
-       cGVOPo->op_gv = Nullgv;
+       SvREFCNT_dec(cSVOPo->op_sv);
+       cSVOPo->op_sv = Nullsv;
        break;
     case OP_CONST:
        SvREFCNT_dec(cSVOPo->op_sv);
@@ -729,7 +761,7 @@ STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
     Safefree(cop->cop_label);
-    SvREFCNT_dec(cop->cop_filegv);
+    SvREFCNT_dec(CopFILEGV(cop));
     if (! specialWARN(cop->cop_warnings))
        SvREFCNT_dec(cop->cop_warnings);
 }
@@ -1325,7 +1357,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
                    break;
                }
                
-               cv = GvCV(kGVOP->op_gv);
+               cv = GvCV((GV*)kSVOP->op_sv);
                if (!cv) 
                    goto restore_2cv;
                if (CvLVALUE(cv))
@@ -1951,6 +1983,8 @@ Perl_newPROG(pTHX_ OP *o)
                               ((PL_in_eval & EVAL_KEEPERR)
                                ? OPf_SPECIAL : 0), o);
        PL_eval_start = linklist(PL_eval_root);
+       PL_eval_root->op_private |= OPpREFCOUNTED;
+       OpREFCNT_set(PL_eval_root, 1);
        PL_eval_root->op_next = 0;
        peep(PL_eval_start);
     }
@@ -1960,6 +1994,8 @@ Perl_newPROG(pTHX_ OP *o)
        PL_main_root = scope(sawparens(scalarvoid(o)));
        PL_curcop = &PL_compiling;
        PL_main_start = LINKLIST(PL_main_root);
+       PL_main_root->op_private |= OPpREFCOUNTED;
+       OpREFCNT_set(PL_main_root, 1);
        PL_main_root->op_next = 0;
        peep(PL_main_start);
        PL_compcv = 0;
@@ -1970,7 +2006,7 @@ Perl_newPROG(pTHX_ OP *o)
            if (cv) {
                dSP;
                PUSHMARK(SP);
-               XPUSHs((SV*)PL_compiling.cop_filegv);
+               XPUSHs((SV*)CopFILEGV(&PL_compiling));
                PUTBACK;
                call_sv((SV*)cv, G_DISCARD);
            }
@@ -2779,7 +2815,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
                    }
 #else
                    if (curop->op_type == OP_GV) {
-                       GV *gv = ((GVOP*)curop)->op_gv;
+                       GV *gv = (GV*)((SVOP*)curop)->op_sv;
                        repl_has_vars = 1;
                        if (strchr("&`'123456789+", *GvENAME(gv)))
                            break;
@@ -2863,18 +2899,7 @@ OP *
 Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
 {
     dTHR;
-    GVOP *gvop;
-    NewOp(1101, gvop, 1, GVOP);
-    gvop->op_type = type;
-    gvop->op_ppaddr = PL_ppaddr[type];
-    gvop->op_gv = (GV*)SvREFCNT_inc(gv);
-    gvop->op_next = (OP*)gvop;
-    gvop->op_flags = flags;
-    if (PL_opargs[type] & OA_RETSCALAR)
-       scalar((OP*)gvop);
-    if (PL_opargs[type] & OA_TARGET)
-       gvop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return CHECKOP(type, gvop);
+    return newSVOP(type, flags, SvREFCNT_inc(gv));
 }
 
 OP *
@@ -3113,7 +3138,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 = ((GVOP*)curop)->op_gv;
+                       GV *gv = (GV*)((SVOP*)curop)->op_sv;
                        if (gv == PL_defgv || SvCUR(gv) == PL_generation)
                            break;
                        SvCUR(gv) = PL_generation;
@@ -3165,7 +3190,7 @@ 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*)((GVOP*)tmpop)->op_gv;
+                       pm->op_pmreplroot = (OP*)((SVOP*)tmpop)->op_sv;
                        pm->op_pmflags |= PMf_ONCE;
                        tmpop = cUNOPo->op_first;       /* to list (nulled) */
                        tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
@@ -3249,14 +3274,14 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     if (PL_copline == NOLINE)
         cop->cop_line = PL_curcop->cop_line;
     else {
-        cop->cop_line = PL_copline;
+       cop->cop_line = PL_copline;
         PL_copline = NOLINE;
     }
-    cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv);
+    CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
     cop->cop_stash = PL_curstash;
 
     if (PERLDB_LINE && PL_curstash != PL_debstash) {
-       SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE);
+       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;
@@ -3846,13 +3871,14 @@ cv_dump(CV *cv)
     SV** ppad;
     I32 ix;
 
-    PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
-                 cv,
+    PerlIO_printf(Perl_debug_log,
+                 "\tCV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
+                 PTR2UV(cv),
                  (CvANON(cv) ? "ANON"
                   : (cv == PL_main_cv) ? "MAIN"
                   : CvUNIQUE(cv) ? "UNIQUE"
                   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
-                 outside,
+                 PTR2UV(outside),
                  (!outside ? "null"
                   : CvANON(outside) ? "ANON"
                   : (outside == PL_main_cv) ? "MAIN"
@@ -3869,12 +3895,13 @@ cv_dump(CV *cv)
 
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
        if (SvPOK(pname[ix]))
-           PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
-                         ix, ppad[ix],
+           PerlIO_printf(Perl_debug_log,
+                         "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
+                         ix, PTR2UV(ppad[ix]),
                          SvFAKE(pname[ix]) ? "FAKE " : "",
                          SvPVX(pname[ix]),
-                         (long)I_32(SvNVX(pname[ix])),
-                         (long)SvIVX(pname[ix]));
+                         (IV)I_32(SvNVX(pname[ix])),
+                         SvIVX(pname[ix]));
     }
 }
 #endif /* DEBUG_CLOSURES */
@@ -3914,7 +3941,6 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv)                = 0;
 #endif /* USE_THREADS */
-    CvFILEGV(cv)       = CvFILEGV(proto);
     CvGV(cv)           = (GV*)SvREFCNT_inc(CvGV(proto));
     CvSTASH(cv)                = CvSTASH(proto);
     CvROOT(cv)         = CvROOT(proto);
@@ -4240,7 +4266,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
-    CvFILEGV(cv) = PL_curcop->cop_filegv;
     CvSTASH(cv) = PL_curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
@@ -4318,12 +4343,14 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
 
-    if(CvLVALUE(cv)) {
+    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));
@@ -4339,8 +4366,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            HV *hv;
 
            Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld",
-                   GvSV(PL_curcop->cop_filegv),
-                   (long)PL_subline, (long)PL_curcop->cop_line);
+                          CopFILESV(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);
            hv = GvHVn(db_postponed);
@@ -4361,7 +4388,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        if (strEQ(s, "BEGIN")) {
            I32 oldscope = PL_scopestack_ix;
            ENTER;
-           SAVESPTR(PL_compiling.cop_filegv);
+           SAVESPTR(CopFILEGV(&PL_compiling));
            SAVEI16(PL_compiling.cop_line);
            save_svref(&PL_rs);
            sv_setsv(PL_rs, PL_nrs);
@@ -4473,7 +4500,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
     MUTEX_INIT(CvMUTEXP(cv));
     CvOWNER(cv) = 0;
 #endif /* USE_THREADS */
-    CvFILEGV(cv) = gv_fetchfile(filename);
+    (void)gv_fetchfile(filename);
     CvXSUB(cv) = subaddr;
 
     if (name) {
@@ -4537,7 +4564,6 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     cv = PL_compcv;
     GvFORM(gv) = cv;
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
-    CvFILEGV(cv) = PL_curcop->cop_filegv;
 
     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
        if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
@@ -4545,6 +4571,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     }
 
     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 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));
@@ -5659,11 +5687,11 @@ S_simplify_sort(pTHX_ OP *o)
     if (kUNOP->op_first->op_type != OP_GV)
        return;
     kid = kUNOP->op_first;                             /* get past rv2sv */
-    if (GvSTASH(kGVOP->op_gv) != PL_curstash)
+    if (GvSTASH((GV*)kSVOP->op_sv) != PL_curstash)
        return;
-    if (strEQ(GvNAME(kGVOP->op_gv), "a"))
+    if (strEQ(GvNAME((GV*)kSVOP->op_sv), "a"))
        reversed = 0;
-    else if(strEQ(GvNAME(kGVOP->op_gv), "b"))
+    else if(strEQ(GvNAME((GV*)kSVOP->op_sv), "b"))
        reversed = 1;
     else
        return;
@@ -5674,10 +5702,10 @@ S_simplify_sort(pTHX_ OP *o)
     if (kUNOP->op_first->op_type != OP_GV)
        return;
     kid = kUNOP->op_first;                             /* get past rv2sv */
-    if (GvSTASH(kGVOP->op_gv) != PL_curstash
+    if (GvSTASH((GV*)kSVOP->op_sv) != PL_curstash
        || ( reversed
-           ? strNE(GvNAME(kGVOP->op_gv), "a")
-           : strNE(GvNAME(kGVOP->op_gv), "b")))
+           ? strNE(GvNAME((GV*)kSVOP->op_sv), "a")
+           : strNE(GvNAME((GV*)kSVOP->op_sv), "b")))
        return;
     o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
     if (reversed)
@@ -6076,11 +6104,11 @@ Perl_peep(pTHX_ register OP *o)
                    o->op_type = OP_AELEMFAST;
                    o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
                    o->op_private = (U8)i;
-                   GvAVn(((GVOP*)o)->op_gv);
+                   GvAVn((GV*)((SVOP*)o)->op_sv);
                }
            }
            else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
-               GV *gv = cGVOPo->op_gv;
+               GV *gv = (GV*)cSVOPo->op_sv;
                if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
                    /* XXX could check prototype here instead of just carping */
                    SV *sv = sv_newmortal();