This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
XS side of new threads::shared designed, coded and compiles,
authorNick Ing-Simmons <nik@tiuk.ti.com>
Mon, 21 Jan 2002 22:34:06 +0000 (22:34 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Mon, 21 Jan 2002 22:34:06 +0000 (22:34 +0000)
and mostly commented but is totaly untested.
submit in case anyone wants a preview.

p4raw-id: //depot/perlio@14372

MANIFEST
ext/threads/shared/shared.pm
ext/threads/shared/shared.xs
ext/threads/shared/typemap [new file with mode: 0644]

index c37345c..8868e3c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -610,6 +610,7 @@ ext/threads/shared/t/hv_simple.t    Tests for basic shared hash functionality.
 ext/threads/shared/t/no_share.t        Tests for disabled share on variables.
 ext/threads/shared/t/sv_refs.t thread shared variables
 ext/threads/shared/t/sv_simple.t       thread shared variables
+ext/threads/shared/typemap     thread::shared types
 ext/threads/t/basic.t          ithreads
 ext/threads/t/stress_cv.t      Test with multiple threads, coderef cv argument.
 ext/threads/t/stress_re.t      Test with multiple threads, string cv argument and regexes.
index 62cdbdd..8baa503 100644 (file)
@@ -7,7 +7,7 @@ use Scalar::Util qw(weaken);
 use attributes qw(reftype);
 
 BEGIN {
-    if($Config{'useithreads'} && $threads::threads) {
+    if ($Config{'useithreads'} && $threads::threads) {
        *share = \&share_enabled;
        *cond_wait = \&cond_wait_enabled;
        *cond_signal = \&cond_signal_enabled;
@@ -38,7 +38,7 @@ sub unlock_disabled { 1 };
 sub lock_disabled { 1 }
 sub share_disabled { return @_}
 
-sub share_enabled (\[$@%]) { # \]     
+sub share_enabled (\[$@%]) { # \]
     my $value = $_[0];
     my $ref = reftype($value);
     if($ref eq 'SCALAR') {
@@ -55,20 +55,6 @@ sub share_enabled (\[$@%]) { # \]
     }
 }
 
-sub CLONE {
-    return unless($_[0] eq "threads::shared");
-       foreach my $ptr (keys %shared) {
-           if($ptr) {
-               thrcnt_inc($shared{$ptr},$threads::origthread);
-           }
-       }
-}
-
-sub DESTROY {
-    my $self = shift;
-    _thrcnt_dec($$self);
-    delete($shared{$$self});
-}
 
 package threads::shared::sv;
 use base 'threads::shared';
@@ -156,7 +142,7 @@ C<lock> places a lock on a variable until the lock goes out of scope.  If
 the variable is locked by another thread, the C<lock> call will block until
 it's available. C<lock> is recursive, so multiple calls to C<lock> are
 safe--the variable will remain locked until the outermost lock on the
-variable goes out of scope or C<unlock> is called enough times to match 
+variable goes out of scope or C<unlock> is called enough times to match
 the number of calls to <lock>.
 
 If a container object, such as a hash or array, is locked, all the elements
index 876fb97..79cebfa 100644 (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
-*
-*/
+ *
+ * "Hand any two wizards a piece of rope and they would instinctively pull in
+ * opposite directions."
+ *                         --Sourcery
+ *
+ * Contributed by Arthur Bergman arthur@contiller.se
+ * pulled in the (an)other direction by Nick Ing-Simmons nick@ing-simmons.net
+ */
 
 #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 */
+#define SHAREDSvPTR(a)      ((a)->sv)
+
+/*
+ * The shared things need an intepreter to live in ...
+ */
+PerlInterpreter *PL_sharedsv_space;             /* The shared sv space */
+/* To access shared space we fake aTHX in this scope and thread's context */
+#define SHARED_CONTEXT             PERL_SET_CONTEXT((aTHX = PL_sharedsv_space))
+
+/* So we need a way to switch back to the caller's context... */
+/* So we declare _another_ copy of the aTHX variable ... */
+#define dTHXc PerlInterpreter *caller_perl = aTHX
+/* and use it to switch back */
+#define CALLER_CONTEXT      PERL_SET_CONTEXT((aTHX = caller_perl))
+
+/*
+ * 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 */
+
+#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 {        \
+                               SHARED_LOCK;    \
+                               SHARED_CONTEXT; \
+                           } STMT_END
+
+/* then switch out and release access. */
+#define SHARED_RELEASE     STMT_START {        \
+                               CALLER_CONTEXT; \
+                               SHARED_UNLOCK;  \
+                           } STMT_END
+                       
+
+/*
+
+  Shared SV
+
+  Shared SV is a structure for keeping the backend storage
+  of shared svs.
+
+  Shared-ness really only needs the SV * - the rest is for locks.
+  (Which suggests further space optimization ... )
+
+*/
 
 typedef struct {
-    SV                 *sv;             /* The actual SV */
+    SV                 *sv;             /* The actual SV - in shared space */
     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);
+/* The SV in shared-space has a back-pointer to the shared_sv
+   struct associated with it PERL_MAGIC_ext.
 
-/*
-  Shared SV
+   The vtable used has just one entry - when the SV goes away
+   we free the memory for the above.
 
-  Shared SV is a structure for keeping the backend storage
-  of shared svs.
+ */
 
-*/
+int
+sharedsv_shared_mg_free(pTHX_ SV *sv, MAGIC *mg)
+{
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    if (shared) {
+       PerlMemShared_free(shared);
+       mg->mg_ptr = NULL;
+    }
+    return 0;
+}
+
+
+MGVTBL sharedsv_shared_vtbl = {
+ 0,                            /* get */
+ 0,                            /* set */
+ 0,                            /* len */
+ 0,                            /* clear */
+ sharedsv_shared_mg_free,      /* free */
+ 0,                            /* copy */
+ 0,                            /* dup */
+};
+
+/* Access to shared things is heavily based on MAGIC - in mg.h/mg.c/sv.c sense */
+
+/* In any thread that has access to a shared thing there is a "proxy"
+   for it in its own space which has 'MAGIC' associated which accesses
+   the shared thing.
+ */
+
+MGVTBL sharedsv_scalar_vtbl;    /* scalars have this vtable */
+MGVTBL sharedsv_array_vtbl;     /* hashes and arrays have this - like 'tie' */
+MGVTBL sharedsv_elem_vtbl;      /* elements of hashes and arrays have this
+                                  _AS WELL AS_ the scalar magic */
+
+/* The sharedsv_elem_vtbl associates the element with the array/hash and
+   the sharedsv_scalar_vtbl associates it with the value
+ */
+
+=for apidoc sharedsv_find
+
+Given a private side SV tries to find if a given SV has a shared backend,
+by looking for the magic.
+
+=cut
+
+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) {
+               return (shared_sv *) mg->mg_ptr;
+           }
+           break;
+    default:
+       if ((mg = mg_find(sv, PERL_MAGIC_shared_scalar))
+               && mg->mg_virtual == &sharedsv_scalar_vtbl) {
+               return (shared_sv *) mg->mg_ptr;
+       }
+    }
+    return NULL;
+}
 
 /*
+ *  Almost all the pain is in this routine.
+ *
+ */
 
- =head1 Shared SV Functions
+shared_sv *
+Perl_sharedsv_associate(pTHX_ SV **psv, SV *ssv, shared_sv *data)
+{
+    /* First try and get global data structure */
+    dTHXc;
+    MAGIC *mg;
+    SV *sv;
+    if (aTHX == PL_sharedsv_space) {
+       croak("panic:Cannot associate from within shared space");
+    }
+    SHARED_LOCK;
 
- =for apidoc sharedsv_init 
+    /* Try shared SV as 1st choice */
+    if (!data && ssv) {
+       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);
+    }
+    /* If neither of those then create a new one */
+    if (!data) {
+           data = PerlMemShared_malloc(sizeof(shared_sv));
+           Zero(data,1,shared_sv);
+           MUTEX_INIT(&data->mutex);
+           COND_INIT(&data->cond);
+           COND_INIT(&data->user_cond);
+           data->owner = 0;
+           data->locks = 0;
+    }
 
-Saves a space for keeping SVs wider than an interpreter,
-currently only stores a pointer to the first interpreter.
+    if (!ssv)
+       ssv = SHAREDSvPTR(data);
+       
+    /* If we know type allocate shared side SV */
+    if (psv && *psv && !ssv) {
+       SHARED_CONTEXT;
+       ssv = newSV(0);
+       sv_upgrade(ssv, SvTYPE(*psv));
+       /* Tag shared side SV with data pointer */
+       sv_magicext(ssv, ssv, PERL_MAGIC_ext, &sharedsv_shared_vtbl,
+                  (char *)data, 0);
+       CALLER_CONTEXT;
+    }
 
- =cut
+    if (!SHAREDSvPTR(data))
+       SHAREDSvPTR(data) = ssv;
 
-*/
+    /* Now if requested allocate private SV */
+    if (psv && !*psv && ssv) {
+       sv = newSV(0);
+       sv_upgrade(sv, SvTYPE(SHAREDSvPTR(data)));
+       *psv = sv;
+    }
+
+    /* Finally if private SV exists check and add magic */
+    if (psv && *psv) {
+       SV *sv = *psv;
+       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 (mg)
+                   sv_unmagic(sv, PERL_MAGIC_tied);
+               mg = sv_magicext(sv, sv, PERL_MAGIC_tied, &sharedsv_array_vtbl,
+                               (char *) data, 0);
+               mg->mg_flags |= (MGf_COPY|MGf_DUP);
+           }
+           break;
+
+       default:
+           if (!(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);
+           }
+           break;
+       }
+    }
+    SHARED_UNLOCK;
+    return data;
+}
 
 void
