This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
various minor fixes in threads.
authorDave Mitchell <davem@fdisolutions.com>
Mon, 13 May 2002 23:48:22 +0000 (00:48 +0100)
committerJarkko Hietaniemi <jhi@iki.fi>
Mon, 13 May 2002 23:09:36 +0000 (23:09 +0000)
Message-ID: <20020513234822.G21318@fdgroup.com>

p4raw-id: //depot/perl@16586

dump.c
ext/threads/shared/shared.xs

diff --git a/dump.c b/dump.c
index ced9d3a..7f82fad 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -731,7 +731,7 @@ Perl_gv_dump(pTHX_ GV *gv)
 }
 
 
-/* map magic types to the symbolic name
+/* map magic types to the symbolic names
  * (with the PERL_MAGIC_ prefixed stripped)
  */
 
@@ -747,6 +747,7 @@ static struct { char type; char *name; } magic_names[] = {
        { PERL_MAGIC_env,            "env(E)" },
        { PERL_MAGIC_isa,            "isa(I)" },
        { PERL_MAGIC_dbfile,         "dbfile(L)" },
+       { PERL_MAGIC_shared,         "shared(N)" },
        { PERL_MAGIC_tied,           "tied(P)" },
        { PERL_MAGIC_sig,            "sig(S)" },
        { PERL_MAGIC_uvar,           "uvar(U)" },
@@ -760,12 +761,14 @@ static struct { char type; char *name; } magic_names[] = {
        { PERL_MAGIC_nkeys,          "nkeys(k)" },
        { PERL_MAGIC_dbline,         "dbline(l)" },
        { PERL_MAGIC_mutex,          "mutex(m)" },
+       { PERL_MAGIC_shared_scalar,  "shared_scalar(n)" },
        { PERL_MAGIC_collxfrm,       "collxfrm(o)" },
        { PERL_MAGIC_tiedelem,       "tiedelem(p)" },
        { PERL_MAGIC_tiedscalar,     "tiedscalar(q)" },
        { PERL_MAGIC_qr,             "qr(r)" },
        { PERL_MAGIC_sigelem,        "sigelem(s)" },
        { PERL_MAGIC_taint,          "taint(t)" },
+       { PERL_MAGIC_uvar_elem,      "uvar_elem(v)" },
        { PERL_MAGIC_vec,            "vec(v)" },
        { PERL_MAGIC_substr,         "substr(x)" },
        { PERL_MAGIC_defelem,        "defelem(y)" },
index 477cdb4..9b0ca50 100644 (file)
@@ -1,6 +1,6 @@
-/*    sharedsv.c
+/*    shared.xs
  *
- *    Copyright (c) 2001, Larry Wall
+ *    Copyright (c) 2001-2002, 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.
@@ -723,10 +723,19 @@ Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
     recursive_lock_acquire(aTHX_ &ssv->lock, __FILE__, __LINE__);
 }
 
+/* handles calls from lock() builtin via PL_lockhook */
+
 void
 Perl_sharedsv_locksv(pTHX_ SV *sv)
 {
-    Perl_sharedsv_lock(aTHX_ Perl_sharedsv_find(aTHX_ sv));
+    shared_sv* shared;
+
+    if(SvROK(sv))
+       sv = SvRV(sv);
+    shared = Perl_sharedsv_find(aTHX, sv);
+    if(!shared)
+       croak("lock can only be used on shared values");
+    Perl_sharedsv_lock(aTHX_ shared);
 }
 
 =head1 Shared SV Functions
@@ -914,6 +923,7 @@ _id(SV *ref)
        PROTOTYPE: \[$@%]
 CODE:
        shared_sv *shared;
+       ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
        if( (shared = Perl_sharedsv_find(aTHX_ ref)) ){
@@ -928,6 +938,7 @@ _refcnt(SV *ref)
        PROTOTYPE: \[$@%]
 CODE:
        shared_sv *shared;
+       ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
        if( (shared = Perl_sharedsv_find(aTHX_ ref)) ){
@@ -948,6 +959,7 @@ void
 share(SV *ref)
        PROTOTYPE: \[$@%]
        CODE:
+       ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
        Perl_sharedsv_share(aTHX, ref);
@@ -957,6 +969,7 @@ lock_enabled(SV *ref)
        PROTOTYPE: \[$@%]
        CODE:
        shared_sv* shared;
+       ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
        shared = Perl_sharedsv_find(aTHX, ref);
@@ -970,6 +983,7 @@ cond_wait_enabled(SV *ref)
        CODE:
        shared_sv* shared;
        int locks;
+       ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
        shared = Perl_sharedsv_find(aTHX_ ref);
@@ -999,6 +1013,7 @@ cond_signal_enabled(SV *ref)
        PROTOTYPE: \[$@%]
        CODE:
        shared_sv* shared;
+       ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
        shared = Perl_sharedsv_find(aTHX_ ref);
@@ -1011,6 +1026,7 @@ cond_broadcast_enabled(SV *ref)
        PROTOTYPE: \[$@%]
        CODE:
        shared_sv* shared;
+       ref = SvRV(ref);
        if(SvROK(ref))
            ref = SvRV(ref);
        shared = Perl_sharedsv_find(aTHX_ ref);