[perl5.git] / ext / XS / APItest / APItest.xs

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


/* for my_cxt tests */

#define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION

typedef struct {
    int i;
    SV *sv;
} my_cxt_t;

START_MY_CXT

/* indirect functions to test the [pa]MY_CXT macros */
int
my_cxt_getint_p(pMY_CXT)
{
    return MY_CXT.i;
}
void
my_cxt_setint_p(pMY_CXT_ int i)
{
    MY_CXT.i = i;
}
void
my_cxt_setsv_p(SV* sv _pMY_CXT)
{
    MY_CXT.sv = sv;
}


/* from exception.c */
int exception(int);

/* A routine to test hv_delayfree_ent
   (which itself is tested by testing on hv_free_ent  */

typedef void (freeent_function)(pTHX_ HV *, register HE *);

void
test_freeent(freeent_function *f) {
    dTHX;
    dSP;
    HV *test_hash = newHV();
    HE *victim;
    SV *test_scalar;
    U32 results[4];
    int i;

#ifdef PURIFY
    victim = (HE*)safemalloc(sizeof(HE));
#else
    /* Storing then deleting something should ensure that a hash entry is
       available.  */
    hv_store(test_hash, "", 0, &PL_sv_yes, 0);
    hv_delete(test_hash, "", 0, 0);

    /* We need to "inline" new_he here as it's static, and the functions we
       test expect to be able to call del_HE on the HE  */
    if (!PL_body_roots[HE_SVSLOT])
	croak("PL_he_root is 0");
    victim = (HE*) PL_body_roots[HE_SVSLOT];
    PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
#endif

    victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);

    test_scalar = newSV(0);
    SvREFCNT_inc(test_scalar);
    victim->hent_val = test_scalar;

    /* Need this little game else we free the temps on the return stack.  */
    results[0] = SvREFCNT(test_scalar);
    SAVETMPS;
    results[1] = SvREFCNT(test_scalar);
    f(aTHX_ test_hash, victim);
    results[2] = SvREFCNT(test_scalar);
    FREETMPS;
    results[3] = SvREFCNT(test_scalar);

    i = 0;
    do {
	mPUSHu(results[i]);
    } while (++i < sizeof(results)/sizeof(results[0]));

    /* Goodbye to our extra reference.  */
    SvREFCNT_dec(test_scalar);
}

MODULE = XS::APItest:Hash		PACKAGE = XS::APItest::Hash

#define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)

bool
exists(hash, key_sv)
	PREINIT:
	STRLEN len;
	const char *key;
	INPUT:
	HV *hash
	SV *key_sv
	CODE:
	key = SvPV(key_sv, len);
	RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
        OUTPUT:
        RETVAL

SV *
delete(hash, key_sv)
	PREINIT:
	STRLEN len;
	const char *key;
	INPUT:
	HV *hash
	SV *key_sv
	CODE:
	key = SvPV(key_sv, len);
	/* It's already mortal, so need to increase reference count.  */
	RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
        OUTPUT:
        RETVAL

SV *
store_ent(hash, key, value)
	PREINIT:
	SV *copy;
	HE *result;
	INPUT:
	HV *hash
	SV *key
	SV *value
	CODE:
	copy = newSV(0);
	result = hv_store_ent(hash, key, copy, 0);
	SvSetMagicSV(copy, value);
	if (!result) {
	    SvREFCNT_dec(copy);
	    XSRETURN_EMPTY;
	}
	/* It's about to become mortal, so need to increase reference count.
	 */
	RETVAL = SvREFCNT_inc(HeVAL(result));
        OUTPUT:
        RETVAL


SV *
store(hash, key_sv, value)
	PREINIT:
	STRLEN len;
	const char *key;
	SV *copy;
	SV **result;
	INPUT:
	HV *hash
	SV *key_sv
	SV *value
	CODE:
	key = SvPV(key_sv, len);
	copy = newSV(0);
	result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
	SvSetMagicSV(copy, value);
	if (!result) {
	    SvREFCNT_dec(copy);
	    XSRETURN_EMPTY;
	}
	/* It's about to become mortal, so need to increase reference count.
	 */
	RETVAL = SvREFCNT_inc(*result);
        OUTPUT:
        RETVAL


