Shared scalars working, some shared array ops working.

p4raw-id: //depot/perlio@14377

6 files changed, 196 insertions, 129 deletions

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index 8baa5033b5..56bc71ba3d 100644
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -1,14 +1,18 @@
 package threads::shared;
-
 use strict;
 use warnings;
 use Config;
-use Scalar::Util qw(weaken);
-use attributes qw(reftype);
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock);
+our $VERSION = '0.90';
+
+use XSLoader;
+XSLoader::load('threads::shared',$VERSION);
 
 BEGIN {
-    if ($Config{'useithreads'} && $threads::threads) {
-	*share = \&share_enabled;
+    if ($Config{'useithreads'}) {
 	*cond_wait = \&cond_wait_enabled;
 	*cond_signal = \&cond_signal_enabled;
 	*cond_broadcast = \&cond_broadcast_enabled;
@@ -22,14 +26,6 @@ BEGIN {
     }
 }
 
-require Exporter;
-require DynaLoader;
-our @ISA = qw(Exporter DynaLoader);
-
-our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock);
-our $VERSION = '0.90';
-
-our %shared;
 
 sub cond_wait_disabled { return @_ };
 sub cond_signal_disabled { return @_};
@@ -38,58 +34,8 @@ sub unlock_disabled { 1 };
 sub lock_disabled { 1 }
 sub share_disabled { return @_}
 
-sub share_enabled (\[$@%]) { # \]
-    my $value = $_[0];
-    my $ref = reftype($value);
-    if($ref eq 'SCALAR') {
-	my $obj = \threads::shared::sv->new($$value);
-	bless $obj, 'threads::shared::sv';
-	$shared{$$obj} = $value;
-	weaken($shared{$$obj});
-    } elsif($ref eq "ARRAY") {
-	tie @$value, 'threads::shared::av', $value;
-    } elsif($ref eq "HASH") {
-	tie %$value, "threads::shared::hv", $value;
-    } else {
-	die "You cannot share ref of type $_[0]\n";
-    }
-}
-
-
-package threads::shared::sv;
-use base 'threads::shared';
-
-sub DESTROY {}
-
-package threads::shared::av;
-use base 'threads::shared';
-use Scalar::Util qw(weaken);
-sub TIEARRAY {
-	my $class = shift;
-        my $value = shift;
-	my $self = bless \threads::shared::av->new($value),'threads::shared::av';
-	$shared{$self->ptr} = $value;
-	weaken($shared{$self->ptr});
-	return $self;
-}
-
-package threads::shared::hv;
-use base 'threads::shared';
-use Scalar::Util qw(weaken);
-sub TIEHASH {
-    my $class = shift;
-    my $value = shift;
-    my $self = bless \threads::shared::hv->new($value),'threads::shared::hv';
-    $shared{$self->ptr} = $value;
-    weaken($shared{$self->ptr});
-    return $self;
-}
-
-package threads::shared;
-
 $threads::shared::threads_shared = 1;
 
-bootstrap threads::shared $VERSION;
 
 __END__
 
diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 79cebfa7b5..56ac88dd14 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -41,9 +41,18 @@ PerlInterpreter *PL_sharedsv_space;             /* The shared sv space */
  * Only one thread at a time is allowed to mess with shared space.
  */
 perl_mutex       PL_sharedsv_space_mutex;       /* Mutex protecting the shared sv space */
+PerlInterpreter  *PL_shared_owner;              /* For locking assertions */
+
+#define SHARED_LOCK         STMT_START { \
+			      MUTEX_LOCK(&PL_sharedsv_space_mutex);      \
+			      PL_shared_owner = aTHX;                    \
+                            } STMT_END
+
+#define SHARED_UNLOCK       STMT_START { \
+			      PL_shared_owner = NULL;                    \
+			      MUTEX_UNLOCK(&PL_sharedsv_space_mutex);    \
+                            } STMT_END
 
