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