SV *
fetch(hash, key_sv)
	PREINIT:
	STRLEN len;
	const char *key;
	SV **result;
	INPUT:
	HV *hash
	SV *key_sv
	CODE:
	key = SvPV(key_sv, len);
	result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
	if (!result) {
	    XSRETURN_EMPTY;
	}
	/* Force mg_get  */
	RETVAL = newSVsv(*result);
        OUTPUT:
        RETVAL

void
test_hv_free_ent()
	PPCODE:
	test_freeent(&Perl_hv_free_ent);
	XSRETURN(4);

void
test_hv_delayfree_ent()
	PPCODE:
	test_freeent(&Perl_hv_delayfree_ent);
	XSRETURN(4);

SV *
test_share_unshare_pvn(input)
	PREINIT:
	STRLEN len;
	U32 hash;
	char *pvx;
	char *p;
	INPUT:
	SV *input
	CODE:
	pvx = SvPV(input, len);
	PERL_HASH(hash, pvx, len);
	p = sharepvn(pvx, len, hash);
	RETVAL = newSVpvn(p, len);
	unsharepvn(p, len, hash);
	OUTPUT:
	RETVAL
	
=pod

sub TIEHASH  { bless {}, $_[0] }
sub STORE    { $_[0]->{$_[1]} = $_[2] }
sub FETCH    { $_[0]->{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY  { each %{$_[0]} }
sub EXISTS   { exists $_[0]->{$_[1]} }
sub DELETE   { delete $_[0]->{$_[1]} }
sub CLEAR    { %{$_[0]} = () }

=cut

MODULE = XS::APItest		PACKAGE = XS::APItest

PROTOTYPES: DISABLE

BOOT:
{
    MY_CXT_INIT;
    MY_CXT.i  = 99;
    MY_CXT.sv = newSVpv("initial",0);
}                              

void
CLONE(...)
    CODE:
    MY_CXT_CLONE;
    MY_CXT.sv = newSVpv("initial_clone",0);

void
print_double(val)
        double val
        CODE:
        printf("%5.3f\n",val);

int
have_long_double()
        CODE:
#ifdef HAS_LONG_DOUBLE
        RETVAL = 1;
#else
        RETVAL = 0;
#endif
        OUTPUT:
        RETVAL

void
print_long_double()
        CODE:
#ifdef HAS_LONG_DOUBLE
#   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
        long double val = 7.0;
        printf("%5.3" PERL_PRIfldbl "\n",val);
#   else
        double val = 7.0;
        printf("%5.3f\n",val);
#   endif
#endif

void
print_int(val)
        int val
        CODE:
        printf("%d\n",val);

void
print_long(val)
        long val
        CODE:
        printf("%ld\n",val);

void
print_float(val)
        float val
        CODE:
        printf("%5.3f\n",val);
	
void
print_flush()
    	CODE:
	fflush(stdout);

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);


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_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)));

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)
    const char* p
    I32 croak_on_error
    PPCODE:
	PUTBACK;
	EXTEND(SP, 1);
	PUSHs(eval_pv(p, croak_on_error));

void
require_pv(pv)
    const char* pv
    PPCODE:
	PUTBACK;
	require_pv(pv);

int
exception(throw_e)
    int throw_e
    OUTPUT:
        RETVAL

void
mycroak(sv)
    SV* sv
    CODE:
    if (SvOK(sv)) {
        Perl_croak(aTHX_ "%s", SvPV_nolen(sv));
    }
    else {
	Perl_croak(aTHX_ NULL);
    }

SV*
strtab()
   CODE:
   RETVAL = newRV_inc((SV*)PL_strtab);
   OUTPUT:
   RETVAL

int
my_cxt_getint()
    CODE:
	dMY_CXT;
	RETVAL = my_cxt_getint_p(aMY_CXT);
    OUTPUT:
        RETVAL

void
my_cxt_setint(i)
    int i;
    CODE:
	dMY_CXT;
	my_cxt_setint_p(aMY_CXT_ i);

