Half way through moving per-thread magicals into per-thread fields

and the associated new OP_SPECIFIC and find_thread_magical stuff.
perl will compile but plenty of the magicals are still broken.

p4raw-id: //depot/perl@195

23 files changed, 443 insertions, 151 deletions

diff --git a/doop.c b/doop.c
index 3f8bd10a94..0be09acfc9 100644
--- a/doop.c
+++ b/doop.c
@@ -257,6 +257,7 @@ I32
 do_chomp(sv)
 register SV *sv;
 {
+    dTHR;
     register I32 count;
     STRLEN len;
     char *s;
@@ -334,6 +335,7 @@ SV *sv;
 SV *left;
 SV *right;
 {
+    dTHR;	/* just for taint */
 #ifdef LIBERAL
     register long *dl;
     register long *ll;
diff --git a/embed.h b/embed.h
index 5f3b76542c..ee5feeae81 100644
--- a/embed.h
+++ b/embed.h
@@ -282,12 +282,15 @@
 #define inc_amg			Perl_inc_amg
 #define ingroup			Perl_ingroup
 #define init_stacks		Perl_init_stacks
+#define init_thread_intern	Perl_init_thread_intern
 #define instr			Perl_instr
 #define intro_my		Perl_intro_my
 #define intuit_more		Perl_intuit_more
 #define invert			Perl_invert
 #define io_close		Perl_io_close
 #define jmaybe			Perl_jmaybe
+#define key_create		Perl_key_create
+#define key_destroy		Perl_key_destroy
 #define keyword			Perl_keyword
 #define know_next		Perl_know_next
 #define last_lop		Perl_last_lop
@@ -458,6 +461,7 @@
 #define newWHILEOP		Perl_newWHILEOP
 #define newXS			Perl_newXS
 #define newXSUB			Perl_newXSUB
+#define new_struct_thread	Perl_new_struct_thread
 #define nextargv		Perl_nextargv
 #define nexttoke		Perl_nexttoke
 #define nexttype		Perl_nexttype
@@ -479,6 +483,7 @@
 #define nomemok			Perl_nomemok
 #define nomethod_amg		Perl_nomethod_amg
 #define not_amg			Perl_not_amg
+#define nthreads		Perl_nthreads
 #define numer_amg		Perl_numer_amg
 #define numeric_local		Perl_numeric_local
 #define numeric_name		Perl_numeric_name
@@ -510,6 +515,7 @@
 #define padix			Perl_padix
 #define patleave		Perl_patleave
 #define peep			Perl_peep
+#define per_thread_magicals	Perl_per_thread_magicals
 #define pidgone			Perl_pidgone
 #define pidstatus		Perl_pidstatus
 #define pmflag			Perl_pmflag
@@ -1090,6 +1096,7 @@
 #define taint_env		Perl_taint_env
 #define taint_proper		Perl_taint_proper
 #define thisexpr		Perl_thisexpr
+#define thr_key			Perl_thr_key
 #define timesbuf		Perl_timesbuf
 #define tokenbuf		Perl_tokenbuf
 #define too_few_arguments	Perl_too_few_arguments
@@ -1258,7 +1265,8 @@
 #define e_tmpname		(curinterp->Ie_tmpname)
 #define endav			(curinterp->Iendav)
 #define envgv			(curinterp->Ienvgv)
-#define errgv			(curinterp->Ierrgv)
+#define errhv			(curinterp->Ierrhv)
+#define errsv			(curinterp->Ierrsv)
 #define eval_root		(curinterp->Ieval_root)
 #define eval_start		(curinterp->Ieval_start)
 #define fdpid			(curinterp->Ifdpid)
@@ -1272,6 +1280,8 @@
 #define incgv			(curinterp->Iincgv)
 #define initav			(curinterp->Iinitav)
 #define inplace			(curinterp->Iinplace)
+#define keys			(curinterp->Ikeys)
+#define keys_mutex		(curinterp->Ikeys_mutex)
 #define last_in_gv		(curinterp->Ilast_in_gv)
 #define lastfd			(curinterp->Ilastfd)
 #define lastretstr		(curinterp->Ilastretstr)
@@ -1284,6 +1294,7 @@
 #define lineary			(curinterp->Ilineary)
 #define localizing		(curinterp->Ilocalizing)
 #define localpatches		(curinterp->Ilocalpatches)
+#define magical_keys		(curinterp->Imagical_keys)
 #define main_cv			(curinterp->Imain_cv)
 #define main_root		(curinterp->Imain_root)
 #define main_start		(curinterp->Imain_start)
@@ -1410,7 +1421,8 @@
 #define Ie_tmpname		e_tmpname
 #define Iendav			endav
 #define Ienvgv			envgv
-#define Ierrgv			errgv
+#define Ierrhv			errhv
+#define Ierrsv			errsv
 #define Ieval_root		eval_root
 #define Ieval_start		eval_start
 #define Ifdpid			fdpid
@@ -1424,6 +1436,8 @@
 #define Iincgv			incgv
 #define Iinitav			initav
 #define Iinplace		inplace
+#define Ikeys			keys
+#define Ikeys_mutex		keys_mutex
 #define Ilast_in_gv		last_in_gv
 #define Ilastfd			lastfd
 #define Ilastretstr		lastretstr
@@ -1436,6 +1450,7 @@
 #define Ilineary		lineary
 #define Ilocalizing		localizing
 #define Ilocalpatches		localpatches
+#define Imagical_keys		magical_keys
 #define Imain_cv		main_cv
 #define Imain_root		main_root
 #define Imain_start		main_start
@@ -1571,7 +1586,8 @@
 #define e_fp			Perl_e_fp
 #define e_tmpname		Perl_e_tmpname
 #define endav			Perl_endav
-#define errgv			Perl_errgv
+#define errhv			Perl_errhv
+#define errsv			Perl_errsv
 #define eval_root		Perl_eval_root
 #define eval_start		Perl_eval_start
 #define fdpid			Perl_fdpid
@@ -1585,6 +1601,8 @@
 #define incgv			Perl_incgv
 #define initav			Perl_initav
 #define inplace			Perl_inplace
+#define keys			Perl_keys
+#define keys_mutex		Perl_keys_mutex
 #define last_in_gv		Perl_last_in_gv
 #define lastfd			Perl_lastfd
 #define lastretstr		Perl_lastretstr
@@ -1597,6 +1615,7 @@
 #define lineary			Perl_lineary
 #define localizing		Perl_localizing
 #define localpatches		Perl_localpatches
+#define magical_keys		Perl_magical_keys
 #define main_cv			Perl_main_cv
 #define main_root		Perl_main_root
 #define main_start		Perl_main_start
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 7d309b6a2e..a6386176ff 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -204,38 +204,9 @@ char *class;
 #endif
     
     savethread = thr;
-    sv = newSVpv("", 0);
-    SvGROW(sv, sizeof(struct thread) + 1);
-    SvCUR_set(sv, sizeof(struct thread));
-    thr = (Thread) SvPVX(sv);
-    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: newthread(%s) = %p)\n",
-			  savethread, SvPEEK(startsv), thr));
-    oursv = sv; 
-    /* If we don't zero these foostack pointers, init_stacks won't init them */
-    markstack = 0;
-    scopestack = 0;
-    savestack = 0;
-    retstack = 0;
+    thr = new_struct_thread(thr);
     init_stacks(ARGS);
