# basic C types

int T_IV

unsigned T_UV

unsigned int T_UV

long T_IV

unsigned long T_UV

short T_IV

unsigned short T_UV

char T_CHAR

unsigned char T_U_CHAR

char * T_PV

unsigned char * T_PV

const char * T_PV

caddr_t T_PV

wchar_t * T_PV

wchar_t T_IV

# bool_t is defined in <rpc/rpc.h>

bool_t T_IV

size_t T_UV

ssize_t T_IV

time_t T_NV

unsigned long * T_OPAQUEPTR

char ** T_PACKEDARRAY

void * T_PTR

Time_t * T_PV

SV * T_SV

# These are the backwards-compatibility AV*/HV* typemaps that

# do not decrement refcounts. Locally override with

# "AV* T_AVREF_REFCOUNT_FIXED", "HV* T_HVREF_REFCOUNT_FIXED",

# "CV* T_CVREF_REFCOUNT_FIXED", "SVREF T_SVREF_REFCOUNT_FIXED",

# to get the fixed versions.

SVREF T_SVREF

CV * T_CVREF

AV * T_AVREF

HV * T_HVREF

IV T_IV

UV T_UV

NV T_NV

I32 T_IV

I16 T_IV

I8 T_IV

STRLEN T_UV

U32 T_U_LONG

U16 T_U_SHORT

U8 T_UV

Result T_U_CHAR

Boolean T_BOOL

float T_FLOAT

double T_DOUBLE

SysRet T_SYSRET

SysRetLong T_SYSRET

FILE * T_STDIO

PerlIO * T_INOUT

FileHandle T_PTROBJ

InputStream T_IN

InOutStream T_INOUT

OutputStream T_OUT

bool T_BOOL

#############################################################################

INPUT

T_SV

$var = $arg

T_SVREF

