Rewrite synchronisation of subs/methods and add attrs

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

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

diff --git a/Thread.pm b/Thread.pm
index d2f2d8b..2ace5dd 100644 (file)
--- 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 c3149a1..ab06922 100644 (file)
--- 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 3b7b1e4..9c2e589 100644 (file)
--- 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 9230d82..75e814f 100644 (file)
--- 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;