void
my_cxt_getsv()
    PPCODE:
	dMY_CXT;
	EXTEND(SP, 1);
	ST(0) = MY_CXT.sv;
	XSRETURN(1);

void
my_cxt_setsv(sv)
    SV *sv;
    CODE:
	dMY_CXT;
	SvREFCNT_dec(MY_CXT.sv);
	my_cxt_setsv_p(sv _aMY_CXT);
	SvREFCNT_inc(sv);
Commit	Line	Data
47e6fc1e	1	#define PERL_IN_XS_APITEST
3e61d65a JH	2	#include "EXTERN.h"
	3	#include "perl.h"
	4	#include "XSUB.h"
	5
cdbcf450 JH	6
	7	/* for my_cxt tests */
	8
	9	#define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION
	10
	11	typedef struct {
	12	int i;
	13	SV *sv;
	14	} my_cxt_t;
	15
	16	START_MY_CXT
	17
	18	/* indirect functions to test the [pa]MY_CXT macros */
	19	int
	20	my_cxt_getint_p(pMY_CXT)
	21	{
	22	return MY_CXT.i;
	23	}
	24	void
	25	my_cxt_setint_p(pMY_CXT_ int i)
	26	{
	27	MY_CXT.i = i;
	28	}
	29	void
	30	my_cxt_setsv_p(SV* sv _pMY_CXT)
	31	{
	32	MY_CXT.sv = sv;
	33	}
	34
	35
	36
6cea6f74 NC	37	/* from exception.c */
6cea6f74 NC	38	int exception(int);
56a4ef1f	39
7a334344 NC	40	/* A routine to test hv_delayfree_ent
	41	(which itself is tested by testing on hv_free_ent */
	42
	43	typedef void (freeent_function)(pTHX_ HV , register HE );
	44
	45	void
	46	test_freeent(freeent_function *f) {
	47	dTHX;
	48	dSP;
	49	HV *test_hash = newHV();
	50	HE *victim;
	51	SV *test_scalar;
	52	U32 results[4];
	53	int i;
	54
	55	#ifdef PURIFY
	56	victim = (HE*)safemalloc(sizeof(HE));
	57	#else
	58	/* Storing then deleting something should ensure that a hash entry is
	59	available. */
	60	hv_store(test_hash, "", 0, &PL_sv_yes, 0);
	61	hv_delete(test_hash, "", 0, 0);
	62
	63	/* We need to "inline" new_he here as it's static, and the functions we
	64	test expect to be able to call del_HE on the HE */
47e6fc1e	65	if (!PL_body_roots[HE_SVSLOT])
7a334344	66	croak("PL_he_root is 0");
6af95b68	67	victim = (HE*) PL_body_roots[HE_SVSLOT];
47e6fc1e	68	PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
7a334344 NC	69	#endif
	70
	71	victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
	72
	73	test_scalar = newSV(0);
	74	SvREFCNT_inc(test_scalar);
	75	victim->hent_val = test_scalar;
	76
	77	/* Need this little game else we free the temps on the return stack. */
	78	results[0] = SvREFCNT(test_scalar);
	79	SAVETMPS;
	80	results[1] = SvREFCNT(test_scalar);
	81	f(aTHX_ test_hash, victim);
	82	results[2] = SvREFCNT(test_scalar);
	83	FREETMPS;
	84	results[3] = SvREFCNT(test_scalar);
	85
	86	i = 0;
	87	do {
	88	mPUSHu(results[i]);
	89	} while (++i < sizeof(results)/sizeof(results[0]));
	90
	91	/* Goodbye to our extra reference. */
	92	SvREFCNT_dec(test_scalar);
	93	}
	94
56a4ef1f NC	95	MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
56a4ef1f NC	96
1ed1e641 MHM	97	#define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
1ed1e641 MHM	98
56a4ef1f NC	99	bool
	100	exists(hash, key_sv)
	101	PREINIT:
	102	STRLEN len;
	103	const char *key;
	104	INPUT:
	105	HV *hash
	106	SV *key_sv
	107	CODE:
	108	key = SvPV(key_sv, len);
