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     return ssv;
  72 }
  73
  74
  75 /*
  76 =for apidoc sharedsv_find
  77
  78 Tries to find if a given SV has a shared backend, either by
  79 looking at magic, or by checking if it is tied again threads::shared.
  80
  81 =cut
  82 */
  83
  84 shared_sv *
  85 Perl_sharedsv_find(pTHX_ SV* sv)
  86 {
  87   /* does all it can to find a shared_sv struct, returns NULL otherwise */
  88     shared_sv* ssv = NULL;
  89     switch (SvTYPE(sv)) {
  90         case SVt_PVMG:
  91             {MAGIC* mg = mg_find(sv, PERL_MAGIC_ext);
  92
  93             if(strcmp(mg->mg_ptr,"threads::shared"))
  94                 break;
  95             ssv = (shared_sv*) SvIV(mg->mg_obj);
  96             }
  97     }
  98     return ssv;
  99 }
 100
 101 /*
 102 =for apidoc sharedsv_lock
 103
 104 Recursive locks on a sharedsv.
 105 Locks are dynamicly scoped at the level of the first lock.
 106 =cut
 107 */
 108 void
 109 Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
 110 {
 111     if(!ssv)
 112         return;
 113     MUTEX_LOCK(&ssv->mutex);
 114     if(ssv->owner && ssv->owner == my_perl) {
 115         ssv->locks++;
 116         MUTEX_UNLOCK(&ssv->mutex);
 117         return;
 118     }
 119     while(ssv->owner)
 120       COND_WAIT(&ssv->cond,&ssv->mutex);
 121     ssv->locks++;
 122     ssv->owner = my_perl;
 123     if(ssv->locks == 1)
 124         SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
 125     MUTEX_UNLOCK(&ssv->mutex);
 126 }
 127
 128 /*
 129 =for apidoc sharedsv_unlock
 130
 131 Recursively unlocks a shared sv.
 132
 133 =cut
 134 */
 135
 136 void
 137 Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
 138 {
 139     MUTEX_LOCK(&ssv->mutex);
 140     if(ssv->owner != my_perl) {
 141         Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
 142         MUTEX_UNLOCK(&ssv->mutex);
 143         return;
 144     }
 145
 146     if(--ssv->locks == 0) {
 147         ssv->owner = NULL;
 148         COND_SIGNAL(&ssv->cond);
 149     }
 150     MUTEX_UNLOCK(&ssv->mutex);
 151  }
 152
 153 void
 154 Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
 155 {
 156     MUTEX_LOCK(&ssv->mutex);
 157     if(ssv->owner != my_perl) {
 158         MUTEX_UNLOCK(&ssv->mutex);
 159         return;
 160     }
 161     ssv->locks = 0;
 162     ssv->owner = NULL;
 163     COND_SIGNAL(&ssv->cond);
 164     MUTEX_UNLOCK(&ssv->mutex);
 165 }
 166
 167 /*
 168 =for apidoc sharedsv_thrcnt_inc
 169
 170 Increments the threadcount of a sharedsv.
 171 =cut
 172 */
 173 void
 174 Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
 175 {
 176   SHAREDSvLOCK(ssv);
 177   SvREFCNT_inc(ssv->sv);
 178   SHAREDSvUNLOCK(ssv);
 179 }
 180
 181 /*
 182 =for apidoc sharedsv_thrcnt_dec
 183
 184 Decrements the threadcount of a shared sv. When a threads frontend is freed
 185 this function should be called.
 186
 187 =cut
 188 */
 189
 190 void
 191 Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
 192 {
 193     SV* sv;
 194     SHAREDSvLOCK(ssv);
 195     sv = SHAREDSvGET(ssv);
 196     if (SvREFCNT(sv) == 1) {
 197         switch (SvTYPE(sv)) {
 198         case SVt_RV:
 199             if (SvROK(sv))
 200             Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
 201             break;
 202         case SVt_PVAV: {
 203             SV **src_ary  = AvARRAY((AV *)sv);
 204             SSize_t items = AvFILLp((AV *)sv) + 1;
 205
 206             while (items-- > 0) {
 207             if(SvTYPE(*src_ary))
 208                 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary++)));
 209             }
 210             break;
 211         }
 212         case SVt_PVHV: {
 213             HE *entry;
 214             (void)hv_iterinit((HV *)sv);
 215             while ((entry = hv_iternext((HV *)sv)))
 216                 Perl_sharedsv_thrcnt_dec(
 217                     aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
 218                 );
 219             break;
 220         }
 221         }
 222     }
 223     Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
 224     SHAREDSvUNLOCK(ssv);
 225 }
 226
 227 #endif /* USE_ITHREADS */
 228