This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
070a95641317a303b6351997bcaedbac316c6c8d
[perl5.git] / sharedsv.c
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 #ifdef USE_ITHREADS
24
25 PerlInterpreter* sharedsv_space;
26 perl_mutex sharedsv_space_mutex;
27
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;
49     MUTEX_INIT(&sharedsv_space_mutex);
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     COND_INIT(&ssv->user_cond);
67     ssv->owner = 0;
68     ssv->locks = 0;
69     return ssv;
70 }
71
72
73 /*
74 =for apidoc sharedsv_find
75
76 Tries to find if a given SV has a shared backend, either by
77 looking at magic, or by checking if it is tied again threads::shared.
78
79 =cut
80 */
81
82 shared_sv *
83 Perl_sharedsv_find(pTHX_ SV* sv)
84 {
85     /* does all it can to find a shared_sv struct, returns NULL otherwise */
86     shared_sv* ssv = NULL;
87     return ssv;
88 }
89
90 /*
91 =for apidoc sharedsv_lock
92
93 Recursive locks on a sharedsv.
94 Locks are dynamicly scoped at the level of the first lock.
95 =cut
96 */
97 void
98 Perl_sharedsv_lock(pTHX_ shared_sv* ssv)
99 {
100     if(!ssv)
101         return;
102     MUTEX_LOCK(&ssv->mutex);
103     if(ssv->owner && ssv->owner == my_perl) {
104         ssv->locks++;
105         MUTEX_UNLOCK(&ssv->mutex);
106         return;
107     }
108     while(ssv->owner) 
109       COND_WAIT(&ssv->cond,&ssv->mutex);
110     ssv->locks++;
111     ssv->owner = my_perl;
112     if(ssv->locks == 1)
113         SAVEDESTRUCTOR_X(Perl_sharedsv_unlock_scope,ssv);
114     MUTEX_UNLOCK(&ssv->mutex);
115 }
116
117 /*
118 =for apidoc sharedsv_unlock
119
120 Recursively unlocks a shared sv.
121
122 =cut
123 */
124
125 void
126 Perl_sharedsv_unlock(pTHX_ shared_sv* ssv)
127 {
128     MUTEX_LOCK(&ssv->mutex);
129     if(ssv->owner != my_perl) {
130         Perl_croak(aTHX_ "panic: Perl_sharedsv_unlock unlocking mutex that we don't own");
131         MUTEX_UNLOCK(&ssv->mutex); 
132         return;
133     } 
134
135     if(--ssv->locks == 0) {
136         ssv->owner = NULL;
137         COND_SIGNAL(&ssv->cond);
138     }
139     MUTEX_UNLOCK(&ssv->mutex);
140  }
141
142 void
143 Perl_sharedsv_unlock_scope(pTHX_ shared_sv* ssv)
144 {
145     MUTEX_LOCK(&ssv->mutex);
146     if(ssv->owner != my_perl) {
147         MUTEX_UNLOCK(&ssv->mutex);
148         return;
149     }
150     ssv->locks = 0;
151     ssv->owner = NULL;
152     COND_SIGNAL(&ssv->cond);
153     MUTEX_UNLOCK(&ssv->mutex);
154 }
155
156 /*
157 =for apidoc sharedsv_thrcnt_inc
158
159 Increments the threadcount of a sharedsv.
160 =cut
161 */
162 void
163 Perl_sharedsv_thrcnt_inc(pTHX_ shared_sv* ssv)
164 {
165   SHAREDSvEDIT(ssv);
166   SvREFCNT_inc(ssv->sv);
167   SHAREDSvRELEASE(ssv);
168 }
169
170 /*
171 =for apidoc sharedsv_thrcnt_dec
172
173 Decrements the threadcount of a shared sv. When a threads frontend is freed
174 this function should be called.
175
176 =cut
177 */
178
179 void
180 Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
181 {
182     SV* sv;
183     SHAREDSvEDIT(ssv);
184     sv = SHAREDSvGET(ssv);
185     if (SvREFCNT(sv) == 1) {
186         switch (SvTYPE(sv)) {
187         case SVt_RV:
188             if (SvROK(sv))
189             Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(SvRV(sv))));
190             break;
191         case SVt_PVAV: {
192             SV **src_ary  = AvARRAY((AV *)sv);
193             SSize_t items = AvFILLp((AV *)sv) + 1;
194
195             while (items-- > 0) {
196             if(SvTYPE(*src_ary))
197                 Perl_sharedsv_thrcnt_dec(aTHX_ INT2PTR(shared_sv *, SvIV(*src_ary++)));
198             }
199             break;
200         }
201         case SVt_PVHV: {
202             HE *entry;
203             (void)hv_iterinit((HV *)sv);
204             while ((entry = hv_iternext((HV *)sv)))
205                 Perl_sharedsv_thrcnt_dec(
206                     aTHX_ INT2PTR(shared_sv *, SvIV(hv_iterval((HV *)sv, entry)))
207                 );
208             break;
209         }
210         }
211     }
212     SvREFCNT_dec(sv);
213     SHAREDSvRELEASE(ssv);
214 }
215
216 #endif /* USE_ITHREADS */
217