[p5sagit/p5-mst-13.2.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;
}

SV*
my_cxt_getsv_interp(void)
{
#ifdef PERL_IMPLICIT_CONTEXT
    dTHX;
    dMY_CXT_INTERP(my_perl);
#else
    dMY_CXT;
#endif
    return MY_CXT.sv;
}

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);
    HeVAL(victim) = 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

bool
refcounted_he_exists(key, level=0)
	SV *key
	IV level
	CODE:
	if (level) {
	    croak("level must be zero, not %"IVdf, level);
	}
	RETVAL = (Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
					   key, NULL, 0, 0, 0)
		  != &PL_sv_placeholder);
	OUTPUT:
	RETVAL


SV *
refcounted_he_fetch(key, level=0)
	SV *key
	IV level
	CODE:
	if (level) {
	    croak("level must be zero, not %"IVdf, level);
	}
	RETVAL = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, key,
					  NULL, 0, 0, 0);
	SvREFCNT_inc(RETVAL);
	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:
	EXTEND(SP, 1);
	ST(0) = my_cxt_getsv_interp();
	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);

bool
sv_setsv_cow_hashkey_core()

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