-Perl_sharedsv_init(pTHX)
+Perl_sharedsv_free(pTHX_ shared_sv *shared)
 {
-  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);
+    if (shared) {
+       dTHXc;
+       SHARED_EDIT;
+       SvREFCNT_dec(SHAREDSvPTR(shared));
+       SHARED_RELEASE;
+    }
 }
 
-/*
- =for apidoc sharedsv_new
+void
+Perl_sharedsv_share(pTHX_ SV *sv)
+{
+    switch(SvTYPE(sv)) {
+    case SVt_PVGV:
+       Perl_croak(aTHX_ "Cannot share globs yet");
+       break;
+
+    case SVt_PVCV:
+       Perl_croak(aTHX_ "Cannot share subs yet");
+       break;
+       
+    default:
+       Perl_sharedsv_associate(aTHX_ &sv, 0, 0);
+    }
+}
 
-Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
- =cut
-*/
+/* MAGIC (in mg.h sense) hooks */
 
-shared_sv *
-Perl_sharedsv_new(pTHX)
+int
+sharedsv_scalar_mg_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    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;
+    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);
+       }
+       else {
+           sv_setsv(sv, SHAREDSvPTR(shared));
+       }
+    }
+    SHARED_UNLOCK;
+    return 0;
+}
+
+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);
+    bool allowed = TRUE;
+
+    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);
+           SvREFCNT_dec(tmp);
+       }
+       else {
+           allowed = FALSE;
+       }
+    }
+    else {
+       sv_setsv(SHAREDSvPTR(shared), sv);
+    }
+    SHARED_RELEASE;
+
+    if (!allowed) {
+       Perl_croak(aTHX_ "Invalid value for shared scalar");
+    }
+    return 0;
 }
 
+int
+sharedsv_scalar_mg_free(pTHX_ SV *sv, MAGIC *mg)
+{
+    Perl_sharedsv_free(aTHX_ (shared_sv *) mg->mg_ptr);
+    return 0;
+}
 
 /*
- =for apidoc sharedsv_find
+ * Called during cloning of new threads
+ */
+int
+sharedsv_scalar_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
+{
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    if (shared) {
+       SvREFCNT_inc(SHAREDSvPTR(shared));
+    }
+    return 0;
+}
 
-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.
+MGVTBL sharedsv_scalar_vtbl = {
+ sharedsv_scalar_mg_get,       /* get */
+ sharedsv_scalar_mg_set,       /* set */
+ 0,                            /* len */
+ 0,                            /* clear */
+ sharedsv_scalar_mg_free,      /* free */
+ 0,                            /* copy */
+ sharedsv_scalar_mg_dup                /* dup */
+};
 
- =cut
-*/
+/* Now the arrays/hashes stuff */
 
