Commit | Line | Data |
b050c948 |
1 | |
2 | #include "EXTERN.h" |
3 | #include "perl.h" |
4 | #include "XSUB.h" |
5 | |
6 | |
7 | void shared_sv_attach_sv (SV* sv, shared_sv* shared) { |
8 | HV* shared_hv = get_hv("threads::shared::shared", FALSE); |
9 | SV* id = newSViv((IV)shared); |
10 | STRLEN length = sv_len(id); |
11 | SV* tiedobject; |
12 | SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0); |
13 | if(tiedobject_) { |
14 | tiedobject = (*tiedobject_); |
15 | SvROK_on(sv); |
16 | SvRV(sv) = SvRV(tiedobject); |
17 | |
18 | } else { |
19 | croak("die\n"); |
20 | } |
21 | } |
22 | |
23 | |
24 | int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) { |
25 | shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj); |
26 | SHAREDSvLOCK(shared); |
55fc11ad |
27 | if(mg->mg_private != shared->index) { |
28 | if(SvROK(SHAREDSvGET(shared))) { |
29 | shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))); |
30 | shared_sv_attach_sv(sv, target); |
31 | } else { |
32 | sv_setsv(sv, SHAREDSvGET(shared)); |
33 | } |
34 | mg->mg_private = shared->index; |
b050c948 |
35 | } |
36 | SHAREDSvUNLOCK(shared); |
37 | |
38 | return 0; |
39 | } |
40 | |
41 | int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) { |
42 | shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj); |
43 | SHAREDSvLOCK(shared); |
44 | if(SvROK(SHAREDSvGET(shared))) |
45 | Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)))); |
46 | SHAREDSvEDIT(shared); |
47 | if(SvROK(sv)) { |
48 | shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv)); |
49 | if(!target) { |
50 | SHAREDSvRELEASE(shared); |
51 | sv_setsv(sv,SHAREDSvGET(shared)); |
52 | SHAREDSvUNLOCK(shared); |
53 | Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar"); |
54 | } |
55 | Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared)); |
56 | SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target)); |
b050c948 |
57 | } else { |
58 | sv_setsv(SHAREDSvGET(shared), sv); |
59 | } |
55fc11ad |
60 | shared->index++; |
61 | mg->mg_private = shared->index; |
b050c948 |
62 | SHAREDSvRELEASE(shared); |
63 | if(SvROK(SHAREDSvGET(shared))) |
64 | Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)))); |
65 | SHAREDSvUNLOCK(shared); |
66 | return 0; |
67 | } |
68 | |
69 | int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) { |
70 | shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj); |
71 | if(!shared) |
72 | return 0; |
73 | Perl_sharedsv_thrcnt_dec(aTHX_ shared); |
74 | } |
75 | |
76 | MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg), |
77 | MEMBER_TO_FPTR(shared_sv_store_mg), |
78 | 0, |
79 | 0, |
80 | MEMBER_TO_FPTR(shared_sv_destroy_mg) |
81 | }; |
82 | |
83 | MODULE = threads::shared PACKAGE = threads::shared |
84 | |
85 | |
86 | PROTOTYPES: DISABLE |
87 | |
88 | |
89 | SV* |
90 | ptr(ref) |
91 | SV* ref |
92 | CODE: |
93 | RETVAL = newSViv(SvIV(SvRV(ref))); |
94 | OUTPUT: |
95 | RETVAL |
96 | |
97 | |
98 | SV* |
99 | _thrcnt(ref) |
100 | SV* ref |
101 | CODE: |
102 | shared_sv* shared = Perl_sharedsv_find(aTHX, ref); |
103 | if(!shared) |
104 | croak("thrcnt can only be used on shared values"); |
105 | SHAREDSvLOCK(shared); |
106 | RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared))); |
107 | SHAREDSvUNLOCK(shared); |
108 | OUTPUT: |
109 | RETVAL |
110 | |
111 | |
112 | void |
113 | thrcnt_inc(ref) |
114 | SV* ref |
115 | CODE: |
116 | shared_sv* shared; |
117 | if(SvROK(ref)) |
118 | ref = SvRV(ref); |
119 | shared = Perl_sharedsv_find(aTHX, ref); |
120 | if(!shared) |
121 | croak("thrcnt can only be used on shared values"); |
122 | Perl_sharedsv_thrcnt_inc(aTHX_ shared); |
123 | |
124 | |
125 | MODULE = threads::shared PACKAGE = threads::shared::sv |
126 | |
127 | SV* |
128 | new(class, value) |
129 | SV* class |
130 | SV* value |
131 | CODE: |
132 | shared_sv* shared = Perl_sharedsv_new(aTHX); |
133 | MAGIC* shared_magic; |
134 | SV* obj = newSViv((IV)shared); |
135 | SHAREDSvEDIT(shared); |
136 | SHAREDSvGET(shared) = newSVsv(value); |
137 | SHAREDSvRELEASE(shared); |
138 | sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16); |
139 | shared_magic = mg_find(value, PERL_MAGIC_ext); |
140 | shared_magic->mg_virtual = &svtable; |
141 | shared_magic->mg_obj = newSViv((IV)shared); |
142 | shared_magic->mg_flags |= MGf_REFCOUNTED; |
55fc11ad |
143 | shared_magic->mg_private = 0; |
b050c948 |
144 | SvMAGICAL_on(value); |
145 | RETVAL = obj; |
146 | OUTPUT: |
147 | RETVAL |
148 | |
149 | |