Nearly-working threads re-structuring. Do not integrate,

submit-ing to get to Win32, and as "off site" backup.

p4raw-id: //depot/perlio@14352

25 files changed, 839 insertions, 773 deletions

diff --git a/MANIFEST b/MANIFEST
index 68a0e5f50b..bb99801629 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2046,8 +2046,6 @@ regnodes.h			Description of nodes of RE engine
 run.c				The interpreter loop
 scope.c				Scope entry and exit code
 scope.h				Scope entry and exit header
-sharedsv.c			ithreads-shared scalar values code
-sharedsv.h			ithreads-shared scalar values header
 sv.c				Scalar value code
 sv.h				Scalar value header
 t/base/cond.t			See if conditionals work
diff --git a/Makefile.SH b/Makefile.SH
index f86b17bf6b..9405eeb505 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -288,19 +288,19 @@ h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h
 h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
 h3 = opcode.h patchlevel.h perl.h perlapi.h perly.h pp.h proto.h regcomp.h
 h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
-h5 = utf8.h warnings.h sharedsv.h
+h5 = utf8.h warnings.h
 h = $(h1) $(h2) $(h3) $(h4) $(h5)
 
 c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c
 c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c utf8.c
 c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c xsutils.c
-c4 = globals.c perlio.c perlapi.c numeric.c locale.c pp_pack.c pp_sort.c sharedsv.c
+c4 = globals.c perlio.c perlapi.c numeric.c locale.c pp_pack.c pp_sort.c
 
 c = $(c1) $(c2) $(c3) $(c4) miniperlmain.c perlmain.c
 
 obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT)
 obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
-obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) xsutils$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT) sharedsv$(OBJ_EXT)
+obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) xsutils$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT)
 
 obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
 
diff --git a/Makefile.micro b/Makefile.micro
index 0e3ddbb632..11f2cc2fda 100644
--- a/Makefile.micro
+++ b/Makefile.micro
@@ -1,7 +1,7 @@
 CC = cc
 LD = $(CC)
 DEFINES = -DPERL_CORE -DPERL_MICRO
-OPTIMIZE = 
+OPTIMIZE =
 CFLAGS = $(DEFINES) $(OPTIMIZE)
 LIBS = -lm
 _O = .o
@@ -16,8 +16,7 @@ O = uav$(_O) udeb$(_O) udoio$(_O) udoop$(_O) udump$(_O) \
 	uregcomp$(_O) uregexec$(_O) urun$(_O) \
 	uscope$(_O) usv$(_O) utaint$(_O) utoke$(_O) \
 	unumeric$(_O) ulocale$(_O) \
-	uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) \
-	usharedsv$(_O)
+	uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O)
 
 microperl:	$(O)
 	$(LD) -o $@ $(O) $(LIBS)
@@ -138,6 +137,4 @@ uutil$(_O):	$(HE) util.c
 uperlapi$(_O):	$(HE) perlapi.c perlapi.h
 	$(CC) -c -o $@ $(CFLAGS) perlapi.c
 
-usharedsv$(_O):	$(HE) sharedsv.c sharedsv.h
-	$(CC) -c -o $@ $(CFLAGS) sharedsv.c
 
diff --git a/embed.fnc b/embed.fnc
index f76805ea66..ae73fd1941 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -943,6 +943,9 @@ Ap	|void	|sys_intern_init
 Ap |char * |custom_op_name|OP* op
 Ap |char * |custom_op_desc|OP* op
 
+Adp	|void	|sv_nosharing	|SV *
+Adp	|void	|sv_nolocking	|SV *
+Adp	|void	|sv_nounlocking	|SV *
 
 END_EXTERN_C
 
@@ -1160,17 +1163,6 @@ s	|void	|debprof	|OP *o
 s	|SV*	|save_scalar_at	|SV **sptr
 #endif
 
-#if defined(USE_ITHREADS)
-Adp    |void        |sharedsv_init
-Adp    |shared_sv*  |sharedsv_new
-Adp    |shared_sv*  |sharedsv_find          |SV* sv
-Adp    |void        |sharedsv_lock          |shared_sv* ssv
-Adp    |void        |sharedsv_unlock        |shared_sv* ssv
-p      |void        |sharedsv_unlock_scope  |shared_sv* ssv
-Adp    |void        |sharedsv_thrcnt_inc    |shared_sv* ssv
-Adp    |void        |sharedsv_thrcnt_dec    |shared_sv* ssv
-#endif
-
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 s	|IV	|asIV		|SV* sv
 s	|UV	|asUV		|SV* sv
diff --git a/embed.h b/embed.h
index a2fbb67052..5f8b3ada2b 100644
--- a/embed.h
+++ b/embed.h
@@ -881,6 +881,9 @@
 #endif
 #define custom_op_name		Perl_custom_op_name
 #define custom_op_desc		Perl_custom_op_desc
+#define sv_nosharing		Perl_sv_nosharing
+#define sv_nolocking		Perl_sv_nolocking
+#define sv_nounlocking		Perl_sv_nounlocking
 #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
 #define avhv_index_sv		S_avhv_index_sv
 #define avhv_index		S_avhv_index
@@ -1071,16 +1074,6 @@
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #define save_scalar_at		S_save_scalar_at
 #endif
-#if defined(USE_ITHREADS)
-#define sharedsv_init		Perl_sharedsv_init
-#define sharedsv_new		Perl_sharedsv_new
-#define sharedsv_find		Perl_sharedsv_find
-#define sharedsv_lock		Perl_sharedsv_lock
-#define sharedsv_unlock		Perl_sharedsv_unlock
-#define sharedsv_unlock_scope	Perl_sharedsv_unlock_scope
-#define sharedsv_thrcnt_inc	Perl_sharedsv_thrcnt_inc
-#define sharedsv_thrcnt_dec	Perl_sharedsv_thrcnt_dec
-#endif
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #define asIV			S_asIV
 #define asUV			S_asUV
@@ -2426,6 +2419,9 @@
 #endif
 #define custom_op_name(a)	Perl_custom_op_name(aTHX_ a)
 #define custom_op_desc(a)	Perl_custom_op_desc(aTHX_ a)
+#define sv_nosharing(a)		Perl_sv_nosharing(aTHX_ a)
+#define sv_nolocking(a)		Perl_sv_nolocking(aTHX_ a)
+#define sv_nounlocking(a)	Perl_sv_nounlocking(aTHX_ a)
 #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
 #define avhv_index_sv(a)	S_avhv_index_sv(aTHX_ a)
 #define avhv_index(a,b,c)	S_avhv_index(aTHX_ a,b,c)
@@ -2615,16 +2611,6 @@
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #define save_scalar_at(a)	S_save_scalar_at(aTHX_ a)
 #endif
-#if defined(USE_ITHREADS)
-#define sharedsv_init()		Perl_sharedsv_init(aTHX)
-#define sharedsv_new()		Perl_sharedsv_new(aTHX)
-#define sharedsv_find(a)	Perl_sharedsv_find(aTHX_ a)
-#define sharedsv_lock(a)	Perl_sharedsv_lock(aTHX_ a)
-#define sharedsv_unlock(a)	Perl_sharedsv_unlock(aTHX_ a)
-#define sharedsv_unlock_scope(a)	Perl_sharedsv_unlock_scope(aTHX_ a)
-#define sharedsv_thrcnt_inc(a)	Perl_sharedsv_thrcnt_inc(aTHX_ a)
-#define sharedsv_thrcnt_dec(a)	Perl_sharedsv_thrcnt_dec(aTHX_ a)
-#endif
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 #define asIV(a)			S_asIV(aTHX_ a)
 #define asUV(a)			S_asUV(aTHX_ a)
diff --git a/embedvar.h b/embedvar.h
index c6eb5fa7ae..1557c657d3 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -1350,14 +1350,15 @@
 #define PL_curinterp		(PL_Vars.Gcurinterp)
 #define PL_do_undump		(PL_Vars.Gdo_undump)
 #define PL_hexdigit		(PL_Vars.Ghexdigit)
+#define PL_lockhook		(PL_Vars.Glockhook)
 #define PL_malloc_mutex		(PL_Vars.Gmalloc_mutex)
 #define PL_op_mutex		(PL_Vars.Gop_mutex)
 #define PL_patleave		(PL_Vars.Gpatleave)
 #define PL_runops_dbg		(PL_Vars.Grunops_dbg)
 #define PL_runops_std		(PL_Vars.Grunops_std)
-#define PL_sharedsv_space	(PL_Vars.Gsharedsv_space)
-#define PL_sharedsv_space_mutex	(PL_Vars.Gsharedsv_space_mutex)
+#define PL_sharehook		(PL_Vars.Gsharehook)
 #define PL_thr_key		(PL_Vars.Gthr_key)
+#define PL_unlockhook		(PL_Vars.Gunlockhook)
 
 #else /* !PERL_GLOBAL_STRUCT */
 
@@ -1366,14 +1367,15 @@
 #define PL_Gcurinterp		PL_curinterp
 #define PL_Gdo_undump		PL_do_undump
 #define PL_Ghexdigit		PL_hexdigit
+#define PL_Glockhook		PL_lockhook
 #define PL_Gmalloc_mutex	PL_malloc_mutex
 #define PL_Gop_mutex		PL_op_mutex
 #define PL_Gpatleave		PL_patleave
 #define PL_Grunops_dbg		PL_runops_dbg
 #define PL_Grunops_std		PL_runops_std
-#define PL_Gsharedsv_space	PL_sharedsv_space
-#define PL_Gsharedsv_space_mutex	PL_sharedsv_space_mutex
+#define PL_Gsharehook		PL_sharehook
 #define PL_Gthr_key		PL_thr_key
+#define PL_Gunlockhook		PL_unlockhook
 
 #endif /* PERL_GLOBAL_STRUCT */
 
diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index cf655cbc58..e21bbe964c 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -1,11 +1,286 @@
+/*    sharedsv.c
+ *
+ *    Copyright (c) 2001, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
 
+/*
+* Contributed by Arthur Bergman arthur@contiller.se
+*
+* "Hand any two wizards a piece of rope and they would instinctively pull in
+* opposite directions."
+*                         --Sourcery
+*
+*/
+
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 
+PerlInterpreter	*PL_sharedsv_space;		/* The shared sv space */
+perl_mutex	 PL_sharedsv_space_mutex;	/* Mutex protecting the shared sv space */
+
+typedef struct {
+    SV                 *sv;             /* The actual SV */
+    perl_mutex          mutex;          /* Our mutex */
+    perl_cond           cond;           /* Our condition variable */
+    perl_cond           user_cond;      /* For user-level conditions */
+    IV                  locks;          /* Number of locks held */
+    PerlInterpreter    *owner;          /* Who owns the lock? */
+    U16                 index;          /* Update index */
+} shared_sv;
+
+#define SHAREDSvGET(a)      (a->sv)
+#define SHAREDSvLOCK(a)     Perl_sharedsv_lock(aTHX_ a)
+#define SHAREDSvUNLOCK(a)   Perl_sharedsv_unlock(aTHX_ a)
+
+#define SHAREDSvEDIT(a)     STMT_START {                                \
+                                MUTEX_LOCK(&PL_sharedsv_space_mutex);   \
+                                SHAREDSvLOCK((a));                      \
+                                PERL_SET_CONTEXT(PL_sharedsv_space);    \
+                            } STMT_END
+
+#define SHAREDSvRELEASE(a)  STMT_START {                                \
+                                PERL_SET_CONTEXT((a)->owner);           \
+                                SHAREDSvUNLOCK((a));                    \
+                                MUTEX_UNLOCK(&PL_sharedsv_space_mutex); \
+                            } STMT_END
+
+extern void	Perl_sharedsv_init(pTHX);
+extern shared_sv*	Perl_sharedsv_new(pTHX);
+extern shared_sv*	Perl_sharedsv_find(pTHX_ SV* sv);
+extern void	Perl_sharedsv_lock(pTHX_ shared_sv* ssv);
+extern void	Perl_sharedsv_unlock(pTHX_ shared_sv* ssv);
+extern void	Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv);
+extern void	Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv);
+extern void	Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv);
+
+/*
+  Shared SV
+
+  Shared SV is a structure for keeping the backend storage
+  of shared svs.
+
+*/
+
+/*
+
+ =head1 Shared SV Functions
+
+ =for apidoc sharedsv_init 
+
+Saves a space for keeping SVs wider than an interpreter,
+currently only stores a pointer to the first interpreter.
+
+ =cut
+
+*/
+
+void
+Perl_sharedsv_init(pTHX)
+{
+  PerlInterpreter* old_context = PERL_GET_CONTEXT;
+  PL_sharedsv_space = perl_alloc();
+  perl_construct(PL_sharedsv_space);
+  PERL_SET_CONTEXT(old_context);
+  MUTEX_INIT(&PL_sharedsv_space_mutex);
+}
+
+/*
+ =for apidoc sharedsv_new
+
+Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
+ =cut
+*/
+
+shared_sv *
+Perl_sharedsv_new(pTHX)
+{
+    shared_sv* ssv;
+    New(2555,ssv,1,shared_sv);
+    MUTEX_INIT(&ssv->mutex);
+    COND_INIT(&ssv->cond);
+    COND_INIT(&ssv->user_cond);
+    ssv->owner = 0;
+    ssv->locks = 0;
+    ssv->index = 0;
+    return ssv;
+}
+
+
+/*
+ =for apidoc sharedsv_find
+
+Tries to find if a given SV has a shared backend, either by
+looking at magic, or by checking if it is tied again threads::shared.
+
+ =cut
+*/
+
+shared_sv *
+Perl_sharedsv_find(pTHX_ SV* sv)
+{
+  /* does all it can to find a shared_sv struct, returns NULL otherwise */
+    shared_sv* ssv = NULL;
+    switch (SvTYPE(sv)) {
+        case SVt_PVMG:
+        case SVt_PVAV:
+        case SVt_PVHV: {
+            MAGIC* mg = mg_find(sv, PERL_MAGIC_ext);
+            if(mg) {
+	        if(strcmp(mg->mg_ptr,"threads::shared"))
+                    break;
+                ssv = INT2PTR(shared_sv *, SvIV(mg->mg_obj));
+	        break;
+             }
+	
+	     mg = mg_find(sv,PERL_MAGIC_tied);
+             if(mg) {
+                 SV* obj = SvTIED_obj(sv,mg);
+	         if(sv_derived_from(obj, "threads::shared"))
+                     ssv = INT2PTR(shared_sv *, SvIV(SvRV(obj)));
+                 break;
+             }
+	}
+    }
+    return ssv;
+}
+
+/*
+ =for apidoc sharedsv_lock
+
+Recursive locks on a sharedsv.
+Locks are dynamically scoped at the level of the first lock.
+ =cut
+*/
+void
+Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
+{
+    if(!ssv)
+        return;
+    MUTEX_LOCK(&ssv->mutex);
+    if(ssv->owner && ssv->owner == my_perl) {
+        ssv->locks++;
+	MUTEX_UNLOCK(&ssv->mutex);
+        return;
+    }
+    while(ssv->owner)
+      COND_WAIT(&ssv->cond,&ssv->mutex);
+    ssv->locks++;
+    ssv->owner = my_perl;
+    if(ssv->locks == 1)
+        SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
+    MUTEX_UNLOCK(&ssv->mutex);
+}
+
+/*
+ =for apidoc sharedsv_unlock
+
+Recursively unlocks a shared sv.
+
+ =cut
+*/
+
+void
+Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
+{
+    MUTEX_LOCK(&ssv->mutex);
+    if(ssv->owner != my_perl) {
+        Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
+        MUTEX_UNLOCK(&ssv->mutex);
+        return;
+    }
+
+    if(--ssv->locks == 0) {
+        ssv->owner = NULL;
+	COND_SIGNAL(&ssv->cond);
+    }
+    MUTEX_UNLOCK(&ssv->mutex);
+ }
+
+void
+Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
+{
+    MUTEX_LOCK(&ssv->mutex);
+    if(ssv->owner != my_perl) {
+        MUTEX_UNLOCK(&ssv->mutex);
+        return;
+    }
+    ssv->locks = 0;
+    ssv->owner = NULL;
+    COND_SIGNAL(&ssv->cond);
+    MUTEX_UNLOCK(&ssv->mutex);
+}
+
+/*
+ =for apidoc sharedsv_thrcnt_inc
+
+Increments the threadcount of a sharedsv.
+ =cut
+*/
+void
+Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
+{
+  SHAREDSvLOCK(ssv);
+  SvREFCNT_inc(ssv->sv);
+  SHAREDSvUNLOCK(ssv);
+}
+
+/*
+ =for apidoc sharedsv_thrcnt_dec
+
+Decrements the threadcount of a shared sv. When a threads frontend is freed
+this function should be called.
+
+ =cut
+*/
+
+void
+Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
+{
+    SV* sv;
+    SHAREDSvLOCK(ssv);
+    sv = SHAREDSvGET(ssv);
+    if (SvREFCNT(sv) == 1) {
+        switch (SvTYPE(sv)) {
+        case SVt_RV:
+            if (SvROK(sv))
+            Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
+            break;
+        case SVt_PVAV: {
+            SV **src_ary  = AvARRAY((AV *)sv);
+            SSize_t items = AvFILLp((AV *)sv) + 1;
+
+            while (items-- > 0) {
+            if(SvTYPE(*src_ary))
+                Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary)));
+                src_ary++;
+            }
+            break;
+        }
+        case SVt_PVHV: {
+            HE *entry;
+            (void)hv_iterinit((HV *)sv);
+            while ((entry = hv_iternext((HV *)sv)))
+                Perl_sharedsv_thrcnt_dec(
+                    aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
+                );
+            break;
+        }
+        }
+    }
+    Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
+    SHAREDSvUNLOCK(ssv);
+}
+
+
 MGVTBL svtable;
 
-SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
+SV* Perl_shared_sv_attach_sv (pTHX_ SV* sv, shared_sv* shared) {
     HV* shared_hv = get_hv("threads::shared::shared", FALSE);
     SV* id = newSViv(PTR2IV(shared));
     STRLEN length = sv_len(id);
@@ -99,7 +374,7 @@ int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
         shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
         if(!target) {
             sv_setsv(sv,SHAREDSvGET(shared));
-            SHAREDSvUNLOCK(shared);            
+            SHAREDSvUNLOCK(shared);
             Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
         }
         SHAREDSvEDIT(shared);
@@ -120,7 +395,7 @@ int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
 
 int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
     shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
-    if(!shared) 
+    if(!shared)
         return 0;
     {
 	HV* shared_hv = get_hv("threads::shared::shared", FALSE);
@@ -167,7 +442,7 @@ _thrcnt(ref)
         RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
         SHAREDSvUNLOCK(shared);
 	OUTPUT:
-        RETVAL   
+        RETVAL
 
 
 void
@@ -178,7 +453,7 @@ thrcnt_inc(ref,perl)
 	shared_sv* shared;
 	PerlInterpreter* origperl = INT2PTR(PerlInterpreter*, SvIV(perl));
 	PerlInterpreter* oldperl = PERL_GET_CONTEXT;
-        if(SvROK(ref)) 
+        if(SvROK(ref))
             ref = SvRV(ref);
         shared = Perl_sharedsv_find(aTHX, ref);
         if(!shared)
@@ -196,7 +471,7 @@ _thrcnt_dec(ref)
            croak("thrcnt can only be used on shared values");
 	Perl_sharedsv_thrcnt_dec(aTHX_ shared);
 
-void 
+void
 unlock_enabled(ref)
 	SV* ref
 	PROTOTYPE: \[$@%]
@@ -296,7 +571,7 @@ new(class, value)
 
 MODULE = threads::shared		PACKAGE = threads::shared::av
 
-SV* 
+SV*
 new(class, value)
 	SV* class
 	SV* value
@@ -315,7 +590,7 @@ STORE(self, index, value)
         SV* self
 	SV* index
         SV* value
-        CODE:    
+        CODE:
         shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
         shared_sv* slot;
         SV* aentry;
@@ -370,7 +645,7 @@ FETCH(self, index)
 	        slot = INT2PTR(shared_sv*, SvIV(aentry));
 		if(SvROK(SHAREDSvGET(slot))) {
 		     shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-		     retval = shared_sv_attach_sv(NULL,target);
+		     retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
 		} else {
 	             retval = newSVsv(SHAREDSvGET(slot));
 		}
@@ -453,7 +728,7 @@ POP(self)
 	    slot = INT2PTR(shared_sv*, SvIV(retval));
 	    if(SvROK(SHAREDSvGET(slot))) {
 		 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-		 retval = shared_sv_attach_sv(NULL,target);
+		 retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
 	    } else {
 	         retval = newSVsv(SHAREDSvGET(slot));
             }
@@ -482,7 +757,7 @@ SHIFT(self)
 	    slot = INT2PTR(shared_sv*, SvIV(retval));
             if(SvROK(SHAREDSvGET(slot))) {
                  shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-                 retval = shared_sv_attach_sv(NULL,target);
+                 retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
             } else {
                  retval = newSVsv(SHAREDSvGET(slot));
             }
@@ -584,14 +859,14 @@ DELETE(self,index)
 		slot = INT2PTR(shared_sv*, SvIV(tmp));
                 if(SvROK(SHAREDSvGET(slot))) {
                    shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-                   RETVAL = shared_sv_attach_sv(NULL,target);
+                   RETVAL = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
                 } else {
                    RETVAL = newSVsv(SHAREDSvGET(slot));
                 }
-                Perl_sharedsv_thrcnt_dec(aTHX_ slot);               
+                Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 	    } else {
                 RETVAL = &PL_sv_undef;
-	    }	    
+	    }	
 	} else {
 	    RETVAL = &PL_sv_undef;
 	}	