-shared_sv *
-Perl_sharedsv_find(pTHX_ SV* sv)
+int
+sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg)
 {
-  /* 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;
-             }
+    dTHXc;
+    shared_sv *shared = Perl_sharedsv_find(aTHX_ mg->mg_obj);
+    shared_sv *target = Perl_sharedsv_find(aTHX_ sv);
+    SV** svp;
+
+    SHARED_EDIT;
+    if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
+           svp = av_fetch((AV*) SHAREDSvPTR(shared), mg->mg_len, 0);
+    }
+    else {
+       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));
+           }
+           SHAREDSvPTR(target) = SvREFCNT_inc(*svp);
+       }
+    }
+    else {
+       if (SHAREDSvPTR(target)) {
+           SvREFCNT_dec(SHAREDSvPTR(target));
        }
+       SHAREDSvPTR(target) = Nullsv;
     }
-    return ssv;
+    SHARED_RELEASE;
+    return 0;
 }
 
-/*
- =for apidoc sharedsv_lock
+int
+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);
+    /* 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;
+    if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
+       av_store((AV*) SHAREDSvPTR(shared), mg->mg_len, SHAREDSvPTR(target));
+    }
+    else {
+       hv_store((HV*) SHAREDSvPTR(shared), mg->mg_ptr, mg->mg_len,
+                      SHAREDSvPTR(target), 0);
+    }
+    SHARED_RELEASE;
+    return 0;
+}
 
-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)
+int
+sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg)
 {
-    if(!ssv)
-        return;
-    MUTEX_LOCK(&ssv->mutex);
-    if(ssv->owner && ssv->owner == my_perl) {
-        ssv->locks++;
-       MUTEX_UNLOCK(&ssv->mutex);
-        return;
+    dTHXc;
+    shared_sv *shared = Perl_sharedsv_find(aTHX_ mg->mg_obj);
+    SV* ssv;
+    SHARED_EDIT;
+    if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
+       ssv = av_delete((AV*) SHAREDSvPTR(shared), mg->mg_len, 0);
     }
-    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);
+    else {
+       ssv = hv_delete((HV*) SHAREDSvPTR(shared), mg->mg_ptr, mg->mg_len, 0);
+    }
+    SHARED_RELEASE;
+    /* It is no longer in the array - so remove that magic */
+    sv_unmagic(sv, PERL_MAGIC_tiedelem);
+    Perl_sharedsv_associate(aTHX_ &sv, ssv, 0);
+    return 0;
+}
+
+
+int
+sharedsv_elem_mg_free(pTHX_ SV *sv, MAGIC *mg)
+{
+    Perl_sharedsv_free(aTHX_ Perl_sharedsv_find(aTHX_ mg->mg_obj));
+    return 0;
+}
+
+int
+sharedsv_elem_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
+{
+    shared_sv *shared = Perl_sharedsv_find(aTHX_ mg->mg_obj);
+    SvREFCNT_inc(SHAREDSvPTR(shared));
+    mg->mg_flags |= MGf_DUP;
+    return 0;
+}
+
+MGVTBL sharedsv_elem_vtbl = {
+ sharedsv_elem_mg_FETCH,       /* get */
+ sharedsv_elem_mg_STORE,       /* set */
+ 0,                            /* len */
+ sharedsv_elem_mg_DELETE,      /* clear */
+ sharedsv_elem_mg_free,                /* free */
+ 0,                            /* copy */
+ sharedsv_elem_mg_dup          /* dup */
+};
+
+U32
+sharedsv_array_mg_FETCHSIZE(pTHX_ SV *sv, MAGIC *mg)
+{
+    dTHXc;
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    U32 val;
+    SHARED_EDIT;
+    if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
+       val = av_len((AV*) SHAREDSvPTR(shared));
+    }
+    else {
+       /* not actually defined by tie API but ... */
+       val = HvKEYS((HV*) SHAREDSvPTR(shared));
+    }
+    SHARED_RELEASE;
+    return val;
+}
+
+int
+sharedsv_array_mg_CLEAR(pTHX_ SV *sv, MAGIC *mg)
+{
+    dTHXc;
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    SHARED_EDIT;
+    if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
+       av_clear((AV*) SHAREDSvPTR(shared));
+    }
+    else {
+       hv_clear((HV*) SHAREDSvPTR(shared));
+    }
+    SHARED_RELEASE;
+    return 0;
+}
+
+int
+sharedsv_array_mg_free(pTHX_ SV *sv, MAGIC *mg)
+{
+    Perl_sharedsv_free(aTHX_ (shared_sv *) mg->mg_ptr);
+    return 0;
 }
 
 /*
- =for apidoc sharedsv_unlock
+ * This is called when perl is about to access an element of
+ * the array -
+ */
+int
+sharedsv_array_mg_copy(pTHX_ SV *sv, MAGIC* mg,
+                      SV *nsv, const char *name, int namlen)
+{
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    MAGIC *nmg = sv_magicext(nsv,mg->mg_obj,
+                           toLOWER(mg->mg_type),&sharedsv_elem_vtbl,
+                           name, namlen);
+    nmg->mg_flags |= MGf_DUP;
+#if 0
+    /* Maybe do this to associate shared value immediately ? */
+    sharedsv_elem_FIND(aTHX_ nsv, nmg);
+#endif
+    return 1;
+}
+
+int
+sharedsv_array_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
+{
+    shared_sv *shared = (shared_sv *) mg->mg_ptr;
+    SvREFCNT_inc(SHAREDSvPTR(shared));
+    mg->mg_flags |= MGf_DUP;
+    return 0;
+}
+
+MGVTBL sharedsv_array_vtbl = {
+ 0,                            /* get */
+ 0,                            /* set */
+ sharedsv_array_mg_FETCHSIZE,  /* len */
+ sharedsv_array_mg_CLEAR,      /* clear */
+ sharedsv_array_mg_free,       /* free */
+ sharedsv_array_mg_copy,       /* copy */
+ sharedsv_array_mg_dup         /* dup */
+};
+
+=for apidoc sharedsv_unlock
 
 Recursively unlocks a shared sv.
 
