home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / lib / ExtUtils / typemap < prev    next >
Text File  |  1998-11-26  |  6KB  |  294 lines
  1. # $Header$ 
  2. # basic C types
  3. int            T_IV
  4. unsigned        T_UV
  5. unsigned int        T_UV
  6. long            T_IV
  7. unsigned long        T_UV
  8. short            T_IV
  9. unsigned short        T_UV
  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_UV
  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_UV
  77.     $var = ($type)SvUV($arg)
  78. T_IV
  79.     $var = ($type)SvIV($arg)
  80. T_INT
  81.     $var = (int)SvIV($arg)
  82. T_ENUM
  83.     $var = ($type)SvIV($arg)
  84. T_BOOL
  85.     $var = (int)SvIV($arg)
  86. T_U_INT
  87.     $var = (unsigned int)SvUV($arg)
  88. T_SHORT
  89.     $var = (short)SvIV($arg)
  90. T_U_SHORT
  91.     $var = (unsigned short)SvUV($arg)
  92. T_LONG
  93.     $var = (long)SvIV($arg)
  94. T_U_LONG
  95.     $var = (unsigned long)SvUV($arg)
  96. T_CHAR
  97.     $var = (char)*SvPV($arg,PL_na)
  98. T_U_CHAR
  99.     $var = (unsigned char)SvUV($arg)
  100. T_FLOAT
  101.     $var = (float)SvNV($arg)
  102. T_NV
  103.     $var = ($type)SvNV($arg)
  104. T_DOUBLE
  105.     $var = (double)SvNV($arg)
  106. T_PV
  107.     $var = ($type)SvPV($arg,PL_na)
  108. T_PTR
  109.     $var = ($type)SvIV($arg)
  110. T_PTRREF
  111.     if (SvROK($arg)) {
  112.         IV tmp = SvIV((SV*)SvRV($arg));
  113.         $var = ($type) tmp;
  114.     }
  115.     else
  116.         croak(\"$var is not a reference\")
  117. T_REF_IV_REF
  118.     if (sv_isa($arg, \"${type}\")) {
  119.         IV tmp = SvIV((SV*)SvRV($arg));
  120.         $var = *($type *) tmp;
  121.     }
  122.     else
  123.         croak(\"$var is not of type ${ntype}\")
  124. T_REF_IV_PTR
  125.     if (sv_isa($arg, \"${type}\")) {
  126.         IV tmp = SvIV((SV*)SvRV($arg));
  127.         $var = ($type) tmp;
  128.     }
  129.     else
  130.         croak(\"$var is not of type ${ntype}\")
  131. T_PTROBJ
  132.     if (sv_derived_from($arg, \"${ntype}\")) {
  133.         IV tmp = SvIV((SV*)SvRV($arg));
  134.         $var = ($type) tmp;
  135.     }
  136.     else
  137.         croak(\"$var is not of type ${ntype}\")
  138. T_PTRDESC
  139.     if (sv_isa($arg, \"${ntype}\")) {
  140.         IV tmp = SvIV((SV*)SvRV($arg));
  141.         ${type}_desc = (\U${type}_DESC\E*) tmp; 
  142.         $var = ${type}_desc->ptr;
  143.     }
  144.     else
  145.         croak(\"$var is not of type ${ntype}\")
  146. T_REFREF
  147.     if (SvROK($arg)) {
  148.         IV tmp = SvIV((SV*)SvRV($arg));
  149.         $var = *($type) tmp;
  150.     }
  151.     else
  152.         croak(\"$var is not a reference\")
  153. T_REFOBJ
  154.     if (sv_isa($arg, \"${ntype}\")) {
  155.         IV tmp = SvIV((SV*)SvRV($arg));
  156.         $var = *($type) tmp;
  157.     }
  158.     else
  159.         croak(\"$var is not of type ${ntype}\")
  160. T_OPAQUE
  161.     $var NOT IMPLEMENTED
  162. T_OPAQUEPTR
  163.     $var = ($type)SvPV($arg,PL_na)
  164. T_PACKED
  165.     $var = XS_unpack_$ntype($arg)
  166. T_PACKEDARRAY
  167.     $var = XS_unpack_$ntype($arg)
  168. T_CALLBACK
  169.     $var = make_perl_cb_$type($arg)
  170. T_ARRAY
  171.     $var = $ntype(items -= $argoff);
  172.     U32 ix_$var = $argoff;
  173.     while (items--) {
  174.         DO_ARRAY_ELEM;
  175.     }
  176. T_IN
  177.     $var = IoIFP(sv_2io($arg))
  178. T_INOUT
  179.     $var = IoIFP(sv_2io($arg))
  180. T_OUT
  181.     $var = IoOFP(sv_2io($arg))
  182. #############################################################################
  183. OUTPUT
  184. T_SV
  185.     $arg = $var;
  186. T_SVREF
  187.     $arg = newRV((SV*)$var);
  188. T_AVREF
  189.     $arg = newRV((SV*)$var);
  190. T_HVREF
  191.     $arg = newRV((SV*)$var);
  192. T_CVREF
  193.     $arg = newRV((SV*)$var);
  194. T_IV
  195.     sv_setiv($arg, (IV)$var);
  196. T_UV
  197.     sv_setuv($arg, (UV)$var);
  198. T_INT
  199.     sv_setiv($arg, (IV)$var);
  200. T_SYSRET
  201.     if ($var != -1) {
  202.         if ($var == 0)
  203.         sv_setpvn($arg, "0 but true", 10);
  204.         else
  205.         sv_setiv($arg, (IV)$var);
  206.     }
  207. T_ENUM
  208.     sv_setiv($arg, (IV)$var);
  209. T_BOOL
  210.     $arg = boolSV($var);
  211. T_U_INT
  212.     sv_setuv($arg, (UV)$var);
  213. T_SHORT
  214.     sv_setiv($arg, (IV)$var);
  215. T_U_SHORT
  216.     sv_setuv($arg, (UV)$var);
  217. T_LONG
  218.     sv_setiv($arg, (IV)$var);
  219. T_U_LONG
  220.     sv_setuv($arg, (UV)$var);
  221. T_CHAR
  222.     sv_setpvn($arg, (char *)&$var, 1);
  223. T_U_CHAR
  224.     sv_setuv($arg, (UV)$var);
  225. T_FLOAT
  226.     sv_setnv($arg, (double)$var);
  227. T_NV
  228.     sv_setnv($arg, (double)$var);
  229. T_DOUBLE
  230.     sv_setnv($arg, (double)$var);
  231. T_PV
  232.     sv_setpv((SV*)$arg, $var);
  233. T_PTR
  234.     sv_setiv($arg, (IV)$var);
  235. T_PTRREF
  236.     sv_setref_pv($arg, Nullch, (void*)$var);
  237. T_REF_IV_REF
  238.     sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
  239. T_REF_IV_PTR
  240.     sv_setref_pv($arg, \"${ntype}\", (void*)$var);
  241. T_PTROBJ
  242.     sv_setref_pv($arg, \"${ntype}\", (void*)$var);
  243. T_PTRDESC
  244.     sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
  245. T_REFREF
  246.     sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
  247.             ($var ? (void*)new $ntype($var) : 0));
  248. T_REFOBJ
  249.     NOT IMPLEMENTED
  250. T_OPAQUE
  251.     sv_setpvn($arg, (char *)&$var, sizeof($var));
  252. T_OPAQUEPTR
  253.     sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
  254. T_PACKED
  255.     XS_pack_$ntype($arg, $var);
  256. T_PACKEDARRAY
  257.     XS_pack_$ntype($arg, $var, count_$ntype);
  258. T_DATAUNIT    
  259.     sv_setpvn($arg, $var.chp(), $var.size());
  260. T_CALLBACK
  261.     sv_setpvn($arg, $var.context.value().chp(),
  262.         $var.context.value().size());
  263. T_ARRAY
  264.     ST_EXTEND($var.size);
  265.     for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
  266.         ST(ix_$var) = sv_newmortal();
  267.     DO_ARRAY_ELEM
  268.     }
  269.     SP += $var.size - 1;
  270. T_IN
  271.     {
  272.         GV *gv = newGVgen("$Package");
  273.         if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
  274.         sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
  275.         else
  276.         $arg = &PL_sv_undef;
  277.     }
  278. T_INOUT
  279.     {
  280.         GV *gv = newGVgen("$Package");
  281.         if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
  282.         sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
  283.         else
  284.         $arg = &PL_sv_undef;
  285.     }
  286. T_OUT
  287.     {
  288.         GV *gv = newGVgen("$Package");
  289.         if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
  290.         sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
  291.         else
  292.         $arg = &PL_sv_undef;
  293.     }
  294.