-    curcop = savethread->Tcurcop;	/* XXX As good a guess as any? */
     SPAGAIN;
-    defstash = savethread->Tdefstash;	/* XXX maybe these should */
-    curstash = savethread->Tcurstash;	/* always be set to main? */
-    /* top_env? */
-    /* runlevel */
-    cvcache = newHV();
-    thr->flags = THRf_R_JOINABLE;
-    MUTEX_INIT(&thr->mutex);
-    thr->tid = ++threadnum;
-    /* Insert new thread into the circular linked list and bump nthreads */
-    MUTEX_LOCK(&threads_mutex);
-    thr->next = savethread->next;
-    thr->prev = savethread;
-    savethread->next = thr;
-    thr->next->prev = thr;
-    nthreads++;
-    MUTEX_UNLOCK(&threads_mutex);
-
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 			  "%p: newthread, tid is %u, preparing stack\n",
 			  savethread, thr->tid));
diff --git a/global.sym b/global.sym
index 549a754b59..2ea71b231f 100644
--- a/global.sym
+++ b/global.sym
@@ -74,6 +74,8 @@ in_my
 in_my_stash
 inc_amg
 io_close
+key_create
+key_destroy
 know_next
 last_lop
 last_lop_op
@@ -118,6 +120,7 @@ na
 ncmp_amg
 ne_amg
 neg_amg
+new_struct_thread
 nexttoke
 nexttype
 nextval
@@ -160,6 +163,7 @@ pad_reset_pending
 padix
 padix_floor
 patleave
+per_thread_magicals
 pidstatus
 pow_amg
 pow_ass_amg
@@ -953,6 +957,7 @@ pp_snetent
 pp_socket
 pp_sockpair
 pp_sort
+pp_specific
 pp_splice
 pp_split
 pp_sprintf
diff --git a/gv.c b/gv.c
index 16f16ae978..857e19c221 100644
--- a/gv.c
+++ b/gv.c
@@ -234,7 +234,6 @@ I32 level;
 		    (cv = GvCV(gv)) &&
 		    (CvROOT(cv) || CvXSUB(cv)))
 		{
-		    dTHR;	/* just for SvREFCNT_inc */
 		    if (cv = GvCV(topgv))
 			SvREFCNT_dec(cv);
 		    GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
diff --git a/hv.c b/hv.c
index 50ff060e36..15d6c624de 100644
--- a/hv.c
+++ b/hv.c
@@ -316,6 +316,7 @@ register U32 hash;
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
+	dTHR;
 	bool save_taint = tainted;
 	if (tainting)
 	    tainted = SvTAINTED(keysv);
@@ -925,7 +926,6 @@ HV *hv;
 	}
 	magic_nextpack((SV*) hv,mg,key);
         if (SvOK(key)) {
-	    dTHR;		/* just for SvREFCNT_inc */
 	    /* force key to stay around until next time */
 	    HeSVKEY_set(entry, SvREFCNT_inc(key));
 	    return entry;		/* beware, hent_val is not set */
diff --git a/interp.sym b/interp.sym
index 1583ea217e..d64093eaea 100644
--- a/interp.sym
+++ b/interp.sym
@@ -47,7 +47,8 @@ e_fp
 e_tmpname
 endav
 envgv
-errgv
+errhv
+errsv
 eval_root
 eval_start
 fdpid
@@ -61,6 +62,8 @@ in_eval
 incgv
 initav
 inplace
+keys
+keys_mutex
 last_in_gv
 lastfd
 lastretstr
@@ -73,6 +76,7 @@ leftgv
 lineary
 localizing
 localpatches
+magical_keys
 main_cv
 main_root
 main_start
diff --git a/mg.c b/mg.c
index 7f49f68aa0..47e05a1176 100644
--- a/mg.c
+++ b/mg.c
@@ -264,6 +264,7 @@ magic_len(sv, mg)
 SV *sv;
 MAGIC *mg;
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -329,6 +330,7 @@ magic_get(sv, mg)
 SV *sv;
 MAGIC *mg;
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -415,7 +417,11 @@ MAGIC *mg;
     case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9': case '&':
 	if (curpm && (rx = curpm->op_pmregexp)) {
-	    paren = atoi(GvENAME((GV*)mg->mg_obj));
+	    /*
+	     * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
+	     * XXX Does the new way break anything?
+	     */
+	    paren = atoi(mg->mg_ptr);
 	  getparen:
 	    if (paren <= rx->nparens &&
 		(s = rx->startp[paren]) &&
@@ -572,6 +578,11 @@ MAGIC *mg;
 	break;
     case '0':
 	break;
+#ifdef USE_THREADS
+    case '@':
+	sv_setsv(sv, errsv);
+	break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
@@ -749,7 +760,6 @@ MAGIC* mg;
     	if(psig_ptr[i])
     	    sv_setsv(sv,psig_ptr[i]);
     	else {
-	    dTHR;		/* just for SvREFCNT_inc */
     	    Sighandler_t sigstate = rsignal_state(i);
 
     	    /* cache state so we don't fetch it again */
@@ -1177,6 +1187,7 @@ magic_gettaint(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     TAINT_IF((mg->mg_len & 1) ||
 	     (mg->mg_len & 2) && mg->mg_obj == sv);	/* kludge */
     return 0;
@@ -1706,6 +1717,11 @@ MAGIC* mg;
 		origargv[i] = Nullch;
 	}
 	break;
+#ifdef USE_THREADS
+    case '@':
+	sv_setsv(errsv, sv);
+	break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
diff --git a/op.c b/op.c
index e7d843dac8..71f6689885 100644
--- a/op.c
+++ b/op.c
@@ -247,7 +247,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
 			    warn("Variable \"%s\" will not stay shared", name);
 		    }
 		}
-		av_store(comppad, newoff, SvREFCNT_inc(oldsv));
+		av_store(comppad, newoff, oldsv ? SvREFCNT_inc(oldsv) : 0);
 		return newoff;
 	    }
 	}
@@ -511,6 +511,33 @@ pad_reset()
     pad_reset_pending = FALSE;
 }
 
