gperl-i11n-marshal-interface.c 16 KB
Newer Older
1 2
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */

3 4 5
static gpointer _sv_to_class_struct_pointer (SV *sv, GPerlI11nInvocationInfo *iinfo);
static void _store_enum (GIEnumInfo * info, gint value, GIArgument * arg);
static gint _retrieve_enum (GIEnumInfo * info, GIArgument * arg);
6 7 8

static gpointer
instance_sv_to_pointer (GICallableInfo *info, SV *sv, GPerlI11nInvocationInfo *iinfo)
9 10 11 12 13 14 15 16
{
	// We do *not* own container.
	GIBaseInfo *container = g_base_info_get_container (info);
	GIInfoType info_type = g_base_info_get_type (container);
	gpointer pointer = NULL;

	/* FIXME: Much of this code is duplicated in sv_to_interface. */

17
	dwarn ("container name = %s, info type = %d (%s)\n",
18
	       g_base_info_get_name (container),
19
	       info_type, g_info_type_to_string (info_type));
20 21 22 23 24

	switch (info_type) {
	    case GI_INFO_TYPE_OBJECT:
	    case GI_INFO_TYPE_INTERFACE:
		pointer = gperl_get_object (sv);
25
		dwarn ("  -> object pointer: %p\n", pointer);
26 27 28 29 30 31
		break;

	    case GI_INFO_TYPE_BOXED:
	    case GI_INFO_TYPE_STRUCT:
            case GI_INFO_TYPE_UNION:
	    {
32
		GType type = get_gtype ((GIRegisteredTypeInfo *) container);
33
		if (!type || type == G_TYPE_NONE) {
34
			if (g_struct_info_is_gtype_struct (container)) {
35
				pointer = _sv_to_class_struct_pointer (sv, iinfo);
36 37 38 39 40 41 42 43
			}
			if (!pointer) {
				dwarn ("  -> untyped record\n");
				pointer = sv_to_struct (GI_TRANSFER_NOTHING,
				                        container,
				                        info_type,
				                        sv);
			}
44
		} else {
45
			dwarn ("  -> boxed: type=%s (%"G_GSIZE_FORMAT")\n",
46 47 48
			       g_type_name (type), type);
			pointer = gperl_get_boxed_check (sv, type);
		}
49
		dwarn ("  -> record pointer: %p\n", pointer);
50 51 52 53
		break;
	    }

	    default:
54
		ccroak ("Don't know how to handle info type %d for instance SV", info_type);
55 56 57 58 59
	}

	return pointer;
}

60 61 62 63 64 65 66 67 68 69 70 71 72
/* This may call Perl code (via gperl_new_boxed, gperl_sv_from_value,
 * struct_to_sv), so it needs to be wrapped with PUTBACK/SPAGAIN by the
 * caller. */
static SV *
instance_pointer_to_sv (GICallableInfo *info, gpointer pointer)
{
	// We do *not* own container.
	GIBaseInfo *container = g_base_info_get_container (info);
	GIInfoType info_type = g_base_info_get_type (container);
	SV *sv = NULL;

	/* FIXME: Much of this code is duplicated in interface_to_sv. */

73
	dwarn ("container name = %s, info type = %d (%s)\n",
74
	       g_base_info_get_name (container),
75
	       info_type, g_info_type_to_string (info_type));
76 77 78 79 80

	switch (info_type) {
	    case GI_INFO_TYPE_OBJECT:
	    case GI_INFO_TYPE_INTERFACE:
		sv = gperl_new_object (pointer, FALSE);
81
		dwarn ("  -> object SV: %p\n", sv);
82 83 84 85
		break;

	    case GI_INFO_TYPE_BOXED:
	    case GI_INFO_TYPE_STRUCT:
86
	    case GI_INFO_TYPE_UNION:
87 88 89
	    {
		GType type = get_gtype ((GIRegisteredTypeInfo *) container);
		if (!type || type == G_TYPE_NONE) {
90
			dwarn ("  -> untyped record\n");
91 92
			sv = struct_to_sv (container, info_type, pointer, FALSE);
		} else {
93
			dwarn ("  -> boxed: type=%s (%"G_GSIZE_FORMAT")\n",
94 95 96
			       g_type_name (type), type);
			sv = gperl_new_boxed (pointer, type, FALSE);
		}
97
		dwarn ("  -> record pointer: %p\n", pointer);
98 99 100 101
		break;
	    }

	    default:
102
		ccroak ("Don't know how to handle info type %d for instance pointer", info_type);
103 104 105 106 107
	}

	return sv;
}

