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