Integrate mainline @ 18:15 CST 31 Oct 1997

p4raw-id: //depot/ansiperl@199

23 files changed, 440 insertions, 151 deletions

diff --git a/doop.c b/doop.c
index 5042e3ca1a..93b618ce5b 100644
--- a/doop.c
+++ b/doop.c
@@ -244,6 +244,7 @@ do_chop(register SV *astr, register SV *sv)
 I32
 do_chomp(register SV *sv)
 {
+    dTHR;
     register I32 count;
     STRLEN len;
     char *s;
@@ -317,6 +318,7 @@ do_chomp(register SV *sv)
 void
 do_vop(I32 optype, 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 f50fbbe35b..c4b9eefc54 100644
--- a/embed.h
+++ b/embed.h
@@ -289,6 +289,8 @@
 #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
@@ -459,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
@@ -513,6 +516,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
@@ -1263,7 +1267,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)
@@ -1277,6 +1282,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)
@@ -1289,6 +1296,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)
@@ -1415,7 +1423,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
@@ -1429,6 +1438,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
@@ -1441,6 +1452,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
@@ -1576,7 +1588,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
@@ -1590,6 +1603,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
@@ -1602,6 +1617,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 45b08d1b2d..e6714aae96 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -219,38 +219,9 @@ newthread (SV *startsv, AV *initargs, 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 cb4bf17c5f..fc7bc046fd 100644
--- a/global.sym
+++ b/global.sym
@@ -76,6 +76,8 @@ in_my
 in_my_stash
 inc_amg
 io_close
+key_create
+key_destroy
 know_next
 last_lop
 last_lop_op
@@ -120,6 +122,7 @@ na
 ncmp_amg
 ne_amg
 neg_amg
+new_struct_thread
 nexttoke
 nexttype
 nextval
@@ -162,6 +165,7 @@ pad_reset_pending
 padix
 padix_floor
 patleave
+per_thread_magicals
 pidstatus
 pow_amg
 pow_ass_amg
@@ -955,6 +959,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 7419d43b32..da6dd631d4 100644
--- a/gv.c
+++ b/gv.c
@@ -219,7 +219,6 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, 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 2ef9ae3496..f3ab6ccbb9 100644
--- a/hv.c
+++ b/hv.c
@@ -294,6 +294,7 @@ hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
+	dTHR;
 	bool save_taint = tainted;
 	if (tainting)
 	    tainted = SvTAINTED(keysv);
@@ -877,7 +878,6 @@ hv_iternext(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 ea46b68406..0699b47f0f 100644
--- a/mg.c
+++ b/mg.c
@@ -247,6 +247,7 @@ mg_free(SV *sv)
 U32
 magic_len(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -310,6 +311,7 @@ magic_len(SV *sv, MAGIC *mg)
 int
 magic_get(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -396,7 +398,11 @@ magic_get(SV *sv, 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]) &&
@@ -553,6 +559,11 @@ magic_get(SV *sv, MAGIC *mg)
 	break;
     case '0':
 	break;
+#ifdef USE_THREADS
+    case '@':
+	sv_setsv(sv, errsv);
+	break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
@@ -718,7 +729,6 @@ magic_getsig(SV *sv, 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 */
@@ -1102,6 +1112,7 @@ magic_setsubstr(SV *sv, MAGIC *mg)
 int
 magic_gettaint(SV *sv, MAGIC *mg)
 {
+    dTHR;
     TAINT_IF((mg->mg_len & 1) ||
 	     (mg->mg_len & 2) && mg->mg_obj == sv);	/* kludge */
     return 0;
@@ -1608,6 +1619,11 @@ magic_set(SV *sv, 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 a0309dec3e..637537f336 100644
--- a/op.c
+++ b/op.c
@@ -235,7 +235,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;
 	    }
 	}
@@ -495,6 +495,33 @@ pad_reset(void)
     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
@@ -1122,6 +1149,7 @@ mod(OP *o, I32 type)
 	    goto nomod;
 	/* FALL THROUGH */
     case OP_PADSV:
+    case OP_SPECIFIC:
 	modcount++;
 	if (!type)
 	    croak("Can't localize lexical variable %s",
@@ -1278,6 +1306,10 @@ ref(OP *o, I32 type)
 	}
 	break;
       
+    case OP_SPECIFIC:
+	o->op_flags |= OPf_MOD;		/* XXX ??? */
+	break;
+
     case OP_RV2AV:
     case OP_RV2HV:
 	o->op_flags |= OPf_REF; 
@@ -2064,7 +2096,8 @@ pmruntime(OP *o, OP *expr, 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
@@ -3262,8 +3295,8 @@ newSUB(I32 floor, OP *o, OP *proto, 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));
 		}
 	    }
 	}
@@ -3645,6 +3678,8 @@ newSVREF(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 a7ff240424..0500164aec 100644
--- a/perl.c
+++ b/perl.c
@@ -106,9 +106,12 @@ perl_alloc(void)
 void
 perl_construct(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;
@@ -120,45 +123,23 @@ perl_construct(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);
@@ -228,6 +209,9 @@ perl_construct(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);
@@ -485,7 +469,8 @@ perl_destruct(register PerlInterpreter *sv_interp)
     envgv = Nullgv;
     siggv = Nullgv;
     incgv = Nullgv;
-    errgv = Nullgv;
+    errhv = Nullhv;
+    errsv = Nullsv;
     argvgv = Nullgv;
     argvoutgv = Nullgv;
     stdingv = Nullgv;
@@ -979,8 +964,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();
 
@@ -1243,7 +1231,7 @@ perl_call_sv(SV *sv, I32 flags)
 	    if (flags & G_KEEPERR)
 		in_eval |= 4;
 	    else
-		sv_setpv(GvSV(errgv),"");
+		sv_setpv(errsv,"");
 	}
 	markstack_ptr++;
 
@@ -1288,7 +1276,7 @@ perl_call_sv(SV *sv, I32 flags)
 	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) {
@@ -1397,7 +1385,7 @@ perl_eval_sv(SV *sv, I32 flags)
 	runops();
     retval = stack_sp - (stack_base + oldmark);
     if (!(flags & G_KEEPERR))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
 
   cleanup:
     JMPENV_POP;
@@ -1426,8 +1414,8 @@ perl_eval_pv(char *p, 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;
 }
@@ -1504,6 +1492,8 @@ moreswitches(char *s)
 
     switch (*s) {
     case '0':
+    {
+	dTHR;
 	rschar = scan_oct(s, 4, &numlen);
 	SvREFCNT_dec(nrs);
 	if (rschar & ~((U8)~0))
@@ -1515,6 +1505,7 @@ moreswitches(char *s)
 	    nrs = newSVpv(&ch, 1);
 	}
 	return s + numlen;
+    }
     case 'F':
 	minus_F = TRUE;
 	splitstr = savepv(s + 1);
@@ -1601,6 +1592,7 @@ moreswitches(char *s)
 	    s += numlen;
 	}
 	else {
+	    dTHR;
 	    if (RsPARA(nrs)) {
 		ors = "\n\n";
 		orslen = 2;
@@ -1789,11 +1781,11 @@ init_main_stash(void)
     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));
@@ -2525,7 +2517,11 @@ init_predump_symbols(void)
     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);
