Integrate mainline.

p4raw-id: //depot/perlio@8003

69 files changed, 1207 insertions, 1132 deletions

diff --git a/Changes b/Changes
index 91822b138a..64dcb782ac 100644
--- a/Changes
+++ b/Changes
@@ -32,6 +32,187 @@ Version v5.7.1		Development release working toward v5.8
 --------------
 
 ____________________________________________________________________________
+[  7978] By: jhi                                   on 2000/12/04  16:42:17
+        Log: Retract #7977, still too volatile (the euphemism of the day
+             for unfinished and buggy :-)
+     Branch: perl
+	   ! doop.c hv.c pp.c sv.h
+____________________________________________________________________________
+[  7977] By: jhi                                   on 2000/12/04  16:25:15
+        Log: (Retracted by #7978, too shaky yet.)
+             
+             Subject: Re: utf8 in hash keys, implementor missing
+             From: Simon Cozens <simon@cozens.net>
+             Date: Sat, 2 Dec 2000 19:49:35 +0000
+             Message-ID: <20001202194935.A25673@pembro33.pmb.ox.ac.uk>
+             
+             The first step at UTF-8 hash keys.
+     Branch: perl
+	   ! doop.c hv.c pp.c sv.h
+____________________________________________________________________________
+[  7976] By: jhi                                   on 2000/12/04  16:13:53
+        Log: Subject: [ID 20001203.001] Not OK: perl v5.7.0 +DEVEL7965 on os2-64int-ld 2.30 (UNINSTALLED)
+             From: sthoenna@efn.org
+             Date: Sun, 3 Dec 2000 19:06:53 -0800 (PST)
+             Message-Id: <200012040306.eB436rE18922@garcia.efn.org>
+     Branch: perl
+	   ! os2/os2.c perlio.c
+____________________________________________________________________________
+[  7975] By: jhi                                   on 2000/12/04  16:05:25
+        Log: Subject: Re: [ID 20001129.009] Not OK: perl v5.7.0 +DEVEL7928 on os2-64int-ld 2.30 (UNINSTALLED)
+             From: sthoenna@efn.org (Yitzchak Scott-Thoennes)
+             Date: Thu, 30 Nov 2000 20:50:37 -0800
+             Message-ID: <d4yJ6gzkgGsJ092yn@efn.org>
+     Branch: perl
+	   ! os2/os2.c
+____________________________________________________________________________
+[  7974] By: jhi                                   on 2000/12/04  16:03:57
+        Log: Subject: [PATCH] ++ 20% faster
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Mon, 4 Dec 2000 12:17:27 +0000
+             Message-ID: <20001204121726.B52976@plum.flirble.org>
+             
+             Make '$i = ""; $i++' to produce true IVs without a hint of NVs.
+     Branch: perl
+	   ! sv.c
+____________________________________________________________________________
+[  7973] By: jhi                                   on 2000/12/04  16:00:48
+        Log: 
+             Subject: Re: Not OK: perl v5.7.0 +DEVEL7825 on aix 4.2.1.0 (UNINSTALLED)
+             From: "H.Merijn Brand" <h.m.brand@hccnet.nl>
+             Date: Mon, 04 Dec 2000 12:30:45 +0100
+             Message-Id: <20001204122118.E85D.H.M.BRAND@hccnet.nl>
+             
+             AIX 4.2 (using latest patchlevels on 20001130) has a broken bind
+             library (getprotobyname and getprotobynumber are outversioned by
+             the same calls in libc, at least for xlc version 3.
+     Branch: perl
+	   ! hints/aix.sh
+____________________________________________________________________________
+[  7972] By: jhi                                   on 2000/12/04  02:58:31
+        Log: Integrate perlio.
+     Branch: perl
+	  !> doio.c iperlsys.h perl.c perl.h perlio.c perlio.h toke.c
+	  !> win32/makefile.mk win32/perlhost.h win32/perllib.c
+	  !> win32/win32.h win32/win32iop.h win32/win32thread.h
+____________________________________________________________________________
+[  7971] By: nick                                  on 2000/12/04  00:24:33
+        Log: Quieten some noise in Win32 builds:
+             - win32.h is included after <sys/socket.h>, so need to 
+             set Win32SCK_IS_STDSCK earlier to avoid re-defined noise in XSUB.h
+             - GCC (& MSVC?) have execv(...,const char *const *) so need a cast from char **.
+     Branch: perlio
+	   ! doio.c perl.h toke.c win32/win32.h
+____________________________________________________________________________
+[  7970] By: nick                                  on 2000/12/03  22:57:46
+        Log: PERL_IMPLICIT_SYS compiles but does not work.
+     Branch: perlio
+	   ! iperlsys.h perl.c perlio.c perlio.h win32/makefile.mk
+	   ! win32/perlhost.h win32/perllib.c win32/win32.h
+	   ! win32/win32iop.h win32/win32thread.h
+____________________________________________________________________________
+[  7969] By: jhi                                   on 2000/12/03  22:12:58
+        Log: On DEBUGGING make ANYOFUTF8 nodes store away also the SV
+             used to swash_init(), makes regprop() dumps more informative
+             (+utf8::IsAlpha, -utf8::IsDigit, for example).
+     Branch: perl
+	   ! regcomp.c regexec.c
+____________________________________________________________________________
+[  7968] By: jhi                                   on 2000/12/03  21:39:56
+        Log: Implement ANYOFUTF8 regprop() dumping.
+     Branch: perl
+	   ! regcomp.c
+____________________________________________________________________________
+[  7967] By: jhi                                   on 2000/12/03  20:57:19
+        Log: Make uv_to_utf8() to zero-terminate its output buffer,
+             always use (at least) UTF8_MAXLEN + 1 U8s deep buffer.
+     Branch: perl
+	   ! op.c pp.c regcomp.c regexec.c sv.c toke.c utf8.c
+____________________________________________________________________________
+[  7966] By: nick                                  on 2000/12/03  18:41:21
+        Log: Integrate mainline (STDCHAR)
+     Branch: perlio
+	  !> Configure t/pragma/utf8.t
+____________________________________________________________________________
+[  7965] By: jhi                                   on 2000/12/03  17:58:20
+        Log: Raw zero bytes in text files confuse at least GNU patch 2.1.
+     Branch: perl
+	   ! t/pragma/utf8.t
+____________________________________________________________________________
+[  7964] By: jhi                                   on 2000/12/03  17:35:56
+        Log: Integrate perlio.
+     Branch: perl
+	  !> iperlsys.h perlio.c
+____________________________________________________________________________
+[  7963] By: jhi                                   on 2000/12/03  17:33:55
+        Log: Metaconfig unit change for #7962.
+     Branch: metaconfig
+	   ! U/modified/stdchar.U
+____________________________________________________________________________
+[  7962] By: jhi                                   on 2000/12/03  17:33:27
+        Log: Untangle the <stdio.h> #include nest for the stdchar test,
+             from Andy Dougherty.
+     Branch: perl
+	   ! Configure
+____________________________________________________________________________
+[  7961] By: nick                                  on 2000/12/03  16:53:00
+        Log: Make iperlsys.h vector stdio not PerlIO.
+     Branch: perlio
+	   ! iperlsys.h perlio.c
+____________________________________________________________________________
+[  7960] By: nick                                  on 2000/12/03  14:43:01
+        Log: Integrate mainline
+     Branch: perlio
+	  !> Changes Configure config_h.SH lib/ExtUtils/MM_Unix.pm op.c
+	  !> patchlevel.h pod/perldiag.pod t/lib/net-hostent.t toke.c
+____________________________________________________________________________
+[  7959] By: jhi                                   on 2000/12/03  08:16:36
+        Log: Use DO_UTF8().
+     Branch: perl
+	   ! op.c
+____________________________________________________________________________
+[  7958] By: jhi                                   on 2000/12/02  18:33:05
+        Log: Subject: Re: [ID 20001130.011] expression parsing bug ?
+             From: Mike Guy <mjtg@cam.ac.uk>         
+             Date: Sat, 02 Dec 2000 17:27:13 +0000
+             Message-Id: <E142GRN-0003go-00@libra.cus.cam.ac.uk>
+             
+             An extraneous argument.
+     Branch: perl
+	   ! toke.c
+____________________________________________________________________________
+[  7957] By: jhi                                   on 2000/12/02  18:22:32
+        Log: A missing hunk.
+     Branch: perl
+	   ! t/lib/net-hostent.t
+____________________________________________________________________________
+[  7956] By: jhi                                   on 2000/12/02  18:06:20
+        Log: Subject: [PATCH] Re: [ID 20001202.001] (Net::hostent)
+             From: Nicholas Clark <nick@ccl4.org>
+             Date: Sat, 2 Dec 2000 14:28:27 +0000
+             Message-ID: <20001202142827.A12308@plum.flirble.org>
+             
+             Test robustness.
+     Branch: perl
+	   ! t/lib/net-hostent.t
+____________________________________________________________________________
+[  7955] By: jhi                                   on 2000/12/02  17:58:06
+        Log: Metaconfig unit change for #7954.
+     Branch: metaconfig
+	   ! U/modified/stdchar.U
+____________________________________________________________________________
+[  7954] By: jhi                                   on 2000/12/02  17:54:32
+        Log: An inconvenient hang would happen if the stdio _ptr wasn't
+             found in <stdio.h> and <stdio_impl.h> didn't exist.  (grep
+             would be grepping stdin for all eternity for the _ptr.)
+     Branch: perl
+	   ! Configure
+____________________________________________________________________________
+[  7953] By: jhi                                   on 2000/12/02  00:07:15
+        Log: Update Changes.
+     Branch: perl
+	   ! Changes patchlevel.h
+____________________________________________________________________________
 [  7952] By: jhi                                   on 2000/12/01  23:54:47
         Log: Subject: Re: long shell lines
              From: Andy Dougherty <doughera@lafayette.edu>
diff --git a/MANIFEST b/MANIFEST
index 7da209ef0f..03be9636a8 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1522,6 +1522,7 @@ t/op/inc.t		See if inc/dec of integers near 32 bit limit work
 t/op/index.t		See if index works
 t/op/int.t		See if int works
 t/op/join.t		See if join works
+t/op/length.t		See if length works
 t/op/lex_assign.t	See if ops involving lexicals or pad temps work
 t/op/lfs.t		See if large files work for perlio
 t/op/list.t		See if array lists work
@@ -1576,6 +1577,7 @@ t/op/tr.t		See if tr works
 t/op/undef.t		See if undef works
 t/op/universal.t	See if UNIVERSAL class works
 t/op/unshift.t		See if unshift works
+t/op/utf8decode.t	See if UTF-8 decoding works
 t/op/vec.t		See if vectors work
 t/op/ver.t		See if v-strings and the %v format flag work
 t/op/wantarray.t	See if wantarray works
diff --git a/av.c b/av.c
index e5f6dc8d7a..ebefe3787d 100644
--- a/av.c
+++ b/av.c
@@ -34,10 +34,8 @@ Perl_av_reify(pTHX_ AV *av)
     while (key) {
 	sv = AvARRAY(av)[--key];
 	assert(sv);
-	if (sv != &PL_sv_undef) {
-	    dTHR;
+	if (sv != &PL_sv_undef)
 	    (void)SvREFCNT_inc(sv);
-	}
     }
     key = AvARRAY(av) - AvALLOC(av);
     while (key)
@@ -58,7 +56,6 @@ extended.
 void
 Perl_av_extend(pTHX_ AV *av, I32 key)
 {
-    dTHR;			/* only necessary if we have to extend stack */
     MAGIC *mg;
     if ((mg = SvTIED_mg((SV*)av, 'P'))) {
 	dSP;
@@ -189,7 +186,6 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 
     if (SvRMAGICAL(av)) {
 	if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
-	    dTHR;
 	    sv = sv_newmortal();
 	    mg_copy((SV*)av, sv, 0, key);
 	    PL_av_fetch_sv = sv;
@@ -272,7 +268,6 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     ary = AvARRAY(av);
     if (AvFILLp(av) < key) {
 	if (!AvREAL(av)) {
-	    dTHR;
 	    if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
 		PL_stack_sp = PL_stack_base + key;	/* XPUSH in disguise */
 	    do
diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c
index 33ea4db16b..962a60a8d4 100644
--- a/cygwin/cygwin.c
+++ b/cygwin/cygwin.c
@@ -27,11 +27,9 @@ do_spawnvp (const char *path, const char * const *argv)
     childpid = spawnvp(_P_NOWAIT,path,argv);
     if (childpid < 0) {
 	status = -1;
-	if(ckWARN(WARN_EXEC)) {
-	    dTHR;
+	if(ckWARN(WARN_EXEC))
 	    Perl_warner(aTHX_ WARN_EXEC,"Can't spawn \"%s\": %s",
 		    path,Strerror (errno));
-	}
     } else {
 	do {
 	    result = wait4pid(childpid, &status, 0);
diff --git a/deb.c b/deb.c
index 441487f88e..a027cf8aac 100644
--- a/deb.c
+++ b/deb.c
@@ -45,7 +45,6 @@ void
 Perl_vdeb(pTHX_ const char *pat, va_list *args)
 {
 #ifdef DEBUGGING
-    dTHR;
     char* file = CopFILE(PL_curcop);
 
 #ifdef USE_THREADS
@@ -65,7 +64,6 @@ I32
 Perl_debstackptrs(pTHX)
 {
 #ifdef DEBUGGING
-    dTHR;
     PerlIO_printf(Perl_debug_log,
 		  "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
 		  PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
@@ -84,7 +82,6 @@ I32
 Perl_debstack(pTHX)
 {
 #ifdef DEBUGGING
-    dTHR;
     I32 top = PL_stack_sp - PL_stack_base;
     register I32 i = top - 30;
     I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff;
diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c
index 80a627e518..4e390cfc59 100644
--- a/djgpp/djgpp.c
+++ b/djgpp/djgpp.c
@@ -130,7 +130,6 @@ convretcode (pTHX_ int rc,char *prog,int fl)
 int
 do_aspawn (pTHX_ SV *really,SV **mark,SV **sp)
 {
-    dTHR;
     int  rc;
     char **a,*tmps,**argv; 
     STRLEN n_a;
diff --git a/doio.c b/doio.c
index 5fc66412f1..901ca718d0 100644
--- a/doio.c
+++ b/doio.c
@@ -226,7 +226,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		len = tend-type;
 	    }
 	    if (*name == '\0') { /* command is missing 19990114 */
-		dTHR;
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
 		errno = EPIPE;
@@ -236,7 +235,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		TAINT_ENV();
 	    TAINT_PROPER("piped open");
 	    if (!num_svs && name[len-1] == '|') {
-		dTHR;
 		name[--len] = '\0' ;
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe");
@@ -390,7 +388,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	        len  = tend-type;
 	    }
 	    if (*name == '\0') { /* command is missing 19990114 */
-		dTHR;
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
 		errno = EPIPE;
@@ -429,13 +426,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	}
     }
     if (!fp) {
-	dTHR;
 	if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n'))
 	    Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
 	goto say_false;
     }
     if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) {
-	dTHR;
 	if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
 	    (void)PerlIO_close(fp);
 	    goto say_false;
@@ -533,7 +528,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
     IoFLAGS(io) &= ~IOf_NOLINE;
     if (writing) {
-	dTHR;
 	if (IoTYPE(io) == IoTYPE_SOCKET
 	    || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) )
 	{
@@ -597,7 +591,6 @@ Perl_nextargv(pTHX_ register GV *gv)
     }
     PL_filemode = 0;
     while (av_len(GvAV(gv)) >= 0) {
-	dTHR;
 	STRLEN oldlen;
 	sv = av_shift(GvAV(gv));
 	SAVEFREESV(sv);
@@ -746,7 +739,6 @@ Perl_nextargv(pTHX_ register GV *gv)
 	    return IoIFP(GvIOp(gv));
 	}
 	else {
-	    dTHR;
 	    if (ckWARN_d(WARN_INPLACE)) {
 		int eno = errno;
 		if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
@@ -841,7 +833,6 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
     io = GvIO(gv);
     if (!io) {		/* never opened */
 	if (not_implicit) {
-	    dTHR;
 	    if (ckWARN(WARN_UNOPENED)) /* no check for closed here */
 		report_evil_fh(gv, io, PL_op->op_type);
 	    SETERRNO(EBADF,SS$_IVCHAN);
@@ -897,7 +888,6 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
 bool
 Perl_do_eof(pTHX_ GV *gv)
 {
-    dTHR;
     register IO *io;
     int ch;
 
@@ -964,11 +954,8 @@ Perl_do_tell(pTHX_ GV *gv)
 #endif
 	return PerlIO_tell(fp);
     }
-    {
-	dTHR;
-	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-	    report_evil_fh(gv, io, PL_op->op_type);
-    }
+    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,RMS$_IFI);
     return (Off_t)-1;
 }
@@ -986,11 +973,8 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
 #endif
 	return PerlIO_seek(fp, pos, whence) >= 0;
     }
-    {
-	dTHR;
-	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-	    report_evil_fh(gv, io, PL_op->op_type);
-    }
+    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,RMS$_IFI);
     return FALSE;
 }
@@ -1003,11 +987,8 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
 
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
 	return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
-    {
-	dTHR;
-	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-	    report_evil_fh(gv, io, PL_op->op_type);
-    }
+    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,RMS$_IFI);
     return (Off_t)-1;
 }
@@ -1152,11 +1133,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
     }
     switch (SvTYPE(sv)) {
     case SVt_NULL:
-	{
-	    dTHR;
-	    if (ckWARN(WARN_UNINITIALIZED))
-		report_uninit();
-	}
+	if (ckWARN(WARN_UNINITIALIZED))
+	    report_uninit();
 	return TRUE;
     case SVt_IV:
 	if (SvIOK(sv)) {
@@ -1287,7 +1265,6 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
     STRLEN n_a;
 
     if (sp > mark) {
-	dTHR;
 	New(401,PL_Argv, sp - mark + 1, char*);
 	a = PL_Argv;
 	while (++mark <= sp) {
@@ -1435,7 +1412,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 	    goto doshell;
 	}
 	{
-	    dTHR;
 	    int e = errno;
 
 	    if (ckWARN(WARN_EXEC))
@@ -1456,7 +1432,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 I32
 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 {
-    dTHR;
     register I32 val;
     register I32 val2;
     register I32 tot = 0;
@@ -1741,7 +1716,6 @@ Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective)
 I32
 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 {
-    dTHR;
     key_t key;
     I32 n, flags;
 
@@ -1774,7 +1748,6 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 I32
 Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 {
-    dTHR;
     SV *astr;
     char *a;
     I32 id, n, cmd, infosize, getinfo;
@@ -1899,7 +1872,6 @@ I32
 Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_MSG
-    dTHR;
     SV *mstr;
     char *mbuf;
     I32 id, msize, flags;
@@ -1922,7 +1894,6 @@ I32
 Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_MSG
-    dTHR;
     SV *mstr;
     char *mbuf;
     long mtype;
@@ -1960,7 +1931,6 @@ I32
 Perl_do_semop(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_SEM
-    dTHR;
     SV *opstr;
     char *opbuf;
     I32 id;
@@ -1985,7 +1955,6 @@ I32
 Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 {
 #ifdef HAS_SHM
-    dTHR;
     SV *mstr;
     char *mbuf, *shm;
     I32 id, mpos, msize;
diff --git a/doop.c b/doop.c
index 3c34425075..9dbee678ef 100644
--- a/doop.c
+++ b/doop.c
@@ -36,7 +36,6 @@
 STATIC I32
 S_do_trans_simple(pTHX_ SV *sv)
 {
-    dTHR;
     U8 *s;
     U8 *d;
     U8 *send;
@@ -102,7 +101,6 @@ S_do_trans_simple(pTHX_ SV *sv)
 STATIC I32
 S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     I32 matches = 0;
@@ -140,7 +138,6 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
@@ -222,7 +219,6 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 STATIC I32
 S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
@@ -293,7 +289,6 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     I32 matches = 0;
@@ -322,7 +317,6 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
@@ -449,7 +443,6 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 I32
 Perl_do_trans(pTHX_ SV *sv)
 {
-    dTHR;
     STRLEN len;
     I32 hasutf = (PL_op->op_private &
                     (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
@@ -600,7 +593,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 	    }
 #ifdef UV_IS_QUAD
 	    else if (size == 64) {
-		dTHR;
 		if (ckWARN(WARN_PORTABLE))
 		    Perl_warner(aTHX_ WARN_PORTABLE,
 				"Bit vector size > 32 non-portable");
@@ -670,7 +662,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 		      s[offset + 3];
 #ifdef UV_IS_QUAD
 	else if (size == 64) {
-	    dTHR;
 	    if (ckWARN(WARN_PORTABLE))
 		Perl_warner(aTHX_ WARN_PORTABLE,
 			    "Bit vector size > 32 non-portable");
@@ -758,7 +749,6 @@ Perl_do_vecset(pTHX_ SV *sv)
 	}
 #ifdef UV_IS_QUAD
 	else if (size == 64) {
-	    dTHR;
 	    if (ckWARN(WARN_PORTABLE))
 		Perl_warner(aTHX_ WARN_PORTABLE,
 			    "Bit vector size > 32 non-portable");
@@ -781,7 +771,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 {
     STRLEN len;
     char *s;
-    dTHR;
 
     if (SvTYPE(sv) == SVt_PVAV) {
 	register I32 i;
@@ -843,7 +832,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 I32
 Perl_do_chomp(pTHX_ register SV *sv)
 {
-    dTHR;
     register I32 count;
     STRLEN len;
     char *s;
@@ -921,7 +909,6 @@ Perl_do_chomp(pTHX_ register SV *sv)
 void
 Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 {
-    dTHR;	/* just for taint */
 #ifdef LIBERAL
     register long *dl;
     register long *ll;
diff --git a/dump.c b/dump.c
index cffbc4498a..a6547d6359 100644
--- a/dump.c
+++ b/dump.c
@@ -29,7 +29,6 @@ Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 void
 Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 {
-    dTHR;
     PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), "");
     PerlIO_vprintf(file, pat, *args);
 }
@@ -37,7 +36,6 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 void
 Perl_dump_all(pTHX)
 {
-    dTHR;
     PerlIO_setlinebuf(Perl_debug_log);
     if (PL_main_root)
 	op_dump(PL_main_root);
@@ -47,7 +45,6 @@ Perl_dump_all(pTHX)
 void
 Perl_dump_packsubs(pTHX_ HV *stash)
 {
-    dTHR;
     I32	i;
     HE	*entry;
 
@@ -275,6 +272,8 @@ Perl_sv_peek(pTHX_ SV *sv)
 	    if (SvOOK(sv))
 		Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
 	    Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127));
+	    if (SvUTF8(sv))
+		Perl_sv_catpvf(aTHX_ t, " [UTF8]"); 
 	    SvREFCNT_dec(tmp);
 	}
     }
@@ -369,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)
@@ -768,7 +766,6 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv)
 void
 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
-    dTHR;
     SV *d;
     char *s;
     U32 flags;
diff --git a/embed.h b/embed.h
index 14dcbd7d14..6c90a54033 100644
--- a/embed.h
+++ b/embed.h
@@ -702,6 +702,7 @@
 #define sv_tainted		Perl_sv_tainted
 #define sv_unmagic		Perl_sv_unmagic
 #define sv_unref		Perl_sv_unref
+#define sv_unref_flags		Perl_sv_unref_flags
 #define sv_untaint		Perl_sv_untaint
 #define sv_upgrade		Perl_sv_upgrade
 #define sv_usepvn		Perl_sv_usepvn
@@ -819,6 +820,7 @@
 #define sv_utf8_encode		Perl_sv_utf8_encode
 #define sv_utf8_decode		Perl_sv_utf8_decode
 #define sv_force_normal		Perl_sv_force_normal
+#define sv_force_normal_flags	Perl_sv_force_normal_flags
 #define tmps_grow		Perl_tmps_grow
 #define sv_rvweaken		Perl_sv_rvweaken
 #define magic_killbackrefs	Perl_magic_killbackrefs
@@ -2165,6 +2167,7 @@
 #define sv_tainted(a)		Perl_sv_tainted(aTHX_ a)
 #define sv_unmagic(a,b)		Perl_sv_unmagic(aTHX_ a,b)
 #define sv_unref(a)		Perl_sv_unref(aTHX_ a)
+#define sv_unref_flags(a,b)	Perl_sv_unref_flags(aTHX_ a,b)
 #define sv_untaint(a)		Perl_sv_untaint(aTHX_ a)
 #define sv_upgrade(a,b)		Perl_sv_upgrade(aTHX_ a,b)
 #define sv_usepvn(a,b,c)	Perl_sv_usepvn(aTHX_ a,b,c)
@@ -2276,6 +2279,7 @@
 #define sv_utf8_encode(a)	Perl_sv_utf8_encode(aTHX_ a)
 #define sv_utf8_decode(a)	Perl_sv_utf8_decode(aTHX_ a)
 #define sv_force_normal(a)	Perl_sv_force_normal(aTHX_ a)
+#define sv_force_normal_flags(a,b)	Perl_sv_force_normal_flags(aTHX_ a,b)
 #define tmps_grow(a)		Perl_tmps_grow(aTHX_ a)
 #define sv_rvweaken(a)		Perl_sv_rvweaken(aTHX_ a)
 #define magic_killbackrefs(a,b)	Perl_magic_killbackrefs(aTHX_ a,b)
@@ -4246,6 +4250,8 @@
 #define sv_unmagic		Perl_sv_unmagic
 #define Perl_sv_unref		CPerlObj::Perl_sv_unref
 #define sv_unref		Perl_sv_unref
+#define Perl_sv_unref_flags	CPerlObj::Perl_sv_unref_flags
+#define sv_unref_flags		Perl_sv_unref_flags
 #define Perl_sv_untaint		CPerlObj::Perl_sv_untaint
 #define sv_untaint		Perl_sv_untaint
 #define Perl_sv_upgrade		CPerlObj::Perl_sv_upgrade
@@ -4463,6 +4469,8 @@
 #define sv_utf8_decode		Perl_sv_utf8_decode
 #define Perl_sv_force_normal	CPerlObj::Perl_sv_force_normal
 #define sv_force_normal		Perl_sv_force_normal
+#define Perl_sv_force_normal_flags	CPerlObj::Perl_sv_force_normal_flags
+#define sv_force_normal_flags	Perl_sv_force_normal_flags
 #define Perl_tmps_grow		CPerlObj::Perl_tmps_grow
 #define tmps_grow		Perl_tmps_grow
 #define Perl_sv_rvweaken	CPerlObj::Perl_sv_rvweaken
diff --git a/embed.pl b/embed.pl
index 6412ef6b9a..ac43b0757d 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1563,11 +1563,11 @@ Ap	|HV*	|gv_stashpvn	|const char* name|U32 namelen|I32 create
 Apd	|HV*	|gv_stashsv	|SV* sv|I32 create
 Apd	|void	|hv_clear	|HV* tb
 Ap	|void	|hv_delayfree_ent|HV* hv|HE* entry
-Apd	|SV*	|hv_delete	|HV* tb|const char* key|U32 klen|I32 flags
+Apd	|SV*	|hv_delete	|HV* tb|const char* key|I32 klen|I32 flags
 Apd	|SV*	|hv_delete_ent	|HV* tb|SV* key|I32 flags|U32 hash
-Apd	|bool	|hv_exists	|HV* tb|const char* key|U32 klen
+Apd	|bool	|hv_exists	|HV* tb|const char* key|I32 klen
 Apd	|bool	|hv_exists_ent	|HV* tb|SV* key|U32 hash
-Apd	|SV**	|hv_fetch	|HV* tb|const char* key|U32 klen|I32 lval
+Apd	|SV**	|hv_fetch	|HV* tb|const char* key|I32 klen|I32 lval
 Apd	|HE*	|hv_fetch_ent	|HV* tb|SV* key|I32 lval|U32 hash
 Ap	|void	|hv_free_ent	|HV* hv|HE* entry
 Apd	|I32	|hv_iterinit	|HV* tb
@@ -1578,7 +1578,7 @@ Apd	|SV*	|hv_iternextsv	|HV* hv|char** key|I32* retlen
 Apd	|SV*	|hv_iterval	|HV* tb|HE* entry
 Ap	|void	|hv_ksplit	|HV* hv|IV newmax
 Apd	|void	|hv_magic	|HV* hv|GV* gv|int how
-Apd	|SV**	|hv_store	|HV* tb|const char* key|U32 klen|SV* val \
+Apd	|SV**	|hv_store	|HV* tb|const char* key|I32 klen|SV* val \
 				|U32 hash
 Apd	|HE*	|hv_store_ent	|HV* tb|SV* key|SV* val|U32 hash
 Apd	|void	|hv_undef	|HV* tb
@@ -2042,6 +2042,7 @@ Ap	|void	|sv_taint	|SV* sv
 Ap	|bool	|sv_tainted	|SV* sv
 Apd	|int	|sv_unmagic	|SV* sv|int type
 Apd	|void	|sv_unref	|SV* sv
+Apd	|void	|sv_unref_flags	|SV* sv|U32 flags
 Ap	|void	|sv_untaint	|SV* sv
 Apd	|bool	|sv_upgrade	|SV* sv|U32 mt
 Apd	|void	|sv_usepvn	|SV* sv|char* ptr|STRLEN len
@@ -2170,6 +2171,7 @@ ApdM      |bool   |sv_utf8_downgrade|SV *sv|bool fail_ok
 ApdM      |void   |sv_utf8_encode |SV *sv
 Ap      |bool   |sv_utf8_decode |SV *sv
 Ap	|void	|sv_force_normal|SV *sv
+Ap	|void	|sv_force_normal_flags|SV *sv|U32 flags
 Ap	|void	|tmps_grow	|I32 n
 Apd	|SV*	|sv_rvweaken	|SV *sv
 p	|int	|magic_killbackrefs|SV *sv|MAGIC *mg
diff --git a/epoc/epoc.c b/epoc/epoc.c
index a2691f3d38..b9bc652c22 100644
--- a/epoc/epoc.c
+++ b/epoc/epoc.c
@@ -101,7 +101,6 @@ do_aspawn( pTHX_ SV *really,SV **mark,SV **sp) {
 int
 do_spawn (pTHX_ SV *really,SV **mark,SV **sp)
 {
-    dTHR;
     int  rc;
     char **a,*cmd,**ptr, *cmdline, **argv, *p2; 
     STRLEN n_a;
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
index d3b435199e..05b795ca25 100644
--- a/ext/ByteLoader/ByteLoader.xs
+++ b/ext/ByteLoader/ByteLoader.xs
@@ -77,7 +77,6 @@ bl_read(struct byteloader_fdata *data, char *buf, size_t size, size_t n)
 static I32
 byteloader_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
 {
-    dTHR;
     OP *saveroot = PL_main_root;
     OP *savestart = PL_main_start;
     struct byteloader_state bstate;
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 19f1f6b44c..3e12790fb0 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -54,7 +54,6 @@ bset_obj_store(pTHXo_ struct byteloader_state *bstate, void *obj, I32 ix)
 void
 byterun(pTHXo_ register struct byteloader_state *bstate)
 {
-    dTHR;
     register int insn;
     U32 ix;
     SV *specialsv_list[6];
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 7167a0028f..8f28c6eb33 100644
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -3,11 +3,6 @@
 #include "perl.h"
 #include "XSUB.h"
 
-/* For older Perls */
-#ifndef dTHR
-#  define dTHR int dummy_thr
-#endif	/* dTHR */ 
-
 /*#define DBG_SUB 1      */
 /*#define DBG_TIMER 1    */
 
@@ -388,7 +383,6 @@ prof_mark(pTHX_ opcode ptype)
 static void
 test_time(pTHX_ clock_t *r, clock_t *u, clock_t *s)
 {
-    dTHR;
     CV *cv = perl_get_cv("Devel::DProf::NONESUCH_noxs", FALSE);
     int i, j, k = 0;
     HV *oldstash = PL_curstash;
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index c911279c1d..07befed144 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -98,7 +98,6 @@ threadstart(void *arg)
     DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n",
 			  thr));
 
-    /* Don't call *anything* requiring dTHR until after PERL_SET_THX() */
     /*
      * Wait until our creator releases us. If we didn't do this, then
      * it would be potentially possible for out thread to carry on and
@@ -116,7 +115,6 @@ threadstart(void *arg)
      */
     PERL_SET_THX(thr);
 
-    /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */
     DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n",
 			  thr, SvPEEK(TOPs)));
 
diff --git a/ext/re/re.xs b/ext/re/re.xs
index 04a5fdc742..25c2a90d60 100644
--- a/ext/re/re.xs
+++ b/ext/re/re.xs
@@ -25,7 +25,6 @@ static int oldfl;
 static void
 deinstall(pTHX)
 {
-    dTHR;
     PL_regexecp = Perl_regexec_flags;
     PL_regcompp = Perl_pregcomp;
     PL_regint_start = Perl_re_intuit_start;
@@ -39,7 +38,6 @@ deinstall(pTHX)
 static void
 install(pTHX)
 {
-    dTHR;
     PL_colorset = 0;			/* Allow reinspection of ENV. */
     PL_regexecp = &my_regexec;
     PL_regcompp = &my_regcomp;
diff --git a/gv.c b/gv.c
index 5c9015d6e2..dba34449c4 100644
--- a/gv.c
+++ b/gv.c
@@ -53,7 +53,6 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
 GV *
 Perl_gv_fetchfile(pTHX_ const char *name)
 {
-    dTHR;
     char smallbuf[256];
     char *tmpbuf;
     STRLEN tmplen;
@@ -85,7 +84,6 @@ Perl_gv_fetchfile(pTHX_ const char *name)
 void
 Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 {
-    dTHR;
     register GP *gp;
     bool doproto = SvTYPE(gv) > SVt_NULL;
     char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;
@@ -227,7 +225,6 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 	    basestash = gv_stashpvn(packname, packlen, TRUE);
 	    gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
 	    if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
-		dTHR;		/* just for SvREFCNT_dec */
 		gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
 		if (!gvp || !(gv = *gvp))
 		    Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash));
@@ -247,7 +244,6 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 	    SV* sv = *svp++;
 	    HV* basestash = gv_stashsv(sv, FALSE);
 	    if (!basestash) {
-		dTHR;		/* just for ckWARN */
 		if (ckWARN(WARN_MISC))
 		    Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA",
 			SvPVX(sv), HvNAME(stash));
@@ -342,7 +338,6 @@ C<call_sv> apply equally to these functions.
 GV *
 Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 {
-    dTHR;
     register const char *nend;
     const char *nsplit = 0;
     GV* gv;
@@ -403,7 +398,6 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 GV*
 Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
 {
-    dTHR;
     static char autoload[] = "AUTOLOAD";
     static STRLEN autolen = 8;
     GV* gv;
@@ -525,7 +519,6 @@ Perl_gv_stashsv(pTHX_ SV *sv, I32 create)
 GV *
 Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 {
-    dTHR;
     register const char *name = nambeg;
     register GV *gv = 0;
     GV**gvp;
@@ -999,7 +992,6 @@ Perl_gv_efullname(pTHX_ SV *sv, GV *gv)
 IO *
 Perl_newIO(pTHX)
 {
-    dTHR;
     IO *io;
     GV *iogv;
 
@@ -1018,7 +1010,6 @@ Perl_newIO(pTHX)
 void
 Perl_gv_check(pTHX_ HV *stash)
 {
-    dTHR;
     register HE *entry;
     register I32 i;
     register GV *gv;
@@ -1095,7 +1086,6 @@ Perl_gp_ref(pTHX_ GP *gp)
 void
 Perl_gp_free(pTHX_ GV *gv)
 {
-    dTHR;
     GP* gp;
 
     if (!gv || !(gp = GvGP(gv)))
@@ -1156,7 +1146,6 @@ register GV *gv;
 bool
 Perl_Gv_AMupdate(pTHX_ HV *stash)
 {
-  dTHR;
   GV* gv;
   CV* cv;
   MAGIC* mg=mg_find((SV*)stash,'c');
@@ -1319,7 +1308,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {
-  dTHR;
   MAGIC *mg;
   CV *cv;
   CV **cvp=NULL, **ocvp=NULL;
diff --git a/hints/aix.sh b/hints/aix.sh
index 35ee662350..b14aad0e99 100644
--- a/hints/aix.sh
+++ b/hints/aix.sh
@@ -163,6 +163,20 @@ case "$osvers" in
     lddlflags="$lddlflags -bhalt:4 -bM:SRE -bI:\$(PERL_INC)/perl.exp -bE:\$(BASEEXT).exp -b noentry -lc"
     ;;
 esac
+# AIX 4.2 (using latest patchlevels on 20001130) has a broken bind
+# library (getprotobyname and getprotobynumber are outversioned by
+# the same calls in libc, at least for xlc version 3...
+case "`oslevel`" in
+    4.2.1.*)  # Test for xlc version too, should we?
+      case "$ccversion" in    # Don't know if needed for gcc
+          3.1.4.*)    # libswanted "bind ... c ..." => "... c bind ..."
+              set `echo X "$libswanted "| sed -e 's/ bind\( .*\) \([cC]\) / \1 \2 bind /'`
+              shift
+              libswanted="$*"
+              ;;
+          esac
+      ;;
+    esac
 
 # This script UU/usethreads.cbu will get 'called-back' by Configure 
 # after it has prompted the user for whether to use threads.
diff --git a/hv.c b/hv.c
index 8a43a19eb5..334f7ad306 100644
--- a/hv.c
+++ b/hv.c
@@ -75,13 +75,19 @@ S_save_hek(pTHX_ const char *str, I32 len, U32 hash)
 {
     char *k;
     register HEK *hek;
+    bool is_utf8 = FALSE;
+
+    if (len < 0) {
+      len = -len;
+      is_utf8 = TRUE;
+    }
 
     New(54, k, HEK_BASESIZE + len + 1, char);
     hek = (HEK*)k;
     Copy(str, HEK_KEY(hek), len, char);
-    *(HEK_KEY(hek) + len) = '\0';
     HEK_LEN(hek) = len;
     HEK_HASH(hek) = hash;
+    HEK_UTF8(hek) = (char)is_utf8;
     return hek;
 }
 
@@ -112,9 +118,9 @@ Perl_he_dup(pTHX_ HE *e, bool shared)
     if (HeKLEN(e) == HEf_SVKEY)
 	HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e)));
     else if (shared)
-	HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
+ HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
     else
-	HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
+ HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
     HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e)));
     return ret;
 }
@@ -138,19 +144,24 @@ information on how to use this function on tied hashes.
 */
 
 SV**
-Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
+Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
 {
     register XPVHV* xhv;
     register U32 hash;
     register HE *entry;
     SV *sv;
+    bool is_utf8 = FALSE;
 
     if (!hv)
 	return 0;
 
+    if (klen < 0) {
+      klen = -klen;
+      is_utf8 = TRUE;
+    }
+
     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;
@@ -194,6 +205,8 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
 	    continue;
 	if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))	/* is this it? */
 	    continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+     continue;
 	return &HeVAL(entry);
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
@@ -209,7 +222,7 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
 #endif
     if (lval) {		/* gonna assign to this, so it better be there */
 	sv = NEWSV(61,0);
-	return hv_store(hv,key,klen,sv,hash);
+ return hv_store(hv,key,is_utf8?-klen:klen,sv,hash);
     }
     return 0;
 }
@@ -241,13 +254,13 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
     STRLEN klen;
     register HE *entry;
     SV *sv;
+    bool is_utf8;
 
     if (!hv)
 	return 0;
 
     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);
@@ -291,6 +304,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
     }
 
     key = SvPV(keysv, klen);
+    is_utf8 = (SvUTF8(keysv)!=0);
 
     if (!hash)
 	PERL_HASH(hash, key, klen);
@@ -303,6 +317,8 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 	    continue;
 	if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))	/* is this it? */
 	    continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+     continue;
 	return entry;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
@@ -361,16 +377,22 @@ information on how to use this function on tied hashes.
 */
 
 SV**
-Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 hash)
+Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 hash)
 {
     register XPVHV* xhv;
     register I32 i;
     register HE *entry;
     register HE **oentry;
+    bool is_utf8 = FALSE;
 
     if (!hv)
 	return 0;
 
+    if (klen < 0) {
+      klen = -klen;
+      is_utf8 = TRUE;
+    }
+
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
 	bool needs_copy;
@@ -406,6 +428,8 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 has
 	    continue;
 	if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))	/* is this it? */
 	    continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+     continue;
 	SvREFCNT_dec(HeVAL(entry));
 	HeVAL(entry) = val;
 	return &HeVAL(entry);
@@ -413,9 +437,9 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 has
 
     entry = new_HE();
     if (HvSHAREKEYS(hv))
-	HeKEY_hek(entry) = share_hek(key, klen, hash);
+ HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
     else                                       /* gotta do the real thing */
-	HeKEY_hek(entry) = save_hek(key, klen, hash);
+ HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
     HeVAL(entry) = val;
     HeNEXT(entry) = *oentry;
     *oentry = entry;
@@ -458,13 +482,13 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
     register I32 i;
     register HE *entry;
     register HE **oentry;
+    bool is_utf8;
 
     if (!hv)
 	return 0;
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
-	dTHR;
  	bool needs_copy;
  	bool needs_store;
  	hv_magic_check (hv, &needs_copy, &needs_store);
@@ -489,6 +513,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
     }
 
     key = SvPV(keysv, klen);
+    is_utf8 = (SvUTF8(keysv) != 0);
 
     if (!hash)
 	PERL_HASH(hash, key, klen);
@@ -507,6 +532,8 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
 	    continue;
 	if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))	/* is this it? */
 	    continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+     continue;
 	SvREFCNT_dec(HeVAL(entry));
 	HeVAL(entry) = val;
 	return entry;
@@ -514,9 +541,9 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
 
     entry = new_HE();
     if (HvSHAREKEYS(hv))
-	HeKEY_hek(entry) = share_hek(key, klen, hash);
+ HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
     else                                       /* gotta do the real thing */
-	HeKEY_hek(entry) = save_hek(key, klen, hash);
+ HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
     HeVAL(entry) = val;
     HeNEXT(entry) = *oentry;
     *oentry = entry;
@@ -543,7 +570,7 @@ will be returned.
 */
 
 SV *
-Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
+Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 {
     register XPVHV* xhv;
     register I32 i;
@@ -552,9 +579,14 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
     register HE **oentry;
     SV **svp;
     SV *sv;
+    bool is_utf8 = FALSE;
 
     if (!hv)
 	return Nullsv;
+    if (klen < 0) {
+      klen = -klen;
+      is_utf8 = TRUE;
+    }
     if (SvRMAGICAL(hv)) {
 	bool needs_copy;
 	bool needs_store;
@@ -594,6 +626,8 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
 	    continue;
 	if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))	/* is this it? */
 	    continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+     continue;
 	*oentry = HeNEXT(entry);
 	if (i && !*oentry)
 	    xhv->xhv_fill--;
@@ -634,6 +668,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     register HE *entry;
     register HE **oentry;
     SV *sv;
+    bool is_utf8;
 
     if (!hv)
 	return Nullsv;
@@ -667,6 +702,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 	return Nullsv;
 
     key = SvPV(keysv, klen);
+    is_utf8 = (SvUTF8(keysv) != 0);
 
     if (!hash)
 	PERL_HASH(hash, key, klen);
@@ -681,6 +717,8 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 	    continue;
 	if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))	/* is this it? */
 	    continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+     continue;
 	*oentry = HeNEXT(entry);
 	if (i && !*oentry)
 	    xhv->xhv_fill--;
@@ -710,19 +748,24 @@ C<klen> is the length of the key.
 */
 
 bool
-Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 klen)
+Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
 {
     register XPVHV* xhv;
     register U32 hash;
     register HE *entry;
     SV *sv;
+    bool is_utf8 = FALSE;
 
     if (!hv)
 	return 0;
 
+    if (klen < 0) {
+      klen = -klen;
+      is_utf8 = TRUE;
+    }
+
     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'));
@@ -756,6 +799,8 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 klen)
 	    continue;
 	if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))	/* is this it? */
 	    continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+     continue;
 	return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
@@ -798,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);
@@ -1051,7 +1095,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
 	/* Slow way */
 	hv_iterinit(ohv);
 	while ((entry = hv_iternext(ohv))) {
-	    hv_store(hv, HeKEY(entry), HeKLEN(entry),
+     hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
 		     SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
 	}
 	HvRITER(ohv) = hv_riter;
@@ -1343,8 +1387,11 @@ Perl_hv_iterkeysv(pTHX_ register HE *entry)
     if (HeKLEN(entry) == HEf_SVKEY)
 	return sv_mortalcopy(HeKEY_sv(entry));
     else {
-	return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
-				  HeKLEN(entry), HeHASH(entry)));
+        SV *sv = newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
+    HeKLEN(entry), HeHASH(entry));
+ if (HeKUTF8(entry))
+     SvUTF8_on(sv);
+ return sv_2mortal(sv);
     }
 }
 
