-# $Header$
# basic C types
int T_IV
unsigned T_UV
unsigned char T_U_CHAR
char * T_PV
unsigned char * T_PV
+const char * T_PV
caddr_t T_PV
wchar_t * T_PV
wchar_t T_IV
IV T_IV
UV T_UV
+NV T_NV
I32 T_IV
I16 T_IV
I8 T_IV
+STRLEN T_IV
U32 T_U_LONG
U16 T_U_SHORT
U8 T_UV
Result T_U_CHAR
-Boolean T_IV
+Boolean T_BOOL
+float T_FLOAT
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
T_SV
$var = $arg
T_SVREF
- if (sv_isa($arg, \"${ntype}\"))
+ if (SvROK($arg))
$var = (SV*)SvRV($arg);
else
- croak(\"$var is not of type ${ntype}\")
+ Perl_croak(aTHX_ \"$var is not a reference\")
T_AVREF
- if (sv_isa($arg, \"${ntype}\"))
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
$var = (AV*)SvRV($arg);
else
- croak(\"$var is not of type ${ntype}\")
+ Perl_croak(aTHX_ \"$var is not an array reference\")
T_HVREF
- if (sv_isa($arg, \"${ntype}\"))
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV)
$var = (HV*)SvRV($arg);
else
- croak(\"$var is not of type ${ntype}\")
+ Perl_croak(aTHX_ \"$var is not a hash reference\")
T_CVREF
- if (sv_isa($arg, \"${ntype}\"))
+ if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV)
$var = (CV*)SvRV($arg);
else
- croak(\"$var is not of type ${ntype}\")
+ Perl_croak(aTHX_ \"$var is not a code reference\")
T_SYSRET
$var NOT IMPLEMENTED
T_UV
T_ENUM
$var = ($type)SvIV($arg)
T_BOOL
- $var = (int)SvIV($arg)
+ $var = (bool)SvTRUE($arg)
T_U_INT
$var = (unsigned int)SvUV($arg)
T_SHORT
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;
+ $var = *INT2PTR($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}\")) {
+ 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_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
T_CALLBACK
$var = make_perl_cb_$type($arg)
T_ARRAY
- $var = $ntype(items -= $argoff);
U32 ix_$var = $argoff;
+ $var = $ntype(items -= $argoff);
while (items--) {
DO_ARRAY_ELEM;
+ ix_$var++;
}
+ /* this is the number of elements in the array */
+ ix_$var -= $argoff
+T_STDIO
+ $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
T_IN
$var = IoIFP(sv_2io($arg))
T_INOUT
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_PTRDESC
sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
T_REFREF
- sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
- ($var ? (void*)new $ntype($var) : 0));
+ NOT_IMPLEMENTED
T_REFOBJ
NOT IMPLEMENTED
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
sv_setpvn($arg, $var.context.value().chp(),
$var.context.value().size());
T_ARRAY
- ST_EXTEND($var.size);
- for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
+ {
+ U32 ix_$var;
+ EXTEND(SP,size_$var);
+ for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
ST(ix_$var) = sv_newmortal();
DO_ARRAY_ELEM
+ }
+ }
+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;
}
- SP += $var.size - 1;
T_IN
{
GV *gv = newGVgen("$Package");