/tool/gec/runtime/c/ge_types.c

/*
	description:

		"C functions used to implement type information"

	system: "Gobo Eiffel Compiler"
	copyright: "Copyright (c) 2016-2018, Eric Bezault and others"
	license: "MIT License"
	date: "$Date$"
	revision: "$Revision$"
*/

#ifndef GE_TYPES_C
#define GE_TYPES_C
#if defined(_MSC_VER) && (_MSC_VER >= 1020)
#pragma once
#endif

#ifndef GE_TYPES_H
#include "ge_types.h"
#endif
#ifndef GE_STRING_H
#include "ge_string.h"
#endif

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Number of type infos in `GE_type_infos'.
 * Do not take into account the fake item at index 0.
 */
int GE_type_info_count;

/*
 * Encode a EIF_TYPE into a EIF_ENCODED_TYPE.
 * The lower part of EIF_ENCODED_TYPE contains the .id field,
 * and the upper part the .annotations.
 */
EIF_ENCODED_TYPE GE_encoded_type(EIF_TYPE a_type)
{
	EIF_ENCODED_TYPE l_result;

#if defined(_MSC_VER)
		/* This code below is just optimized as one move by cl on x86 platforms.
		 * The else-part below generates non-optimal code with cl.
		 */
	memcpy(&l_result, &a_type, sizeof(EIF_ENCODED_TYPE));
#else
		/* This code below is just optimized as one move by gcc/clang on x86 platforms. */
	l_result = a_type.annotations;
	l_result = (l_result << 16) | a_type.id;
#endif
	return l_result;
}

/*
 * Decode a EIF_ENCODED_TYPE into a EIF_TYPE.
 * The lower part of EIF_ENCODED_TYPE contains the .id field,
 * and the upper part the .annotations.
 */
EIF_TYPE GE_decoded_type(EIF_ENCODED_TYPE a_type)
{
	EIF_TYPE l_result;

#if defined(_MSC_VER)
		/* This code below is just optimized as one move by cl on x86 platforms.
		 * The else-part below generates non-optimal code with cl.
		 */
	memcpy(&l_result, &a_type, sizeof(EIF_TYPE));
#else
		/* This code below is just optimized as one move by gcc/clang on x86 platforms. */
	l_result.id = a_type & 0x0000FFFF;
	l_result.annotations = a_type >> 16;
#endif
	return l_result;
}

/*
 * Type with `a_id' and `a_annotations'.
 */
EIF_TYPE GE_new_type(EIF_TYPE_INDEX a_id, EIF_TYPE_INDEX a_annotations)
{
	EIF_TYPE l_result;
	l_result.id = a_id;
	l_result.annotations = a_annotations;
	return l_result;
}

/*
 * Associated detachable type of `a_type' if any,
 * otherwise `a_type'.
 */
EIF_TYPE GE_non_attached_type(EIF_TYPE a_type)
{
		/* Since types are by default detachable, we simply remove
		 * all attachment marks. */
	a_type.annotations &= ~(ATTACHED_FLAG | DETACHABLE_FLAG);
	return a_type;
}

/*
 * Associated attached type of `a_type' if any,
 * otherwise `a_type'.
 */
EIF_TYPE GE_attached_type(EIF_TYPE a_type)
{
	if (!GE_is_expanded_type_index(a_type.id)) {
		a_type.annotations &= ~DETACHABLE_FLAG;
		a_type.annotations |= ATTACHED_FLAG;
	}
	return a_type;
}

/*
 * Is `a_type' a SPECIAL type of user-defined expanded type?
 */
EIF_BOOLEAN GE_is_special_of_expanded_type_index(EIF_TYPE_INDEX a_type)
{
	EIF_BOOLEAN l_result = EIF_FALSE;
#ifdef GE_USE_TYPE_GENERIC_PARAMETERS
	EIF_TYPE_INDEX l_generic_parameter;
	uint32_t l_flags;

	if ((GE_type_infos[a_type].flags & GE_TYPE_FLAG_SPECIAL)) {
		l_generic_parameter = GE_decoded_type(GE_type_infos[a_type].generic_parameters[0]).id;
		l_flags = GE_type_infos[l_generic_parameter].flags;
		l_result = EIF_TEST((l_flags & GE_TYPE_FLAG_EXPANDED) && !(l_flags & GE_TYPE_FLAG_BASIC_MASK));
	}
#endif
	return l_result;
}

/*
 * Is `a_type' a SPECIAL type of reference type?
 */
