typemap.win32

UNIX下perl实现代码

JavaVM *		T_JPTROBJ
JNINativeMethod *	T_JPTROBJ
const char *		T_PV
const jbyte *		T_JMEM
const jchar *		T_JMEM
jarray			T_JPTROBJ
jboolean		T_IV
jboolean *		T_JMEM
jbooleanArray		T_JPTROBJ
jbyte			T_IV
jbyte *			T_JMEM
jbyteArray		T_JPTROBJ
jchar			T_IV
jchar *			T_JMEM
jcharArray		T_JPTROBJ
jclass			T_JPTROBJ
jdouble			T_NV
jdouble *		T_JMEM
jdoubleArray		T_JPTROBJ
jfieldID		T_JIDSIG
jfloat			T_NV
jfloat *		T_JMEM
jfloatArray		T_JPTROBJ
jint			T_IV
jint *			T_JMEM
jintArray		T_JPTROBJ
jlong			T_NV
jlong *			T_JMEM
jlongArray		T_JPTROBJ
jmethodID		T_JIDSIG
jobject			T_JPTROBJ
jobjectArray		T_JPTROBJ
jshort			T_IV
jshort *		T_JMEM
jshortArray		T_JPTROBJ
jsize			T_IV
jstring			T_JSTRING
jthrowable		T_JPTROBJ
jvalue *		T_JVALUELIST

INPUT
T_JMEM
	{
	    $var = ($type)SvPV($arg,tmplen);
	    ${var}_len_ = (jsize) tmplen / sizeof(${subtype});
	}
T_JSTRING
	if (SvROK($arg)) {
	    $var = ($type)(void*)SvIV(SvRV($arg));
	}
	else
	    $var = ($type)env->NewStringUTF((char *) SvPV($arg,PL_na))