+#ifdef USE_THREADS
+PADOFFSET
+find_thread_magical(name)
+char *name;
+{
+    dTHR;
+    char *p;
+    PADOFFSET key;
+    /* We currently only handle single character magicals */
+    p = strchr(per_thread_magicals, *name);
+    if (!p)
+	return NOT_IN_PAD;
+    key = magical_keys[p - per_thread_magicals];
+    if (key == NOT_IN_PAD) {
+	SV *sv;
+	key = magical_keys[p - per_thread_magicals] = key_create();
+	sv = NEWSV(0, 0);
+	av_store(thr->specific, key, sv);
+	sv_magic(sv, 0, 0, name, 1); 
+	DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			      "find_thread_magical: key %d new SV %p for %d\n",
+			      (int)key, sv, (int)*name));
+    }
+    return key;
+}
+#endif /* USE_THREADS */
+
 /* Destructor */
 
 void
@@ -1152,6 +1179,7 @@ I32 type;
 	    goto nomod;
 	/* FALL THROUGH */
     case OP_PADSV:
+    case OP_SPECIFIC:
 	modcount++;
 	if (!type)
 	    croak("Can't localize lexical variable %s",
@@ -1314,6 +1342,10 @@ I32 type;
 	}
 	break;
       
+    case OP_SPECIFIC:
+	o->op_flags |= OPf_MOD;		/* XXX ??? */
+	break;
+
     case OP_RV2AV:
     case OP_RV2HV:
 	o->op_flags |= OPf_REF; 
@@ -2150,7 +2182,8 @@ OP *repl;
 		    else if (curop->op_type == OP_PADSV ||
 			     curop->op_type == OP_PADAV ||
 			     curop->op_type == OP_PADHV ||
-			     curop->op_type == OP_PADANY) {
+			     curop->op_type == OP_PADANY ||
+			     curop->op_type == OP_SPECIFIC) {
 			     /* is okay */
 		    }
 		    else
@@ -3410,8 +3443,8 @@ OP *block;
 		    croak(not_safe);
 		else {
 		    /* force display of errors found but not reported */
-		    sv_catpv(GvSV(errgv), not_safe);
-		    croak("%s", SvPVx(GvSV(errgv), na));
+		    sv_catpv(errsv, not_safe);
+		    croak("%s", SvPV(errsv, na));
 		}
 	    }
 	}
@@ -3814,6 +3847,8 @@ OP *o;
 	o->op_ppaddr = ppaddr[OP_PADSV];
 	return o;
     }
+    else if (o->op_type == OP_SPECIFIC)
+	return o;
     return newUNOP(OP_RV2SV, 0, scalar(o));
 }
 
diff --git a/opcode.h b/opcode.h
index 3f2a5c290b..936831bada 100644
--- a/opcode.h
+++ b/opcode.h
@@ -349,10 +349,11 @@ typedef enum {
 	OP_GETLOGIN,	/* 342 */
 	OP_SYSCALL,	/* 343 */
 	OP_LOCK,	/* 344 */
+	OP_SPECIFIC,	/* 345 */
 	OP_max		
 } opcode;
 
-#define MAXO 345
+#define MAXO 346
 
 #ifndef DOINIT
 EXT char *op_name[];
@@ -703,6 +704,7 @@ EXT char *op_name[] = {
 	"getlogin",
 	"syscall",
 	"lock",
+	"specific",
 };
 #endif
 
@@ -1055,6 +1057,7 @@ EXT char *op_desc[] = {
 	"getlogin",
 	"syscall",
 	"lock",
+	"thread-specific",
 };
 #endif
 
@@ -1436,6 +1439,7 @@ OP *	pp_egrent	_((ARGSproto));
 OP *	pp_getlogin	_((ARGSproto));
 OP *	pp_syscall	_((ARGSproto));
 OP *	pp_lock		_((ARGSproto));
+OP *	pp_specific	_((ARGSproto));
 
 #ifndef DOINIT
 EXT OP * (*ppaddr[])();
@@ -1786,6 +1790,7 @@ EXT OP * (*ppaddr[])() = {
 	pp_getlogin,
 	pp_syscall,
 	pp_lock,
+	pp_specific,
 };
 #endif
 
@@ -2138,6 +2143,7 @@ EXT OP * (*check[]) _((OP *op)) = {
 	ck_null,	/* getlogin */
 	ck_fun,		/* syscall */
 	ck_rfun,	/* lock */
+	ck_null,	/* specific */
 };
 #endif
 
@@ -2490,5 +2496,6 @@ EXT U32 opargs[] = {
 	0x0000000c,	/* getlogin */
 	0x0002151d,	/* syscall */
 	0x00001c04,	/* lock */
+	0x00000044,	/* specific */
 };
 #endif
