This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[PATHC] sharedsv.[c|h]
[perl5.git] / sharedsv.c
CommitLineData
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
23PerlInterpreter* 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
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{
47 sharedsv_space = PERL_GET_CONTEXT;
48}
49
50/*
51=for apidoc sharedsv_new
52
53Allocates a new shared sv struct, you must yourself create the SV/AV/HV.
54=cut
55*/
56
57shared_sv *
58Perl_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
72Tries to find if a given SV has a shared backend, either by
73looking at magic, or by checking if it is tied again threads::shared.
74
75=cut
76*/
77
78shared_sv *
79Perl_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
89Recursive locks on a sharedsv.
90Locks are dynamicly scoped at the level of the first lock.
91=cut
92*/
93void
94Perl_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
112Recursively unlocks a shared sv.
113
114=cut
115*/
116
117void
118Perl_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
129void
130Perl_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
142Increments the threadcount of a sharedsv.
143=cut
144*/
145void
146Perl_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
156Decrements the threadcount of a shared sv. When a threads frontend is freed
157this function should be called.
158
159=cut
160*/
161
162void
163Perl_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