108 109 110
static void
sv_to_interface (GIArgInfo * arg_info,
                 GITypeInfo * type_info,
111
                 GITransfer transfer,
112
                 gboolean may_be_null,
113 114 115 116 117 118 119 120 121 122 123 124
                 SV * sv,
                 GIArgument * arg,
                 GPerlI11nInvocationInfo * invocation_info)
{
	GIBaseInfo *interface;
	GIInfoType info_type;

	interface = g_type_info_get_interface (type_info);
	if (!interface)
		ccroak ("Could not convert sv %p to pointer", sv);
	info_type = g_base_info_get_type (interface);

125 126 127
	dwarn ("interface = %p (%s), type = %d (%s)\n",
	       interface, g_base_info_get_name (interface),
	       info_type, g_info_type_to_string (info_type));
128 129 130 131

	switch (info_type) {
	    case GI_INFO_TYPE_OBJECT:
	    case GI_INFO_TYPE_INTERFACE:
132 133 134
		if (may_be_null && !gperl_sv_is_defined (sv)) {
			arg->v_pointer = NULL;
		} else {
135 136 137 138 139
			/* GParamSpecs are represented as classes of
			 * fundamental type, but gperl_get_object_check cannot
			 * handle this.  So we do it here. */
			if (info_type == GI_INFO_TYPE_OBJECT &&
			    g_object_info_get_fundamental (interface))
140
			{
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
				GType type = G_TYPE_FUNDAMENTAL (get_gtype (interface));
				switch (type) {
				    case G_TYPE_PARAM:
					arg->v_pointer = SvGParamSpec (sv);
					break;
				    default:
					ccroak ("sv_to_interface: Don't know how to handle fundamental type %s (%lu)\n",
					        g_type_name (type), type);
				}
			} else {
				arg->v_pointer = gperl_get_object_check (sv, get_gtype (interface));
				if (arg->v_pointer && transfer == GI_TRANSFER_NOTHING &&
				    ((GObject *) arg->v_pointer)->ref_count == 1 &&
				    SvTEMP (sv) && SvREFCNT (SvRV (sv)) == 1)
				{
					cwarn ("*** Asked to hand out object without ownership transfer, "
					       "but object is about to be destroyed; "
					       "adding an additional reference for safety");
					transfer = GI_TRANSFER_EVERYTHING;
				}
				if (transfer >= GI_TRANSFER_CONTAINER) {
					g_object_ref (arg->v_pointer);
				}
164 165
			}
		}
166 167 168 169 170 171
		break;

	    case GI_INFO_TYPE_UNION:
	    case GI_INFO_TYPE_STRUCT:
	    case GI_INFO_TYPE_BOXED:
	    {
172 173 174
		gboolean need_value_semantics =
			arg_info && g_arg_info_is_caller_allocates (arg_info)
			&& !g_type_info_is_pointer (type_info);
175
		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
176
		if (!type || type == G_TYPE_NONE) {
177
			dwarn ("  -> untyped record\n");
178
			g_assert (!need_value_semantics);
179 180
			if (g_struct_info_is_gtype_struct (interface)) {
				arg->v_pointer = _sv_to_class_struct_pointer (sv, invocation_info);
181
			} else {
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203
				const gchar *namespace, *name, *package;
				GType parent_type;
				/* Find out whether this untyped record is a member of
				 * a boxed union before using raw hash-to-struct
				 * conversion. */
				name = g_base_info_get_name (interface);
				namespace = g_base_info_get_namespace (interface);
				package = get_package_for_basename (namespace);
				parent_type = package ? find_union_member_gtype (package, name) : 0;
				if (parent_type && parent_type != G_TYPE_NONE) {
					arg->v_pointer = gperl_get_boxed_check (
					                   sv, parent_type);
					if (GI_TRANSFER_EVERYTHING == transfer)
						arg->v_pointer =
							g_boxed_copy (parent_type,
							              arg->v_pointer);
				} else {
					arg->v_pointer = sv_to_struct (transfer,
					                               interface,
					                               info_type,
					                               sv);
				}
204
			}
205 206 207
		}

		else if (type == G_TYPE_CLOSURE) {
208
			/* FIXME: User cannot supply user data. */
209
			dwarn ("  -> closure\n");
210
			g_assert (!need_value_semantics);
211
			arg->v_pointer = gperl_closure_new (sv, NULL, FALSE);
212 213 214
		}

		else if (type == G_TYPE_VALUE) {
215
			GValue *gvalue = SvGValueWrapper (sv);
216
			dwarn ("  -> value\n");
217
			if (!gvalue)
218
				ccroak ("Cannot convert arbitrary SV to GValue");
219 220 221 222 223 224 225 226 227 228 229 230
			if (need_value_semantics) {
				g_value_init (arg->v_pointer, G_VALUE_TYPE (gvalue));
				g_value_copy (gvalue, arg->v_pointer);
			} else {
				if (GI_TRANSFER_EVERYTHING == transfer) {
					arg->v_pointer = g_new0 (GValue, 1);
					g_value_init (arg->v_pointer, G_VALUE_TYPE (gvalue));
					g_value_copy (gvalue, arg->v_pointer);
				} else {
					arg->v_pointer = gvalue;
				}
			}
231 232 233
		}

		else if (g_type_is_a (type, G_TYPE_BOXED)) {
234
			dwarn ("  -> boxed: type=%s, name=%s, caller-allocates=%d, is-pointer=%d\n",
235 236
			       g_type_name (type),
			       g_base_info_get_name (interface),
237
			       (arg_info ? g_arg_info_is_caller_allocates (arg_info) : INT_MAX),
238 239
			       g_type_info_is_pointer (type_info));
			if (need_value_semantics) {
240 241 242 243 244 245 246
				if (may_be_null && !gperl_sv_is_defined (sv)) {
					/* Do nothing. */
				} else {
					gsize n_bytes = g_struct_info_get_size (interface);
					gpointer mem = gperl_get_boxed_check (sv, type);
					g_memmove (arg->v_pointer, mem, n_bytes);
				}
247
			} else {
248
				if (may_be_null && !gperl_sv_is_defined (sv)) {
249 250 251
					arg->v_pointer = NULL;
				} else {
					arg->v_pointer = gperl_get_boxed_check (sv, type);
252 253 254
					if (GI_TRANSFER_EVERYTHING == transfer)
						arg->v_pointer = g_boxed_copy (
							type, arg->v_pointer);
255
				}
256
			}
257
		}
258 259 260

#if GLIB_CHECK_VERSION (2, 24, 0)
		else if (g_type_is_a (type, G_TYPE_VARIANT)) {
261
			dwarn ("  -> variant type\n");
262 263 264 265 266 267 268 269 270 271 272
			g_assert (!need_value_semantics);
			arg->v_pointer = SvGVariant (sv);
			if (GI_TRANSFER_EVERYTHING == transfer)
				g_variant_ref (arg->v_pointer);
		}
#endif

		else {
			ccroak ("Cannot convert SV to record value of unknown type %s (%" G_GSIZE_FORMAT ")",
			        g_type_name (type), type);
		}
273 274 275 276 277
		break;
	    }

	    case GI_INFO_TYPE_ENUM:
	    {
278
		gint value;
279
		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
280 281 282 283
		if (G_TYPE_NONE == type) {
			ccroak ("Could not handle unknown enum type %s",
			        g_base_info_get_name (interface));
		}
284 285
		value = gperl_convert_enum (type, sv);
		_store_enum (interface, value, arg);
286 287 288 289 290
		break;
	    }

	    case GI_INFO_TYPE_FLAGS:
	    {
291
		gint value;
292
		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
293 294 295 296
		if (G_TYPE_NONE == type) {
			ccroak ("Could not handle unknown flags type %s",
			        g_base_info_get_name (interface));
		}
297 298
		value = gperl_convert_flags (type, sv);
		_store_enum (interface, value, arg);
299 300 301 302
		break;
	    }

	    case GI_INFO_TYPE_CALLBACK:
303 304
		arg->v_pointer = sv_to_callback (arg_info, type_info, sv,
		                                 invocation_info);
305 306 307
		break;

	    default:
308
		ccroak ("sv_to_interface: Could not handle info type %s (%d)",
309 310
		        g_info_type_to_string (info_type),
		        info_type);
311 312 313 314 315
	}

	g_base_info_unref ((GIBaseInfo *) interface);
}

