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