firebird-mirror/src/gpre/gpre_meta.epp

/*
 * 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): ______________________________________.
 *  
 *
 *____________________________________________________________
 *
 *	$Id: gpre_meta.epp,v 1.27 2003-10-07 09:58:26 robocop Exp $
 */

#include "firebird.h"
#include <string.h>
#include "../jrd/gds.h"
#include "../gpre/gpre.h"
#include "../jrd/license.h"
#include "../gpre/parse.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 "../jrd/constants.h"

#define MAX_USER_LENGTH		33
#define MAX_PASSWORD_LENGTH	33

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

extern enum lang_t sw_language;
extern bool sw_cstring;
extern DBB isc_databases;

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

#ifdef SCROLLABLE_CURSORS
static SCHAR db_version_info[] = { gds__info_base_level };
#endif

static SLONG array_size(GPRE_FLD);
static void get_array(dbb*, const TEXT*, GPRE_FLD);
static bool get_intl_char_subtype(SSHORT*, const UCHAR*, USHORT, dbb*);
static bool resolve_charset_and_collation(SSHORT*, const UCHAR*, const UCHAR*);
static int symbol_length(const TEXT*);
#ifdef NOT_USED_OR_REPLACED
static int upcase(const TEXT*, TEXT*);
#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;
	}

	SCHAR name[NAME_SIZE];
	strcpy(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 (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(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)];

#ifndef REQUESTER
	if (sw_language == lang_internal) {
		JRDMET_init(database);
		return true;
	}
#endif

	DB = NULL;

	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 
 */

 	SCHAR dpb[MAX_PASSWORD_LENGTH + MAX_USER_LENGTH + 5];
	SCHAR* d = dpb;
	if (database->dbb_c_user || database->dbb_c_password) {
		*d++ = gds_dpb_version1;
		const SCHAR* p = database->dbb_c_user;
		if (p) {
			*d++ = gds_dpb_user_name;
			*d++ = strlen(p);
			while (*p)
				*d++ = *p++;
		}
		p = database->dbb_c_password;
		if (p) {
			*d++ = gds_dpb_password;
			*d++ = strlen(p);
			while (*p)
				*d++ = *p++;
		}
	}

	if (gds__attach_database
		(gds_status, 0, database->dbb_filename, &DB, d - &dpb[0], dpb)) {
		/* We failed to attach, try in read only mode just in case 
		if (d == dpb)
			*d++ = gds_dpb_version1;
		*d++ = isc_dpb_set_db_readonly;
		*d++ = 1;
		*d++ = TRUE;
		if (gds__attach_database
			(gds_status, 0, database->dbb_filename, &DB, d - &dpb[0], dpb)) {
		*/
				gds__print_status(gds_status);
				return false;
		//}
	}

	database->dbb_handle = DB;

	if (sw_version && print_version) {
		ib_printf("    Version(s) for database \"%s\"\n", database->dbb_filename);
		gds__version(&DB, NULL, NULL);
	}

	sw_ods_version = 0;
	sw_server_version = 0;
	if (isc_database_info(isc_status, &DB, sizeof(sql_version_info),
		  (char*) sql_version_info, sizeof(sql_buffer), (char*) sql_buffer)) {
		gds__print_status(isc_status);
		return false;
	}

	const UCHAR* ptr = sql_buffer;
	while (*ptr != isc_info_end) {
		const UCHAR item = *ptr++;
		const USHORT length = isc_vax_integer((char*)ptr, sizeof(USHORT));
		ptr += sizeof(USHORT);
		
		switch (item) {
		case isc_info_base_level:
			sw_server_version = (USHORT) ptr[1];
			break;

		case isc_info_ods_version:
			sw_ods_version = isc_vax_integer((char*)ptr, length);
			break;

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

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

#ifdef DEBUG
	if (sw_version && print_version)
		ib_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",
	sw_server_version, sw_ods_version, compiletime_db_dialect, sw_sql_dialect);
#endif
#ifdef SCROLLABLE_CURSORS

	SCHAR buffer[16];

/*  get the base level of the engine  */

	if (gds__database_info(gds_status, &DB, sizeof(db_version_info),
						   db_version_info, sizeof(buffer), buffer)) {
		gds__print_status(gds_status);
		return false;
	}

/*  this seems like a lot of rigamarole to read one info item, 
 *  but it provides for easy extensibility in case we need 
 *  more info items later 
 */

	const SCHAR* data = buffer;
	while (*data != gds__info_end) {
	    const SCHAR item = *data++;
		const USHORT l = isc_vax_integer(data, sizeof(USHORT));
		data += sizeof(USHORT);

		switch (item) {
			/* This flag indicates the version level of the engine  
			   itself, so we can tell what capabilities the engine 
			   code itself (as opposed to the on-disk structure).
			   Apparently the base level up to now indicated the major 
			   version number, but for 4.1 the base level is being 
			   incremented, so the base level indicates an engine version 
			   as follows:
			   1 == v1.x
			   2 == v2.x
			   3 == v3.x
			   4 == v4.0 only
			   5 == v4.1
			   Note: this info item is so old it apparently uses an 
			   archaic format, not a standard vax integer format.
			 */

		case gds__info_base_level:
			database->dbb_base_level = (USHORT) data[1];
			break;

		default:
			;
		}

		data += l;
	}
#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)
{
	SCHAR name[NAME_SIZE];
	bool found = false;

	strcpy(name, string);

/*  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 (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;

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

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

	if (!(database->dbb_flags & DBB_v3)) {
		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,
							  &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;
	}
	else {
		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,
											 &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;
			}

			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(dbb* database,
							const TEXT* domain_name,
							TEXT* buffer,
							USHORT buff_length)
{
	SCHAR name[NAME_SIZE];
	ISC_STATUS_ARRAY status_vect;

	strcpy(name, domain_name);

	if (database == NULL)
		return false;

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

	assert(database->dbb_transaction == NULL);
	FRBRD* gds_trans = NULL;

	FRBRD* DB = database->dbb_handle; // Overrides global DB

	START_TRANSACTION;

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

			/* open the blob */
			isc_blob_handle blob_handle = NULL;
			ISC_STATUS stat = isc_open_blob2(status_vect, &DB, &gds_trans,
									&blob_handle, blob_id, sizeof(blr_bpb),
									const_cast<unsigned char*>(blr_bpb));
			if (stat) {
				gds__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;
				else if (stat == gds_segstr_eof) {
					/* null terminate the buffer */
					*ptr_in_buffer = 0;
					break;
				}
				else
					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 */
			assert(buffer[0] == blr_version4 || buffer[0] == blr_version5);
			assert(buffer[1] == blr_literal ||
				   buffer[1] == blr_null || buffer[1] == blr_user_name);

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

			if (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(GPRE_REL relation,
							const TEXT* column_name,
							TEXT* buffer,
							USHORT buff_length)
{
	SCHAR name[NAME_SIZE];
	ISC_STATUS_ARRAY status_vect;

	strcpy(name, column_name);

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

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

	assert(database->dbb_transaction == NULL);
	FRBRD* gds_trans = NULL;

	FRBRD* DB = database->dbb_handle; // Overrides global DB

	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;
		}

		if (has_default) {
			/* open the blob */
			isc_blob_handle blob_handle = NULL;
			ISC_STATUS stat = isc_open_blob2(status_vect, &DB, &gds_trans,
								  &blob_handle, blob_id, sizeof(blr_bpb),
								  const_cast<unsigned char*>(blr_bpb));
			if (stat) {
				gds__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;
				else if (stat == gds_segstr_eof) {
					/* null terminate the buffer */
					*ptr_in_buffer = 0;
					break;
				}
				else
					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 */

			assert(buffer[0] == blr_version4 || buffer[0] == blr_version5);
			assert(buffer[1] == blr_literal ||
				   buffer[1] == blr_null || buffer[1] == blr_user_name);
		}
		else {
			if (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.
 */  

LLS MET_get_primary_key(dbb* database, const TEXT* relation_name)
{
	SCHAR name[NAME_SIZE];

	strcpy(name, relation_name);

	if (database == NULL)
		return NULL;

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

	assert(database->dbb_transaction == NULL);
	FRBRD* gds_trans = NULL;

	FRBRD* DB = database->dbb_handle; // Overrides global DB

	START_TRANSACTION;

    LLS fields = NULL;
	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*) MAKE_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';

		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)
{
	SCHAR name[NAME_SIZE];

	strcpy(name, string);
	const SSHORT length = strlen(name);

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

	GPRE_FLD field = NULL;
	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;
		}
		else if (symbol->sym_type == SYM_field &&
				 (field = (GPRE_FLD) symbol->sym_object) &&
				 field->fld_relation == relation)
		{
			return field;
		}

	if (sw_language == lang_internal)
		return NULL;

	dbb* database = relation->rel_database;

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

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

	field = NULL;
	if (!(database->dbb_flags & DBB_v3)) {
		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) 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,
						  &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 && !(database->dbb_flags & DBB_no_arrays))
				get_array(database, F.RDB$FIELD_NAME, field);

			if ((field->fld_dtype <= dtype_any_text)
				|| (field->fld_dtype == dtype_blob))
			{
				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 (!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,
						   symbol_length(RFR.RDB$FIELD_SOURCE), (GPRE_CTX) field);
		END_FOR;
	}
	else {
		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) 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,
							  &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 (!(database->dbb_flags & DBB_no_arrays))
				get_array(database, F.RDB$FIELD_NAME, field);

			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,
						   symbol_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 = MAKE_NODE(nod_list, procedure->prc_out_count);
		//count = 0;
		for (field = procedure->prc_outputs; field; field = field->fld_next) {
			reference = (REF) 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 = MAKE_NODE(nod_list, count);
		//count = 0;
		for (field = relation->rel_fields; field; field = field->fld_next) {
			reference = (REF) 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 (sw_language == lang_internal)
		return NULL;

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

	int count = 0;
	LLS stack = NULL;
	FOR(REQUEST_HANDLE database->dbb_flds_request)
	RFR IN RDB$RELATION_FIELDS CROSS GPRE_FLD IN RDB$FIELDS WITH
		RFR.RDB$FIELD_SOURCE EQ GPRE_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;
		PUSH((GPRE_NOD) MET_field(relation, RFR.RDB$FIELD_NAME), &stack);
		count++;
	END_FOR;

	GPRE_NOD node = MAKE_NODE(nod_list, count);

	while (stack) {
		field = (GPRE_FLD) POP(&stack);
		reference = (REF) 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(dbb* end)
{
	for (dbb* database = 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 = NULL;
			database->dbb_transaction = NULL;

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


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

const SCHAR* MET_generator(const TEXT* string, dbb* database)
{
	SCHAR name[NAME_SIZE];

	strcpy(name, string);

	for (SYM symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
		if ((symbol->sym_type == SYM_generator) &&
			(database == (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* length)
{
	USHORT dtype;

	USHORT l = *length;

	switch (blr_dtype) {
	case blr_varying:
	case blr_text:
		dtype = dtype_text;
		if (sw_cstring && !SUBTYPE_ALLOWS_NULLS(sub_type)) {
			++l;
			dtype = dtype_cstring;
		}
		break;

	case blr_cstring:
		dtype = dtype_cstring;
		++l;
		break;

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

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

	case blr_quad:
		dtype = dtype_quad;
		l = sizeof(GDS__QUAD);
		break;

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

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

	case blr_blob:
		dtype = dtype_blob;
		l = sizeof(GDS__QUAD);
		break;

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

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

	case blr_timestamp:
		dtype = dtype_timestamp;
		l = sizeof(ISC_TIMESTAMP);
		break;
/** Begin sql date/time/timestamp **/

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

	default:
		CPR_error("datatype not supported");
	}

	*length = l;

	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(dbb* database, const TEXT* string, const TEXT* owner_name)
{
	SCHAR name[NAME_SIZE], owner[NAME_SIZE];

	strcpy(name, string);
	strcpy(owner, owner_name);
	GPRE_PRC procedure = NULL;

	for (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;

	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) 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,
												 &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,
											   symbol_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(dbb* database, const TEXT* string, const TEXT* owner_name)
{
	GPRE_REL relation;
	SCHAR name[NAME_SIZE], owner[NAME_SIZE];

	strcpy(name, string);
	strcpy(owner, owner_name);

	for (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 = 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(dbb* database, const TEXT* string)
{
	SCHAR name[NAME_SIZE];

	strcpy(name, string);
	udf* the_udf = NULL;
	for (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;

	if (database->dbb_flags & DBB_v3) {
		/* Version of V4 request without new V4 metadata */
		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$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) 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,
											 &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;
				break;
			}
		END_FOR;
	}
	else {
		/* Same request as above, but with V4 metadata also fetched */
		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$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) 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,
											 &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)
{
	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.
 */  

IND MET_index(dbb* database, const TEXT* string)
{
	IND index;
	SCHAR name[NAME_SIZE];

	strcpy(name, string);
	const USHORT length = strlen(name);

	SYM symbol;
	for (symbol = HSH_lookup(name); symbol; symbol = symbol->sym_homonym)
		if (symbol->sym_type == SYM_index &&
			(index = (IND) symbol->sym_object) &&
			index->ind_relation->rel_database == database)
			return index;

	if (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 = (IND) 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(dbb* database)
{
/*  If this is an internal ISC access method invocation, don't do any of this
 *  stuff
 */

	if (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 = NULL;
	DB = database->dbb_handle;

	START_TRANSACTION;

	database->dbb_transaction = gds_trans;

/*  Determine if the database is V3.  */

	bool post_v3_flag = false;
	FRBRD* handle = NULL;
	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;
	gds__release_request(gds_status, &handle);

	if (!post_v3_flag)
		database->dbb_flags |= DBB_v3;

	SYM symbol;
	TEXT* p;
	SLONG length;

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

	if (database->dbb_flags & DBB_v3) {
		FOR(REQUEST_HANDLE handle)
		X IN RDB$RELATIONS
			gpre_rel* relation = (GPRE_REL) ALLOC(REL_LEN);
			relation->rel_database = database;
			relation->rel_next = database->dbb_relations;
			database->dbb_relations = relation;
			relation->rel_id = X.RDB$RELATION_ID;
			relation->rel_symbol = symbol =
				MSC_symbol(SYM_relation, X.RDB$RELATION_NAME,
						   symbol_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;

		END_FOR;
	}
	else {
		FOR(REQUEST_HANDLE handle)
		X IN RDB$RELATIONS
			gpre_rel* relation = (GPRE_REL) ALLOC(REL_LEN);
			relation->rel_database = database;
			relation->rel_next = database->dbb_relations;
			database->dbb_relations = relation;
			relation->rel_id = X.RDB$RELATION_ID;
			relation->rel_symbol = symbol =
				MSC_symbol(SYM_relation, X.RDB$RELATION_NAME,
						   symbol_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 = symbol_length(X.RDB$OWNER_NAME)))
			{
				relation->rel_owner =
					MSC_symbol(SYM_username, X.RDB$OWNER_NAME, length, NULL);
			}

		END_FOR;
	}

	gds__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
		gpre_prc* procedure = (GPRE_PRC) ALLOC(REL_LEN);
		procedure->prc_database = database;
		procedure->prc_next = (GPRE_PRC) database->dbb_procedures;
		database->dbb_procedures = (GPRE_REL) procedure;
		procedure->prc_id = X.RDB$PROCEDURE_ID;
		procedure->prc_symbol = symbol =
			MSC_symbol(SYM_procedure, X.RDB$PROCEDURE_NAME,
					   symbol_length(X.RDB$PROCEDURE_NAME), (GPRE_CTX) procedure);
		HSH_insert(symbol);
		if (!X.RDB$OWNER_NAME.NULL && (length = symbol_length(X.RDB$OWNER_NAME)))
			procedure->prc_owner =
				MSC_symbol(SYM_username, X.RDB$OWNER_NAME, length, NULL);
	END_FOR
	ON_ERROR
		/* assume pre V4 database, no procedures */
	END_ERROR;

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

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

	FRBRD* handle2 = NULL;

	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$RETURN_ARGUMENT EQ ARG.RDB$ARGUMENT_POSITION
		p = FUN.RDB$FUNCTION_NAME;
		length = symbol_length(p);
		p[length] = 0;

		udf* an_udf = (udf*) 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 = symbol_length(FUN.RDB$QUERY_NAME)) {
			p = FUN.RDB$QUERY_NAME;
			p[length] = 0;
		}
		an_udf->udf_symbol = symbol = MSC_symbol(SYM_udf, p, 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,
						  &an_udf->udf_length);

		if (post_v3_flag) {
			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$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
		// Nothing
	END_ERROR;

	gds__release_request(gds_status, &handle);
	if (handle2)
		gds__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 = symbol_length(p);
		p[length] = 0;
		INTLSYM iname = (INTLSYM) ALLOC(INTLSYM_LEN + length);
		strcpy(iname->intlsym_name, p);
		iname->intlsym_database = database;
		iname->intlsym_symbol = symbol =
			MSC_symbol(SYM_collate, p, 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 = text_subtypes;
		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 = symbol_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
		/* assume pre V4 database, no collations */
	END_ERROR;

	gds__release_request(gds_status, &handle);
	if (handle2)
		gds__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 = symbol_length(p);
		p[length] = 0;
		INTLSYM iname = (INTLSYM) ALLOC(INTLSYM_LEN + length);
		strcpy(iname->intlsym_name, p);
		iname->intlsym_database = database;
		iname->intlsym_symbol = symbol =
			MSC_symbol(SYM_charset, p, 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 = symbol_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
		/* assume pre V4 database, no character sets */
	END_ERROR;

	gds__release_request(gds_status, &handle);
	if (handle2)
		gds__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 = symbol_length(p);
		p[length] = 0;
		database->dbb_def_charset = (TEXT*) ALLOC(length + 1);
		strcpy(database->dbb_def_charset, p);
		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
		/* Assume V3 Db, no default charset */
	END_ERROR;

	gds__release_request(gds_status, &handle);

/*  Pick up all generators for the database  */

	FOR(REQUEST_HANDLE handle)
	X IN RDB$GENERATORS
		symbol = MSC_symbol(SYM_generator, X.RDB$GENERATOR_NAME,
							symbol_length(X.RDB$GENERATOR_NAME), (GPRE_CTX) database);
		HSH_insert(symbol);

	END_FOR 
	ON_ERROR
		// Nothing
	END_ERROR;

	gds__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,
			 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);
		}
		sw_know_interp = database->dbb_know_subtype;
		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) ALLOC(FLD_LEN);
	field->fld_length = length;
	field->fld_dtype = dtype;
	SYM symbol = MSC_symbol(SYM_field, name, strlen(name), (GPRE_CTX) field);
	field->fld_symbol = symbol;
	if (insert_flag)
		HSH_insert(symbol);

	return field;
}


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

IND MET_make_index(const SCHAR* name)
{
	IND index = (IND) ALLOC(IND_LEN);
	index->ind_symbol = MSC_symbol(SYM_index, name, strlen(name), (GPRE_CTX) index);

	return index;
}


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

GPRE_REL MET_make_relation(const SCHAR* name)
{
	GPRE_REL relation = (GPRE_REL) ALLOC(REL_LEN);
	relation->rel_symbol =
		MSC_symbol(SYM_relation, name, 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)
{
	TYP type;
	UCHAR buffer[32];			/* BASED ON RDB$TYPES.RDB$TYPE_NAME */

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

	GPRE_REL relation = field->fld_relation;
	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
		type = (TYP) ALLOC(TYP_LEN);
		type->typ_field = field;
		*ptr = type->typ_value = X.RDB$TYPE;
		type->typ_symbol = symbol =
			MSC_symbol(SYM_type, string, 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(dbb* database,
						const TEXT* trigger_name)
{
	char name[NAME_SIZE];

	strcpy(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( GPRE_FLD field)
{
	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(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) 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*) ALLOC(ARY_LEN);
				//(ARY) ALLOC(ARY_LEN(F.RDB$DIMENSIONS));
			array_block->ary_dtype = sub_field->fld_dtype;
		} 
	END_FOR
	ON_ERROR {
		database->dbb_flags |= DBB_no_arrays;
		return;
	}
	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) 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, dbb* database)
{
	UCHAR buffer[32];			/* BASED ON RDB$COLLATION_NAME */

	assert(id != NULL);
	assert(name != NULL);
	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);
	}

	else {
		/* 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)
{
	assert(id != NULL);

	if (!DB)
		return false;

	bool found = false;
	FRBRD* request = NULL;
	
	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
				/* Assume V3 DB, without default character set */
			END_ERROR;

			gds__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;

		gds__release_request(gds_status, &request);

		return found;
	}
	else 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;

		gds__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;

	gds__release_request(gds_status, &request);

	return found;
}


/*____________________________________________________________
 *  
 *		Compute significant length of symbol.
 */  

static int symbol_length(const TEXT* string)
{
	const int len = strlen(string);

	const TEXT* p = string + (len - 1);

	for (; p >= string && *p == ' '; p--);
	if (p < string)
		return 0;
	++p;
	return p - string;
}

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

static int upcase(const TEXT* from, TEXT* to)
{
	TEXT c;

	TEXT* p = to;
	const TEXT* const end = to + NAME_SIZE;

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

	*p = 0;

	return p - to;
}
#endif