[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / PPPort.xs

/*******************************************************************************
*
*  !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
*
********************************************************************************
*
*  Perl/Pollution/Portability
*
********************************************************************************
*
*  $Revision: 8 $
*  $Author: mhx $
*  $Date: 2005/01/31 08:10:55 +0100 $
*
********************************************************************************
*
*  Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
*  Version 2.x, Copyright (C) 2001, Paul Marquess.
*  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
*
*  This program is free software; you can redistribute it and/or
*  modify it under the same terms as Perl itself.
*
*******************************************************************************/

/* ========== BEGIN XSHEAD ================================================== */


/* =========== END XSHEAD =================================================== */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

/* ========== BEGIN XSINIT ================================================== */

/* ---- from parts/inc/call ---- */
#define NEED_eval_pv

/* ---- from parts/inc/grok ---- */
#define NEED_grok_number
#define NEED_grok_numeric_radix
#define NEED_grok_bin
#define NEED_grok_hex
#define NEED_grok_oct

/* ---- from parts/inc/newCONSTSUB ---- */
#define NEED_newCONSTSUB

/* ---- from parts/inc/newRV ---- */
#define NEED_newRV_noinc

/* ---- from parts/inc/sv_xpvf ---- */
#define NEED_vnewSVpvf
#define NEED_sv_catpvf_mg
#define NEED_sv_catpvf_mg_nocontext
#define NEED_sv_setpvf_mg
#define NEED_sv_setpvf_mg_nocontext

/* ---- from parts/inc/SvPV ---- */
#define NEED_sv_2pv_nolen
#define NEED_sv_2pvbyte

/* =========== END XSINIT =================================================== */

#include "ppport.h"

/* ========== BEGIN XSMISC ================================================== */

/* ---- from parts/inc/exception ---- */
static void throws_exception(int throw_e)
{
  if (throw_e)
    croak("boo\n");
}

static int exception(int throw_e)
{
  dTHR;
  dXCPT;
  SV *caught = get_sv("Devel::PPPort::exception_caught", 0);

  XCPT_TRY_START {
    throws_exception(throw_e);
  } XCPT_TRY_END

  XCPT_CATCH
  {
    sv_setiv(caught, 1);
    XCPT_RETHROW;
  }

  sv_setiv(caught, 0);

  return 42;
}

/* ---- from parts/inc/misc ---- */
XS(XS_Devel__PPPort_dXSTARG);  /* prototype */
XS(XS_Devel__PPPort_dXSTARG)
{
  dXSARGS;
  dXSTARG;
  IV iv;
  SP -= items;
  iv = SvIV(ST(0)) + 1;
  PUSHi(iv);
  XSRETURN(1);
}

/* ---- from parts/inc/MY_CXT ---- */
#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
 
typedef struct {
  /* Put Global Data in here */
  int dummy;          
} my_cxt_t;
 
START_MY_CXT     

/* ---- from parts/inc/newCONSTSUB ---- */
void call_newCONSTSUB_1(void)
{
#ifdef PERL_NO_GET_CONTEXT
	dTHX;
#endif
	newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
}

extern void call_newCONSTSUB_2(void);
extern void call_newCONSTSUB_3(void);

/* ---- from parts/inc/sv_xpvf ---- */
static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
{
  SV *sv;
  va_list args;
  va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
  sv = vnewSVpvf(pat, &args);
#else
  sv = newSVpv(pat, 0);
#endif
  va_end(args);
  return sv;
}

static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
{
  va_list args;
  va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
  sv_vcatpvf(sv, pat, &args);
#else
  sv_catpv(sv, pat);
#endif
  va_end(args);
}

static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
{
  va_list args;
  va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
  sv_vsetpvf(sv, pat, &args);
#else
  sv_setpv(sv, pat);
#endif
  va_end(args);
}

/* =========== END XSMISC =================================================== */

MODULE = Devel::PPPort		PACKAGE = Devel::PPPort

BOOT:
	/* ---- from parts/inc/misc ---- */
	newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
	
	/* ---- from parts/inc/MY_CXT ---- */
	{
	  MY_CXT_INIT;
	  /* If any of the fields in the my_cxt_t struct need
	   * to be initialised, do it here.
	   */
	  MY_CXT.dummy = 42;
	}
	

##----------------------------------------------------------------------
##  XSUBs from parts/inc/call
##----------------------------------------------------------------------

I32
G_SCALAR()
	CODE:
		RETVAL = G_SCALAR;
	OUTPUT:
		RETVAL

I32
G_ARRAY()
	CODE:
		RETVAL = G_ARRAY;
	OUTPUT:
		RETVAL

I32
G_DISCARD()
	CODE:
		RETVAL = G_DISCARD;
	OUTPUT:
		RETVAL

void
eval_sv(sv, flags)
	SV* sv
	I32 flags
	PREINIT:
		I32 i;
	PPCODE:
		PUTBACK;
		i = eval_sv(sv, flags);
		SPAGAIN;
		EXTEND(SP, 1);
		PUSHs(sv_2mortal(newSViv(i)));

void
eval_pv(p, croak_on_error)
	char* p
	I32 croak_on_error
	PPCODE:
		PUTBACK;
		EXTEND(SP, 1);
		PUSHs(eval_pv(p, croak_on_error));

void
call_sv(sv, flags, ...)
	SV* sv
	I32 flags
	PREINIT:
		I32 i;
	PPCODE:
		for (i=0; i<items-2; i++)
		  ST(i) = ST(i+2); /* pop first two args */
		PUSHMARK(SP);
		SP += items - 2;
		PUTBACK;
		i = call_sv(sv, flags);
		SPAGAIN;
		EXTEND(SP, 1);
		PUSHs(sv_2mortal(newSViv(i)));

void
call_pv(subname, flags, ...)
	char* subname
	I32 flags
	PREINIT:
		I32 i;
	PPCODE:
		for (i=0; i<items-2; i++)
		  ST(i) = ST(i+2); /* pop first two args */
		PUSHMARK(SP);
		SP += items - 2;
		PUTBACK;
		i = call_pv(subname, flags);
		SPAGAIN;
		EXTEND(SP, 1);
		PUSHs(sv_2mortal(newSViv(i)));

void
call_argv(subname, flags, ...)
	char* subname
	I32 flags
	PREINIT:
		I32 i;
		char *args[8];
	PPCODE:
		if (items > 8)  /* play safe */
		  XSRETURN_UNDEF;
		for (i=2; i<items; i++)
		  args[i-2] = SvPV_nolen(ST(i));
		args[items-2] = NULL;
		PUTBACK;
		i = call_argv(subname, flags, args);
		SPAGAIN;
		EXTEND(SP, 1);
		PUSHs(sv_2mortal(newSViv(i)));

void
call_method(methname, flags, ...)
	char* methname
	I32 flags
	PREINIT:
		I32 i;
	PPCODE:
		for (i=0; i<items-2; i++)
		  ST(i) = ST(i+2); /* pop first two args */
		PUSHMARK(SP);
		SP += items - 2;
		PUTBACK;
		i = call_method(methname, flags);
		SPAGAIN;
		EXTEND(SP, 1);
		PUSHs(sv_2mortal(newSViv(i)));

##----------------------------------------------------------------------
##  XSUBs from parts/inc/cop
##----------------------------------------------------------------------

char *
CopSTASHPV()
	CODE:
		RETVAL = CopSTASHPV(PL_curcop);
	OUTPUT:
		RETVAL

char *
CopFILE()
	CODE:
		RETVAL = CopFILE(PL_curcop);
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/exception
##----------------------------------------------------------------------

int
exception(throw_e)
  int throw_e
  OUTPUT:
    RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/grok
##----------------------------------------------------------------------

UV
grok_number(string)
	SV *string
	PREINIT:
		const char *pv;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		if (!grok_number(pv, len, &RETVAL))
		  XSRETURN_UNDEF;
	OUTPUT:
		RETVAL

UV
grok_bin(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = grok_bin(pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
grok_hex(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = grok_hex(pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
grok_oct(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = grok_oct(pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
Perl_grok_number(string)
	SV *string
	PREINIT:
		const char *pv;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
		  XSRETURN_UNDEF;
	OUTPUT:
		RETVAL

UV
Perl_grok_bin(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
Perl_grok_hex(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

UV
Perl_grok_oct(string)
	SV *string
	PREINIT:
		char *pv;
		I32 flags;
		STRLEN len;
	CODE:
		pv = SvPV(string, len);
		RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/limits
##----------------------------------------------------------------------

IV
iv_size()
	CODE:
		RETVAL = IVSIZE == sizeof(IV);
	OUTPUT:
		RETVAL

IV
uv_size()
	CODE:
		RETVAL = UVSIZE == sizeof(UV);
	OUTPUT:
		RETVAL

IV
iv_type()
	CODE:
		RETVAL = sizeof(IVTYPE) == sizeof(IV);
	OUTPUT:
		RETVAL

IV
uv_type()
	CODE:
		RETVAL = sizeof(UVTYPE) == sizeof(UV);
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/magic
##----------------------------------------------------------------------

void
sv_catpv_mg(sv, string)
	SV *sv;
	char *string;
	CODE:
		sv_catpv_mg(sv, string);

void
sv_catpvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		sv_catpvn_mg(sv, str, len);

void
sv_catsv_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	CODE:
		sv_catsv_mg(sv, sv2);

void
sv_setiv_mg(sv, iv)
	SV *sv;
	IV iv;
	CODE:
		sv_setiv_mg(sv, iv);

void
sv_setnv_mg(sv, nv)
	SV *sv;
	NV nv;
	CODE:
		sv_setnv_mg(sv, nv);

void
sv_setpv_mg(sv, pv)
	SV *sv;
	char *pv;
	CODE:
		sv_setpv_mg(sv, pv);

void
sv_setpvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		sv_setpvn_mg(sv, str, len);

void
sv_setsv_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	CODE:
		sv_setsv_mg(sv, sv2);

void
sv_setuv_mg(sv, uv)
	SV *sv;
	UV uv;
	CODE:
		sv_setuv_mg(sv, uv);

void
sv_usepvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str, *copy;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		New(42, copy, len+1, char);
		Copy(str, copy, len+1, char);
		sv_usepvn_mg(sv, copy, len);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/misc
##----------------------------------------------------------------------

int
gv_stashpvn(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
	OUTPUT:
		RETVAL

int
get_sv(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = get_sv(name, create) != NULL;
	OUTPUT:
		RETVAL

int
get_av(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = get_av(name, create) != NULL;
	OUTPUT:
		RETVAL

int
get_hv(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = get_hv(name, create) != NULL;
	OUTPUT:
		RETVAL

int
get_cv(name, create)
	char *name
	I32 create
	CODE:
		RETVAL = get_cv(name, create) != NULL;
	OUTPUT:
		RETVAL

void
newSVpvn()
	PPCODE:
		XPUSHs(newSVpvn("test", 4));
		XPUSHs(newSVpvn("test", 2));
		XPUSHs(newSVpvn("test", 0));
		XPUSHs(newSVpvn(NULL, 2));
		XPUSHs(newSVpvn(NULL, 0));
		XSRETURN(5);

SV *
PL_sv_undef()
	CODE:
		RETVAL = newSVsv(&PL_sv_undef);
	OUTPUT:
		RETVAL

SV *
PL_sv_yes()
	CODE:
		RETVAL = newSVsv(&PL_sv_yes);
	OUTPUT:
		RETVAL

SV *
PL_sv_no()
	CODE:
		RETVAL = newSVsv(&PL_sv_no);
	OUTPUT:
		RETVAL

int
PL_na(string)
	char *string
	CODE:
		PL_na = strlen(string);
		RETVAL = PL_na;
	OUTPUT:
		RETVAL

SV*
boolSV(value)
	int value
	CODE:
		RETVAL = newSVsv(boolSV(value));
	OUTPUT:
		RETVAL

SV*
DEFSV()
	CODE:
		RETVAL = newSVsv(DEFSV);
	OUTPUT:
		RETVAL

int
ERRSV()
	CODE:
		RETVAL = SvTRUE(ERRSV);
	OUTPUT:
		RETVAL

SV*
UNDERBAR()
	CODE:
		{
		  dUNDERBAR;
		  RETVAL = newSVsv(UNDERBAR);
		}
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/mPUSH
##----------------------------------------------------------------------

void
mPUSHp()
	PPCODE:
	EXTEND(SP, 3);
	mPUSHp("one", 3);
	mPUSHp("two", 3);
	mPUSHp("three", 5);
	XSRETURN(3);

void
mPUSHn()
	PPCODE:
	EXTEND(SP, 3);
	mPUSHn(0.5);
	mPUSHn(-0.25);
	mPUSHn(0.125);
	XSRETURN(3);

void
mPUSHi()
	PPCODE:
	EXTEND(SP, 3);
	mPUSHi(-1);
	mPUSHi(2);
	mPUSHi(-3);
	XSRETURN(3);

void
mPUSHu()
	PPCODE:
	EXTEND(SP, 3);
	mPUSHu(1);
	mPUSHu(2);
	mPUSHu(3);
	XSRETURN(3);

void
mXPUSHp()
	PPCODE:
	mXPUSHp("one", 3);
	mXPUSHp("two", 3);
	mXPUSHp("three", 5);
	XSRETURN(3);

void
mXPUSHn()
	PPCODE:
	mXPUSHn(0.5);
	mXPUSHn(-0.25);
	mXPUSHn(0.125);
	XSRETURN(3);

void
mXPUSHi()
	PPCODE:
	mXPUSHi(-1);
	mXPUSHi(2);
	mXPUSHi(-3);
	XSRETURN(3);

void
mXPUSHu()
	PPCODE:
	mXPUSHu(1);
	mXPUSHu(2);
	mXPUSHu(3);
	XSRETURN(3);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/MY_CXT
##----------------------------------------------------------------------

int
MY_CXT_1()
	CODE:
		dMY_CXT;
		RETVAL = MY_CXT.dummy == 42;
		++MY_CXT.dummy;
	OUTPUT:
		RETVAL

int
MY_CXT_2()
	CODE:
		dMY_CXT;
		RETVAL = MY_CXT.dummy == 43;
	OUTPUT:
		RETVAL

int
MY_CXT_CLONE()
	CODE:
		MY_CXT_CLONE;
		RETVAL = 42;
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/newCONSTSUB
##----------------------------------------------------------------------

void
call_newCONSTSUB_1()

void
call_newCONSTSUB_2()

void
call_newCONSTSUB_3()

##----------------------------------------------------------------------
##  XSUBs from parts/inc/newRV
##----------------------------------------------------------------------

U32
newRV_inc_REFCNT()
	PREINIT:
		SV *sv, *rv;
	CODE:
		sv = newSViv(42);
		rv = newRV_inc(sv);
		SvREFCNT_dec(sv);
		RETVAL = SvREFCNT(sv);
		sv_2mortal(rv);
	OUTPUT:
		RETVAL

U32
newRV_noinc_REFCNT()
	PREINIT:
		SV *sv, *rv;
	CODE:
		sv = newSViv(42);
		rv = newRV_noinc(sv);
		RETVAL = SvREFCNT(sv);
		sv_2mortal(rv);
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/sv_xpvf
##----------------------------------------------------------------------

SV *
vnewSVpvf()
	CODE:
		RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
	OUTPUT:
		RETVAL

SV *
sv_vcatpvf(sv)
	SV *sv
	CODE:
		RETVAL = newSVsv(sv);
		test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
	OUTPUT:
		RETVAL

SV *
sv_vsetpvf(sv)
	SV *sv
	CODE:
		RETVAL = newSVsv(sv);
		test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
	OUTPUT:
		RETVAL

void
sv_catpvf_mg(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
#endif

void
Perl_sv_catpvf_mg(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
#endif

void
sv_catpvf_mg_nocontext(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
#ifdef PERL_IMPLICIT_CONTEXT
		sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
#else
		sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
#endif
#endif

void
sv_setpvf_mg(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
#endif

void
Perl_sv_setpvf_mg(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
		Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
#endif

void
sv_setpvf_mg_nocontext(sv)
	SV *sv
	CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
#ifdef PERL_IMPLICIT_CONTEXT
		sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
#else
		sv_setpvf_mg(sv, "%s-%d", "bar", 44);
#endif
#endif

##----------------------------------------------------------------------
##  XSUBs from parts/inc/SvPV
##----------------------------------------------------------------------

IV
SvPVbyte(sv)
	SV *sv
	PREINIT:
		STRLEN len;
		const char *str;
	CODE:
		str = SvPVbyte(sv, len);
		RETVAL = strEQ(str, "mhx") ? len : -1;
	OUTPUT:
		RETVAL

IV
SvPV_nolen(sv)
	SV *sv
	PREINIT:
		const char *str;
	CODE:
		str = SvPV_nolen(sv);
		RETVAL = strEQ(str, "mhx") ? 42 : 0;
	OUTPUT:
		RETVAL

##----------------------------------------------------------------------
##  XSUBs from parts/inc/threads
##----------------------------------------------------------------------

IV
no_THX_arg(sv)
	SV *sv
	CODE:
		RETVAL = 1 + sv_2iv(sv);
	OUTPUT:
		RETVAL

void
with_THX_arg(error)
	char *error
	PPCODE:
		Perl_croak(aTHX_ "%s", error);

##----------------------------------------------------------------------
##  XSUBs from parts/inc/uv
##----------------------------------------------------------------------

SV *
sv_setuv(uv)
	UV uv
	CODE:
		RETVAL = newSViv(1);
		sv_setuv(RETVAL, uv);
	OUTPUT:
		RETVAL

SV *
newSVuv(uv)
	UV uv
	CODE:
		RETVAL = newSVuv(uv);
	OUTPUT:
		RETVAL

UV
sv_2uv(sv)
	SV *sv
	CODE:
		RETVAL = sv_2uv(sv);
	OUTPUT:
		RETVAL

UV
SvUVx(sv)
	SV *sv
	CODE:
		sv--;
		RETVAL = SvUVx(++sv);
	OUTPUT:
		RETVAL

void
XSRETURN_UV()
	PPCODE:
		XSRETURN_UV(42);

void
PUSHu()
	PREINIT:
		dTARG;
	PPCODE:
		TARG = sv_newmortal();
		EXTEND(SP, 1);
		PUSHu(42);
		XSRETURN(1);

void
XPUSHu()
	PREINIT:
		dTARG;
	PPCODE:
		TARG = sv_newmortal();
		XPUSHu(43);
		XSRETURN(1);
Commit	Line	Data
adfe19db	1	/*******************************************************************************
	2	*
	3	* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
	4	*
	5	********************************************************************************
	6	*
	7	* Perl/Pollution/Portability
	8	*
	9	********************************************************************************
	10	*
9132e1a3	11	* $Revision: 8 $
adfe19db	12	* $Author: mhx $
9132e1a3	13	* $Date: 2005/01/31 08:10:55 +0100 $
adfe19db	14	*
	15	********************************************************************************
	16	*
9132e1a3	17	* Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
adfe19db	18	* Version 2.x, Copyright (C) 2001, Paul Marquess.
	19	* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	20	*
	21	* This program is free software; you can redistribute it and/or
	22	* modify it under the same terms as Perl itself.
	23	*
	24	*******************************************************************************/
	25
	26	/* ========== BEGIN XSHEAD ================================================== */
	27
	28
	29
	30	/* =========== END XSHEAD =================================================== */
0a7c7f4f	31
	32	#include "EXTERN.h"
	33	#include "perl.h"
	34	#include "XSUB.h"
	35
adfe19db	36	/* ========== BEGIN XSINIT ================================================== */
	37
	38	/* ---- from parts/inc/call ---- */
	39	#define NEED_eval_pv
	40
	41	/* ---- from parts/inc/grok ---- */
	42	#define NEED_grok_number
	43	#define NEED_grok_numeric_radix
	44	#define NEED_grok_bin
	45	#define NEED_grok_hex
	46	#define NEED_grok_oct
	47
	48	/* ---- from parts/inc/newCONSTSUB ---- */
0a7c7f4f	49	#define NEED_newCONSTSUB
adfe19db	50
	51	/* ---- from parts/inc/newRV ---- */
	52	#define NEED_newRV_noinc
	53
96ad942f	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
	60
adfe19db	61	/* ---- from parts/inc/SvPV ---- */
	62	#define NEED_sv_2pv_nolen
	63	#define NEED_sv_2pvbyte
	64
	65	/* =========== END XSINIT =================================================== */
	66
0a7c7f4f	67	#include "ppport.h"
0a7c7f4f	68
adfe19db	69	/* ========== BEGIN XSMISC ================================================== */
adfe19db	70
9132e1a3	71	/* ---- from parts/inc/exception ---- */
	72	static void throws_exception(int throw_e)
	73	{
	74	if (throw_e)
	75	croak("boo\n");
	76	}
	77
	78	static int exception(int throw_e)
	79	{
	80	dTHR;
	81	dXCPT;
	82	SV *caught = get_sv("Devel::PPPort::exception_caught", 0);
	83
	84	XCPT_TRY_START {
	85	throws_exception(throw_e);
	86	} XCPT_TRY_END
	87
	88	XCPT_CATCH
	89	{
	90	sv_setiv(caught, 1);
	91	XCPT_RETHROW;
	92	}
	93
	94	sv_setiv(caught, 0);
	95
	96	return 42;
	97	}
	98
	99	/* ---- from parts/inc/misc ---- */
	100	XS(XS_Devel__PPPort_dXSTARG); /* prototype */
	101	XS(XS_Devel__PPPort_dXSTARG)
	102	{
	103	dXSARGS;
	104	dXSTARG;
f8952f9c	105	IV iv;
9132e1a3	106	SP -= items;
f8952f9c	107	iv = SvIV(ST(0)) + 1;
9132e1a3	108	PUSHi(iv);
	109	XSRETURN(1);
	110	}
	111
adfe19db	112	/* ---- from parts/inc/MY_CXT ---- */
44284200	113	#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
0a7c7f4f	114
0a7c7f4f	115	typedef struct {
adfe19db	116	/* Put Global Data in here */
adfe19db	117	int dummy;
0a7c7f4f	118	} my_cxt_t;
	119
	120	START_MY_CXT
	121
adfe19db	122	/* ---- from parts/inc/newCONSTSUB ---- */
adfe19db	123	void call_newCONSTSUB_1(void)
0a7c7f4f	124	{
adfe19db	125	#ifdef PERL_NO_GET_CONTEXT
	126	dTHX;
	127	#endif
44284200	128	newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
0a7c7f4f	129	}
0a7c7f4f	130
adfe19db	131	extern void call_newCONSTSUB_2(void);
	132	extern void call_newCONSTSUB_3(void);
	133
96ad942f	134	/* ---- from parts/inc/sv_xpvf ---- */
	135	static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
	136	{
	137	SV *sv;
	138	va_list args;
	139	va_start(args, pat);
	140	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
	141	sv = vnewSVpvf(pat, &args);
	142	#else
	143	sv = newSVpv(pat, 0);
	144	#endif
	145	va_end(args);
	146	return sv;
	147	}
	148
	149	static void test_sv_vcatpvf(pTHX_ SV sv, const char pat, ...)
	150	{
	151	va_list args;
	152	va_start(args, pat);
	153	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
	154	sv_vcatpvf(sv, pat, &args);
	155	#else
	156	sv_catpv(sv, pat);
	157	#endif
	158	va_end(args);
	159	}
	160
	161	static void test_sv_vsetpvf(pTHX_ SV sv, const char pat, ...)
	162	{
	163	va_list args;
	164	va_start(args, pat);
	165	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
	166	sv_vsetpvf(sv, pat, &args);
	167	#else
	168	sv_setpv(sv, pat);
	169	#endif
	170	va_end(args);
	171	}
	172
adfe19db	173	/* =========== END XSMISC =================================================== */
0a7c7f4f	174
44284200	175	MODULE = Devel::PPPort PACKAGE = Devel::PPPort
0a7c7f4f	176
0a7c7f4f	177	BOOT:
9132e1a3	178	/* ---- from parts/inc/misc ---- */
	179	newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
	180
adfe19db	181	/* ---- from parts/inc/MY_CXT ---- */
	182	{
	183	MY_CXT_INIT;
	184	/* If any of the fields in the my_cxt_t struct need
	185	* to be initialised, do it here.
	186	*/
	187	MY_CXT.dummy = 42;
	188	}
	189
	190
	191	##----------------------------------------------------------------------
	192	## XSUBs from parts/inc/call
	193	##----------------------------------------------------------------------
	194
	195	I32
	196	G_SCALAR()
	197	CODE:
	198	RETVAL = G_SCALAR;
	199	OUTPUT:
	200	RETVAL
	201
	202	I32
	203	G_ARRAY()
	204	CODE:
	205	RETVAL = G_ARRAY;
	206	OUTPUT:
	207	RETVAL
	208
	209	I32
	210	G_DISCARD()
	211	CODE:
	212	RETVAL = G_DISCARD;
	213	OUTPUT:
	214	RETVAL
	215
	216	void
	217	eval_sv(sv, flags)
	218	SV* sv
	219	I32 flags
	220	PREINIT:
	221	I32 i;
	222	PPCODE:
	223	PUTBACK;
	224	i = eval_sv(sv, flags);
	225	SPAGAIN;
	226	EXTEND(SP, 1);
	227	PUSHs(sv_2mortal(newSViv(i)));
	228
	229	void
	230	eval_pv(p, croak_on_error)
	231	char* p
	232	I32 croak_on_error
	233	PPCODE:
	234	PUTBACK;
	235	EXTEND(SP, 1);
	236	PUSHs(eval_pv(p, croak_on_error));
	237
	238	void
	239	call_sv(sv, flags, ...)
	240	SV* sv
	241	I32 flags
	242	PREINIT:
	243	I32 i;
	244	PPCODE:
245	for (i=0; i<items-2; i++)
246	ST(i) = ST(i+2); /* pop first two args */
247	PUSHMARK(SP);
248	SP += items - 2;
249	PUTBACK;
250	i = call_sv(sv, flags);
251	SPAGAIN;
252	EXTEND(SP, 1);
253	PUSHs(sv_2mortal(newSViv(i)));
254
0a7c7f4f	255	void
adfe19db	256	call_pv(subname, flags, ...)
	257	char* subname
	258	I32 flags
	259	PREINIT:
	260	I32 i;
	261	PPCODE:
	262	for (i=0; i<items-2; i++)
	263	ST(i) = ST(i+2); /* pop first two args */
	264	PUSHMARK(SP);
	265	SP += items - 2;
	266	PUTBACK;
	267	i = call_pv(subname, flags);
	268	SPAGAIN;
	269	EXTEND(SP, 1);
	270	PUSHs(sv_2mortal(newSViv(i)));
0a7c7f4f	271
0a7c7f4f	272	void
adfe19db	273	call_argv(subname, flags, ...)
	274	char* subname
	275	I32 flags
	276	PREINIT:
	277	I32 i;
	278	char *args[8];
	279	PPCODE:
	280	if (items > 8) /* play safe */
	281	XSRETURN_UNDEF;
	282	for (i=2; i<items; i++)
	283	args[i-2] = SvPV_nolen(ST(i));
	284	args[items-2] = NULL;
	285	PUTBACK;
	286	i = call_argv(subname, flags, args);
	287	SPAGAIN;
	288	EXTEND(SP, 1);
	289	PUSHs(sv_2mortal(newSViv(i)));
0a7c7f4f	290
0a7c7f4f	291	void
adfe19db	292	call_method(methname, flags, ...)
	293	char* methname
	294	I32 flags
	295	PREINIT:
	296	I32 i;
	297	PPCODE:
	298	for (i=0; i<items-2; i++)
	299	ST(i) = ST(i+2); /* pop first two args */
	300	PUSHMARK(SP);
	301	SP += items - 2;
	302	PUTBACK;
	303	i = call_method(methname, flags);
	304	SPAGAIN;
	305	EXTEND(SP, 1);
	306	PUSHs(sv_2mortal(newSViv(i)));
	307
	308	##----------------------------------------------------------------------
	309	## XSUBs from parts/inc/cop
	310	##----------------------------------------------------------------------
	311
	312	char *
	313	CopSTASHPV()
	314	CODE:
	315	RETVAL = CopSTASHPV(PL_curcop);
	316	OUTPUT:
	317	RETVAL
	318
	319	char *
	320	CopFILE()
	321	CODE:
	322	RETVAL = CopFILE(PL_curcop);
	323	OUTPUT:
	324	RETVAL
	325
	326	##----------------------------------------------------------------------
9132e1a3	327	## XSUBs from parts/inc/exception
	328	##----------------------------------------------------------------------
	329
	330	int
	331	exception(throw_e)
	332	int throw_e
	333	OUTPUT:
	334	RETVAL
	335
	336	##----------------------------------------------------------------------
adfe19db	337	## XSUBs from parts/inc/grok
	338	##----------------------------------------------------------------------
	339
	340	UV
	341	grok_number(string)
	342	SV *string
	343	PREINIT:
	344	const char *pv;
	345	STRLEN len;
	346	CODE:
	347	pv = SvPV(string, len);
	348	if (!grok_number(pv, len, &RETVAL))
	349	XSRETURN_UNDEF;
	350	OUTPUT:
	351	RETVAL
	352
	353	UV
	354	grok_bin(string)
	355	SV *string
	356	PREINIT:
	357	char *pv;
	358	I32 flags;
	359	STRLEN len;
	360	CODE:
	361	pv = SvPV(string, len);
	362	RETVAL = grok_bin(pv, &len, &flags, NULL);
	363	OUTPUT:
	364	RETVAL
	365
	366	UV
	367	grok_hex(string)
	368	SV *string
	369	PREINIT:
	370	char *pv;
	371	I32 flags;
	372	STRLEN len;
	373	CODE:
	374	pv = SvPV(string, len);
	375	RETVAL = grok_hex(pv, &len, &flags, NULL);
	376	OUTPUT:
	377	RETVAL
	378
	379	UV
	380	grok_oct(string)
	381	SV *string
	382	PREINIT:
	383	char *pv;
	384	I32 flags;
	385	STRLEN len;
	386	CODE:
	387	pv = SvPV(string, len);
	388	RETVAL = grok_oct(pv, &len, &flags, NULL);
	389	OUTPUT:
	390	RETVAL
	391
	392	UV
	393	Perl_grok_number(string)
	394	SV *string
	395	PREINIT:
	396	const char *pv;
	397	STRLEN len;
	398	CODE:
	399	pv = SvPV(string, len);
	400	if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
401	XSRETURN_UNDEF;
402	OUTPUT:
403	RETVAL
404
405	UV
406	Perl_grok_bin(string)
407	SV *string
408	PREINIT:
409	char *pv;
410	I32 flags;
411	STRLEN len;
412	CODE:
413	pv = SvPV(string, len);
414	RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
415	OUTPUT:
416	RETVAL
417
418	UV
419	Perl_grok_hex(string)
420	SV *string
421	PREINIT:
422	char *pv;
423	I32 flags;
424	STRLEN len;
425	CODE:
426	pv = SvPV(string, len);
427	RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
428	OUTPUT:
429	RETVAL
430
431	UV
432	Perl_grok_oct(string)
433	SV *string
434	PREINIT:
435	char *pv;
436	I32 flags;
437	STRLEN len;
438	CODE:
439	pv = SvPV(string, len);
440	RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
441	OUTPUT:
442	RETVAL
443
444	##----------------------------------------------------------------------
445	## XSUBs from parts/inc/limits
446	##----------------------------------------------------------------------
447
448	IV
449	iv_size()
450	CODE:
451	RETVAL = IVSIZE == sizeof(IV);
452	OUTPUT:
453	RETVAL
454
455	IV
456	uv_size()
457	CODE:
458	RETVAL = UVSIZE == sizeof(UV);
459	OUTPUT:
460	RETVAL
461
462	IV
463	iv_type()
464	CODE:
465	RETVAL = sizeof(IVTYPE) == sizeof(IV);
466	OUTPUT:
467	RETVAL
468
469	IV
470	uv_type()
471	CODE:
472	RETVAL = sizeof(UVTYPE) == sizeof(UV);
473	OUTPUT:
474	RETVAL
475
476	##----------------------------------------------------------------------
477	## XSUBs from parts/inc/magic
478	##----------------------------------------------------------------------
479
480	void
481	sv_catpv_mg(sv, string)
482	SV *sv;
483	char *string;
484	CODE:
485	sv_catpv_mg(sv, string);
486
487	void
488	sv_catpvn_mg(sv, sv2)
489	SV *sv;
490	SV *sv2;
491	PREINIT:
492	char *str;
493	STRLEN len;
494	CODE:
495	str = SvPV(sv2, len);
496	sv_catpvn_mg(sv, str, len);
497
498	void
499	sv_catsv_mg(sv, sv2)
500	SV *sv;
501	SV *sv2;
502	CODE:
503	sv_catsv_mg(sv, sv2);
504
505	void
506	sv_setiv_mg(sv, iv)
507	SV *sv;
508	IV iv;
509	CODE:
510	sv_setiv_mg(sv, iv);
511
512	void
513	sv_setnv_mg(sv, nv)
514	SV *sv;
515	NV nv;
516	CODE:
517	sv_setnv_mg(sv, nv);
518
519	void
520	sv_setpv_mg(sv, pv)
521	SV *sv;
522	char *pv;
523	CODE:
524	sv_setpv_mg(sv, pv);
525
526	void
527	sv_setpvn_mg(sv, sv2)
528	SV *sv;
529	SV *sv2;
530	PREINIT:
531	char *str;
532	STRLEN len;
533	CODE:
534	str = SvPV(sv2, len);
535	sv_setpvn_mg(sv, str, len);
536
537	void
538	sv_setsv_mg(sv, sv2)
539	SV *sv;
540	SV *sv2;
541	CODE:
542	sv_setsv_mg(sv, sv2);
543
544	void
545	sv_setuv_mg(sv, uv)
546	SV *sv;
547	UV uv;
548	CODE:
549	sv_setuv_mg(sv, uv);
550
551	void
552	sv_usepvn_mg(sv, sv2)
553	SV *sv;
554	SV *sv2;
555	PREINIT:
556	char str, copy;
557	STRLEN len;
558	CODE:
559	str = SvPV(sv2, len);
560	New(42, copy, len+1, char);
561	Copy(str, copy, len+1, char);
562	sv_usepvn_mg(sv, copy, len);
563
564	##----------------------------------------------------------------------
565	## XSUBs from parts/inc/misc
566	##----------------------------------------------------------------------
0a7c7f4f	567
0a7c7f4f	568	int
adfe19db	569	gv_stashpvn(name, create)
	570	char *name
	571	I32 create
0a7c7f4f	572	CODE:
adfe19db	573	RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
0a7c7f4f	574	OUTPUT:
adfe19db	575	RETVAL
0a7c7f4f	576
0a7c7f4f	577	int
adfe19db	578	get_sv(name, create)
	579	char *name
	580	I32 create
0a7c7f4f	581	CODE:
adfe19db	582	RETVAL = get_sv(name, create) != NULL;
	583	OUTPUT:
	584	RETVAL
	585
	586	int
	587	get_av(name, create)
	588	char *name
	589	I32 create
	590	CODE:
	591	RETVAL = get_av(name, create) != NULL;
	592	OUTPUT:
	593	RETVAL
	594
	595	int
	596	get_hv(name, create)
	597	char *name
	598	I32 create
	599	CODE:
	600	RETVAL = get_hv(name, create) != NULL;
	601	OUTPUT:
	602	RETVAL
	603
	604	int
	605	get_cv(name, create)
	606	char *name
	607	I32 create
	608	CODE:
	609	RETVAL = get_cv(name, create) != NULL;
0a7c7f4f	610	OUTPUT:
adfe19db	611	RETVAL
	612
	613	void
	614	newSVpvn()
	615	PPCODE:
	616	XPUSHs(newSVpvn("test", 4));
	617	XPUSHs(newSVpvn("test", 2));
	618	XPUSHs(newSVpvn("test", 0));
	619	XPUSHs(newSVpvn(NULL, 2));
	620	XPUSHs(newSVpvn(NULL, 0));
	621	XSRETURN(5);
0a7c7f4f	622
0a7c7f4f	623	SV *
adfe19db	624	PL_sv_undef()
0a7c7f4f	625	CODE:
adfe19db	626	RETVAL = newSVsv(&PL_sv_undef);
0a7c7f4f	627	OUTPUT:
adfe19db	628	RETVAL
0a7c7f4f	629
0a7c7f4f	630	SV *
adfe19db	631	PL_sv_yes()
0a7c7f4f	632	CODE:
adfe19db	633	RETVAL = newSVsv(&PL_sv_yes);
0a7c7f4f	634	OUTPUT:
adfe19db	635	RETVAL
0a7c7f4f	636
0a7c7f4f	637	SV *
adfe19db	638	PL_sv_no()
0a7c7f4f	639	CODE:
adfe19db	640	RETVAL = newSVsv(&PL_sv_no);
0a7c7f4f	641	OUTPUT:
adfe19db	642	RETVAL
0a7c7f4f	643
0a7c7f4f	644	int
adfe19db	645	PL_na(string)
adfe19db	646	char *string
0a7c7f4f	647	CODE:
0a7c7f4f	648	PL_na = strlen(string);
0a7c7f4f	649	RETVAL = PL_na;
0a7c7f4f	650	OUTPUT:
adfe19db	651	RETVAL
0a7c7f4f	652
0a7c7f4f	653	SV*
adfe19db	654	boolSV(value)
0a7c7f4f	655	int value
0a7c7f4f	656	CODE:
adfe19db	657	RETVAL = newSVsv(boolSV(value));
0a7c7f4f	658	OUTPUT:
adfe19db	659	RETVAL
0a7c7f4f	660
0a7c7f4f	661	SV*
adfe19db	662	DEFSV()
0a7c7f4f	663	CODE:
0a7c7f4f	664	RETVAL = newSVsv(DEFSV);
0a7c7f4f	665	OUTPUT:
adfe19db	666	RETVAL
0a7c7f4f	667
0a7c7f4f	668	int
adfe19db	669	ERRSV()
0a7c7f4f	670	CODE:
0a7c7f4f	671	RETVAL = SvTRUE(ERRSV);
0a7c7f4f	672	OUTPUT:
adfe19db	673	RETVAL
	674
	675	SV*
	676	UNDERBAR()
	677	CODE:
	678	{
	679	dUNDERBAR;
	680	RETVAL = newSVsv(UNDERBAR);
	681	}
	682	OUTPUT:
	683	RETVAL
	684
	685	##----------------------------------------------------------------------
	686	## XSUBs from parts/inc/mPUSH
	687	##----------------------------------------------------------------------
	688
	689	void
	690	mPUSHp()
	691	PPCODE:
	692	EXTEND(SP, 3);
	693	mPUSHp("one", 3);
	694	mPUSHp("two", 3);
	695	mPUSHp("three", 5);
	696	XSRETURN(3);
	697
	698	void
	699	mPUSHn()
	700	PPCODE:
	701	EXTEND(SP, 3);
	702	mPUSHn(0.5);
	703	mPUSHn(-0.25);
	704	mPUSHn(0.125);
	705	XSRETURN(3);
	706
	707	void
	708	mPUSHi()
	709	PPCODE:
	710	EXTEND(SP, 3);
	711	mPUSHi(-1);
	712	mPUSHi(2);
	713	mPUSHi(-3);
	714	XSRETURN(3);
	715
	716	void
	717	mPUSHu()
	718	PPCODE:
	719	EXTEND(SP, 3);
	720	mPUSHu(1);
	721	mPUSHu(2);
	722	mPUSHu(3);
	723	XSRETURN(3);
	724
	725	void
	726	mXPUSHp()
	727	PPCODE:
	728	mXPUSHp("one", 3);
	729	mXPUSHp("two", 3);
	730	mXPUSHp("three", 5);
	731	XSRETURN(3);
	732
	733	void
	734	mXPUSHn()
	735	PPCODE:
	736	mXPUSHn(0.5);
737	mXPUSHn(-0.25);
738	mXPUSHn(0.125);
739	XSRETURN(3);
740
741	void
742	mXPUSHi()
743	PPCODE:
744	mXPUSHi(-1);
745	mXPUSHi(2);
746	mXPUSHi(-3);
747	XSRETURN(3);
748
749	void
750	mXPUSHu()
751	PPCODE:
752	mXPUSHu(1);
753	mXPUSHu(2);
754	mXPUSHu(3);
755	XSRETURN(3);
756
757	##----------------------------------------------------------------------
758	## XSUBs from parts/inc/MY_CXT
759	##----------------------------------------------------------------------
0a7c7f4f	760
0a7c7f4f	761	int
adfe19db	762	MY_CXT_1()
0a7c7f4f	763	CODE:
0a7c7f4f	764	dMY_CXT;
adfe19db	765	RETVAL = MY_CXT.dummy == 42;
adfe19db	766	++MY_CXT.dummy;
0a7c7f4f	767	OUTPUT:
adfe19db	768	RETVAL
0a7c7f4f	769
0a7c7f4f	770	int
adfe19db	771	MY_CXT_2()
0a7c7f4f	772	CODE:
0a7c7f4f	773	dMY_CXT;
adfe19db	774	RETVAL = MY_CXT.dummy == 43;
	775	OUTPUT:
	776	RETVAL
	777
e4c28a9f	778	int
	779	MY_CXT_CLONE()
	780	CODE:
	781	MY_CXT_CLONE;
	782	RETVAL = 42;
	783	OUTPUT:
	784	RETVAL
	785
adfe19db	786	##----------------------------------------------------------------------
	787	## XSUBs from parts/inc/newCONSTSUB
	788	##----------------------------------------------------------------------
	789
	790	void
	791	call_newCONSTSUB_1()
	792
	793	void
	794	call_newCONSTSUB_2()
	795
	796	void
	797	call_newCONSTSUB_3()
	798
	799	##----------------------------------------------------------------------
	800	## XSUBs from parts/inc/newRV
	801	##----------------------------------------------------------------------
	802
	803	U32
	804	newRV_inc_REFCNT()
	805	PREINIT:
	806	SV sv, rv;
	807	CODE:
	808	sv = newSViv(42);
	809	rv = newRV_inc(sv);
	810	SvREFCNT_dec(sv);
	811	RETVAL = SvREFCNT(sv);
	812	sv_2mortal(rv);
0a7c7f4f	813	OUTPUT:
adfe19db	814	RETVAL
0a7c7f4f	815
adfe19db	816	U32
	817	newRV_noinc_REFCNT()
	818	PREINIT:
	819	SV sv, rv;
	820	CODE:
	821	sv = newSViv(42);
	822	rv = newRV_noinc(sv);
	823	RETVAL = SvREFCNT(sv);
	824	sv_2mortal(rv);
	825	OUTPUT:
	826	RETVAL
	827
	828	##----------------------------------------------------------------------
96ad942f	829	## XSUBs from parts/inc/sv_xpvf
	830	##----------------------------------------------------------------------
	831
	832	SV *
	833	vnewSVpvf()
	834	CODE:
	835	RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
	836	OUTPUT:
	837	RETVAL
	838
	839	SV *
	840	sv_vcatpvf(sv)
	841	SV *sv
	842	CODE:
	843	RETVAL = newSVsv(sv);
	844	test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
	845	OUTPUT:
	846	RETVAL
	847
	848	SV *
	849	sv_vsetpvf(sv)
	850	SV *sv
	851	CODE:
	852	RETVAL = newSVsv(sv);
	853	test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
	854	OUTPUT:
	855	RETVAL
	856
	857	void
	858	sv_catpvf_mg(sv)
	859	SV *sv
	860	CODE:
	861	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
	862	sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
	863	#endif
	864
	865	void
	866	Perl_sv_catpvf_mg(sv)
	867	SV *sv
	868	CODE:
	869	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
	870	Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
	871	#endif
	872
	873	void
	874	sv_catpvf_mg_nocontext(sv)
	875	SV *sv
	876	CODE:
	877	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
	878	#ifdef PERL_IMPLICIT_CONTEXT
	879	sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
	880	#else
	881	sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
	882	#endif
	883	#endif
	884
	885	void
	886	sv_setpvf_mg(sv)
	887	SV *sv
	888	CODE:
	889	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
	890	sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
	891	#endif
	892
893	void
894	Perl_sv_setpvf_mg(sv)
895	SV *sv
896	CODE:
897	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
898	Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
899	#endif
900
901	void
902	sv_setpvf_mg_nocontext(sv)
903	SV *sv
904	CODE:
905	#if ((PERL_VERSION > 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
906	#ifdef PERL_IMPLICIT_CONTEXT
907	sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
908	#else
909	sv_setpvf_mg(sv, "%s-%d", "bar", 44);
910	#endif
911	#endif
912
913	##----------------------------------------------------------------------
adfe19db	914	## XSUBs from parts/inc/SvPV
	915	##----------------------------------------------------------------------
	916
	917	IV
	918	SvPVbyte(sv)
	919	SV *sv
	920	PREINIT:
	921	STRLEN len;
	922	const char *str;
	923	CODE:
	924	str = SvPVbyte(sv, len);
	925	RETVAL = strEQ(str, "mhx") ? len : -1;
	926	OUTPUT:
	927	RETVAL
	928
	929	IV
	930	SvPV_nolen(sv)
	931	SV *sv
	932	PREINIT:
	933	const char *str;
	934	CODE:
	935	str = SvPV_nolen(sv);
9132e1a3	936	RETVAL = strEQ(str, "mhx") ? 42 : 0;
adfe19db	937	OUTPUT:
	938	RETVAL
	939
	940	##----------------------------------------------------------------------
	941	## XSUBs from parts/inc/threads
	942	##----------------------------------------------------------------------
	943
	944	IV
	945	no_THX_arg(sv)
	946	SV *sv
	947	CODE:
	948	RETVAL = 1 + sv_2iv(sv);
	949	OUTPUT:
	950	RETVAL
	951
	952	void
	953	with_THX_arg(error)
	954	char *error
	955	PPCODE:
	956	Perl_croak(aTHX_ "%s", error);
	957
	958	##----------------------------------------------------------------------
	959	## XSUBs from parts/inc/uv
	960	##----------------------------------------------------------------------
	961
	962	SV *
	963	sv_setuv(uv)
	964	UV uv
	965	CODE:
	966	RETVAL = newSViv(1);
	967	sv_setuv(RETVAL, uv);
	968	OUTPUT:
	969	RETVAL
	970
	971	SV *
	972	newSVuv(uv)
	973	UV uv
	974	CODE:
	975	RETVAL = newSVuv(uv);
	976	OUTPUT:
	977	RETVAL
	978
	979	UV
	980	sv_2uv(sv)
	981	SV *sv
	982	CODE:
	983	RETVAL = sv_2uv(sv);
	984	OUTPUT:
	985	RETVAL
	986
	987	UV
	988	SvUVx(sv)
	989	SV *sv
	990	CODE:
	991	sv--;
	992	RETVAL = SvUVx(++sv);
	993	OUTPUT:
	994	RETVAL
	995
	996	void
	997	XSRETURN_UV()
	998	PPCODE:
	999	XSRETURN_UV(42);
96ad942f	1000
	1001	void
	1002	PUSHu()
	1003	PREINIT:
	1004	dTARG;
	1005	PPCODE:
	1006	TARG = sv_newmortal();
	1007	EXTEND(SP, 1);
	1008	PUSHu(42);
	1009	XSRETURN(1);
	1010
	1011	void
	1012	XPUSHu()
	1013	PREINIT:
	1014	dTARG;
	1015	PPCODE:
	1016	TARG = sv_newmortal();
	1017	XPUSHu(43);
	1018	XSRETURN(1);