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