316 317 318
/* This may call Perl code (via gperl_new_boxed, gperl_sv_from_value,
 * struct_to_sv), so it needs to be wrapped with PUTBACK/SPAGAIN by the
 * caller. */
319
static SV *
320
interface_to_sv (GITypeInfo* info, GIArgument *arg, gboolean own, GPerlI11nInvocationInfo *iinfo)
321 322 323 324 325
{
	GIBaseInfo *interface;
	GIInfoType info_type;
	SV *sv = NULL;

326
	dwarn ("arg %p, info %p\n", arg, info);
327 328 329 330 331

	interface = g_type_info_get_interface (info);
	if (!interface)
		ccroak ("Could not convert arg %p to SV", arg);
	info_type = g_base_info_get_type (interface);
332 333
	dwarn ("  info type: %d (%s)\n",
	       info_type, g_info_type_to_string (info_type));
334 335 336

	switch (info_type) {
	    case GI_INFO_TYPE_OBJECT:
337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358
		/* GParamSpecs are represented as classes of fundamental type,
		 * but gperl_new_object cannot handle this.  So we do it
		 * here. */
		if (g_object_info_get_fundamental (interface)) {
			GType type = G_TYPE_FUNDAMENTAL (get_gtype (interface));
			switch (type) {
			    case G_TYPE_PARAM:
				sv = newSVGParamSpec (arg->v_pointer); /* does ref & sink */
				/* FIXME: What if own=true and the pspec is not
				 * floating?  Then we would leak.  We do not
				 * have the API to detect this.  But it is
				 * probably also quite rare. */
				break;
			    default:
				ccroak ("interface_to_sv: Don't know how to handle fundamental type %s (%lu)\n",
				        g_type_name (type), type);
			}
		} else {
			sv = gperl_new_object (arg->v_pointer, own);
		}
		break;

359 360 361 362 363 364 365 366 367 368
	    case GI_INFO_TYPE_INTERFACE:
		sv = gperl_new_object (arg->v_pointer, own);
		break;

	    case GI_INFO_TYPE_UNION:
	    case GI_INFO_TYPE_STRUCT:
	    case GI_INFO_TYPE_BOXED:
	    {
		/* FIXME: What about pass-by-value here? */
		GType type;
369
		type = get_gtype ((GIRegisteredTypeInfo *) interface);
370
		if (!type || type == G_TYPE_NONE) {
371
			dwarn ("  -> untyped record\n");
372
			sv = struct_to_sv (interface, info_type, arg->v_pointer, own);
373 374 375
		}

		else if (type == G_TYPE_VALUE) {
376
			dwarn ("  -> value\n");
377
			sv = gperl_sv_from_value (arg->v_pointer);
Torsten Schönfeld's avatar
Torsten Schönfeld committed
378 379
			if (own)
				g_boxed_free (type, arg->v_pointer);
380 381 382
		}

		else if (g_type_is_a (type, G_TYPE_BOXED)) {
383 384
			dwarn ("  -> boxed: pointer=%p, type=%"G_GSIZE_FORMAT" (%s), own=%d\n",
			       arg->v_pointer, type, g_type_name (type), own);
385 386
			sv = gperl_new_boxed (arg->v_pointer, type, own);
		}
387 388 389

#if GLIB_CHECK_VERSION (2, 24, 0)
		else if (g_type_is_a (type, G_TYPE_VARIANT)) {
390
			dwarn ("  -> variant\n");
391 392 393 394 395 396 397 398 399
			sv = own ? newSVGVariant_noinc (arg->v_pointer)
			         : newSVGVariant (arg->v_pointer);
		}
#endif

		else {
			ccroak ("Cannot convert record value of unknown type %s (%" G_GSIZE_FORMAT ") to SV",
			        g_type_name (type), type);
		}
400 401 402 403 404
		break;
	    }

	    case GI_INFO_TYPE_ENUM:
	    {
405
		gint value;
406
		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
407 408 409 410
		if (G_TYPE_NONE == type) {
			ccroak ("Could not handle unknown enum type %s",
			        g_base_info_get_name (interface));
		}
411 412
		value = _retrieve_enum (interface, arg);
		sv = gperl_convert_back_enum (type, value);
413 414 415 416 417
		break;
	    }

	    case GI_INFO_TYPE_FLAGS:
	    {
418
		gint value;
419
		GType type = get_gtype ((GIRegisteredTypeInfo *) interface);
420 421 422 423
		if (G_TYPE_NONE == type) {
			ccroak ("Could not handle unknown flags type %s",
			        g_base_info_get_name (interface));
		}
424 425
		value = _retrieve_enum (interface, arg);
		sv = gperl_convert_back_flags (type, value);
426 427 428
		break;
	    }

429 430 431 432
	    case GI_INFO_TYPE_CALLBACK:
		sv = callback_to_sv (interface, arg->v_pointer, iinfo);
		break;

433
	    default:
434 435 436
		ccroak ("interface_to_sv: Don't know how to handle info type %s (%d)",
		        g_info_type_to_string (info_type),
		        info_type);
437 438 439 440 441 442
	}

	g_base_info_unref ((GIBaseInfo *) interface);

	return sv;
}
443 444 445

