Commit | Line | Data |
---|---|---|
cd1ee231 JH |
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 RGS |
23 | #ifdef USE_ITHREADS |
24 | ||
4f896ddc | 25 | |
cd1ee231 | 26 | |
cd1ee231 JH |
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 | { | |
59ae5728 AB |
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 JH |
52 | } |
53 | ||
54 | /* | |
55 | =for apidoc sharedsv_new | |
56 | ||
57 | Allocates a new shared sv struct, you must yourself create the SV/AV/HV. | |
58 | =cut | |
59 | */ | |
60 | ||
61 | shared_sv * | |
62 | Perl_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 AB |
68 | COND_INIT(&ssv->user_cond); |
69 | ssv->owner = 0; | |
cd1ee231 | 70 | ssv->locks = 0; |
55fc11ad | 71 | ssv->index = 0; |
cd1ee231 JH |
72 | return ssv; |
73 | } | |
74 | ||
75 | ||
76 | /* | |
77 | =for apidoc sharedsv_find | |
78 | ||
79 | Tries to find if a given SV has a shared backend, either by | |
80 | looking at magic, or by checking if it is tied again threads::shared. | |
81 | ||
82 | =cut | |
83 | */ | |
84 | ||
85 | shared_sv * | |
86 | Perl_sharedsv_find(pTHX_ SV* sv) | |
87 | { | |
b050c948 AB |
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 AB |
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 AB |
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 AB |
107 | break; |
108 | } | |
109 | } | |
b050c948 | 110 | } |
cd1ee231 JH |
111 | return ssv; |
112 | } | |
113 | ||
114 | /* | |
115 | =for apidoc sharedsv_lock | |
116 | ||
117 | Recursive locks on a sharedsv. | |
118 | Locks are dynamicly scoped at the level of the first lock. | |
119 | =cut | |
120 | */ | |
121 | void | |
122 | Perl_sharedsv_lock(pTHX_ shared_sv* ssv) | |
123 | { | |
124 | if(!ssv) | |
125 | return; | |
39696b0c | 126 | MUTEX_LOCK(&ssv->mutex); |
cd1ee231 JH |
127 | if(ssv->owner && ssv->owner == my_perl) { |
128 | ssv->locks++; | |
39696b0c | 129 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 JH |
130 | return; |
131 | } | |
39696b0c AB |
132 | while(ssv->owner) |
133 | COND_WAIT(&ssv->cond,&ssv->mutex); | |
cd1ee231 JH |
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 JH |
139 | } |
140 | ||
141 | /* | |
142 | =for apidoc sharedsv_unlock | |
143 | ||
144 | Recursively unlocks a shared sv. | |
145 | ||
146 | =cut | |
147 | */ | |
148 | ||
149 | void | |
150 | Perl_sharedsv_unlock(pTHX_ shared_sv* ssv) | |
151 | { | |
39696b0c AB |
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 JH |
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 JH |
164 | } |
165 | ||
166 | void | |
167 | Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv) | |
168 | { | |
39696b0c AB |
169 | MUTEX_LOCK(&ssv->mutex); |
170 | if(ssv->owner != my_perl) { | |
171 | MUTEX_UNLOCK(&ssv->mutex); | |
cd1ee231 | 172 | return; |
39696b0c | 173 | } |
cd1ee231 JH |
174 | ssv->locks = 0; |
175 | ssv->owner = NULL; | |
39696b0c | 176 | COND_SIGNAL(&ssv->cond); |
cd1ee231 JH |
177 | MUTEX_UNLOCK(&ssv->mutex); |
178 | } | |
179 | ||
180 | /* | |
181 | =for apidoc sharedsv_thrcnt_inc | |
182 | ||
183 | Increments the threadcount of a sharedsv. | |
184 | =cut | |
185 | */ | |
186 | void | |
187 | Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv) | |
188 | { | |
b050c948 | 189 | SHAREDSvLOCK(ssv); |
cd1ee231 | 190 | SvREFCNT_inc(ssv->sv); |
b050c948 | 191 | SHAREDSvUNLOCK(ssv); |
cd1ee231 JH |
192 | } |
193 | ||
194 | /* | |
195 | =for apidoc sharedsv_thrcnt_dec | |
196 | ||
197 | Decrements the threadcount of a shared sv. When a threads frontend is freed | |
198 | this function should be called. | |
199 | ||
200 | =cut | |
201 | */ | |
202 | ||
203 | void | |
204 | Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv) | |
205 | { | |
206 | SV* sv; | |
b050c948 | 207 | SHAREDSvLOCK(ssv); |
cd1ee231 JH |
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 JH |
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 AB |
221 | Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary))); |
222 | src_ary++; | |
cd1ee231 JH |
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 JH |
232 | ); |
233 | break; | |
234 | } | |
235 | } | |
236 | } | |
b050c948 AB |
237 | Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv)); |
238 | SHAREDSvUNLOCK(ssv); | |
cd1ee231 JH |
239 | } |
240 | ||
0a66a22f | 241 | #endif /* USE_ITHREADS */ |
39696b0c | 242 |