-# $Header$
# basic C types
int T_IV
-unsigned T_IV
-unsigned int T_IV
+unsigned T_UV
+unsigned int T_UV
long T_IV
-unsigned long T_IV
+unsigned long T_UV
short T_IV
-unsigned short T_IV
+unsigned short T_UV
char T_CHAR
unsigned char T_U_CHAR
char * T_PV
CV * T_CVREF
IV T_IV
+UV T_UV
I32 T_IV
I16 T_IV
I8 T_IV
U32 T_U_LONG
U16 T_U_SHORT
-U8 T_IV
+U8 T_UV
Result T_U_CHAR
Boolean T_IV
double T_DOUBLE
SysRet T_SYSRET
SysRetLong T_SYSRET
-FILE * T_IN
+FILE * T_STDIO
+PerlIO * T_INOUT
FileHandle T_PTROBJ
InputStream T_IN
InOutStream T_INOUT
if (sv_isa($arg, \"${ntype}\"))
$var = (SV*)SvRV($arg);
else
- croak(\"$var is not of type ${ntype}\")
+ Perl_croak(aTHX_ \"$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}\")
+ Perl_croak(aTHX_ \"$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}\")
+ Perl_croak(aTHX_ \"$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}\")
+ Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
T_SYSRET
$var NOT IMPLEMENTED
+T_UV
+ $var = ($type)SvUV($arg)
T_IV
$var = ($type)SvIV($arg)
T_INT
T_BOOL
$var = (int)SvIV($arg)
T_U_INT
- $var = (unsigned int)SvIV($arg)
+ $var = (unsigned int)SvUV($arg)
T_SHORT
$var = (short)SvIV($arg)
T_U_SHORT
- $var = (unsigned short)SvIV($arg)
+ $var = (unsigned short)SvUV($arg)
T_LONG
$var = (long)SvIV($arg)
T_U_LONG
- $var = (unsigned long)SvIV($arg)
+ $var = (unsigned long)SvUV($arg)
T_CHAR
$var = (char)*SvPV($arg,PL_na)
T_U_CHAR
- $var = (unsigned char)SvIV($arg)
+ $var = (unsigned char)SvUV($arg)
T_FLOAT
$var = (float)SvNV($arg)
T_NV
T_PV
$var = ($type)SvPV($arg,PL_na)
T_PTR
- $var = ($type)SvIV($arg)
+ $var = INT2PTR($type,SvIV($arg))
T_PTRREF
if (SvROK($arg)) {
IV tmp = SvIV((SV*)SvRV($arg));
- $var = ($type) tmp;
+ $var = INT2PTR($type,tmp);
}
else
- croak(\"$var is not a reference\")
+ Perl_croak(aTHX_ \"$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}\")
+ Perl_croak(aTHX_ \"$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}\")
+ Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
T_PTROBJ
if (sv_derived_from($arg, \"${ntype}\")) {
IV tmp = SvIV((SV*)SvRV($arg));
- $var = ($type) tmp;
+ $var = INT2PTR($type,tmp);
}
else
- croak(\"$var is not of type ${ntype}\")
+ Perl_croak(aTHX_ \"$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;
+ ${type}_desc = (\U${type}_DESC\E*) tmp;
$var = ${type}_desc->ptr;
}
else
- croak(\"$var is not of type ${ntype}\")
+ Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
T_REFREF
if (SvROK($arg)) {
IV tmp = SvIV((SV*)SvRV($arg));
- $var = *($type) tmp;
+ $var = *INT2PTR($type,tmp);
}
else
- croak(\"$var is not a reference\")
+ Perl_croak(aTHX_ \"$var is not a reference\")
T_REFOBJ
if (sv_isa($arg, \"${ntype}\")) {
IV tmp = SvIV((SV*)SvRV($arg));
- $var = *($type) tmp;
+ $var = *INT2PTR($type,tmp);
}
else
- croak(\"$var is not of type ${ntype}\")
+ Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
T_OPAQUE
$var NOT IMPLEMENTED
T_OPAQUEPTR
while (items--) {
DO_ARRAY_ELEM;
}
+T_STDIO
+ $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
T_IN
$var = IoIFP(sv_2io($arg))
T_INOUT
$arg = newRV((SV*)$var);
T_IV
sv_setiv($arg, (IV)$var);
+T_UV
+ sv_setuv($arg, (UV)$var);
T_INT
sv_setiv($arg, (IV)$var);
T_SYSRET
T_BOOL
$arg = boolSV($var);
T_U_INT
- sv_setiv($arg, (IV)$var);
+ sv_setuv($arg, (UV)$var);
T_SHORT
sv_setiv($arg, (IV)$var);
T_U_SHORT
- sv_setiv($arg, (IV)$var);
+ sv_setuv($arg, (UV)$var);
T_LONG
sv_setiv($arg, (IV)$var);
T_U_LONG
- sv_setiv($arg, (IV)$var);
+ sv_setuv($arg, (UV)$var);
T_CHAR
sv_setpvn($arg, (char *)&$var, 1);
T_U_CHAR
- sv_setiv($arg, (IV)$var);
+ sv_setuv($arg, (UV)$var);
T_FLOAT
sv_setnv($arg, (double)$var);
T_NV
- sv_setnv($arg, (double)$var);
+ sv_setnv($arg, (NV)$var);
T_DOUBLE
sv_setnv($arg, (double)$var);
T_PV
sv_setpv((SV*)$arg, $var);
T_PTR
- sv_setiv($arg, (IV)$var);
+ sv_setiv($arg, PTR2IV($var));
T_PTRREF
sv_setref_pv($arg, Nullch, (void*)$var);
T_REF_IV_REF
T_OPAQUE
sv_setpvn($arg, (char *)&$var, sizeof($var));
T_OPAQUEPTR
- sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
+ sv_setpvn($arg, (char *)$var, sizeof(*$var));
T_PACKED
XS_pack_$ntype($arg, $var);
T_PACKEDARRAY
DO_ARRAY_ELEM
}
SP += $var.size - 1;
+T_STDIO
+ {
+ GV *gv = newGVgen("$Package");
+ PerlIO *fp = PerlIO_importFILE($var,0);
+ if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
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 = &sv_undef;
+ $arg = &PL_sv_undef;
}
T_INOUT
{
if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
else
- $arg = &sv_undef;
+ $arg = &PL_sv_undef;
}
T_OUT
{
if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
else
- $arg = &sv_undef;
+ $arg = &PL_sv_undef;
}