$VERSION "a5" doesn't quite work.
[p5sagit/p5-mst-13.2.git] / sharedsv.c
CommitLineData
cd1ee231 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
0a66a22f 23#ifdef USE_ITHREADS
24
4f896ddc 25
cd1ee231 26
cd1ee231 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
38Saves a space for keeping SVs wider than an interpreter,
39currently only stores a pointer to the first interpreter.
40
41=cut
42*/
43
44void
45Perl_sharedsv_init(pTHX)
46{
59ae5728 47 PerlInterpreter* old_context = PERL_GET_CONTEXT;
48 PL_sharedsv_space = perl_alloc();
49 perl_construct(PL_sharedsv_space);
50 PERL_SET_CONTEXT(old_context);
51 MUTEX_INIT(&PL_sharedsv_space_mutex);
cd1ee231 52}
53
54/*
55=for apidoc sharedsv_new
56
57Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
58=cut
59*/
60
61shared_sv *
62Perl_sharedsv_new(pTHX)
63{
64 shared_sv* ssv;
65 New(2555,ssv,1,shared_sv);
66 MUTEX_INIT(&ssv->mutex);
67 COND_INIT(&ssv->cond);
39696b0c 68 COND_INIT(&ssv->user_cond);
69 ssv->owner = 0;
cd1ee231 70 ssv->locks = 0;
55fc11ad 71 ssv->index = 0;
cd1ee231 72 return ssv;
73}
74
75
76/*
77=for apidoc sharedsv_find
78
79Tries to find if a given SV has a shared backend, either by
80looking at magic, or by checking if it is tied again threads::shared.
81
82=cut
83*/
84
85shared_sv *
86Perl_sharedsv_find(pTHX_ SV* sv)
87{
b050c948 88 /* does all it can to find a shared_sv struct, returns NULL otherwise */
89 shared_sv* ssv = NULL;
90 switch (SvTYPE(sv)) {
91 case SVt_PVMG:
cd946ae2 92 case SVt_PVAV:
93 case SVt_PVHV: {
94 MAGIC* mg = mg_find(sv, PERL_MAGIC_ext);
95 if(mg) {
96 if(strcmp(mg->mg_ptr,"threads::shared"))
97 break;
36f8622d 98 ssv = INT2PTR(shared_sv *, SvIV(mg->mg_obj));
cd946ae2 99 break;
100 }
101
102 mg = mg_find(sv,PERL_MAGIC_tied);
103 if(mg) {
104 SV* obj = SvTIED_obj(sv,mg);
105 if(sv_derived_from(obj, "threads::shared"))
36f8622d 106 ssv = INT2PTR(shared_sv *, SvIV(SvRV(obj)));
cd946ae2 107 break;
108 }
109 }
b050c948 110 }
cd1ee231 111 return ssv;
112}
113
114/*
115=for apidoc sharedsv_lock
116
117Recursive locks on a sharedsv.
118Locks are dynamicly scoped at the level of the first lock.
119=cut
120*/
121void
122Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
123{
124 if(!ssv)
125 return;
39696b0c 126 MUTEX_LOCK(&ssv->mutex);
cd1ee231 127 if(ssv->owner && ssv->owner == my_perl) {
128 ssv->locks++;
39696b0c 129 MUTEX_UNLOCK(&ssv->mutex);
cd1ee231 130 return;
131 }
39696b0c 132 while(ssv->owner)
133 COND_WAIT(&ssv->cond,&ssv->mutex);
cd1ee231 134 ssv->locks++;
135 ssv->owner = my_perl;
136 if(ssv->locks == 1)
137 SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
39696b0c 138 MUTEX_UNLOCK(&ssv->mutex);
cd1ee231 139}
140
141/*
142=for apidoc sharedsv_unlock
143
144Recursively unlocks a shared sv.
145
146=cut
147*/
148
149void
150Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
151{
39696b0c 152 MUTEX_LOCK(&ssv->mutex);
153 if(ssv->owner != my_perl) {
154 Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
155 MUTEX_UNLOCK(&ssv->mutex);
cd1ee231 156 return;
39696b0c 157 }
cd1ee231 158
159 if(--ssv->locks == 0) {
160 ssv->owner = NULL;
39696b0c 161 COND_SIGNAL(&ssv->cond);
cd1ee231 162 }
39696b0c 163 MUTEX_UNLOCK(&ssv->mutex);
cd1ee231 164 }
165
166void
167Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
168{
39696b0c 169 MUTEX_LOCK(&ssv->mutex);
170 if(ssv->owner != my_perl) {
171 MUTEX_UNLOCK(&ssv->mutex);
cd1ee231 172 return;
39696b0c 173 }
cd1ee231 174 ssv->locks = 0;
175 ssv->owner = NULL;
39696b0c 176 COND_SIGNAL(&ssv->cond);
cd1ee231 177 MUTEX_UNLOCK(&ssv->mutex);
178}
179
180/*
181=for apidoc sharedsv_thrcnt_inc
182
183Increments the threadcount of a sharedsv.
184=cut
185*/
186void
187Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
188{
b050c948 189 SHAREDSvLOCK(ssv);
cd1ee231 190 SvREFCNT_inc(ssv->sv);
b050c948 191 SHAREDSvUNLOCK(ssv);
cd1ee231 192}
193
194/*
195=for apidoc sharedsv_thrcnt_dec
196
197Decrements the threadcount of a shared sv. When a threads frontend is freed
198this function should be called.
199
200=cut
201*/
202
203void
204Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
205{
206 SV* sv;
b050c948 207 SHAREDSvLOCK(ssv);
cd1ee231 208 sv = SHAREDSvGET(ssv);
209 if (SvREFCNT(sv) == 1) {
210 switch (SvTYPE(sv)) {
211 case SVt_RV:
212 if (SvROK(sv))
cbfa9890 213 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
cd1ee231 214 break;
215 case SVt_PVAV: {
216 SV **src_ary = AvARRAY((AV *)sv);
217 SSize_t items = AvFILLp((AV *)sv) + 1;
218
219 while (items-- > 0) {
220 if(SvTYPE(*src_ary))
3cc54a1f 221 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary)));
222 src_ary++;
cd1ee231 223 }
224 break;
225 }
226 case SVt_PVHV: {
227 HE *entry;
228 (void)hv_iterinit((HV *)sv);
229 while ((entry = hv_iternext((HV *)sv)))
230 Perl_sharedsv_thrcnt_dec(
cbfa9890 231 aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
cd1ee231 232 );
233 break;
234 }
235 }
236 }
b050c948 237 Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv));
238 SHAREDSvUNLOCK(ssv);
cd1ee231 239}
240
0a66a22f 241#endif /* USE_ITHREADS */
39696b0c 242