-#define SHARED_LOCK         MUTEX_LOCK(&PL_sharedsv_space_mutex)
-#define SHARED_UNLOCK       MUTEX_UNLOCK(&PL_sharedsv_space_mutex)
 
 /* A common idiom is to acquire access and switch in ... */
 #define SHARED_EDIT	    STMT_START {	\
@@ -92,6 +101,7 @@ sharedsv_shared_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
     shared_sv *shared = (shared_sv *) mg->mg_ptr;
     if (shared) {
+	PerlIO_debug(__FUNCTION__ "Free %p\n",shared);
 	PerlMemShared_free(shared);
 	mg->mg_ptr = NULL;
     }
@@ -136,18 +146,21 @@ shared_sv *
 Perl_sharedsv_find(pTHX_ SV *sv)
 {
     MAGIC *mg;
-    switch(SvTYPE(sv)) {
-    case SVt_PVAV:
-    case SVt_PVHV:
-	if ((mg = mg_find(sv, PERL_MAGIC_tied))
-	    	&& mg->mg_virtual == &sharedsv_array_vtbl) {
+    if (SvTYPE(sv) >= SVt_PVMG) {
+	switch(SvTYPE(sv)) {
+	case SVt_PVAV:
+	case SVt_PVHV:
+	    if ((mg = mg_find(sv, PERL_MAGIC_tied))
+		&& mg->mg_virtual == &sharedsv_array_vtbl) {
 		return (shared_sv *) mg->mg_ptr;
 	    }
 	    break;
-    default:
-	if ((mg = mg_find(sv, PERL_MAGIC_shared_scalar))
-	    	&& mg->mg_virtual == &sharedsv_scalar_vtbl) {
+	default:
+	    if ((mg = mg_find(sv, PERL_MAGIC_shared_scalar))
+		&& mg->mg_virtual == &sharedsv_scalar_vtbl) {
 		return (shared_sv *) mg->mg_ptr;
+		}
+	    break;
 	}
     }
     return NULL;
@@ -163,22 +176,26 @@ Perl_sharedsv_associate(pTHX_ SV **psv, SV *ssv, shared_sv *data)
 {
     /* First try and get global data structure */
     dTHXc;
-    MAGIC *mg;
+    MAGIC *mg = 0;
     SV *sv;
-    if (aTHX == PL_sharedsv_space) {
-	croak("panic:Cannot associate from within shared space");
-    }
-    SHARED_LOCK;
+
+    /* If we are asked for an private ops we need a thread */
+    assert ( aTHX !=  PL_sharedsv_space );
+
+    /* To avoid need for recursive locks require caller to hold lock */
+    if ( PL_shared_owner != aTHX )
+     abort();
+    assert ( PL_shared_owner == aTHX );
 
     /* Try shared SV as 1st choice */
-    if (!data && ssv) {
+    if (!data && ssv && SvTYPE(ssv) >= SVt_PVMG) {
 	if (mg = mg_find(ssv, PERL_MAGIC_ext)) {
 	    data = (shared_sv *) mg->mg_ptr;
 	}
     }
     /* Next try private SV */
     if (!data && psv && *psv) {
-	data = Perl_sharedsv_find(aTHX_ *psv);
+	data = Perl_sharedsv_find(aTHX,*psv);
     }
     /* If neither of those then create a new one */
     if (!data) {
@@ -216,35 +233,40 @@ Perl_sharedsv_associate(pTHX_ SV **psv, SV *ssv, shared_sv *data)
     }
 
     /* Finally if private SV exists check and add magic */
-    if (psv && *psv) {
-	SV *sv = *psv;
-	MAGIC *mg;
+    if (psv && (sv = *psv)) {
+	MAGIC *mg = 0;
 	switch(SvTYPE(sv)) {
 	case SVt_PVAV:
 	case SVt_PVHV:
 	    if (!(mg = mg_find(sv, PERL_MAGIC_tied))
 	        || mg->mg_virtual != &sharedsv_array_vtbl) {
+		SV *obj = newSV(0);
+		sv_setref_iv(obj, "threads::shared::tie",PTR2IV(data));
 		if (mg)
 		    sv_unmagic(sv, PERL_MAGIC_tied);
-		mg = sv_magicext(sv, sv, PERL_MAGIC_tied, &sharedsv_array_vtbl,
+		mg = sv_magicext(sv, obj, PERL_MAGIC_tied, &sharedsv_array_vtbl,
 				(char *) data, 0);
 		mg->mg_flags |= (MGf_COPY|MGf_DUP);
+		SvREFCNT_inc(SHAREDSvPTR(data));
+		PerlIO_debug(__FUNCTION__ " %p %d\n",data,SvREFCNT(SHAREDSvPTR(data)));
+		SvREFCNT_dec(obj);
 	    }
 	    break;
 
 	default:
-	    if (!(mg = mg_find(sv, PERL_MAGIC_shared_scalar)) ||
+	    if (SvTYPE(sv) < SVt_PVMG || !(mg = mg_find(sv, PERL_MAGIC_shared_scalar)) ||
 		mg->mg_virtual != &sharedsv_scalar_vtbl) {
 		if (mg)
 		    sv_unmagic(sv, PERL_MAGIC_shared_scalar);
 		mg = sv_magicext(sv, Nullsv, PERL_MAGIC_shared_scalar,
 				&sharedsv_scalar_vtbl, (char *)data, 0);
 		mg->mg_flags |= (MGf_COPY|MGf_DUP);
+		SvREFCNT_inc(SHAREDSvPTR(data));
+		PerlIO_debug(__FUNCTION__ " %p %d\n",data,SvREFCNT(SHAREDSvPTR(data)));
 	    }
 	    break;
 	}
     }
-    SHARED_UNLOCK;
     return data;
 }
 
@@ -272,7 +294,11 @@ Perl_sharedsv_share(pTHX_ SV *sv)
 	break;
 	
     default:
+	SHARED_LOCK;
 	Perl_sharedsv_associate(aTHX_ &sv, 0, 0);
+	SHARED_UNLOCK;
+	SvSETMAGIC(sv);
+	break;
     }
 }
 
@@ -284,15 +310,16 @@ sharedsv_scalar_mg_get(pTHX_ SV *sv, MAGIC *mg)
     shared_sv *shared = (shared_sv *) mg->mg_ptr;
 
     SHARED_LOCK;
-    SvOK_off(sv);
     if (SHAREDSvPTR(shared)) {
 	if (SvROK(SHAREDSvPTR(shared))) {
-	    SV *rv = newRV(Nullsv);
-	    Perl_sharedsv_associate(aTHX_ &SvRV(rv), SvRV(SHAREDSvPTR(shared)), NULL);
-	    sv_setsv(sv, rv);
+	    SV *obj = Nullsv;
+	    Perl_sharedsv_associate(aTHX_ &obj, SvRV(SHAREDSvPTR(shared)), NULL);
+	    sv_setsv_nomg(sv, &PL_sv_undef);
+	    SvRV(sv) = obj;
+	    SvROK_on(sv);
 	}
 	else {
-	    sv_setsv(sv, SHAREDSvPTR(shared));
+	    sv_setsv_nomg(sv, SHAREDSvPTR(shared));
 	}
     }
     SHARED_UNLOCK;
@@ -303,24 +330,29 @@ int
 sharedsv_scalar_mg_set(pTHX_ SV *sv, MAGIC *mg)
 {
     dTHXc;
-    shared_sv *shared = Perl_sharedsv_associate(aTHX_ &sv, Nullsv,
-    			(shared_sv *) mg->mg_ptr);
+    shared_sv *shared;
     bool allowed = TRUE;
+    SHARED_LOCK;
+    shared = Perl_sharedsv_associate(aTHX_ &sv, Nullsv, (shared_sv *) mg->mg_ptr);
 
-    SHARED_EDIT;
     if (SvROK(sv)) {
 	shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
 	if (target) {
-	    SV *tmp = newRV(SHAREDSvPTR(target));
-	    sv_setsv(SHAREDSvPTR(shared), tmp);
+	    SV *tmp;
+	    SHARED_CONTEXT;
+	    tmp = newRV(SHAREDSvPTR(target));
+	    sv_setsv_nomg(SHAREDSvPTR(shared), tmp);
 	    SvREFCNT_dec(tmp);
+	    CALLER_CONTEXT;
 	}
 	else {
 	    allowed = FALSE;
 	}
     }
     else {
-	sv_setsv(SHAREDSvPTR(shared), sv);
+	SHARED_CONTEXT;
+	sv_setsv_nomg(SHAREDSvPTR(shared), sv);
+	CALLER_CONTEXT;
     }
     SHARED_RELEASE;
 
@@ -333,7 +365,18 @@ sharedsv_scalar_mg_set(pTHX_ SV *sv, MAGIC *mg)
 int
 sharedsv_scalar_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
-    Perl_sharedsv_free(aTHX_ (shared_sv *) mg->mg_ptr);
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    PerlIO_debug(__FUNCTION__ " %p %d\n",shared,SvREFCNT(SHAREDSvPTR(shared))-1);
+    assert (SvREFCNT(SHAREDSvPTR(shared)) < 1000);
+    Perl_sharedsv_free(aTHX_ shared);
+    return 0;
+}
+
+int
+sharedsv_scalar_mg_clear(pTHX_ SV *sv, MAGIC *mg)
+{
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    PerlIO_debug(__FUNCTION__ " %p %d\n",shared,SvREFCNT(SHAREDSvPTR(shared)));
     return 0;
 }
 
@@ -347,6 +390,7 @@ sharedsv_scalar_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
     if (shared) {
 	SvREFCNT_inc(SHAREDSvPTR(shared));
     }
+    PerlIO_debug(__FUNCTION__ " %p %d\n",shared,SvREFCNT(SHAREDSvPTR(shared)));
     return 0;
 }
 
@@ -354,7 +398,7 @@ MGVTBL sharedsv_scalar_vtbl = {
  sharedsv_scalar_mg_get,	/* get */
  sharedsv_scalar_mg_set,	/* set */
  0,				/* len */
- 0,				/* clear */
+ sharedsv_scalar_mg_clear,	/* clear */
  sharedsv_scalar_mg_free,	/* free */
  0,				/* copy */
  sharedsv_scalar_mg_dup		/* dup */
@@ -370,23 +414,36 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg)
     shared_sv *target = Perl_sharedsv_find(aTHX_ sv);
     SV** svp;
 
+    assert ( shared );
+    assert ( SHAREDSvPTR(shared) );
+
     SHARED_EDIT;
     if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
-	    svp = av_fetch((AV*) SHAREDSvPTR(shared), mg->mg_len, 0);
+	assert ( mg->mg_ptr == 0 );
+	svp = av_fetch((AV*) SHAREDSvPTR(shared), mg->mg_len, 0);
     }
     else {
+	assert ( mg->mg_ptr != 0 );
 	svp = hv_fetch((HV*) SHAREDSvPTR(shared), mg->mg_ptr, mg->mg_len, 0);
     }
 
     if (svp) {
-	if (SHAREDSvPTR(target) != *svp) {
-	    if (SHAREDSvPTR(target)) {
-		SvREFCNT_dec(SHAREDSvPTR(target));
+	if (target) {
+	    if (SHAREDSvPTR(target) != *svp) {
+		if (SHAREDSvPTR(target)) {
+		    PerlIO_debug(__FUNCTION__ " %p %d\n",shared,SvREFCNT(SHAREDSvPTR(shared)));
+		    SvREFCNT_dec(SHAREDSvPTR(target));
+		}
+		SHAREDSvPTR(target) = SvREFCNT_inc(*svp);
 	    }
-	    SHAREDSvPTR(target) = SvREFCNT_inc(*svp);
+	}
+	else {
+	    CALLER_CONTEXT;
+	    Perl_sharedsv_associate(aTHX_ &sv, *svp, 0);
+	    SHARED_CONTEXT;
 	}
     }
-    else {
+    else if (target) {
 	if (SHAREDSvPTR(target)) {
 	    SvREFCNT_dec(SHAREDSvPTR(target));
 	}
@@ -401,18 +458,22 @@ sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg)
 {
     dTHXc;
     shared_sv *shared = Perl_sharedsv_find(aTHX_ mg->mg_obj);
-    shared_sv *target = Perl_sharedsv_associate(aTHX_ &sv, Nullsv, 0);
+    shared_sv *target;
+    SV *val;
     /* Theory - SV itself is magically shared - and we have ordered the
        magic such that by the time we get here it has been stored
        to its shared counterpart
      */
-    SHARED_EDIT;
+    SHARED_LOCK;
+    target = Perl_sharedsv_associate(aTHX_ &sv, Nullsv, 0);
+    SHARED_CONTEXT;
+    val = SHAREDSvPTR(target);
     if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
-	av_store((AV*) SHAREDSvPTR(shared), mg->mg_len, SHAREDSvPTR(target));
+	av_store((AV*) SHAREDSvPTR(shared), mg->mg_len, SvREFCNT_inc(val));
     }
     else {
 	hv_store((HV*) SHAREDSvPTR(shared), mg->mg_ptr, mg->mg_len,
-	               SHAREDSvPTR(target), 0);
+	               SvREFCNT_inc(val), 0);
     }
     SHARED_RELEASE;
     return 0;
@@ -451,6 +512,7 @@ sharedsv_elem_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
 {
     shared_sv *shared = Perl_sharedsv_find(aTHX_ mg->mg_obj);
     SvREFCNT_inc(SHAREDSvPTR(shared));
+    PerlIO_debug(__FUNCTION__ " %p %d\n",shared,SvREFCNT(SHAREDSvPTR(shared)));
     mg->mg_flags |= MGf_DUP;
     return 0;
 }
@@ -518,6 +580,7 @@ sharedsv_array_mg_copy(pTHX_ SV *sv, MAGIC* mg,
     MAGIC *nmg = sv_magicext(nsv,mg->mg_obj,
 			    toLOWER(mg->mg_type),&sharedsv_elem_vtbl,
 			    name, namlen);
+    SvREFCNT_inc(SHAREDSvPTR(shared));
     nmg->mg_flags |= MGf_DUP;
 #if 0
     /* Maybe do this to associate shared value immediately ? */
@@ -531,6 +594,7 @@ sharedsv_array_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
 {
     shared_sv *shared = (shared_sv *) mg->mg_ptr;
     SvREFCNT_inc(SHAREDSvPTR(shared));
+    PerlIO_debug(__FUNCTION__ " %p %d\n",shared,SvREFCNT(SHAREDSvPTR(shared)));
     mg->mg_flags |= MGf_DUP;
     return 0;
 }
@@ -658,16 +722,16 @@ PUSH(shared_sv *shared, ...)
 CODE:
 	dTHXc;
 	int i;
-	SHARED_LOCK;
 	for(i = 1; i < items; i++) {
 	    SV* tmp = newSVsv(ST(i));
-	    shared_sv *target = Perl_sharedsv_associate(aTHX_ &tmp, Nullsv, 0);
+	    shared_sv *target;
+	    SHARED_LOCK;
+	    target = Perl_sharedsv_associate(aTHX_ &tmp, Nullsv, 0);
 	    SHARED_CONTEXT;
 	    av_push((AV*) SHAREDSvPTR(shared), SHAREDSvPTR(target));
-	    CALLER_CONTEXT;
+	    SHARED_RELEASE;
 	    SvREFCNT_dec(tmp);
 	}
-	SHARED_UNLOCK;
 
 void
 UNSHIFT(shared_sv *shared, ...)
@@ -796,6 +860,35 @@ MODULE = threads::shared                PACKAGE = threads::shared
 PROTOTYPES: ENABLE
 
 void
+_thrcnt(SV *ref)
+	PROTOTYPE: \[$@%]
+CODE:
+	shared_sv *shared;
+	if(SvROK(ref))
+	    ref = SvRV(ref);
+	if (shared = Perl_sharedsv_find(aTHX_ ref)) {
+	  if (SHAREDSvPTR(shared)) {
+	    ST(0) = sv_2mortal(newSViv(SvREFCNT(SHAREDSvPTR(shared))));
+	    XSRETURN(1);
+	  }
+	  else {
+	     Perl_warn(aTHX_ "%_ s=%p has no shared SV",ST(0),shared);
+	  }
+	}
+	else {
+	     Perl_warn(aTHX_ "%_ is not shared",ST(0));
+	}
+	XSRETURN_UNDEF;
+
+void
+share(SV *ref)
+	PROTOTYPE: \[$@%]
+	CODE:
+	if(SvROK(ref))
+	    ref = SvRV(ref);
+	Perl_sharedsv_share(aTHX, ref);
+
+void
 lock_enabled(SV *ref)
 	PROTOTYPE: \[$@%]
 	CODE:
diff --git a/ext/threads/shared/t/sv_refs.t b/ext/threads/shared/t/sv_refs.t
index 86e9f548c8..402ff60cce 100644
--- a/ext/threads/shared/t/sv_refs.t
+++ b/ext/threads/shared/t/sv_refs.t
@@ -34,7 +34,8 @@ share($foo);
 eval {
 $foo = \$bar;
 };
-ok(2,my $temp1 = $@ =~/You cannot assign a non shared reference to a shared scalar/, "Check that the warning message is correct");
+
+ok(2,my $temp1 = $@ =~/^Invalid\b.*shared scalar/, "Wrong error message");
 share($bar);
 $foo = \$bar;
 ok(3, $temp1 = $foo =~/SCALAR/, "Check that is a ref");
diff --git a/ext/threads/shared/t/sv_simple.t b/ext/threads/shared/t/sv_simple.t
index 2a0d2970de..da16a0e51d 100644
--- a/ext/threads/shared/t/sv_simple.t
+++ b/ext/threads/shared/t/sv_simple.t
@@ -36,14 +36,15 @@ share($test);
 ok(2,$test eq "bar","Test magic share fetch");
 $test = "foo";
 ok(3,$test eq "foo","Test magic share assign");
+my $c = threads::shared::_thrcnt($test);
 threads->create(
 		sub {
-		    ok(4, $test eq "foo","Test mage share fetch after thread");
+		    ok(4, $test eq "foo","Test magic share fetch after thread");
 		    $test = "baz";
-                    ok(5,threads::shared::_thrcnt($test) == 2, "Check that threadcount is correct");
+                    ok(5,threads::shared::_thrcnt($test) > $c, "Check that threadcount is correct");
 		    })->join();
 ok(6,$test eq "baz","Test that value has changed in another thread");
-ok(7,threads::shared::_thrcnt($test) == 1,"Check thrcnt is down properly");
+ok(7,threads::shared::_thrcnt($test) == $c,"Check thrcnt is down properly");
 $test = "barbar";
 ok(8, length($test) == 6, "Check length code");
 threads->create(sub { $test = "barbarbar" })->join;
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 82989b9edb..4f113af131 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -49,6 +49,7 @@ typedef struct ithread_s {
     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 ? */
+    int gimme;			/* Context of create */
     SV* init_function;          /* Code to run */
     SV* params;                 /* args to pass function */
 #ifdef WIN32
@@ -202,20 +203,30 @@ Perl_ithread_run(void * arg) {
 		    XPUSHs(av_shift(params));
 		}
 		PUTBACK;
-		call_sv(thread->init_function, G_DISCARD|G_EVAL);
+		len = call_sv(thread->init_function, thread->gimme|G_EVAL);
 		SPAGAIN;
+		for (i=len-1; i >= 0; i--) {
+		    SV *sv = POPs;
+		    av_store(params, i, SvREFCNT_inc(sv));
+		}
+		PUTBACK;
+		if (SvTRUE(ERRSV)) {
+		    Perl_warn(aTHX_ "Died:%_",ERRSV);
+		}
 		FREETMPS;
 		LEAVE;
-		SvREFCNT_dec(thread->params);
 		SvREFCNT_dec(thread->init_function);
 	}
 
 	PerlIO_flush((PerlIO*)NULL);
 	MUTEX_LOCK(&thread->mutex);
-	if (thread->detached == 1) {
+	if (thread->detached & 1) {
 		MUTEX_UNLOCK(&thread->mutex);
+		SvREFCNT_dec(thread->params);
+		thread->params = Nullsv;
 		Perl_ithread_destruct(aTHX_ thread);
 	} else {
+		thread->detached |= 4;
 	  	MUTEX_UNLOCK(&thread->mutex);
    	}
 #ifdef WIN32
@@ -283,7 +294,8 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 	thread->count = 1;
 	MUTEX_INIT(&thread->mutex);
 	thread->tid = tid_counter++;
-	thread->detached = 0;
+	thread->gimme = GIMME_V;
+	thread->detached = (thread->gimme == G_VOID) ? 1 : 0;
 
 	/* "Clone" our interpreter into the thread's interpreter
 	 * This gives thread access to "static data" and code.
@@ -298,7 +310,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 #endif
 	/* perl_clone leaves us in new interpreter's context.
 	   As it is tricky to spot implcit aTHX create a new scope
-	   with aTHX matching the context for the duration of 
+	   with aTHX matching the context for the duration of
 	   our work for new interpreter.
 	 */
 	{
@@ -386,7 +398,15 @@ Perl_ithread_join(pTHX_ SV *obj)
 {
     ithread *thread = SV_to_ithread(aTHX_ obj);
     MUTEX_LOCK(&thread->mutex);
-    if (!thread->detached) {
+    if (thread->detached & 1) {
+	MUTEX_UNLOCK(&thread->mutex);
+	Perl_croak(aTHX_ "Cannot join a detached thread");
+    }
+    else if (thread->detached & 2) {
+	MUTEX_UNLOCK(&thread->mutex);
+	Perl_croak(aTHX_ "Thread already joined");
+    }
+    else {
 #ifdef WIN32
 	DWORD waitcode;
 #else
@@ -398,16 +418,13 @@ Perl_ithread_join(pTHX_ SV *obj)
 #else
 	pthread_join(thread->thr,&retval);
 #endif
-	/* We have finished with it */
 	MUTEX_LOCK(&thread->mutex);
-	thread->detached = 2;
+	/* sv_dup over the args */
+	/* We have finished with it */
+	thread->detached |= 2;
 	MUTEX_UNLOCK(&thread->mutex);
 	sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
     }
-    else {
-	MUTEX_UNLOCK(&thread->mutex);
-	Perl_croak(aTHX_ "Cannot join a detached thread");
-    }
 }
 
 void
diff --git a/perl.h b/perl.h
index e2b3419fcd..85aae2c82e 100644
--- a/perl.h
+++ b/perl.h
@@ -2540,6 +2540,14 @@ Gid_t getegid (void);
 #define YYMAXDEPTH 300
 
 #ifndef assert  /* <assert.h> might have been included somehow */
+#ifdef DEBUGGING
+#define assert(what)	DEB( {						\
+	if (!(what)) {							\
+	    Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d",	\
+		__FILE__, __LINE__);					\
+	    PerlProc_exit(1);						\
+	}})
+#else
 #define assert(what)	DEB( {						\
 	if (!(what)) {							\
 	    Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d",	\
@@ -2547,6 +2555,7 @@ Gid_t getegid (void);
 	    PerlProc_exit(1);						\
 	}})
 #endif
+#endif
 
 struct ufuncs {
     I32 (*uf_val)(pTHX_ IV, SV*);