diff --git a/opcode.pl b/opcode.pl
index 1ef36f2fad..a97e987546 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -180,8 +180,6 @@ for (@ops) {
     $argsum |= 128 if $flags =~ /u/;		# defaults to $_
 
     $flags =~ /([^a-zA-Z])/ or die qq[Opcode "$_" has no class indicator];
-    printf STDERR "op $_, class $1 => 0x%x, argsum 0x%x",
-	$opclass{$1}, $argsum; # debug
     $argsum |= $opclass{$1} << 8;
     $mul = 4096;				# 2 ^ OASHIFT
     for $arg (split(' ',$args{$_})) {
@@ -190,7 +188,6 @@ for (@ops) {
 	$argsum += $argnum * $mul;
 	$mul <<= 4;
     }
-    printf STDERR ", argsum now 0x%x\n", $argsum; # debug
     $argsum = sprintf("0x%08x", $argsum);
     print "\t", &tab(3, "$argsum,"), "/* $_ */\n";
 }
@@ -680,3 +677,4 @@ syscall		syscall			ck_fun		imst@	S L
 
 # For multi-threading
 lock		lock			ck_rfun		s%	S
+specific	thread-specific		ck_null		ds0
diff --git a/perl.c b/perl.c
index a1dd4e5ce6..17403fb92b 100644
--- a/perl.c
+++ b/perl.c
@@ -107,9 +107,12 @@ void
 perl_construct( sv_interp )
 register PerlInterpreter *sv_interp;
 {
-#if defined(USE_THREADS) && !defined(FAKE_THREADS)
+#ifdef USE_THREADS
+    int i;
+#ifndef FAKE_THREADS
     struct thread *thr;
-#endif
+#endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
     
     if (!(curinterp = sv_interp))
 	return;
@@ -121,45 +124,23 @@ register PerlInterpreter *sv_interp;
    /* Init the real globals (and main thread)? */
     if (!linestr) {
 #ifdef USE_THREADS
-	XPV *xpv;
 
     	INIT_THREADS;
-	Newz(53, thr, 1, struct thread);
+	if (pthread_key_create(&thr_key, 0))
+	    croak("panic: pthread_key_create");
 	MUTEX_INIT(&malloc_mutex);
 	MUTEX_INIT(&sv_mutex);
-	/* Safe to use SVs from now on */
+	/*
+	 * Safe to use basic SV functions from now on (though
+	 * not things like mortals or tainting yet).
+	 */
 	MUTEX_INIT(&eval_mutex);
 	COND_INIT(&eval_cond);
 	MUTEX_INIT(&threads_mutex);
 	COND_INIT(&nthreads_cond);
-	nthreads = 1;
-	cvcache = newHV();
-	curcop = &compiling;
-	thr->flags = THRf_R_JOINABLE;
-	MUTEX_INIT(&thr->mutex);
-	thr->next = thr;
-	thr->prev = thr;
-	thr->tid = 0;
-
-	/* Handcraft thrsv similarly to mess_sv */
-    	New(53, thrsv, 1, SV);
-	Newz(53, xpv, 1, XPV);
-	SvFLAGS(thrsv) = SVt_PV;
-	SvANY(thrsv) = (void*)xpv;
-	SvREFCNT(thrsv) = 1 << 30;	/* practically infinite */
-	SvPVX(thrsv) = (char*)thr;
-	SvCUR_set(thrsv, sizeof(thr));
-	SvLEN_set(thrsv, sizeof(thr));
-	*SvEND(thrsv) = '\0';		/* in the trailing_nul field */
-	oursv = thrsv;
-#ifdef HAVE_THREAD_INTERN
-	init_thread_intern(thr);
-#else
-	thr->self = pthread_self();
-	if (pthread_key_create(&thr_key, 0))
-	    croak("panic: pthread_key_create");
-#endif /* HAVE_THREAD_INTERN */
-	SET_THR(thr);
+	MUTEX_INIT(&keys_mutex);
+	
+	thr = new_struct_thread(0);
 #endif /* USE_THREADS */
 
 	linestr = NEWSV(65,80);
@@ -229,6 +210,9 @@ register PerlInterpreter *sv_interp;
 
     fdpid = newAV();	/* for remembering popen pids by fd */
 
+    for (i = 0; i < N_PER_THREAD_MAGICALS; i++)
+	magical_keys[i] = NOT_IN_PAD;
+    keys = newSVpv("", 0);
     init_stacks(ARGS);
     DEBUG( {
 	New(51,debname,128,char);
@@ -487,7 +471,8 @@ register PerlInterpreter *sv_interp;
     envgv = Nullgv;
     siggv = Nullgv;
     incgv = Nullgv;
-    errgv = Nullgv;
+    errhv = Nullhv;
+    errsv = Nullsv;
     argvgv = Nullgv;
     argvoutgv = Nullgv;
     stdingv = Nullgv;
@@ -987,8 +972,11 @@ print \"  \\@INC:\\n    @INC\\n\";");
     /* now that script is parsed, we can modify record separator */
     SvREFCNT_dec(rs);
     rs = SvREFCNT_inc(nrs);
+#ifdef USE_THREADS
+    sv_setsv(*av_fetch(thr->specific, find_thread_magical("/"), TRUE), rs); 
+#else
     sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
-
+#endif /* USE_THREADS */
     if (do_undump)
 	my_unexec();
 
@@ -1260,7 +1248,7 @@ I32 flags;		/* See G_* flags in cop.h */
 	    if (flags & G_KEEPERR)
 		in_eval |= 4;
 	    else
-		sv_setpv(GvSV(errgv),"");
+		sv_setpv(errsv,"");
 	}
 	markstack_ptr++;
 
@@ -1305,7 +1293,7 @@ I32 flags;		/* See G_* flags in cop.h */
 	runops();
     retval = stack_sp - (stack_base + oldmark);
     if ((flags & G_EVAL) && !(flags & G_KEEPERR))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
 
   cleanup:
     if (flags & G_EVAL) {
@@ -1414,7 +1402,7 @@ I32 flags;		/* See G_* flags in cop.h */
 	runops();
     retval = stack_sp - (stack_base + oldmark);
     if (!(flags & G_KEEPERR))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
 
   cleanup:
     JMPENV_POP;
@@ -1445,8 +1433,8 @@ I32 croak_on_error;
     sv = POPs;
     PUTBACK;
 
-    if (croak_on_error && SvTRUE(GvSV(errgv)))
-	croak(SvPVx(GvSV(errgv), na));
+    if (croak_on_error && SvTRUE(errsv))
+	croak(SvPV(errsv, na));
 
     return sv;
 }
@@ -1528,6 +1516,8 @@ char *s;
 
     switch (*s) {
     case '0':
+    {
+	dTHR;
 	rschar = scan_oct(s, 4, &numlen);
 	SvREFCNT_dec(nrs);
 	if (rschar & ~((U8)~0))
@@ -1539,6 +1529,7 @@ char *s;
 	    nrs = newSVpv(&ch, 1);
 	}
 	return s + numlen;
+    }
     case 'F':
 	minus_F = TRUE;
 	splitstr = savepv(s + 1);
@@ -1625,6 +1616,7 @@ char *s;
 	    s += numlen;
 	}
 	else {
+	    dTHR;
 	    if (RsPARA(nrs)) {
 		ors = "\n\n";
 		orslen = 2;
@@ -1813,11 +1805,11 @@ init_main_stash()
     incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(incgv);
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
-    errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
-    GvMULTI_on(errgv);
+    errsv = newSVpv("", 0);
+    errhv = newHV();
     (void)form("%240s","");	/* Preallocate temp - for immediate signals. */
-    sv_grow(GvSV(errgv), 240);	/* Preallocate - for immediate signals. */
-    sv_setpvn(GvSV(errgv), "", 0);
+    sv_grow(errsv, 240);	/* Preallocate - for immediate signals. */
+    sv_setpvn(errsv, "", 0);
     curstash = defstash;
     compiling.cop_stash = defstash;
     debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
@@ -2553,7 +2545,11 @@ init_predump_symbols()
     GV *tmpgv;
     GV *othergv;
 
+#ifdef USE_THREADS
+    sv_setpvn(*av_fetch(thr->specific,find_thread_magical("\""),TRUE), " ", 1);
+#else
     sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
+#endif /* USE_THREADS */
 
     stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(stdingv);
@@ -2589,6 +2585,7 @@ register int argc;
 register char **argv;
 register char **env;
 {
+    dTHR;
     char *s;
     SV *sv;
     GV* tmpgv;
@@ -2851,7 +2848,7 @@ AV* list;
 	JMPENV_PUSH(ret);
 	switch (ret) {
 	case 0: {
-		SV* atsv = GvSV(errgv);
+		SV* atsv = sv_mortalcopy(errsv);
 		PUSHMARK(stack_sp);
 		perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
 		(void)SvPV(atsv, len);
@@ -2913,8 +2910,8 @@ U32 status;
     dTHR;
 
 #ifdef USE_THREADS
-    DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread 0x%lx, status %lu\n",
-			 (unsigned long) thr, (unsigned long) status));
+    DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
+			  thr, (unsigned long) status));
 #endif /* USE_THREADS */
     switch (status) {
     case 0:
diff --git a/perl.h b/perl.h
index c8a33a0ab1..507fbe8cd1 100644
--- a/perl.h
+++ b/perl.h
@@ -1338,6 +1338,9 @@ int runops_standard _((void));
 int runops_debug _((void));
 #endif
 
+#define PER_THREAD_MAGICALS "123456789&`'+/.,\\\";^-%=|~:\001\005!@"
+#define N_PER_THREAD_MAGICALS 30
+
 /****************/
 /* Truly global */
 /****************/
@@ -1354,6 +1357,7 @@ EXT struct thread *	eval_owner;	/* Owner thread for doeval */
 EXT int			nthreads;	/* Number of threads currently */
 EXT perl_mutex		threads_mutex;	/* Mutex for nthreads and thread list */
 EXT perl_cond		nthreads_cond;	/* Condition variable for nthreads */
+EXT char *		per_thread_magicals INIT(PER_THREAD_MAGICALS);
 #ifdef FAKE_THREADS
 EXT struct thread *	thr;		/* Currently executing (fake) thread */
 #endif
@@ -1856,7 +1860,8 @@ IEXT I32	Imaxscream IINIT(-1);
 IEXT SV *	Ilastscream;
 
 /* shortcuts to misc objects */
-IEXT GV *	Ierrgv;
+IEXT HV *	Ierrhv;
+IEXT SV *	Ierrsv;
 
 /* shortcuts to debugging objects */
 IEXT GV *	IDBgv;
@@ -1965,6 +1970,10 @@ IEXT SV *	Imess_sv;
 #ifdef USE_THREADS
 /* threads stuff */
 IEXT SV *	Ithrsv;		/* holds struct thread for main thread */
+IEXT perl_mutex	Ikeys_mutex;	/* protects keys and magical_keys */
+IEXT SV *	Ikeys;		/* each char marks a per-thread key in-use */
+IEXT PADOFFSET	Imagical_keys[N_PER_THREAD_MAGICALS];
+				/* index is position in per_thread_magicals */
 #endif /* USE_THREADS */
 
 #undef IEXT
diff --git a/pp.c b/pp.c
index 649506fa89..981e4889e2 100644
--- a/pp.c
+++ b/pp.c
@@ -396,7 +396,6 @@ SV* sv;
     else if (SvPADTMP(sv))
 	sv = newSVsv(sv);
     else {
-	dTHR;			/* just for SvREFCNT_inc */
 	SvTEMP_off(sv);
 	(void)SvREFCNT_inc(sv);
     }
@@ -4296,3 +4295,15 @@ PP(pp_lock)
     SETs(retsv);
     RETURN;
 }
+
+PP(pp_specific)
+{
+#ifdef USE_THREADS
+    dSP;
+    SV **svp = av_fetch(thr->specific, op->op_targ, TRUE);
+    XPUSHs(svp ? *svp : &sv_undef);
+#else
+    DIE("tried to access thread-specific data in non-threaded perl");
+#endif /* USE_THREADS */
+    RETURN;
+}
diff --git a/pp_ctl.c b/pp_ctl.c
index d14fa4b502..532fda3910 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1040,21 +1040,21 @@ char *message;
 	    SV **svp;
 	    STRLEN klen = strlen(message);
 	    
-	    svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
+	    svp = hv_fetch(errhv, message, klen, TRUE);
 	    if (svp) {
 		if (!SvIOK(*svp)) {
 		    static char prefix[] = "\t(in cleanup) ";
 		    sv_upgrade(*svp, SVt_IV);
 		    (void)SvIOK_only(*svp);
-		    SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
-		    sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
-		    sv_catpvn(GvSV(errgv), message, klen);
+		    SvGROW(errsv, SvCUR(errsv)+sizeof(prefix)+klen);
+		    sv_catpvn(errsv, prefix, sizeof(prefix)-1);
+		    sv_catpvn(errsv, message, klen);
 		}
 		sv_inc(*svp);
 	    }
 	}
 	else
-	    sv_setpv(GvSV(errgv), message);
+	    sv_setpv(errsv, message);
 	
 	cxix = dopoptoeval(cxstack_ix);
 	if (cxix >= 0) {
@@ -1077,7 +1077,7 @@ char *message;
 	    LEAVE;
 
 	    if (optype == OP_REQUIRE) {
-		char* msg = SvPVx(GvSV(errgv), na);
+		char* msg = SvPV(errsv, na);
 		DIE("%s", *msg ? msg : "Compilation failed in require");
 	    }
 	    return pop_return();
@@ -2186,7 +2186,7 @@ int gimme;
     CvPADLIST(compcv) = comppadlist;
 
     if (saveop->op_type != OP_REQUIRE)
-	CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller);
+	CvOUTSIDE(compcv) = caller ? (CV*)SvREFCNT_inc(caller) : 0;
 
     SAVEFREESV(compcv);
 
@@ -2212,7 +2212,7 @@ int gimme;
     if (saveop->op_flags & OPf_SPECIAL)
 	in_eval |= 4;
     else
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
     if (yyparse() || error_count || !eval_root) {
 	SV **newsp;
 	I32 gimme;
@@ -2231,7 +2231,7 @@ int gimme;
 	lex_end();
 	LEAVE;
 	if (optype == OP_REQUIRE) {
-	    char* msg = SvPVx(GvSV(errgv), na);
+	    char* msg = SvPV(errsv, na);
 	    DIE("%s", *msg ? msg : "Compilation failed in require");
 	}
 	SvREFCNT_dec(rs);
@@ -2585,7 +2585,7 @@ PP(pp_leaveeval)
     LEAVE;
 
     if (!(save_flags & OPf_SPECIAL))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
 
     RETURNOP(retop);
 }
@@ -2605,7 +2605,7 @@ PP(pp_entertry)
     eval_root = op;		/* Only needed so that goto works right. */
 
     in_eval = 1;
-    sv_setpv(GvSV(errgv),"");
+    sv_setpv(errsv,"");
     PUTBACK;
     return DOCATCH(op->op_next);
 }
@@ -2653,7 +2653,7 @@ PP(pp_leavetry)
     curpm = newpm;	/* Don't pop $1 et al till now */
 
     LEAVE;
-    sv_setpv(GvSV(errgv),"");
+    sv_setpv(errsv,"");
     RETURN;
 }
 
