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