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