- =cut
-*/
+=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->owner != aTHX) {
+       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;
+    if (--ssv->locks == 0) {
+       ssv->owner = NULL;
        COND_SIGNAL(&ssv->cond);
     }
     MUTEX_UNLOCK(&ssv->mutex);
@@ -206,9 +572,9 @@ void
 Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
 {
     MUTEX_LOCK(&ssv->mutex);
-    if(ssv->owner != my_perl) {
-        MUTEX_UNLOCK(&ssv->mutex);
-        return;
+    if (ssv->owner != aTHX) {
+       MUTEX_UNLOCK(&ssv->mutex);
+       return;
     }
     ssv->locks = 0;
     ssv->owner = NULL;
@@ -216,293 +582,233 @@ Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
     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
+=for apidoc sharedsv_lock
 
-Decrements the threadcount of a shared sv. When a threads frontend is freed
-this function should be called.
+Recursive locks on a sharedsv.
+Locks are dynamically scoped at the level of the first lock.
 
- =cut
-*/
+=cut
 
 void
-Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
+Perl_sharedsv_lock(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;
-        }
-        }
+    if (!ssv)
+       return;
+    MUTEX_LOCK(&ssv->mutex);
+    if (ssv->owner && ssv->owner == aTHX) {
+       ssv->locks++;
+       MUTEX_UNLOCK(&ssv->mutex);
+       return;
     }
-    Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
-    SHAREDSvUNLOCK(ssv);
+    while (ssv->owner)
+      COND_WAIT(&ssv->cond,&ssv->mutex);
+    ssv->locks++;
+    ssv->owner = aTHX;
+    if (ssv->locks == 1)
+       SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
+    MUTEX_UNLOCK(&ssv->mutex);
 }
 
-
-MGVTBL svtable;
-
-#define shared_sv_attach_sv(sv,shared) Perl_shared_sv_attach_sv(aTHX_ 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);
-    SV* tiedobject;
-    SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
-    if(tiedobject_) {
-       tiedobject = (*tiedobject_);
-       if(sv) {
-            SvROK_on(sv);
-            SvRV(sv) = SvRV(tiedobject);
-       } else {
-           sv = newRV(SvRV(tiedobject));
-       }
-    } else {
-       switch(SvTYPE(SHAREDSvGET(shared))) {
-           case SVt_PVAV: {
-               SV* weakref;
-               SV* obj_ref = newSViv(0);
-               SV* obj = newSVrv(obj_ref,"threads::shared::av");
-               AV* hv = newAV();
-               sv_setiv(obj,PTR2IV(shared));
-               weakref = newRV((SV*)hv);
-               sv = newRV_noinc((SV*)hv);
-               sv_rvweaken(weakref);
-               sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
-               hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
-               Perl_sharedsv_thrcnt_inc(aTHX_ shared);         
-           }
-           break;
-           case SVt_PVHV: {
-               SV* weakref;
-               SV* obj_ref = newSViv(0);
-               SV* obj = newSVrv(obj_ref,"threads::shared::hv");
-               HV* hv = newHV();
-               sv_setiv(obj,PTR2IV(shared));
-               weakref = newRV((SV*)hv);
-               sv = newRV_noinc((SV*)hv);
-               sv_rvweaken(weakref);
-               sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
-               hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
-               Perl_sharedsv_thrcnt_inc(aTHX_ shared);         
-           }
-           break;
-           default: {
-               MAGIC* shared_magic;
-               SV* value = newSVsv(SHAREDSvGET(shared));
-               SV* obj = newSViv(PTR2IV(shared));
-               sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
-               shared_magic = mg_find(value, PERL_MAGIC_ext);
-               shared_magic->mg_virtual = &svtable;
-               shared_magic->mg_obj = newSViv(PTR2IV(shared));
-               shared_magic->mg_flags |= MGf_REFCOUNTED;
-               shared_magic->mg_private = 0;
-               SvMAGICAL_on(value);
-               sv = newRV_noinc(value);
-               value = newRV(value);
-               sv_rvweaken(value);
-               hv_store(shared_hv, SvPV(id,length),length, value, 0);
-               Perl_sharedsv_thrcnt_inc(aTHX_ shared);
-           }
-               
-       }
-    }
-    return sv;
+void
+Perl_sharedsv_locksv(pTHX_ SV *sv)
+{
+    Perl_sharedsv_lock(aTHX_ Perl_sharedsv_find(aTHX_ sv));
 }
 
+=head1 Shared SV Functions
 
-int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
-    shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
-    SHAREDSvLOCK(shared);
-    if(mg->mg_private != shared->index) {
-        if(SvROK(SHAREDSvGET(shared))) {
-            shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared))));
-           shared_sv_attach_sv(sv, target);
-        } else {
-            sv_setsv(sv, SHAREDSvGET(shared));
-        }
-        mg->mg_private = shared->index;
-    }
-    SHAREDSvUNLOCK(shared);
+=for apidoc sharedsv_init
 
-    return 0;
-}
+Saves a space for keeping SVs wider than an interpreter,
+currently only stores a pointer to the first interpreter.
 
-int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
-    shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
-    SHAREDSvLOCK(shared);
-    if(SvROK(SHAREDSvGET(shared)))
-        Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared)))));
-    if(SvROK(sv)) {
-        shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
-        if(!target) {
-            sv_setsv(sv,SHAREDSvGET(shared));
-            SHAREDSvUNLOCK(shared);
-            Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
-        }
-        SHAREDSvEDIT(shared);
-        Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
-        SHAREDSvGET(shared) = newRV_noinc(newSViv(PTR2IV(target)));
-    } else {
-            SHAREDSvEDIT(shared);
-       sv_setsv(SHAREDSvGET(shared), sv);
-    }
-    shared->index++;
-    mg->mg_private = shared->index;
-    SHAREDSvRELEASE(shared);
-    if(SvROK(SHAREDSvGET(shared)))
-       Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(shared)))));
-    SHAREDSvUNLOCK(shared);
-    return 0;
+=cut
+
+void
+Perl_sharedsv_init(pTHX)
+{
+  dTHXc;
+  /* This pair leaves us in shared context ... */
+  PL_sharedsv_space = perl_alloc();
+  perl_construct(PL_sharedsv_space);
+  CALLER_CONTEXT;
+  MUTEX_INIT(&PL_sharedsv_space_mutex);
+  PL_lockhook = &Perl_sharedsv_locksv;
+  PL_sharehook = &Perl_sharedsv_share;
 }
 
-int 
-shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) 
+/* Accessor to convert threads::shared::tie objects back shared_sv * */
+shared_sv *
+SV_to_sharedsv(pTHX_ SV *sv)
 {
-    shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
-    if (shared) {
-       HV* shared_hv = get_hv("threads::shared::shared", FALSE);
-        SV* id = newSViv(PTR2IV(shared));
-        STRLEN length = sv_len(id);
-        hv_delete(shared_hv, SvPV(id,length), length,0);
-       Perl_sharedsv_thrcnt_dec(aTHX_ shared);
-    }
-    return 0;
+    shared_sv *shared = 0;
+    if (SvROK(sv))
+     {
+      shared = INT2PTR(shared_sv *, SvIV(SvRV(sv)));
+     }
+    return shared;
 }
 
-MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
-                 MEMBER_TO_FPTR(shared_sv_store_mg),
-                 0,
-                 0,
-                 MEMBER_TO_FPTR(shared_sv_destroy_mg)
-};
+MODULE = threads::shared       PACKAGE = threads::shared::tie
 
-MODULE = threads::shared               PACKAGE = threads::shared               
+PROTOTYPES: DISABLE
 
+void
+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_CONTEXT;
+           av_push((AV*) SHAREDSvPTR(shared), SHAREDSvPTR(target));
+           CALLER_CONTEXT;
+           SvREFCNT_dec(tmp);
+       }
+       SHARED_UNLOCK;
 
-PROTOTYPES: ENABLE
+void
+UNSHIFT(shared_sv *shared, ...)
+CODE:
+       dTHXc;
+       int i;
+       SHARED_LOCK;
+       SHARED_CONTEXT;
+       av_unshift((AV*)SHAREDSvPTR(shared), items - 1);
+       CALLER_CONTEXT;
+       for(i = 1; i < items; i++) {
+           SV* tmp = newSVsv(ST(i));
+           shared_sv *target = Perl_sharedsv_associate(aTHX_ &tmp, Nullsv, 0);
+           SHARED_CONTEXT;
+           av_store((AV*) SHAREDSvPTR(shared), i - 1, SHAREDSvPTR(target));
+           CALLER_CONTEXT;
+           SvREFCNT_dec(tmp);
+       }
+       SHARED_UNLOCK;
 
+void
+POP(shared_sv *shared)
+CODE:
+       dTHXc;
+       SV* sv;
+       SHARED_LOCK;
+       SHARED_CONTEXT;
+       sv = av_pop((AV*)SHAREDSvPTR(shared));
+       CALLER_CONTEXT;
+       ST(0) = Nullsv;
+       Perl_sharedsv_associate(aTHX_ &ST(0), sv, 0);
+       SHARED_UNLOCK;
+       XSRETURN(1);
 
-SV*
-ptr(ref)
-       SV* ref
-       CODE:
-       RETVAL = newSViv(SvIV(SvRV(ref)));
-       OUTPUT:
-       RETVAL
+void
+SHIFT(shared_sv *shared)
+CODE:
+       dTHXc;
+       SV* sv;
+       SHARED_LOCK;
+       SHARED_CONTEXT;
+       sv = av_shift((AV*)SHAREDSvPTR(shared));
+       CALLER_CONTEXT;
+       ST(0) = Nullsv;
+       Perl_sharedsv_associate(aTHX_ &ST(0), sv, 0);
+       SHARED_UNLOCK;
+       XSRETURN(1);
 
+void
+EXTEND(shared_sv *shared, IV count)
+CODE:
+       dTHXc;
+       SHARED_EDIT;
+       av_extend((AV*)SHAREDSvPTR(shared), count);
+       SHARED_RELEASE;
 
-SV*
-_thrcnt(ref)
-        SV* ref
-       CODE:
-        shared_sv* shared;
-       if(SvROK(ref))
-           ref = SvRV(ref);
-       shared = Perl_sharedsv_find(aTHX, ref);
-        if(!shared)
-           croak("thrcnt can only be used on shared values");
-       SHAREDSvLOCK(shared);
-        RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
-        SHAREDSvUNLOCK(shared);
-       OUTPUT:
-        RETVAL
+void
+EXISTS(shared_sv *shared, SV *index)
+CODE:
+       dTHXc;
+       bool exists;
+       SHARED_EDIT;
+       if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
+           exists = av_exists((AV*) SHAREDSvPTR(shared), SvIV(index));
+       }
+       else {
+           exists = hv_exists_ent((HV*) SHAREDSvPTR(shared), index, 0);
+       }
+       SHARED_RELEASE;
+       ST(0) = (exists) ? &PL_sv_yes : &PL_sv_no;
+       XSRETURN(1);
 
+void
+STORESIZE(shared_sv *shared,IV count)
+CODE:
+       dTHXc;
+       SHARED_EDIT;
+       av_fill((AV*) SHAREDSvPTR(shared), count);
+       SHARED_RELEASE;
 
 void
-thrcnt_inc(ref,perl)
-        SV* ref
-       SV* perl
-        CODE:
-       shared_sv* shared;
-       PerlInterpreter* origperl = INT2PTR(PerlInterpreter*, SvIV(perl));
-       PerlInterpreter* oldperl = PERL_GET_CONTEXT;
-        if(SvROK(ref))
-            ref = SvRV(ref);
-        shared = Perl_sharedsv_find(aTHX, ref);
-        if(!shared)
-           croak("thrcnt can only be used on shared values");
-       PERL_SET_CONTEXT(origperl);
-       Perl_sharedsv_thrcnt_inc(aTHX_ shared);
-       PERL_SET_CONTEXT(oldperl);      
+FIRSTKEY(shared_sv *shared)
+CODE:
+       dTHXc;
+       char* key = NULL;
+       I32 len = 0;
+       HE* entry;
+       SHARED_LOCK;
+       SHARED_CONTEXT;
+       hv_iterinit((HV*) SHAREDSvPTR(shared));
+       entry = hv_iternext((HV*) SHAREDSvPTR(shared));
+       if (entry) {
+               key = hv_iterkey(entry,&len);
+               CALLER_CONTEXT;
+               ST(0) = sv_2mortal(newSVpv(key, len));
+       } else {
+            CALLER_CONTEXT;
+            ST(0) = &PL_sv_undef;
+       }
+       SHARED_UNLOCK;
+       XSRETURN(1);
 
 void
-_thrcnt_dec(ref)
-        SV* ref
-        CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(ref));
-        if(!shared)
-           croak("thrcnt can only be used on shared values");
-       Perl_sharedsv_thrcnt_dec(aTHX_ shared);
+NEXTKEY(shared_sv *shared, SV *oldkey)
+CODE:
+       dTHXc;
+       char* key = NULL;
+       I32 len = 0;
+       HE* entry;
+       SHARED_LOCK;
+       SHARED_CONTEXT;
+       entry = hv_iternext((HV*) SHAREDSvPTR(shared));
+       if(entry) {
+               key = hv_iterkey(entry,&len);
+               CALLER_CONTEXT;
+               ST(0) = sv_2mortal(newSVpv(key, len));
+       } else {
+            CALLER_CONTEXT;
+            ST(0) = &PL_sv_undef;
+       }
+       SHARED_UNLOCK;
+       XSRETURN(1);
+
+MODULE = threads::shared                PACKAGE = threads::shared
+
+PROTOTYPES: ENABLE
 
 void
