| 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_ (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_ (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_ (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 */ |