diff --git a/pp_sys.c b/pp_sys.c
index 99abde927b..3f339e9afd 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -278,11 +278,10 @@ PP(pp_warn)
 	tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-	SV *error = GvSV(errgv);
-	(void)SvUPGRADE(error, SVt_PV);
-	if (SvPOK(error) && SvCUR(error))
-	    sv_catpv(error, "\t...caught");
-	tmps = SvPV(error, na);
+	(void)SvUPGRADE(errsv, SVt_PV);
+	if (SvPOK(errsv) && SvCUR(errsv))
+	    sv_catpv(errsv, "\t...caught");
+	tmps = SvPV(errsv, na);
     }
     if (!tmps || !*tmps)
 	tmps = "Warning: something's wrong";
@@ -304,11 +303,10 @@ PP(pp_die)
 	tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-	SV *error = GvSV(errgv);
-	(void)SvUPGRADE(error, SVt_PV);
-	if (SvPOK(error) && SvCUR(error))
-	    sv_catpv(error, "\t...propagated");
-	tmps = SvPV(error, na);
+	(void)SvUPGRADE(errsv, SVt_PV);
+	if (SvPOK(errsv) && SvCUR(errsv))
+	    sv_catpv(errsv, "\t...propagated");
+	tmps = SvPV(errsv, na);
     }
     if (!tmps || !*tmps)
 	tmps = "Died";
