diff options
| -rw-r--r-- | av.c | 7 | ||||
| -rw-r--r-- | cygwin/cygwin.c | 4 | ||||
| -rw-r--r-- | deb.c | 3 | ||||
| -rw-r--r-- | djgpp/djgpp.c | 1 | ||||
| -rw-r--r-- | doio.c | 47 | ||||
| -rw-r--r-- | doop.c | 13 | ||||
| -rw-r--r-- | dump.c | 5 | ||||
| -rw-r--r-- | epoc/epoc.c | 1 | ||||
| -rw-r--r-- | ext/ByteLoader/ByteLoader.xs | 1 | ||||
| -rw-r--r-- | ext/ByteLoader/byterun.c | 1 | ||||
| -rw-r--r-- | ext/Devel/DProf/DProf.xs | 6 | ||||
| -rw-r--r-- | ext/Thread/Thread.xs | 2 | ||||
| -rw-r--r-- | ext/re/re.xs | 2 | ||||
| -rw-r--r-- | gv.c | 12 | ||||
| -rw-r--r-- | hv.c | 12 | ||||
| -rw-r--r-- | mg.c | 24 | ||||
| -rw-r--r-- | op.c | 60 | ||||
| -rw-r--r-- | os2/OS2/REXX/REXX.xs | 1 | ||||
| -rw-r--r-- | os2/os2.c | 9 | ||||
| -rw-r--r-- | os2/os2ish.h | 1 | ||||
| -rw-r--r-- | perl.c | 33 | ||||
| -rw-r--r-- | perl.h | 4 | ||||
| -rw-r--r-- | perlapi.c | 10 | ||||
| -rw-r--r-- | pp.c | 2 | ||||
| -rw-r--r-- | pp.h | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 13 | ||||
| -rw-r--r-- | pp_hot.c | 5 | ||||
| -rw-r--r-- | pp_sys.c | 5 | ||||
| -rw-r--r-- | regcomp.c | 26 | ||||
| -rw-r--r-- | regexec.c | 14 | ||||
| -rw-r--r-- | run.c | 4 | ||||
| -rw-r--r-- | scope.c | 48 | ||||
| -rw-r--r-- | sv.c | 60 | ||||
| -rw-r--r-- | taint.c | 7 | ||||
| -rw-r--r-- | toke.c | 27 | ||||
| -rw-r--r-- | universal.c | 1 | ||||
| -rw-r--r-- | utf8.c | 3 | ||||
| -rw-r--r-- | util.c | 18 | ||||
| -rw-r--r-- | vmesa/vmesa.c | 2 | ||||
| -rw-r--r-- | vms/ext/Stdio/Stdio.xs | 1 | ||||
| -rw-r--r-- | win32/win32.c | 3 |
41 files changed, 30 insertions, 470 deletions
@@ -34,10 +34,8 @@ Perl_av_reify(pTHX_ AV *av) while (key) { sv = AvARRAY(av)[--key]; assert(sv); - if (sv != &PL_sv_undef) { - dTHR; + if (sv != &PL_sv_undef) (void)SvREFCNT_inc(sv); - } } key = AvARRAY(av) - AvALLOC(av); while (key) @@ -58,7 +56,6 @@ extended. void Perl_av_extend(pTHX_ AV *av, I32 key) { - dTHR; /* only necessary if we have to extend stack */ MAGIC *mg; if ((mg = SvTIED_mg((SV*)av, 'P'))) { dSP; @@ -189,7 +186,6 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval) if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { - dTHR; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); PL_av_fetch_sv = sv; @@ -272,7 +268,6 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) ary = AvARRAY(av); if (AvFILLp(av) < key) { if (!AvREAL(av)) { - dTHR; if (av == PL_curstack && key > PL_stack_sp - PL_stack_base) PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */ do diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c index 33ea4db16b..962a60a8d4 100644 --- a/cygwin/cygwin.c +++ b/cygwin/cygwin.c @@ -27,11 +27,9 @@ do_spawnvp (const char *path, const char * const *argv) childpid = spawnvp(_P_NOWAIT,path,argv); if (childpid < 0) { status = -1; - if(ckWARN(WARN_EXEC)) { - dTHR; + if(ckWARN(WARN_EXEC)) Perl_warner(aTHX_ WARN_EXEC,"Can't spawn \"%s\": %s", path,Strerror (errno)); - } } else { do { result = wait4pid(childpid, &status, 0); @@ -45,7 +45,6 @@ void Perl_vdeb(pTHX_ const char *pat, va_list *args) { #ifdef DEBUGGING - dTHR; char* file = CopFILE(PL_curcop); #ifdef USE_THREADS @@ -65,7 +64,6 @@ I32 Perl_debstackptrs(pTHX) { #ifdef DEBUGGING - dTHR; PerlIO_printf(Perl_debug_log, "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n", PTR2UV(PL_curstack), PTR2UV(PL_stack_base), @@ -84,7 +82,6 @@ I32 Perl_debstack(pTHX) { #ifdef DEBUGGING - dTHR; I32 top = PL_stack_sp - PL_stack_base; register I32 i = top - 30; I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff; diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 80a627e518..4e390cfc59 100644 --- a/djgpp/djgpp.c +++ b/djgpp/djgpp.c @@ -130,7 +130,6 @@ convretcode (pTHX_ int rc,char *prog,int fl) int do_aspawn (pTHX_ SV *really,SV **mark,SV **sp) { - dTHR; int rc; char **a,*tmps,**argv; STRLEN n_a; @@ -226,7 +226,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, len = tend-type; } if (*name == '\0') { /* command is missing 19990114 */ - dTHR; if (ckWARN(WARN_PIPE)) Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open"); errno = EPIPE; @@ -236,7 +235,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, TAINT_ENV(); TAINT_PROPER("piped open"); if (!num_svs && name[len-1] == '|') { - dTHR; name[--len] = '\0' ; if (ckWARN(WARN_PIPE)) Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe"); @@ -390,7 +388,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, len = tend-type; } if (*name == '\0') { /* command is missing 19990114 */ - dTHR; if (ckWARN(WARN_PIPE)) Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open"); errno = EPIPE; @@ -429,13 +426,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } if (!fp) { - dTHR; if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n')) Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open"); goto say_false; } if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) { - dTHR; if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) { (void)PerlIO_close(fp); goto say_false; @@ -533,7 +528,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, IoFLAGS(io) &= ~IOf_NOLINE; if (writing) { - dTHR; if (IoTYPE(io) == IoTYPE_SOCKET || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) ) { @@ -597,7 +591,6 @@ Perl_nextargv(pTHX_ register GV *gv) } PL_filemode = 0; while (av_len(GvAV(gv)) >= 0) { - dTHR; STRLEN oldlen; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); @@ -746,7 +739,6 @@ Perl_nextargv(pTHX_ register GV *gv) return IoIFP(GvIOp(gv)); } else { - dTHR; if (ckWARN_d(WARN_INPLACE)) { int eno = errno; if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0 @@ -841,7 +833,6 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) io = GvIO(gv); if (!io) { /* never opened */ if (not_implicit) { - dTHR; if (ckWARN(WARN_UNOPENED)) /* no check for closed here */ report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,SS$_IVCHAN); @@ -897,7 +888,6 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit) bool Perl_do_eof(pTHX_ GV *gv) { - dTHR; register IO *io; int ch; @@ -964,11 +954,8 @@ Perl_do_tell(pTHX_ GV *gv) #endif return PerlIO_tell(fp); } - { - dTHR; - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); - } + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); return (Off_t)-1; } @@ -986,11 +973,8 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) #endif return PerlIO_seek(fp, pos, whence) >= 0; } - { - dTHR; - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); - } + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); return FALSE; } @@ -1003,11 +987,8 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); - { - dTHR; - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); - } + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); return (Off_t)-1; } @@ -1152,11 +1133,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) } switch (SvTYPE(sv)) { case SVt_NULL: - { - dTHR; - if (ckWARN(WARN_UNINITIALIZED)) - report_uninit(); - } + if (ckWARN(WARN_UNINITIALIZED)) + report_uninit(); return TRUE; case SVt_IV: if (SvIOK(sv)) { @@ -1287,7 +1265,6 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, STRLEN n_a; if (sp > mark) { - dTHR; New(401,PL_Argv, sp - mark + 1, char*); a = PL_Argv; while (++mark <= sp) { @@ -1435,7 +1412,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) goto doshell; } { - dTHR; int e = errno; if (ckWARN(WARN_EXEC)) @@ -1456,7 +1432,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) I32 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) { - dTHR; register I32 val; register I32 val2; register I32 tot = 0; @@ -1741,7 +1716,6 @@ Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective) I32 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) { - dTHR; key_t key; I32 n, flags; @@ -1774,7 +1748,6 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) I32 Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { - dTHR; SV *astr; char *a; I32 id, n, cmd, infosize, getinfo; @@ -1899,7 +1872,6 @@ I32 Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) { #ifdef HAS_MSG - dTHR; SV *mstr; char *mbuf; I32 id, msize, flags; @@ -1922,7 +1894,6 @@ I32 Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) { #ifdef HAS_MSG - dTHR; SV *mstr; char *mbuf; long mtype; @@ -1960,7 +1931,6 @@ I32 Perl_do_semop(pTHX_ SV **mark, SV **sp) { #ifdef HAS_SEM - dTHR; SV *opstr; char *opbuf; I32 id; @@ -1985,7 +1955,6 @@ I32 Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) { #ifdef HAS_SHM - dTHR; SV *mstr; char *mbuf, *shm; I32 id, mpos, msize; @@ -36,7 +36,6 @@ STATIC I32 S_do_trans_simple(pTHX_ SV *sv) { - dTHR; U8 *s; U8 *d; U8 *send; @@ -102,7 +101,6 @@ S_do_trans_simple(pTHX_ SV *sv) STATIC I32 S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ { - dTHR; U8 *s; U8 *send; I32 matches = 0; @@ -140,7 +138,6 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ STATIC I32 S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ { - dTHR; U8 *s; U8 *send; U8 *d; @@ -222,7 +219,6 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ STATIC I32 S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ { - dTHR; U8 *s; U8 *send; U8 *d; @@ -293,7 +289,6 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ STATIC I32 S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ { - dTHR; U8 *s; U8 *send; I32 matches = 0; @@ -322,7 +317,6 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ STATIC I32 S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ { - dTHR; U8 *s; U8 *send; U8 *d; @@ -449,7 +443,6 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ I32 Perl_do_trans(pTHX_ SV *sv) { - dTHR; STRLEN len; I32 hasutf = (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)); @@ -600,7 +593,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) } #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -670,7 +662,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) s[offset + 3]; #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -758,7 +749,6 @@ Perl_do_vecset(pTHX_ SV *sv) } #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -781,7 +771,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) { STRLEN len; char *s; - dTHR; if (SvTYPE(sv) == SVt_PVAV) { register I32 i; @@ -843,7 +832,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) I32 Perl_do_chomp(pTHX_ register SV *sv) { - dTHR; register I32 count; STRLEN len; char *s; @@ -921,7 +909,6 @@ Perl_do_chomp(pTHX_ register SV *sv) void Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) { - dTHR; /* just for taint */ #ifdef LIBERAL register long *dl; register long *ll; @@ -29,7 +29,6 @@ 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) { - dTHR; PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); PerlIO_vprintf(file, pat, *args); } @@ -37,7 +36,6 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) void Perl_dump_all(pTHX) { - dTHR; PerlIO_setlinebuf(Perl_debug_log); if (PL_main_root) op_dump(PL_main_root); @@ -47,7 +45,6 @@ Perl_dump_all(pTHX) void Perl_dump_packsubs(pTHX_ HV *stash) { - dTHR; I32 i; HE *entry; @@ -371,7 +368,6 @@ Perl_pmop_dump(pTHX_ PMOP *pm) void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) { - dTHR; Perl_dump_indent(aTHX_ level, file, "{\n"); level++; if (o->op_seq) @@ -770,7 +766,6 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) { - dTHR; SV *d; char *s; U32 flags; diff --git a/epoc/epoc.c b/epoc/epoc.c index a2691f3d38..b9bc652c22 100644 --- a/epoc/epoc.c +++ b/epoc/epoc.c @@ -101,7 +101,6 @@ do_aspawn( pTHX_ SV *really,SV **mark,SV **sp) { int do_spawn (pTHX_ SV *really,SV **mark,SV **sp) { - dTHR; int rc; char **a,*cmd,**ptr, *cmdline, **argv, *p2; STRLEN n_a; diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs index d3b435199e..05b795ca25 100644 --- a/ext/ByteLoader/ByteLoader.xs +++ b/ext/ByteLoader/ByteLoader.xs @@ -77,7 +77,6 @@ bl_read(struct byteloader_fdata *data, char *buf, size_t size, size_t n) static I32 byteloader_filter(pTHXo_ int idx, SV *buf_sv, int maxlen) { - dTHR; OP *saveroot = PL_main_root; OP *savestart = PL_main_start; struct byteloader_state bstate; diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c index 19f1f6b44c..3e12790fb0 100644 --- a/ext/ByteLoader/byterun.c +++ b/ext/ByteLoader/byterun.c @@ -54,7 +54,6 @@ bset_obj_store(pTHXo_ struct byteloader_state *bstate, void *obj, I32 ix) void byterun(pTHXo_ register struct byteloader_state *bstate) { - dTHR; register int insn; U32 ix; SV *specialsv_list[6]; diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs index 7167a0028f..8f28c6eb33 100644 --- a/ext/Devel/DProf/DProf.xs +++ b/ext/Devel/DProf/DProf.xs @@ -3,11 +3,6 @@ #include "perl.h" #include "XSUB.h" -/* For older Perls */ -#ifndef dTHR -# define dTHR int dummy_thr -#endif /* dTHR */ - /*#define DBG_SUB 1 */ /*#define DBG_TIMER 1 */ @@ -388,7 +383,6 @@ prof_mark(pTHX_ opcode ptype) static void test_time(pTHX_ clock_t *r, clock_t *u, clock_t *s) { - dTHR; CV *cv = perl_get_cv("Devel::DProf::NONESUCH_noxs", FALSE); int i, j, k = 0; HV *oldstash = PL_curstash; diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index c911279c1d..07befed144 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -98,7 +98,6 @@ threadstart(void *arg) DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n", thr)); - /* Don't call *anything* requiring dTHR until after PERL_SET_THX() */ /* * Wait until our creator releases us. If we didn't do this, then * it would be potentially possible for out thread to carry on and @@ -116,7 +115,6 @@ threadstart(void *arg) */ PERL_SET_THX(thr); - /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); diff --git a/ext/re/re.xs b/ext/re/re.xs index 04a5fdc742..25c2a90d60 100644 --- a/ext/re/re.xs +++ b/ext/re/re.xs @@ -25,7 +25,6 @@ static int oldfl; static void deinstall(pTHX) { - dTHR; PL_regexecp = Perl_regexec_flags; PL_regcompp = Perl_pregcomp; PL_regint_start = Perl_re_intuit_start; @@ -39,7 +38,6 @@ deinstall(pTHX) static void install(pTHX) { - dTHR; PL_colorset = 0; /* Allow reinspection of ENV. */ PL_regexecp = &my_regexec; PL_regcompp = &my_regcomp; @@ -53,7 +53,6 @@ Perl_gv_IOadd(pTHX_ register GV *gv) GV * Perl_gv_fetchfile(pTHX_ const char *name) { - dTHR; char smallbuf[256]; char *tmpbuf; STRLEN tmplen; @@ -85,7 +84,6 @@ Perl_gv_fetchfile(pTHX_ const char *name) void Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) { - dTHR; register GP *gp; bool doproto = SvTYPE(gv) > SVt_NULL; char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL; @@ -227,7 +225,6 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) basestash = gv_stashpvn(packname, packlen, TRUE); gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE); if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) { - dTHR; /* just for SvREFCNT_dec */ gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); if (!gvp || !(gv = *gvp)) Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash)); @@ -247,7 +244,6 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) SV* sv = *svp++; HV* basestash = gv_stashsv(sv, FALSE); if (!basestash) { - dTHR; /* just for ckWARN */ if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA", SvPVX(sv), HvNAME(stash)); @@ -342,7 +338,6 @@ C<call_sv> apply equally to these functions. GV * Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) { - dTHR; register const char *nend; const char *nsplit = 0; GV* gv; @@ -403,7 +398,6 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) GV* Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) { - dTHR; static char autoload[] = "AUTOLOAD"; static STRLEN autolen = 8; GV* gv; @@ -525,7 +519,6 @@ Perl_gv_stashsv(pTHX_ SV *sv, I32 create) GV * Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) { - dTHR; register const char *name = nambeg; register GV *gv = 0; GV**gvp; @@ -999,7 +992,6 @@ Perl_gv_efullname(pTHX_ SV *sv, GV *gv) IO * Perl_newIO(pTHX) { - dTHR; IO *io; GV *iogv; @@ -1018,7 +1010,6 @@ Perl_newIO(pTHX) void Perl_gv_check(pTHX_ HV *stash) { - dTHR; register HE *entry; register I32 i; register GV *gv; @@ -1095,7 +1086,6 @@ Perl_gp_ref(pTHX_ GP *gp) void Perl_gp_free(pTHX_ GV *gv) { - dTHR; GP* gp; if (!gv || !(gp = GvGP(gv))) @@ -1156,7 +1146,6 @@ register GV *gv; bool Perl_Gv_AMupdate(pTHX_ HV *stash) { - dTHR; GV* gv; CV* cv; MAGIC* mg=mg_find((SV*)stash,'c'); @@ -1319,7 +1308,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) SV* Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) { - dTHR; MAGIC *mg; CV *cv; CV **cvp=NULL, **ocvp=NULL; @@ -162,7 +162,6 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - dTHR; sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); PL_hv_fetch_sv = sv; @@ -262,7 +261,6 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - dTHR; sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); @@ -491,7 +489,6 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { - dTHR; bool needs_copy; bool needs_store; hv_magic_check (hv, &needs_copy, &needs_store); @@ -769,7 +766,6 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - dTHR; sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); magic_existspack(sv, mg_find(sv, 'p')); @@ -847,7 +843,6 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - dTHR; /* just for SvTRUE */ sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); @@ -1504,11 +1499,8 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) } UNLOCK_STRTAB_MUTEX; - { - dTHR; - if (!found && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str); - } + if (!found && ckWARN_d(WARN_INTERNAL)) + Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str); } /* get a (constant) string ptr from the global string table @@ -39,7 +39,6 @@ struct magic_state { STATIC void S_save_magic(pTHX_ I32 mgs_ix, SV *sv) { - dTHR; MGS* mgs; assert(SvMAGICAL(sv)); @@ -91,7 +90,6 @@ Do magic after a value is retrieved from the SV. See C<sv_magic>. int Perl_mg_get(pTHX_ SV *sv) { - dTHR; I32 mgs_ix; MAGIC* mg; MAGIC** mgp; @@ -134,7 +132,6 @@ Do magic after a value is assigned to the SV. See C<sv_magic>. int Perl_mg_set(pTHX_ SV *sv) { - dTHR; I32 mgs_ix; MAGIC* mg; MAGIC* nextmg; @@ -334,7 +331,6 @@ Perl_mg_free(pTHX_ SV *sv) U32 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) { - dTHR; register REGEXP *rx; if (PL_curpm && (rx = PL_curpm->op_pmregexp)) { @@ -350,7 +346,6 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) { - dTHR; register I32 paren; register I32 s; register I32 i; @@ -378,7 +373,6 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg) { - dTHR; Perl_croak(aTHX_ PL_no_modify); /* NOT REACHED */ return 0; @@ -387,7 +381,6 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg) U32 Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) { - dTHR; register I32 paren; register I32 i; register REGEXP *rx; @@ -469,7 +462,6 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { - dTHR; register I32 paren; register char *s; register I32 i; @@ -574,7 +566,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) break; case '\023': /* ^S */ { - dTHR; if (PL_lex_state != LEX_NOTPARSING) (void)SvOK_off(sv); else if (PL_in_eval) @@ -898,7 +889,6 @@ Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg) #if defined(VMS) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); #else - dTHR; if (PL_localizing) { HE* entry; STRLEN n_a; @@ -1006,7 +996,6 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) { - dTHR; register char *s; I32 i; SV** svp; @@ -1269,7 +1258,6 @@ Perl_magic_existspack(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) { - dTHR; OP *o; I32 i; GV* gv; @@ -1288,7 +1276,6 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_getarylen(pTHX_ SV *sv, MAGIC *mg) { - dTHR; sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + PL_curcop->cop_arybase); return 0; } @@ -1296,7 +1283,6 @@ Perl_magic_getarylen(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) { - dTHR; av_fill((AV*)mg->mg_obj, SvIV(sv) - PL_curcop->cop_arybase); return 0; } @@ -1309,7 +1295,6 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) { mg = mg_find(lsv, 'g'); if (mg && mg->mg_len >= 0) { - dTHR; I32 i = mg->mg_len; if (DO_UTF8(lsv)) sv_pos_b2u(lsv, &i); @@ -1328,7 +1313,6 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) SSize_t pos; STRLEN len; STRLEN ulen = 0; - dTHR; mg = 0; @@ -1439,7 +1423,6 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg) { - dTHR; TAINT_IF((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv)); /* kludge */ return 0; @@ -1448,7 +1431,6 @@ Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg) { - dTHR; if (PL_localizing) { if (PL_localizing == 1) mg->mg_len <<= 1; @@ -1507,7 +1489,6 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg) targ = AvARRAY(av)[LvTARGOFF(sv)]; } if (targ && targ != &PL_sv_undef) { - dTHR; /* just for SvREFCNT_dec */ /* somebody else defined it for us */ SvREFCNT_dec(LvTARG(sv)); LvTARG(sv) = SvREFCNT_inc(targ); @@ -1538,7 +1519,6 @@ Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg) void Perl_vivify_defelem(pTHX_ SV *sv) { - dTHR; /* just for SvREFCNT_inc and SvREFCNT_dec*/ MAGIC *mg; SV *value = Nullsv; @@ -1662,7 +1642,6 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) { - dTHR; register char *s; I32 i; STRLEN len; @@ -2110,7 +2089,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg) { - dTHR; DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n", PTR2UV(thr), PTR2UV(sv));) @@ -2251,7 +2229,6 @@ cleanup: static void restore_magic(pTHXo_ void *p) { - dTHR; MGS* mgs = SSPTR(PTR2IV(p), MGS*); SV* sv = mgs->mgs_sv; @@ -2293,7 +2270,6 @@ restore_magic(pTHXo_ void *p) static void unwind_handler_stack(pTHXo_ void *p) { - dTHR; U32 flags = *(U32*)p; if (flags & 1) @@ -107,7 +107,6 @@ S_no_bareword_allowed(pTHX_ OP *o) PADOFFSET Perl_pad_allocmy(pTHX_ char *name) { - dTHR; PADOFFSET off; SV *sv; @@ -238,7 +237,6 @@ STATIC PADOFFSET S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags) { - dTHR; CV *cv; I32 off; SV *sv; @@ -385,7 +383,6 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, PADOFFSET Perl_pad_findmy(pTHX_ char *name) { - dTHR; I32 off; I32 pendoff = 0; SV *sv; @@ -448,7 +445,6 @@ Perl_pad_findmy(pTHX_ char *name) void Perl_pad_leavemy(pTHX_ I32 fill) { - dTHR; I32 off; SV **svp = AvARRAY(PL_comppad_name); SV *sv; @@ -468,7 +464,6 @@ Perl_pad_leavemy(pTHX_ I32 fill) PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) { - dTHR; SV *sv; I32 retval; @@ -520,7 +515,6 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) SV * Perl_pad_sv(pTHX_ PADOFFSET po) { - dTHR; #ifdef USE_THREADS DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n", @@ -537,7 +531,6 @@ Perl_pad_sv(pTHX_ PADOFFSET po) void Perl_pad_free(pTHX_ PADOFFSET po) { - dTHR; if (!PL_curpad) return; if (AvARRAY(PL_comppad) != PL_curpad) @@ -565,7 +558,6 @@ Perl_pad_free(pTHX_ PADOFFSET po) void Perl_pad_swipe(pTHX_ PADOFFSET po) { - dTHR; if (AvARRAY(PL_comppad) != PL_curpad) Perl_croak(aTHX_ "panic: pad_swipe curpad"); if (!po) @@ -595,7 +587,6 @@ void Perl_pad_reset(pTHX) { #ifdef USE_BROKEN_PAD_RESET - dTHR; register I32 po; if (AvARRAY(PL_comppad) != PL_curpad) @@ -624,7 +615,6 @@ Perl_pad_reset(pTHX) PADOFFSET Perl_find_threadsv(pTHX_ const char *name) { - dTHR; char *p; PADOFFSET key; SV **svp; @@ -911,7 +901,6 @@ STATIC OP * S_scalarboolean(pTHX_ OP *o) { if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) { - dTHR; if (ckWARN(WARN_SYNTAX)) { line_t oldline = CopLINE(PL_curcop); @@ -1007,10 +996,7 @@ Perl_scalarvoid(pTHX_ OP *o) || (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_SETSTATE || o->op_targ == OP_DBSTATE))) - { - dTHR; PL_curcop = (COP*)o; /* for warning below */ - } /* assumes no premature commitment */ want = o->op_flags & OPf_WANT; @@ -1127,7 +1113,6 @@ Perl_scalarvoid(pTHX_ OP *o) if (cSVOPo->op_private & OPpCONST_STRICT) no_bareword_allowed(o); else { - dTHR; if (ckWARN(WARN_VOID)) { useless = "a constant"; if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) @@ -1196,11 +1181,8 @@ Perl_scalarvoid(pTHX_ OP *o) } break; } - if (useless) { - dTHR; - if (ckWARN(WARN_VOID)) - Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless); - } + if (useless && ckWARN(WARN_VOID)) + Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless); return o; } @@ -1301,7 +1283,6 @@ Perl_scalarseq(pTHX_ OP *o) o->op_type == OP_LEAVE || o->op_type == OP_LEAVETRY) { - dTHR; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) { scalarvoid(kid); @@ -1332,7 +1313,6 @@ S_modkids(pTHX_ OP *o, I32 type) OP * Perl_mod(pTHX_ OP *o, I32 type) { - dTHR; OP *kid; STRLEN n_a; @@ -1967,7 +1947,6 @@ Perl_sawparens(pTHX_ OP *o) OP * Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) { - dTHR; OP *o; if (ckWARN(WARN_MISC) && @@ -2054,7 +2033,6 @@ Perl_save_hints(pTHX) int Perl_block_start(pTHX_ int full) { - dTHR; int retval = PL_savestack_ix; SAVEI32(PL_comppad_name_floor); @@ -2088,7 +2066,6 @@ Perl_block_start(pTHX_ int full) OP* Perl_block_end(pTHX_ I32 floor, OP *seq) { - dTHR; int needblockscope = PL_hints & HINT_BLOCK_SCOPE; OP* retval = scalarseq(seq); LEAVE_SCOPE(floor); @@ -2116,7 +2093,6 @@ S_newDEFSVOP(pTHX) void Perl_newPROG(pTHX_ OP *o) { - dTHR; if (PL_in_eval) { if (PL_eval_root) return; @@ -2161,7 +2137,6 @@ Perl_localize(pTHX_ OP *o, I32 lex) if (o->op_flags & OPf_PARENS) list(o); else { - dTHR; if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') { char *s; for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ; @@ -2199,7 +2174,6 @@ Perl_jmaybe(pTHX_ OP *o) OP * Perl_fold_constants(pTHX_ register OP *o) { - dTHR; register OP *curop; I32 type = o->op_type; SV *sv; @@ -2317,7 +2291,6 @@ Perl_fold_constants(pTHX_ register OP *o) OP * Perl_gen_constant_list(pTHX_ register OP *o) { - dTHR; register OP *curop; I32 oldtmps_floor = PL_tmps_floor; @@ -2861,7 +2834,6 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) OP * Perl_newPMOP(pTHX_ I32 type, I32 flags) { - dTHR; PMOP *pmop; NewOp(1101, pmop, 1, PMOP); @@ -2888,7 +2860,6 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags) OP * Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) { - dTHR; PMOP *pm; LOGOP *rcop; I32 repl_has_vars = 0; @@ -3079,7 +3050,6 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv) OP * Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv) { - dTHR; #ifdef USE_ITHREADS GvIN_PAD_on(gv); return newPADOP(type, flags, SvREFCNT_inc(gv)); @@ -3108,7 +3078,6 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv) void Perl_package(pTHX_ OP *o) { - dTHR; SV *sv; save_hptr(&PL_curstash); @@ -3370,7 +3339,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) } if (list_assignment(left)) { - dTHR; OP *curop; PL_modcount = 0; @@ -3511,7 +3479,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) OP * Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) { - dTHR; U32 seq = intro_my(); register COP *cop; @@ -3604,7 +3571,6 @@ Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other) STATIC OP * S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) { - dTHR; LOGOP *logop; OP *o; OP *first = *firstp; @@ -3716,7 +3682,6 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) OP * Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) { - dTHR; LOGOP *logop; OP *start; OP *o; @@ -3770,7 +3735,6 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) OP * Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) { - dTHR; LOGOP *range; OP *flip; OP *flop; @@ -3817,7 +3781,6 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) OP * Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) { - dTHR; OP* listop; OP* o; int once = block && block->op_flags & OPf_SPECIAL && @@ -3873,7 +3836,6 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) OP * Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont) { - dTHR; OP *redo; OP *next = 0; OP *listop; @@ -4067,7 +4029,6 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo OP* Perl_newLOOPEX(pTHX_ I32 type, OP *label) { - dTHR; OP *o; STRLEN n_a; @@ -4094,7 +4055,6 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) void Perl_cv_undef(pTHX_ CV *cv) { - dTHR; #ifdef USE_THREADS if (CvMUTEXP(cv)) { MUTEX_DESTROY(CvMUTEXP(cv)); @@ -4204,7 +4164,6 @@ S_cv_dump(pTHX_ CV *cv) STATIC CV * S_cv_clone2(pTHX_ CV *proto, CV *outside) { - dTHR; AV* av; I32 ix; AV* protopadlist = CvPADLIST(proto); @@ -4356,8 +4315,6 @@ Perl_cv_clone(pTHX_ CV *proto) void Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p) { - dTHR; - if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) && ckWARN_d(WARN_PROTOTYPE)) { SV* msg = sv_newmortal(); SV* name = Nullsv; @@ -4474,7 +4431,6 @@ Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block) CV * Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) { - dTHR; STRLEN n_a; char *name; char *aname; @@ -4829,7 +4785,6 @@ eligible for inlining at compile-time. CV * Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv) { - dTHR; CV* cv; ENTER; @@ -4872,7 +4827,6 @@ Used by C<xsubpp> to hook up XSUBs as Perl subs. CV * Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) { - dTHR; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); register CV *cv; @@ -4974,7 +4928,6 @@ done: void Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) { - dTHR; register CV *cv; char *name; GV *gv; @@ -5072,8 +5025,6 @@ Perl_oopsAV(pTHX_ OP *o) OP * Perl_oopsHV(pTHX_ OP *o) { - dTHR; - switch (o->op_type) { case OP_PADSV: case OP_PADAV: @@ -5370,7 +5321,6 @@ Perl_ck_gvconst(pTHX_ register OP *o) OP * Perl_ck_rvconst(pTHX_ register OP *o) { - dTHR; SVOP *kid = (SVOP*)cUNOPo->op_first; o->op_private |= (PL_hints & HINT_STRICT_REFS); @@ -5480,7 +5430,6 @@ Perl_ck_rvconst(pTHX_ register OP *o) OP * Perl_ck_ftst(pTHX_ OP *o) { - dTHR; I32 type = o->op_type; if (o->op_flags & OPf_REF) { @@ -5518,7 +5467,6 @@ Perl_ck_ftst(pTHX_ OP *o) OP * Perl_ck_fun(pTHX_ OP *o) { - dTHR; register OP *kid; OP **tokid; OP *sibl; @@ -5843,7 +5791,6 @@ Perl_ck_lfun(pTHX_ OP *o) OP * Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ { - dTHR; if ((o->op_flags & OPf_KIDS) && ckWARN(WARN_DEPRECATED)) { switch (cUNOPo->op_first->op_type) { case OP_RV2AV: @@ -6214,7 +6161,6 @@ Perl_ck_sort(pTHX_ OP *o) STATIC void S_simplify_sort(pTHX_ OP *o) { - dTHR; register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ OP *k; int reversed; @@ -6348,7 +6294,6 @@ Perl_ck_join(pTHX_ OP *o) OP * Perl_ck_subr(pTHX_ OP *o) { - dTHR; OP *prev = ((cUNOPo->op_first->op_sibling) ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first; OP *o2 = prev->op_sibling; @@ -6563,7 +6508,6 @@ Perl_ck_substr(pTHX_ OP *o) void Perl_peep(pTHX_ register OP *o) { - dTHR; register OP* oldop = 0; STRLEN n_a; OP *last_composite = Nullop; diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs index 1dc20d3c04..b196ea19b8 100644 --- a/os2/OS2/REXX/REXX.xs +++ b/os2/OS2/REXX/REXX.xs @@ -46,7 +46,6 @@ static long incompartment; static SV* exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler) { - dTHR; HMODULE hRexx, hRexxAPI; BYTE buf[200]; LONG APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING, @@ -377,7 +377,6 @@ spawn_sighandler(int sig) static int result(pTHX_ int flag, int pid) { - dTHR; int r, status; Signal_t (*ihand)(); /* place to save signal during system() */ Signal_t (*qhand)(); /* place to save signal during system() */ @@ -469,7 +468,6 @@ static ULONG os2_mytype; int do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) { - dTHR; int trueflag = flag; int rc, pass = 1; char *tmps; @@ -825,7 +823,6 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag) int do_spawn3(pTHX_ char *cmd, int execf, int flag) { - dTHR; register char **a; register char *s; char flags[10]; @@ -953,7 +950,6 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) int os2_do_aspawn(pTHX_ SV *really, register SV **mark, register SV **sp) { - dTHR; register char **a; int rc; int flag = P_WAIT, flag_set = 0; @@ -991,21 +987,18 @@ os2_do_aspawn(pTHX_ SV *really, register SV **mark, register SV **sp) int os2_do_spawn(pTHX_ char *cmd) { - dTHR; return do_spawn3(aTHX_ cmd, EXECF_SPAWN, 0); } int do_spawn_nowait(pTHX_ char *cmd) { - dTHR; return do_spawn3(aTHX_ cmd, EXECF_SPAWN_NOWAIT,0); } bool Perl_do_exec(pTHX_ char *cmd) { - dTHR; do_spawn3(aTHX_ cmd, EXECF_EXEC, 0); return FALSE; } @@ -1013,7 +1006,6 @@ Perl_do_exec(pTHX_ char *cmd) bool os2exec(pTHX_ char *cmd) { - dTHR; return do_spawn3(aTHX_ cmd, EXECF_TRUEEXEC, 0); } @@ -1374,7 +1366,6 @@ os2error(int rc) char * os2_execname(pTHX) { - dTHR; char buf[300], *p; if (_execname(buf, sizeof buf) != 0) diff --git a/os2/os2ish.h b/os2/os2ish.h index c9719e65bd..dccd9320b6 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -155,7 +155,6 @@ extern int rc; Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc); \ } STMT_END /*#define THR ((struct thread *) TlsGetValue(PL_thr_key)) -#define dTHR struct thread *thr = THR */ #ifdef USE_SLOW_THREAD_SPECIFIC @@ -298,7 +298,6 @@ Shuts down a Perl interpreter. See L<perlembed>. void perl_destruct(pTHXx) { - dTHR; int destruct_level; /* 0=none, 1=full, 2=full with checks */ I32 last_sv_count; HV *hv; @@ -816,7 +815,6 @@ Tells a Perl interpreter to parse a Perl script. See L<perlembed>. int perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) { - dTHR; I32 oldscope; int ret; dJMPENV; @@ -918,7 +916,6 @@ S_vparse_body(pTHX_ va_list args) STATIC void * S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { - dTHR; int argc = PL_origargc; char **argv = PL_origargv; char *scriptname = NULL; @@ -1349,7 +1346,6 @@ Tells a Perl interpreter to run. See L<perlembed>. int perl_run(pTHXx) { - dTHR; I32 oldscope; int ret = 0; dJMPENV; @@ -1417,8 +1413,6 @@ S_vrun_body(pTHX_ va_list args) STATIC void * S_run_body(pTHX_ I32 oldscope) { - dTHR; - DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n", PL_sawampersand ? "Enabling" : "Omitting")); @@ -1477,10 +1471,8 @@ Perl_get_sv(pTHX_ const char *name, I32 create) #ifdef USE_THREADS if (name[1] == '\0' && !isALPHA(name[0])) { PADOFFSET tmp = find_threadsv(name); - if (tmp != NOT_IN_PAD) { - dTHR; + if (tmp != NOT_IN_PAD) return THREADSV(tmp); - } } #endif /* USE_THREADS */ gv = gv_fetchpv(name, create, SVt_PV); @@ -1800,8 +1792,6 @@ S_vcall_body(pTHX_ va_list args) STATIC void S_call_body(pTHX_ OP *myop, int is_eval) { - dTHR; - if (PL_op == myop) { if (is_eval) PL_op = Perl_pp_entereval(aTHX); /* this doesn't do a POPMARK */ @@ -2034,7 +2024,6 @@ Perl_moreswitches(pTHX_ char *s) switch (*s) { case '0': { - dTHR; numlen = 0; /* disallow underscores */ rschar = (U32)scan_oct(s, 4, &numlen); SvREFCNT_dec(PL_nrs); @@ -2110,7 +2099,6 @@ Perl_moreswitches(pTHX_ char *s) } PL_debug |= 0x80000000; #else - dTHR; if (ckWARN_d(WARN_DEBUGGING)) Perl_warner(aTHX_ WARN_DEBUGGING, "Recompile perl with -DDEBUGGING to use -D switch\n"); @@ -2172,7 +2160,6 @@ Perl_moreswitches(pTHX_ char *s) s += numlen; } else { - dTHR; if (RsPARA(PL_nrs)) { PL_ors = "\n\n"; PL_orslen = 2; @@ -2487,7 +2474,6 @@ S_init_interp(pTHX) STATIC void S_init_main_stash(pTHX) { - dTHR; GV *gv; /* Note that strtab is a rather special HV. Assumptions are made @@ -2531,8 +2517,6 @@ S_init_main_stash(pTHX) STATIC void S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) { - dTHR; - *fdscript = -1; if (PL_e_script) { @@ -2826,7 +2810,6 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) */ #ifdef DOSUID - dTHR; char *s, *s2; if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0) /* normal stat is insecure */ @@ -3024,7 +3007,6 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #else /* !DOSUID */ if (PL_euid != PL_uid || PL_egid != PL_gid) { /* (suidperl doesn't exist, in fact) */ #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW - dTHR; PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf); /* may be either wrapped or real suid */ if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) || @@ -3115,7 +3097,6 @@ S_forbid_setid(pTHX_ char *s) void Perl_init_debugger(pTHX) { - dTHR; HV *ostash = PL_curstash; PL_curstash = PL_debstash; @@ -3183,7 +3164,6 @@ Perl_init_stacks(pTHX) STATIC void S_nuke_stacks(pTHX) { - dTHR; while (PL_curstackinfo->si_next) PL_curstackinfo = PL_curstackinfo->si_next; while (PL_curstackinfo) { @@ -3220,7 +3200,6 @@ S_init_lexer(pTHX) STATIC void S_init_predump_symbols(pTHX) { - dTHR; GV *tmpgv; IO *io; @@ -3260,7 +3239,6 @@ S_init_predump_symbols(pTHX) STATIC void S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env) { - dTHR; char *s; SV *sv; GV* tmpgv; @@ -3655,8 +3633,9 @@ S_init_main_thread(pTHX) PERL_SET_THX(thr); /* - * These must come after the SET_THR because sv_setpvn does - * SvTAINT and the taint fields require dTHR. + * These must come after the thread self setting + * because sv_setpvn does SvTAINT and the taint + * fields thread selfness being set. */ PL_toptarget = NEWSV(0,0); sv_upgrade(PL_toptarget, SVt_PVFM); @@ -3684,7 +3663,6 @@ S_init_main_thread(pTHX) void Perl_call_list(pTHX_ I32 oldscope, AV *paramList) { - dTHR; SV *atsv; line_t oldline = CopLINE(PL_curcop); CV *cv; @@ -3789,8 +3767,6 @@ S_call_list_body(pTHX_ CV *cv) void Perl_my_exit(pTHX_ U32 status) { - dTHR; - DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n", thr, (unsigned long) status)); switch (status) { @@ -3839,7 +3815,6 @@ Perl_my_failure_exit(pTHX) STATIC void S_my_exit_jump(pTHX) { - dTHR; register PERL_CONTEXT *cx; I32 gimme; SV **newsp; @@ -183,7 +183,7 @@ class CPerlObj; struct perl_thread; # define pTHX register struct perl_thread *thr # define aTHX thr -# define dTHR dNOOP +# define dTHR dNOOP /* only backward compatibility */ # define dTHXa(a) pTHX = (struct perl_thread*)a # else # ifndef MULTIPLICITY @@ -303,7 +303,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #endif #define WITH_THX(s) STMT_START { dTHX; s; } STMT_END -#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END +#define WITH_THR(s) WITH_THX(s) /* * SOFT_CAST can be used for args to prototyped functions to retain some @@ -936,7 +936,7 @@ Perl_hv_delayfree_ent(pTHXo_ HV* hv, HE* entry) #undef Perl_hv_delete SV* -Perl_hv_delete(pTHXo_ HV* tb, const char* key, U32 klen, I32 flags) +Perl_hv_delete(pTHXo_ HV* tb, const char* key, I32 klen, I32 flags) { return ((CPerlObj*)pPerl)->Perl_hv_delete(tb, key, klen, flags); } @@ -950,7 +950,7 @@ Perl_hv_delete_ent(pTHXo_ HV* tb, SV* key, I32 flags, U32 hash) #undef Perl_hv_exists bool -Perl_hv_exists(pTHXo_ HV* tb, const char* key, U32 klen) +Perl_hv_exists(pTHXo_ HV* tb, const char* key, I32 klen) { return ((CPerlObj*)pPerl)->Perl_hv_exists(tb, key, klen); } @@ -964,7 +964,7 @@ Perl_hv_exists_ent(pTHXo_ HV* tb, SV* key, U32 hash) #undef Perl_hv_fetch SV** -Perl_hv_fetch(pTHXo_ HV* tb, const char* key, U32 klen, I32 lval) +Perl_hv_fetch(pTHXo_ HV* tb, const char* key, I32 klen, I32 lval) { return ((CPerlObj*)pPerl)->Perl_hv_fetch(tb, key, klen, lval); } @@ -1041,7 +1041,7 @@ Perl_hv_magic(pTHXo_ HV* hv, GV* gv, int how) #undef Perl_hv_store SV** -Perl_hv_store(pTHXo_ HV* tb, const char* key, U32 klen, SV* val, U32 hash) +Perl_hv_store(pTHXo_ HV* tb, const char* key, I32 klen, SV* val, U32 hash) { return ((CPerlObj*)pPerl)->Perl_hv_store(tb, key, klen, val, hash); } @@ -3365,7 +3365,7 @@ Perl_utf8_length(pTHXo_ U8* s, U8 *e) } #undef Perl_utf8_distance -I32 +IV Perl_utf8_distance(pTHXo_ U8 *a, U8 *b) { return ((CPerlObj*)pPerl)->Perl_utf8_distance(a, b); @@ -1792,7 +1792,6 @@ S_seed(pTHX) #define SEED_C3 269 #define SEED_C5 26107 - dTHR; #ifndef PERL_NO_DEV_RANDOM int fd; #endif @@ -5338,7 +5337,6 @@ PP(pp_split) void Perl_unlock_condpair(pTHX_ void *svv) { - dTHR; MAGIC *mg = mg_find((SV*)svv, 'm'); if (!mg) @@ -61,7 +61,7 @@ Refetch the stack pointer. Used after a callback. See L<perlcall>. #define POPMARK (*PL_markstack_ptr--) #define djSP register SV **sp = PL_stack_sp -#define dSP dTHR; djSP +#define dSP djSP #define dMARK register SV **mark = PL_stack_base + POPMARK #define dORIGMARK I32 origmark = mark - PL_stack_base #define SETORIGMARK origmark = mark - PL_stack_base @@ -1160,7 +1160,6 @@ PP(pp_flop) STATIC I32 S_dopoptolabel(pTHX_ char *label) { - dTHR; register I32 i; register PERL_CONTEXT *cx; @@ -1216,7 +1215,6 @@ Perl_dowantarray(pTHX) I32 Perl_block_gimme(pTHX) { - dTHR; I32 cxix; cxix = dopoptosub(cxstack_ix); @@ -1240,14 +1238,12 @@ Perl_block_gimme(pTHX) STATIC I32 S_dopoptosub(pTHX_ I32 startingblock) { - dTHR; return dopoptosub_at(cxstack, startingblock); } STATIC I32 S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock) { - dTHR; I32 i; register PERL_CONTEXT *cx; for (i = startingblock; i >= 0; i--) { @@ -1268,7 +1264,6 @@ S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock) STATIC I32 S_dopoptoeval(pTHX_ I32 startingblock) { - dTHR; I32 i; register PERL_CONTEXT *cx; for (i = startingblock; i >= 0; i--) { @@ -1287,7 +1282,6 @@ S_dopoptoeval(pTHX_ I32 startingblock) STATIC I32 S_dopoptoloop(pTHX_ I32 startingblock) { - dTHR; I32 i; register PERL_CONTEXT *cx; for (i = startingblock; i >= 0; i--) { @@ -1329,7 +1323,6 @@ S_dopoptoloop(pTHX_ I32 startingblock) void Perl_dounwind(pTHX_ I32 cxix) { - dTHR; register PERL_CONTEXT *cx; I32 optype; @@ -1375,7 +1368,6 @@ Perl_dounwind(pTHX_ I32 cxix) STATIC void S_free_closures(pTHX) { - dTHR; SV **svp = AvARRAY(PL_comppad_name); I32 ix; for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) { @@ -1768,7 +1760,6 @@ PP(pp_enteriter) #ifdef USE_THREADS if (PL_op->op_flags & OPf_SPECIAL) { - dTHR; svp = &THREADSV(PL_op->op_targ); /* per-thread variable */ SAVEGENERICSV(*svp); *svp = NEWSV(0,0); @@ -2158,7 +2149,6 @@ S_dofindlabel(pTHX_ OP *o, char *label, OP **opstack, OP **oplimit) } *ops = 0; if (o->op_flags & OPf_KIDS) { - dTHR; /* First try all the kids at this level, since that's likeliest. */ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && @@ -2669,7 +2659,6 @@ S_docatch_body(pTHX) STATIC OP * S_docatch(pTHX_ OP *o) { - dTHR; int ret; OP *oldop = PL_op; volatile PERL_SI *cursi = PL_curstackinfo; @@ -4147,7 +4136,6 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp) static I32 sortcv(pTHXo_ SV *a, SV *b) { - dTHR; I32 oldsaveix = PL_savestack_ix; I32 oldscopeix = PL_scopestack_ix; I32 result; @@ -4171,7 +4159,6 @@ sortcv(pTHXo_ SV *a, SV *b) static I32 sortcv_stacked(pTHXo_ SV *a, SV *b) { - dTHR; I32 oldsaveix = PL_savestack_ix; I32 oldscopeix = PL_scopestack_ix; I32 result; @@ -406,7 +406,6 @@ PP(pp_print) RETURN; } if (!(io = GvIO(gv))) { - dTHR; if ((GvEGV(gv)) && (mg = SvTIED_mg((SV*)GvEGV(gv),'q'))) goto had_magic; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) @@ -2288,7 +2287,6 @@ PP(pp_leavesublv) STATIC CV * S_get_db_sub(pTHX_ SV **svp, CV *cv) { - dTHR; SV *dbsv = GvSV(PL_DBsub); if (!PERLDB_SUB_NN) { @@ -2992,9 +2990,6 @@ static void unset_cvowner(pTHXo_ void *cvarg) { register CV* cv = (CV *) cvarg; -#ifdef DEBUGGING - dTHR; -#endif /* DEBUGGING */ DEBUG_S((PerlIO_printf(Perl_debug_log, "%p unsetting CvOWNER of %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); @@ -1059,7 +1059,6 @@ PP(pp_sselect) void Perl_setdefout(pTHX_ GV *gv) { - dTHR; if (gv) (void)SvREFCNT_inc(gv); if (PL_defoutgv) @@ -1142,7 +1141,6 @@ PP(pp_read) STATIC OP * S_doform(pTHX_ CV *cv, GV *gv, OP *retop) { - dTHR; register PERL_CONTEXT *cx; I32 gimme = GIMME_V; AV* padlist = CvPADLIST(cv); @@ -1378,7 +1376,6 @@ PP(pp_prtf) sv = NEWSV(0,0); if (!(io = GvIO(gv))) { - dTHR; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); @@ -2562,7 +2559,6 @@ PP(pp_stat) ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1); } if (PL_laststatval < 0) { - dTHR; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, GvIO(gv), PL_op->op_type); max = 0; @@ -3117,7 +3113,6 @@ PP(pp_fttext) len = 512; } else { - dTHR; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) { gv = cGVOP_gv; report_evil_fh(gv, GvIO(gv), PL_op->op_type); @@ -431,7 +431,6 @@ static void clear_re(pTHXo_ void *r); STATIC void S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data) { - dTHR; STRLEN l = CHR_SVLEN(data->last_found); STRLEN old_l = CHR_SVLEN(*data->longest); @@ -596,7 +595,6 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg /* deltap: Write maxlen-minlen here. */ /* last: Stop before this one. */ { - dTHR; I32 min = 0, pars = 0, code; regnode *scan = *scanp, *next; I32 delta = 0; @@ -1521,7 +1519,6 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg STATIC I32 S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, char *s) { - dTHR; if (RExC_rx->data) { Renewc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1), @@ -1542,7 +1539,6 @@ S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, char *s) void Perl_reginitcolors(pTHX) { - dTHR; int i = 0; char *s = PerlEnv_getenv("PERL_RE_COLORS"); @@ -1583,7 +1579,6 @@ Perl_reginitcolors(pTHX) regexp * Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) { - dTHR; register regexp *r; regnode *scan; regnode *first; @@ -1956,7 +1951,6 @@ STATIC regnode * S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */ { - dTHR; register regnode *ret; /* Will be the head of the group. */ register regnode *br; register regnode *lastbr; @@ -2015,7 +2009,6 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) /* FALL THROUGH */ case '{': { - dTHR; I32 count = 1, n = 0; char c; char *s = RExC_parse; @@ -2301,7 +2294,6 @@ 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) { - dTHR; register regnode *ret; register regnode *chain = NULL; register regnode *latest; @@ -2367,7 +2359,6 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first) STATIC regnode * S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) { - dTHR; register regnode *ret; register char op; register char *next; @@ -2535,7 +2526,6 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) STATIC regnode * S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp) { - dTHR; register regnode *ret = 0; I32 flags; @@ -3050,7 +3040,6 @@ S_regwhite(pTHX_ char *p, char *e) STATIC I32 S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) { - dTHR; char *posixcc = 0; I32 namedclass = OOB_NAMEDCLASS; @@ -3205,7 +3194,6 @@ S_checkposixcc(pTHX_ RExC_state_t *pRExC_state) STATIC regnode * S_regclass(pTHX_ RExC_state_t *pRExC_state) { - dTHR; register U32 value; register I32 lastvalue = OOB_CHAR8; register I32 range = 0; @@ -3682,7 +3670,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state) STATIC regnode * S_regclassutf8(pTHX_ RExC_state_t *pRExC_state) { - dTHR; register char *e; register U32 value; register U32 lastvalue = OOB_UTF8; @@ -3953,7 +3940,6 @@ S_regclassutf8(pTHX_ RExC_state_t *pRExC_state) STATIC char* S_nextchar(pTHX_ RExC_state_t *pRExC_state) { - dTHR; char* retval = RExC_parse++; for (;;) { @@ -3986,7 +3972,6 @@ S_nextchar(pTHX_ RExC_state_t *pRExC_state) STATIC regnode * /* Location. */ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op) { - dTHR; register regnode *ret; register regnode *ptr; @@ -4011,7 +3996,6 @@ 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) { - dTHR; register regnode *ret; register regnode *ptr; @@ -4036,7 +4020,6 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) STATIC void S_reguni(pTHX_ RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) { - dTHR; *lenp = SIZE_ONLY ? UNISKIP(uv) : (uv_to_utf8((U8*)s, uv) - (U8*)s); } @@ -4048,7 +4031,6 @@ S_reguni(pTHX_ 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) { - dTHR; register regnode *src; register regnode *dst; register regnode *place; @@ -4079,7 +4061,6 @@ 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) { - dTHR; register regnode *scan; register regnode *temp; @@ -4109,7 +4090,6 @@ 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) { - dTHR; /* "Operandless" and "op != BRANCH" are synonymous in practice. */ if (p == NULL || SIZE_ONLY) return; @@ -4223,7 +4203,6 @@ void Perl_regdump(pTHX_ regexp *r) { #ifdef DEBUGGING - dTHR; SV *sv = sv_newmortal(); (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0); @@ -4305,7 +4284,6 @@ void Perl_regprop(pTHX_ SV *sv, regnode *o) { #ifdef DEBUGGING - dTHR; register int k; sv_setpvn(sv, "", 0); @@ -4477,7 +4455,6 @@ Perl_re_intuit_string(pTHX_ regexp *prog) void Perl_pregfree(pTHX_ struct regexp *r) { - dTHR; DEBUG_r(if (!PL_colorset) reginitcolors()); if (!r || (--r->refcnt > 0)) @@ -4568,7 +4545,6 @@ Perl_pregfree(pTHX_ struct regexp *r) regnode * Perl_regnext(pTHX_ register regnode *p) { - dTHR; register I32 offset; if (p == &PL_regdummy) @@ -4620,8 +4596,6 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...) void Perl_save_re_context(pTHX) { - dTHR; - #if 0 SAVEPPTR(RExC_precomp); /* uncompiled string. */ SAVEI32(RExC_npar); /* () count. */ @@ -128,7 +128,6 @@ static void restore_pos(pTHXo_ void *arg); STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor) { - dTHR; int retval = PL_savestack_ix; int i = (PL_regsize - parenfloor) * 4; int p; @@ -161,7 +160,6 @@ S_regcppush(pTHX_ I32 parenfloor) STATIC char * S_regcppop(pTHX) { - dTHR; I32 i = SSPOPINT; U32 paren = 0; char *input; @@ -217,7 +215,6 @@ S_regcppop(pTHX) STATIC char * S_regcp_set_to(pTHX_ I32 ss) { - dTHR; I32 tmp = PL_savestack_ix; PL_savestack_ix = ss; @@ -276,7 +273,6 @@ Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *stren STATIC void S_cache_re(pTHX_ regexp *prog) { - dTHR; PL_regprecomp = prog->precomp; /* Needed for FAIL. */ #ifdef DEBUGGING PL_regprogram = prog->program; @@ -1342,7 +1338,6 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * /* data: May be used for some additional optimizations. */ /* nosave: For optimizations. */ { - dTHR; register char *s; register regnode *c; register char *startpos = stringarg; @@ -1726,7 +1721,6 @@ phooey: STATIC I32 /* 0 failure, 1 success */ S_regtry(pTHX_ regexp *prog, char *startpos) { - dTHR; register I32 i; register I32 *sp; register I32 *ep; @@ -1884,7 +1878,6 @@ typedef union re_unwind_t { STATIC I32 /* 0 failure, 1 success */ S_regmatch(pTHX_ regnode *prog) { - dTHR; register regnode *scan; /* Current node. */ regnode *next; /* Next node. */ regnode *inner; /* Next node in internal branch. */ @@ -3464,7 +3457,6 @@ do_no: STATIC I32 S_regrepeat(pTHX_ regnode *p, I32 max) { - dTHR; register char *scan; register I32 c; register char *loceol = PL_regeol; @@ -3676,7 +3668,6 @@ S_regrepeat(pTHX_ regnode *p, I32 max) STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) { - dTHR; register char *scan; register char *start; register char *loceol = PL_regeol; @@ -3727,7 +3718,6 @@ S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) STATIC bool S_reginclass(pTHX_ register regnode *p, register I32 c) { - dTHR; char flags = ANYOF_FLAGS(p); bool match = FALSE; @@ -3791,7 +3781,6 @@ S_reginclass(pTHX_ register regnode *p, register I32 c) STATIC bool S_reginclassutf8(pTHX_ regnode *f, U8 *p) { - dTHR; char flags = ARG1(f); bool match = FALSE; #ifdef DEBUGGING @@ -3825,7 +3814,6 @@ S_reginclassutf8(pTHX_ regnode *f, U8 *p) STATIC U8 * S_reghop(pTHX_ U8 *s, I32 off) { - dTHR; if (off >= 0) { while (off-- && s < (U8*)PL_regeol) s += UTF8SKIP(s); @@ -3847,7 +3835,6 @@ S_reghop(pTHX_ U8 *s, I32 off) STATIC U8 * S_reghopmaybe(pTHX_ U8* s, I32 off) { - dTHR; if (off >= 0) { while (off-- && s < (U8*)PL_regeol) s += UTF8SKIP(s); @@ -3879,7 +3866,6 @@ S_reghopmaybe(pTHX_ U8* s, I32 off) static void restore_pos(pTHXo_ void *arg) { - dTHR; if (PL_reg_eval_set) { if (PL_reg_oldsaved) { PL_reg_re->subbeg = PL_reg_oldsaved; @@ -20,8 +20,6 @@ int Perl_runops_standard(pTHX) { - dTHR; - while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) { PERL_ASYNC_CHECK(); } @@ -34,7 +32,6 @@ int Perl_runops_debug(pTHX) { #ifdef DEBUGGING - dTHR; if (!PL_op) { if (ckWARN_d(WARN_DEBUGGING)) Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN"); @@ -96,7 +93,6 @@ void Perl_watch(pTHX_ char **addr) { #ifdef DEBUGGING - dTHR; PL_watchaddr = addr; PL_watchok = *addr; PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n", @@ -33,7 +33,6 @@ void * Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, protect_body_t body, va_list *args) { - dTHR; int ex; void *ret; @@ -51,7 +50,6 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, SV** Perl_stack_grow(pTHX_ SV **sp, SV **p, int n) { - dTHR; #if defined(DEBUGGING) && !defined(USE_THREADS) static int growing = 0; if (growing++) @@ -97,7 +95,6 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems) I32 Perl_cxinc(pTHX) { - dTHR; cxstack_max = GROW(cxstack_max); Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */ return cxstack_ix + 1; @@ -106,7 +103,6 @@ Perl_cxinc(pTHX) void Perl_push_return(pTHX_ OP *retop) { - dTHR; if (PL_retstack_ix == PL_retstack_max) { PL_retstack_max = GROW(PL_retstack_max); Renew(PL_retstack, PL_retstack_max, OP*); @@ -117,7 +113,6 @@ Perl_push_return(pTHX_ OP *retop) OP * Perl_pop_return(pTHX) { - dTHR; if (PL_retstack_ix > 0) return PL_retstack[--PL_retstack_ix]; else @@ -127,7 +122,6 @@ Perl_pop_return(pTHX) void Perl_push_scope(pTHX) { - dTHR; if (PL_scopestack_ix == PL_scopestack_max) { PL_scopestack_max = GROW(PL_scopestack_max); Renew(PL_scopestack, PL_scopestack_max, I32); @@ -139,7 +133,6 @@ Perl_push_scope(pTHX) void Perl_pop_scope(pTHX) { - dTHR; I32 oldsave = PL_scopestack[--PL_scopestack_ix]; LEAVE_SCOPE(oldsave); } @@ -147,7 +140,6 @@ Perl_pop_scope(pTHX) void Perl_markstack_grow(pTHX) { - dTHR; I32 oldmax = PL_markstack_max - PL_markstack; I32 newmax = GROW(oldmax); @@ -159,7 +151,6 @@ Perl_markstack_grow(pTHX) void Perl_savestack_grow(pTHX) { - dTHR; PL_savestack_max = GROW(PL_savestack_max) + 4; Renew(PL_savestack, PL_savestack_max, ANY); } @@ -169,7 +160,6 @@ Perl_savestack_grow(pTHX) void Perl_tmps_grow(pTHX_ I32 n) { - dTHR; #ifndef STRESS_REALLOC if (n < 128) n = (PL_tmps_max < 512) ? 128 : 512; @@ -182,7 +172,6 @@ Perl_tmps_grow(pTHX_ I32 n) void Perl_free_tmps(pTHX) { - dTHR; /* XXX should tmps_floor live in cxstack? */ I32 myfloor = PL_tmps_floor; while (PL_tmps_ix > myfloor) { /* clean up after last statement */ @@ -198,7 +187,6 @@ Perl_free_tmps(pTHX) STATIC SV * S_save_scalar_at(pTHX_ SV **sptr) { - dTHR; register SV *sv; SV *osv = *sptr; @@ -229,7 +217,6 @@ S_save_scalar_at(pTHX_ SV **sptr) SV * Perl_save_scalar(pTHX_ GV *gv) { - dTHR; SV **sptr = &GvSV(gv); SSCHECK(3); SSPUSHPTR(SvREFCNT_inc(gv)); @@ -241,7 +228,6 @@ Perl_save_scalar(pTHX_ GV *gv) SV* Perl_save_svref(pTHX_ SV **sptr) { - dTHR; SSCHECK(3); SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); @@ -254,7 +240,6 @@ Perl_save_svref(pTHX_ SV **sptr) void Perl_save_generic_svref(pTHX_ SV **sptr) { - dTHR; SSCHECK(3); SSPUSHPTR(sptr); SSPUSHPTR(SvREFCNT_inc(*sptr)); @@ -267,7 +252,6 @@ Perl_save_generic_svref(pTHX_ SV **sptr) void Perl_save_generic_pvref(pTHX_ char **str) { - dTHR; SSCHECK(3); SSPUSHPTR(str); SSPUSHPTR(*str); @@ -277,7 +261,6 @@ Perl_save_generic_pvref(pTHX_ char **str) void Perl_save_gp(pTHX_ GV *gv, I32 empty) { - dTHR; SSCHECK(6); SSPUSHIV((IV)SvLEN(gv)); SvLEN(gv) = 0; /* forget that anything was allocated here */ @@ -314,7 +297,6 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) AV * Perl_save_ary(pTHX_ GV *gv) { - dTHR; AV *oav = GvAVn(gv); AV *av; @@ -342,7 +324,6 @@ Perl_save_ary(pTHX_ GV *gv) HV * Perl_save_hash(pTHX_ GV *gv) { - dTHR; HV *ohv, *hv; SSCHECK(3); @@ -367,7 +348,6 @@ Perl_save_hash(pTHX_ GV *gv) void Perl_save_item(pTHX_ register SV *item) { - dTHR; register SV *sv = NEWSV(0,0); sv_setsv(sv,item); @@ -380,7 +360,6 @@ Perl_save_item(pTHX_ register SV *item) void Perl_save_int(pTHX_ int *intp) { - dTHR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -390,7 +369,6 @@ Perl_save_int(pTHX_ int *intp) void Perl_save_long(pTHX_ long int *longp) { - dTHR; SSCHECK(3); SSPUSHLONG(*longp); SSPUSHPTR(longp); @@ -400,7 +378,6 @@ Perl_save_long(pTHX_ long int *longp) void Perl_save_I32(pTHX_ I32 *intp) { - dTHR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -410,7 +387,6 @@ Perl_save_I32(pTHX_ I32 *intp) void Perl_save_I16(pTHX_ I16 *intp) { - dTHR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -420,7 +396,6 @@ Perl_save_I16(pTHX_ I16 *intp) void Perl_save_I8(pTHX_ I8 *bytep) { - dTHR; SSCHECK(3); SSPUSHINT(*bytep); SSPUSHPTR(bytep); @@ -430,7 +405,6 @@ Perl_save_I8(pTHX_ I8 *bytep) void Perl_save_iv(pTHX_ IV *ivp) { - dTHR; SSCHECK(3); SSPUSHIV(*ivp); SSPUSHPTR(ivp); @@ -443,7 +417,6 @@ Perl_save_iv(pTHX_ IV *ivp) void Perl_save_pptr(pTHX_ char **pptr) { - dTHR; SSCHECK(3); SSPUSHPTR(*pptr); SSPUSHPTR(pptr); @@ -453,7 +426,6 @@ Perl_save_pptr(pTHX_ char **pptr) void Perl_save_vptr(pTHX_ void *ptr) { - dTHR; SSCHECK(3); SSPUSHPTR(*(char**)ptr); SSPUSHPTR(ptr); @@ -463,7 +435,6 @@ Perl_save_vptr(pTHX_ void *ptr) void Perl_save_sptr(pTHX_ SV **sptr) { - dTHR; SSCHECK(3); SSPUSHPTR(*sptr); SSPUSHPTR(sptr); @@ -473,7 +444,6 @@ Perl_save_sptr(pTHX_ SV **sptr) void Perl_save_padsv(pTHX_ PADOFFSET off) { - dTHR; SSCHECK(4); SSPUSHPTR(PL_curpad[off]); SSPUSHPTR(PL_curpad); @@ -485,7 +455,6 @@ SV ** Perl_save_threadsv(pTHX_ PADOFFSET i) { #ifdef USE_THREADS - dTHR; SV **svp = &THREADSV(i); /* XXX Change to save by offset */ DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n", (UV)i, svp, *svp, SvPEEK(*svp))); @@ -500,7 +469,6 @@ Perl_save_threadsv(pTHX_ PADOFFSET i) void Perl_save_nogv(pTHX_ GV *gv) { - dTHR; SSCHECK(2); SSPUSHPTR(gv); SSPUSHINT(SAVEt_NSTAB); @@ -509,7 +477,6 @@ Perl_save_nogv(pTHX_ GV *gv) void Perl_save_hptr(pTHX_ HV **hptr) { - dTHR; SSCHECK(3); SSPUSHPTR(*hptr); SSPUSHPTR(hptr); @@ -519,7 +486,6 @@ Perl_save_hptr(pTHX_ HV **hptr) void Perl_save_aptr(pTHX_ AV **aptr) { - dTHR; SSCHECK(3); SSPUSHPTR(*aptr); SSPUSHPTR(aptr); @@ -529,7 +495,6 @@ Perl_save_aptr(pTHX_ AV **aptr) void Perl_save_freesv(pTHX_ SV *sv) { - dTHR; SSCHECK(2); SSPUSHPTR(sv); SSPUSHINT(SAVEt_FREESV); @@ -538,7 +503,6 @@ Perl_save_freesv(pTHX_ SV *sv) void Perl_save_freeop(pTHX_ OP *o) { - dTHR; SSCHECK(2); SSPUSHPTR(o); SSPUSHINT(SAVEt_FREEOP); @@ -547,7 +511,6 @@ Perl_save_freeop(pTHX_ OP *o) void Perl_save_freepv(pTHX_ char *pv) { - dTHR; SSCHECK(2); SSPUSHPTR(pv); SSPUSHINT(SAVEt_FREEPV); @@ -556,7 +519,6 @@ Perl_save_freepv(pTHX_ char *pv) void Perl_save_clearsv(pTHX_ SV **svp) { - dTHR; SSCHECK(2); SSPUSHLONG((long)(svp-PL_curpad)); SSPUSHINT(SAVEt_CLEARSV); @@ -565,7 +527,6 @@ Perl_save_clearsv(pTHX_ SV **svp) void Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen) { - dTHR; SSCHECK(4); SSPUSHINT(klen); SSPUSHPTR(key); @@ -576,7 +537,6 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen) void Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg) { - dTHR; register SV *sv; register I32 i; @@ -593,7 +553,6 @@ Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg) void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) { - dTHR; SSCHECK(3); SSPUSHDPTR(f); SSPUSHPTR(p); @@ -603,7 +562,6 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) { - dTHR; SSCHECK(3); SSPUSHDXPTR(f); SSPUSHPTR(p); @@ -613,7 +571,6 @@ Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) void Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) { - dTHR; SSCHECK(4); SSPUSHPTR(SvREFCNT_inc(av)); SSPUSHINT(idx); @@ -625,7 +582,6 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) { - dTHR; SSCHECK(4); SSPUSHPTR(SvREFCNT_inc(hv)); SSPUSHPTR(SvREFCNT_inc(key)); @@ -637,7 +593,6 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr) void Perl_save_op(pTHX) { - dTHR; SSCHECK(2); SSPUSHPTR(PL_op); SSPUSHINT(SAVEt_OP); @@ -646,7 +601,6 @@ Perl_save_op(pTHX) I32 Perl_save_alloc(pTHX_ I32 size, I32 pad) { - dTHR; register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix] - (char*)PL_savestack); register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack)); @@ -664,7 +618,6 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad) void Perl_leave_scope(pTHX_ I32 base) { - dTHR; register SV *sv; register SV *value; register GV *gv; @@ -990,7 +943,6 @@ void Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) { #ifdef DEBUGGING - dTHR; PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]); if (CxTYPE(cx) != CXt_SUBST) { PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); @@ -1285,11 +1285,8 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i) case SVt_PVCV: case SVt_PVFM: case SVt_PVIO: - { - dTHR; - Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0), - PL_op_desc[PL_op->op_type]); - } + Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0), + PL_op_desc[PL_op->op_type]); } (void)SvIOK_only(sv); /* validate number */ SvIVX(sv) = i; @@ -1373,11 +1370,8 @@ Perl_sv_setnv(pTHX_ register SV *sv, NV num) case SVt_PVCV: case SVt_PVFM: case SVt_PVIO: - { - dTHR; - Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0), - PL_op_name[PL_op->op_type]); - } + Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0), + PL_op_name[PL_op->op_type]); } SvNVX(sv) = num; (void)SvNOK_only(sv); /* validate number */ @@ -1402,7 +1396,6 @@ Perl_sv_setnv_mg(pTHX_ register SV *sv, NV num) STATIC void S_not_a_number(pTHX_ SV *sv) { - dTHR; char tmpbuf[64]; char *d = tmpbuf; char *s; @@ -1482,7 +1475,6 @@ Perl_sv_2iv(pTHX_ register SV *sv) return asIV(sv); if (!SvROK(sv)) { if (!(SvFLAGS(sv) & SVs_PADTMP)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) report_uninit(); } @@ -1501,7 +1493,6 @@ Perl_sv_2iv(pTHX_ register SV *sv) sv_force_normal(sv); } if (SvREADONLY(sv) && !SvOK(sv)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED)) report_uninit(); return 0; @@ -1588,7 +1579,6 @@ Perl_sv_2iv(pTHX_ register SV *sv) } } else { - dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) report_uninit(); if (SvTYPE(sv) < SVt_IV) @@ -1616,7 +1606,6 @@ Perl_sv_2uv(pTHX_ register SV *sv) return asUV(sv); if (!SvROK(sv)) { if (!(SvFLAGS(sv) & SVs_PADTMP)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) report_uninit(); } @@ -1632,7 +1621,6 @@ Perl_sv_2uv(pTHX_ register SV *sv) return PTR2UV(SvRV(sv)); } if (SvREADONLY(sv) && !SvOK(sv)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED)) report_uninit(); return 0; @@ -1732,8 +1720,6 @@ Perl_sv_2uv(pTHX_ register SV *sv) #endif } else { /* Not a number. Cache 0. */ - dTHR; - if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv, SVt_PVIV); (void)SvIOK_on(sv); @@ -1746,7 +1732,6 @@ Perl_sv_2uv(pTHX_ register SV *sv) } else { if (!(SvFLAGS(sv) & SVs_PADTMP)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) report_uninit(); } @@ -1771,7 +1756,6 @@ Perl_sv_2nv(pTHX_ register SV *sv) if (SvNOKp(sv)) return SvNVX(sv); if (SvPOKp(sv) && SvLEN(sv)) { - dTHR; if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv)) not_a_number(sv); return Atof(SvPVX(sv)); @@ -1784,7 +1768,6 @@ Perl_sv_2nv(pTHX_ register SV *sv) } if (!SvROK(sv)) { if (!(SvFLAGS(sv) & SVs_PADTMP)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) report_uninit(); } @@ -1800,7 +1783,6 @@ Perl_sv_2nv(pTHX_ register SV *sv) return PTR2NV(SvRV(sv)); } if (SvREADONLY(sv) && !SvOK(sv)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED)) report_uninit(); return 0.0; @@ -1836,13 +1818,11 @@ Perl_sv_2nv(pTHX_ register SV *sv) SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv); } else if (SvPOKp(sv) && SvLEN(sv)) { - dTHR; if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv)) not_a_number(sv); SvNVX(sv) = Atof(SvPVX(sv)); } else { - dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) report_uninit(); if (SvTYPE(sv) < SVt_NV) @@ -1878,7 +1858,6 @@ S_asIV(pTHX_ SV *sv) if (numtype & IS_NUMBER_TO_INT_BY_ATOL) return Atol(SvPVX(sv)); if (!numtype) { - dTHR; if (ckWARN(WARN_NUMERIC)) not_a_number(sv); } @@ -1896,7 +1875,6 @@ S_asUV(pTHX_ SV *sv) return Strtoul(SvPVX(sv), Null(char**), 10); #endif if (!numtype) { - dTHR; if (ckWARN(WARN_NUMERIC)) not_a_number(sv); } @@ -2112,7 +2090,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) } if (!SvROK(sv)) { if (!(SvFLAGS(sv) & SVs_PADTMP)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) report_uninit(); } @@ -2139,7 +2116,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) == (SVs_OBJECT|SVs_RMG)) && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp") && (mg = mg_find(sv, 'r'))) { - dTHR; regexp *re = (regexp *)mg->mg_obj; if (!mg->mg_ptr) { @@ -2210,7 +2186,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) return s; } if (SvREADONLY(sv) && !SvOK(sv)) { - dTHR; if (ckWARN(WARN_UNINITIALIZED)) report_uninit(); *lp = 0; @@ -2273,12 +2248,9 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) SvPOK_on(sv); } else { - dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) - { report_uninit(); - } *lp = 0; if (SvTYPE(sv) < SVt_PV) /* Typically the caller expects that sv_any is not NULL now. */ @@ -2369,7 +2341,6 @@ Perl_sv_2bool(pTHX_ register SV *sv) if (!SvOK(sv)) return 0; if (SvROK(sv)) { - dTHR; SV* tmpsv; if (SvAMAGIC(sv) && (tmpsv=AMG_CALLun(sv,bool_)) && (SvRV(tmpsv) != SvRV(sv))) @@ -2532,7 +2503,6 @@ C<sv_setsv_mg>. void Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) { - dTHR; register U32 sflags; register int dtype; register int stype; @@ -3101,7 +3071,6 @@ void Perl_sv_force_normal(pTHX_ register SV *sv) { if (SvREADONLY(sv)) { - dTHR; if (SvFAKE(sv)) { char *pvx = SvPVX(sv); STRLEN len = SvCUR(sv); @@ -3322,7 +3291,6 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam MAGIC* mg; if (SvREADONLY(sv)) { - dTHR; if (PL_curcop != &PL_compiling && !strchr("gBf", how)) Perl_croak(aTHX_ PL_no_modify); } @@ -3343,7 +3311,6 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam if (!obj || obj == sv || how == '#' || how == 'r') mg->mg_obj = obj; else { - dTHR; mg->mg_obj = SvREFCNT_inc(obj); mg->mg_flags |= MGf_REFCOUNTED; } @@ -3532,7 +3499,6 @@ Perl_sv_rvweaken(pTHX_ SV *sv) if (!SvROK(sv)) Perl_croak(aTHX_ "Can't weaken a nonreference"); else if (SvWEAKREF(sv)) { - dTHR; if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ WARN_MISC, "Reference is already weak"); return sv; @@ -3685,7 +3651,6 @@ Make the first argument a copy of the second, then delete the original. void Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv) { - dTHR; U32 refcnt = SvREFCNT(sv); SV_CHECK_THINKFIRST(sv); if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL)) @@ -3726,7 +3691,6 @@ Perl_sv_clear(pTHX_ register SV *sv) assert(SvREFCNT(sv) == 0); if (SvOBJECT(sv)) { - dTHR; if (PL_defstash) { /* Still have a symbol table? */ djSP; GV* destructor; @@ -3926,7 +3890,6 @@ Free the memory used by an SV. void Perl_sv_free(pTHX_ SV *sv) { - dTHR; int refcount_is_zero; if (!sv) @@ -4070,7 +4033,6 @@ Perl_sv_pos_b2u(pTHX_ register SV *sv, I32* offsetp) ++len; } if (s != send) { - dTHR; if (ckWARN_d(WARN_UTF8)) Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character"); --len; @@ -4327,7 +4289,6 @@ appending to the currently-stored string. char * Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) { - dTHR; char *rsptr; STRLEN rslen; register STDCHAR rslast; @@ -4613,7 +4574,6 @@ Perl_sv_inc(pTHX_ register SV *sv) mg_get(sv); if (SvTHINKFIRST(sv)) { if (SvREADONLY(sv)) { - dTHR; if (PL_curcop != &PL_compiling) Perl_croak(aTHX_ PL_no_modify); } @@ -4721,7 +4681,6 @@ Perl_sv_dec(pTHX_ register SV *sv) mg_get(sv); if (SvTHINKFIRST(sv)) { if (SvREADONLY(sv)) { - dTHR; if (PL_curcop != &PL_compiling) Perl_croak(aTHX_ PL_no_modify); } @@ -4787,7 +4746,6 @@ as mortal. SV * Perl_sv_mortalcopy(pTHX_ SV *oldstr) { - dTHR; register SV *sv; new_SV(sv); @@ -4809,7 +4767,6 @@ Creates a new SV which is mortal. The reference count of the SV is set to 1. SV * Perl_sv_newmortal(pTHX) { - dTHR; register SV *sv; new_SV(sv); @@ -4833,7 +4790,6 @@ ends. SV * Perl_sv_2mortal(pTHX_ register SV *sv) { - dTHR; if (!sv) return sv; if (SvREADONLY(sv) && SvIMMORTAL(sv)) @@ -5029,7 +4985,6 @@ SV is B<not> incremented. SV * Perl_newRV_noinc(pTHX_ SV *tmpRef) { - dTHR; register SV *sv; new_SV(sv); @@ -5060,7 +5015,6 @@ Creates a new SV which is an exact duplicate of the original SV. SV * Perl_newSVsv(pTHX_ register SV *old) { - dTHR; register SV *sv; if (!old) @@ -5215,7 +5169,6 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref) if (SvGMAGICAL(sv)) mg_get(sv); if (SvROK(sv)) { - dTHR; SV **sp = &sv; /* Used in tryAMAGICunDEREF macro. */ tryAMAGICunDEREF(to_cv); @@ -5271,7 +5224,6 @@ Returns true if the SV has a true value by Perl's rules. I32 Perl_sv_true(pTHX_ register SV *sv) { - dTHR; if (!sv) return 0; if (SvPOK(sv)) { @@ -5367,7 +5319,6 @@ Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp) } else { if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) { - dTHR; Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0), PL_op_name[PL_op->op_type]); } @@ -5547,7 +5498,6 @@ reference count is 1. SV* Perl_newSVrv(pTHX_ SV *rv, const char *classname) { - dTHR; SV *sv; new_SV(sv); @@ -5687,7 +5637,6 @@ of the SV is unaffected. SV* Perl_sv_bless(pTHX_ SV *sv, HV *stash) { - dTHR; SV *tmpRef; if (!SvROK(sv)) Perl_croak(aTHX_ "Can't bless non-reference value"); @@ -6010,7 +5959,6 @@ locales). void Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted) { - dTHR; char *p; char *q; char *patend; @@ -11,7 +11,6 @@ void Perl_taint_proper(pTHX_ const char *f, const char *s) { - dTHR; /* just for taint */ char *ug; #ifdef HAS_SETEUID @@ -64,12 +63,10 @@ Perl_taint_env(pTHX) if (!svp || *svp == &PL_sv_undef) break; if (SvTAINTED(*svp)) { - dTHR; TAINT; taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); } if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) { - dTHR; TAINT; taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); } @@ -81,12 +78,10 @@ Perl_taint_env(pTHX) svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE); if (svp && *svp) { if (SvTAINTED(*svp)) { - dTHR; TAINT; taint_proper("Insecure %s%s", "$ENV{PATH}"); } if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) { - dTHR; TAINT; taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); } @@ -96,7 +91,6 @@ Perl_taint_env(pTHX) /* tainted $TERM is okay if it contains no metachars */ svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE); if (svp && *svp && SvTAINTED(*svp)) { - dTHR; /* just for taint */ STRLEN n_a; bool was_tainted = PL_tainted; char *t = SvPV(*svp, n_a); @@ -116,7 +110,6 @@ Perl_taint_env(pTHX) for (e = misc_env; *e; e++) { svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { - dTHR; /* just for taint */ TAINT; taint_proper("Insecure $ENV{%s}%s", *e); } @@ -274,7 +274,6 @@ S_missingterm(pTHX_ char *s) void Perl_deprecate(pTHX_ char *s) { - dTHR; if (ckWARN(WARN_DEPRECATED)) Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s); } @@ -337,7 +336,6 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) void Perl_lex_start(pTHX_ SV *line) { - dTHR; char *s; STRLEN len; @@ -433,7 +431,6 @@ Perl_lex_end(pTHX) STATIC void S_incline(pTHX_ char *s) { - dTHR; char *t; char *n; char *e; @@ -495,7 +492,6 @@ S_incline(pTHX_ char *s) STATIC char * S_skipspace(pTHX_ register char *s) { - dTHR; if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { while (s < PL_bufend && SPACE_OR_TAB(*s)) s++; @@ -614,7 +610,6 @@ S_check_uni(pTHX) { char *s; char *t; - dTHR; if (PL_oldoldbufptr != PL_last_uni) return; @@ -680,7 +675,6 @@ S_uni(pTHX_ I32 f, char *s) STATIC I32 S_lop(pTHX_ I32 f, int x, char *s) { - dTHR; yylval.ival = f; CLINE; PL_expect = x; @@ -782,7 +776,6 @@ S_force_ident(pTHX_ register char *s, int kind) PL_nextval[PL_nexttoke].opval = o; force_next(WORD); if (kind) { - dTHR; /* just for in_eval */ o->op_private = OPpCONST_ENTERED; /* XXX see note in pp_entereval() for why we forgo typo warnings if the symbol must be introduced in an eval. @@ -995,7 +988,6 @@ S_sublex_start(pTHX) STATIC I32 S_sublex_push(pTHX) { - dTHR; ENTER; PL_lex_state = PL_sublex_info.super_state; @@ -1356,7 +1348,6 @@ S_scan_const(pTHX_ char *start) if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat && isDIGIT(*s) && *s != '0' && !isDIGIT(s[1])) { - dTHR; /* only for ckWARN */ if (ckWARN(WARN_SYNTAX)) Perl_warner(aTHX_ WARN_SYNTAX, "\\%c better written as $%c", *s, *s); *--s = '$'; @@ -1381,7 +1372,6 @@ S_scan_const(pTHX_ char *start) /* FALL THROUGH */ default: { - dTHR; if (ckWARN(WARN_MISC) && isALNUM(*s)) Perl_warner(aTHX_ WARN_MISC, "Unrecognized escape \\%c passed through", @@ -2073,7 +2063,6 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len) int Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp) { - dTHR; int r; yylval_pointer[yyactlevel] = lvalp; @@ -2101,7 +2090,6 @@ Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp) Perl_yylex(pTHX) #endif { - dTHR; register char *s; register char *d; register I32 tmp; @@ -5759,7 +5747,6 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what) char *w; if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ - dTHR; /* only for ckWARN */ if (ckWARN(WARN_SYNTAX)) { int level = 1; for (w = s+2; *w && level; w++) { @@ -6042,7 +6029,6 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des *d = '\0'; while (s < send && SPACE_OR_TAB(*s)) s++; if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { - dTHR; /* only for ckWARN */ if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) { const char *brack = *s == '[' ? "[...]" : "{...}"; Perl_warner(aTHX_ WARN_AMBIGUOUS, @@ -6074,7 +6060,6 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if (funny == '#') funny = '@'; if (PL_lex_state == LEX_NORMAL) { - dTHR; /* only for ckWARN */ if (ckWARN(WARN_AMBIGUOUS) && (keyword(dest, d - dest) || get_cv(dest, FALSE))) { @@ -6273,7 +6258,6 @@ S_scan_trans(pTHX_ char *start) STATIC char * S_scan_heredoc(pTHX_ register char *s) { - dTHR; SV *herewas; I32 op_type = OP_SCALAR; I32 len; @@ -6625,7 +6609,6 @@ S_scan_inputsymbol(pTHX_ char *start) STATIC char * S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) { - dTHR; SV *sv; /* scalar value: string */ char *tmps; /* temp string, used for delimiter matching */ register char *s = start; /* current position in the buffer */ @@ -6856,7 +6839,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) we in octal/hex/binary?" indicator to disallow hex characters when in octal mode. */ - dTHR; NV n = 0.0; UV u = 0; I32 shift; @@ -6944,7 +6926,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) if ((x >> shift) != u && !(PL_hints & HINT_NEW_BINARY)) { - dTHR; overflowed = TRUE; n = (NV) u; if (ckWARN_d(WARN_OVERFLOW)) @@ -6976,7 +6957,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) out: sv = NEWSV(92,0); if (overflowed) { - dTHR; if (ckWARN(WARN_PORTABLE) && n > 4294967295.0) Perl_warner(aTHX_ WARN_PORTABLE, "%s number > %s non-portable", @@ -6985,7 +6965,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) } else { #if UVSIZE > 4 - dTHR; if (ckWARN(WARN_PORTABLE) && u > 0xffffffff) Perl_warner(aTHX_ WARN_PORTABLE, "%s number > %s non-portable", @@ -7015,7 +6994,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) if -w is on */ if (*s == '_') { - dTHR; /* only for ckWARN */ if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3) Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number"); lastub = ++s; @@ -7031,7 +7009,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* final misplaced underbar check */ if (lastub && s - lastub != 3) { - dTHR; if (ckWARN(WARN_SYNTAX)) Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number"); } @@ -7248,7 +7225,6 @@ vstring: STATIC char * S_scan_formline(pTHX_ register char *s) { - dTHR; register char *eol; register char *t; SV *stuff = newSVpvn("",0); @@ -7339,7 +7315,6 @@ S_set_csh(pTHX) I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags) { - dTHR; I32 oldsavestack_ix = PL_savestack_ix; CV* outsidecv = PL_compcv; AV* comppadlist; @@ -7395,7 +7370,6 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) int Perl_yywarn(pTHX_ char *s) { - dTHR; PL_in_eval |= EVAL_WARNONLY; yyerror(s); PL_in_eval &= ~EVAL_WARNONLY; @@ -7405,7 +7379,6 @@ Perl_yywarn(pTHX_ char *s) int Perl_yyerror(pTHX_ char *s) { - dTHR; char *where = NULL; char *context = NULL; int contlen = -1; diff --git a/universal.c b/universal.c index 0899b1a601..12d31e58b1 100644 --- a/universal.c +++ b/universal.c @@ -74,7 +74,6 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level) SV* sv = *svp++; HV* basestash = gv_stashsv(sv, FALSE); if (!basestash) { - dTHR; if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ WARN_SYNTAX, "Can't locate package %s for @%s::ISA", @@ -198,7 +198,6 @@ various flags to allow deviations from the strict UTF-8 encoding UV Perl_utf8_to_uv(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags) { - dTHR; UV uv = *s, ouv; STRLEN len = 1; #ifdef EBCDIC @@ -503,7 +502,6 @@ reflect the new length. U8* Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN *len) { - dTHR; U8 *send; U8 *d; U8 *dst; @@ -556,7 +554,6 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen) continue; } if (uv >= 0xd800 && uv < 0xdbff) { /* surrogates */ - dTHR; UV low = *p++; if (low < 0xdc00 || low >= 0xdfff) Perl_croak(aTHX_ "Malformed UTF-16 surrogate"); @@ -1262,7 +1262,6 @@ 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) { - dTHR; register unsigned char *s, *x; register unsigned char *big; register I32 pos; @@ -1432,7 +1431,6 @@ Perl_savepvn(pTHX_ const char *sv, register I32 len) STATIC SV * S_mess_alloc(pTHX) { - dTHR; SV *sv; XPVMG *any; @@ -1518,7 +1516,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') { - dTHR; if (CopLINE(PL_curcop)) Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf, CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); @@ -1542,7 +1539,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args) OP * Perl_vdie(pTHX_ const char* pat, va_list *args) { - dTHR; char *message; int was_in_eval = PL_in_eval; HV *stash; @@ -1643,7 +1639,6 @@ Perl_die(pTHX_ const char* pat, ...) void Perl_vcroak(pTHX_ const char* pat, va_list *args) { - dTHR; char *message; HV *stash; GV *gv; @@ -1776,7 +1771,6 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) if (PL_warnhook) { /* sv_2cv might call Perl_warn() */ - dTHR; SV *oldwarnhook = PL_warnhook; ENTER; SAVESPTR(PL_warnhook); @@ -1874,7 +1868,6 @@ Perl_warner(pTHX_ U32 err, const char* pat,...) void Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) { - dTHR; char *message; HV *stash; GV *gv; @@ -1931,7 +1924,6 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) else { if (PL_warnhook) { /* sv_2cv might call Perl_warn() */ - dTHR; SV *oldwarnhook = PL_warnhook; ENTER; SAVESPTR(PL_warnhook); @@ -2965,7 +2957,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen) continue; } else { - dTHR; if (ckWARN(WARN_DIGIT)) Perl_warner(aTHX_ WARN_DIGIT, "Illegal binary digit '%c' ignored", *s); @@ -2976,7 +2967,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen) register UV xuv = ruv << 1; if ((xuv >> 1) != ruv) { - dTHR; overflowed = TRUE; rnv = (NV) ruv; if (ckWARN_d(WARN_OVERFLOW)) @@ -3004,7 +2994,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen) || (!overflowed && ruv > 0xffffffff ) #endif ) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Binary number > 0b11111111111111111111111111111111 non-portable"); @@ -3034,7 +3023,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen) * as soon as non-octal characters are seen, complain only iff * someone seems to want to use the digits eight and nine). */ if (*s == '8' || *s == '9') { - dTHR; if (ckWARN(WARN_DIGIT)) Perl_warner(aTHX_ WARN_DIGIT, "Illegal octal digit '%c' ignored", *s); @@ -3046,7 +3034,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen) register UV xuv = ruv << 3; if ((xuv >> 3) != ruv) { - dTHR; overflowed = TRUE; rnv = (NV) ruv; if (ckWARN_d(WARN_OVERFLOW)) @@ -3074,7 +3061,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen) || (!overflowed && ruv > 0xffffffff ) #endif ) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Octal number > 037777777777 non-portable"); @@ -3113,7 +3099,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen) ++s; } else { - dTHR; if (ckWARN(WARN_DIGIT)) Perl_warner(aTHX_ WARN_DIGIT, "Illegal hexadecimal digit '%c' ignored", *s); @@ -3124,7 +3109,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen) register UV xuv = ruv << 4; if ((xuv >> 4) != ruv) { - dTHR; overflowed = TRUE; rnv = (NV) ruv; if (ckWARN_d(WARN_OVERFLOW)) @@ -3152,7 +3136,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen) || (!overflowed && ruv > 0xffffffff ) #endif ) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Hexadecimal number > 0xffffffff non-portable"); @@ -3164,7 +3147,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen) char* Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags) { - dTHR; char *xfound = Nullch; char *xfailed = Nullch; char tmpbuf[MAXPATHLEN]; diff --git a/vmesa/vmesa.c b/vmesa/vmesa.c index 0e4ad86682..8bc733b5b7 100644 --- a/vmesa/vmesa.c +++ b/vmesa/vmesa.c @@ -121,7 +121,6 @@ do_aspawn(SV* really, SV **mark, SV **sp) status = FAIL; if (sp > mark) { - dTHR; New(401,PL_Argv, sp - mark + 1, char*); a = PL_Argv; while (++mark <= sp) @@ -286,7 +285,6 @@ do_spawn(char *cmd, int execf) (const char **) environ); if (pid < 0) { - dTHR; status = FAIL; if (ckWARN(WARN_EXEC)) warner(WARN_EXEC,"Can't exec \"%s\": %s", diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs index 22d9a7262c..d82b17dbfa 100644 --- a/vms/ext/Stdio/Stdio.xs +++ b/vms/ext/Stdio/Stdio.xs @@ -87,7 +87,6 @@ newFH(FILE *fp, char type) { HV *stash; IO *io; - dTHR; /* Find stash for VMS::Stdio. We don't do this once at boot * to allow for possibility of threaded Perl with per-thread * symbol tables. This code (through io = ...) is really diff --git a/win32/win32.c b/win32/win32.c index ed12430497..2167eeb9a1 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -581,7 +581,6 @@ do_aspawn(void *vreally, void **vmark, void **vsp) } else { if (status < 0) { - dTHR; if (ckWARN(WARN_EXEC)) Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno)); status = 255 * 256; @@ -674,7 +673,6 @@ do_spawn2(char *cmd, int exectype) } else { if (status < 0) { - dTHR; if (ckWARN(WARN_EXEC)) Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s", (exectype == EXECF_EXEC ? "exec" : "spawn"), @@ -1875,7 +1873,6 @@ win32_crypt(const char *txt, const char *salt) { dTHXo; #ifdef HAVE_DES_FCRYPT - dTHR; return des_fcrypt(txt, salt, w32_crypt_buffer); #else Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia."); |