@@ -609,7 +884,7 @@ SPLICE(self, offset, length, ...)
 	
 MODULE = threads::shared		PACKAGE = threads::shared::hv
 
-SV* 
+SV*
 new(class, value)
 	SV* class
 	SV* value
@@ -689,7 +964,7 @@ FETCH(self, key)
                 slot = INT2PTR(shared_sv*, SvIV(hentry));
 		if(SvROK(SHAREDSvGET(slot))) {
 		    shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-		    retval = shared_sv_attach_sv(NULL, target);
+		    retval = Perl_shared_sv_attach_sv(aTHX_ NULL, target);
 		} else {
 	            retval = newSVsv(SHAREDSvGET(slot));
 		}
@@ -802,7 +1077,7 @@ DELETE(self, key)
 		slot = INT2PTR(shared_sv*, SvIV(tmp));
 		if(SvROK(SHAREDSvGET(slot))) {
 		    shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-		    RETVAL = shared_sv_attach_sv(NULL, target);
+		    RETVAL = Perl_shared_sv_attach_sv(aTHX_ NULL, target);
 		} else {
 		    RETVAL = newSVsv(SHAREDSvGET(slot));
 		}
@@ -813,3 +1088,8 @@ DELETE(self, key)
         SHAREDSvUNLOCK(shared);
         OUTPUT:
         RETVAL
+
+BOOT:
+{
+     Perl_sharedsv_init(aTHX);
+}
diff --git a/ext/threads/threads.h b/ext/threads/threads.h
deleted file mode 100755
index 72a4872485..0000000000
--- a/ext/threads/threads.h
+++ /dev/null
@@ -1,99 +0,0 @@
-
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include <stdio.h>
-#include <stdlib.h>
-
-#ifdef WIN32
-#include <windows.h>
-#include <win32thread.h>
-#define PERL_THREAD_DETACH(t) 
-#define PERL_THREAD_SETSPECIFIC(k,v) TlsSetValue(k,v)
-#define PERL_THREAD_GETSPECIFIC(k,v) v = TlsGetValue(k)
-#define PERL_THREAD_ALLOC_SPECIFIC(k) \
-STMT_START {\
-  if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
-    PerlIO_printf(PerlIO_stderr(),"panic threads.h: TlsAlloc");\
-    exit(1);\
-  }\
-} STMT_END
-#else
-#include <pthread.h>
-#include <thread.h>
-
-#define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
-#ifdef OLD_PTHREADS_API
-#define PERL_THREAD_DETACH(t) pthread_detach(&(t))
-#define PERL_THREAD_GETSPECIFIC(k,v) pthread_getspecific(k,&v)
-#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
-  if(pthread_keycreate(&(k),0)) {\
-    PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
-    exit(1);\
-  }\
-} STMT_END
-#else
-#define PERL_THREAD_DETACH(t) pthread_detach((t))
-#define PERL_THREAD_GETSPECIFIC(k,v) v = pthread_getspecific(k)
-#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
-  if(pthread_key_create(&(k),0)) {\
-    PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
-    exit(1);\
-  }\
-} STMT_END
-#endif
-#endif
-
-typedef struct {
-  PerlInterpreter *interp;    /* The threads interpreter */
-  I32 tid;              /* Our thread */
-  perl_mutex mutex; 		/* our mutex */
-  I32 count;			/* how many threads have a reference to us */
-  signed char detached;		/* are we detached ? */
-  SV* init_function;
-  SV* params;
-#ifdef WIN32
-  DWORD	thr;
-  HANDLE handle;
-#else
-  pthread_t thr;
-#endif
-} ithread;
-
-
-
-static perl_mutex create_mutex;  /* protects the creation of threads ??? */
-
-
-
-I32 tid_counter = 1;
-shared_sv* threads;
-
-perl_key self_key;
-
-
-
-
-/* internal functions */
-#ifdef WIN32
-THREAD_RET_TYPE Perl_thread_run(LPVOID arg);
-#else
-void* Perl_thread_run(void * arg);
-#endif
-void Perl_thread_destruct(ithread* thread);
-
-/* Perl mapped functions to iThread:: */
-SV* Perl_thread_create(char* class, SV* function_to_call, SV* params);
-I32 Perl_thread_tid (SV* obj);
-void Perl_thread_join(SV* obj);
-void Perl_thread_detach(SV* obj);
-SV* Perl_thread_self (char* class);
-
-
-
-
-
-
-
-
-
diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm
index 444ec5b67c..7a5a2740bb 100755
--- a/ext/threads/threads.pm
+++ b/ext/threads/threads.pm
@@ -4,7 +4,7 @@ use 5.7.2;
 use strict;
 use warnings;
 
-use overload 
+use overload
     '==' => \&equal,
     'fallback' => 1;
 
@@ -41,6 +41,9 @@ $threads::threads = 1;
 
 bootstrap threads $VERSION;
 
+# why document 'new' then use 'create' in the tests!
+*create = \&new;
+
 # Preloaded methods go here.
 
 1;
@@ -146,9 +149,9 @@ Arthur Bergman E<lt>arthur at contiller.seE<gt>
 
 threads is released under the same license as Perl.
 
-Thanks to 
+Thanks to
 
-Richard Soderberg E<lt>rs at crystalflame.netE<gt> 
+Richard Soderberg E<lt>rs at crystalflame.netE<gt>
 Helping me out tons, trying to find reasons for races and other weird bugs!
 
 Simon Cozens E<lt>simon at brecon.co.ukE<gt>
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 6f58de9681..1b89e2cc14 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -1,68 +1,220 @@
-#include "threads.h"
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef WIN32
+#include <windows.h>
+#include <win32thread.h>
+#define PERL_THREAD_SETSPECIFIC(k,v) TlsSetValue(k,v)
+#define PERL_THREAD_GETSPECIFIC(k,v) v = TlsGetValue(k)
+#define PERL_THREAD_ALLOC_SPECIFIC(k) \
+STMT_START {\
+  if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
+    PerlIO_printf(PerlIO_stderr(),"panic threads.h: TlsAlloc");\
+    exit(1);\
+  }\
+} STMT_END
+#else
+#include <pthread.h>
+#include <thread.h>
+
+#define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
+#ifdef OLD_PTHREADS_API
+#define PERL_THREAD_DETACH(t) pthread_detach(&(t))
+#define PERL_THREAD_GETSPECIFIC(k,v) pthread_getspecific(k,&v)
+#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
+  if(pthread_keycreate(&(k),0)) {\
+    PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
+    exit(1);\
+  }\
+} STMT_END
+#else
+#define PERL_THREAD_DETACH(t) pthread_detach((t))
+#define PERL_THREAD_GETSPECIFIC(k,v) v = pthread_getspecific(k)
+#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
+  if(pthread_key_create(&(k),0)) {\
+    PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
+    exit(1);\
+  }\
+} STMT_END
+#endif
+#endif
+
+typedef struct ithread_s {
+    struct ithread_s *next;	/* next thread in the list */
+    struct ithread_s *prev;	/* prev thread in the list */
+    PerlInterpreter *interp;	/* The threads interpreter */
+    I32 tid;              	/* threads module's thread id */
+    perl_mutex mutex; 		/* mutex for updating things in this struct */
+    I32 count;			/* how many SVs have a reference to us */
+    signed char detached;	/* are we detached ? */
+    SV* init_function;          /* Code to run */
+    SV* params;                 /* args to pass function */
+#ifdef WIN32
+	DWORD	thr;            /* OS's idea if thread id */
+	HANDLE handle;          /* OS's waitable handle */
+#else
+  	pthread_t thr;          /* OS's handle for the thread */
+#endif
+} ithread;
+
+ithread *threads;
+
+/* Macros to supply the aTHX_ in an embed.h like manner */
+#define ithread_join(thread)		Perl_ithread_join(aTHX_ thread)
+#define ithread_DESTROY(thread)		Perl_ithread_DESTROY(aTHX_ thread)
+#define ithread_CLONE(thread)		Perl_ithread_CLONE(aTHX_ thread)
+#define ithread_detach(thread)		Perl_ithread_detach(aTHX_ thread)
+#define ithread_tid(thread)		((thread)->tid)
+
+static perl_mutex create_mutex;  /* protects the creation of threads ??? */
+
+I32 tid_counter = 0;
+
+perl_key self_key;
+
+/*
+ *  Clear up after thread is done with
+ */
+void
+Perl_ithread_destruct (pTHX_ ithread* thread)
+{
+	MUTEX_LOCK(&thread->mutex);
+	Perl_warn(aTHX_ "destruct %d with count=%d",thread->tid,thread->count);
+	if (thread->count != 0) {
+		MUTEX_UNLOCK(&thread->mutex);
+		return;	
+	}
+	MUTEX_UNLOCK(&thread->mutex);
+	MUTEX_LOCK(&create_mutex);
+	/* Remove from circular list of threads */
+	if (thread->next == thread) {
+	    /* last one should never get here ? */
+	    threads = NULL;
+        }
+	else {
+	    thread->next->prev = thread->prev->next;
+	    thread->prev->next = thread->next->prev;
+	    if (threads == thread) {
+		threads = thread->next;
+	    }
+	}
+	MUTEX_UNLOCK(&create_mutex);
+	/* Thread is now disowned */
+	if (thread->interp) {
+	    dTHXa(thread->interp);
+	    PERL_SET_CONTEXT(thread->interp);
+	    perl_destruct(thread->interp);
+	    perl_free(thread->interp);
+	    thread->interp = NULL;
+	}
+	PERL_SET_CONTEXT(aTHX);
+}
+
+
+/* MAGIC (in mg.h sense) hooks */
+
+int
+ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
+{
+    ithread *thread = (ithread *) mg->mg_ptr;
+    SvIVX(sv) = PTR2IV(thread);
+    SvIOK_on(sv);
+    return 0;
+}
+
+int
+ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
+{
+    ithread *thread = (ithread *) mg->mg_ptr;
+    MUTEX_LOCK(&thread->mutex);
+    Perl_warn(aTHX_ "Unmagic %d with count=%d",thread->tid,thread->count);
+    thread->count--;
+    MUTEX_UNLOCK(&thread->mutex);
+    /* This is safe as it re-checks count */
+    Perl_ithread_destruct(aTHX_ thread);
+    return 0;
+}
+
+int
+ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
+{
+    ithread *thread = (ithread *) mg->mg_ptr;
+    MUTEX_LOCK(&thread->mutex);
+    Perl_warn(aTHX_ "DUP %d with count=%d",thread->tid,thread->count);
+    thread->count++;
+    MUTEX_UNLOCK(&thread->mutex);
+    return 0;
+}
+
+MGVTBL ithread_vtbl = {
+ ithread_mg_get,	/* get */
+ 0,			/* set */
+ 0,			/* len */
+ 0,			/* clear */
+ ithread_mg_free,	/* free */
+ 0,			/* copy */
+ ithread_mg_dup		/* dup */
+};
+
 
 /*
  *	Starts executing the thread. Needs to clean up memory a tad better.
+ *      Passed as the C level function to run in the new thread
  */
 
 #ifdef WIN32
