Commit | Line | Data |
---|---|---|
cd1ee231 JH |
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 RGS |
23 | #ifdef USE_ITHREADS |
24 | ||
cd1ee231 | 25 | PerlInterpreter* sharedsv_space; |
667883b0 | 26 | perl_mutex sharedsv_space_mutex; |
cd1ee231 | 27 | |
cd1ee231 JH |
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 JH |
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 JH |
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 JH |
168 | SHAREDSvEDIT(ssv); |
169 | sv = SHAREDSvGET(ssv); | |
170 | if (SvREFCNT(sv) == 1) { | |
171 | switch (SvTYPE(sv)) { | |
172 | case SVt_RV: | |
173 | if (SvROK(sv)) | |
174 | Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv *)SvIV(SvRV(sv))); | |
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)) | |
182 | Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv *)SvIV(*src_ary++)); | |
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( | |
191 | aTHX_ (shared_sv *)SvIV(hv_iterval((HV *)sv, entry)) | |
192 | ); | |
193 | break; | |
194 | } | |
195 | } | |
196 | } | |
197 | SvREFCNT_dec(sv); | |
198 | SHAREDSvRELEASE(ssv); | |
cd1ee231 JH |
199 | } |
200 | ||
0a66a22f | 201 | #endif /* USE_ITHREADS */ |