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