diff --git a/proto.h b/proto.h
index 7123beebca..7eddfd9cb2 100644
--- a/proto.h
+++ b/proto.h
@@ -190,6 +190,8 @@ bool	io_close _((IO* io));
 OP*	invert _((OP* cmd));
 OP*	jmaybe _((OP* arg));
 I32	keyword _((char* d, I32 len));
+PADOFFSET	key_create _((void));
+void	key_destroy _((PADOFFSET key));
 void	leave_scope _((I32 base));
 void	lex_end _((void));
 void	lex_start _((SV* line));
@@ -338,6 +340,9 @@ SV*	newSVsv _((SV* old));
 OP*	newUNOP _((I32 type, I32 flags, OP* first));
 OP*	newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop,
 		      I32 whileline, OP* expr, OP* block, OP* cont));
+#ifdef USE_THREADS
+struct thread *	new_struct_thread _((struct thread *t));
+#endif
 PerlIO*	nextargv _((GV* gv));
 char*	ninstr _((char* big, char* bigend, char* little, char* lend));
 OP*	oopsCV _((OP* o));
diff --git a/sv.c b/sv.c
index da4c73d6df..13bad80b02 100644
--- a/sv.c
+++ b/sv.c
@@ -1105,6 +1105,7 @@ sv_setiv(sv,i)
 register SV *sv;
 IV i;
 {
+    dTHR;	/* just for taint */
     sv_check_thinkfirst(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -1156,6 +1157,7 @@ sv_setnv(sv,num)
 register SV *sv;
 double num;
 {
+    dTHR;	/* just for taint */
     sv_check_thinkfirst(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -2186,6 +2188,7 @@ register SV *sv;
 register const char *ptr;
 register STRLEN len;
 {
+    dTHR;	/* just for taint */
     assert(len >= 0);  /* STRLEN is probably unsigned, so this may
 			  elicit a warning, but it won't hurt. */
     sv_check_thinkfirst(sv);
@@ -2212,6 +2215,7 @@ sv_setpv(sv,ptr)
 register SV *sv;
 register const char *ptr;
 {
+    dTHR;	/* just for taint */
     register STRLEN len;
 
     sv_check_thinkfirst(sv);
@@ -2239,6 +2243,7 @@ register SV *sv;
 register char *ptr;
 register STRLEN len;
 {
+    dTHR;	/* just for taint */
     sv_check_thinkfirst(sv);
     if (!SvUPGRADE(sv, SVt_PV))
 	return;
@@ -2303,6 +2308,7 @@ register SV *sv;
 register char *ptr;
 register STRLEN len;
 {
+    dTHR;	/* just for taint */
     STRLEN tlen;
     char *junk;
 
@@ -2335,6 +2341,7 @@ sv_catpv(sv,ptr)
 register SV *sv;
 register char *ptr;
 {
+    dTHR;	/* just for taint */
     register STRLEN len;
     STRLEN tlen;
     char *junk;
@@ -3060,6 +3067,7 @@ register SV *sv;
 register PerlIO *fp;
 I32 append;
 {
+    dTHR;
     char *rsptr;
     STRLEN rslen;
     register STDCHAR rslast;
@@ -3667,6 +3675,7 @@ HV *stash;
 		sv = GvSV(gv);
 		(void)SvOK_off(sv);
 		if (SvTYPE(sv) >= SVt_PV) {
+		    dTHR;	/* just for taint */
 		    SvCUR_set(sv, 0);
 		    if (SvPVX(sv) != Nullch)
 			*SvPVX(sv) = '\0';
@@ -3907,6 +3916,7 @@ STRLEN *lp;
 	    *SvEND(sv) = '\0';
 	}
 	if (!SvPOK(sv)) {
+	    dTHR;	/* just for taint */
 	    SvPOK_on(sv);		/* validate pointer */
 	    SvTAINT(sv);
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
diff --git a/sv.h b/sv.h
index 2694534f78..437f4888fa 100644
--- a/sv.h
+++ b/sv.h
@@ -70,17 +70,20 @@ struct io {
 
 #define SvANY(sv)	(sv)->sv_any
 #define SvFLAGS(sv)	(sv)->sv_flags
-
 #define SvREFCNT(sv)	(sv)->sv_refcnt
-#ifdef CRIPPLED_CC
-#define SvREFCNT_inc(sv)	sv_newref((SV*)sv)
-#define SvREFCNT_dec(sv)	sv_free((SV*)sv)
+
+#ifdef __GNUC__
+#  define SvREFCNT_inc(sv)	({SV *nsv = (SV*)(sv); ++SvREFCNT(nsv); nsv;})
 #else
-#define SvREFCNT_inc(sv)	((Sv = (SV*)(sv)), \
-				    (Sv && ++SvREFCNT(Sv)), (SV*)Sv)
-#define SvREFCNT_dec(sv)	sv_free((SV*)sv)
+#  if defined(CRIPPLED_CC) || defined(USE_THREADS)
+#    define SvREFCNT_inc(sv)	sv_newref((SV*)sv)
+#  else
+#    define SvREFCNT_inc(sv)	((Sv = (SV*)(sv)), ++SvREFCNT(Sv), (SV*)Sv)
+#  endif
 #endif
 
+#define SvREFCNT_dec(sv)	sv_free((SV*)sv)
+
 #define SVTYPEMASK	0xff
 #define SvTYPE(sv)	((sv)->sv_flags & SVTYPEMASK)
 
@@ -544,20 +547,32 @@ I32 SvTRUE _((SV *));
 		? SvNVX(sv) != 0.0				\
 		: sv_2bool(sv) )
 
-#define SvIVx(sv) ((Sv = (sv)), SvIV(Sv))
-#define SvUVx(sv) ((Sv = (sv)), SvUV(Sv))
-#define SvNVx(sv) ((Sv = (sv)), SvNV(Sv))
-#define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp))
+#ifdef __GNUC__
+#  define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); })
+#  define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); })
+#  define SvNVx(sv) ({SV *nsv = (SV*)(sv); SvNV(nsv); })
+#  define SvPVx(sv, lp) ({SV *nsv = (sv); SvPV(nsv, lp); })
+#else
+#  define SvIVx(sv) ((Sv = (sv)), SvIV(Sv))
+#  define SvUVx(sv) ((Sv = (sv)), SvUV(Sv))
+#  define SvNVx(sv) ((Sv = (sv)), SvNV(Sv))
+#  define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp))
+#endif /* __GNUC__ */
+
 #define SvTRUEx(sv) ((Sv = (sv)), SvTRUE(Sv))
 
 #endif /* CRIPPLED_CC */
 
 #define newRV_inc(sv)	newRV(sv)
-#ifdef CRIPPLED_CC
-SV *newRV_noinc _((SV *));
+#ifdef __GNUC__
+#  define newRV_noinc(sv) ({SV *nsv=newRV((sv)); --SvREFCNT(SvRV(nsv)); nsv;})
 #else
-#define newRV_noinc(sv)	((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv)
-#endif
+#  if defined(CRIPPLED_CC) || defined(USE_THREADS)
+SV *newRV_noinc _((SV *));
+#  else
+#    define newRV_noinc(sv)	((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv)
+#  endif
+#endif /* __GNUC__ */
 
 /* the following macro updates any magic values this sv is associated with */
 
diff --git a/taint.c b/taint.c
index 6776272782..af943e0647 100644
--- a/taint.c
+++ b/taint.c
@@ -12,6 +12,7 @@ taint_proper(f, s)
 const char *f;
 char *s;
 {
+    dTHR;	/* just for taint */
     char *ug;
 
     DEBUG_u(PerlIO_printf(Perl_debug_log,
@@ -70,10 +71,12 @@ taint_env()
     svp = hv_fetch(GvHVn(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}");
 	}
@@ -83,6 +86,7 @@ taint_env()
     /* tainted $TERM is okay if it contains no metachars */
     svp = hv_fetch(GvHVn(envgv),"TERM",4,FALSE);
     if (svp && *svp && SvTAINTED(*svp)) {
+    	dTHR;	/* just for taint */
 	bool was_tainted = tainted;
 	char *t = SvPV(*svp, na);
 	char *e = t + na;
@@ -101,6 +105,7 @@ taint_env()
     for (e = misc_env; *e; e++) {
 	svp = hv_fetch(GvHVn(envgv), *e, strlen(*e), FALSE);
 	if (svp && *svp != &sv_undef && SvTAINTED(*svp)) {
+	    dTHR;	/* just for taint */
 	    TAINT;
 	    taint_proper("Insecure $ENV{%s}%s", *e);
 	}
diff --git a/thread.h b/thread.h
index fb6a7c05ce..d8da3ee4b6 100644
--- a/thread.h
+++ b/thread.h
@@ -171,10 +171,25 @@ struct thread {
 
     /* Now the fields that used to be "per interpreter" (even when global) */
 
-    /* XXX What about magic variables such as $/, $? and so on? */
+    /* Fields used by magic variables such as $@, $/ and so on */
+    bool	Ttainted;
+    PMOP *	Tcurpm;
+    SV *	Tnrs;
+    SV *	Trs;
+    GV *	Tlast_in_gv;
+    char *	Tofs;
+    STRLEN	Tofslen;
+    GV *	Tdefoutgv;
+    char *	Tchopset;
+    SV *	Tformtarget;
+    SV *	Tbodytarget;
+    SV *	Ttoptarget;
+
+    /* Stashes */
     HV *	Tdefstash;
     HV *	Tcurstash;
 
+    /* Stacks */
     SV **	Ttmps_stack;
     I32		Ttmps_ix;
     I32		Ttmps_floor;
@@ -202,6 +217,7 @@ struct thread {
     HV *	Tcvcache;
     perl_thread	self;			/* Underlying thread object */
     U32		flags;
+    AV *	specific;		/* Thread specific data (& magicals) */
     perl_mutex	mutex;			/* For the fields others can change */
     U32		tid;
     struct thread *next, *prev;		/* Circular linked list of threads */
@@ -277,6 +293,18 @@ typedef struct condpair {
 #undef	Xpv
 #undef	statbuf
 #undef	timesbuf
+#undef	tainted
+#undef	curpm
+#undef	nrs
+#undef	rs
+#undef	last_in_gv
+#undef	ofs
+#undef	ofslen
+#undef	defoutgv
+#undef	chopset
+#undef	formtarget
+#undef	bodytarget
+#undef	toptarget
 #undef	top_env
 #undef	runlevel
 #undef	in_eval
@@ -323,6 +351,18 @@ typedef struct condpair {
 #define Xpv		(thr->TXpv)
 #define statbuf		(thr->Tstatbuf)
 #define timesbuf	(thr->Ttimesbuf)
+#define	tainted		(thr->Ttainted)
+#define	tainted		(thr->Ttainted)
+#define	curpm		(thr->Tcurpm)
+#define	nrs		(thr->Tnrs)
+#define	rs		(thr->Trs)
+#define	last_in_gv	(thr->Tlast_in_gv)
+#define	ofs		(thr->Tofs)
+#define	defoutgv	(thr->Tdefoutgv)
+#define	chopset		(thr->Tchopset)
+#define	formtarget	(thr->Tformtarget)
+#define	bodytarget	(thr->Tbodytarget)
+#define	toptarget	(thr->Ttoptarget)
 #define defstash	(thr->Tdefstash)
 #define curstash	(thr->Tcurstash)
 
diff --git a/toke.c b/toke.c
index bfcab10278..3786719096 100644
--- a/toke.c
+++ b/toke.c
@@ -1256,27 +1256,37 @@ yylex()
 	    return PRIVATEREF;
 	}
 
-	if (!strchr(tokenbuf,':')
-	    && (tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
-	    if (last_lop_op == OP_SORT &&
-		tokenbuf[0] == '$' &&
-		(tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
-		&& !tokenbuf[2])
-	    {
-		for (d = in_eval ? oldoldbufptr : linestart;
-		     d < bufend && *d != '\n';
-		     d++)
+	if (!strchr(tokenbuf,':')) {
+#ifdef USE_THREADS
+	    /* Check for single character per-thread magicals */
+	    if (tokenbuf[0] == '$' && tokenbuf[2] == '\0'
+		&& (tmp = find_thread_magical(&tokenbuf[1])) != NOT_IN_PAD) {
+		yylval.opval = newOP(OP_SPECIFIC, 0);
+		yylval.opval->op_targ = tmp;
+		return PRIVATEREF;
+	    }
+#endif /* USE_THREADS */
+	    if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
+		if (last_lop_op == OP_SORT &&
+		    tokenbuf[0] == '$' &&
+		    (tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
+		    && !tokenbuf[2])
 		{
-		    if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
-			croak("Can't use \"my %s\" in sort comparison",
-			      tokenbuf);
+		    for (d = in_eval ? oldoldbufptr : linestart;
+			 d < bufend && *d != '\n';
+			 d++)
+		    {
+			if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
+			    croak("Can't use \"my %s\" in sort comparison",
+				  tokenbuf);
+			}
 		    }
 		}
-	    }
 
-	    yylval.opval = newOP(OP_PADANY, 0);
-	    yylval.opval->op_targ = tmp;
-	    return PRIVATEREF;
+		yylval.opval = newOP(OP_PADANY, 0);
+		yylval.opval->op_targ = tmp;
+		return PRIVATEREF;
+	    }
 	}
 
 	/* Force them to make up their mind on "@foo". */
@@ -5413,7 +5423,7 @@ char *s;
     if (in_eval & 2)
 	warn("%_", msg);
     else if (in_eval)
-	sv_catsv(GvSV(errgv), msg);
+	sv_catsv(errsv, msg);
     else
 	PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
     if (++error_count >= 10)
diff --git a/util.c b/util.c
index 0d33863411..fcba8c4ac2 100644
--- a/util.c
+++ b/util.c
@@ -56,6 +56,10 @@
 static void xstat _((void));
 #endif
 
+#ifdef USE_THREADS
+static U32 threadnum = 0;
+#endif /* USE_THREADS */
+
 #ifndef MYMALLOC
 
 /* paranoid version of malloc */
@@ -2478,6 +2482,138 @@ SV *sv;
     }
     return mg;
 }
+
+/*
+ * Make a new perl thread structure using t as a prototype. If t is NULL
+ * then this is the initial main thread and we have to bootstrap carefully.
+ * Some of the fields for the new thread are copied from the prototype
+ * thread, t, so t should not be running in perl at the time this function
+ * is called. The usual case, where t is the thread calling new_struct_thread,
+ * clearly satisfies this constraint.
+ */
+struct thread *
+new_struct_thread(t)
+struct thread *t;
+{
+    struct thread *thr;
+    XPV *xpv;
+    SV *sv;
+
+    Newz(53, thr, 1, struct thread);
+    cvcache = newHV();
+    curcop = &compiling;
+    thr->specific = newAV();
+    thr->flags = THRf_R_JOINABLE;
+    MUTEX_INIT(&thr->mutex);
+    if (t) {
+	oursv = newSVpv("", 0);
+	SvGROW(oursv, sizeof(struct thread) + 1);
+	SvCUR_set(oursv, sizeof(struct thread));
+	thr = (struct thread *) SvPVX(sv);
+    } else {
+	/* Handcraft thrsv similarly to mess_sv */
+	New(53, thrsv, 1, SV);
+	Newz(53, xpv, 1, XPV);
+	SvFLAGS(thrsv) = SVt_PV;
+	SvANY(thrsv) = (void*)xpv;
+	SvREFCNT(thrsv) = 1 << 30;	/* practically infinite */
+	SvPVX(thrsv) = (char*)thr;
+	SvCUR_set(thrsv, sizeof(thr));
+	SvLEN_set(thrsv, sizeof(thr));
+	*SvEND(thrsv) = '\0';		/* in the trailing_nul field */
+	oursv = thrsv;
+    }
+    if (t) {
+	curcop = t->Tcurcop;       /* XXX As good a guess as any? */
+	defstash = t->Tdefstash;   /* XXX maybe these should */
+	curstash = t->Tcurstash;   /* always be set to main? */
+	/* top_env? */
+	/* runlevel */
+	tainted = t->Ttainted;
+	curpm = t->Tcurpm;         /* XXX No PMOP ref count */
+	nrs = newSVsv(t->Tnrs);
+	rs = newSVsv(t->Trs);
+	last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv);
+	ofslen = t->Tofslen;
+	ofs = savepvn(t->Tofs, ofslen);
+	defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
+	chopset = t->Tchopset;
+	formtarget = newSVsv(t->Tformtarget);
+	bodytarget = newSVsv(t->Tbodytarget);
+	toptarget = newSVsv(t->Ttoptarget);
+	keys = newSVpv("", 0);
+    } else {
+	curcop = &compiling;
+	chopset = " \n-";
+   }
+    MUTEX_LOCK(&threads_mutex);
+    nthreads++;
+    thr->tid = threadnum++;
+    if (t) {
+	thr->next = t->next;
+	thr->prev = t;
+	t->next = thr;
+	thr->next->prev = thr;
+    } else {
+	thr->next = thr;
+	thr->prev = thr;
+    }
+    MUTEX_UNLOCK(&threads_mutex);
+
+#ifdef HAVE_THREAD_INTERN
+    init_thread_intern(thr);
+#else
+    thr->self = pthread_self();
+#endif /* HAVE_THREAD_INTERN */
+    SET_THR(thr);
+    if (!t) {
+	/*
+	 * These must come after the SET_THR because sv_setpvn does
+	 * SvTAINT and the taint fields require dTHR.
+	 */
+	toptarget = NEWSV(0,0);
+	sv_upgrade(toptarget, SVt_PVFM);
+	sv_setpvn(toptarget, "", 0);
+	bodytarget = NEWSV(0,0);
+	sv_upgrade(bodytarget, SVt_PVFM);
+	sv_setpvn(bodytarget, "", 0);
+	formtarget = bodytarget;
+    }
+    return thr;
+}
+
+PADOFFSET
+key_create()
+{
+    char *s;
+    STRLEN len;
+    PADOFFSET i;
+    MUTEX_LOCK(&keys_mutex);
+    s = SvPV(keys, len);
+    for (i = 0; i < len; i++) {
+	if (!s[i]) {
+	    s[i] = 1;
+	    break;
+	}
+    }
+    if (i == len)
+	sv_catpvn(keys, "\1", 1);
+    MUTEX_UNLOCK(&keys_mutex);
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "key_create: %d\n", (int)i));
+    return i;
+}
+
+void
+key_destroy(key)
+PADOFFSET key;
+{
+    char *s;
+    MUTEX_LOCK(&keys_mutex);
+    s = SvPVX(keys);
+    s[key] = 0;
+    MUTEX_UNLOCK(&keys_mutex);
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "key_destroy: %d\n", (int)key));
+}
 #endif /* USE_THREADS */
 
 #ifdef HUGE_VAL