xref: /openbsd/gnu/usr.bin/perl/lib/ExtUtils/typemap (revision eac174f2) 
1# basic C types
2int			T_IV
3unsigned		T_UV
4unsigned int		T_UV
5long			T_IV
6unsigned long		T_UV
7short			T_IV
8unsigned short		T_UV
9char			T_CHAR
10unsigned char		T_U_CHAR
11char *			T_PV
12unsigned char *		T_PV
13const char *		T_PV
14caddr_t			T_PV
15wchar_t *		T_PV
16wchar_t			T_IV
17# bool_t is defined in <rpc/rpc.h>
18bool_t			T_IV
19size_t			T_UV
20ssize_t			T_IV
21time_t			T_NV
22unsigned long *		T_OPAQUEPTR
23char **			T_PACKEDARRAY
24void *			T_PTR
25Time_t *		T_PV
26SV *			T_SV
27
28# These are the backwards-compatibility AV*/HV* typemaps that
29# do not decrement refcounts. Locally override with
30# "AV*	T_AVREF_REFCOUNT_FIXED", "HV*	T_HVREF_REFCOUNT_FIXED",
31# "CV*	T_CVREF_REFCOUNT_FIXED", "SVREF	T_SVREF_REFCOUNT_FIXED",
32# to get the fixed versions.
33SVREF			T_SVREF
34CV *			T_CVREF
35AV *			T_AVREF
36HV *			T_HVREF
37
38IV			T_IV
39UV			T_UV
40NV                      T_NV
41I32			T_IV
42I16			T_IV
43I8			T_IV
44STRLEN			T_UV
45U32			T_U_LONG
46U16			T_U_SHORT
47U8			T_UV
48Result			T_U_CHAR
49Boolean			T_BOOL
50float                   T_FLOAT
51double			T_DOUBLE
52SysRet			T_SYSRET
53SysRetLong		T_SYSRET
54FILE *			T_STDIO
55PerlIO *		T_INOUT
56FileHandle		T_PTROBJ
57InputStream		T_IN
58InOutStream		T_INOUT
59OutputStream		T_OUT
60bool			T_BOOL
61
62#############################################################################
63INPUT
64T_SV
65	$var = $arg
66T_SVREF
67	STMT_START {
68		SV* const xsub_tmp_sv = $arg;
69		SvGETMAGIC(xsub_tmp_sv);
70		if (SvROK(xsub_tmp_sv)){
71		    $var = SvRV(xsub_tmp_sv);
72		}
73		else{
74		    Perl_croak_nocontext(\"%s: %s is not a reference\",
75				${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
76				\"$var\");
77		}
78	} STMT_END
79T_SVREF_REFCOUNT_FIXED
80	STMT_START {
81		SV* const xsub_tmp_sv = $arg;
82		SvGETMAGIC(xsub_tmp_sv);
83		if (SvROK(xsub_tmp_sv)){
84		    $var = SvRV(xsub_tmp_sv);
85		}
86		else{
87		    Perl_croak_nocontext(\"%s: %s is not a reference\",
88				${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
89				\"$var\");
90		}
91	} STMT_END
92T_AVREF
93	STMT_START {
94		SV* const xsub_tmp_sv = $arg;
95		SvGETMAGIC(xsub_tmp_sv);
96		if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){
97		    $var = (AV*)SvRV(xsub_tmp_sv);
98		}
99		else{
100		    Perl_croak_nocontext(\"%s: %s is not an ARRAY reference\",
101				${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
102				\"$var\");
103		}
104	} STMT_END
105T_AVREF_REFCOUNT_FIXED
106	STMT_START {
107		SV* const xsub_tmp_sv = $arg;
108		SvGETMAGIC(xsub_tmp_sv);
109		if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){
110		    $var = (AV*)SvRV(xsub_tmp_sv);
111		}
112		else{
113		    Perl_croak_nocontext(\"%s: %s is not an ARRAY reference\",
114				${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
115				\"$var\");
116		}
117	} STMT_END
118T_HVREF
119	STMT_START {
120		SV* const xsub_tmp_sv = $arg;
121		SvGETMAGIC(xsub_tmp_sv);
122		if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){
123		    $var = (HV*)SvRV(xsub_tmp_sv);
124		}
125		else{
126		    Perl_croak_nocontext(\"%s: %s is not a HASH reference\",
127				${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
128				\"$var\");
129		}
130	} STMT_END
131T_HVREF_REFCOUNT_FIXED
132	STMT_START {
133		SV* const xsub_tmp_sv = $arg;
134		SvGETMAGIC(xsub_tmp_sv);
135		if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){
136		    $var = (HV*)SvRV(xsub_tmp_sv);
137		}
138		else{
139		    Perl_croak_nocontext(\"%s: %s is not a HASH reference\",
140				${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
141				\"$var\");
142		}
143	} STMT_END
144T_CVREF
145	STMT_START {
146                HV *st;
147                GV *gvp;
148		SV * const xsub_tmp_sv = $arg;
149		SvGETMAGIC(xsub_tmp_sv);
150                $var = sv_2cv(xsub_tmp_sv, &st, &gvp, 0);
151		if (!$var) {
152		    Perl_croak_nocontext(\"%s: %s is not a CODE reference\",
153				${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
154				\"$var\");
155		}
156	} STMT_END
157T_CVREF_REFCOUNT_FIXED
158	STMT_START {
159                HV *st;
160                GV *gvp;
161		SV * const xsub_tmp_sv = $arg;
162		SvGETMAGIC(xsub_tmp_sv);
163                $var = sv_2cv(xsub_tmp_sv, &st, &gvp, 0);
164		if (!$var) {
165		    Perl_croak_nocontext(\"%s: %s is not a CODE reference\",
166				${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
167				\"$var\");
168		}
169	} STMT_END
170T_SYSRET
171	$var NOT IMPLEMENTED
172T_UV
173	$var = ($type)SvUV($arg)
174T_IV
175	$var = ($type)SvIV($arg)
176T_INT
177	$var = (int)SvIV($arg)
178T_ENUM
179	$var = ($type)SvIV($arg)
180T_BOOL
181	$var = (bool)SvTRUE($arg)
182T_U_INT
183	$var = (unsigned int)SvUV($arg)
184T_SHORT
185	$var = (short)SvIV($arg)
186T_U_SHORT
187	$var = (unsigned short)SvUV($arg)
188T_LONG
189	$var = (long)SvIV($arg)
190T_U_LONG
191	$var = (unsigned long)SvUV($arg)
192T_CHAR
193	$var = (char)*SvPV_nolen($arg)
194T_U_CHAR
195	$var = (unsigned char)SvUV($arg)
196T_FLOAT
197	$var = (float)SvNV($arg)
198T_NV
199	$var = ($type)SvNV($arg)
200T_DOUBLE
201	$var = (double)SvNV($arg)
202T_PV
203	$var = ($type)SvPV_nolen($arg)
204T_PTR
205	$var = INT2PTR($type,SvIV($arg))
206T_PTRREF
207	if (SvROK($arg)) {
208	    IV tmp = SvIV((SV*)SvRV($arg));
209	    $var = INT2PTR($type,tmp);
210	}
211	else
212	    Perl_croak_nocontext(\"%s: %s is not a reference\",
213			${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
214			\"$var\")
215T_REF_IV_REF
216	if (sv_isa($arg, \"${ntype}\")) {
217	    IV tmp = SvIV((SV*)SvRV($arg));
218	    $var = *INT2PTR($type *, tmp);
219	}
220	else {
221		const char* refstr = SvROK($arg) ? \"\" : SvOK($arg) ? \"scalar \" : \"undef\";
222	    Perl_croak_nocontext(\"%s: Expected %s to be of type %s; got %s%\" SVf \" instead\",
223			${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
224			\"$var\", \"$ntype\",
225			refstr, $arg
226		);
227	}
228T_REF_IV_PTR
229	if (sv_isa($arg, \"${ntype}\")) {
230	    IV tmp = SvIV((SV*)SvRV($arg));
231	    $var = INT2PTR($type, tmp);
232	}
233	else {
234		const char* refstr = SvROK($arg) ? \"\" : SvOK($arg) ? \"scalar \" : \"undef\";
235	    Perl_croak_nocontext(\"%s: Expected %s to be of type %s; got %s%\" SVf \" instead\",
236			${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
237			\"$var\", \"$ntype\",
238			refstr, $arg
239		);
240	}
241T_PTROBJ
242	if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) {
243	    IV tmp = SvIV((SV*)SvRV($arg));
244	    $var = INT2PTR($type,tmp);
245	}
246	else {
247		const char* refstr = SvROK($arg) ? \"\" : SvOK($arg) ? \"scalar \" : \"undef\";
248	    Perl_croak_nocontext(\"%s: Expected %s to be of type %s; got %s%\" SVf \" instead\",
249			${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
250			\"$var\", \"$ntype\",
251			refstr, $arg
252		);
253	}
254T_PTRDESC
255	if (sv_isa($arg, \"${ntype}\")) {
256	    IV tmp = SvIV((SV*)SvRV($arg));
257	    ${type}_desc = (\U${type}_DESC\E*) tmp;
258	    $var = ${type}_desc->ptr;
259	}
260	else {
261		const char* refstr = SvROK($arg) ? \"\" : SvOK($arg) ? \"scalar \" : \"undef\";
262	    Perl_croak_nocontext(\"%s: Expected %s to be of type %s; got %s%\" SVf \" instead\",
263			${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
264			\"$var\", \"$ntype\",
265			refstr, $arg
266		);
267	}
268T_REFREF
269	if (SvROK($arg)) {
270	    IV tmp = SvIV((SV*)SvRV($arg));
271	    $var = *INT2PTR($type,tmp);
272	}
273	else
274	    Perl_croak_nocontext(\"%s: %s is not a reference\",
275			${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
276			\"$var\")
277T_REFOBJ
278	if (sv_isa($arg, \"${ntype}\")) {
279	    IV tmp = SvIV((SV*)SvRV($arg));
280	    $var = *INT2PTR($type,tmp);
281	}
282	else {
283		const char* refstr = SvROK($arg) ? \"\" : SvOK($arg) ? \"scalar \" : \"undef\";
284	    Perl_croak_nocontext(\"%s: Expected %s to be of type %s; got %s%\" SVf \" instead\",
285			${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
286			\"$var\", \"$ntype\",
287			refstr, $arg
288		);
289	}
290T_OPAQUE
291	$var = *($type *)SvPV_nolen($arg)
292T_OPAQUEPTR
293	$var = ($type)SvPV_nolen($arg)
294T_PACKED
295	$var = XS_unpack_$ntype($arg)
296T_PACKEDARRAY
297	$var = XS_unpack_$ntype($arg)
298T_ARRAY
299	U32 ix_$var = $argoff;
300	$var = $ntype(items -= $argoff);
301	while (items--) {
302	    DO_ARRAY_ELEM;
303	    ix_$var++;
304	}
305        /* this is the number of elements in the array */
306        ix_$var -= $argoff
307T_STDIO
308	$var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
309T_IN
310	$var = IoIFP(sv_2io($arg))
311T_INOUT
312	$var = IoIFP(sv_2io($arg))
313T_OUT
314	$var = IoOFP(sv_2io($arg))
315#############################################################################
316OUTPUT
317T_SV
318	${ "$var" eq "RETVAL" ? \"$arg = $var;" : \"sv_setsv_mg($arg, $var);" }
319T_SVREF
320	$arg = newRV((SV*)$var);
321T_SVREF_REFCOUNT_FIXED
322	${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" }
323T_AVREF
324	$arg = newRV((SV*)$var);
325T_AVREF_REFCOUNT_FIXED
326	${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" }
327T_HVREF
328	$arg = newRV((SV*)$var);
329T_HVREF_REFCOUNT_FIXED
330	${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" }
331T_CVREF
332	$arg = newRV((SV*)$var);
333T_CVREF_REFCOUNT_FIXED
334	${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" }
335T_IV
336	sv_setiv($arg, (IV)$var);
337T_UV
338	sv_setuv($arg, (UV)$var);
339T_INT
340	sv_setiv($arg, (IV)$var);
341T_SYSRET
342	if ($var != -1) {
343	    if ($var == 0)
344		sv_setpvn($arg, "0 but true", 10);
345	    else
346		sv_setiv($arg, (IV)$var);
347	}
348T_ENUM
349	sv_setiv($arg, (IV)$var);
350T_BOOL
351	${"$var" eq "RETVAL" ? \"$arg = boolSV($var);" : \"sv_setsv($arg, boolSV($var));"}
352T_U_INT
353	sv_setuv($arg, (UV)$var);
354T_SHORT
355	sv_setiv($arg, (IV)$var);
356T_U_SHORT
357	sv_setuv($arg, (UV)$var);
358T_LONG
359	sv_setiv($arg, (IV)$var);
360T_U_LONG
361	sv_setuv($arg, (UV)$var);
362T_CHAR
363	sv_setpvn($arg, (char *)&$var, 1);
364T_U_CHAR
365	sv_setuv($arg, (UV)$var);
366T_FLOAT
367	sv_setnv($arg, (double)$var);
368T_NV
369	sv_setnv($arg, (NV)$var);
370T_DOUBLE
371	sv_setnv($arg, (double)$var);
372T_PV
373	sv_setpv((SV*)$arg, $var);
374T_PTR
375	sv_setiv($arg, PTR2IV($var));
376T_PTRREF
377	sv_setref_pv($arg, Nullch, (void*)$var);
378T_REF_IV_REF
379	sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
380T_REF_IV_PTR
381	sv_setref_pv($arg, \"${ntype}\", (void*)$var);
382T_PTROBJ
383	sv_setref_pv($arg, \"${ntype}\", (void*)$var);
384T_PTRDESC
385	sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
386T_REFREF
387	NOT_IMPLEMENTED
388T_REFOBJ
389	NOT IMPLEMENTED
390T_OPAQUE
391	sv_setpvn($arg, (char *)&$var, sizeof($var));
392T_OPAQUEPTR
393	sv_setpvn($arg, (char *)$var, sizeof(*$var));
394T_PACKED
395	XS_pack_$ntype($arg, $var);
396T_PACKEDARRAY
397	XS_pack_$ntype($arg, $var, count_$ntype);
398T_ARRAY
399        {
400	    U32 ix_$var;
401            SSize_t extend_size =
402                /* The weird way this is written is because g++ is dumb
403                 * enough to warn "comparison is always false" on something
404                 * like:
405                 *
406                 * sizeof(a) > sizeof(b) && a > B_t_MAX
407                 *
408                 * (where the LH condition is false)
409                 */
410                (size_$var > (sizeof(size_$var) > sizeof(SSize_t)
411                              ? SSize_t_MAX : size_$var))
412                ? -1 : (SSize_t)size_$var;
413	    EXTEND(SP, extend_size);
414	    for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
415		ST(ix_$var) = sv_newmortal();
416	DO_ARRAY_ELEM
417	    }
418        }
419T_STDIO
420	{
421	    GV *gv = (GV *)sv_newmortal();
422	    PerlIO *fp = PerlIO_importFILE($var,0);
423	    gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
424	    if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) {
425		SV *rv = newRV_inc((SV*)gv);
426		rv = sv_bless(rv, GvSTASH(gv));
427		${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"
428		    : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}
429	    }${"$var" ne "RETVAL" ? \"
430	    else
431		sv_setsv($arg, &PL_sv_undef);\n" : \""}
432	}
433T_IN
434	{
435	    GV *gv = (GV *)sv_newmortal();
436	    gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
437	    if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) {
438		SV *rv = newRV_inc((SV*)gv);
439		rv = sv_bless(rv, GvSTASH(gv));
440		${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"
441		    : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}
442	    }${"$var" ne "RETVAL" ? \"
443	    else
444		sv_setsv($arg, &PL_sv_undef);\n" : \""}
445	}
446T_INOUT
447	{
448	    GV *gv = (GV *)sv_newmortal();
449	    gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
450	    if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) {
451		SV *rv = newRV_inc((SV*)gv);
452		rv = sv_bless(rv, GvSTASH(gv));
453		${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"
454		    : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}
455	    }${"$var" ne "RETVAL" ? \"
456	    else
457		sv_setsv($arg, &PL_sv_undef);\n" : \""}
458	}
459T_OUT
460	{
461	    GV *gv = (GV *)sv_newmortal();
462	    gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
463	    if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) {
464		SV *rv = newRV_inc((SV*)gv);
465		rv = sv_bless(rv, GvSTASH(gv));
466		${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"
467		    : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}
468	    }${"$var" ne "RETVAL" ? \"
469	    else
470		sv_setsv($arg, &PL_sv_undef);\n" : \""}
471	}
472