1# basic C types 2int T_IV 3unsigned T_UV 4unsigned int T_UV 5long T_IV 6unsigned long T_UV 7short T_IV 8unsigned short T_UV 9char T_CHAR 10unsigned char T_U_CHAR 11char * T_PV 12unsigned char * T_PV 13const char * T_PV 14caddr_t T_PV 15wchar_t * T_PV 16wchar_t T_IV 17bool_t T_IV 18size_t T_UV 19ssize_t T_IV 20time_t T_NV 21unsigned long * T_OPAQUEPTR 22char ** T_PACKEDARRAY 23void * T_PTR 24Time_t * T_PV 25SV * T_SV 26SVREF T_SVREF 27AV * T_AVREF 28HV * T_HVREF 29CV * T_CVREF 30 31IV T_IV 32UV T_UV 33NV T_NV 34I32 T_IV 35I16 T_IV 36I8 T_IV 37STRLEN T_UV 38U32 T_U_LONG 39U16 T_U_SHORT 40U8 T_UV 41Result T_U_CHAR 42Boolean T_BOOL 43float T_FLOAT 44double T_DOUBLE 45SysRet T_SYSRET 46SysRetLong T_SYSRET 47FILE * T_STDIO 48PerlIO * T_INOUT 49FileHandle T_PTROBJ 50InputStream T_IN 51InOutStream T_INOUT 52OutputStream T_OUT 53bool T_BOOL 54 55############################################################################# 56INPUT 57T_SV 58 $var = $arg 59T_SVREF 60 if (SvROK($arg)) 61 $var = (SV*)SvRV($arg); 62 else 63 Perl_croak(aTHX_ \"$var is not a reference\") 64T_AVREF 65 if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV) 66 $var = (AV*)SvRV($arg); 67 else 68 Perl_croak(aTHX_ \"$var is not an array reference\") 69T_HVREF 70 if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV) 71 $var = (HV*)SvRV($arg); 72 else 73 Perl_croak(aTHX_ \"$var is not a hash reference\") 74T_CVREF 75 if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV) 76 $var = (CV*)SvRV($arg); 77 else 78 Perl_croak(aTHX_ \"$var is not a code reference\") 79T_SYSRET 80 $var NOT IMPLEMENTED 81T_UV 82 $var = ($type)SvUV($arg) 83T_IV 84 $var = ($type)SvIV($arg) 85T_INT 86 $var = (int)SvIV($arg) 87T_ENUM 88 $var = ($type)SvIV($arg) 89T_BOOL 90 $var = (bool)SvTRUE($arg) 91T_U_INT 92 $var = (unsigned int)SvUV($arg) 93T_SHORT 94 $var = (short)SvIV($arg) 95T_U_SHORT 96 $var = (unsigned short)SvUV($arg) 97T_LONG 98 $var = (long)SvIV($arg) 99T_U_LONG 100 $var = (unsigned long)SvUV($arg) 101T_CHAR 102 $var = (char)*SvPV_nolen($arg) 103T_U_CHAR 104 $var = (unsigned char)SvUV($arg) 105T_FLOAT 106 $var = (float)SvNV($arg) 107T_NV 108 $var = ($type)SvNV($arg) 109T_DOUBLE 110 $var = (double)SvNV($arg) 111T_PV 112 $var = ($type)SvPV_nolen($arg) 113T_PTR 114 $var = INT2PTR($type,SvIV($arg)) 115T_PTRREF 116 if (SvROK($arg)) { 117 IV tmp = SvIV((SV*)SvRV($arg)); 118 $var = INT2PTR($type,tmp); 119 } 120 else 121 Perl_croak(aTHX_ \"$var is not a reference\") 122T_REF_IV_REF 123 if (sv_isa($arg, \"${ntype}\")) { 124 IV tmp = SvIV((SV*)SvRV($arg)); 125 $var = *INT2PTR($type *, tmp); 126 } 127 else 128 Perl_croak(aTHX_ \"$var is not of type ${ntype}\") 129T_REF_IV_PTR 130 if (sv_isa($arg, \"${ntype}\")) { 131 IV tmp = SvIV((SV*)SvRV($arg)); 132 $var = INT2PTR($type, tmp); 133 } 134 else 135 Perl_croak(aTHX_ \"$var is not of type ${ntype}\") 136T_PTROBJ 137 if (sv_derived_from($arg, \"${ntype}\")) { 138 IV tmp = SvIV((SV*)SvRV($arg)); 139 $var = INT2PTR($type,tmp); 140 } 141 else 142 Perl_croak(aTHX_ \"$var is not of type ${ntype}\") 143T_PTRDESC 144 if (sv_isa($arg, \"${ntype}\")) { 145 IV tmp = SvIV((SV*)SvRV($arg)); 146 ${type}_desc = (\U${type}_DESC\E*) tmp; 147 $var = ${type}_desc->ptr; 148 } 149 else 150 Perl_croak(aTHX_ \"$var is not of type ${ntype}\") 151T_REFREF 152 if (SvROK($arg)) { 153 IV tmp = SvIV((SV*)SvRV($arg)); 154 $var = *INT2PTR($type,tmp); 155 } 156 else 157 Perl_croak(aTHX_ \"$var is not a reference\") 158T_REFOBJ 159 if (sv_isa($arg, \"${ntype}\")) { 160 IV tmp = SvIV((SV*)SvRV($arg)); 161 $var = *INT2PTR($type,tmp); 162 } 163 else 164 Perl_croak(aTHX_ \"$var is not of type ${ntype}\") 165T_OPAQUE 166 $var = *($type *)SvPV_nolen($arg) 167T_OPAQUEPTR 168 $var = ($type)SvPV_nolen($arg) 169T_PACKED 170 $var = XS_unpack_$ntype($arg) 171T_PACKEDARRAY 172 $var = XS_unpack_$ntype($arg) 173T_CALLBACK 174 $var = make_perl_cb_$type($arg) 175T_ARRAY 176 U32 ix_$var = $argoff; 177 $var = $ntype(items -= $argoff); 178 while (items--) { 179 DO_ARRAY_ELEM; 180 ix_$var++; 181 } 182 /* this is the number of elements in the array */ 183 ix_$var -= $argoff 184T_STDIO 185 $var = PerlIO_findFILE(IoIFP(sv_2io($arg))) 186T_IN 187 $var = IoIFP(sv_2io($arg)) 188T_INOUT 189 $var = IoIFP(sv_2io($arg)) 190T_OUT 191 $var = IoOFP(sv_2io($arg)) 192############################################################################# 193OUTPUT 194T_SV 195 $arg = $var; 196T_SVREF 197 $arg = newRV((SV*)$var); 198T_AVREF 199 $arg = newRV((SV*)$var); 200T_HVREF 201 $arg = newRV((SV*)$var); 202T_CVREF 203 $arg = newRV((SV*)$var); 204T_IV 205 sv_setiv($arg, (IV)$var); 206T_UV 207 sv_setuv($arg, (UV)$var); 208T_INT 209 sv_setiv($arg, (IV)$var); 210T_SYSRET 211 if ($var != -1) { 212 if ($var == 0) 213 sv_setpvn($arg, "0 but true", 10); 214 else 215 sv_setiv($arg, (IV)$var); 216 } 217T_ENUM 218 sv_setiv($arg, (IV)$var); 219T_BOOL 220 $arg = boolSV($var); 221T_U_INT 222 sv_setuv($arg, (UV)$var); 223T_SHORT 224 sv_setiv($arg, (IV)$var); 225T_U_SHORT 226 sv_setuv($arg, (UV)$var); 227T_LONG 228 sv_setiv($arg, (IV)$var); 229T_U_LONG 230 sv_setuv($arg, (UV)$var); 231T_CHAR 232 sv_setpvn($arg, (char *)&$var, 1); 233T_U_CHAR 234 sv_setuv($arg, (UV)$var); 235T_FLOAT 236 sv_setnv($arg, (double)$var); 237T_NV 238 sv_setnv($arg, (NV)$var); 239T_DOUBLE 240 sv_setnv($arg, (double)$var); 241T_PV 242 sv_setpv((SV*)$arg, $var); 243T_PTR 244 sv_setiv($arg, PTR2IV($var)); 245T_PTRREF 246 sv_setref_pv($arg, Nullch, (void*)$var); 247T_REF_IV_REF 248 sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var)); 249T_REF_IV_PTR 250 sv_setref_pv($arg, \"${ntype}\", (void*)$var); 251T_PTROBJ 252 sv_setref_pv($arg, \"${ntype}\", (void*)$var); 253T_PTRDESC 254 sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var)); 255T_REFREF 256 NOT_IMPLEMENTED 257T_REFOBJ 258 NOT IMPLEMENTED 259T_OPAQUE 260 sv_setpvn($arg, (char *)&$var, sizeof($var)); 261T_OPAQUEPTR 262 sv_setpvn($arg, (char *)$var, sizeof(*$var)); 263T_PACKED 264 XS_pack_$ntype($arg, $var); 265T_PACKEDARRAY 266 XS_pack_$ntype($arg, $var, count_$ntype); 267T_DATAUNIT 268 sv_setpvn($arg, $var.chp(), $var.size()); 269T_CALLBACK 270 sv_setpvn($arg, $var.context.value().chp(), 271 $var.context.value().size()); 272T_ARRAY 273 { 274 U32 ix_$var; 275 EXTEND(SP,size_$var); 276 for (ix_$var = 0; ix_$var < size_$var; ix_$var++) { 277 ST(ix_$var) = sv_newmortal(); 278 DO_ARRAY_ELEM 279 } 280 } 281T_STDIO 282 { 283 GV *gv = newGVgen("$Package"); 284 PerlIO *fp = PerlIO_importFILE($var,0); 285 if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) 286 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); 287 else 288 $arg = &PL_sv_undef; 289 } 290T_IN 291 { 292 GV *gv = newGVgen("$Package"); 293 if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) 294 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); 295 else 296 $arg = &PL_sv_undef; 297 } 298T_INOUT 299 { 300 GV *gv = newGVgen("$Package"); 301 if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) 302 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); 303 else 304 $arg = &PL_sv_undef; 305 } 306T_OUT 307 { 308 GV *gv = newGVgen("$Package"); 309 if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) 310 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); 311 else 312 $arg = &PL_sv_undef; 313 } 314