aboutsummaryrefslogtreecommitdiffstats
path: root/perlobject.map
blob: 4795c4776b1ab0f5a1a9b4d924f340f2094b96cc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
# "perlobject.map"  Dean Roehrich, version 19960302
#
# TYPEMAPs
#
# HV *		-> unblessed Perl HV object.
# AV *		-> unblessed Perl AV object.
#
# INPUT/OUTPUT maps
#
# O_*		-> opaque blessed objects
# T_*		-> opaque blessed or unblessed objects
#
# O_OBJECT	-> link an opaque C or C++ object to a blessed Perl object.
# T_OBJECT	-> link an opaque C or C++ object to an unblessed Perl object.
# O_HvRV	-> a blessed Perl HV object.
# T_HvRV	-> an unblessed Perl HV object.
# O_AvRV	-> a blessed Perl AV object.
# T_AvRV	-> an unblessed Perl AV object.

TYPEMAP

HV *		T_HvRV
AV *		T_AvRV


######################################################################
OUTPUT

# The Perl object is blessed into 'CLASS', which should be a
# char* having the name of the package for the blessing.
O_OBJECT
	sv_setref_pv( $arg, CLASS, (void*)$var );

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

# Cannot use sv_setref_pv() because that will destroy
# the HV-ness of the object.  Remember that newRV() will increment
# the refcount.
O_HvRV
	$arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );

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

# Cannot use sv_setref_pv() because that will destroy
# the AV-ness of the object.  Remember that newRV() will increment
# the refcount.
O_AvRV
	$arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );

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


######################################################################
INPUT

O_OBJECT
	if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
		$var = ($type)SvIV((SV*)SvRV( $arg ));
	else{
		warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
		XSRETURN_UNDEF;
	}

T_OBJECT
	if( SvROK($arg) )
		$var = ($type)SvIV((SV*)SvRV( $arg ));
	else{
		warn( \"${Package}::$func_name() -- $var is not an SV reference\" );
		XSRETURN_UNDEF;
	}

O_HvRV
	if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )
		$var = (HV*)SvRV( $arg );
	else {
		warn( \"${Package}::$func_name() -- $var is not a blessed HV reference\" );
		XSRETURN_UNDEF;
	}

T_HvRV
	if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )
		$var = (HV*)SvRV( $arg );
	else {
		warn( \"${Package}::$func_name() -- $var is not an HV reference\" );
		XSRETURN_UNDEF;
	}

O_AvRV
	if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )
		$var = (AV*)SvRV( $arg );
	else {
		warn( \"${Package}::$func_name() -- $var is not a blessed AV reference\" );
		XSRETURN_UNDEF;
	}

T_AvRV
	if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )
		$var = (AV*)SvRV( $arg );
	else {
		warn( \"${Package}::$func_name() -- $var is not an AV reference\" );
		XSRETURN_UNDEF;
	}