/*******************************************************************************
*
*  !!!!! 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);