-THREAD_RET_TYPE Perl_thread_run(LPVOID arg) {
+THREAD_RET_TYPE
+Perl_ithread_run(LPVOID arg) {
 #else
-void* Perl_thread_run(void * arg) {
+void*
+Perl_ithread_run(void * arg) {
 #endif
 	ithread* thread = (ithread*) arg;
-	SV* thread_tid_ptr;
-	SV* thread_ptr;
 	dTHXa(thread->interp);
 	PERL_SET_CONTEXT(thread->interp);
+	PERL_THREAD_SETSPECIFIC(self_key,thread);
 
+#if 0
+	/* Far from clear messing with ->thr child-side is a good idea */
+	MUTEX_LOCK(&thread->mutex);
 #ifdef WIN32
 	thread->thr = GetCurrentThreadId();
 #else
 	thread->thr = pthread_self();
 #endif
+ 	MUTEX_UNLOCK(&thread->mutex);
+#endif
 
-	SHAREDSvLOCK(threads);
-	SHAREDSvEDIT(threads);
-	PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid));
-	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid);	
-	thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
-	hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
-   	SvREFCNT_dec(thread_tid_ptr);
-	SHAREDSvRELEASE(threads);
-	SHAREDSvUNLOCK(threads);
 	PL_perl_destruct_level = 2;
 
 	{
-
-		AV* params;
-		I32 len;
+		AV* params = (AV*) SvRV(thread->params);
+		I32 len = av_len(params)+1;
 		int i;
 		dSP;
-		params = (AV*) SvRV(thread->params);
-		len = av_len(params);
 		ENTER;
 		SAVETMPS;
 		PUSHMARK(SP);
-		if(len > -1) {
-			for(i = 0; i < len + 1; i++) {
-				XPUSHs(av_shift(params));
-			}	
+		for(i = 0; i < len; i++) {
+		    XPUSHs(av_shift(params));
 		}
 		PUTBACK;
-	 	call_sv(thread->init_function, G_DISCARD);
+		call_sv(thread->init_function, G_DISCARD|G_EVAL);
+		SPAGAIN;
 		FREETMPS;
 		LEAVE;
-
-
+		SvREFCNT_dec(thread->params);
+		SvREFCNT_dec(thread->init_function);
 	}
 
-	MUTEX_LOCK(&thread->mutex);
 	PerlIO_flush((PerlIO*)NULL);
- 	perl_destruct(thread->interp);	
-	perl_free(thread->interp);
-	if(thread->detached == 1) {
+	MUTEX_LOCK(&thread->mutex);
+	Perl_warn(aTHX_ "finished %d with count=%d",thread->tid,thread->count);
+	if (thread->detached == 1) {
 		MUTEX_UNLOCK(&thread->mutex);
-		Perl_thread_destruct(thread);
+		Perl_ithread_destruct(aTHX_ thread);
 	} else {
 	  	MUTEX_UNLOCK(&thread->mutex);
    	}
@@ -71,46 +223,84 @@ void* Perl_thread_run(void * arg) {
 #else
 	return 0;
 #endif
+}
+
+SV *
+ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
+{
+    SV *sv;
+    MAGIC *mg;
+    if (inc) {
+	MUTEX_LOCK(&thread->mutex);
+	thread->count++;
+	Perl_warn(aTHX_ "SV for %d with count=%d",thread->tid,thread->count);
+	MUTEX_UNLOCK(&thread->mutex);
+    }
+    if (!obj)
+     obj = newSV(0);
+    sv = newSVrv(obj,classname);
+    sv_setiv(sv,PTR2IV(thread));
+    mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0);
+    mg->mg_flags |= MGf_DUP;
+    SvREADONLY_on(sv);
+    return obj;
+}
 
+ithread *
+SV_to_ithread(pTHX_ SV *sv)
+{
+    ithread *thread;
+    if (SvROK(sv))
+     {
+      thread = INT2PTR(ithread*, SvIV(SvRV(sv)));
+     }
+    else
+     {
+      PERL_THREAD_GETSPECIFIC(self_key,thread);
+     }
+    return thread;
 }
 
 /*
- * iThread->create();
+ * iThread->create(); ( aka iThread->new() )
+ * Called in context of parent thread
  */
 
-SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
-	ithread* thread = malloc(sizeof(ithread));
-  	SV*      obj_ref;
-  	SV*      obj;
-	SV*		temp_store;
-	PerlInterpreter *current_perl;
-	CLONE_PARAMS clone_param;
-
-	MUTEX_LOCK(&create_mutex);  
-	obj_ref = newSViv(0);
-	obj = newSVrv(obj_ref, class);
-	sv_setiv(obj, PTR2IV(thread));
-	SvREADONLY_on(obj);
-	PerlIO_flush((PerlIO*)NULL);
-	current_perl = PERL_GET_CONTEXT;	
-
+SV *
+Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* params)
+{
+	ithread*	thread;
+	CLONE_PARAMS	clone_param;
+
+	MUTEX_LOCK(&create_mutex);
+	thread = PerlMemShared_malloc(sizeof(ithread));
+	Zero(thread,1,ithread);
+	thread->next = threads;
+	thread->prev = threads->prev;
+	thread->prev->next = thread;
+	/* Set count to 1 immediately in case thread exits before
+	 * we return to caller !
+	 */
+	thread->count = 1;
+	MUTEX_INIT(&thread->mutex);
+	thread->tid = tid_counter++;
+	thread->detached = 0;
 
+	/* "Clone" our interpreter into the thread's interpreter
+	 * This gives thread access to "static data" and code.
+	 */
 
-	temp_store = Perl_get_sv(current_perl, "threads::origthread", TRUE | GV_ADDMULTI);
-	sv_setiv(temp_store,PTR2IV(current_perl));
-	temp_store = NULL;	
+	PerlIO_flush((PerlIO*)NULL);
 
-	
 #ifdef WIN32
-	thread->interp = perl_clone(current_perl, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
+	thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
 #else
-	thread->interp = perl_clone(current_perl, CLONEf_KEEP_PTR_TABLE);
+	thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE);
 #endif
-	
 
 	clone_param.flags = 0;	
 	thread->init_function = Perl_sv_dup(thread->interp, init_function, &clone_param);
-	if(SvREFCNT(thread->init_function) == 0) {
+	if (SvREFCNT(thread->init_function) == 0) {
 	    SvREFCNT_inc(thread->init_function);
 	}	
 
@@ -120,25 +310,15 @@ SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
 	ptr_table_free(PL_ptr_table);
 	PL_ptr_table = NULL;
 	
+	PERL_SET_CONTEXT(aTHX);
 
-
-
-	PERL_SET_CONTEXT(current_perl);
-
-
-	/* let's init the thread */
-
-	MUTEX_INIT(&thread->mutex);
-	thread->tid = tid_counter++;
-	thread->detached = 0;
-	thread->count = 1;
+	/* Start the thread */
 
 #ifdef WIN32
 
-	thread->handle = CreateThread(NULL, 0, Perl_thread_run,
+	thread->handle = CreateThread(NULL, 0, Perl_ithread_run,
 			(LPVOID)thread, 0, &thread->thr);
 
-
 #else
 	{
 	  static pthread_attr_t attr;
@@ -158,243 +338,165 @@ SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
 #  endif
 
 #ifdef OLD_PTHREADS_API
-	  pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread);
+	  pthread_create( &thread->thr, attr, Perl_ithread_run, (void *)thread);
 #else
-	  pthread_create( &thread->thr, &attr, Perl_thread_run, (void *)thread);
+	  pthread_create( &thread->thr, &attr, Perl_ithread_run, (void *)thread);
 #endif
 	}
 #endif
 	MUTEX_UNLOCK(&create_mutex);	
+	return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
+}
 
-	return obj_ref;
+SV*
+Perl_ithread_self (pTHX_ SV *obj, char* Class)
+{
+    ithread *thread;
+    PERL_THREAD_GETSPECIFIC(self_key,thread);
+    return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
 }
 
 /*
- * returns the id of the thread
+ * joins the thread this code needs to take the returnvalue from the
+ * call_sv and send it back
  */
-I32 Perl_thread_tid (SV* obj) {
-	ithread* thread;
-	if(!SvROK(obj)) {
-		obj = Perl_thread_self(SvPV_nolen(obj));
-		thread = INT2PTR(ithread*, SvIV(SvRV(obj)));
-		SvREFCNT_dec(obj);
-	} else {
-		thread = INT2PTR(ithread*, SvIV(SvRV(obj)));
-	}
-	return thread->tid;
-}
 
-SV* Perl_thread_self (char* class) {
-	dTHX;
-	SV*      obj_ref;
-	SV*      obj;
-	SV*	thread_tid_ptr;
-	SV*	thread_ptr;
-	HE*	thread_entry;
-	void*   id;
-	PERL_THREAD_GETSPECIFIC(self_key,id);
-	SHAREDSvLOCK(threads);
-	SHAREDSvEDIT(threads);
-	
-	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id));	
-
-	thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
-					 (HV*) SHAREDSvGET(threads),
-					 thread_tid_ptr, 0,0);
-	thread_ptr = HeVAL(thread_entry);
-	SvREFCNT_dec(thread_tid_ptr);	
-	SHAREDSvRELEASE(threads);
-	SHAREDSvUNLOCK(threads);
-
-	obj_ref = newSViv(0);
-	obj = newSVrv(obj_ref, class);
-   	sv_setsv(obj, thread_ptr);
-   	SvREADONLY_on(obj);
-	return obj_ref;
+void
+Perl_ithread_CLONE(pTHX_ SV *obj)
+{
+ if (SvROK(obj))
+  {
+   ithread *thread = SV_to_ithread(aTHX_ obj);
+  }
+ else
+  {
+   Perl_warn(aTHX_ "CLONE %_",obj);
+  }
 }
 
