1 /* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
2 
3 static void _prepare_c_invocation_info (GPerlI11nCInvocationInfo *iinfo,
4                                         GICallableInfo *info,
5                                         IV items,
6                                         UV internal_stack_offset,
7                                         const gchar *package,
8                                         const gchar *namespace,
9                                         const gchar *function);
10 static void _clear_c_invocation_info (GPerlI11nCInvocationInfo *iinfo);
11 static void _check_n_args (GPerlI11nCInvocationInfo *iinfo);
12 static void _handle_automatic_arg (guint pos,
13                                    GIArgInfo * arg_info,
14                                    GITypeInfo * arg_type,
15                                    GIArgument * arg,
16                                    GPerlI11nCInvocationInfo * invocation_info);
17 static gpointer _allocate_out_mem (GITypeInfo *arg_type);
18 
19 static void
invoke_c_code(GICallableInfo * info,gpointer func_pointer,SV ** sp,I32 ax,SV ** mark,I32 items,UV internal_stack_offset,const gchar * package,const gchar * namespace,const gchar * function)20 invoke_c_code (GICallableInfo *info,
21                gpointer func_pointer,
22                SV **sp, I32 ax, SV **mark, I32 items, /* these correspond to dXSARGS */
23                UV internal_stack_offset,
24                const gchar *package,
25                const gchar *namespace,
26                const gchar *function)
27 {
28 	ffi_cif cif;
29 	gpointer instance = NULL;
30 	guint i;
31 	GPerlI11nCInvocationInfo iinfo;
32 	guint n_return_values;
33 #if GI_CHECK_VERSION (1, 32, 0)
34 	GIFFIReturnValue ffi_return_value;
35 #endif
36 	gpointer return_value_p;
37 	GIArgument return_value;
38 	GError * local_error = NULL;
39 	gpointer local_error_address = &local_error;
40 
41 	PERL_UNUSED_VAR (mark);
42 
43 	_prepare_c_invocation_info (&iinfo, info, items, internal_stack_offset,
44 	                            package, namespace, function);
45 
46 	_check_n_args (&iinfo);
47 
48 	if (iinfo.is_method) {
49 		instance = instance_sv_to_pointer (info, ST (0 + iinfo.stack_offset), &iinfo.base);
50 		iinfo.arg_types_ffi[0] = &ffi_type_pointer;
51 		iinfo.args[0] = &instance;
52 	}
53 
54 	/*
55 	 * --- handle arguments -----------------------------------------------
56 	 */
57 
58 	for (i = 0 ; i < iinfo.base.n_args ; i++) {
59 		GIArgInfo * arg_info;
60 		GITypeInfo * arg_type;
61 		GITransfer transfer;
62 		gboolean may_be_null = FALSE, is_skipped = FALSE;
63 		gint perl_stack_pos, ffi_stack_pos;
64 		SV *current_sv;
65 
66 		arg_info = &(iinfo.base.arg_infos[i]);
67 		arg_type = &(iinfo.base.arg_types[i]);
68 		transfer = g_arg_info_get_ownership_transfer (arg_info);
69 		may_be_null = g_arg_info_may_be_null (arg_info);
70 #if GI_CHECK_VERSION (1, 29, 0)
71 		is_skipped = g_arg_info_is_skip (arg_info);
72 #endif
73 		perl_stack_pos = (gint) i
74 		               + (gint) iinfo.constructor_offset
75 		               + (gint) iinfo.method_offset
76 		               + (gint) iinfo.stack_offset
77 		               + iinfo.dynamic_stack_offset;
78 		ffi_stack_pos = (gint) i
79 		              + (gint) iinfo.method_offset;
80 		g_assert (perl_stack_pos >= 0 && ffi_stack_pos >= 0);
81 
82 		/* FIXME: Is this right?  I'm confused about the relation of
83 		 * the numbers in g_callable_info_get_arg and
84 		 * g_arg_info_get_closure and g_arg_info_get_destroy.  We used
85 		 * to add method_offset, but that stopped being correct at some
86 		 * point. */
87 		iinfo.base.current_pos = i; /* + method_offset; */
88 
89 		dwarn ("arg %d: tag = %d (%s), is_pointer = %d, is_automatic = %d\n",
90 		       i,
91 		       g_type_info_get_tag (arg_type),
92 		       g_type_tag_to_string (g_type_info_get_tag (arg_type)),
93 		       g_type_info_is_pointer (arg_type),
94 		       iinfo.is_automatic_arg[i]);
95 
96 		/* Use undef for missing args (due to the checks above, these
97 		 * must be nullable). */
98 		current_sv = perl_stack_pos < items ? ST (perl_stack_pos) : &PL_sv_undef;
99 
100 		switch (g_arg_info_get_direction (arg_info)) {
101 		    case GI_DIRECTION_IN:
102 			if (iinfo.is_automatic_arg[i]) {
103 				iinfo.dynamic_stack_offset--;
104 			} else if (is_skipped) {
105 				iinfo.dynamic_stack_offset--;
106 			} else {
107 				sv_to_arg (current_sv,
108 				           &iinfo.in_args[i], arg_info, arg_type,
109 				           transfer, may_be_null, &iinfo.base);
110 			}
111 			iinfo.arg_types_ffi[ffi_stack_pos] =
112 				g_type_info_get_ffi_type (arg_type);
113 			iinfo.args[ffi_stack_pos] = &iinfo.in_args[i];
114 			break;
115 
116 		    case GI_DIRECTION_OUT:
117 			if (g_arg_info_is_caller_allocates (arg_info)) {
118 				iinfo.base.aux_args[i].v_pointer =
119 					_allocate_out_mem (arg_type);
120 				iinfo.out_args[i].v_pointer = &iinfo.base.aux_args[i];
121 				iinfo.args[ffi_stack_pos] = &iinfo.base.aux_args[i];
122 			} else {
123 				iinfo.out_args[i].v_pointer = &iinfo.base.aux_args[i];
124 				iinfo.args[ffi_stack_pos] = &iinfo.out_args[i];
125 			}
126 			iinfo.arg_types_ffi[ffi_stack_pos] = &ffi_type_pointer;
127 			/* Adjust the dynamic stack offset so that this out
128 			 * argument doesn't inadvertedly eat up an in argument. */
129 			iinfo.dynamic_stack_offset--;
130 			break;
131 
132 		    case GI_DIRECTION_INOUT:
133 			iinfo.in_args[i].v_pointer =
134 				iinfo.out_args[i].v_pointer =
135 					&iinfo.base.aux_args[i];
136 			if (iinfo.is_automatic_arg[i]) {
137 				iinfo.dynamic_stack_offset--;
138 			} else if (is_skipped) {
139 				iinfo.dynamic_stack_offset--;
140 			} else {
141 				/* We pass iinfo.in_args[i].v_pointer here,
142 				 * not &iinfo.in_args[i], so that the value
143 				 * pointed to is filled from the SV. */
144 				sv_to_arg (current_sv,
145 				           iinfo.in_args[i].v_pointer, arg_info, arg_type,
146 				           transfer, may_be_null, &iinfo.base);
147 			}
148 			iinfo.arg_types_ffi[ffi_stack_pos] = &ffi_type_pointer;
149 			iinfo.args[ffi_stack_pos] = &iinfo.in_args[i];
150 			break;
151 		}
152 	}
153 
154 	/* do another pass to handle automatic args */
155 	for (i = 0 ; i < iinfo.base.n_args ; i++) {
156 		GIArgInfo * arg_info;
157 		GITypeInfo * arg_type;
158 		if (!iinfo.is_automatic_arg[i])
159 			continue;
160 		arg_info = &(iinfo.base.arg_infos[i]);
161 		arg_type = &(iinfo.base.arg_types[i]);
162 		switch (g_arg_info_get_direction (arg_info)) {
163 		    case GI_DIRECTION_IN:
164 			_handle_automatic_arg (i, arg_info, arg_type, &iinfo.in_args[i], &iinfo);
165 			break;
166 		    case GI_DIRECTION_INOUT:
167 			_handle_automatic_arg (i, arg_info, arg_type, &iinfo.base.aux_args[i], &iinfo);
168 			break;
169 		    case GI_DIRECTION_OUT:
170 			/* handled later */
171 			break;
172 		}
173 	}
174 
175 	if (iinfo.throws) {
176 		iinfo.args[iinfo.n_invoke_args - 1] = &local_error_address;
177 		iinfo.arg_types_ffi[iinfo.n_invoke_args - 1] = &ffi_type_pointer;
178 	}
179 
180 	/*
181 	 * --- prepare & call -------------------------------------------------
182 	 */
183 
184 	/* prepare and call the function */
185 	if (FFI_OK != ffi_prep_cif (&cif, FFI_DEFAULT_ABI, iinfo.n_invoke_args,
186 	                            iinfo.base.return_type_ffi, iinfo.arg_types_ffi))
187 	{
188 		_clear_c_invocation_info (&iinfo);
189 		ccroak ("Could not prepare a call interface");
190 	}
191 
192 #if GI_CHECK_VERSION (1, 32, 0)
193 	return_value_p = &ffi_return_value;
194 #else
195 	return_value_p = &return_value;
196 #endif
197 
198 	/* Wrap the call in PUTBACK/SPAGAIN because the C function might end up
199 	 * calling Perl code (via a vfunc), which might reallocate the stack
200 	 * and hence invalidate 'sp'. */
201 	PUTBACK;
202 	ffi_call (&cif, func_pointer, return_value_p, iinfo.args);
203 	SPAGAIN;
204 
205 	/* free call-scoped data */
206 	invoke_free_after_call_handlers (&iinfo.base);
207 
208 	if (local_error) {
209 		_clear_c_invocation_info (&iinfo);
210 		gperl_croak_gerror (NULL, local_error);
211 	}
212 
213 	/*
214 	 * --- handle return values -------------------------------------------
215 	 */
216 
217 #if GI_CHECK_VERSION (1, 32, 0)
218 	/* libffi has special semantics for return value storage; see `man
219 	 * ffi_call`.  We use gobject-introspection's extraction helper. */
220 	gi_type_info_extract_ffi_return_value (&iinfo.base.return_type_info,
221 	                                       &ffi_return_value,
222 	                                       &return_value);
223 #endif
224 
225 	n_return_values = 0;
226 
227 	/* place return value and output args on the stack */
228 	if (iinfo.base.has_return_value
229 #if GI_CHECK_VERSION (1, 29, 0)
230 	    && !g_callable_info_skip_return ((GICallableInfo *) info)
231 #endif
232 	   )
233 	{
234 		SV *value;
235 		dwarn ("return value: type = %p\n", &iinfo.base.return_type_info);
236 		value = SAVED_STACK_SV (arg_to_sv (&return_value,
237 		                                   &iinfo.base.return_type_info,
238 		                                   iinfo.base.return_type_transfer,
239 		                                   GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
240 		                                   &iinfo.base));
241 		if (value) {
242 			XPUSHs (sv_2mortal (value));
243 			n_return_values++;
244 		}
245 	}
246 
247 	/* out args */
248 	for (i = 0 ; i < iinfo.base.n_args ; i++) {
249 		GIArgInfo * arg_info;
250 		if (iinfo.is_automatic_arg[i])
251 			continue;
252 		arg_info = &(iinfo.base.arg_infos[i]);
253 #if GI_CHECK_VERSION (1, 29, 0)
254 		if (g_arg_info_is_skip (arg_info)) {
255 			continue;
256 		}
257 #endif
258 		switch (g_arg_info_get_direction (arg_info)) {
259 		    case GI_DIRECTION_OUT:
260 		    case GI_DIRECTION_INOUT:
261 		    {
262 			GITransfer transfer;
263 			SV *sv;
264 			dwarn ("out/inout arg at pos %d\n", i);
265 			/* If we allocated the memory ourselves, we always own it. */
266 			transfer = g_arg_info_is_caller_allocates (arg_info)
267 			         ? GI_TRANSFER_CONTAINER
268 			         : g_arg_info_get_ownership_transfer (arg_info);
269 			sv = SAVED_STACK_SV (arg_to_sv (iinfo.out_args[i].v_pointer,
270 			                                &(iinfo.base.arg_types[i]),
271 			                                transfer,
272 			                                GPERL_I11N_MEMORY_SCOPE_IRRELEVANT,
273 			                                &iinfo.base));
274 			if (sv) {
275 				XPUSHs (sv_2mortal (sv));
276 				n_return_values++;
277 			}
278 			break;
279 		    }
280 
281 		    default:
282 			break;
283 		}
284 	}
285 
286 	_clear_c_invocation_info (&iinfo);
287 
288 	dwarn ("n_return_values = %d\n", n_return_values);
289 
290 	PUTBACK;
291 }
292 
293 /* ------------------------------------------------------------------------- */
294 
295 static void
_prepare_c_invocation_info(GPerlI11nCInvocationInfo * iinfo,GICallableInfo * info,IV items,UV internal_stack_offset,const gchar * package,const gchar * namespace,const gchar * function)296 _prepare_c_invocation_info (GPerlI11nCInvocationInfo *iinfo,
297                             GICallableInfo *info,
298                             IV items,
299                             UV internal_stack_offset,
300                             const gchar *package,
301                             const gchar *namespace,
302                             const gchar *function)
303 {
304 	guint i;
305 
306 	prepare_invocation_info ((GPerlI11nInvocationInfo *) iinfo, info);
307 
308 	dwarn ("%s::%s::%s => %s\n",
309 	       package, namespace, function,
310 	       g_base_info_get_name (info));
311 
312 	iinfo->target_package = package;
313 	iinfo->target_namespace = namespace;
314 	iinfo->target_function = function;
315 
316 	iinfo->stack_offset = (guint) internal_stack_offset;
317 	g_assert (items >= iinfo->stack_offset);
318 	iinfo->n_given_args = ((guint) items) - iinfo->stack_offset;
319 	iinfo->n_invoke_args = iinfo->base.n_args;
320 
321 	iinfo->is_constructor = FALSE;
322 	if (iinfo->base.is_function) {
323 		iinfo->is_constructor =
324 			g_function_info_get_flags (info) & GI_FUNCTION_IS_CONSTRUCTOR;
325 	}
326 
327 	/* FIXME: can a vfunc not throw? */
328 	iinfo->throws = FALSE;
329 	if (iinfo->base.is_function) {
330 		iinfo->throws =
331 			g_function_info_get_flags (info) & GI_FUNCTION_THROWS;
332 	}
333 	if (iinfo->throws) {
334 		/* Add one for the implicit GError arg. */
335 		iinfo->n_invoke_args++;
336 	}
337 
338 	if (iinfo->base.is_vfunc) {
339 		iinfo->is_method = TRUE;
340 	} else if (iinfo->base.is_callback) {
341 		iinfo->is_method = FALSE;
342 	} else {
343 		iinfo->is_method =
344 			(g_function_info_get_flags (info) & GI_FUNCTION_IS_METHOD)
345 			&& !iinfo->is_constructor;
346 	}
347 	if (iinfo->is_method) {
348 		/* Add one for the implicit invocant arg. */
349 		iinfo->n_invoke_args++;
350 	}
351 
352 	dwarn ("  args = %u, given = %u, invoke = %u\n",
353 	       iinfo->base.n_args,
354 	       iinfo->n_given_args,
355 	       iinfo->n_invoke_args);
356 
357 	dwarn ("  symbol = %s\n",
358 	       iinfo->base.is_vfunc ? g_base_info_get_name (info) : g_function_info_get_symbol (info));
359 
360 	dwarn ("  is_constructor = %d, is_method = %d, throws = %d\n",
361 	       iinfo->is_constructor, iinfo->is_method, iinfo->throws);
362 
363 	/* allocate enough space for all args in both the out and in lists.
364 	 * we'll only use as much as we need.  since function argument lists
365 	 * are typically small, this shouldn't be a big problem. */
366 	if (iinfo->n_invoke_args) {
367 		guint n = iinfo->n_invoke_args;
368 		iinfo->in_args = gperl_alloc_temp (sizeof (GIArgument) * n);
369 		iinfo->out_args = gperl_alloc_temp (sizeof (GIArgument) * n);
370 		iinfo->arg_types_ffi = gperl_alloc_temp (sizeof (ffi_type *) * n);
371 		iinfo->args = gperl_alloc_temp (sizeof (gpointer) * n);
372 		iinfo->is_automatic_arg = gperl_alloc_temp (sizeof (gboolean) * n);
373 	}
374 
375 	/* If we call a constructor, we skip the initial package name resulting
376 	 * from the "Package->new" syntax.  If we call a method, we handle the
377 	 * invocant separately. */
378 	iinfo->constructor_offset = iinfo->is_constructor ? 1 : 0;
379 	iinfo->method_offset = iinfo->is_method ? 1 : 0;
380 	iinfo->dynamic_stack_offset = 0;
381 
382 	/* Make a first pass to mark args that are filled in automatically, and
383 	 * thus have no counterpart on the Perl side. */
384 	for (i = 0 ; i < iinfo->base.n_args ; i++) {
385 		GIArgInfo * arg_info = &(iinfo->base.arg_infos[i]);
386 		GITypeInfo * arg_type = &(iinfo->base.arg_types[i]);
387 		GITypeTag arg_tag = g_type_info_get_tag (arg_type);
388 
389 		if (arg_tag == GI_TYPE_TAG_ARRAY) {
390 			gint pos = g_type_info_get_array_length (arg_type);
391 			if (pos >= 0) {
392 				dwarn ("  pos %d is automatic (array length)\n", pos);
393 				iinfo->is_automatic_arg[pos] = TRUE;
394 			}
395 		}
396 
397 		else if (arg_tag == GI_TYPE_TAG_INTERFACE) {
398 			GIBaseInfo * interface = g_type_info_get_interface (arg_type);
399 			GIInfoType info_type = g_base_info_get_type (interface);
400 			if (info_type == GI_INFO_TYPE_CALLBACK) {
401 				gint pos = g_arg_info_get_destroy (arg_info);
402 				if (pos >= 0) {
403 					dwarn ("  pos %d is automatic (callback destroy notify)\n", pos);
404 					iinfo->is_automatic_arg[pos] = TRUE;
405 				}
406 			}
407 			g_base_info_unref ((GIBaseInfo *) interface);
408 		}
409 	}
410 
411 	/* Make another pass to count the expected args. */
412 	iinfo->n_expected_args = iinfo->constructor_offset + iinfo->method_offset;
413 	iinfo->n_nullable_args = 0;
414 	for (i = 0 ; i < iinfo->base.n_args ; i++) {
415 		GIArgInfo * arg_info = &(iinfo->base.arg_infos[i]);
416 		GITypeInfo * arg_type = &(iinfo->base.arg_types[i]);
417 		GITypeTag arg_tag = g_type_info_get_tag (arg_type);
418 		gboolean is_out = GI_DIRECTION_OUT == g_arg_info_get_direction (arg_info);
419 		gboolean is_automatic = iinfo->is_automatic_arg[i];
420 		gboolean is_skipped = FALSE;
421 #if GI_CHECK_VERSION (1, 29, 0)
422 		is_skipped = g_arg_info_is_skip (arg_info);
423 #endif
424 
425 		if (!is_out && !is_automatic && !is_skipped)
426 			iinfo->n_expected_args++;
427 		/* Callback user data may always be NULL. */
428 		if (g_arg_info_may_be_null (arg_info) || arg_tag == GI_TYPE_TAG_VOID)
429 			iinfo->n_nullable_args++;
430 	}
431 
432 	/* If the return value is an array which comes with an outbound length
433 	 * arg, then mark that length arg as automatic, too. */
434 	if (g_type_info_get_tag (&iinfo->base.return_type_info) == GI_TYPE_TAG_ARRAY) {
435 		gint pos = g_type_info_get_array_length (&iinfo->base.return_type_info);
436 		if (pos >= 0) {
437 			GIArgInfo * arg_info = &(iinfo->base.arg_infos[pos]);
438 			if (GI_DIRECTION_OUT == g_arg_info_get_direction (arg_info)) {
439 				dwarn ("  pos %d is automatic (array length)\n", pos);
440 				iinfo->is_automatic_arg[pos] = TRUE;
441 			}
442 		}
443 	}
444 
445 	/* We need to undo the special handling that GInitiallyUnowned
446 	 * descendants receive from gobject-introspection: values of this type
447 	 * are always marked transfer=none, even for constructors.
448 	 *
449 	 * FIXME: This is not correct for GtkWindow and its descendants, as
450 	 * gtk+ keeps an internal reference to each window.  Hence,
451 	 * constructors like gtk_window_new return a non-floating object and do
452 	 * not pass ownership of a reference on to us.  But the sink func
453 	 * currently registered for GInitiallyUnowned (sink_initially_unowned
454 	 * in GObject.xs in Glib) is actually inadvertently conforming to this
455 	 * requirement.  It runs ref_sink+unref regardless of whether the
456 	 * object is floating or not.  So, in the non-floating window case, it
457 	 * does nothing, resulting in an extra reference taken, despite the
458 	 * request to transfer ownership.
459 	 *
460 	 * If we ever encounter a constructor of a GInitiallyUnowned descendant
461 	 * that returns a non-floating object and passes ownership of a
462 	 * reference on to us, or a constructor of a GInitiallyUnowned
463 	 * descendant that returns a floating object but passes no reference on
464 	 * to us, then we need to revisit this. */
465 	if (iinfo->is_constructor &&
466 	    g_type_info_get_tag (&iinfo->base.return_type_info) == GI_TYPE_TAG_INTERFACE)
467 	{
468 		GIBaseInfo * interface = g_type_info_get_interface (&iinfo->base.return_type_info);
469 		if (GI_IS_REGISTERED_TYPE_INFO (interface) &&
470 		    g_type_is_a (get_gtype (interface),
471 		                 G_TYPE_INITIALLY_UNOWNED))
472 		{
473 			iinfo->base.return_type_transfer = GI_TRANSFER_EVERYTHING;
474 		}
475 		g_base_info_unref ((GIBaseInfo *) interface);
476 	}
477 }
478 
479 static void
_clear_c_invocation_info(GPerlI11nCInvocationInfo * iinfo)480 _clear_c_invocation_info (GPerlI11nCInvocationInfo *iinfo)
481 {
482 	clear_invocation_info ((GPerlI11nInvocationInfo *) iinfo);
483 }
484 
485 /* ------------------------------------------------------------------------- */
486 
487 static gchar *
_format_target(GPerlI11nCInvocationInfo * iinfo)488 _format_target (GPerlI11nCInvocationInfo *iinfo)
489 {
490 	gchar *caller = NULL;
491 	if (iinfo->target_package && iinfo->target_namespace && iinfo->target_function) {
492 		caller = g_strconcat (iinfo->target_package, "::",
493 		                      iinfo->target_namespace, "::",
494 		                      iinfo->target_function,
495 		                      NULL);
496 	} else if (iinfo->target_package && iinfo->target_function) {
497 		caller = g_strconcat (iinfo->target_package, "::",
498 		                      iinfo->target_function,
499 		                      NULL);
500 	} else {
501 		caller = g_strconcat ("Callable ",
502 		                      g_base_info_get_name (iinfo->base.interface),
503 		                      NULL);
504 	}
505 	return caller;
506 }
507 
508 static void
_check_n_args(GPerlI11nCInvocationInfo * iinfo)509 _check_n_args (GPerlI11nCInvocationInfo *iinfo)
510 {
511 	if (iinfo->n_expected_args != iinfo->n_given_args) {
512 		/* Avoid the cost of formatting the target until we know we
513 		 * need it. */
514 		gchar *caller = NULL;
515 		if (iinfo->n_given_args < (iinfo->n_expected_args - iinfo->n_nullable_args)) {
516 			caller = _format_target (iinfo);
517 			ccroak ("%s: passed too few parameters "
518 			        "(expected %u, got %u)",
519 			        caller, iinfo->n_expected_args, iinfo->n_given_args);
520 		} else if (iinfo->n_given_args > iinfo->n_expected_args) {
521 			caller = _format_target (iinfo);
522 			cwarn ("*** %s: passed too many parameters "
523 			       "(expected %u, got %u); ignoring excess",
524 			       caller, iinfo->n_expected_args, iinfo->n_given_args);
525 		}
526 		if (caller)
527 			g_free (caller);
528 	}
529 }
530 
531 /* ------------------------------------------------------------------------- */
532 
533 static void
_handle_automatic_arg(guint pos,GIArgInfo * arg_info,GITypeInfo * arg_type,GIArgument * arg,GPerlI11nCInvocationInfo * invocation_info)534 _handle_automatic_arg (guint pos,
535                        GIArgInfo * arg_info,
536                        GITypeInfo * arg_type,
537                        GIArgument * arg,
538                        GPerlI11nCInvocationInfo * invocation_info)
539 {
540 	GSList *l;
541 
542 	/* array length */
543 	for (l = invocation_info->base.array_infos; l != NULL; l = l->next) {
544 		GPerlI11nArrayInfo *ainfo = l->data;
545 		if (((gint) pos) == ainfo->length_pos) {
546 			SV *conversion_sv;
547 			dwarn ("  setting automatic arg %d (array length) to %"G_GSIZE_FORMAT"\n",
548 			       pos, ainfo->length);
549 			conversion_sv = newSVuv (ainfo->length);
550 			sv_to_arg (conversion_sv, arg, arg_info, arg_type,
551 			           GI_TRANSFER_NOTHING, FALSE, NULL);
552 			SvREFCNT_dec (conversion_sv);
553 			return;
554 		}
555 	}
556 
557 	/* callback destroy notify */
558 	for (l = invocation_info->base.callback_infos; l != NULL; l = l->next) {
559 		GPerlI11nPerlCallbackInfo *cinfo = l->data;
560 		if (((gint) pos) == cinfo->destroy_pos) {
561 			dwarn ("  setting automatic arg %d (destroy notify for calllback %p)\n",
562 			       pos, cinfo);
563 			/* If the code pointer is NULL, then the user actually
564 			 * specified undef for the callback or nothing at all,
565 			 * in which case we must not install our destroy notify
566 			 * handler. */
567 			arg->v_pointer = cinfo->code ? release_perl_callback : NULL;
568 			return;
569 		}
570 	}
571 
572 	ccroak ("Could not handle automatic arg %d", pos);
573 }
574 
575 static gpointer
_allocate_out_mem(GITypeInfo * arg_type)576 _allocate_out_mem (GITypeInfo *arg_type)
577 {
578 	GIBaseInfo *interface_info;
579 	GIInfoType type;
580 	gboolean is_boxed = FALSE;
581 	GType gtype = G_TYPE_INVALID;
582 
583 	interface_info = g_type_info_get_interface (arg_type);
584 	g_assert (interface_info);
585 	type = g_base_info_get_type (interface_info);
586 	if (GI_IS_REGISTERED_TYPE_INFO (interface_info)) {
587 		gtype = get_gtype (interface_info);
588 		is_boxed = g_type_is_a (gtype, G_TYPE_BOXED);
589 	}
590 	g_base_info_unref (interface_info);
591 
592 	switch (type) {
593 	    case GI_INFO_TYPE_STRUCT:
594 	    {
595 		/* No plain g_struct_info_get_size (interface_info) here so
596 		 * that we get the GValue override. */
597 		gsize size;
598 		gpointer mem;
599 		size = size_of_interface (arg_type);
600 		mem = g_malloc0 (size);
601 		if (is_boxed) {
602 			/* For a boxed type, malloc() might not be the right
603 			 * allocator.  For example, GtkTreeIter uses GSlice.
604 			 * So use g_boxed_copy() to make a copy of the newly
605 			 * allocated block using the correct allocator. */
606 			gpointer real_mem = g_boxed_copy (gtype, mem);
607 			g_free (mem);
608 			mem = real_mem;
609 		}
610 		return mem;
611 	    }
612 	    default:
613 		g_assert_not_reached ();
614 		return NULL;
615 	}
616 }
617