diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 1999-11-11 06:04:20 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1999-11-11 06:04:20 +0000 |
commit | 57843af05bc7863df9b9bfb6b37e3a29d08532a9 (patch) | |
tree | afce7f3f9e5ac7d38a7578c9d040f161c686fe6b | |
parent | 743e66e61aecff1c9998bd0ff719a1d679b03e9f (diff) | |
download | perl-57843af05bc7863df9b9bfb6b37e3a29d08532a9.tar.gz |
another change towards a shareable optree: avoid pointer to filegv
in COP; revert parts of change#4485 and s/xcv_filegv/xcv_file/
(CvFILE() may yet come in handy somewhere); adjust compiler doodads
to suit
p4raw-link: @4485 on //depot/perl: b195d4879f55e1610299cb9b1b55356940c2a577
p4raw-id: //depot/perl@4545
-rw-r--r-- | bytecode.pl | 5 | ||||
-rw-r--r-- | cop.h | 39 | ||||
-rw-r--r-- | cv.h | 9 | ||||
-rw-r--r-- | dump.c | 5 | ||||
-rw-r--r-- | ext/B/B.pm | 4 | ||||
-rw-r--r-- | ext/B/B.xs | 12 | ||||
-rw-r--r-- | ext/B/B/Asmdata.pm | 139 | ||||
-rw-r--r-- | ext/B/B/Bytecode.pm | 12 | ||||
-rw-r--r-- | ext/B/B/C.pm | 10 | ||||
-rw-r--r-- | ext/B/B/CC.pm | 4 | ||||
-rw-r--r-- | ext/B/B/Debug.pm | 10 | ||||
-rw-r--r-- | ext/B/B/Deparse.pm | 2 | ||||
-rw-r--r-- | ext/B/B/Lint.pm | 2 | ||||
-rw-r--r-- | ext/B/B/Xref.pm | 2 | ||||
-rw-r--r-- | ext/ByteLoader/bytecode.h | 2 | ||||
-rw-r--r-- | ext/ByteLoader/byterun.c | 153 | ||||
-rw-r--r-- | ext/ByteLoader/byterun.h | 141 | ||||
-rw-r--r-- | ext/Devel/Peek/Peek.pm | 1 | ||||
-rw-r--r-- | gv.c | 23 | ||||
-rw-r--r-- | gv.h | 2 | ||||
-rw-r--r-- | op.c | 69 | ||||
-rw-r--r-- | perl.c | 19 | ||||
-rw-r--r-- | pp.c | 2 | ||||
-rw-r--r-- | pp_ctl.c | 44 | ||||
-rw-r--r-- | pp_sys.c | 2 | ||||
-rw-r--r-- | scope.c | 2 | ||||
-rw-r--r-- | scope.h | 8 | ||||
-rw-r--r-- | sv.c | 4 | ||||
-rw-r--r-- | sv.h | 6 | ||||
-rw-r--r-- | toke.c | 94 | ||||
-rw-r--r-- | util.c | 4 | ||||
-rw-r--r-- | util.h | 24 | ||||
-rw-r--r-- | win32/perllib.c | 2 |
33 files changed, 473 insertions, 384 deletions
diff --git a/bytecode.pl b/bytecode.pl index 326633e2fa..9837d53ff2 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 @@ -400,10 +401,10 @@ 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_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 @@ -11,7 +11,11 @@ struct cop { BASEOP char * cop_label; /* label for this construct */ HV * cop_stash; /* package line was compiled in */ +#ifdef USE_ITHREADS + char * cop_file; /* file name the following line # is from */ +#else 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 +24,36 @@ 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 CopSTASH(c) (CopSTASHPV(c) \ + ? gv_fetchstash(CopSTASHPV(c)) : Nullhv) +# define CopSTASH_set(c,hv) ((c)->cop_stashpv = HvNAME(hv)) /* XXX */ +# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = pv) +# define CopSTASHPV(c) ((c)->cop_stashpv) +#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) +#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. @@ -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 @@ -530,8 +530,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; @@ -1068,6 +1068,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/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 224354c850..cef9ecbf6a 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -747,10 +747,10 @@ LOOP_lastop(o) #define COP_label(o) o->cop_label #define COP_stash(o) o->cop_stash -#define COP_filegv(o) o->cop_filegv +#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_ @@ -763,8 +763,8 @@ B::HV COP_stash(o) B::COP o -B::GV -COP_filegv(o) +char * +COP_file(o) B::COP o U32 @@ -1153,6 +1153,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..7d37616228 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_stash} = [109, \&PUT_svindex, "GET_svindex"]; +$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..382a591e99 100644 --- a/ext/B/B/Bytecode.pm +++ b/ext/B/B/Bytecode.pm @@ -280,26 +280,25 @@ sub B::COP::bytecode { my $op = shift; my $stash = $op->stash; my $stashix = $stash->objix; - my $filegv = $op->filegv; - my $filegvix = $filegv->objix; + 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), $op->cop_seq, pvstring($file), $op->arybase; newpv %s cop_label cop_stash $stashix 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..192ecefd28 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -293,9 +293,8 @@ 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,7 +302,7 @@ 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), + $init->add(sprintf("CopFILE_set(&cop_list[%d], %s);", $copix, cstring($op->file)), sprintf("cop_list[%d].cop_stash = %s;", $copix, $stashsym)); savesym($op, "(OP*)&cop_list[$copix]"); } @@ -700,6 +699,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 +1011,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..7623e9b249 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->stash}, $op->file, $op->seq, $op->arybase, $op->line, ${$op->warnings}; cop_label %s cop_stash 0x%x - cop_filegv 0x%x + 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..7509b96b19 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -777,7 +777,7 @@ sub pp_nextstate { } 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..77d93b035d 100644 --- a/ext/ByteLoader/bytecode.h +++ b/ext/ByteLoader/bytecode.h @@ -137,6 +137,8 @@ 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_OBJ_STORE(obj, ix) \ (I32)ix > bytecode_obj_list_fill ? \ diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c index 264cb01e6a..f55feb758a 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_STASH: /* 109 */ { svindex arg; BGET_svindex(arg); *(SV**)&cCOP->cop_stash = 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..17560c858b 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_STASH, /* 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 @@ -71,8 +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); - if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm"))) - GvMULTI_on(gv); if (PERLDB_LINE) hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); } @@ -121,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; @@ -879,7 +878,6 @@ Perl_gv_check(pTHX_ HV *stash) register I32 i; register GV *gv; HV *hv; - GV *filegv; if (!HvARRAY(stash)) return; @@ -892,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)); @@ -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) @@ -774,7 +774,11 @@ STATIC void S_cop_free(pTHX_ COP* cop) { Safefree(cop->cop_label); +#ifdef USE_ITHREADS + Safefree(CopFILE(cop)); /* XXXXX share in a pvtable? */ +#else SvREFCNT_dec(CopFILEGV(cop)); +#endif if (! specialWARN(cop->cop_warnings)) SvREFCNT_dec(cop->cop_warnings); } @@ -835,12 +839,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); @@ -2811,8 +2815,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 @@ -3287,7 +3291,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 ]; } @@ -3316,12 +3320,16 @@ 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))); +#endif cop->cop_stash = PL_curstash; if (PERLDB_LINE && PL_curstash != PL_debstash) { @@ -3441,14 +3449,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); } } @@ -3987,6 +3995,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); @@ -4252,12 +4261,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; @@ -4315,6 +4324,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; @@ -4437,8 +4447,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); @@ -4489,8 +4499,8 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv) 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; + line_t oldline = CopLINE(PL_curcop); + CopLINE_set(PL_curcop, PL_copline); PL_hints &= ~HINT_BLOCK_SCOPE; if(stash) @@ -4507,7 +4517,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv) PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); } CV * @@ -4528,11 +4538,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; @@ -4557,6 +4567,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) { @@ -4616,17 +4628,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])) @@ -6237,12 +6250,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; @@ -1082,7 +1082,7 @@ print \" \\@INC:\\n @INC\\n\";"); PL_origfilename); } } - PL_curcop->cop_line = 0; + CopLINE_set(PL_curcop, 0); PL_curstash = PL_defstash; PL_preprocess = FALSE; if (PL_e_script) { @@ -1097,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; @@ -2115,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) { @@ -2446,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"); @@ -3119,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; @@ -3134,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 @@ -3158,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"); @@ -3173,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"); @@ -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); } @@ -1446,7 +1446,7 @@ PP(pp_caller) 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]. */ @@ -2491,11 +2491,11 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) SAVESPTR(PL_compiling.cop_stash); PL_compiling.cop_stash = 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 @@ -2671,7 +2671,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)); @@ -2782,21 +2782,9 @@ PP(pp_require) /* prepare to compile file */ - 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 - ) + if (PERL_FILE_IS_ABSOLUTE(name) + || (*name == '.' && (name[1] == '/' || + (name[1] == '.' && name[2] == '/')))) { tryname = name; tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE); @@ -2940,8 +2928,8 @@ PP(pp_require) } } } - 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) { @@ -3010,8 +2998,8 @@ PP(pp_require) 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 @@ -3051,10 +3039,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 @@ -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); @@ -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 { @@ -110,6 +110,14 @@ } \ } STMT_END +#ifdef USE_ITHREADS +# define SAVECOPFILE(cop) SAVEPPTR(CopFILE(cop)) +#else +# 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. @@ -2462,7 +2462,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); @@ -6176,7 +6176,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags, PL_compiling = proto_perl->Icompiling; PL_compiling.cop_stash = hv_dup(PL_compiling.cop_stash); - PL_compiling.cop_filegv = gv_dup(PL_compiling.cop_filegv); + 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; @@ -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; @@ -104,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 @@ -366,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); @@ -434,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. @@ -449,7 +449,7 @@ S_incline(pTHX_ char *s) char ch; int sawline = 0; - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); if (*s++ != '#') return; while (*s == ' ' || *s == '\t') s++; @@ -474,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); } /* @@ -590,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); } } } @@ -969,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); @@ -997,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) @@ -2335,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; } @@ -2384,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 */ @@ -2799,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 ')': @@ -2963,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('{'); @@ -3004,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); } @@ -3540,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); @@ -3734,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__: @@ -3913,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: @@ -3963,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; @@ -4101,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: @@ -4693,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: @@ -4749,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: @@ -6045,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) { @@ -6059,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); @@ -6079,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); @@ -6099,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) { @@ -6124,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; @@ -6139,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); @@ -6330,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 */ @@ -6360,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) @@ -6386,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 && @@ -6435,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) { @@ -6447,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 */ @@ -6458,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 */ @@ -6909,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(); @@ -6990,12 +6990,12 @@ 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", (int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start); @@ -1416,9 +1416,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'); @@ -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 0480ae3786..61798faf1c 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -1556,7 +1556,7 @@ RunPerl(int argc, char **argv, char **env) exitstatus = perl_parse(my_perl, xs_init, argc, argv, env); if (!exitstatus) { -#ifdef USE_ITHREADS /* XXXXXX testing */ +#if 0 /* def USE_ITHREADS */ /* XXXXXX testing */ extern PerlInterpreter * perl_clone(pTHXx_ IV flags); PerlInterpreter *new_perl = perl_clone(my_perl, 0); |