dTHR is a nop in 5.6.0 onwards. Ergo, it can go.
authorJarkko Hietaniemi <jhi@iki.fi>
Tue, 5 Dec 2000 05:48:16 +0000 (05:48 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Tue, 5 Dec 2000 05:48:16 +0000 (05:48 +0000)
p4raw-id: //depot/perl@7984

41 files changed:
av.c
cygwin/cygwin.c
deb.c
djgpp/djgpp.c
doio.c
doop.c
dump.c
epoc/epoc.c
ext/ByteLoader/ByteLoader.xs
ext/ByteLoader/byterun.c
ext/Devel/DProf/DProf.xs
ext/Thread/Thread.xs
ext/re/re.xs
gv.c
hv.c
mg.c
op.c
os2/OS2/REXX/REXX.xs
os2/os2.c
os2/os2ish.h
perl.c
perl.h
perlapi.c
pp.c
pp.h
pp_ctl.c
pp_hot.c
pp_sys.c
regcomp.c
regexec.c
run.c
scope.c
sv.c
taint.c
toke.c
universal.c
utf8.c
util.c
vmesa/vmesa.c
vms/ext/Stdio/Stdio.xs
win32/win32.c

diff --git a/av.c b/av.c
index e5f6dc8..ebefe37 100644 (file)
--- 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
index 33ea4db..962a60a 100644 (file)
@@ -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 441487f..a027cf8 100644 (file)
--- 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;
index 80a627e..4e390cf 100644 (file)
@@ -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 5fc6641..901ca71 100644 (file)
--- 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 3c34425..9dbee67 100644 (file)
--- 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 8bb4370..a6547d6 100644 (file)
--- 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;
index a2691f3..b9bc652 100644 (file)
@@ -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;
index d3b4351..05b795c 100644 (file)
@@ -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;
index 19f1f6b..3e12790 100644 (file)
@@ -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];
index 7167a00..8f28c6e 100644 (file)
@@ -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;
index c911279..07befed 100644 (file)
@@ -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)));
 
index 04a5fdc..25c2a90 100644 (file)
@@ -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 5c9015d..dba3444 100644 (file)
--- 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 dd30b4d..334f7ad 100644 (file)
--- 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 660fa54..52e1b0d 100644 (file)
--- 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 5d00c69..c530e5f 100644 (file)
--- 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;
index 1dc20d3..b196ea1 100644 (file)
@@ -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, 
index 66e48c4..b244716 100644 (file)
--- 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)
index c9719e6..dccd932 100644 (file)
@@ -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 0ebd935..f8dfe8c 100644 (file)
--- 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 562da8a..a55ebef 100644 (file)
--- 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
index 02c5aa3..4f3497e 100644 (file)
--- 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 10e6c6a..c512db3 100644 (file)
--- 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 029583a..2226c20 100644 (file)
--- 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
index d22f2ef..d079e4a 100644 (file)
--- 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;
index 7b5f832..c12e986 100644 (file)
--- 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))));
index 37b8d14..c167336 100644 (file)
--- 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);
index 64a83cd..aae2ced 100644 (file)
--- 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. */
index 6a06910..5e821ba 100644 (file)
--- 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 728b761..ee761d3 100644 (file)
--- 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 82cd748..0713fa7 100644 (file)
--- 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 69ed824..d645a6d 100644 (file)
--- 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 0f0ce98..7a8baac 100644 (file)
--- 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 c07d991..232c4ee 100644 (file)
--- 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;
index 0899b1a..12d31e5 100644 (file)
@@ -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 5713d65..5e01826 100644 (file)
--- 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 d9ea421..128e24e 100644 (file)
--- 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];
index 0e4ad86..8bc733b 100644 (file)
@@ -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",
index 22d9a72..d82b17d 100644 (file)
@@ -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
index ed12430..2167eeb 100644 (file)
@@ -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.");