-/*
- * joins the thread this code needs to take the returnvalue from the
- * call_sv and send it back */
-
-void Perl_thread_join(SV* obj) {
-	ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj)));
+void
+Perl_ithread_join(pTHX_ SV *obj)
+{
+    ithread *thread = SV_to_ithread(aTHX_ obj);
+    MUTEX_LOCK(&thread->mutex);
+    Perl_warn(aTHX_ "joining %d with count=%d",thread->tid,thread->count);
+    if (!thread->detached) {
 #ifdef WIN32
 	DWORD waitcode;
-	waitcode = WaitForSingleObject(thread->handle, INFINITE);
 #else
 	void *retval;
-	pthread_join(thread->thr,&retval);
 #endif
-}
-
-/* detaches a thread
- * needs to better clean up memory */
-
-void Perl_thread_detach(SV* obj) {
-	ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj)));
-	MUTEX_LOCK(&thread->mutex);
-	thread->detached = 1;
-	PERL_THREAD_DETACH(thread->thr);
 	MUTEX_UNLOCK(&thread->mutex);
-}
-
-void Perl_thread_DESTROY (SV* obj) {
-	ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj)));
-	
+#ifdef WIN32
+	waitcode = WaitForSingleObject(thread->handle, INFINITE);
+#else
+	pthread_join(thread->thr,&retval);
+#endif
+	Perl_warn(aTHX_ "joined %d with count=%d",thread->tid,thread->count);
+	/* We have finished with it */
 	MUTEX_LOCK(&thread->mutex);
-	thread->count--;
+	thread->detached = 2;
 	MUTEX_UNLOCK(&thread->mutex);
-	Perl_thread_destruct(thread);
-}
-
-void Perl_thread_destruct (ithread* thread) {
-	return;
-	MUTEX_LOCK(&thread->mutex);
-	if(thread->count != 0) {
-		MUTEX_UNLOCK(&thread->mutex);
-		return;	
-	}
+	sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
+    }
+    else {
 	MUTEX_UNLOCK(&thread->mutex);
-	/* it is safe noone is holding a ref to this */
-	/*printf("proper destruction!\n");*/
+	Perl_croak(aTHX_ "Cannot join a detached thread");
+    }
 }
 
-MODULE = threads		PACKAGE = threads		
-BOOT:
-	Perl_sharedsv_init(aTHX);
-	PERL_THREAD_ALLOC_SPECIFIC(self_key);
-	PL_perl_destruct_level = 2;
-	threads = Perl_sharedsv_new(aTHX);
-	SHAREDSvEDIT(threads);
-	SHAREDSvGET(threads) = (SV *)newHV();
-	SHAREDSvRELEASE(threads);
-	{
-	    
-	
-	    SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI);
-	    SV* temp2 = newSViv(PTR2IV(PL_sharedsv_space));
-	    sv_setsv( temp , temp2 );
-	}
-	{
-		ithread* thread = malloc(sizeof(ithread));
-		SV* thread_tid_ptr;
-		SV* thread_ptr;
-		MUTEX_INIT(&thread->mutex);
-		thread->tid = 0;
+void
+Perl_ithread_detach(pTHX_ ithread *thread)
+{
+    MUTEX_LOCK(&thread->mutex);
+    if (!thread->detached) {
+	thread->detached = 1;
 #ifdef WIN32
-		thread->thr = GetCurrentThreadId();
+	CloseHandle(thread->handle);
+	thread->handle = 0;
 #else
-		thread->thr = pthread_self();
+	PERL_THREAD_DETACH(thread->thr);
 #endif
-		SHAREDSvEDIT(threads);
-		PERL_THREAD_ALLOC_SPECIFIC(self_key);
-		PERL_THREAD_SETSPECIFIC(self_key,0);
-		thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0);
-		thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
-		hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
-	   	SvREFCNT_dec(thread_tid_ptr);
-		SHAREDSvRELEASE(threads);
-	}
-	MUTEX_INIT(&create_mutex);
-
-PROTOTYPES: DISABLE
+    }
+    MUTEX_UNLOCK(&thread->mutex);
+}
 
-SV *
-create (class, function_to_call, ...)
-        char *  class
-        SV *    function_to_call
-		CODE:
-			AV* params = newAV();
-			if(items > 2) {
-				int i;
-				for(i = 2; i < items ; i++) {
-					av_push(params, ST(i));
-				}
-			}
-			RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
-			OUTPUT:
-			RETVAL
 
-SV *
-new (class, function_to_call, ...)
-        char *  class
-        SV *    function_to_call
-		CODE:
-			AV* params = newAV();
-			if(items > 2) {
-				int i;
-				for(i = 2; i < items ; i++) {
-					av_push(params, ST(i));
-				}
-			}
-			RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params));
-			OUTPUT:
-			RETVAL
+void
+Perl_ithread_DESTROY(pTHX_ SV *sv)
+{
+    ithread *thread = SV_to_ithread(aTHX_ sv);
+    Perl_warn(aTHX_ "DESTROY %d with count=%d",thread->tid,thread->count);
+    sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar);
+}
 
+MODULE = threads		PACKAGE = threads	PREFIX = ithread_
+PROTOTYPES: DISABLE
 
+void
+ithread_new (classname, function_to_call, ...)
+char *	classname
+SV *	function_to_call
+CODE:
+{
+    AV* params = newAV();
+    if (items > 2) {
+	int i;
+	for(i = 2; i < items ; i++) {
+	    av_push(params, ST(i));
+	}
+    }
+    ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params)));
+    XSRETURN(1);
+}
 
-SV *
-self (class)
-		char* class
-	CODE:
-		RETVAL = Perl_thread_self(class);
-	OUTPUT:
-		RETVAL
+void
+ithread_self(char *classname)
+CODE:
+{
+	ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv,classname));
+	XSRETURN(1);
+}
 
 int
-tid (obj)	
-		SV *	obj;
-	CODE:
-		RETVAL = Perl_thread_tid(obj);
-	OUTPUT:
-	RETVAL
+ithread_tid(ithread *thread)
 
 void
-join (obj)
-        SV *    obj
-        PREINIT:
-        I32* temp;
-        PPCODE:
-        temp = PL_markstack_ptr++;
-        Perl_thread_join(obj);
-        if (PL_markstack_ptr != temp) {
-          /* truly void, because dXSARGS not invoked */
-          PL_markstack_ptr = temp;
-          XSRETURN_EMPTY; /* return empty stack */
-        }
-        /* must have used dXSARGS; list context implied */
-        return; /* assume stack size is correct */
+ithread_join(SV *obj)
 
 void
-detach (obj)
-        SV *    obj
-        PREINIT:
-        I32* temp;
-        PPCODE:
-        temp = PL_markstack_ptr++;
-        Perl_thread_detach(obj);
-        if (PL_markstack_ptr != temp) {
-          /* truly void, because dXSARGS not invoked */
-          PL_markstack_ptr = temp;
-          XSRETURN_EMPTY; /* return empty stack */
-        }
-        /* must have used dXSARGS; list context implied */
-        return; /* assume stack size is correct */
+ithread_detach(ithread *thread)
 
 void
-DESTROY (obj)
-        SV *    obj
-        PREINIT:
-        I32* temp;
-        PPCODE:
-        temp = PL_markstack_ptr++;
-        Perl_thread_DESTROY(obj);
-        if (PL_markstack_ptr != temp) {
-          /* truly void, because dXSARGS not invoked */
-          PL_markstack_ptr = temp;
-          XSRETURN_EMPTY; /* return empty stack */
-        }
-        /* must have used dXSARGS; list context implied */
-        return; /* assume stack size is correct */
+ithread_DESTROY(SV *thread)
+
+void
+ithread_CLONE(SV *sv)
+
+BOOT:
+{
+	ithread* thread;
+	PERL_THREAD_ALLOC_SPECIFIC(self_key);
+	MUTEX_INIT(&create_mutex);
+	MUTEX_LOCK(&create_mutex);
+	thread  = PerlMemShared_malloc(sizeof(ithread));
+	Zero(thread,1,ithread);
+	PL_perl_destruct_level = 2;
+	MUTEX_INIT(&thread->mutex);
+	threads = thread;
+	thread->next = thread;
+        thread->prev = thread;
+	thread->interp = aTHX;
+	thread->count  = 1;  /* imortal */
+	thread->tid = tid_counter++;
+	thread->detached = 1;
+#ifdef WIN32
+	thread->thr = GetCurrentThreadId();
+#else
+	thread->thr = pthread_self();
+#endif
+	PERL_THREAD_SETSPECIFIC(self_key,thread);
+	MUTEX_UNLOCK(&create_mutex);
+}
+
 
diff --git a/ext/threads/typemap b/ext/threads/typemap
new file mode 100644
index 0000000000..269d412ae6
--- /dev/null
+++ b/ext/threads/typemap
@@ -0,0 +1,9 @@
+ithread *	T_ITHREAD
+
+INPUT
+T_ITHREAD
+	$var = SV_to_ithread(aTHX_ $arg)
+
+OUTPUT
+T_ITHREAD
+	ithread_to_SV(aTHX_ $arg, $var, classname, TRUE);
diff --git a/global.sym b/global.sym
index e64508b793..df840d92d3 100644
--- a/global.sym
+++ b/global.sym
@@ -594,13 +594,9 @@ Perl_sys_intern_clear
 Perl_sys_intern_init
 Perl_custom_op_name
 Perl_custom_op_desc
-Perl_sharedsv_init
-Perl_sharedsv_new
-Perl_sharedsv_find
-Perl_sharedsv_lock
-Perl_sharedsv_unlock
-Perl_sharedsv_thrcnt_inc
-Perl_sharedsv_thrcnt_dec
+Perl_sv_nosharing
+Perl_sv_nolocking
+Perl_sv_nounlocking
 Perl_sv_setsv_flags
 Perl_sv_catpvn_flags
 Perl_sv_catsv_flags