@@ -2558,6 +2554,7 @@ init_predump_symbols(void)
 static void
 init_postdump_symbols(register int argc, register char **argv, register char **env)
 {
+    dTHR;
     char *s;
     SV *sv;
     GV* tmpgv;
@@ -2816,7 +2813,7 @@ call_list(I32 oldscope, 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);
@@ -2877,8 +2874,8 @@ my_exit(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 1fe9723002..9a8d74ee6c 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 49860d472d..ac722c4f76 100644
--- a/pp.c
+++ b/pp.c
@@ -413,7 +413,6 @@ refto(SV *sv)
     else if (SvPADTMP(sv))
 	sv = newSVsv(sv);
     else {
-	dTHR;			/* just for SvREFCNT_inc */
 	SvTEMP_off(sv);
 	(void)SvREFCNT_inc(sv);
     }
@@ -4305,3 +4304,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 5cae7ce93a..fbb8ac533c 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1029,21 +1029,21 @@ die_where(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) {
@@ -1066,7 +1066,7 @@ die_where(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();
@@ -2161,7 +2161,7 @@ doeval(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);
 
@@ -2187,7 +2187,7 @@ doeval(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;
@@ -2206,7 +2206,7 @@ doeval(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);
@@ -2560,7 +2560,7 @@ PP(pp_leaveeval)
     LEAVE;
 
     if (!(save_flags & OPf_SPECIAL))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(errsv,"");
 
     RETURNOP(retop);
 }
@@ -2580,7 +2580,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);
 }
@@ -2628,7 +2628,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 1aabab82b8..caa5e379f0 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -284,11 +284,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";
@@ -310,11 +309,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 02ea7ca8c0..bcb87c27a7 100644
--- a/sv.c
+++ b/sv.c
@@ -1084,6 +1084,7 @@ sv_grow(SV* sv, unsigned long newlen)
 void
 sv_setiv(register SV *sv, IV i)
 {
+    dTHR;	/* just for taint */
     sv_check_thinkfirst(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -1131,6 +1132,7 @@ sv_setuv(register SV *sv, UV u)
 void
 sv_setnv(register SV *sv, double num)
 {
+    dTHR;	/* just for taint */
     sv_check_thinkfirst(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -2146,6 +2148,7 @@ sv_setsv(SV *dstr, register SV *sstr)
 void
 sv_setpvn(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);
@@ -2170,6 +2173,7 @@ sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
 void
 sv_setpv(register SV *sv, register const char *ptr)
 {
+    dTHR;	/* just for taint */
     register STRLEN len;
 
     sv_check_thinkfirst(sv);
@@ -2194,6 +2198,7 @@ sv_setpv(register SV *sv, register const char *ptr)
 void
 sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
 {
+    dTHR;	/* just for taint */
     sv_check_thinkfirst(sv);
     if (!SvUPGRADE(sv, SVt_PV))
 	return;
@@ -2254,6 +2259,7 @@ sv_chop(register SV *sv, register char *ptr)	/* like set but assuming ptr is in
 void
 sv_catpvn(register SV *sv, register char *ptr, register STRLEN len)
 {
+    dTHR;	/* just for taint */
     STRLEN tlen;
     char *junk;
 
@@ -2282,6 +2288,7 @@ sv_catsv(SV *dstr, register SV *sstr)
 void
 sv_catpv(register SV *sv, register char *ptr)
 {
+    dTHR;	/* just for taint */
     register STRLEN len;
     STRLEN tlen;
     char *junk;
@@ -2978,6 +2985,7 @@ sv_collxfrm(SV *sv, STRLEN *nxp)
 char *
 sv_gets(register SV *sv, register FILE *fp, I32 append)
 {
+    dTHR;
     char *rsptr;
     STRLEN rslen;
     register STDCHAR rslast;
@@ -3572,6 +3580,7 @@ sv_reset(register char *s, 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';
@@ -3799,6 +3808,7 @@ sv_pvn_force(SV *sv, 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 c8c6800c46..2dc43a4ab4 100644
--- a/taint.c
+++ b/taint.c
@@ -10,6 +10,7 @@
 void
 taint_proper(const char *f, char *s)
 {
+    dTHR;	/* just for taint */
     char *ug;
 
     DEBUG_u(PerlIO_printf(Perl_debug_log,
@@ -68,10 +69,12 @@ taint_env(void)
     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}");
 	}
@@ -81,6 +84,7 @@ taint_env(void)
     /* 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;
@@ -99,6 +103,7 @@ taint_env(void)
     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 5cb4b284ca..c9ec77e362 100644
--- a/thread.h
+++ b/thread.h
@@ -172,10 +172,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;
@@ -203,6 +218,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 */
@@ -278,6 +294,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
@@ -324,6 +352,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 b5e1bc0c4e..143b3c21da 100644
--- a/toke.c
+++ b/toke.c
@@ -1225,27 +1225,37 @@ yylex(void)
 	    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". */
@@ -5352,7 +5362,7 @@ yyerror(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 e3233e578a..985448728a 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 */
@@ -2396,6 +2400,138 @@ condpair_magic(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