sharedsv.c

   1 /*    sharedsv.c
   2  *
   3  *    Copyright (c) 2001, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11 * Contributed by Arthur Bergman arthur@contiller.se
  12 *
  13 * "Hand any two wizards a piece of rope and they would instinctively pull in
  14 * opposite directions."
  15 *                         --Sourcery
  16 *
  17 */
  18
  19 #include "EXTERN.h"
  20 #define PERL_IN_SHAREDSV_C
  21 #include "perl.h"
  22
  23 #ifdef USE_ITHREADS
  24
  25
  26
  27 /*
  28   Shared SV
  29
  30   Shared SV is a structure for keeping the backend storage
  31   of shared svs.
  32
  33  */
  34
  35 /*
  36 =for apidoc sharedsv_init
  37
  38 Saves a space for keeping SVs wider than an interpreter,
  39 currently only stores a pointer to the first interpreter.
  40
  41 =cut
  42 */
  43
  44 void
  45 Perl_sharedsv_init(pTHX)
  46 {
  47   PerlInterpreter* old_context = PERL_GET_CONTEXT;
  48   PL_sharedsv_space = perl_alloc();
  49   perl_construct(PL_sharedsv_space);
  50   PERL_SET_CONTEXT(old_context);
  51   MUTEX_INIT(&PL_sharedsv_space_mutex);
  52 }
  53
  54 /*
  55 =for apidoc sharedsv_new
  56
  57 Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
  58 =cut
  59 */
  60
  61 shared_sv *
  62 Perl_sharedsv_new(pTHX)
  63 {
  64     shared_sv* ssv;
  65     New(2555,ssv,1,shared_sv);
  66     MUTEX_INIT(&ssv->mutex);
  67     COND_INIT(&ssv->cond);
  68     COND_INIT(&ssv->user_cond);
  69     ssv->owner = 0;
  70     ssv->locks = 0;
  71     ssv->index = 0;
  72     return ssv;
  73 }
  74
  75
  76 /*
  77 =for apidoc sharedsv_find
  78
  79 Tries to find if a given SV has a shared backend, either by
  80 looking at magic, or by checking if it is tied again threads::shared.
  81
  82 =cut
  83 */
  84
  85 shared_sv *
  86 Perl_sharedsv_find(pTHX_ SV* sv)
  87 {
  88   /* does all it can to find a shared_sv struct, returns NULL otherwise */
  89     shared_sv* ssv = NULL;
  90     switch (SvTYPE(sv)) {
  91         case SVt_PVMG:
  92             {MAGIC* mg = mg_find(sv, PERL_MAGIC_ext);
  93
  94             if(strcmp(mg->mg_ptr,"threads::shared"))
  95                 break;
  96             ssv = (shared_sv*) SvIV(mg->mg_obj);
  97             }
  98     }
  99     return ssv;
 100 }
 101
 102 /*
 103 =for apidoc sharedsv_lock
 104
 105 Recursive locks on a sharedsv.
 106 Locks are dynamicly scoped at the level of the first lock.
 107 =cut
 108 */
 109 void
 110 Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
 111 {
 112     if(!ssv)
 113         return;
 114     MUTEX_LOCK(&ssv->mutex);
 115     if(ssv->owner && ssv->owner == my_perl) {
 116         ssv->locks++;
 117         MUTEX_UNLOCK(&ssv->mutex);
 118         return;
 119     }
 120     while(ssv->owner)
 121       COND_WAIT(&ssv->cond,&ssv->mutex);
 122     ssv->locks++;
 123     ssv->owner = my_perl;
 124     if(ssv->locks == 1)
 125         SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
 126     MUTEX_UNLOCK(&ssv->mutex);
 127 }
 128
 129 /*
 130 =for apidoc sharedsv_unlock
 131
 132 Recursively unlocks a shared sv.
 133
 134 =cut
 135 */
 136
 137 void
 138 Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
 139 {
 140     MUTEX_LOCK(&ssv->mutex);
 141     if(ssv->owner != my_perl) {
 142         Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
 143         MUTEX_UNLOCK(&ssv->mutex);
 144         return;
 145     }
 146
 147     if(--ssv->locks == 0) {
 148         ssv->owner = NULL;
 149         COND_SIGNAL(&ssv->cond);
 150     }
 151     MUTEX_UNLOCK(&ssv->mutex);
 152  }
 153
 154 void
 155 Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
 156 {
 157     MUTEX_LOCK(&ssv->mutex);
 158     if(ssv->owner != my_perl) {
 159         MUTEX_UNLOCK(&ssv->mutex);
 160         return;
 161     }
 162     ssv->locks = 0;
 163     ssv->owner = NULL;
 164     COND_SIGNAL(&ssv->cond);
 165     MUTEX_UNLOCK(&ssv->mutex);
 166 }
 167
 168 /*
 169 =for apidoc sharedsv_thrcnt_inc
 170
 171 Increments the threadcount of a sharedsv.
 172 =cut
 173 */
 174 void
 175 Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
 176 {
 177   SHAREDSvLOCK(ssv);
 178   SvREFCNT_inc(ssv->sv);
 179   SHAREDSvUNLOCK(ssv);
 180 }
 181
 182 /*
 183 =for apidoc sharedsv_thrcnt_dec
 184
 185 Decrements the threadcount of a shared sv. When a threads frontend is freed
 186 this function should be called.
 187
 188 =cut
 189 */
 190
 191 void
 192 Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
 193 {
 194     SV* sv;
 195     SHAREDSvLOCK(ssv);
 196     sv = SHAREDSvGET(ssv);
 197     if (SvREFCNT(sv) == 1) {
 198         switch (SvTYPE(sv)) {
 199         case SVt_RV:
 200             if (SvROK(sv))
 201             Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
 202             break;
 203         case SVt_PVAV: {
 204             SV **src_ary  = AvARRAY((AV *)sv);
 205             SSize_t items = AvFILLp((AV *)sv) + 1;
 206
 207             while (items-- > 0) {
 208             if(SvTYPE(*src_ary))
 209                 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary++)));
 210             }
 211             break;
 212         }
 213         case SVt_PVHV: {
 214             HE *entry;
 215             (void)hv_iterinit((HV *)sv);
 216             while ((entry = hv_iternext((HV *)sv)))
 217                 Perl_sharedsv_thrcnt_dec(
 218                     aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
 219                 );
 220             break;
 221         }
 222         }
 223     }
 224     Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
 225     SHAREDSvUNLOCK(ssv);
 226 }
 227
 228 #endif /* USE_ITHREADS */
 229