EIF_BOOLEAN GE_is_special_of_reference_type_index(EIF_TYPE_INDEX a_type)
{
	EIF_BOOLEAN l_result = EIF_FALSE;
#ifdef GE_USE_TYPE_GENERIC_PARAMETERS
	EIF_TYPE_INDEX l_generic_parameter;
	uint32_t l_flags;

	if ((GE_type_infos[a_type].flags & GE_TYPE_FLAG_SPECIAL)) {
		l_generic_parameter = GE_decoded_type(GE_type_infos[a_type].generic_parameters[0]).id;
		l_flags = GE_type_infos[l_generic_parameter].flags;
		l_result = EIF_TEST(!(l_flags & GE_TYPE_FLAG_EXPANDED));
	}
#endif
	return l_result;
}

/*
 * Is `a_type' a SPECIAL type of reference type or basic expanded type?
 * (Note that user-defined expanded types are excluded.)
 */
EIF_BOOLEAN GE_is_special_of_reference_or_basic_expanded_type_index(EIF_TYPE_INDEX a_type)
{
	EIF_BOOLEAN l_result = EIF_FALSE;
#ifdef GE_USE_TYPE_GENERIC_PARAMETERS
	EIF_TYPE_INDEX l_generic_parameter;
	uint32_t l_flags;

	if ((GE_type_infos[a_type].flags & GE_TYPE_FLAG_SPECIAL)) {
		l_generic_parameter = GE_decoded_type(GE_type_infos[a_type].generic_parameters[0]).id;
		l_flags = GE_type_infos[l_generic_parameter].flags;
		l_result = EIF_TEST(!(l_flags & GE_TYPE_FLAG_EXPANDED) || (l_flags & GE_TYPE_FLAG_BASIC_MASK));
	}
#endif
	return l_result;
}

/*
 * Does `i'-th field of `a_object + a_physical_offset' (which is expected to be reference)
 * denote a reference with copy semantics?
 */
EIF_BOOLEAN GE_is_copy_semantics_field(EIF_INTEGER i, EIF_POINTER a_object, EIF_INTEGER a_physical_offset)
{
	EIF_REFERENCE l_object;

	l_object = GE_reference_field(i, a_object, a_physical_offset);
	if (l_object) {
		return GE_is_expanded_object(l_object);
	} else {
		return EIF_FALSE;
	}
}

/*
 * Does `i'-th item of special `a_object' (which is expected to be reference)
 * denote a reference with copy semantics?
 */
EIF_BOOLEAN GE_is_special_copy_semantics_item(EIF_INTEGER i, EIF_POINTER a_object)
{
#if defined(GE_USE_ATTRIBUTES) && defined(GE_USE_ATTRIBUTE_OFFSET)
	EIF_REFERENCE l_object;
	GE_type_info l_type_info;

	l_type_info = GE_type_infos[((EIF_REFERENCE)a_object)->id];
		/* The last pseudo attribute is the item at index 0 in the special object */
	l_object = *(EIF_REFERENCE*)((char*)a_object + l_type_info.attributes[l_type_info.attribute_count - 1]->offset + i * sizeof(EIF_REFERENCE));
	if (l_object) {
		return GE_is_expanded_object(l_object);
	} else {
		return EIF_FALSE;
	}
#else
	return EIF_FALSE;
#endif
}

/*
 * Generator class name of `a_type'.
 */
EIF_REFERENCE GE_generator_of_type_index(EIF_TYPE_INDEX a_type)
{
	const char* l_generator;
#ifdef GE_USE_TYPE_GENERATOR
/* TODO: check that `a_type' is valid. */
	l_generator = GE_type_infos[a_type].generator;
#else
	l_generator = "";
#endif
	return GE_str(l_generator);
}

EIF_REFERENCE GE_generator_8_of_type_index(EIF_TYPE_INDEX a_type)
{
	const char* l_generator;
#ifdef GE_USE_TYPE_GENERATOR
/* TODO: check that `a_type' is valid. */
	l_generator = GE_type_infos[a_type].generator;
#else
	l_generator = "";
#endif
	return GE_str8(l_generator);
}

/*
 * Full name of `a_type'.
 */
EIF_REFERENCE GE_generating_type_of_encoded_type(EIF_ENCODED_TYPE a_type)
{
	const char* l_name;
#ifdef GE_USE_TYPE_NAME
/* TODO: check that `a_type' is valid. */
	EIF_TYPE l_decoded_type;

	l_decoded_type = GE_decoded_type(a_type);
	l_name = GE_type_infos[l_decoded_type.id].name;
	if (!l_decoded_type.annotations) {
		l_name++;
	}
#else
	l_name = "";
#endif
	return GE_str(l_name);
}

