diff options
-rw-r--r-- | cop.h | 8 | ||||
-rw-r--r-- | deb.c | 11 | ||||
-rw-r--r-- | gv.c | 8 | ||||
-rw-r--r-- | op.c | 16 | ||||
-rw-r--r-- | perl.c | 12 | ||||
-rw-r--r-- | pp_ctl.c | 27 | ||||
-rw-r--r-- | pp_sys.c | 2 | ||||
-rw-r--r-- | scope.c | 2 | ||||
-rw-r--r-- | toke.c | 24 | ||||
-rw-r--r-- | util.c | 2 |
10 files changed, 58 insertions, 54 deletions
@@ -20,6 +20,14 @@ 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) +#define CopLINE(c) ((c)->cop_line) +#define CopLINE_set(c,l) ((c)->cop_line = (l)) + /* * Here we have some enormously heavy (or at least ponderous) wizardry. */ @@ -47,17 +47,16 @@ Perl_vdeb(pTHX_ const char *pat, va_list *args) #ifdef DEBUGGING dTHR; register I32 i; - GV* gv = PL_curcop->cop_filegv; + char* file = CopFILE(PL_curcop); #ifdef USE_THREADS PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t", PTR2UV(thr), - SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", - (long)PL_curcop->cop_line); + (file ? file : "<free>"), + (long)CopLINE(PL_curcop)); #else - PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", - SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>", - (long)PL_curcop->cop_line); + PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"), + (long)CopLINE(PL_curcop)); #endif /* USE_THREADS */ (void) PerlIO_vprintf(Perl_debug_log, pat, *args); #endif /* DEBUGGING */ @@ -101,8 +101,8 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) Newz(602, gp, 1, GP); GvGP(gv) = gp_ref(gp); GvSV(gv) = NEWSV(72,0); - GvLINE(gv) = PL_curcop->cop_line; - GvFILE(gv) = PL_curcop->cop_filegv ? SvPVX(GvSV(PL_curcop->cop_filegv)) : ""; + GvLINE(gv) = CopLINE(PL_curcop); + GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; GvCVGEN(gv) = 0; GvEGV(gv) = gv; sv_magic((SV*)gv, (SV*)gv, '*', name, len); @@ -895,9 +895,9 @@ Perl_gv_check(pTHX_ HV *stash) gv = (GV*)HeVAL(entry); if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) continue; - PL_curcop->cop_line = GvLINE(gv); + CopLINE_set(PL_curcop, GvLINE(gv)); filegv = GvFILEGV(gv); /* XXX could be made faster */ - PL_curcop->cop_filegv = filegv; + CopFILEGV_set(PL_curcop, filegv); if (filegv && GvMULTI(filegv)) /* Filename began with slash */ continue; Perl_warner(aTHX_ WARN_ONCE, @@ -761,7 +761,7 @@ STATIC void S_cop_free(pTHX_ COP* cop) { Safefree(cop->cop_label); - SvREFCNT_dec(cop->cop_filegv); + SvREFCNT_dec(CopFILEGV(cop)); if (! specialWARN(cop->cop_warnings)) SvREFCNT_dec(cop->cop_warnings); } @@ -2006,7 +2006,7 @@ Perl_newPROG(pTHX_ OP *o) if (cv) { dSP; PUSHMARK(SP); - XPUSHs((SV*)PL_compiling.cop_filegv); + XPUSHs((SV*)CopFILEGV(&PL_compiling)); PUTBACK; call_sv((SV*)cv, G_DISCARD); } @@ -3274,14 +3274,14 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) if (PL_copline == NOLINE) cop->cop_line = PL_curcop->cop_line; else { - cop->cop_line = PL_copline; + cop->cop_line = PL_copline; PL_copline = NOLINE; } - cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv); + CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop))); cop->cop_stash = PL_curstash; if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE); + SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE); if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) { (void)SvIOK_on(*svp); SvIVX(*svp) = 1; @@ -4366,8 +4366,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) HV *hv; Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld", - GvSV(PL_curcop->cop_filegv), - (long)PL_subline, (long)PL_curcop->cop_line); + CopFILESV(PL_curcop), + (long)PL_subline, (long)CopLINE(PL_curcop)); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); hv = GvHVn(db_postponed); @@ -4388,7 +4388,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (strEQ(s, "BEGIN")) { I32 oldscope = PL_scopestack_ix; ENTER; - SAVESPTR(PL_compiling.cop_filegv); + SAVESPTR(CopFILEGV(&PL_compiling)); SAVEI16(PL_compiling.cop_line); save_svref(&PL_rs); sv_setsv(PL_rs, PL_nrs); @@ -2052,7 +2052,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) } } - PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename); + CopFILEGV_set(PL_curcop, gv_fetchfile(PL_origfilename)); if (strEQ(PL_origfilename,"-")) scriptname = ""; if (*fdscript >= 0) { @@ -2166,7 +2166,7 @@ sed %s -e \"/^[^#]/b\" \ #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ if (PL_euid && - PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&PL_statbuf) >= 0 && + PerlLIO_stat(CopFILE(PL_curcop),&PL_statbuf) >= 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) { /* try again */ @@ -2176,7 +2176,7 @@ sed %s -e \"/^[^#]/b\" \ #endif #endif Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", - SvPVX(GvSV(PL_curcop->cop_filegv)), Strerror(errno)); + CopFILE(PL_curcop), Strerror(errno)); } } @@ -2320,7 +2320,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) * But I don't think it's too important. The manual lies when * it says access() is useful in setuid programs. */ - if (PerlLIO_access(SvPVX(GvSV(PL_curcop->cop_filegv)),1)) /*double check*/ + if (PerlLIO_access(CopFILE(PL_curcop),1)) /*double check*/ Perl_croak(aTHX_ "Permission denied"); #else /* If we can swap euid and uid, then we can determine access rights @@ -2341,7 +2341,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) #endif || PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid) Perl_croak(aTHX_ "Can't swap uid and euid"); /* really paranoid */ - if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0) + if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0) Perl_croak(aTHX_ "Permission denied"); /* testing full pathname here */ #if defined(IAMSUID) && !defined(NO_NOSUID_CHECK) if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) @@ -2356,7 +2356,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) (Filename of set-id script was %s, uid %"Uid_t_f" gid %"Gid_t_f".)\n\nSincerely,\nperl\n", PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino, (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino, - SvPVX(GvSV(PL_curcop->cop_filegv)), + CopFILE(PL_curcop), PL_statbuf.st_uid, PL_statbuf.st_gid); (void)PerlProc_pclose(PL_rsfp); } @@ -1445,8 +1445,7 @@ PP(pp_caller) PUSHs(&PL_sv_undef); else PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0))); - PUSHs(sv_2mortal(newSVpvn(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), - SvCUR(GvSV(cx->blk_oldcop->cop_filegv))))); + PUSHs(sv_2mortal(newSVsv(CopFILESV(cx->blk_oldcop)))); PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line))); if (!MAXARG) RETURN; @@ -2489,10 +2488,10 @@ 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(PL_compiling.cop_filegv); + SAVESPTR(CopFILEGV(&PL_compiling)); SAVEI16(PL_compiling.cop_line); sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); - PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); + CopFILEGV_set(&PL_compiling, gv_fetchfile(tmpbuf+2)); PL_compiling.cop_line = 1; /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs @@ -2513,7 +2512,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) PL_op->op_type = OP_ENTEREVAL; PL_op->op_flags = 0; /* Avoid uninit warning. */ PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, 0, PL_compiling.cop_filegv); + PUSHEVAL(cx, 0, Nullgv); rop = doeval(G_SCALAR, startop); POPBLOCK(cx,PL_curpm); POPEVAL(cx); @@ -2691,7 +2690,7 @@ S_doeval(pTHX_ int gimme, OP** startop) if (cv) { dSP; PUSHMARK(SP); - XPUSHs((SV*)PL_compiling.cop_filegv); + XPUSHs((SV*)CopFILEGV(&PL_compiling)); PUTBACK; call_sv((SV*)cv, G_DISCARD); } @@ -2938,8 +2937,8 @@ PP(pp_require) } } } - SAVESPTR(PL_compiling.cop_filegv); - PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name); + SAVESPTR(CopFILEGV(&PL_compiling)); + CopFILEGV_set(&PL_compiling, gv_fetchfile(tryrsfp ? tryname : name)); SvREFCNT_dec(namesv); if (!tryrsfp) { if (PL_op->op_type == OP_REQUIRE) { @@ -2974,7 +2973,7 @@ PP(pp_require) /* Assume success here to prevent recursive requirement. */ (void)hv_store(GvHVn(PL_incgv), name, strlen(name), - newSVsv(GvSV(PL_compiling.cop_filegv)), 0 ); + newSVsv(CopFILESV(&PL_compiling)), 0 ); ENTER; SAVETMPS; @@ -3006,7 +3005,7 @@ PP(pp_require) /* switch to eval mode */ push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, name, PL_compiling.cop_filegv); + PUSHEVAL(cx, name, Nullgv); SAVEI16(PL_compiling.cop_line); PL_compiling.cop_line = 0; @@ -3049,9 +3048,9 @@ PP(pp_entereval) /* switch to eval mode */ - SAVESPTR(PL_compiling.cop_filegv); + SAVESPTR(CopFILEGV(&PL_compiling)); sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); - PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); + CopFILEGV_set(&PL_compiling, gv_fetchfile(tmpbuf+2)); PL_compiling.cop_line = 1; /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs @@ -3070,12 +3069,12 @@ PP(pp_entereval) push_return(PL_op->op_next); PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP); - PUSHEVAL(cx, 0, PL_compiling.cop_filegv); + PUSHEVAL(cx, 0, Nullgv); /* prepare to compile string */ if (PERLDB_LINE && PL_curstash != PL_debstash) - save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr); + save_lines(CopFILEAV(&PL_compiling), PL_linestr); PUTBACK; #ifdef USE_THREADS MUTEX_LOCK(&PL_eval_mutex); @@ -475,7 +475,7 @@ PP(pp_die) HV *stash = SvSTASH(SvRV(error)); GV *gv = gv_fetchmethod(stash, "PROPAGATE"); if (gv) { - SV *file = sv_2mortal(newSVsv(GvSV(PL_curcop->cop_filegv))); + SV *file = sv_2mortal(newSVsv(CopFILESV(PL_curcop))); SV *line = sv_2mortal(newSViv(PL_curcop->cop_line)); EXTEND(SP, 3); PUSHMARK(SP); @@ -283,7 +283,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) if (GvCVu(gv)) PL_sub_generation++; /* taking a method out of circulation */ - else if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) { + if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) { gp->gp_io = newIO(); IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START; } @@ -474,9 +474,9 @@ S_incline(pTHX_ char *s) ch = *t; *t = '\0'; if (t - s > 0) - PL_curcop->cop_filegv = gv_fetchfile(s); + CopFILEGV_set(PL_curcop, gv_fetchfile(s)); else - PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename); + CopFILEGV_set(PL_curcop, gv_fetchfile(PL_origfilename)); *t = ch; PL_curcop->cop_line = 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(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv); + av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv); } } } @@ -2330,7 +2330,7 @@ Perl_yylex(pTHX) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); - av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv); + av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv); } goto retry; } @@ -2379,7 +2379,7 @@ Perl_yylex(pTHX) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); - av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv); + av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv); } PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); if (PL_curcop->cop_line == 1) { @@ -2420,7 +2420,7 @@ Perl_yylex(pTHX) */ SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); assert(SvPOK(x) || SvGMAGICAL(x)); - if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) { + if (sv_eq(x, CopFILESV(PL_curcop))) { sv_setpvn(x, ipath, ipathend - ipath); SvSETMAGIC(x); } @@ -3724,7 +3724,7 @@ Perl_yylex(pTHX) case KEY___FILE__: yylval.opval = (OP*)newSVOP(OP_CONST, 0, - newSVsv(GvSV(PL_curcop->cop_filegv))); + newSVsv(CopFILESV(PL_curcop))); TERM(THING); case KEY___LINE__: @@ -6115,8 +6115,7 @@ S_scan_heredoc(pTHX_ register char *s) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); - av_store(GvAV(PL_curcop->cop_filegv), - (I32)PL_curcop->cop_line,sv); + av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line,sv); } if (*s == term && memEQ(s,PL_tokenbuf,len)) { s = PL_bufend - 1; @@ -6439,8 +6438,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(GvAV(PL_curcop->cop_filegv), - (I32)PL_curcop->cop_line, sv); + av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line, sv); } /* having changed the buffer, we must update PL_bufend */ @@ -6983,7 +6981,7 @@ Perl_yyerror(pTHX_ char *s) } msg = sv_2mortal(newSVpv(s, 0)); Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ", - GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line); + CopFILESV(PL_curcop), (IV)PL_curcop->cop_line); if (context) Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context); else @@ -6999,7 +6997,7 @@ Perl_yyerror(pTHX_ char *s) else qerror(msg); if (PL_error_count >= 10) - Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv)); + Perl_croak(aTHX_ "%_ has too many errors.\n", CopFILESV(PL_curcop)); PL_in_my = 0; PL_in_my_stash = Nullhv; return 0; @@ -1418,7 +1418,7 @@ Perl_vmess(pTHX_ const char *pat, va_list *args) dTHR; if (PL_curcop->cop_line) Perl_sv_catpvf(aTHX_ sv, " at %_ line %"IVdf, - GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line); + CopFILESV(PL_curcop), (IV)PL_curcop->cop_line); 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'); |