# define CopFILE(c) ((c)->cop_file)
# define CopFILEGV(c) (CopFILE(c) \
? gv_fetchfile(CopFILE(c)) : Nullgv)
-# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) /* XXX */
+# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
# define CopFILESV(c) (CopFILE(c) \
? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
# define CopFILEAV(c) (CopFILE(c) \
? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
# define CopSTASHPV(c) ((c)->cop_stashpv)
-# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv)) /* XXX */
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv))
# define CopSTASH(c) (CopSTASHPV(c) \
? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
# define CopSTASH_set(c,hv) CopSTASHPV_set(c, HvNAME(hv))
-# define CopSTASH_eq(c,hv) (hv \
+# define CopSTASH_eq(c,hv) ((hv) \
&& (CopSTASHPV(c) == HvNAME(hv) \
|| (CopSTASHPV(c) && HvNAME(hv) \
&& strEQ(CopSTASHPV(c), HvNAME(hv)))))
#else
# define CopFILEGV(c) ((c)->cop_filegv)
-# define CopFILEGV_set(c,gv) ((c)->cop_filegv = gv)
-# define CopFILE_set(c,pv) ((c)->cop_filegv = gv_fetchfile(pv))
+# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
+# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
# define CopSTASH(c) ((c)->cop_stash)
-# define CopSTASH_set(c,hv) ((c)->cop_stash = hv)
+# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
-# define CopSTASHPV_set(c,pv) CopSTASH_set(c, gv_stashpv(pv,GV_ADD))
-# define CopSTASH_eq(c,hv) (CopSTASH(c) == hv)
+ /* cop_stash is not refcounted */
+# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
+# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
#endif /* USE_ITHREADS */
#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv))
#define save_freeop Perl_save_freeop
#define save_freepv Perl_save_freepv
#define save_generic_svref Perl_save_generic_svref
+#define save_generic_pvref Perl_save_generic_pvref
#define save_gp Perl_save_gp
#define save_hash Perl_save_hash
#define save_helem Perl_save_helem
#define save_freeop(a) Perl_save_freeop(aTHX_ a)
#define save_freepv(a) Perl_save_freepv(aTHX_ a)
#define save_generic_svref(a) Perl_save_generic_svref(aTHX_ a)
+#define save_generic_pvref(a) Perl_save_generic_pvref(aTHX_ a)
#define save_gp(a,b) Perl_save_gp(aTHX_ a,b)
#define save_hash(a) Perl_save_hash(aTHX_ a)
#define save_helem(a,b,c) Perl_save_helem(aTHX_ a,b,c)
#define save_freepv Perl_save_freepv
#define Perl_save_generic_svref CPerlObj::Perl_save_generic_svref
#define save_generic_svref Perl_save_generic_svref
+#define Perl_save_generic_pvref CPerlObj::Perl_save_generic_pvref
+#define save_generic_pvref Perl_save_generic_pvref
#define Perl_save_gp CPerlObj::Perl_save_gp
#define save_gp Perl_save_gp
#define Perl_save_hash CPerlObj::Perl_save_hash
p |void |save_freeop |OP* o
Ap |void |save_freepv |char* pv
Ap |void |save_generic_svref|SV** sptr
+Ap |void |save_generic_pvref|char** str
Ap |void |save_gp |GV* gv|I32 empty
Ap |HV* |save_hash |GV* gv
Ap |void |save_helem |HV* hv|SV *key|SV **sptr
#define Perl_save_generic_svref pPerl->Perl_save_generic_svref
#undef save_generic_svref
#define save_generic_svref Perl_save_generic_svref
+#undef Perl_save_generic_pvref
+#define Perl_save_generic_pvref pPerl->Perl_save_generic_pvref
+#undef save_generic_pvref
+#define save_generic_pvref Perl_save_generic_pvref
#undef Perl_save_gp
#define Perl_save_gp pPerl->Perl_save_gp
#undef save_gp
{
Safefree(cop->cop_label);
#ifdef USE_ITHREADS
- Safefree(CopFILE(cop)); /* XXXXX share in a pvtable? */
- Safefree(CopSTASHPV(cop)); /* XXXXX share in a pvtable? */
+ Safefree(CopFILE(cop)); /* XXX share in a pvtable? */
+ Safefree(CopSTASHPV(cop)); /* XXX share in a pvtable? */
#else
/* NOTE: COP.cop_stash is not refcounted */
SvREFCNT_dec(CopFILEGV(cop));
PL_copline = NOLINE;
}
#ifdef USE_ITHREADS
- CopFILE_set(cop, CopFILE(PL_curcop)); /* XXXXX share in a pvtable? */
+ CopFILE_set(cop, CopFILE(PL_curcop)); /* XXX share in a pvtable? */
#else
- CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
+ CopFILEGV_set(cop, CopFILEGV(PL_curcop));
#endif
CopSTASH_set(cop, PL_curstash);
dTHR;
ENTER;
- SAVECOPLINE(PL_curcop);
- SAVEHINTS();
+ SAVECOPLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_copline);
+
+ SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash) {
if (!specialWARN(PL_compiling.cop_warnings))
SvREFCNT_dec(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = Nullsv;
-#ifndef USE_ITHREADS
+#ifdef USE_ITHREADS
+ Safefree(CopFILE(&PL_compiling));
+ CopFILE(&PL_compiling) = Nullch;
+ Safefree(CopSTASHPV(&PL_compiling));
+#else
SvREFCNT_dec(CopFILEGV(&PL_compiling));
- CopFILEGV_set(&PL_compiling, Nullgv);
+ CopFILEGV(&PL_compiling) = Nullgv;
+ /* cop_stash is not refcounted */
#endif
/* Prepare to destruct main symbol table. */
}
}
+#ifdef USE_ITHREADS
+ Safefree(CopFILE(PL_curcop));
+#else
+ SvREFCNT_dec(CopFILEGV(PL_curcop));
+#endif
CopFILE_set(PL_curcop, PL_origfilename);
if (strEQ(PL_origfilename,"-"))
scriptname = "";
((CPerlObj*)pPerl)->Perl_save_generic_svref(sptr);
}
+#undef Perl_save_generic_pvref
+void
+Perl_save_generic_pvref(pTHXo_ char** str)
+{
+ ((CPerlObj*)pPerl)->Perl_save_generic_pvref(str);
+}
+
#undef Perl_save_gp
void
Perl_save_gp(pTHXo_ GV* gv, I32 empty)
#endif
struct ysv *ysave;
+#ifdef USE_ITHREADS
+ ENTER; /* force yydestruct() before we return */
+#endif
New(73, ysave, 1, struct ysv);
SAVEDESTRUCTOR_X(yydestruct, ysave);
ysave->oldyydebug = yydebug;
yyabort:
retval = 1;
yyaccept:
+#ifdef USE_ITHREADS
+ LEAVE; /* force yydestruct() before we return */
+#endif
return retval;
}
if (yys = getenv("YYDEBUG"))
{
yyn = *yys;
---- 1447,1473 ----
+--- 1447,1476 ----
yyparse()
{
register int yym, yyn, yystate;
! #endif
+ struct ysv *ysave;
++ #ifdef USE_ITHREADS
++ ENTER; /* force yydestruct() before we return */
++ #endif
+ New(73, ysave, 1, struct ysv);
+ SAVEDESTRUCTOR_X(yydestruct, ysave);
+ ysave->oldyydebug = yydebug;
yyn = *yys;
***************
*** 1463,1468 ****
---- 1480,1495 ----
+--- 1483,1498 ----
yyerrflag = 0;
yychar = (-1);
}
*++yyssp = yystate = yytable[yyn];
*++yyvsp = yylval;
---- 1520,1538 ----
+--- 1523,1541 ----
#endif
if (yyssp >= yyss + yystacksize - 1)
{
}
*++yyssp = yystate = yytable[yyn];
*++yyvsp = yylval;
---- 1573,1591 ----
+--- 1576,1594 ----
#endif
if (yyssp >= yyss + yystacksize - 1)
{
yyaccept:
! return (0);
}
---- 2524,2569 ----
+--- 2527,2575 ----
#endif
if (yyssp >= yyss + yystacksize - 1)
{
yyabort:
! retval = 1;
yyaccept:
+! #ifdef USE_ITHREADS
+! LEAVE; /* force yydestruct() before we return */
+! #endif
! return retval;
! }
!
/* switch to eval mode */
if (PL_curcop == &PL_compiling) {
- SAVECOPSTASH(&PL_compiling);
+ SAVECOPSTASH_FREE(&PL_compiling);
CopSTASH_set(&PL_compiling, PL_curstash);
}
- SAVECOPFILE(&PL_compiling);
- SAVECOPLINE(&PL_compiling);
if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
SV *sv = sv_newmortal();
Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]",
}
else
sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
+ SAVECOPFILE_FREE(&PL_compiling);
CopFILE_set(&PL_compiling, tmpbuf+2);
+ SAVECOPLINE(&PL_compiling);
CopLINE_set(&PL_compiling, 1);
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
}
}
}
- SAVECOPFILE(&PL_compiling);
+ SAVECOPFILE_FREE(&PL_compiling);
CopFILE_set(&PL_compiling, tryrsfp ? tryname : name);
SvREFCNT_dec(namesv);
if (!tryrsfp) {
/* switch to eval mode */
- SAVECOPFILE(&PL_compiling);
if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
SV *sv = sv_newmortal();
Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
}
else
sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
+ SAVECOPFILE_FREE(&PL_compiling);
CopFILE_set(&PL_compiling, tmpbuf+2);
+ SAVECOPLINE(&PL_compiling);
CopLINE_set(&PL_compiling, 1);
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
PERL_CALLCONV void Perl_save_freeop(pTHX_ OP* o);
PERL_CALLCONV void Perl_save_freepv(pTHX_ char* pv);
PERL_CALLCONV void Perl_save_generic_svref(pTHX_ SV** sptr);
+PERL_CALLCONV void Perl_save_generic_pvref(pTHX_ char** str);
PERL_CALLCONV void Perl_save_gp(pTHX_ GV* gv, I32 empty);
PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv);
PERL_CALLCONV void Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr);
return save_scalar_at(sptr);
}
-/* Like save_svref(), but doesn't deal with magic. Can be used to
+/* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to
* restore a global SV to its prior contents, freeing new value. */
void
Perl_save_generic_svref(pTHX_ SV **sptr)
SSPUSHINT(SAVEt_GENERIC_SVREF);
}
+/* Like save_pptr(), but also Safefree()s the new value if it is different
+ * from the old one. Can be used to restore a global char* to its prior
+ * contents, freeing new value. */
+void
+Perl_save_generic_pvref(pTHX_ char **str)
+{
+ dTHR;
+ SSCHECK(3);
+ SSPUSHPTR(str);
+ SSPUSHPTR(*str);
+ SSPUSHINT(SAVEt_GENERIC_PVREF);
+}
+
void
Perl_save_gp(pTHX_ GV *gv, I32 empty)
{
register AV *av;
register HV *hv;
register void* ptr;
+ register char* str;
I32 i;
if (base < -1)
ptr = &GvSV(gv);
SvREFCNT_dec(gv);
goto restore_sv;
+ case SAVEt_GENERIC_PVREF: /* generic pv */
+ str = (char*)SSPOPPTR;
+ ptr = SSPOPPTR;
+ if (*(char**)ptr != str) {
+ Safefree(*(char**)ptr);
+ *(char**)ptr = str;
+ }
+ break;
case SAVEt_GENERIC_SVREF: /* generic sv */
value = (SV*)SSPOPPTR;
ptr = SSPOPPTR;
- if (ptr) {
- sv = *(SV**)ptr;
- *(SV**)ptr = value;
- SvREFCNT_dec(sv);
- }
+ sv = *(SV**)ptr;
+ *(SV**)ptr = value;
+ SvREFCNT_dec(sv);
SvREFCNT_dec(value);
break;
case SAVEt_SVREF: /* scalar reference */
#define SAVEt_VPTR 31
#define SAVEt_I8 32
#define SAVEt_COMPPAD 33
+#define SAVEt_GENERIC_PVREF 34
#define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow()
#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
#define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p))
#define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv))
#define SAVEGENERICSV(s) save_generic_svref((SV**)&(s))
+#define SAVEGENERICPV(s) save_generic_pvref((char**)&(s))
#define SAVEDELETE(h,k,l) \
save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l))
#define SAVEDESTRUCTOR(f,p) \
} STMT_END
#ifdef USE_ITHREADS
-# define SAVECOPSTASH(cop) SAVEPPTR(CopSTASHPV(cop))
-# define SAVECOPFILE(cop) SAVEPPTR(CopFILE(cop))
+# define SAVECOPSTASH(c) SAVEPPTR(CopSTASHPV(c))
+# define SAVECOPSTASH_FREE(c) SAVEGENERICPV(CopSTASHPV(c))
+# define SAVECOPFILE(c) SAVEPPTR(CopFILE(c))
+# define SAVECOPFILE_FREE(c) SAVEGENERICPV(CopFILE(c))
#else
-# define SAVECOPSTASH(cop) SAVESPTR(CopSTASH(cop))
-# define SAVECOPFILE(cop) SAVESPTR(CopFILEGV(cop))
+# define SAVECOPSTASH(c) SAVESPTR(CopSTASH(c))
+# define SAVECOPSTASH_FREE(c) SAVECOPSTASH(c) /* XXX not refcounted */
+# define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c))
+# define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c))
#endif
-#define SAVECOPLINE(cop) SAVEI16(CopLINE(cop))
+#define SAVECOPLINE(c) SAVEI16(CopLINE(c))
/* SSNEW() temporarily allocates a specified number of bytes of data on the
* savestack. It returns an integer index into the savestack, because a
gv = (GV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = gv_dup_inc(gv);
break;
+ case SAVEt_GENERIC_PVREF: /* generic char* */
+ c = (char*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = pv_dup(c);
+ ptr = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ break;
case SAVEt_GENERIC_SVREF: /* generic sv */
case SAVEt_SVREF: /* scalar reference */
sv = (SV*)POPPTR(ss,ix);
ch = *t;
*t = '\0';
- if (t - s > 0)
+ if (t - s > 0) {
+#ifdef USE_ITHREADS
+ Safefree(CopFILE(PL_curcop));
+#else
+ SvREFCNT_dec(CopFILEGV(PL_curcop));
+#endif
CopFILE_set(PL_curcop, s);
+ }
*t = ch;
CopLINE_set(PL_curcop, atoi(n)-1);
}
PL_expect = XTERM;
TOKEN('(');
case ';':
- if (CopLINE(PL_curcop) < PL_copline)
- PL_copline = CopLINE(PL_curcop);
+ CLINE;
tmp = *s++;
OPERATOR(tmp);
case ')':
#endif
struct ysv *ysave;
+#ifdef USE_ITHREADS
+ ENTER; /* force yydestruct() before we return */
+#endif
New(73, ysave, 1, struct ysv);
SAVEDESTRUCTOR_X(yydestruct, ysave);
ysave->oldyydebug = yydebug;
yyabort:
retval = 1;
yyaccept:
+#ifdef USE_ITHREADS
+ LEAVE; /* force yydestruct() before we return */
+#endif
return retval;
}