1 /*******************************************************************************
3 * !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
5 ********************************************************************************
7 * Perl/Pollution/Portability
9 ********************************************************************************
13 * $Date: 2004/08/13 12:49:19 +0200 $
15 ********************************************************************************
17 * Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
18 * Version 2.x, Copyright (C) 2001, Paul Marquess.
19 * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
21 * This program is free software; you can redistribute it and/or
22 * modify it under the same terms as Perl itself.
24 *******************************************************************************/
26 /* ========== BEGIN XSHEAD ================================================== */
30 /* =========== END XSHEAD =================================================== */
36 /* ========== BEGIN XSINIT ================================================== */
38 /* ---- from parts/inc/call ---- */
41 /* ---- from parts/inc/grok ---- */
42 #define NEED_grok_number
43 #define NEED_grok_numeric_radix
48 /* ---- from parts/inc/newCONSTSUB ---- */
49 #define NEED_newCONSTSUB
51 /* ---- from parts/inc/newRV ---- */
52 #define NEED_newRV_noinc
54 /* ---- from parts/inc/sv_xpvf ---- */
55 #define NEED_vnewSVpvf
56 #define NEED_sv_catpvf_mg
57 #define NEED_sv_catpvf_mg_nocontext
58 #define NEED_sv_setpvf_mg
59 #define NEED_sv_setpvf_mg_nocontext
61 /* ---- from parts/inc/SvPV ---- */
62 #define NEED_sv_2pv_nolen
63 #define NEED_sv_2pvbyte
65 /* =========== END XSINIT =================================================== */
69 /* ========== BEGIN XSMISC ================================================== */
71 /* ---- from parts/inc/MY_CXT ---- */
72 #define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
75 /* Put Global Data in here */
81 /* ---- from parts/inc/newCONSTSUB ---- */
82 void call_newCONSTSUB_1(void)
84 #ifdef PERL_NO_GET_CONTEXT
87 newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
90 extern void call_newCONSTSUB_2(void);
91 extern void call_newCONSTSUB_3(void);
93 /* ---- from parts/inc/sv_xpvf ---- */
94 static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
99 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
100 sv = vnewSVpvf(pat, &args);
102 sv = newSVpv(pat, 0);
108 static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
112 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
113 sv_vcatpvf(sv, pat, &args);
120 static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
124 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
125 sv_vsetpvf(sv, pat, &args);
132 /* =========== END XSMISC =================================================== */
134 MODULE = Devel::PPPort PACKAGE = Devel::PPPort
137 /* ---- from parts/inc/MY_CXT ---- */
140 /* If any of the fields in the my_cxt_t struct need
141 * to be initialised, do it here.
147 ##----------------------------------------------------------------------
148 ## XSUBs from parts/inc/call
149 ##----------------------------------------------------------------------
180 i = eval_sv(sv, flags);
183 PUSHs(sv_2mortal(newSViv(i)));
186 eval_pv(p, croak_on_error)
192 PUSHs(eval_pv(p, croak_on_error));
195 call_sv(sv, flags, ...)
201 for (i=0; i<items-2; i++)
202 ST(i) = ST(i+2); /* pop first two args */
206 i = call_sv(sv, flags);
209 PUSHs(sv_2mortal(newSViv(i)));
212 call_pv(subname, flags, ...)
218 for (i=0; i<items-2; i++)
219 ST(i) = ST(i+2); /* pop first two args */
223 i = call_pv(subname, flags);
226 PUSHs(sv_2mortal(newSViv(i)));
229 call_argv(subname, flags, ...)
236 if (items > 8) /* play safe */
238 for (i=2; i<items; i++)
239 args[i-2] = SvPV_nolen(ST(i));
240 args[items-2] = NULL;
242 i = call_argv(subname, flags, args);
245 PUSHs(sv_2mortal(newSViv(i)));
248 call_method(methname, flags, ...)
254 for (i=0; i<items-2; i++)
255 ST(i) = ST(i+2); /* pop first two args */
259 i = call_method(methname, flags);
262 PUSHs(sv_2mortal(newSViv(i)));
264 ##----------------------------------------------------------------------
265 ## XSUBs from parts/inc/cop
266 ##----------------------------------------------------------------------
271 RETVAL = CopSTASHPV(PL_curcop);
278 RETVAL = CopFILE(PL_curcop);
282 ##----------------------------------------------------------------------
283 ## XSUBs from parts/inc/grok
284 ##----------------------------------------------------------------------
293 pv = SvPV(string, len);
294 if (!grok_number(pv, len, &RETVAL))
307 pv = SvPV(string, len);
308 RETVAL = grok_bin(pv, &len, &flags, NULL);
320 pv = SvPV(string, len);
321 RETVAL = grok_hex(pv, &len, &flags, NULL);
333 pv = SvPV(string, len);
334 RETVAL = grok_oct(pv, &len, &flags, NULL);
339 Perl_grok_number(string)
345 pv = SvPV(string, len);
346 if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
352 Perl_grok_bin(string)
359 pv = SvPV(string, len);
360 RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
365 Perl_grok_hex(string)
372 pv = SvPV(string, len);
373 RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
378 Perl_grok_oct(string)
385 pv = SvPV(string, len);
386 RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
390 ##----------------------------------------------------------------------
391 ## XSUBs from parts/inc/limits
392 ##----------------------------------------------------------------------
397 RETVAL = IVSIZE == sizeof(IV);
404 RETVAL = UVSIZE == sizeof(UV);
411 RETVAL = sizeof(IVTYPE) == sizeof(IV);
418 RETVAL = sizeof(UVTYPE) == sizeof(UV);
422 ##----------------------------------------------------------------------
423 ## XSUBs from parts/inc/magic
424 ##----------------------------------------------------------------------
427 sv_catpv_mg(sv, string)
431 sv_catpv_mg(sv, string);
434 sv_catpvn_mg(sv, sv2)
441 str = SvPV(sv2, len);
442 sv_catpvn_mg(sv, str, len);
449 sv_catsv_mg(sv, sv2);
473 sv_setpvn_mg(sv, sv2)
480 str = SvPV(sv2, len);
481 sv_setpvn_mg(sv, str, len);
488 sv_setsv_mg(sv, sv2);
498 sv_usepvn_mg(sv, sv2)
505 str = SvPV(sv2, len);
506 New(42, copy, len+1, char);
507 Copy(str, copy, len+1, char);
508 sv_usepvn_mg(sv, copy, len);
510 ##----------------------------------------------------------------------
511 ## XSUBs from parts/inc/misc
512 ##----------------------------------------------------------------------
515 gv_stashpvn(name, create)
519 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
528 RETVAL = get_sv(name, create) != NULL;
537 RETVAL = get_av(name, create) != NULL;
546 RETVAL = get_hv(name, create) != NULL;
555 RETVAL = get_cv(name, create) != NULL;
562 XPUSHs(newSVpvn("test", 4));
563 XPUSHs(newSVpvn("test", 2));
564 XPUSHs(newSVpvn("test", 0));
565 XPUSHs(newSVpvn(NULL, 2));
566 XPUSHs(newSVpvn(NULL, 0));
572 RETVAL = newSVsv(&PL_sv_undef);
579 RETVAL = newSVsv(&PL_sv_yes);
586 RETVAL = newSVsv(&PL_sv_no);
594 PL_na = strlen(string);
603 RETVAL = newSVsv(boolSV(value));
610 RETVAL = newSVsv(DEFSV);
617 RETVAL = SvTRUE(ERRSV);
626 RETVAL = newSVsv(UNDERBAR);
631 ##----------------------------------------------------------------------
632 ## XSUBs from parts/inc/mPUSH
633 ##----------------------------------------------------------------------
703 ##----------------------------------------------------------------------
704 ## XSUBs from parts/inc/MY_CXT
705 ##----------------------------------------------------------------------
711 RETVAL = MY_CXT.dummy == 42;
720 RETVAL = MY_CXT.dummy == 43;
724 ##----------------------------------------------------------------------
725 ## XSUBs from parts/inc/newCONSTSUB
726 ##----------------------------------------------------------------------
737 ##----------------------------------------------------------------------
738 ## XSUBs from parts/inc/newRV
739 ##----------------------------------------------------------------------
749 RETVAL = SvREFCNT(sv);
760 rv = newRV_noinc(sv);
761 RETVAL = SvREFCNT(sv);
766 ##----------------------------------------------------------------------
767 ## XSUBs from parts/inc/sv_xpvf
768 ##----------------------------------------------------------------------
773 RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
781 RETVAL = newSVsv(sv);
782 test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
790 RETVAL = newSVsv(sv);
791 test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
799 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
800 sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
804 Perl_sv_catpvf_mg(sv)
807 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
808 Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
812 sv_catpvf_mg_nocontext(sv)
815 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
816 #ifdef PERL_IMPLICIT_CONTEXT
817 sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
819 sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
827 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
828 sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
832 Perl_sv_setpvf_mg(sv)
835 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
836 Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
840 sv_setpvf_mg_nocontext(sv)
843 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
844 #ifdef PERL_IMPLICIT_CONTEXT
845 sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
847 sv_setpvf_mg(sv, "%s-%d", "bar", 44);
851 ##----------------------------------------------------------------------
852 ## XSUBs from parts/inc/SvPV
853 ##----------------------------------------------------------------------
862 str = SvPVbyte(sv, len);
863 RETVAL = strEQ(str, "mhx") ? len : -1;
873 str = SvPV_nolen(sv);
874 RETVAL = strEQ(str, "mhx") ? 3 : 0;
878 ##----------------------------------------------------------------------
879 ## XSUBs from parts/inc/threads
880 ##----------------------------------------------------------------------
886 RETVAL = 1 + sv_2iv(sv);
894 Perl_croak(aTHX_ "%s", error);
896 ##----------------------------------------------------------------------
897 ## XSUBs from parts/inc/uv
898 ##----------------------------------------------------------------------
905 sv_setuv(RETVAL, uv);
913 RETVAL = newSVuv(uv);
930 RETVAL = SvUVx(++sv);
944 TARG = sv_newmortal();
954 TARG = sv_newmortal();