diff --git a/intrpvar.h b/intrpvar.h
index 00005963b5..dccbdb65b6 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -490,9 +490,6 @@ PERLVAR(Iregex_padav,   AV*)		/* All regex objects */
 PERLVAR(Ireentrant_buffer, REBUF*)	/* here we store the _r buffers */
 #endif
 
-PERLVAR(sharedsv_space,		PerlInterpreter*)
-PERLVAR(sharedsv_space_mutex,	perl_mutex)
-
 #endif
 
 PERLVAR(Isavebegin,     bool)	/* save BEGINs for compiler	*/
diff --git a/mg.c b/mg.c
index c7ebca3817..36026431d5 100644
--- a/mg.c
+++ b/mg.c
@@ -319,7 +319,11 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
     int count = 0;
     MAGIC* mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	if (isUPPER(mg->mg_type)) {
+	MGVTBL* vtbl = mg->mg_virtual;
+	if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
+	    count += CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv, key, klen);
+	}
+	else if (isUPPER(mg->mg_type)) {
 	    sv_magic(nsv,
 		     mg->mg_type == PERL_MAGIC_tied ? SvTIED_obj(sv, mg) :
 		     (mg->mg_type == PERL_MAGIC_regdata && mg->mg_obj)
diff --git a/mg.h b/mg.h
index 0048803440..566ced70fc 100644
--- a/mg.h
+++ b/mg.h
@@ -16,6 +16,9 @@ struct mgvtbl {
     U32		(CPERLscope(*svt_len))	(pTHX_ SV *sv, MAGIC* mg);
     int		(CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg);
     int		(CPERLscope(*svt_free))	(pTHX_ SV *sv, MAGIC* mg);
+    int		(CPERLscope(*svt_copy))	(pTHX_ SV *sv, MAGIC* mg,
+    					SV *nsv, const char *name, int namlen);
+    int		(CPERLscope(*svt_dup))	(pTHX_ MAGIC *mg, CLONE_PARAMS *param);
 };
 #endif
 
@@ -33,6 +36,8 @@ struct magic {
 #define MGf_TAINTEDDIR 1
 #define MGf_REFCOUNTED 2
 #define MGf_GSKIP      4
+#define MGf_COPY       8
+#define MGf_DUP        16
 
 #define MGf_MINMATCH   1
 
diff --git a/perl.h b/perl.h
index 11cac10a00..e2b3419fcd 100644
--- a/perl.h
+++ b/perl.h
@@ -2149,7 +2149,6 @@ typedef I32 (*filter_t) (pTHX_ int, SV *, int);
 #include "scope.h"
 #include "warnings.h"
 #include "utf8.h"
-#include "sharedsv.h"
 
 /* Current curly descriptor */
 typedef struct curcur CURCUR;
@@ -2514,7 +2513,9 @@ Gid_t getegid (void);
 #define PERL_MAGIC_nkeys	  'k' /* scalar(keys()) lvalue */
 #define PERL_MAGIC_dbfile	  'L' /* Debugger %_<filename */
 #define PERL_MAGIC_dbline	  'l' /* Debugger %_<filename element */
-#define PERL_MAGIC_mutex	  'm' /* ??? */
+#define PERL_MAGIC_mutex	  'm' /* for lock op */
+#define PERL_MAGIC_shared	  'N' /* Shared between threads */
+#define PERL_MAGIC_shared_scalar  'n' /* Shared between threads */
 #define PERL_MAGIC_collxfrm	  'o' /* Locale transformation */
 #define PERL_MAGIC_tied		  'P' /* Tied array or hash */
 #define PERL_MAGIC_tiedelem	  'p' /* Tied array or hash element */
@@ -2524,6 +2525,7 @@ Gid_t getegid (void);
 #define PERL_MAGIC_sigelem	  's' /* %SIG hash element */
 #define PERL_MAGIC_taint	  't' /* Taintedness */
 #define PERL_MAGIC_uvar		  'U' /* Available for use by extensions */
+#define PERL_MAGIC_uvar_elem	  'u' /* Reserved for use by extensions */
 #define PERL_MAGIC_vec		  'v' /* vec() lvalue */
 #define PERL_MAGIC_substr	  'x' /* substr() lvalue */
 #define PERL_MAGIC_defelem	  'y' /* Shadow "foreach" iterator variable /
@@ -2531,7 +2533,7 @@ Gid_t getegid (void);
 #define PERL_MAGIC_glob		  '*' /* GV (typeglob) */
 #define PERL_MAGIC_arylen	  '#' /* Array length ($#ary) */
 #define PERL_MAGIC_pos		  '.' /* pos() lvalue */
-#define PERL_MAGIC_backref	  '<' /* ??? */
+#define PERL_MAGIC_backref	  '<' /* for weak ref data */
 #define PERL_MAGIC_ext		  '~' /* Available for use by extensions */
 
 
@@ -2762,6 +2764,7 @@ typedef Sighandler_t Sigsave_t;
 
 
 typedef int (CPERLscope(*runops_proc_t)) (pTHX);
+typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
 typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
 
 /* _ (for $_) must be first in the following list (DEFSV requires it) */
@@ -3325,7 +3328,7 @@ START_EXTERN_C
 
 #ifdef DOINIT
 
-EXT MGVTBL PL_vtbl_sv =	{MEMBER_TO_FPTR(Perl_magic_get),
+EXT MGVTBL PL_vtbl_sv =		{MEMBER_TO_FPTR(Perl_magic_get),
 				MEMBER_TO_FPTR(Perl_magic_set),
 					MEMBER_TO_FPTR(Perl_magic_len),
 						0,	0};
@@ -3344,10 +3347,12 @@ EXT MGVTBL PL_vtbl_sigelem =	{MEMBER_TO_FPTR(Perl_magic_getsig),
 					0,	MEMBER_TO_FPTR(Perl_magic_clearsig),
 							0};
 #endif
-EXT MGVTBL PL_vtbl_pack =	{0,	0,	MEMBER_TO_FPTR(Perl_magic_sizepack),	MEMBER_TO_FPTR(Perl_magic_wipepack),
+EXT MGVTBL PL_vtbl_pack =	{0,	0,	
+    				MEMBER_TO_FPTR(Perl_magic_sizepack),	
+				MEMBER_TO_FPTR(Perl_magic_wipepack),
 							0};
 EXT MGVTBL PL_vtbl_packelem =	{MEMBER_TO_FPTR(Perl_magic_getpack),
-				MEMBER_TO_FPTR(Perl_magic_setpack),
+					MEMBER_TO_FPTR(Perl_magic_setpack),
 					0,	MEMBER_TO_FPTR(Perl_magic_clearpack),
 							0};
 EXT MGVTBL PL_vtbl_dbline =	{0,	MEMBER_TO_FPTR(Perl_magic_setdbline),
@@ -3368,12 +3373,14 @@ EXT MGVTBL PL_vtbl_mglob =	{0,	MEMBER_TO_FPTR(Perl_magic_setmglob),
 EXT MGVTBL PL_vtbl_nkeys =	{MEMBER_TO_FPTR(Perl_magic_getnkeys),
 				MEMBER_TO_FPTR(Perl_magic_setnkeys),
 					0,	0,	0};
-EXT MGVTBL PL_vtbl_taint =	{MEMBER_TO_FPTR(Perl_magic_gettaint),MEMBER_TO_FPTR(Perl_magic_settaint),
+EXT MGVTBL PL_vtbl_taint =	{MEMBER_TO_FPTR(Perl_magic_gettaint),
+    					MEMBER_TO_FPTR(Perl_magic_settaint),
 					0,	0,	0};
-EXT MGVTBL PL_vtbl_substr =	{MEMBER_TO_FPTR(Perl_magic_getsubstr), MEMBER_TO_FPTR(Perl_magic_setsubstr),
+EXT MGVTBL PL_vtbl_substr =	{MEMBER_TO_FPTR(Perl_magic_getsubstr),
+    					MEMBER_TO_FPTR(Perl_magic_setsubstr),
 					0,	0,	0};
 EXT MGVTBL PL_vtbl_vec =	{MEMBER_TO_FPTR(Perl_magic_getvec),
-				MEMBER_TO_FPTR(Perl_magic_setvec),
+					MEMBER_TO_FPTR(Perl_magic_setvec),
 					0,	0,	0};
 EXT MGVTBL PL_vtbl_pos =	{MEMBER_TO_FPTR(Perl_magic_getpos),
 				MEMBER_TO_FPTR(Perl_magic_setpos),
@@ -3386,9 +3393,11 @@ EXT MGVTBL PL_vtbl_uvar =	{MEMBER_TO_FPTR(Perl_magic_getuvar),
 				MEMBER_TO_FPTR(Perl_magic_setuvar),
 					0,	0,	0};
 #ifdef USE_5005THREADS
-EXT MGVTBL PL_vtbl_mutex =	{0,	0,	0,	0,	MEMBER_TO_FPTR(Perl_magic_mutexfree)};
+EXT MGVTBL PL_vtbl_mutex =	{0,	0,	0,	0,	
+					MEMBER_TO_FPTR(Perl_magic_mutexfree)};
 #endif /* USE_5005THREADS */
-EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),MEMBER_TO_FPTR(Perl_magic_setdefelem),
+EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),
+    					MEMBER_TO_FPTR(Perl_magic_setdefelem),
 					0,	0,	0};
 
 EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
diff --git a/perlapi.h b/perlapi.h
index 76eb92f2c5..82761a4618 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -941,6 +941,8 @@ END_EXTERN_C
 #define PL_do_undump		(*Perl_Gdo_undump_ptr(NULL))
 #undef  PL_hexdigit
 #define PL_hexdigit		(*Perl_Ghexdigit_ptr(NULL))
+#undef  PL_lockhook
+#define PL_lockhook		(*Perl_Glockhook_ptr(NULL))
 #undef  PL_malloc_mutex
 #define PL_malloc_mutex		(*Perl_Gmalloc_mutex_ptr(NULL))
 #undef  PL_op_mutex
@@ -951,12 +953,12 @@ END_EXTERN_C
 #define PL_runops_dbg		(*Perl_Grunops_dbg_ptr(NULL))
 #undef  PL_runops_std
 #define PL_runops_std		(*Perl_Grunops_std_ptr(NULL))
-#undef  PL_sharedsv_space
-#define PL_sharedsv_space	(*Perl_Gsharedsv_space_ptr(NULL))
-#undef  PL_sharedsv_space_mutex
-#define PL_sharedsv_space_mutex	(*Perl_Gsharedsv_space_mutex_ptr(NULL))
+#undef  PL_sharehook
+#define PL_sharehook		(*Perl_Gsharehook_ptr(NULL))
 #undef  PL_thr_key
 #define PL_thr_key		(*Perl_Gthr_key_ptr(NULL))
+#undef  PL_unlockhook
+#define PL_unlockhook		(*Perl_Gunlockhook_ptr(NULL))
 
 #endif /* !PERL_CORE */
 #endif /* MULTIPLICITY */
diff --git a/perlvars.h b/perlvars.h
index 606f7a5243..8cff1657dc 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -37,11 +37,14 @@ PERLVAR(Gmalloc_mutex,	perl_mutex)	/* Mutex for malloc */
 
 #if defined(USE_ITHREADS)
 PERLVAR(Gop_mutex,	perl_mutex)	/* Mutex for op refcounting */
-PERLVAR(Gsharedsv_space, PerlInterpreter*) /* The shared sv space */
-PERLVAR(Gsharedsv_space_mutex, perl_mutex) /* Mutex protecting the shared sv space */
 #endif
 
 /* Force inclusion of both runops options */
 PERLVARI(Grunops_std,	runops_proc_t,	MEMBER_TO_FPTR(Perl_runops_standard))
 PERLVARI(Grunops_dbg,	runops_proc_t,	MEMBER_TO_FPTR(Perl_runops_debug))
 
+/* Hooks to shared SVs and locks. */
+PERLVARI(Gsharehook,	share_proc_t,	MEMBER_TO_FPTR(Perl_sv_nosharing))
+PERLVARI(Glockhook,	share_proc_t,	MEMBER_TO_FPTR(Perl_sv_nolocking))
+PERLVARI(Gunlockhook,	share_proc_t,	MEMBER_TO_FPTR(Perl_sv_nounlocking))
+
diff --git a/pp.c b/pp.c
index 0d7f75bbd3..ef0c75e9d5 100644
--- a/pp.c
+++ b/pp.c
@@ -1006,7 +1006,7 @@ PP(pp_divide)
 {
     dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
     /* Only try to do UV divide first
-       if ((SLOPPYDIVIDE is true) or 
+       if ((SLOPPYDIVIDE is true) or
            (PERL_PRESERVE_IVUV is true and one or both SV is a UV too large
             to preserve))
        The assumption is that it is better to use floating point divide
@@ -2702,7 +2702,7 @@ PP(pp_int)
 #   if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
 #       ifdef HAS_MODFL_POW32_BUG
 /* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
-                { 
+                {
                     NV offset = Perl_modf(value, &value);
                     (void)Perl_modf(offset, &offset);
                     value += offset;
@@ -3134,7 +3134,7 @@ PP(pp_ord)
     }
 
     XPUSHu(DO_UTF8(argsv) ? utf8_to_uvchr(s, 0) : (*s & 0xff));
-    
+
     RETURN;
 }
 
@@ -3183,7 +3183,7 @@ PP(pp_crypt)
 	  * If not possible, croak.
 	  * Yes, we made this up.  */
          SV* tsv = sv_2mortal(newSVsv(left));
-	 
+	
 	 SvUTF8_on(tsv);
 	 if (!sv_utf8_downgrade(tsv, FALSE))
 	      Perl_croak(aTHX_ "Wide character in crypt");
@@ -4541,14 +4541,7 @@ PP(pp_lock)
     dSP;
     dTOPss;
     SV *retsv = sv;
-#ifdef USE_5005THREADS
-    sv_lock(sv);
-#endif /* USE_5005THREADS */
-#ifdef USE_ITHREADS
-    shared_sv *ssv = Perl_sharedsv_find(aTHX_ sv);
-    if(ssv)
-        Perl_sharedsv_lock(aTHX_ ssv);
-#endif /* USE_ITHREADS */
+    SvLOCK(sv);
     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
 	|| SvTYPE(retsv) == SVt_PVCV) {
 	retsv = refto(retsv);
diff --git a/proto.h b/proto.h
index b93bb2c525..f2f8fe00fb 100644
--- a/proto.h
+++ b/proto.h
@@ -980,6 +980,9 @@ PERL_CALLCONV void	Perl_sys_intern_init(pTHX);
 PERL_CALLCONV char *	Perl_custom_op_name(pTHX_ OP* op);
 PERL_CALLCONV char *	Perl_custom_op_desc(pTHX_ OP* op);
 
+PERL_CALLCONV void	Perl_sv_nosharing(pTHX_ SV *);
+PERL_CALLCONV void	Perl_sv_nolocking(pTHX_ SV *);
+PERL_CALLCONV void	Perl_sv_nounlocking(pTHX_ SV *);
 
 END_EXTERN_C
 
@@ -1189,17 +1192,6 @@ STATIC void	S_debprof(pTHX_ OP *o);
 STATIC SV*	S_save_scalar_at(pTHX_ SV **sptr);
 #endif
 
-#if defined(USE_ITHREADS)
-PERL_CALLCONV void	Perl_sharedsv_init(pTHX);
-PERL_CALLCONV shared_sv*	Perl_sharedsv_new(pTHX);
-PERL_CALLCONV shared_sv*	Perl_sharedsv_find(pTHX_ SV* sv);
-PERL_CALLCONV void	Perl_sharedsv_lock(pTHX_ shared_sv* ssv);
-PERL_CALLCONV void	Perl_sharedsv_unlock(pTHX_ shared_sv* ssv);
-PERL_CALLCONV void	Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv);
-PERL_CALLCONV void	Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv);
-PERL_CALLCONV void	Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv);
-#endif
-
 #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
 STATIC IV	S_asIV(pTHX_ SV* sv);
 STATIC UV	S_asUV(pTHX_ SV* sv);
diff --git a/sharedsv.c b/sharedsv.c
deleted file mode 100644
index f0cba10d98..0000000000
--- a/sharedsv.c
+++ /dev/null
@@ -1,244 +0,0 @@
-/*    sharedsv.c
- *
- *    Copyright (c) 2001, Larry Wall
- *
- *    You may distribute under the terms of either the GNU General Public
- *    License or the Artistic License, as specified in the README file.
- *
- */
-
-/*
-* Contributed by Arthur Bergman arthur@contiller.se
-*
-* "Hand any two wizards a piece of rope and they would instinctively pull in
-* opposite directions."
-*                         --Sourcery
-*
-*/
-
-#include "EXTERN.h"
-#define PERL_IN_SHAREDSV_C
-#include "perl.h"
-
-#ifdef USE_ITHREADS
-
-
-
-/*
-  Shared SV
-
-  Shared SV is a structure for keeping the backend storage
-  of shared svs.
-
- */
-
-/*
-=head1 Shared SV Functions
-
-=for apidoc sharedsv_init
-
-Saves a space for keeping SVs wider than an interpreter,
-currently only stores a pointer to the first interpreter.
-
-=cut
-*/
-
-void
-Perl_sharedsv_init(pTHX)
-{
-  PerlInterpreter* old_context = PERL_GET_CONTEXT;
-  PL_sharedsv_space = perl_alloc();
-  perl_construct(PL_sharedsv_space);
-  PERL_SET_CONTEXT(old_context);
-  MUTEX_INIT(&PL_sharedsv_space_mutex);
-}
-
-/*
-=for apidoc sharedsv_new
-
-Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
-=cut
-*/
-
-shared_sv *
-Perl_sharedsv_new(pTHX)
-{
-    shared_sv* ssv;
-    New(2555,ssv,1,shared_sv);
-    MUTEX_INIT(&ssv->mutex);
-    COND_INIT(&ssv->cond);
-    COND_INIT(&ssv->user_cond);
-    ssv->owner = 0;
-    ssv->locks = 0;
-    ssv->index = 0;
-    return ssv;
-}
-
-
-/*
-=for apidoc sharedsv_find
-
-Tries to find if a given SV has a shared backend, either by
-looking at magic, or by checking if it is tied again threads::shared.
-
-=cut
-*/
-
-shared_sv *
-Perl_sharedsv_find(pTHX_ SV* sv)
-{
-  /* does all it can to find a shared_sv struct, returns NULL otherwise */
-    shared_sv* ssv = NULL; 
-    switch (SvTYPE(sv)) {
-        case SVt_PVMG:
-        case SVt_PVAV:
-        case SVt_PVHV: {
-            MAGIC* mg = mg_find(sv, PERL_MAGIC_ext);
-            if(mg) {
-	        if(strcmp(mg->mg_ptr,"threads::shared"))
-                    break;
-                ssv = INT2PTR(shared_sv *, SvIV(mg->mg_obj));
-	        break;
-             }
-	    
-	     mg = mg_find(sv,PERL_MAGIC_tied);
-             if(mg) {
-                 SV* obj = SvTIED_obj(sv,mg);
-	         if(sv_derived_from(obj, "threads::shared"))
-                     ssv = INT2PTR(shared_sv *, SvIV(SvRV(obj)));
-                 break;
-             }
-	}
-    }            
-    return ssv;
-}
-
-/*
-=for apidoc sharedsv_lock
-
-Recursive locks on a sharedsv.
-Locks are dynamically scoped at the level of the first lock.
-=cut
-*/
-void
-Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
-{
-    if(!ssv)
-        return;
-    MUTEX_LOCK(&ssv->mutex);
-    if(ssv->owner && ssv->owner == my_perl) {
-        ssv->locks++;
-	MUTEX_UNLOCK(&ssv->mutex);
-        return;
-    }
-    while(ssv->owner) 
-      COND_WAIT(&ssv->cond,&ssv->mutex);
-    ssv->locks++;
-    ssv->owner = my_perl;
-    if(ssv->locks == 1)
-        SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
-    MUTEX_UNLOCK(&ssv->mutex);
-}
-
-/*
-=for apidoc sharedsv_unlock
-
-Recursively unlocks a shared sv.
-
-=cut
-*/
-
-void
-Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
-{
-    MUTEX_LOCK(&ssv->mutex);
-    if(ssv->owner != my_perl) {
-        Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
-        MUTEX_UNLOCK(&ssv->mutex); 
-        return;
-    } 
-
-    if(--ssv->locks == 0) {
-        ssv->owner = NULL;
-	COND_SIGNAL(&ssv->cond);
-    }
-    MUTEX_UNLOCK(&ssv->mutex);
- }
-
-void
-Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
-{
-    MUTEX_LOCK(&ssv->mutex);
-    if(ssv->owner != my_perl) {
-        MUTEX_UNLOCK(&ssv->mutex);
-        return;
-    }
-    ssv->locks = 0;
-    ssv->owner = NULL;
-    COND_SIGNAL(&ssv->cond);
-    MUTEX_UNLOCK(&ssv->mutex);
-}
-
-/*
-=for apidoc sharedsv_thrcnt_inc
-
-Increments the threadcount of a sharedsv.
-=cut
-*/
-void
-Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
-{
-  SHAREDSvLOCK(ssv);
-  SvREFCNT_inc(ssv->sv);
-  SHAREDSvUNLOCK(ssv);
-}
-
-/*
-=for apidoc sharedsv_thrcnt_dec
-
-Decrements the threadcount of a shared sv. When a threads frontend is freed
-this function should be called.
-
-=cut
-*/
-
-void
-Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
-{
-    SV* sv;
-    SHAREDSvLOCK(ssv);
-    sv = SHAREDSvGET(ssv);
-    if (SvREFCNT(sv) == 1) {
-        switch (SvTYPE(sv)) {
-        case SVt_RV:
-            if (SvROK(sv))
-            Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
-            break;
-        case SVt_PVAV: {
-            SV **src_ary  = AvARRAY((AV *)sv);
-            SSize_t items = AvFILLp((AV *)sv) + 1;
-
-            while (items-- > 0) {
-            if(SvTYPE(*src_ary))
-                Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary)));
-                src_ary++;
-            }
-            break;
-        }
-        case SVt_PVHV: {
-            HE *entry;
-            (void)hv_iterinit((HV *)sv);
-            while ((entry = hv_iternext((HV *)sv)))
-                Perl_sharedsv_thrcnt_dec(
-                    aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
-                );
-            break;
-        }
-        }
-    }
-    Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
-    SHAREDSvUNLOCK(ssv);
-}
-
-#endif /* USE_ITHREADS */
-
diff --git a/sharedsv.h b/sharedsv.h
deleted file mode 100644
index f82804dba4..0000000000
--- a/sharedsv.h
+++ /dev/null
@@ -1,29 +0,0 @@
-#ifdef USE_ITHREADS
-
-typedef struct {
-    SV                 *sv;             /* The actual SV */
-    perl_mutex          mutex;          /* Our mutex */
-    perl_cond           cond;           /* Our condition variable */
-    perl_cond           user_cond;      /* For user-level conditions */
-    IV                  locks;          /* Number of locks held */
-    PerlInterpreter    *owner;          /* Who owns the lock? */
-    U16                 index;          /* Update index */
-} shared_sv;
-
-#define SHAREDSvGET(a)      (a->sv)
-#define SHAREDSvLOCK(a)     Perl_sharedsv_lock(aTHX_ a)
-#define SHAREDSvUNLOCK(a)   Perl_sharedsv_unlock(aTHX_ a)
-
-#define SHAREDSvEDIT(a)     STMT_START {                                \
-                                MUTEX_LOCK(&PL_sharedsv_space_mutex);   \
-                                SHAREDSvLOCK((a));                      \
-                                PERL_SET_CONTEXT(PL_sharedsv_space);    \
-                            } STMT_END
-
-#define SHAREDSvRELEASE(a)  STMT_START {                                \
-                                PERL_SET_CONTEXT((a)->owner);           \
-                                SHAREDSvUNLOCK((a));                    \
-                                MUTEX_UNLOCK(&PL_sharedsv_space_mutex); \
-                            } STMT_END
-
-#endif /* USE_ITHREADS */
diff --git a/sv.c b/sv.c
index 2fbabb0214..89633b5de9 100644
--- a/sv.c
+++ b/sv.c
@@ -4418,17 +4418,16 @@ Perl_newSV(pTHX_ STRLEN len)
 /*
 =for apidoc sv_magicext
 
-Adds magic to an SV, upgrading it if necessary. Applies the 
+Adds magic to an SV, upgrading it if necessary. Applies the
 supplied vtable and returns pointer to the magic added.
 
 Note that sv_magicext will allow things that sv_magic will not.
-In particular you can add magic to SvREADONLY SVs and and more than 
+In particular you can add magic to SvREADONLY SVs and and more than
 one instance of the same 'how'
 
 I C<namelen> is greater then zero then a savepvn() I<copy> of C<name> is stored,
-(if C<name> is NULL then namelen bytes are allocated and Zero()-ed),
-if C<namelen> is zero then C<name> is stored as-is and - as another special 
-case - if C<(name && namelen == HEf_SVKEY)> then C<name> is assumed to contain 
+if C<namelen> is zero then C<name> is stored as-is and - as another special
+case - if C<(name && namelen == HEf_SVKEY)> then C<name> is assumed to contain
 an C<SV*> and has its REFCNT incremented
 
 (This is now used as a subroutine by sv_magic.)
@@ -4440,7 +4439,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
 		 const char* name, I32 namlen)
 {
     MAGIC* mg;
-    
+
     if (SvTYPE(sv) < SVt_PVMG) {
 	(void)SvUPGRADE(sv, SVt_PVMG);
     }
@@ -4473,11 +4472,11 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
 	    mg->mg_ptr = savepvn(name, namlen);
 	else if (namlen == HEf_SVKEY)
 	    mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name);
-	else 
+	else
 	    mg->mg_ptr = (char *) name;
     }
     mg->mg_virtual = vtable;
-    
+
     mg_magical(sv);
     if (SvGMAGICAL(sv))
 	SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
@@ -4495,7 +4494,7 @@ then adds a new magic item of type C<how> to the head of the magic list.
 
 void
 Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
-{ 
+{
     MAGIC* mg;
     MGVTBL *vtable = 0;
 
@@ -4512,15 +4511,15 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     }
     if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) {
 	if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
-	    /* sv_magic() refuses to add a magic of the same 'how' as an 
-	       existing one 
+	    /* sv_magic() refuses to add a magic of the same 'how' as an
+	       existing one
 	     */
 	    if (how == PERL_MAGIC_taint)
 		mg->mg_len |= 1;
 	    return;
 	}
     }
