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); |
27 | if(SvROK(SHAREDSvGET(shared))) { |
28 | shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))); |
29 | shared_sv_attach_sv(sv, target); |
30 | } else { |
31 | sv_setsv(sv, SHAREDSvGET(shared)); |
32 | } |
33 | SHAREDSvUNLOCK(shared); |
34 | |
35 | return 0; |
36 | } |
37 | |
38 | int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) { |
39 | shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj); |
40 | SHAREDSvLOCK(shared); |
41 | if(SvROK(SHAREDSvGET(shared))) |
42 | Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)))); |
43 | SHAREDSvEDIT(shared); |
44 | if(SvROK(sv)) { |
45 | shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv)); |
46 | if(!target) { |
47 | SHAREDSvRELEASE(shared); |
48 | sv_setsv(sv,SHAREDSvGET(shared)); |
49 | SHAREDSvUNLOCK(shared); |
50 | Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar"); |
51 | } |
52 | Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared)); |
53 | SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target)); |
54 | SvROK_off(sv); |
55 | } else { |
56 | sv_setsv(SHAREDSvGET(shared), sv); |
57 | } |
58 | SHAREDSvRELEASE(shared); |
59 | if(SvROK(SHAREDSvGET(shared))) |
60 | Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)))); |
61 | SHAREDSvUNLOCK(shared); |
62 | return 0; |
63 | } |
64 | |
65 | int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) { |
66 | shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj); |
67 | if(!shared) |
68 | return 0; |
69 | Perl_sharedsv_thrcnt_dec(aTHX_ shared); |
70 | } |
71 | |
72 | MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg), |
73 | MEMBER_TO_FPTR(shared_sv_store_mg), |
74 | 0, |
75 | 0, |
76 | MEMBER_TO_FPTR(shared_sv_destroy_mg) |
77 | }; |
78 | |
79 | MODULE = threads::shared PACKAGE = threads::shared |
80 | |
81 | |
82 | PROTOTYPES: DISABLE |
83 | |
84 | |
85 | SV* |
86 | ptr(ref) |
87 | SV* ref |
88 | CODE: |
89 | RETVAL = newSViv(SvIV(SvRV(ref))); |
90 | OUTPUT: |
91 | RETVAL |
92 | |
93 | |
94 | SV* |
95 | _thrcnt(ref) |
96 | SV* ref |
97 | CODE: |
98 | shared_sv* shared = Perl_sharedsv_find(aTHX, ref); |
99 | if(!shared) |
100 | croak("thrcnt can only be used on shared values"); |
101 | SHAREDSvLOCK(shared); |
102 | RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared))); |
103 | SHAREDSvUNLOCK(shared); |
104 | OUTPUT: |
105 | RETVAL |
106 | |
107 | |
108 | void |
109 | thrcnt_inc(ref) |
110 | SV* ref |
111 | CODE: |
112 | shared_sv* shared; |
113 | if(SvROK(ref)) |
114 | ref = SvRV(ref); |
115 | shared = Perl_sharedsv_find(aTHX, ref); |
116 | if(!shared) |
117 | croak("thrcnt can only be used on shared values"); |
118 | Perl_sharedsv_thrcnt_inc(aTHX_ shared); |
119 | |
120 | |
121 | MODULE = threads::shared PACKAGE = threads::shared::sv |
122 | |
123 | SV* |
124 | new(class, value) |
125 | SV* class |
126 | SV* value |
127 | CODE: |
128 | shared_sv* shared = Perl_sharedsv_new(aTHX); |
129 | MAGIC* shared_magic; |
130 | SV* obj = newSViv((IV)shared); |
131 | SHAREDSvEDIT(shared); |
132 | SHAREDSvGET(shared) = newSVsv(value); |
133 | SHAREDSvRELEASE(shared); |
134 | sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16); |
135 | shared_magic = mg_find(value, PERL_MAGIC_ext); |
136 | shared_magic->mg_virtual = &svtable; |
137 | shared_magic->mg_obj = newSViv((IV)shared); |
138 | shared_magic->mg_flags |= MGf_REFCOUNTED; |
139 | SvMAGICAL_on(value); |
140 | RETVAL = obj; |
141 | OUTPUT: |
142 | RETVAL |
143 | |
144 | |