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