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
25 PerlInterpreter* sharedsv_space;
26 perl_mutex sharedsv_space_mutex;
31 Shared SV is a structure for keeping the backend storage
37 =for apidoc sharedsv_init
39 Saves a space for keeping SVs wider than an interpreter,
40 currently only stores a pointer to the first interpreter.
46 Perl_sharedsv_init(pTHX)
48 sharedsv_space = PERL_GET_CONTEXT;
49 MUTEX_INIT(&sharedsv_space_mutex);
53 =for apidoc sharedsv_new
55 Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
60 Perl_sharedsv_new(pTHX)
63 New(2555,ssv,1,shared_sv);
64 MUTEX_INIT(&ssv->mutex);
65 COND_INIT(&ssv->cond);
66 COND_INIT(&ssv->user_cond);
74 =for apidoc sharedsv_find
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.
83 Perl_sharedsv_find(pTHX_ SV* sv)
85 /* does all it can to find a shared_sv struct, returns NULL otherwise */
86 shared_sv* ssv = NULL;
91 =for apidoc sharedsv_lock
93 Recursive locks on a sharedsv.
94 Locks are dynamicly scoped at the level of the first lock.
98 Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
102 MUTEX_LOCK(&ssv->mutex);
103 if(ssv->owner && ssv->owner == my_perl) {
105 MUTEX_UNLOCK(&ssv->mutex);
109 COND_WAIT(&ssv->cond,&ssv->mutex);
111 ssv->owner = my_perl;
113 SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
114 MUTEX_UNLOCK(&ssv->mutex);
118 =for apidoc sharedsv_unlock
120 Recursively unlocks a shared sv.
126 Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
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);
135 if(--ssv->locks == 0) {
137 COND_SIGNAL(&ssv->cond);
139 MUTEX_UNLOCK(&ssv->mutex);
143 Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
145 MUTEX_LOCK(&ssv->mutex);
146 if(ssv->owner != my_perl) {
147 MUTEX_UNLOCK(&ssv->mutex);
152 COND_SIGNAL(&ssv->cond);
153 MUTEX_UNLOCK(&ssv->mutex);
157 =for apidoc sharedsv_thrcnt_inc
159 Increments the threadcount of a sharedsv.
163 Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
166 SvREFCNT_inc(ssv->sv);
167 SHAREDSvRELEASE(ssv);
171 =for apidoc sharedsv_thrcnt_dec
173 Decrements the threadcount of a shared sv. When a threads frontend is freed
174 this function should be called.
180 Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
184 sv = SHAREDSvGET(ssv);
185 if (SvREFCNT(sv) == 1) {
186 switch (SvTYPE(sv)) {
189 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
192 SV **src_ary = AvARRAY((AV *)sv);
193 SSize_t items = AvFILLp((AV *)sv) + 1;
195 while (items-- > 0) {
197 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary++)));
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)))
213 SHAREDSvRELEASE(ssv);
216 #endif /* USE_ITHREADS */