summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2000-12-05 05:48:16 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2000-12-05 05:48:16 +0000
commit411caa507cab4ba311ec4000c486ad2592d51146 (patch)
tree1528f3b10157445edf526b3779d7a7733f181fae
parent8fed10cdafa32ef4e1990378c72a599fc726f7a0 (diff)
downloadperl-411caa507cab4ba311ec4000c486ad2592d51146.tar.gz
dTHR is a nop in 5.6.0 onwards. Ergo, it can go.
p4raw-id: //depot/perl@7984
Diffstat
-rw-r--r--av.c7
-rw-r--r--cygwin/cygwin.c4
-rw-r--r--deb.c3
-rw-r--r--djgpp/djgpp.c1
-rw-r--r--doio.c47
-rw-r--r--doop.c13
-rw-r--r--dump.c5
-rw-r--r--epoc/epoc.c1
-rw-r--r--ext/ByteLoader/ByteLoader.xs1
-rw-r--r--ext/ByteLoader/byterun.c1
-rw-r--r--ext/Devel/DProf/DProf.xs6
-rw-r--r--ext/Thread/Thread.xs2
-rw-r--r--ext/re/re.xs2
-rw-r--r--gv.c12
-rw-r--r--hv.c12
-rw-r--r--mg.c24
-rw-r--r--op.c60
-rw-r--r--os2/OS2/REXX/REXX.xs1
-rw-r--r--os2/os2.c9
-rw-r--r--os2/os2ish.h1
-rw-r--r--perl.c33
-rw-r--r--perl.h4
-rw-r--r--perlapi.c10
-rw-r--r--pp.c2
-rw-r--r--pp.h2
-rw-r--r--pp_ctl.c13
-rw-r--r--pp_hot.c5
-rw-r--r--pp_sys.c5
-rw-r--r--regcomp.c26
-rw-r--r--regexec.c14
-rw-r--r--run.c4
-rw-r--r--scope.c48
-rw-r--r--sv.c60
-rw-r--r--taint.c7
-rw-r--r--toke.c27
-rw-r--r--universal.c1
-rw-r--r--utf8.c3
-rw-r--r--util.c18
-rw-r--r--vmesa/vmesa.c2
-rw-r--r--vms/ext/Stdio/Stdio.xs1
-rw-r--r--win32/win32.c3
41 files changed, 30 insertions, 470 deletions
diff --git a/av.c b/av.c
index e5f6dc8d7a..ebefe3787d 100644
--- a/av.c
+++ b/av.c
@@ -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);
diff --git a/deb.c b/deb.c
index 441487f88e..a027cf8aac 100644
--- a/deb.c
+++ b/deb.c
@@ -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;
diff --git a/doio.c b/doio.c
index 5fc66412f1..901ca718d0 100644
--- a/doio.c
+++ b/doio.c
@@ -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;
diff --git a/doop.c b/doop.c
index 3c34425075..9dbee678ef 100644
--- a/doop.c
+++ b/doop.c
@@ -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;
diff --git a/dump.c b/dump.c
index 8bb4370851..a6547d6359 100644
--- a/dump.c
+++ b/dump.c
@@ -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;
diff --git a/gv.c b/gv.c
index 5c9015d6e2..dba34449c4 100644
--- a/gv.c
+++ b/gv.c
@@ -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;
diff --git a/hv.c b/hv.c
index dd30b4d61c..334f7ad306 100644
--- a/hv.c
+++ b/hv.c
@@ -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
diff --git a/mg.c b/mg.c
index 660fa54140..52e1b0d7f0 100644
--- a/mg.c
+++ b/mg.c
@@ -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)
diff --git a/op.c b/op.c
index 5d00c697ed..c530e5f484 100644
--- a/op.c
+++ b/op.c
@@ -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,
diff --git a/os2/os2.c b/os2/os2.c
index 66e48c42e3..b244716f2f 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -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
diff --git a/perl.c b/perl.c
index 0ebd935941..f8dfe8c850 100644
--- a/perl.c
+++ b/perl.c
@@ -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;
diff --git a/perl.h b/perl.h
index 562da8ae5d..a55ebefc6e 100644
--- a/perl.h
+++ b/perl.h
@@ -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
diff --git a/perlapi.c b/perlapi.c
index 02c5aa3bca..4f3497e4fd 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -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);
diff --git a/pp.c b/pp.c
index 10e6c6aa99..c512db3d98 100644
--- a/pp.c
+++ b/pp.c
@@ -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)
diff --git a/pp.h b/pp.h
index 029583a09b..2226c20a6a 100644
--- a/pp.h
+++ b/pp.h
@@ -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
diff --git a/pp_ctl.c b/pp_ctl.c
index d22f2efc0f..d079e4af22 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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;
diff --git a/pp_hot.c b/pp_hot.c
index 7b5f8320e8..c12e986665 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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))));
diff --git a/pp_sys.c b/pp_sys.c
index 37b8d14cfd..c167336ef7 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -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);
diff --git a/regcomp.c b/regcomp.c
index 64a83cd440..aae2ceda5f 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -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. */
diff --git a/regexec.c b/regexec.c
index 6a069106ea..5e821ba3f0 100644
--- a/regexec.c
+++ b/regexec.c
@@ -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;
diff --git a/run.c b/run.c
index 728b761ff0..ee761d3a0b 100644
--- a/run.c
+++ b/run.c
@@ -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",
diff --git a/scope.c b/scope.c
index 82cd748274..0713fa7e78 100644
--- a/scope.c
+++ b/scope.c
@@ -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);
diff --git a/sv.c b/sv.c
index 69ed824e07..d645a6dfcf 100644
--- a/sv.c
+++ b/sv.c
@@ -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;
diff --git a/taint.c b/taint.c
index 0f0ce98e7a..7a8baac7b0 100644
--- a/taint.c
+++ b/taint.c
@@ -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);
}
diff --git a/toke.c b/toke.c
index c07d991274..232c4eeb2b 100644
--- a/toke.c
+++ b/toke.c
@@ -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",
diff --git a/utf8.c b/utf8.c
index 5713d65dea..5e018260fa 100644
--- a/utf8.c
+++ b/utf8.c
@@ -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");
diff --git a/util.c b/util.c
index d9ea421afb..128e24eaa3 100644
--- a/util.c
+++ b/util.c
@@ -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.");
View Lorry Controller Status