-unlock_enabled(ref)
-       SV* ref
+lock_enabled(SV *ref)
        PROTOTYPE: \[$@%]
        CODE:
        shared_sv* shared;
        if(SvROK(ref))
            ref = SvRV(ref);
        shared = Perl_sharedsv_find(aTHX, ref);
-        if(!shared)
-           croak("unlock can only be used on shared values");
-       SHAREDSvUNLOCK(shared);
-
-void
-lock_enabled(ref)
-        SV* ref
-        CODE:
-        shared_sv* shared;
-        if(SvROK(ref))
-            ref = SvRV(ref);
-        shared = Perl_sharedsv_find(aTHX, ref);
-        if(!shared)
-           croak("lock can only be used on shared values");
-        SHAREDSvLOCK(shared);
-
+       if(!shared)
+          croak("lock can only be used on shared values");
+       Perl_sharedsv_lock(aTHX_ shared);
 
 void
-cond_wait_enabled(ref)
-       SV* ref
+cond_wait_enabled(SV *ref)
        PROTOTYPE: \[$@%]
        CODE:
        shared_sv* shared;
@@ -512,18 +818,18 @@ cond_wait_enabled(ref)
        shared = Perl_sharedsv_find(aTHX_ ref);
        if(!shared)
            croak("cond_wait can only be used on shared values");
-       if(shared->owner != PERL_GET_CONTEXT)
+       if(shared->owner != aTHX)
            croak("You need a lock before you can cond_wait");
        MUTEX_LOCK(&shared->mutex);
        shared->owner = NULL;
        locks = shared->locks = 0;
        COND_WAIT(&shared->user_cond, &shared->mutex);
-       shared->owner = PERL_GET_CONTEXT;
+       shared->owner = aTHX;
        shared->locks = locks;
        MUTEX_UNLOCK(&shared->mutex);
 
-void cond_signal_enabled(ref)
-       SV* ref
+void
+cond_signal_enabled(SV *ref)
        PROTOTYPE: \[$@%]
        CODE:
        shared_sv* shared;
@@ -534,9 +840,8 @@ void cond_signal_enabled(ref)
            croak("cond_signal can only be used on shared values");
        COND_SIGNAL(&shared->user_cond);
 
-
-void cond_broadcast_enabled(ref)
-       SV* ref
+void
+cond_broadcast_enabled(SV *ref)
        PROTOTYPE: \[$@%]
        CODE:
        shared_sv* shared;
@@ -547,551 +852,6 @@ void cond_broadcast_enabled(ref)
            croak("cond_broadcast can only be used on shared values");
        COND_BROADCAST(&shared->user_cond);
 
