/*
 * tab=4
 *____________________________________________________________
 *
 *		PROGRAM:	C preprocessor
 *		MODULE:		gpre_meta.epp
 *		DESCRIPTION:	Meta data interface to system
 *
 *  The contents of this file are subject to the Interbase Public
 *  License Version 1.0 (the "License"); you may not use this file
 *  except in compliance with the License. You may obtain a copy
 *  of the License at http://www.Inprise.com/IPL.html
 *
 *  Software distributed under the License is distributed on an
 *  "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express
 *  or implied. See the License for the specific language governing
 *  rights and limitations under the License.
 *
 *  The Original Code was created by Inprise Corporation
 *  and its predecessors. Portions created by Inprise Corporation are
 *  Copyright (C) Inprise Corporation.
 *
 *  All Rights Reserved.
 *  Contributor(s): ______________________________________.
 *
 *
 *____________________________________________________________
 *
 */

#include "firebird.h"
#include <string.h>
#include "ibase.h"
#include "../gpre/gpre.h"
#include "../jrd/intl.h"
#include "../gpre/gpre_proto.h"
#include "../gpre/hsh_proto.h"
#include "../gpre/jrdme_proto.h"
#include "../gpre/gpre_meta.h"
#include "../gpre/msc_proto.h"
#include "../gpre/par_proto.h"
#include "../common/utils_proto.h"
#include "../common/classes/ClumpletWriter.h"


const char NEED_IB4_AT_LEAST[] = "Databases before IB4 are not supported";


DATABASE DB = FILENAME "yachts.lnk" RUNTIME database->dbb_filename;

static const UCHAR blr_bpb[] =
{
	isc_bpb_version1,
	isc_bpb_source_type, 1, isc_blob_blr,
	isc_bpb_target_type, 1, isc_blob_blr
};

// CVC: I made this class as a quick solution for the many buffer overruns
// that would result in erratic behavior.
class MetIdentifier
{
	char name[NAME_SIZE];
public:
	explicit MetIdentifier(const char* s)
	{
		fb_utils::copy_terminate(name, s, NAME_SIZE);
	}
	operator char*() {return name;}
	operator const char*() const {return name;}
};


static SLONG array_size(const gpre_fld*);
static void get_array(gpre_dbb*, const TEXT*, gpre_fld*);
static bool get_intl_char_subtype(SSHORT*, const UCHAR*, USHORT, gpre_dbb*);
static bool resolve_charset_and_collation(SSHORT*, const UCHAR*, const UCHAR*);
#ifdef NOT_USED_OR_REPLACED
static int upcase(const TEXT*, TEXT* const);
#endif

/*____________________________________________________________
 *
 *		Lookup a field by name in a context.
 *		If found, return field block.  If not, return NULL.
 */

