This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[patch] typemap =~ s/croak/Perl_croak/
[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 caddr_t                 T_PV
14 wchar_t *               T_PV
15 wchar_t                 T_IV
16 bool_t                  T_IV
17 size_t                  T_IV
18 ssize_t                 T_IV
19 time_t                  T_NV
20 unsigned long *         T_OPAQUEPTR
21 char **                 T_PACKED
22 void *                  T_PTR
23 Time_t *                T_PV
24 SV *                    T_SV
25 SVREF                   T_SVREF
26 AV *                    T_AVREF
27 HV *                    T_HVREF
28 CV *                    T_CVREF
29
30 IV                      T_IV
31 UV                      T_UV
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             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
59 T_AVREF
60         if (sv_isa($arg, \"${ntype}\"))
61             $var = (AV*)SvRV($arg);
62         else
63             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
64 T_HVREF
65         if (sv_isa($arg, \"${ntype}\"))
66             $var = (HV*)SvRV($arg);
67         else
68             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
69 T_CVREF
70         if (sv_isa($arg, \"${ntype}\"))
71             $var = (CV*)SvRV($arg);
72         else
73             Perl_croak(aTHX_ \"$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 = INT2PTR($type,SvIV($arg))
110 T_PTRREF
111         if (SvROK($arg)) {
112             IV tmp = SvIV((SV*)SvRV($arg));
113             $var = INT2PTR($type,tmp);
114         }
115         else
116             Perl_croak(aTHX_ \"$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             Perl_croak(aTHX_ \"$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             Perl_croak(aTHX_ \"$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 = INT2PTR($type,tmp);
135         }
136         else
137             Perl_croak(aTHX_ \"$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             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
146 T_REFREF
147         if (SvROK($arg)) {
148             IV tmp = SvIV((SV*)SvRV($arg));
149             $var = *INT2PTR($type,tmp);
150         }
151         else
152             Perl_croak(aTHX_ \"$var is not a reference\")
153 T_REFOBJ
154         if (sv_isa($arg, \"${ntype}\")) {
155             IV tmp = SvIV((SV*)SvRV($arg));
156             $var = *INT2PTR($type,tmp);
157         }
158         else
159             Perl_croak(aTHX_ \"$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, (NV)$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, PTR2IV($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));
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         }