1ed1e641	109	RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
56a4ef1f NC	110	OUTPUT:
	111	RETVAL
	112
	113	SV *
	114	delete(hash, key_sv)
	115	PREINIT:
	116	STRLEN len;
	117	const char *key;
	118	INPUT:
	119	HV *hash
	120	SV *key_sv
	121	CODE:
	122	key = SvPV(key_sv, len);
	123	/* It's already mortal, so need to increase reference count. */
1ed1e641	124	RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
56a4ef1f NC	125	OUTPUT:
	126	RETVAL
	127
	128	SV *
586f459e NC	129	store_ent(hash, key, value)
	130	PREINIT:
	131	SV *copy;
	132	HE *result;
	133	INPUT:
	134	HV *hash
	135	SV *key
	136	SV *value
	137	CODE:
	138	copy = newSV(0);
	139	result = hv_store_ent(hash, key, copy, 0);
	140	SvSetMagicSV(copy, value);
	141	if (!result) {
	142	SvREFCNT_dec(copy);
	143	XSRETURN_EMPTY;
	144	}
	145	/* It's about to become mortal, so need to increase reference count.
	146	*/
	147	RETVAL = SvREFCNT_inc(HeVAL(result));
	148	OUTPUT:
	149	RETVAL
	150
	151
	152	SV *
56a4ef1f NC	153	store(hash, key_sv, value)
	154	PREINIT:
	155	STRLEN len;
	156	const char *key;
	157	SV *copy;
	158	SV **result;
	159	INPUT:
	160	HV *hash
	161	SV *key_sv
	162	SV *value
	163	CODE:
	164	key = SvPV(key_sv, len);
	165	copy = newSV(0);
1ed1e641	166	result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
586f459e	167	SvSetMagicSV(copy, value);
56a4ef1f NC	168	if (!result) {
	169	SvREFCNT_dec(copy);
	170	XSRETURN_EMPTY;
	171	}
	172	/* It's about to become mortal, so need to increase reference count.
	173	*/
	174	RETVAL = SvREFCNT_inc(*result);
	175	OUTPUT:
	176	RETVAL
	177
	178
	179	SV *
	180	fetch(hash, key_sv)
	181	PREINIT:
	182	STRLEN len;
	183	const char *key;
	184	SV **result;
	185	INPUT:
	186	HV *hash
	187	SV *key_sv
	188	CODE:
	189	key = SvPV(key_sv, len);
1ed1e641	190	result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
56a4ef1f NC	191	if (!result) {
	192	XSRETURN_EMPTY;
	193	}
	194	/* Force mg_get */
	195	RETVAL = newSVsv(*result);
	196	OUTPUT:
	197	RETVAL
7a334344 NC	198
	199	void
	200	test_hv_free_ent()
	201	PPCODE:
	202	test_freeent(&Perl_hv_free_ent);
	203	XSRETURN(4);
	204
	205	void
	206	test_hv_delayfree_ent()
	207	PPCODE:
	208	test_freeent(&Perl_hv_delayfree_ent);
	209	XSRETURN(4);
5100483f NC	210
	211	SV *
	212	test_share_unshare_pvn(input)
	213	PREINIT:
5100483f NC	214	STRLEN len;
	215	U32 hash;
	216	char *pvx;
	217	char *p;
	218	INPUT:
	219	SV *input
	220	CODE:
	221	pvx = SvPV(input, len);
	222	PERL_HASH(hash, pvx, len);
	223	p = sharepvn(pvx, len, hash);
	224	RETVAL = newSVpvn(p, len);
	225	unsharepvn(p, len, hash);
	226	OUTPUT:
	227	RETVAL
	228
56a4ef1f NC	229	=pod
	230
	231	sub TIEHASH { bless {}, $_[0] }
	232	sub STORE { $_[0]->{$_[1]} = $_[2] }
	233	sub FETCH { $_[0]->{$_[1]} }
	234	sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
	235	sub NEXTKEY { each %{$_[0]} }
	236	sub EXISTS { exists $_[0]->{$_[1]} }
	237	sub DELETE { delete $_[0]->{$_[1]} }
	238	sub CLEAR { %{$_[0]} = () }
	239
	240	=cut
	241
3e61d65a JH	242	MODULE = XS::APItest PACKAGE = XS::APItest
	243
	244	PROTOTYPES: DISABLE
	245
