File Coverage

include/ffi_platypus_call.h

Criterion	Covered	Total	%
statement	676	724	93.3
branch	570	1798	31.7
condition			n/a
subroutine			n/a
pod			n/a
total	1246	2522	49.4

line	stmt	bran	code
1
2			/*
3			* Philosophy: FFI dispatch should be as fast as possible considering
4			* reasonable trade offs.
5			*
6			* - don't allocate memory for small things using `malloc`, instead use
7			* alloca on platforms that allow it (most modern platforms do).
8			* - don't make function calls. You shouldn't have to make a function
9			* calls to call a function. Exceptions are for custom types and
10			* some of the more esoteric types.
11			* - one way we avoid making function calls is by putting the FFI dispatch
12			* in this header file so that it can be "called" twice without an
13			* extra function call. (`$ffi->function(...)->call(...)` and
14			* `$ffi->attach(foo => ...); foo(...)`). This is obviously absurd.
15			*
16			* Maybe each of these weird trade offs each save only a few ms on
17			* each call, but in the end the can add up. As a result of this
18			* priority set, FFI::Platypus does seem to perform considerably better
19			* than any other FFI implementations available in Perl ( see
20			* https://github.com/perl5-FFI/FFI-Performance ) and is even competitive
21			* with XS tbh.
22			*/
23
24	2068		ffi_pl_heap *heap = NULL;
25
26			#if FFI_PL_CALL_NO_RECORD_VALUE
27			#define RESULT &result
28			ffi_pl_result result;
29			#elif FFI_PL_CALL_RET_NO_NORMAL
30			#define RESULT result_ptr
31			void *result_ptr;
32	2		Newx_or_alloca(result_ptr, self->return_type->extra[0].record.size, char);
33			#else
34			#define RESULT result_ptr
35			ffi_pl_result result;
36			void *result_ptr;
37	403	100	if(self->return_type->type_code == FFI_PL_TYPE_RECORD_VALUE
38	402	100	\|\| self->return_type->type_code == (FFI_PL_TYPE_RECORD_VALUE \| FFI_PL_SHAPE_CUSTOM_PERL))
39			{
40	2		Newx_or_alloca(result_ptr, self->return_type->extra[0].record.size, char);
41			}
42			else
43			{
44	401		result_ptr = &result;
45			}
46			#endif
47
48			{
49			/* buffer contains the memory required for the arguments structure */
50			char *buffer;
51	2068		size_t buffer_size = sizeof(ffi_pl_argument) * self->ffi_cif.nargs +
52			sizeof(void) self->ffi_cif.nargs +
53			sizeof(ffi_pl_arguments);
54	2068		ffi_pl_heap_add(buffer, buffer_size, char);
55	2068		MY_CXT.current_argv = arguments = (ffi_pl_arguments*) buffer;
56			}
57
58	2068		arguments->count = self->ffi_cif.nargs;
59	2068		argument_pointers = (void**) &arguments->slot[arguments->count];
60
61			/*
62			* ARGUMENT IN
63			*/
64
65	4689	100	for(i=0, perl_arg_index=(EXTRA_ARGS); i < self->ffi_cif.nargs; i++, perl_arg_index++)
		100
		100