EIF_REFERENCE GE_generating_type_8_of_encoded_type(EIF_ENCODED_TYPE a_type)
{
	const char* l_name;
#ifdef GE_USE_TYPE_NAME
/* TODO: check that `a_type' is valid. */
	EIF_TYPE l_decoded_type;

	l_decoded_type = GE_decoded_type(a_type);
	l_name = GE_type_infos[l_decoded_type.id].name;
	if (!l_decoded_type.annotations) {
		l_name++;
	}
#else
	l_name = "";
#endif
	return GE_str8(l_name);
}

/*
 * Encoded type whose name is `a_name'.
 * -1 if no such type.
 */
EIF_ENCODED_TYPE GE_encoded_type_from_name(EIF_POINTER a_name)
{
#ifdef GE_USE_TYPE_NAME
/* TODO: check that `a_type' is valid. */
	int i;
	const char* l_name;

	for (i = 1; i <= GE_type_info_count; i++) {
		l_name = GE_type_infos[i].name;
		if (strcmp((char*)a_name, l_name + 1) == 0) {
			return (EIF_INTEGER)GE_encoded_type(GE_new_type(i, 0x0));
		} else if (strcmp((char*)a_name, l_name) == 0) {
			return (EIF_INTEGER)GE_encoded_type(GE_new_type(i, ATTACHED_FLAG));
		}
	}
#endif
	return EIF_NO_TYPE;
}

/*
 * Does `a_type_1' conform to `a_type_2'?
 */
EIF_BOOLEAN GE_encoded_type_conforms_to(EIF_ENCODED_TYPE a_type_1, EIF_ENCODED_TYPE a_type_2)
{
#ifdef GE_USE_ANCESTORS
	GE_type_info l_type_info_1, l_type_info_2;
	GE_ancestor** l_ancestors;
	uint32_t l_ancestor_count, i;
	EIF_TYPE l_decoded_type_1, l_decoded_type_2;
	EIF_TYPE_INDEX l_type_index_1, l_type_index_2, l_ancestor_type_index;
	uint32_t l_flags_1, l_flags_2;

	l_decoded_type_1 = GE_decoded_type(a_type_1);
	l_decoded_type_2 = GE_decoded_type(a_type_2);
	l_type_index_1 = l_decoded_type_1.id;
	l_type_index_2 = l_decoded_type_2.id;
	l_type_info_1 = GE_type_infos[l_type_index_1];
	l_type_info_2 = GE_type_infos[l_type_index_2];
	l_flags_1 = l_type_info_1.flags;
	l_flags_2 = l_type_info_2.flags;
	if (!(l_flags_1 & GE_TYPE_FLAG_EXPANDED || l_decoded_type_1.annotations & ATTACHED_FLAG) && (l_flags_2 & GE_TYPE_FLAG_EXPANDED || l_decoded_type_2.annotations & ATTACHED_FLAG)) {
		return EIF_FALSE;
	} else if (l_flags_1 & GE_TYPE_FLAG_NONE) {
		return EIF_TEST(!(l_flags_2 & GE_TYPE_FLAG_EXPANDED));
	} else if (l_type_index_1 == l_type_index_2) {
		return EIF_TRUE;
	} else if (l_type_index_1 < l_type_index_2) {
		return EIF_FALSE;
	} else {
		l_ancestors = l_type_info_1.ancestors;
		l_ancestor_count = l_type_info_1.ancestor_count;
		for (i = 0; i < l_ancestor_count; i++) {
			l_ancestor_type_index = l_ancestors[i]->type_id;
			if (l_ancestor_type_index == l_type_index_2) {
				return EIF_TRUE;
			} else if (l_ancestor_type_index > l_type_index_2) {
				return EIF_FALSE;
			}
		}
	}
#endif
	return EIF_FALSE;
}

/*
 * Number of generic parameters.
 */
EIF_INTEGER GE_generic_parameter_count_of_type_index(EIF_TYPE_INDEX a_type)
{
#ifdef GE_USE_TYPE_GENERIC_PARAMETERS
	return (EIF_INTEGER)GE_type_infos[a_type].generic_parameter_count;
#else
	return (EIF_INTEGER)0;
#endif
}

/*
 * Type of `i'-th generic parameter of `a_type'.
 */
