From 97aff369fa5580e7a888d4fa4c86be74ab000409 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 6 Jan 2006 18:18:53 +0200 Subject: [PATCH] sprinkle dVAR Message-ID: <43BE7C4D.1010302@gmail.com> p4raw-id: //depot/perl@26675 --- av.c | 7 ++ deb.c | 5 ++ doio.c | 20 +++++ doop.c | 15 ++++ dump.c | 12 +++ ext/threads/threads.xs | 2 +- gv.c | 12 +++ hv.c | 11 +++ lib/ExtUtils/ParseXS.pm | 10 ++- locale.c | 7 ++ mathoms.c | 5 ++ mg.c | 29 ++++++++ numeric.c | 2 + op.c | 42 +++++++++++ opcode.h | 10 +++ opcode.pl | 10 +++ pad.c | 22 ++++++ perl.c | 30 +++++++- perl.h | 13 ++-- perl_keyword.pl | 1 + perlio.c | 30 ++++++++ perlvars.h | 2 + perly.c | 1 + pp.c | 191 ++++++++++++++++++++++++++---------------------- pp_ctl.c | 35 ++++++++- pp_hot.c | 61 +++++++++------- pp_pack.c | 6 +- pp_sort.c | 9 +++ pp_sys.c | 145 ++++++++++++++++++++---------------- regcomp.c | 23 ++++++ regexec.c | 15 ++++ run.c | 1 + scope.c | 51 +++++++++++++ sv.c | 72 +++++++++++++++++- taint.c | 2 + toke.c | 50 +++++++++++++ universal.c | 39 +++++++++- utf8.c | 26 +++++++ util.c | 25 ++++++- xsutils.c | 7 ++ 40 files changed, 858 insertions(+), 198 deletions(-) diff --git a/av.c b/av.c index c225093..fc6fca3 100644 --- a/av.c +++ b/av.c @@ -24,6 +24,7 @@ void Perl_av_reify(pTHX_ AV *av) { + dVAR; I32 key; assert(av); @@ -62,6 +63,7 @@ extended. void Perl_av_extend(pTHX_ AV *av, I32 key) { + dVAR; MAGIC *mg; assert(av); @@ -191,6 +193,7 @@ more information on how to use this function on tied arrays. SV** Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval) { + dVAR; SV *sv; assert(av); @@ -276,6 +279,7 @@ more information on how to use this function on tied arrays. SV** Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) { + dVAR; SV** ary; assert(av); @@ -415,6 +419,7 @@ array itself. void Perl_av_clear(pTHX_ register AV *av) { + dVAR; register I32 key; assert(av); @@ -769,6 +774,7 @@ and null is returned. SV * Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) { + dVAR; SV *sv; assert(av); @@ -856,6 +862,7 @@ C<&PL_sv_undef>. bool Perl_av_exists(pTHX_ AV *av, I32 key) { + dVAR; assert(av); if (SvRMAGICAL(av)) { diff --git a/deb.c b/deb.c index 933ae6c..681d8a2 100644 --- a/deb.c +++ b/deb.c @@ -53,6 +53,7 @@ void Perl_vdeb(pTHX_ const char *pat, va_list *args) { #ifdef DEBUGGING + dVAR; char* file = OutCopFILE(PL_curcop); PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : ""), @@ -68,6 +69,7 @@ I32 Perl_debstackptrs(pTHX) { #ifdef DEBUGGING + dVAR; PerlIO_printf(Perl_debug_log, "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n", PTR2UV(PL_curstack), PTR2UV(PL_stack_base), @@ -97,6 +99,7 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, I32 mark_min, I32 mark_max) { #ifdef DEBUGGING + dVAR; register I32 i = stack_max - 30; const I32 *markscan = PL_markstack + mark_min; if (i < stack_min) @@ -143,6 +146,7 @@ I32 Perl_debstack(pTHX) { #ifndef SKIP_DEBUGGING + dVAR; if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) return 0; @@ -182,6 +186,7 @@ void Perl_deb_stack_all(pTHX) { #ifdef DEBUGGING + dVAR; I32 si_ix; const PERL_SI *si; diff --git a/doio.c b/doio.c index f9a07fb..1dc4169 100644 --- a/doio.c +++ b/doio.c @@ -722,6 +722,7 @@ say_false: PerlIO * Perl_nextargv(pTHX_ register GV *gv) { + dVAR; register SV *sv; #ifndef FLEXFILENAMES int filedev; @@ -941,6 +942,7 @@ Perl_nextargv(pTHX_ register GV *gv) bool Perl_do_close(pTHX_ GV *gv, bool not_implicit) { + dVAR; bool retval; IO *io; @@ -973,6 +975,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) bool Perl_io_close(pTHX_ IO *io, bool not_implicit) { + dVAR; bool retval = FALSE; if (IoIFP(io)) { @@ -1011,6 +1014,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit) bool Perl_do_eof(pTHX_ GV *gv) { + dVAR; register IO * const io = GvIO(gv); if (!io) @@ -1053,6 +1057,7 @@ Perl_do_eof(pTHX_ GV *gv) Off_t Perl_do_tell(pTHX_ GV *gv) { + dVAR; register IO *io = NULL; register PerlIO *fp; @@ -1072,6 +1077,7 @@ Perl_do_tell(pTHX_ GV *gv) bool Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) { + dVAR; register IO *io = NULL; register PerlIO *fp; @@ -1091,6 +1097,7 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) Off_t Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) { + dVAR; register IO *io = NULL; register PerlIO *fp; @@ -1215,6 +1222,7 @@ my_chsize(int fd, Off_t length) bool Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) { + dVAR; register const char *tmps; STRLEN len; @@ -1266,6 +1274,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) I32 Perl_my_stat(pTHX) { + dVAR; dSP; IO *io; GV* gv; @@ -1324,6 +1333,7 @@ Perl_my_stat(pTHX) I32 Perl_my_lstat(pTHX) { + dVAR; static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat"; dSP; SV *sv; @@ -1411,6 +1421,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, void Perl_do_execfree(pTHX) { + dVAR; Safefree(PL_Argv); PL_Argv = Null(char **); Safefree(PL_Cmd); @@ -1563,6 +1574,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) I32 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) { + dVAR; register I32 val; register I32 tot = 0; const char *const what = PL_op_name[type]; @@ -1869,6 +1881,7 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp) * is in the list of groups returned from getgroups(). */ { + dVAR; #ifdef DOSISH /* [Comments and code from Len Reed] * MS-DOS "user" is similar to UNIX's "superuser," but can't write @@ -1925,6 +1938,7 @@ Perl_ingroup(pTHX_ Gid_t testgid, bool effective) /* This is simply not correct for AppleShare, but fix it yerself. */ return TRUE; #else + dVAR; if (testgid == (effective ? PL_egid : PL_gid)) return TRUE; #ifdef HAS_GETGROUPS @@ -1955,6 +1969,7 @@ Perl_ingroup(pTHX_ Gid_t testgid, bool effective) I32 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) { + dVAR; const key_t key = (key_t)SvNVx(*++mark); const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark); const I32 flags = SvIVx(*++mark); @@ -1986,6 +2001,7 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) I32 Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { + dVAR; char *a; I32 ret = -1; const I32 id = SvIVx(*++mark); @@ -2108,6 +2124,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) I32 Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) { + dVAR; #ifdef HAS_MSG STRLEN len; const I32 id = SvIVx(*++mark); @@ -2131,6 +2148,7 @@ I32 Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) { #ifdef HAS_MSG + dVAR; char *mbuf; long mtype; I32 msize, flags, ret; @@ -2167,6 +2185,7 @@ I32 Perl_do_semop(pTHX_ SV **mark, SV **sp) { #ifdef HAS_SEM + dVAR; STRLEN opsize; const I32 id = SvIVx(*++mark); SV * const opstr = *++mark; @@ -2218,6 +2237,7 @@ I32 Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) { #ifdef HAS_SHM + dVAR; char *shm; struct shmid_ds shmds; const I32 id = SvIVx(*++mark); diff --git a/doop.c b/doop.c index 28ace41..7fbc23b 100644 --- a/doop.c +++ b/doop.c @@ -28,6 +28,7 @@ STATIC I32 S_do_trans_simple(pTHX_ SV *sv) { + dVAR; U8 *s; U8 *d; const U8 *send; @@ -96,6 +97,7 @@ S_do_trans_simple(pTHX_ SV *sv) STATIC I32 S_do_trans_count(pTHX_ SV *sv) { + dVAR; const U8 *s; const U8 *send; I32 matches = 0; @@ -133,6 +135,7 @@ S_do_trans_count(pTHX_ SV *sv) STATIC I32 S_do_trans_complex(pTHX_ SV *sv) { + dVAR; U8 *s; U8 *send; U8 *d; @@ -298,6 +301,7 @@ S_do_trans_complex(pTHX_ SV *sv) STATIC I32 S_do_trans_simple_utf8(pTHX_ SV *sv) { + dVAR; U8 *s; U8 *send; U8 *d; @@ -398,6 +402,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv) STATIC I32 S_do_trans_count_utf8(pTHX_ SV *sv) { + dVAR; const U8 *s; const U8 *start = NULL; const U8 *send; @@ -441,6 +446,7 @@ S_do_trans_count_utf8(pTHX_ SV *sv) STATIC I32 S_do_trans_complex_utf8(pTHX_ SV *sv) { + dVAR; U8 *start, *send; U8 *d; I32 matches = 0; @@ -602,6 +608,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) I32 Perl_do_trans(pTHX_ SV *sv) { + dVAR; STRLEN len; const I32 hasutf = (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)); @@ -650,6 +657,7 @@ Perl_do_trans(pTHX_ SV *sv) void Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **sp) { + dVAR; SV ** const oldmark = mark; register I32 items = sp - mark; register STRLEN len; @@ -706,6 +714,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s void Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) { + dVAR; STRLEN patlen; const char * const pat = SvPV_const(*sarg, patlen); bool do_taint = FALSE; @@ -723,6 +732,7 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) UV Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) { + dVAR; STRLEN srclen, len; const unsigned char *s = (const unsigned char *) SvPV_const(sv, srclen); UV retnum = 0; @@ -861,6 +871,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) void Perl_do_vecset(pTHX_ SV *sv) { + dVAR; register I32 offset; register I32 size; register unsigned char *s; @@ -942,6 +953,7 @@ Perl_do_vecset(pTHX_ SV *sv) void Perl_do_chop(pTHX_ register SV *astr, register SV *sv) { + dVAR; STRLEN len; char *s; @@ -1017,6 +1029,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) I32 Perl_do_chomp(pTHX_ register SV *sv) { + dVAR; register I32 count; STRLEN len; char *s; @@ -1152,6 +1165,7 @@ Perl_do_chomp(pTHX_ register SV *sv) void Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) { + dVAR; #ifdef LIBERAL register long *dl; register long *ll; @@ -1343,6 +1357,7 @@ finish: OP * Perl_do_kv(pTHX) { + dVAR; dSP; HV * const hv = (HV*)POPs; HV *keys; diff --git a/dump.c b/dump.c index cebd7ab..2930a58 100644 --- a/dump.c +++ b/dump.c @@ -41,6 +41,7 @@ Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) { + dVAR; PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); PerlIO_vprintf(file, pat, *args); } @@ -48,6 +49,7 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) void Perl_dump_all(pTHX) { + dVAR; PerlIO_setlinebuf(Perl_debug_log); if (PL_main_root) op_dump(PL_main_root); @@ -57,6 +59,7 @@ Perl_dump_all(pTHX) void Perl_dump_packsubs(pTHX_ const HV *stash) { + dVAR; I32 i; if (!HvARRAY(stash)) @@ -112,6 +115,7 @@ Perl_dump_form(pTHX_ const GV *gv) void Perl_dump_eval(pTHX) { + dVAR; op_dump(PL_eval_root); } @@ -1097,6 +1101,7 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv) void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) { + dVAR; SV *d; const char *s; U32 flags; @@ -1586,12 +1591,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo void Perl_sv_dump(pTHX_ SV *sv) { + dVAR; do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0); } int Perl_runops_debug(pTHX) { + dVAR; if (!PL_op) { if (ckWARN_d(WARN_DEBUGGING)) Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); @@ -1630,6 +1637,7 @@ Perl_runops_debug(pTHX) I32 Perl_debop(pTHX_ const OP *o) { + dVAR; if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) return 0; @@ -1678,6 +1686,7 @@ Perl_debop(pTHX_ const OP *o) STATIC CV* S_deb_curcv(pTHX_ I32 ix) { + dVAR; const PERL_CONTEXT *cx = &cxstack[ix]; if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) return cx->blk_sub.cv; @@ -1694,6 +1703,7 @@ S_deb_curcv(pTHX_ I32 ix) void Perl_watch(pTHX_ char **addr) { + dVAR; PL_watchaddr = addr; PL_watchok = *addr; PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n", @@ -1703,6 +1713,7 @@ Perl_watch(pTHX_ char **addr) STATIC void S_debprof(pTHX_ const OP *o) { + dVAR; if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) return; if (!PL_profiledata) @@ -1713,6 +1724,7 @@ S_debprof(pTHX_ const OP *o) void Perl_debprofdump(pTHX) { + dVAR; unsigned i; if (!PL_profiledata) return; diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index d19e425..f0d9d32 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -771,8 +771,8 @@ ithread_DESTROY(SV *thread) BOOT: { - MY_CXT_INIT; #ifdef USE_ITHREADS + MY_CXT_INIT; ithread* thread; PL_perl_destruct_level = 2; MUTEX_INIT(&create_destruct_mutex); diff --git a/gv.c b/gv.c index c36cef8..42c1556 100644 --- a/gv.c +++ b/gv.c @@ -73,6 +73,7 @@ Perl_gv_HVadd(pTHX_ register GV *gv) GV * Perl_gv_IOadd(pTHX_ register GV *gv) { + dVAR; if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) { /* @@ -102,6 +103,7 @@ Perl_gv_IOadd(pTHX_ register GV *gv) GV * Perl_gv_fetchfile(pTHX_ const char *name) { + dVAR; char smallbuf[256]; char *tmpbuf; STRLEN tmplen; @@ -282,6 +284,7 @@ obtained from the GV with the C macro. GV * Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) { + dVAR; AV* av; GV* topgv; GV* gv; @@ -482,6 +485,7 @@ C apply equally to these functions. GV * Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) { + dVAR; register const char *nend; const char *nsplit = NULL; GV* gv; @@ -748,6 +752,7 @@ GV * Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, I32 sv_type) { + dVAR; register const char *name = nambeg; register GV *gv = NULL; GV**gvp; @@ -1237,6 +1242,7 @@ Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain IO * Perl_newIO(pTHX) { + dVAR; GV *iogv; IO * const io = (IO*)NEWSV(0,0); @@ -1259,6 +1265,7 @@ Perl_newIO(pTHX) void Perl_gv_check(pTHX_ HV *stash) { + dVAR; register I32 i; if (!HvARRAY(stash)) @@ -1310,6 +1317,7 @@ Perl_gv_check(pTHX_ HV *stash) GV * Perl_newGVgen(pTHX_ const char *pack) { + dVAR; return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++), TRUE, SVt_PVGV); } @@ -1319,6 +1327,7 @@ Perl_newGVgen(pTHX_ const char *pack) GP* Perl_gp_ref(pTHX_ GP *gp) { + dVAR; if (!gp) return (GP*)NULL; gp->gp_refcnt++; @@ -1340,6 +1349,7 @@ Perl_gp_ref(pTHX_ GP *gp) void Perl_gp_free(pTHX_ GV *gv) { + dVAR; GP* gp; if (!gv || !(gp = GvGP(gv))) @@ -1404,6 +1414,7 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg) bool Perl_Gv_AMupdate(pTHX_ HV *stash) { + dVAR; MAGIC* const mg = mg_find((SV*)stash, PERL_MAGIC_overload_table); AMT * const amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; AMT amt; @@ -1526,6 +1537,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) CV* Perl_gv_handler(pTHX_ HV *stash, I32 id) { + dVAR; MAGIC *mg; AMT *amtp; diff --git a/hv.c b/hv.c index 8ac9fb8..8a2449a 100644 --- a/hv.c +++ b/hv.c @@ -39,6 +39,7 @@ static const char S_strtab_error[] STATIC void S_more_he(pTHX) { + dVAR; HE* he; HE* heend; Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE); @@ -64,6 +65,7 @@ S_more_he(pTHX) STATIC HE* S_new_he(pTHX) { + dVAR; HE* he; void ** const root = &PL_body_roots[HE_SVSLOT]; @@ -115,6 +117,7 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) void Perl_free_tied_hv_pool(pTHX) { + dVAR; HE *he = PL_hv_fetch_ent_mh; while (he) { HE * const ohe = he; @@ -1126,6 +1129,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, STATIC void S_hsplit(pTHX_ HV *hv) { + dVAR; register XPVHV* xhv = (XPVHV*)SvANY(hv); const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ register I32 newsize = oldsize * 2; @@ -1295,6 +1299,7 @@ S_hsplit(pTHX_ HV *hv) void Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) { + dVAR; register XPVHV* xhv = (XPVHV*)SvANY(hv); const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ register I32 newsize; @@ -1489,6 +1494,7 @@ Perl_newHVhv(pTHX_ HV *ohv) void Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) { + dVAR; SV *val; if (!entry) @@ -1511,6 +1517,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) void Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry) { + dVAR; if (!entry) return; /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent */ @@ -1788,6 +1795,7 @@ Undefines the hash. void Perl_hv_undef(pTHX_ HV *hv) { + dVAR; register XPVHV* xhv; const char *name; @@ -1937,6 +1945,7 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) { void Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags) { + dVAR; struct xpvhv_aux *iter; U32 hash; @@ -2249,6 +2258,7 @@ Perl_unshare_hek(pTHX_ HEK *hek) STATIC void S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) { + dVAR; register XPVHV* xhv; HE *entry; register HE **oentry; @@ -2380,6 +2390,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) STATIC HEK * S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) { + dVAR; register HE *entry; const int flags_masked = flags & HVhek_MASK; const U32 hindex = hash & (I32) HvMAX(PL_strtab); diff --git a/lib/ExtUtils/ParseXS.pm b/lib/ExtUtils/ParseXS.pm index e2bce12..26e15fa 100644 --- a/lib/ExtUtils/ParseXS.pm +++ b/lib/ExtUtils/ParseXS.pm @@ -18,7 +18,7 @@ my(@XSStack); # Stack of conditionals and INCLUDEs my($XSS_work_idx, $cpp_next_tmp); use vars qw($VERSION); -$VERSION = '2.15_01'; +$VERSION = '2.15_02'; use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback $cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers @@ -565,7 +565,11 @@ EOF #XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */ #XS(XS_${Full_func_name}) #[[ +##ifdef dVAR +# dVAR; dXSARGS; +##else # dXSARGS; +##endif EOF print Q(<<"EOF") if $ALIAS ; # dXSI32; @@ -919,7 +923,11 @@ EOF print Q(<<"EOF"); #[[ +##ifdef dVAR +# dVAR; dXSARGS; +##else # dXSARGS; +##endif EOF #-Wall: if there is no $Full_func_name there are no xsubs in this .xs diff --git a/locale.c b/locale.c index 9400471..55da8b1 100644 --- a/locale.c +++ b/locale.c @@ -81,6 +81,7 @@ void Perl_set_numeric_radix(pTHX) { #ifdef USE_LOCALE_NUMERIC + dVAR; # ifdef HAS_LOCALECONV const struct lconv* const lc = localeconv(); @@ -109,6 +110,7 @@ void Perl_new_numeric(pTHX_ const char *newnum) { #ifdef USE_LOCALE_NUMERIC + dVAR; if (! newnum) { Safefree(PL_numeric_name); @@ -134,6 +136,7 @@ void Perl_set_numeric_standard(pTHX) { #ifdef USE_LOCALE_NUMERIC + dVAR; if (! PL_numeric_standard) { setlocale(LC_NUMERIC, "C"); @@ -149,6 +152,7 @@ void Perl_set_numeric_local(pTHX) { #ifdef USE_LOCALE_NUMERIC + dVAR; if (! PL_numeric_local) { setlocale(LC_NUMERIC, PL_numeric_name); @@ -190,6 +194,7 @@ void Perl_new_collate(pTHX_ const char *newcoll) { #ifdef USE_LOCALE_COLLATE + dVAR; if (! newcoll) { if (PL_collation_name) { @@ -242,6 +247,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) */ #if defined(USE_LOCALE) + dVAR; #ifdef USE_LOCALE_CTYPE char *curctype = NULL; @@ -555,6 +561,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) char * Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen) { + dVAR; char *xbuf; STRLEN xAlloc, xin, xout; /* xalloc is a reserved word in VC */ diff --git a/mathoms.c b/mathoms.c index 703918d..0f44c1b 100644 --- a/mathoms.c +++ b/mathoms.c @@ -581,6 +581,7 @@ Perl_do_exec(pTHX_ const char *cmd) void Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv) { + dVAR; register IO *rstio; register IO *wstio; int fd[2]; @@ -674,21 +675,25 @@ PP(pp_mapstart) /* These ops all have the same body as pp_null. */ PP(pp_scalar) { + dVAR; return NORMAL; } PP(pp_regcmaybe) { + dVAR; return NORMAL; } PP(pp_lineseq) { + dVAR; return NORMAL; } PP(pp_scope) { + dVAR; return NORMAL; } diff --git a/mg.c b/mg.c index d1bed8e..aa7ef7d 100644 --- a/mg.c +++ b/mg.c @@ -83,6 +83,7 @@ struct magic_state { STATIC void S_save_magic(pTHX_ I32 mgs_ix, SV *sv) { + dVAR; MGS* mgs; assert(SvMAGICAL(sv)); #ifdef PERL_OLD_COPY_ON_WRITE @@ -139,6 +140,7 @@ Do magic after a value is retrieved from the SV. See C. int Perl_mg_get(pTHX_ SV *sv) { + dVAR; const I32 mgs_ix = SSNEW(sizeof(MGS)); const bool was_temp = (bool)SvTEMP(sv); int have_new = 0; @@ -219,6 +221,7 @@ Do magic after a value is assigned to the SV. See C. int Perl_mg_set(pTHX_ SV *sv) { + dVAR; const I32 mgs_ix = SSNEW(sizeof(MGS)); MAGIC* mg; MAGIC* nextmg; @@ -251,6 +254,7 @@ Report on the SV's length. See C. U32 Perl_mg_length(pTHX_ SV *sv) { + dVAR; MAGIC* mg; STRLEN len; @@ -402,6 +406,7 @@ doesn't (eg taint, pos). void Perl_mg_localize(pTHX_ SV *sv, SV *nsv) { + dVAR; MAGIC *mg; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL* const vtbl = mg->mg_virtual; @@ -485,6 +490,7 @@ Perl_mg_free(pTHX_ SV *sv) U32 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) { + dVAR; PERL_UNUSED_ARG(sv); if (PL_curpm) { @@ -502,6 +508,7 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) { + dVAR; if (PL_curpm) { register const REGEXP * const rx = PM_GETRE(PL_curpm); if (rx) { @@ -544,6 +551,7 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg) U32 Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) { + dVAR; register I32 paren; register I32 i; register const REGEXP *rx; @@ -1124,6 +1132,7 @@ Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg) { + dVAR; PERL_UNUSED_ARG(mg); #if defined(VMS) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); @@ -1168,6 +1177,7 @@ restore_sigmask(pTHX_ SV *save_sv) int Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) { + dVAR; /* Are we fetching a signal entry? */ const I32 i = whichsig(MgPV_nolen_const(mg)); if (i > 0) { @@ -1262,6 +1272,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) static void S_raise_signal(pTHX_ int sig) { + dVAR; /* Set a flag to say this signal is pending */ PL_psig_pend[sig]++; /* And one to say _a_ signal is pending */ @@ -1324,6 +1335,7 @@ Perl_csighandler_init(void) void Perl_despatch_signals(pTHX) { + dVAR; int sig; PL_sig_pending = 0; for (sig = 1; sig < SIG_SIZE; sig++) { @@ -1463,6 +1475,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) { + dVAR; PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg); PL_sub_generation++; @@ -1472,6 +1485,7 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg) { + dVAR; PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg); /* HV_badAMAGIC_on(Sv_STASH(sv)); */ @@ -1515,6 +1529,7 @@ Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg) STATIC int S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int n, SV *val) { + dVAR; dSP; PUSHMARK(SP); @@ -1691,6 +1706,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) int Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) { + dVAR; GV * const gv = PL_DBline; const I32 i = SvTRUE(sv); SV ** const svp = av_fetch(GvAV(gv), @@ -1711,6 +1727,7 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg) { + dVAR; const AV * const obj = (AV*)mg->mg_obj; if (obj) { sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase); @@ -1723,6 +1740,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg) int Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) { + dVAR; AV * const obj = (AV*)mg->mg_obj; if (obj) { av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase); @@ -1737,6 +1755,7 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg) { + dVAR; PERL_UNUSED_ARG(sv); /* during global destruction, mg_obj may already have been freed */ if (PL_in_clean_all) @@ -1758,6 +1777,7 @@ Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) { + dVAR; SV* const lsv = LvTARG(sv); if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) { @@ -1777,6 +1797,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) { + dVAR; SV* const lsv = LvTARG(sv); SSize_t pos; STRLEN len; @@ -1882,6 +1903,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg) { + dVAR; STRLEN len; const char *tmps = SvPV_const(sv, len); SV * const lsv = LvTARG(sv); @@ -1915,6 +1937,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg) { + dVAR; PERL_UNUSED_ARG(sv); TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1)); return 0; @@ -1923,6 +1946,7 @@ Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg) { + dVAR; PERL_UNUSED_ARG(sv); /* update taint status unless we're restoring at scope exit */ if (PL_localizing != 2) { @@ -1960,6 +1984,7 @@ Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) { + dVAR; SV *targ = Nullsv; if (LvTARGLEN(sv)) { if (mg->mg_obj) { @@ -2005,6 +2030,7 @@ Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg) void Perl_vivify_defelem(pTHX_ SV *sv) { + dVAR; MAGIC *mg; SV *value = Nullsv; @@ -2090,6 +2116,7 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg) { + dVAR; regexp * const re = (regexp *)mg->mg_obj; PERL_UNUSED_ARG(sv); @@ -2129,6 +2156,7 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) { + dVAR; register const char *s; I32 i; STRLEN len; @@ -2741,6 +2769,7 @@ cleanup: static void S_restore_magic(pTHX_ const void *p) { + dVAR; MGS* const mgs = SSPTR(PTR2IV(p), MGS*); SV* const sv = mgs->mgs_sv; diff --git a/numeric.c b/numeric.c index a745a70..8ff19e5 100644 --- a/numeric.c +++ b/numeric.c @@ -498,6 +498,7 @@ bool Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) { #ifdef USE_LOCALE_NUMERIC + dVAR; if (PL_numeric_radix_sv && IN_LOCALE) { STRLEN len; const char * const radix = SvPV(PL_numeric_radix_sv, len); @@ -803,6 +804,7 @@ Perl_my_atof(pTHX_ const char* s) { NV x = 0.0; #ifdef USE_LOCALE_NUMERIC + dVAR; if (PL_numeric_local && IN_LOCALE) { NV y; diff --git a/op.c b/op.c index 065c684..baf207f 100644 --- a/op.c +++ b/op.c @@ -208,6 +208,7 @@ S_no_bareword_allowed(pTHX_ const OP *o) PADOFFSET Perl_allocmy(pTHX_ char *name) { + dVAR; PADOFFSET off; const bool is_our = (PL_in_my == KEY_our); @@ -546,6 +547,7 @@ Perl_scalarkids(pTHX_ OP *o) STATIC OP * S_scalarboolean(pTHX_ OP *o) { + dVAR; if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) { if (ckWARN(WARN_SYNTAX)) { const line_t oldline = CopLINE(PL_curcop); @@ -963,6 +965,7 @@ Perl_list(pTHX_ OP *o) OP * Perl_scalarseq(pTHX_ OP *o) { + dVAR; if (o) { if (o->op_type == OP_LINESEQ || o->op_type == OP_SCOPE || @@ -1536,6 +1539,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref) STATIC OP * S_dup_attrlist(pTHX_ OP *o) { + dVAR; OP *rop; /* An attrlist is either a simple OP_CONST or an OP_LIST with kids, @@ -1599,6 +1603,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) STATIC void S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) { + dVAR; OP *pack, *imop, *arg; SV *meth, *stashsv; @@ -1690,6 +1695,7 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv, STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) { + dVAR; I32 type; if (!o || PL_error_count) @@ -1751,6 +1757,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs) { + dVAR; OP *rops; int maybe_scalar = 0; @@ -1899,6 +1906,7 @@ Perl_scope(pTHX_ OP *o) int Perl_block_start(pTHX_ int full) { + dVAR; const int retval = PL_savestack_ix; pad_block_start(full); SAVEHINTS(); @@ -1919,6 +1927,7 @@ Perl_block_start(pTHX_ int full) OP* Perl_block_end(pTHX_ I32 floor, OP *seq) { + dVAR; const int needblockscope = PL_hints & HINT_BLOCK_SCOPE; OP* const retval = scalarseq(seq); LEAVE_SCOPE(floor); @@ -1932,6 +1941,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq) STATIC OP * S_newDEFSVOP(pTHX) { + dVAR; const I32 offset = pad_findmy("$_"); if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) { return newSVREF(newGVOP(OP_GV, 0, PL_defgv)); @@ -1946,6 +1956,7 @@ S_newDEFSVOP(pTHX) void Perl_newPROG(pTHX_ OP *o) { + dVAR; if (PL_in_eval) { if (PL_eval_root) return; @@ -1991,6 +2002,7 @@ Perl_newPROG(pTHX_ OP *o) OP * Perl_localize(pTHX_ OP *o, I32 lex) { + dVAR; if (o->op_flags & OPf_PARENS) /* [perl #17376]: this appears to be premature, and results in code such as C< our(%x); > executing in list mode rather than void mode */ @@ -2410,6 +2422,7 @@ static int uvcompare(const void *a, const void *b) OP * Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) { + dVAR; SV * const tstr = ((SVOP*)expr)->op_sv; SV * const rstr = ((SVOP*)repl)->op_sv; STRLEN tlen; @@ -3030,6 +3043,7 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv) void Perl_package(pTHX_ OP *o) { + dVAR; const char *name; STRLEN len; @@ -3049,6 +3063,7 @@ Perl_package(pTHX_ OP *o) void Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) { + dVAR; OP *pack; OP *imop; OP *veop; @@ -3180,6 +3195,7 @@ Perl_load_module_nocontext(U32 flags, SV *name, SV *ver, ...) void Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) { + dVAR; OP *veop, *imop; OP * const modname = newSVOP(OP_CONST, 0, name); @@ -3220,6 +3236,7 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) OP * Perl_dofile(pTHX_ OP *term, I32 force_builtin) { + dVAR; OP *doop; GV *gv = Nullgv; @@ -3294,6 +3311,7 @@ S_is_list_assignment(pTHX_ register const OP *o) OP * Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) { + dVAR; OP *o; if (optype) { @@ -3767,6 +3785,7 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) OP * Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) { + dVAR; OP* listop; OP* o; const bool once = block && block->op_flags & OPf_SPECIAL && @@ -4033,6 +4052,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP OP* Perl_newLOOPEX(pTHX_ I32 type, OP *label) { + dVAR; OP *o; if (type != OP_GOTO || label->op_type == OP_CONST) { @@ -4092,6 +4112,7 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block, I32 enter_opcode, I32 leave_opcode, PADOFFSET entertarg) { + dVAR; LOGOP *enterop; OP *o; @@ -4144,6 +4165,7 @@ STATIC bool S_looks_like_bool(pTHX_ OP *o) { + dVAR; switch(o->op_type) { case OP_OR: return looks_like_bool(cLOGOPo->op_first); @@ -4199,6 +4221,7 @@ S_looks_like_bool(pTHX_ OP *o) OP * Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off) { + dVAR; assert( cond ); return newGIVWHENOP( ref_array_or_hash(cond), @@ -4359,6 +4382,7 @@ Perl_cv_const_sv(pTHX_ CV *cv) SV * Perl_op_const_sv(pTHX_ const OP *o, CV *cv) { + dVAR; SV *sv = Nullsv; if (!o) @@ -4840,6 +4864,7 @@ Used by C to hook up XSUBs as Perl subs. CV * Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) { + dVAR; GV * const gv = gv_fetchpv(name ? name : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"), GV_ADDMULTI, SVt_PVCV); @@ -4949,6 +4974,7 @@ done: void Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) { + dVAR; register CV *cv; GV * const gv = o @@ -5147,6 +5173,7 @@ Perl_ck_anoncode(pTHX_ OP *o) OP * Perl_ck_bitop(pTHX_ OP *o) { + dVAR; #define OP_IS_NUMCOMPARE(op) \ ((op) == OP_LT || (op) == OP_I_LT || \ (op) == OP_GT || (op) == OP_I_GT || \ @@ -5253,6 +5280,7 @@ Perl_ck_die(pTHX_ OP *o) OP * Perl_ck_eof(pTHX_ OP *o) { + dVAR; const I32 type = o->op_type; if (o->op_flags & OPf_KIDS) { @@ -5349,6 +5377,7 @@ Perl_ck_exec(pTHX_ OP *o) OP * Perl_ck_exists(pTHX_ OP *o) { + dVAR; o = ck_fun(o); if (o->op_flags & OPf_KIDS) { OP * const kid = cUNOPo->op_first; @@ -5523,6 +5552,7 @@ Perl_ck_ftst(pTHX_ OP *o) OP * Perl_ck_fun(pTHX_ OP *o) { + dVAR; const int type = o->op_type; register I32 oa = PL_opargs[type] >> OASHIFT; @@ -5998,6 +6028,7 @@ Perl_ck_say(pTHX_ OP *o) OP * Perl_ck_smartmatch(pTHX_ OP *o) { + dVAR; if (0 == (o->op_flags & OPf_SPECIAL)) { OP *first = cBINOPo->op_first; OP *second = first->op_sibling; @@ -6055,6 +6086,7 @@ Perl_ck_sassign(pTHX_ OP *o) OP * Perl_ck_match(pTHX_ OP *o) { + dVAR; if (o->op_type != OP_QR && PL_compcv) { const I32 offset = pad_findmy("$_"); if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS(offset) & SVpad_OUR)) { @@ -6098,6 +6130,7 @@ Perl_ck_null(pTHX_ OP *o) OP * Perl_ck_open(pTHX_ OP *o) { + dVAR; HV * const table = GvHV(PL_hintgv); if (table) { SV **svp = hv_fetch(table, "open_IN", 7, FALSE); @@ -6158,6 +6191,7 @@ Perl_ck_repeat(pTHX_ OP *o) OP * Perl_ck_require(pTHX_ OP *o) { + dVAR; GV* gv = Nullgv; if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ @@ -6217,6 +6251,7 @@ Perl_ck_require(pTHX_ OP *o) OP * Perl_ck_return(pTHX_ OP *o) { + dVAR; if (CvLVALUE(PL_compcv)) { OP *kid; for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling) @@ -6249,6 +6284,7 @@ Perl_ck_select(pTHX_ OP *o) OP * Perl_ck_shift(pTHX_ OP *o) { + dVAR; const I32 type = o->op_type; if (!(o->op_flags & OPf_KIDS)) { @@ -6265,6 +6301,7 @@ Perl_ck_shift(pTHX_ OP *o) OP * Perl_ck_sort(pTHX_ OP *o) { + dVAR; OP *firstkid; if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0) @@ -6343,6 +6380,7 @@ Perl_ck_sort(pTHX_ OP *o) STATIC void S_simplify_sort(pTHX_ OP *o) { + dVAR; register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ OP *k; int descending; @@ -6484,6 +6522,7 @@ Perl_ck_join(pTHX_ OP *o) OP * Perl_ck_subr(pTHX_ OP *o) { + dVAR; OP *prev = ((cUNOPo->op_first->op_sibling) ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first; OP *o2 = prev->op_sibling; @@ -7403,6 +7442,7 @@ Perl_peep(pTHX_ register OP *o) char* Perl_custom_op_name(pTHX_ const OP* o) { + dVAR; const IV index = PTR2IV(o->op_ppaddr); SV* keysv; HE* he; @@ -7422,6 +7462,7 @@ Perl_custom_op_name(pTHX_ const OP* o) char* Perl_custom_op_desc(pTHX_ const OP* o) { + dVAR; const IV index = PTR2IV(o->op_ppaddr); SV* keysv; HE* he; @@ -7444,6 +7485,7 @@ Perl_custom_op_desc(pTHX_ const OP* o) static void const_sv_xsub(pTHX_ CV* cv) { + dVAR; dXSARGS; if (items != 0) { #if 0 diff --git a/opcode.h b/opcode.h index 755e4c9..ac3c01e 100644 --- a/opcode.h +++ b/opcode.h @@ -774,13 +774,16 @@ END_EXTERN_C START_EXTERN_C #ifdef PERL_GLOBAL_STRUCT_INIT +# define PERL_PPADDR_INITED static const Perl_ppaddr_t Gppaddr[] #else # ifndef PERL_GLOBAL_STRUCT +# define PERL_PPADDR_INITED EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ # endif #endif /* PERL_GLOBAL_STRUCT */ #if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT) +# define PERL_PPADDR_INITED = { MEMBER_TO_FPTR(Perl_pp_null), MEMBER_TO_FPTR(Perl_pp_stub), @@ -1145,16 +1148,21 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ MEMBER_TO_FPTR(Perl_pp_print), /* Perl_pp_say */ } #endif +#ifdef PERL_PPADDR_INITED ; +#endif #ifdef PERL_GLOBAL_STRUCT_INIT +# define PERL_CHECK_INITED static const Perl_check_t Gcheck[] #else # ifndef PERL_GLOBAL_STRUCT +# define PERL_CHECK_INITED EXT Perl_check_t PL_check[] /* or perlvars.h */ # endif #endif #if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT) +# define PERL_CHECK_INITED = { MEMBER_TO_FPTR(Perl_ck_null), /* null */ MEMBER_TO_FPTR(Perl_ck_null), /* stub */ @@ -1520,7 +1528,9 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ MEMBER_TO_FPTR(Perl_ck_null), /* custom */ } #endif +#ifdef PERL_CHECK_INITED ; +#endif /* #ifdef PERL_CHECK_INITED */ #ifndef PERL_GLOBAL_STRUCT_INIT diff --git a/opcode.pl b/opcode.pl index d4ff275..7923797 100755 --- a/opcode.pl +++ b/opcode.pl @@ -213,13 +213,16 @@ print < indicates that the name to check is an 'our' declaration void Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) { + dVAR; SV **svp; PADOFFSET top, off; @@ -572,6 +578,7 @@ Returns the offset in the current pad, or NOT_IN_PAD on failure. PADOFFSET Perl_pad_findmy(pTHX_ const char *name) { + dVAR; SV *out_sv; int out_flags; I32 offset; @@ -610,6 +617,7 @@ Perl_pad_findmy(pTHX_ const char *name) PADOFFSET Perl_find_rundefsvoffset(pTHX) { + dVAR; SV *out_sv; int out_flags; return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1, @@ -656,6 +664,7 @@ STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags) { + dVAR; I32 offset, new_offset; SV *new_capture; SV **new_capturep; @@ -877,6 +886,7 @@ Use macro PAD_SV instead of calling this function directly. SV * Perl_pad_sv(pTHX_ PADOFFSET po) { + dVAR; ASSERT_CURPAD_ACTIVE("pad_sv"); if (!po) @@ -901,6 +911,7 @@ Use the macro PAD_SETSV() rather than calling this function directly. void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv) { + dVAR; ASSERT_CURPAD_ACTIVE("pad_setsv"); DEBUG_X(PerlIO_printf(Perl_debug_log, @@ -930,6 +941,7 @@ Update the pad compilation state variables on entry to a new block void Perl_pad_block_start(pTHX_ int full) { + dVAR; ASSERT_CURPAD_ACTIVE("pad_block_start"); SAVEI32(PL_comppad_name_floor); PL_comppad_name_floor = AvFILLp(PL_comppad_name); @@ -958,6 +970,7 @@ Perl_pad_block_start(pTHX_ int full) U32 Perl_intro_my(pTHX) { + dVAR; SV **svp; I32 i; @@ -999,6 +1012,7 @@ lexicals in this scope and warn of any lexicals that never got introduced. void Perl_pad_leavemy(pTHX) { + dVAR; I32 off; SV * const * const svp = AvARRAY(PL_comppad_name); @@ -1044,6 +1058,7 @@ new one. void Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust) { + dVAR; ASSERT_CURPAD_LEGAL("pad_swipe"); if (!PL_curpad) return; @@ -1092,6 +1107,7 @@ Mark all the current temporaries for reuse void Perl_pad_reset(pTHX) { + dVAR; #ifdef USE_BROKEN_PAD_RESET if (AvARRAY(PL_comppad) != PL_curpad) Perl_croak(aTHX_ "panic: pad_reset curpad"); @@ -1230,6 +1246,7 @@ Free the SV at offset po in the current pad. void Perl_pad_free(pTHX_ PADOFFSET po) { + dVAR; ASSERT_CURPAD_LEGAL("pad_free"); if (!PL_curpad) return; @@ -1274,6 +1291,7 @@ Dump the contents of a padlist void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) { + dVAR; const AV *pad_name; const AV *pad; SV **pname; @@ -1345,6 +1363,7 @@ dump the contents of a CV STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title) { + dVAR; const CV * const outside = CvOUTSIDE(cv); AV* const padlist = CvPADLIST(cv); @@ -1536,6 +1555,7 @@ moved to a pre-existing CV struct. void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) { + dVAR; I32 ix; AV * const comppad_name = (AV*)AvARRAY(padlist)[0]; AV * const comppad = (AV*)AvARRAY(padlist)[1]; @@ -1568,6 +1588,7 @@ the new pad an @_ in slot zero. void Perl_pad_push(pTHX_ PADLIST *padlist, int depth) { + dVAR; if (depth <= AvFILLp(padlist)) return; @@ -1623,6 +1644,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) HV * Perl_pad_compname_type(pTHX_ const PADOFFSET po) { + dVAR; SV* const * const av = av_fetch(PL_comppad_name, po, FALSE); if ( SvFLAGS(*av) & SVpad_TYPED ) { return SvSTASH(*av); diff --git a/perl.c b/perl.c index 0493dd4..a76307d 100644 --- a/perl.c +++ b/perl.c @@ -1335,6 +1335,7 @@ perl_fini(void) void Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr) { + dVAR; Renew(PL_exitlist, PL_exitlistlen+1, PerlExitListEntry); PL_exitlist[PL_exitlistlen].fn = fn; PL_exitlist[PL_exitlistlen].ptr = ptr; @@ -1378,6 +1379,7 @@ S_procself_val(pTHX_ SV *sv, const char *arg0) STATIC void S_set_caret_X(pTHX) { + dVAR; GV* tmpgv = gv_fetchpv("\030",TRUE, SVt_PV); /* $^X */ if (tmpgv) { #ifdef HAS_PROCSELFEXE @@ -2220,6 +2222,7 @@ Tells a Perl interpreter to run. See L. int perl_run(pTHXx) { + dVAR; I32 oldscope; int ret = 0; dJMPENV; @@ -2273,6 +2276,7 @@ perl_run(pTHXx) STATIC void S_run_body(pTHX_ I32 oldscope) { + dVAR; DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n", PL_sawampersand ? "Enabling" : "Omitting")); @@ -2442,6 +2446,7 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv) /* See G_* flags in cop.h */ /* null terminated arg list */ { + dVAR; dSP; PUSHMARK(SP); @@ -2647,6 +2652,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) STATIC void S_call_body(pTHX_ const OP *myop, bool is_eval) { + dVAR; if (PL_op == myop) { if (is_eval) PL_op = Perl_pp_entereval(aTHX); /* this doesn't do a POPMARK */ @@ -2672,6 +2678,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) /* See G_* flags in cop.h */ { + dVAR; dSP; UNOP myop; /* fake syntax tree node */ volatile I32 oldmark = SP - PL_stack_base; @@ -2764,6 +2771,7 @@ Tells Perl to C the given string and return an SV* result. SV* Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error) { + dVAR; dSP; SV* sv = newSVpv(p, 0); @@ -2797,8 +2805,9 @@ implemented that way; consider using load_module instead. void Perl_require_pv(pTHX_ const char *pv) { - SV* sv; + dVAR; dSP; + SV* sv; PUSHSTACKi(PERLSI_REQUIRE); PUTBACK; sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0); @@ -3407,7 +3416,7 @@ Perl_my_unexec(pTHX) STATIC void S_init_interp(pTHX) { - + dVAR; #ifdef MULTIPLICITY # define PERLVAR(var,type) # define PERLVARA(var,n,type) @@ -3451,6 +3460,7 @@ S_init_interp(pTHX) STATIC void S_init_main_stash(pTHX) { + dVAR; GV *gv; PL_curstash = PL_defstash = newHV(); @@ -4208,6 +4218,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); STATIC void S_find_beginning(pTHX) { + dVAR; register char *s; register const char *s2; #ifdef MACOS_TRADITIONAL @@ -4277,6 +4288,7 @@ S_find_beginning(pTHX) STATIC void S_init_ids(pTHX) { + dVAR; PL_uid = PerlProc_getuid(); PL_euid = PerlProc_geteuid(); PL_gid = PerlProc_getgid(); @@ -4339,6 +4351,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[]) STATIC void S_forbid_setid(pTHX_ const char *s) { + dVAR; #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW if (PL_euid != PL_uid) Perl_croak(aTHX_ "No %s allowed while running setuid", s); @@ -4378,6 +4391,7 @@ S_forbid_setid(pTHX_ const char *s) void Perl_init_debugger(pTHX) { + dVAR; HV * const ostash = PL_curstash; PL_curstash = PL_debstash; @@ -4406,6 +4420,7 @@ Perl_init_debugger(pTHX) void Perl_init_stacks(pTHX) { + dVAR; /* start with 128-item stack and 8K cxstack */ PL_curstackinfo = new_stackinfo(REASONABLE(128), REASONABLE(8192/sizeof(PERL_CONTEXT) - 1)); @@ -4442,6 +4457,7 @@ Perl_init_stacks(pTHX) STATIC void S_nuke_stacks(pTHX) { + dVAR; while (PL_curstackinfo->si_next) PL_curstackinfo = PL_curstackinfo->si_next; while (PL_curstackinfo) { @@ -4460,6 +4476,7 @@ S_nuke_stacks(pTHX) STATIC void S_init_lexer(pTHX) { + dVAR; PerlIO *tmpfp; tmpfp = PL_rsfp; PL_rsfp = Nullfp; @@ -4471,6 +4488,7 @@ S_init_lexer(pTHX) STATIC void S_init_predump_symbols(pTHX) { + dVAR; GV *tmpgv; IO *io; @@ -4512,6 +4530,7 @@ S_init_predump_symbols(pTHX) void Perl_init_argv_symbols(pTHX_ register int argc, register char **argv) { + dVAR; argc--,argv++; /* skip name of script */ if (PL_doswitches) { for (; argc > 0 && **argv == '-'; argc--,argv++) { @@ -4645,6 +4664,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register STATIC void S_init_perllib(pTHX) { + dVAR; char *s; if (!PL_tainting) { #ifndef VMS @@ -4789,6 +4809,7 @@ S_init_perllib(pTHX) STATIC SV * S_incpush_if_exists(pTHX_ SV *dir) { + dVAR; Stat_t tmpstatbuf; if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) { @@ -4802,6 +4823,7 @@ STATIC void S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, bool canrelocate) { + dVAR; SV *subdir = Nullsv; const char *p = dir; @@ -5188,6 +5210,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) STATIC void * S_call_list_body(pTHX_ CV *cv) { + dVAR; PUSHMARK(PL_stack_sp); call_sv((SV*)cv, G_EVAL|G_DISCARD); return NULL; @@ -5196,6 +5219,7 @@ S_call_list_body(pTHX_ CV *cv) void Perl_my_exit(pTHX_ U32 status) { + dVAR; DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n", thr, (unsigned long) status)); switch (status) { @@ -5215,6 +5239,7 @@ Perl_my_exit(pTHX_ U32 status) void Perl_my_failure_exit(pTHX) { + dVAR; #ifdef VMS /* We have been called to fall on our sword. The desired exit code * should be already set in STATUS_UNIX, but could be shifted over @@ -5314,6 +5339,7 @@ S_my_exit_jump(pTHX) static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen) { + dVAR; const char * const p = SvPVX_const(PL_e_script); const char *nl = strchr(p, '\n'); diff --git a/perl.h b/perl.h index 1612020..f303cfb 100644 --- a/perl.h +++ b/perl.h @@ -59,23 +59,24 @@ # endif #endif -#if defined(MULTIPLICITY) -# ifndef PERL_IMPLICIT_CONTEXT -# define PERL_IMPLICIT_CONTEXT -# endif -#endif - #ifdef PERL_GLOBAL_STRUCT_PRIVATE # ifndef PERL_GLOBAL_STRUCT # define PERL_GLOBAL_STRUCT # endif #endif + #ifdef PERL_GLOBAL_STRUCT # ifndef MULTIPLICITY # define MULTIPLICITY # endif #endif +#ifdef MULTIPLICITY +# ifndef PERL_IMPLICIT_CONTEXT +# define PERL_IMPLICIT_CONTEXT +# endif +#endif + /* undef WIN32 when building on Cygwin (for libwin32) - gph */ #ifdef __CYGWIN__ # undef WIN32 diff --git a/perl_keyword.pl b/perl_keyword.pl index 904bb59..9312f47 100644 --- a/perl_keyword.pl +++ b/perl_keyword.pl @@ -67,6 +67,7 @@ print <cur >= list->len) { list->len += 8; @@ -660,6 +662,7 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param) void PerlIO_destruct(pTHX) { + dVAR; PerlIO **table = &PL_perlio; PerlIO *f; #ifdef USE_ITHREADS @@ -715,6 +718,7 @@ PerlIO_pop(pTHX_ PerlIO *f) AV * PerlIO_get_layers(pTHX_ PerlIO *f) { + dVAR; AV * const av = newAV(); if (PerlIOValid(f)) { @@ -877,6 +881,7 @@ XS(XS_PerlIO__Layer__NoWarnings) /* This is used as a %SIG{__WARN__} handler to supress warnings during loading of layers. */ + dVAR; dXSARGS; if (items) PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0))); @@ -885,6 +890,7 @@ XS(XS_PerlIO__Layer__NoWarnings) XS(XS_PerlIO__Layer__find) { + dVAR; dXSARGS; if (items < 2) Perl_croak(aTHX_ "Usage class->find(name[,load])"); @@ -903,6 +909,7 @@ XS(XS_PerlIO__Layer__find) void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab) { + dVAR; if (!PL_known_layers) PL_known_layers = PerlIO_list_alloc(aTHX); PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv); @@ -912,6 +919,7 @@ PerlIO_define_layer(pTHX_ PerlIO_funcs *tab) int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) { + dVAR; if (names) { const char *s = names; while (*s) { @@ -1005,6 +1013,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) void PerlIO_default_buffer(pTHX_ PerlIO_list_t *av) { + dVAR; PERLIO_FUNCS_DECL(*tab) = &PerlIO_perlio; #ifdef PERLIO_USING_CRLF tab = &PerlIO_crlf; @@ -1084,6 +1093,7 @@ PERLIO_FUNCS_DECL(PerlIO_remove) = { PerlIO_list_t * PerlIO_default_layers(pTHX) { + dVAR; if (!PL_def_layerlist) { const char * const s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO"); PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix; @@ -1135,6 +1145,7 @@ Perl_boot_core_PerlIO(pTHX) PerlIO_funcs * PerlIO_default_layer(pTHX_ I32 n) { + dVAR; PerlIO_list_t * const av = PerlIO_default_layers(aTHX); if (n < 0) n += av->cur; @@ -1147,6 +1158,7 @@ PerlIO_default_layer(pTHX_ I32 n) void PerlIO_stdstreams(pTHX) { + dVAR; if (!PL_perlio) { PerlIO_allocate(aTHX); PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT); @@ -1378,12 +1390,14 @@ Perl_PerlIO_close(pTHX_ PerlIO *f) int Perl_PerlIO_fileno(pTHX_ PerlIO *f) { + dVAR; Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f)); } static const char * PerlIO_context_layers(pTHX_ const char *mode) { + dVAR; const char *type = NULL; /* * Need to supply default layer info from open.pm @@ -1410,6 +1424,7 @@ PerlIO_context_layers(pTHX_ const char *mode) static PerlIO_funcs * PerlIO_layer_from_ref(pTHX_ SV *sv) { + dVAR; /* * For any scalar type load the handler which is bundled with perl */ @@ -1436,6 +1451,7 @@ PerlIO_list_t * PerlIO_resolve_layers(pTHX_ const char *layers, const char *mode, int narg, SV **args) { + dVAR; PerlIO_list_t *def = PerlIO_default_layers(aTHX); int incdef = 1; if (!PL_perlio) @@ -1494,6 +1510,7 @@ PerlIO * PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { + dVAR; if (!f && narg == 1 && *args == &PL_sv_undef) { if ((f = PerlIO_tmpfile())) { if (!layers || !*layers) @@ -1609,6 +1626,7 @@ Perl_PerlIO_tell(pTHX_ PerlIO *f) int Perl_PerlIO_flush(pTHX_ PerlIO *f) { + dVAR; if (f) { if (*f) { const PerlIO_funcs *tab = PerlIOBase(f)->tab; @@ -1650,6 +1668,7 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f) void PerlIOBase_flush_linebuf(pTHX) { + dVAR; PerlIO **table = &PL_perlio; PerlIO *f; while ((f = *table)) { @@ -2242,6 +2261,7 @@ PerlIOUnix_refcnt_inc(int fd) { dTHX; if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) { + dVAR; #ifdef USE_THREADS MUTEX_LOCK(&PerlIO_mutex); #endif @@ -2259,6 +2279,7 @@ PerlIOUnix_refcnt_dec(int fd) dTHX; int cnt = 0; if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) { + dVAR; #ifdef USE_THREADS MUTEX_LOCK(&PerlIO_mutex); #endif @@ -2274,6 +2295,7 @@ PerlIOUnix_refcnt_dec(int fd) void PerlIO_cleanup(pTHX) { + dVAR; int i; #ifdef USE_ITHREADS PerlIO_debug("Cleanup layers for %p\n",aTHX); @@ -2505,6 +2527,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) SSize_t PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { + dVAR; const int fd = PerlIOSelf(f, PerlIOUnix)->fd; #ifdef PERLIO_STD_SPECIAL if (fd == 0) @@ -2536,6 +2559,7 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) SSize_t PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { + dVAR; const int fd = PerlIOSelf(f, PerlIOUnix)->fd; #ifdef PERLIO_STD_SPECIAL if (fd == 1 || fd == 2) @@ -2566,6 +2590,7 @@ PerlIOUnix_tell(pTHX_ PerlIO *f) IV PerlIOUnix_close(pTHX_ PerlIO *f) { + dVAR; const int fd = PerlIOSelf(f, PerlIOUnix)->fd; int code = 0; if (PerlIOBase(f)->flags & PERLIO_F_OPEN) { @@ -3038,6 +3063,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f) SSize_t PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { + dVAR; FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio; SSize_t got = 0; for (;;) { @@ -3126,6 +3152,7 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) SSize_t PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { + dVAR; SSize_t got; for (;;) { got = PerlSIO_fwrite(vbuf, 1, count, @@ -4715,6 +4742,7 @@ PERLIO_FUNCS_DECL(PerlIO_mmap) = { PerlIO * Perl_PerlIO_stdin(pTHX) { + dVAR; if (!PL_perlio) { PerlIO_stdstreams(aTHX); } @@ -4724,6 +4752,7 @@ Perl_PerlIO_stdin(pTHX) PerlIO * Perl_PerlIO_stdout(pTHX) { + dVAR; if (!PL_perlio) { PerlIO_stdstreams(aTHX); } @@ -4733,6 +4762,7 @@ Perl_PerlIO_stdout(pTHX) PerlIO * Perl_PerlIO_stderr(pTHX) { + dVAR; if (!PL_perlio) { PerlIO_stdstreams(aTHX); } diff --git a/perlvars.h b/perlvars.h index c15b666..0c4319b 100644 --- a/perlvars.h +++ b/perlvars.h @@ -127,6 +127,8 @@ PERLVAR(Gtimesbase, struct tms) /* allocate a unique index to every module that calls MY_CXT_INIT */ #ifdef PERL_IMPLICIT_CONTEXT +# ifdef USE_ITHREADS PERLVAR(Gmy_ctx_mutex, perl_mutex) +# endif PERLVARI(Gmy_cxt_index, int, 0) #endif diff --git a/perly.c b/perly.c index fd4df1d..57eba71 100644 --- a/perly.c +++ b/perly.c @@ -250,6 +250,7 @@ yystpcpy (pTHX_ char *yydest, const char *yysrc) int Perl_yyparse (pTHX) { + dVAR; int yychar; /* The lookahead symbol. */ YYSTYPE yylval; /* The semantic value of the lookahead symbol. */ int yynerrs; /* Number of syntax errors so far. */ diff --git a/pp.c b/pp.c index b161eb6..304fced 100644 --- a/pp.c +++ b/pp.c @@ -47,6 +47,7 @@ extern Pid_t getpid (void); PP(pp_stub) { + dVAR; dSP; if (GIMME_V == G_SCALAR) XPUSHs(&PL_sv_undef); @@ -57,7 +58,7 @@ PP(pp_stub) PP(pp_padav) { - dSP; dTARGET; + dVAR; dSP; dTARGET; I32 gimme; if (PL_op->op_private & OPpLVAL_INTRO) SAVECLEARSV(PAD_SVl(PL_op->op_targ)); @@ -98,7 +99,7 @@ PP(pp_padav) PP(pp_padhv) { - dSP; dTARGET; + dVAR; dSP; dTARGET; I32 gimme; XPUSHs(TARG); @@ -126,7 +127,7 @@ PP(pp_padhv) PP(pp_rv2gv) { - dSP; dTOPss; + dVAR; dSP; dTOPss; if (SvROK(sv)) { wasref: @@ -221,8 +222,8 @@ PP(pp_rv2gv) PP(pp_rv2sv) { + dVAR; dSP; dTOPss; GV *gv = NULL; - dSP; dTOPss; if (SvROK(sv)) { wasref: @@ -293,7 +294,7 @@ PP(pp_rv2sv) PP(pp_av2arylen) { - dSP; + dVAR; dSP; AV * const av = (AV*)TOPs; SV ** const sv = Perl_av_arylen_p(aTHX_ (AV*)av); if (!*sv) { @@ -307,7 +308,7 @@ PP(pp_av2arylen) PP(pp_pos) { - dSP; dTARGET; dPOPss; + dVAR; dSP; dTARGET; dPOPss; if (PL_op->op_flags & OPf_MOD || LVRET) { if (SvTYPE(TARG) < SVt_PVLV) { @@ -341,7 +342,7 @@ PP(pp_pos) PP(pp_rv2cv) { - dSP; + dVAR; dSP; GV *gv; HV *stash; const I32 flags = (PL_op->op_flags & OPf_SPECIAL) @@ -374,7 +375,7 @@ PP(pp_rv2cv) PP(pp_prototype) { - dSP; + dVAR; dSP; CV *cv; HV *stash; GV *gv; @@ -440,7 +441,7 @@ PP(pp_prototype) PP(pp_anoncode) { - dSP; + dVAR; dSP; CV* cv = (CV*)PAD_SV(PL_op->op_targ); if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); @@ -451,14 +452,14 @@ PP(pp_anoncode) PP(pp_srefgen) { - dSP; + dVAR; dSP; *SP = refto(*SP); RETURN; } PP(pp_refgen) { - dSP; dMARK; + dVAR; dSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; @@ -477,6 +478,7 @@ PP(pp_refgen) STATIC SV* S_refto(pTHX_ SV *sv) { + dVAR; SV* rv; if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') { @@ -508,7 +510,7 @@ S_refto(pTHX_ SV *sv) PP(pp_ref) { - dSP; dTARGET; + dVAR; dSP; dTARGET; const char *pv; SV * const sv = POPs; @@ -525,7 +527,7 @@ PP(pp_ref) PP(pp_bless) { - dSP; + dVAR; dSP; HV *stash; if (MAXARG == 1) @@ -550,7 +552,7 @@ PP(pp_bless) PP(pp_gelem) { - dSP; + dVAR; dSP; SV *sv = POPs; const char * const elem = SvPV_nolen_const(sv); @@ -623,7 +625,7 @@ PP(pp_gelem) PP(pp_study) { - dSP; dPOPss; + dVAR; dSP; dPOPss; register unsigned char *s; register I32 pos; register I32 ch; @@ -686,7 +688,7 @@ PP(pp_study) PP(pp_trans) { - dSP; dTARG; + dVAR; dSP; dTARG; SV *sv; if (PL_op->op_flags & OPf_STACKED) @@ -706,7 +708,7 @@ PP(pp_trans) PP(pp_schop) { - dSP; dTARGET; + dVAR; dSP; dTARGET; do_chop(TARG, TOPs); SETTARG; RETURN; @@ -714,7 +716,7 @@ PP(pp_schop) PP(pp_chop) { - dSP; dMARK; dTARGET; dORIGMARK; + dVAR; dSP; dMARK; dTARGET; dORIGMARK; while (MARK < SP) do_chop(TARG, *++MARK); SP = ORIGMARK; @@ -724,14 +726,14 @@ PP(pp_chop) PP(pp_schomp) { - dSP; dTARGET; + dVAR; dSP; dTARGET; SETi(do_chomp(TOPs)); RETURN; } PP(pp_chomp) { - dSP; dMARK; dTARGET; + dVAR; dSP; dMARK; dTARGET; register I32 count = 0; while (SP > MARK) @@ -742,7 +744,7 @@ PP(pp_chomp) PP(pp_undef) { - dSP; + dVAR; dSP; SV *sv; if (!PL_op->op_private) { @@ -807,7 +809,7 @@ PP(pp_undef) PP(pp_predec) { - dSP; + dVAR; dSP; if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV) DIE(aTHX_ PL_no_modify); if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) @@ -824,7 +826,7 @@ PP(pp_predec) PP(pp_postinc) { - dSP; dTARGET; + dVAR; dSP; dTARGET; if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV) DIE(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); @@ -846,7 +848,7 @@ PP(pp_postinc) PP(pp_postdec) { - dSP; dTARGET; + dVAR; dSP; dTARGET; if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV) DIE(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); @@ -867,7 +869,7 @@ PP(pp_postdec) PP(pp_pow) { - dSP; dATARGET; + dVAR; dSP; dATARGET; #ifdef PERL_PRESERVE_IVUV bool is_int = 0; #endif @@ -996,7 +998,7 @@ PP(pp_pow) PP(pp_multiply) { - dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1114,7 +1116,7 @@ PP(pp_multiply) PP(pp_divide) { - dSP; dATARGET; tryAMAGICbin(div,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN); /* Only try to do UV divide first if ((SLOPPYDIVIDE is true) or (PERL_PRESERVE_IVUV is true and one or both SV is a UV too large @@ -1229,7 +1231,7 @@ PP(pp_divide) PP(pp_modulo) { - dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { UV left = 0; UV right = 0; @@ -1357,7 +1359,7 @@ PP(pp_modulo) PP(pp_repeat) { - dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); { register IV count; dPOPss; @@ -1482,7 +1484,7 @@ PP(pp_repeat) PP(pp_subtract) { - dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN); + dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN); useleft = USE_LEFT(TOPm1s); #ifdef PERL_PRESERVE_IVUV /* See comments in pp_add (in pp_hot.c) about Overflow, and how @@ -1599,7 +1601,7 @@ PP(pp_subtract) PP(pp_left_shift) { - dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { const IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { @@ -1616,7 +1618,7 @@ PP(pp_left_shift) PP(pp_right_shift) { - dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { const IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { @@ -1633,7 +1635,7 @@ PP(pp_right_shift) PP(pp_lt) { - dSP; tryAMAGICbinSET(lt,0); + dVAR; dSP; tryAMAGICbinSET(lt,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1708,7 +1710,7 @@ PP(pp_lt) PP(pp_gt) { - dSP; tryAMAGICbinSET(gt,0); + dVAR; dSP; tryAMAGICbinSET(gt,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1784,7 +1786,7 @@ PP(pp_gt) PP(pp_le) { - dSP; tryAMAGICbinSET(le,0); + dVAR; dSP; tryAMAGICbinSET(le,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1860,7 +1862,7 @@ PP(pp_le) PP(pp_ge) { - dSP; tryAMAGICbinSET(ge,0); + dVAR; dSP; tryAMAGICbinSET(ge,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1936,7 +1938,7 @@ PP(pp_ge) PP(pp_ne) { - dSP; tryAMAGICbinSET(ne,0); + dVAR; dSP; tryAMAGICbinSET(ne,0); #ifndef NV_PRESERVES_UV if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; @@ -2005,7 +2007,7 @@ PP(pp_ne) PP(pp_ncmp) { - dSP; dTARGET; tryAMAGICbin(ncmp,0); + dVAR; dSP; dTARGET; tryAMAGICbin(ncmp,0); #ifndef NV_PRESERVES_UV if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { const UV right = PTR2UV(SvRV(POPs)); @@ -2109,7 +2111,7 @@ PP(pp_ncmp) PP(pp_sle) { - dSP; + dVAR; dSP; int amg_type = sle_amg; int multiplier = 1; @@ -2147,7 +2149,7 @@ PP(pp_sle) PP(pp_seq) { - dSP; tryAMAGICbinSET(seq,0); + dVAR; dSP; tryAMAGICbinSET(seq,0); { dPOPTOPssrl; SETs(boolSV(sv_eq(left, right))); @@ -2157,7 +2159,7 @@ PP(pp_seq) PP(pp_sne) { - dSP; tryAMAGICbinSET(sne,0); + dVAR; dSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; SETs(boolSV(!sv_eq(left, right))); @@ -2167,7 +2169,7 @@ PP(pp_sne) PP(pp_scmp) { - dSP; dTARGET; tryAMAGICbin(scmp,0); + dVAR; dSP; dTARGET; tryAMAGICbin(scmp,0); { dPOPTOPssrl; const int cmp = (IN_LOCALE_RUNTIME @@ -2180,7 +2182,7 @@ PP(pp_scmp) PP(pp_bit_and) { - dSP; dATARGET; tryAMAGICbin(band,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(band,opASSIGN); { dPOPTOPssrl; SvGETMAGIC(left); @@ -2205,7 +2207,7 @@ PP(pp_bit_and) PP(pp_bit_xor) { - dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); { dPOPTOPssrl; SvGETMAGIC(left); @@ -2230,7 +2232,7 @@ PP(pp_bit_xor) PP(pp_bit_or) { - dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); { dPOPTOPssrl; SvGETMAGIC(left); @@ -2255,7 +2257,7 @@ PP(pp_bit_or) PP(pp_negate) { - dSP; dTARGET; tryAMAGICun(neg); + dVAR; dSP; dTARGET; tryAMAGICun(neg); { dTOPss; const int flags = SvFLAGS(sv); @@ -2325,14 +2327,14 @@ PP(pp_negate) PP(pp_not) { - dSP; tryAMAGICunSET(not); + dVAR; dSP; tryAMAGICunSET(not); *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp)); return NORMAL; } PP(pp_complement) { - dSP; dTARGET; tryAMAGICun(compl); + dVAR; dSP; dTARGET; tryAMAGICun(compl); { dTOPss; SvGETMAGIC(sv); @@ -2429,7 +2431,7 @@ PP(pp_complement) PP(pp_i_multiply) { - dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPiirl; SETi( left * right ); @@ -2439,7 +2441,7 @@ PP(pp_i_multiply) PP(pp_i_divide) { - dSP; dATARGET; tryAMAGICbin(div,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPiv; if (value == 0) @@ -2471,7 +2473,7 @@ PP(pp_i_modulo_1) /* This is the i_modulo with the workaround for the _moddi3 bug * in (at least) glibc 2.2.5 (the PERL_ABS() the workaround). * See below for pp_i_modulo. */ - dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dVAR; dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -2524,7 +2526,7 @@ PP(pp_i_modulo) PP(pp_i_add) { - dSP; dATARGET; tryAMAGICbin(add,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(add,opASSIGN); { dPOPTOPiirl_ul; SETi( left + right ); @@ -2534,7 +2536,7 @@ PP(pp_i_add) PP(pp_i_subtract) { - dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { dPOPTOPiirl_ul; SETi( left - right ); @@ -2544,7 +2546,7 @@ PP(pp_i_subtract) PP(pp_i_lt) { - dSP; tryAMAGICbinSET(lt,0); + dVAR; dSP; tryAMAGICbinSET(lt,0); { dPOPTOPiirl; SETs(boolSV(left < right)); @@ -2554,7 +2556,7 @@ PP(pp_i_lt) PP(pp_i_gt) { - dSP; tryAMAGICbinSET(gt,0); + dVAR; dSP; tryAMAGICbinSET(gt,0); { dPOPTOPiirl; SETs(boolSV(left > right)); @@ -2564,7 +2566,7 @@ PP(pp_i_gt) PP(pp_i_le) { - dSP; tryAMAGICbinSET(le,0); + dVAR; dSP; tryAMAGICbinSET(le,0); { dPOPTOPiirl; SETs(boolSV(left <= right)); @@ -2574,7 +2576,7 @@ PP(pp_i_le) PP(pp_i_ge) { - dSP; tryAMAGICbinSET(ge,0); + dVAR; dSP; tryAMAGICbinSET(ge,0); { dPOPTOPiirl; SETs(boolSV(left >= right)); @@ -2584,7 +2586,7 @@ PP(pp_i_ge) PP(pp_i_eq) { - dSP; tryAMAGICbinSET(eq,0); + dVAR; dSP; tryAMAGICbinSET(eq,0); { dPOPTOPiirl; SETs(boolSV(left == right)); @@ -2594,7 +2596,7 @@ PP(pp_i_eq) PP(pp_i_ne) { - dSP; tryAMAGICbinSET(ne,0); + dVAR; dSP; tryAMAGICbinSET(ne,0); { dPOPTOPiirl; SETs(boolSV(left != right)); @@ -2604,7 +2606,7 @@ PP(pp_i_ne) PP(pp_i_ncmp) { - dSP; dTARGET; tryAMAGICbin(ncmp,0); + dVAR; dSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPiirl; I32 value; @@ -2622,7 +2624,7 @@ PP(pp_i_ncmp) PP(pp_i_negate) { - dSP; dTARGET; tryAMAGICun(neg); + dVAR; dSP; dTARGET; tryAMAGICun(neg); SETi(-TOPi); RETURN; } @@ -2631,7 +2633,7 @@ PP(pp_i_negate) PP(pp_atan2) { - dSP; dTARGET; tryAMAGICbin(atan2,0); + dVAR; dSP; dTARGET; tryAMAGICbin(atan2,0); { dPOPTOPnnrl; SETn(Perl_atan2(left, right)); @@ -2641,7 +2643,7 @@ PP(pp_atan2) PP(pp_sin) { - dSP; dTARGET; tryAMAGICun(sin); + dVAR; dSP; dTARGET; tryAMAGICun(sin); { const NV value = POPn; XPUSHn(Perl_sin(value)); @@ -2651,7 +2653,7 @@ PP(pp_sin) PP(pp_cos) { - dSP; dTARGET; tryAMAGICun(cos); + dVAR; dSP; dTARGET; tryAMAGICun(cos); { const NV value = POPn; XPUSHn(Perl_cos(value)); @@ -2676,7 +2678,7 @@ extern double drand48 (void); PP(pp_rand) { - dSP; dTARGET; + dVAR; dSP; dTARGET; NV value; if (MAXARG < 1) value = 1.0; @@ -2695,7 +2697,7 @@ PP(pp_rand) PP(pp_srand) { - dSP; + dVAR; dSP; const UV anum = (MAXARG < 1) ? seed() : POPu; (void)seedDrand01((Rand_seed_t)anum); PL_srand_called = TRUE; @@ -2705,7 +2707,7 @@ PP(pp_srand) PP(pp_exp) { - dSP; dTARGET; tryAMAGICun(exp); + dVAR; dSP; dTARGET; tryAMAGICun(exp); { NV value; value = POPn; @@ -2717,7 +2719,7 @@ PP(pp_exp) PP(pp_log) { - dSP; dTARGET; tryAMAGICun(log); + dVAR; dSP; dTARGET; tryAMAGICun(log); { const NV value = POPn; if (value <= 0.0) { @@ -2731,7 +2733,7 @@ PP(pp_log) PP(pp_sqrt) { - dSP; dTARGET; tryAMAGICun(sqrt); + dVAR; dSP; dTARGET; tryAMAGICun(sqrt); { const NV value = POPn; if (value < 0.0) { @@ -2745,7 +2747,7 @@ PP(pp_sqrt) PP(pp_int) { - dSP; dTARGET; tryAMAGICun(int); + dVAR; dSP; dTARGET; tryAMAGICun(int); { const IV iv = TOPi; /* attempt to convert to IV if possible. */ /* XXX it's arguable that compiler casting to IV might be subtly @@ -2784,7 +2786,7 @@ PP(pp_int) PP(pp_abs) { - dSP; dTARGET; tryAMAGICun(abs); + dVAR; dSP; dTARGET; tryAMAGICun(abs); { /* This will cache the NV value if string isn't actually integer */ const IV iv = TOPi; @@ -2822,7 +2824,7 @@ PP(pp_abs) PP(pp_hex) { - dSP; dTARGET; + dVAR; dSP; dTARGET; const char *tmps; I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; STRLEN len; @@ -2852,7 +2854,7 @@ PP(pp_hex) PP(pp_oct) { - dSP; dTARGET; + dVAR; dSP; dTARGET; const char *tmps; I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; STRLEN len; @@ -2894,7 +2896,7 @@ PP(pp_oct) PP(pp_length) { - dSP; dTARGET; + dVAR; dSP; dTARGET; SV * const sv = TOPs; if (DO_UTF8(sv)) @@ -2906,7 +2908,7 @@ PP(pp_length) PP(pp_substr) { - dSP; dTARGET; + dVAR; dSP; dTARGET; SV *sv; I32 len = 0; STRLEN curlen; @@ -3074,7 +3076,7 @@ PP(pp_substr) PP(pp_vec) { - dSP; dTARGET; + dVAR; dSP; dTARGET; register const IV size = POPi; register const IV offset = POPi; register SV * const src = POPs; @@ -3105,7 +3107,7 @@ PP(pp_vec) PP(pp_index) { - dSP; dTARGET; + dVAR; dSP; dTARGET; SV *big; SV *little; SV *temp = NULL; @@ -3168,7 +3170,7 @@ PP(pp_index) PP(pp_rindex) { - dSP; dTARGET; + dVAR; dSP; dTARGET; SV *big; SV *little; SV *temp = NULL; @@ -3237,7 +3239,7 @@ PP(pp_rindex) PP(pp_sprintf) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; do_sprintf(TARG, SP-MARK, MARK+1); TAINT_IF(SvTAINTED(TARG)); SP = ORIGMARK; @@ -3247,7 +3249,7 @@ PP(pp_sprintf) PP(pp_ord) { - dSP; dTARGET; + dVAR; dSP; dTARGET; SV *argsv = POPs; STRLEN len; const U8 *s = (U8*)SvPV_const(argsv, len); @@ -3268,7 +3270,7 @@ PP(pp_ord) PP(pp_chr) { - dSP; dTARGET; + dVAR; dSP; dTARGET; char *tmps; UV value; @@ -3325,7 +3327,7 @@ PP(pp_chr) PP(pp_crypt) { #ifdef HAS_CRYPT - dSP; dTARGET; + dVAR; dSP; dTARGET; dPOPTOPssrl; STRLEN len; const char *tmps = SvPV_const(left, len); @@ -3373,6 +3375,7 @@ PP(pp_crypt) PP(pp_ucfirst) { + dVAR; dSP; SV *sv = TOPs; const U8 *s; @@ -3441,6 +3444,7 @@ PP(pp_ucfirst) PP(pp_uc) { + dVAR; dSP; SV *sv = TOPs; STRLEN len; @@ -3525,6 +3529,7 @@ PP(pp_uc) PP(pp_lc) { + dVAR; dSP; SV *sv = TOPs; STRLEN len; @@ -3629,7 +3634,7 @@ PP(pp_lc) PP(pp_quotemeta) { - dSP; dTARGET; + dVAR; dSP; dTARGET; SV * const sv = TOPs; STRLEN len; register const char *s = SvPV_const(sv,len); @@ -3682,7 +3687,7 @@ PP(pp_quotemeta) PP(pp_aslice) { - dSP; dMARK; dORIGMARK; + dVAR; dSP; dMARK; dORIGMARK; register AV* const av = (AV*)POPs; register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); @@ -3727,6 +3732,7 @@ PP(pp_aslice) PP(pp_each) { + dVAR; dSP; HV * const hash = (HV*)POPs; HE *entry; @@ -3758,6 +3764,7 @@ PP(pp_each) PP(pp_delete) { + dVAR; dSP; const I32 gimme = GIMME_V; const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; @@ -3817,6 +3824,7 @@ PP(pp_delete) PP(pp_exists) { + dVAR; dSP; SV *tmpsv; HV *hv; @@ -3851,7 +3859,7 @@ PP(pp_exists) PP(pp_hslice) { - dSP; dMARK; dORIGMARK; + dVAR; dSP; dMARK; dORIGMARK; register HV * const hv = (HV*)POPs; register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); const bool localizing = PL_op->op_private & OPpLVAL_INTRO; @@ -3913,7 +3921,7 @@ PP(pp_hslice) PP(pp_list) { - dSP; dMARK; + dVAR; dSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; /* unwanted list, return last item */ @@ -3926,6 +3934,7 @@ PP(pp_list) PP(pp_lslice) { + dVAR; dSP; SV ** const lastrelem = PL_stack_sp; SV ** const lastlelem = PL_stack_base + POPMARK; @@ -3979,7 +3988,7 @@ PP(pp_lslice) PP(pp_anonlist) { - dSP; dMARK; dORIGMARK; + dVAR; dSP; dMARK; dORIGMARK; const I32 items = SP - MARK; SV * const av = sv_2mortal((SV*)av_make(items, MARK+1)); SP = ORIGMARK; /* av_make() might realloc stack_sp */ @@ -3989,7 +3998,7 @@ PP(pp_anonlist) PP(pp_anonhash) { - dSP; dMARK; dORIGMARK; + dVAR; dSP; dMARK; dORIGMARK; HV* const hv = (HV*)sv_2mortal((SV*)newHV()); while (MARK < SP) { @@ -4245,6 +4254,7 @@ PP(pp_push) PP(pp_pop) { + dVAR; dSP; AV * const av = (AV*)POPs; SV * const sv = av_pop(av); @@ -4256,6 +4266,7 @@ PP(pp_pop) PP(pp_shift) { + dVAR; dSP; AV * const av = (AV*)POPs; SV * const sv = av_shift(av); @@ -4298,7 +4309,7 @@ PP(pp_unshift) PP(pp_reverse) { - dSP; dMARK; + dVAR; dSP; dMARK; SV ** const oldsp = SP; if (GIMME == G_ARRAY) { @@ -4672,6 +4683,7 @@ PP(pp_split) PP(pp_lock) { + dVAR; dSP; dTOPss; SV *retsv = sv; @@ -4687,6 +4699,7 @@ PP(pp_lock) PP(unimplemented_op) { + dVAR; DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op), PL_op->op_type); } diff --git a/pp_ctl.c b/pp_ctl.c index 3e66ada..05b34bf 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -40,6 +40,7 @@ PP(pp_wantarray) { + dVAR; dSP; I32 cxix; EXTEND(SP, 1); @@ -60,6 +61,7 @@ PP(pp_wantarray) PP(pp_regcreset) { + dVAR; /* XXXX Should store the old value to allow for tie/overload - and restore in regcomp, where marked with XXXX. */ PL_reginterp_cnt = 0; @@ -69,6 +71,7 @@ PP(pp_regcreset) PP(pp_regcomp) { + dVAR; dSP; register PMOP *pm = (PMOP*)cLOGOP->op_other; SV *tmpstr; @@ -180,6 +183,7 @@ PP(pp_regcomp) PP(pp_substcont) { + dVAR; dSP; register PERL_CONTEXT *cx = &cxstack[cxstack_ix]; register PMOP * const pm = (PMOP*) cLOGOP->op_other; @@ -385,7 +389,7 @@ Perl_rxres_free(pTHX_ void **rsp) PP(pp_formline) { - dSP; dMARK; dORIGMARK; + dVAR; dSP; dMARK; dORIGMARK; register SV * const tmpForm = *++MARK; register U32 *fpc; register char *t; @@ -1047,6 +1051,7 @@ PP(pp_mapwhile) PP(pp_range) { + dVAR; if (GIMME == G_ARRAY) return NORMAL; if (SvTRUEx(PAD_SV(PL_op->op_targ))) @@ -1057,6 +1062,7 @@ PP(pp_range) PP(pp_flip) { + dVAR; dSP; if (GIMME == G_ARRAY) { @@ -1111,7 +1117,7 @@ PP(pp_flip) PP(pp_flop) { - dSP; + dVAR; dSP; if (GIMME == G_ARRAY) { dPOPPOPssrl; @@ -1201,6 +1207,7 @@ static const char * const context_name[] = { STATIC I32 S_dopoptolabel(pTHX_ const char *label) { + dVAR; register I32 i; for (i = cxstack_ix; i >= 0; i--) { @@ -1237,6 +1244,7 @@ S_dopoptolabel(pTHX_ const char *label) I32 Perl_dowantarray(pTHX) { + dVAR; const I32 gimme = block_gimme(); return (gimme == G_VOID) ? G_SCALAR : gimme; } @@ -1244,6 +1252,7 @@ Perl_dowantarray(pTHX) I32 Perl_block_gimme(pTHX) { + dVAR; const I32 cxix = dopoptosub(cxstack_ix); if (cxix < 0) return G_VOID; @@ -1265,6 +1274,7 @@ Perl_block_gimme(pTHX) I32 Perl_is_lvalue_sub(pTHX) { + dVAR; const I32 cxix = dopoptosub(cxstack_ix); assert(cxix >= 0); /* We should only be called from inside subs */ @@ -1277,12 +1287,14 @@ Perl_is_lvalue_sub(pTHX) STATIC I32 S_dopoptosub(pTHX_ I32 startingblock) { + dVAR; return dopoptosub_at(cxstack, startingblock); } STATIC I32 S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock) { + dVAR; I32 i; for (i = startingblock; i >= 0; i--) { register const PERL_CONTEXT * const cx = &cxstk[i]; @@ -1302,6 +1314,7 @@ S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock) STATIC I32 S_dopoptoeval(pTHX_ I32 startingblock) { + dVAR; I32 i; for (i = startingblock; i >= 0; i--) { register const PERL_CONTEXT *cx = &cxstack[i]; @@ -1319,6 +1332,7 @@ S_dopoptoeval(pTHX_ I32 startingblock) STATIC I32 S_dopoptoloop(pTHX_ I32 startingblock) { + dVAR; I32 i; for (i = startingblock; i >= 0; i--) { register const PERL_CONTEXT * const cx = &cxstack[i]; @@ -1345,6 +1359,7 @@ S_dopoptoloop(pTHX_ I32 startingblock) STATIC I32 S_dopoptogiven(pTHX_ I32 startingblock) { + dVAR; I32 i; for (i = startingblock; i >= 0; i--) { register const PERL_CONTEXT *cx = &cxstack[i]; @@ -1367,6 +1382,7 @@ S_dopoptogiven(pTHX_ I32 startingblock) STATIC I32 S_dopoptowhen(pTHX_ I32 startingblock) { + dVAR; I32 i; for (i = startingblock; i >= 0; i--) { register const PERL_CONTEXT *cx = &cxstack[i]; @@ -1384,6 +1400,7 @@ S_dopoptowhen(pTHX_ I32 startingblock) void Perl_dounwind(pTHX_ I32 cxix) { + dVAR; I32 optype; while (cxstack_ix > cxix) { @@ -1420,6 +1437,7 @@ Perl_dounwind(pTHX_ I32 cxix) void Perl_qerror(pTHX_ SV *err) { + dVAR; if (PL_in_eval) sv_catsv(ERRSV, err); else if (PL_errors) @@ -1527,7 +1545,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen) PP(pp_xor) { - dSP; dPOPTOPssrl; + dVAR; dSP; dPOPTOPssrl; if (SvTRUE(left) != SvTRUE(right)) RETSETYES; else @@ -1536,6 +1554,7 @@ PP(pp_xor) PP(pp_caller) { + dVAR; dSP; register I32 cxix = dopoptosub(cxstack_ix); register const PERL_CONTEXT *cx; @@ -1700,6 +1719,7 @@ PP(pp_caller) PP(pp_reset) { + dVAR; dSP; const char * const tmps = (MAXARG < 1) ? "" : POPpconstx; sv_reset(tmps, CopSTASH(PL_curcop)); @@ -2203,6 +2223,7 @@ PP(pp_redo) STATIC OP * S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit) { + dVAR; OP **ops = opstack; static const char too_deep[] = "Target of goto is too deeply nested"; @@ -2607,6 +2628,7 @@ PP(pp_goto) PP(pp_exit) { + dVAR; dSP; I32 anum; @@ -2655,6 +2677,7 @@ S_save_lines(pTHX_ AV *array, SV *sv) STATIC void S_docatch_body(pTHX) { + dVAR; CALLRUNOPS(aTHX); return; } @@ -2662,6 +2685,7 @@ S_docatch_body(pTHX) STATIC OP * S_docatch(pTHX_ OP *o) { + dVAR; int ret; OP * const oldop = PL_op; dJMPENV; @@ -2819,6 +2843,7 @@ than in the scope of the debugger itself). CV* Perl_find_runcv(pTHX_ U32 *db_seqp) { + dVAR; PERL_SI *si; if (db_seqp) @@ -3669,6 +3694,7 @@ STATIC PMOP * S_make_matcher(pTHX_ regexp *re) { + dVAR; PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED); PM_SETRE(matcher, ReREFCNT_inc(re)); @@ -3682,6 +3708,7 @@ STATIC bool S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv) { + dVAR; dSP; PL_op = (OP *) matcher; @@ -3696,6 +3723,7 @@ STATIC void S_destroy_matcher(pTHX_ PMOP *matcher) { + dVAR; PERL_UNUSED_ARG(matcher); FREETMPS; LEAVE; @@ -3748,6 +3776,7 @@ STATIC OP * S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) { + dVAR; dSP; SV *e = TOPs; /* e is for 'expression' */ diff --git a/pp_hot.c b/pp_hot.c index dd4bdad..c48333a 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -37,6 +37,7 @@ PP(pp_const) { + dVAR; dSP; XPUSHs(cSVOP_sv); RETURN; @@ -44,6 +45,7 @@ PP(pp_const) PP(pp_nextstate) { + dVAR; PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -53,6 +55,7 @@ PP(pp_nextstate) PP(pp_gvsv) { + dVAR; dSP; EXTEND(SP,1); if (PL_op->op_private & OPpLVAL_INTRO) @@ -64,24 +67,27 @@ PP(pp_gvsv) PP(pp_null) { + dVAR; return NORMAL; } PP(pp_setstate) { + dVAR; PL_curcop = (COP*)PL_op; return NORMAL; } PP(pp_pushmark) { + dVAR; PUSHMARK(PL_stack_sp); return NORMAL; } PP(pp_stringify) { - dSP; dTARGET; + dVAR; dSP; dTARGET; sv_copypv(TARG,TOPs); SETTARG; RETURN; @@ -89,14 +95,14 @@ PP(pp_stringify) PP(pp_gv) { - dSP; + dVAR; dSP; XPUSHs((SV*)cGVOP_gv); RETURN; } PP(pp_and) { - dSP; + dVAR; dSP; if (!SvTRUE(TOPs)) RETURN; else { @@ -108,7 +114,7 @@ PP(pp_and) PP(pp_sassign) { - dSP; dPOPTOPssrl; + dVAR; dSP; dPOPTOPssrl; if (PL_op->op_private & OPpASSIGN_BACKWARDS) { SV * const temp = left; @@ -176,7 +182,7 @@ PP(pp_sassign) PP(pp_cond_expr) { - dSP; + dVAR; dSP; if (SvTRUEx(POPs)) RETURNOP(cLOGOP->op_other); else @@ -185,6 +191,7 @@ PP(pp_cond_expr) PP(pp_unstack) { + dVAR; I32 oldsave; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -196,7 +203,7 @@ PP(pp_unstack) PP(pp_concat) { - dSP; dATARGET; tryAMAGICbin(concat,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(concat,opASSIGN); { dPOPTOPssrl; bool lbyte; @@ -262,7 +269,7 @@ PP(pp_concat) PP(pp_padsv) { - dSP; dTARGET; + dVAR; dSP; dTARGET; XPUSHs(TARG); if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) @@ -278,6 +285,7 @@ PP(pp_padsv) PP(pp_readline) { + dVAR; tryAMAGICunTARGET(iter, 0); PL_last_in_gv = (GV*)(*PL_stack_sp--); if (SvTYPE(PL_last_in_gv) != SVt_PVGV) { @@ -296,7 +304,7 @@ PP(pp_readline) PP(pp_eq) { - dSP; tryAMAGICbinSET(eq,0); + dVAR; dSP; tryAMAGICbinSET(eq,0); #ifndef NV_PRESERVES_UV if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; @@ -363,7 +371,7 @@ PP(pp_eq) PP(pp_preinc) { - dSP; + dVAR; dSP; if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV) DIE(aTHX_ PL_no_modify); if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) @@ -380,7 +388,7 @@ PP(pp_preinc) PP(pp_or) { - dSP; + dVAR; dSP; if (SvTRUE(TOPs)) RETURN; else { @@ -392,7 +400,7 @@ PP(pp_or) PP(pp_defined) { - dSP; + dVAR; dSP; register SV* sv = NULL; bool defined = FALSE; const int op_type = PL_op->op_type; @@ -445,7 +453,7 @@ PP(pp_defined) PP(pp_add) { - dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); + dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); useleft = USE_LEFT(TOPm1s); #ifdef PERL_PRESERVE_IVUV /* We must see if we can perform the addition with integers if possible, @@ -607,7 +615,7 @@ PP(pp_add) PP(pp_aelemfast) { - dSP; + dVAR; dSP; AV * const av = PL_op->op_flags & OPf_SPECIAL ? (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv); const U32 lval = PL_op->op_flags & OPf_MOD; @@ -622,7 +630,7 @@ PP(pp_aelemfast) PP(pp_join) { - dSP; dMARK; dTARGET; + dVAR; dSP; dMARK; dTARGET; MARK++; do_join(TARG, *MARK, MARK, SP); SP = MARK; @@ -632,7 +640,7 @@ PP(pp_join) PP(pp_pushre) { - dSP; + dVAR; dSP; #ifdef DEBUGGING /* * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs @@ -749,7 +757,7 @@ PP(pp_print) PP(pp_rv2av) { - dSP; dTOPss; + dVAR; dSP; dTOPss; AV *av; if (SvROK(sv)) { @@ -875,7 +883,7 @@ PP(pp_rv2av) PP(pp_rv2hv) { - dSP; dTOPss; + dVAR; dSP; dTOPss; HV *hv; const I32 gimme = GIMME_V; static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context"; @@ -987,6 +995,7 @@ PP(pp_rv2hv) STATIC void S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) { + dVAR; if (*relem) { SV *tmpstr; const HE *didstore; @@ -1238,7 +1247,7 @@ PP(pp_aassign) PP(pp_qr) { - dSP; + dVAR; dSP; register PMOP * const pm = cPMOP; SV * const rv = sv_newmortal(); SV * const sv = newSVrv(rv, "Regexp"); @@ -1250,7 +1259,7 @@ PP(pp_qr) PP(pp_match) { - dSP; dTARG; + dVAR; dSP; dTARG; register PMOP *pm = cPMOP; PMOP *dynpm = pm; register const char *t; @@ -1738,7 +1747,7 @@ PP(pp_enter) PP(pp_helem) { - dSP; + dVAR; dSP; HE* he; SV **svp; SV * const keysv = POPs; @@ -1879,7 +1888,7 @@ PP(pp_leave) PP(pp_iter) { - dSP; + dVAR; dSP; register PERL_CONTEXT *cx; SV *sv, *oldsv; AV* av; @@ -2008,7 +2017,7 @@ PP(pp_iter) PP(pp_subst) { - dSP; dTARG; + dVAR; dSP; dTARG; register PMOP *pm = cPMOP; PMOP *rpm = pm; register SV *dstr; @@ -2626,6 +2635,7 @@ PP(pp_leavesublv) STATIC CV * S_get_db_sub(pTHX_ SV **svp, CV *cv) { + dVAR; SV * const dbsv = GvSVn(PL_DBsub); save_item(dbsv); @@ -2922,7 +2932,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv) PP(pp_aelem) { - dSP; + dVAR; dSP; SV** svp; SV* const elemsv = POPs; IV elem = SvIV(elemsv); @@ -3010,7 +3020,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) PP(pp_method) { - dSP; + dVAR; dSP; SV* const sv = TOPs; if (SvROK(sv)) { @@ -3027,7 +3037,7 @@ PP(pp_method) PP(pp_method_named) { - dSP; + dVAR; dSP; SV* const sv = cSVOP_sv; U32 hash = SvSHARED_HASH(sv); @@ -3038,6 +3048,7 @@ PP(pp_method_named) STATIC SV * S_method_common(pTHX_ SV* meth, U32* hashp) { + dVAR; SV* ob; GV* gv; HV* stash; diff --git a/pp_pack.c b/pp_pack.c index 3295720..72f8c0e 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -689,6 +689,7 @@ uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len STATIC bool next_uni_uu(pTHX_ const char **s, const char *end, I32 *out) { + dVAR; STRLEN retlen; const UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen, UTF8_CHECK_ONLY); if (val >= 0x100 || !ISUUCHAR(val) || @@ -2274,6 +2275,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c PP(pp_unpack) { + dVAR; dSP; dPOPPOPssrl; I32 gimme = GIMME_V; @@ -2424,6 +2426,7 @@ The engine implementing pack() Perl function. void Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist ) { + dVAR; STRLEN no_len; tempsym_t sym; @@ -2520,6 +2523,7 @@ STATIC SV ** S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) { + dVAR; tempsym_t lookahead; I32 items = endlist - beglist; bool found = next_symbol(symptr); @@ -3604,7 +3608,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) PP(pp_pack) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; register SV *cat = TARG; STRLEN fromlen; SV *pat_sv = *++MARK; diff --git a/pp_sort.c b/pp_sort.c index 0718ca2..7588625 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -341,12 +341,14 @@ typedef struct { static I32 cmp_desc(pTHX_ gptr a, gptr b) { + dVAR; return -PL_sort_RealCmp(aTHX_ a, b); } STATIC void S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags) { + dVAR; IV i, run, offset; I32 sense, level; register gptr *f1, *f2, *t, *b, *p; @@ -1314,6 +1316,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare) static I32 cmpindir(pTHX_ gptr a, gptr b) { + dVAR; gptr * const ap = (gptr *)a; gptr * const bp = (gptr *)b; const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp); @@ -1326,6 +1329,7 @@ cmpindir(pTHX_ gptr a, gptr b) static I32 cmpindir_desc(pTHX_ gptr a, gptr b) { + dVAR; gptr * const ap = (gptr *)a; gptr * const bp = (gptr *)b; const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp); @@ -1341,6 +1345,7 @@ cmpindir_desc(pTHX_ gptr a, gptr b) STATIC void S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags) { + dVAR; if ((flags & SORTf_STABLE) != 0) { register gptr **pp, *q; register size_t n, j, i; @@ -1842,6 +1847,7 @@ S_sv_i_ncmp(pTHX_ SV *a, SV *b) static I32 S_amagic_ncmp(pTHX_ register SV *a, register SV *b) { + dVAR; SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp); if (tmpsv) { if (SvIOK(tmpsv)) { @@ -1863,6 +1869,7 @@ S_amagic_ncmp(pTHX_ register SV *a, register SV *b) static I32 S_amagic_i_ncmp(pTHX_ register SV *a, register SV *b) { + dVAR; SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp); if (tmpsv) { if (SvIOK(tmpsv)) { @@ -1884,6 +1891,7 @@ S_amagic_i_ncmp(pTHX_ register SV *a, register SV *b) static I32 S_amagic_cmp(pTHX_ register SV *str1, register SV *str2) { + dVAR; SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp); if (tmpsv) { if (SvIOK(tmpsv)) { @@ -1905,6 +1913,7 @@ S_amagic_cmp(pTHX_ register SV *str1, register SV *str2) static I32 S_amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2) { + dVAR; SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp); if (tmpsv) { if (SvIOK(tmpsv)) { diff --git a/pp_sys.c b/pp_sys.c index eedabdb..c37c213 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -317,7 +317,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) PP(pp_backtick) { - dSP; dTARGET; + dVAR; dSP; dTARGET; PerlIO *fp; const char * const tmps = POPpconstx; const I32 gimme = GIMME_V; @@ -417,13 +417,14 @@ PP(pp_glob) PP(pp_rcatline) { + dVAR; PL_last_in_gv = cGVOP_gv; return do_readline(); } PP(pp_warn) { - dSP; dMARK; + dVAR; dSP; dMARK; SV *tmpsv; const char *tmps; STRLEN len; @@ -458,7 +459,7 @@ PP(pp_warn) PP(pp_die) { - dSP; dMARK; + dVAR; dSP; dMARK; const char *tmps; SV *tmpsv; STRLEN len; @@ -601,6 +602,7 @@ PP(pp_close) PP(pp_pipe_op) { #ifdef HAS_PIPE + dVAR; dSP; register IO *rstio; register IO *wstio; @@ -692,6 +694,7 @@ PP(pp_fileno) PP(pp_umask) { + dVAR; dSP; #ifdef HAS_UMASK dTARGET; @@ -903,6 +906,7 @@ PP(pp_untie) PP(pp_tied) { + dVAR; dSP; const MAGIC *mg; SV *sv = POPs; @@ -980,7 +984,7 @@ PP(pp_dbmopen) PP(pp_sselect) { #ifdef HAS_SELECT - dSP; dTARGET; + dVAR; dSP; dTARGET; register I32 i; register I32 j; register char *s; @@ -1145,6 +1149,7 @@ PP(pp_sselect) void Perl_setdefout(pTHX_ GV *gv) { + dVAR; if (gv) (void)SvREFCNT_inc(gv); if (PL_defoutgv) @@ -1154,7 +1159,7 @@ Perl_setdefout(pTHX_ GV *gv) PP(pp_select) { - dSP; dTARGET; + dVAR; dSP; dTARGET; HV *hv; GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL; GV * egv = GvEGV(PL_defoutgv); @@ -1252,6 +1257,7 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop) PP(pp_enterwrite) { + dVAR; dSP; register GV *gv; register IO *io; @@ -1494,6 +1500,7 @@ PP(pp_prtf) PP(pp_sysopen) { + dVAR; dSP; const int perm = (MAXARG > 3) ? POPi : 0666; const int mode = POPi; @@ -2055,6 +2062,7 @@ PP(pp_sysseek) PP(pp_truncate) { + dVAR; dSP; /* There seems to be no consensus on the length type of truncate() * and ftruncate(), both off_t and size_t have supporters. In @@ -2149,7 +2157,7 @@ PP(pp_truncate) PP(pp_ioctl) { - dSP; dTARGET; + dVAR; dSP; dTARGET; SV * const argsv = POPs; const unsigned int func = POPu; const int optype = PL_op->op_type; @@ -2225,7 +2233,7 @@ PP(pp_ioctl) PP(pp_flock) { #ifdef FLOCK - dSP; dTARGET; + dVAR; dSP; dTARGET; I32 value; IO *io = NULL; PerlIO *fp; @@ -2261,7 +2269,7 @@ PP(pp_flock) PP(pp_socket) { #ifdef HAS_SOCKET - dSP; + dVAR; dSP; const int protocol = POPi; const int type = POPi; const int domain = POPi; @@ -2311,7 +2319,7 @@ PP(pp_socket) PP(pp_sockpair) { #if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET)) - dSP; + dVAR; dSP; const int protocol = POPi; const int type = POPi; const int domain = POPi; @@ -2372,7 +2380,7 @@ PP(pp_sockpair) PP(pp_bind) { #ifdef HAS_SOCKET - dSP; + dVAR; dSP; #ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */ extern void GETPRIVMODE(); extern void GETUSERMODE(); @@ -2432,7 +2440,7 @@ nuts: PP(pp_connect) { #ifdef HAS_SOCKET - dSP; + dVAR; dSP; SV * const addrsv = POPs; GV * const gv = (GV*)POPs; register IO * const io = GvIOn(gv); @@ -2462,7 +2470,7 @@ nuts: PP(pp_listen) { #ifdef HAS_SOCKET - dSP; + dVAR; dSP; const int backlog = POPi; GV * const gv = (GV*)POPs; register IO * const io = gv ? GvIOn(gv) : NULL; @@ -2488,7 +2496,7 @@ nuts: PP(pp_accept) { #ifdef HAS_SOCKET - dSP; dTARGET; + dVAR; dSP; dTARGET; register IO *nstio; register IO *gstio; char namebuf[MAXPATHLEN]; @@ -2556,7 +2564,7 @@ badexit: PP(pp_shutdown) { #ifdef HAS_SOCKET - dSP; dTARGET; + dVAR; dSP; dTARGET; const int how = POPi; GV * const gv = (GV*)POPs; register IO * const io = GvIOn(gv); @@ -2580,7 +2588,7 @@ nuts: PP(pp_ssockopt) { #ifdef HAS_SOCKET - dSP; + dVAR; dSP; const int optype = PL_op->op_type; SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(NEWSV(22, 257)) : POPs; const unsigned int optname = (unsigned int) POPi; @@ -2657,7 +2665,7 @@ nuts2: PP(pp_getpeername) { #ifdef HAS_SOCKET - dSP; + dVAR; dSP; const int optype = PL_op->op_type; GV * const gv = (GV*)POPs; register IO * const io = GvIOn(gv); @@ -2722,6 +2730,7 @@ nuts2: PP(pp_stat) { + dVAR; dSP; GV *gv; I32 gimme; @@ -2851,6 +2860,7 @@ PP(pp_stat) PP(pp_ftrread) { + dVAR; I32 result; /* Not const, because things tweak this below. Not bool, because there's no guarantee that OPp_FT_ACCESS is <= CHAR_MAX */ @@ -2962,6 +2972,7 @@ PP(pp_ftrread) PP(pp_ftis) { + dVAR; I32 result; const int op_type = PL_op->op_type; dSP; @@ -3000,6 +3011,7 @@ PP(pp_ftis) PP(pp_ftrowned) { + dVAR; I32 result; dSP; @@ -3084,6 +3096,7 @@ PP(pp_ftrowned) PP(pp_ftlink) { + dVAR; I32 result = my_lstat(); dSP; if (result < 0) @@ -3095,6 +3108,7 @@ PP(pp_ftlink) PP(pp_fttty) { + dVAR; dSP; int fd; GV *gv; @@ -3137,6 +3151,7 @@ PP(pp_fttty) PP(pp_fttext) { + dVAR; dSP; I32 i; I32 len; @@ -3295,7 +3310,7 @@ PP(pp_fttext) PP(pp_chdir) { - dSP; dTARGET; + dVAR; dSP; dTARGET; const char *tmps = NULL; GV *gv = NULL; @@ -3372,7 +3387,7 @@ PP(pp_chdir) PP(pp_chown) { - dSP; dMARK; dTARGET; + dVAR; dSP; dMARK; dTARGET; const I32 value = (I32)apply(PL_op->op_type, MARK, SP); SP = MARK; @@ -3383,7 +3398,7 @@ PP(pp_chown) PP(pp_chroot) { #ifdef HAS_CHROOT - dSP; dTARGET; + dVAR; dSP; dTARGET; char * const tmps = POPpx; TAINT_PROPER("chroot"); PUSHi( chroot(tmps) >= 0 ); @@ -3395,7 +3410,7 @@ PP(pp_chroot) PP(pp_rename) { - dSP; dTARGET; + dVAR; dSP; dTARGET; int anum; const char * const tmps2 = POPpconstx; const char * const tmps = SvPV_nolen_const(TOPs); @@ -3421,7 +3436,7 @@ PP(pp_rename) #if defined(HAS_LINK) || defined(HAS_SYMLINK) PP(pp_link) { - dSP; dTARGET; + dVAR; dSP; dTARGET; const int op_type = PL_op->op_type; int result; @@ -3469,6 +3484,7 @@ PP(pp_link) PP(pp_readlink) { + dVAR; dSP; #ifdef HAS_SYMLINK dTARGET; @@ -3601,7 +3617,7 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename) PP(pp_mkdir) { - dSP; dTARGET; + dVAR; dSP; dTARGET; STRLEN len; const char *tmps; bool copy = FALSE; @@ -3628,7 +3644,7 @@ PP(pp_mkdir) PP(pp_rmdir) { - dSP; dTARGET; + dVAR; dSP; dTARGET; STRLEN len; const char *tmps; bool copy = FALSE; @@ -3650,7 +3666,7 @@ PP(pp_rmdir) PP(pp_open_dir) { #if defined(Direntry_t) && defined(HAS_READDIR) - dSP; + dVAR; dSP; const char * const dirname = POPpconstx; GV * const gv = (GV*)POPs; register IO * const io = GvIOn(gv); @@ -3681,6 +3697,7 @@ PP(pp_readdir) #if !defined(I_DIRENT) && !defined(VMS) Direntry_t *readdir (DIR *); #endif + dVAR; dSP; SV *sv; @@ -3765,7 +3782,7 @@ nope: PP(pp_seekdir) { #if defined(HAS_SEEKDIR) || defined(seekdir) - dSP; + dVAR; dSP; const long along = POPl; GV * const gv = (GV*)POPs; register IO * const io = GvIOn(gv); @@ -3792,7 +3809,7 @@ nope: PP(pp_rewinddir) { #if defined(HAS_REWINDDIR) || defined(rewinddir) - dSP; + dVAR; dSP; GV * const gv = (GV*)POPs; register IO * const io = GvIOn(gv); @@ -3817,7 +3834,7 @@ nope: PP(pp_closedir) { #if defined(Direntry_t) && defined(HAS_READDIR) - dSP; + dVAR; dSP; GV * const gv = (GV*)POPs; register IO * const io = GvIOn(gv); @@ -3853,7 +3870,7 @@ nope: PP(pp_fork) { #ifdef HAS_FORK - dSP; dTARGET; + dVAR; dSP; dTARGET; Pid_t childpid; EXTEND(SP, 1); @@ -3898,7 +3915,7 @@ PP(pp_fork) PP(pp_wait) { #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) - dSP; dTARGET; + dVAR; dSP; dTARGET; Pid_t childpid; int argflags; @@ -3926,7 +3943,7 @@ PP(pp_wait) PP(pp_waitpid) { #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) - dSP; dTARGET; + dVAR; dSP; dTARGET; const int optype = POPi; const Pid_t pid = TOPi; Pid_t result; @@ -3955,7 +3972,7 @@ PP(pp_waitpid) PP(pp_system) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; I32 value; int result; @@ -4084,7 +4101,7 @@ PP(pp_system) PP(pp_exec) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; I32 value; if (PL_tainting) { @@ -4136,7 +4153,7 @@ PP(pp_exec) PP(pp_getppid) { #ifdef HAS_GETPPID - dSP; dTARGET; + dVAR; dSP; dTARGET; # ifdef THREADS_HAVE_PIDS if (PL_ppid != 1 && getppid() == 1) /* maybe the parent process has died. Refresh ppid cache */ @@ -4154,7 +4171,7 @@ PP(pp_getppid) PP(pp_getpgrp) { #ifdef HAS_GETPGRP - dSP; dTARGET; + dVAR; dSP; dTARGET; Pid_t pgrp; const Pid_t pid = (MAXARG < 1) ? 0 : SvIVx(POPs); @@ -4175,7 +4192,7 @@ PP(pp_getpgrp) PP(pp_setpgrp) { #ifdef HAS_SETPGRP - dSP; dTARGET; + dVAR; dSP; dTARGET; Pid_t pgrp; Pid_t pid; if (MAXARG < 2) { @@ -4207,7 +4224,7 @@ PP(pp_setpgrp) PP(pp_getpriority) { #ifdef HAS_GETPRIORITY - dSP; dTARGET; + dVAR; dSP; dTARGET; const int who = POPi; const int which = TOPi; SETi( getpriority(which, who) ); @@ -4220,7 +4237,7 @@ PP(pp_getpriority) PP(pp_setpriority) { #ifdef HAS_SETPRIORITY - dSP; dTARGET; + dVAR; dSP; dTARGET; const int niceval = POPi; const int who = POPi; const int which = TOPi; @@ -4236,7 +4253,7 @@ PP(pp_setpriority) PP(pp_time) { - dSP; dTARGET; + dVAR; dSP; dTARGET; #ifdef BIG_TIME XPUSHn( time(Null(Time_t*)) ); #else @@ -4248,6 +4265,7 @@ PP(pp_time) PP(pp_tms) { #ifdef HAS_TIMES + dVAR; dSP; EXTEND(SP, 4); #ifndef VMS @@ -4324,6 +4342,7 @@ static struct tm *S_my_localtime (pTHX_ Time_t *tp) PP(pp_gmtime) { + dVAR; dSP; Time_t when; const struct tm *tmbuf; @@ -4386,7 +4405,7 @@ PP(pp_gmtime) PP(pp_alarm) { #ifdef HAS_ALARM - dSP; dTARGET; + dVAR; dSP; dTARGET; int anum; anum = POPi; anum = alarm((unsigned int)anum); @@ -4402,7 +4421,7 @@ PP(pp_alarm) PP(pp_sleep) { - dSP; dTARGET; + dVAR; dSP; dTARGET; I32 duration; Time_t lasttime; Time_t when; @@ -4425,7 +4444,7 @@ PP(pp_sleep) PP(pp_shmwrite) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - dSP; dMARK; dTARGET; + dVAR; dSP; dMARK; dTARGET; const int op_type = PL_op->op_type; I32 value; @@ -4457,7 +4476,7 @@ PP(pp_shmwrite) PP(pp_semget) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - dSP; dMARK; dTARGET; + dVAR; dSP; dMARK; dTARGET; const int anum = do_ipcget(PL_op->op_type, MARK, SP); SP = MARK; if (anum == -1) @@ -4472,7 +4491,7 @@ PP(pp_semget) PP(pp_semctl) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - dSP; dMARK; dTARGET; + dVAR; dSP; dMARK; dTARGET; const int anum = do_ipcctl(PL_op->op_type, MARK, SP); SP = MARK; if (anum == -1) @@ -4494,7 +4513,7 @@ PP(pp_semctl) PP(pp_ghostent) { #if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT) - dSP; + dVAR; dSP; I32 which = PL_op->op_type; register char **elem; register SV *sv; @@ -4592,7 +4611,7 @@ PP(pp_ghostent) PP(pp_gnetent) { #if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT) - dSP; + dVAR; dSP; I32 which = PL_op->op_type; register char **elem; register SV *sv; @@ -4674,7 +4693,7 @@ PP(pp_gnetent) PP(pp_gprotoent) { #if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT) - dSP; + dVAR; dSP; I32 which = PL_op->op_type; register char **elem; register SV *sv; @@ -4742,7 +4761,7 @@ PP(pp_gprotoent) PP(pp_gservent) { #if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT) - dSP; + dVAR; dSP; I32 which = PL_op->op_type; register char **elem; register SV *sv; @@ -4826,7 +4845,7 @@ PP(pp_gservent) PP(pp_shostent) { #ifdef HAS_SETHOSTENT - dSP; + dVAR; dSP; PerlSock_sethostent(TOPi); RETSETYES; #else @@ -4837,7 +4856,7 @@ PP(pp_shostent) PP(pp_snetent) { #ifdef HAS_SETNETENT - dSP; + dVAR; dSP; PerlSock_setnetent(TOPi); RETSETYES; #else @@ -4848,7 +4867,7 @@ PP(pp_snetent) PP(pp_sprotoent) { #ifdef HAS_SETPROTOENT - dSP; + dVAR; dSP; PerlSock_setprotoent(TOPi); RETSETYES; #else @@ -4859,7 +4878,7 @@ PP(pp_sprotoent) PP(pp_sservent) { #ifdef HAS_SETSERVENT - dSP; + dVAR; dSP; PerlSock_setservent(TOPi); RETSETYES; #else @@ -4870,7 +4889,7 @@ PP(pp_sservent) PP(pp_ehostent) { #ifdef HAS_ENDHOSTENT - dSP; + dVAR; dSP; PerlSock_endhostent(); EXTEND(SP,1); RETPUSHYES; @@ -4882,7 +4901,7 @@ PP(pp_ehostent) PP(pp_enetent) { #ifdef HAS_ENDNETENT - dSP; + dVAR; dSP; PerlSock_endnetent(); EXTEND(SP,1); RETPUSHYES; @@ -4894,7 +4913,7 @@ PP(pp_enetent) PP(pp_eprotoent) { #ifdef HAS_ENDPROTOENT - dSP; + dVAR; dSP; PerlSock_endprotoent(); EXTEND(SP,1); RETPUSHYES; @@ -4906,7 +4925,7 @@ PP(pp_eprotoent) PP(pp_eservent) { #ifdef HAS_ENDSERVENT - dSP; + dVAR; dSP; PerlSock_endservent(); EXTEND(SP,1); RETPUSHYES; @@ -4918,7 +4937,7 @@ PP(pp_eservent) PP(pp_gpwent) { #ifdef HAS_PASSWD - dSP; + dVAR; dSP; I32 which = PL_op->op_type; register SV *sv; struct passwd *pwent = NULL; @@ -5152,7 +5171,7 @@ PP(pp_gpwent) PP(pp_spwent) { #if defined(HAS_PASSWD) && defined(HAS_SETPWENT) - dSP; + dVAR; dSP; setpwent(); RETPUSHYES; #else @@ -5163,7 +5182,7 @@ PP(pp_spwent) PP(pp_epwent) { #if defined(HAS_PASSWD) && defined(HAS_ENDPWENT) - dSP; + dVAR; dSP; endpwent(); RETPUSHYES; #else @@ -5174,7 +5193,7 @@ PP(pp_epwent) PP(pp_ggrent) { #ifdef HAS_GROUP - dSP; + dVAR; dSP; I32 which = PL_op->op_type; register char **elem; register SV *sv; @@ -5246,7 +5265,7 @@ PP(pp_ggrent) PP(pp_sgrent) { #if defined(HAS_GROUP) && defined(HAS_SETGRENT) - dSP; + dVAR; dSP; setgrent(); RETPUSHYES; #else @@ -5257,7 +5276,7 @@ PP(pp_sgrent) PP(pp_egrent) { #if defined(HAS_GROUP) && defined(HAS_ENDGRENT) - dSP; + dVAR; dSP; endgrent(); RETPUSHYES; #else @@ -5268,7 +5287,7 @@ PP(pp_egrent) PP(pp_getlogin) { #ifdef HAS_GETLOGIN - dSP; dTARGET; + dVAR; dSP; dTARGET; char *tmps; EXTEND(SP, 1); if (!(tmps = PerlProc_getlogin())) @@ -5285,7 +5304,7 @@ PP(pp_getlogin) PP(pp_syscall) { #ifdef HAS_SYSCALL - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; register I32 items = SP - MARK; unsigned long a[20]; register I32 i = 0; diff --git a/regcomp.c b/regcomp.c index 67aec27..83b9015 100644 --- a/regcomp.c +++ b/regcomp.c @@ -1540,6 +1540,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, /* deltap: Write maxlen-minlen here. */ /* last: Stop before this one. */ { + dVAR; I32 min = 0, pars = 0, code; regnode *scan = *scanp, *next; I32 delta = 0; @@ -2767,6 +2768,7 @@ S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, const char *s) void Perl_reginitcolors(pTHX) { + dVAR; const char * const s = PerlEnv_getenv("PERL_RE_COLORS"); if (s) { char *t = savepv(s); @@ -2808,6 +2810,7 @@ Perl_reginitcolors(pTHX) regexp * Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) { + dVAR; register regexp *r; regnode *scan; regnode *first; @@ -3627,6 +3630,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) STATIC regnode * S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first) { + dVAR; register regnode *ret; register regnode *chain = NULL; register regnode *latest; @@ -3694,6 +3698,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first) STATIC regnode * S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) { + dVAR; register regnode *ret; register char op; register char *next; @@ -3871,6 +3876,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) STATIC regnode * S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) { + dVAR; register regnode *ret = NULL; I32 flags; char *parse_start = RExC_parse; @@ -4460,6 +4466,7 @@ S_regwhite(pTHX_ char *p, const char *e) STATIC I32 S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) { + dVAR; I32 namedclass = OOB_NAMEDCLASS; if (value == '[' && RExC_parse + 1 < RExC_end && @@ -4619,6 +4626,7 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) STATIC void S_checkposixcc(pTHX_ RExC_state_t *pRExC_state) { + dVAR; if (!SIZE_ONLY && POSIXCC(UCHARAT(RExC_parse))) { const char *s = RExC_parse; const char c = *s++; @@ -4646,6 +4654,7 @@ S_checkposixcc(pTHX_ RExC_state_t *pRExC_state) STATIC regnode * S_regclass(pTHX_ RExC_state_t *pRExC_state) { + dVAR; register UV value; register UV nextvalue; register IV prevvalue = OOB_UNICODE; @@ -5422,6 +5431,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) STATIC char* S_nextchar(pTHX_ RExC_state_t *pRExC_state) { + dVAR; char* retval = RExC_parse++; for (;;) { @@ -5456,6 +5466,7 @@ S_nextchar(pTHX_ RExC_state_t *pRExC_state) STATIC regnode * /* Location. */ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) { + dVAR; register regnode *ptr; regnode * const ret = RExC_emit; @@ -5491,6 +5502,7 @@ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) STATIC regnode * /* Location. */ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) { + dVAR; register regnode *ptr; regnode * const ret = RExC_emit; @@ -5527,6 +5539,7 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) STATIC void S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) { + dVAR; *lenp = SIZE_ONLY ? UNISKIP(uv) : (uvchr_to_utf8((U8*)s, uv) - (U8*)s); } @@ -5538,6 +5551,7 @@ S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) STATIC void S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd) { + dVAR; register regnode *src; register regnode *dst; register regnode *place; @@ -5596,6 +5610,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd) STATIC void S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) { + dVAR; register regnode *scan; if (SIZE_ONLY) @@ -5624,6 +5639,7 @@ S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) STATIC void S_regoptail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val) { + dVAR; /* "Operandless" and "op != BRANCH" are synonymous in practice. */ if (p == NULL || SIZE_ONLY) return; @@ -5666,6 +5682,7 @@ void Perl_regdump(pTHX_ regexp *r) { #ifdef DEBUGGING + dVAR; SV * const sv = sv_newmortal(); (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0); @@ -5769,6 +5786,7 @@ void Perl_regprop(pTHX_ SV *sv, const regnode *o) { #ifdef DEBUGGING + dVAR; register int k; sv_setpvn(sv, "", 0); @@ -5968,6 +5986,7 @@ Perl_regprop(pTHX_ SV *sv, const regnode *o) SV * Perl_re_intuit_string(pTHX_ regexp *prog) { /* Assume that RE_INTUIT is set */ + dVAR; GET_RE_DEBUG_FLAGS_DECL; DEBUG_COMPILE_r( { @@ -6113,6 +6132,7 @@ Perl_pregfree(pTHX_ struct regexp *r) regnode * Perl_regnext(pTHX_ register regnode *p) { + dVAR; register I32 offset; if (p == &PL_regdummy) @@ -6164,6 +6184,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...) void Perl_save_re_context(pTHX) { + dVAR; SAVEI32(PL_reg_flags); /* from regexec.c */ SAVEPPTR(PL_bostr); SAVEPPTR(PL_reginput); /* String-input pointer. */ @@ -6237,6 +6258,7 @@ Perl_save_re_context(pTHX) static void clear_re(pTHX_ void *r) { + dVAR; ReREFCNT_dec((regexp *)r); } @@ -6257,6 +6279,7 @@ S_put_byte(pTHX_ SV *sv, int c) STATIC regnode * S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) { + dVAR; register U8 op = EXACT; /* Arbitrary non-END op. */ register regnode *next; diff --git a/regexec.c b/regexec.c index de95e31..a65ded7 100644 --- a/regexec.c +++ b/regexec.c @@ -178,6 +178,7 @@ static void restore_pos(pTHX_ void *arg); STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor) { + dVAR; const int retval = PL_savestack_ix; #define REGCP_PAREN_ELEMS 4 const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS; @@ -222,6 +223,7 @@ S_regcppush(pTHX_ I32 parenfloor) STATIC char * S_regcppop(pTHX) { + dVAR; I32 i; U32 paren = 0; char *input; @@ -286,6 +288,7 @@ S_regcppop(pTHX) STATIC char * S_regcp_set_to(pTHX_ I32 ss) { + dVAR; const I32 tmp = PL_savestack_ix; PL_savestack_ix = ss; @@ -344,6 +347,7 @@ Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *stren STATIC void S_cache_re(pTHX_ regexp *prog) { + dVAR; PL_regprecomp = prog->precomp; /* Needed for FAIL. */ #ifdef DEBUGGING PL_regprogram = prog->program; @@ -403,6 +407,7 @@ char * Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, char *strend, U32 flags, re_scream_pos_data *data) { + dVAR; register I32 start_shift = 0; /* Should be nonnegative! */ register I32 end_shift = 0; @@ -1633,6 +1638,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * /* data: May be used for some additional optimizations. */ /* nosave: For optimizations. */ { + dVAR; register char *s; register regnode *c; register char *startpos = stringarg; @@ -2102,6 +2108,7 @@ phooey: STATIC I32 /* 0 failure, 1 success */ S_regtry(pTHX_ regexp *prog, char *startpos) { + dVAR; register I32 i; register I32 *sp; register I32 *ep; @@ -4601,6 +4608,7 @@ S_regrepeat(pTHX_ const regnode *p, I32 max) STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) { + dVAR; register char *scan = Nullch; register char *start; register char *loceol = PL_regeol; @@ -4651,6 +4659,7 @@ S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) SV * Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp) { + dVAR; SV *sw = NULL; SV *si = NULL; SV *alt = NULL; @@ -4826,12 +4835,14 @@ S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp STATIC U8 * S_reghop(pTHX_ U8 *s, I32 off) { + dVAR; return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)); } STATIC U8 * S_reghop3(pTHX_ U8 *s, I32 off, U8* lim) { + dVAR; if (off >= 0) { while (off-- && s < lim) { /* XXX could check well-formedness here */ @@ -4856,12 +4867,14 @@ S_reghop3(pTHX_ U8 *s, I32 off, U8* lim) STATIC U8 * S_reghopmaybe(pTHX_ U8 *s, I32 off) { + dVAR; return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)); } STATIC U8 * S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim) { + dVAR; if (off >= 0) { while (off-- && s < lim) { /* XXX could check well-formedness here */ @@ -4892,6 +4905,7 @@ S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim) static void restore_pos(pTHX_ void *arg) { + dVAR; PERL_UNUSED_ARG(arg); if (PL_reg_eval_set) { if (PL_reg_oldsaved) { @@ -4934,6 +4948,7 @@ S_to_utf8_substr(pTHX_ register regexp *prog) STATIC void S_to_byte_substr(pTHX_ register regexp *prog) { + dVAR; if (prog->float_utf8 && !prog->float_substr) { SV* sv; prog->float_substr = sv = newSVsv(prog->float_utf8); diff --git a/run.c b/run.c index 95bc676..c700bb9 100644 --- a/run.c +++ b/run.c @@ -34,6 +34,7 @@ int Perl_runops_standard(pTHX) { + dVAR; while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) { PERL_ASYNC_CHECK(); } diff --git a/scope.c b/scope.c index 6a862a4..14f7884 100644 --- a/scope.c +++ b/scope.c @@ -27,6 +27,7 @@ SV** Perl_stack_grow(pTHX_ SV **sp, SV **p, int n) { + dVAR; PL_stack_sp = sp; #ifndef STRESS_REALLOC av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128); @@ -45,6 +46,7 @@ Perl_stack_grow(pTHX_ SV **sp, SV **p, int n) PERL_SI * Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) { + dVAR; PERL_SI *si; Newx(si, 1, PERL_SI); si->si_stack = newAV(); @@ -67,6 +69,7 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) I32 Perl_cxinc(pTHX) { + dVAR; const IV old_max = cxstack_max; cxstack_max = GROW(cxstack_max); Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */ @@ -79,6 +82,7 @@ Perl_cxinc(pTHX) void Perl_push_scope(pTHX) { + dVAR; if (PL_scopestack_ix == PL_scopestack_max) { PL_scopestack_max = GROW(PL_scopestack_max); Renew(PL_scopestack, PL_scopestack_max, I32); @@ -90,6 +94,7 @@ Perl_push_scope(pTHX) void Perl_pop_scope(pTHX) { + dVAR; const I32 oldsave = PL_scopestack[--PL_scopestack_ix]; LEAVE_SCOPE(oldsave); } @@ -97,6 +102,7 @@ Perl_pop_scope(pTHX) void Perl_markstack_grow(pTHX) { + dVAR; const I32 oldmax = PL_markstack_max - PL_markstack; const I32 newmax = GROW(oldmax); @@ -108,6 +114,7 @@ Perl_markstack_grow(pTHX) void Perl_savestack_grow(pTHX) { + dVAR; PL_savestack_max = GROW(PL_savestack_max) + 4; Renew(PL_savestack, PL_savestack_max, ANY); } @@ -115,6 +122,7 @@ Perl_savestack_grow(pTHX) void Perl_savestack_grow_cnt(pTHX_ I32 need) { + dVAR; PL_savestack_max = PL_savestack_ix + need; Renew(PL_savestack, PL_savestack_max, ANY); } @@ -124,6 +132,7 @@ Perl_savestack_grow_cnt(pTHX_ I32 need) void Perl_tmps_grow(pTHX_ I32 n) { + dVAR; #ifndef STRESS_REALLOC if (n < 128) n = (PL_tmps_max < 512) ? 128 : 512; @@ -136,6 +145,7 @@ Perl_tmps_grow(pTHX_ I32 n) void Perl_free_tmps(pTHX) { + dVAR; /* XXX should tmps_floor live in cxstack? */ const I32 myfloor = PL_tmps_floor; while (PL_tmps_ix > myfloor) { /* clean up after last statement */ @@ -151,6 +161,7 @@ Perl_free_tmps(pTHX) STATIC SV * S_save_scalar_at(pTHX_ SV **sptr) { + dVAR; SV * const osv = *sptr; register SV * const sv = *sptr = NEWSV(0,0); @@ -169,6 +180,7 @@ S_save_scalar_at(pTHX_ SV **sptr) SV * Perl_save_scalar(pTHX_ GV *gv) { + dVAR; SV ** const sptr = &GvSV(gv); PL_localizing = 1; SvGETMAGIC(*sptr); @@ -183,6 +195,7 @@ Perl_save_scalar(pTHX_ GV *gv) SV* Perl_save_svref(pTHX_ SV **sptr) { + dVAR; SvGETMAGIC(*sptr); SSCHECK(3); SSPUSHPTR(sptr); @@ -196,6 +209,7 @@ Perl_save_svref(pTHX_ SV **sptr) void Perl_save_generic_svref(pTHX_ SV **sptr) { + dVAR; SSCHECK(3); SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); @@ -208,6 +222,7 @@ Perl_save_generic_svref(pTHX_ SV **sptr) void Perl_save_generic_pvref(pTHX_ char **str) { + dVAR; SSCHECK(3); SSPUSHPTR(str); SSPUSHPTR(*str); @@ -220,6 +235,7 @@ Perl_save_generic_pvref(pTHX_ char **str) void Perl_save_shared_pvref(pTHX_ char **str) { + dVAR; SSCHECK(3); SSPUSHPTR(str); SSPUSHPTR(*str); @@ -231,6 +247,7 @@ Perl_save_shared_pvref(pTHX_ char **str) void Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val) { + dVAR; SSCHECK(4); SSPUSHPTR(sv); SSPUSHINT(mask); @@ -241,6 +258,7 @@ Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val) void Perl_save_gp(pTHX_ GV *gv, I32 empty) { + dVAR; SSGROW(6); SSPUSHIV((IV)SvLEN(gv)); SvLEN_set(gv, 0); /* forget that anything was allocated here */ @@ -279,6 +297,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) AV * Perl_save_ary(pTHX_ GV *gv) { + dVAR; AV * const oav = GvAVn(gv); AV *av; @@ -299,6 +318,7 @@ Perl_save_ary(pTHX_ GV *gv) HV * Perl_save_hash(pTHX_ GV *gv) { + dVAR; HV *ohv, *hv; SSCHECK(3); @@ -316,6 +336,7 @@ Perl_save_hash(pTHX_ GV *gv) void Perl_save_item(pTHX_ register SV *item) { + dVAR; register SV * const sv = newSVsv(item); SSCHECK(3); @@ -327,6 +348,7 @@ Perl_save_item(pTHX_ register SV *item) void Perl_save_int(pTHX_ int *intp) { + dVAR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -336,6 +358,7 @@ Perl_save_int(pTHX_ int *intp) void Perl_save_long(pTHX_ long int *longp) { + dVAR; SSCHECK(3); SSPUSHLONG(*longp); SSPUSHPTR(longp); @@ -345,6 +368,7 @@ Perl_save_long(pTHX_ long int *longp) void Perl_save_bool(pTHX_ bool *boolp) { + dVAR; SSCHECK(3); SSPUSHBOOL(*boolp); SSPUSHPTR(boolp); @@ -354,6 +378,7 @@ Perl_save_bool(pTHX_ bool *boolp) void Perl_save_I32(pTHX_ I32 *intp) { + dVAR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -363,6 +388,7 @@ Perl_save_I32(pTHX_ I32 *intp) void Perl_save_I16(pTHX_ I16 *intp) { + dVAR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -372,6 +398,7 @@ Perl_save_I16(pTHX_ I16 *intp) void Perl_save_I8(pTHX_ I8 *bytep) { + dVAR; SSCHECK(3); SSPUSHINT(*bytep); SSPUSHPTR(bytep); @@ -381,6 +408,7 @@ Perl_save_I8(pTHX_ I8 *bytep) void Perl_save_iv(pTHX_ IV *ivp) { + dVAR; SSCHECK(3); SSPUSHIV(*ivp); SSPUSHPTR(ivp); @@ -393,6 +421,7 @@ Perl_save_iv(pTHX_ IV *ivp) void Perl_save_pptr(pTHX_ char **pptr) { + dVAR; SSCHECK(3); SSPUSHPTR(*pptr); SSPUSHPTR(pptr); @@ -402,6 +431,7 @@ Perl_save_pptr(pTHX_ char **pptr) void Perl_save_vptr(pTHX_ void *ptr) { + dVAR; SSCHECK(3); SSPUSHPTR(*(char**)ptr); SSPUSHPTR(ptr); @@ -411,6 +441,7 @@ Perl_save_vptr(pTHX_ void *ptr) void Perl_save_sptr(pTHX_ SV **sptr) { + dVAR; SSCHECK(3); SSPUSHPTR(*sptr); SSPUSHPTR(sptr); @@ -420,6 +451,7 @@ Perl_save_sptr(pTHX_ SV **sptr) void Perl_save_padsv(pTHX_ PADOFFSET off) { + dVAR; SSCHECK(4); ASSERT_CURPAD_ACTIVE("save_padsv"); SSPUSHPTR(PL_curpad[off]); @@ -431,6 +463,7 @@ Perl_save_padsv(pTHX_ PADOFFSET off) SV ** Perl_save_threadsv(pTHX_ PADOFFSET i) { + dVAR; Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl"); PERL_UNUSED_ARG(i); NORETURN_FUNCTION_END; @@ -439,6 +472,7 @@ Perl_save_threadsv(pTHX_ PADOFFSET i) void Perl_save_nogv(pTHX_ GV *gv) { + dVAR; SSCHECK(2); SSPUSHPTR(gv); SSPUSHINT(SAVEt_NSTAB); @@ -447,6 +481,7 @@ Perl_save_nogv(pTHX_ GV *gv) void Perl_save_hptr(pTHX_ HV **hptr) { + dVAR; SSCHECK(3); SSPUSHPTR(*hptr); SSPUSHPTR(hptr); @@ -456,6 +491,7 @@ Perl_save_hptr(pTHX_ HV **hptr) void Perl_save_aptr(pTHX_ AV **aptr) { + dVAR; SSCHECK(3); SSPUSHPTR(*aptr); SSPUSHPTR(aptr); @@ -465,6 +501,7 @@ Perl_save_aptr(pTHX_ AV **aptr) void Perl_save_freesv(pTHX_ SV *sv) { + dVAR; SSCHECK(2); SSPUSHPTR(sv); SSPUSHINT(SAVEt_FREESV); @@ -473,6 +510,7 @@ Perl_save_freesv(pTHX_ SV *sv) void Perl_save_mortalizesv(pTHX_ SV *sv) { + dVAR; SSCHECK(2); SSPUSHPTR(sv); SSPUSHINT(SAVEt_MORTALIZESV); @@ -481,6 +519,7 @@ Perl_save_mortalizesv(pTHX_ SV *sv) void Perl_save_freeop(pTHX_ OP *o) { + dVAR; SSCHECK(2); SSPUSHPTR(o); SSPUSHINT(SAVEt_FREEOP); @@ -489,6 +528,7 @@ Perl_save_freeop(pTHX_ OP *o) void Perl_save_freepv(pTHX_ char *pv) { + dVAR; SSCHECK(2); SSPUSHPTR(pv); SSPUSHINT(SAVEt_FREEPV); @@ -497,6 +537,7 @@ Perl_save_freepv(pTHX_ char *pv) void Perl_save_clearsv(pTHX_ SV **svp) { + dVAR; ASSERT_CURPAD_ACTIVE("save_clearsv"); SSCHECK(2); SSPUSHLONG((long)(svp-PL_curpad)); @@ -507,6 +548,7 @@ Perl_save_clearsv(pTHX_ SV **svp) void Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen) { + dVAR; SSCHECK(4); SSPUSHINT(klen); SSPUSHPTR(key); @@ -517,6 +559,7 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen) void Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg) { + dVAR; register I32 i; for (i = 1; i <= maxsarg; i++) { @@ -532,6 +575,7 @@ Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg) void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) { + dVAR; SSCHECK(3); SSPUSHDPTR(f); SSPUSHPTR(p); @@ -541,6 +585,7 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) { + dVAR; SSCHECK(3); SSPUSHDXPTR(f); SSPUSHPTR(p); @@ -550,6 +595,7 @@ Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) void Perl_save_aelem(pTHX_ const AV *av, I32 idx, SV **sptr) { + dVAR; SV *sv; SvGETMAGIC(*sptr); SSCHECK(4); @@ -573,6 +619,7 @@ Perl_save_aelem(pTHX_ const AV *av, I32 idx, SV **sptr) void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) { + dVAR; SV *sv; SvGETMAGIC(*sptr); SSCHECK(4); @@ -593,6 +640,7 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) void Perl_save_op(pTHX) { + dVAR; SSCHECK(2); SSPUSHPTR(PL_op); SSPUSHINT(SAVEt_OP); @@ -601,6 +649,7 @@ Perl_save_op(pTHX) I32 Perl_save_alloc(pTHX_ I32 size, I32 pad) { + dVAR; register const I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix] - (char*)PL_savestack); register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack)); @@ -618,6 +667,7 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad) void Perl_leave_scope(pTHX_ I32 base) { + dVAR; register SV *sv; register SV *value; register GV *gv; @@ -987,6 +1037,7 @@ Perl_leave_scope(pTHX_ I32 base) void Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) { + dVAR; #ifdef DEBUGGING PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]); if (CxTYPE(cx) != CXt_SUBST) { diff --git a/sv.c b/sv.c index e6690c1..d0234cd 100644 --- a/sv.c +++ b/sv.c @@ -177,6 +177,7 @@ Public API: void Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size) { + dVAR; void *new_chunk; U32 new_chunk_size; LOCK_SV_MUTEX; @@ -236,6 +237,7 @@ Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size) STATIC SV* S_more_sv(pTHX) { + dVAR; SV* sv; if (PL_nice_chunk) { @@ -314,6 +316,7 @@ S_new_SV(pTHX) STATIC void S_del_sv(pTHX_ SV *p) { + dVAR; if (DEBUG_D_TEST) { SV* sva; bool ok = 0; @@ -357,6 +360,7 @@ and split it into a list of free SVs. void Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags) { + dVAR; SV* const sva = (SV*)ptr; register SV* sv; register SV* svend; @@ -394,6 +398,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags) STATIC I32 S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask) { + dVAR; SV* sva; I32 visited = 0; @@ -448,6 +453,7 @@ Perl_sv_report_used(pTHX) static void do_clean_objs(pTHX_ SV *ref) { + dVAR; if (SvROK(ref)) { SV * const target = SvRV(ref); if (SvOBJECT(target)) { @@ -473,6 +479,7 @@ do_clean_objs(pTHX_ SV *ref) static void do_clean_named_objs(pTHX_ SV *sv) { + dVAR; if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) { if (( #ifdef PERL_DONT_CREATE_GVSV @@ -503,6 +510,7 @@ Attempt to destroy all objects not yet freed void Perl_sv_clean_objs(pTHX) { + dVAR; PL_in_clean_objs = TRUE; visit(do_clean_objs, SVf_ROK, SVf_ROK); #ifndef DISABLE_DESTRUCTOR_KLUDGE @@ -517,6 +525,7 @@ Perl_sv_clean_objs(pTHX) static void do_clean_all(pTHX_ SV *sv) { + dVAR; DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) )); SvFLAGS(sv) |= SVf_BREAK; if (PL_comppad == (AV*)sv) { @@ -539,6 +548,7 @@ SVs which are in complex self-referential hierarchies. I32 Perl_sv_clean_all(pTHX) { + dVAR; I32 cleaned; PL_in_clean_all = TRUE; cleaned = visit(do_clean_all, 0,0); @@ -573,6 +583,7 @@ heads and bodies within the arenas must already have been freed. void Perl_sv_free_arenas(pTHX) { + dVAR; SV* sva; SV* svanext; int i; @@ -640,6 +651,7 @@ Perl_sv_free_arenas(pTHX) STATIC void * S_more_bodies (pTHX_ size_t size, svtype sv_type) { + dVAR; void ** const arena_root = &PL_body_arenaroots[sv_type]; void ** const root = &PL_body_roots[sv_type]; char *start; @@ -693,6 +705,7 @@ S_more_bodies (pTHX_ size_t size, svtype sv_type) STATIC void * S_new_body(pTHX_ size_t size, svtype sv_type) { + dVAR; void *xpv; new_body_inline(xpv, size, sv_type); return xpv; @@ -930,6 +943,7 @@ You generally want to use the C macro wrapper. See also C. void Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type) { + dVAR; void* old_body; void* new_body; const U32 old_type = SvTYPE(sv); @@ -1255,6 +1269,7 @@ Does not handle 'set' magic. See also C. void Perl_sv_setiv(pTHX_ register SV *sv, IV i) { + dVAR; SV_CHECK_THINKFIRST_COW_DROP(sv); switch (SvTYPE(sv)) { case SVt_NULL: @@ -1355,6 +1370,7 @@ Does not handle 'set' magic. See also C. void Perl_sv_setnv(pTHX_ register SV *sv, NV num) { + dVAR; SV_CHECK_THINKFIRST_COW_DROP(sv); switch (SvTYPE(sv)) { case SVt_NULL: @@ -1403,6 +1419,7 @@ Perl_sv_setnv_mg(pTHX_ register SV *sv, NV num) STATIC void S_not_a_number(pTHX_ SV *sv) { + dVAR; SV *dsv; char tmpbuf[64]; const char *pv; @@ -1584,6 +1601,7 @@ Perl_looks_like_number(pTHX_ SV *sv) STATIC int S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype) { + dVAR; DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%"NVgf" inttype=%"UVXf"\n", SvPVX_const(sv), SvIVX(sv), SvNVX(sv), (UV)numtype)); if (SvNVX(sv) < (NV)IV_MIN) { (void)SvIOKp_on(sv); @@ -1630,6 +1648,7 @@ S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype) STATIC bool S_sv_2iuv_common(pTHX_ SV *sv) { + dVAR; if (SvNOKp(sv)) { /* erm. not sure. *should* never get NOKp (without NOK) from sv_2nv * without also getting a cached IV/UV from it at the same time @@ -1881,6 +1900,7 @@ Normally used via the C and C macros. IV Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags) { + dVAR; if (!sv) return 0; if (SvGMAGICAL(sv)) { @@ -1960,6 +1980,7 @@ Normally used via the C and C macros. UV Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags) { + dVAR; if (!sv) return 0; if (SvGMAGICAL(sv)) { @@ -2034,6 +2055,7 @@ macros. NV Perl_sv_2nv(pTHX_ register SV *sv) { + dVAR; if (!sv) return 0.0; if (SvGMAGICAL(sv)) { @@ -2263,6 +2285,7 @@ S_uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob) static char * S_stringify_regexp(pTHX_ SV *sv, MAGIC *mg, STRLEN *lp) { + dVAR; const regexp * const re = (regexp *)mg->mg_obj; if (!mg->mg_ptr) { @@ -2352,6 +2375,7 @@ usually end up here too. char * Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) { + dVAR; register char *s; if (!sv) { @@ -2638,6 +2662,7 @@ sv_true() or its macro equivalent. bool Perl_sv_2bool(pTHX_ register SV *sv) { + dVAR; SvGETMAGIC(sv); if (!SvOK(sv)) @@ -2701,6 +2726,7 @@ use the Encode extension for that. STRLEN Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags) { + dVAR; if (sv == &PL_sv_undef) return 0; if (!SvPOK(sv)) { @@ -2770,6 +2796,7 @@ use the Encode extension for that. bool Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok) { + dVAR; if (SvPOKp(sv) && SvUTF8(sv)) { if (SvCUR(sv)) { U8 *s; @@ -2900,6 +2927,7 @@ copy-ish functions and macros use this underneath. void Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) { + dVAR; register U32 sflags; register int dtype; register int stype; @@ -3531,6 +3559,7 @@ undefined. Does not handle 'set' magic. See C. void Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len) { + dVAR; register char *dptr; SV_CHECK_THINKFIRST_COW_DROP(sv); @@ -3581,6 +3610,7 @@ handle 'set' magic. See C. void Perl_sv_setpv(pTHX_ register SV *sv, register const char *ptr) { + dVAR; register STRLEN len; SV_CHECK_THINKFIRST_COW_DROP(sv); @@ -3630,6 +3660,7 @@ See C. void Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len) { + dVAR; STRLEN allocate; SV_CHECK_THINKFIRST_COW_DROP(sv); SvUPGRADE(sv, SVt_PV); @@ -3731,6 +3762,7 @@ with flags set to 0. void Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) { + dVAR; #ifdef PERL_OLD_COPY_ON_WRITE if (SvREADONLY(sv)) { /* At this point I believe I should acquire a global SV mutex. */ @@ -3860,6 +3892,7 @@ in terms of this function. void Perl_sv_catpvn_flags(pTHX_ register SV *dsv, register const char *sstr, register STRLEN slen, I32 flags) { + dVAR; STRLEN dlen; const char * const dstr = SvPV_force_flags(dsv, dlen, flags); @@ -3894,6 +3927,7 @@ and C are implemented in terms of this function. void Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags) { + dVAR; if (ssv) { STRLEN slen; const char *spv = SvPV_const(ssv, slen); @@ -3942,6 +3976,7 @@ valid UTF-8. Handles 'get' magic, but not 'set' magic. See C. void Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr) { + dVAR; register STRLEN len; STRLEN tlen; char *junk; @@ -3987,6 +4022,7 @@ macro. SV * Perl_newSV(pTHX_ STRLEN len) { + dVAR; register SV *sv; new_SV(sv); @@ -4019,6 +4055,7 @@ MAGIC * Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable, const char* name, I32 namlen) { + dVAR; MAGIC* mg; if (SvTYPE(sv) < SVt_PVMG) { @@ -4103,6 +4140,7 @@ to add more than one instance of the same 'how'. void Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen) { + dVAR; const MGVTBL *vtable; MAGIC* mg; @@ -4353,6 +4391,7 @@ Perl_sv_rvweaken(pTHX_ SV *sv) void Perl_sv_add_backref(pTHX_ SV *tsv, SV *sv) { + dVAR; AV *av; if (SvTYPE(tsv) == SVt_PVHV) { @@ -4406,6 +4445,7 @@ Perl_sv_add_backref(pTHX_ SV *tsv, SV *sv) STATIC void S_sv_del_backref(pTHX_ SV *tsv, SV *sv) { + dVAR; AV *av = NULL; SV **svp; I32 i; @@ -4505,6 +4545,7 @@ the Perl substr() function. void Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little, STRLEN littlelen) { + dVAR; register char *big; register char *mid; register char *midend; @@ -4602,6 +4643,7 @@ time you'll want to use C or one of its many macro front-ends. void Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) { + dVAR; const U32 refcnt = SvREFCNT(sv); SV_CHECK_THINKFIRST_COW_DROP(sv); if (SvREFCNT(nsv) != 1) { @@ -5388,6 +5430,7 @@ coerce its args to strings if necessary. I32 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) { + dVAR; const char *pv1; STRLEN cur1; const char *pv2; @@ -5483,6 +5526,7 @@ coerce its args to strings if necessary. See also C. I32 Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2) { + dVAR; STRLEN cur1, cur2; const char *pv1, *pv2; char *tpv = Nullch; @@ -5566,6 +5610,7 @@ if necessary. See also C. See also C. I32 Perl_sv_cmp_locale(pTHX_ register SV *sv1, register SV *sv2) { + dVAR; #ifdef USE_LOCALE_COLLATE char *pv1, *pv2; @@ -5630,6 +5675,7 @@ settings. char * Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp) { + dVAR; MAGIC *mg; mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_collxfrm) : (MAGIC *) NULL; @@ -5686,6 +5732,7 @@ appending to the currently-stored string. char * Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) { + dVAR; const char *rsptr; STRLEN rslen; register STDCHAR rslast; @@ -6041,6 +6088,7 @@ if necessary. Handles 'get' magic. void Perl_sv_inc(pTHX_ register SV *sv) { + dVAR; register char *d; int flags; @@ -6197,6 +6245,7 @@ if necessary. Handles 'get' magic. void Perl_sv_dec(pTHX_ register SV *sv) { + dVAR; int flags; if (!sv) @@ -6313,6 +6362,7 @@ statement boundaries. See also C and C. SV * Perl_sv_mortalcopy(pTHX_ SV *oldstr) { + dVAR; register SV *sv; new_SV(sv); @@ -6337,6 +6387,7 @@ See also C and C. SV * Perl_sv_newmortal(pTHX) { + dVAR; register SV *sv; new_SV(sv); @@ -6385,6 +6436,7 @@ strlen(). For efficiency, consider using C instead. SV * Perl_newSVpv(pTHX_ const char *s, STRLEN len) { + dVAR; register SV *sv; new_SV(sv); @@ -6406,6 +6458,7 @@ C bytes long. If the C argument is NULL the new SV will be undefined. SV * Perl_newSVpvn(pTHX_ const char *s, STRLEN len) { + dVAR; register SV *sv; new_SV(sv); @@ -6427,6 +6480,7 @@ SV if the hek is NULL. SV * Perl_newSVhek(pTHX_ const HEK *hek) { + dVAR; if (!hek) { SV *sv; @@ -6485,6 +6539,7 @@ hash lookup will avoid string compare. SV * Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash) { + dVAR; register SV *sv; bool is_utf8 = FALSE; if (len < 0) { @@ -6555,6 +6610,7 @@ Perl_newSVpvf(pTHX_ const char* pat, ...) SV * Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args) { + dVAR; register SV *sv; new_SV(sv); sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); @@ -6573,6 +6629,7 @@ The reference count for the SV is set to 1. SV * Perl_newSVnv(pTHX_ NV n) { + dVAR; register SV *sv; new_SV(sv); @@ -6592,6 +6649,7 @@ SV is set to 1. SV * Perl_newSViv(pTHX_ IV i) { + dVAR; register SV *sv; new_SV(sv); @@ -6611,6 +6669,7 @@ The reference count for the SV is set to 1. SV * Perl_newSVuv(pTHX_ UV u) { + dVAR; register SV *sv; new_SV(sv); @@ -6630,6 +6689,7 @@ SV is B incremented. SV * Perl_newRV_noinc(pTHX_ SV *tmpRef) { + dVAR; register SV *sv; new_SV(sv); @@ -6647,6 +6707,7 @@ Perl_newRV_noinc(pTHX_ SV *tmpRef) SV * Perl_newRV(pTHX_ SV *tmpRef) { + dVAR; return newRV_noinc(SvREFCNT_inc(tmpRef)); } @@ -6662,6 +6723,7 @@ Creates a new SV which is an exact duplicate of the original SV. SV * Perl_newSVsv(pTHX_ register SV *old) { + dVAR; register SV *sv; if (!old) @@ -6964,7 +7026,7 @@ C and C char * Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) { - + dVAR; if (SvTHINKFIRST(sv) && !SvROK(sv)) sv_force_normal_flags(sv, 0); @@ -7162,6 +7224,7 @@ reference count is 1. SV* Perl_newSVrv(pTHX_ SV *rv, const char *classname) { + dVAR; SV *sv; new_SV(sv); @@ -7217,6 +7280,7 @@ Note that C copies the string while this copies the pointer. SV* Perl_sv_setref_pv(pTHX_ SV *rv, const char *classname, void *pv) { + dVAR; if (!pv) { sv_setsv(rv, &PL_sv_undef); SvSETMAGIC(rv); @@ -7318,6 +7382,7 @@ of the SV is unaffected. SV* Perl_sv_bless(pTHX_ SV *sv, HV *stash) { + dVAR; SV *tmpRef; if (!SvROK(sv)) Perl_croak(aTHX_ "Can't bless non-reference value"); @@ -7357,6 +7422,7 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash) STATIC void S_sv_unglob(pTHX_ SV *sv) { + dVAR; void *xpvmg; assert(SvTYPE(sv) == SVt_PVGV); @@ -7714,6 +7780,7 @@ Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV STATIC I32 S_expect_number(pTHX_ char** pattern) { + dVAR; I32 var = 0; switch (**pattern) { case '1': case '2': case '3': @@ -7781,6 +7848,7 @@ Usually used via one of its frontends C and C. void Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted) { + dVAR; char *p; char *q; const char *patend; @@ -11100,6 +11168,7 @@ S_find_hash_subscript(pTHX_ HV *hv, SV* val) STATIC I32 S_find_array_subscript(pTHX_ AV *av, SV* val) { + dVAR; SV** svp; I32 i; if (!av || SvMAGICAL(av) || !AvARRAY(av) || @@ -11506,6 +11575,7 @@ Print appropriate "Use of uninitialized variable" warning void Perl_report_uninit(pTHX_ SV* uninit_sv) { + dVAR; if (PL_op) { SV* varname = Nullsv; if (uninit_sv) { diff --git a/taint.c b/taint.c index 9de7748..efe5dc4 100644 --- a/taint.c +++ b/taint.c @@ -25,6 +25,7 @@ void Perl_taint_proper(pTHX_ const char *f, const char *s) { #if defined(HAS_SETEUID) && defined(DEBUGGING) + dVAR; # if Uid_t_size == 1 { const UV uid = PL_uid; @@ -72,6 +73,7 @@ Perl_taint_proper(pTHX_ const char *f, const char *s) void Perl_taint_env(pTHX) { + dVAR; SV** svp; MAGIC* mg; const char* const *e; diff --git a/toke.c b/toke.c index 6280145..139a121 100644 --- a/toke.c +++ b/toke.c @@ -283,6 +283,7 @@ static struct debug_tokens { const int token, type; const char *name; } STATIC int S_tokereport(pTHX_ I32 rv) { + dVAR; if (DEBUG_T_TEST) { const char *name = Nullch; enum token_type type = TOKENTYPE_NONE; @@ -360,6 +361,7 @@ S_printbuf(pTHX_ const char* fmt, const char* s) STATIC int S_ao(pTHX_ int toketype) { + dVAR; if (*PL_bufptr == '=') { PL_bufptr++; if (toketype == ANDAND) @@ -389,6 +391,7 @@ S_ao(pTHX_ int toketype) STATIC void S_no_op(pTHX_ const char *what, char *s) { + dVAR; char * const oldbp = PL_bufptr; const bool is_first = (PL_oldbufptr == PL_linestart); @@ -430,6 +433,7 @@ S_no_op(pTHX_ const char *what, char *s) STATIC void S_missingterm(pTHX_ char *s) { + dVAR; char tmpbuf[3]; char q; if (s) { @@ -468,6 +472,7 @@ S_missingterm(pTHX_ char *s) STATIC bool S_feature_is_enabled(pTHX_ char *name, STRLEN namelen) { + dVAR; HV * const hinthv = GvHV(PL_hintgv); char he_name[32] = "feature_"; (void) strncpy(&he_name[8], name, 24); @@ -549,6 +554,7 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) void Perl_lex_start(pTHX_ SV *line) { + dVAR; const char *s; STRLEN len; @@ -627,6 +633,7 @@ Perl_lex_start(pTHX_ SV *line) void Perl_lex_end(pTHX) { + dVAR; PL_doextract = FALSE; } @@ -643,6 +650,7 @@ Perl_lex_end(pTHX) STATIC void S_incline(pTHX_ char *s) { + dVAR; char *t; char *n; char *e; @@ -737,6 +745,7 @@ S_incline(pTHX_ char *s) STATIC char * S_skipspace(pTHX_ register char *s) { + dVAR; if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; @@ -858,6 +867,7 @@ S_skipspace(pTHX_ register char *s) STATIC void S_check_uni(pTHX) { + dVAR; char *s; char *t; @@ -896,6 +906,7 @@ S_check_uni(pTHX) STATIC I32 S_lop(pTHX_ I32 f, int x, char *s) { + dVAR; yylval.ival = f; CLINE; PL_expect = x; @@ -925,6 +936,7 @@ S_lop(pTHX_ I32 f, int x, char *s) STATIC void S_force_next(pTHX_ I32 type) { + dVAR; PL_nexttype[PL_nexttoke] = type; PL_nexttoke++; if (PL_lex_state != LEX_KNOWNEXT) { @@ -937,6 +949,7 @@ S_force_next(pTHX_ I32 type) STATIC SV * S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len) { + dVAR; SV * const sv = newSVpvn(start,len); if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len)) SvUTF8_on(sv); @@ -962,6 +975,7 @@ S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len) STATIC char * S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick) { + dVAR; register char *s; STRLEN len; @@ -1003,6 +1017,7 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow STATIC void S_force_ident(pTHX_ register const char *s, int kind) { + dVAR; if (s && *s) { OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0)); PL_nextval[PL_nexttoke].opval = o; @@ -1058,6 +1073,7 @@ Perl_str_to_version(pTHX_ SV *sv) STATIC char * S_force_version(pTHX_ char *s, int guessing) { + dVAR; OP *version = Nullop; char *d; @@ -1102,6 +1118,7 @@ S_force_version(pTHX_ char *s, int guessing) STATIC SV * S_tokeq(pTHX_ SV *sv) { + dVAR; register char *s; register char *send; register char *d; @@ -1175,6 +1192,7 @@ S_tokeq(pTHX_ SV *sv) STATIC I32 S_sublex_start(pTHX) { + dVAR; register const I32 op_type = yylval.ival; if (op_type == OP_NULL) { @@ -1416,6 +1434,7 @@ S_sublex_done(pTHX) STATIC char * S_scan_const(pTHX_ char *start) { + dVAR; register char *send = PL_bufend; /* end of the constant */ SV *sv = NEWSV(93, send - start); /* sv for the constant */ register char *s = start; /* start of the constant */ @@ -1946,6 +1965,7 @@ S_scan_const(pTHX_ char *start) STATIC int S_intuit_more(pTHX_ register char *s) { + dVAR; if (PL_lex_brackets) return TRUE; if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{')) @@ -2101,6 +2121,7 @@ S_intuit_more(pTHX_ register char *s) STATIC int S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) { + dVAR; char *s = start + (*start == '$'); char tmpbuf[sizeof PL_tokenbuf]; STRLEN len; @@ -2173,6 +2194,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) STATIC const char* S_incl_perldb(pTHX) { + dVAR; if (PL_perldb) { const char * const pdb = PerlEnv_getenv("PERL5DB"); @@ -2205,6 +2227,7 @@ S_incl_perldb(pTHX) SV * Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) { + dVAR; if (!funcp) return Nullsv; @@ -2227,6 +2250,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) void Perl_filter_del(pTHX_ filter_t funcp) { + dVAR; SV *datasv; #ifdef DEBUGGING @@ -2253,6 +2277,7 @@ Perl_filter_del(pTHX_ filter_t funcp) I32 Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) { + dVAR; filter_t funcp; SV *datasv = NULL; @@ -2309,6 +2334,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) STATIC char * S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) { + dVAR; #ifdef PERL_CR_FILTER if (!PL_rsfp_filters) { filter_add(S_cr_textfilter,NULL); @@ -2329,6 +2355,7 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) STATIC HV * S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) { + dVAR; GV *gv; if (len == 11 && *pkgname == '_' && strEQ(pkgname, "__PACKAGE__")) @@ -2354,6 +2381,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) STATIC char * S_tokenize_use(pTHX_ int is_use, char *s) { + dVAR; if (PL_expect != XSTATE) yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression", is_use ? "use" : "no")); @@ -2415,6 +2443,7 @@ S_tokenize_use(pTHX_ int is_use, char *s) { int Perl_yylex(pTHX) { + dVAR; register char *s = PL_bufptr; register char *d; STRLEN len; @@ -5658,6 +5687,7 @@ Perl_yylex(pTHX) static int S_pending_ident(pTHX) { + dVAR; register char *d; register I32 tmp = 0; /* pit holds the identifier we read and pending_ident is reset */ @@ -5801,6 +5831,7 @@ S_pending_ident(pTHX) I32 Perl_keyword (pTHX_ const char *name, I32 len) { + dVAR; switch (len) { case 1: /* 5 tokens of length 1 */ @@ -9165,6 +9196,7 @@ unknown: STATIC void S_checkcomma(pTHX_ register char *s, const char *name, const char *what) { + dVAR; const char *w; if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ @@ -9313,6 +9345,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv, STATIC char * S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp) { + dVAR; register char *d = dest; register char * const e = d + destlen - 3; /* two-character token, ending NUL */ for (;;) { @@ -9350,6 +9383,7 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag STATIC char * S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni) { + dVAR; register char *d; register char *e; char *bracket = Nullch; @@ -9526,6 +9560,7 @@ Perl_pmflag(pTHX_ U32* pmfl, int ch) STATIC char * S_scan_pat(pTHX_ char *start, I32 type) { + dVAR; PMOP *pm; char *s = scan_str(start,FALSE,FALSE); @@ -9633,6 +9668,7 @@ S_scan_subst(pTHX_ char *start) STATIC char * S_scan_trans(pTHX_ char *start) { + dVAR; register char* s; OP *o; short *tbl; @@ -9691,6 +9727,7 @@ S_scan_trans(pTHX_ char *start) STATIC char * S_scan_heredoc(pTHX_ register char *s) { + dVAR; SV *herewas; I32 op_type = OP_SCALAR; I32 len; @@ -9912,6 +9949,7 @@ retval: STATIC char * S_scan_inputsymbol(pTHX_ char *start) { + dVAR; register char *s = start; /* current position in buffer */ register char *d; const char *e; @@ -10100,6 +10138,7 @@ intro_sym: STATIC char * S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) { + dVAR; SV *sv; /* scalar value: string */ char *tmps; /* temp string, used for delimiter matching */ register char *s = start; /* current position in the buffer */ @@ -10396,6 +10435,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) char * Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) { + dVAR; register const char *s = start; /* current position in buffer */ register char *d; /* destination in temp buffer */ register char *e; /* end of temp buffer */ @@ -10777,6 +10817,7 @@ vstring: STATIC char * S_scan_formline(pTHX_ register char *s) { + dVAR; register char *eol; register char *t; SV *stuff = newSVpvs(""); @@ -10872,6 +10913,7 @@ STATIC void S_set_csh(pTHX) { #ifdef CSH + dVAR; if (!PL_cshlen) PL_cshlen = strlen(PL_cshname); #endif @@ -10880,6 +10922,7 @@ S_set_csh(pTHX) I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags) { + dVAR; const I32 oldsavestack_ix = PL_savestack_ix; CV* outsidecv = PL_compcv; @@ -10908,6 +10951,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) int Perl_yywarn(pTHX_ const char *s) { + dVAR; PL_in_eval |= EVAL_WARNONLY; yyerror(s); PL_in_eval &= ~EVAL_WARNONLY; @@ -10917,6 +10961,7 @@ Perl_yywarn(pTHX_ const char *s) int Perl_yyerror(pTHX_ const char *s) { + dVAR; const char *where = NULL; const char *context = NULL; int contlen = -1; @@ -11014,6 +11059,7 @@ Perl_yyerror(pTHX_ const char *s) STATIC char* S_swallow_bom(pTHX_ U8 *s) { + dVAR; const STRLEN slen = SvCUR(PL_linestr); switch (s[0]) { case 0xFF: @@ -11113,6 +11159,7 @@ S_swallow_bom(pTHX_ U8 *s) static void restore_rsfp(pTHX_ void *f) { + dVAR; PerlIO * const fp = (PerlIO*)f; if (PL_rsfp == PerlIO_stdin()) @@ -11126,6 +11173,7 @@ restore_rsfp(pTHX_ void *f) static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) { + dVAR; const STRLEN old = SvCUR(sv); const I32 count = FILTER_READ(idx+1, sv, maxlen); DEBUG_P(PerlIO_printf(Perl_debug_log, @@ -11147,6 +11195,7 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) { + dVAR; const STRLEN old = SvCUR(sv); const I32 count = FILTER_READ(idx+1, sv, maxlen); DEBUG_P(PerlIO_printf(Perl_debug_log, @@ -11183,6 +11232,7 @@ passed in, for performance reasons. char * Perl_scan_vstring(pTHX_ const char *s, SV *sv) { + dVAR; const char *pos = s; const char *start = s; if (*pos == 'v') pos++; /* get past 'v' */ diff --git a/universal.c b/universal.c index c56c535..9e9b223 100644 --- a/universal.c +++ b/universal.c @@ -35,6 +35,7 @@ STATIC SV * S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash, int len, int level) { + dVAR; AV* av; GV* gv; GV** gvp; @@ -140,6 +141,7 @@ for class names as well as for objects. bool Perl_sv_derived_from(pTHX_ SV *sv, const char *name) { + dVAR; HV *stash; SvGETMAGIC(sv); @@ -204,6 +206,7 @@ XS(XS_Internals_inc_sub_generation); void Perl_boot_core_UNIVERSAL(pTHX) { + dVAR; const char file[] = __FILE__; newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, file); @@ -255,6 +258,7 @@ Perl_boot_core_UNIVERSAL(pTHX) XS(XS_UNIVERSAL_isa) { + dVAR; dXSARGS; if (items != 2) @@ -278,6 +282,7 @@ XS(XS_UNIVERSAL_isa) XS(XS_UNIVERSAL_can) { + dVAR; dXSARGS; SV *sv; const char *name; @@ -319,6 +324,7 @@ XS(XS_UNIVERSAL_can) XS(XS_UNIVERSAL_VERSION) { + dVAR; dXSARGS; HV *pkg; GV **gvp; @@ -392,6 +398,7 @@ XS(XS_UNIVERSAL_VERSION) XS(XS_version_new) { + dVAR; dXSARGS; if (items > 3) Perl_croak(aTHX_ "Usage: version::new(class, version)"); @@ -433,6 +440,7 @@ XS(XS_version_new) XS(XS_version_stringify) { + dVAR; dXSARGS; if (items < 1) Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)"); @@ -455,6 +463,7 @@ XS(XS_version_stringify) XS(XS_version_numify) { + dVAR; dXSARGS; if (items < 1) Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)"); @@ -477,6 +486,7 @@ XS(XS_version_numify) XS(XS_version_normal) { + dVAR; dXSARGS; if (items < 1) Perl_croak(aTHX_ "Usage: version::normal(lobj, ...)"); @@ -499,6 +509,7 @@ XS(XS_version_normal) XS(XS_version_vcmp) { + dVAR; dXSARGS; if (items < 1) Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)"); @@ -543,10 +554,11 @@ XS(XS_version_vcmp) XS(XS_version_boolean) { - dXSARGS; - if (items < 1) - Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)"); - SP -= items; + dVAR; + dXSARGS; + if (items < 1) + Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)"); + SP -= items; if (sv_derived_from(ST(0), "version")) { SV * const lobj = SvRV(ST(0)); SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) ); @@ -560,6 +572,7 @@ XS(XS_version_boolean) XS(XS_version_noop) { + dVAR; dXSARGS; if (items < 1) Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)"); @@ -574,6 +587,7 @@ XS(XS_version_noop) XS(XS_version_is_alpha) { + dVAR; dXSARGS; if (items != 1) Perl_croak(aTHX_ "Usage: version::is_alpha(lobj)"); @@ -593,6 +607,7 @@ XS(XS_version_is_alpha) XS(XS_version_qv) { + dVAR; dXSARGS; if (items != 1) Perl_croak(aTHX_ "Usage: version::qv(ver)"); @@ -629,6 +644,7 @@ XS(XS_version_qv) XS(XS_utf8_is_utf8) { + dVAR; dXSARGS; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)"); @@ -644,6 +660,7 @@ XS(XS_utf8_is_utf8) XS(XS_utf8_valid) { + dVAR; dXSARGS; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::valid(sv)"); @@ -661,6 +678,7 @@ XS(XS_utf8_valid) XS(XS_utf8_encode) { + dVAR; dXSARGS; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::encode(sv)"); @@ -670,6 +688,7 @@ XS(XS_utf8_encode) XS(XS_utf8_decode) { + dVAR; dXSARGS; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::decode(sv)"); @@ -684,6 +703,7 @@ XS(XS_utf8_decode) XS(XS_utf8_upgrade) { + dVAR; dXSARGS; if (items != 1) Perl_croak(aTHX_ "Usage: utf8::upgrade(sv)"); @@ -700,6 +720,7 @@ XS(XS_utf8_upgrade) XS(XS_utf8_downgrade) { + dVAR; dXSARGS; if (items < 1 || items > 2) Perl_croak(aTHX_ "Usage: utf8::downgrade(sv, failok=0)"); @@ -716,6 +737,7 @@ XS(XS_utf8_downgrade) XS(XS_utf8_native_to_unicode) { + dVAR; dXSARGS; const UV uv = SvUV(ST(0)); @@ -728,6 +750,7 @@ XS(XS_utf8_native_to_unicode) XS(XS_utf8_unicode_to_native) { + dVAR; dXSARGS; const UV uv = SvUV(ST(0)); @@ -740,6 +763,7 @@ XS(XS_utf8_unicode_to_native) XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */ { + dVAR; dXSARGS; SV * const sv = SvRV(ST(0)); @@ -765,6 +789,7 @@ XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */ XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */ { + dVAR; dXSARGS; SV * const sv = SvRV(ST(0)); @@ -780,6 +805,7 @@ XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */ XS(XS_Internals_hv_clear_placehold) { + dVAR; dXSARGS; if (items != 1) @@ -798,6 +824,7 @@ XS(XS_Regexp_DESTROY) XS(XS_PerlIO_get_layers) { + dVAR; dXSARGS; if (items < 1 || items % 2 == 0) Perl_croak(aTHX_ "Usage: PerlIO_get_layers(filehandle[,args])"); @@ -919,6 +946,7 @@ XS(XS_PerlIO_get_layers) XS(XS_Internals_hash_seed) { + dVAR; /* Using dXSARGS would also have dITEM and dSP, * which define 2 unused local variables. */ dAXMARK; @@ -929,6 +957,7 @@ XS(XS_Internals_hash_seed) XS(XS_Internals_rehash_seed) { + dVAR; /* Using dXSARGS would also have dITEM and dSP, * which define 2 unused local variables. */ dAXMARK; @@ -939,6 +968,7 @@ XS(XS_Internals_rehash_seed) XS(XS_Internals_HvREHASH) /* Subject to change */ { + dVAR; dXSARGS; if (SvROK(ST(0))) { const HV * const hv = (HV *) SvRV(ST(0)); @@ -954,6 +984,7 @@ XS(XS_Internals_HvREHASH) /* Subject to change */ XS(XS_Internals_inc_sub_generation) { + dVAR; /* Using dXSARGS would also have dITEM and dSP, * which define 2 unused local variables. */ dAXMARK; diff --git a/utf8.c b/utf8.c index 6a6930d..7dc5d99 100644 --- a/utf8.c +++ b/utf8.c @@ -399,6 +399,7 @@ Most code should use utf8_to_uvchr() rather than call this directly. UV Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) { + dVAR; const U8 *s0 = s; UV uv = *s, ouv = 0; STRLEN len = 1; @@ -655,6 +656,7 @@ up past C, croaks. STRLEN Perl_utf8_length(pTHX_ const U8 *s, const U8 *e) { + dVAR; STRLEN len = 0; /* Note: cannot use UTF8_IS_...() too eagerly here since e.g. @@ -698,6 +700,7 @@ same UTF-8 buffer. IV Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) { + dVAR; IV off = 0; /* Note: cannot use UTF8_IS_...() too eagerly here since e.g. @@ -1240,6 +1243,7 @@ static bool S_is_utf8_common(pTHX_ const U8 *const p, SV **swash, const char *const swashname) { + dVAR; if (!is_utf8_char(p)) return FALSE; if (!*swash) @@ -1250,6 +1254,7 @@ S_is_utf8_common(pTHX_ const U8 *const p, SV **swash, bool Perl_is_utf8_alnum(pTHX_ const U8 *p) { + dVAR; /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true * descendant of isalnum(3), in other words, it doesn't * contain the '_'. --jhi */ @@ -1259,12 +1264,14 @@ Perl_is_utf8_alnum(pTHX_ const U8 *p) bool Perl_is_utf8_alnumc(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_alnumc, "IsAlnumC"); } bool Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */ { + dVAR; if (*p == '_') return TRUE; /* is_utf8_idstart would be more logical. */ @@ -1274,6 +1281,7 @@ Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */ bool Perl_is_utf8_idcont(pTHX_ const U8 *p) { + dVAR; if (*p == '_') return TRUE; return S_is_utf8_common(aTHX_ p, &PL_utf8_idcont, "IdContinue"); @@ -1282,72 +1290,84 @@ Perl_is_utf8_idcont(pTHX_ const U8 *p) bool Perl_is_utf8_alpha(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_alpha, "IsAlpha"); } bool Perl_is_utf8_ascii(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_ascii, "IsAscii"); } bool Perl_is_utf8_space(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_space, "IsSpacePerl"); } bool Perl_is_utf8_digit(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_digit, "IsDigit"); } bool Perl_is_utf8_upper(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_upper, "IsUppercase"); } bool Perl_is_utf8_lower(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_lower, "IsLowercase"); } bool Perl_is_utf8_cntrl(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_cntrl, "IsCntrl"); } bool Perl_is_utf8_graph(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_graph, "IsGraph"); } bool Perl_is_utf8_print(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_print, "IsPrint"); } bool Perl_is_utf8_punct(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_punct, "IsPunct"); } bool Perl_is_utf8_xdigit(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_xdigit, "Isxdigit"); } bool Perl_is_utf8_mark(pTHX_ const U8 *p) { + dVAR; return S_is_utf8_common(aTHX_ p, &PL_utf8_mark, "IsM"); } @@ -1380,6 +1400,7 @@ UV Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, const char *normal, const char *special) { + dVAR; U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; STRLEN len = 0; @@ -1480,6 +1501,7 @@ The first character of the uppercased version is returned UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) { + dVAR; return Perl_to_utf8_case(aTHX_ p, ustrp, lenp, &PL_utf8_toupper, "ToUpper", "utf8::ToSpecUpper"); } @@ -1500,6 +1522,7 @@ The first character of the titlecased version is returned UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) { + dVAR; return Perl_to_utf8_case(aTHX_ p, ustrp, lenp, &PL_utf8_totitle, "ToTitle", "utf8::ToSpecTitle"); } @@ -1520,6 +1543,7 @@ The first character of the lowercased version is returned UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) { + dVAR; return Perl_to_utf8_case(aTHX_ p, ustrp, lenp, &PL_utf8_tolower, "ToLower", "utf8::ToSpecLower"); } @@ -1541,6 +1565,7 @@ The first character of the foldcased version is returned UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) { + dVAR; return Perl_to_utf8_case(aTHX_ p, ustrp, lenp, &PL_utf8_tofold, "ToFold", "utf8::ToSpecFold"); } @@ -2233,6 +2258,7 @@ http://www.unicode.org/unicode/reports/tr21/ (Case Mappings). I32 Perl_ibcmp_utf8(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const char *s2, char **pe2, register UV l2, bool u2) { + dVAR; register const U8 *p1 = (const U8*)s1; register const U8 *p2 = (const U8*)s2; register const U8 *f1 = NULL; diff --git a/util.c b/util.c index f868645..881287b 100644 --- a/util.c +++ b/util.c @@ -60,6 +60,7 @@ int putenv(char *); static char * S_write_no_mem(pTHX) { + dVAR; /* Can't use PerlIO to write as it allocates memory */ PerlLIO_write(PerlIO_fileno(Perl_error_log), PL_no_mem, strlen(PL_no_mem)); @@ -180,9 +181,10 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) Free_t Perl_safesysfree(Malloc_t where) { - dVAR; #if defined(PERL_IMPLICIT_SYS) || defined(PERL_TRACK_MEMPOOL) dTHX; +#else + dVAR; #endif DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++)); if (where) { @@ -424,6 +426,7 @@ Analyses the string in order to make fast searches on it using fbm_instr() void Perl_fbm_compile(pTHX_ SV *sv, U32 flags) { + dVAR; register const U8 *s; register U32 i; STRLEN len; @@ -691,6 +694,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit char * Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last) { + dVAR; register const unsigned char *big; register I32 pos; register I32 previous; @@ -910,6 +914,7 @@ Perl_savesvpv(pTHX_ SV *sv) STATIC SV * S_mess_alloc(pTHX) { + dVAR; SV *sv; XPVMG *any; @@ -1011,6 +1016,7 @@ Perl_mess(pTHX_ const char *pat, ...) STATIC COP* S_closest_cop(pTHX_ COP *cop, const OP *o) { + dVAR; /* Look for PL_op starting from o. cop is the last COP we've seen. */ if (!o || o == PL_op) @@ -1043,6 +1049,7 @@ S_closest_cop(pTHX_ COP *cop, const OP *o) SV * Perl_vmess(pTHX_ const char *pat, va_list *args) { + dVAR; SV * const sv = mess_alloc(); static const char dgd[] = " during global destruction.\n"; @@ -1128,6 +1135,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen) STATIC void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8) { + dVAR; HV *stash; GV *gv; CV *cv; @@ -1200,6 +1208,7 @@ S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen, OP * Perl_vdie(pTHX_ const char* pat, va_list *args) { + dVAR; const char *message; const int was_in_eval = PL_in_eval; STRLEN msglen; @@ -1249,6 +1258,7 @@ Perl_die(pTHX_ const char* pat, ...) void Perl_vcroak(pTHX_ const char* pat, va_list *args) { + dVAR; const char *message; STRLEN msglen; I32 utf8 = 0; @@ -1441,6 +1451,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) bool Perl_ckwarn(pTHX_ U32 w) { + dVAR; return ( isLEXWARN_on @@ -1468,6 +1479,7 @@ Perl_ckwarn(pTHX_ U32 w) bool Perl_ckwarn_d(pTHX_ U32 w) { + dVAR; return isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL @@ -2071,6 +2083,7 @@ PerlIO * Perl_my_popen_list(pTHX_ char *mode, int n, SV **args) { #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) && !defined(NETWARE) + dVAR; int p[2]; register I32 This, that; register Pid_t pid; @@ -2204,6 +2217,7 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args) PerlIO * Perl_my_popen(pTHX_ const char *cmd, const char *mode) { + dVAR; int p[2]; register I32 This, that; register Pid_t pid; @@ -2636,6 +2650,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) I32 Perl_my_pclose(pTHX_ PerlIO *ptr) { + dVAR; Sigsave_t hstat, istat, qstat; int status; SV **svp; @@ -2692,6 +2707,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) I32 Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) { + dVAR; I32 result = 0; if (!pid) return -1; @@ -2877,6 +2893,7 @@ char* Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char *const *const search_ext, I32 flags) { + dVAR; const char *xfound = Nullch; char *xfailed = Nullch; char tmpbuf[MAXPATHLEN]; @@ -3803,7 +3820,7 @@ int Perl_getcwd_sv(pTHX_ register SV *sv) { #ifndef PERL_MICRO - + dVAR; #ifndef INCOMPLETE_TAINTS SvTAINTED_on(sv); #endif @@ -4131,6 +4148,7 @@ want to upgrade the SV. SV * Perl_new_version(pTHX_ SV *ver) { + dVAR; SV * const rv = newSV(0); if ( sv_derived_from(ver,"version") ) /* can just copy directly */ { @@ -4864,6 +4882,7 @@ Perl_parse_unicode_opts(pTHX_ const char **popt) U32 Perl_seed(pTHX) { + dVAR; /* * This is really just a quick hack which grabs various garbage * values. It really should be a real hash algorithm which @@ -4945,6 +4964,7 @@ Perl_seed(pTHX) UV Perl_get_hash_seed(pTHX) { + dVAR; const char *s = PerlEnv_getenv("PERL_HASH_SEED"); UV myseed = 0; @@ -5209,6 +5229,7 @@ extending the interpreter's PL_my_cxt_list array */ void * Perl_my_cxt_init(pTHX_ int *index, size_t size) { + dVAR; void *p; if (*index == -1) { /* this module hasn't been allocated an index yet */ diff --git a/xsutils.c b/xsutils.c index 329af28..59a2496 100644 --- a/xsutils.c +++ b/xsutils.c @@ -56,6 +56,7 @@ Perl_boot_core_xsutils(pTHX) static int modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) { + dVAR; SV *attr; int nret; @@ -159,6 +160,7 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) XS(XS_attributes_bootstrap) { + dVAR; dXSARGS; const char file[] = __FILE__; @@ -176,6 +178,7 @@ XS(XS_attributes_bootstrap) XS(XS_attributes__modify_attrs) { + dVAR; dXSARGS; SV *rv, *sv; @@ -197,6 +200,7 @@ usage: XS(XS_attributes__fetch_attrs) { + dVAR; dXSARGS; SV *rv, *sv; cv_flags_t cvflags; @@ -242,6 +246,7 @@ usage: XS(XS_attributes__guess_stash) { + dVAR; dXSARGS; SV *rv, *sv; dXSTARG; @@ -294,6 +299,7 @@ usage: XS(XS_attributes_reftype) { + dVAR; dXSARGS; SV *rv, *sv; dXSTARG; @@ -318,6 +324,7 @@ usage: XS(XS_attributes__warn_reserved) { + dVAR; dXSARGS; if (items != 0) { -- 1.8.3.1