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