/* ------------------------------------------------------------------------- */

446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474
static gpointer
_sv_to_class_struct_pointer (SV *sv, GPerlI11nInvocationInfo *iinfo)
{
	gpointer pointer = NULL;
	GType class_type = 0;
	dwarn ("  -> gtype struct?\n");
	if (gperl_sv_is_ref (sv)) { /* instance? */
		const char *package = sv_reftype (SvRV (sv), TRUE);
		class_type = gperl_type_from_package (package);
	} else { /* package? */
		class_type = gperl_type_from_package (SvPV_nolen (sv));
	}
	dwarn ("     class_type = %s (%lu), is_classed = %d\n",
	       g_type_name (class_type), class_type, G_TYPE_IS_CLASSED (class_type));
	if (G_TYPE_IS_CLASSED (class_type)) {
		pointer = g_type_class_peek (class_type);
		if (!pointer) {
			/* If peek() produced NULL, the class has not been
			 * instantiated yet and needs to be created. */
			pointer = g_type_class_ref (class_type);
			free_after_call (iinfo, (GFunc) g_type_class_unref, pointer);
		}
		dwarn ("     type class = %p\n", pointer);
	}
	return pointer;
}

/* ------------------------------------------------------------------------- */

475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559
void
_store_enum (GIEnumInfo * info, gint value, GIArgument * arg)
{
	GITypeTag tag = g_enum_info_get_storage_type (info);
	switch (tag) {
	    case GI_TYPE_TAG_BOOLEAN:
		arg->v_boolean = (gboolean) value;
		break;

	    case GI_TYPE_TAG_INT8:
		arg->v_int8 = (gint8) value;
		break;

	    case GI_TYPE_TAG_UINT8:
		arg->v_uint8 = (guint8) value;
		break;

	    case GI_TYPE_TAG_INT16:
		arg->v_int16 = (gint16) value;
		break;

	    case GI_TYPE_TAG_UINT16:
		arg->v_uint16 = (guint16) value;
		break;

	    case GI_TYPE_TAG_INT32:
		arg->v_int32 = (gint32) value;
		break;

	    case GI_TYPE_TAG_UINT32:
		arg->v_uint32 = (guint32) value;
		break;

	    case GI_TYPE_TAG_INT64:
		arg->v_int64 = (gint64) value;
		break;

	    case GI_TYPE_TAG_UINT64:
		arg->v_uint64 = (guint64) value;
		break;

	    default:
		ccroak ("Unhandled enumeration type %s (%d) encountered",
		        g_type_tag_to_string (tag), tag);
	}
}

gint
_retrieve_enum (GIEnumInfo * info, GIArgument * arg)
{
	GITypeTag tag = g_enum_info_get_storage_type (info);
	switch (tag) {
	    case GI_TYPE_TAG_BOOLEAN:
		return (gint) arg->v_boolean;

	    case GI_TYPE_TAG_INT8:
		return (gint) arg->v_int8;

	    case GI_TYPE_TAG_UINT8:
		return (gint) arg->v_uint8;

	    case GI_TYPE_TAG_INT16:
		return (gint) arg->v_int16;

	    case GI_TYPE_TAG_UINT16:
		return (gint) arg->v_uint16;

	    case GI_TYPE_TAG_INT32:
		return (gint) arg->v_int32;

	    case GI_TYPE_TAG_UINT32:
		return (gint) arg->v_uint32;

	    case GI_TYPE_TAG_INT64:
		return (gint) arg->v_int64;

	    case GI_TYPE_TAG_UINT64:
		return (gint) arg->v_uint64;

	    default:
		ccroak ("Unhandled enumeration type %s (%d) encountered",
		        g_type_tag_to_string (tag), tag);
		return 0;
	}
}