tools/HTMesh-0.01/perlobject.map

0001 # "perlobject.map"  Dean Roehrich, version 19960302
0002 #
0003 # TYPEMAPs
0004 #
0005 # HV *          -> unblessed Perl HV object.
0006 # AV *          -> unblessed Perl AV object.
0007 #
0008 # INPUT/OUTPUT maps
0009 #
0010 # O_*           -> opaque blessed objects
0011 # T_*           -> opaque blessed or unblessed objects
0012 #
0013 # O_OBJECT      -> link an opaque C or C++ object to a blessed Perl object.
0014 # T_OBJECT      -> link an opaque C or C++ object to an unblessed Perl object.
0015 # O_HvRV        -> a blessed Perl HV object.
0016 # T_HvRV        -> an unblessed Perl HV object.
0017 # O_AvRV        -> a blessed Perl AV object.
0018 # T_AvRV        -> an unblessed Perl AV object.
0019
0020 TYPEMAP
0021
0022 HV *            T_HvRV
0023 AV *            T_AvRV
0024
0025
0026 ######################################################################
0027 OUTPUT
0028
0029 # The Perl object is blessed into 'CLASS', which should be a
0030 # char* having the name of the package for the blessing.
0031 O_OBJECT
0032         sv_setref_pv( $arg, CLASS, (void*)$var );
0033
0034 T_OBJECT
0035         sv_setref_pv( $arg, Nullch, (void*)$var );
0036
0037 # Cannot use sv_setref_pv() because that will destroy
0038 # the HV-ness of the object.  Remember that newRV() will increment
0039 # the refcount.
0040 O_HvRV
0041         $arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );
0042
0043 T_HvRV
0044         $arg = newRV((SV*)$var);
0045
0046 # Cannot use sv_setref_pv() because that will destroy
0047 # the AV-ness of the object.  Remember that newRV() will increment
0048 # the refcount.
0049 O_AvRV
0050         $arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );
0051
0052 T_AvRV
0053         $arg = newRV((SV*)$var);
0054
0055
0056 ######################################################################
0057 INPUT
0058
0059 O_OBJECT
0060         if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
0061                 $var = ($type)SvIV((SV*)SvRV( $arg ));
0062         else{
0063                 warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
0064                 XSRETURN_UNDEF;
0065         }
0066
0067 T_OBJECT
0068         if( SvROK($arg) )
0069                 $var = ($type)SvIV((SV*)SvRV( $arg ));
0070         else{
0071                 warn( \"${Package}::$func_name() -- $var is not an SV reference\" );
0072                 XSRETURN_UNDEF;
0073         }
0074
0075 O_HvRV
0076         if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )
0077                 $var = (HV*)SvRV( $arg );
0078         else {
0079                 warn( \"${Package}::$func_name() -- $var is not a blessed HV reference\" );
0080                 XSRETURN_UNDEF;
0081         }
0082
0083 T_HvRV
0084         if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )
0085                 $var = (HV*)SvRV( $arg );
0086         else {
0087                 warn( \"${Package}::$func_name() -- $var is not an HV reference\" );
0088                 XSRETURN_UNDEF;
0089         }
0090
0091 O_AvRV
0092         if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )
0093                 $var = (AV*)SvRV( $arg );
0094         else {
0095                 warn( \"${Package}::$func_name() -- $var is not a blessed AV reference\" );
0096                 XSRETURN_UNDEF;
0097         }
0098
0099 T_AvRV
0100         if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )
0101                 $var = (AV*)SvRV( $arg );
0102         else {
0103                 warn( \"${Package}::$func_name() -- $var is not an AV reference\" );
0104                 XSRETURN_UNDEF;
0105         }
0106