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 | /* |
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 |
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 | |
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 |
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 | |
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 |
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: |
92 | {MAGIC* mg = mg_find(sv, PERL_MAGIC_ext); |
93 | |
94 | if(strcmp(mg->mg_ptr,"threads::shared")) |
95 | break; |
96 | ssv = (shared_sv*) SvIV(mg->mg_obj); |
97 | } |
98 | } |
cd1ee231 |
99 | return ssv; |
100 | } |
101 | |
102 | /* |
103 | =for apidoc sharedsv_lock |
104 | |
105 | Recursive locks on a sharedsv. |
106 | Locks are dynamicly scoped at the level of the first lock. |
107 | =cut |
108 | */ |
109 | void |
110 | Perl_sharedsv_lock(pTHX_ shared_sv* ssv) |
111 | { |
112 | if(!ssv) |
113 | return; |
39696b0c |
114 | MUTEX_LOCK(&ssv->mutex); |
cd1ee231 |
115 | if(ssv->owner && ssv->owner == my_perl) { |
116 | ssv->locks++; |
39696b0c |
117 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
118 | return; |
119 | } |
39696b0c |
120 | while(ssv->owner) |
121 | COND_WAIT(&ssv->cond,&ssv->mutex); |
cd1ee231 |
122 | ssv->locks++; |
123 | ssv->owner = my_perl; |
124 | if(ssv->locks == 1) |
125 | SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv); |
39696b0c |
126 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
127 | } |
128 | |
129 | /* |
130 | =for apidoc sharedsv_unlock |
131 | |
132 | Recursively unlocks a shared sv. |
133 | |
134 | =cut |
135 | */ |
136 | |
137 | void |
138 | Perl_sharedsv_unlock(pTHX_ shared_sv* ssv) |
139 | { |
39696b0c |
140 | MUTEX_LOCK(&ssv->mutex); |
141 | if(ssv->owner != my_perl) { |
142 | Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own"); |
143 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
144 | return; |
39696b0c |
145 | } |
cd1ee231 |
146 | |
147 | if(--ssv->locks == 0) { |
148 | ssv->owner = NULL; |
39696b0c |
149 | COND_SIGNAL(&ssv->cond); |
cd1ee231 |
150 | } |
39696b0c |
151 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
152 | } |
153 | |
154 | void |
155 | Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv) |
156 | { |
39696b0c |
157 | MUTEX_LOCK(&ssv->mutex); |
158 | if(ssv->owner != my_perl) { |
159 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
160 | return; |
39696b0c |
161 | } |
cd1ee231 |
162 | ssv->locks = 0; |
163 | ssv->owner = NULL; |
39696b0c |
164 | COND_SIGNAL(&ssv->cond); |
cd1ee231 |
165 | MUTEX_UNLOCK(&ssv->mutex); |
166 | } |
167 | |
168 | /* |
169 | =for apidoc sharedsv_thrcnt_inc |
170 | |
171 | Increments the threadcount of a sharedsv. |
172 | =cut |
173 | */ |
174 | void |
175 | Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv) |
176 | { |
b050c948 |
177 | SHAREDSvLOCK(ssv); |
cd1ee231 |
178 | SvREFCNT_inc(ssv->sv); |
b050c948 |
179 | SHAREDSvUNLOCK(ssv); |
cd1ee231 |
180 | } |
181 | |
182 | /* |
183 | =for apidoc sharedsv_thrcnt_dec |
184 | |
185 | Decrements the threadcount of a shared sv. When a threads frontend is freed |
186 | this function should be called. |
187 | |
188 | =cut |
189 | */ |
190 | |
191 | void |
192 | Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv) |
193 | { |
194 | SV* sv; |
b050c948 |
195 | SHAREDSvLOCK(ssv); |
cd1ee231 |
196 | sv = SHAREDSvGET(ssv); |
197 | if (SvREFCNT(sv) == 1) { |
198 | switch (SvTYPE(sv)) { |
199 | case SVt_RV: |
200 | if (SvROK(sv)) |
cbfa9890 |
201 | Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv)))); |
cd1ee231 |
202 | break; |
203 | case SVt_PVAV: { |
204 | SV **src_ary = AvARRAY((AV *)sv); |
205 | SSize_t items = AvFILLp((AV *)sv) + 1; |
206 | |
207 | while (items-- > 0) { |
208 | if(SvTYPE(*src_ary)) |
cbfa9890 |
209 | Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary++))); |
cd1ee231 |
210 | } |
211 | break; |
212 | } |
213 | case SVt_PVHV: { |
214 | HE *entry; |
215 | (void)hv_iterinit((HV *)sv); |
216 | while ((entry = hv_iternext((HV *)sv))) |
217 | Perl_sharedsv_thrcnt_dec( |
cbfa9890 |
218 | aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry))) |
cd1ee231 |
219 | ); |
220 | break; |
221 | } |
222 | } |
223 | } |
b050c948 |
224 | Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(ssv)); |
225 | SHAREDSvUNLOCK(ssv); |
cd1ee231 |
226 | } |
227 | |
0a66a22f |
228 | #endif /* USE_ITHREADS */ |
39696b0c |
229 | |