summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>1999-11-11 19:48:21 +0000
committerJarkko Hietaniemi <jhi@iki.fi>1999-11-11 19:48:21 +0000
commit8a12f161a3a8b8cc9c866a9f342b9476fb0b9b95 (patch)
treef7d97a5034e7bcae78537a54f77a0067f572f6aa
parent887d29384f0bc4b6197573ce19ff42abfe67fa51 (diff)
parent11faa288e292c27cb2ddc4ccdc483b523d26ce19 (diff)
downloadperl-8a12f161a3a8b8cc9c866a9f342b9476fb0b9b95.tar.gz
Integrate with Sarathy.
p4raw-id: //depot/cfgperl@4549
Diffstat
-rw-r--r--av.h2
-rw-r--r--bytecode.pl7
-rw-r--r--cop.h41
-rw-r--r--cv.h9
-rw-r--r--doio.c13
-rw-r--r--dump.c9
-rw-r--r--embed.h64
-rwxr-xr-xembed.pl18
-rw-r--r--embedvar.h3
-rw-r--r--ext/B/B.pm4
-rw-r--r--ext/B/B.xs19
-rw-r--r--ext/B/B/Asmdata.pm139
-rw-r--r--ext/B/B/Bytecode.pm18
-rw-r--r--ext/B/B/C.pm13
-rw-r--r--ext/B/B/CC.pm4
-rw-r--r--ext/B/B/Debug.pm12
-rw-r--r--ext/B/B/Deparse.pm4
-rw-r--r--ext/B/B/Lint.pm2
-rw-r--r--ext/B/B/Xref.pm2
-rw-r--r--ext/ByteLoader/bytecode.h3
-rw-r--r--ext/ByteLoader/byterun.c159
-rw-r--r--ext/ByteLoader/byterun.h141
-rw-r--r--ext/Devel/Peek/Peek.pm1
-rw-r--r--global.sym13
-rw-r--r--gv.c31
-rw-r--r--gv.h7
-rw-r--r--hv.c59
-rw-r--r--hv.h10
-rw-r--r--intrpvar.h4
-rw-r--r--makedef.pl26
-rw-r--r--objXSUB.h58
-rw-r--r--op.c222
-rw-r--r--op.h97
-rwxr-xr-xopcode.pl2
-rw-r--r--perl.c220
-rw-r--r--perl.h20
-rwxr-xr-xperlapi.c95
-rw-r--r--pp.c6
-rw-r--r--pp_ctl.c104
-rw-r--r--pp_hot.c13
-rw-r--r--pp_sys.c12
-rw-r--r--proto.h17
-rw-r--r--run.c4
-rw-r--r--scope.c2
-rw-r--r--scope.h10
-rw-r--r--sv.c1036
-rw-r--r--sv.h19
-rw-r--r--toke.c153
-rw-r--r--util.c24
-rw-r--r--util.h24
-rw-r--r--win32/perllib.c8
-rw-r--r--win32/win32.c60
-rw-r--r--win32/win32.h65
-rw-r--r--win32/win32iop.h6
-rw-r--r--win32/win32sck.c32
55 files changed, 2305 insertions, 841 deletions
diff --git a/av.h b/av.h
index f537d9eadb..14e87658a6 100644
--- a/av.h
+++ b/av.h
@@ -10,7 +10,7 @@
struct xpvav {
char* xav_array; /* pointer to first array element */
SSize_t xav_fill; /* Index of last element present */
- SSize_t xav_max; /* Number of elements for which array has space */
+ SSize_t xav_max; /* max index for which array has space */
IV xof_off; /* ptr is incremented by offset */
NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* magic for scalar array */
diff --git a/bytecode.pl b/bytecode.pl
index 326633e2fa..00df48b957 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -339,6 +339,7 @@ xcv_stash *(SV**)&CvSTASH(bytecode_sv) svindex
xcv_start CvSTART(bytecode_sv) opindex
xcv_root CvROOT(bytecode_sv) opindex
xcv_gv *(SV**)&CvGV(bytecode_sv) svindex
+xcv_file CvFILE(bytecode_sv) pvcontents
xcv_depth CvDEPTH(bytecode_sv) long
xcv_padlist *(SV**)&CvPADLIST(bytecode_sv) svindex
xcv_outside *(SV**)&CvOUTSIDE(bytecode_sv) svindex
@@ -399,11 +400,11 @@ op_redoop cLOOP->op_redoop opindex
op_nextop cLOOP->op_nextop opindex
op_lastop cLOOP->op_lastop opindex
cop_label cCOP->cop_label pvcontents
-cop_stash *(SV**)&cCOP->cop_stash svindex
-cop_filegv *(SV**)&cCOP->cop_filegv svindex
+cop_stashpv cCOP pvcontents x
+cop_file cCOP pvcontents x
cop_seq cCOP->cop_seq U32
cop_arybase cCOP->cop_arybase I32
-cop_line cCOP->cop_line line_t
+cop_line cCOP line_t x
cop_warnings cCOP->cop_warnings svindex
main_start PL_main_start opindex
main_root PL_main_root opindex
diff --git a/cop.h b/cop.h
index 238c677bb4..d5f7f423a6 100644
--- a/cop.h
+++ b/cop.h
@@ -10,8 +10,13 @@
struct cop {
BASEOP
char * cop_label; /* label for this construct */
+#ifdef USE_ITHREADS
+ char * cop_stashpv; /* package line was compiled in */
+ char * cop_file; /* file name the following line # is from */
+#else
HV * cop_stash; /* package line was compiled in */
GV * cop_filegv; /* file the following line # is from */
+#endif
U32 cop_seq; /* parse sequence number */
I32 cop_arybase; /* array base this line was compiled with */
line_t cop_line; /* line # of this command */
@@ -20,13 +25,37 @@ struct cop {
#define Nullcop Null(COP*)
-#define CopFILEGV(c) (c)->cop_filegv
-#define CopFILEGV_set(c,gv) ((c)->cop_filegv = gv)
-#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)
+#ifdef USE_ITHREADS
+# 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 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 CopSTASH(c) (CopSTASHPV(c) \
+ ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
+# define CopSTASH_set(c,hv) CopSTASHPV_set(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 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 CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
+# define CopSTASHPV_set(c,pv) CopSTASH_set(c, gv_stashpv(pv,GV_ADD))
+#endif /* USE_ITHREADS */
+
#define CopLINE(c) ((c)->cop_line)
-#define CopLINE_set(c,l) ((c)->cop_line = (l))
+#define CopLINE_inc(c) (++CopLINE(c))
+#define CopLINE_dec(c) (--CopLINE(c))
+#define CopLINE_set(c,l) (CopLINE(c) = (l))
/*
* Here we have some enormously heavy (or at least ponderous) wizardry.
diff --git a/cv.h b/cv.h
index b822eaae87..06cbb89b87 100644
--- a/cv.h
+++ b/cv.h
@@ -7,7 +7,8 @@
*
*/
-/* This structure much match the beginning of XPVFM */
+/* This structure much match XPVCV in B/C.pm and the beginning of XPVFM
+ * in sv.h */
struct xpvcv {
char * xpv_pv; /* pointer to malloced string */
@@ -24,9 +25,7 @@ struct xpvcv {
void (*xcv_xsub) (pTHXo_ CV*);
ANY xcv_xsubany;
GV * xcv_gv;
-#if defined(PERL_BINCOMPAT_5005)
- GV * xcv_filegv; /* XXX unused (and deprecated) */
-#endif
+ char * xcv_file;
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
@@ -45,6 +44,8 @@ struct xpvcv {
#define CvXSUB(sv) ((XPVCV*)SvANY(sv))->xcv_xsub
#define CvXSUBANY(sv) ((XPVCV*)SvANY(sv))->xcv_xsubany
#define CvGV(sv) ((XPVCV*)SvANY(sv))->xcv_gv
+#define CvFILE(sv) ((XPVCV*)SvANY(sv))->xcv_file
+#define CvFILEGV(sv) (gv_fetchfile(CvFILE(sv))
#define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth
#define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist
#define CvOUTSIDE(sv) ((XPVCV*)SvANY(sv))->xcv_outside
diff --git a/doio.c b/doio.c
index 76a6276a45..f023ebd12a 100644
--- a/doio.c
+++ b/doio.c
@@ -490,8 +490,11 @@ Perl_nextargv(pTHX_ register GV *gv)
PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
IoFLAGS(io) &= ~IOf_START;
- if (PL_inplace)
+ if (PL_inplace) {
+ if (!PL_argvout_stack)
+ PL_argvout_stack = newAV();
av_push(PL_argvout_stack, SvREFCNT_inc(PL_defoutgv));
+ }
}
if (PL_filemode & (S_ISUID|S_ISGID)) {
PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv))); /* chmod must follow last write */
@@ -668,7 +671,9 @@ Perl_nextargv(pTHX_ register GV *gv)
IoFLAGS(io) |= IOf_START;
if (PL_inplace) {
(void)do_close(PL_argvoutgv,FALSE);
- if (io && (IoFLAGS(io) & IOf_ARGV) && AvFILLp(PL_argvout_stack) >= 0) {
+ if (io && (IoFLAGS(io) & IOf_ARGV)
+ && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
+ {
GV *oldout = (GV*)av_pop(PL_argvout_stack);
setdefout(oldout);
SvREFCNT_dec(oldout);
@@ -1059,7 +1064,7 @@ Perl_my_stat(pTHX)
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
- tmpgv = (GV*)cSVOP->op_sv;
+ tmpgv = cGVOP;
do_fstat:
io = GvIO(tmpgv);
if (io && IoIFP(io)) {
@@ -1112,7 +1117,7 @@ Perl_my_lstat(pTHX)
STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
- if ((GV*)cSVOP->op_sv == PL_defgv) {
+ if (cGVOP == PL_defgv) {
if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat");
return PL_laststatval;
diff --git a/dump.c b/dump.c
index 1e216c5fbd..27afb0b130 100644
--- a/dump.c
+++ b/dump.c
@@ -514,11 +514,11 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
switch (o->op_type) {
case OP_GVSV:
case OP_GV:
- if (cSVOPo->op_sv) {
+ if (cGVOPo) {
SV *tmpsv = NEWSV(0,0);
ENTER;
SAVEFREESV(tmpsv);
- gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
+ gv_fullname3(tmpsv, (GV*)cGVOPo, Nullch);
Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
LEAVE;
}
@@ -532,8 +532,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
- if (cCOPo->cop_line)
- Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",cCOPo->cop_line);
+ if (CopLINE(cCOPo))
+ Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo));
if (cCOPo->cop_label)
Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",cCOPo->cop_label);
break;
@@ -1070,6 +1070,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32);
do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
+ Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
#ifdef USE_THREADS
Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv)));
diff --git a/embed.h b/embed.h
index 1622da23be..3307585c2a 100644
--- a/embed.h
+++ b/embed.h
@@ -437,6 +437,7 @@
#define newHVhv Perl_newHVhv
#define newIO Perl_newIO
#define newLISTOP Perl_newLISTOP
+#define newPADOP Perl_newPADOP
#define newPMOP Perl_newPMOP
#define newPVOP Perl_newPVOP
#define newRV Perl_newRV
@@ -762,6 +763,22 @@
#define newMYSUB Perl_newMYSUB
#define my_attrs Perl_my_attrs
#define boot_core_xsutils Perl_boot_core_xsutils
+#if defined(USE_ITHREADS)
+#define he_dup Perl_he_dup
+#define re_dup Perl_re_dup
+#define fp_dup Perl_fp_dup
+#define dirp_dup Perl_dirp_dup
+#define gp_dup Perl_gp_dup
+#define mg_dup Perl_mg_dup
+#define sv_dup Perl_sv_dup
+#if defined(HAVE_INTERP_INTERN)
+#define sys_intern_dup Perl_sys_intern_dup
+#endif
+#define sv_table_new Perl_sv_table_new
+#define sv_table_fetch Perl_sv_table_fetch
+#define sv_table_store Perl_sv_table_store
+#define sv_table_split Perl_sv_table_split
+#endif
#if defined(PERL_OBJECT)
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
@@ -1797,6 +1814,7 @@
#define newHVhv(a) Perl_newHVhv(aTHX_ a)
#define newIO() Perl_newIO(aTHX)
#define newLISTOP(a,b,c,d) Perl_newLISTOP(aTHX_ a,b,c,d)
+#define newPADOP(a,b,c) Perl_newPADOP(aTHX_ a,b,c)
#define newPMOP(a,b) Perl_newPMOP(aTHX_ a,b)
#define newPVOP(a,b,c) Perl_newPVOP(aTHX_ a,b,c)
#define newRV(a) Perl_newRV(aTHX_ a)
@@ -2113,6 +2131,22 @@
#define newMYSUB(a,b,c,d,e) Perl_newMYSUB(aTHX_ a,b,c,d,e)
#define my_attrs(a,b) Perl_my_attrs(aTHX_ a,b)
#define boot_core_xsutils() Perl_boot_core_xsutils(aTHX)
+#if defined(USE_ITHREADS)
+#define he_dup(a,b) Perl_he_dup(aTHX_ a,b)
+#define re_dup(a) Perl_re_dup(aTHX_ a)
+#define fp_dup(a,b) Perl_fp_dup(aTHX_ a,b)
+#define dirp_dup(a) Perl_dirp_dup(aTHX_ a)
+#define gp_dup(a) Perl_gp_dup(aTHX_ a)
+#define mg_dup(a) Perl_mg_dup(aTHX_ a)
+#define sv_dup(a) Perl_sv_dup(aTHX_ a)
+#if defined(HAVE_INTERP_INTERN)
+#define sys_intern_dup(a,b) Perl_sys_intern_dup(aTHX_ a,b)
+#endif
+#define sv_table_new() Perl_sv_table_new(aTHX)
+#define sv_table_fetch(a,b) Perl_sv_table_fetch(aTHX_ a,b)
+#define sv_table_store(a,b,c) Perl_sv_table_store(aTHX_ a,b,c)
+#define sv_table_split(a) Perl_sv_table_split(aTHX_ a)
+#endif
#if defined(PERL_OBJECT)
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
@@ -3520,6 +3554,8 @@
#define newIO Perl_newIO
#define Perl_newLISTOP CPerlObj::Perl_newLISTOP
#define newLISTOP Perl_newLISTOP
+#define Perl_newPADOP CPerlObj::Perl_newPADOP
+#define newPADOP Perl_newPADOP
#define Perl_newPMOP CPerlObj::Perl_newPMOP
#define newPMOP Perl_newPMOP
#define Perl_newPVOP CPerlObj::Perl_newPVOP
@@ -4165,6 +4201,34 @@
#define my_attrs Perl_my_attrs
#define Perl_boot_core_xsutils CPerlObj::Perl_boot_core_xsutils
#define boot_core_xsutils Perl_boot_core_xsutils
+#if defined(USE_ITHREADS)
+#define Perl_he_dup CPerlObj::Perl_he_dup
+#define he_dup Perl_he_dup
+#define Perl_re_dup CPerlObj::Perl_re_dup
+#define re_dup Perl_re_dup
+#define Perl_fp_dup CPerlObj::Perl_fp_dup
+#define fp_dup Perl_fp_dup
+#define Perl_dirp_dup CPerlObj::Perl_dirp_dup
+#define dirp_dup Perl_dirp_dup
+#define Perl_gp_dup CPerlObj::Perl_gp_dup
+#define gp_dup Perl_gp_dup
+#define Perl_mg_dup CPerlObj::Perl_mg_dup
+#define mg_dup Perl_mg_dup
+#define Perl_sv_dup CPerlObj::Perl_sv_dup
+#define sv_dup Perl_sv_dup
+#if defined(HAVE_INTERP_INTERN)
+#define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup
+#define sys_intern_dup Perl_sys_intern_dup
+#endif
+#define Perl_sv_table_new CPerlObj::Perl_sv_table_new
+#define sv_table_new Perl_sv_table_new
+#define Perl_sv_table_fetch CPerlObj::Perl_sv_table_fetch
+#define sv_table_fetch Perl_sv_table_fetch
+#define Perl_sv_table_store CPerlObj::Perl_sv_table_store
+#define sv_table_store Perl_sv_table_store
+#define Perl_sv_table_split CPerlObj::Perl_sv_table_split
+#define sv_table_split Perl_sv_table_split
+#endif
#if defined(PERL_OBJECT)
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
diff --git a/embed.pl b/embed.pl
index 71e9406764..07bed666cb 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1404,6 +1404,7 @@ p |HV* |newHV
p |HV* |newHVhv |HV* hv
p |IO* |newIO
p |OP* |newLISTOP |I32 type|I32 flags|OP* first|OP* last
+p |OP* |newPADOP |I32 type|I32 flags|SV* sv
p |OP* |newPMOP |I32 type|I32 flags
p |OP* |newPVOP |I32 type|I32 flags|char* pv
p |SV* |newRV |SV* pref
@@ -1771,6 +1772,23 @@ p |CV* |newATTRSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block
p |void |newMYSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block
p |OP * |my_attrs |OP *o|OP *attrs
p |void |boot_core_xsutils
+#if defined(USE_ITHREADS)
+p |HE* |he_dup |HE* e|bool shared
+p |REGEXP*|re_dup |REGEXP* r
+p |PerlIO*|fp_dup |PerlIO* fp|char type
+p |DIR* |dirp_dup |DIR* dp
+p |GP* |gp_dup |GP* gp
+p |MAGIC* |mg_dup |MAGIC* mg
+p |SV* |sv_dup |SV* sstr
+#if defined(HAVE_INTERP_INTERN)
+p |void |sys_intern_dup |struct interp_intern* src \
+ |struct interp_intern* dst
+#endif
+p |SVTBL* |sv_table_new
+p |SV* |sv_table_fetch |SVTBL *tbl|SV *sv
+p |void |sv_table_store |SVTBL *tbl|SV *oldsv|SV *newsv
+p |void |sv_table_split |SVTBL *tbl
+#endif
#if defined(PERL_OBJECT)
protected:
diff --git a/embedvar.h b/embedvar.h
index 556e4d03ed..566483b383 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -376,6 +376,7 @@
#define PL_sv_no (PERL_GET_INTERP->Isv_no)
#define PL_sv_objcount (PERL_GET_INTERP->Isv_objcount)
#define PL_sv_root (PERL_GET_INTERP->Isv_root)
+#define PL_sv_table (PERL_GET_INTERP->Isv_table)
#define PL_sv_undef (PERL_GET_INTERP->Isv_undef)
#define PL_sv_yes (PERL_GET_INTERP->Isv_yes)
#define PL_svref_mutex (PERL_GET_INTERP->Isvref_mutex)
@@ -636,6 +637,7 @@
#define PL_sv_no (vTHX->Isv_no)
#define PL_sv_objcount (vTHX->Isv_objcount)
#define PL_sv_root (vTHX->Isv_root)
+#define PL_sv_table (vTHX->Isv_table)
#define PL_sv_undef (vTHX->Isv_undef)
#define PL_sv_yes (vTHX->Isv_yes)
#define PL_svref_mutex (vTHX->Isvref_mutex)
@@ -898,6 +900,7 @@
#define PL_Isv_no PL_sv_no
#define PL_Isv_objcount PL_sv_objcount
#define PL_Isv_root PL_sv_root
+#define PL_Isv_table PL_sv_table
#define PL_Isv_undef PL_sv_undef
#define PL_Isv_yes PL_sv_yes
#define PL_Isvref_mutex PL_svref_mutex
diff --git a/ext/B/B.pm b/ext/B/B.pm
index bc6d6cbe69..6661ebac93 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -512,6 +512,8 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>).
=item GV
+=item FILE
+
=item DEPTH
=item PADLIST
@@ -688,7 +690,7 @@ This returns the op description from the global C PL_op_desc array
=item stash
-=item filegv
+=item file
=item cop_seq
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 731ae950dd..7d0fc742fc 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -746,11 +746,12 @@ LOOP_lastop(o)
B::LOOP o
#define COP_label(o) o->cop_label
-#define COP_stash(o) o->cop_stash
-#define COP_filegv(o) o->cop_filegv
+#define COP_stashpv(o) CopSTASHPV(o)
+#define COP_stash(o) CopSTASH(o)
+#define COP_file(o) CopFILE(o)
#define COP_cop_seq(o) o->cop_seq
#define COP_arybase(o) o->cop_arybase
-#define COP_line(o) o->cop_line
+#define COP_line(o) CopLINE(o)
#define COP_warnings(o) o->cop_warnings
MODULE = B PACKAGE = B::COP PREFIX = COP_
@@ -759,12 +760,16 @@ char *
COP_label(o)
B::COP o
+char *
+COP_stashpv(o)
+ B::COP o
+
B::HV
COP_stash(o)
B::COP o
-B::GV
-COP_filegv(o)
+char *
+COP_file(o)
B::COP o
U32
@@ -1153,6 +1158,10 @@ B::GV
CvGV(cv)
B::CV cv
+char *
+CvFILE(cv)
+ B::CV cv
+
long
CvDEPTH(cv)
B::CV cv
diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm
index 58d07c47d4..a7dbbe2026 100644
--- a/ext/B/B/Asmdata.pm
+++ b/ext/B/B/Asmdata.pm
@@ -68,75 +68,76 @@ $insn_data{xcv_stash} = [44, \&PUT_svindex, "GET_svindex"];
$insn_data{xcv_start} = [45, \&PUT_opindex, "GET_opindex"];
$insn_data{xcv_root} = [46, \&PUT_opindex, "GET_opindex"];
$insn_data{xcv_gv} = [47, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_depth} = [48, \&PUT_I32, "GET_I32"];
-$insn_data{xcv_padlist} = [49, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_outside} = [50, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_flags} = [51, \&PUT_U8, "GET_U8"];
-$insn_data{av_extend} = [52, \&PUT_I32, "GET_I32"];
-$insn_data{av_push} = [53, \&PUT_svindex, "GET_svindex"];
-$insn_data{xav_fill} = [54, \&PUT_I32, "GET_I32"];
-$insn_data{xav_max} = [55, \&PUT_I32, "GET_I32"];
-$insn_data{xav_flags} = [56, \&PUT_U8, "GET_U8"];
-$insn_data{xhv_riter} = [57, \&PUT_I32, "GET_I32"];
-$insn_data{xhv_name} = [58, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{hv_store} = [59, \&PUT_svindex, "GET_svindex"];
-$insn_data{sv_magic} = [60, \&PUT_U8, "GET_U8"];
-$insn_data{mg_obj} = [61, \&PUT_svindex, "GET_svindex"];
-$insn_data{mg_private} = [62, \&PUT_U16, "GET_U16"];
-$insn_data{mg_flags} = [63, \&PUT_U8, "GET_U8"];
-$insn_data{mg_pv} = [64, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{xmg_stash} = [65, \&PUT_svindex, "GET_svindex"];
-$insn_data{gv_fetchpv} = [66, \&PUT_strconst, "GET_strconst"];
-$insn_data{gv_stashpv} = [67, \&PUT_strconst, "GET_strconst"];
-$insn_data{gp_sv} = [68, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_refcnt} = [69, \&PUT_U32, "GET_U32"];
-$insn_data{gp_refcnt_add} = [70, \&PUT_I32, "GET_I32"];
-$insn_data{gp_av} = [71, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_hv} = [72, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_cv} = [73, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_file} = [74, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{gp_io} = [75, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_form} = [76, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_cvgen} = [77, \&PUT_U32, "GET_U32"];
-$insn_data{gp_line} = [78, \&PUT_U16, "GET_U16"];
-$insn_data{gp_share} = [79, \&PUT_svindex, "GET_svindex"];
-$insn_data{xgv_flags} = [80, \&PUT_U8, "GET_U8"];
-$insn_data{op_next} = [81, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_sibling} = [82, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_ppaddr} = [83, \&PUT_strconst, "GET_strconst"];
-$insn_data{op_targ} = [84, \&PUT_U32, "GET_U32"];
-$insn_data{op_type} = [85, \&PUT_U16, "GET_U16"];
-$insn_data{op_seq} = [86, \&PUT_U16, "GET_U16"];
-$insn_data{op_flags} = [87, \&PUT_U8, "GET_U8"];
-$insn_data{op_private} = [88, \&PUT_U8, "GET_U8"];
-$insn_data{op_first} = [89, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_last} = [90, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_other} = [91, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_children} = [92, \&PUT_U32, "GET_U32"];
-$insn_data{op_pmreplroot} = [93, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmreplrootgv} = [94, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_pmreplstart} = [95, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmnext} = [96, \&PUT_opindex, "GET_opindex"];
-$insn_data{pregcomp} = [97, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pmflags} = [98, \&PUT_U16, "GET_U16"];
-$insn_data{op_pmpermflags} = [99, \&PUT_U16, "GET_U16"];
-$insn_data{op_sv} = [100, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_padix} = [101, \&PUT_U32, "GET_U32"];
-$insn_data{op_pv} = [102, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pv_tr} = [103, \&PUT_op_tr_array, "GET_op_tr_array"];
-$insn_data{op_redoop} = [104, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_nextop} = [105, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_lastop} = [106, \&PUT_opindex, "GET_opindex"];
-$insn_data{cop_label} = [107, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{cop_stash} = [108, \&PUT_svindex, "GET_svindex"];
-$insn_data{cop_filegv} = [109, \&PUT_svindex, "GET_svindex"];
-$insn_data{cop_seq} = [110, \&PUT_U32, "GET_U32"];
-$insn_data{cop_arybase} = [111, \&PUT_I32, "GET_I32"];
-$insn_data{cop_line} = [112, \&PUT_U16, "GET_U16"];
-$insn_data{cop_warnings} = [113, \&PUT_svindex, "GET_svindex"];
-$insn_data{main_start} = [114, \&PUT_opindex, "GET_opindex"];
-$insn_data{main_root} = [115, \&PUT_opindex, "GET_opindex"];
-$insn_data{curpad} = [116, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_file} = [48, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"];
+$insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_flags} = [52, \&PUT_U8, "GET_U8"];
+$insn_data{av_extend} = [53, \&PUT_I32, "GET_I32"];
+$insn_data{av_push} = [54, \&PUT_svindex, "GET_svindex"];
+$insn_data{xav_fill} = [55, \&PUT_I32, "GET_I32"];
+$insn_data{xav_max} = [56, \&PUT_I32, "GET_I32"];
+$insn_data{xav_flags} = [57, \&PUT_U8, "GET_U8"];
+$insn_data{xhv_riter} = [58, \&PUT_I32, "GET_I32"];
+$insn_data{xhv_name} = [59, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{hv_store} = [60, \&PUT_svindex, "GET_svindex"];
+$insn_data{sv_magic} = [61, \&PUT_U8, "GET_U8"];
+$insn_data{mg_obj} = [62, \&PUT_svindex, "GET_svindex"];
+$insn_data{mg_private} = [63, \&PUT_U16, "GET_U16"];
+$insn_data{mg_flags} = [64, \&PUT_U8, "GET_U8"];
+$insn_data{mg_pv} = [65, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xmg_stash} = [66, \&PUT_svindex, "GET_svindex"];
+$insn_data{gv_fetchpv} = [67, \&PUT_strconst, "GET_strconst"];
+$insn_data{gv_stashpv} = [68, \&PUT_strconst, "GET_strconst"];
+$insn_data{gp_sv} = [69, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_refcnt} = [70, \&PUT_U32, "GET_U32"];
+$insn_data{gp_refcnt_add} = [71, \&PUT_I32, "GET_I32"];
+$insn_data{gp_av} = [72, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_hv} = [73, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cv} = [74, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_file} = [75, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{gp_io} = [76, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_form} = [77, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cvgen} = [78, \&PUT_U32, "GET_U32"];
+$insn_data{gp_line} = [79, \&PUT_U16, "GET_U16"];
+$insn_data{gp_share} = [80, \&PUT_svindex, "GET_svindex"];
+$insn_data{xgv_flags} = [81, \&PUT_U8, "GET_U8"];
+$insn_data{op_next} = [82, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_sibling} = [83, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_ppaddr} = [84, \&PUT_strconst, "GET_strconst"];
+$insn_data{op_targ} = [85, \&PUT_U32, "GET_U32"];
+$insn_data{op_type} = [86, \&PUT_U16, "GET_U16"];
+$insn_data{op_seq} = [87, \&PUT_U16, "GET_U16"];
+$insn_data{op_flags} = [88, \&PUT_U8, "GET_U8"];
+$insn_data{op_private} = [89, \&PUT_U8, "GET_U8"];
+$insn_data{op_first} = [90, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_last} = [91, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_other} = [92, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_children} = [93, \&PUT_U32, "GET_U32"];
+$insn_data{op_pmreplroot} = [94, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplrootgv} = [95, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pmreplstart} = [96, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmnext} = [97, \&PUT_opindex, "GET_opindex"];
+$insn_data{pregcomp} = [98, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pmflags} = [99, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmpermflags} = [100, \&PUT_U16, "GET_U16"];
+$insn_data{op_sv} = [101, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_padix} = [102, \&PUT_U32, "GET_U32"];
+$insn_data{op_pv} = [103, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pv_tr} = [104, \&PUT_op_tr_array, "GET_op_tr_array"];
+$insn_data{op_redoop} = [105, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_nextop} = [106, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_lastop} = [107, \&PUT_opindex, "GET_opindex"];
+$insn_data{cop_label} = [108, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{cop_stashpv} = [109, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{cop_file} = [110, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{cop_seq} = [111, \&PUT_U32, "GET_U32"];
+$insn_data{cop_arybase} = [112, \&PUT_I32, "GET_I32"];
+$insn_data{cop_line} = [113, \&PUT_U16, "GET_U16"];
+$insn_data{cop_warnings} = [114, \&PUT_svindex, "GET_svindex"];
+$insn_data{main_start} = [115, \&PUT_opindex, "GET_opindex"];
+$insn_data{main_root} = [116, \&PUT_opindex, "GET_opindex"];
+$insn_data{curpad} = [117, \&PUT_svindex, "GET_svindex"];
my ($insn_name, $insn_data);
while (($insn_name, $insn_data) = each %insn_data) {
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index da8808a217..8764a0d588 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -278,28 +278,27 @@ sub B::LOOP::bytecode {
sub B::COP::bytecode {
my $op = shift;
- my $stash = $op->stash;
- my $stashix = $stash->objix;
- my $filegv = $op->filegv;
- my $filegvix = $filegv->objix;
+ my $stashpv = $op->stashpv;
+ my $file = $op->file;
my $line = $op->line;
my $warnings = $op->warnings;
my $warningsix = $warnings->objix;
if ($debug_bc) {
- printf "# line %s:%d\n", $filegv->SV->PV, $line;
+ printf "# line %s:%d\n", $file, $line;
}
$op->B::OP::bytecode;
- printf <<"EOT", pvstring($op->label), $op->cop_seq, $op->arybase;
+ printf <<"EOT", pvstring($op->label), pvstring($stashpv), $op->cop_seq, pvstring($file), $op->arybase;
newpv %s
cop_label
-cop_stash $stashix
+newpv %s
+cop_stashpv
cop_seq %d
-cop_filegv $filegvix
+newpv %s
+cop_file
cop_arybase %d
cop_line $line
cop_warnings $warningsix
EOT
- $filegv->bytecode;
$stash->bytecode;
}
@@ -583,6 +582,7 @@ sub B::CV::bytecode {
printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
}
printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->FLAGS;
+ printf "newpv %s\nxcv_file\n", pvstring($cv->FILE);
# Now save all the subfields (except for CvROOT which was handled
# above) and CvSTART (now the initial element of @subfields).
shift @subfields; # bye-bye CvSTART
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index f3318212b8..f8607444f4 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -293,9 +293,7 @@ sub B::COP::save {
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- my $gvsym = $op->filegv->save;
- my $stashsym = $op->stash->save;
- warn sprintf("COP: line %d file %s\n", $op->line, $op->filegv->SV->PV)
+ warn sprintf("COP: line %d file %s\n", $op->line, $op->file)
if $debug_cops;
$copsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
${$op->next}, ${$op->sibling}, $op->ppaddr,
@@ -303,8 +301,8 @@ sub B::COP::save {
$op->private, cstring($op->label), $op->cop_seq,
$op->arybase, $op->line));
my $copix = $copsect->index;
- $init->add(sprintf("cop_list[%d].cop_filegv = %s;", $copix, $gvsym),
- sprintf("cop_list[%d].cop_stash = %s;", $copix, $stashsym));
+ $init->add(sprintf("CopFILE_set(&cop_list[%d], %s);", $copix, cstring($op->file)),
+ sprintf("CopSTASHPV_set(&cop_list[%d], %s);", $copix, cstring($op->stashpv));
savesym($op, "(OP*)&cop_list[$copix]");
}
@@ -700,6 +698,7 @@ sub B::CV::save {
warn sprintf("done saving GV 0x%x for CV 0x%x\n",
$$gv, $$cv) if $debug_cv;
}
+ $init->add(sprintf("CvFILE($sym) = %s;", cstring($cv->FILE)));
my $stash = $cv->STASH;
if ($$stash) {
$stash->save;
@@ -1011,9 +1010,7 @@ typedef struct {
void (*xcv_xsub) (CV*);
void * xcv_xsubany;
GV * xcv_gv;
-#if defined(PERL_BINCOMPAT_5005)
- GV * xcv_filegv; /* XXX unused (and deprecated) */
-#endif
+ char * xcv_file;
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 1c31599dea..0fe5e7d8d5 100644
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -374,7 +374,7 @@ sub dopoptolabel {
sub error {
my $format = shift;
- my $file = $curcop->[0]->filegv->SV->PV;
+ my $file = $curcop->[0]->file;
my $line = $curcop->[0]->line;
$errors++;
if (@_) {
@@ -598,7 +598,7 @@ sub pp_nextstate {
my $op = shift;
$curcop->load($op);
@stack = ();
- debug(sprintf("%s:%d\n", $op->filegv->SV->PV, $op->line)) if $debug_lineno;
+ debug(sprintf("%s:%d\n", $op->file, $op->line)) if $debug_lineno;
runtime("TAINT_NOT;") unless $omit_taint;
runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;");
if ($freetmps_each_bblock || $freetmps_each_loop) {
diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm
index 732169f630..ae7a9733bc 100644
--- a/ext/B/B/Debug.pm
+++ b/ext/B/B/Debug.pm
@@ -60,17 +60,15 @@ sub B::PMOP::debug {
sub B::COP::debug {
my ($op) = @_;
$op->B::OP::debug();
- my ($filegv) = $op->filegv;
- printf <<'EOT', $op->label, ${$op->stash}, $$filegv, $op->seq, $op->arybase, $op->line, ${$op->warnings};
+ printf <<'EOT', $op->label, $op->stashpv, $op->file, $op->seq, $op->arybase, $op->line, ${$op->warnings};
cop_label %s
- cop_stash 0x%x
- cop_filegv 0x%x
+ cop_stashpv %s
+ cop_file %s
cop_seq %d
cop_arybase %d
cop_line %d
cop_warnings 0x%x
EOT
- $filegv->debug;
}
sub B::SVOP::debug {
@@ -177,12 +175,14 @@ sub B::CV::debug {
my ($start) = $sv->START;
my ($root) = $sv->ROOT;
my ($padlist) = $sv->PADLIST;
+ my ($file) = $sv->FILE;
my ($gv) = $sv->GV;
- printf <<'EOT', $$stash, $$start, $$root, $$gv, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
+ printf <<'EOT', $$stash, $$start, $$root, $$gv, $file, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
STASH 0x%x
START 0x%x
ROOT 0x%x
GV 0x%x
+ FILE %s
DEPTH %d
PADLIST 0x%x
OUTSIDE 0x%x
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index c5d3ce9504..be7088e768 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -770,14 +770,14 @@ sub pp_nextstate {
and $seq > $self->{'subs_todo'}[0][0]) {
push @text, $self->next_todo;
}
- my $stash = $op->stash->NAME;
+ my $stash = $op->stashpv;
if ($stash ne $self->{'curstash'}) {
push @text, "package $stash;\n";
$self->{'curstash'} = $stash;
}
if ($self->{'linenums'}) {
push @text, "\f#line " . $op->line .
- ' "' . substr($op->filegv->NAME, 2), qq'"\n';
+ ' "' . $op->file, qq'"\n';
}
return join("", @text);
}
diff --git a/ext/B/B/Lint.pm b/ext/B/B/Lint.pm
index 41d3c5ae22..ed0d07dfcb 100644
--- a/ext/B/B/Lint.pm
+++ b/ext/B/B/Lint.pm
@@ -172,7 +172,7 @@ sub B::OP::lint {}
sub B::COP::lint {
my $op = shift;
if ($op->name eq "nextstate") {
- $file = $op->filegv->SV->PV;
+ $file = $op->file;
$line = $op->line;
$curstash = $op->stash->NAME;
}
diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm
index f7cd64926d..53b655c82e 100644
--- a/ext/B/B/Xref.pm
+++ b/ext/B/B/Xref.pm
@@ -201,7 +201,7 @@ sub xref_main {
sub pp_nextstate {
my $op = shift;
- $file = $op->filegv->SV->PV;
+ $file = $op->file;
$line = $op->line;
$top = UNKNOWN;
}
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 5ca0d1afc6..6e19e129df 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -137,6 +137,9 @@ typedef IV IV64;
PL_comppad = (AV *)arg; \
pad = AvARRAY(arg); \
} STMT_END
+#define BSET_cop_file(cop, arg) CopFILE_set(cop,arg)
+#define BSET_cop_line(cop, arg) CopLINE_set(cop,arg)
+#define BSET_cop_stashpv(cop, arg) CopSTASHPV_set(cop,arg)
#define BSET_OBJ_STORE(obj, ix) \
(I32)ix > bytecode_obj_list_fill ? \
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 264cb01e6a..595fd4e18d 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -401,483 +401,490 @@ byterun(pTHXo_ struct bytestream bs)
*(SV**)&CvGV(bytecode_sv) = arg;
break;
}
- case INSN_XCV_DEPTH: /* 48 */
+ case INSN_XCV_FILE: /* 48 */
+ {
+ pvcontents arg;
+ BGET_pvcontents(arg);
+ CvFILE(bytecode_sv) = arg;
+ break;
+ }
+ case INSN_XCV_DEPTH: /* 49 */
{
long arg;
BGET_I32(arg);
CvDEPTH(bytecode_sv) = arg;
break;
}
- case INSN_XCV_PADLIST: /* 49 */
+ case INSN_XCV_PADLIST: /* 50 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&CvPADLIST(bytecode_sv) = arg;
break;
}
- case INSN_XCV_OUTSIDE: /* 50 */
+ case INSN_XCV_OUTSIDE: /* 51 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&CvOUTSIDE(bytecode_sv) = arg;
break;
}
- case INSN_XCV_FLAGS: /* 51 */
+ case INSN_XCV_FLAGS: /* 52 */
{
U8 arg;
BGET_U8(arg);
CvFLAGS(bytecode_sv) = arg;
break;
}
- case INSN_AV_EXTEND: /* 52 */
+ case INSN_AV_EXTEND: /* 53 */
{
SSize_t arg;
BGET_I32(arg);
BSET_av_extend(bytecode_sv, arg);
break;
}
- case INSN_AV_PUSH: /* 53 */
+ case INSN_AV_PUSH: /* 54 */
{
svindex arg;
BGET_svindex(arg);
BSET_av_push(bytecode_sv, arg);
break;
}
- case INSN_XAV_FILL: /* 54 */
+ case INSN_XAV_FILL: /* 55 */
{
SSize_t arg;
BGET_I32(arg);
AvFILLp(bytecode_sv) = arg;
break;
}
- case INSN_XAV_MAX: /* 55 */
+ case INSN_XAV_MAX: /* 56 */
{
SSize_t arg;
BGET_I32(arg);
AvMAX(bytecode_sv) = arg;
break;
}
- case INSN_XAV_FLAGS: /* 56 */
+ case INSN_XAV_FLAGS: /* 57 */
{
U8 arg;
BGET_U8(arg);
AvFLAGS(bytecode_sv) = arg;
break;
}
- case INSN_XHV_RITER: /* 57 */
+ case INSN_XHV_RITER: /* 58 */
{
I32 arg;
BGET_I32(arg);
HvRITER(bytecode_sv) = arg;
break;
}
- case INSN_XHV_NAME: /* 58 */
+ case INSN_XHV_NAME: /* 59 */
{
pvcontents arg;
BGET_pvcontents(arg);
HvNAME(bytecode_sv) = arg;
break;
}
- case INSN_HV_STORE: /* 59 */
+ case INSN_HV_STORE: /* 60 */
{
svindex arg;
BGET_svindex(arg);
BSET_hv_store(bytecode_sv, arg);
break;
}
- case INSN_SV_MAGIC: /* 60 */
+ case INSN_SV_MAGIC: /* 61 */
{
char arg;
BGET_U8(arg);
BSET_sv_magic(bytecode_sv, arg);
break;
}
- case INSN_MG_OBJ: /* 61 */
+ case INSN_MG_OBJ: /* 62 */
{
svindex arg;
BGET_svindex(arg);
SvMAGIC(bytecode_sv)->mg_obj = arg;
break;
}
- case INSN_MG_PRIVATE: /* 62 */
+ case INSN_MG_PRIVATE: /* 63 */
{
U16 arg;
BGET_U16(arg);
SvMAGIC(bytecode_sv)->mg_private = arg;
break;
}
- case INSN_MG_FLAGS: /* 63 */
+ case INSN_MG_FLAGS: /* 64 */
{
U8 arg;
BGET_U8(arg);
SvMAGIC(bytecode_sv)->mg_flags = arg;
break;
}
- case INSN_MG_PV: /* 64 */
+ case INSN_MG_PV: /* 65 */
{
pvcontents arg;
BGET_pvcontents(arg);
BSET_mg_pv(SvMAGIC(bytecode_sv), arg);
break;
}
- case INSN_XMG_STASH: /* 65 */
+ case INSN_XMG_STASH: /* 66 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&SvSTASH(bytecode_sv) = arg;
break;
}
- case INSN_GV_FETCHPV: /* 66 */
+ case INSN_GV_FETCHPV: /* 67 */
{
strconst arg;
BGET_strconst(arg);
BSET_gv_fetchpv(bytecode_sv, arg);
break;
}
- case INSN_GV_STASHPV: /* 67 */
+ case INSN_GV_STASHPV: /* 68 */
{
strconst arg;
BGET_strconst(arg);
BSET_gv_stashpv(bytecode_sv, arg);
break;
}
- case INSN_GP_SV: /* 68 */
+ case INSN_GP_SV: /* 69 */
{
svindex arg;
BGET_svindex(arg);
GvSV(bytecode_sv) = arg;
break;
}
- case INSN_GP_REFCNT: /* 69 */
+ case INSN_GP_REFCNT: /* 70 */
{
U32 arg;
BGET_U32(arg);
GvREFCNT(bytecode_sv) = arg;
break;
}
- case INSN_GP_REFCNT_ADD: /* 70 */
+ case INSN_GP_REFCNT_ADD: /* 71 */
{
I32 arg;
BGET_I32(arg);
BSET_gp_refcnt_add(GvREFCNT(bytecode_sv), arg);
break;
}
- case INSN_GP_AV: /* 71 */
+ case INSN_GP_AV: /* 72 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&GvAV(bytecode_sv) = arg;
break;
}
- case INSN_GP_HV: /* 72 */
+ case INSN_GP_HV: /* 73 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&GvHV(bytecode_sv) = arg;
break;
}
- case INSN_GP_CV: /* 73 */
+ case INSN_GP_CV: /* 74 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&GvCV(bytecode_sv) = arg;
break;
}
- case INSN_GP_FILE: /* 74 */
+ case INSN_GP_FILE: /* 75 */
{
pvcontents arg;
BGET_pvcontents(arg);
GvFILE(bytecode_sv) = arg;
break;
}
- case INSN_GP_IO: /* 75 */
+ case INSN_GP_IO: /* 76 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&GvIOp(bytecode_sv) = arg;
break;
}
- case INSN_GP_FORM: /* 76 */
+ case INSN_GP_FORM: /* 77 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&GvFORM(bytecode_sv) = arg;
break;
}
- case INSN_GP_CVGEN: /* 77 */
+ case INSN_GP_CVGEN: /* 78 */
{
U32 arg;
BGET_U32(arg);
GvCVGEN(bytecode_sv) = arg;
break;
}
- case INSN_GP_LINE: /* 78 */
+ case INSN_GP_LINE: /* 79 */
{
line_t arg;
BGET_U16(arg);
GvLINE(bytecode_sv) = arg;
break;
}
- case INSN_GP_SHARE: /* 79 */
+ case INSN_GP_SHARE: /* 80 */
{
svindex arg;
BGET_svindex(arg);
BSET_gp_share(bytecode_sv, arg);
break;
}
- case INSN_XGV_FLAGS: /* 80 */
+ case INSN_XGV_FLAGS: /* 81 */
{
U8 arg;
BGET_U8(arg);
GvFLAGS(bytecode_sv) = arg;
break;
}
- case INSN_OP_NEXT: /* 81 */
+ case INSN_OP_NEXT: /* 82 */
{
opindex arg;
BGET_opindex(arg);
PL_op->op_next = arg;
break;
}
- case INSN_OP_SIBLING: /* 82 */
+ case INSN_OP_SIBLING: /* 83 */
{
opindex arg;
BGET_opindex(arg);
PL_op->op_sibling = arg;
break;
}
- case INSN_OP_PPADDR: /* 83 */
+ case INSN_OP_PPADDR: /* 84 */
{
strconst arg;
BGET_strconst(arg);
BSET_op_ppaddr(PL_op->op_ppaddr, arg);
break;
}
- case INSN_OP_TARG: /* 84 */
+ case INSN_OP_TARG: /* 85 */
{
PADOFFSET arg;
BGET_U32(arg);
PL_op->op_targ = arg;
break;
}
- case INSN_OP_TYPE: /* 85 */
+ case INSN_OP_TYPE: /* 86 */
{
OPCODE arg;
BGET_U16(arg);
BSET_op_type(PL_op, arg);
break;
}
- case INSN_OP_SEQ: /* 86 */
+ case INSN_OP_SEQ: /* 87 */
{
U16 arg;
BGET_U16(arg);
PL_op->op_seq = arg;
break;
}
- case INSN_OP_FLAGS: /* 87 */
+ case INSN_OP_FLAGS: /* 88 */
{
U8 arg;
BGET_U8(arg);
PL_op->op_flags = arg;
break;
}
- case INSN_OP_PRIVATE: /* 88 */
+ case INSN_OP_PRIVATE: /* 89 */
{
U8 arg;
BGET_U8(arg);
PL_op->op_private = arg;
break;
}
- case INSN_OP_FIRST: /* 89 */
+ case INSN_OP_FIRST: /* 90 */
{
opindex arg;
BGET_opindex(arg);
cUNOP->op_first = arg;
break;
}
- case INSN_OP_LAST: /* 90 */
+ case INSN_OP_LAST: /* 91 */
{
opindex arg;
BGET_opindex(arg);
cBINOP->op_last = arg;
break;
}
- case INSN_OP_OTHER: /* 91 */
+ case INSN_OP_OTHER: /* 92 */
{
opindex arg;
BGET_opindex(arg);
cLOGOP->op_other = arg;
break;
}
- case INSN_OP_CHILDREN: /* 92 */
+ case INSN_OP_CHILDREN: /* 93 */
{
U32 arg;
BGET_U32(arg);
cLISTOP->op_children = arg;
break;
}
- case INSN_OP_PMREPLROOT: /* 93 */
+ case INSN_OP_PMREPLROOT: /* 94 */
{
opindex arg;
BGET_opindex(arg);
cPMOP->op_pmreplroot = arg;
break;
}
- case INSN_OP_PMREPLROOTGV: /* 94 */
+ case INSN_OP_PMREPLROOTGV: /* 95 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&cPMOP->op_pmreplroot = arg;
break;
}
- case INSN_OP_PMREPLSTART: /* 95 */
+ case INSN_OP_PMREPLSTART: /* 96 */
{
opindex arg;
BGET_opindex(arg);
cPMOP->op_pmreplstart = arg;
break;
}
- case INSN_OP_PMNEXT: /* 96 */
+ case INSN_OP_PMNEXT: /* 97 */
{
opindex arg;
BGET_opindex(arg);
*(OP**)&cPMOP->op_pmnext = arg;
break;
}
- case INSN_PREGCOMP: /* 97 */
+ case INSN_PREGCOMP: /* 98 */
{
pvcontents arg;
BGET_pvcontents(arg);
BSET_pregcomp(PL_op, arg);
break;
}
- case INSN_OP_PMFLAGS: /* 98 */
+ case INSN_OP_PMFLAGS: /* 99 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmflags = arg;
break;
}
- case INSN_OP_PMPERMFLAGS: /* 99 */
+ case INSN_OP_PMPERMFLAGS: /* 100 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmpermflags = arg;
break;
}
- case INSN_OP_SV: /* 100 */
+ case INSN_OP_SV: /* 101 */
{
svindex arg;
BGET_svindex(arg);
cSVOP->op_sv = arg;
break;
}
- case INSN_OP_PADIX: /* 101 */
+ case INSN_OP_PADIX: /* 102 */
{
PADOFFSET arg;
BGET_U32(arg);
cPADOP->op_padix = arg;
break;
}
- case INSN_OP_PV: /* 102 */
+ case INSN_OP_PV: /* 103 */
{
pvcontents arg;
BGET_pvcontents(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_PV_TR: /* 103 */
+ case INSN_OP_PV_TR: /* 104 */
{
op_tr_array arg;
BGET_op_tr_array(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_REDOOP: /* 104 */
+ case INSN_OP_REDOOP: /* 105 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_redoop = arg;
break;
}
- case INSN_OP_NEXTOP: /* 105 */
+ case INSN_OP_NEXTOP: /* 106 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_nextop = arg;
break;
}
- case INSN_OP_LASTOP: /* 106 */
+ case INSN_OP_LASTOP: /* 107 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_lastop = arg;
break;
}
- case INSN_COP_LABEL: /* 107 */
+ case INSN_COP_LABEL: /* 108 */
{
pvcontents arg;
BGET_pvcontents(arg);
cCOP->cop_label = arg;
break;
}
- case INSN_COP_STASH: /* 108 */
+ case INSN_COP_STASHPV: /* 109 */
{
- svindex arg;
- BGET_svindex(arg);
- *(SV**)&cCOP->cop_stash = arg;
+ pvcontents arg;
+ BGET_pvcontents(arg);
+ BSET_cop_stashpv(cCOP, arg);
break;
}
- case INSN_COP_FILEGV: /* 109 */
+ case INSN_COP_FILE: /* 110 */
{
- svindex arg;
- BGET_svindex(arg);
- *(SV**)&cCOP->cop_filegv = arg;
+ pvcontents arg;
+ BGET_pvcontents(arg);
+ BSET_cop_file(cCOP, arg);
break;
}
- case INSN_COP_SEQ: /* 110 */
+ case INSN_COP_SEQ: /* 111 */
{
U32 arg;
BGET_U32(arg);
cCOP->cop_seq = arg;
break;
}
- case INSN_COP_ARYBASE: /* 111 */
+ case INSN_COP_ARYBASE: /* 112 */
{
I32 arg;
BGET_I32(arg);
cCOP->cop_arybase = arg;
break;
}
- case INSN_COP_LINE: /* 112 */
+ case INSN_COP_LINE: /* 113 */
{
line_t arg;
BGET_U16(arg);
- cCOP->cop_line = arg;
+ BSET_cop_line(cCOP, arg);
break;
}
- case INSN_COP_WARNINGS: /* 113 */
+ case INSN_COP_WARNINGS: /* 114 */
{
svindex arg;
BGET_svindex(arg);
cCOP->cop_warnings = arg;
break;
}
- case INSN_MAIN_START: /* 114 */
+ case INSN_MAIN_START: /* 115 */
{
opindex arg;
BGET_opindex(arg);
PL_main_start = arg;
break;
}
- case INSN_MAIN_ROOT: /* 115 */
+ case INSN_MAIN_ROOT: /* 116 */
{
opindex arg;
BGET_opindex(arg);
PL_main_root = arg;
break;
}
- case INSN_CURPAD: /* 116 */
+ case INSN_CURPAD: /* 117 */
{
svindex arg;
BGET_svindex(arg);
diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h
index 306df9cbd4..f0de6b4820 100644
--- a/ext/ByteLoader/byterun.h
+++ b/ext/ByteLoader/byterun.h
@@ -64,76 +64,77 @@ enum {
INSN_XCV_START, /* 45 */
INSN_XCV_ROOT, /* 46 */
INSN_XCV_GV, /* 47 */
- INSN_XCV_DEPTH, /* 48 */
- INSN_XCV_PADLIST, /* 49 */
- INSN_XCV_OUTSIDE, /* 50 */
- INSN_XCV_FLAGS, /* 51 */
- INSN_AV_EXTEND, /* 52 */
- INSN_AV_PUSH, /* 53 */
- INSN_XAV_FILL, /* 54 */
- INSN_XAV_MAX, /* 55 */
- INSN_XAV_FLAGS, /* 56 */
- INSN_XHV_RITER, /* 57 */
- INSN_XHV_NAME, /* 58 */
- INSN_HV_STORE, /* 59 */
- INSN_SV_MAGIC, /* 60 */
- INSN_MG_OBJ, /* 61 */
- INSN_MG_PRIVATE, /* 62 */
- INSN_MG_FLAGS, /* 63 */
- INSN_MG_PV, /* 64 */
- INSN_XMG_STASH, /* 65 */
- INSN_GV_FETCHPV, /* 66 */
- INSN_GV_STASHPV, /* 67 */
- INSN_GP_SV, /* 68 */
- INSN_GP_REFCNT, /* 69 */
- INSN_GP_REFCNT_ADD, /* 70 */
- INSN_GP_AV, /* 71 */
- INSN_GP_HV, /* 72 */
- INSN_GP_CV, /* 73 */
- INSN_GP_FILE, /* 74 */
- INSN_GP_IO, /* 75 */
- INSN_GP_FORM, /* 76 */
- INSN_GP_CVGEN, /* 77 */
- INSN_GP_LINE, /* 78 */
- INSN_GP_SHARE, /* 79 */
- INSN_XGV_FLAGS, /* 80 */
- INSN_OP_NEXT, /* 81 */
- INSN_OP_SIBLING, /* 82 */
- INSN_OP_PPADDR, /* 83 */
- INSN_OP_TARG, /* 84 */
- INSN_OP_TYPE, /* 85 */
- INSN_OP_SEQ, /* 86 */
- INSN_OP_FLAGS, /* 87 */
- INSN_OP_PRIVATE, /* 88 */
- INSN_OP_FIRST, /* 89 */
- INSN_OP_LAST, /* 90 */
- INSN_OP_OTHER, /* 91 */
- INSN_OP_CHILDREN, /* 92 */
- INSN_OP_PMREPLROOT, /* 93 */
- INSN_OP_PMREPLROOTGV, /* 94 */
- INSN_OP_PMREPLSTART, /* 95 */
- INSN_OP_PMNEXT, /* 96 */
- INSN_PREGCOMP, /* 97 */
- INSN_OP_PMFLAGS, /* 98 */
- INSN_OP_PMPERMFLAGS, /* 99 */
- INSN_OP_SV, /* 100 */
- INSN_OP_PADIX, /* 101 */
- INSN_OP_PV, /* 102 */
- INSN_OP_PV_TR, /* 103 */
- INSN_OP_REDOOP, /* 104 */
- INSN_OP_NEXTOP, /* 105 */
- INSN_OP_LASTOP, /* 106 */
- INSN_COP_LABEL, /* 107 */
- INSN_COP_STASH, /* 108 */
- INSN_COP_FILEGV, /* 109 */
- INSN_COP_SEQ, /* 110 */
- INSN_COP_ARYBASE, /* 111 */
- INSN_COP_LINE, /* 112 */
- INSN_COP_WARNINGS, /* 113 */
- INSN_MAIN_START, /* 114 */
- INSN_MAIN_ROOT, /* 115 */
- INSN_CURPAD, /* 116 */
- MAX_INSN = 116
+ INSN_XCV_FILE, /* 48 */
+ INSN_XCV_DEPTH, /* 49 */
+ INSN_XCV_PADLIST, /* 50 */
+ INSN_XCV_OUTSIDE, /* 51 */
+ INSN_XCV_FLAGS, /* 52 */
+ INSN_AV_EXTEND, /* 53 */
+ INSN_AV_PUSH, /* 54 */
+ INSN_XAV_FILL, /* 55 */
+ INSN_XAV_MAX, /* 56 */
+ INSN_XAV_FLAGS, /* 57 */
+ INSN_XHV_RITER, /* 58 */
+ INSN_XHV_NAME, /* 59 */
+ INSN_HV_STORE, /* 60 */
+ INSN_SV_MAGIC, /* 61 */
+ INSN_MG_OBJ, /* 62 */
+ INSN_MG_PRIVATE, /* 63 */
+ INSN_MG_FLAGS, /* 64 */
+ INSN_MG_PV, /* 65 */
+ INSN_XMG_STASH, /* 66 */
+ INSN_GV_FETCHPV, /* 67 */
+ INSN_GV_STASHPV, /* 68 */
+ INSN_GP_SV, /* 69 */
+ INSN_GP_REFCNT, /* 70 */
+ INSN_GP_REFCNT_ADD, /* 71 */
+ INSN_GP_AV, /* 72 */
+ INSN_GP_HV, /* 73 */
+ INSN_GP_CV, /* 74 */
+ INSN_GP_FILE, /* 75 */
+ INSN_GP_IO, /* 76 */
+ INSN_GP_FORM, /* 77 */
+ INSN_GP_CVGEN, /* 78 */
+ INSN_GP_LINE, /* 79 */
+ INSN_GP_SHARE, /* 80 */
+ INSN_XGV_FLAGS, /* 81 */
+ INSN_OP_NEXT, /* 82 */
+ INSN_OP_SIBLING, /* 83 */
+ INSN_OP_PPADDR, /* 84 */
+ INSN_OP_TARG, /* 85 */
+ INSN_OP_TYPE, /* 86 */
+ INSN_OP_SEQ, /* 87 */
+ INSN_OP_FLAGS, /* 88 */
+ INSN_OP_PRIVATE, /* 89 */
+ INSN_OP_FIRST, /* 90 */
+ INSN_OP_LAST, /* 91 */
+ INSN_OP_OTHER, /* 92 */
+ INSN_OP_CHILDREN, /* 93 */
+ INSN_OP_PMREPLROOT, /* 94 */
+ INSN_OP_PMREPLROOTGV, /* 95 */
+ INSN_OP_PMREPLSTART, /* 96 */
+ INSN_OP_PMNEXT, /* 97 */
+ INSN_PREGCOMP, /* 98 */
+ INSN_OP_PMFLAGS, /* 99 */
+ INSN_OP_PMPERMFLAGS, /* 100 */
+ INSN_OP_SV, /* 101 */
+ INSN_OP_PADIX, /* 102 */
+ INSN_OP_PV, /* 103 */
+ INSN_OP_PV_TR, /* 104 */
+ INSN_OP_REDOOP, /* 105 */
+ INSN_OP_NEXTOP, /* 106 */
+ INSN_OP_LASTOP, /* 107 */
+ INSN_COP_LABEL, /* 108 */
+ INSN_COP_STASHPV, /* 109 */
+ INSN_COP_FILE, /* 110 */
+ INSN_COP_SEQ, /* 111 */
+ INSN_COP_ARYBASE, /* 112 */
+ INSN_COP_LINE, /* 113 */
+ INSN_COP_WARNINGS, /* 114 */
+ INSN_MAIN_START, /* 115 */
+ INSN_MAIN_ROOT, /* 116 */
+ INSN_CURPAD, /* 117 */
+ MAX_INSN = 117
};
enum {
diff --git a/ext/Devel/Peek/Peek.pm b/ext/Devel/Peek/Peek.pm
index 4bac55fd31..2e990b0a3a 100644
--- a/ext/Devel/Peek/Peek.pm
+++ b/ext/Devel/Peek/Peek.pm
@@ -364,6 +364,7 @@ Looks like this:
XSUB = 0x0
XSUBANY = 0
GVGV::GV = 0x1d44e8 "MY" :: "top_targets"
+ FILE = "(eval 5)"
DEPTH = 0
PADLIST = 0x1c9338
diff --git a/global.sym b/global.sym
index 26561d36b2..b6596b6d79 100644
--- a/global.sym
+++ b/global.sym
@@ -358,6 +358,7 @@ Perl_newHV
Perl_newHVhv
Perl_newIO
Perl_newLISTOP
+Perl_newPADOP
Perl_newPMOP
Perl_newPVOP
Perl_newRV
@@ -674,3 +675,15 @@ Perl_newATTRSUB
Perl_newMYSUB
Perl_my_attrs
Perl_boot_core_xsutils
+Perl_he_dup
+Perl_re_dup
+Perl_fp_dup
+Perl_dirp_dup
+Perl_gp_dup
+Perl_mg_dup
+Perl_sv_dup
+Perl_sys_intern_dup
+Perl_sv_table_new
+Perl_sv_table_fetch
+Perl_sv_table_store
+Perl_sv_table_split
diff --git a/gv.c b/gv.c
index 1671b39370..b662141abc 100644
--- a/gv.c
+++ b/gv.c
@@ -71,12 +71,6 @@ Perl_gv_fetchfile(pTHX_ const char *name)
if (!isGV(gv)) {
gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
sv_setpv(GvSV(gv), name);
-#ifdef MACOS_TRADITIONAL
- if (strchr(name, ':') && instr(name,".pm"))
-#else
- if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm")))
-#endif
- GvMULTI_on(gv);
if (PERLDB_LINE)
hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
}
@@ -125,6 +119,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
PL_sub_generation++;
CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
+ CvFILE(GvCV(gv)) = CopFILE(PL_curcop);
CvSTASH(GvCV(gv)) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(GvCV(gv)) = 0;
@@ -305,7 +300,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
/* ->SUPER::method should really be looked up in original stash */
SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
- HvNAME(PL_curcop->cop_stash)));
+ CopSTASHPV(PL_curcop)));
stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
origname, HvNAME(stash), name) );
@@ -564,7 +559,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
}
}
else
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
}
else
stash = PL_defstash;
@@ -883,7 +878,6 @@ Perl_gv_check(pTHX_ HV *stash)
register I32 i;
register GV *gv;
HV *hv;
- GV *filegv;
if (!HvARRAY(stash))
return;
@@ -896,14 +890,25 @@ Perl_gv_check(pTHX_ HV *stash)
gv_check(hv); /* nested package */
}
else if (isALPHA(*HeKEY(entry))) {
+ char *file;
gv = (GV*)HeVAL(entry);
if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
continue;
- CopLINE_set(PL_curcop, GvLINE(gv));
- filegv = GvFILEGV(gv); /* XXX could be made faster */
- CopFILEGV_set(PL_curcop, filegv);
- if (filegv && GvMULTI(filegv)) /* Filename began with slash */
+ file = GvFILE(gv);
+ /* performance hack: if filename is absolute and it's a standard
+ * module, don't bother warning */
+ if (file
+ && PERL_FILE_IS_ABSOLUTE(file)
+ && (instr(file, "/lib/") || instr(file, ".pm")))
+ {
continue;
+ }
+ CopLINE_set(PL_curcop, GvLINE(gv));
+#ifdef USE_ITHREADS
+ CopFILE(PL_curcop) = file; /* set for warning */
+#else
+ CopFILEGV(PL_curcop) = gv_fetchfile(file);
+#endif
Perl_warner(aTHX_ WARN_ONCE,
"Name \"%s::%s\" used only once: possible typo",
HvNAME(stash), GvNAME(gv));
diff --git a/gv.h b/gv.h
index 99d534eeba..f00331aed0 100644
--- a/gv.h
+++ b/gv.h
@@ -71,7 +71,7 @@ HV *GvHVn();
#define GvLINE(gv) (GvGP(gv)->gp_line)
#define GvFILE(gv) (GvGP(gv)->gp_file)
-#define GvFILEGV(gv) (gv_fetchfile(GvGP(gv)->gp_file))
+#define GvFILEGV(gv) (gv_fetchfile(GvFILE(gv)))
#define GvEGV(gv) (GvGP(gv)->gp_egv)
#define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv)
@@ -80,6 +80,7 @@ HV *GvHVn();
#define GVf_INTRO 0x01
#define GVf_MULTI 0x02
#define GVf_ASSUMECV 0x04
+#define GVf_IN_PAD 0x08
#define GVf_IMPORTED 0xF0
#define GVf_IMPORTED_SV 0x10
#define GVf_IMPORTED_AV 0x20
@@ -118,6 +119,10 @@ HV *GvHVn();
#define GvIMPORTED_CV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_CV)
#define GvIMPORTED_CV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_CV)
+#define GvIN_PAD(gv) (GvFLAGS(gv) & GVf_IN_PAD)
+#define GvIN_PAD_on(gv) (GvFLAGS(gv) |= GVf_IN_PAD)
+#define GvIN_PAD_off(gv) (GvFLAGS(gv) &= ~GVf_IN_PAD)
+
#define Nullgv Null(GV*)
#define DM_UID 0x003
diff --git a/hv.c b/hv.c
index 857bd70fe9..e38c785f05 100644
--- a/hv.c
+++ b/hv.c
@@ -15,15 +15,6 @@
#define PERL_IN_HV_C
#include "perl.h"
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-# define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) )
-#else
-# define MALLOC_OVERHEAD 16
-# define ARRAY_ALLOC_BYTES(size) ( ((size) < 64) \
- ? (size)*sizeof(HE*) \
- : (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
-#endif
-
STATIC HE*
S_new_he(pTHX)
{
@@ -82,6 +73,27 @@ Perl_unshare_hek(pTHX_ HEK *hek)
unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
}
+#if defined(USE_ITHREADS)
+HE *
+Perl_he_dup(pTHX_ HE *e, bool shared)
+{
+ HE *ret;
+
+ if (!e)
+ return Nullhe;
+ ret = new_he();
+ HeNEXT(ret) = (HE*)NULL;
+ if (HeKLEN(e) == HEf_SVKEY)
+ HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e)));
+ else if (shared)
+ HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
+ else
+ HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
+ HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e)));
+ return ret;
+}
+#endif /* USE_ITHREADS */
+
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
* contains an SV* */
@@ -126,7 +138,8 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
|| (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
#endif
)
- Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(503, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
else
return 0;
}
@@ -214,7 +227,8 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
|| (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
#endif
)
- Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(503, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
else
return 0;
}
@@ -304,7 +318,8 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 has
PERL_HASH(hash, key, klen);
if (!xhv->xhv_array)
- Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(505, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
@@ -385,7 +400,8 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
PERL_HASH(hash, key, klen);
if (!xhv->xhv_array)
- Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(505, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
i = 1;
@@ -714,21 +730,21 @@ S_hsplit(pTHX_ HV *hv)
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
- Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
+ Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
#else
#define MALLOC_OVERHEAD 16
- New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
+ New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
if (oldsize >= 64) {
- offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
+ offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
Safefree(xhv->xhv_array);
@@ -789,20 +805,20 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
if (a) {
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
- Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
+ Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
#else
- New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
+ New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return;
}
Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
if (oldsize >= 64) {
- offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
+ offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
}
else
Safefree(xhv->xhv_array);
@@ -811,7 +827,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
}
else {
- Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char);
+ Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
}
xhv->xhv_max = --newsize;
xhv->xhv_array = a;
@@ -1079,7 +1095,8 @@ Perl_hv_iternext(pTHX_ HV *hv)
#endif
if (!xhv->xhv_array)
- Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
+ Newz(506, xhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
if (entry)
entry = HeNEXT(entry);
while (!entry) {
diff --git a/hv.h b/hv.h
index 3977b1c395..11a602c1b7 100644
--- a/hv.h
+++ b/hv.h
@@ -114,3 +114,13 @@ struct xpvhv {
#define HEK_HASH(hek) (hek)->hek_hash
#define HEK_LEN(hek) (hek)->hek_len
#define HEK_KEY(hek) (hek)->hek_key
+
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+# define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*))
+#else
+# define MALLOC_OVERHEAD 16
+# define PERL_HV_ARRAY_ALLOC_BYTES(size) \
+ (((size) < 64) \
+ ? (size) * sizeof(HE*) \
+ : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD)
+#endif
diff --git a/intrpvar.h b/intrpvar.h
index 9f6f3b2548..0e2390504d 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -378,3 +378,7 @@ PERLVAR(IDir, struct IPerlDir*)
PERLVAR(ISock, struct IPerlSock*)
PERLVAR(IProc, struct IPerlProc*)
#endif
+
+#if defined(USE_ITHREADS)
+PERLVAR(Isv_table, SVTBL*)
+#endif
diff --git a/makedef.pl b/makedef.pl
index 63a09bdad0..5c38aad75a 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -359,6 +359,26 @@ Perl_unlock_condpair
Perl_magic_mutexfree
)];
}
+
+unless ($define{'USE_ITHREADS'})
+ {
+ skip_symbols [qw(
+PL_sv_table
+Perl_dirp_dup
+Perl_fp_dup
+Perl_gp_dup
+Perl_he_dup
+Perl_mg_dup
+Perl_re_dup
+Perl_sv_dup
+Perl_sys_intern_dup
+Perl_sv_table_fetch
+Perl_sv_table_new
+Perl_sv_table_split
+Perl_sv_table_store
+)];
+ }
+
unless ($define{'USE_THREADS'} or $define{'PERL_IMPLICIT_CONTEXT'}
or $define{'PERL_OBJECT'})
{
@@ -435,11 +455,6 @@ unless ($define{'DEBUGGING'})
PL_watchok)];
}
-if ($PLATFORM eq 'win32' && $define{'HAVE_DES_FCRYPT'})
- {
- emit_symbols [qw(win32_crypt)];
- }
-
# functions from *.sym files
my @syms = ($global_sym, $pp_sym, $globvar_sym);
@@ -651,6 +666,7 @@ win32_rewinddir
win32_closedir
win32_longpath
win32_os_id
+win32_crypt
)) {
try_symbol($symbol);
}
diff --git a/objXSUB.h b/objXSUB.h
index f7d1fd475a..c90b984262 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -418,6 +418,8 @@
#define PL_sv_objcount (*Perl_Isv_objcount_ptr(aTHXo))
#undef PL_sv_root
#define PL_sv_root (*Perl_Isv_root_ptr(aTHXo))
+#undef PL_sv_table
+#define PL_sv_table (*Perl_Isv_table_ptr(aTHXo))
#undef PL_sv_undef
#define PL_sv_undef (*Perl_Isv_undef_ptr(aTHXo))
#undef PL_sv_yes
@@ -2261,6 +2263,10 @@
#define Perl_newLISTOP pPerl->Perl_newLISTOP
#undef newLISTOP
#define newLISTOP Perl_newLISTOP
+#undef Perl_newPADOP
+#define Perl_newPADOP pPerl->Perl_newPADOP
+#undef newPADOP
+#define newPADOP Perl_newPADOP
#undef Perl_newPMOP
#define Perl_newPMOP pPerl->Perl_newPMOP
#undef newPMOP
@@ -3527,6 +3533,58 @@
#define Perl_boot_core_xsutils pPerl->Perl_boot_core_xsutils
#undef boot_core_xsutils
#define boot_core_xsutils Perl_boot_core_xsutils
+#if defined(USE_ITHREADS)
+#undef Perl_he_dup
+#define Perl_he_dup pPerl->Perl_he_dup
+#undef he_dup
+#define he_dup Perl_he_dup
+#undef Perl_re_dup
+#define Perl_re_dup pPerl->Perl_re_dup
+#undef re_dup
+#define re_dup Perl_re_dup
+#undef Perl_fp_dup
+#define Perl_fp_dup pPerl->Perl_fp_dup
+#undef fp_dup
+#define fp_dup Perl_fp_dup
+#undef Perl_dirp_dup
+#define Perl_dirp_dup pPerl->Perl_dirp_dup
+#undef dirp_dup
+#define dirp_dup Perl_dirp_dup
+#undef Perl_gp_dup
+#define Perl_gp_dup pPerl->Perl_gp_dup
+#undef gp_dup
+#define gp_dup Perl_gp_dup
+#undef Perl_mg_dup
+#define Perl_mg_dup pPerl->Perl_mg_dup
+#undef mg_dup
+#define mg_dup Perl_mg_dup
+#undef Perl_sv_dup
+#define Perl_sv_dup pPerl->Perl_sv_dup
+#undef sv_dup
+#define sv_dup Perl_sv_dup
+#if defined(HAVE_INTERP_INTERN)
+#undef Perl_sys_intern_dup
+#define Perl_sys_intern_dup pPerl->Perl_sys_intern_dup
+#undef sys_intern_dup
+#define sys_intern_dup Perl_sys_intern_dup
+#endif
+#undef Perl_sv_table_new
+#define Perl_sv_table_new pPerl->Perl_sv_table_new
+#undef sv_table_new
+#define sv_table_new Perl_sv_table_new
+#undef Perl_sv_table_fetch
+#define Perl_sv_table_fetch pPerl->Perl_sv_table_fetch
+#undef sv_table_fetch
+#define sv_table_fetch Perl_sv_table_fetch
+#undef Perl_sv_table_store
+#define Perl_sv_table_store pPerl->Perl_sv_table_store
+#undef sv_table_store
+#define sv_table_store Perl_sv_table_store
+#undef Perl_sv_table_split
+#define Perl_sv_table_split pPerl->Perl_sv_table_split
+#undef sv_table_split
+#define sv_table_split Perl_sv_table_split
+#endif
#if defined(PERL_OBJECT)
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
diff --git a/op.c b/op.c
index 89de1851e6..4577ff16b4 100644
--- a/op.c
+++ b/op.c
@@ -448,7 +448,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
(sv = names[PL_padix]) && sv != &PL_sv_undef)
continue;
sv = *av_fetch(PL_comppad, PL_padix, TRUE);
- if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)))
+ if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)) && !IS_PADGV(sv))
break;
}
retval = PL_padix;
@@ -717,8 +717,19 @@ S_op_clear(pTHX_ OP *o)
case OP_GVSV:
case OP_GV:
case OP_AELEMFAST:
- SvREFCNT_dec(cSVOPo->op_sv);
+#ifdef USE_ITHREADS
+ if (PL_curpad) {
+ GV *gv = cGVOPo;
+ pad_swipe(cPADOPo->op_padix);
+ /* No GvIN_PAD_off(gv) here, because other references may still
+ * exist on the pad */
+ SvREFCNT_dec(gv);
+ }
+ cPADOPo->op_padix = 0;
+#else
+ SvREFCNT_dec(cGVOPo);
cSVOPo->op_sv = Nullsv;
+#endif
break;
case OP_CONST:
SvREFCNT_dec(cSVOPo->op_sv);
@@ -753,15 +764,23 @@ S_op_clear(pTHX_ OP *o)
break;
}
- if (o->op_targ > 0)
+ if (o->op_targ > 0) {
pad_free(o->op_targ);
+ o->op_targ = 0;
+ }
}
STATIC void
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? */
+#else
+ /* NOTE: COP.cop_stash is not refcounted */
SvREFCNT_dec(CopFILEGV(cop));
+#endif
if (! specialWARN(cop->cop_warnings))
SvREFCNT_dec(cop->cop_warnings);
}
@@ -822,12 +841,12 @@ S_scalarboolean(pTHX_ OP *o)
if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
dTHR;
if (ckWARN(WARN_SYNTAX)) {
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
- PL_curcop->cop_line = PL_copline;
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
}
return scalar(o);
@@ -841,12 +860,10 @@ Perl_scalar(pTHX_ OP *o)
/* assumes no premature commitment */
if (!o || (o->op_flags & OPf_WANT) || PL_error_count
|| o->op_type == OP_RETURN)
+ {
return o;
+ }
- if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
- return scalar(o); /* As if inside SASSIGN */
-
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
switch (o->op_type) {
@@ -927,11 +944,15 @@ Perl_scalarvoid(pTHX_ OP *o)
want = o->op_flags & OPf_WANT;
if ((want && want != OPf_WANT_SCALAR) || PL_error_count
|| o->op_type == OP_RETURN)
+ {
return o;
+ }
if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+ {
return scalar(o); /* As if inside SASSIGN */
+ }
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
@@ -1129,11 +1150,15 @@ Perl_list(pTHX_ OP *o)
/* assumes no premature commitment */
if (!o || (o->op_flags & OPf_WANT) || PL_error_count
|| o->op_type == OP_RETURN)
+ {
return o;
+ }
if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+ {
return o; /* As if inside SASSIGN */
+ }
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
@@ -1243,8 +1268,10 @@ Perl_mod(pTHX_ OP *o, I32 type)
return o;
if ((o->op_private & OPpTARGET_MY)
- && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
+ {
return o;
+ }
switch (o->op_type) {
case OP_UNDEF:
@@ -1357,7 +1384,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
break;
}
- cv = GvCV((GV*)kSVOP->op_sv);
+ cv = GvCV(kGVOP);
if (!cv)
goto restore_2cv;
if (CvLVALUE(cv))
@@ -2790,8 +2817,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
OP *curop;
if (pm->op_pmflags & PMf_EVAL) {
curop = 0;
- if (PL_curcop->cop_line < PL_multi_end)
- PL_curcop->cop_line = PL_multi_end;
+ if (CopLINE(PL_curcop) < PL_multi_end)
+ CopLINE_set(PL_curcop, PL_multi_end);
}
#ifdef USE_THREADS
else if (repl->op_type == OP_THREADSV
@@ -2815,7 +2842,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
}
#else
if (curop->op_type == OP_GV) {
- GV *gv = (GV*)((SVOP*)curop)->op_sv;
+ GV *gv = cGVOPx(curop);
repl_has_vars = 1;
if (strchr("&`'123456789+", *GvENAME(gv)))
break;
@@ -2896,10 +2923,33 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
}
OP *
+Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
+{
+ PADOP *padop;
+ NewOp(1101, padop, 1, PADOP);
+ padop->op_type = type;
+ padop->op_ppaddr = PL_ppaddr[type];
+ padop->op_padix = pad_alloc(type, SVs_PADTMP);
+ PL_curpad[padop->op_padix] = sv;
+ padop->op_next = (OP*)padop;
+ padop->op_flags = flags;
+ if (PL_opargs[type] & OA_RETSCALAR)
+ scalar((OP*)padop);
+ if (PL_opargs[type] & OA_TARGET)
+ padop->op_targ = pad_alloc(type, SVs_PADTMP);
+ return CHECKOP(type, padop);
+}
+
+OP *
Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
{
dTHR;
+#ifdef USE_ITHREADS
+ GvIN_PAD_on(gv);
+ return newPADOP(type, flags, SvREFCNT_inc(gv));
+#else
return newSVOP(type, flags, SvREFCNT_inc(gv));
+#endif
}
OP *
@@ -3138,7 +3188,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 = (GV*)((SVOP*)curop)->op_sv;
+ GV *gv = cGVOPx(curop);
if (gv == PL_defgv || SvCUR(gv) == PL_generation)
break;
SvCUR(gv) = PL_generation;
@@ -3190,7 +3240,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*)((SVOP*)tmpop)->op_sv;
+ pm->op_pmreplroot = (OP*)cGVOPx(tmpop);
pm->op_pmflags |= PMf_ONCE;
tmpop = cUNOPo->op_first; /* to list (nulled) */
tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
@@ -3243,7 +3293,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
register COP *cop;
NewOp(1101, cop, 1, COP);
- if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
+ if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
cop->op_type = OP_DBSTATE;
cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
}
@@ -3272,13 +3322,17 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
if (PL_copline == NOLINE)
- cop->cop_line = PL_curcop->cop_line;
+ CopLINE_set(cop, CopLINE(PL_curcop));
else {
- cop->cop_line = PL_copline;
+ CopLINE_set(cop, PL_copline);
PL_copline = NOLINE;
}
+#ifdef USE_ITHREADS
+ CopFILE_set(cop, CopFILE(PL_curcop)); /* XXXXX share in a pvtable? */
+#else
CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
- cop->cop_stash = PL_curstash;
+#endif
+ CopSTASH_set(cop, PL_curstash);
if (PERLDB_LINE && PL_curstash != PL_debstash) {
SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE);
@@ -3397,14 +3451,14 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
break;
}
if (warnop) {
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = PL_copline;
+ line_t oldline = CopLINE(PL_curcop);
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_UNSAFE,
"Value of %s%s can be \"0\"; test with defined()",
PL_op_desc[warnop],
((warnop == OP_READLINE || warnop == OP_GLOB)
? " construct" : "() operator"));
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
}
@@ -3700,11 +3754,13 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
}
else if (sv->op_type == OP_PADSV) { /* private variable */
padoff = sv->op_targ;
+ sv->op_targ = 0;
op_free(sv);
sv = Nullop;
}
else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
padoff = sv->op_targ;
+ sv->op_targ = 0;
iterflags |= OPf_SPECIAL;
op_free(sv);
sv = Nullop;
@@ -3859,9 +3915,9 @@ Perl_cv_undef(pTHX_ CV *cv)
}
}
-#ifdef DEBUG_CLOSURES
+#ifdef DEBUGGING
STATIC void
-cv_dump(CV *cv)
+S_cv_dump(pTHX_ CV *cv)
{
CV *outside = CvOUTSIDE(cv);
AV* padlist = CvPADLIST(cv);
@@ -3904,7 +3960,7 @@ cv_dump(CV *cv)
SvIVX(pname[ix]));
}
}
-#endif /* DEBUG_CLOSURES */
+#endif /* DEBUGGING */
STATIC CV *
S_cv_clone2(pTHX_ CV *proto, CV *outside)
@@ -3941,6 +3997,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
MUTEX_INIT(CvMUTEXP(cv));
CvOWNER(cv) = 0;
#endif /* USE_THREADS */
+ CvFILE(cv) = CvFILE(proto);
CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto));
CvSTASH(cv) = CvSTASH(proto);
CvROOT(cv) = CvROOT(proto);
@@ -3999,6 +4056,9 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
PL_curpad[ix] = sv;
}
}
+ else if (IS_PADGV(ppad[ix])) {
+ PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
+ }
else {
SV* sv = NEWSV(0,0);
SvPADTMP_on(sv);
@@ -4203,12 +4263,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
"autouse"))) {
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = PL_copline;
+ line_t oldline = CopLINE(PL_curcop);
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_REDEFINE,
const_sv ? "Constant subroutine %s redefined"
: "Subroutine %s redefined", name);
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
cv = Nullcv;
@@ -4266,6 +4326,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
}
}
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvFILE(cv) = CopFILE(PL_curcop);
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(cv) = 0;
@@ -4312,7 +4373,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
SV *namesv;
- if (SvIMMORTAL(PL_curpad[ix]))
+ if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]))
continue;
/*
* The only things that a clonable function needs in its
@@ -4336,7 +4397,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
AvFLAGS(av) = AVf_REIFY;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
- if (SvIMMORTAL(PL_curpad[ix]))
+ if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]))
continue;
if (!SvPADMY(PL_curpad[ix]))
SvPADTMP_on(PL_curpad[ix]);
@@ -4388,8 +4449,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
if (strEQ(s, "BEGIN")) {
I32 oldscope = PL_scopestack_ix;
ENTER;
- SAVESPTR(CopFILEGV(&PL_compiling));
- SAVEI16(PL_compiling.cop_line);
+ SAVECOPFILE(&PL_compiling);
+ SAVECOPLINE(&PL_compiling);
save_svref(&PL_rs);
sv_setsv(PL_rs, PL_nrs);
@@ -4437,15 +4498,24 @@ void
Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
{
dTHR;
- U32 oldhints = PL_hints;
- HV *old_cop_stash = PL_curcop->cop_stash;
- HV *old_curstash = PL_curstash;
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = PL_copline;
+ ENTER;
+ SAVECOPLINE(PL_curcop);
+ SAVEHINTS();
+
+ CopLINE_set(PL_curcop, PL_copline);
PL_hints &= ~HINT_BLOCK_SCOPE;
- if(stash)
- PL_curstash = PL_curcop->cop_stash = stash;
+
+ if (stash) {
+ SAVESPTR(PL_curstash);
+ SAVECOPSTASH(PL_curcop);
+ PL_curstash = stash;
+#ifdef USE_ITHREADS
+ CopSTASHPV(PL_curcop) = stash ? HvNAME(stash) : Nullch;
+#else
+ CopSTASH(PL_curcop) = stash;
+#endif
+ }
newATTRSUB(
start_subparse(FALSE, 0),
@@ -4455,10 +4525,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
- PL_hints = oldhints;
- PL_curcop->cop_stash = old_cop_stash;
- PL_curstash = old_curstash;
- PL_curcop->cop_line = oldline;
+ LEAVE;
}
CV *
@@ -4479,11 +4546,11 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
- PL_curcop->cop_line = PL_copline;
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_REDEFINE, "Subroutine %s redefined",name);
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
cv = 0;
@@ -4508,6 +4575,8 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
CvOWNER(cv) = 0;
#endif /* USE_THREADS */
(void)gv_fetchfile(filename);
+ CvFILE(cv) = filename; /* NOTE: not copied, as it is expected to be
+ an external constant string */
CvXSUB(cv) = subaddr;
if (name) {
@@ -4567,17 +4636,18 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
GvMULTI_on(gv);
if (cv = GvFORM(gv)) {
if (ckWARN(WARN_REDEFINE)) {
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
- PL_curcop->cop_line = PL_copline;
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
SvREFCNT_dec(cv);
}
cv = PL_compcv;
GvFORM(gv) = cv;
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
+ CvFILE(cv) = CopFILE(PL_curcop);
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
@@ -5004,7 +5074,14 @@ Perl_ck_rvconst(pTHX_ register OP *o)
if (gv) {
kid->op_type = OP_GV;
SvREFCNT_dec(kid->op_sv);
+#ifdef USE_ITHREADS
+ /* XXXXXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
+ kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
+ GvIN_PAD_on(gv);
+ PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv);
+#else
kid->op_sv = SvREFCNT_inc(gv);
+#endif
kid->op_ppaddr = PL_ppaddr[OP_GV];
}
}
@@ -5477,6 +5554,7 @@ Perl_ck_sassign(pTHX_ OP *o)
return o;
}
kid->op_targ = kkid->op_targ;
+ kkid->op_targ = 0;
/* Now we do not need PADSV and SASSIGN. */
kid->op_sibling = o->op_sibling; /* NULL */
cLISTOPo->op_first = NULL;
@@ -5685,6 +5763,7 @@ S_simplify_sort(pTHX_ OP *o)
register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
int reversed;
+ GV *gv;
if (!(o->op_flags & OPf_STACKED))
return;
GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
@@ -5708,11 +5787,12 @@ S_simplify_sort(pTHX_ OP *o)
if (kUNOP->op_first->op_type != OP_GV)
return;
kid = kUNOP->op_first; /* get past rv2sv */
- if (GvSTASH((GV*)kSVOP->op_sv) != PL_curstash)
+ gv = kGVOP;
+ if (GvSTASH(gv) != PL_curstash)
return;
- if (strEQ(GvNAME((GV*)kSVOP->op_sv), "a"))
+ if (strEQ(GvNAME(gv), "a"))
reversed = 0;
- else if(strEQ(GvNAME((GV*)kSVOP->op_sv), "b"))
+ else if(strEQ(GvNAME(gv), "b"))
reversed = 1;
else
return;
@@ -5723,10 +5803,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((GV*)kSVOP->op_sv) != PL_curstash
+ gv = kGVOP;
+ if (GvSTASH(gv) != PL_curstash
|| ( reversed
- ? strNE(GvNAME((GV*)kSVOP->op_sv), "a")
- : strNE(GvNAME((GV*)kSVOP->op_sv), "b")))
+ ? strNE(GvNAME(gv), "a")
+ : strNE(GvNAME(gv), "b")))
return;
o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
if (reversed)
@@ -5832,11 +5913,12 @@ Perl_ck_subr(pTHX_ OP *o)
null(cvop); /* disable rv2cv */
tmpop = (SVOP*)((UNOP*)cvop)->op_first;
if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
- cv = GvCVu(tmpop->op_sv);
+ GV *gv = cGVOPx(tmpop);
+ cv = GvCVu(gv);
if (!cv)
tmpop->op_private |= OPpEARLY_CV;
else if (SvPOK(cv)) {
- namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
+ namegv = CvANON(cv) ? gv : CvGV(cv);
proto = SvPV((SV*)cv, n_a);
}
}
@@ -5899,7 +5981,7 @@ Perl_ck_subr(pTHX_ OP *o)
(gvop = ((UNOP*)gvop)->op_first) &&
gvop->op_type == OP_GV)
{
- GV *gv = (GV*)((SVOP*)gvop)->op_sv;
+ GV *gv = cGVOPx(gvop);
OP *sibling = o2->op_sibling;
SV *n = newSVpvn("",0);
op_free(o2);
@@ -6057,11 +6139,13 @@ Perl_peep(pTHX_ register OP *o)
&& (((LISTOP*)o)->op_first->op_sibling->op_type
== OP_PADSV)
&& (((LISTOP*)o)->op_first->op_sibling->op_targ
- == o->op_next->op_targ))) {
+ == o->op_next->op_targ)))
+ {
goto ignore_optimization;
}
else {
o->op_targ = o->op_next->op_targ;
+ o->op_next->op_targ = 0;
o->op_private |= OPpTARGET_MY;
}
}
@@ -6117,6 +6201,7 @@ Perl_peep(pTHX_ register OP *o)
<= 255 &&
i >= 0)
{
+ GV *gv;
null(o->op_next);
null(pop->op_next);
null(pop);
@@ -6125,11 +6210,12 @@ Perl_peep(pTHX_ register OP *o)
o->op_type = OP_AELEMFAST;
o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
o->op_private = (U8)i;
- GvAVn((GV*)((SVOP*)o)->op_sv);
+ gv = cGVOPo;
+ GvAVn(gv);
}
}
else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
- GV *gv = (GV*)cSVOPo->op_sv;
+ GV *gv = cGVOPo;
if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
/* XXX could check prototype here instead of just carping */
SV *sv = sv_newmortal();
@@ -6179,12 +6265,12 @@ Perl_peep(pTHX_ register OP *o)
o->op_next->op_sibling->op_type != OP_EXIT &&
o->op_next->op_sibling->op_type != OP_WARN &&
o->op_next->op_sibling->op_type != OP_DIE) {
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
- PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
+ CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
Perl_warner(aTHX_ WARN_SYNTAX, "Statement unlikely to be reached");
Perl_warner(aTHX_ WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n");
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
}
}
break;
diff --git a/op.h b/op.h
index c1ce70b5a7..95ecf87ecc 100644
--- a/op.h
+++ b/op.h
@@ -259,39 +259,70 @@ struct loop {
OP * op_lastop;
};
-#define cUNOP ((UNOP*)PL_op)
-#define cBINOP ((BINOP*)PL_op)
-#define cLISTOP ((LISTOP*)PL_op)
-#define cLOGOP ((LOGOP*)PL_op)
-#define cPMOP ((PMOP*)PL_op)
-#define cSVOP ((SVOP*)PL_op)
-#define cPADOP ((PADOP*)PL_op)
-#define cPVOP ((PVOP*)PL_op)
-#define cCOP ((COP*)PL_op)
-#define cLOOP ((LOOP*)PL_op)
-
-#define cUNOPo ((UNOP*)o)
-#define cBINOPo ((BINOP*)o)
-#define cLISTOPo ((LISTOP*)o)
-#define cLOGOPo ((LOGOP*)o)
-#define cPMOPo ((PMOP*)o)
-#define cSVOPo ((SVOP*)o)
-#define cPADOPo ((PADOP*)o)
-#define cPVOPo ((PVOP*)o)
-#define cCVOPo ((CVOP*)o)
-#define cCOPo ((COP*)o)
-#define cLOOPo ((LOOP*)o)
-
-#define kUNOP ((UNOP*)kid)
-#define kBINOP ((BINOP*)kid)
-#define kLISTOP ((LISTOP*)kid)
-#define kLOGOP ((LOGOP*)kid)
-#define kPMOP ((PMOP*)kid)
-#define kSVOP ((SVOP*)kid)
-#define kPADOP ((PADOP*)kid)
-#define kPVOP ((PVOP*)kid)
-#define kCOP ((COP*)kid)
-#define kLOOP ((LOOP*)kid)
+#define cUNOPx(o) ((UNOP*)o)
+#define cBINOPx(o) ((BINOP*)o)
+#define cLISTOPx(o) ((LISTOP*)o)
+#define cLOGOPx(o) ((LOGOP*)o)
+#define cPMOPx(o) ((PMOP*)o)
+#define cSVOPx(o) ((SVOP*)o)
+#define cPADOPx(o) ((PADOP*)o)
+#define cPVOPx(o) ((PVOP*)o)
+#define cCOPx(o) ((COP*)o)
+#define cLOOPx(o) ((LOOP*)o)
+
+#define cUNOP cUNOPx(PL_op)
+#define cBINOP cBINOPx(PL_op)
+#define cLISTOP cLISTOPx(PL_op)
+#define cLOGOP cLOGOPx(PL_op)
+#define cPMOP cPMOPx(PL_op)
+#define cSVOP cSVOPx(PL_op)
+#define cPADOP cPADOPx(PL_op)
+#define cPVOP cPVOPx(PL_op)
+#define cCOP cCOPx(PL_op)
+#define cLOOP cLOOPx(PL_op)
+
+#define cUNOPo cUNOPx(o)
+#define cBINOPo cBINOPx(o)
+#define cLISTOPo cLISTOPx(o)
+#define cLOGOPo cLOGOPx(o)
+#define cPMOPo cPMOPx(o)
+#define cSVOPo cSVOPx(o)
+#define cPADOPo cPADOPx(o)
+#define cPVOPo cPVOPx(o)
+#define cCOPo cCOPx(o)
+#define cLOOPo cLOOPx(o)
+
+#define kUNOP cUNOPx(kid)
+#define kBINOP cBINOPx(kid)
+#define kLISTOP cLISTOPx(kid)
+#define kLOGOP cLOGOPx(kid)
+#define kPMOP cPMOPx(kid)
+#define kSVOP cSVOPx(kid)
+#define kPADOP cPADOPx(kid)
+#define kPVOP cPVOPx(kid)
+#define kCOP cCOPx(kid)
+#define kLOOP cLOOPx(kid)
+
+
+#ifdef USE_ITHREADS
+# define cGVOPx(o) ((GV*)PAD_SV(cPADOPx(o)->op_padix))
+# define cGVOP ((GV*)PAD_SV(cPADOP->op_padix))
+# define cGVOPo ((GV*)PAD_SV(cPADOPo->op_padix))
+# define kGVOP ((GV*)PAD_SV(kPADOP->op_padix))
+# define cGVOP_set(v) (PL_curpad[cPADOP->op_padix] = (SV*)(v))
+# define cGVOPo_set(v) (PL_curpad[cPADOPo->op_padix] = (SV*)(v))
+# define kGVOP_set(v) (PL_curpad[kPADOP->op_padix] = (SV*)(v))
+# define IS_PADGV(v) (v && SvTYPE(v) == SVt_PVGV && GvIN_PAD(v))
+#else
+# define cGVOPx(o) ((GV*)cSVOPx(o)->op_sv)
+# define cGVOP ((GV*)cSVOP->op_sv)
+# define cGVOPo ((GV*)cSVOPo->op_sv)
+# define kGVOP ((GV*)kSVOP->op_sv)
+# define cGVOP_set(v) (cPADOP->op_sv = (SV*)(v))
+# define cGVOPo_set(v) (cPADOPo->op_sv = (SV*)(v))
+# define kGVOP_set(v) (kPADOP->op_sv = (SV*)(v))
+# define IS_PADGV(v) FALSE
+#endif
#define Nullop Null(OP*)
diff --git a/opcode.pl b/opcode.pl
index 1c5c3e29fe..60cdf49ff2 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -183,7 +183,7 @@ END
'|', 3, # logop
'@', 4, # listop
'/', 5, # pmop
- '$', 6, # svop
+ '$', 6, # svop_or_padop
'#', 7, # padop
'"', 8, # pvop_or_svop
'{', 9, # loop
diff --git a/perl.c b/perl.c
index cc13c23a88..11a06bd4f1 100644
--- a/perl.c
+++ b/perl.c
@@ -281,8 +281,8 @@ perl_destruct(pTHXx)
goto retry_cleanup;
default:
DEBUG_S(PerlIO_printf(Perl_debug_log,
- "perl_destruct: ignoring %p (state %"UVuf")\n",
- t, (UV)ThrSTATE(t)));
+ "perl_destruct: ignoring %p (state %u)\n",
+ t, ThrSTATE(t)));
MUTEX_UNLOCK(&t->mutex);
/* fall through and out */
}
@@ -451,15 +451,77 @@ perl_destruct(pTHXx)
PL_stderrgv = Nullgv;
PL_last_in_gv = Nullgv;
PL_replgv = Nullgv;
+ PL_debstash = Nullhv;
/* reset so print() ends up where we expect */
setdefout(Nullgv);
+ SvREFCNT_dec(PL_argvout_stack);
+ PL_argvout_stack = Nullav;
+
+ SvREFCNT_dec(PL_fdpid);
+ PL_fdpid = Nullav;
+ SvREFCNT_dec(PL_modglobal);
+ PL_modglobal = Nullhv;
+ SvREFCNT_dec(PL_preambleav);
+ PL_preambleav = Nullav;
+ SvREFCNT_dec(PL_subname);
+ PL_subname = Nullsv;
+ SvREFCNT_dec(PL_linestr);
+ PL_linestr = Nullsv;
+ SvREFCNT_dec(PL_pidstatus);
+ PL_pidstatus = Nullhv;
+ SvREFCNT_dec(PL_toptarget);
+ PL_toptarget = Nullsv;
+ SvREFCNT_dec(PL_bodytarget);
+ PL_bodytarget = Nullsv;
+ PL_formtarget = Nullsv;
+
+ /* clear utf8 character classes */
+ SvREFCNT_dec(PL_utf8_alnum);
+ SvREFCNT_dec(PL_utf8_alnumc);
+ SvREFCNT_dec(PL_utf8_ascii);
+ SvREFCNT_dec(PL_utf8_alpha);
+ SvREFCNT_dec(PL_utf8_space);
+ SvREFCNT_dec(PL_utf8_cntrl);
+ SvREFCNT_dec(PL_utf8_graph);
+ SvREFCNT_dec(PL_utf8_digit);
+ SvREFCNT_dec(PL_utf8_upper);
+ SvREFCNT_dec(PL_utf8_lower);
+ SvREFCNT_dec(PL_utf8_print);
+ SvREFCNT_dec(PL_utf8_punct);
+ SvREFCNT_dec(PL_utf8_xdigit);
+ SvREFCNT_dec(PL_utf8_mark);
+ SvREFCNT_dec(PL_utf8_toupper);
+ SvREFCNT_dec(PL_utf8_tolower);
+ PL_utf8_alnum = Nullsv;
+ PL_utf8_alnumc = Nullsv;
+ PL_utf8_ascii = Nullsv;
+ PL_utf8_alpha = Nullsv;
+ PL_utf8_space = Nullsv;
+ PL_utf8_cntrl = Nullsv;
+ PL_utf8_graph = Nullsv;
+ PL_utf8_digit = Nullsv;
+ PL_utf8_upper = Nullsv;
+ PL_utf8_lower = Nullsv;
+ PL_utf8_print = Nullsv;
+ PL_utf8_punct = Nullsv;
+ PL_utf8_xdigit = Nullsv;
+ PL_utf8_mark = Nullsv;
+ PL_utf8_toupper = Nullsv;
+ PL_utf8_totitle = Nullsv;
+ PL_utf8_tolower = Nullsv;
+
+ SvREFCNT_dec(PL_compiling.cop_warnings);
+ PL_compiling.cop_warnings = Nullsv;
+
/* Prepare to destruct main symbol table. */
hv = PL_defstash;
PL_defstash = 0;
SvREFCNT_dec(hv);
+ SvREFCNT_dec(PL_curstname);
+ PL_curstname = Nullsv;
/* clear queued errors */
SvREFCNT_dec(PL_errors);
@@ -530,8 +592,6 @@ perl_destruct(pTHXx)
sv_free_arenas();
/* No SVs have survived, need to clean out */
- PL_linestr = NULL;
- PL_pidstatus = Nullhv;
Safefree(PL_origfilename);
Safefree(PL_archpat_auto);
Safefree(PL_reg_start_tmp);
@@ -753,11 +813,6 @@ S_parse_body(pTHX_ va_list args)
goto reswitch;
case 'e':
-#ifdef MACOS_TRADITIONAL
- /* ignore -e for Dev:Pseudo argument */
- if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
- break;
-#endif
if (PL_euid != PL_uid || PL_egid != PL_gid)
Perl_croak(aTHX_ "No -e allowed in setuid scripts");
if (!PL_e_script) {
@@ -960,14 +1015,11 @@ print \" \\@INC:\\n @INC\\n\";");
}
#endif
-#ifdef MACOS_TRADITIONAL
- if (PL_doextract || gAlwaysExtract)
-#else
if (PL_doextract) {
-#endif
find_beginning();
if (cddir && PerlDir_chdir(cddir) < 0)
Perl_croak(aTHX_ "Can't chdir to %s",cddir);
+
}
PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
@@ -1022,16 +1074,6 @@ print \" \\@INC:\\n @INC\\n\";");
SETERRNO(0,SS$_NORMAL);
PL_error_count = 0;
-#ifdef MACOS_TRADITIONAL
- if (gSyntaxError = (yyparse() || PL_error_count)) {
- if (PL_minus_c)
- Perl_croak(aTHX_ "%s had compilation errors.\n", MPWFileName(PL_origfilename));
- else {
- Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
- MPWFileName(PL_origfilename));
- }
- }
-#else
if (yyparse() || PL_error_count) {
if (PL_minus_c)
Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
@@ -1040,8 +1082,7 @@ print \" \\@INC:\\n @INC\\n\";");
PL_origfilename);
}
}
-#endif
- PL_curcop->cop_line = 0;
+ CopLINE_set(PL_curcop, 0);
PL_curstash = PL_defstash;
PL_preprocess = FALSE;
if (PL_e_script) {
@@ -1056,8 +1097,11 @@ print \" \\@INC:\\n @INC\\n\";");
if (PL_do_undump)
my_unexec();
- if (isWARN_ONCE)
+ if (isWARN_ONCE) {
+ SAVECOPFILE(PL_curcop);
+ SAVECOPLINE(PL_curcop);
gv_check(PL_defstash);
+ }
LEAVE;
FREETMPS;
@@ -1134,12 +1178,8 @@ S_run_body(pTHX_ va_list args)
PTR2UV(thr)));
if (PL_minus_c) {
-#ifdef MACOS_TRADITIONAL
- PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", MPWFileName(PL_origfilename));
-#else
PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
-#endif
-my_exit(0);
+ my_exit(0);
}
if (PERLDB_SINGLE && PL_DBsingle)
sv_setiv(PL_DBsingle, 1);
@@ -1648,10 +1688,10 @@ Perl_moreswitches(pTHX_ char *s)
my_setenv("PERL5DB", Perl_form(aTHX_ "use Devel::%s;", ++s));
s += strlen(s);
}
- if (!PL_perldb) {
+ if (!PL_perldb)
PL_perldb = PERLDB_ALL;
+ if (!PL_debstash)
init_debugger();
- }
return s;
case 'D':
{
@@ -1761,7 +1801,7 @@ Perl_moreswitches(pTHX_ char *s)
sv_catpv(sv, "})");
}
s += strlen(s);
- if (PL_preambleav == NULL)
+ if (!PL_preambleav)
PL_preambleav = newAV();
av_push(PL_preambleav, sv);
}
@@ -1787,9 +1827,6 @@ Perl_moreswitches(pTHX_ char *s)
s++;
return s;
case 'u':
-#ifdef MACOS_TRADITIONAL
- Perl_croak(aTHX_ "Believe me, you don't want to use \"-u\" on a Macintosh");
-#endif
PL_do_undump = TRUE;
s++;
return s;
@@ -1812,9 +1849,6 @@ Perl_moreswitches(pTHX_ char *s)
#endif
printf("\n\nCopyright 1987-1999, Larry Wall\n");
-#ifdef MACOS_TRADITIONAL
- fputs("Macintosh port Copyright 1991-1999, Matthias Neeracher\n", stdout);
-#endif
#ifdef MSDOS
printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
#endif
@@ -2012,12 +2046,6 @@ S_init_interp(pTHX)
# endif
#endif
-#ifdef MACOS_TRADITIONAL
- /* In MacOS time() already returns values in excess of 2**31-1,
- * therefore we patch the integerness away. */
- PL_opargs[OP_TIME] &= ~OA_RETINTEGER;
-#endif
-
}
STATIC void
@@ -2056,8 +2084,7 @@ S_init_main_stash(pTHX)
sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
sv_setpvn(ERRSV, "", 0);
PL_curstash = PL_defstash;
- PL_compiling.cop_stash = PL_defstash;
- PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+ CopSTASH_set(&PL_compiling, PL_defstash);
PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
sv_setpvn(get_sv("/", TRUE), "\n", 1);
@@ -2091,7 +2118,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
}
}
- CopFILEGV_set(PL_curcop, gv_fetchfile(PL_origfilename));
+ CopFILE_set(PL_curcop, PL_origfilename);
if (strEQ(PL_origfilename,"-"))
scriptname = "";
if (*fdscript >= 0) {
@@ -2422,7 +2449,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
if (PL_statbuf.st_mode & S_IWOTH)
Perl_croak(aTHX_ "Setuid/gid script is writable by world");
PL_doswitches = FALSE; /* -s is insecure in suid */
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
Perl_croak(aTHX_ "No #! line");
@@ -2567,32 +2594,11 @@ S_find_beginning(pTHX)
/* skip forward in input to the real script? */
forbid_setid("-x");
-#ifdef MACOS_TRADITIONAL
- /* Since the Mac OS does not honor !# arguments for us,
- * we do it ourselves. */
- while (PL_doextract || gAlwaysExtract) {
- if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
- if (!gAlwaysExtract)
- Perl_croak(aTHX_ "No Perl script found in input\n");
-
- if (PL_doextract) /* require explicit override ? */
- if (!OverrideExtract(PL_origfilename))
- Perl_croak(aTHX_ "User aborted script\n");
- else
- PL_doextract = FALSE;
-
- /* Pater peccavi, file does not have #! */
- PerlIO_rewind(PL_rsfp);
-
- break;
- }
-#else
while (PL_doextract) {
if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch)
Perl_croak(aTHX_ "No Perl script found in input\n");
-#endif
if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) {
- PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */
+ PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */
PL_doextract = FALSE;
while (*s && !(isSPACE (*s) || *s == '#')) s++;
s2 = s;
@@ -2637,6 +2643,7 @@ Perl_init_debugger(pTHX)
dTHR;
HV *ostash = PL_curstash;
+ PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
PL_curstash = PL_debstash;
PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
AvREAL_off(PL_dbargs);
@@ -2772,9 +2779,8 @@ S_init_predump_symbols(pTHX)
PL_statname = NEWSV(66,0); /* last filename we did stat on */
- if (PL_osname)
- Safefree(PL_osname);
- PL_osname = savepv(OSNAME);
+ if (!PL_osname)
+ PL_osname = savepv(OSNAME);
}
STATIC void
@@ -2812,13 +2818,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
TAINT;
if (tmpgv = gv_fetchpv("0",TRUE, SVt_PV)) {
-#ifdef MACOS_TRADITIONAL
- sv_setpv(GvSV(tmpgv),MPWFileName(PL_origfilename));
- /* $0 is not majick on a Mac */
-#else
sv_setpv(GvSV(tmpgv),PL_origfilename);
magicname("0", "0", 1);
-#endif
}
if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))
#ifdef OS2
@@ -2833,7 +2834,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
for (; argc > 0; argc--,argv++) {
av_push(GvAVn(PL_argvgv),newSVpv(argv[0],0));
}
- PL_argvout_stack = newAV();
}
if (PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
HV *hv;
@@ -2910,24 +2910,6 @@ S_init_perllib(pTHX)
#ifdef ARCHLIB_EXP
incpush(ARCHLIB_EXP, FALSE);
#endif
-#ifdef MACOS_TRADITIONAL
- {
- struct stat tmpstatbuf;
- SV * privdir = NEWSV(55, 0);
- char * macperl = getenv("MACPERL") || "";
-
- Perl_sv_setpvf(privdir, "%slib:", macperl);
- if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush(SvPVX(privdir), TRUE);
- Perl_sv_setpvf(privdir, "%ssite_perl:", macperl);
- if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush(SvPVX(privdir), TRUE);
-
- SvREFCNT_dec(privdir);
- }
- if (!PL_tainting)
- incpush(":", FALSE);
-#else
#ifndef PRIVLIB_EXP
#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
@@ -2956,24 +2938,19 @@ S_init_perllib(pTHX)
#endif
if (!PL_tainting)
incpush(".", FALSE);
-#endif /* MACOS_TRADITIONAL */
}
-#if defined(MACOS_TRADITIONAL)
-# define PERLLIB_SEP ','
+#if defined(DOSISH)
+# define PERLLIB_SEP ';'
#else
-# if defined(DOSISH)
-# define PERLLIB_SEP ';'
+# if defined(VMS)
+# define PERLLIB_SEP '|'
# else
-# if defined(VMS)
-# define PERLLIB_SEP '|'
-# else
-# define PERLLIB_SEP ':'
-# endif
+# define PERLLIB_SEP ':'
# endif
-#endif
+#endif
#ifndef PERLLIB_MANGLE
-# define PERLLIB_MANGLE(s,n) (s)
+# define PERLLIB_MANGLE(s,n) (s)
#endif
STATIC void
@@ -2990,11 +2967,7 @@ S_incpush(pTHX_ char *p, int addsubdirs)
STRLEN len = (sizeof(ARCHNAME) + strlen(PL_patchlevel)
+ sizeof("//auto"));
New(55, PL_archpat_auto, len, char);
-#ifdef MACOS_TRADITIONAL
- sprintf(PL_archpat_auto, "%s:%s:auto:", ARCHNAME, PL_patchlevel);
-#else
- sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel);
-#endif
+ sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel);
#ifdef VMS
for (len = sizeof(ARCHNAME) + 2;
PL_archpat_auto[len] != '\0' && PL_archpat_auto[len] != '/'; len++)
@@ -3024,12 +2997,6 @@ S_incpush(pTHX_ char *p, int addsubdirs)
sv_setpv(libdir, PERLLIB_MANGLE(p, 0));
p = Nullch; /* break out */
}
-#ifdef MACOS_TRADITIONAL
- if (!strchr(SvPVX(libdir), ':'))
- sv_insert(libdir, 0, 0, ":", 1);
- if (SvPVX(libdir)[SvCUR(libdir)-1] != ':')
- sv_catpv(libdir, ":");
-#endif
/*
* BEFORE pushing libdir onto @INC we may first push version- and
@@ -3155,7 +3122,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
{
dTHR;
SV *atsv = ERRSV;
- line_t oldline = PL_curcop->cop_line;
+ line_t oldline = CopLINE(PL_curcop);
CV *cv;
STRLEN len;
int ret;
@@ -3170,7 +3137,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
(void)SvPV(atsv, len);
if (len) {
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
if (paramList == PL_beginav)
sv_catpv(atsv, "BEGIN failed--compilation aborted");
else
@@ -3194,7 +3161,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
FREETMPS;
PL_curstash = PL_defstash;
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
if (PL_statusvalue) {
if (paramList == PL_beginav)
Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
@@ -3209,7 +3176,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
case 3:
if (PL_restartop) {
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
JMPENV_JUMP(3);
}
PerlIO_printf(Perl_error_log, "panic: restartop\n");
@@ -3323,4 +3290,3 @@ read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen)
sv_chop(PL_e_script, nl);
return 1;
}
-
diff --git a/perl.h b/perl.h
index 0cde982d19..525221139c 100644
--- a/perl.h
+++ b/perl.h
@@ -470,7 +470,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
# include <stdlib.h>
#endif
-#if !defined(PERL_FOR_X2P) && !defined(PERL_OBJECT)
+#if !defined(PERL_FOR_X2P) && !defined(WIN32)
# include "embed.h"
#endif
@@ -1326,6 +1326,8 @@ typedef struct xpvfm XPVFM;
typedef struct xpvio XPVIO;
typedef struct mgvtbl MGVTBL;
typedef union any ANY;
+typedef struct svtblent SVTBLENT;
+typedef struct svtbl SVTBL;
#include "handy.h"
@@ -1749,6 +1751,18 @@ struct scan_data_t; /* Used in S_* functions in regcomp.c */
typedef I32 CHECKPOINT;
+struct svtblent {
+ struct svtblent* next;
+ SV* oldval;
+ SV* newval;
+};
+
+struct svtbl {
+ struct svtblent** tbl_ary;
+ UV tbl_max;
+ UV tbl_items;
+};
+
#if defined(iAPX286) || defined(M_I286) || defined(I80286)
# define I286
#endif
@@ -2662,6 +2676,10 @@ PERLVARA(object_compatibility,30, char)
/* this has structure inits, so it cannot be included before here */
# include "opcode.h"
+#else
+# if defined(WIN32)
+# include "embed.h"
+# endif
#endif /* PERL_OBJECT */
#ifndef PERL_GLOBAL_STRUCT
diff --git a/perlapi.c b/perlapi.c
index 41dd32a387..6ea713ce16 100755
--- a/perlapi.c
+++ b/perlapi.c
@@ -2636,6 +2636,13 @@ Perl_newLISTOP(pTHXo_ I32 type, I32 flags, OP* first, OP* last)
return ((CPerlObj*)pPerl)->Perl_newLISTOP(type, flags, first, last);
}
+#undef Perl_newPADOP
+OP*
+Perl_newPADOP(pTHXo_ I32 type, I32 flags, SV* sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_newPADOP(type, flags, sv);
+}
+
#undef Perl_newPMOP
OP*
Perl_newPMOP(pTHXo_ I32 type, I32 flags)
@@ -4848,6 +4855,94 @@ Perl_boot_core_xsutils(pTHXo)
{
((CPerlObj*)pPerl)->Perl_boot_core_xsutils();
}
+#if defined(USE_ITHREADS)
+
+#undef Perl_he_dup
+HE*
+Perl_he_dup(pTHXo_ HE* e, bool shared)
+{
+ return ((CPerlObj*)pPerl)->Perl_he_dup(e, shared);
+}
+
+#undef Perl_re_dup
+REGEXP*
+Perl_re_dup(pTHXo_ REGEXP* r)
+{
+ return ((CPerlObj*)pPerl)->Perl_re_dup(r);
+}
+
+#undef Perl_fp_dup
+PerlIO*
+Perl_fp_dup(pTHXo_ PerlIO* fp, char type)
+{
+ return ((CPerlObj*)pPerl)->Perl_fp_dup(fp, type);
+}
+
+#undef Perl_dirp_dup
+DIR*
+Perl_dirp_dup(pTHXo_ DIR* dp)
+{
+ return ((CPerlObj*)pPerl)->Perl_dirp_dup(dp);
+}
+
+#undef Perl_gp_dup
+GP*
+Perl_gp_dup(pTHXo_ GP* gp)
+{
+ return ((CPerlObj*)pPerl)->Perl_gp_dup(gp);
+}
+
+#undef Perl_mg_dup
+MAGIC*
+Perl_mg_dup(pTHXo_ MAGIC* mg)
+{
+ return ((CPerlObj*)pPerl)->Perl_mg_dup(mg);
+}
+
+#undef Perl_sv_dup
+SV*
+Perl_sv_dup(pTHXo_ SV* sstr)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_dup(sstr);
+}
+#if defined(HAVE_INTERP_INTERN)
+
+#undef Perl_sys_intern_dup
+void
+Perl_sys_intern_dup(pTHXo_ struct interp_intern* src, struct interp_intern* dst)
+{
+ ((CPerlObj*)pPerl)->Perl_sys_intern_dup(src, dst);
+}
+#endif
+
+#undef Perl_sv_table_new
+SVTBL*
+Perl_sv_table_new(pTHXo)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_table_new();
+}
+
+#undef Perl_sv_table_fetch
+SV*
+Perl_sv_table_fetch(pTHXo_ SVTBL *tbl, SV *sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_table_fetch(tbl, sv);
+}
+
+#undef Perl_sv_table_store
+void
+Perl_sv_table_store(pTHXo_ SVTBL *tbl, SV *oldsv, SV *newsv)
+{
+ ((CPerlObj*)pPerl)->Perl_sv_table_store(tbl, oldsv, newsv);
+}
+
+#undef Perl_sv_table_split
+void
+Perl_sv_table_split(pTHXo_ SVTBL *tbl)
+{
+ ((CPerlObj*)pPerl)->Perl_sv_table_split(tbl);
+}
+#endif
#if defined(PERL_OBJECT)
#endif
#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
diff --git a/pp.c b/pp.c
index 7d1673cb70..1fb26c3a6c 100644
--- a/pp.c
+++ b/pp.c
@@ -254,7 +254,7 @@ PP(pp_rv2gv)
}
}
}
- gv_init(gv, PL_curcop->cop_stash, name, len, 0);
+ gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
sv_upgrade(sv, SVt_RV);
SvRV(sv) = (SV *) gv;
SvROK_on(sv);
@@ -581,7 +581,7 @@ PP(pp_bless)
HV *stash;
if (MAXARG == 1)
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
else {
SV *ssv = POPs;
STRLEN len;
@@ -854,7 +854,7 @@ PP(pp_undef)
Newz(602, gp, 1, GP);
GvGP(sv) = gp_ref(gp);
GvSV(sv) = NEWSV(72,0);
- GvLINE(sv) = PL_curcop->cop_line;
+ GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = (GV*)sv;
GvMULTI_on(sv);
}
diff --git a/pp_ctl.c b/pp_ctl.c
index 5cbe74ec07..22c83aa8d0 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -792,7 +792,7 @@ PP(pp_sort)
kid = kUNOP->op_first; /* pass rv2gv */
kid = kUNOP->op_first; /* pass leave */
PL_sortcop = kid->op_next;
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
}
else {
cv = sv_2cv(*++MARK, &stash, &gv, 0);
@@ -822,7 +822,7 @@ PP(pp_sort)
}
else {
PL_sortcop = Nullop;
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
}
up = myorigmark + 1;
@@ -1428,8 +1428,8 @@ PP(pp_caller)
cx = &ccstack[dbcxix];
}
+ hv = CopSTASH(cx->blk_oldcop);
if (GIMME != G_ARRAY) {
- hv = cx->blk_oldcop->cop_stash;
if (!hv)
PUSHs(&PL_sv_undef);
else {
@@ -1440,13 +1440,12 @@ PP(pp_caller)
RETURN;
}
- hv = cx->blk_oldcop->cop_stash;
if (!hv)
PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
PUSHs(sv_2mortal(newSVsv(CopFILESV(cx->blk_oldcop))));
- PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
+ PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop))));
if (!MAXARG)
RETURN;
if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */
@@ -1480,7 +1479,7 @@ PP(pp_caller)
PUSHs(&PL_sv_undef);
}
if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs
- && PL_curcop->cop_stash == PL_debstash)
+ && CopSTASH(PL_curcop) == PL_debstash)
{
AV *ary = cx->blk_sub.argarray;
int off = AvARRAY(ary) - AvALLOC(ary);
@@ -1516,7 +1515,7 @@ PP(pp_reset)
tmps = "";
else
tmps = POPpx;
- sv_reset(tmps, PL_curcop->cop_stash);
+ sv_reset(tmps, CopSTASH(PL_curcop));
PUSHs(&PL_sv_yes);
RETURN;
}
@@ -2111,7 +2110,6 @@ PP(pp_goto)
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
else { /* save temporaries on recursion? */
- PERL_STACK_OVERFLOW_CHECK();
if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
sub_crush_depth(cv);
if (CvDEPTH(cv) > AvFILLp(padlist)) {
@@ -2139,6 +2137,9 @@ PP(pp_goto)
SvPADMY_on(sv);
}
}
+ else if (IS_PADGV(oldpad[ix])) {
+ av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
+ }
else {
av_store(newpad, ix, sv = NEWSV(0,0));
SvPADTMP_on(sv);
@@ -2486,14 +2487,14 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
/* switch to eval mode */
if (PL_curcop == &PL_compiling) {
- SAVESPTR(PL_compiling.cop_stash);
- PL_compiling.cop_stash = PL_curstash;
+ SAVECOPSTASH(&PL_compiling);
+ CopSTASH_set(&PL_compiling, PL_curstash);
}
- SAVESPTR(CopFILEGV(&PL_compiling));
- SAVEI16(PL_compiling.cop_line);
+ SAVECOPFILE(&PL_compiling);
+ SAVECOPLINE(&PL_compiling);
sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
- CopFILEGV_set(&PL_compiling, gv_fetchfile(tmpbuf+2));
- PL_compiling.cop_line = 1;
+ CopFILE_set(&PL_compiling, tmpbuf+2);
+ 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
(i.e. before run-time proper). To work around the coredump that
@@ -2603,7 +2604,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
/* make sure we compile in the right package */
- newstash = PL_curcop->cop_stash;
+ newstash = CopSTASH(PL_curcop);
if (PL_curstash != newstash) {
SAVESPTR(PL_curstash);
PL_curstash = newstash;
@@ -2669,7 +2670,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
}
SvREFCNT_dec(PL_rs);
PL_rs = SvREFCNT_inc(PL_nrs);
- PL_compiling.cop_line = 0;
+ CopLINE_set(&PL_compiling, 0);
if (startop) {
*startop = PL_eval_root;
SvREFCNT_dec(CvOUTSIDE(PL_compcv));
@@ -2780,42 +2781,14 @@ PP(pp_require)
/* prepare to compile file */
-#ifdef MACOS_TRADITIONAL
- if (strchr(name, ':')
-#else
- if (*name == '/' ||
- (*name == '.' &&
- (name[1] == '/' ||
- (name[1] == '.' && name[2] == '/')))
-#ifdef DOSISH
- || (name[0] && name[1] == ':')
-#endif
-#ifdef WIN32
- || (name[0] == '\\' && name[1] == '\\') /* UNC path */
-#endif
-#ifdef VMS
- || (strchr(name,':') || ((*name == '[' || *name == '<') &&
- (isALNUM(name[1]) || strchr("$-_]>",name[1]))))
-#endif
-#endif
- )
+ if (PERL_FILE_IS_ABSOLUTE(name)
+ || (*name == '.' && (name[1] == '/' ||
+ (name[1] == '.' && name[2] == '/'))))
{
tryname = name;
tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
-#ifdef MACOS_TRADITIONAL
- /* We consider paths of the form :a:b ambiguous and interpret them first
- as global then as local
- */
- if (name[0] == ':' && !tryrsfp && name[1] != ':' && strchr(name+2, ':'))
- goto trylocal;
-#endif
}
-#ifdef MACOS_TRADITIONAL
- else
-trylocal: {
-#else
else {
-#endif
AV *ar = GvAVn(PL_incgv);
I32 i;
#ifdef VMS
@@ -2933,24 +2906,6 @@ trylocal: {
}
else {
char *dir = SvPVx(dirsv, n_a);
-#ifdef MACOS_TRADITIONAL
- /* We have ensured in incpush that library ends with ':' */
- int dirlen = strlen(dir);
- char *colon = strchr(dir, ':') ? "" : ":";
- int colons = (dir[dirlen-1] == ':') + (*name == ':');
-
- switch (colons) {
- case 2:
- sv_setpvfaTHX_ (namesv, "%s%s%s", colon, dir, name+1);
- break;
- case 1:
- sv_setpvf(aTHX_ namesv, "%s%s%s", colon, dir, name);
- break;
- case 0:
- sv_setpvf(aTHX_ namesv, "%s%s:%s", colon, dir, name);
- break;
- }
-#else
#ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
@@ -2960,13 +2915,8 @@ trylocal: {
#else
Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
#endif
-#endif
TAINT_PROPER("require");
tryname = SvPVX(namesv);
-#ifdef MACOS_TRADITIONAL
- for (colon = tryname+dirlen; colon = strchr(colon, '/'); )
- *colon++ = ':';
-#endif
tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
if (tryrsfp) {
if (tryname[0] == '.' && tryname[1] == '/')
@@ -2977,8 +2927,8 @@ trylocal: {
}
}
}
- SAVESPTR(CopFILEGV(&PL_compiling));
- CopFILEGV_set(&PL_compiling, gv_fetchfile(tryrsfp ? tryname : name));
+ SAVECOPFILE(&PL_compiling);
+ CopFILE_set(&PL_compiling, tryrsfp ? tryname : name);
SvREFCNT_dec(namesv);
if (!tryrsfp) {
if (PL_op->op_type == OP_REQUIRE) {
@@ -3047,8 +2997,8 @@ trylocal: {
PUSHBLOCK(cx, CXt_EVAL, SP);
PUSHEVAL(cx, name, Nullgv);
- SAVEI16(PL_compiling.cop_line);
- PL_compiling.cop_line = 0;
+ SAVECOPLINE(&PL_compiling);
+ CopLINE_set(&PL_compiling, 0);
PUTBACK;
#ifdef USE_THREADS
@@ -3088,10 +3038,10 @@ PP(pp_entereval)
/* switch to eval mode */
- SAVESPTR(CopFILEGV(&PL_compiling));
+ SAVECOPFILE(&PL_compiling);
sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
- CopFILEGV_set(&PL_compiling, gv_fetchfile(tmpbuf+2));
- PL_compiling.cop_line = 1;
+ CopFILE_set(&PL_compiling, tmpbuf+2);
+ 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
(i.e. before run-time proper). To work around the coredump that
diff --git a/pp_hot.c b/pp_hot.c
index de35e84f44..421b0995cd 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -58,9 +58,9 @@ PP(pp_gvsv)
djSP;
EXTEND(SP,1);
if (PL_op->op_private & OPpLVAL_INTRO)
- PUSHs(save_scalar((GV*)cSVOP->op_sv));
+ PUSHs(save_scalar(cGVOP));
else
- PUSHs(GvSV((GV*)cSVOP->op_sv));
+ PUSHs(GvSV(cGVOP));
RETURN;
}
@@ -95,7 +95,7 @@ PP(pp_stringify)
PP(pp_gv)
{
djSP;
- XPUSHs(cSVOP->op_sv);
+ XPUSHs((SV*)cGVOP);
RETURN;
}
@@ -271,7 +271,7 @@ PP(pp_add)
PP(pp_aelemfast)
{
djSP;
- AV *av = GvAV((GV*)cSVOP->op_sv);
+ AV *av = GvAV(cGVOP);
U32 lval = PL_op->op_flags & OPf_MOD;
SV** svp = av_fetch(av, PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
@@ -2500,6 +2500,9 @@ try_autoload:
SvPADMY_on(sv);
}
}
+ else if (IS_PADGV(oldpad[ix])) {
+ av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
+ }
else {
av_store(newpad, ix, sv = NEWSV(0,0));
SvPADTMP_on(sv);
@@ -2782,7 +2785,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
sep = p, leaf = p + 2;
}
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
- packname = HvNAME(sep ? PL_curcop->cop_stash : stash);
+ packname = sep ? CopSTASHPV(PL_curcop) : HvNAME(stash);
packlen = strlen(packname);
}
else {
diff --git a/pp_sys.c b/pp_sys.c
index d370a4cfee..d5b7969330 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -411,7 +411,7 @@ PP(pp_indread)
PP(pp_rcatline)
{
- PL_last_in_gv = (GV*)cSVOP->op_sv;
+ PL_last_in_gv = cGVOP;
return do_readline();
}
@@ -476,7 +476,7 @@ PP(pp_die)
GV *gv = gv_fetchmethod(stash, "PROPAGATE");
if (gv) {
SV *file = sv_2mortal(newSVsv(CopFILESV(PL_curcop)));
- SV *line = sv_2mortal(newSViv(PL_curcop->cop_line));
+ SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop)));
EXTEND(SP, 3);
PUSHMARK(SP);
PUSHs(error);
@@ -2412,7 +2412,7 @@ PP(pp_stat)
STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
- tmpgv = (GV*)cSVOP->op_sv;
+ tmpgv = cGVOP;
do_fstat:
if (tmpgv != PL_defgv) {
PL_laststype = OP_STAT;
@@ -2874,7 +2874,7 @@ PP(pp_fttty)
STRLEN n_a;
if (PL_op->op_flags & OPf_REF)
- gv = (GV*)cSVOP->op_sv;
+ gv = cGVOP;
else if (isGV(TOPs))
gv = (GV*)POPs;
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
@@ -2916,7 +2916,7 @@ PP(pp_fttext)
PerlIO *fp;
if (PL_op->op_flags & OPf_REF)
- gv = (GV*)cSVOP->op_sv;
+ gv = cGVOP;
else if (isGV(TOPs))
gv = (GV*)POPs;
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
@@ -2967,7 +2967,7 @@ PP(pp_fttext)
else {
if (ckWARN(WARN_UNOPENED))
Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>",
- GvENAME((GV*)cSVOP->op_sv));
+ GvENAME(cGVOP));
SETERRNO(EBADF,RMS$_IFI);
RETPUSHUNDEF;
}
diff --git a/proto.h b/proto.h
index e62902cf88..5daeb9022d 100644
--- a/proto.h
+++ b/proto.h
@@ -397,6 +397,7 @@ PERL_CALLCONV HV* Perl_newHV(pTHX);
PERL_CALLCONV HV* Perl_newHVhv(pTHX_ HV* hv);
PERL_CALLCONV IO* Perl_newIO(pTHX);
PERL_CALLCONV OP* Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP* first, OP* last);
+PERL_CALLCONV OP* Perl_newPADOP(pTHX_ I32 type, I32 flags, SV* sv);
PERL_CALLCONV OP* Perl_newPMOP(pTHX_ I32 type, I32 flags);
PERL_CALLCONV OP* Perl_newPVOP(pTHX_ I32 type, I32 flags, char* pv);
PERL_CALLCONV SV* Perl_newRV(pTHX_ SV* pref);
@@ -737,6 +738,22 @@ PERL_CALLCONV CV* Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
PERL_CALLCONV void Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block);
PERL_CALLCONV OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs);
PERL_CALLCONV void Perl_boot_core_xsutils(pTHX);
+#if defined(USE_ITHREADS)
+PERL_CALLCONV HE* Perl_he_dup(pTHX_ HE* e, bool shared);
+PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r);
+PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type);
+PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR* dp);
+PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp);
+PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg);
+PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr);
+#if defined(HAVE_INTERP_INTERN)
+PERL_CALLCONV void Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst);
+#endif
+PERL_CALLCONV SVTBL* Perl_sv_table_new(pTHX);
+PERL_CALLCONV SV* Perl_sv_table_fetch(pTHX_ SVTBL *tbl, SV *sv);
+PERL_CALLCONV void Perl_sv_table_store(pTHX_ SVTBL *tbl, SV *oldsv, SV *newsv);
+PERL_CALLCONV void Perl_sv_table_split(pTHX_ SVTBL *tbl);
+#endif
#if defined(PERL_OBJECT)
protected:
#endif
diff --git a/run.c b/run.c
index 5734fdb18f..1c44f05f35 100644
--- a/run.c
+++ b/run.c
@@ -74,9 +74,9 @@ Perl_debop(pTHX_ OP *o)
break;
case OP_GVSV:
case OP_GV:
- if (cSVOPo->op_sv) {
+ if (cGVOPo) {
sv = NEWSV(0,0);
- gv_fullname3(sv, (GV*)cSVOPo->op_sv, Nullch);
+ gv_fullname3(sv, cGVOPo, Nullch);
PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
SvREFCNT_dec(sv);
}
diff --git a/scope.c b/scope.c
index 9c8a0f402e..0fd3692a68 100644
--- a/scope.c
+++ b/scope.c
@@ -289,7 +289,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
}
GvGP(gv) = gp_ref(gp);
GvSV(gv) = NEWSV(72,0);
- GvLINE(gv) = PL_curcop->cop_line;
+ GvLINE(gv) = CopLINE(PL_curcop);
GvEGV(gv) = gv;
}
else {
diff --git a/scope.h b/scope.h
index 9a196e6eda..6aca9ea5a6 100644
--- a/scope.h
+++ b/scope.h
@@ -110,6 +110,16 @@
} \
} STMT_END
+#ifdef USE_ITHREADS
+# define SAVECOPSTASH(cop) SAVEPPTR(CopSTASHPV(cop))
+# define SAVECOPFILE(cop) SAVEPPTR(CopFILE(cop))
+#else
+# define SAVECOPSTASH(cop) SAVESPTR(CopSTASH(cop))
+# define SAVECOPFILE(cop) SAVESPTR(CopFILEGV(cop))
+#endif
+
+#define SAVECOPLINE(cop) SAVEI16(CopLINE(cop))
+
/* SSNEW() temporarily allocates a specified number of bytes of data on the
* savestack. It returns an integer index into the savestack, because a
* pointer would get broken if the savestack is moved on reallocation.
diff --git a/sv.c b/sv.c
index 65b47acbe3..9a4fb96c7d 100644
--- a/sv.c
+++ b/sv.c
@@ -2369,8 +2369,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
SvTYPE(SvRV(sstr)) == SVt_PVGV) {
sstr = SvRV(sstr);
if (sstr == dstr) {
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED(dstr) != GVf_IMPORTED
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_on(dstr);
+ }
GvMULTI_on(dstr);
return;
}
@@ -2424,8 +2427,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
gp_free((GV*)dstr);
GvGP(dstr) = gp_ref(GvGP(sstr));
SvTAINT(dstr);
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED(dstr) != GVf_IMPORTED
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_on(dstr);
+ }
GvMULTI_on(dstr);
return;
}
@@ -2462,7 +2468,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
Newz(602,gp, 1, GP);
GvGP(dstr) = gp_ref(gp);
GvSV(dstr) = NEWSV(72,0);
- GvLINE(dstr) = PL_curcop->cop_line;
+ GvLINE(dstr) = CopLINE(PL_curcop);
GvEGV(dstr) = (GV*)dstr;
}
GvMULTI_on(dstr);
@@ -2473,8 +2479,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
else
dref = (SV*)GvAV(dstr);
GvAV(dstr) = (AV*)sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_AV_off(dstr)
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_AV_on(dstr);
+ }
break;
case SVt_PVHV:
if (intro)
@@ -2482,8 +2491,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
else
dref = (SV*)GvHV(dstr);
GvHV(dstr) = (HV*)sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_HV_off(dstr)
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_HV_on(dstr);
+ }
break;
case SVt_PVCV:
if (intro) {
@@ -2535,8 +2547,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
GvASSUMECV_on(dstr);
PL_sub_generation++;
}
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_CV_off(dstr)
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_CV_on(dstr);
+ }
break;
case SVt_PVIO:
if (intro)
@@ -2551,8 +2566,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
else
dref = (SV*)GvSV(dstr);
GvSV(dstr) = sref;
- if (PL_curcop->cop_stash != GvSTASH(dstr))
+ if (GvIMPORTED_SV_off(dstr)
+ && CopSTASH(PL_curcop) != GvSTASH(dstr))
+ {
GvIMPORTED_SV_on(dstr);
+ }
break;
}
if (dref)
@@ -3318,10 +3336,9 @@ Perl_sv_clear(pTHX_ register SV *sv)
{
io_close((IO*)sv, FALSE);
}
- if (IoDIRP(sv)) {
+ if (IoDIRP(sv) && !(IoFLAGS(sv) & IOf_FAKE_DIRP))
PerlDir_close(IoDIRP(sv));
- IoDIRP(sv) = 0;
- }
+ IoDIRP(sv) = (DIR*)NULL;
Safefree(IoTOP_NAME(sv));
Safefree(IoFMT_NAME(sv));
Safefree(IoBOTTOM_NAME(sv));
@@ -5586,6 +5603,1005 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
}
}
+#if defined(USE_ITHREADS)
+
+#if defined(USE_THREADS)
+# include "error: USE_THREADS and USE_ITHREADS are incompatible"
+#endif
+
+#ifndef OpREFCNT_inc
+# define OpREFCNT_inc(o) o
+#endif
+
+#define sv_dup_inc(s) SvREFCNT_inc(sv_dup(s))
+#define av_dup(s) (AV*)sv_dup((SV*)s)
+#define av_dup_inc(s) (AV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define hv_dup(s) (HV*)sv_dup((SV*)s)
+#define hv_dup_inc(s) (HV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define cv_dup(s) (CV*)sv_dup((SV*)s)
+#define cv_dup_inc(s) (CV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define io_dup(s) (IO*)sv_dup((SV*)s)
+#define io_dup_inc(s) (IO*)SvREFCNT_inc(sv_dup((SV*)s))
+#define gv_dup(s) (GV*)sv_dup((SV*)s)
+#define gv_dup_inc(s) (GV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define SAVEPV(p) (p ? savepv(p) : Nullch)
+#define SAVEPVN(p,n) (p ? savepvn(p,n) : Nullch)
+
+REGEXP *
+Perl_re_dup(pTHX_ REGEXP *r)
+{
+ /* XXX fix when pmop->op_pmregexp becomes shared */
+ return ReREFCNT_inc(r);
+}
+
+PerlIO *
+Perl_fp_dup(pTHX_ PerlIO *fp, char type)
+{
+ if (!fp)
+ return (PerlIO*)NULL;
+ return fp; /* XXX */
+ /* return PerlIO_fdopen(PerlIO_fileno(fp),
+ type == '<' ? "r" : type == '>' ? "w" : "rw"); */
+}
+
+DIR *
+Perl_dirp_dup(pTHX_ DIR *dp)
+{
+ if (!dp)
+ return (DIR*)NULL;
+ /* XXX TODO */
+ return dp;
+}
+
+GP *
+Perl_gp_dup(pTHX_ GP *gp)
+{
+ GP *ret;
+ if (!gp)
+ return (GP*)NULL;
+ Newz(0, ret, 1, GP);
+ ret->gp_sv = sv_dup_inc(gp->gp_sv);
+ ret->gp_io = io_dup_inc(gp->gp_io);
+ ret->gp_form = cv_dup_inc(gp->gp_form);
+ ret->gp_av = av_dup_inc(gp->gp_av);
+ ret->gp_hv = hv_dup_inc(gp->gp_hv);
+ ret->gp_egv = gv_dup_inc(gp->gp_egv);
+ ret->gp_cv = cv_dup_inc(gp->gp_cv);
+ ret->gp_cvgen = gp->gp_cvgen;
+ ret->gp_flags = gp->gp_flags;
+ ret->gp_line = gp->gp_line;
+ ret->gp_file = gp->gp_file; /* points to COP.cop_file */
+ ret->gp_refcnt = 0;
+ return ret;
+}
+
+MAGIC *
+Perl_mg_dup(pTHX_ MAGIC *mg)
+{
+ MAGIC *mgret = (MAGIC*)NULL;
+ MAGIC *mgprev;
+ if (!mg)
+ return (MAGIC*)NULL;
+ for (; mg; mg = mg->mg_moremagic) {
+ MAGIC *nmg;
+ Newz(0, nmg, 1, MAGIC);
+ if (!mgret)
+ mgret = nmg;
+ else
+ mgprev->mg_moremagic = nmg;
+ nmg->mg_virtual = mg->mg_virtual; /* XXX copy dynamic vtable? */
+ nmg->mg_private = mg->mg_private;
+ nmg->mg_type = mg->mg_type;
+ nmg->mg_flags = mg->mg_flags;
+ if (mg->mg_type == 'r') {
+ nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj);
+ }
+ else {
+ nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED)
+ ? sv_dup_inc(mg->mg_obj)
+ : sv_dup(mg->mg_obj);
+ }
+ nmg->mg_len = mg->mg_len;
+ nmg->mg_ptr = mg->mg_ptr; /* XXX random ptr? */
+ if (mg->mg_ptr && mg->mg_type != 'g') {
+ if (mg->mg_len >= 0)
+ nmg->mg_ptr = SAVEPVN(mg->mg_ptr, mg->mg_len);
+ else if (mg->mg_len == HEf_SVKEY)
+ nmg->mg_ptr = (char*)sv_dup_inc((SV*)mg->mg_ptr);
+ }
+ mgprev = nmg;
+ }
+ return mgret;
+}
+
+SVTBL *
+Perl_sv_table_new(pTHX)
+{
+ SVTBL *tbl;
+ Newz(0, tbl, 1, SVTBL);
+ tbl->tbl_max = 511;
+ tbl->tbl_items = 0;
+ Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, SVTBLENT*);
+ return tbl;
+}
+
+SV *
+Perl_sv_table_fetch(pTHX_ SVTBL *tbl, SV *sv)
+{
+ SVTBLENT *tblent;
+ UV hash = (UV)sv;
+ assert(tbl);
+ tblent = tbl->tbl_ary[hash & tbl->tbl_max];
+ for (; tblent; tblent = tblent->next) {
+ if (tblent->oldval == sv)
+ return tblent->newval;
+ }
+ return Nullsv;
+}
+
+void
+Perl_sv_table_store(pTHX_ SVTBL *tbl, SV *old, SV *new)
+{
+ SVTBLENT *tblent, **otblent;
+ UV hash = (UV)old;
+ bool i = 1;
+ assert(tbl);
+ otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
+ for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
+ if (tblent->oldval == old) {
+ tblent->newval = new;
+ tbl->tbl_items++;
+ return;
+ }
+ }
+ Newz(0, tblent, 1, SVTBLENT);
+ tblent->oldval = old;
+ tblent->newval = new;
+ tblent->next = *otblent;
+ *otblent = tblent;
+ tbl->tbl_items++;
+ if (i && tbl->tbl_items > tbl->tbl_max)
+ sv_table_split(tbl);
+}
+
+void
+Perl_sv_table_split(pTHX_ SVTBL *tbl)
+{
+ SVTBLENT **ary = tbl->tbl_ary;
+ UV oldsize = tbl->tbl_max + 1;
+ UV newsize = oldsize * 2;
+ UV i;
+
+ Renew(ary, newsize, SVTBLENT*);
+ Zero(&ary[oldsize], newsize-oldsize, SVTBLENT*);
+ tbl->tbl_max = --newsize;
+ tbl->tbl_ary = ary;
+ for (i=0; i < oldsize; i++, ary++) {
+ SVTBLENT **curentp, **entp, *ent;
+ if (!*ary)
+ continue;
+ curentp = ary + oldsize;
+ for (entp = ary, ent = *ary; ent; ent = *entp) {
+ if ((newsize & (UV)ent->oldval) != i) {
+ *entp = ent->next;
+ ent->next = *curentp;
+ *curentp = ent;
+ continue;
+ }
+ else
+ entp = &ent->next;
+ }
+ }
+}
+
+SV *
+Perl_sv_dup(pTHX_ SV *sstr)
+{
+ U32 sflags;
+ int dtype;
+ int stype;
+ SV *dstr;
+
+ if (!sstr)
+ return Nullsv;
+ /* look for it in the table first */
+ dstr = sv_table_fetch(PL_sv_table, sstr);
+ if (dstr)
+ return dstr;
+
+ /* XXX TODO: sanity-check sv_dup() vs sv_dup_inc() appropriateness */
+
+ /* create anew and remember what it is */
+ new_SV(dstr);
+ sv_table_store(PL_sv_table, sstr, dstr);
+
+ /* clone */
+ SvFLAGS(dstr) = SvFLAGS(sstr);
+ SvFLAGS(dstr) &= ~SVf_OOK; /* don't propagate OOK hack */
+ SvREFCNT(dstr) = 0;
+
+ switch (SvTYPE(sstr)) {
+ case SVt_NULL:
+ SvANY(dstr) = NULL;
+ break;
+ case SVt_IV:
+ SvANY(dstr) = new_XIV();
+ SvIVX(dstr) = SvIVX(sstr);
+ break;
+ case SVt_NV:
+ SvANY(dstr) = new_XNV();
+ SvNVX(dstr) = SvNVX(sstr);
+ break;
+ case SVt_RV:
+ SvANY(dstr) = new_XRV();
+ SvRV(dstr) = sv_dup_inc(SvRV(sstr));
+ break;
+ case SVt_PV:
+ SvANY(dstr) = new_XPV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ break;
+ case SVt_PVIV:
+ SvANY(dstr) = new_XPVIV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ break;
+ case SVt_PVNV:
+ SvANY(dstr) = new_XPVNV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ break;
+ case SVt_PVMG:
+ SvANY(dstr) = new_XPVMG();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
+ SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
+ else
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ break;
+ case SVt_PVBM:
+ SvANY(dstr) = new_XPVBM();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
+ SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
+ else
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ BmRARE(dstr) = BmRARE(sstr);
+ BmUSEFUL(dstr) = BmUSEFUL(sstr);
+ BmPREVIOUS(dstr)= BmPREVIOUS(sstr);
+ break;
+ case SVt_PVLV:
+ SvANY(dstr) = new_XPVLV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
+ SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
+ else
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ LvTARGOFF(dstr) = LvTARGOFF(sstr); /* XXX sometimes holds PMOP* when DEBUGGING */
+ LvTARGLEN(dstr) = LvTARGLEN(sstr);
+ LvTARG(dstr) = sv_dup_inc(LvTARG(sstr));
+ LvTYPE(dstr) = LvTYPE(sstr);
+ break;
+ case SVt_PVGV:
+ SvANY(dstr) = new_XPVGV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
+ SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
+ else
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ GvNAMELEN(dstr) = GvNAMELEN(sstr);
+ GvNAME(dstr) = SAVEPVN(GvNAME(sstr), GvNAMELEN(sstr));
+ GvSTASH(dstr) = hv_dup_inc(GvSTASH(sstr));
+ GvFLAGS(dstr) = GvFLAGS(sstr);
+ GvGP(dstr) = gp_dup(GvGP(sstr));
+ GvGP(dstr)->gp_refcnt++;
+ break;
+ case SVt_PVIO:
+ SvANY(dstr) = new_XPVIO();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
+ SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
+ else
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr));
+ if (IoOFP(sstr) == IoIFP(sstr))
+ IoOFP(dstr) = IoIFP(dstr);
+ else
+ IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr));
+ /* PL_rsfp_filters entries have fake IoDIRP() */
+ if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP))
+ IoDIRP(dstr) = dirp_dup(IoDIRP(sstr));
+ else
+ IoDIRP(dstr) = IoDIRP(sstr);
+ IoLINES(dstr) = IoLINES(sstr);
+ IoPAGE(dstr) = IoPAGE(sstr);
+ IoPAGE_LEN(dstr) = IoPAGE_LEN(sstr);
+ IoLINES_LEFT(dstr) = IoLINES_LEFT(sstr);
+ IoTOP_NAME(dstr) = SAVEPV(IoTOP_NAME(sstr));
+ IoTOP_GV(dstr) = gv_dup(IoTOP_GV(sstr));
+ IoFMT_NAME(dstr) = SAVEPV(IoFMT_NAME(sstr));
+ IoFMT_GV(dstr) = gv_dup(IoFMT_GV(sstr));
+ IoBOTTOM_NAME(dstr) = SAVEPV(IoBOTTOM_NAME(sstr));
+ IoBOTTOM_GV(dstr) = gv_dup(IoBOTTOM_GV(sstr));
+ IoSUBPROCESS(dstr) = IoSUBPROCESS(sstr);
+ IoTYPE(dstr) = IoTYPE(sstr);
+ IoFLAGS(dstr) = IoFLAGS(sstr);
+ break;
+ case SVt_PVAV:
+ SvANY(dstr) = new_XPVAV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr));
+ AvFLAGS((AV*)dstr) = AvFLAGS((AV*)sstr);
+ if (AvALLOC((AV*)sstr)) {
+ SV **dst_ary, **src_ary;
+ SSize_t items = AvFILLp((AV*)sstr) + 1;
+
+ src_ary = AvALLOC((AV*)sstr);
+ Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
+ SvPVX(dstr) = (char*)dst_ary;
+ AvALLOC((AV*)dstr) = dst_ary;
+ if (AvREAL((AV*)sstr)) {
+ while (items-- > 0)
+ *dst_ary++ = sv_dup_inc(*src_ary++);
+ }
+ else {
+ while (items-- > 0)
+ *dst_ary++ = sv_dup(*src_ary++);
+ }
+ items = AvMAX((AV*)sstr) - AvFILLp((AV*)sstr);
+ while (items-- > 0) {
+ *dst_ary++ = &PL_sv_undef;
+ }
+ }
+ else {
+ SvPVX(dstr) = Nullch;
+ AvALLOC((AV*)dstr) = (SV**)NULL;
+ }
+ break;
+ case SVt_PVHV:
+ SvANY(dstr) = new_XPVHV();
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ HvRITER((HV*)dstr) = HvRITER((HV*)sstr);
+ if (HvARRAY((HV*)sstr)) {
+ HE *entry;
+ STRLEN i = 0;
+ XPVHV *dxhv = (XPVHV*)SvANY(dstr);
+ XPVHV *sxhv = (XPVHV*)SvANY(sstr);
+ Newz(0, dxhv->xhv_array,
+ PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
+ while (i <= sxhv->xhv_max) {
+ HE *dentry, *oentry;
+ entry = ((HE**)sxhv->xhv_array)[i];
+ dentry = he_dup(entry, !!HvSHAREKEYS(sstr));
+ ((HE**)dxhv->xhv_array)[i] = dentry;
+ while (entry) {
+ entry = HeNEXT(entry);
+ oentry = dentry;
+ dentry = he_dup(entry, !!HvSHAREKEYS(sstr));
+ HeNEXT(oentry) = dentry;
+ }
+ ++i;
+ }
+ if (sxhv->xhv_riter >= 0 && sxhv->xhv_eiter) {
+ entry = ((HE**)sxhv->xhv_array)[sxhv->xhv_riter];
+ while (entry && entry != sxhv->xhv_eiter)
+ entry = HeNEXT(entry);
+ dxhv->xhv_eiter = entry;
+ }
+ else
+ dxhv->xhv_eiter = (HE*)NULL;
+ }
+ else
+ SvPVX(dstr) = Nullch;
+ HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
+ HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
+ break;
+ case SVt_PVFM:
+ SvANY(dstr) = new_XPVFM();
+ goto dup_pvcv;
+ /* NOTREACHED */
+ case SVt_PVCV:
+ SvANY(dstr) = new_XPVCV();
+dup_pvcv:
+ SvCUR(dstr) = SvCUR(sstr);
+ SvLEN(dstr) = SvLEN(sstr);
+ SvIVX(dstr) = SvIVX(sstr);
+ SvNVX(dstr) = SvNVX(sstr);
+ SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr));
+ if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
+ SvSTASH(dstr) = SvSTASH(sstr); /* COP* in disguise */
+ else
+ SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr));
+ if (SvPOKp(sstr) && SvLEN(sstr))
+ SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ else
+ SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
+ CvSTASH(dstr) = hv_dup(CvSTASH(sstr));/* NOTE: not refcounted */
+ CvSTART(dstr) = CvSTART(sstr);
+ CvROOT(dstr) = OpREFCNT_inc(CvROOT(sstr));
+ CvXSUB(dstr) = CvXSUB(sstr);
+ CvXSUBANY(dstr) = CvXSUBANY(sstr);
+ CvGV(dstr) = gv_dup_inc(CvGV(sstr));
+ CvDEPTH(dstr) = CvDEPTH(sstr);
+ CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr));
+ CvOUTSIDE(dstr) = cv_dup_inc(CvOUTSIDE(sstr));
+ CvFLAGS(dstr) = CvFLAGS(sstr);
+ break;
+ default:
+ Perl_croak(aTHX_ "Bizarre SvTYPE [%d]", SvTYPE(sstr));
+ break;
+ }
+
+ if (SvOBJECT(dstr))
+ ++PL_sv_objcount;
+
+ return dstr;
+}
+
+PerlInterpreter *
+perl_clone_using(PerlInterpreter *proto_perl, IV flags,
+ struct IPerlMem* ipM, struct IPerlEnv* ipE,
+ struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
+ struct IPerlDir* ipD, struct IPerlSock* ipS,
+ struct IPerlProc* ipP)
+{
+ IV i;
+ SV *sv;
+ SV **svp;
+ PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
+ PERL_SET_INTERP(my_perl);
+
+#ifdef DEBUGGING
+ memset(my_perl, 0xab, sizeof(PerlInterpreter));
+ PL_markstack = 0;
+ PL_scopestack = 0;
+ PL_savestack = 0;
+ PL_retstack = 0;
+#else
+# if 0
+ Copy(proto_perl, my_perl, 1, PerlInterpreter);
+# endif
+#endif
+
+ /* XXX many of the string copies here can be optimized if they're
+ * constants; they need to be allocated as common memory and just
+ * their pointers copied. */
+
+ /* host pointers */
+ PL_Mem = ipM;
+ PL_Env = ipE;
+ PL_StdIO = ipStd;
+ PL_LIO = ipLIO;
+ PL_Dir = ipD;
+ PL_Sock = ipS;
+ PL_Proc = ipP;
+
+ /* arena roots */
+ PL_xiv_arenaroot = NULL;
+ PL_xiv_root = NULL;
+ PL_xnv_root = NULL;
+ PL_xrv_root = NULL;
+ PL_xpv_root = NULL;
+ PL_xpviv_root = NULL;
+ PL_xpvnv_root = NULL;
+ PL_xpvcv_root = NULL;
+ PL_xpvav_root = NULL;
+ PL_xpvhv_root = NULL;
+ PL_xpvmg_root = NULL;
+ PL_xpvlv_root = NULL;
+ PL_xpvbm_root = NULL;
+ PL_he_root = NULL;
+ PL_nice_chunk = NULL;
+ PL_nice_chunk_size = 0;
+ PL_sv_count = 0;
+ PL_sv_objcount = 0;
+ PL_sv_root = Nullsv;
+ PL_sv_arenaroot = Nullsv;
+
+ PL_debug = proto_perl->Idebug;
+
+ /* create SV map for pointer relocation */
+ PL_sv_table = sv_table_new();
+
+ /* initialize these special pointers as early as possible */
+ SvANY(&PL_sv_undef) = NULL;
+ SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
+ SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVt_NULL;
+ sv_table_store(PL_sv_table, &proto_perl->Isv_undef, &PL_sv_undef);
+
+ SvANY(&PL_sv_no) = new_XPVNV();
+ SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
+ SvFLAGS(&PL_sv_no) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
+ SvPVX(&PL_sv_no) = SAVEPVN(PL_No, 0);
+ SvCUR(&PL_sv_no) = 0;
+ SvLEN(&PL_sv_no) = 1;
+ SvNVX(&PL_sv_no) = 0;
+ sv_table_store(PL_sv_table, &proto_perl->Isv_no, &PL_sv_no);
+
+ SvANY(&PL_sv_yes) = new_XPVNV();
+ SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+ SvFLAGS(&PL_sv_yes) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
+ SvPVX(&PL_sv_yes) = SAVEPVN(PL_Yes, 1);
+ SvCUR(&PL_sv_yes) = 1;
+ SvLEN(&PL_sv_yes) = 2;
+ SvNVX(&PL_sv_yes) = 1;
+ sv_table_store(PL_sv_table, &proto_perl->Isv_yes, &PL_sv_yes);
+
+ /* create shared string table */
+ PL_strtab = newHV();
+ HvSHAREKEYS_off(PL_strtab);
+ hv_ksplit(PL_strtab, 512);
+ sv_table_store(PL_sv_table, (SV*)proto_perl->Istrtab, (SV*)PL_strtab);
+
+ PL_compiling = proto_perl->Icompiling;
+ PL_compiling.cop_stashpv = SAVEPV(PL_compiling.cop_stashpv);
+ PL_compiling.cop_file = SAVEPV(PL_compiling.cop_file);
+ PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
+ if (proto_perl->Tcurcop == &proto_perl->Icompiling)
+ PL_curcop = &PL_compiling;
+ else
+ PL_curcop = proto_perl->Tcurcop;
+
+ /* pseudo environmental stuff */
+ PL_origargc = proto_perl->Iorigargc;
+ i = PL_origargc;
+ New(0, PL_origargv, i+1, char*);
+ PL_origargv[i] = '\0';
+ while (i-- > 0) {
+ PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
+ }
+ PL_envgv = gv_dup(proto_perl->Ienvgv);
+ PL_incgv = gv_dup(proto_perl->Iincgv);
+ PL_hintgv = gv_dup(proto_perl->Ihintgv);
+ PL_origfilename = SAVEPV(proto_perl->Iorigfilename);
+ PL_diehook = sv_dup_inc(proto_perl->Idiehook);
+ PL_warnhook = sv_dup_inc(proto_perl->Iwarnhook);
+
+ /* switches */
+ PL_minus_c = proto_perl->Iminus_c;
+ Copy(proto_perl->Ipatchlevel, PL_patchlevel, 10, char);
+ PL_localpatches = proto_perl->Ilocalpatches;
+ PL_splitstr = proto_perl->Isplitstr;
+ PL_preprocess = proto_perl->Ipreprocess;
+ PL_minus_n = proto_perl->Iminus_n;
+ PL_minus_p = proto_perl->Iminus_p;
+ PL_minus_l = proto_perl->Iminus_l;
+ PL_minus_a = proto_perl->Iminus_a;
+ PL_minus_F = proto_perl->Iminus_F;
+ PL_doswitches = proto_perl->Idoswitches;
+ PL_dowarn = proto_perl->Idowarn;
+ PL_doextract = proto_perl->Idoextract;
+ PL_sawampersand = proto_perl->Isawampersand;
+ PL_unsafe = proto_perl->Iunsafe;
+ PL_inplace = SAVEPV(proto_perl->Iinplace);
+ PL_e_script = sv_dup_inc(proto_perl->Ie_script);
+ PL_perldb = proto_perl->Iperldb;
+ PL_perl_destruct_level = proto_perl->Iperl_destruct_level;
+
+ /* magical thingies */
+ /* XXX time(&PL_basetime) instead? */
+ PL_basetime = proto_perl->Ibasetime;
+ PL_formfeed = sv_dup(proto_perl->Iformfeed);
+
+ PL_maxsysfd = proto_perl->Imaxsysfd;
+ PL_multiline = proto_perl->Imultiline;
+ PL_statusvalue = proto_perl->Istatusvalue;
+#ifdef VMS
+ PL_statusvalue_vms = proto_perl->Istatusvalue_vms;
+#endif
+
+ /* shortcuts to various I/O objects */
+ PL_stdingv = gv_dup(proto_perl->Istdingv);
+ PL_stderrgv = gv_dup(proto_perl->Istderrgv);
+ PL_defgv = gv_dup(proto_perl->Idefgv);
+ PL_argvgv = gv_dup(proto_perl->Iargvgv);
+ PL_argvoutgv = gv_dup(proto_perl->Iargvoutgv);
+ PL_argvout_stack = av_dup(proto_perl->Iargvout_stack);
+
+ /* shortcuts to regexp stuff */
+ PL_replgv = gv_dup(proto_perl->Ireplgv);
+
+ /* shortcuts to misc objects */
+ PL_errgv = gv_dup(proto_perl->Ierrgv);
+
+ /* shortcuts to debugging objects */
+ PL_DBgv = gv_dup(proto_perl->IDBgv);
+ PL_DBline = gv_dup(proto_perl->IDBline);
+ PL_DBsub = gv_dup(proto_perl->IDBsub);
+ PL_DBsingle = sv_dup(proto_perl->IDBsingle);
+ PL_DBtrace = sv_dup(proto_perl->IDBtrace);
+ PL_DBsignal = sv_dup(proto_perl->IDBsignal);
+ PL_lineary = av_dup(proto_perl->Ilineary);
+ PL_dbargs = av_dup(proto_perl->Idbargs);
+
+ /* symbol tables */
+ PL_defstash = hv_dup_inc(proto_perl->Tdefstash);
+ PL_curstash = hv_dup(proto_perl->Tcurstash);
+ PL_debstash = hv_dup(proto_perl->Idebstash);
+ PL_globalstash = hv_dup(proto_perl->Iglobalstash);
+ PL_curstname = sv_dup_inc(proto_perl->Icurstname);
+
+ PL_beginav = av_dup_inc(proto_perl->Ibeginav);
+ PL_endav = av_dup_inc(proto_perl->Iendav);
+ PL_stopav = av_dup_inc(proto_perl->Istopav);
+ PL_initav = av_dup_inc(proto_perl->Iinitav);
+
+ PL_sub_generation = proto_perl->Isub_generation;
+
+ /* funky return mechanisms */
+ PL_forkprocess = proto_perl->Iforkprocess;
+
+ /* subprocess state */
+ PL_fdpid = av_dup(proto_perl->Ifdpid);
+
+ /* internal state */
+ PL_tainting = proto_perl->Itainting;
+ PL_maxo = proto_perl->Imaxo;
+ if (proto_perl->Iop_mask)
+ PL_op_mask = SAVEPVN(proto_perl->Iop_mask, PL_maxo);
+ else
+ PL_op_mask = Nullch;
+
+ /* current interpreter roots */
+ PL_main_cv = cv_dup_inc(proto_perl->Imain_cv);
+ PL_main_root = OpREFCNT_inc(proto_perl->Imain_root);
+ PL_main_start = proto_perl->Imain_start;
+ PL_eval_root = proto_perl->Ieval_root;
+ PL_eval_start = proto_perl->Ieval_start;
+
+ /* runtime control stuff */
+ PL_curcopdb = proto_perl->Icurcopdb;
+ PL_copline = proto_perl->Icopline;
+
+ PL_filemode = proto_perl->Ifilemode;
+ PL_lastfd = proto_perl->Ilastfd;
+ PL_oldname = proto_perl->Ioldname; /* XXX */
+ PL_Argv = NULL;
+ PL_Cmd = Nullch;
+ PL_gensym = proto_perl->Igensym;
+ PL_preambled = proto_perl->Ipreambled;
+ PL_preambleav = av_dup_inc(proto_perl->Ipreambleav);
+ PL_laststatval = proto_perl->Ilaststatval;
+ PL_laststype = proto_perl->Ilaststype;
+ PL_mess_sv = Nullsv;
+
+ PL_orslen = proto_perl->Iorslen;
+ PL_ors = SAVEPVN(proto_perl->Iors, PL_orslen);
+ PL_ofmt = SAVEPV(proto_perl->Iofmt);
+
+ /* interpreter atexit processing */
+ PL_exitlistlen = proto_perl->Iexitlistlen;
+ if (PL_exitlistlen) {
+ New(0, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+ Copy(proto_perl->Iexitlist, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+ }
+ else
+ PL_exitlist = (PerlExitListEntry*)NULL;
+ PL_modglobal = hv_dup(proto_perl->Imodglobal);
+
+ PL_profiledata = NULL; /* XXX */
+ PL_rsfp = fp_dup(proto_perl->Irsfp, '<');
+ /* XXX PL_rsfp_filters entries have fake IoDIRP() */
+ PL_rsfp_filters = av_dup(proto_perl->Irsfp_filters);
+
+ PL_compcv = cv_dup(proto_perl->Icompcv);
+ PL_comppad = av_dup(proto_perl->Icomppad);
+ PL_comppad_name = av_dup(proto_perl->Icomppad_name);
+ PL_comppad_name_fill = proto_perl->Icomppad_name_fill;
+ PL_comppad_name_floor = proto_perl->Icomppad_name_floor;
+ PL_curpad = AvARRAY(PL_comppad); /* XXX */
+
+#ifdef HAVE_INTERP_INTERN
+ sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern);
+#endif
+
+ /* more statics moved here */
+ PL_generation = proto_perl->Igeneration;
+ PL_DBcv = cv_dup(proto_perl->IDBcv);
+ PL_archpat_auto = SAVEPV(proto_perl->Iarchpat_auto);
+
+ PL_in_clean_objs = proto_perl->Iin_clean_objs;
+ PL_in_clean_all = proto_perl->Iin_clean_all;
+
+ PL_uid = proto_perl->Iuid;
+ PL_euid = proto_perl->Ieuid;
+ PL_gid = proto_perl->Igid;
+ PL_egid = proto_perl->Iegid;
+ PL_nomemok = proto_perl->Inomemok;
+ PL_an = proto_perl->Ian;
+ PL_cop_seqmax = proto_perl->Icop_seqmax;
+ PL_op_seqmax = proto_perl->Iop_seqmax;
+ PL_evalseq = proto_perl->Ievalseq;
+ PL_origenviron = proto_perl->Iorigenviron; /* XXX */
+ PL_origalen = proto_perl->Iorigalen;
+ PL_pidstatus = newHV();
+ PL_osname = SAVEPV(proto_perl->Iosname);
+ PL_sh_path = SAVEPV(proto_perl->Ish_path);
+ PL_sighandlerp = proto_perl->Isighandlerp;
+
+
+ PL_runops = proto_perl->Irunops;
+
+ Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char); /* XXX */
+
+#ifdef CSH
+ PL_cshlen = proto_perl->Icshlen;
+ PL_cshname = SAVEPVN(proto_perl->Icshname, PL_cshlen);
+#endif
+
+ PL_lex_state = proto_perl->Ilex_state;
+ PL_lex_defer = proto_perl->Ilex_defer;
+ PL_lex_expect = proto_perl->Ilex_expect;
+ PL_lex_formbrack = proto_perl->Ilex_formbrack;
+ PL_lex_fakebrack = proto_perl->Ilex_fakebrack;
+ PL_lex_dojoin = proto_perl->Ilex_dojoin;
+ PL_lex_starts = proto_perl->Ilex_starts;
+ PL_lex_stuff = Nullsv; /* XXX */
+ PL_lex_repl = Nullsv; /* XXX */
+ PL_lex_op = proto_perl->Ilex_op;
+ PL_lex_inpat = proto_perl->Ilex_inpat;
+ PL_lex_inwhat = proto_perl->Ilex_inwhat;
+ PL_lex_brackets = proto_perl->Ilex_brackets;
+ i = (PL_lex_brackets < 120 ? 120 : PL_lex_brackets);
+ PL_lex_brackstack = SAVEPVN(proto_perl->Ilex_brackstack,i);
+ PL_lex_casemods = proto_perl->Ilex_casemods;
+ i = (PL_lex_casemods < 12 ? 12 : PL_lex_casemods);
+ PL_lex_casestack = SAVEPVN(proto_perl->Ilex_casestack,i);
+
+ Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE);
+ Copy(proto_perl->Inexttype, PL_nexttype, 5, I32);
+ PL_nexttoke = proto_perl->Inexttoke;
+
+ PL_linestr = sv_dup_inc(proto_perl->Ilinestr);
+ i = proto_perl->Ibufptr - SvPVX(proto_perl->Ilinestr);
+ PL_bufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ i = proto_perl->Ioldbufptr - SvPVX(proto_perl->Ilinestr);
+ PL_oldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ i = proto_perl->Ioldoldbufptr - SvPVX(proto_perl->Ilinestr);
+ PL_oldoldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ i = proto_perl->Ilinestart - SvPVX(proto_perl->Ilinestr);
+ PL_linestart = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ PL_pending_ident = proto_perl->Ipending_ident;
+ PL_sublex_info = proto_perl->Isublex_info; /* XXX */
+
+ PL_expect = proto_perl->Iexpect;
+
+ PL_multi_start = proto_perl->Imulti_start;
+ PL_multi_end = proto_perl->Imulti_end;
+ PL_multi_open = proto_perl->Imulti_open;
+ PL_multi_close = proto_perl->Imulti_close;
+
+ PL_error_count = proto_perl->Ierror_count;
+ PL_subline = proto_perl->Isubline;
+ PL_subname = sv_dup_inc(proto_perl->Isubname);
+
+ PL_min_intro_pending = proto_perl->Imin_intro_pending;
+ PL_max_intro_pending = proto_perl->Imax_intro_pending;
+ PL_padix = proto_perl->Ipadix;
+ PL_padix_floor = proto_perl->Ipadix_floor;
+ PL_pad_reset_pending = proto_perl->Ipad_reset_pending;
+
+ i = proto_perl->Ilast_uni - SvPVX(proto_perl->Ilinestr);
+ PL_last_uni = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ i = proto_perl->Ilast_lop - SvPVX(proto_perl->Ilinestr);
+ PL_last_lop = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+ PL_last_lop_op = proto_perl->Ilast_lop_op;
+ PL_in_my = proto_perl->Iin_my;
+ PL_in_my_stash = hv_dup(proto_perl->Iin_my_stash);
+#ifdef FCRYPT
+ PL_cryptseen = proto_perl->Icryptseen;
+#endif
+
+ PL_hints = proto_perl->Ihints;
+
+ PL_amagic_generation = proto_perl->Iamagic_generation;
+
+#ifdef USE_LOCALE_COLLATE
+ PL_collation_ix = proto_perl->Icollation_ix;
+ PL_collation_name = SAVEPV(proto_perl->Icollation_name);
+ PL_collation_standard = proto_perl->Icollation_standard;
+ PL_collxfrm_base = proto_perl->Icollxfrm_base;
+ PL_collxfrm_mult = proto_perl->Icollxfrm_mult;
+#endif /* USE_LOCALE_COLLATE */
+
+#ifdef USE_LOCALE_NUMERIC
+ PL_numeric_name = SAVEPV(proto_perl->Inumeric_name);
+ PL_numeric_standard = proto_perl->Inumeric_standard;
+ PL_numeric_local = proto_perl->Inumeric_local;
+ PL_numeric_radix = proto_perl->Inumeric_radix;
+#endif /* !USE_LOCALE_NUMERIC */
+
+ /* utf8 character classes */
+ PL_utf8_alnum = sv_dup_inc(proto_perl->Iutf8_alnum);
+ PL_utf8_alnumc = sv_dup_inc(proto_perl->Iutf8_alnumc);
+ PL_utf8_ascii = sv_dup_inc(proto_perl->Iutf8_ascii);
+ PL_utf8_alpha = sv_dup_inc(proto_perl->Iutf8_alpha);
+ PL_utf8_space = sv_dup_inc(proto_perl->Iutf8_space);
+ PL_utf8_cntrl = sv_dup_inc(proto_perl->Iutf8_cntrl);
+ PL_utf8_graph = sv_dup_inc(proto_perl->Iutf8_graph);
+ PL_utf8_digit = sv_dup_inc(proto_perl->Iutf8_digit);
+ PL_utf8_upper = sv_dup_inc(proto_perl->Iutf8_upper);
+ PL_utf8_lower = sv_dup_inc(proto_perl->Iutf8_lower);
+ PL_utf8_print = sv_dup_inc(proto_perl->Iutf8_print);
+ PL_utf8_punct = sv_dup_inc(proto_perl->Iutf8_punct);
+ PL_utf8_xdigit = sv_dup_inc(proto_perl->Iutf8_xdigit);
+ PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark);
+ PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper);
+ PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle);
+ PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower);
+
+ /* swatch cache */
+ PL_last_swash_hv = Nullhv; /* XXX recreate swatch cache? */
+ PL_last_swash_klen = 0;
+ PL_last_swash_key[0]= '\0';
+ PL_last_swash_tmps = Nullch;
+ PL_last_swash_slen = 0;
+
+ /* perly.c globals */
+ PL_yydebug = proto_perl->Iyydebug;
+ PL_yynerrs = proto_perl->Iyynerrs;
+ PL_yyerrflag = proto_perl->Iyyerrflag;
+ PL_yychar = proto_perl->Iyychar;
+ PL_yyval = proto_perl->Iyyval;
+ PL_yylval = proto_perl->Iyylval;
+
+ PL_glob_index = proto_perl->Iglob_index;
+ PL_srand_called = proto_perl->Isrand_called;
+ PL_uudmap['M'] = 0; /* reinit on demand */
+ PL_bitcount = Nullch; /* reinit on demand */
+
+
+ /* thrdvar.h stuff */
+
+/* PL_curstackinfo = clone_stackinfo(proto_perl->Tcurstackinfo);
+ clone_stacks();
+ PL_mainstack = av_dup(proto_perl->Tmainstack);
+ PL_curstack = av_dup(proto_perl->Tcurstack);*/ /* XXXXXX */
+ init_stacks();
+
+ PL_op = proto_perl->Top;
+ PL_statbuf = proto_perl->Tstatbuf;
+ PL_statcache = proto_perl->Tstatcache;
+ PL_statgv = gv_dup(proto_perl->Tstatgv);
+ PL_statname = sv_dup(proto_perl->Tstatname);
+#ifdef HAS_TIMES
+ PL_timesbuf = proto_perl->Ttimesbuf;
+#endif
+
+ PL_tainted = proto_perl->Ttainted;
+ PL_curpm = proto_perl->Tcurpm; /* XXX No PMOP ref count */
+ PL_nrs = sv_dup_inc(proto_perl->Tnrs);
+ PL_rs = sv_dup_inc(proto_perl->Trs);
+ PL_last_in_gv = gv_dup(proto_perl->Tlast_in_gv);
+ PL_ofslen = proto_perl->Tofslen;
+ PL_ofs = SAVEPVN(proto_perl->Tofs, PL_ofslen);
+ PL_defoutgv = gv_dup_inc(proto_perl->Tdefoutgv);
+ PL_chopset = proto_perl->Tchopset; /* XXX */
+ PL_toptarget = sv_dup_inc(proto_perl->Ttoptarget);
+ PL_bodytarget = sv_dup_inc(proto_perl->Tbodytarget);
+ PL_formtarget = sv_dup(proto_perl->Tformtarget);
+
+ PL_restartop = proto_perl->Trestartop;
+ PL_in_eval = proto_perl->Tin_eval;
+ PL_delaymagic = proto_perl->Tdelaymagic;
+ PL_dirty = proto_perl->Tdirty;
+ PL_localizing = proto_perl->Tlocalizing;
+
+ PL_start_env = proto_perl->Tstart_env; /* XXXXXX */
+ PL_top_env = &PL_start_env;
+ PL_protect = proto_perl->Tprotect;
+ PL_errors = sv_dup_inc(proto_perl->Terrors);
+ PL_av_fetch_sv = Nullsv;
+ PL_hv_fetch_sv = Nullsv;
+ Zero(&PL_hv_fetch_ent_mh, 1, HE); /* XXX */
+ PL_modcount = proto_perl->Tmodcount;
+ PL_lastgotoprobe = Nullop;
+ PL_dumpindent = proto_perl->Tdumpindent;
+ PL_sortstash = hv_dup(proto_perl->Tsortstash);
+ PL_firstgv = gv_dup(proto_perl->Tfirstgv);
+ PL_secondgv = gv_dup(proto_perl->Tsecondgv);
+ PL_sortcxix = proto_perl->Tsortcxix;
+ PL_efloatbuf = Nullch;
+ PL_efloatsize = 0;
+
+ PL_screamfirst = NULL;
+ PL_screamnext = NULL;
+ PL_maxscream = -1;
+ PL_lastscream = Nullsv;
+
+ /* RE engine - function pointers */
+ PL_regcompp = proto_perl->Tregcompp;
+ PL_regexecp = proto_perl->Tregexecp;
+ PL_regint_start = proto_perl->Tregint_start;
+ PL_regint_string = proto_perl->Tregint_string;
+ PL_regfree = proto_perl->Tregfree;
+
+ PL_regindent = 0;
+ PL_reginterp_cnt = 0;
+ PL_reg_start_tmp = 0;
+ PL_reg_start_tmpl = 0;
+ PL_reg_poscache = Nullch;
+
+ PL_watchaddr = NULL;
+ PL_watchok = Nullch;
+
+ return my_perl;
+}
+
+PerlInterpreter *
+perl_clone(pTHXx_ IV flags)
+{
+ return perl_clone_using(aTHXx_ flags, PL_Mem, PL_Env, PL_StdIO, PL_LIO,
+ PL_Dir, PL_Sock, PL_Proc);
+}
+
+#endif /* USE_ITHREADS */
#ifdef PERL_OBJECT
#include "XSUB.h"
diff --git a/sv.h b/sv.h
index 116f17828a..e9d6893e21 100644
--- a/sv.h
+++ b/sv.h
@@ -257,7 +257,7 @@ struct xpvbm {
U8 xbm_rare; /* rarest character in string */
};
-/* This structure much match XPVCV */
+/* This structure much match XPVCV in cv.h */
typedef U16 cv_flags_t;
@@ -276,9 +276,7 @@ struct xpvfm {
void (*xcv_xsub)(pTHXo_ CV*);
ANY xcv_xsubany;
GV * xcv_gv;
-#if defined(PERL_BINCOMPAT_5005)
- GV * xcv_filegv; /* XXX unused (and deprecated) */
-#endif
+ char * xcv_file;
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
@@ -318,12 +316,13 @@ struct xpvio {
char xio_flags;
};
-#define IOf_ARGV 1 /* this fp iterates over ARGV */
-#define IOf_START 2 /* check for null ARGV and substitute '-' */
-#define IOf_FLUSH 4 /* this fp wants a flush after write op */
-#define IOf_DIDTOP 8 /* just did top of form */
-#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */
-#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */
+#define IOf_ARGV 1 /* this fp iterates over ARGV */
+#define IOf_START 2 /* check for null ARGV and substitute '-' */
+#define IOf_FLUSH 4 /* this fp wants a flush after write op */
+#define IOf_DIDTOP 8 /* just did top of form */
+#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */
+#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */
+#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge) */
/* The following macros define implementation-independent predicates on SVs. */
diff --git a/toke.c b/toke.c
index d1f77df3bd..a33f3b727d 100644
--- a/toke.c
+++ b/toke.c
@@ -49,13 +49,6 @@ static void restore_lex_expect(pTHXo_ void *e);
* 1999-02-27 mjd-perl-patch@plover.com */
#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
-/* On MacOS, respect nonbreaking spaces */
-#ifdef MACOS_TRADITIONAL
-#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\312'||(c)=='\t')
-#else
-#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t')
-#endif
-
/* LEX_* are values for PL_lex_state, the state of the lexer.
* They are arranged oddly so that the guard on the switch statement
* can get by with a single comparison (if the compiler is smart enough).
@@ -111,7 +104,7 @@ int* yychar_pointer = NULL;
#ifdef CLINE
#undef CLINE
#endif
-#define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline))
+#define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
/*
* Convenience functions to return different tokens and prime the
@@ -373,7 +366,7 @@ Perl_lex_start(pTHX_ SV *line)
SAVEI32(PL_lex_state);
SAVESPTR(PL_lex_inpat);
SAVEI32(PL_lex_inwhat);
- SAVEI16(PL_curcop->cop_line);
+ SAVECOPLINE(PL_curcop);
SAVEPPTR(PL_bufptr);
SAVEPPTR(PL_bufend);
SAVEPPTR(PL_oldbufptr);
@@ -441,7 +434,7 @@ Perl_lex_end(pTHX)
* S_incline
* This subroutine has nothing to do with tilting, whether at windmills
* or pinball tables. Its name is short for "increment line". It
- * increments the current line number in PL_curcop->cop_line and checks
+ * increments the current line number in CopLINE(PL_curcop) and checks
* to see whether the line starts with a comment of the form
* # line 500 "foo.pm"
* If so, it sets the current line number and file to the values in the comment.
@@ -456,11 +449,10 @@ S_incline(pTHX_ char *s)
char ch;
int sawline = 0;
- PERL_ASYNC_CHECK();
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
if (*s++ != '#')
return;
- while (SPACE_OR_TAB(*s)) s++;
+ while (*s == ' ' || *s == '\t') s++;
if (strnEQ(s, "line ", 5)) {
s += 5;
sawline = 1;
@@ -470,7 +462,7 @@ S_incline(pTHX_ char *s)
n = s;
while (isDIGIT(*s))
s++;
- while (SPACE_OR_TAB(*s))
+ while (*s == ' ' || *s == '\t')
s++;
if (*s == '"' && (t = strchr(s+1, '"')))
s++;
@@ -482,11 +474,11 @@ S_incline(pTHX_ char *s)
ch = *t;
*t = '\0';
if (t - s > 0)
- CopFILEGV_set(PL_curcop, gv_fetchfile(s));
+ CopFILE_set(PL_curcop, s);
else
- CopFILEGV_set(PL_curcop, gv_fetchfile(PL_origfilename));
+ CopFILE_set(PL_curcop, PL_origfilename);
*t = ch;
- PL_curcop->cop_line = atoi(n)-1;
+ CopLINE_set(PL_curcop, atoi(n)-1);
}
/*
@@ -500,7 +492,7 @@ S_skipspace(pTHX_ register char *s)
{
dTHR;
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
- while (s < PL_bufend && SPACE_OR_TAB(*s))
+ while (s < PL_bufend && (*s == ' ' || *s == '\t'))
s++;
return s;
}
@@ -598,7 +590,7 @@ S_skipspace(pTHX_ register char *s)
sv_upgrade(sv, SVt_PVMG);
sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
- av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
}
}
@@ -977,7 +969,7 @@ S_sublex_push(pTHX)
SAVEI32(PL_lex_state);
SAVESPTR(PL_lex_inpat);
SAVEI32(PL_lex_inwhat);
- SAVEI16(PL_curcop->cop_line);
+ SAVECOPLINE(PL_curcop);
SAVEPPTR(PL_bufptr);
SAVEPPTR(PL_oldbufptr);
SAVEPPTR(PL_oldoldbufptr);
@@ -1005,7 +997,7 @@ S_sublex_push(pTHX)
*PL_lex_casestack = '\0';
PL_lex_starts = 0;
PL_lex_state = LEX_INTERPCONCAT;
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
PL_lex_inwhat = PL_sublex_info.sub_inwhat;
if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
@@ -1772,7 +1764,8 @@ S_incl_perldb(pTHX)
* store private buffers and state information.
*
* The supplied datasv parameter is upgraded to a PVIO type
- * and the IoDIRP field is used to store the function pointer.
+ * and the IoDIRP field is used to store the function pointer,
+ * and IOf_FAKE_DIRP is enabled on datasv to mark this as such.
* Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
* private use must be set using malloc'd pointers.
*/
@@ -1790,6 +1783,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
if (!SvUPGRADE(datasv, SVt_PVIO))
Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
+ IoFLAGS(datasv) |= IOf_FAKE_DIRP;
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
funcp, SvPV_nolen(datasv)));
av_unshift(PL_rsfp_filters, 1);
@@ -1802,12 +1796,15 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
void
Perl_filter_del(pTHX_ filter_t funcp)
{
+ SV *datasv;
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp));
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
- if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
- IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL;
+ datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
+ if (IoDIRP(datasv) == (DIR*)funcp) {
+ IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
+ IoDIRP(datasv) = (DIR*)NULL;
sv_free(av_pop(PL_rsfp_filters));
return;
@@ -2338,7 +2335,7 @@ Perl_yylex(pTHX)
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
goto retry;
}
@@ -2387,10 +2384,10 @@ Perl_yylex(pTHX)
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- if (PL_curcop->cop_line == 1) {
+ if (CopLINE(PL_curcop) == 1) {
while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
@@ -2478,7 +2475,6 @@ Perl_yylex(pTHX)
*s = '#'; /* Don't try to parse shebang line */
}
#endif /* ALTERNATE_SHEBANG */
-#ifndef MACOS_TRADITIONAL
if (!d &&
*s == '#' &&
ipathend > ipath &&
@@ -2506,14 +2502,13 @@ Perl_yylex(pTHX)
PerlProc_execv(ipath, newargv);
Perl_croak(aTHX_ "Can't exec %s", ipath);
}
-#endif
if (d) {
U32 oldpdb = PL_perldb;
bool oldn = PL_minus_n;
bool oldp = PL_minus_p;
while (*d && !isSPACE(*d)) d++;
- while (SPACE_OR_TAB(*d)) d++;
+ while (*d == ' ' || *d == '\t') d++;
if (*d++ == '-') {
do {
@@ -2555,9 +2550,6 @@ Perl_yylex(pTHX)
"(Maybe you didn't strip carriage returns after a network transfer?)\n");
#endif
case ' ': case '\t': case '\f': case 013:
-#ifdef MACOS_TRADITIONAL
- case '\312': /* Them nonbreaking spaces again */
-#endif
s++;
goto retry;
case '#':
@@ -2586,7 +2578,7 @@ Perl_yylex(pTHX)
PL_bufptr = s;
tmp = *s++;
- while (s < PL_bufend && SPACE_OR_TAB(*s))
+ while (s < PL_bufend && (*s == ' ' || *s == '\t'))
s++;
if (strnEQ(s,"=>",2)) {
@@ -2807,8 +2799,8 @@ Perl_yylex(pTHX)
PL_expect = XTERM;
TOKEN('(');
case ';':
- if (PL_curcop->cop_line < PL_copline)
- PL_copline = PL_curcop->cop_line;
+ if (CopLINE(PL_curcop) < PL_copline)
+ PL_copline = CopLINE(PL_curcop);
tmp = *s++;
OPERATOR(tmp);
case ')':
@@ -2852,20 +2844,20 @@ Perl_yylex(pTHX)
PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
OPERATOR(HASHBRACK);
case XOPERATOR:
- while (s < PL_bufend && SPACE_OR_TAB(*s))
+ while (s < PL_bufend && (*s == ' ' || *s == '\t'))
s++;
d = s;
PL_tokenbuf[0] = '\0';
if (d < PL_bufend && *d == '-') {
PL_tokenbuf[0] = '-';
d++;
- while (d < PL_bufend && SPACE_OR_TAB(*d))
+ while (d < PL_bufend && (*d == ' ' || *d == '\t'))
d++;
}
if (d < PL_bufend && isIDFIRST_lazy(d)) {
d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
FALSE, &len);
- while (d < PL_bufend && SPACE_OR_TAB(*d))
+ while (d < PL_bufend && (*d == ' ' || *d == '\t'))
d++;
if (*d == '}') {
char minus = (PL_tokenbuf[0] == '-');
@@ -2971,7 +2963,7 @@ Perl_yylex(pTHX)
}
break;
}
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
if (isSPACE(*s) || *s == '#')
PL_copline = NOLINE; /* invalidate current command line number */
TOKEN('{');
@@ -3012,9 +3004,9 @@ Perl_yylex(pTHX)
s--;
if (PL_expect == XOPERATOR) {
if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) {
- PL_curcop->cop_line--;
+ CopLINE_dec(PL_curcop);
Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
BAop(OP_BIT_AND);
}
@@ -3076,9 +3068,9 @@ Perl_yylex(pTHX)
if (PL_lex_brackets < PL_lex_formbrack) {
char *t;
#ifdef PERL_STRICT_CR
- for (t = s; SPACE_OR_TAB(*t); t++) ;
+ for (t = s; *t == ' ' || *t == '\t'; t++) ;
#else
- for (t = s; SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
+ for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ;
#endif
if (*t == '\n' || *t == '#') {
s--;
@@ -3548,9 +3540,9 @@ Perl_yylex(pTHX)
if (PL_expect == XOPERATOR) {
if (PL_bufptr == PL_linestart) {
- PL_curcop->cop_line--;
+ CopLINE_dec(PL_curcop);
Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi);
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
else
no_op("Bareword",s);
@@ -3638,7 +3630,7 @@ Perl_yylex(pTHX)
if (*s == '(') {
CLINE;
if (gv && GvCVu(gv)) {
- for (d = s + 1; SPACE_OR_TAB(*d); d++) ;
+ for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
s = d + 1;
goto its_constant;
@@ -3742,7 +3734,7 @@ Perl_yylex(pTHX)
case KEY___LINE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- Perl_newSVpvf(aTHX_ "%"IVdf, (IV)PL_curcop->cop_line));
+ Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)));
TERM(THING);
case KEY___PACKAGE__:
@@ -3921,7 +3913,7 @@ Perl_yylex(pTHX)
PREBLOCK(ELSE);
case KEY_elsif:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(ELSIF);
case KEY_eq:
@@ -3971,7 +3963,7 @@ Perl_yylex(pTHX)
case KEY_for:
case KEY_foreach:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
s = skipspace(s);
if (PL_expect == XSTATE && isIDFIRST_lazy(s)) {
char *p = s;
@@ -4109,7 +4101,7 @@ Perl_yylex(pTHX)
UNI(OP_HEX);
case KEY_if:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(IF);
case KEY_index:
@@ -4701,11 +4693,11 @@ Perl_yylex(pTHX)
UNI(OP_UNTIE);
case KEY_until:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNTIL);
case KEY_unless:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(UNLESS);
case KEY_unlink:
@@ -4757,7 +4749,7 @@ Perl_yylex(pTHX)
LOP(OP_VEC,XTERM);
case KEY_while:
- yylval.ival = PL_curcop->cop_line;
+ yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHILE);
case KEY_warn:
@@ -5683,7 +5675,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
if (isSPACE(s[-1])) {
while (s < send) {
char ch = *s++;
- if (!SPACE_OR_TAB(ch)) {
+ if (ch != ' ' && ch != '\t') {
*d = ch;
break;
}
@@ -5709,7 +5701,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
Perl_croak(aTHX_ ident_too_long);
}
*d = '\0';
- while (s < send && SPACE_OR_TAB(*s)) s++;
+ while (s < send && (*s == ' ' || *s == '\t')) s++;
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
dTHR; /* only for ckWARN */
if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
@@ -5984,7 +5976,7 @@ S_scan_heredoc(pTHX_ register char *s)
e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
if (!outer)
*d++ = '\n';
- for (peek = s; SPACE_OR_TAB(*peek); peek++) ;
+ for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
if (*peek && strchr("`'\"",*peek)) {
s = peek;
term = *s++;
@@ -6053,7 +6045,7 @@ S_scan_heredoc(pTHX_ register char *s)
}
CLINE;
- PL_multi_start = PL_curcop->cop_line;
+ PL_multi_start = CopLINE(PL_curcop);
PL_multi_open = PL_multi_close = '<';
term = *PL_tokenbuf;
if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
@@ -6067,10 +6059,10 @@ S_scan_heredoc(pTHX_ register char *s)
while (s < bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
if (*s++ == '\n')
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
if (s >= bufend) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
sv_setpvn(herewas,bufptr,d-bufptr+1);
@@ -6087,15 +6079,15 @@ S_scan_heredoc(pTHX_ register char *s)
while (s < PL_bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
if (*s++ == '\n')
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
}
if (s >= PL_bufend) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
sv_setpvn(tmpstr,d+1,s-d);
s += len - 1;
- PL_curcop->cop_line++; /* the preceding stmt passes a newline */
+ CopLINE_inc(PL_curcop); /* the preceding stmt passes a newline */
sv_catpvn(herewas,s,PL_bufend-s);
sv_setsv(PL_linestr,herewas);
@@ -6107,10 +6099,10 @@ S_scan_heredoc(pTHX_ register char *s)
while (s >= PL_bufend) { /* multiple line string? */
if (!outer ||
!(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
missingterm(PL_tokenbuf);
}
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
#ifndef PERL_STRICT_CR
if (PL_bufend - PL_linestart >= 2) {
@@ -6132,7 +6124,7 @@ S_scan_heredoc(pTHX_ register char *s)
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
}
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
s = PL_bufend - 1;
@@ -6147,7 +6139,7 @@ S_scan_heredoc(pTHX_ register char *s)
}
s++;
retval:
- PL_multi_end = PL_curcop->cop_line;
+ PL_multi_end = CopLINE(PL_curcop);
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
@@ -6338,7 +6330,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
/* after skipping whitespace, the next character is the terminator */
term = *s;
/* mark where we are */
- PL_multi_start = PL_curcop->cop_line;
+ PL_multi_start = CopLINE(PL_curcop);
PL_multi_open = term;
/* find corresponding closing delimiter */
@@ -6368,7 +6360,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
for (; s < PL_bufend; s++,to++) {
/* embedded newlines increment the current line number */
if (*s == '\n' && !PL_rsfp)
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* handle quoted delimiters */
if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
if (!keep_quoted && s[1] == term)
@@ -6394,7 +6386,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
for (; s < PL_bufend; s++,to++) {
/* embedded newlines increment the line count */
if (*s == '\n' && !PL_rsfp)
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* backslashes can escape the open or closing characters */
if (*s == '\\' && s+1 < PL_bufend) {
if (!keep_quoted &&
@@ -6443,11 +6435,11 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
if (!PL_rsfp ||
!(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
sv_free(sv);
- PL_curcop->cop_line = PL_multi_start;
+ CopLINE_set(PL_curcop, PL_multi_start);
return Nullch;
}
/* we read a line, so increment our line counter */
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
/* update debugger info */
if (PERLDB_LINE && PL_curstash != PL_debstash) {
@@ -6455,7 +6447,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line, sv);
+ av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
}
/* having changed the buffer, we must update PL_bufend */
@@ -6466,7 +6458,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
if (keep_delims)
sv_catpvn(sv, s, 1);
- PL_multi_end = PL_curcop->cop_line;
+ PL_multi_end = CopLINE(PL_curcop);
s++;
/* if we allocated too much space, give some back */
@@ -6813,9 +6805,9 @@ S_scan_formline(pTHX_ register char *s)
if (*s == '.' || *s == '}') {
/*SUPPRESS 530*/
#ifdef PERL_STRICT_CR
- for (t = s+1;SPACE_OR_TAB(*t); t++) ;
+ for (t = s+1;*t == ' ' || *t == '\t'; t++) ;
#else
- for (t = s+1;SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
+ for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
#endif
if (*t == '\n' || t == PL_bufend)
break;
@@ -6917,7 +6909,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
PL_comppad_name_fill = 0;
PL_min_intro_pending = 0;
PL_padix = 0;
- PL_subline = PL_curcop->cop_line;
+ PL_subline = CopLINE(PL_curcop);
#ifdef USE_THREADS
av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
PL_curpad[0] = (SV*)newAV();
@@ -6998,15 +6990,14 @@ Perl_yyerror(pTHX_ char *s)
}
msg = sv_2mortal(newSVpv(s, 0));
Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ",
- CopFILESV(PL_curcop), (IV)PL_curcop->cop_line);
+ CopFILESV(PL_curcop), (IV)CopLINE(PL_curcop));
if (context)
Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
else
Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
- if (PL_multi_start < PL_multi_end &&
- (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
+ if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) {
Perl_sv_catpvf(aTHX_ msg,
- " (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
+ " (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
(int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
PL_multi_end = 0;
}
diff --git a/util.c b/util.c
index 9bd766c6c0..554c5b4041 100644
--- a/util.c
+++ b/util.c
@@ -1419,9 +1419,9 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
dTHR;
- if (PL_curcop->cop_line)
+ if (CopLINE(PL_curcop))
Perl_sv_catpvf(aTHX_ sv, " at %_ line %"IVdf,
- CopFILESV(PL_curcop), (IV)PL_curcop->cop_line);
+ CopFILESV(PL_curcop), (IV)CopLINE(PL_curcop));
if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
bool line_mode = (RsSIMPLE(PL_rs) &&
SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
@@ -3396,8 +3396,6 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
Zero(thr, 1, struct perl_thread);
#endif
- PL_protect = MEMBER_TO_FPTR(Perl_default_protect);
-
thr->oursv = sv;
init_stacks();
@@ -3410,18 +3408,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
thr->flags = THRf_R_JOINABLE;
MUTEX_INIT(&thr->mutex);
- /* top_env needs to be non-zero. It points to an area
- in which longjmp() stuff is stored, as C callstack
- info there at least is thread specific this has to
- be per-thread. Otherwise a 'die' in a thread gives
- that thread the C stack of last thread to do an eval {}!
- See comments in scope.h
- Initialize top entry (as in perl.c for main thread)
- */
- PL_start_env.je_prev = NULL;
- PL_start_env.je_ret = -1;
- PL_start_env.je_mustcatch = TRUE;
- PL_top_env = &PL_start_env;
+ JMPENV_BOOTSTRAP;
PL_in_eval = EVAL_NULL; /* ~(EVAL_INEVAL|EVAL_WARNONLY|EVAL_KEEPERR) */
PL_restartop = 0;
@@ -3461,9 +3448,12 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
PL_ofs = savepvn(t->Tofs, PL_ofslen);
PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
PL_chopset = t->Tchopset;
- PL_formtarget = newSVsv(t->Tformtarget);
PL_bodytarget = newSVsv(t->Tbodytarget);
PL_toptarget = newSVsv(t->Ttoptarget);
+ if (t->Tformtarget == t->Ttoptarget)
+ PL_formtarget = PL_toptarget;
+ else
+ PL_formtarget = PL_bodytarget;
/* Initialise all per-thread SVs that the template thread used */
svp = AvARRAY(t->threadsv);
diff --git a/util.h b/util.h
index 7dcf9ceab5..1c2c5552e7 100644
--- a/util.h
+++ b/util.h
@@ -6,3 +6,27 @@
* License or the Artistic License, as specified in the README file.
*
*/
+
+#ifdef VMS
+# define PERL_FILE_IS_ABSOLUTE(f) \
+ (*(f) == '/' \
+ || (strchr(f,':') \
+ || ((*(f) == '[' || *(f) == '<') \
+ && (isALNUM((f)[1]) || strchr("$-_]>",(f)[1])))))
+
+#else /* !VMS */
+# ifdef WIN32
+# define PERL_FILE_IS_ABSOLUTE(f) \
+ (*(f) == '/' \
+ || ((f)[0] && (f)[1] == ':') /* drive name */ \
+ || ((f)[0] == '\\' && (f)[1] == '\\')) /* UNC path */
+# else /* !WIN32 */
+# ifdef DOSISH
+# define PERL_FILE_IS_ABSOLUTE(f) \
+ (*(f) == '/' \
+ || ((f)[0] && (f)[1] == ':')) /* drive name */
+# else /* !DOSISH */
+# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/')
+# endif /* DOSISH */
+# endif /* WIN32 */
+#endif /* VMS */
diff --git a/win32/perllib.c b/win32/perllib.c
index e8d59cdf36..61798faf1c 100644
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -1556,7 +1556,15 @@ RunPerl(int argc, char **argv, char **env)
exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
if (!exitstatus) {
+#if 0 /* def USE_ITHREADS */ /* XXXXXX testing */
+extern PerlInterpreter * perl_clone(pTHXx_ IV flags);
+
+ PerlInterpreter *new_perl = perl_clone(my_perl, 0);
+ exitstatus = perl_run( new_perl );
+ /* perl_destruct(new_perl); perl_free(new_perl); */
+#else
exitstatus = perl_run( my_perl );
+#endif
}
perl_destruct( my_perl );
diff --git a/win32/win32.c b/win32/win32.c
index 3f56f600f3..4abb60df66 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -100,29 +100,6 @@ HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
char w32_module_name[MAX_PATH+1];
static DWORD w32_platform = (DWORD)-1;
-#ifdef USE_THREADS
-# ifdef USE_DECLSPEC_THREAD
-__declspec(thread) char strerror_buffer[512];
-__declspec(thread) char getlogin_buffer[128];
-__declspec(thread) char w32_perllib_root[MAX_PATH+1];
-# ifdef HAVE_DES_FCRYPT
-__declspec(thread) char crypt_buffer[30];
-# endif
-# else
-# define strerror_buffer (thr->i.Wstrerror_buffer)
-# define getlogin_buffer (thr->i.Wgetlogin_buffer)
-# define w32_perllib_root (thr->i.Ww32_perllib_root)
-# define crypt_buffer (thr->i.Wcrypt_buffer)
-# endif
-#else
-static char strerror_buffer[512];
-static char getlogin_buffer[128];
-static char w32_perllib_root[MAX_PATH+1];
-# ifdef HAVE_DES_FCRYPT
-static char crypt_buffer[30];
-# endif
-#endif
-
int
IsWin95(void)
{
@@ -916,8 +893,8 @@ char *
getlogin(void)
{
dTHXo;
- char *buf = getlogin_buffer;
- DWORD size = sizeof(getlogin_buffer);
+ char *buf = w32_getlogin_buffer;
+ DWORD size = sizeof(w32_getlogin_buffer);
if (GetUserName(buf,&size))
return buf;
return (char*)NULL;
@@ -1571,7 +1548,6 @@ win32_alarm(unsigned int sec)
return 0;
}
-#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT)
#ifdef HAVE_DES_FCRYPT
extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf);
#endif
@@ -1582,13 +1558,12 @@ win32_crypt(const char *txt, const char *salt)
dTHXo;
#ifdef HAVE_DES_FCRYPT
dTHR;
- return des_fcrypt(txt, salt, crypt_buffer);
+ return des_fcrypt(txt, salt, w32_crypt_buffer);
#else
- die("The crypt() function is unimplemented due to excessive paranoia.");
+ Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
return Nullch;
#endif
}
-#endif
#ifdef USE_FIXED_OSFHANDLE
@@ -1808,10 +1783,11 @@ win32_strerror(int e)
e = GetLastError();
if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
- strerror_buffer, sizeof(strerror_buffer), NULL) == 0)
- strcpy(strerror_buffer, "Unknown Error");
+ w32_strerror_buffer,
+ sizeof(w32_strerror_buffer), NULL) == 0)
+ strcpy(w32_strerror_buffer, "Unknown Error");
- return strerror_buffer;
+ return w32_strerror_buffer;
}
return strerror(e);
}
@@ -2971,8 +2947,8 @@ static
XS(w32_LoginName)
{
dXSARGS;
- char *name = getlogin_buffer;
- DWORD size = sizeof(getlogin_buffer);
+ char *name = w32_getlogin_buffer;
+ DWORD size = sizeof(w32_getlogin_buffer);
EXTEND(SP,1);
if (GetUserName(name,&size)) {
/* size includes NULL */
@@ -3353,6 +3329,21 @@ Perl_win32_init(int *argcp, char ***argvp)
MALLOC_INIT;
}
+#ifdef USE_ITHREADS
+void
+Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
+{
+ dst->perlshell_tokens = Nullch;
+ dst->perlshell_vec = (char**)NULL;
+ dst->perlshell_items = 0;
+ dst->fdpid = newAV();
+ New(1313, dst->children, 1, child_tab);
+ dst->children->num = 0;
+ dst->hostlist = src->hostlist; /* XXX */
+ dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype;
+}
+#endif
+
#ifdef USE_BINMODE_SCRIPTS
void
@@ -3377,4 +3368,3 @@ win32_strip_return(SV *sv)
}
#endif
-
diff --git a/win32/win32.h b/win32/win32.h
index 766f488de9..9eaf76a2d4 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -348,6 +348,32 @@ EXT void win32_strip_return(struct sv *sv);
#define win32_strip_return(sv) NOOP
#endif
+/*
+ * Now Win32 specific per-thread data stuff
+ */
+
+struct thread_intern {
+ /* XXX can probably use one buffer instead of several */
+ char Wstrerror_buffer[512];
+ struct servent Wservent;
+ char Wgetlogin_buffer[128];
+# ifdef USE_SOCKETS_AS_HANDLES
+ int Winit_socktype;
+# endif
+# ifdef HAVE_DES_FCRYPT
+ char Wcrypt_buffer[30];
+# endif
+# ifdef USE_RTL_THREAD_API
+ void * retv; /* slot for thread return value */
+# endif
+};
+
+#ifdef USE_THREADS
+# ifndef USE_DECLSPEC_THREAD
+# define HAVE_THREAD_INTERN
+# endif /* !USE_DECLSPEC_THREAD */
+#endif /* USE_THREADS */
+
#define HAVE_INTERP_INTERN
typedef struct {
long num;
@@ -368,6 +394,9 @@ struct interp_intern {
child_tab * children;
HANDLE child_handles[MAXIMUM_WAIT_OBJECTS];
struct host_link * hostlist;
+#ifndef USE_THREADS
+ struct thread_intern thr_intern;
+#endif
};
@@ -380,32 +409,18 @@ struct interp_intern {
#define w32_child_pids (w32_children->pids)
#define w32_child_handles (PL_sys_intern.child_handles)
#define w32_host_link (PL_sys_intern.hostlist)
-
-/*
- * Now Win32 specific per-thread data stuff
- */
-
#ifdef USE_THREADS
-# ifndef USE_DECLSPEC_THREAD
-# define HAVE_THREAD_INTERN
-
-struct thread_intern {
- /* XXX can probably use one buffer instead of several */
- char Wstrerror_buffer[512];
- struct servent Wservent;
- char Wgetlogin_buffer[128];
- char Ww32_perllib_root[MAX_PATH+1];
-# ifdef USE_SOCKETS_AS_HANDLES
- int Winit_socktype;
-# endif
-# ifdef HAVE_DES_FCRYPT
- char Wcrypt_buffer[30];
-# endif
-# ifdef USE_RTL_THREAD_API
- void * retv; /* slot for thread return value */
-# endif
-};
-# endif /* !USE_DECLSPEC_THREAD */
+# define w32_strerror_buffer (thr->i.Wstrerror_buffer)
+# define w32_getlogin_buffer (thr->i.Wgetlogin_buffer)
+# define w32_crypt_buffer (thr->i.Wcrypt_buffer)
+# define w32_servent (thr->i.Wservent)
+# define w32_init_socktype (thr->i.Winit_socktype)
+#else
+# define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer)
+# define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer)
+# define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer)
+# define w32_servent (PL_sys_intern.thr_intern.Wservent)
+# define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype)
#endif /* USE_THREADS */
/* UNICODE<>ANSI translation helpers */
diff --git a/win32/win32iop.h b/win32/win32iop.h
index 9abb05fca6..e23000bc60 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -139,9 +139,7 @@ DllExport int win32_kill(int pid, int sig);
DllExport unsigned long win32_os_id(void);
DllExport void* win32_dynaload(const char*filename);
-#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT)
DllExport char * win32_crypt(const char *txt, const char *salt);
-#endif
END_EXTERN_C
@@ -287,10 +285,8 @@ END_EXTERN_C
#define closedir win32_closedir
#define os_id win32_os_id
-#ifdef HAVE_DES_FCRYPT
#undef crypt
-#define crypt win32_crypt
-#endif
+#define crypt(t,s) win32_crypt(t,s)
#ifndef USE_WIN32_RTL_ENV
#undef getenv
diff --git a/win32/win32sck.c b/win32/win32sck.c
index 49d38f33f1..93d501edef 100644
--- a/win32/win32sck.c
+++ b/win32/win32sck.c
@@ -75,18 +75,6 @@ static struct servent* win32_savecopyservent(struct servent*d,
struct servent*s,
const char *proto);
-#ifdef USE_THREADS
-#ifdef USE_DECLSPEC_THREAD
-__declspec(thread) struct servent myservent;
-__declspec(thread) int init_socktype;
-#else
-#define myservent (thr->i.Wservent)
-#define init_socktype (thr->i.Winit_socktype)
-#endif
-#else
-static struct servent myservent;
-#endif
-
static int wsock_started = 0;
void
@@ -117,16 +105,16 @@ set_socktype(void)
#ifdef USE_SOCKETS_AS_HANDLES
#ifdef USE_THREADS
dTHX;
- if(!init_socktype) {
+ if (!w32_init_socktype) {
#endif
- int iSockOpt = SO_SYNCHRONOUS_NONALERT;
- /*
- * Enable the use of sockets as filehandles
- */
- setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
- (char *)&iSockOpt, sizeof(iSockOpt));
+ int iSockOpt = SO_SYNCHRONOUS_NONALERT;
+ /*
+ * Enable the use of sockets as filehandles
+ */
+ setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
+ (char *)&iSockOpt, sizeof(iSockOpt));
#ifdef USE_THREADS
- init_socktype = 1;
+ w32_init_socktype = 1;
}
#endif
#endif /* USE_SOCKETS_AS_HANDLES */
@@ -500,7 +488,7 @@ win32_getservbyname(const char *name, const char *proto)
SOCKET_TEST(r = getservbyname(name, proto), NULL);
if (r) {
- r = win32_savecopyservent(&myservent, r, proto);
+ r = win32_savecopyservent(&w32_servent, r, proto);
}
return r;
}
@@ -513,7 +501,7 @@ win32_getservbyport(int port, const char *proto)
SOCKET_TEST(r = getservbyport(port, proto), NULL);
if (r) {
- r = win32_savecopyservent(&myservent, r, proto);
+ r = win32_savecopyservent(&w32_servent, r, proto);
}
return r;
}
View Lorry Controller Status