gpre_fld* MET_context_field( gpre_ctx* context, const char* string)
{
	if (context->ctx_relation) {
		return MET_field(context->ctx_relation, string);
	}

	if (!context->ctx_procedure) {
		return NULL;
	}

	const MetIdentifier name(string);
	gpre_prc* procedure = context->ctx_procedure;

	// At this point the procedure should have been scanned, so all
	// its fields are in the symbol table.

	gpre_fld* field = NULL;
	for (gpre_sym* symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
	{
		if (symbol->sym_type == SYM_field && (field = (gpre_fld*) symbol->sym_object) &&
			field->fld_procedure == procedure)
		{
			return field;
		}
	}

	return field;
}


/*____________________________________________________________
 *
 *		Initialize meta data access to database.  If the
 *		database can't be opened, return false.
 */

bool MET_database(gpre_dbb* database, bool print_version)
{
	static const UCHAR sql_version_info[] =
	{
		isc_info_base_level,
		isc_info_ods_version,
		isc_info_db_sql_dialect,
		isc_info_end
	};

	// Each info item requested will return
	//
	//     1 byte for the info item tag
	//     2 bytes for the length of the information that follows
	//     1 to 4 bytes of integer information
	//
	// isc_info_end will not have a 2-byte length - which gives us
	// some padding in the buffer.

	UCHAR sql_buffer[sizeof(sql_version_info) * (1 + 2 + 4)];

	if (gpreGlob.sw_language == lang_internal)
	{
		JRDMET_init(database);
		return true;
	}

	DB = 0;

	if (!database->dbb_filename)
	{
		CPR_error("No database specified");
		return false;
	}

	// generate a dpb for the attach from the specified
	// compiletime user name and password

	Firebird::ClumpletWriter dpb(Firebird::ClumpletReader::dpbList, MAX_DPB_SIZE);

	const TEXT* p;
	if ((p = database->dbb_c_user)) {
		dpb.insertString(isc_dpb_user_name, p, fb_strlen(p));
	}
	if ((p = database->dbb_c_password)) {
		dpb.insertString(isc_dpb_password, p, fb_strlen(p));
	}
#ifdef TRUSTED_AUTH
	if (gpreGlob.trusted_auth) {
		dpb.insertTag(isc_dpb_trusted_auth);
	}
#endif

	if (isc_attach_database(gds_status, 0, database->dbb_filename, &DB,
							dpb.getBufferLength(),
							reinterpret_cast<const char*>(dpb.getBuffer())))
	{
		// We failed to attach, try in read only mode just in case
		//dpb.insertByte(isc_dpb_set_db_readonly, true);
		//if (isc_attach_database(gds_status, 0, database->dbb_filename, &DB,
		//						dpb.getBufferLength(),
		//						reinterpret_cast<const char*>(dpb.getBuffer())))
		//{
			isc_print_status(gds_status);
			return false;
		//}
	}

	database->dbb_handle = DB;

	if (gpreGlob.sw_version && print_version)
	{
		printf("    Version(s) for database \"%s\"\n", database->dbb_filename);
		isc_version(&DB, NULL, NULL);
	}

	gpreGlob.sw_ods_version = 0;
	gpreGlob.sw_server_version = 0;
	if (isc_database_info(isc_status, &DB, sizeof(sql_version_info),
		reinterpret_cast<const char*>(sql_version_info), sizeof(sql_buffer),
		reinterpret_cast<char*>(sql_buffer)))
	{
		isc_print_status(isc_status);
		return false;
	}

	const UCHAR* ptr = sql_buffer;
	while (*ptr != isc_info_end)
	{
		const UCHAR item = *ptr++;
		const USHORT length = gds__vax_integer(ptr, sizeof(USHORT));
		ptr += sizeof(USHORT);

		switch (item)
		{
		case isc_info_base_level:
			gpreGlob.sw_server_version = (USHORT) ptr[1];
			break;

		case isc_info_ods_version:
			gpreGlob.sw_ods_version = gds__vax_integer(ptr, length);
			break;

		case isc_info_db_sql_dialect:
			gpreGlob.compiletime_db_dialect = gds__vax_integer(ptr, length);
			break;

		case isc_info_error:
			// Error indicates that one of the  option
			// was not understood by the server. Make sure it was
			// isc_info_db_sql_dialect and assume
			// that the database dialect is SQL_DIALECT_V5
			if ((gpreGlob.sw_server_version != 0) && (gpreGlob.sw_ods_version != 0))
				gpreGlob.compiletime_db_dialect = SQL_DIALECT_V5;
			else
				printf("Internal error: Unexpected isc_info_value %d\n", item);
			break;

		default:
			printf("Internal error: Unexpected isc_info_value %d\n", item);
			break;
		}
		ptr += length;
	}

	if (!gpreGlob.dialect_specified)
		gpreGlob.sw_sql_dialect = gpreGlob.compiletime_db_dialect;

	if (gpreGlob.sw_ods_version < 8)
	{
		CPR_error(NEED_IB4_AT_LEAST);
		CPR_abort();
	}

	if (gpreGlob.sw_ods_version < 10)
	{
		if (gpreGlob.sw_sql_dialect != gpreGlob.compiletime_db_dialect)
		{
			char warn_mesg[100];
			sprintf(warn_mesg, "Pre 6.0 database. Cannot use dialect %d, Resetting to %d\n",
					gpreGlob.sw_sql_dialect, gpreGlob.compiletime_db_dialect);
			CPR_warn(warn_mesg);
		}
		gpreGlob.sw_sql_dialect = gpreGlob.compiletime_db_dialect;
	}
	else if (gpreGlob.sw_sql_dialect != gpreGlob.compiletime_db_dialect)
	{
		char warn_mesg[100];
		sprintf(warn_mesg, "Client dialect set to %d. Compiletime database dialect is %d\n",
				gpreGlob.sw_sql_dialect, gpreGlob.compiletime_db_dialect);
		CPR_warn(warn_mesg);
	}

#ifdef DEBUG
	if (gpreGlob.sw_version && print_version)
		printf("Gpre Start up values. \
	\n\tServer Ver                   : %d\
        \n\tCompile time db Ver          : %d\
	\n\tCompile time db Sql Dialect  : %d\
	\n\tClient Sql dialect set to    : %d\n\n",
	gpreGlob.sw_server_version, gpreGlob.sw_ods_version, gpreGlob.compiletime_db_dialect, gpreGlob.sw_sql_dialect);
#endif

	return true;
}


/*____________________________________________________________
 *
 *		Lookup a domain by name.
 *		Initialize the size of the field.
 */

bool MET_domain_lookup(gpre_req* request, gpre_fld* field, const char* string)
{
	const MetIdentifier name(string);
	bool found = false;

	// Lookup domain.  If we find it in the hash table, and it is not the
	// field we a currently looking at, use it.  Else look it up from the
	// database.

	for (gpre_sym* symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
	{
		gpre_fld* d_field;
		if ((symbol->sym_type == SYM_field) &&
			((d_field = (gpre_fld*) symbol->sym_object) && (d_field != field)))
		{
			field->fld_length = d_field->fld_length;
			field->fld_scale = d_field->fld_scale;
			field->fld_sub_type = d_field->fld_sub_type;
			field->fld_dtype = d_field->fld_dtype;
			field->fld_ttype = d_field->fld_ttype;
			field->fld_charset_id = d_field->fld_charset_id;
			field->fld_collate_id = d_field->fld_collate_id;
			field->fld_char_length = d_field->fld_char_length;
			return true;
		}
	}

	if (!request)
		return false;

	gpre_dbb* database = request->req_database;
	if (database->dbb_flags & DBB_sqlca)
		return false;

	DB = database->dbb_handle;
	gds_trans = database->dbb_transaction;

	FOR(REQUEST_HANDLE database->dbb_domain_request)
	F IN RDB$FIELDS WITH F.RDB$FIELD_NAME EQ name
		found = true;
		field->fld_length = F.RDB$FIELD_LENGTH;
		field->fld_scale = F.RDB$FIELD_SCALE;
		field->fld_sub_type = F.RDB$FIELD_SUB_TYPE;
		field->fld_dtype = MET_get_dtype(
			F.RDB$FIELD_TYPE, F.RDB$FIELD_SUB_TYPE, F.RDB$CHARACTER_LENGTH, &field->fld_length);

		switch (field->fld_dtype)
		{
		case dtype_text:
		case dtype_cstring:
			field->fld_flags |= FLD_text;
			break;

		case dtype_blob:
			field->fld_flags |= FLD_blob;
			field->fld_seg_length = F.RDB$SEGMENT_LENGTH;
			break;
		}

		if (field->fld_dtype <= dtype_any_text)
		{
			if (!F.RDB$CHARACTER_LENGTH.NULL)
				field->fld_char_length = F.RDB$CHARACTER_LENGTH;
			if (!F.RDB$CHARACTER_SET_ID.NULL)
				field->fld_charset_id = F.RDB$CHARACTER_SET_ID;
			if (!F.RDB$COLLATION_ID.NULL)
				field->fld_collate_id = F.RDB$COLLATION_ID;
		}

		field->fld_ttype = INTL_CS_COLL_TO_TTYPE(field->fld_charset_id, field->fld_collate_id);

	END_FOR;

	return found;
}


/*____________________________________________________________
 *
 *		Gets the default value for a domain of an existing table
 */

bool MET_get_domain_default(gpre_dbb* database,
							const TEXT* domain_name,
							TEXT* buffer,
							USHORT buff_length)
{
	if (database == NULL)
		return false;

	if (database->dbb_handle == 0 && !MET_database(database, false))
		CPR_exit(FINI_ERROR);

	fb_assert(database->dbb_transaction == 0);
	const MetIdentifier name(domain_name);
	gds_trans = 0;
	DB = database->dbb_handle;
	ISC_STATUS_ARRAY status_vect;

	START_TRANSACTION;

	bool has_default = false;
	FOR(REQUEST_HANDLE database->dbb_domain_request)
	GLOB_FLD IN RDB$FIELDS WITH
		GLOB_FLD.RDB$FIELD_NAME EQ name
		if (!GLOB_FLD.RDB$DEFAULT_VALUE.NULL)
		{
			ISC_QUAD* blob_id = &GLOB_FLD.RDB$DEFAULT_VALUE;

			// open the blob
			isc_blob_handle blob_handle = 0;
			ISC_STATUS stat = isc_open_blob2(status_vect, &DB, &gds_trans,
									&blob_handle, blob_id, sizeof(blr_bpb), blr_bpb);
			if (stat)
			{
				isc_print_status(status_vect);
				CPR_exit(FINI_ERROR);
			}
			// fetch segments. Assume buffer is big enough.
			TEXT* ptr_in_buffer = buffer;
			while (true)
			{
				SSHORT length;
				stat = isc_get_segment(status_vect, &blob_handle, (USHORT*) &length,
									   buff_length, ptr_in_buffer);
				ptr_in_buffer = ptr_in_buffer + length;
				buff_length = buff_length - length;

				if (!stat)
					continue;
				if (stat == isc_segstr_eof)
				{
					// null terminate the buffer
					*ptr_in_buffer = 0;
					break;
				}
				CPR_exit(FINI_ERROR);
			}
			isc_close_blob(status_vect, &blob_handle);

			// the default string must be of the form:
			// blr_version4 blr_literal ..... blr_eoc OR
			// blr_version4 blr_null blr_eoc OR
			// blr_version4 blr_user_name  blr_eoc
			fb_assert(buffer[0] == blr_version4 || buffer[0] == blr_version5);
			fb_assert(buffer[1] == blr_literal || buffer[1] == blr_null || buffer[1] == blr_user_name);

			has_default = true;
		}
		else
		{
			// default not found

			if (gpreGlob.sw_sql_dialect > SQL_DIALECT_V5)
				buffer[0] = blr_version5;
			else
				buffer[0] = blr_version4;
			buffer[1] = blr_eoc;
		}
	END_FOR
	COMMIT;
	return has_default;
}


/*____________________________________________________________
 *
 *		Gets the default value for a column of an existing table.
 *		Will check the default for the column of the table, if that is
 *		not present, will check for the default of the relevant domain
 *
 *		The default blr is returned in buffer. The blr is of the form
 *		blr_version4 blr_literal ..... blr_eoc
 *
 *		Reads the system tables RDB$FIELDS and RDB$RELATION_FIELDS.
 */

bool MET_get_column_default(const gpre_rel* relation,
							const TEXT* column_name,
							TEXT* buffer,
							USHORT buff_length)
{
	const MetIdentifier name(column_name);

	gpre_dbb* database = relation->rel_database;
	if (database == NULL)
		return false;

	if (database->dbb_handle == 0 && !MET_database(database, false))
		CPR_exit(FINI_ERROR);

	fb_assert(database->dbb_transaction == 0);
	gds_trans = 0;
	DB = database->dbb_handle;
	ISC_STATUS_ARRAY status_vect;

	START_TRANSACTION;

	bool has_default = false;
	FOR(REQUEST_HANDLE database->dbb_field_request)
	RFR IN RDB$RELATION_FIELDS CROSS F IN RDB$FIELDS WITH
		RFR.RDB$FIELD_SOURCE EQ F.RDB$FIELD_NAME AND
		RFR.RDB$FIELD_NAME EQ name AND
		RFR.RDB$RELATION_NAME EQ relation->rel_symbol->sym_string

		ISC_QUAD* blob_id;
		if (!RFR.RDB$DEFAULT_VALUE.NULL)
		{
			blob_id = &RFR.RDB$DEFAULT_VALUE;
			has_default = true;
		}
		else if (!F.RDB$DEFAULT_VALUE.NULL)
		{
			blob_id = &F.RDB$DEFAULT_VALUE;
			has_default = true;
		}
		else {
			blob_id = NULL; // silence non initialized warning
		}

		if (has_default)
		{
			// open the blob
			isc_blob_handle blob_handle = 0;
			ISC_STATUS stat = isc_open_blob2(status_vect, &DB, &gds_trans,
								  &blob_handle, blob_id, sizeof(blr_bpb), blr_bpb);
			if (stat)
			{
				isc_print_status(status_vect);
				CPR_exit(FINI_ERROR);
			}

			// fetch segments. Assuming here that the buffer is big enough.
			TEXT* ptr_in_buffer = buffer;
			while (true)
			{
				SSHORT length;
				stat = isc_get_segment(status_vect, &blob_handle,
									   (USHORT*)&length, buff_length, ptr_in_buffer);
				ptr_in_buffer = ptr_in_buffer + length;
				buff_length = buff_length - length;
				if (!stat)
					continue;
				if (stat == isc_segstr_eof)
				{
					// null terminate the buffer
					*ptr_in_buffer = 0;
					break;
				}
				CPR_exit(FINI_ERROR);
			}
			isc_close_blob(status_vect, &blob_handle);

			// the default string must be of the form:
			// blr_version4 blr_literal ..... blr_eoc OR
			// blr_version4 blr_null blr_eoc OR
			// blr_version4 blr_user_name blr_eoc

			fb_assert(buffer[0] == blr_version4 || buffer[0] == blr_version5);
			fb_assert(buffer[1] == blr_literal || buffer[1] == blr_null || buffer[1] == blr_user_name);
		}
		else
		{
			if (gpreGlob.sw_sql_dialect > SQL_DIALECT_V5)
				buffer[0] = blr_version5;
			else
				buffer[0] = blr_version4;
			buffer[1] = blr_eoc;
		}

	END_FOR;
	COMMIT;
	return has_default;
}


/*____________________________________________________________
 *
 *		Lookup the fields for the primary key
 *		index on a relation, returning a list
 *		of the fields.
 */

gpre_lls* MET_get_primary_key(gpre_dbb* database, const TEXT* relation_name)
{
	const MetIdentifier name(relation_name);

	if (database == NULL)
		return NULL;

	if (database->dbb_handle == 0 && !MET_database(database, false))
		CPR_exit(FINI_ERROR);

	fb_assert(database->dbb_transaction == 0);
	gds_trans = 0;
	DB = database->dbb_handle;

	START_TRANSACTION;

    gpre_lls* fields = NULL;
	gpre_lls** ptr_fields = &fields;

	FOR(REQUEST_HANDLE database->dbb_primary_key_request)
		X IN RDB$INDICES CROSS
		Y IN RDB$INDEX_SEGMENTS
		OVER RDB$INDEX_NAME CROSS
		Z IN RDB$RELATION_CONSTRAINTS
		OVER RDB$INDEX_NAME
		WITH Z.RDB$RELATION_NAME EQ name
		AND Z.RDB$CONSTRAINT_TYPE EQ "PRIMARY KEY"
		SORTED BY Y.RDB$FIELD_POSITION

		str* field_name = (str*) MSC_string(Y.RDB$FIELD_NAME);
		// Strip off any trailing spaces from field name
		// CVC: This code stops at the first space, even in the middle.
		TEXT* tmp = (TEXT*) field_name;
		while (*tmp && *tmp != ' ')
			++tmp;
		*tmp = '\0';

		MSC_push((gpre_nod*) field_name, ptr_fields);
		ptr_fields = &(*ptr_fields)->lls_next;

	END_FOR
	COMMIT;

	return fields;
}


/*____________________________________________________________
 *
 *		Lookup a field by name in a relation.
 *		If found, return field block.  If not, return NULL.
 */

gpre_fld* MET_field(gpre_rel* relation, const char* string)
{
	const MetIdentifier name(string);
	const SSHORT length = static_cast<SSHORT>(strlen(name));

	// Lookup field.  If we find it, nifty.  If not, look it up in the
	// database.

	gpre_sym* symbol;
	for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
	{
		if (symbol->sym_type == SYM_keyword && symbol->sym_keyword == (int) KW_DBKEY)
		{
			return relation->rel_dbkey;
		}

		gpre_fld* field;
		if (symbol->sym_type == SYM_field && (field = (gpre_fld*) symbol->sym_object) &&
			field->fld_relation == relation)
		{
			return field;
		}
	}

	if (gpreGlob.sw_language == lang_internal)
		return NULL;

	gpre_dbb* database = relation->rel_database;

	if (database->dbb_flags & DBB_sqlca)
		return NULL;

	DB = database->dbb_handle;
	gds_trans = database->dbb_transaction;

	gpre_fld* field = NULL;
	FOR(REQUEST_HANDLE database->dbb_field_request)
	RFR IN RDB$RELATION_FIELDS CROSS F IN RDB$FIELDS WITH
		RFR.RDB$FIELD_SOURCE EQ F.RDB$FIELD_NAME AND
		RFR.RDB$FIELD_NAME EQ name AND
		RFR.RDB$RELATION_NAME EQ relation->rel_symbol->sym_string
		field = (gpre_fld*) MSC_alloc(FLD_LEN);
		field->fld_relation = relation;
		field->fld_next = relation->rel_fields;
		relation->rel_fields = field;
		field->fld_id = RFR.RDB$FIELD_ID;
		field->fld_length = F.RDB$FIELD_LENGTH;
		field->fld_scale = F.RDB$FIELD_SCALE;
		field->fld_position = RFR.RDB$FIELD_POSITION;
		field->fld_sub_type = F.RDB$FIELD_SUB_TYPE;
		field->fld_dtype = MET_get_dtype(
			F.RDB$FIELD_TYPE, F.RDB$FIELD_SUB_TYPE, F.RDB$CHARACTER_LENGTH, &field->fld_length);

		switch (field->fld_dtype)
		{
		case dtype_text:
		case dtype_cstring:
			field->fld_flags |= FLD_text;
			break;

		case dtype_blob:
			field->fld_flags |= FLD_blob;
			field->fld_seg_length = F.RDB$SEGMENT_LENGTH;
			break;
		}

		if (F.RDB$DIMENSIONS)
			get_array(database, F.RDB$FIELD_NAME, field);

		if ((field->fld_dtype <= dtype_any_text) || (field->fld_dtype == dtype_blob))
		{
			if (!F.RDB$CHARACTER_SET_ID.NULL)
				field->fld_charset_id = F.RDB$CHARACTER_SET_ID;
			if (!RFR.RDB$COLLATION_ID.NULL)
				field->fld_collate_id = RFR.RDB$COLLATION_ID;
			else if (!F.RDB$COLLATION_ID.NULL)
				field->fld_collate_id = F.RDB$COLLATION_ID;
		}

		field->fld_ttype =
			INTL_CS_COLL_TO_TTYPE(field->fld_charset_id, field->fld_collate_id);
		field->fld_symbol = symbol = MSC_symbol(SYM_field, name, length, (gpre_ctx*) field);
		HSH_insert(symbol);
		field->fld_global = symbol =
			MSC_symbol(SYM_field, RFR.RDB$FIELD_SOURCE,
					   fb_utils::name_length(RFR.RDB$FIELD_SOURCE), (gpre_ctx*) field);
	END_FOR;

	return field;
}


/*____________________________________________________________
 *
 *     Return a list of the fields in a relation
 */

gpre_nod* MET_fields(gpre_ctx* context)
{
	gpre_fld* field;
	gpre_nod* field_node;
	ref* reference;

	gpre_prc* procedure = context->ctx_procedure;
	if (procedure)
	{
		gpre_nod* node = MSC_node(nod_list, procedure->prc_out_count);
		//count = 0;
		for (field = procedure->prc_outputs; field; field = field->fld_next)
		{
			reference = (ref*) MSC_alloc(REF_LEN);
			reference->ref_field = field;
			reference->ref_context = context;
			field_node = MSC_unary(nod_field, (gpre_nod*) reference);
			node->nod_arg[field->fld_position] = field_node;
			//count++;
		}
		return node;
	}

	gpre_rel* relation = context->ctx_relation;
	if (relation->rel_meta)
	{
		int count = 0;
		for (field = relation->rel_fields; field; field = field->fld_next) {
				++count;
		}
		gpre_nod* anode = MSC_node(nod_list, count);
		//count = 0;
		for (field = relation->rel_fields; field; field = field->fld_next)
		{
			reference = (ref*) MSC_alloc(REF_LEN);
			reference->ref_field = field;
			reference->ref_context = context;
			field_node = MSC_unary(nod_field, (gpre_nod*) reference);
			anode->nod_arg[field->fld_position] = field_node;
			//count++;
		}
		return anode;
	}

	if (gpreGlob.sw_language == lang_internal)
		return NULL;

	gpre_dbb* database = relation->rel_database;
	DB = database->dbb_handle;
	gds_trans = database->dbb_transaction;

	int count = 0;
	gpre_lls* stack = NULL;
	FOR(REQUEST_HANDLE database->dbb_flds_request)
	RFR IN RDB$RELATION_FIELDS CROSS GLOB_FLD IN RDB$FIELDS WITH
		RFR.RDB$FIELD_SOURCE EQ GLOB_FLD.RDB$FIELD_NAME AND
		RFR.RDB$RELATION_NAME EQ relation->rel_symbol->sym_string
		SORTED BY RFR.RDB$FIELD_POSITION

		TEXT* p;
		// This code stops at the first blank.
		for (p = RFR.RDB$FIELD_NAME; *p && *p != ' '; p++);
		*p = 0;
		MSC_push((gpre_nod*) MET_field(relation, RFR.RDB$FIELD_NAME), &stack);
		count++;
	END_FOR;

	gpre_nod* node = MSC_node(nod_list, count);

	while (stack)
	{
		field = (gpre_fld*) MSC_pop(&stack);
		reference = (ref*) MSC_alloc(REF_LEN);
		reference->ref_field = field;
		reference->ref_context = context;
		field_node = MSC_unary(nod_field, (gpre_nod*) reference);
		node->nod_arg[--count] = field_node;
	}

	return node;
}


/*____________________________________________________________
 *
 *		Shutdown all attached databases.
 */

void MET_fini(gpre_dbb* end)
{
	for (gpre_dbb* database = gpreGlob.isc_databases;
		 database && database != end;
		 database = database->dbb_next)
	{
		if (DB = database->dbb_handle)
		{
			if (gds_trans = database->dbb_transaction)
				COMMIT;
			FINISH;
			database->dbb_handle = 0;
			database->dbb_transaction = 0;

			database->dbb_field_request = 0;
			database->dbb_flds_request = 0;
			//database->dbb_relation_request = 0;
			database->dbb_procedure_request = 0;
			database->dbb_udf_request = 0;
			database->dbb_trigger_request = 0;
			database->dbb_proc_prms_request = 0;
			database->dbb_proc_prm_fld_request = 0;
			database->dbb_index_request = 0;
			database->dbb_type_request = 0;
			database->dbb_array_request = 0;
			database->dbb_dimension_request = 0;
			database->dbb_domain_request = 0;
			//database->dbb_generator_request = 0;
			database->dbb_view_request = 0;
			database->dbb_primary_key_request = 0;
		}
	}
}


/*____________________________________________________________
 *
 *		Lookup a generator by name.
 *		If found, return string. If not, return NULL.
 */

const SCHAR* MET_generator(const TEXT* string, const gpre_dbb* database)
{
	const MetIdentifier name(string);

	for (gpre_sym* symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
		if ((symbol->sym_type == SYM_generator) && (database == (gpre_dbb*) symbol->sym_object))
		{
			return symbol->sym_string;
		}

	return NULL;
}


/*____________________________________________________________
 *
 *		Compute internal datatype and length based on system relation field values.
 */

USHORT MET_get_dtype(USHORT blr_dtype, USHORT sub_type, USHORT char_length, USHORT* length)
{
	USHORT dtype;

	USHORT corr_length = *length;

	switch (blr_dtype)
	{
	case blr_varying:
	case blr_text:
		if (char_length != 0 && sub_type >= dsc_text_type_metadata)	// subtypes below are single byte characters
			corr_length = char_length * 4;

		dtype = dtype_text;
		if (sub_type == dsc_text_type_fixed)
		{
			if (blr_dtype == blr_varying)
			{
				dtype = dtype_varying;
				// Round up size of field to get right alignment and workaround message length mismatch error
				corr_length = (corr_length + 1) & ~1U;
			}
		}
		else if (gpreGlob.sw_cstring)
		{
			++corr_length;
			dtype = dtype_cstring;
		}
		break;

	case blr_cstring:
		dtype = dtype_cstring;
		if (char_length != 0 && sub_type >= dsc_text_type_metadata)	// subtypes below are single byte characters
			corr_length = char_length * 4;
		++corr_length;
		break;

	case blr_short:
		dtype = dtype_short;
		corr_length = sizeof(SSHORT);
		break;

	case blr_long:
		dtype = dtype_long;
		corr_length = sizeof(SLONG);
		break;

	case blr_quad:
		dtype = dtype_quad;
		corr_length = sizeof(ISC_QUAD);
		break;

	case blr_float:
		dtype = dtype_real;
		corr_length = sizeof(float);
		break;

	case blr_double:
		dtype = dtype_double;
		corr_length = sizeof(double);
		break;

	case blr_blob:
		dtype = dtype_blob;
		corr_length = sizeof(ISC_QUAD);
		break;

	// Begin sql date/time/timestamp
	case blr_sql_date:
		dtype = dtype_sql_date;
		corr_length = sizeof(ISC_DATE);
		break;

	case blr_sql_time:
		dtype = dtype_sql_time;
		corr_length = sizeof(ISC_TIME);
		break;

	case blr_timestamp:
		dtype = dtype_timestamp;
		corr_length = sizeof(ISC_TIMESTAMP);
		break;
	// End sql date/time/timestamp

	case blr_int64:
		dtype = dtype_int64;
		corr_length = sizeof(ISC_INT64);
		break;

	case blr_bool:
		dtype = dtype_boolean;
		corr_length = sizeof(UCHAR);
		break;

	default:
		CPR_error("datatype not supported");
		return 0; // silence non initialized warning
	}

	*length = corr_length;

	return dtype;
}


/*____________________________________________________________
 *
 *		Lookup a procedure (represented by a token) in a database.
 *		Return a procedure block (if name is found) or NULL.
 *
 *		This function has been cloned into MET_get_udf
 */

gpre_prc* MET_get_procedure(gpre_dbb* database, const TEXT* string, const TEXT* owner_name)
{
	const MetIdentifier name(string), owner(owner_name);

	gpre_prc* procedure = NULL;

	for (gpre_sym* symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
	{
		if (symbol->sym_type == SYM_procedure && (procedure = (gpre_prc*) symbol->sym_object) &&
			procedure->prc_database == database &&
			(!owner[0] || (procedure->prc_owner && !strcmp(owner, procedure->prc_owner->sym_string))))
		{
			break;
		}
	}

	if (!procedure)
		return NULL;

	if (procedure->prc_flags & PRC_scanned)
		return procedure;

	FOR(REQUEST_HANDLE database->dbb_procedure_request)
	X IN RDB$PROCEDURES
	WITH X.RDB$PROCEDURE_ID = procedure->prc_id AND
		 X.RDB$PACKAGE_NAME MISSING

	for (USHORT type = 0; type < 2; type++)
	{
		USHORT count = 0;
		gpre_fld** fld_list;
		if (type)
			fld_list = &procedure->prc_outputs;
		else
			fld_list = &procedure->prc_inputs;

		FOR(REQUEST_HANDLE database->dbb_proc_prms_request)
		Y IN RDB$PROCEDURE_PARAMETERS WITH
			Y.RDB$PROCEDURE_NAME EQ name AND
			Y.RDB$PARAMETER_TYPE EQ type
			SORTED BY DESCENDING Y.RDB$PARAMETER_NUMBER
			count++;

			FOR(REQUEST_HANDLE database->dbb_proc_prm_fld_request)
			F IN RDB$FIELDS WITH
				Y.RDB$FIELD_SOURCE EQ F.RDB$FIELD_NAME
				gpre_fld* field = (gpre_fld*) MSC_alloc(FLD_LEN);
				field->fld_procedure = procedure;
				field->fld_next = *fld_list;
				*fld_list = field;
				field->fld_position = Y.RDB$PARAMETER_NUMBER;
				field->fld_length = F.RDB$FIELD_LENGTH;
				field->fld_scale = F.RDB$FIELD_SCALE;
				field->fld_sub_type = F.RDB$FIELD_SUB_TYPE;
				field->fld_dtype = MET_get_dtype(F.RDB$FIELD_TYPE, F.RDB$FIELD_SUB_TYPE,
					F.RDB$CHARACTER_LENGTH, &field->fld_length);

				switch (field->fld_dtype)
				{
				case dtype_text:
				case dtype_cstring:
					field->fld_flags |= FLD_text;
					if (!F.RDB$CHARACTER_LENGTH.NULL)
						field->fld_char_length = F.RDB$CHARACTER_LENGTH;
					if (!F.RDB$CHARACTER_SET_ID.NULL)
						field->fld_charset_id = F.RDB$CHARACTER_SET_ID;
					if (!F.RDB$COLLATION_ID.NULL)
						field->fld_collate_id = F.RDB$COLLATION_ID;
					field->fld_ttype =
						INTL_CS_COLL_TO_TTYPE(field->fld_charset_id, field->fld_collate_id);
					break;

				case dtype_blob:
					field->fld_flags |= FLD_blob;
					field->fld_seg_length = F.RDB$SEGMENT_LENGTH;
					if (!F.RDB$CHARACTER_SET_ID.NULL)
						field->fld_charset_id = F.RDB$CHARACTER_SET_ID;
					break;
				}
				field->fld_symbol = MSC_symbol(SYM_field,
											   Y.RDB$PARAMETER_NAME,
											   fb_utils::name_length(Y.RDB$PARAMETER_NAME),
											   (gpre_ctx*) field);
				// If output parameter, insert in symbol table as a field.
				if (type)
					HSH_insert(field->fld_symbol);

			END_FOR;

		END_FOR;

		if (type)
			procedure->prc_out_count = count;
		else
			procedure->prc_in_count = count;
	}

	END_FOR;
	procedure->prc_flags |= PRC_scanned;

	// Generate a dummy relation to point to the procedure to use when procedure
	// is used as a view.
	return procedure;
}


/*____________________________________________________________
 *
 *		Lookup a relation (represented by a token) in a database.
 *		Return a relation block (if name is found) or NULL.
 */

gpre_rel* MET_get_relation(gpre_dbb* database, const TEXT* string, const TEXT* owner_name)
{
	gpre_rel* relation;
	const MetIdentifier name(string), owner(owner_name);

	for (gpre_sym* symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
	{
		if (symbol->sym_type == SYM_relation && (relation = (gpre_rel*) symbol->sym_object) &&
			relation->rel_database == database &&
			(!owner[0] || (relation->rel_owner && !strcmp(owner, relation->rel_owner->sym_string))))
		{
			return relation;
		}
	}

	return NULL;
}


/*____________________________________________________________
 *
 */

intlsym* MET_get_text_subtype(SSHORT ttype)
{
	for (intlsym* p = gpreGlob.text_subtypes; p; p = p->intlsym_next)
	{
		if (p->intlsym_ttype == ttype)
			return p;
	}

	return NULL;
}


/*____________________________________________________________
 *
 *		Lookup a udf (represented by a token) in a database.
 *		Return a udf block (if name is found) or NULL.
 *
 *		This function was cloned from MET_get_procedure
 */

udf* MET_get_udf(gpre_dbb* database, const TEXT* string)
{
	const MetIdentifier name(string);

	udf* the_udf = NULL;
	for (gpre_sym* symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
	{
		if (symbol->sym_type == SYM_udf &&
			(the_udf = (udf*) symbol->sym_object) && the_udf->udf_database == database)
		{
			break;
		}
	}

	if (!the_udf)
		return NULL;

	if (the_udf->udf_flags & UDF_scanned)
		return the_udf;

	FOR(REQUEST_HANDLE database->dbb_udf_request)
	UDF_DEF IN RDB$FUNCTIONS CROSS
		UDF_ARG IN RDB$FUNCTION_ARGUMENTS
		WITH UDF_DEF.RDB$FUNCTION_NAME EQ name AND
		UDF_DEF.RDB$PACKAGE_NAME MISSING AND
		UDF_ARG.RDB$PACKAGE_NAME MISSING AND
		UDF_DEF.RDB$FUNCTION_NAME EQ UDF_ARG.RDB$FUNCTION_NAME AND
		UDF_DEF.RDB$RETURN_ARGUMENT != UDF_ARG.RDB$ARGUMENT_POSITION
		SORTED BY DESCENDING UDF_ARG.RDB$ARGUMENT_POSITION;

		gpre_fld* field = (gpre_fld*) MSC_alloc(FLD_LEN);
		field->fld_next = the_udf->udf_inputs;
		the_udf->udf_inputs = field;
		the_udf->udf_args++;
		field->fld_position = UDF_ARG.RDB$ARGUMENT_POSITION;
		field->fld_length = UDF_ARG.RDB$FIELD_LENGTH;
		field->fld_scale = UDF_ARG.RDB$FIELD_SCALE;
		field->fld_sub_type = UDF_ARG.RDB$FIELD_SUB_TYPE;
		field->fld_dtype = MET_get_dtype(UDF_ARG.RDB$FIELD_TYPE, UDF_ARG.RDB$FIELD_SUB_TYPE,
			UDF_ARG.RDB$CHARACTER_LENGTH, &field->fld_length);

		switch (field->fld_dtype)
		{
		case dtype_text:
		case dtype_cstring:
			field->fld_flags |= FLD_text;
			if (!UDF_ARG.RDB$CHARACTER_SET_ID.NULL)
				field->fld_charset_id = UDF_ARG.RDB$CHARACTER_SET_ID;
			field->fld_ttype = INTL_CS_COLL_TO_TTYPE(field->fld_charset_id, field->fld_collate_id);
			break;

		case dtype_blob:
			field->fld_flags |= FLD_blob;
			if (!UDF_ARG.RDB$CHARACTER_SET_ID.NULL)
				field->fld_charset_id = UDF_ARG.RDB$CHARACTER_SET_ID;
			break;
		}
	END_FOR;

	the_udf->udf_flags |= UDF_scanned;

	return the_udf;
}


/*____________________________________________________________
 *
 *		Return relation if the passed view_name represents a
 *		view with the passed relation as a base table
 *		(the relation could be an alias).
 */

gpre_rel* MET_get_view_relation(gpre_req* request,
							   const char* view_name,
							   const char* relation_or_alias,
							   USHORT level)
{
	gpre_dbb* database = request->req_database;
	DB = database->dbb_handle;
	gds_trans = database->dbb_transaction;

	gpre_rel* relation = NULL;

	FOR(REQUEST_HANDLE database->dbb_view_request, LEVEL level)
	X IN RDB$VIEW_RELATIONS WITH
		X.RDB$VIEW_NAME EQ view_name
		TEXT* p;
		// This code stops at the first blank.
		for (p = X.RDB$CONTEXT_NAME; *p && *p != ' '; p++);
		*p = 0;

		for (p = X.RDB$RELATION_NAME; *p && *p != ' '; p++);
		*p = 0;

		if (!strcmp(X.RDB$RELATION_NAME, relation_or_alias) ||
			!strcmp(X.RDB$CONTEXT_NAME, relation_or_alias))
		{
			return MET_get_relation(database, X.RDB$RELATION_NAME, "");
		}

		if (relation =
			MET_get_view_relation(request, X.RDB$RELATION_NAME, relation_or_alias, level + 1))
		{
			return relation;
		}

	END_FOR;

	return NULL;
}


/*____________________________________________________________
 *
 *		Lookup an index for a database.
 *		Return an index block (if name is found) or NULL.
 */

gpre_index* MET_index(gpre_dbb* database, const TEXT* string)
{
	gpre_index* index;
	const MetIdentifier name(string);
	const USHORT length = static_cast<USHORT>(strlen(name));

	gpre_sym* symbol;
	for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
	{
		if (symbol->sym_type == SYM_index && (index = (gpre_index*) symbol->sym_object) &&
			index->ind_relation->rel_database == database)
		{
			return index;
		}
	}

	if (gpreGlob.sw_language == lang_internal)
		return NULL;

	if (database->dbb_flags & DBB_sqlca)
		return NULL;

	DB = database->dbb_handle;
	gds_trans = database->dbb_transaction;
	index = NULL;

	FOR(REQUEST_HANDLE database->dbb_index_request)
	X IN RDB$INDICES WITH X.RDB$INDEX_NAME EQ name
		index = (gpre_index*) MSC_alloc(IND_LEN);
		index->ind_symbol = symbol = MSC_symbol(SYM_index, name, length, (gpre_ctx*) index);
		index->ind_relation = MET_get_relation(database, X.RDB$RELATION_NAME, "");
		HSH_insert(symbol);

	END_FOR;

	return index;
}


/*____________________________________________________________
 *
 *		Load all of the relation names, procedure names
 *       and user defined function names
 *       into the symbol (hash) table.
 *      Includes also charsets and collations.
 */

void MET_load_hash_table(gpre_dbb* database)
{
	// If this is an internal ISC access method invocation, don't do any of this stuff

	if (gpreGlob.sw_language == lang_internal)
		return;

	if (!database->dbb_handle)
	{
		if (!MET_database(database, false))
			CPR_exit(FINI_ERROR);
	}

	if (database->dbb_transaction)
	{
		// we must have already loaded this one
		return;
	}

	gds_trans = 0;
	DB = database->dbb_handle;

	START_TRANSACTION;

	database->dbb_transaction = gds_trans;

	// Determine if the database is V3.

	bool post_v3_flag = false;
	FB_API_HANDLE handle = 0;
	FOR(REQUEST_HANDLE handle)
	X IN RDB$RELATIONS WITH
		X.RDB$RELATION_NAME = 'RDB$PROCEDURES' AND
		X.RDB$SYSTEM_FLAG = 1
		post_v3_flag = true;

	END_FOR;
	isc_release_request(gds_status, &handle);

	if (!post_v3_flag)
	{
		CPR_error(NEED_IB4_AT_LEAST);
		CPR_abort();
	}

	SLONG length;

	// Pick up all relations (necessary to parse parts of the GDML grammar)

	FOR(REQUEST_HANDLE handle)
	X IN RDB$RELATIONS
		gpre_rel* relation = (gpre_rel*) MSC_alloc(REL_LEN);
		relation->rel_database = database;
		relation->rel_next = database->dbb_relations;
		database->dbb_relations = relation;
		relation->rel_id = X.RDB$RELATION_ID;
		gpre_sym* symbol = relation->rel_symbol =
			MSC_symbol(SYM_relation, X.RDB$RELATION_NAME,
					   fb_utils::name_length(X.RDB$RELATION_NAME), (gpre_ctx*) relation);
		HSH_insert(symbol);
		const USHORT dbk_len = (X.RDB$DBKEY_LENGTH) ? X.RDB$DBKEY_LENGTH : 8;
		gpre_fld* dbkey = MET_make_field("rdb$db_key", dtype_text, dbk_len, false);
		relation->rel_dbkey = dbkey;
		dbkey->fld_flags |= FLD_dbkey | FLD_text | FLD_charset;
		dbkey->fld_ttype = ttype_binary;

		if (!X.RDB$OWNER_NAME.NULL && (length = fb_utils::name_length(X.RDB$OWNER_NAME)))
		{
			relation->rel_owner = MSC_symbol(SYM_username, X.RDB$OWNER_NAME, length, NULL);
		}

	END_FOR;

	isc_release_request(gds_status, &handle);

	// Pick up all procedures (necessary to parse parts of the GDML grammar)

	FOR(REQUEST_HANDLE handle)
	X IN RDB$PROCEDURES
	WITH X.RDB$PACKAGE_NAME MISSING
		gpre_prc* procedure = (gpre_prc*) MSC_alloc(REL_LEN);
		procedure->prc_database = database;
		procedure->prc_next = database->dbb_procedures;
		database->dbb_procedures = procedure;
		procedure->prc_id = X.RDB$PROCEDURE_ID;
		gpre_sym* symbol = procedure->prc_symbol =
			MSC_symbol(SYM_procedure, X.RDB$PROCEDURE_NAME,
					   fb_utils::name_length(X.RDB$PROCEDURE_NAME), (gpre_ctx*) procedure);
		HSH_insert(symbol);
		if (!X.RDB$OWNER_NAME.NULL && (length = fb_utils::name_length(X.RDB$OWNER_NAME)))
			procedure->prc_owner = MSC_symbol(SYM_username, X.RDB$OWNER_NAME, length, NULL);
	END_FOR
	ON_ERROR
		CPR_error(NEED_IB4_AT_LEAST);
		CPR_abort();
	END_ERROR;

	if (handle)
		isc_release_request(gds_status, &handle);

	// Pickup any user defined functions.  If the database does not support udf's,
	// this may fail

	TEXT* p;
	FB_API_HANDLE handle2 = 0;

	FOR(REQUEST_HANDLE handle)
	FUN IN RDB$FUNCTIONS CROSS ARG IN RDB$FUNCTION_ARGUMENTS WITH
		FUN.RDB$FUNCTION_NAME EQ ARG.RDB$FUNCTION_NAME AND
		FUN.RDB$PACKAGE_NAME MISSING AND
		ARG.RDB$PACKAGE_NAME MISSING AND
		FUN.RDB$RETURN_ARGUMENT EQ ARG.RDB$ARGUMENT_POSITION
		p = FUN.RDB$FUNCTION_NAME;
		length = fb_utils::name_length(p);
		p[length] = 0;

		udf* an_udf = (udf*) MSC_alloc(UDF_LEN + length);
		strcpy(an_udf->udf_function, p);
		an_udf->udf_database = database;
		an_udf->udf_type = FUN.RDB$FUNCTION_TYPE;

		if (length = fb_utils::name_length(FUN.RDB$QUERY_NAME))
		{
			p = FUN.RDB$QUERY_NAME;
			p[length] = 0;
		}
		gpre_sym* symbol = an_udf->udf_symbol = MSC_symbol(SYM_udf,
			p, static_cast<USHORT>(strlen(p)), (gpre_ctx*) an_udf);
		HSH_insert(symbol);

		an_udf->udf_length = ARG.RDB$FIELD_LENGTH;
		an_udf->udf_scale = ARG.RDB$FIELD_SCALE;
		an_udf->udf_sub_type = ARG.RDB$FIELD_SUB_TYPE;
		an_udf->udf_dtype = MET_get_dtype(ARG.RDB$FIELD_TYPE, ARG.RDB$FIELD_SUB_TYPE,
			ARG.RDB$CHARACTER_LENGTH, &an_udf->udf_length);

		if (an_udf->udf_dtype == dtype_text || an_udf->udf_dtype == dtype_cstring)
		{
			FOR(REQUEST_HANDLE handle2)
			V4ARG IN RDB$FUNCTION_ARGUMENTS
				CROSS CS IN RDB$CHARACTER_SETS
				CROSS COLL IN RDB$COLLATIONS WITH
				V4ARG.RDB$CHARACTER_SET_ID EQ CS.RDB$CHARACTER_SET_ID AND
				COLL.RDB$COLLATION_NAME EQ CS.RDB$DEFAULT_COLLATE_NAME AND
				V4ARG.RDB$CHARACTER_SET_ID NOT MISSING AND
				V4ARG.RDB$FUNCTION_NAME EQ ARG.RDB$FUNCTION_NAME AND
				V4ARG.RDB$PACKAGE_NAME MISSING AND
				V4ARG.RDB$ARGUMENT_POSITION EQ ARG.RDB$ARGUMENT_POSITION;

				an_udf->udf_charset_id = V4ARG.RDB$CHARACTER_SET_ID;
				an_udf->udf_ttype =
					INTL_CS_COLL_TO_TTYPE(an_udf->udf_charset_id, COLL.RDB$COLLATION_ID);

			END_FOR
		}
	END_FOR
	ON_ERROR
		CPR_error(NEED_IB4_AT_LEAST);
		CPR_abort();
	END_ERROR;

	isc_release_request(gds_status, &handle);
	if (handle2)
		isc_release_request(gds_status, &handle2);

	// Pick up all Collation names, might have several collations
	// for a given character set.
	// There can also be several alias names for a character set.

	FOR(REQUEST_HANDLE handle)
	CHARSET IN RDB$CHARACTER_SETS CROSS COLL IN RDB$COLLATIONS OVER
		RDB$CHARACTER_SET_ID;

		p = COLL.RDB$COLLATION_NAME;
		length = fb_utils::name_length(p);
		p[length] = 0;
		intlsym* iname = (intlsym*) MSC_alloc(INTLSYM_LEN + length);
		strcpy(iname->intlsym_name, p);
		iname->intlsym_database = database;
		gpre_sym* symbol = iname->intlsym_symbol =
			MSC_symbol(SYM_collate, p, static_cast<USHORT>(strlen(p)), (gpre_ctx*) iname);
		HSH_insert(symbol);
		iname->intlsym_type = INTLSYM_collation;
		iname->intlsym_flags = 0;
		iname->intlsym_charset_id = COLL.RDB$CHARACTER_SET_ID;
		iname->intlsym_collate_id = COLL.RDB$COLLATION_ID;
		iname->intlsym_ttype =
			INTL_CS_COLL_TO_TTYPE(iname->intlsym_charset_id, iname->intlsym_collate_id);
		iname->intlsym_bytes_per_char =
			(CHARSET.RDB$BYTES_PER_CHARACTER.NULL) ? 1 : (CHARSET.RDB$BYTES_PER_CHARACTER);
		iname->intlsym_next = gpreGlob.text_subtypes;
		gpreGlob.text_subtypes = iname;

		FOR(REQUEST_HANDLE handle2)
		TYPE IN RDB$TYPES
			WITH TYPE.RDB$FIELD_NAME = "RDB$COLLATION_NAME"
			AND TYPE.RDB$TYPE = COLL.RDB$COLLATION_ID
			AND TYPE.RDB$TYPE_NAME != COLL.RDB$COLLATION_NAME;

			p = TYPE.RDB$TYPE_NAME;
			length = fb_utils::name_length(p);
			p[length] = 0;
			symbol = MSC_symbol(SYM_collate, p, length, (gpre_ctx*) iname);
			HSH_insert(symbol);
		END_FOR
		ON_ERROR
			// Nothing
		END_ERROR;

	END_FOR
	ON_ERROR
		CPR_error(NEED_IB4_AT_LEAST);
		CPR_abort();
	END_ERROR;

	isc_release_request(gds_status, &handle);
	if (handle2)
		isc_release_request(gds_status, &handle2);

	// Now pick up all character set names - with the subtype set to
	// the type of the default collation for the character set.

	FOR(REQUEST_HANDLE handle)
	CHARSET IN RDB$CHARACTER_SETS CROSS COLL IN RDB$COLLATIONS
		WITH CHARSET.RDB$DEFAULT_COLLATE_NAME EQ COLL.RDB$COLLATION_NAME;

		p = CHARSET.RDB$CHARACTER_SET_NAME;
		length = fb_utils::name_length(p);
		p[length] = 0;
		intlsym* iname = (intlsym*) MSC_alloc(INTLSYM_LEN + length);
		strcpy(iname->intlsym_name, p);
		iname->intlsym_database = database;
		gpre_sym* symbol = iname->intlsym_symbol =
			MSC_symbol(SYM_charset, p, static_cast<USHORT>(strlen(p)), (gpre_ctx*) iname);
		HSH_insert(symbol);
		iname->intlsym_type = INTLSYM_collation;
		iname->intlsym_flags = 0;
		iname->intlsym_charset_id = COLL.RDB$CHARACTER_SET_ID;
		iname->intlsym_collate_id = COLL.RDB$COLLATION_ID;
		iname->intlsym_ttype =
			INTL_CS_COLL_TO_TTYPE(iname->intlsym_charset_id, iname->intlsym_collate_id);
		iname->intlsym_bytes_per_char =
			(CHARSET.RDB$BYTES_PER_CHARACTER.NULL) ? 1 : (CHARSET.RDB$BYTES_PER_CHARACTER);

		FOR(REQUEST_HANDLE handle2)
		TYPE IN RDB$TYPES
			WITH TYPE.RDB$FIELD_NAME = "RDB$CHARACTER_SET_NAME"
			AND TYPE.RDB$TYPE = CHARSET.RDB$CHARACTER_SET_ID
			AND TYPE.RDB$TYPE_NAME != CHARSET.RDB$CHARACTER_SET_NAME;

			p = TYPE.RDB$TYPE_NAME;
			length = fb_utils::name_length(p);
			p[length] = 0;
			symbol = MSC_symbol(SYM_charset, p, length, (gpre_ctx*) iname);
			HSH_insert(symbol);
		END_FOR
		ON_ERROR
			// Nothing
		END_ERROR;

	END_FOR
	ON_ERROR
		CPR_error(NEED_IB4_AT_LEAST);
		CPR_abort();
	END_ERROR;

	isc_release_request(gds_status, &handle);
	if (handle2)
		isc_release_request(gds_status, &handle2);

	// Pick up name of database default character set for SQL

	FOR(REQUEST_HANDLE handle)
		FIRST 1 DBB IN RDB$DATABASE
		WITH DBB.RDB$CHARACTER_SET_NAME NOT MISSING
		p = DBB.RDB$CHARACTER_SET_NAME;
		length = fb_utils::name_length(p);
		p[length] = 0;
		TEXT* s = (TEXT*) MSC_alloc(length + 1);
		strcpy(s, p);
		database->dbb_def_charset = s;
		if (!MSC_find_symbol(HSH_lookup(database->dbb_def_charset), SYM_charset))
			CPR_warn("Default character set for database is not known");
	END_FOR
	ON_ERROR
		CPR_error(NEED_IB4_AT_LEAST);
		CPR_abort();
	END_ERROR;

	isc_release_request(gds_status, &handle);

	// Pick up all generators for the database

	FOR(REQUEST_HANDLE handle)
	X IN RDB$GENERATORS
		gpre_sym* symbol = MSC_symbol(SYM_generator, X.RDB$GENERATOR_NAME,
							fb_utils::name_length(X.RDB$GENERATOR_NAME), (gpre_ctx*) database);
		HSH_insert(symbol);

	END_FOR
	ON_ERROR
		// Nothing
	END_ERROR;

	isc_release_request(gds_status, &handle);

	// now that we have attached to the database, resolve the character set
	// request (if any) (and if we can)

	if (database->dbb_c_lc_ctype)
	{
		if (get_intl_char_subtype(&database->dbb_char_subtype, (UCHAR*) database->dbb_c_lc_ctype,
			 					  static_cast<USHORT>(strlen(database->dbb_c_lc_ctype)), database))
		{
			database->dbb_know_subtype = 1;
		}
		else
		{
			TEXT buffer[200];

			sprintf(buffer, "Cannot recognize character set '%s'", database->dbb_c_lc_ctype);
			PAR_error(buffer);
		}
		gpreGlob.sw_know_interp = database->dbb_know_subtype != 0;
		gpreGlob.sw_interp = database->dbb_char_subtype;
	}
}


/*____________________________________________________________
 *
 *		Make a field symbol.
 */

gpre_fld* MET_make_field(const SCHAR* name, SSHORT dtype, SSHORT length, bool insert_flag)
{
	gpre_fld* field = (gpre_fld*) MSC_alloc(FLD_LEN);
	field->fld_length = length;
	field->fld_dtype = dtype;
	gpre_sym* symbol = MSC_symbol(SYM_field, name, static_cast<USHORT>(strlen(name)), (gpre_ctx*) field);
	field->fld_symbol = symbol;
	if (insert_flag)
		HSH_insert(symbol);

	return field;
}


/*____________________________________________________________
 *
 *		Make an index symbol.
 */

gpre_index* MET_make_index(const SCHAR* name)
{
	gpre_index* index = (gpre_index*) MSC_alloc(IND_LEN);
	index->ind_symbol = MSC_symbol(SYM_index,
		name, static_cast<USHORT>(strlen(name)), (gpre_ctx*) index);

	return index;
}


/*____________________________________________________________
 *
 *		Make an relation symbol.
 */

gpre_rel* MET_make_relation(const SCHAR* name)
{
	gpre_rel* relation = (gpre_rel*) MSC_alloc(REL_LEN);
	relation->rel_symbol = MSC_symbol(SYM_relation,
		name, static_cast<USHORT>(strlen(name)), (gpre_ctx*) relation);

	return relation;
}


/*____________________________________________________________
 *
 *		Lookup a type name for a field.
 */

bool MET_type(gpre_fld* field, const TEXT* string, SSHORT* ptr)
{
	UCHAR buffer[32];			// BASED ON RDB$TYPES.RDB$TYPE_NAME

	gpre_sym* symbol;
	for (symbol = HSH_lookup(string); symbol; symbol = symbol->sym_homonym)
	{
		field_type* type;
		if (symbol->sym_type == SYM_type && (type = (field_type*) symbol->sym_object) &&
			(!type->typ_field || type->typ_field == field))
		{
			*ptr = type->typ_value;
			return true;
		}
	}

	gpre_rel* relation = field->fld_relation;
	gpre_dbb* database = relation->rel_database;
	DB = database->dbb_handle;
	gds_trans = database->dbb_transaction;

	// Force the name to uppercase, using C locale rules for uppercasing
	UCHAR* p;
	for (p = buffer; *string && p < &buffer[sizeof(buffer) - 1]; ++p, ++string)
	{
		*p = UPPER7(*string);
	}
	*p = '\0';

	FOR(REQUEST_HANDLE database->dbb_type_request)
	X IN RDB$TYPES WITH X.RDB$FIELD_NAME EQ field->fld_global->sym_string AND
		X.RDB$TYPE_NAME EQ buffer
		field_type* type = (field_type*) MSC_alloc(TYP_LEN);
		type->typ_field = field;
		*ptr = type->typ_value = X.RDB$TYPE;
		type->typ_symbol = symbol = MSC_symbol(SYM_type,
			string, static_cast<USHORT>(strlen(string)), (gpre_ctx*) type);
		HSH_insert(symbol);
		return true;
	END_FOR
	ON_ERROR
		// Nothing
	END_ERROR;

	return false;
}


/*____________________________________________________________
 *
 *		Lookup an index for a database.
 *
 *  Return: true if the trigger exists
 *		   false otherwise
 */

bool MET_trigger_exists(gpre_dbb* database, const TEXT* trigger_name)
{
	const MetIdentifier name(trigger_name);

	DB = database->dbb_handle;
	gds_trans = database->dbb_transaction;

	FOR(REQUEST_HANDLE database->dbb_trigger_request)
	TRIG IN RDB$TRIGGERS WITH TRIG.RDB$TRIGGER_NAME EQ name
		return true;
	END_FOR;

	return false;
}


/*____________________________________________________________
 *
 *		Compute and return the size of the array.
 */

static SLONG array_size(const gpre_fld* field)
{
	const ary* array_block = field->fld_array_info;
	SLONG count = field->fld_array->fld_length;
	for (dim* dimension = array_block->ary_dimension; dimension; dimension = dimension->dim_next)
	{
		count = count * (dimension->dim_upper - dimension->dim_lower + 1);
	}

	return count;
}


/*____________________________________________________________
 *
 *		See if field is array.
 */

static void get_array(gpre_dbb* database, const TEXT* field_name, gpre_fld* field)
{
	ary* array_block = NULL;
	USHORT field_dimensions = 0;

	FOR(REQUEST_HANDLE database->dbb_array_request)

	F IN RDB$FIELDS WITH F.RDB$FIELD_NAME EQ field_name
		if (F.RDB$DIMENSIONS)
		{
			gpre_fld* sub_field = (gpre_fld*) MSC_alloc(FLD_LEN);
			*sub_field = *field;
			// CVC: beware, the above line is far from deep copy;
			// there are only 13 non-pointer members in gpre_fld.
			// The 14 pointer members share target locations with "field".
			field->fld_array = sub_field;
			field->fld_dtype = dtype_blob;
			field->fld_flags |= FLD_blob;
			field->fld_length = 8;
			// CVC: Someone allocated the the max size inside the ary structure,
			// so the dynamic length is irrelevant to create the array_block.
			field_dimensions = F.RDB$DIMENSIONS;
			fb_assert(field_dimensions <= MAX_ARRAY_DIMENSIONS);
			fb_assert(field_dimensions > 0); // Sometimes, sys tables screw
			field->fld_array_info = array_block = (ary*) MSC_alloc(ARY_LEN);
				//(ary*) MSC_alloc(ARY_LEN(F.RDB$DIMENSIONS));
			array_block->ary_dtype = sub_field->fld_dtype;
		}
	END_FOR
	ON_ERROR
		CPR_error(NEED_IB4_AT_LEAST);
		CPR_abort();
	END_ERROR;

	if (!array_block)
		return;

    dim* last_dimension_block = 0;
    USHORT dimension_counter = 0;
	FOR(REQUEST_HANDLE database->dbb_dimension_request)
	D IN RDB$FIELD_DIMENSIONS WITH D.RDB$FIELD_NAME EQ field_name
		SORTED BY ASCENDING D.RDB$DIMENSION
		array_block->ary_rpt[D.RDB$DIMENSION].ary_lower = D.RDB$LOWER_BOUND;
		array_block->ary_rpt[D.RDB$DIMENSION].ary_upper = D.RDB$UPPER_BOUND;
		dim* dimension_block = (dim*) MSC_alloc(DIM_LEN);
		dimension_block->dim_number = D.RDB$DIMENSION;
		dimension_block->dim_lower = D.RDB$LOWER_BOUND;
		dimension_block->dim_upper = D.RDB$UPPER_BOUND;

		if (D.RDB$DIMENSION != 0)
		{
			last_dimension_block->dim_next = dimension_block;
			dimension_block->dim_previous = last_dimension_block;
		}
		else
			array_block->ary_dimension = dimension_block;
		last_dimension_block = dimension_block;
		++dimension_counter;
	END_FOR;

    // Check for lack of sync between RDB$FIELDS & RDB$FIELD_DIMENSIONS,
    // it happened in the past due to buggy DYN code.
	fb_assert(last_dimension_block);
	fb_assert(dimension_counter == field_dimensions);

	array_block->ary_dimension_count = last_dimension_block->dim_number + 1;
	array_block->ary_size = array_size(field);
}


/*____________________________________________________________
 *
 *		Character types can be specified as either:
 *		   b) A POSIX style locale name "<collation>.<characterset>"
 *		   or
 *		   c) A simple <characterset> name (using default collation)
 *		   d) A simple <collation> name    (use charset for collation)
 *
 *		Given an ASCII7 string which could be any of the above, try to
 *		resolve the name in the order b, c, d.
 *		b) is only tried iff the name contains a period.
 *		(in which case c) and d) are not tried).
 *
 *  Return:
 *		true if no errors (and *id is set).
 *		false if the name could not be resolved.
 */

static bool get_intl_char_subtype(SSHORT* id, const UCHAR* name, USHORT length, gpre_dbb* database)
{
	UCHAR buffer[32];			// BASED ON RDB$COLLATION_NAME

	fb_assert(id != NULL);
	fb_assert(name != NULL);
	fb_assert(database != NULL);


	DB = database->dbb_handle;
	if (!DB)
		return false;
	gds_trans = database->dbb_transaction;

	const UCHAR* const end_name = name + length;
	// Force key to uppercase, following C locale rules for uppercasing
	// At the same time, search for the first period in the string (if any)

	UCHAR* period = NULL;
	UCHAR* p;
	for (p = buffer; name < end_name && p < (buffer + sizeof(buffer) - 1); p++, name++)
	{
		*p = UPPER7(*name);
		if ((*p == '.') && !period)
			period = p;
	}
	*p = 0;

	// Is there a period, separating collation name from character set?
	if (period)
	{
		*period = 0;
		return resolve_charset_and_collation(id, period + 1, buffer);
	}

	// Is it a character set name (implying charset default collation sequence)
	bool res = resolve_charset_and_collation(id, buffer, NULL);
	if (!res)
	{
		// Is it a collation name (implying implementation-default character set)
		res = resolve_charset_and_collation(id, NULL, buffer);
	}
	return res;
}


/*____________________________________________________________
 *
 *		Given ASCII7 name of charset & collation
 *		resolve the specification to a ttype (id) that implements
 *		it.
 *
 *  Inputs:
 *		(charset)
 *			ASCII7z name of characterset.
 *			NULL (implying unspecified) means use the character set
 *		        for defined for (collation).
 *
 *		(collation)
 *			ASCII7z name of collation.
 *			NULL means use the default collation for (charset).
 *
 *  Outputs:
 *		(*id)
 *			Set to subtype specified by this name.
 *
 *  Return:
 *		true if no errors (and *id is set).
 *		false if either name not found.
 *		  or if names found, but the collation isn't for the specified
 *		  character set.
 */

static bool resolve_charset_and_collation(SSHORT* id, const UCHAR* charset, const UCHAR* collation)
{
	fb_assert(id != NULL);

	if (!DB)
		return false;

	bool found = false;
	FB_API_HANDLE request = 0;

	if (collation == NULL)
	{
		if (charset == NULL)
		{
			FOR(REQUEST_HANDLE request)
				FIRST 1 DBB IN RDB$DATABASE
				WITH DBB.RDB$CHARACTER_SET_NAME NOT MISSING
				AND DBB.RDB$CHARACTER_SET_NAME != " ";

				charset = (UCHAR*) DBB.RDB$CHARACTER_SET_NAME;

			END_FOR
			ON_ERROR
				CPR_error(NEED_IB4_AT_LEAST);
				CPR_abort();
			END_ERROR;

			isc_release_request(gds_status, &request);

			if (charset == NULL)
				charset = (UCHAR*) DEFAULT_CHARACTER_SET_NAME;
		}

		FOR(REQUEST_HANDLE request)
			FIRST 1 CS IN RDB$CHARACTER_SETS
			CROSS COLL IN RDB$COLLATIONS
			CROSS TYPE IN RDB$TYPES
			WITH TYPE.RDB$TYPE_NAME EQ charset
			AND TYPE.RDB$FIELD_NAME EQ "RDB$CHARACTER_SET_NAME"
			AND TYPE.RDB$TYPE EQ CS.RDB$CHARACTER_SET_ID
			AND CS.RDB$DEFAULT_COLLATE_NAME EQ COLL.RDB$COLLATION_NAME;

			found = true;
			*id = MAP_CHARSET_TO_TTYPE(CS.RDB$CHARACTER_SET_ID);

		END_FOR
		ON_ERROR
			// Nothing
		END_ERROR;

		isc_release_request(gds_status, &request);

		return found;
	}

	if (charset == NULL)
	{
		FOR(REQUEST_HANDLE request)
			FIRST 1 CS IN RDB$CHARACTER_SETS
			CROSS COLL IN RDB$COLLATIONS
			OVER RDB$CHARACTER_SET_ID
			WITH COLL.RDB$COLLATION_NAME EQ collation;

			found = true;
			*id = MAP_CHARSET_TO_TTYPE(CS.RDB$CHARACTER_SET_ID);
		END_FOR
		ON_ERROR
			// Nothing
		END_ERROR;

		isc_release_request(gds_status, &request);

		return found;
	}

	FOR(REQUEST_HANDLE request)
		FIRST 1 CS IN RDB$CHARACTER_SETS
		CROSS COL IN RDB$COLLATIONS OVER RDB$CHARACTER_SET_ID
		CROSS NAME2 IN RDB$TYPES
		WITH COL.RDB$COLLATION_NAME EQ collation
		AND NAME2.RDB$TYPE_NAME EQ charset
		AND NAME2.RDB$FIELD_NAME EQ "RDB$CHARACTER_SET_NAME"
		AND NAME2.RDB$TYPE EQ CS.RDB$CHARACTER_SET_ID;

		found = true;
		*id = MAP_CHARSET_TO_TTYPE(CS.RDB$CHARACTER_SET_ID);
	END_FOR
	ON_ERROR
		// Nothing
	END_ERROR;

	isc_release_request(gds_status, &request);

	return found;
}


#ifdef NOT_USED_OR_REPLACED
/*____________________________________________________________
 *
 *		Upcase a string into another string.  Return
 *		length of string.
 */

static int upcase(const TEXT* from, TEXT* const to)
{
	TEXT* p = to;
	const TEXT* const end = to + NAME_SIZE;

	TEXT c;
	while (p < end && (c = *from++)) {
		*p++ = UPPER(c);
	}

	*p = 0;

	return p - to;
}
#endif