STMT_START {

SV* const xsub_tmp_sv = $arg;

SvGETMAGIC(xsub_tmp_sv);

if (SvROK(xsub_tmp_sv)){

$var = SvRV(xsub_tmp_sv);

}

else{

Perl_croak_nocontext(\"%s: %s is not a reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\");

}

} STMT_END

T_SVREF_REFCOUNT_FIXED

STMT_START {

SV* const xsub_tmp_sv = $arg;

SvGETMAGIC(xsub_tmp_sv);

if (SvROK(xsub_tmp_sv)){

$var = SvRV(xsub_tmp_sv);

}

else{

Perl_croak_nocontext(\"%s: %s is not a reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\");

}

} STMT_END

T_AVREF

STMT_START {

SV* const xsub_tmp_sv = $arg;

SvGETMAGIC(xsub_tmp_sv);

if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){

$var = (AV*)SvRV(xsub_tmp_sv);

}

else{

Perl_croak_nocontext(\"%s: %s is not an ARRAY reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\");

}

} STMT_END

T_AVREF_REFCOUNT_FIXED

STMT_START {

SV* const xsub_tmp_sv = $arg;

SvGETMAGIC(xsub_tmp_sv);

if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){

$var = (AV*)SvRV(xsub_tmp_sv);

}

else{

Perl_croak_nocontext(\"%s: %s is not an ARRAY reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\");

}

} STMT_END

T_HVREF

STMT_START {

SV* const xsub_tmp_sv = $arg;

SvGETMAGIC(xsub_tmp_sv);

if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){

$var = (HV*)SvRV(xsub_tmp_sv);

}

else{

Perl_croak_nocontext(\"%s: %s is not a HASH reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\");

}

} STMT_END

T_HVREF_REFCOUNT_FIXED

STMT_START {

SV* const xsub_tmp_sv = $arg;

SvGETMAGIC(xsub_tmp_sv);

if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){

$var = (HV*)SvRV(xsub_tmp_sv);

}

else{

Perl_croak_nocontext(\"%s: %s is not a HASH reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\");

}

} STMT_END

T_CVREF

STMT_START {

HV *st;

GV *gvp;

SV * const xsub_tmp_sv = $arg;

SvGETMAGIC(xsub_tmp_sv);

$var = sv_2cv(xsub_tmp_sv, &st, &gvp, 0);

if (!$var) {

Perl_croak_nocontext(\"%s: %s is not a CODE reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\");

}

} STMT_END

T_CVREF_REFCOUNT_FIXED

STMT_START {

HV *st;

GV *gvp;

SV * const xsub_tmp_sv = $arg;

SvGETMAGIC(xsub_tmp_sv);

$var = sv_2cv(xsub_tmp_sv, &st, &gvp, 0);

if (!$var) {

Perl_croak_nocontext(\"%s: %s is not a CODE reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\");

}

} STMT_END

T_SYSRET

$var NOT IMPLEMENTED

T_UV

$var = ($type)SvUV($arg)

T_IV

$var = ($type)SvIV($arg)

T_INT

$var = (int)SvIV($arg)

T_ENUM

$var = ($type)SvIV($arg)

T_BOOL

$var = (bool)SvTRUE($arg)

T_U_INT

$var = (unsigned int)SvUV($arg)

T_SHORT

$var = (short)SvIV($arg)

T_U_SHORT

$var = (unsigned short)SvUV($arg)

T_LONG

$var = (long)SvIV($arg)

T_U_LONG

$var = (unsigned long)SvUV($arg)

T_CHAR

$var = (char)*SvPV_nolen($arg)

T_U_CHAR

$var = (unsigned char)SvUV($arg)

T_FLOAT

$var = (float)SvNV($arg)

T_NV

$var = ($type)SvNV($arg)

T_DOUBLE

$var = (double)SvNV($arg)

T_PV

$var = ($type)SvPV_nolen($arg)

T_PTR

$var = INT2PTR($type,SvIV($arg))

T_PTRREF

if (SvROK($arg)) {

IV tmp = SvIV((SV*)SvRV($arg));

$var = INT2PTR($type,tmp);

}

else

Perl_croak_nocontext(\"%s: %s is not a reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\")

T_REF_IV_REF

if (sv_isa($arg, \"${ntype}\")) {

IV tmp = SvIV((SV*)SvRV($arg));

$var = *INT2PTR($type *, tmp);

}

else

Perl_croak_nocontext(\"%s: %s is not of type %s\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\", \"$ntype\")

T_REF_IV_PTR

if (sv_isa($arg, \"${ntype}\")) {

IV tmp = SvIV((SV*)SvRV($arg));

$var = INT2PTR($type, tmp);

}

else

Perl_croak_nocontext(\"%s: %s is not of type %s\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\", \"$ntype\")

T_PTROBJ

if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) {

IV tmp = SvIV((SV*)SvRV($arg));

$var = INT2PTR($type,tmp);

}

else

Perl_croak_nocontext(\"%s: %s is not of type %s\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\", \"$ntype\")

T_PTRDESC

if (sv_isa($arg, \"${ntype}\")) {

IV tmp = SvIV((SV*)SvRV($arg));

${type}_desc = (\U${type}_DESC\E*) tmp;

$var = ${type}_desc->ptr;

}

else

Perl_croak_nocontext(\"%s: %s is not of type %s\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\", \"$ntype\")

T_REFREF

if (SvROK($arg)) {

IV tmp = SvIV((SV*)SvRV($arg));

$var = *INT2PTR($type,tmp);

}

else

Perl_croak_nocontext(\"%s: %s is not a reference\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\")

T_REFOBJ

if (sv_isa($arg, \"${ntype}\")) {

IV tmp = SvIV((SV*)SvRV($arg));

$var = *INT2PTR($type,tmp);

}

else

Perl_croak_nocontext(\"%s: %s is not of type %s\",

${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},

\"$var\", \"$ntype\")

T_OPAQUE

$var = *($type *)SvPV_nolen($arg)

T_OPAQUEPTR

$var = ($type)SvPV_nolen($arg)

T_PACKED

$var = XS_unpack_$ntype($arg)

T_PACKEDARRAY

$var = XS_unpack_$ntype($arg)

T_ARRAY

U32 ix_$var = $argoff;

$var = $ntype(items -= $argoff);

while (items--) {

DO_ARRAY_ELEM;

ix_$var++;

}

/* this is the number of elements in the array */

ix_$var -= $argoff

T_STDIO

$var = PerlIO_findFILE(IoIFP(sv_2io($arg)))

T_IN

$var = IoIFP(sv_2io($arg))

T_INOUT

$var = IoIFP(sv_2io($arg))

T_OUT

$var = IoOFP(sv_2io($arg))

#############################################################################

OUTPUT

T_SV

$arg = $var;

T_SVREF

$arg = newRV((SV*)$var);

T_SVREF_REFCOUNT_FIXED

$arg = newRV_noinc((SV*)$var);

T_AVREF

$arg = newRV((SV*)$var);

T_AVREF_REFCOUNT_FIXED

$arg = newRV_noinc((SV*)$var);

T_HVREF

$arg = newRV((SV*)$var);

T_HVREF_REFCOUNT_FIXED

$arg = newRV_noinc((SV*)$var);

T_CVREF

$arg = newRV((SV*)$var);

T_CVREF_REFCOUNT_FIXED

$arg = newRV_noinc((SV*)$var);

T_IV

sv_setiv($arg, (IV)$var);

T_UV

sv_setuv($arg, (UV)$var);

T_INT

sv_setiv($arg, (IV)$var);

T_SYSRET

if ($var != -1) {

if ($var == 0)

sv_setpvn($arg, "0 but true", 10);

else

sv_setiv($arg, (IV)$var);

}

T_ENUM

sv_setiv($arg, (IV)$var);

T_BOOL

${"$var" eq "RETVAL" ? \"$arg = boolSV($var);" : \"sv_setsv($arg, boolSV($var));"}

T_U_INT

sv_setuv($arg, (UV)$var);

T_SHORT

sv_setiv($arg, (IV)$var);

T_U_SHORT

sv_setuv($arg, (UV)$var);

T_LONG

sv_setiv($arg, (IV)$var);

T_U_LONG

sv_setuv($arg, (UV)$var);

T_CHAR

sv_setpvn($arg, (char *)&$var, 1);

T_U_CHAR

sv_setuv($arg, (UV)$var);

T_FLOAT

sv_setnv($arg, (double)$var);

T_NV

sv_setnv($arg, (NV)$var);

T_DOUBLE

sv_setnv($arg, (double)$var);

T_PV

sv_setpv((SV*)$arg, $var);

T_PTR

sv_setiv($arg, PTR2IV($var));

T_PTRREF

sv_setref_pv($arg, Nullch, (void*)$var);

T_REF_IV_REF

sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));

T_REF_IV_PTR

sv_setref_pv($arg, \"${ntype}\", (void*)$var);

T_PTROBJ

sv_setref_pv($arg, \"${ntype}\", (void*)$var);

T_PTRDESC

sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));

T_REFREF

NOT_IMPLEMENTED

T_REFOBJ

NOT IMPLEMENTED

T_OPAQUE

sv_setpvn($arg, (char *)&$var, sizeof($var));

T_OPAQUEPTR

sv_setpvn($arg, (char *)$var, sizeof(*$var));

T_PACKED

XS_pack_$ntype($arg, $var);

T_PACKEDARRAY

XS_pack_$ntype($arg, $var, count_$ntype);

T_ARRAY

{

U32 ix_$var;

SSize_t extend_size =

/* The weird way this is written is because g++ is dumb

* enough to warn "comparison is always false" on something

* like:

*

* sizeof(a) > sizeof(b) && a > B_t_MAX

*

* (where the LH condition is false)

*/

(size_$var > (sizeof(size_$var) > sizeof(SSize_t)

? SSize_t_MAX : size_$var))

? -1 : (SSize_t)size_$var;

EXTEND(SP, extend_size);

for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {

ST(ix_$var) = sv_newmortal();

DO_ARRAY_ELEM

}

}

T_STDIO

{

GV *gv = (GV *)sv_newmortal();

PerlIO *fp = PerlIO_importFILE($var,0);

gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);

if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) {

SV *rv = newRV_inc((SV*)gv);

rv = sv_bless(rv, GvSTASH(gv));

${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"

: \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}

}${"$var" ne "RETVAL" ? \"

else

sv_setsv($arg, &PL_sv_undef);\n" : \""}

}

T_IN

{

GV *gv = (GV *)sv_newmortal();

gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);

if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) {

SV *rv = newRV_inc((SV*)gv);

rv = sv_bless(rv, GvSTASH(gv));

${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"

: \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}

}${"$var" ne "RETVAL" ? \"

else

sv_setsv($arg, &PL_sv_undef);\n" : \""}

}

T_INOUT

{

GV *gv = (GV *)sv_newmortal();

gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);

if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) {

SV *rv = newRV_inc((SV*)gv);

rv = sv_bless(rv, GvSTASH(gv));

${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"

: \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}

}${"$var" ne "RETVAL" ? \"

else

sv_setsv($arg, &PL_sv_undef);\n" : \""}

}

T_OUT

{

GV *gv = (GV *)sv_newmortal();

gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);

if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) {

SV *rv = newRV_inc((SV*)gv);

rv = sv_bless(rv, GvSTASH(gv));

${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"

: \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}

}${"$var" ne "RETVAL" ? \"

else

sv_setsv($arg, &PL_sv_undef);\n" : \""}

}