T_JVALUELIST
	if (SvROK($arg)) {
	    AV* av = (AV*)SvRV($arg);
	    if (SvTYPE(av) == SVt_PVAV) {
		I32 maxarg = AvFILL(av) + 1;
		$var = makeargs(sig, AvARRAY(av), maxarg);
	    }
	    else
		croak(\"$var is not an array reference\");
	}
	else
	    croak(\"$var is not a reference\")
T_JIDSIG
	{
	    $var = ($type)SvIV($arg);
	    sig = (char*)SvPV($arg,PL_na);
	}
T_JPTROBJ
	if (SvROK($arg) && SvOBJECT(SvRV($arg))) {
	    IV tmp = SvIV((SV*)SvRV($arg));
	    $var = ($type) tmp;
	}
	else
	    croak(\"$var is not of type ${ntype}\")

OUTPUT
T_JMEM
	sv_setpvn((SV*)$arg, (char*)$var, (STRLEN)${var}_len_ * sizeof(${subtype}));
T_JSTRING
	{
	    static HV* ${var}_stashhv_ = 0;
	    if (!${var}_stashhv_)
		${var}_stashhv_ = gv_stashpv("java::lang::String", TRUE);
	 
	    sv_bless(
		sv_setref_iv($arg, Nullch, (IV)(void*)${var}),
		${var}_stashhv_);
 
	}
T_JIDSIG
	sv_setiv($arg, (IV)(void*)$var);
	sv_setpv($arg, (char*)sig);
	SvIOK_on($arg);
T_JPTROBJ
	sv_setref_pv($arg, \"${ntype}\", (void*)$var);

# basic C types
#	int			T_IV
#	unsigned		T_IV
#	unsigned int		T_IV
#	long			T_IV
#	unsigned long		T_IV
#	short			T_IV
#	unsigned short		T_IV
#	char			T_CHAR
#	unsigned char		T_U_CHAR
#	char *			T_PV
#	unsigned char *		T_PV
#	caddr_t			T_PV
#	wchar_t *		T_PV
#	wchar_t			T_IV
#	bool_t			T_IV
#	size_t			T_IV
#	ssize_t			T_IV
#	time_t			T_NV
#	unsigned long *		T_OPAQUEPTR
#	char **			T_PACKED
#	void *			T_PTR
#	Time_t *		T_PV
#	SV *			T_SV
#	SVREF			T_SVREF
#	AV *			T_AVREF
#	HV *			T_HVREF
#	CV *			T_CVREF
#	
#	IV			T_IV
#	I32			T_IV
#	I16			T_IV
#	I8			T_IV
#	U32			T_U_LONG
#	U16			T_U_SHORT
#	U8			T_IV
#	Result			T_U_CHAR
#	Boolean			T_IV
#	double			T_DOUBLE
#	SysRet			T_SYSRET
#	SysRetLong		T_SYSRET
#	FILE *			T_IN
#	FileHandle		T_PTROBJ
#	InputStream		T_IN
#	InOutStream		T_INOUT
#	OutputStream		T_OUT
#	bool			T_BOOL
#
#############################################################################
#	INPUT
#	T_SV
#		$var = $arg
#	T_SVREF
#		if (sv_isa($arg, \"${ntype}\"))
#		    $var = (SV*)SvRV($arg);
#		else
#		    croak(\"$var is not of type ${ntype}\")
#	T_AVREF
#		if (sv_isa($arg, \"${ntype}\"))
#		    $var = (AV*)SvRV($arg);
#		else
#		    croak(\"$var is not of type ${ntype}\")
#	T_HVREF
#		if (sv_isa($arg, \"${ntype}\"))
#		    $var = (HV*)SvRV($arg);
#		else
#		    croak(\"$var is not of type ${ntype}\")
#	T_CVREF
#		if (sv_isa($arg, \"${ntype}\"))
#		    $var = (CV*)SvRV($arg);
#		else
#		    croak(\"$var is not of type ${ntype}\")
#	T_SYSRET
#		$var NOT IMPLEMENTED
#	T_IV
#		$var = ($type)SvIV($arg)
#	T_INT
#		$var = (int)SvIV($arg)
#	T_ENUM
#		$var = ($type)SvIV($arg)
#	T_BOOL
#		$var = (int)SvIV($arg)
#	T_U_INT
#		$var = (unsigned int)SvIV($arg)
#	T_SHORT
#		$var = (short)SvIV($arg)
#	T_U_SHORT
#		$var = (unsigned short)SvIV($arg)
#	T_LONG
#		$var = (long)SvIV($arg)
#	T_U_LONG
#		$var = (unsigned long)SvIV($arg)
#	T_CHAR
#		$var = (char)*SvPV($arg,PL_na)
#	T_U_CHAR
#		$var = (unsigned char)SvIV($arg)
#	T_FLOAT
#		$var = (float)SvNV($arg)
#	T_NV
#		$var = ($type)SvNV($arg)
#	T_DOUBLE
#		$var = (double)SvNV($arg)
#	T_PV
#		$var = ($type)SvPV($arg,PL_na)
#	T_PTR
#		$var = ($type)SvIV($arg)
#	T_PTRREF
#		if (SvROK($arg)) {
#		    IV tmp = SvIV((SV*)SvRV($arg));
#		    $var = ($type) tmp;
#		}
#		else
#		    croak(\"$var is not a reference\")
#	T_REF_IV_REF
#		if (sv_isa($arg, \"${type}\")) {
#		    IV tmp = SvIV((SV*)SvRV($arg));
#		    $var = *($type *) tmp;
#		}
#		else
#		    croak(\"$var is not of type ${ntype}\")
#	T_REF_IV_PTR
#		if (sv_isa($arg, \"${type}\")) {
#		    IV tmp = SvIV((SV*)SvRV($arg));
#		    $var = ($type) tmp;
#		}
#		else
#		    croak(\"$var is not of type ${ntype}\")
#	T_PTROBJ
#		if (sv_derived_from($arg, \"${ntype}\")) {
#		    IV tmp = SvIV((SV*)SvRV($arg));
#		    $var = ($type) tmp;
#		}
#		else
#		    croak(\"$var is not of type ${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
#		    croak(\"$var is not of type ${ntype}\")
#	T_REFREF
#		if (SvROK($arg)) {
#		    IV tmp = SvIV((SV*)SvRV($arg));
#		    $var = *($type) tmp;
#		}
#		else
#		    croak(\"$var is not a reference\")
#	T_REFOBJ
#		if (sv_isa($arg, \"${ntype}\")) {
#		    IV tmp = SvIV((SV*)SvRV($arg));
#		    $var = *($type) tmp;
#		}
#		else
#		    croak(\"$var is not of type ${ntype}\")
#	T_OPAQUE
#		$var NOT IMPLEMENTED
#	T_OPAQUEPTR
#		$var = ($type)SvPV($arg,PL_na)
#	T_PACKED
#		$var = XS_unpack_$ntype($arg)
#	T_PACKEDARRAY
#		$var = XS_unpack_$ntype($arg)
#	T_CALLBACK
#		$var = make_perl_cb_$type($arg)
#	T_ARRAY
#		$var = $ntype(items -= $argoff);
#		U32 ix_$var = $argoff;
#		while (items--) {
#		    DO_ARRAY_ELEM;
#		}
#	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_AVREF
#		$arg = newRV((SV*)$var);
#	T_HVREF
#		$arg = newRV((SV*)$var);
#	T_CVREF
#		$arg = newRV((SV*)$var);
#	T_IV
#		sv_setiv($arg, (IV)$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
#		$arg = boolSV($var);
#	T_U_INT
#		sv_setiv($arg, (IV)$var);
#	T_SHORT
#		sv_setiv($arg, (IV)$var);
#	T_U_SHORT
#		sv_setiv($arg, (IV)$var);
#	T_LONG
#		sv_setiv($arg, (IV)$var);
#	T_U_LONG
#		sv_setiv($arg, (IV)$var);
#	T_CHAR
#		sv_setpvn($arg, (char *)&$var, 1);
#	T_U_CHAR
#		sv_setiv($arg, (IV)$var);
#	T_FLOAT
#		sv_setnv($arg, (double)$var);
#	T_NV
#		sv_setnv($arg, (double)$var);
#	T_DOUBLE
#		sv_setnv($arg, (double)$var);
#	T_PV
#		sv_setpv((SV*)$arg, $var);
#	T_PTR
#		sv_setiv($arg, (IV)$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
#		sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
#			    ($var ? (void*)new $ntype($var) : 0));
#	T_REFOBJ
#		NOT IMPLEMENTED
#	T_OPAQUE
#		sv_setpvn($arg, (char *)&$var, sizeof($var));
#	T_OPAQUEPTR
#		sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
#	T_PACKED
#		XS_pack_$ntype($arg, $var);
#	T_PACKEDARRAY
#		XS_pack_$ntype($arg, $var, count_$ntype);
#	T_DATAUNIT	
#		sv_setpvn($arg, $var.chp(), $var.size());
#	T_CALLBACK
#		sv_setpvn($arg, $var.context.value().chp(),
#			$var.context.value().size());
#	T_ARRAY
#		ST_EXTEND($var.size);
#		for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
#			ST(ix_$var) = sv_newmortal();
#		DO_ARRAY_ELEM
#		}
#		sp += $var.size - 1;
#	T_IN
#		{
#		    GV *gv = newGVgen("$Package");
#		    if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
#			sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
#		    else
#			$arg = &PL_sv_undef;
#		}
#	T_INOUT
#		{
#		    GV *gv = newGVgen("$Package");
#		    if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
#			sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
#		    else
#			$arg = &PL_sv_undef;
#		}
#	T_OUT
#		{
#		    GV *gv = newGVgen("$Package");
#		    if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
#			sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
#		    else
#			$arg = &PL_sv_undef;
#		}