-        
+
     switch (how) {
     case PERL_MAGIC_sv:
 	vtable = &PL_vtbl_sv;
@@ -4632,10 +4631,10 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     default:
 	Perl_croak(aTHX_ "Don't know how to handle magic of type \\%o", how);
     }
-    
+
     /* Rest of work is done else where */
     mg = sv_magicext(sv,obj,how,vtable,name,namlen);
-    
+
     switch (how) {
     case PERL_MAGIC_taint:
 	mg->mg_len = 1;
@@ -8702,7 +8701,7 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
 	nmg->mg_len	= mg->mg_len;
 	nmg->mg_ptr	= mg->mg_ptr;	/* XXX random ptr? */
 	if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
-	    if (mg->mg_len >= 0) {
+	    if (mg->mg_len > 0) {
 		nmg->mg_ptr	= SAVEPVN(mg->mg_ptr, mg->mg_len);
 		if (mg->mg_type == PERL_MAGIC_overload_table &&
 			AMT_AMAGIC((AMT*)mg->mg_ptr))
@@ -8718,6 +8717,9 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
 	    else if (mg->mg_len == HEf_SVKEY)
 		nmg->mg_ptr	= (char*)sv_dup_inc((SV*)mg->mg_ptr, param);
 	}
+	if ((mg->mg_flags & MGf_DUP) && mg->mg_virtual && mg->mg_virtual->svt_dup) {
+	    CALL_FPTR(nmg->mg_virtual->svt_dup)(aTHX_ nmg, param);
+	}
 	mgprev = nmg;
     }
     return mgret;
@@ -8938,9 +8940,9 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
     else if (SvPVX(sstr)) {
 	/* Has something there */
 	if (SvLEN(sstr)) {
-	    /* Normal PV - clone whole allocated space */ 
+	    /* Normal PV - clone whole allocated space */
 	    SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
-	}  
+	}
 	else {
 	    /* Special case - not normally malloced for some reason */
 	    if (SvREADONLY(sstr) && SvFAKE(sstr)) {
@@ -10494,3 +10496,4 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
      return SvPVX(sv);
 }
 
+
diff --git a/sv.h b/sv.h
index 7c07988518..8414124add 100644
--- a/sv.h
+++ b/sv.h
@@ -1167,6 +1167,18 @@ Like C<SvSetSV>, but does any set magic required afterwards.
 =for apidoc Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv
 Like C<SvSetMagicSV>, but does any set magic required afterwards.
 
+=for apidoc Am|void|SvSHARE|SV* sv
+Arranges for sv to be shared between threads if a suitable module
+has been loaded.
+
+=for apidoc Am|void|SvLOCK|SV* sv
+Arranges for a mutual exclusion lock to be obtained on sv if a suitable module
+has been loaded.
+
+=for apidoc Am|void|SvUNLOCK|SV* sv
+Releases a mutual exclusion lock on sv if a suitable module
+has been loaded.
+
 =head1 SV Manipulation Functions
 
 =for apidoc Am|char *|SvGROW|SV* sv|STRLEN len
@@ -1178,6 +1190,10 @@ Returns a pointer to the character buffer.
 =cut
 */
 
+#define SvSHARE(sv) CALL_FPTR(PL_sharehook)(aTHX_ sv)
+#define SvLOCK(sv) CALL_FPTR(PL_lockhook)(aTHX_ sv)
+#define SvUNLOCK(sv) CALL_FPTR(PL_unlockhook)(aTHX_ sv)
+
 #define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
 #define SvSETMAGIC(x) STMT_START { if (SvSMAGICAL(x)) mg_set(x); } STMT_END
 
diff --git a/util.c b/util.c
index a816cb99ba..46b9ac1e2e 100644
--- a/util.c
+++ b/util.c
@@ -4273,3 +4273,52 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
 }
 #endif
 
+/*
+
+=for apidoc sv_nosharing
+
+Dummy routine which "shares" an SV when there is no sharing module present.
+Exists to avoid test for a NULL function pointer and because it could potentially warn under
+some level of strict-ness.
+
+=cut
+*/
+
+void
+Perl_sv_nosharing(pTHX_ SV *sv)
+{
+}
+
+/*
+=for apidoc sv_nolocking
+
+Dummy routine which "locks" an SV when there is no locking module present.
+Exists to avoid test for a NULL function pointer and because it could potentially warn under
+some level of strict-ness.
+
+=cut
+*/
+
+void
+Perl_sv_nolocking(pTHX_ SV *sv)
+{
+}
+
+
+/*
+=for apidoc sv_nounlocking
+
+Dummy routine which "unlocks" an SV when there is no locking module present.
+Exists to avoid test for a NULL function pointer and because it could potentially warn under
+some level of strict-ness.
+
+=cut
+*/
+
+void
+Perl_sv_nounlocking(pTHX_ SV *sv)
+{
+}
+
+
+