3 * Copyright (c) 2001, Larry Wall
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.
11 * Contributed by Arthur Bergman arthur@contiller.se
13 * "Hand any two wizards a piece of rope and they would instinctively pull in
14 * opposite directions."
20 #define PERL_IN_SHAREDSV_C
30 Shared SV is a structure for keeping the backend storage
36 =head1 Shared SV Functions
38 =for apidoc sharedsv_init
40 Saves a space for keeping SVs wider than an interpreter,
41 currently only stores a pointer to the first interpreter.
47 Perl_sharedsv_init(pTHX)
49 PerlInterpreter* old_context = PERL_GET_CONTEXT;
50 PL_sharedsv_space = perl_alloc();
51 perl_construct(PL_sharedsv_space);
52 PERL_SET_CONTEXT(old_context);
53 MUTEX_INIT(&PL_sharedsv_space_mutex);
57 =for apidoc sharedsv_new
59 Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
64 Perl_sharedsv_new(pTHX)
67 New(2555,ssv,1,shared_sv);
68 MUTEX_INIT(&ssv->mutex);
69 COND_INIT(&ssv->cond);
70 COND_INIT(&ssv->user_cond);
79 =for apidoc sharedsv_find
81 Tries to find if a given SV has a shared backend, either by
82 looking at magic, or by checking if it is tied again threads::shared.
88 Perl_sharedsv_find(pTHX_ SV* sv)
90 /* does all it can to find a shared_sv struct, returns NULL otherwise */
91 shared_sv* ssv = NULL;
96 MAGIC* mg = mg_find(sv, PERL_MAGIC_ext);
98 if(strcmp(mg->mg_ptr,"threads::shared"))
100 ssv = INT2PTR(shared_sv *, SvIV(mg->mg_obj));
104 mg = mg_find(sv,PERL_MAGIC_tied);
106 SV* obj = SvTIED_obj(sv,mg);
107 if(sv_derived_from(obj, "threads::shared"))
108 ssv = INT2PTR(shared_sv *, SvIV(SvRV(obj)));
117 =for apidoc sharedsv_lock
119 Recursive locks on a sharedsv.
120 Locks are dynamically scoped at the level of the first lock.
124 Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
128 MUTEX_LOCK(&ssv->mutex);
129 if(ssv->owner && ssv->owner == my_perl) {
131 MUTEX_UNLOCK(&ssv->mutex);
135 COND_WAIT(&ssv->cond,&ssv->mutex);
137 ssv->owner = my_perl;
139 SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
140 MUTEX_UNLOCK(&ssv->mutex);
144 =for apidoc sharedsv_unlock
146 Recursively unlocks a shared sv.
152 Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
154 MUTEX_LOCK(&ssv->mutex);
155 if(ssv->owner != my_perl) {
156 Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
157 MUTEX_UNLOCK(&ssv->mutex);
161 if(--ssv->locks == 0) {
163 COND_SIGNAL(&ssv->cond);
165 MUTEX_UNLOCK(&ssv->mutex);
169 Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
171 MUTEX_LOCK(&ssv->mutex);
172 if(ssv->owner != my_perl) {
173 MUTEX_UNLOCK(&ssv->mutex);
178 COND_SIGNAL(&ssv->cond);
179 MUTEX_UNLOCK(&ssv->mutex);
183 =for apidoc sharedsv_thrcnt_inc
185 Increments the threadcount of a sharedsv.
189 Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
192 SvREFCNT_inc(ssv->sv);
197 =for apidoc sharedsv_thrcnt_dec
199 Decrements the threadcount of a shared sv. When a threads frontend is freed
200 this function should be called.
206 Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
210 sv = SHAREDSvGET(ssv);
211 if (SvREFCNT(sv) == 1) {
212 switch (SvTYPE(sv)) {
215 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
218 SV **src_ary = AvARRAY((AV *)sv);
219 SSize_t items = AvFILLp((AV *)sv) + 1;
221 while (items-- > 0) {
223 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary)));
230 (void)hv_iterinit((HV *)sv);
231 while ((entry = hv_iternext((HV *)sv)))
232 Perl_sharedsv_thrcnt_dec(
233 aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
239 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
243 #endif /* USE_ITHREADS */