cdbcf450 JH	246	BOOT:
	247	{
	248	MY_CXT_INIT;
	249	MY_CXT.i = 99;
	250	MY_CXT.sv = newSVpv("initial",0);
	251	}
	252
	253	void
	254	CLONE(...)
	255	CODE:
	256	MY_CXT_CLONE;
	257	MY_CXT.sv = newSVpv("initial_clone",0);
	258
3e61d65a JH	259	void
	260	print_double(val)
	261	double val
	262	CODE:
	263	printf("%5.3f\n",val);
	264
	265	int
	266	have_long_double()
	267	CODE:
	268	#ifdef HAS_LONG_DOUBLE
	269	RETVAL = 1;
	270	#else
	271	RETVAL = 0;
	272	#endif
cabb36f0 CN	273	OUTPUT:
cabb36f0 CN	274	RETVAL
3e61d65a JH	275
	276	void
	277	print_long_double()
	278	CODE:
	279	#ifdef HAS_LONG_DOUBLE
fc0bf671	280	# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
3e61d65a JH	281	long double val = 7.0;
	282	printf("%5.3" PERL_PRIfldbl "\n",val);
	283	# else
	284	double val = 7.0;
	285	printf("%5.3f\n",val);
	286	# endif
	287	#endif
	288
	289	void
3e61d65a JH	290	print_int(val)
	291	int val
	292	CODE:
	293	printf("%d\n",val);
	294
	295	void
	296	print_long(val)
	297	long val
	298	CODE:
	299	printf("%ld\n",val);
	300
	301	void
	302	print_float(val)
	303	float val
	304	CODE:
	305	printf("%5.3f\n",val);
50eed52b JH	306
	307	void
	308	print_flush()
	309	CODE:
	310	fflush(stdout);
fb7377f8 NC	311
	312	void
	313	mpushp()
	314	PPCODE:
	315	EXTEND(SP, 3);
	316	mPUSHp("one", 3);
	317	mPUSHp("two", 3);
	318	mPUSHp("three", 5);
	319	XSRETURN(3);
	320
	321	void
	322	mpushn()
	323	PPCODE:
	324	EXTEND(SP, 3);
	325	mPUSHn(0.5);
	326	mPUSHn(-0.25);
	327	mPUSHn(0.125);
	328	XSRETURN(3);
	329
	330	void
	331	mpushi()
	332	PPCODE:
	333	EXTEND(SP, 3);
28f4d5c2 NC	334	mPUSHi(-1);
	335	mPUSHi(2);
	336	mPUSHi(-3);
fb7377f8 NC	337	XSRETURN(3);
	338
	339	void
	340	mpushu()
	341	PPCODE:
	342	EXTEND(SP, 3);
28f4d5c2 NC	343	mPUSHu(1);
	344	mPUSHu(2);
	345	mPUSHu(3);
fb7377f8 NC	346	XSRETURN(3);
	347
	348	void
	349	mxpushp()
	350	PPCODE:
	351	mXPUSHp("one", 3);
	352	mXPUSHp("two", 3);
	353	mXPUSHp("three", 5);
	354	XSRETURN(3);
	355
	356	void
	357	mxpushn()
	358	PPCODE:
	359	mXPUSHn(0.5);
	360	mXPUSHn(-0.25);
	361	mXPUSHn(0.125);
	362	XSRETURN(3);
	363
	364	void
	365	mxpushi()
	366	PPCODE:
28f4d5c2 NC	367	mXPUSHi(-1);
	368	mXPUSHi(2);
	369	mXPUSHi(-3);
fb7377f8 NC	370	XSRETURN(3);
	371
	372	void
	373	mxpushu()
	374	PPCODE:
28f4d5c2 NC	375	mXPUSHu(1);
	376	mXPUSHu(2);
	377	mXPUSHu(3);
