File Coverage

XS.xs
Criterion Covered Total %
statement 100 126 79.3
branch 82 262 31.3
condition n/a
subroutine n/a
pod n/a
total 182 388 46.9


line stmt bran cond sub pod time code
1             #include
2             #include
3              
4             #define _TRYNEXT(code) { \
5             try { code; } \
6             catch (const std::logic_error& err) { croak_sv(newSVpvn_flags(err.what(), strlen(err.what()), SVf_UTF8 | SVs_TEMP)); } \
7             }
8              
9 368           static inline HV* proto_stash (pTHX_ SV* proto) {
10 368 100         if (SvROK(proto)) {
11 157           SV* val = SvRV(proto);
12 157 50         if (SvOBJECT(val)) return SvSTASH(val);
13             }
14 211           return gv_stashsv(proto, GV_ADD);
15             }
16              
17             #if PERL_VERSION < 22
18             #define optimize(a, ...)
19             #else
20              
21             #define PP_METHOD_EXEC(sub) { \
22             dSP; \
23             XPUSHs((SV*)sub); \
24             PUTBACK; \
25             return PL_op->op_next; \
26             }
27              
28             #define PP_SUB_EXEC(sub) { \
29             TOPs = (SV*)sub; \
30             return PL_ppaddr[OP_ENTERSUB](aTHX); \
31             }
32              
33             #define PP_EMPTY_RETURN { \
34             if (GIMME_V == G_SCALAR) *(PL_stack_sp = PL_stack_base + TOPMARK + 1) = &PL_sv_undef; \
35             else PL_stack_sp = PL_stack_base + TOPMARK; \
36             }
37              
38             #define PP_METHOD_MAYBE_EXEC(sub) { \
39             if (sub) { PP_METHOD_EXEC(sub); } \
40             else { \
41             PP_EMPTY_RETURN; \
42             return PL_op->op_next->op_next; \
43             } \
44             }
45              
46             #define PP_SUB_MAYBE_EXEC(sub) { \
47             if (sub) { PP_SUB_EXEC(sub); } \
48             else { \
49             PP_EMPTY_RETURN; \
50             return PL_op->op_next; \
51             } \
52             }
53              
54             #ifdef USE_ITHREADS
55             # define cGVOPx_gv_set(o,gv) (PAD_SVl(cPADOPx(o)->op_padix) = (SV*)gv)
56             #else
57             # define cGVOPx_gv_set(o,gv) (cSVOPx(o)->op_sv = (SV*)gv)
58             #endif
59              
60 61           static void optimize (pTHX_ OP* op, OP* (*pp_method)(pTHX), OP* (*pp_sub)(pTHX), CV* check, GV* payload = NULL) {
61 61 50         if ((op->op_spare & 1) || op->op_type != OP_ENTERSUB || !(op->op_flags & OPf_STACKED) || op->op_ppaddr != PL_ppaddr[OP_ENTERSUB]) return;
    100          
    50          
    50          
62 53           op->op_spare |= 1;
63 53           OP* curop = cUNOPx(op)->op_first;
64 53 50         if (!curop) return; /* Such op can be created by call_sv(G_METHOD_NAMED) */
65 153 100         while (OpHAS_SIBLING(curop)) curop = OpSIBLING(curop);
    50          
66            
67             // optimize METHOD_REDIR $self->next::method
68 53 50         if (curop->op_next == op && curop->op_type == OP_METHOD_REDIR && curop->op_ppaddr == PL_ppaddr[OP_METHOD_REDIR]) {
    100          
    50          
69 46           curop->op_ppaddr = pp_method;
70 46 100         if (!payload) return;
71             // payload will be in cMETHOPx_rclass(PL_op)
72 8           SV* old = cMETHOPx_rclass(curop);
73 8           cMETHOPx_rclass(curop) = (SV*)payload;
74 8           SvREFCNT_inc(payload);
75 8           SvREFCNT_dec(old);
76 8           return;
77             }
78            
79             // OPTIMIZE ENTERSUB FOR CASE next::method($self) - compile-time identified subroutines
80 7 50         if (!OP_TYPE_IS_OR_WAS(curop, OP_LIST)) return;
    50          
    50          
    0          
81 7           curop = cUNOPx(curop)->op_first;
82 7 50         if (!curop) return;
83            
84 22 100         while (OpHAS_SIBLING(curop)) curop = OpSIBLING(curop);
    50          
85 7 50         if (!OP_TYPE_IS_OR_WAS(curop, OP_RV2CV)) return;
    50          
    50          
    0          
86            
87 7           curop = cUNOPx(curop)->op_first;
88 7 50         if (!curop || curop->op_type != OP_GV) return;
    50          
89 7           GV* gv = cGVOPx_gv(curop);
90 7 50         if (GvCV(gv) != check) return;
91            
92 7           op->op_ppaddr = pp_sub;
93            
94 7 50         if (!payload) return;
95             // payload will be in TOPs
96 7           cGVOPx_gv_set(curop, payload);
97 7           SvREFCNT_inc(payload);
98 7           SvREFCNT_dec(gv);
99             }
100              
101             // $self->next::can
102 0           static OP* ppm_nextcan (pTHX) {
103 0           PL_stack_sp = PL_stack_base + TOPMARK + 1;
104             CV* sub;
105 0 0         _TRYNEXT({ sub = xs::next::method(proto_stash(aTHX_ *PL_stack_sp)); });
    0          
    0          
106 0 0         *PL_stack_sp = sub ? sv_2mortal(newRV((SV*)sub)) : &PL_sv_undef;
107 0 0         return PL_op->op_next->op_next; // skip ENTERSUB
108             }
109              
110             // next::can($self)
111 0           static OP* pps_nextcan (pTHX) {
112 0           PL_stack_sp = PL_stack_base + TOPMARK + 1;
113             CV* sub;
114 0 0         _TRYNEXT({ sub = xs::next::method(proto_stash(aTHX_ *PL_stack_sp)); });
    0          
    0          
115 0 0         *PL_stack_sp = sub ? sv_2mortal(newRV((SV*)sub)) : &PL_sv_undef;
116 0 0         return PL_op->op_next;
117             }
118              
119             // $self->next::method
120 10           static OP* ppm_next (pTHX) {
121             CV* sub;
122 10 50         _TRYNEXT({ sub = xs::next::method_strict(proto_stash(aTHX_ PL_stack_base[TOPMARK+1])); });
    50          
    0          
123 10 50         PP_METHOD_EXEC(sub);
    0          
124             }
125              
126             // next::method($self)
127 0           static OP* pps_next (pTHX) {
128 0           dSP;
129             CV* sub;
130 0 0         _TRYNEXT({ sub = xs::next::method_strict(proto_stash(aTHX_ PL_stack_base[TOPMARK+1])); });
    0          
    0          
131 0 0         PP_SUB_EXEC(sub);
132             }
133              
134             // $self->maybe::next::method
135 0           static OP* ppm_next_maybe (pTHX) {
136             CV* sub;
137 0 0         _TRYNEXT({ sub = xs::next::method(proto_stash(aTHX_ PL_stack_base[TOPMARK+1])); });
    0          
    0          
138 0 0         PP_METHOD_MAYBE_EXEC(sub);
    0          
    0          
    0          
    0          
139             }
140              
141             // maybe::next::method($self)
142 0           static OP* pps_next_maybe (pTHX) {
143 0           dSP;
144             CV* sub;
145 0 0         _TRYNEXT({ sub = xs::next::method(proto_stash(aTHX_ PL_stack_base[TOPMARK+1])); });
    0          
    0          
146 0 0         PP_SUB_MAYBE_EXEC(sub);
    0          
    0          
    0          
147             }
148              
149             // $self->super::subname
150 62           static OP* ppm_super (pTHX) {
151             CV* sub;
152 62 50         _TRYNEXT({ sub = xs::super::method_strict(proto_stash(aTHX_ PL_stack_base[TOPMARK+1]), (GV*)cMETHOPx_rclass(PL_op)); });
    50          
    0          
153 62 50         PP_METHOD_EXEC(sub);
    0          
154             }
155              
156             // super::subname($self)
157 62           static OP* pps_super (pTHX) {
158 62           dSP;
159             CV* sub;
160 62 50         _TRYNEXT({ sub = xs::super::method_strict(proto_stash(aTHX_ PL_stack_base[TOPMARK+1]), (GV*)TOPs); });
    50          
    0          
161 62 0         PP_SUB_EXEC(sub);
162             }
163              
164             // $self->super::maybe::subname
165 140           static OP* ppm_super_maybe (pTHX) {
166             CV* sub;
167 140 50         _TRYNEXT({ sub = xs::super::method(proto_stash(aTHX_ PL_stack_base[TOPMARK+1]), (GV*)cMETHOPx_rclass(PL_op)); });
    50          
    0          
168 140 100         PP_METHOD_MAYBE_EXEC(sub);
    50          
    50          
    50          
    0          
169             }
170              
171             // super::maybe::subname($self)
172 33           static OP* pps_super_maybe (pTHX) {
173 33           dSP;
174             CV* sub;
175 33 50         _TRYNEXT({ sub = xs::super::method(proto_stash(aTHX_ PL_stack_base[TOPMARK+1]), (GV*)TOPs); });
    50          
    0          
176 33 50         PP_SUB_MAYBE_EXEC(sub);
    0          
    0          
    0          
177             }
178              
179             #endif
180              
181 15           static inline GV* get_current_opsub (pTHX_ const char* name, STRLEN len, bool is_utf8, U32 hash) {
182 15           const HE* const ent = (HE*)hv_common(CopSTASH(PL_curcop), NULL, name, len, is_utf8, 0, NULL, hash);
183 15 50         if (ent) return (GV*)HeVAL(ent);
184            
185 0           SV* fqn = sv_newmortal();
186 0 0         sv_catpvn(fqn, HvNAME(CopSTASH(PL_curcop)), HvNAMELEN(CopSTASH(PL_curcop)));
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
187 0           sv_catpvs(fqn, "::");
188 0           sv_catpvn(fqn, name, len);
189 0 0         return gv_fetchpvn_flags(SvPVX(fqn), SvCUR(fqn), GV_ADD|(is_utf8 ? SVf_UTF8 : 0), SVt_PVCV);
190             }
191              
192 15           static void super_xsub (pTHX_ CV* cv) {
193 15           dXSARGS; dXSI32;
194 15 50         if (items < 1) croak_xs_usage(cv, "proto, ...");
195 15           SP -= items;
196 15           SV* proto = ST(0);
197            
198 15           GV* gv = CvGV(cv);
199 15           HEK* hek = GvNAME_HEK(gv);
200 15           GV* context = get_current_opsub(aTHX_ HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), HEK_HASH(hek));
201            
202             CV* sub;
203 15 100         if (ix == 0) { // super
204 8           optimize(aTHX_ PL_op, &ppm_super, &pps_super, cv, context);
205 8 50         _TRYNEXT({ sub = xs::super::method_strict(proto_stash(aTHX_ proto), context); });
    50          
    0          
    0          
206             } else { // super::maybe
207 7           optimize(aTHX_ PL_op, &ppm_super_maybe, &pps_super_maybe, cv, context);
208 7 50         _TRYNEXT({ sub = xs::super::method(proto_stash(aTHX_ proto), context); });
    50          
    0          
209 7 100         if (!sub) XSRETURN_EMPTY;
210             }
211            
212 14           ENTER;
213 14 50         PUSHMARK(SP);
214 14 50         call_sv((SV*)sub, GIMME_V);
215 15 0         LEAVE;
216             }
217              
218             // This sub is defined by hand instead of XSUB syntax because we MUST NOT do POPMARK, because super_xsub will
219 3           static void super_AUTOLOAD (pTHX_ CV* cv) {
220 3           dXSI32;
221 3 100         SV* fqn = get_sv(ix == 0 ? "super::AUTOLOAD" : "super::maybe::AUTOLOAD", 0);
222 3           CV* xsub = newXS(SvPVX(fqn), super_xsub, __FILE__);
223 3           CvXSUBANY(xsub).any_i32 = ix;
224 3           super_xsub(aTHX_ xsub);
225 3           return;
226             }
227              
228             MODULE = next::XS PACKAGE = next
229             PROTOTYPES: DISABLE
230              
231             SV* can (SV* proto) {
232 7           optimize(aTHX_ PL_op, &ppm_nextcan, &pps_nextcan, cv);
233             CV* sub;
234 7 50         _TRYNEXT({ sub = xs::next::method(proto_stash(aTHX_ proto)); });
    50          
    0          
235 7 100         RETVAL = sub ? newRV((SV*)sub) : &PL_sv_undef;
236             }
237              
238             void method (SV* proto, ...) {
239 31           optimize(aTHX_ PL_op, &ppm_next, &pps_next, cv);
240            
241             CV* sub;
242 34 50         _TRYNEXT({ sub = xs::next::method_strict(proto_stash(aTHX_ proto)); });
    100          
    50          
243            
244 28           ENTER;
245 28 50         PUSHMARK(SP);
246 28 100         call_sv((SV*)sub, GIMME_V);
247 26           LEAVE;
248 29 50         return;
249             }
250              
251             MODULE = next::XS PACKAGE = maybe::next
252             PROTOTYPES: DISABLE
253              
254             void method (SV* proto, ...) {
255 8           optimize(aTHX_ PL_op, &ppm_next_maybe, &pps_next_maybe, cv);
256            
257             CV* sub;
258 8 50         _TRYNEXT({ sub = xs::next::method(proto_stash(aTHX_ proto)); });
    50          
    0          
259 8 100         if (!sub) XSRETURN_EMPTY;
260            
261 4           ENTER;
262 4 50         PUSHMARK(SP);
263 4 50         call_sv((SV*)sub, GIMME_V);
264 4           LEAVE;
265 8 0         return;
266             }
267              
268             BOOT {
269 18           cv = newXS("super::AUTOLOAD", super_AUTOLOAD, __FILE__);
270 18           XSANY.any_i32 = 0;
271 18           cv = newXS("super::maybe::AUTOLOAD", super_AUTOLOAD, __FILE__);
272 18           XSANY.any_i32 = 1;
273             }