1 /*******************************************************************************
3 * !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
5 ********************************************************************************
7 * Perl/Pollution/Portability
9 ********************************************************************************
13 * $Date: 2005/01/31 08:10:55 +0100 $
15 ********************************************************************************
17 * Version 3.x, Copyright (C) 2004-2005, 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/exception ---- */
72 /* defined in module3.c */
73 int exception(int throw_e);
75 /* ---- from parts/inc/misc ---- */
76 XS(XS_Devel__PPPort_dXSTARG); /* prototype */
77 XS(XS_Devel__PPPort_dXSTARG)
88 /* ---- from parts/inc/MY_CXT ---- */
89 #define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
92 /* Put Global Data in here */
98 /* ---- from parts/inc/newCONSTSUB ---- */
99 void call_newCONSTSUB_1(void)
101 #ifdef PERL_NO_GET_CONTEXT
104 newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
107 extern void call_newCONSTSUB_2(void);
108 extern void call_newCONSTSUB_3(void);
110 /* ---- from parts/inc/sv_xpvf ---- */
111 static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
116 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
117 sv = vnewSVpvf(pat, &args);
119 sv = newSVpv(pat, 0);
125 static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
129 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
130 sv_vcatpvf(sv, pat, &args);
137 static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
141 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
142 sv_vsetpvf(sv, pat, &args);
149 /* =========== END XSMISC =================================================== */
151 MODULE = Devel::PPPort PACKAGE = Devel::PPPort
154 /* ---- from parts/inc/misc ---- */
155 newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
157 /* ---- from parts/inc/MY_CXT ---- */
160 /* If any of the fields in the my_cxt_t struct need
161 * to be initialised, do it here.
167 ##----------------------------------------------------------------------
168 ## XSUBs from parts/inc/call
169 ##----------------------------------------------------------------------
200 i = eval_sv(sv, flags);
203 PUSHs(sv_2mortal(newSViv(i)));
206 eval_pv(p, croak_on_error)
212 PUSHs(eval_pv(p, croak_on_error));
215 call_sv(sv, flags, ...)
221 for (i=0; i<items-2; i++)
222 ST(i) = ST(i+2); /* pop first two args */
226 i = call_sv(sv, flags);
229 PUSHs(sv_2mortal(newSViv(i)));
232 call_pv(subname, flags, ...)
238 for (i=0; i<items-2; i++)
239 ST(i) = ST(i+2); /* pop first two args */
243 i = call_pv(subname, flags);
246 PUSHs(sv_2mortal(newSViv(i)));
249 call_argv(subname, flags, ...)
256 if (items > 8) /* play safe */
258 for (i=2; i<items; i++)
259 args[i-2] = SvPV_nolen(ST(i));
260 args[items-2] = NULL;
262 i = call_argv(subname, flags, args);
265 PUSHs(sv_2mortal(newSViv(i)));
268 call_method(methname, flags, ...)
274 for (i=0; i<items-2; i++)
275 ST(i) = ST(i+2); /* pop first two args */
279 i = call_method(methname, flags);
282 PUSHs(sv_2mortal(newSViv(i)));
284 ##----------------------------------------------------------------------
285 ## XSUBs from parts/inc/cop
286 ##----------------------------------------------------------------------
291 RETVAL = CopSTASHPV(PL_curcop);
298 RETVAL = CopFILE(PL_curcop);
302 ##----------------------------------------------------------------------
303 ## XSUBs from parts/inc/exception
304 ##----------------------------------------------------------------------
312 ##----------------------------------------------------------------------
313 ## XSUBs from parts/inc/grok
314 ##----------------------------------------------------------------------
323 pv = SvPV(string, len);
324 if (!grok_number(pv, len, &RETVAL))
337 pv = SvPV(string, len);
338 RETVAL = grok_bin(pv, &len, &flags, NULL);
350 pv = SvPV(string, len);
351 RETVAL = grok_hex(pv, &len, &flags, NULL);
363 pv = SvPV(string, len);
364 RETVAL = grok_oct(pv, &len, &flags, NULL);
369 Perl_grok_number(string)
375 pv = SvPV(string, len);
376 if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
382 Perl_grok_bin(string)
389 pv = SvPV(string, len);
390 RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
395 Perl_grok_hex(string)
402 pv = SvPV(string, len);
403 RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
408 Perl_grok_oct(string)
415 pv = SvPV(string, len);
416 RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
420 ##----------------------------------------------------------------------
421 ## XSUBs from parts/inc/limits
422 ##----------------------------------------------------------------------
427 RETVAL = IVSIZE == sizeof(IV);
434 RETVAL = UVSIZE == sizeof(UV);
441 RETVAL = sizeof(IVTYPE) == sizeof(IV);
448 RETVAL = sizeof(UVTYPE) == sizeof(UV);
452 ##----------------------------------------------------------------------
453 ## XSUBs from parts/inc/magic
454 ##----------------------------------------------------------------------
457 sv_catpv_mg(sv, string)
461 sv_catpv_mg(sv, string);
464 sv_catpvn_mg(sv, sv2)
471 str = SvPV(sv2, len);
472 sv_catpvn_mg(sv, str, len);
479 sv_catsv_mg(sv, sv2);
503 sv_setpvn_mg(sv, sv2)
510 str = SvPV(sv2, len);
511 sv_setpvn_mg(sv, str, len);
518 sv_setsv_mg(sv, sv2);
528 sv_usepvn_mg(sv, sv2)
535 str = SvPV(sv2, len);
536 New(42, copy, len+1, char);
537 Copy(str, copy, len+1, char);
538 sv_usepvn_mg(sv, copy, len);
540 ##----------------------------------------------------------------------
541 ## XSUBs from parts/inc/misc
542 ##----------------------------------------------------------------------
545 gv_stashpvn(name, create)
549 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
558 RETVAL = get_sv(name, create) != NULL;
567 RETVAL = get_av(name, create) != NULL;
576 RETVAL = get_hv(name, create) != NULL;
585 RETVAL = get_cv(name, create) != NULL;
592 XPUSHs(newSVpvn("test", 4));
593 XPUSHs(newSVpvn("test", 2));
594 XPUSHs(newSVpvn("test", 0));
595 XPUSHs(newSVpvn(NULL, 2));
596 XPUSHs(newSVpvn(NULL, 0));
602 RETVAL = newSVsv(&PL_sv_undef);
609 RETVAL = newSVsv(&PL_sv_yes);
616 RETVAL = newSVsv(&PL_sv_no);
624 PL_na = strlen(string);
633 RETVAL = newSVsv(boolSV(value));
640 RETVAL = newSVsv(DEFSV);
647 RETVAL = SvTRUE(ERRSV);
656 RETVAL = newSVsv(UNDERBAR);
661 ##----------------------------------------------------------------------
662 ## XSUBs from parts/inc/mPUSH
663 ##----------------------------------------------------------------------
733 ##----------------------------------------------------------------------
734 ## XSUBs from parts/inc/MY_CXT
735 ##----------------------------------------------------------------------
741 RETVAL = MY_CXT.dummy == 42;
750 RETVAL = MY_CXT.dummy == 43;
762 ##----------------------------------------------------------------------
763 ## XSUBs from parts/inc/newCONSTSUB
764 ##----------------------------------------------------------------------
775 ##----------------------------------------------------------------------
776 ## XSUBs from parts/inc/newRV
777 ##----------------------------------------------------------------------
787 RETVAL = SvREFCNT(sv);
798 rv = newRV_noinc(sv);
799 RETVAL = SvREFCNT(sv);
804 ##----------------------------------------------------------------------
805 ## XSUBs from parts/inc/sv_xpvf
806 ##----------------------------------------------------------------------
811 RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
819 RETVAL = newSVsv(sv);
820 test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
828 RETVAL = newSVsv(sv);
829 test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
837 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
838 sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
842 Perl_sv_catpvf_mg(sv)
845 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
846 Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
850 sv_catpvf_mg_nocontext(sv)
853 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
854 #ifdef PERL_IMPLICIT_CONTEXT
855 sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
857 sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
865 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
866 sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
870 Perl_sv_setpvf_mg(sv)
873 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
874 Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
878 sv_setpvf_mg_nocontext(sv)
881 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
882 #ifdef PERL_IMPLICIT_CONTEXT
883 sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
885 sv_setpvf_mg(sv, "%s-%d", "bar", 44);
889 ##----------------------------------------------------------------------
890 ## XSUBs from parts/inc/SvPV
891 ##----------------------------------------------------------------------
900 str = SvPVbyte(sv, len);
901 RETVAL = strEQ(str, "mhx") ? len : -1;
911 str = SvPV_nolen(sv);
912 RETVAL = strEQ(str, "mhx") ? 42 : 0;
916 ##----------------------------------------------------------------------
917 ## XSUBs from parts/inc/threads
918 ##----------------------------------------------------------------------
924 RETVAL = 1 + sv_2iv(sv);
932 Perl_croak(aTHX_ "%s", error);
934 ##----------------------------------------------------------------------
935 ## XSUBs from parts/inc/uv
936 ##----------------------------------------------------------------------
943 sv_setuv(RETVAL, uv);
951 RETVAL = newSVuv(uv);
968 RETVAL = SvUVx(++sv);
982 TARG = sv_newmortal();
992 TARG = sv_newmortal();