#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;
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;
{
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 %"IVdf"\n",
+ PTR2UV(thr), PTR2UV(PL_curpad), (IV)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 %"IVdf"\n",
+ PTR2UV(PL_curpad), (IV)po));
#endif /* USE_THREADS */
return PL_curpad[po]; /* eventually we'll turn this into a macro */
}
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 %"IVd"\n",
+ PTR2UV(thr), PTR2UV(PL_curpad), (IV)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 %"IVdf"\n",
+ PTR2UV(PL_curpad), (IV)po));
#endif /* USE_THREADS */
if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
SvPADTMP_off(PL_curpad[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 %"IVdf"\n",
+ PTR2UV(thr), PTR2UV(PL_curpad), (IV)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 %"IVdf"\n",
+ PTR2UV(PL_curpad), (IV)po));
#endif /* USE_THREADS */
SvPADTMP_off(PL_curpad[po]);
PL_curpad[po] = NEWSV(1107,0);
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--) {
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 */
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);
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);
}
}
else { /* lvalue subroutine call */
o->op_private |= OPpLVAL_INTRO;
- if (type == OP_GREPSTART || type == OP_ENTERSUB) {
+ if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) {
/* Backward compatibility mode: */
o->op_private |= OPpENTERSUB_INARGS;
break;
break;
}
- cv = GvCV(kGVOP->op_gv);
+ cv = GvCV((GV*)kSVOP->op_sv);
if (!cv)
goto restore_2cv;
if (CvLVALUE(cv))
char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
right->op_type == OP_TRANS)
? right->op_type : OP_MATCH];
- char *sample = ((left->op_type == OP_RV2AV ||
- left->op_type == OP_PADAV)
- ? "@array" : "%hash");
+ const char *sample = ((left->op_type == OP_RV2AV ||
+ left->op_type == OP_PADAV)
+ ? "@array" : "%hash");
Perl_warner(aTHX_ WARN_UNSAFE,
"Applying %s to %s will act on scalar(%s)",
desc, sample, sample);
((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);
}
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;
if (cv) {
dSP;
PUSHMARK(SP);
- XPUSHs((SV*)PL_compiling.cop_filegv);
+ XPUSHs((SV*)CopFILEGV(&PL_compiling));
PUTBACK;
call_sv((SV*)cv, G_DISCARD);
}
return o;
if (!(PL_hints & HINT_INTEGER)) {
- if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
+ if (type == OP_MODULO
+ || type == OP_DIVIDE
+ || !(o->op_flags & OPf_KIDS))
+ {
return o;
+ }
for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
if (curop->op_type == OP_CONST) {
}
#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;
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 *
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;
{
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 */
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;
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"
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 */
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);
}
}
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
- CvFILEGV(cv) = PL_curcop->cop_filegv;
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(cv) = 0;
}
}
- 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));
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);
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);
av_store(PL_endav, 0, (SV *)cv);
GvCV(gv) = 0;
}
+ else if (strEQ(s, "STOP") && !PL_error_count) {
+ if (!PL_stopav)
+ PL_stopav = newAV();
+ av_unshift(PL_stopav, 1);
+ av_store(PL_stopav, 0, (SV *)cv);
+ GvCV(gv) = 0;
+ }
else if (strEQ(s, "INIT") && !PL_error_count) {
if (!PL_initav)
PL_initav = newAV();
MUTEX_INIT(CvMUTEXP(cv));
CvOWNER(cv) = 0;
#endif /* USE_THREADS */
- CvFILEGV(cv) = gv_fetchfile(filename);
+ (void)gv_fetchfile(filename);
CvXSUB(cv) = subaddr;
if (name) {
av_store(PL_endav, 0, (SV *)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);
+ GvCV(gv) = 0;
+ }
else if (strEQ(s, "INIT")) {
if (!PL_initav)
PL_initav = newAV();
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]))
}
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));
dTHR;
I32 type = o->op_type;
- if (o->op_flags & OPf_REF)
- return o;
-
- if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
+ if (o->op_flags & OPf_REF) {
+ /* nothing */
+ }
+ else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
OP *newop = newGVOP(type, OPf_REF,
gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
op_free(o);
- return newop;
+ o = newop;
}
}
else {
op_free(o);
if (type == OP_FTTTY)
- return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
+ o = newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
SVt_PVIO));
else
- return newUNOP(type, 0, newDEFSVOP());
+ o = newUNOP(type, 0, newDEFSVOP());
}
+#ifdef USE_LOCALE
+ if (type == OP_FTTEXT || type == OP_FTBINARY) {
+ o->op_private = 0;
+ if (PL_hints & HINT_LOCALE)
+ o->op_private |= OPpLOCALE;
+ }
+#endif
return o;
}
if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
-#if 1 /*def PERL_INTERNAL_GLOB */
+#if defined(PERL_INTERNAL_GLOB) && !defined(MINIPERL_BUILD)
/* 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 */
+#endif /* PERL_INTERNAL_GLOB && !MINIPERL_BUILD */
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 */
- 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;
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)
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();
break;
case OP_RETURN:
- if (o->op_next->op_type != OP_LEAVESUBLV) {
+ if (o->op_next && o->op_next->op_type != OP_LEAVESUBLV) {
o->op_seq = PL_op_seqmax++;
break;
}