EIF_INTEGER GE_generic_parameter_of_type_index(EIF_TYPE_INDEX a_type, EIF_INTEGER i)
{
#ifdef GE_USE_TYPE_GENERIC_PARAMETERS
/* TODO: check that `a_type' and `i' are valid. */
	return (EIF_INTEGER)GE_type_infos[a_type].generic_parameters[i - 1];
#else
	return (EIF_INTEGER)0;
#endif
}

/*
 * Number of fields of an object of dynamic type `a_type'.
 */
EIF_INTEGER GE_field_count_of_type_index(EIF_TYPE_INDEX a_type)
{
#if defined(GE_USE_ATTRIBUTES) && defined(GE_USE_ATTRIBUTE_OFFSET)
/* TODO: check that `a_type' is valid. */
	return (EIF_INTEGER)GE_type_infos[a_type].attribute_count;
#else
	return (EIF_INTEGER)0;
#endif
}

/*
 * Physical offset of the `i'-th field for an object of dynamic type `a_type'.
 */
EIF_INTEGER GE_field_offset_of_type_index(EIF_INTEGER i, EIF_TYPE_INDEX a_type)
{
#if defined(GE_USE_ATTRIBUTES) && defined(GE_USE_ATTRIBUTE_OFFSET)
/* TODO: check that `a_type' and `i' are valid. */
	return (EIF_INTEGER)GE_type_infos[a_type].attributes[i - 1]->offset;
#else
	return (EIF_INTEGER)0;
#endif
}

/*
 * Name of the `i'-th field for an object of dynamic type `a_type'.
 */
EIF_POINTER GE_field_name_of_type_index(EIF_INTEGER i, EIF_TYPE_INDEX a_type)
{
#if defined(GE_USE_ATTRIBUTES) && defined(GE_USE_ATTRIBUTE_NAME)
/* TODO: check that `a_type' and `i' are valid. */
	return (EIF_POINTER)GE_type_infos[a_type].attributes[i - 1]->name;
#else
	return (EIF_POINTER)0;
#endif
}

/*
 * Static type of the `i'-th field for an object of dynamic type `a_type'.
 */
EIF_INTEGER GE_field_static_type_of_type_index(EIF_INTEGER i, EIF_TYPE_INDEX a_type)
{
#if defined(GE_USE_ATTRIBUTES) && defined(GE_USE_ATTRIBUTE_TYPE_ID)
/* TODO: check that `a_type' and `i' are valid. */
	return (EIF_INTEGER)GE_type_infos[a_type].attributes[i - 1]->type_id;
#else
	return (EIF_INTEGER)0;
#endif
}

/*
 * Kind of type of the `i'-th field for an object of dynamic type `a_type'.
 */
EIF_INTEGER GE_field_type_kind_of_type_index(EIF_INTEGER i, EIF_TYPE_INDEX a_type)
{
#if defined(GE_USE_ATTRIBUTES) && defined(GE_USE_ATTRIBUTE_TYPE_ID)
	uint32_t l_flags = GE_type_infos[GE_decoded_type(GE_type_infos[a_type].attributes[i - 1]->type_id).id].flags;
	if (l_flags & GE_TYPE_FLAG_BASIC_MASK) {
		switch (l_flags & GE_TYPE_FLAG_BASIC_MASK) {
		case GE_TYPE_FLAG_BOOLEAN:
			return (EIF_INTEGER)GE_TYPE_KIND_BOOLEAN;
		case GE_TYPE_FLAG_CHARACTER_8:
			return (EIF_INTEGER)GE_TYPE_KIND_CHARACTER_8;
		case GE_TYPE_FLAG_CHARACTER_32:
			return (EIF_INTEGER)GE_TYPE_KIND_CHARACTER_32;
		case GE_TYPE_FLAG_INTEGER_8:
			return (EIF_INTEGER)GE_TYPE_KIND_INTEGER_8;
		case GE_TYPE_FLAG_INTEGER_16:
			return (EIF_INTEGER)GE_TYPE_KIND_INTEGER_16;
		case GE_TYPE_FLAG_INTEGER_32:
			return (EIF_INTEGER)GE_TYPE_KIND_INTEGER_32;
		case GE_TYPE_FLAG_INTEGER_64:
			return (EIF_INTEGER)GE_TYPE_KIND_INTEGER_64;
		case GE_TYPE_FLAG_NATURAL_8:
			return (EIF_INTEGER)GE_TYPE_KIND_NATURAL_8;
		case GE_TYPE_FLAG_NATURAL_16:
			return (EIF_INTEGER)GE_TYPE_KIND_NATURAL_16;
		case GE_TYPE_FLAG_NATURAL_32:
			return (EIF_INTEGER)GE_TYPE_KIND_NATURAL_32;
		case GE_TYPE_FLAG_NATURAL_64:
			return (EIF_INTEGER)GE_TYPE_KIND_NATURAL_64;
		case GE_TYPE_FLAG_POINTER:
			return (EIF_INTEGER)GE_TYPE_KIND_POINTER;
		case GE_TYPE_FLAG_REAL_32:
			return (EIF_INTEGER)GE_TYPE_KIND_REAL_32;
		case GE_TYPE_FLAG_REAL_64:
			return (EIF_INTEGER)GE_TYPE_KIND_REAL_64;
		default:
			return (EIF_INTEGER)GE_TYPE_KIND_INVALID;
		}
	} else if (l_flags & GE_TYPE_FLAG_EXPANDED) {
		return (EIF_INTEGER)GE_TYPE_KIND_EXPANDED;
	} else {
		return (EIF_INTEGER)GE_TYPE_KIND_REFERENCE;
	}
#else
	return (EIF_INTEGER)GE_TYPE_KIND_INVALID;
#endif
}