fb7377f8	378	XSRETURN(3);
28f4d5c2 NC	379
	380
	381	void
	382	call_sv(sv, flags, ...)
	383	SV* sv
	384	I32 flags
	385	PREINIT:
	386	I32 i;
	387	PPCODE:
	388	for (i=0; i<items-2; i++)
	389	ST(i) = ST(i+2); /* pop first two args */
	390	PUSHMARK(SP);
	391	SP += items - 2;
	392	PUTBACK;
	393	i = call_sv(sv, flags);
	394	SPAGAIN;
	395	EXTEND(SP, 1);
	396	PUSHs(sv_2mortal(newSViv(i)));
	397
	398	void
	399	call_pv(subname, flags, ...)
	400	char* subname
	401	I32 flags
	402	PREINIT:
	403	I32 i;
	404	PPCODE:
	405	for (i=0; i<items-2; i++)
	406	ST(i) = ST(i+2); /* pop first two args */
	407	PUSHMARK(SP);
	408	SP += items - 2;
	409	PUTBACK;
	410	i = call_pv(subname, flags);
	411	SPAGAIN;
	412	EXTEND(SP, 1);
	413	PUSHs(sv_2mortal(newSViv(i)));
	414
	415	void
	416	call_method(methname, flags, ...)
	417	char* methname
	418	I32 flags
	419	PREINIT:
	420	I32 i;
	421	PPCODE:
	422	for (i=0; i<items-2; i++)
	423	ST(i) = ST(i+2); /* pop first two args */
	424	PUSHMARK(SP);
	425	SP += items - 2;
	426	PUTBACK;
	427	i = call_method(methname, flags);
	428	SPAGAIN;
	429	EXTEND(SP, 1);
	430	PUSHs(sv_2mortal(newSViv(i)));
	431
	432	void
	433	eval_sv(sv, flags)
	434	SV* sv
	435	I32 flags
	436	PREINIT:
	437	I32 i;
	438	PPCODE:
	439	PUTBACK;
	440	i = eval_sv(sv, flags);
	441	SPAGAIN;
	442	EXTEND(SP, 1);
443	PUSHs(sv_2mortal(newSViv(i)));
444
a2592645	445	void
28f4d5c2 NC	446	eval_pv(p, croak_on_error)
	447	const char* p
	448	I32 croak_on_error
28f4d5c2 NC	449	PPCODE:
	450	PUTBACK;
	451	EXTEND(SP, 1);
	452	PUSHs(eval_pv(p, croak_on_error));
	453
	454	void
	455	require_pv(pv)
	456	const char* pv
28f4d5c2 NC	457	PPCODE:
	458	PUTBACK;
	459	require_pv(pv);
	460
67ff4d25 NC	461	int
	462	exception(throw_e)
	463	int throw_e
	464	OUTPUT:
	465	RETVAL
28f4d5c2	466
7a334344	467	void
67ff4d25 NC	468	mycroak(sv)
67ff4d25 NC	469	SV* sv
7a334344	470	CODE:
67ff4d25 NC	471	if (SvOK(sv)) {
	472	Perl_croak(aTHX_ "%s", SvPV_nolen(sv));
	473	}
	474	else {
	475	Perl_croak(aTHX_ NULL);
	476	}
7a334344 NC	477
	478	SV*
	479	strtab()
	480	CODE:
	481	RETVAL = newRV_inc((SV*)PL_strtab);
	482	OUTPUT:
	483	RETVAL
cdbcf450 JH	484
	485	int
	486	my_cxt_getint()
	487	CODE:
	488	dMY_CXT;
	489	RETVAL = my_cxt_getint_p(aMY_CXT);
	490	OUTPUT:
	491	RETVAL
	492
	493	void
	494	my_cxt_setint(i)
	495	int i;
	496	CODE:
	497	dMY_CXT;
	498	my_cxt_setint_p(aMY_CXT_ i);
	499
	500	void
	501	my_cxt_getsv()
	502	PPCODE:
	503	dMY_CXT;
	504	EXTEND(SP, 1);
	505	ST(0) = MY_CXT.sv;
	506	XSRETURN(1);
	507
	508	void
	509	my_cxt_setsv(sv)
	510	SV *sv;
	511	CODE:
	512	dMY_CXT;
	513	SvREFCNT_dec(MY_CXT.sv);
	514	my_cxt_setsv_p(sv _aMY_CXT);
	515	SvREFCNT_inc(sv);