-MODULE = threads::shared               PACKAGE = threads::shared::sv           
-
-SV*
-new(class, value)
-       SV* class
-       SV* value
-       CODE:
-       shared_sv* shared = Perl_sharedsv_new(aTHX);
-        MAGIC* shared_magic;
-       SV* obj = newSViv(PTR2IV(shared));
-       SHAREDSvEDIT(shared);
-       SHAREDSvGET(shared) = newSVsv(value);
-        SHAREDSvRELEASE(shared);
-       sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
-        shared_magic = mg_find(value, PERL_MAGIC_ext);
-        shared_magic->mg_virtual = &svtable;
-        shared_magic->mg_obj = newSViv(PTR2IV(shared));
-        shared_magic->mg_flags |= MGf_REFCOUNTED;
-        shared_magic->mg_private = 0;
-        SvMAGICAL_on(value);
-        RETVAL = obj;
-        OUTPUT:                
-        RETVAL
-
-
-MODULE = threads::shared               PACKAGE = threads::shared::av
-
-SV*
-new(class, value)
-       SV* class
-       SV* value
-       CODE:
-       shared_sv* shared = Perl_sharedsv_new(aTHX);
-       SV* obj = newSViv(PTR2IV(shared));
-        SHAREDSvEDIT(shared);
-        SHAREDSvGET(shared) = (SV*) newAV();
-        SHAREDSvRELEASE(shared);
-        RETVAL = obj;
-        OUTPUT:
-        RETVAL
-
-void
-STORE(self, index, value)
-        SV* self
-       SV* index
-        SV* value
-        CODE:
-        shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-        shared_sv* slot;
-        SV* aentry;
-       SV** aentry_;
-       if(SvROK(value)) {
-           shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
-           if(!target) {
-                Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
-           }
-            value = newRV_noinc(newSViv(PTR2IV(target)));
-        }
-       SHAREDSvLOCK(shared);
-       aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
-       if(aentry_ && SvIV((*aentry_))) {
-           aentry = (*aentry_);
-            slot = INT2PTR(shared_sv*, SvIV(aentry));
-            if(SvROK(SHAREDSvGET(slot)))
-                Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
-            SHAREDSvEDIT(slot);
-            sv_setsv(SHAREDSvGET(slot), value);
-            SHAREDSvRELEASE(slot);
-       } else {
-            slot = Perl_sharedsv_new(aTHX);
-            SHAREDSvEDIT(shared);
-            SHAREDSvGET(slot) = newSVsv(value);
-            aentry = newSViv(PTR2IV(slot));
-            av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
-            SHAREDSvRELEASE(shared);
-       }
-        if(SvROK(SHAREDSvGET(slot)))
-            Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
-
-        SHAREDSvUNLOCK(shared);
-
-SV*
-FETCH(self, index)
-        SV* self
-       SV* index
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       shared_sv* slot;
-       SV* aentry;
-       SV** aentry_;
-       SV* retval;
-       SHAREDSvLOCK(shared);
-       aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
-       if(aentry_) {
-           aentry = (*aentry_);
-            if(SvTYPE(aentry) == SVt_NULL) {
-               retval = &PL_sv_undef;
-           } else {
-               slot = INT2PTR(shared_sv*, SvIV(aentry));
-               if(SvROK(SHAREDSvGET(slot))) {
-                    shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-                    retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
-               } else {
-                    retval = newSVsv(SHAREDSvGET(slot));
-               }
-            }
-       } else {
-           retval = &PL_sv_undef;
-       }
-        SHAREDSvUNLOCK(shared);        
-        RETVAL = retval;
-        OUTPUT:
-        RETVAL
-
-void
-PUSH(self, ...)
-       SV* self
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-        int i;
-        SHAREDSvLOCK(shared);
-       for(i = 1; i < items; i++) {
-           shared_sv* slot = Perl_sharedsv_new(aTHX);
-           SV* tmp = ST(i);
-           if(SvROK(tmp)) {
-                 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
-                 if(!target) {
-                     Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
-                 }
-                 tmp = newRV_noinc(newSViv(PTR2IV(target)));
-            }
-            SHAREDSvEDIT(slot);
-           SHAREDSvGET(slot) = newSVsv(tmp);
-           av_push((AV*) SHAREDSvGET(shared), newSViv(PTR2IV(slot)));
-           SHAREDSvRELEASE(slot);
-           if(SvROK(SHAREDSvGET(slot)))
-                Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
-       }
-        SHAREDSvUNLOCK(shared);
-
-void
-UNSHIFT(self, ...)
-       SV* self
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-        int i;
-        SHAREDSvLOCK(shared);
-       SHAREDSvEDIT(shared);
-       av_unshift((AV*)SHAREDSvGET(shared), items - 1);
-       SHAREDSvRELEASE(shared);
-       for(i = 1; i < items; i++) {
-           shared_sv* slot = Perl_sharedsv_new(aTHX);
-           SV* tmp = ST(i);
-           if(SvROK(tmp)) {
-                 shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
-                 if(!target) {
-                     Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared array");
-                 }
-                 tmp = newRV_noinc(newSViv(PTR2IV(target)));
-            }
-            SHAREDSvEDIT(slot);
-           SHAREDSvGET(slot) = newSVsv(tmp);
-           av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv(PTR2IV(slot)));
-           SHAREDSvRELEASE(slot);
-           if(SvROK(SHAREDSvGET(slot)))
-                Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
-       }
-        SHAREDSvUNLOCK(shared);
-
-SV*
-POP(self)
-       SV* self
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       shared_sv* slot;
-       SV* retval;
-       SHAREDSvLOCK(shared);
-       SHAREDSvEDIT(shared);
-       retval = av_pop((AV*)SHAREDSvGET(shared));
-       SHAREDSvRELEASE(shared);
-       if(retval && SvIV(retval)) {
-           slot = INT2PTR(shared_sv*, SvIV(retval));
-           if(SvROK(SHAREDSvGET(slot))) {
-                shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-                retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
-           } else {
-                retval = newSVsv(SHAREDSvGET(slot));
-            }
-            Perl_sharedsv_thrcnt_dec(aTHX_ slot);
-       } else {
-            retval = &PL_sv_undef;
-       }
-       SHAREDSvUNLOCK(shared);
-       RETVAL = retval;
-       OUTPUT:
-       RETVAL
-
-
-SV*
-SHIFT(self)
-       SV* self
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       shared_sv* slot;
-       SV* retval;
-       SHAREDSvLOCK(shared);
-       SHAREDSvEDIT(shared);
-       retval = av_shift((AV*)SHAREDSvGET(shared));
-       SHAREDSvRELEASE(shared);
-       if(retval && SvIV(retval)) {
-           slot = INT2PTR(shared_sv*, SvIV(retval));
-            if(SvROK(SHAREDSvGET(slot))) {
-                 shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-                 retval = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
-            } else {
-                 retval = newSVsv(SHAREDSvGET(slot));
-            }
-            Perl_sharedsv_thrcnt_dec(aTHX_ slot);
-       } else {
-            retval = &PL_sv_undef;
-       }
-       SHAREDSvUNLOCK(shared);
-       RETVAL = retval;
-       OUTPUT:
-       RETVAL
-
-void
-CLEAR(self)
-       SV* self
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       shared_sv* slot;
-       SV** svp;
-       I32 i;
-       SHAREDSvLOCK(shared);
-       svp = AvARRAY((AV*)SHAREDSvGET(shared));
-       i   = AvFILLp((AV*)SHAREDSvGET(shared));
-       while ( i >= 0) {
-           if(SvIV(svp[i])) {
-               Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(svp[i])));
-           }
-           i--;
-       }
-       SHAREDSvEDIT(shared);
-       av_clear((AV*)SHAREDSvGET(shared));
-       SHAREDSvRELEASE(shared);
-       SHAREDSvUNLOCK(shared);
-       
-void
-EXTEND(self, count)
-       SV* self
-       SV* count
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       SHAREDSvEDIT(shared);
-       av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
-       SHAREDSvRELEASE(shared);
-
-
-
-
-SV*
-EXISTS(self, index)
-       SV* self
-       SV* index
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       I32 exists;
-       SHAREDSvLOCK(shared);
-       exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
-       if(exists) {
-           RETVAL = &PL_sv_yes;
-       } else {
-           RETVAL = &PL_sv_no;
-       }
-       SHAREDSvUNLOCK(shared);
-
-void
-STORESIZE(self,count)
-       SV* self
-       SV* count
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       SHAREDSvEDIT(shared);
-       av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
-       SHAREDSvRELEASE(shared);
-
-SV*
-FETCHSIZE(self)
-       SV* self
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       SHAREDSvLOCK(shared);
-       RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
-       SHAREDSvUNLOCK(shared);
-       OUTPUT:
-       RETVAL
-
-SV*
-DELETE(self,index)
-       SV* self
-       SV* index
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       shared_sv* slot;
-       SHAREDSvLOCK(shared);
-       if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
-           SV* tmp;
-           SHAREDSvEDIT(shared);
-           tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
-           SHAREDSvRELEASE(shared);
-           if(SvIV(tmp)) {
-               slot = INT2PTR(shared_sv*, SvIV(tmp));
-                if(SvROK(SHAREDSvGET(slot))) {
-                   shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-                   RETVAL = Perl_shared_sv_attach_sv(aTHX_ NULL,target);
-                } else {
-                   RETVAL = newSVsv(SHAREDSvGET(slot));
-                }
-                Perl_sharedsv_thrcnt_dec(aTHX_ slot);
-           } else {
-                RETVAL = &PL_sv_undef;
-           }   
-       } else {
-           RETVAL = &PL_sv_undef;
-       }       
-       SHAREDSvUNLOCK(shared);
-       OUTPUT:
-       RETVAL
-
-AV*
-SPLICE(self, offset, length, ...)
-       SV* self
-       SV* offset
-       SV* length
-       CODE:
-       croak("Splice is not implmented for shared arrays");
-       
-MODULE = threads::shared               PACKAGE = threads::shared::hv
-
-SV*
-new(class, value)
-       SV* class
-       SV* value
-       CODE:
-       shared_sv* shared = Perl_sharedsv_new(aTHX);
-       SV* obj = newSViv(PTR2IV(shared));
-        SHAREDSvEDIT(shared);
-        SHAREDSvGET(shared) = (SV*) newHV();
-        SHAREDSvRELEASE(shared);
-        RETVAL = obj;
-        OUTPUT:
-        RETVAL
-
-void
-STORE(self, key, value)
-        SV* self
-        SV* key
-        SV* value
-        CODE:
-        shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-        shared_sv* slot;
-        SV* hentry;
-        SV** hentry_;
-       STRLEN len;
-       char* ckey = SvPV(key, len);
-        SHAREDSvLOCK(shared);
-       if(SvROK(value)) {
-           shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
-           if(!target) {
-               Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
-            }
-           SHAREDSvEDIT(shared);
-           value = newRV_noinc(newSViv(PTR2IV(target)));
-           SHAREDSvRELEASE(shared);
-       }
-        hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
-        if(hentry_ && SvIV((*hentry_))) {
-            hentry = (*hentry_);
-            slot = INT2PTR(shared_sv*, SvIV(hentry));
-            if(SvROK(SHAREDSvGET(slot)))
-                Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
-            SHAREDSvEDIT(slot);
-            sv_setsv(SHAREDSvGET(slot), value);
-            SHAREDSvRELEASE(slot);
-        } else {
-            slot = Perl_sharedsv_new(aTHX);
-            SHAREDSvEDIT(shared);
-            SHAREDSvGET(slot) = newSVsv(value);
-            hentry = newSViv(PTR2IV(slot));
-            hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
-            SHAREDSvRELEASE(shared);
-        }
-       if(SvROK(SHAREDSvGET(slot)))
-           Perl_sharedsv_thrcnt_inc(aTHX_ INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot)))));
-        SHAREDSvUNLOCK(shared);
-
-
-SV*
-FETCH(self, key)
-        SV* self
-        SV* key
-        CODE:
-        shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-        shared_sv* slot;
-        SV* hentry;
-        SV** hentry_;
-        SV* retval;
-       STRLEN len;
-       char* ckey = SvPV(key, len);
-        SHAREDSvLOCK(shared);
-        hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
-        if(hentry_) {
-            hentry = (*hentry_);
-            if(SvTYPE(hentry) == SVt_NULL) {
-                retval = &PL_sv_undef;
-            } else {
-                slot = INT2PTR(shared_sv*, SvIV(hentry));
-               if(SvROK(SHAREDSvGET(slot))) {
-                   shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-                   retval = Perl_shared_sv_attach_sv(aTHX_ NULL, target);
-               } else {
-                   retval = newSVsv(SHAREDSvGET(slot));
-               }
-            }
-        } else {
-            retval = &PL_sv_undef;
-        }
-        SHAREDSvUNLOCK(shared);
-        RETVAL = retval;
-        OUTPUT:
-        RETVAL
-
-void
-CLEAR(self)
-       SV* self
-       CODE:
-        shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-        shared_sv* slot;
-       HE* entry;
-       SHAREDSvLOCK(shared);
-       Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
-       entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
-       while(entry) {
-               slot = INT2PTR(shared_sv*, SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry)));
-               Perl_sharedsv_thrcnt_dec(aTHX_ slot);
-               entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
-       }
-       SHAREDSvEDIT(shared);
-       hv_clear((HV*) SHAREDSvGET(shared));
-       SHAREDSvRELEASE(shared);
-       SHAREDSvUNLOCK(shared);
-
-SV*
-FIRSTKEY(self)
-       SV* self
-       CODE:
-        shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       char* key = NULL;
-       I32 len;
-       HE* entry;
-       SHAREDSvLOCK(shared);
-        Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
-        entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
-       if(entry) {
-                key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
-               RETVAL = newSVpv(key, len);
-        } else {
-            RETVAL = &PL_sv_undef;
-       }
-        SHAREDSvUNLOCK(shared);
-       OUTPUT:
-       RETVAL
-
-
-SV*
-NEXTKEY(self, oldkey)
-        SV* self
-       SV* oldkey
-        CODE:
-        shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-        char* key = NULL;
-        I32 len;
-        HE* entry;
-        SHAREDSvLOCK(shared);
-        entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
-        if(entry) {
-                key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
-                RETVAL = newSVpv(key, len);
-        } else {
-             RETVAL = &PL_sv_undef;
-        }
-        SHAREDSvUNLOCK(shared);
-        OUTPUT:
-        RETVAL
-
-
-SV*
-EXISTS(self, key)
-       SV* self
-       SV* key
-       CODE:
-       shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       STRLEN len;
-       char* ckey = SvPV(key, len);
-       SHAREDSvLOCK(shared);
-       if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
-               RETVAL = &PL_sv_yes;
-       } else {
-               RETVAL = &PL_sv_no;
-       }
-       SHAREDSvUNLOCK(shared);
-       OUTPUT:
-       RETVAL
-
-SV*
-DELETE(self, key)
-        SV* self
-        SV* key
-        CODE:
-        shared_sv* shared = INT2PTR(shared_sv*, SvIV(SvRV(self)));
-       shared_sv* slot;
-        STRLEN len;
-        char* ckey = SvPV(key, len);
-        SV* tmp;
-       SHAREDSvLOCK(shared);
-       SHAREDSvEDIT(shared);
-       tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
-       SHAREDSvRELEASE(shared);
-       if(tmp) {
-               slot = INT2PTR(shared_sv*, SvIV(tmp));
-               if(SvROK(SHAREDSvGET(slot))) {
-                   shared_sv* target = INT2PTR(shared_sv*, SvIV(SvRV(SHAREDSvGET(slot))));
-                   RETVAL = Perl_shared_sv_attach_sv(aTHX_ NULL, target);
-               } else {
-                   RETVAL = newSVsv(SHAREDSvGET(slot));
-               }
-               Perl_sharedsv_thrcnt_dec(aTHX_ slot);
-       } else {
-               RETVAL = &PL_sv_undef;
-       }
-        SHAREDSvUNLOCK(shared);
-        OUTPUT:
-        RETVAL
-
 BOOT:
 {
      Perl_sharedsv_init(aTHX);
diff --git a/ext/threads/shared/typemap b/ext/threads/shared/typemap
new file mode 100644 (file)
index 0000000..0202d04
--- /dev/null
@@ -0,0 +1,7 @@
+shared_sv *    T_SHAREDSV
+
+INPUT
+T_SHAREDSV
+       $var = SV_to_sharedsv(aTHX_ $arg)
+
+