/*
 * Physical size of `a_object'.
 */
EIF_NATURAL_64 GE_object_size(EIF_POINTER a_object)
{
#ifdef GE_USE_TYPE_OBJECT_SIZE
	EIF_TYPE_INDEX l_type_index = ((EIF_REFERENCE)(a_object))->id;
	uint64_t l_size = GE_type_infos[l_type_index].object_size;
#ifdef GE_USE_TYPE_GENERIC_PARAMETERS
	if (GE_is_special_type_index(l_type_index)) {
		EIF_TYPE_INDEX l_generic_parameter = GE_decoded_type(GE_type_infos[l_type_index].generic_parameters[0]).id;
		uint32_t l_flags = GE_type_infos[l_generic_parameter].flags;
		EIF_INTEGER l_capacity = ((EIF_SPECIAL*)a_object)->capacity;
		uint64_t l_item_size;

		if (l_flags & GE_TYPE_FLAG_BASIC_MASK) {
			switch (l_flags & GE_TYPE_FLAG_BASIC_MASK) {
			case GE_TYPE_FLAG_BOOLEAN:
				l_item_size = sizeof(EIF_BOOLEAN);
				break;
			case GE_TYPE_FLAG_CHARACTER_8:
				l_item_size = sizeof(EIF_CHARACTER_8);
				break;
			case GE_TYPE_FLAG_CHARACTER_32:
				l_item_size = sizeof(EIF_CHARACTER_32);
				break;
			case GE_TYPE_FLAG_INTEGER_8:
				l_item_size = sizeof(EIF_INTEGER_8);
				break;
			case GE_TYPE_FLAG_INTEGER_16:
				l_item_size = sizeof(EIF_INTEGER_16);
				break;
			case GE_TYPE_FLAG_INTEGER_32:
				l_item_size = sizeof(EIF_INTEGER_32);
				break;
			case GE_TYPE_FLAG_INTEGER_64:
				l_item_size = sizeof(EIF_INTEGER_64);
				break;
			case GE_TYPE_FLAG_NATURAL_8:
				l_item_size = sizeof(EIF_NATURAL_8);
				break;
			case GE_TYPE_FLAG_NATURAL_16:
				l_item_size = sizeof(EIF_NATURAL_16);
				break;
			case GE_TYPE_FLAG_NATURAL_32:
				l_item_size = sizeof(EIF_NATURAL_32);
				break;
			case GE_TYPE_FLAG_NATURAL_64:
				l_item_size = sizeof(EIF_NATURAL_64);
				break;
			case GE_TYPE_FLAG_POINTER:
				l_item_size = sizeof(EIF_POINTER);
				break;
			case GE_TYPE_FLAG_REAL_32:
				l_item_size = sizeof(EIF_REAL_32);
				break;
			case GE_TYPE_FLAG_REAL_64:
				l_item_size = sizeof(EIF_REAL_64);
				break;
			default:
				l_item_size = 0;
			}
		} else if (l_flags & GE_TYPE_FLAG_EXPANDED) {
			l_item_size = GE_type_infos[l_generic_parameter].object_size;
		} else {
			l_item_size = sizeof(EIF_REFERENCE);
		}
		l_size += l_capacity * l_item_size;
	}
#endif
	return (EIF_NATURAL_64)l_size;
#else
	return (EIF_NATURAL_64)0;
#endif
}

