Rewrite synchronisation of subs/methods and add attrs

extension for specifying 'locked' and 'method' attributes.

p4raw-id: //depot/perlext/Thread@56

4 files changed, 11 insertions, 45 deletions

diff --git a/Thread.pm b/Thread.pm
index d2f2d8be93..2ace5dde2d 100644
--- a/Thread.pm
+++ b/Thread.pm
@@ -2,8 +2,7 @@ package Thread;
 require Exporter;
 require DynaLoader;
 @ISA = qw(Exporter DynaLoader);
-@EXPORT_OK = qw(sync fast yield cond_signal cond_broadcast cond_wait
-	       async);
+@EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async);
 
 #
 # Methods
@@ -18,12 +17,4 @@ sub async (&) {
 
 bootstrap Thread;
 
-my $cv;
-foreach $cv (\&yield, \&sync, \&join, \&fast, \&DESTROY,
-	    \&cond_wait, \&cond_signal, \&cond_broadcast) {
-    fast($cv);
-}
-
-sync(\&new);	# not sure if this needs to be sync'd
-
 1;
diff --git a/Thread.xs b/Thread.xs
index c3149a1de8..ab06922e86 100644
--- a/Thread.xs
+++ b/Thread.xs
@@ -202,24 +202,6 @@ AV *initargs;
     return thr;
 }
 
-static SV *
-fast(sv)
-SV *sv;
-{
-    HV *hvp;
-    GV *gvp;
-    CV *cv = sv_2cv(sv, &hvp, &gvp, FALSE);
-
-    if (!cv)
-	croak("Not a CODE reference");
-    if (CvCONDP(cv)) {
-	COND_DESTROY(CvCONDP(cv));
-	Safefree(CvCONDP(cv));
-	CvCONDP(cv) = 0;
-    }
-    return sv;
-}
-
 MODULE = Thread		PACKAGE = Thread
 
 Thread
@@ -233,26 +215,15 @@ new(class, startsv, ...)
 	RETVAL
 
 void
-sync(sv)
-	SV *	sv
-	HV *	hvp = NO_INIT
-	GV *	gvp = NO_INIT
-    CODE:
-	SvFLAGS(sv_2cv(sv, &hvp, &gvp, FALSE)) |= SVp_SYNC;
-	ST(0) = sv_mortalcopy(sv);
-
-void
-fast(sv)
-	SV *	sv
-    CODE:
-	ST(0) = sv_mortalcopy(fast(sv));
-
-void
 join(t)
 	Thread	t
 	AV *	av = NO_INIT
 	int	i = NO_INIT
     PPCODE:
+	DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			      "0x%lx: joining 0x%lx (state 0x%lx)\n",
+			      (unsigned long)thr, (unsigned long)t,
+			      (unsigned long)ThrSTATE(t)););
 	if (ThrSTATE(t) == THR_DETACHED)
 	    croak("tried to join a detached thread");
 	else if (ThrSTATE(t) == THR_JOINED)
@@ -271,6 +242,10 @@ void
 detach(t)
 	Thread	t
     CODE:
+	DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			      "0x%lx: detaching 0x%lx (state 0x%lx)\n",
+			      (unsigned long)thr, (unsigned long)t,
+			      (unsigned long)ThrSTATE(t)););
 	if (ThrSTATE(t) == THR_DETACHED)
 	    croak("tried to detach an already detached thread");
 	else if (ThrSTATE(t) == THR_JOINED)
diff --git a/sync.t b/sync.t
index 3b7b1e48c4..9c2e5897da 100644
--- a/sync.t
+++ b/sync.t
@@ -3,6 +3,7 @@ use Thread;
 $level = 0;
 
 sub single_file {
+    use attrs 'locked';
     my $arg = shift;
     $level++;
     print "Level $level for $arg\n";
@@ -50,7 +51,6 @@ sub start_baz {
 
 $| = 1;
 srand($$^$^T);
-Thread::sync(\&single_file);
 
 $foo = new Thread \&start_foo;
 $bar = new Thread \&start_bar;
diff --git a/sync2.t b/sync2.t
index 9230d8298e..75e814fbfa 100644
--- a/sync2.t
+++ b/sync2.t
@@ -3,6 +3,7 @@ use Thread;
 $global = undef;
 
 sub single_file {
+    use attrs 'locked';
     my $who = shift;
     my $i;
 
@@ -48,7 +49,6 @@ sub start_c {
 
 $| = 1;
 srand($$^$^T);
-Thread::sync(\&single_file);
 
 $foo = new Thread \&start_a;
 $bar = new Thread \&start_b;