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 | { |
4f896ddc |
47 | PL_sharedsv_space = PERL_GET_CONTEXT; |
48 | MUTEX_INIT(&PL_sharedsv_space_mutex); |
cd1ee231 |
49 | } |
50 | |
51 | /* |
52 | =for apidoc sharedsv_new |
53 | |
54 | Allocates a new shared sv struct, you must yourself create the SV/AV/HV. |
55 | =cut |
56 | */ |
57 | |
58 | shared_sv * |
59 | Perl_sharedsv_new(pTHX) |
60 | { |
61 | shared_sv* ssv; |
62 | New(2555,ssv,1,shared_sv); |
63 | MUTEX_INIT(&ssv->mutex); |
64 | COND_INIT(&ssv->cond); |
39696b0c |
65 | COND_INIT(&ssv->user_cond); |
66 | ssv->owner = 0; |
cd1ee231 |
67 | ssv->locks = 0; |
68 | return ssv; |
69 | } |
70 | |
71 | |
72 | /* |
73 | =for apidoc sharedsv_find |
74 | |
75 | Tries to find if a given SV has a shared backend, either by |
76 | looking at magic, or by checking if it is tied again threads::shared. |
77 | |
78 | =cut |
79 | */ |
80 | |
81 | shared_sv * |
82 | Perl_sharedsv_find(pTHX_ SV* sv) |
83 | { |
84 | /* does all it can to find a shared_sv struct, returns NULL otherwise */ |
85 | shared_sv* ssv = NULL; |
86 | return ssv; |
87 | } |
88 | |
89 | /* |
90 | =for apidoc sharedsv_lock |
91 | |
92 | Recursive locks on a sharedsv. |
93 | Locks are dynamicly scoped at the level of the first lock. |
94 | =cut |
95 | */ |
96 | void |
97 | Perl_sharedsv_lock(pTHX_ shared_sv* ssv) |
98 | { |
99 | if(!ssv) |
100 | return; |
39696b0c |
101 | MUTEX_LOCK(&ssv->mutex); |
cd1ee231 |
102 | if(ssv->owner && ssv->owner == my_perl) { |
103 | ssv->locks++; |
39696b0c |
104 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
105 | return; |
106 | } |
39696b0c |
107 | while(ssv->owner) |
108 | COND_WAIT(&ssv->cond,&ssv->mutex); |
cd1ee231 |
109 | ssv->locks++; |
110 | ssv->owner = my_perl; |
111 | if(ssv->locks == 1) |
112 | SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv); |
39696b0c |
113 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
114 | } |
115 | |
116 | /* |
117 | =for apidoc sharedsv_unlock |
118 | |
119 | Recursively unlocks a shared sv. |
120 | |
121 | =cut |
122 | */ |
123 | |
124 | void |
125 | Perl_sharedsv_unlock(pTHX_ shared_sv* ssv) |
126 | { |
39696b0c |
127 | MUTEX_LOCK(&ssv->mutex); |
128 | if(ssv->owner != my_perl) { |
129 | Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own"); |
130 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
131 | return; |
39696b0c |
132 | } |
cd1ee231 |
133 | |
134 | if(--ssv->locks == 0) { |
135 | ssv->owner = NULL; |
39696b0c |
136 | COND_SIGNAL(&ssv->cond); |
cd1ee231 |
137 | } |
39696b0c |
138 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
139 | } |
140 | |
141 | void |
142 | Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv) |
143 | { |
39696b0c |
144 | MUTEX_LOCK(&ssv->mutex); |
145 | if(ssv->owner != my_perl) { |
146 | MUTEX_UNLOCK(&ssv->mutex); |
cd1ee231 |
147 | return; |
39696b0c |
148 | } |
cd1ee231 |
149 | ssv->locks = 0; |
150 | ssv->owner = NULL; |
39696b0c |
151 | COND_SIGNAL(&ssv->cond); |
cd1ee231 |
152 | MUTEX_UNLOCK(&ssv->mutex); |
153 | } |
154 | |
155 | /* |
156 | =for apidoc sharedsv_thrcnt_inc |
157 | |
158 | Increments the threadcount of a sharedsv. |
159 | =cut |
160 | */ |
161 | void |
162 | Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv) |
163 | { |
667883b0 |
164 | SHAREDSvEDIT(ssv); |
cd1ee231 |
165 | SvREFCNT_inc(ssv->sv); |
667883b0 |
166 | SHAREDSvRELEASE(ssv); |
cd1ee231 |
167 | } |
168 | |
169 | /* |
170 | =for apidoc sharedsv_thrcnt_dec |
171 | |
172 | Decrements the threadcount of a shared sv. When a threads frontend is freed |
173 | this function should be called. |
174 | |
175 | =cut |
176 | */ |
177 | |
178 | void |
179 | Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv) |
180 | { |
181 | SV* sv; |
cd1ee231 |
182 | SHAREDSvEDIT(ssv); |
183 | sv = SHAREDSvGET(ssv); |
184 | if (SvREFCNT(sv) == 1) { |
185 | switch (SvTYPE(sv)) { |
186 | case SVt_RV: |
187 | if (SvROK(sv)) |
cbfa9890 |
188 | Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv)))); |
cd1ee231 |
189 | break; |
190 | case SVt_PVAV: { |
191 | SV **src_ary = AvARRAY((AV *)sv); |
192 | SSize_t items = AvFILLp((AV *)sv) + 1; |
193 | |
194 | while (items-- > 0) { |
195 | if(SvTYPE(*src_ary)) |
cbfa9890 |
196 | Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary++))); |
cd1ee231 |
197 | } |
198 | break; |
199 | } |
200 | case SVt_PVHV: { |
201 | HE *entry; |
202 | (void)hv_iterinit((HV *)sv); |
203 | while ((entry = hv_iternext((HV *)sv))) |
204 | Perl_sharedsv_thrcnt_dec( |
cbfa9890 |
205 | aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry))) |
cd1ee231 |
206 | ); |
207 | break; |
208 | } |
209 | } |
210 | } |
211 | SvREFCNT_dec(sv); |
212 | SHAREDSvRELEASE(ssv); |
cd1ee231 |
213 | } |
214 | |
0a66a22f |
215 | #endif /* USE_ITHREADS */ |
39696b0c |
216 | |