Commit | Line | Data |
7c86a28a |
1 | # "perlobject.map" Dean Roehrich, version 19960302 |
2 | # |
3 | # TYPEMAPs |
4 | # |
5 | # HV * -> unblessed Perl HV object. |
6 | # AV * -> unblessed Perl AV object. |
7 | # |
8 | # INPUT/OUTPUT maps |
9 | # |
10 | # O_* -> opaque blessed objects |
11 | # T_* -> opaque blessed or unblessed objects |
12 | # |
13 | # O_OBJECT -> link an opaque C or C++ object to a blessed Perl object. |
14 | # T_OBJECT -> link an opaque C or C++ object to an unblessed Perl object. |
15 | # O_HvRV -> a blessed Perl HV object. |
16 | # T_HvRV -> an unblessed Perl HV object. |
17 | # O_AvRV -> a blessed Perl AV object. |
18 | # T_AvRV -> an unblessed Perl AV object. |
19 | |
20 | TYPEMAP |
21 | |
22 | HV * T_HvRV |
23 | AV * T_AvRV |
24 | |
25 | |
26 | ###################################################################### |
27 | OUTPUT |
28 | |
29 | # The Perl object is blessed into 'CLASS', which should be a |
30 | # char* having the name of the package for the blessing. |
31 | O_OBJECT |
32 | sv_setref_pv( $arg, CLASS, (void*)$var ); |
33 | |
34 | T_OBJECT |
35 | sv_setref_pv( $arg, Nullch, (void*)$var ); |
36 | |
37 | # Cannot use sv_setref_pv() because that will destroy |
38 | # the HV-ness of the object. Remember that newRV() will increment |
39 | # the refcount. |
40 | O_HvRV |
41 | $arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) ); |
42 | |
43 | T_HvRV |
44 | $arg = newRV((SV*)$var); |
45 | |
46 | # Cannot use sv_setref_pv() because that will destroy |
47 | # the AV-ness of the object. Remember that newRV() will increment |
48 | # the refcount. |
49 | O_AvRV |
50 | $arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) ); |
51 | |
52 | T_AvRV |
53 | $arg = newRV((SV*)$var); |
54 | |
55 | |
56 | ###################################################################### |
57 | INPUT |
58 | |
59 | O_OBJECT |
60 | if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) |
61 | $var = ($type)SvIV((SV*)SvRV( $arg )); |
62 | else{ |
63 | warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" ); |
64 | XSRETURN_UNDEF; |
65 | } |
66 | |
67 | T_OBJECT |
68 | if( SvROK($arg) ) |
69 | $var = ($type)SvIV((SV*)SvRV( $arg )); |
70 | else{ |
71 | warn( \"${Package}::$func_name() -- $var is not an SV reference\" ); |
72 | XSRETURN_UNDEF; |
73 | } |
74 | |
75 | O_HvRV |
76 | if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) ) |
77 | $var = (HV*)SvRV( $arg ); |
78 | else { |
79 | warn( \"${Package}::$func_name() -- $var is not a blessed HV reference\" ); |
80 | XSRETURN_UNDEF; |
81 | } |
82 | |
83 | T_HvRV |
84 | if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) ) |
85 | $var = (HV*)SvRV( $arg ); |
86 | else { |
87 | warn( \"${Package}::$func_name() -- $var is not an HV reference\" ); |
88 | XSRETURN_UNDEF; |
89 | } |
90 | |
91 | O_AvRV |
92 | if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) ) |
93 | $var = (AV*)SvRV( $arg ); |
94 | else { |
95 | warn( \"${Package}::$func_name() -- $var is not a blessed AV reference\" ); |
96 | XSRETURN_UNDEF; |
97 | } |
98 | |
99 | T_AvRV |
100 | if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) ) |
101 | $var = (AV*)SvRV( $arg ); |
102 | else { |
103 | warn( \"${Package}::$func_name() -- $var is not an AV reference\" ); |
104 | XSRETURN_UNDEF; |
105 | } |
106 | |