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