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