66			{
67	2637		int type_code = self->argument_types[i]->type_code;
68	2637		argument_pointers[i] = (void*) &arguments->slot[i];
69
70	2637	100	arg = perl_arg_index < items ? ST(perl_arg_index) : &PL_sv_undef;
		50
		100
71
72	2637		int custom_flag = (type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL;
73	2637	100	if(custom_flag)
		50
		100
74			{
75	154		arg = ffi_pl_custom_perl(
76	154		self->argument_types[i]->extra[0].custom_perl.perl_to_native,
77			arg, i
78			);
79	141		if(arg == NULL)
80			{
81	6		int max = self->argument_types[i]->extra[0].custom_perl.argument_count;
82	12	0	for(n=0; n < max; n++)
		0
		100
83			{
84	6		i++;
85	6		argument_pointers[i] = &arguments->slot[i];
86			}
87	6		continue;
88			}
89	135		av_push(MY_CXT.custom_keepers, newRV_inc(arg));
90	135		type_code ^= FFI_PL_SHAPE_CUSTOM_PERL;
91			}
92
93	2618		switch(type_code)
94			{
95
96			/*
97			* ARGUMENT IN - SCALAR TYPES
98			*/
99
100			case FFI_PL_TYPE_UINT8:
101	68	50	ffi_pl_arguments_set_uint8(arguments, i, SvOK(arg) ? SvUV(arg) : 0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		50
102	68		break;
103			case FFI_PL_TYPE_SINT8:
104	36	50	ffi_pl_arguments_set_sint8(arguments, i, SvOK(arg) ? SvIV(arg) : 0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		50
105	36		break;
106			case FFI_PL_TYPE_UINT16:
107	47	50	ffi_pl_arguments_set_uint16(arguments, i, SvOK(arg) ? SvUV(arg) : 0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		50
108	47		break;
109			case FFI_PL_TYPE_SINT16:
110	35	50	ffi_pl_arguments_set_sint16(arguments, i, SvOK(arg) ? SvIV(arg) : 0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		50
111	35		break;
112			case FFI_PL_TYPE_UINT32:
113	47	50	ffi_pl_arguments_set_uint32(arguments, i, SvOK(arg) ? SvUV(arg) : 0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		50
114	47		break;
115			case FFI_PL_TYPE_SINT32:
116	402	100	ffi_pl_arguments_set_sint32(arguments, i, SvOK(arg) ? SvIV(arg) : 0);
		50
		50
		50
		50
		0
		0
		50
		100
		50
		50
		50
117	402		break;
118			case FFI_PL_TYPE_UINT64:
119	204	50	ffi_pl_arguments_set_uint64(arguments, i, SvOK(arg) ? SvU64(arg) : 0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		50
120	204		break;
121			case FFI_PL_TYPE_SINT64:
122	35	50	ffi_pl_arguments_set_sint64(arguments, i, SvOK(arg) ? SvI64(arg) : 0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		50
123	35		break;
124			case FFI_PL_TYPE_FLOAT:
125	74	50	ffi_pl_arguments_set_float(arguments, i, SvOK(arg) ? SvNV(arg) : 0.0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		100
126	74		break;
127			case FFI_PL_TYPE_DOUBLE:
128	83	50	ffi_pl_arguments_set_double(arguments, i, SvOK(arg) ? SvNV(arg) : 0.0);
		0
		0
		50
		0
		0
		0
		0
		100
		50
		50
		100
129	83		break;
130			case FFI_PL_TYPE_OPAQUE:
131	371	100	ffi_pl_arguments_set_pointer(arguments, i, SvOK(arg) ? INT2PTR(void*, SvIV(arg)) : NULL);
		50
		50
		100
		0
		0
		0
		0
		100
		50
		50
		50
132	371		break;
133			case FFI_PL_TYPE_STRING:
134	455	100	ffi_pl_arguments_set_string(arguments, i, SvOK(arg) ? SvPV_nolen(arg) : NULL);
		50
		50
		50
		50
		0
		0
		50
		100
		50
		50
		50
135	455		break;
136			#ifdef FFI_PL_PROBE_LONGDOUBLE
137			case FFI_PL_TYPE_LONG_DOUBLE:
138			{
139			long double *ptr;
140	3		Newx_or_alloca(ptr, 1, long double);
141	3		argument_pointers[i] = ptr;
142	3	0	ffi_pl_perl_to_long_double(arg, ptr);
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
		0
		0
		50
143			}
144	3		break;
145			#endif
146			#ifdef FFI_PL_PROBE_COMPLEX
147			case FFI_PL_TYPE_COMPLEX_FLOAT:
148			{
149			float *ptr;
150	36		Newx_or_alloca(ptr, 2, float);
151	36		argument_pointers[i] = ptr;
152	36		ffi_pl_perl_to_complex_float(arg, ptr);
153			}
154	36		break;
155			case FFI_PL_TYPE_COMPLEX_DOUBLE:
156			{
157			double *ptr;
158	36		Newx_or_alloca(ptr, 2, double);
159	36		argument_pointers[i] = ptr;
160	36		ffi_pl_perl_to_complex_double(arg, ptr);
161			}
162	36		break;
163			#endif
164			case FFI_PL_TYPE_RECORD:
165			{
166			void *ptr;
167			STRLEN size;
168			int expected;
169	53		expected = self->argument_types[i]->extra[0].record.size;
170	53	100	if(SvROK(arg))
		0
		100
171			{
172	41		SV *arg2 = SvRV(arg);
173	41	100	ptr = SvOK(arg2) ? SvPV(arg2, size) : NULL;
		50
		50
		50
		0
		0
		0
		0
		50
		0
		0
		50
174			}
175			else
176			{
177	12	100	ptr = SvOK(arg) ? SvPV(arg, size) : NULL;
		50
		50
		50
		0
		0
		0
		0
		100
		50
		50
		50
178			}
179	53	100	if(ptr != NULL && expected != 0 && size != expected)
		50
		50
		0
		0
		0
		100
		50
		50
180	0		warn("record argument %d has wrong size (is %d, expected %d)", i, (int)size, expected);
181	53		ffi_pl_arguments_set_pointer(arguments, i, ptr);
182			}
183	53		break;
184			case FFI_PL_TYPE_RECORD_VALUE:
185			{
186	8		const char *record_class = self->argument_types[i]->extra[0].record.class;
187			/* TODO if object is read-onyl ? */
188	8	100	if(sv_isobject(arg) && sv_derived_from(arg, record_class))
		100
		0
		0
		0
		0
189			{
190	5	50	argument_pointers[i] = SvPV_nolen(SvRV(arg));
		0
		0
191			}
192			else
193			{
194	6	100	ffi_pl_croak("argument %d is not an instance of %s", i, record_class);
		0
		0
195			}
196			}
197	5		break;
198			case FFI_PL_TYPE_CLOSURE:
199			{
200	122	100	if(!SvROK(arg))
		0
		100
201			{
202	32	50	ffi_pl_arguments_set_pointer(arguments, i, SvOK(arg) ? INT2PTR(void*, SvIV(arg)) : NULL);
		0
		0
		50
		0
		0
		0
		0
		50
		50
		50
		0
203			}
204			else
205			{
206			ffi_pl_closure *closure;
207			ffi_status ffi_status;
208
209	90		SvREFCNT_inc(arg);
210	90		SvREFCNT_inc(SvRV(arg));
211
212	90		closure = ffi_pl_closure_get_data(arg, self->argument_types[i]);
213	90		if(closure != NULL)
214			{
215	1		ffi_pl_arguments_set_pointer(arguments, i, closure->function_pointer);
216			}
217			else
218			{
219	89		Newx(closure, 1, ffi_pl_closure);
220	89		closure->ffi_closure = ffi_closure_alloc(sizeof(ffi_closure), &closure->function_pointer);
221	89		if(closure->ffi_closure == NULL)
222			{
223	0		Safefree(closure);
224	0		ffi_pl_arguments_set_pointer(arguments, i, NULL);
225	0		warn("unable to allocate memory for closure");
226			}
227			else
228			{
229	89		closure->type = self->argument_types[i];
230
231	89		ffi_status = ffi_prep_closure_loc(
232			closure->ffi_closure,
233	89		&self->argument_types[i]->extra[0].closure.ffi_cif,
234			ffi_pl_closure_call,
235			closure,
236			closure->function_pointer
237			);
238	89		if(ffi_status != FFI_OK)
239			{
240	0		ffi_closure_free(closure->ffi_closure);
241	0		Safefree(closure);
242	0		ffi_pl_arguments_set_pointer(arguments, i, NULL);
243	0		warn("unable to create closure");
244			}
245			else
246			{
247			SV **svp;
248	89		svp = hv_fetch((HV *)SvRV(arg), "code", 4, 0);
249	89		if(svp != NULL)
250			{
251	89		closure->coderef = *svp;
252	89		SvREFCNT_inc(closure->coderef);
253	89		ffi_pl_closure_add_data(arg, closure);
254	89		ffi_pl_arguments_set_pointer(arguments, i, closure->function_pointer);
255			}
256			else
257			{
258	0		ffi_closure_free(closure->ffi_closure);
259	0		Safefree(closure);
260	0		ffi_pl_arguments_set_pointer(arguments, i, NULL);
261	0		warn("closure has no coderef");
262			}
263			}
264			}
265			}
266			}
267			}
268	122		break;
269			default:
270
271	503		switch(type_code & FFI_PL_SHAPE_MASK)
272			{
273
274			/*
275			* ARGUMENT IN - POINTER & ARRAY TYPES
276			*/
277
278			case FFI_PL_SHAPE_POINTER:
279			case FFI_PL_SHAPE_ARRAY:
280			{
281	483		void *ptr = NULL;
282	483		SSize_t count = 0;
283	483		int is_pointer = (type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_POINTER;
284	483		int is_bad = 0;
285	483	50	if(SvROK(arg))
		0
		100
286			{
287	389		SV *arg2 = SvRV(arg);
288	389	100	if(SvTYPE(arg2) < SVt_PVAV && is_pointer)
		50
		0
		0
		100
		50
289			{
290	172		switch(type_code & (FFI_PL_BASE_MASK\|FFI_PL_SIZE_MASK))
291			{
292			case FFI_PL_TYPE_UINT8:
293	9		Newx_or_alloca(ptr, 1, uint8_t);
294	9	0	((uint8_t)ptr) = SvOK(arg2) ? SvUV(arg2) : 0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
295	9		break;
296			case FFI_PL_TYPE_SINT8:
297	9		Newx_or_alloca(ptr, 1, int8_t);
298	9	0	((int8_t)ptr) = SvOK(arg2) ? SvIV(arg2) : 0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
299	9		break;
300			case FFI_PL_TYPE_UINT16:
301	9		Newx_or_alloca(ptr, 1, uint16_t);
302	9	0	((uint16_t)ptr) = SvOK(arg2) ? SvUV(arg2) : 0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
303	9		break;
304			case FFI_PL_TYPE_SINT16:
305	9		Newx_or_alloca(ptr, 1, int16_t);
306	9	0	((int16_t)ptr) = SvOK(arg2) ? SvIV(arg2) : 0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
307	9		break;
308			case FFI_PL_TYPE_UINT32:
309	9		Newx_or_alloca(ptr, 1, uint32_t);
310	9	0	((uint32_t)ptr) = SvOK(arg2) ? SvUV(arg2) : 0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
311	9		break;
312			case FFI_PL_TYPE_SINT32:
313	17		Newx_or_alloca(ptr, 1, int32_t);
314	17	50	((int32_t)ptr) = SvOK(arg2) ? SvIV(arg2) : 0;
		0
		0
		50
		0
		0
		0
		0
		50
		0
		0
		50
315	17		break;
316			case FFI_PL_TYPE_UINT64:
317	9		Newx_or_alloca(ptr, 1, uint64_t);
318	9	0	((uint64_t)ptr) = SvOK(arg2) ? SvU64(arg2) : 0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
319	9		break;
320			case FFI_PL_TYPE_SINT64:
321	9		Newx_or_alloca(ptr, 1, int64_t);
322	9	0	((int64_t)ptr) = SvOK(arg2) ? SvI64(arg2) : 0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
323	9		break;
324			case FFI_PL_TYPE_FLOAT:
325	9		Newx_or_alloca(ptr, 1, float);
326	9	0	((float)ptr) = SvOK(arg2) ? SvNV(arg2) : 0.0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		100
327	9		break;
328			case FFI_PL_TYPE_DOUBLE:
329	9		Newx_or_alloca(ptr, 1, double);
330	9	0	((double)ptr) = SvOK(arg2) ? SvNV(arg2) : 0.0;
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		100
331	9		break;
332			case FFI_PL_TYPE_OPAQUE:
333	12		Newx_or_alloca(ptr, 1, void*);
334			{
335	12		SV *tmp = SvRV(arg);
336	12	0	((void)ptr) = SvOK(tmp) ? INT2PTR(void , SvIV(tmp)) : NULL;
		0
		0
		0
		0
		0
		0
		0
		100
		50
		50
		50
337			}
338	12		break;
339			#ifdef FFI_PL_PROBE_LONGDOUBLE
340			case FFI_PL_TYPE_LONG_DOUBLE:
341	2		Newx_or_alloca(ptr, 1, long double);
342	2	0	ffi_pl_perl_to_long_double(arg2, (long double*)ptr);
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
		0
		0
		50
343	2		break;
344			#endif
345			#ifdef FFI_PL_PROBE_COMPLEX
346			case FFI_PL_TYPE_COMPLEX_FLOAT:
347	27		Newx_or_alloca(ptr, 1, float complex);
348	27		ffi_pl_perl_to_complex_float(arg2, (float *)ptr);
349	27		break;
350			case FFI_PL_TYPE_COMPLEX_DOUBLE:
351	27		Newx_or_alloca(ptr, 1, double complex);
352	27		ffi_pl_perl_to_complex_double(arg2, (double *)ptr);
353	27		break;
354			#endif
355			case FFI_PL_TYPE_STRING:
356	6		Newx_or_alloca(ptr, 1, char *);
357	6	0	if(SvOK(arg2))
		0
		0
		0
		0
		0
		100
		50
		50
358	3		{
359			char *pv;
360			STRLEN len;
361			char *str;
362	3	0	pv = SvPV(arg2, len);
		0
		50
363			/* TODO: this should probably be a malloc since it could be arbitrarily large */
364	3		Newx_or_alloca(str, len+1, char);
365	3		memcpy(str, pv, len+1);
366	3		((char*)ptr) = str;
367			}
368			else
369			{
370	3		((char*)ptr) = NULL;
371			}
372	6		break;
373			default:
374	0		warn("argument type not supported (%d)", i);
375	0		Newx_or_alloca(ptr, 1, void*);
376	0		((void*)ptr) = NULL;
377	0		break;
378			}
379	172		}
380	217	50	else if(SvTYPE(arg2) == SVt_PVAV && (!is_pointer) \|\| (is_pointer && self->platypus_api >= 2))
		100
		50
		50
		0
		0
		0
		0
		50
		100
		50
		50
381	217		{
382	217		AV av = (AV) arg2;
383	217	100	if(!is_pointer)
		0
		100
384			{
385	184		count = self->argument_types[i]->extra[0].array.element_count;
386			}
387	217	100	if(count == 0)
		0
		100
388			{
389	125		count = av_len(av)+1;
390			}
391	217		switch(type_code & (FFI_PL_BASE_MASK\|FFI_PL_SIZE_MASK))
392			{
393			case FFI_PL_TYPE_UINT8:
394	11		Newx(ptr, count, uint8_t);
395	121	0	for(n=0; n
		0
		100
396			{
397	110	0	((uint8_t)ptr)[n] = SvUV(av_fetch(av, n, 1));
		0
		50
398			}
399	11		break;
400			case FFI_PL_TYPE_SINT8:
401	11		Newx(ptr, count, int8_t);
402	121	0	for(n=0; n
		0
		100
403			{
404	110	0	((int8_t)ptr)[n] = SvIV(av_fetch(av, n, 1));
		0
		50
405			}
406	11		break;
407			case FFI_PL_TYPE_UINT16:
408	11	0	Newx(ptr, count, uint16_t);
		0
		50
409	121	0	for(n=0; n
		0
		100
410			{
411	110	0	((uint16_t)ptr)[n] = SvUV(av_fetch(av, n, 1));
		0
		50
412			}
413	11		break;
414			case FFI_PL_TYPE_SINT16:
415	11	0	Newx(ptr, count, int16_t);
		0
		50
416	121	0	for(n=0; n
		0
		100
417			{
418	110	0	((int16_t)ptr)[n] = SvIV(av_fetch(av, n, 1));
		0
		50
419			}
420	11		break;
421			case FFI_PL_TYPE_UINT32:
422	11	0	Newx(ptr, count, uint32_t);
		0
		50
423	121	0	for(n=0; n
		0
		100
424			{
425	110	0	((uint32_t)ptr)[n] = SvUV(av_fetch(av, n, 1));
		0
		50
426			}
427	11		break;
428			case FFI_PL_TYPE_SINT32:
429	11	0	Newx(ptr, count, int32_t);
		0
		50
430	121	0	for(n=0; n
		0
		100
431			{
432	110	0	((int32_t)ptr)[n] = SvIV(av_fetch(av, n, 1));
		0
		50
433			}
434	11		break;
435			case FFI_PL_TYPE_UINT64:
436	11	0	Newx(ptr, count, uint64_t);
		0
		50
437	121	0	for(n=0; n
		0
		100
438			{
439	110	0	((uint64_t)ptr)[n] = SvU64(av_fetch(av, n, 1));
		0
		50
440			}
441	11		break;
442			case FFI_PL_TYPE_SINT64:
443	11	0	Newx(ptr, count, int64_t);
		0
		50
444	121	0	for(n=0; n
		0
		100
445			{
446	110	0	((int64_t)ptr)[n] = SvI64(av_fetch(av, n, 1));
		0
		50
447			}
448	11		break;
449			case FFI_PL_TYPE_FLOAT:
450	11	0	Newx(ptr, count, float);
		0
		50
451	121	0	for(n=0; n
		0
		100
452			{
453	110	0	((float)ptr)[n] = SvNV(av_fetch(av, n, 1));
		0
		100
454			}
455	11		break;
456			case FFI_PL_TYPE_DOUBLE:
457	11	0	Newx(ptr, count, double);
		0
		50
458	121	0	for(n=0; n
		0
		100
459			{
460	110	0	((double)ptr)[n] = SvNV(av_fetch(av, n, 1));
		0
		100
461			}
462	11		break;
463			case FFI_PL_TYPE_OPAQUE:
464	39	50	Newx(ptr, count, void*);
		0
		50
465	434	100	for(n=0; n
		0
		100
466			{
467	395		SV sv = av_fetch(av, n, 1);
468	395	100	((void*)ptr)[n] = SvOK(sv) ? INT2PTR(void, SvIV(sv)) : NULL;
		50
		50
		50
		0
		0
		0
		0
		100
		50
		50
		50
469			}
470	39		break;
471			#ifdef FFI_PL_PROBE_LONGDOUBLE
472			case FFI_PL_TYPE_LONG_DOUBLE:
473			/* gh#236: lets hope the compiler is smart enough to opitmize this */
474			if(sizeof(long double) >= 16)
475			{
476	2	0	Newx(ptr, count, long double);
		0
		50
477			}
478			else
479			{
480			Newx(ptr, count*16, char);
481			}
482	8	0	for(n=0; n
		0
		100
483			{
484	6		SV sv = av_fetch(av, n, 1);
485	6	0	ffi_pl_perl_to_long_double(sv, &((long double*)ptr)[n]);
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
		0
		0
		50
486			}
487	2		break;
488			#endif
489			#ifdef FFI_PL_PROBE_COMPLEX
490			case FFI_PL_TYPE_COMPLEX_FLOAT:
491	16	50	Newx(ptr, count, float complex);
		0
		0
492	64	100	for(n=0; n
		0
		0
493			{
494	48		SV sv = av_fetch(av, n, 1);
495	48		ffi_pl_perl_to_complex_float(sv, &((float)ptr)[n2]);
496			}
497	16		break;
498			case FFI_PL_TYPE_COMPLEX_DOUBLE:
499	16	50	Newx(ptr, count, double complex);
		0
		0
500	64	100	for(n=0; n
		0
		0
501			{
502	48		SV sv = av_fetch(av, n, 1);
503	48		ffi_pl_perl_to_complex_double(sv, &((double)ptr)[n2]);
504			}
505	16		break;
506			#endif
507			case FFI_PL_TYPE_STRING:
508	34	50	Newx(ptr, count, char *);
		0
		0
509	182	100	for(n=0; n
		0
		0
510			{
511	148		SV sv = av_fetch(av, n, 1);
512	148	100	if(SvOK(sv))
		50
		0
		0
		0
513	114		{
514			char *str;
515			char *pv;
516			STRLEN len;
517	114	50	pv = SvPV(sv, len);
		0
		0
518			/* TODO: this should probably be a malloc since it could be arbitrarily large */
519	114		Newx_or_alloca(str, len+1, char);
520	114		memcpy(str, pv, len+1);
521	114		((char**)ptr)[n] = str;
522			}
523			else
524			{
525	34		((char**)ptr)[n] = NULL;
526			}
527			}
528	34		break;
529			default:
530	0		Newxz(ptr, count*(1 << ((type_code & FFI_PL_SIZE_MASK)-1)), char);
531	0		warn("argument type not supported (%d)", i);
532	0		break;
533			}
534	217		ffi_pl_heap_add_ptr(ptr);
535			}
536			else
537			{
538	389		is_bad = 1;
539			}
540			}
541			else
542			{
543	94	0	if(is_pointer)
		0
		100
544			{
545	64		ptr = NULL;
546			}
547			else
548			{
549	30		is_bad = 1;
550			}
551			}
552	483	50	if(is_bad)
		0
		100
553			{
554	30	0	if(is_pointer)
		0
		50
555			{
556	0	0	if(self->platypus_api >= 2)
		0
		0
557			{
558	0		warn("argument type not a reference to scalar or array (%d)", i);
559			}
560			else
561			{
562	0		warn("argument type not a reference to scalar (%d)", i);
563			}
564			}
565			else
566			{
567	30		warn("passing non array reference into ffi/platypus array argument type");
568	30		count = self->argument_types[i]->extra[0].array.element_count;
569	30		Newxz(ptr, count*(1 << ((type_code & FFI_PL_SIZE_MASK)-1)), char);
570	30		ffi_pl_heap_add_ptr(ptr);
571			}
572			}
573	483		ffi_pl_arguments_set_pointer(arguments, i, ptr);
574			}
575	483		break;
576
577			/*
578			* ARGUMENT IN - OBJECT
579			*/
580
581			case FFI_PL_SHAPE_OBJECT:
582			{
583	20	50	if(sv_isobject(arg) && sv_derived_from(arg, self->argument_types[i]->extra[0].object.class))
		50
		0
		0
		0
		0
584	20		{
585	20		SV *arg2 = SvRV(arg);
586	20		switch(type_code)
587			{
588			case FFI_PL_TYPE_UINT8 \| FFI_PL_SHAPE_OBJECT:
589	2	50	ffi_pl_arguments_set_uint8(arguments, i, SvUV(arg2) );
		0
		0
590	2		break;
591			case FFI_PL_TYPE_SINT8 \| FFI_PL_SHAPE_OBJECT:
592	2	50	ffi_pl_arguments_set_sint8(arguments, i, SvIV(arg2) );
		0
		0
593	2		break;
594			case FFI_PL_TYPE_UINT16 \| FFI_PL_SHAPE_OBJECT:
595	2	50	ffi_pl_arguments_set_uint16(arguments, i, SvUV(arg2) );
		0
		0
596	2		break;
597			case FFI_PL_TYPE_SINT16 \| FFI_PL_SHAPE_OBJECT:
598	2	50	ffi_pl_arguments_set_sint16(arguments, i, SvIV(arg2) );
		0
		0
599	2		break;
600			case FFI_PL_TYPE_UINT32 \| FFI_PL_SHAPE_OBJECT:
601	2	50	ffi_pl_arguments_set_uint32(arguments, i, SvUV(arg2) );
		0
		0
602	2		break;
603			case FFI_PL_TYPE_SINT32 \| FFI_PL_SHAPE_OBJECT:
604	2	50	ffi_pl_arguments_set_sint32(arguments, i, SvIV(arg2) );
		0
		0
605	2		break;
606			case FFI_PL_TYPE_UINT64 \| FFI_PL_SHAPE_OBJECT:
607	2	50	ffi_pl_arguments_set_uint64(arguments, i, SvU64(arg2) );
		0
		0
608	2		break;
609			case FFI_PL_TYPE_SINT64 \| FFI_PL_SHAPE_OBJECT:
610	2	50	ffi_pl_arguments_set_sint64(arguments, i, SvI64(arg2) );
		0
		0
611	2		break;
612			case FFI_PL_TYPE_OPAQUE \| FFI_PL_SHAPE_OBJECT:
613	4	50	ffi_pl_arguments_set_pointer(arguments, i, SvOK(arg2) ? INT2PTR(void*, SvIV(arg2)) : NULL);
		0
		0
		50
		0
		0
		0
		0
		0
		0
		0
		0
614	4		break;
615			default:
616	0	0	ffi_pl_croak("Object argument %d type not supported %d", i, type_code);
		0
		0
617			}
618			}
619			else
620			{
621	0	0	ffi_pl_croak("Object argument %d must be an object of class %s", i, self->argument_types[i]->extra[0].object.class);
		0
		0
622			}
623			}
624	20		break;
625
626			/*
627			* ARGUMENT IN - UNSUPPORTED
628			*/
629
630			default:
631	0		warn("FFI::Platypus: argument %d type not supported (%04x)", i, type_code);
632	0		break;
633			}
634			}
635
636	2615	100	if(custom_flag)
		50
		100
637			{
638	135		int max = self->argument_types[i]->extra[0].custom_perl.argument_count;
639	135		SvREFCNT_dec(arg);
640	135	50	for(n=0; n < max; n++)
		0
		50
641			{
642	0		i++;
643	0		argument_pointers[i] = &arguments->slot[i];
644			}
645			}
646			}
647
648			/*
649			* CALL
650			*/
651
652			#if 0
653			fprintf(stderr, "# ===[%p]===\n", self->address);
654			for(i=0; i < self->ffi_cif.nargs; i++)
655			{
656			fprintf(stderr, "# [%d] <%04x> %p %p",
657			i,
658			self->argument_types[i]->type_code,
659			argument_pointers[i],
660			&arguments->slot[i]
661			);
662			switch(self->argument_types[i]->type_code)
663			{
664			case FFI_PL_TYPE_LONG_DOUBLE:
665			fprintf(stderr, " %Lg", ((long double)argument_pointers[i]));
666			break;
667			case FFI_PL_TYPE_COMPLEX_FLOAT:
668			fprintf(stderr, " %g + %g * i",
669			crealf(((float complex)argument_pointers[i])),
670			cimagf(((float complex)argument_pointers[i]))
671			);
672			break;
673			case FFI_PL_TYPE_COMPLEX_DOUBLE:
674			fprintf(stderr, " %g + %g * i",
675			creal(((double complex)argument_pointers[i])),
676			cimag(((double complex)argument_pointers[i]))
677			);
678			break;
679			default:
680			fprintf(stderr, "%016llx", ffi_pl_arguments_get_uint64(arguments, i));
681			break;
682			}
683			fprintf(stderr, "\n");
684			}
685			fprintf(stderr, "# === ===\n");
686			fflush(stderr);
687			#endif
688
689	2052		MY_CXT.current_argv = NULL;
690
691	2052		ffi_call(&self->ffi_cif, self->address, RESULT, ffi_pl_arguments_pointers(arguments));
692
693			/*
694			* ARGUMENT OUT
695			*/
696
697	2052		MY_CXT.current_argv = arguments;
698
699	4672	100	for(i=self->ffi_cif.nargs-1,perl_arg_index--; i >= 0; i--, perl_arg_index--)
		100
		100
700			{
701	2621		int type_code = self->argument_types[i]->type_code;
702
703	2621	100	switch(type_code)
		50
		100
704			{
705
706			/*
707			* ARGUMENT OUT - SCALAR TYPES
708			*/
709
710			case FFI_PL_TYPE_CLOSURE:
711			{
712	122	50	arg = perl_arg_index < items ? ST(perl_arg_index) : &PL_sv_undef;
		0
		100
713	122	100	if(SvROK(arg))
		0
		100
714			{
715	90		SvREFCNT_dec(arg);
716	90		SvREFCNT_dec(SvRV(arg));
717			}
718			}
719	122		break;
720
721			default:
722	2499		switch(type_code & FFI_PL_SHAPE_MASK)
723			{
724
725			/*
726			* ARGUMENT OUT - POINTER & ARRAY TYPES
727			*/
728
729			case FFI_PL_SHAPE_POINTER:
730			case FFI_PL_SHAPE_ARRAY:
731			{
732	483		void *ptr = ffi_pl_arguments_get_pointer(arguments, i);
733	483	50	arg = perl_arg_index < items ? ST(perl_arg_index) : &PL_sv_undef;
		0
		100
734	483	50	if(ptr != NULL && SvOK(arg))
		50
		0
		0
		0
		0
		0
		0
		100
		100
		50
		50
735			{
736	389	50	SV *arg2 = SvROK(arg) ? SvRV(arg) : &PL_sv_undef;
		0
		50
737	389	100	if(SvTYPE(arg2) == SVt_PVAV)
		0
		100
738			{
739	217		SSize_t count = 0;
740	217		AV av = (AV)arg2;
741	217	100	if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_ARRAY)
		0
		100
742			{
743	184		count = self->argument_types[i]->extra[0].array.element_count;
744			}
745	217	100	if(count == 0)
		0
		100
746			{
747	125		count = av_len(av)+1;
748			}
749	217		switch(type_code & (FFI_PL_BASE_MASK\|FFI_PL_SIZE_MASK))
750			{
751			case FFI_PL_TYPE_UINT8:
752	121	0	for(n=0; n
		0
		100
753			{
754	110		sv_setuv(av_fetch(av, n, 1), ((uint8_t)ptr)[n]);
755			}
756	11		break;
757			case FFI_PL_TYPE_SINT8:
758	121	0	for(n=0; n
		0
		100
759			{
760	110		sv_setiv(av_fetch(av, n, 1), ((int8_t)ptr)[n]);
761			}
762	11		break;
763			case FFI_PL_TYPE_UINT16:
764	121	0	for(n=0; n
		0
		100
765			{
766	110		sv_setuv(av_fetch(av, n, 1), ((uint16_t)ptr)[n]);
767			}
768	11		break;
769			case FFI_PL_TYPE_SINT16:
770	121	0	for(n=0; n
		0
		100
771			{
772	110		sv_setiv(av_fetch(av, n, 1), ((int16_t)ptr)[n]);
773			}
774	11		break;
775			case FFI_PL_TYPE_UINT32:
776	121	0	for(n=0; n
		0
		100
777			{
778	110		sv_setuv(av_fetch(av, n, 1), ((uint32_t)ptr)[n]);
779			}
780	11		break;
781			case FFI_PL_TYPE_SINT32:
782	121	0	for(n=0; n
		0
		100
783			{
784	110		sv_setiv(av_fetch(av, n, 1), ((int32_t)ptr)[n]);
785			}
786	11		break;
787			case FFI_PL_TYPE_UINT64:
788	121	0	for(n=0; n
		0
		100
789			{
790	110		sv_setu64(av_fetch(av, n, 1), ((uint64_t)ptr)[n]);
791			}
792	11		break;
793			case FFI_PL_TYPE_SINT64:
794	121	0	for(n=0; n
		0
		100
795			{
796	110		sv_seti64(av_fetch(av, n, 1), ((int64_t)ptr)[n]);
797			}
798	11		break;
799			case FFI_PL_TYPE_FLOAT:
800	121	0	for(n=0; n
		0
		100
801			{
802	110		sv_setnv(av_fetch(av, n, 1), ((float)ptr)[n]);
803			}
804	11		break;
805			case FFI_PL_TYPE_OPAQUE:
806			case FFI_PL_TYPE_STRING:
807	616	100	for(n=0; n
		0
		100
808			{
809	543	100	if( ((void**)ptr)[n] == NULL)
		0
		100
810			{
811	74		av_store(av, n, &PL_sv_undef);
812			}
813			else
814			{
815	469		switch(type_code) {
816			case FFI_PL_TYPE_OPAQUE \| FFI_PL_SHAPE_ARRAY:
817	349		sv_setnv(av_fetch(av,n,1), PTR2IV( ((void*)ptr)[n]) );
818	349		break;
819			case FFI_PL_TYPE_STRING \| FFI_PL_SHAPE_ARRAY:
820	105		sv_setpv(av_fetch(av,n,1), ((char*)ptr)[n] );
821	105		break;
822			}
823			}
824			}
825	73		break;
826			case FFI_PL_TYPE_DOUBLE:
827	121	0	for(n=0; n
		0
		100
828			{
829	110		sv_setnv(av_fetch(av, n, 1), ((double)ptr)[n]);
830			}
831	11		break;
832			#ifdef FFI_PL_PROBE_LONGDOUBLE
833			case FFI_PL_TYPE_LONG_DOUBLE:
834	8	0	for(n=0; n
		0
		100
835			{
836			SV *sv;
837	6		sv = *av_fetch(av, n, 1);
838	6	0	ffi_pl_long_double_to_perl(sv, &((long double*)ptr)[n]);
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
839			}
840	2		break;
841			#endif
842			#ifdef FFI_PL_PROBE_COMPLEX
843			case FFI_PL_TYPE_COMPLEX_DOUBLE:
844	64	100	for(n=0; n
		0
		0
845			{
846			SV *sv;
847	48		sv = *av_fetch(av, n, 1);
848	48		ffi_pl_complex_double_to_perl(sv, &((double)ptr)[n2]);
849			}
850	16		break;
851			case FFI_PL_TYPE_COMPLEX_FLOAT:
852	64	100	for(n=0; n
		0
		0
853			{
854			SV *sv;
855	48		sv = *av_fetch(av, n, 1);
856	48		ffi_pl_complex_float_to_perl(sv, &((float)ptr)[n2]);
857			}
858	217		break;
859			#endif
860			}
861			}
862	172	50	else if(SvTYPE(arg2) < SVt_PVAV && !SvREADONLY(arg2))
		50
		0
		0
		50
		100
863			{
864	109		switch(type_code & (FFI_PL_BASE_MASK\|FFI_PL_SIZE_MASK))
865			{
866			case FFI_PL_TYPE_UINT8:
867	3		sv_setuv(arg2, ((uint8_t)ptr));
868	3		break;
869			case FFI_PL_TYPE_SINT8:
870	6		sv_setiv(arg2, ((int8_t)ptr));
871	6		break;
872			case FFI_PL_TYPE_UINT16:
873	3		sv_setuv(arg2, ((uint16_t)ptr));
874	3		break;
875			case FFI_PL_TYPE_SINT16:
876	6		sv_setiv(arg2, ((int16_t)ptr));
877	6		break;
878			case FFI_PL_TYPE_UINT32:
879	3		sv_setuv(arg2, ((uint32_t)ptr));
880	3		break;
881			case FFI_PL_TYPE_SINT32:
882	14		sv_setiv(arg2, ((int32_t)ptr));
883	14		break;
884			case FFI_PL_TYPE_UINT64:
885	3		sv_setu64(arg2, ((uint64_t)ptr));
886	3		break;
887			case FFI_PL_TYPE_SINT64:
888	6		sv_seti64(arg2, ((int64_t)ptr));
889	6		break;
890			case FFI_PL_TYPE_FLOAT:
891	3		sv_setnv(arg2, ((float)ptr));
892	3		break;
893			case FFI_PL_TYPE_OPAQUE:
894	9	0	if( ((void*)ptr) == NULL)
		0
		100
895	3		sv_setsv(arg2, &PL_sv_undef);
896			else
897	6		sv_setiv(arg2, PTR2IV(((void*)ptr)));
898	9		break;
899			case FFI_PL_TYPE_DOUBLE:
900	3		sv_setnv(arg2, ((double)ptr));
901	3		break;
902			#ifdef FFI_PL_PROBE_LONGDOUBLE
903			case FFI_PL_TYPE_LONG_DOUBLE:
904	2	0	ffi_pl_long_double_to_perl(arg2,(long double*)ptr);
		0
		0
		0
		0
		0
		0
		0
		50
		0
		0
		50
905	2		break;
906			#endif
907			#ifdef FFI_PL_PROBE_COMPLEX
908			case FFI_PL_TYPE_COMPLEX_FLOAT:
909	21		ffi_pl_complex_float_to_perl(arg2, (float *)ptr);
910	21		break;
911			case FFI_PL_TYPE_COMPLEX_DOUBLE:
912	21		ffi_pl_complex_double_to_perl(arg2, (double *)ptr);
913	21		break;
914			#endif
915			case FFI_PL_TYPE_STRING:
916			{
917	6		char **pv = ptr;
918	6	0	if(*pv == NULL)
		0
		50
919			{
920	0		sv_setsv(arg2, &PL_sv_undef);
921			}
922			else
923			{
924	6		sv_setpv(arg2, *pv);
925			}
926			}
927	6		break;
928			}
929			}
930			}
931			}
932	483		break;
933
934			/*
935			* ARGUMENT OUT - CUSTOM TYPE
936			*/
937
938			case FFI_PL_SHAPE_CUSTOM_PERL:
939			{
940			/* FIXME: need to fill out argument_types for skipping */
941	141		i -= self->argument_types[i]->extra[0].custom_perl.argument_count;
942			{
943	141		SV *coderef = self->argument_types[i]->extra[0].custom_perl.perl_to_native_post;
944	141	100	if(coderef != NULL)
		0
		100
945			{
946	85	50	arg = perl_arg_index < items ? ST(perl_arg_index) : &PL_sv_undef;
		0
		50
947	85		ffi_pl_custom_perl_cb(coderef, arg, i);
948			}
949			}
950			{
951	140		SV *sv = av_pop(MY_CXT.custom_keepers);
952	140	50	if(SvOK(sv))
		0
		0
		50
		50
953	134		SvREFCNT_dec(sv);
954			}
955			}
956	140		break;
957
958			default:
959	1875		break;
960			}
961			}
962			}
963
964			{
965
966	2051		int type_code = self->return_type->type_code;
967
968			/*
969			* TODO: This should always happen later if possible
970			*/
971	2051	100	if((type_code & FFI_PL_SHAPE_MASK) != FFI_PL_SHAPE_CUSTOM_PERL
		50
		100
972	1971	100	&& type_code != FFI_PL_TYPE_RECORD_VALUE)
		50
		50
973	4159	100	ffi_pl_heap_free();
		0
		100
974
975	2051		MY_CXT.current_argv = NULL;
976
977			/*
978			* RETURN VALUE
979			*/
980
981	2051		switch(type_code)
982			{
983
984			/*
985			* RETURN VALUE - TYPE SCALAR
986			*/
987
988
989			#if ! FFI_PL_CALL_NO_RECORD_VALUE
990			case FFI_PL_TYPE_RECORD_VALUE:
991			{
992			SV value, ref;
993	3		value = newSV(0);
994	3		sv_setpvn(value, result_ptr, self->return_type->extra[0].record.size);
995	3		ref = ST(0) = sv_2mortal(newRV_noinc(value));
996	3		sv_bless(ref, gv_stashpv(self->return_type->extra[0].record.class, GV_ADD));
997	6	100	ffi_pl_heap_free();
		100
998	3		XSRETURN(1);
999			}
1000			break;
1001			case FFI_PL_TYPE_RECORD_VALUE \| FFI_PL_SHAPE_CUSTOM_PERL:
1002			{
1003			SV value, ref;
1004	1		value = newSV(0);
1005	1		sv_setpvn(value, result_ptr, self->return_type->extra[0].record.size);
1006	1		ref = sv_2mortal(newRV_noinc(value));
1007	1		sv_bless(ref, gv_stashpv(self->return_type->extra[0].record.class, GV_ADD));
1008
1009	1		MY_CXT.current_argv = arguments;
1010
1011	1		ST(0) = ffi_pl_custom_perl(
1012	1		self->return_type->extra[0].custom_perl.native_to_perl,
1013			ref,
1014			-1
1015			);
1016
1017	1		MY_CXT.current_argv = NULL;
1018
1019	2	100	ffi_pl_heap_free();
		0
1020	1		XSRETURN(1);
1021			}
1022			break;
1023			#endif
1024			#if ! FFI_PL_CALL_RET_NO_NORMAL
1025			case FFI_PL_TYPE_VOID:
1026	351		XSRETURN_EMPTY;
1027			break;
1028			case FFI_PL_TYPE_UINT8:
1029			#if defined FFI_PL_PROBE_BIGENDIAN
1030			XSRETURN_UV(result.uint8_array[3]);
1031			#elif defined FFI_PL_PROBE_BIGENDIAN64
1032			XSRETURN_UV(result.uint8_array[7]);
1033			#else
1034	47		XSRETURN_UV(result.uint8);
1035			#endif
1036			break;
1037			case FFI_PL_TYPE_SINT8:
1038			#if defined FFI_PL_PROBE_BIGENDIAN
1039			XSRETURN_IV(result.sint8_array[3]);
1040			#elif defined FFI_PL_PROBE_BIGENDIAN64
1041			XSRETURN_IV(result.sint8_array[7]);
1042			#else
1043	26		XSRETURN_IV(result.sint8);
1044			#endif
1045			break;
1046			case FFI_PL_TYPE_UINT16:
1047			#if defined FFI_PL_PROBE_BIGENDIAN
1048			XSRETURN_UV(result.uint16_array[1]);
1049			#elif defined FFI_PL_PROBE_BIGENDIAN64
1050			XSRETURN_UV(result.uint16_array[3]);
1051			#else
1052	29		XSRETURN_UV(result.uint16);
1053			#endif
1054			break;
1055			case FFI_PL_TYPE_SINT16:
1056			#if defined FFI_PL_PROBE_BIGENDIAN
1057			XSRETURN_IV(result.sint16_array[1]);
1058			#elif defined FFI_PL_PROBE_BIGENDIAN64
1059			XSRETURN_IV(result.sint16_array[3]);
1060			#else
1061	25		XSRETURN_IV(result.sint16);
1062			#endif
1063			break;
1064			case FFI_PL_TYPE_UINT32:
1065			#if defined FFI_PL_PROBE_BIGENDIAN64
1066			XSRETURN_UV(result.uint32_array[1]);
1067			#else
1068	28		XSRETURN_UV(result.uint32);
1069			#endif
1070			break;
1071			case FFI_PL_TYPE_SINT32:
1072			#if defined FFI_PL_PROBE_BIGENDIAN64
1073			XSRETURN_IV(result.sint32_array[1]);
1074			#else
1075	248		XSRETURN_IV(result.sint32);
1076			#endif
1077			break;
1078			case FFI_PL_TYPE_UINT64:
1079	57		XSRETURN_U64(result.uint64);
1080			break;
1081			case FFI_PL_TYPE_SINT64:
1082	25		XSRETURN_I64(result.sint64);
1083			break;
1084			case FFI_PL_TYPE_FLOAT:
1085	59		XSRETURN_NV(result.xfloat);
1086			break;
1087			case FFI_PL_TYPE_DOUBLE:
1088	59		XSRETURN_NV(result.xdouble);
1089			break;
1090			case FFI_PL_TYPE_OPAQUE:
1091			case FFI_PL_TYPE_STRING:
1092	705	100	if(result.pointer == NULL)
		100
1093			{
1094	33	100	if(self->platypus_api >= 2)
		100
1095			{
1096	9		XSRETURN_UNDEF;
1097			}
1098			else
1099			{
1100	24		XSRETURN_EMPTY;
1101			}
1102			}
1103			else
1104			{
1105	672		switch(type_code)
1106			{
1107			case FFI_PL_TYPE_OPAQUE:
1108	504		XSRETURN_IV(PTR2IV(result.pointer));
1109			break;
1110			case FFI_PL_TYPE_STRING:
1111	168		XSRETURN_PV(result.pointer);
1112			break;
1113			}
1114			}
1115	0		break;
1116			#ifdef FFI_PL_PROBE_LONGDOUBLE
1117			case FFI_PL_TYPE_LONG_DOUBLE:
1118			{
1119			#if !(defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE))
1120	1	0	if(MY_CXT.loaded_math_longdouble == 1)
		50
1121			{
1122			SV *sv;
1123			long double *ptr;
1124	0		Newx(ptr, 1, long double);
1125	0		*ptr = result.longdouble;
1126	0		sv = sv_newmortal();
1127	0		sv_setref_pv(sv, "Math::LongDouble", (void*)ptr);
1128	0		ST(0) = sv;
1129	0		XSRETURN(1);
1130			}
1131			else
1132			{
1133			#endif
1134	1		XSRETURN_NV((NV) result.longdouble);
1135			#if !(defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE))
1136			}
1137			#endif
1138			}
1139			#endif
1140			#ifdef FFI_PL_PROBE_COMPLEX
1141			case FFI_PL_TYPE_COMPLEX_FLOAT:
1142			{
1143			SV *c[2];
1144			AV *av;
1145
1146	15		c[0] = sv_2mortal(newSVnv( ((float*)&result.complex_float)[0]) );
1147	15		c[1] = sv_2mortal(newSVnv( ((float*)&result.complex_float)[1]) );
1148	15		av = av_make(2,c);
1149	15		ST(0) = sv_2mortal(newRV_noinc((SV*) av));
1150	15		XSRETURN(1);
1151			}
1152			break;
1153			case FFI_PL_TYPE_COMPLEX_DOUBLE:
1154			{
1155			SV *c[2];
1156			AV *av;
1157
1158	15		c[0] = sv_2mortal(newSVnv( ((double*)&result.complex_double)[0]) );
1159	15		c[1] = sv_2mortal(newSVnv( ((double*)&result.complex_double)[1]) );
1160	15		av = av_make(2,c);
1161	15		ST(0) = sv_2mortal(newRV_noinc((SV*) av));
1162	15		XSRETURN(1);
1163			}
1164			break;
1165			#endif
1166			case FFI_PL_TYPE_RECORD:
1167			case FFI_PL_TYPE_RECORD \| FFI_PL_SHAPE_CUSTOM_PERL:
1168	26	100	if(result.pointer == NULL)
		100
1169			{
1170	8	100	if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL)
		50
1171			{
1172	1		MY_CXT.current_argv = arguments;
1173
1174	1		ST(0) = ffi_pl_custom_perl(
1175	1		self->return_type->extra[0].custom_perl.native_to_perl,
1176			&PL_sv_undef,
1177			-1
1178			);
1179
1180	1		MY_CXT.current_argv = NULL;
1181	2	100	ffi_pl_heap_free();
		0
1182	1		XSRETURN(1);
1183			}
1184	7	100	if(self->platypus_api >= 2)
		100
1185			{
1186	2		XSRETURN_UNDEF;
1187			}
1188			else
1189			{
1190	5		XSRETURN_EMPTY;
1191			}
1192			}
1193			else
1194			{
1195			SV *ref;
1196	18		SV *value = newSV(0);
1197	18		sv_setpvn(value, result.pointer, self->return_type->extra[0].record.size);
1198	18		if(self->return_type->extra[0].record.class != NULL)
1199			{
1200	5		ref = sv_2mortal(newRV_noinc(value));
1201	5		sv_bless(ref, gv_stashpv(self->return_type->extra[0].record.class, GV_ADD));
1202			}
1203			else
1204			{
1205	13		ref = sv_2mortal(value);
1206			}
1207
1208	18	100	if((type_code & FFI_PL_SHAPE_MASK) == FFI_PL_SHAPE_CUSTOM_PERL)
		50
1209			{
1210	1		MY_CXT.current_argv = arguments;
1211
1212	1		ST(0) = ffi_pl_custom_perl(
1213	1		self->return_type->extra[0].custom_perl.native_to_perl,
1214			ref,
1215			-1
1216			);
1217
1218	1		MY_CXT.current_argv = NULL;
1219	2	100	ffi_pl_heap_free();
		0
1220			}
1221			else
1222			{
1223	17		ST(0) = ref;
1224			}
1225
1226	18		XSRETURN(1);
1227			}
1228			break;
1229			case FFI_PL_SHAPE_OBJECT \| FFI_PL_TYPE_OPAQUE:
1230	8	100	if(result.pointer == NULL)
		0
1231			{
1232	4	100	if(self->platypus_api >= 2)
		0
1233			{
1234	2		XSRETURN_UNDEF;
1235			}
1236			else
1237			{
1238	2		XSRETURN_EMPTY;
1239			}
1240			}
1241			else
1242			{
1243			SV *ref;
1244	4		SV *value = newSV(0);
1245	4		sv_setiv(value, PTR2IV(((void*)result.pointer)));
1246	4		ref = ST(0) = sv_2mortal(newRV_noinc(value));
1247	4		sv_bless(ref, gv_stashpv(self->return_type->extra[0].object.class, GV_ADD));
1248	4		XSRETURN(1);
1249			}
1250			break;
1251			default:
1252
1253	323		switch(type_code & FFI_PL_SHAPE_MASK)
1254			{
1255
1256			/*
1257			* RETURN VALUE - TYPE POINTER
1258			*/
1259
1260			case FFI_PL_SHAPE_POINTER:
1261	118	0	if(result.pointer == NULL)
		100
1262			{
1263	39	0	if(self->platypus_api >= 2)
		100
1264			{
1265	13		XSRETURN_UNDEF;
1266			}
1267			else
1268			{
1269	26		XSRETURN_EMPTY;
1270			}
1271			}
1272			else
1273			{
1274			SV *value;
1275	79		switch(type_code)
1276			{
1277			case FFI_PL_TYPE_UINT8 \| FFI_PL_SHAPE_POINTER:
1278	6		value = newSV(0);
1279	6		sv_setuv(value, ((uint8_t) result.pointer));
1280	6		break;
1281			case FFI_PL_TYPE_SINT8 \| FFI_PL_SHAPE_POINTER:
1282	6		value = newSV(0);
1283	6		sv_setiv(value, ((int8_t) result.pointer));
1284	6		break;
1285			case FFI_PL_TYPE_UINT16 \| FFI_PL_SHAPE_POINTER:
1286	6		value = newSV(0);
1287	6		sv_setuv(value, ((uint16_t) result.pointer));
1288	6		break;
1289			case FFI_PL_TYPE_SINT16 \| FFI_PL_SHAPE_POINTER:
1290	6		value = newSV(0);
1291	6		sv_setiv(value, ((int16_t) result.pointer));
1292	6		break;
1293			case FFI_PL_TYPE_UINT32 \| FFI_PL_SHAPE_POINTER:
1294	6		value = newSV(0);
1295	6		sv_setuv(value, ((uint32_t) result.pointer));
1296	6		break;
1297			case FFI_PL_TYPE_SINT32 \| FFI_PL_SHAPE_POINTER:
1298	6		value = newSV(0);
1299	6		sv_setiv(value, ((int32_t) result.pointer));
1300	6		break;
1301			case FFI_PL_TYPE_UINT64 \| FFI_PL_SHAPE_POINTER:
1302	6		value = newSV(0);
1303	6		sv_setu64(value, ((uint64_t) result.pointer));
1304	6		break;
1305			case FFI_PL_TYPE_SINT64 \| FFI_PL_SHAPE_POINTER:
1306	6		value = newSV(0);
1307	6		sv_seti64(value, ((int64_t) result.pointer));
1308	6		break;
1309			case FFI_PL_TYPE_FLOAT \| FFI_PL_SHAPE_POINTER:
1310	6		value = newSV(0);
1311	6		sv_setnv(value, ((float) result.pointer));
1312	6		break;
1313			case FFI_PL_TYPE_DOUBLE \| FFI_PL_SHAPE_POINTER:
1314	6		value = newSV(0);
1315	6		sv_setnv(value, ((double) result.pointer));
1316	6		break;
1317			case FFI_PL_TYPE_OPAQUE \| FFI_PL_SHAPE_POINTER:
1318	6	0	if( ((void*)result.pointer) == NULL )
		100
1319	3		value = &PL_sv_undef;
1320			else
1321			{
1322	3		value = newSV(0);
1323	3		sv_setiv(value, PTR2IV(((void*)result.pointer)));
1324			}
1325	6		break;
1326			#ifdef FFI_PL_PROBE_LONGDOUBLE
1327			case FFI_PL_TYPE_LONG_DOUBLE \| FFI_PL_SHAPE_POINTER:
1328	1		value = newSV(0);
1329	1	0	ffi_pl_long_double_to_perl(value, (long double*)result.pointer);
		0
		0
		0
		50
		0
		0
		50
1330	1		break;
1331			#endif
1332			#ifdef FFI_PL_PROBE_COMPLEX
1333			case FFI_PL_TYPE_COMPLEX_FLOAT \| FFI_PL_SHAPE_POINTER:
1334			{
1335			SV *c[2];
1336			AV *av;
1337	3		c[0] = sv_2mortal(newSVnv( ((float*)result.pointer)[0] ));
1338	3		c[1] = sv_2mortal(newSVnv( ((float*)result.pointer)[1] ));
1339	3		av = av_make(2, c);
1340	3		value = newRV_noinc((SV*)av);
1341			}
1342	3		break;
1343			case FFI_PL_TYPE_COMPLEX_DOUBLE \| FFI_PL_SHAPE_POINTER:
1344			{
1345			SV *c[2];
1346			AV *av;
1347	3		c[0] = sv_2mortal(newSVnv( ((double*)result.pointer)[0] ));
1348	3		c[1] = sv_2mortal(newSVnv( ((double*)result.pointer)[1] ));
1349	3		av = av_make(2, c);
1350	3		value = newRV_noinc((SV*)av);
1351			}
1352	3		break;
1353			#endif
1354			case FFI_PL_TYPE_STRING \| FFI_PL_SHAPE_POINTER:
1355	6		value = newSV(0);
1356	6		if( ((void*)result.pointer) == NULL )
1357	3		value = &PL_sv_undef;
1358			else
1359	3		sv_setpv(value, (char*) result.pointer);
1360	6		break;
1361			default:
1362	0		warn("return type not supported");
1363	0		XSRETURN_EMPTY;
1364			}
1365	79		ST(0) = sv_2mortal(newRV_noinc(value));
1366	79		XSRETURN(1);
1367			}
1368			break;
1369
1370			/*
1371			* RETURN VALUE - TYPE ARRAY
1372			*/
1373
1374			case FFI_PL_SHAPE_ARRAY:
1375	112	100	if(result.pointer == NULL)
		100
1376			{
1377	36	100	if(self->platypus_api >= 2)
		100
1378			{
1379	12		XSRETURN_UNDEF;
1380			}
1381			else
1382			{
1383	24		XSRETURN_EMPTY;
1384			}
1385			}
1386			else
1387			{
1388	76		int count = self->return_type->extra[0].array.element_count;
1389	76	100	if(count == 0 && type_code & FFI_PL_TYPE_OPAQUE)
		50
		100
		50
1390			{
1391	39	100	while(((void**)result.pointer)[count] != NULL)
		100
1392	26		count++;
1393			}
1394			AV *av;
1395			SV **sv;
1396	76	50	Newx(sv, count, SV*);
		50
1397	76		switch(type_code)
1398			{
1399			case FFI_PL_TYPE_UINT8 \| FFI_PL_SHAPE_ARRAY:
1400	67	100	for(i=0; i
		100
1401			{
1402	57		sv[i] = sv_2mortal( newSVuv( ((uint8_t*)result.pointer)[i] ));
1403			}
1404	10		break;
1405			case FFI_PL_TYPE_SINT8 \| FFI_PL_SHAPE_ARRAY:
1406	37	0	for(i=0; i
		100
1407			{
1408	33		sv[i] = sv_2mortal( newSViv( ((int8_t*)result.pointer)[i] ) );
1409			}
1410	4		break;
1411			case FFI_PL_TYPE_UINT16 \| FFI_PL_SHAPE_ARRAY:
1412	37	0	for(i=0; i
		100
1413			{
1414	33		sv[i] = sv_2mortal( newSVuv( ((uint16_t*)result.pointer)[i] ) );
1415			}
1416	4		break;
1417			case FFI_PL_TYPE_SINT16 \| FFI_PL_SHAPE_ARRAY:
1418	37	0	for(i=0; i
		100
1419			{
1420	33		sv[i] = sv_2mortal( newSViv( ((int16_t*)result.pointer)[i] ) );
1421			}
1422	4		break;
1423			case FFI_PL_TYPE_UINT32 \| FFI_PL_SHAPE_ARRAY:
1424	37	0	for(i=0; i
		100
1425			{
1426	33		sv[i] = sv_2mortal( newSVuv( ((uint32_t*)result.pointer)[i] ) );
1427			}
1428	4		break;
1429			case FFI_PL_TYPE_SINT32 \| FFI_PL_SHAPE_ARRAY:
1430	37	0	for(i=0; i
		100
1431			{
1432	33		sv[i] = sv_2mortal( newSViv( ((int32_t*)result.pointer)[i] ) );
1433			}
1434	4		break;
1435			case FFI_PL_TYPE_UINT64 \| FFI_PL_SHAPE_ARRAY:
1436	37	0	for(i=0; i
		100
1437			{
1438	33		sv[i] = sv_2mortal( newSVu64( ((uint64_t*)result.pointer)[i] ) );
1439			}
1440	4		break;
1441			case FFI_PL_TYPE_SINT64 \| FFI_PL_SHAPE_ARRAY:
1442	37	0	for(i=0; i
		100
1443			{
1444	33		sv[i] = sv_2mortal( newSVi64( ((int64_t*)result.pointer)[i] ) );
1445			}
1446	4		break;
1447			case FFI_PL_TYPE_FLOAT \| FFI_PL_SHAPE_ARRAY:
1448	33	0	for(i=0; i
		100
1449			{
1450	30		sv[i] = sv_2mortal( newSVnv( ((float*)result.pointer)[i] ) );
1451			}
1452	3		break;
1453			case FFI_PL_TYPE_DOUBLE \| FFI_PL_SHAPE_ARRAY:
1454	33	0	for(i=0; i
		100
1455			{
1456	30		sv[i] = sv_2mortal( newSVnv( ((double*)result.pointer)[i] ) );
1457			}
1458	3		break;
1459			case FFI_PL_TYPE_STRING \| FFI_PL_SHAPE_ARRAY:
1460			case FFI_PL_TYPE_OPAQUE \| FFI_PL_SHAPE_ARRAY:
1461	87	100	for(i=0; i
		100
1462			{
1463	62	100	if( ((void**)result.pointer)[i] == NULL)
		100
1464			{
1465	12		sv[i] = &PL_sv_undef;
1466			}
1467			else
1468			{
1469	50		switch(type_code) {
1470			case FFI_PL_TYPE_STRING \| FFI_PL_SHAPE_ARRAY:
1471	27		sv[i] = sv_2mortal( newSVpv( ((char**)result.pointer)[i], 0 ) );
1472	27		break;
1473			case FFI_PL_TYPE_OPAQUE \| FFI_PL_SHAPE_ARRAY:
1474	23		sv[i] = sv_2mortal( newSViv( PTR2IV( ((void**)result.pointer)[i] )) );
1475	23		break;
1476			}
1477			}
1478			}
1479	25		break;
1480			#ifdef FFI_PL_PROBE_LONGDOUBLE
1481			case FFI_PL_TYPE_LONG_DOUBLE \| FFI_PL_SHAPE_ARRAY:
1482	4	0	for(i=0; i
		100
1483			{
1484	3		sv[i] = sv_2mortal(newSV(0));
1485	3	0	ffi_pl_long_double_to_perl(sv[i], &((long double*)result.pointer)[i]);
		0
		0
		0
		50
		0
		0
		50
1486			}
1487	1		break;
1488			#endif
1489			#ifdef FFI_PL_PROBE_COMPLEX
1490			case FFI_PL_TYPE_COMPLEX_FLOAT \| FFI_PL_SHAPE_ARRAY:
1491	12	100	for(i=0; i
		0
1492			{
1493			SV *c[2];
1494			AV *av;
1495	9		c[0] = sv_2mortal(newSVnv(((float)result.pointer)[i2]));
1496	9		c[1] = sv_2mortal(newSVnv(((float)result.pointer)[i2+1]));
1497	9		av = av_make(2, c);
1498	9		sv[i] = sv_2mortal(newRV_noinc((SV*)av));
1499			}
1500	3		break;
1501			case FFI_PL_TYPE_COMPLEX_DOUBLE \| FFI_PL_SHAPE_ARRAY:
1502	12	100	for(i=0; i
		0
1503			{
1504			SV *c[2];
1505			AV *av;
1506	9		c[0] = sv_2mortal(newSVnv(((double)result.pointer)[i2]));
1507	9		c[1] = sv_2mortal(newSVnv(((double)result.pointer)[i2+1]));
1508	9		av = av_make(2, c);
1509	9		sv[i] = sv_2mortal(newRV_noinc((SV*)av));
1510			}
1511	3		break;
1512			#endif
1513			default:
1514	0		warn("return type not supported");
1515	0		XSRETURN_EMPTY;
1516			}
1517	76		av = av_make(count, sv);
1518	76		Safefree(sv);
1519	76		ST(0) = sv_2mortal(newRV_noinc((SV*)av));
1520	76		XSRETURN(1);
1521			}
1522			break;
1523
1524			/*
1525			* RETURN VALUE - CUSTOM PERL
1526			*/
1527
1528			case FFI_PL_SHAPE_CUSTOM_PERL:
1529			{
1530	77		SV ret_in=NULL, ret_out;
1531	77		switch(type_code)
1532			{
1533			/* TODO: FFI_PL_BASE_VOID, FFI_PL_BASE_COMPLEX, FFI_PL_BASE_STRING, FFI_PL_BASE_CLOSURE, FFI_PL_BASE_RECORD */
1534			case FFI_PL_TYPE_UINT8 \| FFI_PL_SHAPE_CUSTOM_PERL:
1535			#if defined FFI_PL_PROBE_BIGENDIAN
1536			ret_in = newSVuv(result.uint8_array[3]);
1537			#elif defined FFI_PL_PROBE_BIGENDIAN64
1538			ret_in = newSVuv(result.uint8_array[7]);
1539			#else
1540	4		ret_in = newSVuv(result.uint8);
1541			#endif
1542	4		break;
1543			case FFI_PL_TYPE_SINT8 \| FFI_PL_SHAPE_CUSTOM_PERL:
1544			#if defined FFI_PL_PROBE_BIGENDIAN
1545			ret_in = newSViv(result.sint8_array[3]);
1546			#elif defined FFI_PL_PROBE_BIGENDIAN64
1547			ret_in = newSViv(result.sint8_array[7]);
1548			#else
1549	3		ret_in = newSViv(result.sint8);
1550			#endif
1551	3		break;
1552			case FFI_PL_TYPE_UINT16 \| FFI_PL_SHAPE_CUSTOM_PERL:
1553			#if defined FFI_PL_PROBE_BIGENDIAN
1554			ret_in = newSVuv(result.uint16_array[1]);
1555			#elif defined FFI_PL_PROBE_BIGENDIAN64
1556			ret_in = newSVuv(result.uint16_array[3]);
1557			#else
1558	3		ret_in = newSVuv(result.uint16);
1559			#endif
1560	3		break;
1561			case FFI_PL_TYPE_SINT16 \| FFI_PL_SHAPE_CUSTOM_PERL:
1562			#if defined FFI_PL_PROBE_BIGENDIAN
1563			ret_in = newSViv(result.sint16_array[1]);
1564			#elif defined FFI_PL_PROBE_BIGENDIAN64
1565			ret_in = newSViv(result.sint16_array[3]);
1566			#else
1567	3		ret_in = newSViv(result.sint16);
1568			#endif
1569	3		break;
1570			case FFI_PL_TYPE_UINT32 \| FFI_PL_SHAPE_CUSTOM_PERL:
1571			#if defined FFI_PL_PROBE_BIGENDIAN64
1572			ret_in = newSVuv(result.uint32_array[1]);
1573			#else
1574	3		ret_in = newSVuv(result.uint32);
1575			#endif
1576	3		break;
1577			case FFI_PL_TYPE_SINT32 \| FFI_PL_SHAPE_CUSTOM_PERL:
1578			#if defined FFI_PL_PROBE_BIGENDIAN64
1579			ret_in = newSViv(result.sint32_array[1]);
1580			#else
1581	3		ret_in = newSViv(result.sint32);
1582			#endif
1583	3		break;
1584			case FFI_PL_TYPE_UINT64 \| FFI_PL_SHAPE_CUSTOM_PERL:
1585	3		ret_in = newSVu64(result.uint64);
1586	3		break;
1587			case FFI_PL_TYPE_SINT64 \| FFI_PL_SHAPE_CUSTOM_PERL:
1588	3		ret_in = newSVi64(result.sint64);
1589	3		break;
1590			case FFI_PL_TYPE_FLOAT \| FFI_PL_SHAPE_CUSTOM_PERL:
1591	3		ret_in = newSVnv(result.xfloat);
1592	3		break;
1593			case FFI_PL_TYPE_DOUBLE \| FFI_PL_SHAPE_CUSTOM_PERL:
1594	3		ret_in = newSVnv(result.xdouble);
1595	3		break;
1596			case FFI_PL_TYPE_OPAQUE \| FFI_PL_SHAPE_CUSTOM_PERL:
1597	46	100	if(result.pointer != NULL)
		100
1598	42		ret_in = newSViv(PTR2IV(result.pointer));
1599	46		break;
1600			default:
1601	0	0	ffi_pl_heap_free();
		0
1602	0		warn("return type not supported");
1603	0		XSRETURN_EMPTY;
1604			}
1605
1606	77		MY_CXT.current_argv = arguments;
1607
1608	77	100	ret_out = ffi_pl_custom_perl(
		100
1609	77		self->return_type->extra[0].custom_perl.native_to_perl,
1610			ret_in != NULL ? ret_in : &PL_sv_undef,
1611			-1
1612			);
1613
1614	76		MY_CXT.current_argv = NULL;
1615
1616	176	100	ffi_pl_heap_free();
		100
1617
1618	76	100	if(ret_in != NULL)
		100
1619			{
1620	72		SvREFCNT_dec(ret_in);
1621			}
1622
1623	76	100	if(ret_out == NULL)
		100
1624			{
1625	3	50	if(self->platypus_api >= 2)
		50
1626			{
1627	0		XSRETURN_UNDEF;
1628			}
1629			else
1630			{
1631	3		XSRETURN_EMPTY;
1632			}
1633			}
1634			else
1635			{
1636	73		ST(0) = sv_2mortal(ret_out);
1637	73		XSRETURN(1);
1638			}
1639
1640			}
1641			break;
1642
1643			case FFI_PL_SHAPE_OBJECT:
1644			{
1645			SV *ref;
1646	16		SV *value = newSV(0);
1647	16		switch(type_code)
1648			{
1649			case FFI_PL_TYPE_SINT8 \| FFI_PL_SHAPE_OBJECT:
1650			#if defined FFI_PL_PROBE_BIGENDIAN
1651			sv_setiv(value, result.sint8_array[3]);
1652			#elif defined FFI_PL_PROBE_BIGENDIAN64
1653			sv_setiv(value, result.sint8_array[7]);
1654			#else
1655	2		sv_setiv(value, result.sint8);
1656			#endif
1657	2		break;
1658			case FFI_PL_TYPE_UINT8 \| FFI_PL_SHAPE_OBJECT:
1659			#if defined FFI_PL_PROBE_BIGENDIAN
1660			sv_setuv(value, result.uint8_array[3]);
1661			#elif defined FFI_PL_PROBE_BIGENDIAN64
1662			sv_setuv(value, result.uint8_array[7]);
1663			#else
1664	2		sv_setuv(value, result.uint8);
1665			#endif
1666	2		break;
1667			case FFI_PL_TYPE_SINT16 \| FFI_PL_SHAPE_OBJECT:
1668			#if defined FFI_PL_PROBE_BIGENDIAN
1669			sv_setiv(value, result.sint16_array[1]);
1670			#elif defined FFI_PL_PROBE_BIGENDIAN64
1671			sv_setiv(value, result.sint16_array[3]);
1672			#else
1673	2		sv_setiv(value, result.sint16);
1674			#endif
1675	2		break;
1676			case FFI_PL_TYPE_UINT16 \| FFI_PL_SHAPE_OBJECT:
1677			#if defined FFI_PL_PROBE_BIGENDIAN
1678			sv_setiv(value, result.uint16_array[1]);
1679			#elif defined FFI_PL_PROBE_BIGENDIAN64
1680			sv_setuv(value, result.uint16_array[3]);
1681			#else
1682	2		sv_setuv(value, result.uint16);
1683			#endif
1684	2		break;
1685			case FFI_PL_TYPE_SINT32 \| FFI_PL_SHAPE_OBJECT:
1686			#if defined FFI_PL_PROBE_BIGENDIAN64
1687			sv_setiv(value, result.sint32_array[1]);
1688			#else
1689	2		sv_setiv(value, result.sint32);
1690			#endif
1691	2		break;
1692			case FFI_PL_TYPE_UINT32 \| FFI_PL_SHAPE_OBJECT:
1693			#if defined FFI_PL_PROBE_BIGENDIAN64
1694			sv_setuv(value, result.uint32_array[1]);
1695			#else
1696	2		sv_setuv(value, result.uint32);
1697			#endif
1698	2		break;
1699			case FFI_PL_TYPE_SINT64 \| FFI_PL_SHAPE_OBJECT:
1700	2		sv_seti64(value, result.sint64);
1701	2		break;
1702			case FFI_PL_TYPE_UINT64 \| FFI_PL_SHAPE_OBJECT:
1703	2		sv_setu64(value, result.uint64);
1704	2		break;
1705			default:
1706	0		break;
1707			}
1708	16		ref = ST(0) = sv_2mortal(newRV_noinc(value));
1709	16		sv_bless(ref, gv_stashpv(self->return_type->extra[0].object.class, GV_ADD));
1710	16		XSRETURN(1);
1711			}
1712			break;
1713
1714			default:
1715	0		warn("return type not supported");
1716	0		XSRETURN_EMPTY;
1717			break;
1718			}
1719			#endif
1720			}
1721			}
1722
1723	0		warn("return type not supported");
1724	2048		XSRETURN_EMPTY;
1725
1726			#undef EXTRA_ARGS
1727			#undef FFI_PL_CALL_NO_RECORD_VALUE
1728			#undef FFI_PL_CALL_RET_NO_NORMAL
1729			#undef RESULT