summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--cop.h17
-rw-r--r--embed.h4
-rwxr-xr-xembed.pl1
-rw-r--r--objXSUB.h4
-rw-r--r--op.c13
-rw-r--r--perl.c14
-rw-r--r--perlapi.c7
-rw-r--r--perly.c6
-rw-r--r--perly_c.diff16
-rw-r--r--pp_ctl.c11
-rw-r--r--proto.h1
-rw-r--r--scope.c32
-rw-r--r--scope.h16
-rw-r--r--sv.c6
-rw-r--r--toke.c11
-rw-r--r--vms/perly_c.vms6
16 files changed, 125 insertions, 40 deletions
diff --git a/cop.h b/cop.h
index 3b3c3edbdb..d6fdd23ab2 100644
--- a/cop.h
+++ b/cop.h
@@ -29,32 +29,33 @@ struct cop {
# 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))
diff --git a/embed.h b/embed.h
index 76ff0dc9e6..33ef720e9d 100644
--- a/embed.h
+++ b/embed.h
@@ -571,6 +571,7 @@
#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
@@ -2019,6 +2020,7 @@
#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)
@@ -3954,6 +3956,8 @@
#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
diff --git a/embed.pl b/embed.pl
index 43dbde5924..8a89103380 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1886,6 +1886,7 @@ Ap |void |save_freesv |SV* sv
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
diff --git a/objXSUB.h b/objXSUB.h
index 97e9ba4098..25536e902f 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1345,6 +1345,10 @@
#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
diff --git a/op.c b/op.c
index 57b35ea733..affb5974f2 100644
--- a/op.c
+++ b/op.c
@@ -844,8 +844,8 @@ S_cop_free(pTHX_ COP* cop)
{
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));
@@ -3499,9 +3499,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
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);
@@ -4709,10 +4709,11 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
dTHR;
ENTER;
- SAVECOPLINE(PL_curcop);
- SAVEHINTS();
+ SAVECOPLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_copline);
+
+ SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash) {
diff --git a/perl.c b/perl.c
index 5df462db9d..801dbe15f2 100644
--- a/perl.c
+++ b/perl.c
@@ -600,9 +600,14 @@ perl_destruct(pTHXx)
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. */
@@ -2511,6 +2516,11 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
}
}
+#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 = "";
diff --git a/perlapi.c b/perlapi.c
index 125c6e1003..10a7a37c40 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -2458,6 +2458,13 @@ Perl_save_generic_svref(pTHXo_ SV** sptr)
((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)
diff --git a/perly.c b/perly.c
index 36b51c02e7..d03d3dee98 100644
--- a/perly.c
+++ b/perly.c
@@ -1386,6 +1386,9 @@ yyparse()
#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;
@@ -2477,6 +2480,9 @@ yyoverflow:
yyabort:
retval = 1;
yyaccept:
+#ifdef USE_ITHREADS
+ LEAVE; /* force yydestruct() before we return */
+#endif
return retval;
}
diff --git a/perly_c.diff b/perly_c.diff
index 0b73880c4e..0cfe10f8d7 100644
--- a/perly_c.diff
+++ b/perly_c.diff
@@ -12,7 +12,7 @@
if (yys = getenv("YYDEBUG"))
{
yyn = *yys;
---- 1447,1473 ----
+--- 1447,1476 ----
yyparse()
{
register int yym, yyn, yystate;
@@ -27,6 +27,9 @@
! #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;
@@ -42,7 +45,7 @@
yyn = *yys;
***************
*** 1463,1468 ****
---- 1480,1495 ----
+--- 1483,1498 ----
yyerrflag = 0;
yychar = (-1);
@@ -68,7 +71,7 @@
}
*++yyssp = yystate = yytable[yyn];
*++yyvsp = yylval;
---- 1520,1538 ----
+--- 1523,1541 ----
#endif
if (yyssp >= yyss + yystacksize - 1)
{
@@ -97,7 +100,7 @@
}
*++yyssp = yystate = yytable[yyn];
*++yyvsp = yylval;
---- 1573,1591 ----
+--- 1576,1594 ----
#endif
if (yyssp >= yyss + yystacksize - 1)
{
@@ -134,7 +137,7 @@
yyaccept:
! return (0);
}
---- 2524,2569 ----
+--- 2527,2575 ----
#endif
if (yyssp >= yyss + yystacksize - 1)
{
@@ -160,6 +163,9 @@
yyabort:
! retval = 1;
yyaccept:
+! #ifdef USE_ITHREADS
+! LEAVE; /* force yydestruct() before we return */
+! #endif
! return retval;
! }
!
diff --git a/pp_ctl.c b/pp_ctl.c
index 2060632d55..801f3f1ff1 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2634,11 +2634,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
/* 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"]",
@@ -2648,7 +2646,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
}
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
@@ -3160,7 +3160,7 @@ trylocal: {
}
}
}
- SAVECOPFILE(&PL_compiling);
+ SAVECOPFILE_FREE(&PL_compiling);
CopFILE_set(&PL_compiling, tryrsfp ? tryname : name);
SvREFCNT_dec(namesv);
if (!tryrsfp) {
@@ -3270,7 +3270,6 @@ PP(pp_entereval)
/* 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"]",
@@ -3280,7 +3279,9 @@ PP(pp_entereval)
}
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
diff --git a/proto.h b/proto.h
index eb861e1442..28c9581241 100644
--- a/proto.h
+++ b/proto.h
@@ -651,6 +651,7 @@ PERL_CALLCONV void Perl_save_freesv(pTHX_ SV* sv);
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);
diff --git a/scope.c b/scope.c
index 3b9f0d108a..0544b893d5 100644
--- a/scope.c
+++ b/scope.c
@@ -249,7 +249,7 @@ Perl_save_svref(pTHX_ 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)
@@ -261,6 +261,19 @@ 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)
{
@@ -646,6 +659,7 @@ Perl_leave_scope(pTHX_ I32 base)
register AV *av;
register HV *hv;
register void* ptr;
+ register char* str;
I32 i;
if (base < -1)
@@ -666,14 +680,20 @@ Perl_leave_scope(pTHX_ I32 base)
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 */
diff --git a/scope.h b/scope.h
index f33154abed..e6a4209bd7 100644
--- a/scope.h
+++ b/scope.h
@@ -32,6 +32,7 @@
#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))
@@ -105,6 +106,7 @@ Closing bracket on a callback. See C<ENTER> and L<perlcall>.
#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) \
@@ -147,14 +149,18 @@ Closing bracket on a callback. See C<ENTER> and L<perlcall>.
} 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
diff --git a/sv.c b/sv.c
index 5517355de0..3254cfba3e 100644
--- a/sv.c
+++ b/sv.c
@@ -7152,6 +7152,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
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);
diff --git a/toke.c b/toke.c
index 99c993e8fa..70a7f537c0 100644
--- a/toke.c
+++ b/toke.c
@@ -502,8 +502,14 @@ S_incline(pTHX_ char *s)
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);
}
@@ -2946,8 +2952,7 @@ Perl_yylex(pTHX)
PL_expect = XTERM;
TOKEN('(');
case ';':
- if (CopLINE(PL_curcop) < PL_copline)
- PL_copline = CopLINE(PL_curcop);
+ CLINE;
tmp = *s++;
OPERATOR(tmp);
case ')':
diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index b17faeade1..0676ebd249 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1387,6 +1387,9 @@ yyparse()
#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;
@@ -2479,6 +2482,9 @@ yyoverflow:
yyabort:
retval = 1;
yyaccept:
+#ifdef USE_ITHREADS
+ LEAVE; /* force yydestruct() before we return */
+#endif
return retval;
}
View Lorry Controller Status