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