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