/*
 * Is `i'-th field of objects of type `a_type' a user-defined expanded attribute?
 */
EIF_BOOLEAN GE_is_field_expanded_of_type_index(EIF_INTEGER i, EIF_TYPE_INDEX a_type)
{
#if defined(GE_USE_ATTRIBUTES) && defined(GE_USE_ATTRIBUTE_TYPE_ID)
	uint32_t l_flags = GE_type_infos[GE_decoded_type(GE_type_infos[a_type].attributes[i - 1]->type_id).id].flags;
	return EIF_TEST((l_flags & GE_TYPE_FLAG_EXPANDED) && !(l_flags & GE_TYPE_FLAG_BASIC_MASK));
#else
	return EIF_FALSE;
#endif
}

/*
 * Get a lock on `GE_mark_object' and `GE_unmark_object' routines so that
 * 2 threads cannot `GE_mark_object' and `GE_unmark_object' at the same time.
 */
void GE_lock_marking(void)
{
#ifdef GE_USE_THREADS
/* TODO */
#endif
}

/*
 * Release a lock on `GE_mark_object' and `GE_unmark_object', so that another
 * thread can use `GE_mark_object' and `GE_unmark_object'.
 */
void GE_unlock_marking(void)
{
#ifdef GE_USE_THREADS
/* TODO */
#endif
}

/*
 * Is `obj' marked?
 */
EIF_BOOLEAN GE_is_object_marked(EIF_POINTER obj)
{
	return EIF_TEST(((EIF_REFERENCE)obj)->flags & GE_OBJECT_FLAG_MARKED);
}

/*
 * Mark `obj'.
 */
void GE_mark_object(EIF_POINTER obj)
{
	((EIF_REFERENCE)obj)->flags |= GE_OBJECT_FLAG_MARKED;
}

/*
 * Unmark `obj'.
 */
void GE_unmark_object(EIF_POINTER obj)
{
	((EIF_REFERENCE)obj)->flags &= ~GE_OBJECT_FLAG_MARKED;
}

/*
 * New instance of dynamic `a_type'.
 * Note: returned object is not initialized and may
 * hence violate its invariant.
 * `a_type' cannot represent a SPECIAL type, use
 * `GE_new_special_of_reference_instance_of_type_index' instead.
 */
EIF_REFERENCE GE_new_instance_of_type_index(EIF_TYPE_INDEX a_type)
{
	EIF_REFERENCE (*l_new)(EIF_BOOLEAN);

	l_new = (EIF_REFERENCE (*)(EIF_BOOLEAN))GE_type_infos[a_type].new_instance;
	if (l_new) {
		return l_new(EIF_TRUE);
	} else {
		return EIF_VOID;
	}
}

/*
 * New instance of dynamic `a_type' that represents
 * a SPECIAL with can contain `a_capacity' elements of reference type.
 * To create a SPECIAL of basic type, use class SPECIAL directly.
 */
EIF_REFERENCE GE_new_special_of_reference_instance_of_type_index(EIF_TYPE_INDEX a_type, EIF_INTEGER a_capacity)
{
	EIF_REFERENCE (*l_new)(EIF_INTEGER,EIF_BOOLEAN);

	l_new = (EIF_REFERENCE (*)(EIF_INTEGER,EIF_BOOLEAN))GE_type_infos[a_type].new_instance;
	if (l_new) {
		return l_new(a_capacity, EIF_TRUE);
	} else {
		return EIF_VOID;
	}
}

/*
 * New instance of TYPE for object of type `a_type'.
 */
EIF_REFERENCE GE_new_type_instance_of_encoded_type(EIF_ENCODED_TYPE a_type)
{
	EIF_TYPE l_decoded_type;
	EIF_TYPE_INDEX l_type_index;
	EIF_TYPE_INDEX l_annotations;
	EIF_REFERENCE l_result;

	l_decoded_type = GE_decoded_type(a_type);
	l_type_index = l_decoded_type.id;
	l_annotations = l_decoded_type.annotations;
	l_result = (EIF_REFERENCE)&(GE_types[l_type_index][l_annotations]);
	if (l_result->id == 0) {
		l_result = EIF_VOID;
		GE_raise(GE_EX_PROG);
	}
	return l_result;
}

#ifdef __cplusplus
}
#endif

#endif