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