1 #define PERL_NO_GET_CONTEXT 1
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5
6 #define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
7 #define PERL_DECIMAL_VERSION \
8 PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
9 #define PERL_VERSION_GE(r,v,s) \
10 (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
11
12 #ifndef cBOOL
13 # define cBOOL(x) ((bool)!!(x))
14 #endif /* !cBOOL */
15
16 #ifndef newSVpvs
17 # define newSVpvs(s) newSVpvn(""s"", (sizeof(""s"")-1))
18 #endif /* !newSVpvs */
19
20 #ifndef OpMORESIB_set
21 # define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
22 # define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
23 # define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
24 #endif /* !OpMORESIB_set */
25 #ifndef OpSIBLING
26 # define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
27 # define OpSIBLING(o) (0 + (o)->op_sibling)
28 #endif /* !OpSIBLING */
29
30 #define QPFX xAd8NP3gxZglovQRL5Hn_
31 #define QPFXS STRINGIFY(QPFX)
32 #define QCONCAT0(a,b) a##b
33 #define QCONCAT1(a,b) QCONCAT0(a,b)
34 #define QPFXD(name) QCONCAT1(QPFX, name)
35
36 #if defined(WIN32) && PERL_VERSION_GE(5,13,6)
37 # define MY_BASE_CALLCONV EXTERN_C
38 # define MY_BASE_CALLCONV_S "EXTERN_C"
39 #else /* !(WIN32 && >= 5.13.6) */
40 # define MY_BASE_CALLCONV PERL_CALLCONV
41 # define MY_BASE_CALLCONV_S "PERL_CALLCONV"
42 #endif /* !(WIN32 && >= 5.13.6) */
43
44 #define MY_EXPORT_CALLCONV MY_BASE_CALLCONV
45
46 #if defined(WIN32) || defined(__CYGWIN__)
47 # define MY_IMPORT_CALLCONV_S MY_BASE_CALLCONV_S" __declspec(dllimport)"
48 #else
49 # define MY_IMPORT_CALLCONV_S MY_BASE_CALLCONV_S
50 #endif
51
52 #ifndef rv2cv_op_cv
53
54 # define RV2CVOPCV_MARK_EARLY 0x00000001
55 # define RV2CVOPCV_RETURN_NAME_GV 0x00000002
56
57 # define Perl_rv2cv_op_cv QPFXD(roc0)
58 # define rv2cv_op_cv(cvop, flags) Perl_rv2cv_op_cv(aTHX_ cvop, flags)
QPFXD(roc0)59 MY_EXPORT_CALLCONV CV *QPFXD(roc0)(pTHX_ OP *cvop, U32 flags)
60 {
61 OP *rvop;
62 CV *cv;
63 GV *gv;
64 if(!(cvop->op_type == OP_RV2CV &&
65 !(cvop->op_private & OPpENTERSUB_AMPER) &&
66 (cvop->op_flags & OPf_KIDS)))
67 return NULL;
68 rvop = cUNOPx(cvop)->op_first;
69 switch(rvop->op_type) {
70 case OP_GV: {
71 gv = cGVOPx_gv(rvop);
72 cv = GvCVu(gv);
73 if(!cv) {
74 if(flags & RV2CVOPCV_MARK_EARLY)
75 rvop->op_private |= OPpEARLY_CV;
76 return NULL;
77 }
78 } break;
79 #if PERL_VERSION_GE(5,11,2)
80 case OP_CONST: {
81 SV *rv = cSVOPx_sv(rvop);
82 if(!SvROK(rv)) return NULL;
83 cv = (CV*)SvRV(rv);
84 gv = NULL;
85 } break;
86 #endif /* >=5.11.2 */
87 default: {
88 return NULL;
89 } break;
90 }
91 if(SvTYPE((SV*)cv) != SVt_PVCV) return NULL;
92 if(flags & RV2CVOPCV_RETURN_NAME_GV) {
93 if(!CvANON(cv) || !gv) gv = CvGV(cv);
94 return (CV*)gv;
95 } else {
96 return cv;
97 }
98 }
99
100 # define Q_PROVIDE_RV2CV_OP_CV 1
101
102 #endif /* !rv2cv_op_cv */
103
104 #ifndef ck_entersub_args_proto_or_list
105
106 # ifndef newSV_type
107 # define newSV_type(type) THX_newSV_type(aTHX_ type)
THX_newSV_type(pTHX_ svtype type)108 static SV *THX_newSV_type(pTHX_ svtype type)
109 {
110 SV *sv = newSV(0);
111 (void) SvUPGRADE(sv, type);
112 return sv;
113 }
114 # endif /* !newSV_type */
115
116 # ifndef GvCV_set
117 # define GvCV_set(gv, cv) (GvCV(gv) = (cv))
118 # endif /* !GvCV_set */
119
120 # ifndef CvGV_set
121 # define CvGV_set(cv, gv) (CvGV(cv) = (gv))
122 # endif /* !CvGV_set */
123
124 # define entersub_extract_args(eo) THX_entersub_extract_args(aTHX_ eo)
THX_entersub_extract_args(pTHX_ OP * entersubop)125 static OP *THX_entersub_extract_args(pTHX_ OP *entersubop)
126 {
127 OP *pushop, *aop, *bop, *cop;
128 if(!(entersubop->op_flags & OPf_KIDS)) return NULL;
129 pushop = cUNOPx(entersubop)->op_first;
130 if(!OpHAS_SIBLING(pushop)) {
131 if(!(pushop->op_flags & OPf_KIDS)) return NULL;
132 pushop = cUNOPx(pushop)->op_first;
133 if(!OpHAS_SIBLING(pushop)) return NULL;
134 }
135 for(bop = pushop; (cop = OpSIBLING(bop), OpHAS_SIBLING(cop));
136 bop = cop) ;
137 if(bop == pushop) return NULL;
138 aop = OpSIBLING(pushop);
139 OpMORESIB_set(pushop, cop);
140 OpLASTSIB_set(bop, NULL);
141 return aop;
142 }
143
144 # define entersub_inject_args(eo, ao) THX_entersub_inject_args(aTHX_ eo, ao)
THX_entersub_inject_args(pTHX_ OP * entersubop,OP * aop)145 static void THX_entersub_inject_args(pTHX_ OP *entersubop, OP *aop)
146 {
147 OP *pushop, *bop, *cop;
148 if(!aop) return;
149 if(!(entersubop->op_flags & OPf_KIDS)) {
150 abort:
151 while(aop) {
152 bop = OpSIBLING(aop);
153 op_free(aop);
154 aop = bop;
155 }
156 return;
157 }
158 pushop = cUNOPx(entersubop)->op_first;
159 if(!OpHAS_SIBLING(pushop)) {
160 if(!(pushop->op_flags & OPf_KIDS)) goto abort;
161 pushop = cUNOPx(pushop)->op_first;
162 if(!OpHAS_SIBLING(pushop)) goto abort;
163 }
164 for(bop = aop; (cop = OpSIBLING(bop)); bop = cop) ;
165 OpMORESIB_set(bop, OpSIBLING(pushop));
166 OpMORESIB_set(pushop, aop);
167 }
168
169 # define ck_entersub_args_stalk(eo, so) THX_ck_entersub_args_stalk(aTHX_ eo, so)
THX_ck_entersub_args_stalk(pTHX_ OP * entersubop,OP * stalkcvop)170 static OP *THX_ck_entersub_args_stalk(pTHX_ OP *entersubop, OP *stalkcvop)
171 {
172 OP *stalkenterop = newLISTOP(OP_LIST, 0, newCVREF(0, stalkcvop), NULL);
173 entersub_inject_args(stalkenterop, entersub_extract_args(entersubop));
174 stalkenterop = newUNOP(OP_ENTERSUB, OPf_STACKED, stalkenterop);
175 entersub_inject_args(entersubop, entersub_extract_args(stalkenterop));
176 op_free(stalkenterop);
177 return entersubop;
178 }
179
180 # define Perl_ck_entersub_args_list QPFXD(eal0)
181 # define ck_entersub_args_list(o) Perl_ck_entersub_args_list(aTHX_ o)
QPFXD(eal0)182 MY_EXPORT_CALLCONV OP *QPFXD(eal0)(pTHX_ OP *entersubop)
183 {
184 return ck_entersub_args_stalk(entersubop, newOP(OP_PADANY, 0));
185 }
186
187 # define Perl_ck_entersub_args_proto QPFXD(eap0)
188 # define ck_entersub_args_proto(o, gv, sv) \
189 Perl_ck_entersub_args_proto(aTHX_ o, gv, sv)
QPFXD(eap0)190 MY_EXPORT_CALLCONV OP *QPFXD(eap0)(pTHX_ OP *entersubop, GV *namegv,
191 SV *protosv)
192 {
193 const char *proto;
194 STRLEN proto_len;
195 CV *stalkcv;
196 GV *stalkgv;
197 if(SvTYPE(protosv) == SVt_PVCV ? !SvPOK(protosv) : !SvOK(protosv))
198 croak("panic: ck_entersub_args_proto CV with no proto");
199 proto = SvPV(protosv, proto_len);
200 stalkcv = (CV*)newSV_type(SVt_PVCV);
201 sv_setpvn((SV*)stalkcv, proto, proto_len);
202 stalkgv = (GV*)sv_2mortal(newSV(0));
203 gv_init(stalkgv, GvSTASH(namegv), GvNAME(namegv), GvNAMELEN(namegv), 0);
204 GvCV_set(stalkgv, stalkcv);
205 CvGV_set(stalkcv, stalkgv);
206 return ck_entersub_args_stalk(entersubop, newGVOP(OP_GV, 0, stalkgv));
207 }
208
209 # define Perl_ck_entersub_args_proto_or_list QPFXD(ean0)
210 # define ck_entersub_args_proto_or_list(o, gv, sv) \
211 Perl_ck_entersub_args_proto_or_list(aTHX_ o, gv, sv)
QPFXD(ean0)212 MY_EXPORT_CALLCONV OP *QPFXD(ean0)(pTHX_ OP *entersubop, GV *namegv,
213 SV *protosv)
214 {
215 if(SvTYPE(protosv) == SVt_PVCV ? SvPOK(protosv) : SvOK(protosv))
216 return ck_entersub_args_proto(entersubop, namegv, protosv);
217 else
218 return ck_entersub_args_list(entersubop);
219 }
220
221 # define Q_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST 1
222
223 #endif /* !ck_entersub_args_proto_or_list */
224
225 #ifndef cv_set_call_checker
226
227 # ifndef Newxz
228 # define Newxz(v,n,t) Newz(0,v,n,t)
229 # endif /* !Newxz */
230
231 # ifndef SvMAGIC_set
232 # define SvMAGIC_set(sv, mg) (SvMAGIC(sv) = (mg))
233 # endif /* !SvMAGIC_set */
234
235 # ifndef DPTR2FPTR
236 # define DPTR2FPTR(t,x) ((t)(UV)(x))
237 # endif /* !DPTR2FPTR */
238
239 # ifndef FPTR2DPTR
240 # define FPTR2DPTR(t,x) ((t)(UV)(x))
241 # endif /* !FPTR2DPTR */
242
243 # ifndef op_null
244 # define op_null(o) THX_op_null(aTHX_ o)
THX_op_null(pTHX_ OP * o)245 static void THX_op_null(pTHX_ OP *o)
246 {
247 if(o->op_type == OP_NULL) return;
248 /* must not be used on any op requiring non-trivial clearing */
249 o->op_targ = o->op_type;
250 o->op_type = OP_NULL;
251 o->op_ppaddr = PL_ppaddr[OP_NULL];
252 }
253 # endif /* !op_null */
254
255 # ifndef mg_findext
256 # define mg_findext(sv, type, vtbl) THX_mg_findext(aTHX_ sv, type, vtbl)
THX_mg_findext(pTHX_ SV * sv,int type,MGVTBL const * vtbl)257 static MAGIC *THX_mg_findext(pTHX_ SV *sv, int type, MGVTBL const *vtbl)
258 {
259 MAGIC *mg;
260 if(sv)
261 for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
262 if(mg->mg_type == type && mg->mg_virtual == vtbl)
263 return mg;
264 return NULL;
265 }
266 # endif /* !mg_findext */
267
268 # ifndef sv_unmagicext
269 # define sv_unmagicext(sv, type, vtbl) THX_sv_unmagicext(aTHX_ sv, type, vtbl)
THX_sv_unmagicext(pTHX_ SV * sv,int type,MGVTBL const * vtbl)270 static int THX_sv_unmagicext(pTHX_ SV *sv, int type, MGVTBL const *vtbl)
271 {
272 MAGIC *mg, **mgp;
273 if((vtbl && vtbl->svt_free)
274 # ifdef PERL_MAGIC_regex_global
275 || type == PERL_MAGIC_regex_global
276 # endif /* PERL_MAGIC_regex_global */
277 )
278 /* exceeded intended usage of this reserve implementation */
279 return 0;
280 if(SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv)) return 0;
281 mgp = NULL;
282 for(mg = mgp ? *mgp : SvMAGIC(sv); mg; mg = mgp ? *mgp : SvMAGIC(sv)) {
283 if(mg->mg_type == type && mg->mg_virtual == vtbl) {
284 if(mgp)
285 *mgp = mg->mg_moremagic;
286 else
287 SvMAGIC_set(sv, mg->mg_moremagic);
288 if(mg->mg_flags & MGf_REFCOUNTED)
289 SvREFCNT_dec(mg->mg_obj);
290 Safefree(mg);
291 } else {
292 mgp = &mg->mg_moremagic;
293 }
294 }
295 SvMAGICAL_off(sv);
296 mg_magical(sv);
297 return 0;
298 }
299 # endif /* !sv_unmagicext */
300
301 # ifndef sv_magicext
302 # define sv_magicext(sv, obj, type, vtbl, name, namlen) \
303 THX_sv_magicext(aTHX_ sv, obj, type, vtbl, name, namlen)
THX_sv_magicext(pTHX_ SV * sv,SV * obj,int type,MGVTBL const * vtbl,char const * name,I32 namlen)304 static MAGIC *THX_sv_magicext(pTHX_ SV *sv, SV *obj, int type,
305 MGVTBL const *vtbl, char const *name, I32 namlen)
306 {
307 MAGIC *mg;
308 if(!(obj == &PL_sv_undef && !name && !namlen))
309 /* exceeded intended usage of this reserve implementation */
310 return NULL;
311 Newxz(mg, 1, MAGIC);
312 mg->mg_virtual = (MGVTBL*)vtbl;
313 mg->mg_type = type;
314 mg->mg_obj = &PL_sv_undef;
315 (void) SvUPGRADE(sv, SVt_PVMG);
316 mg->mg_moremagic = SvMAGIC(sv);
317 SvMAGIC_set(sv, mg);
318 SvMAGICAL_off(sv);
319 mg_magical(sv);
320 return mg;
321 }
322 # endif /* !sv_magicext */
323
324 # ifndef PERL_MAGIC_ext
325 # define PERL_MAGIC_ext '~'
326 # endif /* !PERL_MAGIC_ext */
327
328 # if !PERL_VERSION_GE(5,9,3)
329 typedef OP *(*Perl_check_t)(pTHX_ OP *);
330 # endif /* <5.9.3 */
331
332 # if !PERL_VERSION_GE(5,10,1)
333 typedef unsigned Optype;
334 # endif /* <5.10.1 */
335
336 # ifndef wrap_op_checker
337 # define wrap_op_checker(c,n,o) THX_wrap_op_checker(aTHX_ c,n,o)
THX_wrap_op_checker(pTHX_ Optype opcode,Perl_check_t new_checker,Perl_check_t * old_checker_p)338 static void THX_wrap_op_checker(pTHX_ Optype opcode,
339 Perl_check_t new_checker, Perl_check_t *old_checker_p)
340 {
341 if(*old_checker_p) return;
342 OP_REFCNT_LOCK;
343 if(!*old_checker_p) {
344 *old_checker_p = PL_check[opcode];
345 PL_check[opcode] = new_checker;
346 }
347 OP_REFCNT_UNLOCK;
348 }
349 # endif /* !wrap_op_checker */
350
351 static MGVTBL mgvtbl_checkcall;
352
353 typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *);
354
355 # define Perl_cv_get_call_checker QPFXD(gcc0)
356 # define cv_get_call_checker(cv, THX_ckfun_p, ckobj_p) \
357 Perl_cv_get_call_checker(aTHX_ cv, THX_ckfun_p, ckobj_p)
QPFXD(gcc0)358 MY_EXPORT_CALLCONV void QPFXD(gcc0)(pTHX_ CV *cv,
359 Perl_call_checker *THX_ckfun_p, SV **ckobj_p)
360 {
361 MAGIC *callmg = SvMAGICAL((SV*)cv) ?
362 mg_findext((SV*)cv, PERL_MAGIC_ext, &mgvtbl_checkcall) : NULL;
363 if(callmg) {
364 *THX_ckfun_p = DPTR2FPTR(Perl_call_checker, callmg->mg_ptr);
365 *ckobj_p = callmg->mg_obj;
366 } else {
367 *THX_ckfun_p = Perl_ck_entersub_args_proto_or_list;
368 *ckobj_p = (SV*)cv;
369 }
370 }
371
372 # define Perl_cv_set_call_checker QPFXD(scc0)
373 # define cv_set_call_checker(cv, THX_ckfun, ckobj) \
374 Perl_cv_set_call_checker(aTHX_ cv, THX_ckfun, ckobj)
QPFXD(scc0)375 MY_EXPORT_CALLCONV void QPFXD(scc0)(pTHX_ CV *cv,
376 Perl_call_checker THX_ckfun, SV *ckobj)
377 {
378 if(THX_ckfun == Perl_ck_entersub_args_proto_or_list &&
379 ckobj == (SV*)cv) {
380 if(SvMAGICAL((SV*)cv))
381 sv_unmagicext((SV*)cv, PERL_MAGIC_ext,
382 &mgvtbl_checkcall);
383 } else {
384 MAGIC *callmg =
385 mg_findext((SV*)cv, PERL_MAGIC_ext, &mgvtbl_checkcall);
386 if(!callmg)
387 callmg = sv_magicext((SV*)cv, &PL_sv_undef,
388 PERL_MAGIC_ext, &mgvtbl_checkcall, NULL, 0);
389 if(callmg->mg_flags & MGf_REFCOUNTED) {
390 SvREFCNT_dec(callmg->mg_obj);
391 callmg->mg_flags &= ~MGf_REFCOUNTED;
392 }
393 callmg->mg_ptr = FPTR2DPTR(char *, THX_ckfun);
394 callmg->mg_obj = ckobj;
395 if(ckobj != (SV*)cv) {
396 SvREFCNT_inc(ckobj);
397 callmg->mg_flags |= MGf_REFCOUNTED;
398 }
399 }
400 }
401
402 static OP *(*THX_nxck_entersub)(pTHX_ OP *);
403
THX_myck_entersub(pTHX_ OP * entersubop)404 static OP *THX_myck_entersub(pTHX_ OP *entersubop)
405 {
406 OP *aop, *cvop;
407 CV *cv;
408 GV *namegv;
409 Perl_call_checker THX_ckfun;
410 SV *ckobj;
411 aop = cUNOPx(entersubop)->op_first;
412 if(!OpHAS_SIBLING(aop)) aop = cUNOPx(aop)->op_first;
413 aop = OpSIBLING(aop);
414 for(cvop = aop; OpHAS_SIBLING(cvop); cvop = OpSIBLING(cvop)) ;
415 if(!(cv = rv2cv_op_cv(cvop, 0)))
416 return THX_nxck_entersub(aTHX_ entersubop);
417 cv_get_call_checker(cv, &THX_ckfun, &ckobj);
418 if(THX_ckfun == Perl_ck_entersub_args_proto_or_list && ckobj == (SV*)cv)
419 return THX_nxck_entersub(aTHX_ entersubop);
420 namegv = (GV*)rv2cv_op_cv(cvop,
421 RV2CVOPCV_MARK_EARLY|RV2CVOPCV_RETURN_NAME_GV);
422 entersubop->op_private |= OPpENTERSUB_HASTARG;
423 entersubop->op_private |= (PL_hints & HINT_STRICT_REFS);
424 if(PERLDB_SUB && PL_curstash != PL_debstash)
425 entersubop->op_private |= OPpENTERSUB_DB;
426 op_null(cvop);
427 return THX_ckfun(aTHX_ entersubop, namegv, ckobj);
428 }
429
430 # define Q_PROVIDE_CV_SET_CALL_CHECKER 1
431
432 #endif /* !cv_set_call_checker */
433
434 MODULE = Devel::CallChecker PACKAGE = Devel::CallChecker
435
436 PROTOTYPES: DISABLE
437
438 BOOT:
439 #if Q_PROVIDE_CV_SET_CALL_CHECKER
440 wrap_op_checker(OP_ENTERSUB, THX_myck_entersub, &THX_nxck_entersub);
441 #endif /* Q_PROVIDE_CV_SET_CALL_CHECKER */
442
443 SV *
444 callchecker0_h()
445 CODE:
446 RETVAL = newSVpvs(
447 "/* DO NOT EDIT -- generated "
448 "by Devel::CallChecker version "XS_VERSION" */\n"
449 "#ifndef "QPFXS"INCLUDED\n"
450 "#define "QPFXS"INCLUDED 1\n"
451 "#ifndef PERL_VERSION\n"
452 " #error you must include perl.h before callchecker0.h\n"
453 "#elif !(PERL_REVISION == "STRINGIFY(PERL_REVISION)
454 " && PERL_VERSION == "STRINGIFY(PERL_VERSION)
455 #if PERL_VERSION & 1
456 " && PERL_SUBVERSION == "STRINGIFY(PERL_SUBVERSION)
457 #endif /* PERL_VERSION & 1 */
458 ")\n"
459 " #error this callchecker0.h is for Perl "
460 STRINGIFY(PERL_REVISION)"."STRINGIFY(PERL_VERSION)
461 #if PERL_VERSION & 1
462 "."STRINGIFY(PERL_SUBVERSION)
463 #endif /* PERL_VERSION & 1 */
464 " only\n"
465 "#endif /* Perl version mismatch */\n"
466 #define DEFFN(RETTYPE, PUBNAME, PRIVNAME, ARGTYPES, ARGNAMES) \
467 MY_IMPORT_CALLCONV_S" "RETTYPE" "QPFXS PRIVNAME"(pTHX_ "ARGTYPES");\n" \
468 "#define Perl_"PUBNAME" "QPFXS PRIVNAME"\n" \
469 "#define "PUBNAME"("ARGNAMES") Perl_"PUBNAME"(aTHX_ "ARGNAMES")\n"
470 #if Q_PROVIDE_RV2CV_OP_CV
471 "#define RV2CVOPCV_MARK_EARLY 0x00000001\n"
472 "#define RV2CVOPCV_RETURN_NAME_GV 0x00000002\n"
473 DEFFN("CV *", "rv2cv_op_cv", "roc0", "OP *, U32", "cvop, flags")
474 #endif /* Q_PROVIDE_RV2CV_OP_CV */
475 #if Q_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST
476 DEFFN("OP *", "ck_entersub_args_list", "eal0", "OP *", "o")
477 DEFFN("OP *", "ck_entersub_args_proto", "eap0",
478 "OP *, GV *, SV *", "o, gv, sv")
479 DEFFN("OP *", "ck_entersub_args_proto_or_list", "ean0",
480 "OP *, GV *, SV *", "o, gv, sv")
481 #endif /* Q_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST */
482 #if Q_PROVIDE_CV_SET_CALL_CHECKER
483 "typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *);\n"
484 DEFFN("void", "cv_get_call_checker", "gcc0",
485 "CV *, Perl_call_checker *, SV **", "cv, fp, op")
486 DEFFN("void", "cv_set_call_checker", "scc0",
487 "CV *, Perl_call_checker, SV *", "cv, f, o")
488 #endif /* Q_PROVIDE_CV_SET_CALL_CHECKER */
489 "#endif /* !"QPFXS"INCLUDED */\n"
490 );
491 OUTPUT:
492 RETVAL
493