@@ -1452,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
@@ -1471,6 +1515,12 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
     register HE **oentry;
     register I32 i = 1;
     I32 found = 0;
+    bool is_utf8 = FALSE;
+
+    if (len < 0) {
+      len = -len;
+      is_utf8 = TRUE;
+    }
 
     /* what follows is the moral equivalent of:
 
@@ -1488,12 +1538,14 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 	    continue;
 	if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len))	/* is this it? */
 	    continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+     continue;
 	found = 1;
 	break;
     }
     if (!found) {
 	entry = new_HE();
-	HeKEY_hek(entry) = save_hek(str, len, hash);
+ HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
 	HeVAL(entry) = Nullsv;
 	HeNEXT(entry) = *oentry;
 	*oentry = entry;
diff --git a/hv.h b/hv.h
index 08f3bed7d5..f8cf2b968f 100644
--- a/hv.h
+++ b/hv.h
@@ -151,6 +151,8 @@ C<SV*>.
 #define HeKEY(he)		HEK_KEY(HeKEY_hek(he))
 #define HeKEY_sv(he)		(*(SV**)HeKEY(he))
 #define HeKLEN(he)		HEK_LEN(HeKEY_hek(he))
+#define HeKUTF8(he)  HEK_UTF8(HeKEY_hek(he))
+#define HeKLEN_UTF8(he)  (HeKUTF8(he) ? -HeKLEN(he) : HeKLEN(he))
 #define HeVAL(he)		(he)->hent_val
 #define HeHASH(he)		HEK_HASH(HeKEY_hek(he))
 #define HePV(he,lp)		((HeKLEN(he) == HEf_SVKEY) ?		\
@@ -175,6 +177,7 @@ C<SV*>.
 #define HEK_HASH(hek)		(hek)->hek_hash
 #define HEK_LEN(hek)		(hek)->hek_len
 #define HEK_KEY(hek)		(hek)->hek_key
+#define HEK_UTF8(hek)  (*(HEK_KEY(hek)+HEK_LEN(hek)))
 
 /* calculate HV array allocation */
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
diff --git a/lib/Carp.pm b/lib/Carp.pm
index 43524ddbe5..f7e9bf136a 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -68,6 +68,8 @@ $MaxArgLen = 64;        # How much of each argument to print. 0 = all.
 $MaxArgNums = 8;        # How many arguments to print. 0 = all.
 $Verbose = 0;		# If true then make shortmess call longmess instead
 
+$CarpInternal{Carp}++;
+
 require Exporter;
 @ISA = ('Exporter');
 @EXPORT = qw(confess croak carp);
diff --git a/lib/Carp/Heavy.pm b/lib/Carp/Heavy.pm
index 4d12bd7910..36bdcd49a3 100644
--- a/lib/Carp/Heavy.pm
+++ b/lib/Carp/Heavy.pm
@@ -1,247 +1,234 @@
 package Carp;
 
-=head1 NAME
+our $MaxEvalLen;
+our $MaxLenArg;
+our $Verbose;
+
+sub caller_info {
+  my $i = shift(@_) + 1;
+  package DB;
+  my %call_info;
+  @call_info{
+    qw(pack file line sub has_args wantarray evaltext is_require)
+  } = caller($i);
+  
+  unless (defined $call_info{pack}) {
+    return ();
+  }
+
+  my $sub_name = Carp::get_subname(\%call_info);
+  if ($call_info{has_args}) {
+    # Reuse the @args array to avoid warnings. :-)
+    local @args = map {Carp::format_arg($_)} @args;
+    if ($MaxArgNums and @args > $MaxArgNums) { # More than we want to show?
+      $#args = $MaxArgNums;
+      push @args, '...';
+    }
+    # Push the args onto the subroutine
+    $sub_name .= '(' . join (',', @args) . ')';
+  }
+  $call_info{sub_name} = $sub_name;
+  return wantarray() ? %call_info : \%call_info;
+}
 
-Carp::Heavy - Carp guts
+# Transform an argument to a function into a string.
+sub format_arg {
+  my $arg = shift;
+  if (not defined($arg)) {
+    $arg = 'undef';
+  }
+  elsif (ref($arg)) {
+    $arg .= ''; # Make it a string;
+  }
+  $arg =~ s/'/\\'/g;
+  $arg = str_len_trim($arg, $MaxLenArg);
+  
+  # Quote it?
+  $arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
+
+  # The following handling of "control chars" is direct from
+  # the original code - I think it is broken on Unicode though.
+  # Suggestions?
+  $arg =~ s/([[:cntrl:]]|[[^:ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
+  return $arg;
+}
 
-=head1 SYNOPIS
+# Takes an inheritance cache and a package and returns
+# an anon hash of known inheritances and anon array of
+# inheritances which consequences have not been figured
+# for.
+sub get_status {
+    my $cache = shift;
+    my $pkg = shift;
+    $cache->{$pkg} ||= [{$pkg => $pkg}, [trusts_directly($pkg)]];
+    return @{$cache->{$pkg}};
+}
 
-(internal use only)
+# Takes the info from caller() and figures out the name of
+# the sub/require/eval
+sub get_subname {
+  my $info = shift;
+  if (defined($info->{eval})) {
+    my $eval = $info->{eval};
+    if ($info->{is_require}) {
+      return "require $eval";
+    }
+    else {
+      $eval =~ s/([\\\'])/\\$1/g;
+      return str_len_trim($eval, $MaxEvalLen);
+    }
+  }
 
-=head1 DESCRIPTION
+  return ($info->{sub} eq '(eval)') ? 'eval {...}' : $info->{sub};
+}
 
-No user-serviceable parts inside.
+# Figures out what call (from the point of view of the caller)
+# the long error backtrace should start at.
+sub long_error_loc {
+  my $i;
+  my $lvl = $CarpLevel;
+  {
+    my $pkg = caller(++$i);
+    unless(defined($pkg)) {
+      # This *shouldn't* happen.
+      if (%Internal) {
+        local %Internal;
+        $i = long_error_loc();
+        last;
+      }
+      else {
+        # OK, now I am irritated.
+        return 2;
+      }
+    }
+    redo if $CarpInternal{$pkg};
+    redo unless 0 > --$lvl;
+    redo if $Internal{$pkg};
+  }
+  return $i - 1;
+}
 
-=cut
 
-# This package is heavily used. Be small. Be fast. Be good.
+sub longmess_heavy {
+  return @_ if ref($_[0]); # WHAT IS THIS FOR???
+  my $i = long_error_loc();
+  return ret_backtrace($i, @_);
+}
 
-# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
-# _almost_ complete understanding of the package.  Corrections and
-# comments are welcome.
+# Returns a full stack backtrace starting from where it is
+# told.
+sub ret_backtrace {
+  my ($i, @error) = @_;
+  my $mess;
+  my $err = join '', @error;
+  $i++;
+
+  my $tid_msg = '';
+  if (defined &Thread::tid) {
+    my $tid = Thread->self->tid;
+    $tid_msg = " thread $tid" if $tid;
+  }
+
+  if ($err =~ /\n$/) {
+    $mess = $err;
+  }
+  else {
+    my %i = caller_info($i);
+    $mess = "$err at $i{file} line $i{line}$tid_msg\n";
+  }
+
+  while (my %i = caller_info(++$i)) {
+      $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
+  }
+  
+  return $mess || $err;
+}
 
-# longmess() crawls all the way up the stack reporting on all the function
-# calls made.  The error string, $error, is originally constructed from the
-# arguments passed into longmess() via confess(), cluck() or shortmess().
-# This gets appended with the stack trace messages which are generated for
-# each function call on the stack.
+sub ret_summary {
+  my ($i, @error) = @_;
+  my $mess;
+  my $err = join '', @error;
+  $i++;
 
-sub longmess_heavy {
-    return @_ if ref $_[0];
-    my $error = join '', @_;
-    my $mess = "";
-    my $i = 1 + $CarpLevel;
-    my ($pack,$file,$line,$sub,$hargs,$eval,$require);
-    my (@a);
-    #
-    # crawl up the stack....
-    #
-    while (do { { package DB; @a = caller($i++) } } ) {
-	# get copies of the variables returned from caller()
-	($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
-	#
-	# if the $error error string is newline terminated then it
-	# is copied into $mess.  Otherwise, $mess gets set (at the end of
-	# the 'else' section below) to one of two things.  The first time
-	# through, it is set to the "$error at $file line $line" message.
-	# $error is then set to 'called' which triggers subsequent loop
-	# iterations to append $sub to $mess before appending the "$error
-	# at $file line $line" which now actually reads "called at $file line
-	# $line".  Thus, the stack trace message is constructed:
-	#
-	#        first time: $mess  = $error at $file line $line
-	#  subsequent times: $mess .= $sub $error at $file line $line
-	#                                  ^^^^^^
-	#                                 "called"
-	if ($error =~ m/\n$/) {
-	    $mess .= $error;
-	} else {
-	    # Build a string, $sub, which names the sub-routine called.
-	    # This may also be "require ...", "eval '...' or "eval {...}"
-	    if (defined $eval) {
-		if ($require) {
-		    $sub = "require $eval";
-		} else {
-		    $eval =~ s/([\\\'])/\\$1/g;
-		    if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
-			substr($eval,$MaxEvalLen) = '...';
-		    }
-		    $sub = "eval '$eval'";
-		}
-	    } elsif ($sub eq '(eval)') {
-		$sub = 'eval {...}';
-	    }
-	    # if there are any arguments in the sub-routine call, format
-	    # them according to the format variables defined earlier in
-	    # this file and join them onto the $sub sub-routine string
-	    if ($hargs) {
-		# we may trash some of the args so we take a copy
-		@a = @DB::args;	# must get local copy of args
-		# don't print any more than $MaxArgNums
-		if ($MaxArgNums and @a > $MaxArgNums) {
-		    # cap the length of $#a and set the last element to '...'
-		    $#a = $MaxArgNums;
-		    $a[$#a] = "...";
-		}
-		for (@a) {
-		    # set args to the string "undef" if undefined
-		    $_ = "undef", next unless defined $_;
-		    if (ref $_) {
-			# force reference to string representation
-			$_ .= '';
-			s/'/\\'/g;
-		    }
-		    else {
-			s/'/\\'/g;
-			# terminate the string early with '...' if too long
-			substr($_,$MaxArgLen) = '...'
-			    if $MaxArgLen and $MaxArgLen < length;
-		    }
-		    # 'quote' arg unless it looks like a number
-		    $_ = "'$_'" unless /^-?[\d.]+$/;
-		    # print high-end chars as 'M-<char>'
-		    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
-		    # print remaining control chars as ^<char>
-		    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
-		}
-		# append ('all', 'the', 'arguments') to the $sub string
-		$sub .= '(' . join(', ', @a) . ')';
-	    }
-	    # here's where the error message, $mess, gets constructed
-	    $mess .= "\t$sub " if $error eq "called";
-	    $mess .= "$error at $file line $line";
-	    if (defined &Thread::tid) {
-		my $tid = Thread->self->tid;
-		$mess .= " thread $tid" if $tid;
-	    }
-	    $mess .= "\n";
-	}
-	# we don't need to print the actual error message again so we can
-	# change this to "called" so that the string "$error at $file line
-	# $line" makes sense as "called at $file line $line".
-	$error = "called";
-    }
-    $mess || $error;
+  my $tid_msg = '';
+  if (defined &Thread::tid) {
+    my $tid = Thread->self->tid;
+    $tid_msg = " thread $tid" if $tid;
+  }
+
+  my %i = caller_info($i);
+  return "$err at $i{file} line $i{line}$tid_msg\n";
 }
 
 
-# ancestors() returns the complete set of ancestors of a module
-
-sub ancestors($$);
-
-sub ancestors($$){
-    my( $pack, $href ) = @_;
-    if( @{"${pack}::ISA"} ){
-	my $risa = \@{"${pack}::ISA"};
-	my %tree  = ();
-	@tree{@$risa} = ();
-	foreach my $mod ( @$risa ){
-	    # visit ancestors - if not already in the gallery
-	    if( ! defined( $$href{$mod} ) ){
-		my @ancs = ancestors( $mod, $href );
-		@tree{@ancs} = ();
-	    }
-	}
-	return ( keys( %tree ) );
-    } else {
-	return ();
-    }
+sub short_error_loc {
+  my $cache;
+  my $i = 1;
+  my $lvl = $CarpLevel;
+  {
+    my $called = caller($i++);
+    my $caller = caller($i);
+    return 0 unless defined($caller); # What happened?
+    redo if $Internal{$caller};
+    redo if $CarpInternal{$called};
+    redo if trusts($called, $caller, $cache);
+    redo if trusts($caller, $called, $cache);
+    redo unless 0 > --$lvl;
+  }
+  return $i - 1;
 }
 
+sub shortmess_heavy {
+  return longmess_heavy(@_) if $Verbose;
+  return @_ if ref($_[0]); # WHAT IS THIS FOR???
+  my $i = short_error_loc();
+  if ($i) {
+    ret_summary($i, @_);
+  }
+  else {
+    longmess_heavy(@_);
+  }
+}
+
+# If a string is too long, trims it with ...
+sub str_len_trim {
+  my $str = shift;
+  my $max = shift || 0;
+  if (2 < $max and $max < length($str)) {
+    substr($str, $max - 3) = '...';
+  }
+  return $str;
+}
 
-# shortmess() is called by carp() and croak() to skip all the way up to
-# the top-level caller's package and report the error from there.  confess()
-# and cluck() generate a full stack trace so they call longmess() to
-# generate that.  In verbose mode shortmess() calls longmess() so
-# you always get a stack trace
-
-sub shortmess_heavy {	# Short-circuit &longmess if called via multiple packages
-    goto &longmess_heavy if $Verbose;
-    return @_ if ref $_[0];
-    my $error = join '', @_;
-    my ($prevpack) = caller(1);
-    my $extra = $CarpLevel;
-
-    my @Clans = ( $prevpack );
-    my $i = 2;
-    my ($pack,$file,$line);
-    # when reporting an error, we want to report it from the context of the
-    # calling package.  So what is the calling package?  Within a module,
-    # there may be many calls between methods and perhaps between sub-classes
-    # and super-classes, but the user isn't interested in what happens
-    # inside the package.  We start by building a hash array which keeps
-    # track of all the packages to which the calling package belongs.  We
-    # do this by examining its @ISA variable.  Any call from a base class
-    # method (one of our caller's @ISA packages) can be ignored
-    my %isa;
-
-    # merge all the caller's @ISA packages and ancestors into %isa.
-    my @pars = ancestors( $prevpack, \%isa );
-    @isa{@pars} = () if @pars;
-    $isa{$prevpack} = 1;
-
-    # now we crawl up the calling stack and look at all the packages in
-    # there.  For each package, we look to see if it has an @ISA and then
-    # we see if our caller features in that list.  That would imply that
-    # our caller is a derived class of that package and its calls can also
-    # be ignored
-CALLER:
-    while (($pack,$file,$line) = caller($i++)) {
-
-        # Chances are, the caller's caller (or its caller...) is already
-        # in the gallery - if so, ignore this caller.
-        next if exists( $isa{$pack} );
-
-        # no: collect this module's ancestors.
-        my @i = ancestors( $pack, \%isa );
-        my %i;
-        if( @i ){
- 	    @i{@i} = ();
-            # check whether our representative of one of the clans is
-            # in this family tree.
-	    foreach my $cl (@Clans){
-                if( exists( $i{$cl} ) ){
-    	            # yes: merge all of the family tree into %isa
-	            @isa{@i,$pack} = ();
-		    # and here's where we do some more ignoring...
-		    # if the package in question is one of our caller's
-		    # base or derived packages then we can ignore it (skip it)
-		    # and go onto the next.
-		    next CALLER if exists( $isa{$pack} );
-		    last;
-		}
-            }
-	}
-
-	# Hey!  We've found a package that isn't one of our caller's
-	# clan....but wait, $extra refers to the number of 'extra' levels
-	# we should skip up.  If $extra > 0 then this is a false alarm.
-	# We must merge the package into the %isa hash (so we can ignore it
-	# if it pops up again), decrement $extra, and continue.
-	if ($extra-- > 0) {
-	    push( @Clans, $pack );
-	    @isa{@i,$pack} = ();
-	}
-	else {
-	    # OK!  We've got a candidate package.  Time to construct the
-	    # relevant error message and return it.
-	    my $msg;
-	    $msg = "$error at $file line $line";
-	    if (defined &Thread::tid) {
-		my $tid = Thread->self->tid;
-		$msg .= " thread $tid" if $tid;
-	    }
-	    $msg .= "\n";
-	    return $msg;
-	}
+# Takes two packages and an optional cache.  Says whether the
+# first inherits from the second.
+#
+# Recursive versions of this have to work to avoid certain
+# possible endless loops, and when following long chains of
+# inheritance are less efficient.
+sub trusts {
+    my $child = shift;
+    my $parent = shift;
+    my $cache = shift || {};
+    my ($known, $partial) = get_status($cache, $child);
+    # Figure out consequences until we have an answer
+    while (@$partial and not exists $known->{$parent}) {
+        my $anc = shift @$partial;
+        next if exists $known->{$anc};
+        $known->{$anc}++;
+        my ($anc_knows, $anc_partial) = get_status($cache, $anc);
+        my @found = keys %$anc_knows;
+        @$known{@found} = ();
+        push @$partial, @$anc_partial;
     }
+    return exists $known->{$parent};
+}
 
-    # uh-oh!  It looks like we crawled all the way up the stack and
-    # never found a candidate package.  Oh well, let's call longmess
-    # to generate a full stack trace.  We use the magical form of 'goto'
-    # so that this shortmess() function doesn't appear on the stack
-    # to further confuse longmess() about it's calling package.
-    goto &longmess_heavy;
+# Takes a package and gives a list of those trusted directly
+sub trusts_directly {
+    my $class = shift;
+    return @{"$class\::ISA"};
 }
 
 1;
+
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 36b5fa8a2d..a3c1753c3e 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -11,7 +11,7 @@ our($VERSION, $verbose, $switches, $have_devel_corestack, $curtest,
     $columns, @ISA, @EXPORT, @EXPORT_OK);
 $have_devel_corestack = 0;
 
-$VERSION = "1.1604";
+$VERSION = "1.1605";
 
 $ENV{HARNESS_ACTIVE} = 1;
 
@@ -121,7 +121,7 @@ sub runtests {
 			$ok++;
 			$totok++;
 		    }
-		} elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip\S*(?:(?>\s+)(.+))?)?/) {
+		} elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip\S*(?:(?>\s+)(.+))?)?$/) {
 		    $this = $1 if $1 > 0;
 		    print "${ml}ok $this/$max" if $ml;
 		    $ok++;
@@ -138,6 +138,10 @@ sub runtests {
 		      $skip_reason = $reason;
 		    }
 		    $bonus++, $totbonus++ if $todo{$this};
+		} else {
+		    # an ok or not ok not matching the 2 cases above...
+		    # just ignore it for compatibility with TEST
+		    next;
 		}
 		if ($this > $next) {
 		    # print "Test output counter mismatch [test $this]\n";
@@ -468,12 +472,14 @@ script(s). The default value is C<-w>.
 
 If the standard output line contains substring C< # Skip> (with
 variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
-counted as a skipped test.  If the whole testscript succeeds, the
-count of skipped tests is included in the generated output.
-
-C<Test::Harness> reports the text after C< # Skip(whatever)> as a
-reason for skipping.  Similarly, one can include a similar explanation
-in a C<1..0> line emitted if the test is skipped completely:
+counted as a skipped test.  In no other circumstance is anything
+allowed to follow C<ok> or C<ok NUMBER>.  If the whole testscript
+succeeds, the count of skipped tests is included in the generated
+output.
+
+C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason
+for skipping.  Similarly, one can include a similar explanation in a
+C<1..0> line emitted if the test is skipped completely:
 
   1..0 # Skipped: no leverage found
 
diff --git a/mg.c b/mg.c
index 660fa54140..52e1b0d7f0 100644
--- a/mg.c
+++ b/mg.c
@@ -39,7 +39,6 @@ struct magic_state {
 STATIC void
 S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 {
-    dTHR;
     MGS* mgs;
     assert(SvMAGICAL(sv));
 
@@ -91,7 +90,6 @@ Do magic after a value is retrieved from the SV.  See C<sv_magic>.
 int
 Perl_mg_get(pTHX_ SV *sv)
 {
-    dTHR;
     I32 mgs_ix;
     MAGIC* mg;
     MAGIC** mgp;
@@ -134,7 +132,6 @@ Do magic after a value is assigned to the SV.  See C<sv_magic>.
 int
 Perl_mg_set(pTHX_ SV *sv)
 {
-    dTHR;
     I32 mgs_ix;
     MAGIC* mg;
     MAGIC* nextmg;
@@ -334,7 +331,6 @@ Perl_mg_free(pTHX_ SV *sv)
 U32
 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     register REGEXP *rx;
 
     if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
@@ -350,7 +346,6 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     register I32 paren;
     register I32 s;
     register I32 i;
@@ -378,7 +373,6 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     Perl_croak(aTHX_ PL_no_modify);
     /* NOT REACHED */
     return 0;
@@ -387,7 +381,6 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 U32
 Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     register I32 paren;
     register I32 i;
     register REGEXP *rx;
@@ -469,7 +462,6 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -574,7 +566,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '\023':		/* ^S */
 	{
-	    dTHR;
 	    if (PL_lex_state != LEX_NOTPARSING)
 		(void)SvOK_off(sv);
 	    else if (PL_in_eval)
@@ -898,7 +889,6 @@ Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 #if defined(VMS)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
-    dTHR;
     if (PL_localizing) {
 	HE* entry;
 	STRLEN n_a;
@@ -1006,7 +996,6 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     register char *s;
     I32 i;
     SV** svp;
@@ -1269,7 +1258,6 @@ Perl_magic_existspack(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     OP *o;
     I32 i;
     GV* gv;
@@ -1288,7 +1276,6 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getarylen(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + PL_curcop->cop_arybase);
     return 0;
 }
@@ -1296,7 +1283,6 @@ Perl_magic_getarylen(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     av_fill((AV*)mg->mg_obj, SvIV(sv) - PL_curcop->cop_arybase);
     return 0;
 }
@@ -1309,7 +1295,6 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
 	mg = mg_find(lsv, 'g');
 	if (mg && mg->mg_len >= 0) {
-	    dTHR;
 	    I32 i = mg->mg_len;
 	    if (DO_UTF8(lsv))
 		sv_pos_b2u(lsv, &i);
@@ -1328,7 +1313,6 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     SSize_t pos;
     STRLEN len;
     STRLEN ulen = 0;
-    dTHR;
 
     mg = 0;
 
@@ -1439,7 +1423,6 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     TAINT_IF((mg->mg_len & 1) ||
 	     ((mg->mg_len & 2) && mg->mg_obj == sv));	/* kludge */
     return 0;
@@ -1448,7 +1431,6 @@ Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     if (PL_localizing) {
 	if (PL_localizing == 1)
 	    mg->mg_len <<= 1;
@@ -1507,7 +1489,6 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 		targ = AvARRAY(av)[LvTARGOFF(sv)];
 	}
 	if (targ && targ != &PL_sv_undef) {
-	    dTHR;		/* just for SvREFCNT_dec */
 	    /* somebody else defined it for us */
 	    SvREFCNT_dec(LvTARG(sv));
 	    LvTARG(sv) = SvREFCNT_inc(targ);
@@ -1538,7 +1519,6 @@ Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg)
 void
 Perl_vivify_defelem(pTHX_ SV *sv)
 {
-    dTHR;			/* just for SvREFCNT_inc and SvREFCNT_dec*/
     MAGIC *mg;
     SV *value = Nullsv;
 
@@ -1662,7 +1642,6 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     register char *s;
     I32 i;
     STRLEN len;
@@ -2110,7 +2089,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg)
 {
-    dTHR;
     DEBUG_S(PerlIO_printf(Perl_debug_log,
 			  "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n",
 			  PTR2UV(thr), PTR2UV(sv));)
@@ -2251,7 +2229,6 @@ cleanup:
 static void
 restore_magic(pTHXo_ void *p)
 {
-    dTHR;
     MGS* mgs = SSPTR(PTR2IV(p), MGS*);
     SV* sv = mgs->mgs_sv;
 
@@ -2293,7 +2270,6 @@ restore_magic(pTHXo_ void *p)
 static void
 unwind_handler_stack(pTHXo_ void *p)
 {
-    dTHR;
     U32 flags = *(U32*)p;
 
     if (flags & 1)
diff --git a/objXSUB.h b/objXSUB.h
index 91dc6df07c..5a3850cb4e 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1781,6 +1781,10 @@
 #define Perl_sv_unref		pPerl->Perl_sv_unref
 #undef  sv_unref
 #define sv_unref		Perl_sv_unref
+#undef  Perl_sv_unref_flags
+#define Perl_sv_unref_flags	pPerl->Perl_sv_unref_flags
+#undef  sv_unref_flags
+#define sv_unref_flags		Perl_sv_unref_flags
 #undef  Perl_sv_untaint
 #define Perl_sv_untaint		pPerl->Perl_sv_untaint
 #undef  sv_untaint
@@ -2138,6 +2142,10 @@
 #define Perl_sv_force_normal	pPerl->Perl_sv_force_normal
 #undef  sv_force_normal
 #define sv_force_normal		Perl_sv_force_normal
+#undef  Perl_sv_force_normal_flags
+#define Perl_sv_force_normal_flags	pPerl->Perl_sv_force_normal_flags
+#undef  sv_force_normal_flags
+#define sv_force_normal_flags	Perl_sv_force_normal_flags
 #undef  Perl_tmps_grow
 #define Perl_tmps_grow		pPerl->Perl_tmps_grow
 #undef  tmps_grow
diff --git a/op.c b/op.c
index 9d00b7b593..c530e5f484 100644
--- a/op.c
+++ b/op.c
@@ -107,7 +107,6 @@ S_no_bareword_allowed(pTHX_ OP *o)
 PADOFFSET
 Perl_pad_allocmy(pTHX_ char *name)
 {
-    dTHR;
     PADOFFSET off;
     SV *sv;
 
@@ -238,7 +237,6 @@ STATIC PADOFFSET
 S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 	    I32 cx_ix, I32 saweval, U32 flags)
 {
-    dTHR;
     CV *cv;
     I32 off;
     SV *sv;
@@ -385,7 +383,6 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 PADOFFSET
 Perl_pad_findmy(pTHX_ char *name)
 {
-    dTHR;
     I32 off;
     I32 pendoff = 0;
     SV *sv;
@@ -448,7 +445,6 @@ Perl_pad_findmy(pTHX_ char *name)
 void
 Perl_pad_leavemy(pTHX_ I32 fill)
 {
-    dTHR;
     I32 off;
     SV **svp = AvARRAY(PL_comppad_name);
     SV *sv;
@@ -468,7 +464,6 @@ Perl_pad_leavemy(pTHX_ I32 fill)
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
-    dTHR;
     SV *sv;
     I32 retval;
 
@@ -520,7 +515,6 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
-    dTHR;
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 			  "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
@@ -537,7 +531,6 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
-    dTHR;
     if (!PL_curpad)
 	return;
     if (AvARRAY(PL_comppad) != PL_curpad)
@@ -565,7 +558,6 @@ Perl_pad_free(pTHX_ PADOFFSET po)
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po)
 {
-    dTHR;
     if (AvARRAY(PL_comppad) != PL_curpad)
 	Perl_croak(aTHX_ "panic: pad_swipe curpad");
     if (!po)
@@ -595,7 +587,6 @@ void
 Perl_pad_reset(pTHX)
 {
 #ifdef USE_BROKEN_PAD_RESET
-    dTHR;
     register I32 po;
 
     if (AvARRAY(PL_comppad) != PL_curpad)
@@ -624,7 +615,6 @@ Perl_pad_reset(pTHX)
 PADOFFSET
 Perl_find_threadsv(pTHX_ const char *name)
 {
-    dTHR;
     char *p;
     PADOFFSET key;
     SV **svp;
@@ -911,7 +901,6 @@ STATIC OP *
 S_scalarboolean(pTHX_ OP *o)
 {
     if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
-	dTHR;
 	if (ckWARN(WARN_SYNTAX)) {
 	    line_t oldline = CopLINE(PL_curcop);
 
@@ -1007,10 +996,7 @@ Perl_scalarvoid(pTHX_ OP *o)
 	|| (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
 				      || o->op_targ == OP_SETSTATE
 				      || o->op_targ == OP_DBSTATE)))
-    {
-	dTHR;
 	PL_curcop = (COP*)o;		/* for warning below */
-    }
 
     /* assumes no premature commitment */
     want = o->op_flags & OPf_WANT;
@@ -1127,7 +1113,6 @@ Perl_scalarvoid(pTHX_ OP *o)
 	if (cSVOPo->op_private & OPpCONST_STRICT)
 	    no_bareword_allowed(o);
 	else {
-	    dTHR;
 	    if (ckWARN(WARN_VOID)) {
 		useless = "a constant";
 		if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
@@ -1196,11 +1181,8 @@ Perl_scalarvoid(pTHX_ OP *o)
 	}
 	break;
     }
-    if (useless) {
-	dTHR;
-	if (ckWARN(WARN_VOID))
-	    Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless);
-    }
+    if (useless && ckWARN(WARN_VOID))
+	Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless);
     return o;
 }
 
@@ -1301,7 +1283,6 @@ Perl_scalarseq(pTHX_ OP *o)
 	     o->op_type == OP_LEAVE ||
 	     o->op_type == OP_LEAVETRY)
 	{
-	    dTHR;
 	    for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
 		if (kid->op_sibling) {
 		    scalarvoid(kid);
@@ -1332,7 +1313,6 @@ S_modkids(pTHX_ OP *o, I32 type)
 OP *
 Perl_mod(pTHX_ OP *o, I32 type)
 {
-    dTHR;
     OP *kid;
     STRLEN n_a;
 
@@ -1967,7 +1947,6 @@ Perl_sawparens(pTHX_ OP *o)
 OP *
 Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
 {
-    dTHR;
     OP *o;
 
     if (ckWARN(WARN_MISC) &&
@@ -2054,7 +2033,6 @@ Perl_save_hints(pTHX)
 int
 Perl_block_start(pTHX_ int full)
 {
-    dTHR;
     int retval = PL_savestack_ix;
 
     SAVEI32(PL_comppad_name_floor);
@@ -2088,7 +2066,6 @@ Perl_block_start(pTHX_ int full)
 OP*
 Perl_block_end(pTHX_ I32 floor, OP *seq)
 {
-    dTHR;
     int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
     OP* retval = scalarseq(seq);
     LEAVE_SCOPE(floor);
@@ -2116,7 +2093,6 @@ S_newDEFSVOP(pTHX)
 void
 Perl_newPROG(pTHX_ OP *o)
 {
-    dTHR;
     if (PL_in_eval) {
 	if (PL_eval_root)
 		return;
@@ -2161,7 +2137,6 @@ Perl_localize(pTHX_ OP *o, I32 lex)
     if (o->op_flags & OPf_PARENS)
 	list(o);
     else {
-	dTHR;
 	if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
 	    char *s;
 	    for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
@@ -2199,7 +2174,6 @@ Perl_jmaybe(pTHX_ OP *o)
 OP *
 Perl_fold_constants(pTHX_ register OP *o)
 {
-    dTHR;
     register OP *curop;
     I32 type = o->op_type;
     SV *sv;
@@ -2317,7 +2291,6 @@ Perl_fold_constants(pTHX_ register OP *o)
 OP *
 Perl_gen_constant_list(pTHX_ register OP *o)
 {
-    dTHR;
     register OP *curop;
     I32 oldtmps_floor = PL_tmps_floor;
 
@@ -2646,7 +2619,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	I32 to_utf	= o->op_private & OPpTRANS_TO_UTF;
 
 	if (complement) {
-	    U8 tmpbuf[UTF8_MAXLEN];
+	    U8 tmpbuf[UTF8_MAXLEN+1];
 	    U8** cp;
 	    I32* cl;
 	    UV nextmin = 0;
@@ -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;
@@ -6778,6 +6722,8 @@ Perl_peep(pTHX_ register OP *o)
 	    if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
 		key = SvPV(sv, keylen);
 		lexname = newSVpvn_share(key, keylen, 0);
+		if (SvUTF8(sv))
+		    SvUTF8_on(lexname);
 		SvREFCNT_dec(sv);
 		*svp = lexname;
 	    }
diff --git a/opcode.pl b/opcode.pl
index 43d98ae8af..22ef9721ce 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -56,7 +56,9 @@ for (@ops) {
 }
 print ON "\t", &tab(3,"OP_max"), "\n";
 print ON "} opcode;\n";
-print ON "\n#define MAXO ", scalar @ops, "\n\n"; 
+print ON "\n#define MAXO ", scalar @ops, "\n";
+print ON "#define OP_phoney_INPUT_ONLY -1\n";
+print ON "#define OP_phoney_OUTPUT_ONLY -2\n\n";
 
 # Emit op names and descriptions.
 
diff --git a/opnames.h b/opnames.h
index ba28f685fc..16b2f02278 100644
--- a/opnames.h
+++ b/opnames.h
@@ -359,6 +359,8 @@ typedef enum opcode {
 } opcode;
 
 #define MAXO 351
+#define OP_phoney_INPUT_ONLY -1
+#define OP_phoney_OUTPUT_ONLY -2
 
 
 #define OP_IS_SOCKET(op)	\
diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs
index 1dc20d3c04..b196ea19b8 100644
--- a/os2/OS2/REXX/REXX.xs
+++ b/os2/OS2/REXX/REXX.xs
@@ -46,7 +46,6 @@ static long incompartment;
 static SV*
 exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
 {
-    dTHR;
     HMODULE hRexx, hRexxAPI;
     BYTE    buf[200];
     LONG    APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING, 
diff --git a/os2/os2.c b/os2/os2.c
index c324cf20f1..b244716f2f 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -21,6 +21,8 @@
 #include <process.h>
 #include <fcntl.h>
 
+#define PERLIO_NOT_STDIO 0
+
 #include "EXTERN.h"
 #include "perl.h"
 
@@ -375,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() */
@@ -467,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;
@@ -605,8 +605,9 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 		char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
 
 		if (scr) {
-		    FILE *file;
-		    char *s = 0, *s1;
+		    PerlIO *file;
+                    SSize_t rd;
+		    char *s = 0, *s1, *s2;
 		    int l;
 
                     l = strlen(scr);
@@ -622,14 +623,18 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
                     Safefree(scr);
                     scr = scrbuf;
 
-		    file = fopen(scr, "r");
+		    file = PerlIO_open(scr, "r");
 		    PL_Argv[0] = scr;
 		    if (!file)
 			goto panic_file;
-		    if (!fgets(buf, sizeof buf, file)) { /* Empty... */
 
+		    rd = PerlIO_read(file, buf, sizeof buf-1);
+		    buf[rd]='\0';
+		    if ((s2 = strchr(buf, '\n')) != NULL) *++s2 = '\0';
+
+		    if (!rd) { /* Empty... */
 			buf[0] = 0;
-			fclose(file);
+			PerlIO_close(file);
 			/* Special case: maybe from -Zexe build, so
 			   there is an executable around (contrary to
 			   documentation, DosQueryAppType sometimes (?)
@@ -648,7 +653,7 @@ do_spawn_ve(pTHX_ SV *really, U32 flag, U32 execf, char *inicmd, U32 addflag)
 			} else
 			    goto longbuf;
 		    }
-		    if (fclose(file) != 0) { /* Failure */
+		    if (PerlIO_close(file) != 0) { /* Failure */
 		      panic_file:
 			Perl_warner(aTHX_ WARN_EXEC, "Error reading \"%s\": %s", 
 			     scr, Strerror(errno));
@@ -818,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];
@@ -946,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;
@@ -984,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;
 }
@@ -1006,7 +1006,6 @@ Perl_do_exec(pTHX_ char *cmd)
 bool
 os2exec(pTHX_ char *cmd)
 {
-    dTHR;
     return do_spawn3(aTHX_ cmd, EXECF_TRUEEXEC, 0);
 }
 
@@ -1367,7 +1366,6 @@ os2error(int rc)
 char *
 os2_execname(pTHX)
 {
-  dTHR;
   char buf[300], *p;
 
   if (_execname(buf, sizeof buf) != 0)
diff --git a/os2/os2ish.h b/os2/os2ish.h
index c9719e65bd..dccd9320b6 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -155,7 +155,6 @@ extern int rc;
 	    Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc);	\
     } STMT_END
 /*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
-#define dTHR struct thread *thr = THR
 */
 
 #ifdef USE_SLOW_THREAD_SPECIFIC
diff --git a/patchlevel.h b/patchlevel.h
index ab9c9007af..ed74b1659d 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -70,7 +70,7 @@
 #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
 static	char	*local_patches[] = {
         NULL
-	,"DEVEL7952"
+	,"DEVEL7978"
 	,NULL
 };
 
diff --git a/perl.c b/perl.c
index 1467df1c15..7064e2b9eb 100644
--- a/perl.c
+++ b/perl.c
@@ -298,7 +298,6 @@ Shuts down a Perl interpreter.  See L<perlembed>.
 void
 perl_destruct(pTHXx)
 {
-    dTHR;
     int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     I32 last_sv_count;
     HV *hv;
@@ -789,13 +788,12 @@ perl_free(pTHXx)
 #  if defined(WIN32)
 #  if defined(PERL_IMPLICIT_SYS)
     void *host = w32_internal_host;
-    if (PerlProc_lasthost()) {
-	PerlIO_cleanup();     
-    }
+    if (PerlProc_lasthost())
+	PerlIO_cleanup();
     PerlMem_free(aTHXx);
     win32_delete_internal_host(host);
 #else
-    PerlIO_cleanup();     
+    PerlIO_cleanup();
     PerlMem_free(aTHXx);
 #endif
 #  else
@@ -824,7 +822,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;
@@ -926,7 +923,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;
@@ -1357,7 +1353,6 @@ Tells a Perl interpreter to run.  See L<perlembed>.
 int
 perl_run(pTHXx)
 {
-    dTHR;
     I32 oldscope;
     int ret = 0;
     dJMPENV;
@@ -1425,8 +1420,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"));
 
@@ -1485,10 +1478,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);
@@ -1808,8 +1799,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 */
@@ -2042,7 +2031,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);
@@ -2118,7 +2106,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");
@@ -2180,7 +2167,6 @@ Perl_moreswitches(pTHX_ char *s)
 	    s += numlen;
 	}
 	else {
-	    dTHR;
 	    if (RsPARA(PL_nrs)) {
 		PL_ors = "\n\n";
 		PL_orslen = 2;
@@ -2495,7 +2481,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
@@ -2539,8 +2524,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) {
@@ -2834,7 +2817,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 */
@@ -3032,7 +3014,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)
 	    ||
@@ -3123,7 +3104,6 @@ S_forbid_setid(pTHX_ char *s)
 void
 Perl_init_debugger(pTHX)
 {
-    dTHR;
     HV *ostash = PL_curstash;
 
     PL_curstash = PL_debstash;
@@ -3191,7 +3171,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) {
@@ -3228,7 +3207,6 @@ S_init_lexer(pTHX)
 STATIC void
 S_init_predump_symbols(pTHX)
 {
-    dTHR;
     GV *tmpgv;
     IO *io;
 
@@ -3268,7 +3246,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;
@@ -3663,8 +3640,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);
@@ -3692,7 +3670,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;
@@ -3797,8 +3774,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) {
@@ -3847,7 +3822,6 @@ Perl_my_failure_exit(pTHX)
 STATIC void
 S_my_exit_jump(pTHX)
 {
-    dTHR;
     register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
diff --git a/perl.h b/perl.h
index 562da8ae5d..a55ebefc6e 100644
--- a/perl.h
+++ b/perl.h
@@ -183,7 +183,7 @@ class CPerlObj;
 struct perl_thread;
 #    define pTHX	register struct perl_thread *thr
 #    define aTHX	thr
-#    define dTHR	dNOOP
+#    define dTHR	dNOOP /* only backward compatibility */
 #    define dTHXa(a)	pTHX = (struct perl_thread*)a
 #  else
 #    ifndef MULTIPLICITY
@@ -303,7 +303,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #endif
 
 #define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
-#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
+#define WITH_THR(s) WITH_THX(s)
 
 /*
  * SOFT_CAST can be used for args to prototyped functions to retain some
diff --git a/perlapi.c b/perlapi.c
index 02c5aa3bca..4f3497e4fd 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -936,7 +936,7 @@ Perl_hv_delayfree_ent(pTHXo_ HV* hv, HE* entry)
 
 #undef  Perl_hv_delete
 SV*
-Perl_hv_delete(pTHXo_ HV* tb, const char* key, U32 klen, I32 flags)
+Perl_hv_delete(pTHXo_ HV* tb, const char* key, I32 klen, I32 flags)
 {
     return ((CPerlObj*)pPerl)->Perl_hv_delete(tb, key, klen, flags);
 }
@@ -950,7 +950,7 @@ Perl_hv_delete_ent(pTHXo_ HV* tb, SV* key, I32 flags, U32 hash)
 
 #undef  Perl_hv_exists
 bool
-Perl_hv_exists(pTHXo_ HV* tb, const char* key, U32 klen)
+Perl_hv_exists(pTHXo_ HV* tb, const char* key, I32 klen)
 {
     return ((CPerlObj*)pPerl)->Perl_hv_exists(tb, key, klen);
 }
@@ -964,7 +964,7 @@ Perl_hv_exists_ent(pTHXo_ HV* tb, SV* key, U32 hash)
 
 #undef  Perl_hv_fetch
 SV**
-Perl_hv_fetch(pTHXo_ HV* tb, const char* key, U32 klen, I32 lval)
+Perl_hv_fetch(pTHXo_ HV* tb, const char* key, I32 klen, I32 lval)
 {
     return ((CPerlObj*)pPerl)->Perl_hv_fetch(tb, key, klen, lval);
 }
@@ -1041,7 +1041,7 @@ Perl_hv_magic(pTHXo_ HV* hv, GV* gv, int how)
 
 #undef  Perl_hv_store
 SV**
-Perl_hv_store(pTHXo_ HV* tb, const char* key, U32 klen, SV* val, U32 hash)
+Perl_hv_store(pTHXo_ HV* tb, const char* key, I32 klen, SV* val, U32 hash)
 {
     return ((CPerlObj*)pPerl)->Perl_hv_store(tb, key, klen, val, hash);
 }
@@ -3365,7 +3365,7 @@ Perl_utf8_length(pTHXo_ U8* s, U8 *e)
 }
 
 #undef  Perl_utf8_distance
-I32
+IV
 Perl_utf8_distance(pTHXo_ U8 *a, U8 *b)
 {
     return ((CPerlObj*)pPerl)->Perl_utf8_distance(a, b);
diff --git a/perlio.c b/perlio.c
index cd6a244664..4ffcc2ec57 100644
--- a/perlio.c
+++ b/perlio.c
@@ -28,6 +28,12 @@
 #define PERL_IN_PERLIO_C
 #include "perl.h"
 
+#undef PerlMemShared_calloc
+#define PerlMemShared_calloc(x,y) calloc(x,y)
+#undef PerlMemShared_free
+#define PerlMemShared_free(x) free(x)
+
+
 #ifndef PERLIO_LAYERS
 int
 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
@@ -1534,12 +1540,20 @@ IV
 PerlIOStdio_close(PerlIO *f)
 {
  dTHX;
+#ifdef HAS_SOCKET
  int optval, optlen = sizeof(int);
+#endif
  FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
  return(
+#ifdef HAS_SOCKET
    (getsockopt(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (char *)&optval, &optlen) < 0) ?
        PerlSIO_fclose(stdio) :
-       close(PerlIO_fileno(f)));
+       close(PerlIO_fileno(f))
+#else
+   PerlSIO_fclose(stdio)
+#endif
+     );
+
 }
 
 IV
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index 7296c81d0e..f5b237f6db 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -761,7 +761,7 @@ hash and returned to the caller.  The C<klen> is the length of the key.
 The C<flags> value will normally be zero; if set to G_DISCARD then NULL
 will be returned.
 
-	SV*	hv_delete(HV* tb, const char* key, U32 klen, I32 flags)
+	SV*	hv_delete(HV* tb, const char* key, I32 klen, I32 flags)
 
 =for hackers
 Found in file hv.c
@@ -783,7 +783,7 @@ Found in file hv.c
 Returns a boolean indicating whether the specified hash key exists.  The
 C<klen> is the length of the key.
 
-	bool	hv_exists(HV* tb, const char* key, U32 klen)
+	bool	hv_exists(HV* tb, const char* key, I32 klen)
 
 =for hackers
 Found in file hv.c
@@ -809,7 +809,7 @@ dereferencing it to a C<SV*>.
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
 
-	SV**	hv_fetch(HV* tb, const char* key, U32 klen, I32 lval)
+	SV**	hv_fetch(HV* tb, const char* key, I32 klen, I32 lval)
 
 =for hackers
 Found in file hv.c
@@ -920,7 +920,7 @@ the call, and decrementing it if the function returned NULL.
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
 
-	SV**	hv_store(HV* tb, const char* key, U32 klen, SV* val, U32 hash)
+	SV**	hv_store(HV* tb, const char* key, I32 klen, SV* val, U32 hash)
 
 =for hackers
 Found in file hv.c
@@ -2368,19 +2368,19 @@ false, defined or undefined.  Does not handle 'get' magic.
 =for hackers
 Found in file sv.h
 
-=item SvTYPE
-
-Returns the type of the SV.  See C<svtype>.
+=item svtype
 
-	svtype	SvTYPE(SV* sv)
+An enum of flags for Perl types.  These are found in the file B<sv.h> 
+in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
 
 =for hackers
 Found in file sv.h
 
-=item svtype
+=item SvTYPE
 
-An enum of flags for Perl types.  These are found in the file B<sv.h> 
-in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV.  See C<svtype>.
+
+	svtype	SvTYPE(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -3063,13 +3063,29 @@ Found in file sv.c
 
 Unsets the RV status of the SV, and decrements the reference count of
 whatever was being referenced by the RV.  This can almost be thought of
-as a reversal of C<newSVrv>.  See C<SvROK_off>.
+as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with C<flag>
+of zero.  See C<SvROK_off>.  
 
 	void	sv_unref(SV* sv)
 
 =for hackers
 Found in file sv.c
 
+=item sv_unref_flags
+
+Unsets the RV status of the SV, and decrements the reference count of
+whatever was being referenced by the RV.  This can almost be thought of
+as a reversal of C<newSVrv>.  The C<cflags> argument can contain
+C<SV_IMMEDIATE_UNREF> to force the reference count to be decremented
+(otherwise the decrementing is conditional on the reference count being
+different from one or the reference being a readonly SV).
+See C<SvROK_off>.  
+
+	void	sv_unref_flags(SV* sv, U32 flags)
+
+=for hackers
+Found in file sv.c
+
 =item sv_upgrade
 
 Upgrade an SV to a more complex form.  Use C<SvUPGRADE>.  See
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index c069e8801c..ded9191923 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -76,6 +76,10 @@ L<perlsec>).  This pointer may be NULL if that information is not
 important.  Note that this function requires you to specify the length of
 the format.
 
+STRLEN is an integer type (Size_t, usually defined as size_t in
+config.h) guaranteed to be large enough to represent the size of 
+any string that perl can handle.
+
 The C<sv_set*()> functions are not generic enough to operate on values
 that have "magic".  See L<Magic Virtual Tables> later in this document.
 
diff --git a/pp.c b/pp.c
index 17beb6c8a1..c512db3d98 100644
--- a/pp.c
+++ b/pp.c
@@ -1792,7 +1792,6 @@ S_seed(pTHX)
 #define   SEED_C3	269
 #define   SEED_C5	26107
 
-    dTHR;
 #ifndef PERL_NO_DEV_RANDOM
     int fd;
 #endif
@@ -2321,7 +2320,7 @@ PP(pp_ucfirst)
 
     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
 	STRLEN ulen;
-	U8 tmpbuf[UTF8_MAXLEN];
+	U8 tmpbuf[UTF8_MAXLEN+1];
 	U8 *tend;
 	UV uv = utf8_to_uv(s, slen, &ulen, 0);
 
@@ -2380,7 +2379,7 @@ PP(pp_lcfirst)
 
     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
 	STRLEN ulen;
-	U8 tmpbuf[UTF8_MAXLEN];
+	U8 tmpbuf[UTF8_MAXLEN+1];
 	U8 *tend;
 	UV uv = utf8_to_uv(s, slen, &ulen, 0);
 
@@ -4727,7 +4726,7 @@ PP(pp_pack)
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
 		auint = SvUV(fromstr);
-		SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN);
+		SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1);
 		SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint)
 			       - SvPVX(cat));
 	    }
@@ -5338,7 +5337,6 @@ PP(pp_split)
 void
 Perl_unlock_condpair(pTHX_ void *svv)
 {
-    dTHR;
     MAGIC *mg = mg_find((SV*)svv, 'm');
 
     if (!mg)
diff --git a/pp.h b/pp.h
index 029583a09b..2226c20a6a 100644
--- a/pp.h
+++ b/pp.h
@@ -61,7 +61,7 @@ Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
 #define POPMARK		(*PL_markstack_ptr--)
 
 #define djSP		register SV **sp = PL_stack_sp
-#define dSP		dTHR; djSP
+#define dSP		djSP
 #define dMARK		register SV **mark = PL_stack_base + POPMARK
 #define dORIGMARK	I32 origmark = mark - PL_stack_base
 #define SETORIGMARK	origmark = mark - PL_stack_base
diff --git a/pp_ctl.c b/pp_ctl.c
index d22f2efc0f..d079e4af22 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1160,7 +1160,6 @@ PP(pp_flop)
 STATIC I32
 S_dopoptolabel(pTHX_ char *label)
 {
-    dTHR;
     register I32 i;
     register PERL_CONTEXT *cx;
 
@@ -1216,7 +1215,6 @@ Perl_dowantarray(pTHX)
 I32
 Perl_block_gimme(pTHX)
 {
-    dTHR;
     I32 cxix;
 
     cxix = dopoptosub(cxstack_ix);
@@ -1240,14 +1238,12 @@ Perl_block_gimme(pTHX)
 STATIC I32
 S_dopoptosub(pTHX_ I32 startingblock)
 {
-    dTHR;
     return dopoptosub_at(cxstack, startingblock);
 }
 
 STATIC I32
 S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock)
 {
-    dTHR;
     I32 i;
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
@@ -1268,7 +1264,6 @@ S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock)
 STATIC I32
 S_dopoptoeval(pTHX_ I32 startingblock)
 {
-    dTHR;
     I32 i;
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
@@ -1287,7 +1282,6 @@ S_dopoptoeval(pTHX_ I32 startingblock)
 STATIC I32
 S_dopoptoloop(pTHX_ I32 startingblock)
 {
-    dTHR;
     I32 i;
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
@@ -1329,7 +1323,6 @@ S_dopoptoloop(pTHX_ I32 startingblock)
 void
 Perl_dounwind(pTHX_ I32 cxix)
 {
-    dTHR;
     register PERL_CONTEXT *cx;
     I32 optype;
 
@@ -1375,7 +1368,6 @@ Perl_dounwind(pTHX_ I32 cxix)
 STATIC void
 S_free_closures(pTHX)
 {
-    dTHR;
     SV **svp = AvARRAY(PL_comppad_name);
     I32 ix;
     for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) {
@@ -1768,7 +1760,6 @@ PP(pp_enteriter)
 
 #ifdef USE_THREADS
     if (PL_op->op_flags & OPf_SPECIAL) {
-	dTHR;
 	svp = &THREADSV(PL_op->op_targ);	/* per-thread variable */
 	SAVEGENERICSV(*svp);
 	*svp = NEWSV(0,0);
@@ -2158,7 +2149,6 @@ S_dofindlabel(pTHX_ OP *o, char *label, OP **opstack, OP **oplimit)
     }
     *ops = 0;
     if (o->op_flags & OPf_KIDS) {
-	dTHR;
 	/* First try all the kids at this level, since that's likeliest. */
 	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
 	    if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
@@ -2669,7 +2659,6 @@ S_docatch_body(pTHX)
 STATIC OP *
 S_docatch(pTHX_ OP *o)
 {
-    dTHR;
     int ret;
     OP *oldop = PL_op;
     volatile PERL_SI *cursi = PL_curstackinfo;
@@ -4147,7 +4136,6 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
 static I32
 sortcv(pTHXo_ SV *a, SV *b)
 {
-    dTHR;
     I32 oldsaveix = PL_savestack_ix;
     I32 oldscopeix = PL_scopestack_ix;
     I32 result;
@@ -4171,7 +4159,6 @@ sortcv(pTHXo_ SV *a, SV *b)
 static I32
 sortcv_stacked(pTHXo_ SV *a, SV *b)
 {
-    dTHR;
     I32 oldsaveix = PL_savestack_ix;
     I32 oldscopeix = PL_scopestack_ix;
     I32 result;
diff --git a/pp_hot.c b/pp_hot.c
index 7b5f8320e8..830d56ed03 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -406,7 +406,6 @@ PP(pp_print)
 	RETURN;
     }
     if (!(io = GvIO(gv))) {
-        dTHR;
         if ((GvEGV(gv)) && (mg = SvTIED_mg((SV*)GvEGV(gv),'q')))
             goto had_magic;
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
@@ -416,21 +415,8 @@ PP(pp_print)
     }
     else if (!(fp = IoOFP(io))) {
 	if (ckWARN2(WARN_CLOSED, WARN_IO))  {
-	    if (IoIFP(io)) {
-		/* integrate with report_evil_fh()? */
-	        char *name = NULL;
-		if (isGV(gv)) {
-		    SV* sv = sv_newmortal();
-		    gv_efullname4(sv, gv, Nullch, FALSE);
-		    name = SvPV_nolen(sv);
-		}
-		if (name && *name)
-		  Perl_warner(aTHX_ WARN_IO,
-			      "Filehandle %s opened only for input", name);
-		else
-		    Perl_warner(aTHX_ WARN_IO,
-				"Filehandle opened only for input");
-	    }
+	    if (IoIFP(io))
+		report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
 	    else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 		report_evil_fh(gv, io, PL_op->op_type);
 	}
@@ -1395,21 +1381,7 @@ Perl_do_readline(pTHX)
 	else if (ckWARN(WARN_IO)	/* stdout/stderr or other write fh */
 		 && (IoTYPE(io) == IoTYPE_WRONLY || fp == PerlIO_stdout()
 		     || fp == PerlIO_stderr()))
-	{
-	    /* integrate with report_evil_fh()? */
-	    char *name = NULL;
-	    if (isGV(PL_last_in_gv)) { /* can this ever fail? */
-		SV* sv = sv_newmortal();
-		gv_efullname4(sv, PL_last_in_gv, Nullch, FALSE);
-		name = SvPV_nolen(sv);
-	    }
-	    if (name && *name)
-		Perl_warner(aTHX_ WARN_IO,
-			    "Filehandle %s opened only for output", name);
-	    else
-		Perl_warner(aTHX_ WARN_IO,
-			    "Filehandle opened only for output");
-	}
+	    report_evil_fh(PL_last_in_gv, io, OP_phoney_OUTPUT_ONLY);
     }
     if (!fp) {
 	if (ckWARN2(WARN_GLOB, WARN_CLOSED)
@@ -2288,7 +2260,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 +2963,6 @@ static void
 unset_cvowner(pTHXo_ void *cvarg)
 {
     register CV* cv = (CV *) cvarg;
-#ifdef DEBUGGING
-    dTHR;
-#endif /* DEBUGGING */
 
     DEBUG_S((PerlIO_printf(Perl_debug_log, "%p unsetting CvOWNER of %p:%s\n",
 			   thr, cv, SvPEEK((SV*)cv))));
diff --git a/pp_sys.c b/pp_sys.c
index 7e5abbdd4d..314b8851fd 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1059,7 +1059,6 @@ PP(pp_sselect)
 void
 Perl_setdefout(pTHX_ GV *gv)
 {
-    dTHR;
     if (gv)
 	(void)SvREFCNT_inc(gv);
     if (PL_defoutgv)
@@ -1142,7 +1141,6 @@ PP(pp_read)
 STATIC OP *
 S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
-    dTHR;
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
     AV* padlist = CvPADLIST(cv);
@@ -1378,7 +1376,6 @@ PP(pp_prtf)
 
     sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
-        dTHR;
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 	    report_evil_fh(gv, io, PL_op->op_type);
 	SETERRNO(EBADF,RMS$_IFI);
@@ -2562,7 +2559,6 @@ PP(pp_stat)
 		? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1);
 	}
 	if (PL_laststatval < 0) {
-	    dTHR;
 	    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 		report_evil_fh(gv, GvIO(gv), PL_op->op_type);
 	    max = 0;
@@ -3117,7 +3113,6 @@ PP(pp_fttext)
 		len = 512;
 	}
 	else {
-	    dTHR;
 	    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
 		gv = cGVOP_gv;
 		report_evil_fh(gv, GvIO(gv), PL_op->op_type);
diff --git a/proto.h b/proto.h
index 1e34c81cec..1a3802ab47 100644
--- a/proto.h
+++ b/proto.h
@@ -303,11 +303,11 @@ PERL_CALLCONV HV*	Perl_gv_stashpvn(pTHX_ const char* name, U32 namelen, I32 crea
 PERL_CALLCONV HV*	Perl_gv_stashsv(pTHX_ SV* sv, I32 create);
 PERL_CALLCONV void	Perl_hv_clear(pTHX_ HV* tb);
 PERL_CALLCONV void	Perl_hv_delayfree_ent(pTHX_ HV* hv, HE* entry);
-PERL_CALLCONV SV*	Perl_hv_delete(pTHX_ HV* tb, const char* key, U32 klen, I32 flags);
+PERL_CALLCONV SV*	Perl_hv_delete(pTHX_ HV* tb, const char* key, I32 klen, I32 flags);
 PERL_CALLCONV SV*	Perl_hv_delete_ent(pTHX_ HV* tb, SV* key, I32 flags, U32 hash);
-PERL_CALLCONV bool	Perl_hv_exists(pTHX_ HV* tb, const char* key, U32 klen);
+PERL_CALLCONV bool	Perl_hv_exists(pTHX_ HV* tb, const char* key, I32 klen);
 PERL_CALLCONV bool	Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash);
-PERL_CALLCONV SV**	Perl_hv_fetch(pTHX_ HV* tb, const char* key, U32 klen, I32 lval);
+PERL_CALLCONV SV**	Perl_hv_fetch(pTHX_ HV* tb, const char* key, I32 klen, I32 lval);
 PERL_CALLCONV HE*	Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash);
 PERL_CALLCONV void	Perl_hv_free_ent(pTHX_ HV* hv, HE* entry);
 PERL_CALLCONV I32	Perl_hv_iterinit(pTHX_ HV* tb);
@@ -318,7 +318,7 @@ PERL_CALLCONV SV*	Perl_hv_iternextsv(pTHX_ HV* hv, char** key, I32* retlen);
 PERL_CALLCONV SV*	Perl_hv_iterval(pTHX_ HV* tb, HE* entry);
 PERL_CALLCONV void	Perl_hv_ksplit(pTHX_ HV* hv, IV newmax);
 PERL_CALLCONV void	Perl_hv_magic(pTHX_ HV* hv, GV* gv, int how);
-PERL_CALLCONV SV**	Perl_hv_store(pTHX_ HV* tb, const char* key, U32 klen, SV* val, U32 hash);
+PERL_CALLCONV SV**	Perl_hv_store(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash);
 PERL_CALLCONV HE*	Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash);
 PERL_CALLCONV void	Perl_hv_undef(pTHX_ HV* tb);
 PERL_CALLCONV I32	Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len);
@@ -782,6 +782,7 @@ PERL_CALLCONV void	Perl_sv_taint(pTHX_ SV* sv);
 PERL_CALLCONV bool	Perl_sv_tainted(pTHX_ SV* sv);
 PERL_CALLCONV int	Perl_sv_unmagic(pTHX_ SV* sv, int type);
 PERL_CALLCONV void	Perl_sv_unref(pTHX_ SV* sv);
+PERL_CALLCONV void	Perl_sv_unref_flags(pTHX_ SV* sv, U32 flags);
 PERL_CALLCONV void	Perl_sv_untaint(pTHX_ SV* sv);
 PERL_CALLCONV bool	Perl_sv_upgrade(pTHX_ SV* sv, U32 mt);
 PERL_CALLCONV void	Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len);
@@ -919,6 +920,7 @@ PERL_CALLCONV bool	Perl_sv_utf8_downgrade(pTHX_ SV *sv, bool fail_ok);
 PERL_CALLCONV void	Perl_sv_utf8_encode(pTHX_ SV *sv);
 PERL_CALLCONV bool	Perl_sv_utf8_decode(pTHX_ SV *sv);
 PERL_CALLCONV void	Perl_sv_force_normal(pTHX_ SV *sv);
+PERL_CALLCONV void	Perl_sv_force_normal_flags(pTHX_ SV *sv, U32 flags);
 PERL_CALLCONV void	Perl_tmps_grow(pTHX_ I32 n);
 PERL_CALLCONV SV*	Perl_sv_rvweaken(pTHX_ SV *sv);
 PERL_CALLCONV int	Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg);
diff --git a/regcomp.c b/regcomp.c
index 3b4f481b1c..aae2ceda5f 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -431,7 +431,6 @@ static void clear_re(pTHXo_ void *r);
 STATIC void
 S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data)
 {
-    dTHR;
     STRLEN l = CHR_SVLEN(data->last_found);
     STRLEN old_l = CHR_SVLEN(*data->longest);
     
@@ -596,7 +595,6 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
 			/* deltap: Write maxlen-minlen here. */
 			/* last: Stop before this one. */
 {
-    dTHR;
     I32 min = 0, pars = 0, code;
     regnode *scan = *scanp, *next;
     I32 delta = 0;
@@ -1521,7 +1519,6 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
 STATIC I32
 S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, char *s)
 {
-    dTHR;
     if (RExC_rx->data) {
 	Renewc(RExC_rx->data, 
 	       sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1), 
@@ -1542,7 +1539,6 @@ S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, char *s)
 void
 Perl_reginitcolors(pTHX)
 {
-    dTHR;
     int i = 0;
     char *s = PerlEnv_getenv("PERL_RE_COLORS");
 	    
@@ -1583,7 +1579,6 @@ Perl_reginitcolors(pTHX)
 regexp *
 Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
 {
-    dTHR;
     register regexp *r;
     regnode *scan;
     regnode *first;
@@ -1938,6 +1933,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
 	r->reganch |= ROPT_EVAL_SEEN;
     Newz(1002, r->startp, RExC_npar, I32);
     Newz(1002, r->endp, RExC_npar, I32);
+    PL_regdata = r->data; /* for regprop() ANYOFUTF8 */
     DEBUG_r(regdump(r));
     return(r);
 }
@@ -1955,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;
@@ -2014,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;
@@ -2300,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;
@@ -2366,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;
@@ -2534,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;
 
@@ -3049,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;
 
@@ -3204,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;
@@ -3681,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;
@@ -3932,8 +3920,15 @@ S_regclassutf8(pTHX_ RExC_state_t *pRExC_state)
 
     if (!SIZE_ONLY) {
 	SV *rv = swash_init("utf8", "", listsv, 1, 0);
+#ifdef DEBUGGING
+	AV *av = newAV();
+	av_push(av, rv);
+	av_push(av, listsv);
+	rv = newRV_inc((SV*)av);
+#else
 	SvREFCNT_dec(listsv);
-	n = add_data(pRExC_state, 1,"s");
+#endif
+	n = add_data(pRExC_state, 1, "s");
 	RExC_rx->data->data[n] = (void*)rv;
 	ARG1_SET(ret, flags);
 	ARG2_SET(ret, n);
@@ -3945,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 (;;) {
@@ -3978,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;
 
@@ -4003,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;
 
@@ -4028,14 +4020,7 @@ 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;
-    if (SIZE_ONLY) {
-	U8 tmpbuf[UTF8_MAXLEN];
-	*lenp = uv_to_utf8(tmpbuf, uv) - tmpbuf;
-    }
-    else
-	*lenp = uv_to_utf8((U8*)s, uv) - (U8*)s;
-
+    *lenp = SIZE_ONLY ? UNISKIP(uv) : (uv_to_utf8((U8*)s, uv) - (U8*)s);
 }
 
 /*
@@ -4046,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;
@@ -4077,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;
 
@@ -4107,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;
@@ -4221,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);
@@ -4288,7 +4269,7 @@ Perl_regdump(pTHX_ regexp *r)
 STATIC void
 S_put_byte(pTHX_ SV *sv, int c)
 {
-    if (c <= ' ' || c == 127 || c == 255)
+    if (isCNTRL(c) || c == 127 || c == 255)
 	Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
     else if (c == '-' || c == ']' || c == '\\' || c == '^')
 	Perl_sv_catpvf(aTHX_ sv, "\\%c", c);
@@ -4303,7 +4284,6 @@ void
 Perl_regprop(pTHX_ SV *sv, regnode *o)
 {
 #ifdef DEBUGGING
-    dTHR;
     register int k;
 
     sv_setpvn(sv, "", 0);
@@ -4331,8 +4311,10 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 	Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags);	/* 2: embedded, otherwise 1 */
     else if (k == ANYOF) {
 	int i, rangestart = -1;
-	const char * const out[] = {	/* Should be syncronized with
-					   ANYOF_ #xdefines in regcomp.h */
+	bool anyofutf8 = OP(o) == ANYOFUTF8;
+	U8 flags = anyofutf8 ? ARG1(o) : o->flags;
+	const char * const anyofs[] = {	/* Should be syncronized with
+					 * ANYOF_ #xdefines in regcomp.h */
 	    "\\w",
 	    "\\W",
 	    "\\s",
@@ -4365,12 +4347,12 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 	    "[:^blank:]"
 	};
 
-	if (o->flags & ANYOF_LOCALE)
+	if (flags & ANYOF_LOCALE)
 	    sv_catpv(sv, "{loc}");
-	if (o->flags & ANYOF_FOLD)
+	if (flags & ANYOF_FOLD)
 	    sv_catpv(sv, "{i}");
 	Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]);
-	if (o->flags & ANYOF_INVERT)
+	if (flags & ANYOF_INVERT)
 	    sv_catpv(sv, "^");
 	if (OP(o) == ANYOF) {
 	    for (i = 0; i <= 256; i++) {
@@ -4390,12 +4372,59 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 		}
 	    }
 	    if (o->flags & ANYOF_CLASS)
-		for (i = 0; i < sizeof(out)/sizeof(char*); i++)
+		for (i = 0; i < sizeof(anyofs)/sizeof(char*); i++)
 		    if (ANYOF_CLASS_TEST(o,i))
-			sv_catpv(sv, out[i]);
+			sv_catpv(sv, anyofs[i]);
 	}
 	else {
-	    sv_catpv(sv, "{ANYOFUTF8}"); /* TODO: full decode */
+	    SV *rv = (SV*)PL_regdata->data[ARG2(o)];
+	    AV *av = (AV*)SvRV((SV*)rv);
+	    SV *sw = *av_fetch(av, 0, FALSE);
+	    SV *lv = *av_fetch(av, 1, FALSE);
+	    UV i;
+	    U8 s[UTF8_MAXLEN+1];
+	    for (i = 0; i <= 256; i++) { /* just the first 256 */
+		U8 *e = uv_to_utf8(s, i);
+		if (i < 256 && swash_fetch(sw, s)) {
+		    if (rangestart == -1)
+			rangestart = i;
+		} else if (rangestart != -1) {
+		    U8 *p;
+
+		    if (i <= rangestart + 3)
+			for (; rangestart < i; rangestart++) {
+			    for(e = uv_to_utf8(s, rangestart), p = s; p < e; p++)
+				put_byte(sv, *p);
+			}
+		    else {
+			for (e = uv_to_utf8(s, rangestart), p = s; p < e; p++)
+			    put_byte(sv, *p);
+			sv_catpv(sv, "-");
+			for (e = uv_to_utf8(s, i - 1), p = s; p < e; p++)
+			    put_byte(sv, *p);
+		    }
+		    rangestart = -1;
+		}
+	    }
+	    sv_catpv(sv, "...");
+	    {
+		char *s = savepv(SvPVX(lv));
+
+		while(*s && *s != '\n') s++;
+		if (*s == '\n') {
+		    char *t = ++s;
+
+		    while (*s) {
+			if (*s == '\n')
+			    *s = ' ';
+			s++;
+		    }
+		    if (s[-1] == ' ')
+			s[-1] = 0;
+
+		    sv_catpv(sv, t);
+		}
+	    }
 	}
 	Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
     }
@@ -4426,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))
@@ -4458,6 +4486,16 @@ Perl_pregfree(pTHX_ struct regexp *r)
 	while (--n >= 0) {
 	    switch (r->data->what[n]) {
 	    case 's':
+#ifdef DEBUGGING
+	        {
+		    SV *rv = (SV*)r->data->data[n];
+		    AV *av = (AV*)SvRV((SV*)rv);
+		    SV *sw = *av_fetch(av, 0, FALSE);
+		    SV *lv = *av_fetch(av, 1, FALSE);
+		    SvREFCNT_dec(sw);
+		    SvREFCNT_dec(lv);
+		}
+#endif
 		SvREFCNT_dec((SV*)r->data->data[n]);
 		break;
 	    case 'f':
@@ -4507,7 +4545,6 @@ Perl_pregfree(pTHX_ struct regexp *r)
 regnode *
 Perl_regnext(pTHX_ register regnode *p)
 {
-    dTHR;
     register I32 offset;
 
     if (p == &PL_regdummy)
@@ -4559,8 +4596,6 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
 void
 Perl_save_re_context(pTHX)
 {                   
-    dTHR;
-
 #if 0
     SAVEPPTR(RExC_precomp);		/* uncompiled string. */
     SAVEI32(RExC_npar);		/* () count. */
diff --git a/regexec.c b/regexec.c
index 18c06d553f..5e821ba3f0 100644
--- a/regexec.c
+++ b/regexec.c
@@ -106,7 +106,11 @@
  */
 
 #define REGINCLASS(p,c)  (ANYOF_FLAGS(p) ? reginclass(p,c) : ANYOF_BITMAP_TEST(p,c))
-#define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
+#ifdef DEBUGGING
+#   define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch(*av_fetch((AV*)SvRV((SV*)PL_regdata->data[ARG2(f)]),0,FALSE),p))
+#else
+#   define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
+#endif
 
 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
@@ -124,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;
@@ -157,7 +160,6 @@ S_regcppush(pTHX_ I32 parenfloor)
 STATIC char *
 S_regcppop(pTHX)
 {
-    dTHR;
     I32 i = SSPOPINT;
     U32 paren = 0;
     char *input;
@@ -213,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;
@@ -272,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;
@@ -1338,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;
@@ -1722,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;
@@ -1880,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. */
@@ -3460,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;
@@ -3672,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;
@@ -3723,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;
 
@@ -3787,22 +3781,28 @@ 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;
-    SV *sv = (SV*)PL_regdata->data[ARG2(f)];
+#ifdef DEBUGGING
+    SV *rv = (SV*)PL_regdata->data[ARG2(f)];
+    AV *av = (AV*)SvRV((SV*)rv);
+    SV *sw = *av_fetch(av, 0, FALSE);
+    SV *lv = *av_fetch(av, 1, FALSE);
+#else
+    SV *sw = (SV*)PL_regdata->data[ARG2(f)];
+#endif
 
-    if (swash_fetch(sv, p))
+    if (swash_fetch(sw, p))
 	match = TRUE;
     else if (flags & ANYOF_FOLD) {
-	U8 tmpbuf[UTF8_MAXLEN];
+	U8 tmpbuf[UTF8_MAXLEN+1];
 	if (flags & ANYOF_LOCALE) {
 	    PL_reg_flags |= RF_tainted;
 	    uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
 	}
 	else
 	    uv_to_utf8(tmpbuf, toLOWER_utf8(p));
-	if (swash_fetch(sv, tmpbuf))
+	if (swash_fetch(sw, tmpbuf))
 	    match = TRUE;
     }
 
@@ -3814,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);
@@ -3836,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);
@@ -3868,7 +3866,6 @@ S_reghopmaybe(pTHX_ U8* s, I32 off)
 static void
 restore_pos(pTHXo_ void *arg)
 {
-    dTHR;
     if (PL_reg_eval_set) {
 	if (PL_reg_oldsaved) {
 	    PL_reg_re->subbeg = PL_reg_oldsaved;
diff --git a/run.c b/run.c
index 728b761ff0..ee761d3a0b 100644
--- a/run.c
+++ b/run.c
@@ -20,8 +20,6 @@
 int
 Perl_runops_standard(pTHX)
 {
-    dTHR;
-
     while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
 	PERL_ASYNC_CHECK();
     }
@@ -34,7 +32,6 @@ int
 Perl_runops_debug(pTHX)
 {
 #ifdef DEBUGGING
-    dTHR;
     if (!PL_op) {
 	if (ckWARN_d(WARN_DEBUGGING))
 	    Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN");
@@ -96,7 +93,6 @@ void
 Perl_watch(pTHX_ char **addr)
 {
 #ifdef DEBUGGING
-    dTHR;
     PL_watchaddr = addr;
     PL_watchok = *addr;
     PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n",
diff --git a/scope.c b/scope.c
index 82cd748274..3f41a4e56b 100644
--- a/scope.c
+++ b/scope.c
@@ -33,7 +33,6 @@ void *
 Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
 		      protect_body_t body, va_list *args)
 {
-    dTHR;
     int ex;
     void *ret;
 
@@ -51,7 +50,6 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
 SV**
 Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
 {
-    dTHR;
 #if defined(DEBUGGING) && !defined(USE_THREADS)
     static int growing = 0;
     if (growing++)
@@ -97,7 +95,6 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
 I32
 Perl_cxinc(pTHX)
 {
-    dTHR;
     cxstack_max = GROW(cxstack_max);
     Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);	/* XXX should fix CXINC macro */
     return cxstack_ix + 1;
@@ -106,7 +103,6 @@ Perl_cxinc(pTHX)
 void
 Perl_push_return(pTHX_ OP *retop)
 {
-    dTHR;
     if (PL_retstack_ix == PL_retstack_max) {
 	PL_retstack_max = GROW(PL_retstack_max);
 	Renew(PL_retstack, PL_retstack_max, OP*);
@@ -117,7 +113,6 @@ Perl_push_return(pTHX_ OP *retop)
 OP *
 Perl_pop_return(pTHX)
 {
-    dTHR;
     if (PL_retstack_ix > 0)
 	return PL_retstack[--PL_retstack_ix];
     else
@@ -127,7 +122,6 @@ Perl_pop_return(pTHX)
 void
 Perl_push_scope(pTHX)
 {
-    dTHR;
     if (PL_scopestack_ix == PL_scopestack_max) {
 	PL_scopestack_max = GROW(PL_scopestack_max);
 	Renew(PL_scopestack, PL_scopestack_max, I32);
@@ -139,7 +133,6 @@ Perl_push_scope(pTHX)
 void
 Perl_pop_scope(pTHX)
 {
-    dTHR;
     I32 oldsave = PL_scopestack[--PL_scopestack_ix];
     LEAVE_SCOPE(oldsave);
 }
@@ -147,7 +140,6 @@ Perl_pop_scope(pTHX)
 void
 Perl_markstack_grow(pTHX)
 {
-    dTHR;
     I32 oldmax = PL_markstack_max - PL_markstack;
     I32 newmax = GROW(oldmax);
 
@@ -159,7 +151,6 @@ Perl_markstack_grow(pTHX)
 void
 Perl_savestack_grow(pTHX)
 {
-    dTHR;
     PL_savestack_max = GROW(PL_savestack_max) + 4; 
     Renew(PL_savestack, PL_savestack_max, ANY);
 }
@@ -169,7 +160,6 @@ Perl_savestack_grow(pTHX)
 void
 Perl_tmps_grow(pTHX_ I32 n)
 {
-    dTHR;
 #ifndef STRESS_REALLOC
     if (n < 128)
 	n = (PL_tmps_max < 512) ? 128 : 512;
@@ -182,7 +172,6 @@ Perl_tmps_grow(pTHX_ I32 n)
 void
 Perl_free_tmps(pTHX)
 {
-    dTHR;
     /* XXX should tmps_floor live in cxstack? */
     I32 myfloor = PL_tmps_floor;
     while (PL_tmps_ix > myfloor) {      /* clean up after last statement */
@@ -198,7 +187,6 @@ Perl_free_tmps(pTHX)
 STATIC SV *
 S_save_scalar_at(pTHX_ SV **sptr)
 {
-    dTHR;
     register SV *sv;
     SV *osv = *sptr;
 
@@ -229,7 +217,6 @@ S_save_scalar_at(pTHX_ SV **sptr)
 SV *
 Perl_save_scalar(pTHX_ GV *gv)
 {
-    dTHR;
     SV **sptr = &GvSV(gv);
     SSCHECK(3);
     SSPUSHPTR(SvREFCNT_inc(gv));
@@ -241,7 +228,6 @@ Perl_save_scalar(pTHX_ GV *gv)
 SV*
 Perl_save_svref(pTHX_ SV **sptr)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHPTR(sptr);
     SSPUSHPTR(SvREFCNT_inc(*sptr));
@@ -254,7 +240,6 @@ Perl_save_svref(pTHX_ SV **sptr)
 void
 Perl_save_generic_svref(pTHX_ SV **sptr)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHPTR(sptr);
     SSPUSHPTR(SvREFCNT_inc(*sptr));
@@ -267,7 +252,6 @@ Perl_save_generic_svref(pTHX_ SV **sptr)
 void
 Perl_save_generic_pvref(pTHX_ char **str)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHPTR(str);
     SSPUSHPTR(*str);
@@ -277,7 +261,6 @@ Perl_save_generic_pvref(pTHX_ char **str)
 void
 Perl_save_gp(pTHX_ GV *gv, I32 empty)
 {
-    dTHR;
     SSCHECK(6);
     SSPUSHIV((IV)SvLEN(gv));
     SvLEN(gv) = 0; /* forget that anything was allocated here */
@@ -314,7 +297,6 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
 AV *
 Perl_save_ary(pTHX_ GV *gv)
 {
-    dTHR;
     AV *oav = GvAVn(gv);
     AV *av;
 
@@ -342,7 +324,6 @@ Perl_save_ary(pTHX_ GV *gv)
 HV *
 Perl_save_hash(pTHX_ GV *gv)
 {
-    dTHR;
     HV *ohv, *hv;
 
     SSCHECK(3);
@@ -367,7 +348,6 @@ Perl_save_hash(pTHX_ GV *gv)
 void
 Perl_save_item(pTHX_ register SV *item)
 {
-    dTHR;
     register SV *sv = NEWSV(0,0);
 
     sv_setsv(sv,item);
@@ -380,7 +360,6 @@ Perl_save_item(pTHX_ register SV *item)
 void
 Perl_save_int(pTHX_ int *intp)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHINT(*intp);
     SSPUSHPTR(intp);
@@ -390,7 +369,6 @@ Perl_save_int(pTHX_ int *intp)
 void
 Perl_save_long(pTHX_ long int *longp)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHLONG(*longp);
     SSPUSHPTR(longp);
@@ -400,7 +378,6 @@ Perl_save_long(pTHX_ long int *longp)
 void
 Perl_save_I32(pTHX_ I32 *intp)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHINT(*intp);
     SSPUSHPTR(intp);
@@ -410,7 +387,6 @@ Perl_save_I32(pTHX_ I32 *intp)
 void
 Perl_save_I16(pTHX_ I16 *intp)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHINT(*intp);
     SSPUSHPTR(intp);
@@ -420,7 +396,6 @@ Perl_save_I16(pTHX_ I16 *intp)
 void
 Perl_save_I8(pTHX_ I8 *bytep)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHINT(*bytep);
     SSPUSHPTR(bytep);
@@ -430,7 +405,6 @@ Perl_save_I8(pTHX_ I8 *bytep)
 void
 Perl_save_iv(pTHX_ IV *ivp)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHIV(*ivp);
     SSPUSHPTR(ivp);
@@ -443,7 +417,6 @@ Perl_save_iv(pTHX_ IV *ivp)
 void
 Perl_save_pptr(pTHX_ char **pptr)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*pptr);
     SSPUSHPTR(pptr);
@@ -453,7 +426,6 @@ Perl_save_pptr(pTHX_ char **pptr)
 void
 Perl_save_vptr(pTHX_ void *ptr)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*(char**)ptr);
     SSPUSHPTR(ptr);
@@ -463,7 +435,6 @@ Perl_save_vptr(pTHX_ void *ptr)
 void
 Perl_save_sptr(pTHX_ SV **sptr)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*sptr);
     SSPUSHPTR(sptr);
@@ -473,7 +444,6 @@ Perl_save_sptr(pTHX_ SV **sptr)
 void
 Perl_save_padsv(pTHX_ PADOFFSET off)
 {
-    dTHR;
     SSCHECK(4);
     SSPUSHPTR(PL_curpad[off]);
     SSPUSHPTR(PL_curpad);
@@ -485,7 +455,6 @@ SV **
 Perl_save_threadsv(pTHX_ PADOFFSET i)
 {
 #ifdef USE_THREADS
-    dTHR;
     SV **svp = &THREADSV(i);	/* XXX Change to save by offset */
     DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n",
 			  (UV)i, svp, *svp, SvPEEK(*svp)));
@@ -500,7 +469,6 @@ Perl_save_threadsv(pTHX_ PADOFFSET i)
 void
 Perl_save_nogv(pTHX_ GV *gv)
 {
-    dTHR;
     SSCHECK(2);
     SSPUSHPTR(gv);
     SSPUSHINT(SAVEt_NSTAB);
@@ -509,7 +477,6 @@ Perl_save_nogv(pTHX_ GV *gv)
 void
 Perl_save_hptr(pTHX_ HV **hptr)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*hptr);
     SSPUSHPTR(hptr);
@@ -519,7 +486,6 @@ Perl_save_hptr(pTHX_ HV **hptr)
 void
 Perl_save_aptr(pTHX_ AV **aptr)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHPTR(*aptr);
     SSPUSHPTR(aptr);
@@ -529,7 +495,6 @@ Perl_save_aptr(pTHX_ AV **aptr)
 void
 Perl_save_freesv(pTHX_ SV *sv)
 {
-    dTHR;
     SSCHECK(2);
     SSPUSHPTR(sv);
     SSPUSHINT(SAVEt_FREESV);
@@ -538,7 +503,6 @@ Perl_save_freesv(pTHX_ SV *sv)
 void
 Perl_save_freeop(pTHX_ OP *o)
 {
-    dTHR;
     SSCHECK(2);
     SSPUSHPTR(o);
     SSPUSHINT(SAVEt_FREEOP);
@@ -547,7 +511,6 @@ Perl_save_freeop(pTHX_ OP *o)
 void
 Perl_save_freepv(pTHX_ char *pv)
 {
-    dTHR;
     SSCHECK(2);
     SSPUSHPTR(pv);
     SSPUSHINT(SAVEt_FREEPV);
@@ -556,7 +519,6 @@ Perl_save_freepv(pTHX_ char *pv)
 void
 Perl_save_clearsv(pTHX_ SV **svp)
 {
-    dTHR;
     SSCHECK(2);
     SSPUSHLONG((long)(svp-PL_curpad));
     SSPUSHINT(SAVEt_CLEARSV);
@@ -565,7 +527,6 @@ Perl_save_clearsv(pTHX_ SV **svp)
 void
 Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 {
-    dTHR;
     SSCHECK(4);
     SSPUSHINT(klen);
     SSPUSHPTR(key);
@@ -576,7 +537,6 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 void
 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
 {
-    dTHR;
     register SV *sv;
     register I32 i;
 
@@ -593,7 +553,6 @@ Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
 void
 Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHDPTR(f);
     SSPUSHPTR(p);
@@ -603,7 +562,6 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
 void
 Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
 {
-    dTHR;
     SSCHECK(3);
     SSPUSHDXPTR(f);
     SSPUSHPTR(p);
@@ -613,7 +571,6 @@ Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
 void
 Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
 {
-    dTHR;
     SSCHECK(4);
     SSPUSHPTR(SvREFCNT_inc(av));
     SSPUSHINT(idx);
@@ -625,7 +582,6 @@ Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
 void
 Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
 {
-    dTHR;
     SSCHECK(4);
     SSPUSHPTR(SvREFCNT_inc(hv));
     SSPUSHPTR(SvREFCNT_inc(key));
@@ -637,7 +593,6 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
 void
 Perl_save_op(pTHX)
 {
-    dTHR;
     SSCHECK(2);
     SSPUSHPTR(PL_op);
     SSPUSHINT(SAVEt_OP);
@@ -646,7 +601,6 @@ Perl_save_op(pTHX)
 I32
 Perl_save_alloc(pTHX_ I32 size, I32 pad)
 {
-    dTHR;
     register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
                                 - (char*)PL_savestack);
     register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
@@ -664,7 +618,6 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
 void
 Perl_leave_scope(pTHX_ I32 base)
 {
-    dTHR;
     register SV *sv;
     register SV *value;
     register GV *gv;
@@ -856,7 +809,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    /* Can clear pad variable in place? */
 	    if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
 		if (SvTHINKFIRST(sv))
-		    sv_force_normal(sv);
+		    sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
 		if (SvMAGICAL(sv))
 		    mg_free(sv);
 
@@ -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 6658552ec0..2691430787 100644
--- a/sv.c
+++ b/sv.c
@@ -1285,11 +1285,8 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i)
     case SVt_PVCV:
     case SVt_PVFM:
     case SVt_PVIO:
-	{
-	    dTHR;
-	    Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0),
-		  PL_op_desc[PL_op->op_type]);
-	}
+	Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0),
+		   PL_op_desc[PL_op->op_type]);
     }
     (void)SvIOK_only(sv);			/* validate number */
     SvIVX(sv) = i;
@@ -1373,11 +1370,8 @@ Perl_sv_setnv(pTHX_ register SV *sv, NV num)
     case SVt_PVCV:
     case SVt_PVFM:
     case SVt_PVIO:
-	{
-	    dTHR;
-	    Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),
-		  PL_op_name[PL_op->op_type]);
-	}
+	Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),
+		   PL_op_name[PL_op->op_type]);
     }
     SvNVX(sv) = num;
     (void)SvNOK_only(sv);			/* validate number */
@@ -1402,7 +1396,6 @@ Perl_sv_setnv_mg(pTHX_ register SV *sv, NV num)
 STATIC void
 S_not_a_number(pTHX_ SV *sv)
 {
-    dTHR;
     char tmpbuf[64];
     char *d = tmpbuf;
     char *s;
@@ -1482,7 +1475,6 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    return asIV(sv);
 	if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-		dTHR;
 		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		    report_uninit();
 	    }
@@ -1501,7 +1493,6 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    sv_force_normal(sv);
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {
-	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED))
 		report_uninit();
 	    return 0;
@@ -1588,7 +1579,6 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	}
     }
     else  {
-	dTHR;
 	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
 	    report_uninit();
 	if (SvTYPE(sv) < SVt_IV)
@@ -1616,7 +1606,6 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    return asUV(sv);
 	if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-		dTHR;
 		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		    report_uninit();
 	    }
@@ -1632,7 +1621,6 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	  return PTR2UV(SvRV(sv));
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {
-	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED))
 		report_uninit();
 	    return 0;
@@ -1732,8 +1720,6 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 #endif
 	}
 	else {				/* Not a number.  Cache 0. */
-	    dTHR;
-
 	    if (SvTYPE(sv) < SVt_PVIV)
 		sv_upgrade(sv, SVt_PVIV);
 	    (void)SvIOK_on(sv);
@@ -1746,7 +1732,6 @@ Perl_sv_2uv(pTHX_ register SV *sv)
     }
     else  {
 	if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		report_uninit();
 	}
@@ -1771,7 +1756,6 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	if (SvNOKp(sv))
 	    return SvNVX(sv);
 	if (SvPOKp(sv) && SvLEN(sv)) {
-	    dTHR;
 	    if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
 		not_a_number(sv);
 	    return Atof(SvPVX(sv));
@@ -1784,7 +1768,6 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	}	
         if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-		dTHR;
 		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		    report_uninit();
 	    }
@@ -1800,7 +1783,6 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	  return PTR2NV(SvRV(sv));
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {
-	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED))
 		report_uninit();
 	    return 0.0;
@@ -1836,13 +1818,11 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv);
     }
     else if (SvPOKp(sv) && SvLEN(sv)) {
-	dTHR;
 	if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
 	    not_a_number(sv);
 	SvNVX(sv) = Atof(SvPVX(sv));
     }
     else  {
-	dTHR;
 	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
 	    report_uninit();
 	if (SvTYPE(sv) < SVt_NV)
@@ -1878,7 +1858,6 @@ S_asIV(pTHX_ SV *sv)
     if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
 	return Atol(SvPVX(sv));
     if (!numtype) {
-	dTHR;
 	if (ckWARN(WARN_NUMERIC))
 	    not_a_number(sv);
     }
@@ -1896,7 +1875,6 @@ S_asUV(pTHX_ SV *sv)
 	return Strtoul(SvPVX(sv), Null(char**), 10);
 #endif
     if (!numtype) {
-	dTHR;
 	if (ckWARN(WARN_NUMERIC))
 	    not_a_number(sv);
     }
@@ -2112,7 +2090,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	}
         if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-		dTHR;
 		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
 		    report_uninit();
 	    }
@@ -2139,7 +2116,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 			  == (SVs_OBJECT|SVs_RMG))
 			 && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp")
 			 && (mg = mg_find(sv, 'r'))) {
-			dTHR;
 			regexp *re = (regexp *)mg->mg_obj;
 
 			if (!mg->mg_ptr) {
@@ -2210,7 +2186,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	    return s;
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {
-	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED))
 		report_uninit();
 	    *lp = 0;
@@ -2273,12 +2248,9 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	SvPOK_on(sv);
     }
     else {
-	dTHR;
 	if (ckWARN(WARN_UNINITIALIZED)
 	    && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
-	{
 	    report_uninit();
-	}
 	*lp = 0;
 	if (SvTYPE(sv) < SVt_PV)
 	    /* Typically the caller expects that sv_any is not NULL now.  */
@@ -2369,7 +2341,6 @@ Perl_sv_2bool(pTHX_ register SV *sv)
     if (!SvOK(sv))
 	return 0;
     if (SvROK(sv)) {
-	dTHR;
 	SV* tmpsv;
         if (SvAMAGIC(sv) && (tmpsv=AMG_CALLun(sv,bool_)) &&
                 (SvRV(tmpsv) != SvRV(sv)))
@@ -2532,7 +2503,6 @@ C<sv_setsv_mg>.
 void
 Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 {
-    dTHR;
     register U32 sflags;
     register int dtype;
     register int stype;
@@ -3098,10 +3068,9 @@ Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len
 }
 
 void
-Perl_sv_force_normal(pTHX_ register SV *sv)
+Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
 {
     if (SvREADONLY(sv)) {
-	dTHR;
 	if (SvFAKE(sv)) {
 	    char *pvx = SvPVX(sv);
 	    STRLEN len = SvCUR(sv);
@@ -3117,11 +3086,17 @@ Perl_sv_force_normal(pTHX_ register SV *sv)
 	    Perl_croak(aTHX_ PL_no_modify);
     }
     if (SvROK(sv))
-	sv_unref(sv);
+	sv_unref_flags(sv, flags);
     else if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
 	sv_unglob(sv);
 }
 
+void
+Perl_sv_force_normal(pTHX_ register SV *sv)
+{
+    sv_force_normal_flags(sv, 0);
+}
+
 /*
 =for apidoc sv_chop
 
@@ -3322,7 +3297,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 +3317,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 +3505,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 +3657,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 +3697,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 +3896,6 @@ Free the memory used by an SV.
 void
 Perl_sv_free(pTHX_ SV *sv)
 {
-    dTHR;
     int refcount_is_zero;
 
     if (!sv)
@@ -4070,7 +4039,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 +4295,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 +4580,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);
 	}
@@ -4651,9 +4617,9 @@ Perl_sv_inc(pTHX_ register SV *sv)
     }
     if (!(flags & SVp_POK) || !*SvPVX(sv)) {
 	if ((flags & SVTYPEMASK) < SVt_PVNV)
-	    sv_upgrade(sv, SVt_NV);
-	SvNVX(sv) = 1.0;
-	(void)SvNOK_only(sv);
+           sv_upgrade(sv, SVt_IV);
+       (void)SvIOK_only(sv);
+       SvIVX(sv) = 1;
 	return;
     }
     d = SvPVX(sv);
@@ -4721,7 +4687,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 +4752,6 @@ as mortal.
 SV *
 Perl_sv_mortalcopy(pTHX_ SV *oldstr)
 {
-    dTHR;
     register SV *sv;
 
     new_SV(sv);
@@ -4809,7 +4773,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 +4796,6 @@ ends.
 SV *
 Perl_sv_2mortal(pTHX_ register SV *sv)
 {
-    dTHR;
     if (!sv)
 	return sv;
     if (SvREADONLY(sv) && SvIMMORTAL(sv))
@@ -5029,7 +4991,6 @@ SV is B<not> incremented.
 SV *
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
-    dTHR;
     register SV *sv;
 
     new_SV(sv);
@@ -5060,7 +5021,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 +5175,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 +5230,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 +5325,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 +5504,6 @@ reference count is 1.
 SV*
 Perl_newSVrv(pTHX_ SV *rv, const char *classname)
 {
-    dTHR;
     SV *sv;
 
     new_SV(sv);
@@ -5687,7 +5643,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");
@@ -5743,17 +5698,21 @@ S_sv_unglob(pTHX_ SV *sv)
 }
 
 /*
-=for apidoc sv_unref
+=for apidoc sv_unref_flags
 
 Unsets the RV status of the SV, and decrements the reference count of
 whatever was being referenced by the RV.  This can almost be thought of
-as a reversal of C<newSVrv>.  See C<SvROK_off>.
+as a reversal of C<newSVrv>.  The C<cflags> argument can contain
+C<SV_IMMEDIATE_UNREF> to force the reference count to be decremented
+(otherwise the decrementing is conditional on the reference count being
+different from one or the reference being a readonly SV).
+See C<SvROK_off>.  
 
 =cut
 */
 
 void
-Perl_sv_unref(pTHX_ SV *sv)
+Perl_sv_unref_flags(pTHX_ SV *sv, U32 flags)
 {
     SV* rv = SvRV(sv);
 
@@ -5765,12 +5724,29 @@ Perl_sv_unref(pTHX_ SV *sv)
     }
     SvRV(sv) = 0;
     SvROK_off(sv);
-    if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
+    if (SvREFCNT(rv) != 1 || SvREADONLY(rv) || flags) /* SV_IMMEDIATE_UNREF */
 	SvREFCNT_dec(rv);
-    else
+    else /* XXX Hack, but hard to make $a=$a->[1] work otherwise */
 	sv_2mortal(rv);		/* Schedule for freeing later */
 }
 
+/*
+=for apidoc sv_unref
+
+Unsets the RV status of the SV, and decrements the reference count of
+whatever was being referenced by the RV.  This can almost be thought of
+as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
+being zero.  See C<SvROK_off>.  
+
+=cut
+*/
+
+void
+Perl_sv_unref(pTHX_ SV *sv)
+{
+    sv_unref_flags(sv, 0);
+}
+
 void
 Perl_sv_taint(pTHX_ SV *sv)
 {
@@ -6010,7 +5986,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;
@@ -6067,7 +6042,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	bool is_utf = FALSE;
 	
 	char esignbuf[4];
-	U8 utf8buf[UTF8_MAXLEN];
+	U8 utf8buf[UTF8_MAXLEN+1];
 	STRLEN esignlen = 0;
 
 	char *eptr = Nullch;
diff --git a/sv.h b/sv.h
index 425acc3832..39c1c29323 100644
--- a/sv.h
+++ b/sv.h
@@ -801,7 +801,6 @@ Taints an SV if tainting is enabled
 #define SvTAINT(sv)			\
     STMT_START {			\
 	if (PL_tainting) {		\
-	    dTHR;			\
 	    if (PL_tainted)		\
 		SvTAINTED_on(sv);	\
 	}				\
@@ -1097,3 +1096,4 @@ Returns a pointer to the character buffer.
 #define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
 #define Sv_Grow sv_grow
 
+#define SV_IMMEDIATE_UNREF	1
diff --git a/t/lib/net-hostent.t b/t/lib/net-hostent.t
index a0ec7bd970..b1c7a9db66 100644
--- a/t/lib/net-hostent.t
+++ b/t/lib/net-hostent.t
@@ -41,7 +41,7 @@ print "ok 5\n";
 # VMS returns "LOCALHOST" under tcp/ip services V4.1 ECO 2, possibly others
 # OS/390 returns localhost.YADDA.YADDA
 
-if ($^O eq 'MSWin32') {
+if ($^O eq 'MSWin32' or $^O eq 'cygwin') {
   print "ok $_ # skipped on win32\n" for (6,7);
 } else {
   print "not " unless $h->name =~ /^localhost(?:\..+)?$/i;
diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t
index 39a57f36ac..cec839bc43 100644
--- a/t/lib/syslfs.t
+++ b/t/lib/syslfs.t
@@ -26,21 +26,28 @@ sub bye {
     exit(0);
 }
 
+my $explained;
+
 sub explain {
-    print <<EOM;
+    unless ($explained++) {
+	print <<EOM;
 #
-# If the lfs (large file support: large meaning larger than two gigabytes)
-# tests are skipped or fail, it may mean either that your process
-# (or process group) is not allowed to write large files (resource
-# limits) or that the file system you are running the tests on doesn't
-# let your user/group have large files (quota) or the filesystem simply
-# doesn't support large files.  You may even need to reconfigure your kernel.
-# (This is all very operating system and site-dependent.)
+# If the lfs (large file support: large meaning larger than two
+# gigabytes) tests are skipped or fail, it may mean either that your
+# process (or process group) is not allowed to write large files
+# (resource limits) or that the file system (the network filesystem?)
+# you are running the tests on doesn't let your user/group have large
+# files (quota) or the filesystem simply doesn't support large files.
+# You may even need to reconfigure your kernel.  (This is all very
+# operating system and site-dependent.)
 #
 # Perl may still be able to support large files, once you have
 # such a process, enough quota, and such a (file) system.
+# It is just that the test failed now.
 #
 EOM
+    }
+    print "1..0 # Skip: @_\n" if @_;
 }
 
 print "# checking whether we have sparse files...\n";
@@ -120,9 +127,8 @@ sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
 my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
 unless (! $r && defined $sysseek && $sysseek == 5_000_000_000) {
     $sysseek = 'undef' unless defined $sysseek;
-    print "1..0 # Skip: seeking past 2GB failed: ",
-           $r ? 'signal '.($r & 0x7f) : "$! (sysseek returned $sysseek)", "\n";
-    explain();
+    explain("seeking past 2GB failed: ",
+	    $r ? 'signal '.($r & 0x7f) : "$! (sysseek returned $sysseek)");
     bye();
 }
 
@@ -135,11 +141,12 @@ my $close     = close BIG;
 print "# close failed: $!\n" unless $close;
 unless($syswrite && $close) {
     if ($! =~/too large/i) {
-	print "1..0 # Skip: writing past 2GB failed: process limits?\n";
+	explain("writing past 2GB failed: process limits?");
     } elsif ($! =~ /quota/i) {
-	print "1..0 # Skip: filesystem quota limits?\n";
+	explain("filesystem quota limits?");
+    } else {
+	explain("error: $!");
     }
-    explain();
     bye();
 }
 
@@ -148,8 +155,7 @@ unless($syswrite && $close) {
 print "# @s\n";
 
 unless ($s[7] == 5_000_000_003) {
-    print "1..0 # Skip: not configured to use large files?\n";
-    explain();
+    explain("kernel/fs not configured to use large files?");
     bye();
 }
 
@@ -220,7 +226,7 @@ print "ok 16\n";
 fail unless $zero eq "\0\0\0";
 print "ok 17\n";
 
-explain if $fail;
+explain() if $fail;
 
 bye(); # does the necessary cleanup
 
diff --git a/t/op/each.t b/t/op/each.t
index 879c0d0fd3..4a00a1e2c5 100755
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..19\n";
+print "1..20\n";
 
 $h{'abc'} = 'ABC';
 $h{'def'} = 'DEF';
@@ -131,3 +131,15 @@ if ($i == 5) { print "ok 16\n" } else { print "not ok\n" }
     print "ok 19\n";
 }
 
+# Check for Unicode hash keys.
+%u = ("\x{12}", "f", "\x{123}", "fo", "\x{1234}",  "foo");
+$u{"\x{12345}"}  = "bar";
+@u{"\x{123456}"} = "zap";
+
+foreach (keys %u) {
+    unless (length() == 1) {
+	print "not ";
+	last;
+    }
+}
+print "ok 20\n";
diff --git a/t/op/length.t b/t/op/length.t
new file mode 100644
index 0000000000..ceb005ecc4
--- /dev/null
+++ b/t/op/length.t
@@ -0,0 +1,85 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..13\n";
+
+print "not " unless length("")    == 0;
+print "ok 1\n";
+
+print "not " unless length("abc") == 3;
+print "ok 2\n";
+
+$_ = "foobar";
+print "not " unless length()      == 6;
+print "ok 3\n";
+
+# Okay, so that wasn't very challenging.  Let's go Unicode.
+
+{
+    my $a = "\x{41}";
+
+    print "not " unless length($a) == 1;
+    print "ok 4\n";
+    $test++;
+
+    use bytes;
+    print "not " unless $a eq "\x41" && length($a) == 1;
+    print "ok 5\n";
+    $test++;
+}
+
+{
+    my $a = "\x{80}";
+    
+    print "not " unless length($a) == 1;
+    print "ok 6\n";
+    $test++;
+    
+    use bytes;
+    print "not " unless $a eq "\xc2\x80" && length($a) == 2;
+    print "ok 7\n";
+    $test++;
+}
+
+{
+    my $a = "\x{100}";
+    
+    print "not " unless length($a) == 1;
+    print "ok 8\n";
+    $test++;
+    
+    use bytes;
+    print "not " unless $a eq "\xc4\x80" && length($a) == 2;
+    print "ok 9\n";
+    $test++;
+}
+
+{
+    my $a = "\x{100}\x{80}";
+    
+    print "not " unless length($a) == 2;
+    print "ok 10\n";
+    $test++;
+    
+    use bytes;
+    print "not " unless $a eq "\xc4\x80\xc2\x80" && length($a) == 4;
+    print "ok 11\n";
+    $test++;
+}
+
+{
+    my $a = "\x{80}\x{100}";
+    
+    print "not " unless length($a) == 2;
+    print "ok 12\n";
+    $test++;
+    
+    use bytes;
+    print "not " unless $a eq "\xc2\x80\xc4\x80" && length($a) == 4;
+    print "ok 13\n";
+    $test++;
+}
diff --git a/t/op/lfs.t b/t/op/lfs.t
index e55212fe51..e732adc798 100644
--- a/t/op/lfs.t
+++ b/t/op/lfs.t
@@ -25,21 +25,28 @@ sub bye {
     exit(0);
 }
 
+my $explained;
+
 sub explain {
-    print <<EOM;
+    unless ($explained++) {
+	print <<EOM;
 #
-# If the lfs (large file support: large meaning larger than two gigabytes)
-# tests are skipped or fail, it may mean either that your process
-# (or process group) is not allowed to write large files (resource
-# limits) or that the file system you are running the tests on doesn't
-# let your user/group have large files (quota) or the filesystem simply
-# doesn't support large files.  You may even need to reconfigure your kernel.
-# (This is all very operating system and site-dependent.)
+# If the lfs (large file support: large meaning larger than two
+# gigabytes) tests are skipped or fail, it may mean either that your
+# process (or process group) is not allowed to write large files
+# (resource limits) or that the file system (the network filesystem?)
+# you are running the tests on doesn't let your user/group have large
+# files (quota) or the filesystem simply doesn't support large files.
+# You may even need to reconfigure your kernel.  (This is all very
+# operating system and site-dependent.)
 #
 # Perl may still be able to support large files, once you have
 # such a process, enough quota, and such a (file) system.
+# It is just that the test failed now.
 #
 EOM
+    }
+    print "1..0 # Skip: @_\n" if @_;
 }
 
 print "# checking whether we have sparse files...\n";
@@ -125,8 +132,7 @@ open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
 binmode BIG;
 if ($r or not seek(BIG, 5_000_000_000, $SEEK_SET)) {
     my $err = $r ? 'signal '.($r & 0x7f) : $!;
-    print "1..0 # Skip: seeking past 2GB failed: $err\n";
-    explain();
+    explain("seeking past 2GB failed: $err");
     bye();
 }
 
@@ -138,11 +144,12 @@ my $close = close BIG;
 print "# close failed: $!\n" unless $close;
 unless ($print && $close) {
     if ($! =~/too large/i) {
-	print "1..0 # Skip: writing past 2GB failed: process limits?\n";
+	explain("writing past 2GB failed: process limits?");
     } elsif ($! =~ /quota/i) {
-	print "1..0 # Skip: filesystem quota limits?\n";
+	explain("filesystem quota limits?");
+    } else {
+	explain("error: $!");
     }
-    explain();
     bye();
 }
 
@@ -151,8 +158,7 @@ unless ($print && $close) {
 print "# @s\n";
 
 unless ($s[7] == 5_000_000_003) {
-    print "1..0 # Skip: not configured to use large files?\n";
-    explain();
+    explain("kernel/fs not configured to use large files?");
     bye();
 }
 
@@ -224,7 +230,7 @@ print "ok 16\n";
 fail unless $zero eq "\0\0\0";
 print "ok 17\n";
 
-explain if $fail;
+explain() if $fail;
 
 bye(); # does the necessary cleanup
 
diff --git a/t/op/ref.t b/t/op/ref.t
index a2baab8e3b..8ae90424eb 100755
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..56\n";
+print "1..61\n";
 
 # Test glob operations.
 
@@ -279,14 +279,34 @@ print $$_,"\n";
     print ${\$_} for @a;
 }
 
+# This test is the reason for postponed destruction in sv_unref
+$a = [1,2,3];
+$a = $a->[1];
+print "not " unless $a == 2;
+print "ok 54\n";
+
+sub x::DESTROY {print "ok ", 54 + shift->[0], "\n"}
+{ my $a1 = bless [4],"x";
+  my $a2 = bless [3],"x";
+  { my $a3 = bless [2],"x";
+    my $a4 = bless [1],"x";
+    567;
+  }
+}
+
+
 # test global destruction
 
+my $test = 59;
+my $test1 = $test + 1;
+my $test2 = $test + 2;
+
 package FINALE;
 
 {
-    $ref3 = bless ["ok 56\n"];		# package destruction
-    my $ref2 = bless ["ok 55\n"];	# lexical destruction
-    local $ref1 = bless ["ok 54\n"];	# dynamic destruction
+    $ref3 = bless ["ok $test2\n"];	# package destruction
+    my $ref2 = bless ["ok $test1\n"];	# lexical destruction
+    local $ref1 = bless ["ok $test\n"];	# dynamic destruction
     1;					# flush any temp values on stack
 }
 
diff --git a/t/op/utf8decode.t b/t/op/utf8decode.t
new file mode 100644
index 0000000000..c631c0a7a9
--- /dev/null
+++ b/t/op/utf8decode.t
@@ -0,0 +1,181 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..78\n";
+
+my $test = 1;
+
+# This table is based on Markus Kuhn's UTF-8 Decode Stress Tester,
+# http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt,
+# version dated 2000-09-02. 
+
+# Note the \0 instead of a raw zero byte in 2.1.1: for example
+# GNU patch v2.1 has "issues" with raw zero bytes.
+
+my @MK = split(/\n/, <<__EOMK__);
+1	Correct UTF-8
+1.1.1 y "κόσμε"	-		11	ce:ba:e1:bd:b9:cf:83:ce:bc:ce:b5	5
+2	Boundary conditions 
+2.1	First possible sequence of certain length
+2.1.1 y "\0"			0		1	00	1
+2.1.2 y "€"			80		2	c2:80	1
+2.1.3 y "ࠀ"		800		3	e0:a0:80	1
+2.1.4 y "𐀀"		10000		4	f0:90:80:80	1
+2.1.5 y "�����"	200000		5	f8:88:80:80:80	1
+2.1.6 y "������"	4000000		6	fc:84:80:80:80:80	1
+2.2	Last possible sequence of certain length
+2.2.1 y ""			7f		1	7f	1
+2.2.2 y "߿"			7ff		2	df:bf	1
+# The ffff is illegal unless UTF8_ALLOW_FFFF
+2.2.3 n "￿"			ffff		3	ef:bf:bf	1	character 0xffff
+2.2.4 y "����"			1fffff		4	f7:bf:bf:bf	1
+2.2.5 y "�����"			3ffffff		5	fb:bf:bf:bf:bf	1
+2.2.6 y "������"		7fffffff	6	fd:bf:bf:bf:bf:bf	1
+2.3	Other boundary conditions
+2.3.1 y "퟿"		d7ff		3	ed:9f:bf	1
+2.3.2 y ""		e000		3	ee:80:80	1
+2.3.3 y "�"			fffd		3	ef:bf:bd	1
+2.3.4 y "􏿿"		10ffff		4	f4:8f:bf:bf	1
+2.3.5 y "����"		110000		4	f4:90:80:80	1
+3	Malformed sequences
+3.1	Unexpected continuation bytes
+3.1.1 n "�"			-		1	80	-	unexpected continuation byte 0x80
+3.1.2 n "�"			-		1	bf	-	unexpected continuation byte 0xbf
+3.1.3 n "��"			-		2	80:bf	-	unexpected continuation byte 0x80
+3.1.4 n "���"		-		3	80:bf:80	-	unexpected continuation byte 0x80
+3.1.5 n "����"		-		4	80:bf:80:bf	-	unexpected continuation byte 0x80
+3.1.6 n "�����"	-		5	80:bf:80:bf:80	-	unexpected continuation byte 0x80
+3.1.7 n "������"	-		6	80:bf:80:bf:80:bf	-	unexpected continuation byte 0x80
+3.1.8 n "�������"	-		7	80:bf:80:bf:80:bf:80	-	unexpected continuation byte 0x80
+3.1.9 n "����������������������������������������������������������������"				-	64	80:81:82:83:84:85:86:87:88:89:8a:8b:8c:8d:8e:8f:90:91:92:93:94:95:96:97:98:99:9a:9b:9c:9d:9e:9f:a0:a1:a2:a3:a4:a5:a6:a7:a8:a9:aa:ab:ac:ad:ae:af:b0:b1:b2:b3:b4:b5:b6:b7:b8:b9:ba:bb:bc:bd:be:bf	-	unexpected continuation byte 0x80
+3.2	Lonely start characters
+3.2.1 n "� � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � "	-	64 	c0:20:c1:20:c2:20:c3:20:c4:20:c5:20:c6:20:c7:20:c8:20:c9:20:ca:20:cb:20:cc:20:cd:20:ce:20:cf:20:d0:20:d1:20:d2:20:d3:20:d4:20:d5:20:d6:20:d7:20:d8:20:d9:20:da:20:db:20:dc:20:dd:20:de:20:df:20	-	unexpected non-continuation byte 0x20 after byte 0xc0
+3.2.2 n "� � � � � � � � � � � � � � � � "	-	32	e0:20:e1:20:e2:20:e3:20:e4:20:e5:20:e6:20:e7:20:e8:20:e9:20:ea:20:eb:20:ec:20:ed:20:ee:20:ef:20	-	unexpected non-continuation byte 0x20 after byte 0xe0
+3.2.3 n "� � � � � � � � "	-	16	f0:20:f1:20:f2:20:f3:20:f4:20:f5:20:f6:20:f7:20	-	unexpected non-continuation byte 0x20 after byte 0xf0
+3.2.4 n "� � � � "		-	8	f8:20:f9:20:fa:20:fb:20	-	unexpected non-continuation byte 0x20 after byte 0xf8
+3.2.5 n "� � "			-	4	fc:20:fd:20	-	unexpected non-continuation byte 0x20 after byte 0xfc
+3.3	Sequences with last continuation byte missing
+3.3.1 n "�"			-	1	c0	-	1 byte, need 2
+3.3.2 n "��"			-	2	e0:80	-	2 bytes, need 3
+3.3.3 n "���"		-	3	f0:80:80	-	3 bytes, need 4
+3.3.4 n "����"		-	4	f8:80:80:80	-	4 bytes, need 5
+3.3.5 n "�����"	-	5	fc:80:80:80:80	-	5 bytes, need 6
+3.3.6 n "�"			-	1	df	-	1 byte, need 2
+3.3.7 n "�"			-	2	ef:bf	-	2 bytes, need 3
+3.3.8 n "���"			-	3	f7:bf:bf	-	3 bytes, need 4
+3.3.9 n "����"			-	4	fb:bf:bf:bf	-	4 bytes, need 5
+3.3.10 n "�����"		-	5	fd:bf:bf:bf:bf	-	5 bytes, need 6
+3.4	Concatenation of incomplete sequences
+3.4.1 n "�����������������������������"	-	30	c0:e0:80:f0:80:80:f8:80:80:80:fc:80:80:80:80:df:ef:bf:f7:bf:bf:fb:bf:bf:bf:fd:bf:bf:bf:bf	-	unexpected continuation byte 0xe0
+3.5	Impossible bytes
+3.5.1 n "�"			-	1	fe	-	byte 0xfe
+3.5.2 n "�"			-	1	ff	-	byte 0xff
+3.5.3 n "����"			-	4	fe:fe:ff:ff	-	byte 0xfe
+4	Overlong sequences
+4.1	Examples of an overlong ASCII character
+4.1.1 n "��"			-	2	c0:af	-	2 bytes, need 1
+4.1.2 n "���"		-	3	e0:80:af	-	3 bytes, need 1
+4.1.3 n "����"		-	4	f0:80:80:af	-	4 bytes, need 1
+4.1.4 n "�����"	-	5	f8:80:80:80:af	-	5 bytes, need 1
+4.1.5 n "������"	-	6	fc:80:80:80:80:af	-	6 bytes, need 1
+4.2	Maximum overlong sequences
+4.2.1 n "��"			-	2	c1:bf	-	2 bytes, need 1
+4.2.2 n "���"		-	3	e0:9f:bf	-	3 bytes, need 2
+4.2.3 n "����"		-	4	f0:8f:bf:bf	-	4 bytes, need 3
+4.2.4 n "�����"		-	5	f8:87:bf:bf:bf	-	5 bytes, need 4
+4.2.5 n "������"		-	6	fc:83:bf:bf:bf:bf	-	6 bytes, need 5
+4.3	Overlong representation of the NUL character
+4.3.1 n "��"			-	2	c0:80	-	2 bytes, need 1
+4.3.2 n "���"		-	3	e0:80:80	-	3 bytes, need 1
+4.3.3 n "����"		-	4	f0:80:80:80	-	4 bytes, need 1
+4.3.4 n "�����"	-	5	f8:80:80:80:80	-	5 bytes, need 1
+4.3.5 n "������"	-	6	fc:80:80:80:80:80	-	6 bytes, need 1
+5	Illegal code positions
+5.1	Single UTF-16 surrogates
+5.1.1 n "���"		-	3	ed:a0:80	-	UTF-16 surrogate 0xd800
+5.1.2 n "���"			-	3	ed:ad:bf	-	UTF-16 surrogate 0xdb7f
+5.1.3 n "���"		-	3	ed:ae:80	-	UTF-16 surrogate 0xdb80
+5.1.4 n "���"			-	3	ed:af:bf	-	UTF-16 surrogate 0xdbff
+5.1.5 n "���"		-	3	ed:b0:80	-	UTF-16 surrogate 0xdc00
+5.1.6 n "���"		-	3	ed:be:80	-	UTF-16 surrogate 0xdf80
+5.1.7 n "���"			-	3	ed:bf:bf	-	UTF-16 surrogate 0xdfff
+5.2	Paired UTF-16 surrogates
+5.2.1 n "������"		-	6	ed:a0:80:ed:b0:80	-	UTF-16 surrogate 0xd800
+5.2.2 n "������"		-	6	ed:a0:80:ed:bf:bf	-	UTF-16 surrogate 0xd800
+5.2.3 n "������"		-	6	ed:ad:bf:ed:b0:80	-	UTF-16 surrogate 0xdb7f
+5.2.4 n "������"		-	6	ed:ad:bf:ed:bf:bf	-	UTF-16 surrogate 0xdb7f
+5.2.5 n "������"		-	6	ed:ae:80:ed:b0:80	-	UTF-16 surrogate 0xdb80
+5.2.6 n "������"		-	6	ed:ae:80:ed:bf:bf	-	UTF-16 surrogate 0xdb80
+5.2.7 n "������"		-	6	ed:af:bf:ed:b0:80	-	UTF-16 surrogate 0xdbff
+5.2.8 n "������"		-	6	ed:af:bf:ed:bf:bf	-	UTF-16 surrogate 0xdbff
+5.3	Other illegal code positions
+5.3.1 n "￾"			-	3	ef:bf:be	-	byte order mark 0xfffe
+# The ffff is illegal unless UTF8_ALLOW_FFFF
+5.3.2 n "￿"			-	3	ef:bf:bf	-	character 0xffff
+__EOMK__
+
+# 104..181
+{
+    my $WARNCNT;
+    my $id;
+
+    local $SIG{__WARN__} =
+	sub {
+	    # print "# $id: @_";
+	    $WARNCNT++;
+	    $WARNMSG = "@_";
+	};
+
+    sub moan {
+	print "$id: @_";
+    }
+    
+    sub test_unpack_U {
+	$WARNCNT = 0;
+	$WARNMSG = "";
+	unpack('U*', $_[0]);
+    }
+
+    for (@MK) {
+	if (/^(?:\d+(?:\.\d+)?)\s/ || /^#/) {
+	    # print "# $_\n";
+	} elsif (/^(\d+\.\d+\.\d+[bu]?)\s+([yn])\s+"(.+)"\s+([0-9a-f]{1,8}|-)\s+(\d+)\s+([0-9a-f]{2}(?::[0-9a-f]{2})*)(?:\s+((?:\d+|-)(?:\s+(.+))?))?$/) {
+	    $id = $1;
+	    my ($okay, $bytes, $Unicode, $byteslen, $hex, $charslen, $error) =
+		($2, $3, $4, $5, $6, $7, $8);
+	    my @hex = split(/:/, $hex);
+	    unless (@hex == $byteslen) {
+		my $nhex = @hex;
+		moan "amount of hex ($nhex) not equal to byteslen ($byteslen)\n";
+	    }
+	    {
+		use bytes;
+		my $bytesbyteslen = length($bytes);
+		unless ($bytesbyteslen == $byteslen) {
+		    moan "bytes length() ($bytesbyteslen) not equal to $byteslen\n";
+		}
+	    }
+	    if ($okay eq 'y') {
+		test_unpack_U($bytes);
+		if ($WARNCNT) {
+		    moan "unpack('U*') false negative\n";
+		    print "not ";
+		}
+	    } elsif ($okay eq 'n') {
+		test_unpack_U($bytes);
+		if ($WARNCNT == 0 || ($error ne '' && $WARNMSG !~ /$error/)) {
+		    moan "unpack('U*') false positive\n";
+		    print "not ";
+		}
+	    }
+	    print "ok $test\n";
+	    $test++;
+ 	} else {
+	    moan "unknown format\n";
+	}
+    }
+}
diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t
index 60cbd8c97a..8efd571901 100755
--- a/t/pragma/utf8.t
+++ b/t/pragma/utf8.t
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 
-print "1..191\n";
+print "1..103\n";
 
 my $test = 1;
 
@@ -104,6 +104,7 @@ sub nok_bytes {
     ok $1, '123alpha';
     $test++;				# 12
 }
+
 {
     use utf8;
 
@@ -204,10 +205,8 @@ sub nok_bytes {
 
 	ok $1, pack("C*", 0342);
 	$test++;				# 40
-
     }
 
-
     {
 	no utf8;
 	$_="\342\230\272>\342\230\272\342\230\272";
@@ -262,6 +261,7 @@ sub nok_bytes {
 	ok $tmp, pack("C*", 0342, 0230, 0272);
 	$test++;				# 54
     }
+
     {
 	use bytes;
 	no utf8;
@@ -295,7 +295,6 @@ sub nok_bytes {
 
 	ok $1, pack("C*", 0342);
 	$test++;				# 64
-
     }
 
     ok "\x{ab}" =~ /^\x{ab}$/, 1;
@@ -389,8 +388,6 @@ sub nok_bytes {
 {
     # bug id 20000323.056
 
-    use utf8;
-
     print "not " unless "\x{41}" eq +v65;
     print "ok $test\n";
     $test++;
@@ -564,242 +561,3 @@ sub nok_bytes {
     print "ok $test\n";
     $test++;
 }
-
-# This table is based on Markus Kuhn's UTF-8 Decode Stress Tester,
-# http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt,
-# version dated 2000-09-02. 
-
-# Note the \0 instead of a raw zero byte in 2.1.1: for example
-# GNU patch v2.1 has "issues" with raw zero bytes.
-
-my @MK = split(/\n/, <<__EOMK__);
-1	Correct UTF-8
-1.1.1 y "κόσμε"	-		11	ce:ba:e1:bd:b9:cf:83:ce:bc:ce:b5	5
-2	Boundary conditions 
-2.1	First possible sequence of certain length
-2.1.1 y "\0"			0		1	00	1
-2.1.2 y "€"			80		2	c2:80	1
-2.1.3 y "ࠀ"		800		3	e0:a0:80	1
-2.1.4 y "𐀀"		10000		4	f0:90:80:80	1
-2.1.5 y "�����"	200000		5	f8:88:80:80:80	1
-2.1.6 y "������"	4000000		6	fc:84:80:80:80:80	1
-2.2	Last possible sequence of certain length
-2.2.1 y ""			7f		1	7f	1
-2.2.2 y "߿"			7ff		2	df:bf	1
-# The ffff is illegal unless UTF8_ALLOW_FFFF
-2.2.3 n "￿"			ffff		3	ef:bf:bf	1
-2.2.4 y "����"			1fffff		4	f7:bf:bf:bf	1
-2.2.5 y "�����"			3ffffff		5	fb:bf:bf:bf:bf	1
-2.2.6 y "������"		7fffffff	6	fd:bf:bf:bf:bf:bf	1
-2.3	Other boundary conditions
-2.3.1 y "퟿"		d7ff		3	ed:9f:bf	1
-2.3.2 y ""		e000		3	ee:80:80	1
-2.3.3 y "�"			fffd		3	ef:bf:bd	1
-2.3.4 y "􏿿"		10ffff		4	f4:8f:bf:bf	1
-2.3.5 y "����"		110000		4	f4:90:80:80	1
-3	Malformed sequences
-3.1	Unexpected continuation bytes
-3.1.1 n "�"			-		1	80
-3.1.2 n "�"			-		1	bf
-3.1.3 n "��"			-		2	80:bf
-3.1.4 n "���"		-		3	80:bf:80
-3.1.5 n "����"		-		4	80:bf:80:bf
-3.1.6 n "�����"	-		5	80:bf:80:bf:80
-3.1.7 n "������"	-		6	80:bf:80:bf:80:bf
-3.1.8 n "�������"	-		7	80:bf:80:bf:80:bf:80
-3.1.9 n "����������������������������������������������������������������"				-	64	80:81:82:83:84:85:86:87:88:89:8a:8b:8c:8d:8e:8f:90:91:92:93:94:95:96:97:98:99:9a:9b:9c:9d:9e:9f:a0:a1:a2:a3:a4:a5:a6:a7:a8:a9:aa:ab:ac:ad:ae:af:b0:b1:b2:b3:b4:b5:b6:b7:b8:b9:ba:bb:bc:bd:be:bf
-3.2	Lonely start characters
-3.2.1 n "� � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � "	-	64 	c0:20:c1:20:c2:20:c3:20:c4:20:c5:20:c6:20:c7:20:c8:20:c9:20:ca:20:cb:20:cc:20:cd:20:ce:20:cf:20:d0:20:d1:20:d2:20:d3:20:d4:20:d5:20:d6:20:d7:20:d8:20:d9:20:da:20:db:20:dc:20:dd:20:de:20:df:20
-3.2.2 n "� � � � � � � � � � � � � � � � "	-	32	e0:20:e1:20:e2:20:e3:20:e4:20:e5:20:e6:20:e7:20:e8:20:e9:20:ea:20:eb:20:ec:20:ed:20:ee:20:ef:20
-3.2.3 n "� � � � � � � � "	-	16	f0:20:f1:20:f2:20:f3:20:f4:20:f5:20:f6:20:f7:20
-3.2.4 n "� � � � "		-	8	f8:20:f9:20:fa:20:fb:20
-3.2.5 n "� � "			-	4	fc:20:fd:20
-3.3	Sequences with last continuation byte missing
-3.3.1 n "�"			-	1	c0
-3.3.2 n "��"			-	2	e0:80
-3.3.3 n "���"		-	3	f0:80:80
-3.3.4 n "����"		-	4	f8:80:80:80
-3.3.5 n "�����"	-	5	fc:80:80:80:80
-3.3.6 n "�"			-	1	df
-3.3.7 n "�"			-	2	ef:bf
-3.3.8 n "���"			-	3	f7:bf:bf
-3.3.9 n "����"			-	4	fb:bf:bf:bf
-3.3.10 n "�����"		-	5	fd:bf:bf:bf:bf
-3.4	Concatenation of incomplete sequences
-3.4.1 n "�����������������������������"	-	30	c0:e0:80:f0:80:80:f8:80:80:80:fc:80:80:80:80:df:ef:bf:f7:bf:bf:fb:bf:bf:bf:fd:bf:bf:bf:bf
-3.5	Impossible bytes
-3.5.1 n "�"			-	1	fe
-3.5.2 n "�"			-	1	ff
-3.5.3 n "����"			-	4	fe:fe:ff:ff
-4	Overlong sequences
-4.1	Examples of an overlong ASCII character
-4.1.1 n "��"			-	2	c0:af
-4.1.2 n "���"		-	3	e0:80:af
-4.1.3 n "����"		-	4	f0:80:80:af
-4.1.4 n "�����"	-	5	f8:80:80:80:af
-4.1.5 n "������"	-	6	fc:80:80:80:80:af
-4.2	Maximum overlong sequences
-4.2.1 n "��"			-	2	c1:bf
-4.2.2 n "���"		-	3	e0:9f:bf
-4.2.3 n "����"		-	4	f0:8f:bf:bf
-4.2.4 n "�����"		-	5	f8:87:bf:bf:bf
-4.2.5 n "������"		-	6	fc:83:bf:bf:bf:bf
-4.3	Overlong representation of the NUL character
-4.3.1 n "��"			-	2	c0:80
-4.3.2 n "���"		-	3	e0:80:80
-4.3.3 n "����"		-	4	f0:80:80:80
-4.3.4 n "�����"	-	5	f8:80:80:80:80
-4.3.5 n "������"	-	6	fc:80:80:80:80:80
-5	Illegal code positions
-5.1	Single UTF-16 surrogates
-5.1.1 n "���"		-	3	ed:a0:80
-5.1.2 n "���"			-	3	ed:ad:bf
-5.1.3 n "���"		-	3	ed:ae:80
-5.1.4 n "���"			-	3	ed:af:bf
-5.1.5 n "���"		-	3	ed:b0:80
-5.1.6 n "���"		-	3	ed:be:80
-5.1.7 n "���"			-	3	ed:bf:bf
-5.2	Paired UTF-16 surrogates
-5.2.1 n "������"		-	6	ed:a0:80:ed:b0:80
-5.2.2 n "������"		-	6	ed:a0:80:ed:bf:bf
-5.2.3 n "������"		-	6	ed:ad:bf:ed:b0:80
-5.2.4 n "������"		-	6	ed:ad:bf:ed:bf:bf
-5.2.5 n "������"		-	6	ed:ae:80:ed:b0:80
-5.2.6 n "������"		-	6	ed:ae:80:ed:bf:bf
-5.2.7 n "������"		-	6	ed:af:bf:ed:b0:80
-5.2.8 n "������"		-	6	ed:af:bf:ed:bf:bf
-5.3	Other illegal code positions
-5.3.1 n "￾"			-	3	ef:bf:be
-# The ffff is illegal unless UTF8_ALLOW_FFFF
-5.3.2 n "￿"			-	3	ef:bf:bf
-__EOMK__
-
-# 104..181
-{
-    my $WARN;
-    my $id;
-
-    local $SIG{__WARN__} =
-	sub {
-	    # print "# $id: @_";
-	    $WARN++;
-	};
-
-    sub moan {
-	print "$id: @_";
-    }
-    
-    sub test_unpack_U {
-	$WARN = 0;
-	unpack('U*', $_[0]);
-    }
-
-    for (@MK) {
-	if (/^(?:\d+(?:\.\d+)?)\s/ || /^#/) {
-	    # print "# $_\n";
-	} elsif (/^(\d+\.\d+\.\d+[bu]?)\s+([yn])\s+"(.+)"\s+([0-9a-f]{1,8}|-)\s+(\d+)\s+([0-9a-f]{2}(?::[0-9a-f]{2})*)(?:\s+(\d+))?$/) {
-	    $id = $1;
-	    my ($okay, $bytes, $Unicode, $byteslen, $hex, $charslen) =
-		($2, $3, $4, $5, $6, $7);
-	    my @hex = split(/:/, $hex);
-	    unless (@hex == $byteslen) {
-		my $nhex = @hex;
-		moan "amount of hex ($nhex) not equal to byteslen ($byteslen)\n";
-	    }
-	    {
-		use bytes;
-		my $bytesbyteslen = length($bytes);
-		unless ($bytesbyteslen == $byteslen) {
-		    moan "bytes length() ($bytesbyteslen) not equal to $byteslen\n";
-		}
-	    }
-	    if ($okay eq 'y') {
-		test_unpack_U($bytes);
-		unless ($WARN == 0) {
-		    moan "unpack('U*') false negative\n";
-		    print "not ";
-		}
-	    } elsif ($okay eq 'n') {
-		test_unpack_U($bytes);
-		unless ($WARN) {
-		    moan "unpack('U*') false positive\n";
-		    print "not ";
-		}
-	    }
-	    print "ok $test\n";
-	    $test++;
- 	} else {
-	    moan "unknown format\n";
-	}
-    }
-}
-
-{
-    # tests 182..191
-
-    {
-	my $a = "\x{41}";
-
-	print "not " unless length($a) == 1;
-	print "ok $test\n";
-	$test++;
-
-	use bytes;
-	print "not " unless $a eq "\x41" && length($a) == 1;
-	print "ok $test\n";
-	$test++;
-    }
-
-    {
-	my $a = "\x{80}";
-
-	print "not " unless length($a) == 1;
-	print "ok $test\n";
-	$test++;
-
-	use bytes;
-	print "not " unless $a eq "\xc2\x80" && length($a) == 2;
-	print "ok $test\n";
-	$test++;
-    }
-
-    {
-	my $a = "\x{100}";
-
-	print "not " unless length($a) == 1;
-	print "ok $test\n";
-	$test++;
-
-	use bytes;
-	print "not " unless $a eq "\xc4\x80" && length($a) == 2;
-	print "ok $test\n";
-	$test++;
-    }
-
-    {
-	my $a = "\x{100}\x{80}";
-
-	print "not " unless length($a) == 2;
-	print "ok $test\n";
-	$test++;
-
-	use bytes;
-	print "not " unless $a eq "\xc4\x80\xc2\x80" && length($a) == 4;
-	print "ok $test\n";
-	$test++;
-    }
-
-    {
-	my $a = "\x{80}\x{100}";
-
-	print "not " unless length($a) == 2;
-	print "ok $test\n";
-	$test++;
-
-	use bytes;
-	print "not " unless $a eq "\xc2\x80\xc4\x80" && length($a) == 4;
-	print "ok $test\n";
-	$test++;
-    }
-}
-
diff --git a/taint.c b/taint.c
index 0f0ce98e7a..7a8baac7b0 100644
--- a/taint.c
+++ b/taint.c
@@ -11,7 +11,6 @@
 void
 Perl_taint_proper(pTHX_ const char *f, const char *s)
 {
-    dTHR;	/* just for taint */
     char *ug;
 
 #ifdef HAS_SETEUID
@@ -64,12 +63,10 @@ Perl_taint_env(pTHX)
 	if (!svp || *svp == &PL_sv_undef)
 	    break;
 	if (SvTAINTED(*svp)) {
-	    dTHR;
 	    TAINT;
 	    taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
 	}
 	if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) {
-	    dTHR;
 	    TAINT;
 	    taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
 	}
@@ -81,12 +78,10 @@ Perl_taint_env(pTHX)
     svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
     if (svp && *svp) {
 	if (SvTAINTED(*svp)) {
-	    dTHR;
 	    TAINT;
 	    taint_proper("Insecure %s%s", "$ENV{PATH}");
 	}
 	if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) {
-	    dTHR;
 	    TAINT;
 	    taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
 	}
@@ -96,7 +91,6 @@ Perl_taint_env(pTHX)
     /* tainted $TERM is okay if it contains no metachars */
     svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
     if (svp && *svp && SvTAINTED(*svp)) {
-    	dTHR;	/* just for taint */
 	STRLEN n_a;
 	bool was_tainted = PL_tainted;
 	char *t = SvPV(*svp, n_a);
@@ -116,7 +110,6 @@ Perl_taint_env(pTHX)
     for (e = misc_env; *e; e++) {
 	svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
 	if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
-	    dTHR;	/* just for taint */
 	    TAINT;
 	    taint_proper("Insecure $ENV{%s}%s", *e);
 	}
diff --git a/toke.c b/toke.c
index aa3e64b55f..232c4eeb2b 100644
--- a/toke.c
+++ b/toke.c
@@ -274,7 +274,6 @@ S_missingterm(pTHX_ char *s)
 void
 Perl_deprecate(pTHX_ char *s)
 {
-    dTHR;
     if (ckWARN(WARN_DEPRECATED))
 	Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s);
 }
@@ -337,7 +336,6 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 void
 Perl_lex_start(pTHX_ SV *line)
 {
-    dTHR;
     char *s;
     STRLEN len;
 
@@ -433,7 +431,6 @@ Perl_lex_end(pTHX)
 STATIC void
 S_incline(pTHX_ char *s)
 {
-    dTHR;
     char *t;
     char *n;
     char *e;
@@ -495,7 +492,6 @@ S_incline(pTHX_ char *s)
 STATIC char *
 S_skipspace(pTHX_ register char *s)
 {
-    dTHR;
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
 	while (s < PL_bufend && SPACE_OR_TAB(*s))
 	    s++;
@@ -614,7 +610,6 @@ S_check_uni(pTHX)
 {
     char *s;
     char *t;
-    dTHR;
 
     if (PL_oldoldbufptr != PL_last_uni)
 	return;
@@ -680,7 +675,6 @@ S_uni(pTHX_ I32 f, char *s)
 STATIC I32
 S_lop(pTHX_ I32 f, int x, char *s)
 {
-    dTHR;
     yylval.ival = f;
     CLINE;
     PL_expect = x;
@@ -782,7 +776,6 @@ S_force_ident(pTHX_ register char *s, int kind)
 	PL_nextval[PL_nexttoke].opval = o;
 	force_next(WORD);
 	if (kind) {
-	    dTHR;		/* just for in_eval */
 	    o->op_private = OPpCONST_ENTERED;
 	    /* XXX see note in pp_entereval() for why we forgo typo
 	       warnings if the symbol must be introduced in an eval.
@@ -995,7 +988,6 @@ S_sublex_start(pTHX)
 STATIC I32
 S_sublex_push(pTHX)
 {
-    dTHR;
     ENTER;
 
     PL_lex_state = PL_sublex_info.super_state;
@@ -1356,7 +1348,6 @@ S_scan_const(pTHX_ char *start)
 	    if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
 		isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
 	    {
-		dTHR;			/* only for ckWARN */
 		if (ckWARN(WARN_SYNTAX))
 		    Perl_warner(aTHX_ WARN_SYNTAX, "\\%c better written as $%c", *s, *s);
 		*--s = '$';
@@ -1381,7 +1372,6 @@ S_scan_const(pTHX_ char *start)
 		/* FALL THROUGH */
 	    default:
 	        {
-		    dTHR;
 		    if (ckWARN(WARN_MISC) && isALNUM(*s))
 			Perl_warner(aTHX_ WARN_MISC, 
 			       "Unrecognized escape \\%c passed through",
@@ -2073,7 +2063,6 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
 int
 Perl_yylex_r(pTHX_ YYSTYPE *lvalp, int *lcharp)
 {
-    dTHR;
     int r;
 
     yylval_pointer[yyactlevel] = lvalp;
@@ -2101,7 +2090,6 @@ Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp)
 Perl_yylex(pTHX)
 #endif
 {
-    dTHR;
     register char *s;
     register char *d;
     register I32 tmp;
@@ -5759,7 +5747,6 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what)
     char *w;
 
     if (*s == ' ' && s[1] == '(') {	/* XXX gotta be a better way */
-	dTHR;				/* only for ckWARN */
 	if (ckWARN(WARN_SYNTAX)) {
 	    int level = 1;
 	    for (w = s+2; *w && level; w++) {
@@ -6042,7 +6029,6 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
 	    *d = '\0';
 	    while (s < send && SPACE_OR_TAB(*s)) s++;
 	    if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
-		dTHR;			/* only for ckWARN */
 		if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
 		    const char *brack = *s == '[' ? "[...]" : "{...}";
 		    Perl_warner(aTHX_ WARN_AMBIGUOUS,
@@ -6074,7 +6060,6 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
 	    if (funny == '#')
 		funny = '@';
 	    if (PL_lex_state == LEX_NORMAL) {
-		dTHR;			/* only for ckWARN */
 		if (ckWARN(WARN_AMBIGUOUS) &&
 		    (keyword(dest, d - dest) || get_cv(dest, FALSE)))
 		{
@@ -6273,7 +6258,6 @@ S_scan_trans(pTHX_ char *start)
 STATIC char *
 S_scan_heredoc(pTHX_ register char *s)
 {
-    dTHR;
     SV *herewas;
     I32 op_type = OP_SCALAR;
     I32 len;
@@ -6625,7 +6609,6 @@ S_scan_inputsymbol(pTHX_ char *start)
 STATIC char *
 S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 {
-    dTHR;
     SV *sv;				/* scalar value: string */
     char *tmps;				/* temp string, used for delimiter matching */
     register char *s = start;		/* current position in the buffer */
@@ -6856,7 +6839,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 	     we in octal/hex/binary?" indicator to disallow hex characters
 	     when in octal mode.
 	   */
-    	    dTHR;
 	    NV n = 0.0;
 	    UV u = 0;
 	    I32 shift;
@@ -6944,7 +6926,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 
 			if ((x >> shift) != u
 			    && !(PL_hints & HINT_NEW_BINARY)) {
-			    dTHR;
 			    overflowed = TRUE;
 			    n = (NV) u;
 			    if (ckWARN_d(WARN_OVERFLOW))
@@ -6976,7 +6957,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 	  out:
 	    sv = NEWSV(92,0);
 	    if (overflowed) {
-		dTHR;
 		if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
 		    Perl_warner(aTHX_ WARN_PORTABLE,
 				"%s number > %s non-portable",
@@ -6985,7 +6965,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 	    }
 	    else {
 #if UVSIZE > 4
-		dTHR;
 		if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
 		    Perl_warner(aTHX_ WARN_PORTABLE,
 				"%s number > %s non-portable",
@@ -7015,7 +6994,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 	       if -w is on
 	    */
 	    if (*s == '_') {
-		dTHR;			/* only for ckWARN */
 		if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
 		    Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
 		lastub = ++s;
@@ -7031,7 +7009,6 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
 
 	/* final misplaced underbar check */
 	if (lastub && s - lastub != 3) {
-	    dTHR;
 	    if (ckWARN(WARN_SYNTAX))
 		Perl_warner(aTHX_ WARN_SYNTAX, "Misplaced _ in number");
 	}
@@ -7183,7 +7160,7 @@ vstring:
 		pos++;
 	    if (!isALPHA(*pos)) {
 		UV rev;
-		U8 tmpbuf[UTF8_MAXLEN];
+		U8 tmpbuf[UTF8_MAXLEN+1];
 		U8 *tmpend;
 		bool utf8 = FALSE;
 		s++;				/* get past 'v' */
@@ -7248,7 +7225,6 @@ vstring:
 STATIC char *
 S_scan_formline(pTHX_ register char *s)
 {
-    dTHR;
     register char *eol;
     register char *t;
     SV *stuff = newSVpvn("",0);
@@ -7339,7 +7315,6 @@ S_set_csh(pTHX)
 I32
 Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 {
-    dTHR;
     I32 oldsavestack_ix = PL_savestack_ix;
     CV* outsidecv = PL_compcv;
     AV* comppadlist;
@@ -7395,7 +7370,6 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 int
 Perl_yywarn(pTHX_ char *s)
 {
-    dTHR;
     PL_in_eval |= EVAL_WARNONLY;
     yyerror(s);
     PL_in_eval &= ~EVAL_WARNONLY;
@@ -7405,7 +7379,6 @@ Perl_yywarn(pTHX_ char *s)
 int
 Perl_yyerror(pTHX_ char *s)
 {
-    dTHR;
     char *where = NULL;
     char *context = NULL;
     int contlen = -1;
diff --git a/universal.c b/universal.c
index 0899b1a601..12d31e58b1 100644
--- a/universal.c
+++ b/universal.c
@@ -74,7 +74,6 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level)
 		SV* sv = *svp++;
 		HV* basestash = gv_stashsv(sv, FALSE);
 		if (!basestash) {
-		    dTHR;
 		    if (ckWARN(WARN_MISC))
 			Perl_warner(aTHX_ WARN_SYNTAX,
 		             "Can't locate package %s for @%s::ISA",
diff --git a/utf8.c b/utf8.c
index 9e943acb10..bc0a52178d 100644
--- a/utf8.c
+++ b/utf8.c
@@ -27,21 +27,24 @@
 /* Unicode support */
 
 U8 *
-Perl_uv_to_utf8(pTHX_ U8 *d, UV uv)
+Perl_uv_to_utf8(pTHX_ U8 *d, UV uv) /* the d must be UTF8_MAXLEN+1 deep */
 {
     if (uv < 0x80) {
 	*d++ = uv;
+	*d   = 0;
 	return d;
     }
     if (uv < 0x800) {
 	*d++ = (( uv >>  6)         | 0xc0);
 	*d++ = (( uv        & 0x3f) | 0x80);
+	*d   = 0;
 	return d;
     }
     if (uv < 0x10000) {
 	*d++ = (( uv >> 12)         | 0xe0);
 	*d++ = (((uv >>  6) & 0x3f) | 0x80);
 	*d++ = (( uv        & 0x3f) | 0x80);
+	*d   = 0;
 	return d;
     }
     if (uv < 0x200000) {
@@ -49,6 +52,7 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv)
 	*d++ = (((uv >> 12) & 0x3f) | 0x80);
 	*d++ = (((uv >>  6) & 0x3f) | 0x80);
 	*d++ = (( uv        & 0x3f) | 0x80);
+	*d   = 0;
 	return d;
     }
     if (uv < 0x4000000) {
@@ -57,6 +61,7 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv)
 	*d++ = (((uv >> 12) & 0x3f) | 0x80);
 	*d++ = (((uv >>  6) & 0x3f) | 0x80);
 	*d++ = (( uv        & 0x3f) | 0x80);
+	*d   = 0;
 	return d;
     }
     if (uv < 0x80000000) {
@@ -66,6 +71,7 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv)
 	*d++ = (((uv >> 12) & 0x3f) | 0x80);
 	*d++ = (((uv >>  6) & 0x3f) | 0x80);
 	*d++ = (( uv        & 0x3f) | 0x80);
+	*d   = 0;
 	return d;
     }
 #ifdef HAS_QUAD
@@ -79,6 +85,7 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv)
 	*d++ = (((uv >> 12) & 0x3f) | 0x80);
 	*d++ = (((uv >>  6) & 0x3f) | 0x80);
 	*d++ = (( uv        & 0x3f) | 0x80);
+	*d   = 0;
 	return d;
     }
 #ifdef HAS_QUAD
@@ -96,6 +103,7 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv)
 	*d++ = (((uv >> 12) & 0x3f) | 0x80);
 	*d++ = (((uv >>  6) & 0x3f) | 0x80);
 	*d++ = (( uv        & 0x3f) | 0x80);
+	*d   = 0;
 	return d;
     }
 #endif
@@ -190,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
@@ -302,13 +309,6 @@ Perl_utf8_to_uv(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags)
 			"Malformed UTF-8 character (byte order mark 0x%04"UVxf")",
 			uv);
 	goto malformed;
-    } else if ((uv == 0xffff) &&
-	       !(flags & UTF8_ALLOW_FFFF)) {
-	if (dowarn)
-	    Perl_warner(aTHX_ WARN_UTF8,
-			"Malformed UTF-8 character (character 0x%04"UVxf")",
-			uv);
-	goto malformed;
     } else if ((expectlen > UNISKIP(uv)) &&
 	       !(flags & UTF8_ALLOW_LONG)) {
 	if (dowarn)
@@ -316,6 +316,13 @@ Perl_utf8_to_uv(pTHX_ U8* s, STRLEN curlen, STRLEN* retlen, U32 flags)
 			"Malformed UTF-8 character (%d byte%s, need %d)",
 			expectlen, expectlen == 1 ? "": "s", UNISKIP(uv));
 	goto malformed;
+    } else if ((uv == 0xffff) &&
+	       !(flags & UTF8_ALLOW_FFFF)) {
+	if (dowarn)
+	    Perl_warner(aTHX_ WARN_UTF8,
+			"Malformed UTF-8 character (character 0x%04"UVxf")",
+			uv);
+	goto malformed;
     }
 
     return uv;
@@ -495,7 +502,6 @@ reflect the new length.
 U8*
 Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN *len)
 {
-    dTHR;
     U8 *send;
     U8 *d;
     U8 *dst;
@@ -548,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");
@@ -593,7 +598,7 @@ Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
 bool
 Perl_is_uni_alnum(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_alnum(tmpbuf);
 }
@@ -601,7 +606,7 @@ Perl_is_uni_alnum(pTHX_ U32 c)
 bool
 Perl_is_uni_alnumc(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_alnumc(tmpbuf);
 }
@@ -609,7 +614,7 @@ Perl_is_uni_alnumc(pTHX_ U32 c)
 bool
 Perl_is_uni_idfirst(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_idfirst(tmpbuf);
 }
@@ -617,7 +622,7 @@ Perl_is_uni_idfirst(pTHX_ U32 c)
 bool
 Perl_is_uni_alpha(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_alpha(tmpbuf);
 }
@@ -625,7 +630,7 @@ Perl_is_uni_alpha(pTHX_ U32 c)
 bool
 Perl_is_uni_ascii(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_ascii(tmpbuf);
 }
@@ -633,7 +638,7 @@ Perl_is_uni_ascii(pTHX_ U32 c)
 bool
 Perl_is_uni_space(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_space(tmpbuf);
 }
@@ -641,7 +646,7 @@ Perl_is_uni_space(pTHX_ U32 c)
 bool
 Perl_is_uni_digit(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_digit(tmpbuf);
 }
@@ -649,7 +654,7 @@ Perl_is_uni_digit(pTHX_ U32 c)
 bool
 Perl_is_uni_upper(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_upper(tmpbuf);
 }
@@ -657,7 +662,7 @@ Perl_is_uni_upper(pTHX_ U32 c)
 bool
 Perl_is_uni_lower(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_lower(tmpbuf);
 }
@@ -665,7 +670,7 @@ Perl_is_uni_lower(pTHX_ U32 c)
 bool
 Perl_is_uni_cntrl(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_cntrl(tmpbuf);
 }
@@ -673,7 +678,7 @@ Perl_is_uni_cntrl(pTHX_ U32 c)
 bool
 Perl_is_uni_graph(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_graph(tmpbuf);
 }
@@ -681,7 +686,7 @@ Perl_is_uni_graph(pTHX_ U32 c)
 bool
 Perl_is_uni_print(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_print(tmpbuf);
 }
@@ -689,7 +694,7 @@ Perl_is_uni_print(pTHX_ U32 c)
 bool
 Perl_is_uni_punct(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_punct(tmpbuf);
 }
@@ -697,7 +702,7 @@ Perl_is_uni_punct(pTHX_ U32 c)
 bool
 Perl_is_uni_xdigit(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return is_utf8_xdigit(tmpbuf);
 }
@@ -705,7 +710,7 @@ Perl_is_uni_xdigit(pTHX_ U32 c)
 U32
 Perl_to_uni_upper(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return to_utf8_upper(tmpbuf);
 }
@@ -713,7 +718,7 @@ Perl_to_uni_upper(pTHX_ U32 c)
 U32
 Perl_to_uni_title(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return to_utf8_title(tmpbuf);
 }
@@ -721,7 +726,7 @@ Perl_to_uni_title(pTHX_ U32 c)
 U32
 Perl_to_uni_lower(pTHX_ U32 c)
 {
-    U8 tmpbuf[UTF8_MAXLEN];
+    U8 tmpbuf[UTF8_MAXLEN+1];
     uv_to_utf8(tmpbuf, (UV)c);
     return to_utf8_lower(tmpbuf);
 }
diff --git a/util.c b/util.c
index d9ea421afb..d0ea96cbdf 100644
--- a/util.c
+++ b/util.c
@@ -1262,7 +1262,6 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 char *
 Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
 {
-    dTHR;
     register unsigned char *s, *x;
     register unsigned char *big;
     register I32 pos;
@@ -1432,7 +1431,6 @@ Perl_savepvn(pTHX_ const char *sv, register I32 len)
 STATIC SV *
 S_mess_alloc(pTHX)
 {
-    dTHR;
     SV *sv;
     XPVMG *any;
 
@@ -1518,7 +1516,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
-	dTHR;
 	if (CopLINE(PL_curcop))
 	    Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf,
 			   CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
@@ -1542,7 +1539,6 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 OP *
 Perl_vdie(pTHX_ const char* pat, va_list *args)
 {
-    dTHR;
     char *message;
     int was_in_eval = PL_in_eval;
     HV *stash;
@@ -1643,7 +1639,6 @@ Perl_die(pTHX_ const char* pat, ...)
 void
 Perl_vcroak(pTHX_ const char* pat, va_list *args)
 {
-    dTHR;
     char *message;
     HV *stash;
     GV *gv;
@@ -1776,7 +1771,6 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
 
     if (PL_warnhook) {
 	/* sv_2cv might call Perl_warn() */
-	dTHR;
 	SV *oldwarnhook = PL_warnhook;
 	ENTER;
 	SAVESPTR(PL_warnhook);
@@ -1874,7 +1868,6 @@ Perl_warner(pTHX_ U32  err, const char* pat,...)
 void
 Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 {
-    dTHR;
     char *message;
     HV *stash;
     GV *gv;
@@ -1931,7 +1924,6 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
     else {
         if (PL_warnhook) {
             /* sv_2cv might call Perl_warn() */
-            dTHR;
             SV *oldwarnhook = PL_warnhook;
             ENTER;
             SAVESPTR(PL_warnhook);
@@ -2965,7 +2957,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 		continue;
 	    }
 	    else {
-		dTHR;
 		if (ckWARN(WARN_DIGIT))
 		    Perl_warner(aTHX_ WARN_DIGIT,
 				"Illegal binary digit '%c' ignored", *s);
@@ -2976,7 +2967,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 	    register UV xuv = ruv << 1;
 
 	    if ((xuv >> 1) != ruv) {
-		dTHR;
 		overflowed = TRUE;
 		rnv = (NV) ruv;
 		if (ckWARN_d(WARN_OVERFLOW))
@@ -3004,7 +2994,6 @@ Perl_scan_bin(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 	|| (!overflowed && ruv > 0xffffffff  )
 #endif
 	) {
-	dTHR;
 	if (ckWARN(WARN_PORTABLE))
 	    Perl_warner(aTHX_ WARN_PORTABLE,
 			"Binary number > 0b11111111111111111111111111111111 non-portable");
@@ -3034,7 +3023,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 		 * as soon as non-octal characters are seen, complain only iff
 		 * someone seems to want to use the digits eight and nine). */
 		if (*s == '8' || *s == '9') {
-		    dTHR;
 		    if (ckWARN(WARN_DIGIT))
 			Perl_warner(aTHX_ WARN_DIGIT,
 				    "Illegal octal digit '%c' ignored", *s);
@@ -3046,7 +3034,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 	    register UV xuv = ruv << 3;
 
 	    if ((xuv >> 3) != ruv) {
-		dTHR;
 		overflowed = TRUE;
 		rnv = (NV) ruv;
 		if (ckWARN_d(WARN_OVERFLOW))
@@ -3074,7 +3061,6 @@ Perl_scan_oct(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 	|| (!overflowed && ruv > 0xffffffff  )
 #endif
 	) {
-	dTHR;
 	if (ckWARN(WARN_PORTABLE))
 	    Perl_warner(aTHX_ WARN_PORTABLE,
 			"Octal number > 037777777777 non-portable");
@@ -3113,7 +3099,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 		++s;
 	    }
 	    else {
-		dTHR;
 		if (ckWARN(WARN_DIGIT))
 		    Perl_warner(aTHX_ WARN_DIGIT,
 				"Illegal hexadecimal digit '%c' ignored", *s);
@@ -3124,7 +3109,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 	    register UV xuv = ruv << 4;
 
 	    if ((xuv >> 4) != ruv) {
-		dTHR;
 		overflowed = TRUE;
 		rnv = (NV) ruv;
 		if (ckWARN_d(WARN_OVERFLOW))
@@ -3152,7 +3136,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 	|| (!overflowed && ruv > 0xffffffff  )
 #endif
 	) {
-	dTHR;
 	if (ckWARN(WARN_PORTABLE))
 	    Perl_warner(aTHX_ WARN_PORTABLE,
 			"Hexadecimal number > 0xffffffff non-portable");
@@ -3164,7 +3147,6 @@ Perl_scan_hex(pTHX_ char *start, STRLEN len, STRLEN *retlen)
 char*
 Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags)
 {
-    dTHR;
     char *xfound = Nullch;
     char *xfailed = Nullch;
     char tmpbuf[MAXPATHLEN];
@@ -3976,7 +3958,15 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
 	name = SvPVX(sv);
     }
 
-    if (name && *name) {
+    if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
+	if (name && *name)
+	    Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for %sput",
+			name, 
+			(op == OP_phoney_INPUT_ONLY ? "in" : "out"));
+	else
+	    Perl_warner(aTHX_ WARN_IO, "Filehandle opened only for %sput",
+			(op == OP_phoney_INPUT_ONLY ? "in" : "out"));
+    } else if (name && *name) {
 	Perl_warner(aTHX_ warn_type,
 		    "%s%s on %s %s %s", func, pars, vile, type, name);
 	if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
diff --git a/vmesa/vmesa.c b/vmesa/vmesa.c
index 0e4ad86682..8bc733b5b7 100644
--- a/vmesa/vmesa.c
+++ b/vmesa/vmesa.c
@@ -121,7 +121,6 @@ do_aspawn(SV* really, SV **mark, SV **sp)
     status = FAIL;
     if (sp > mark)
     {
-       dTHR;
        New(401,PL_Argv, sp - mark + 1, char*);
        a = PL_Argv;
        while (++mark <= sp)
@@ -286,7 +285,6 @@ do_spawn(char *cmd, int execf)
                     (const char **) environ);
        if (pid < 0)
        {
-          dTHR;
           status = FAIL;
           if (ckWARN(WARN_EXEC))
              warner(WARN_EXEC,"Can't exec \"%s\": %s",
diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs
index 22d9a7262c..d82b17dbfa 100644
--- a/vms/ext/Stdio/Stdio.xs
+++ b/vms/ext/Stdio/Stdio.xs
@@ -87,7 +87,6 @@ newFH(FILE *fp, char type) {
     HV *stash;
     IO *io;
 
-    dTHR;
     /* Find stash for VMS::Stdio.  We don't do this once at boot
      * to allow for possibility of threaded Perl with per-thread
      * symbol tables.  This code (through io = ...) is really
diff --git a/win32/win32.c b/win32/win32.c
index ed12430497..924ee92a7e 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -581,7 +581,6 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     }
     else {
 	if (status < 0) {
-    	    dTHR;
 	    if (ckWARN(WARN_EXEC))
 		Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno));
 	    status = 255 * 256;
@@ -674,7 +673,6 @@ do_spawn2(char *cmd, int exectype)
     }
     else {
 	if (status < 0) {
-    	    dTHR;
 	    if (ckWARN(WARN_EXEC))
 		Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s",
 		     (exectype == EXECF_EXEC ? "exec" : "spawn"),
@@ -1875,7 +1873,6 @@ win32_crypt(const char *txt, const char *salt)
 {
     dTHXo;
 #ifdef HAVE_DES_FCRYPT
-    dTHR;
     return des_fcrypt(txt, salt, w32_crypt_buffer);
 #else
     Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
@@ -2353,7 +2350,7 @@ win32_fstat(int fd,struct stat *sbufptr)
     }
     return rc;
 #else
-    return fstat(fd,sbufptr);
+    return my_fstat(fd,sbufptr);
 #endif
 }
 
diff --git a/win32/win32.h b/win32/win32.h
index 1640564a65..1040ef1c1a 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -344,6 +344,7 @@ DllExport void		win32_get_child_IO(child_IO_table* ptr);
 extern FILE *		my_fdopen(int, char *);
 #endif
 extern int		my_fclose(FILE *);
+extern int		my_fstat(int fd, struct stat *sbufptr);
 extern int		do_aspawn(void *really, void **mark, void **sp);
 extern int		do_spawn(char *cmd);
 extern int		do_spawn_nowait(char *cmd);
diff --git a/win32/win32sck.c b/win32/win32sck.c
index b83e0d98f1..d169db6d9e 100644
--- a/win32/win32sck.c
+++ b/win32/win32sck.c
@@ -485,6 +485,41 @@ my_fclose (FILE *pf)
     return fclose(pf);
 }
 
+#undef fstat
+int
+my_fstat(int fd, struct stat *sbufptr)
+{
+    /* This fixes a bug in fstat() on Windows 9x.  fstat() uses the
+     * GetFileType() win32 syscall, which will fail on Windows 9x.
+     * So if we recognize a socket on Windows 9x, we return the
+     * same results as on Windows NT/2000.
+     * XXX this should be extended further to set S_IFSOCK on
+     * sbufptr->st_mode.
+     */
+    int osf;
+    if (!wsock_started || IsWinNT())
+	return fstat(fd, sbufptr);
+
+    osf = TO_SOCKET(fd);
+    if (osf != -1) {
+	char sockbuf[256];
+	int optlen = sizeof(sockbuf);
+	int retval;
+
+	retval = getsockopt((SOCKET)osf, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
+	if (retval != SOCKET_ERROR || WSAGetLastError() != WSAENOTSOCK) {
+	    sbufptr->st_mode = _S_IFIFO;
+	    sbufptr->st_rdev = sbufptr->st_dev = (dev_t)fd;
+	    sbufptr->st_nlink = 1;
+	    sbufptr->st_uid = sbufptr->st_gid = sbufptr->st_ino = 0;
+	    sbufptr->st_atime = sbufptr->st_mtime = sbufptr->st_ctime = 0;
+	    sbufptr->st_size = (off_t)0;
+	    return 0;
+	}
+    }
+    return fstat(fd, sbufptr);
+}
+
 struct hostent *
 win32_gethostbyaddr(const char *addr, int len, int type)
 {