firebird-mirror/src/gpre/par.cpp

//____________________________________________________________
//  
//		PROGRAM:	C preprocessor
//		MODULE:		par.cpp
//		DESCRIPTION:	Parser
//  
//  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): ______________________________________.

//  Revision 1.2  2000/11/27 09:26:13  fsg
//  Fixed bugs in gpre to handle PYXIS forms
//  and allow edit.e and fred.e to go through
//  gpre without errors (and correct result).
//  
//  This is a partial fix until all
//  PYXIS datatypes are adjusted in frm_trn.c
//  
//  removed some compiler warnings too
//  
//  TMN (Mike Nordell) 11.APR.2001 - Reduce compiler warnings
//  TMN (Mike Nordell) APR-MAY.2001 - Conversion to C++
//  
//
//____________________________________________________________
//
//

#include "firebird.h"
#include <setjmp.h>
#include <stdlib.h>
#include <string.h>
#include "../jrd/ibase.h"
#include "../gpre/gpre.h"
#include "../gpre/cmp_proto.h"
#include "../gpre/exp_proto.h"
#include "../gpre/gpre_proto.h"
#include "../gpre/hsh_proto.h"
#include "../gpre/gpre_meta.h"
#include "../gpre/msc_proto.h"
#include "../gpre/par_proto.h"
#include "../gpre/sql_proto.h"
#include "../common/utils_proto.h"

static jmp_buf*	PAR_jmp_buf;

#ifdef FTN_BLK_DATA
static void		block_data_list(const dbb*);
#endif
static bool		match_parentheses();
static act*		par_any();
static act*		par_array_element();
static act*		par_at();
static act*		par_based();
static act*		par_begin();
static blb*		par_blob();
static act*		par_blob_action(ACT_T);
static act*		par_blob_field();
static act*		par_case();
static act*		par_clear_handles();
static act*		par_derived_from();
static act*		par_end_block();
static act*		par_end_error();
static act*		par_end_fetch();
static act*		par_end_for();
static act*		par_end_modify();
static act*		par_end_stream();
static act*		par_end_store(bool);
static act*		par_erase();
static act*		par_fetch();
static act*		par_finish();
static act*		par_for();
static act*		par_function();
static act*		par_left_brace();
static act*		par_modify();
static act*		par_on();
static act*		par_on_error();
static act*		par_open_blob(ACT_T, gpre_sym*);
static bool		par_options(gpre_req*, bool);
static act*		par_procedure();
static act*		par_ready();
static act*		par_returning_values();
static act*		par_right_brace();
static act*		par_release();
static act*		par_slice(ACT_T);
static act*		par_store();
static act*		par_start_stream();
static act*		par_start_transaction();
static act*		par_subroutine();
static act*		par_trans(ACT_T);
static act*		par_type();
static act*		par_variable();
static act*		scan_routine_header();
static void		set_external_flag();
static bool		terminator();

static int		brace_count;
static bool		routine_decl;
static act*		cur_statement;
static act*		cur_item;
static gpre_lls*	cur_for;
static gpre_lls*	cur_store;
static gpre_lls*	cur_fetch;
static gpre_lls*	cur_modify;
static gpre_lls*	cur_error;
static gpre_lls*	routine_stack;
static gpre_fld*	flag_field;


//____________________________________________________________
//  
//		We have a token with a symbolic meaning.  If appropriate,
//		parse an action segment.  If not, return NULL.
//  

act* PAR_action(const TEXT* base_dir)
{
	jmp_buf env;

	gpre_sym* symbol = gpreGlob.token_global.tok_symbol;

	if (!symbol) {
		cur_statement = NULL;
		return NULL;
	}

	if ((USHORT) gpreGlob.token_global.tok_keyword >= (USHORT) KW_start_actions &&
		(USHORT) gpreGlob.token_global.tok_keyword <= (USHORT) KW_end_actions)
	{
		const enum kwwords keyword = gpreGlob.token_global.tok_keyword;
		switch (keyword)
		{
		case KW_READY:
		case KW_START_TRANSACTION:
		case KW_FINISH:
		case KW_COMMIT:
		case KW_PREPARE:
		case KW_RELEASE_REQUESTS:
		case KW_ROLLBACK:
		case KW_FUNCTION:
		case KW_SAVE:
		case KW_SUB:
		case KW_SUBROUTINE:
			CPR_eol_token();
			break;

		case KW_EXTERNAL:
			set_external_flag();
			return NULL;

		case KW_FOR:
		/** Get the next token as it is without upcasing **/
			gpreGlob.override_case = true;
			CPR_token();
			break;

		default:
			CPR_token();
		}

		try {

		PAR_jmp_buf = &env;

		switch (keyword)
		{
		case KW_INT:
		case KW_LONG:
		case KW_SHORT:
		case KW_CHAR:
		case KW_FLOAT:
		case KW_DOUBLE:
// ***
//    par_var_c (keyword);
//** 
			return NULL;

		case KW_ANY:
			return par_any();
		case KW_AT:
			return par_at();
		case KW_BASED:
			return par_based();
		case KW_CLEAR_HANDLES:
			return par_clear_handles();
		case KW_DATABASE:
			return PAR_database(false, base_dir);
		case KW_DERIVED_FROM:
			return par_derived_from();
		case KW_END_ERROR:
			return par_end_error();
		case KW_END_FOR:
			return cur_statement = par_end_for();
		case KW_END_MODIFY:
			return cur_statement = par_end_modify();
		case KW_END_STREAM:
			return cur_statement = par_end_stream();
		case KW_END_STORE:
			return cur_statement = par_end_store(false);
		case KW_END_STORE_SPECIAL:
			return cur_statement = par_end_store(true);
		case KW_ELEMENT:
			return par_array_element();
		case KW_ERASE:
			return cur_statement = par_erase();
		case KW_EVENT_INIT:
			return cur_statement = PAR_event_init(false);
		case KW_EVENT_WAIT:
			return cur_statement = PAR_event_wait(false);
		case KW_FETCH:
			return cur_statement = par_fetch();
		case KW_FINISH:
			return cur_statement = par_finish();
		case KW_FOR:
			return par_for();
		case KW_END_FETCH:
			return cur_statement = par_end_fetch();
		case KW_MODIFY:
			return par_modify();
		case KW_ON:
			return par_on();
		case KW_ON_ERROR:
			return par_on_error();
		case KW_READY:
			return cur_statement = par_ready();
		case KW_RELEASE_REQUESTS:
			return cur_statement = par_release();
		case KW_RETURNING:
			return par_returning_values();
		case KW_START_STREAM:
			return cur_statement = par_start_stream();
		case KW_STORE:
			return par_store();
		case KW_START_TRANSACTION:
			return cur_statement = par_start_transaction();
		case KW_FUNCTION:
			return par_function();
		case KW_PROCEDURE:
			return par_procedure();

		case KW_PROC:
			break;

		case KW_SUBROUTINE:
			return par_subroutine();
		case KW_SUB:
			break;

		case KW_OPEN_BLOB:
			return cur_statement = par_open_blob(ACT_blob_open, 0);
		case KW_CREATE_BLOB:
			return cur_statement = par_open_blob(ACT_blob_create, 0);
		case KW_GET_SLICE:
			return cur_statement = par_slice(ACT_get_slice);
		case KW_PUT_SLICE:
			return cur_statement = par_slice(ACT_put_slice);
		case KW_GET_SEGMENT:
			return cur_statement = par_blob_action(ACT_get_segment);
		case KW_PUT_SEGMENT:
			return cur_statement = par_blob_action(ACT_put_segment);
		case KW_CLOSE_BLOB:
			return cur_statement = par_blob_action(ACT_blob_close);
		case KW_CANCEL_BLOB:
			return cur_statement = par_blob_action(ACT_blob_cancel);

		case KW_COMMIT:
			return cur_statement = par_trans(ACT_commit);
		case KW_SAVE:
			return cur_statement = par_trans(ACT_commit_retain_context);
		case KW_ROLLBACK:
			return cur_statement = par_trans(ACT_rollback);
		case KW_PREPARE:
			return cur_statement = par_trans(ACT_prepare);

		case KW_L_BRACE:
			return par_left_brace();
		case KW_R_BRACE:
			return par_right_brace();
		case KW_END:
			return par_end_block();
		case KW_BEGIN:
			return par_begin();
		case KW_CASE:
			return par_case();

		case KW_EXEC:
			{
				if (!MSC_match(KW_SQL))
					break;
				gpreGlob.sw_sql = true;
				act* action = SQL_action(base_dir);
				gpreGlob.sw_sql = false;
				return action;
			}

		default:
			break;
		}

		}	// try
		catch (const gpre_exception&) {
			throw;
		}
		catch (const Firebird::fatal_exception&)
		{
			// CVC: a fatal exception should be propagated.
			// For example, a failure in our runtime.
			throw;
		}
		catch (const std::exception&) {
			gpreGlob.sw_sql = false;
			/* This is to force GPRE to get the next symbol. Fix for bug #274. DROOT */
			gpreGlob.token_global.tok_symbol = NULL;
			return NULL;
		}

		cur_statement = NULL;
		return NULL;
	}

	for (; symbol; symbol = symbol->sym_homonym)
	{
		switch (symbol->sym_type)
		{
		case SYM_context:
			try {
				PAR_jmp_buf = &env;
				cur_statement = NULL;
				return par_variable();
			}
			catch (const gpre_exception&) {
				throw;
			}
			catch (const Firebird::fatal_exception&)
			{
				// CVC: a fatal exception should be propagated.
				throw;
			}
			catch (const std::exception&) {
				return 0;
			}
		case SYM_blob:
			try {
				PAR_jmp_buf = &env;
				cur_statement = NULL;
				return par_blob_field();
			}
			catch (const gpre_exception&) {
				throw;
			}
			catch (const Firebird::fatal_exception&)
			{
				// CVC: a fatal exception should be propagated.
				throw;
			}
			catch (const std::exception&) {
				return 0;
			}
		case SYM_relation:
			try {
				PAR_jmp_buf = &env;
				cur_statement = NULL;
				return par_type();
			}
			catch (const gpre_exception&) {
				throw;
			}
			catch (const Firebird::fatal_exception&)
			{
				// CVC: a fatal exception should be propagated.
				throw;
			}
			catch (const std::exception&) {
				return 0;
			}
		default:
			break;
		}
	}

	cur_statement = NULL;
	CPR_token();

	return NULL;
}


//____________________________________________________________
//  
//		Parse a blob subtype -- either a signed number or a symbolic name.
//  

SSHORT PAR_blob_subtype(DBB db)
{
//  Check for symbol type name

	if (gpreGlob.token_global.tok_type == tok_ident) {
		gpre_rel* relation;
		gpre_fld* field;
		if (!(relation = MET_get_relation(db, "RDB$FIELDS", "")) ||
			!(field = MET_field(relation, "RDB$FIELD_SUB_TYPE")))
		{
			PAR_error("error during BLOB SUB_TYPE lookup");
		}
		
		SSHORT const_subtype;
		if (!MET_type(field, gpreGlob.token_global.tok_string, &const_subtype))
			CPR_s_error("blob sub_type");
		PAR_get_token();
		return const_subtype;
	}

	return EXP_SSHORT_ordinal(true);
}


//____________________________________________________________
//  
//		Parse a DATABASE declaration.  If successful, return
//		an action block.
//  

act* PAR_database(bool sql, const TEXT* base_directory)
{
	if (gpreGlob.token_global.tok_length >= NAME_SIZE)
		PAR_error("Database alias too long");

	TEXT s[MAXPATHLEN << 1];

	act* action = MSC_action(0, ACT_database);
	DBB db = (DBB) MSC_alloc(DBB_LEN);

//  Get handle name token, make symbol for handle, and
//  insert symbol into hash table 

	gpre_sym* symbol = PAR_symbol(SYM_dummy);
	db->dbb_name = symbol;
	symbol->sym_type = SYM_database;
	symbol->sym_object = (gpre_ctx*) db;

	if (!MSC_match(KW_EQUALS))
		CPR_s_error("\"=\" in database declaration");

	if (MSC_match(KW_STATIC))
		db->dbb_scope = DBB_STATIC;
	else if (MSC_match(KW_EXTERN))
		db->dbb_scope = DBB_EXTERN;

	MSC_match(KW_COMPILETIME);

//  parse the compiletime options 
	TEXT* string;

	for (;;) {
		if (MSC_match(KW_FILENAME) && (!isQuoted(gpreGlob.token_global.tok_type)))
			CPR_s_error("quoted file name");

		if (isQuoted(gpreGlob.token_global.tok_type)) {
			if (base_directory) {
				db->dbb_filename = string = (TEXT *) MSC_alloc(gpreGlob.token_global.tok_length + 
													strlen(base_directory) + 1);
				MSC_copy_cat(base_directory, strlen(base_directory), 
						 gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length, string);
			}
			else {
				db->dbb_filename = string = (TEXT *) MSC_alloc(gpreGlob.token_global.tok_length + 1);
				MSC_copy(gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length, string);
			}
			gpreGlob.token_global.tok_length += 2;
		}
		else if (MSC_match(KW_PASSWORD)) {
			if (!isQuoted(gpreGlob.token_global.tok_type))
				CPR_s_error("quoted password");
			db->dbb_c_password = string =
				(TEXT *) MSC_alloc(gpreGlob.token_global.tok_length + 1);
			MSC_copy(gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length, string);
		}
		else if (MSC_match(KW_USER)) {
			if (!isQuoted(gpreGlob.token_global.tok_type))
				CPR_s_error("quoted user name");
			db->dbb_c_user = string = (TEXT *) MSC_alloc(gpreGlob.token_global.tok_length + 1);
			MSC_copy(gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length, string);
		}
		else if (MSC_match(KW_LC_MESSAGES)) {
			if (!isQuoted(gpreGlob.token_global.tok_type))
				CPR_s_error("quoted language name");
			db->dbb_c_lc_messages = string =
				(TEXT *) MSC_alloc(gpreGlob.token_global.tok_length + 1);
			MSC_copy(gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length, string);
		}
		else if (!sql && MSC_match(KW_LC_CTYPE)) {
			if (!isQuoted(gpreGlob.token_global.tok_type))
				CPR_s_error("quoted character set name");
			db->dbb_c_lc_ctype = string =
				(TEXT *) MSC_alloc(gpreGlob.token_global.tok_length + 1);
			MSC_copy(gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length, string);
		}
		else
			break;

		PAR_get_token();
	}

	if ((gpreGlob.sw_auto) && (db->dbb_c_password || db->dbb_c_user || db->dbb_c_lc_ctype
			|| db->dbb_c_lc_messages))
	{
			CPR_warn
			("PASSWORD, USER and NAMES options require -manual switch to gpre.");
	}

	if (!db->dbb_filename)
		CPR_s_error("quoted file name");

	if (gpreGlob.default_user && !db->dbb_c_user)
		db->dbb_c_user = gpreGlob.default_user;

	if (gpreGlob.default_password && !db->dbb_c_password)
		db->dbb_c_password = gpreGlob.default_password;

	if (gpreGlob.module_lc_ctype && !db->dbb_c_lc_ctype)
		db->dbb_c_lc_ctype = gpreGlob.module_lc_ctype;

	if (gpreGlob.default_lc_ctype && !db->dbb_c_lc_ctype)
		db->dbb_c_lc_ctype = gpreGlob.default_lc_ctype;

//  parse the runtime options 

	if (MSC_match(KW_RUNTIME)) {
		if (MSC_match(KW_FILENAME))
			db->dbb_runtime = sql ? SQL_var_or_string(false)
				: PAR_native_value(false, false);
		else if (MSC_match(KW_PASSWORD))
			db->dbb_r_password = sql ? SQL_var_or_string(false)
				: PAR_native_value(false, false);
		else if (MSC_match(KW_USER))
			db->dbb_r_user = sql ? SQL_var_or_string(false)
				: PAR_native_value(false, false);
		else if (MSC_match(KW_LC_MESSAGES))
			db->dbb_r_lc_messages = sql ? SQL_var_or_string(false)
				: PAR_native_value(false, false);
		else if (!sql && MSC_match(KW_LC_CTYPE))
			db->dbb_r_lc_ctype = sql ? SQL_var_or_string(false)
				: PAR_native_value(false, false);
		else
			db->dbb_runtime = sql ? SQL_var_or_string(false)
				: PAR_native_value(false, false);
	}

	if ((gpreGlob.sw_language == lang_ada) && (gpreGlob.token_global.tok_keyword == KW_HANDLES)) {
		PAR_get_token();
		if (isQuoted(gpreGlob.token_global.tok_type))
			CPR_s_error("quoted file name");
		int len = gpreGlob.token_global.tok_length;
		if (len > MAXPATHLEN - 2)
		    len = MAXPATHLEN - 2;
		MSC_copy(gpreGlob.token_global.tok_string, len, s);
		s[len] = 0;
		strcat(s, ".");
		if (!gpreGlob.ada_package[0] || !strcmp(gpreGlob.ada_package, s))
		{
			strncpy(gpreGlob.ada_package, s, MAXPATHLEN);
			gpreGlob.ada_package[MAXPATHLEN - 1] = 0;
		}
		else {
			fb_utils::snprintf(s, sizeof(s),
					"Ada handle package \"%s\" already in use, ignoring package %s",
					gpreGlob.ada_package, gpreGlob.token_global.tok_string);
			CPR_warn(s);
		}
		PAR_get_token();
	}

	if (gpreGlob.sw_language != lang_fortran)
		MSC_match(KW_SEMI_COLON);

	bool found_error = false;
	try {
		if (!MET_database(db, true))
		    found_error = true;
	}
	// CVC: It avoids countless errors if the db can't be loaded.
	catch (const Firebird::status_exception& exc)
	{
		found_error = true;
		// CVC: Print the low level error. The lack of this caused me a lot of problems.
		// Granted, status_exception doesn't help, but fatal_exception carries a
		// meaningful message.
		CPR_error(exc.what());
	}
	
	if (found_error)
	{
		fb_utils::snprintf(s, sizeof(s), "Couldn't access database %s = '%s'",
				db->dbb_name->sym_string, db->dbb_filename);
		CPR_error(s);
		CPR_abort();
	}

	db->dbb_next = gpreGlob.isc_databases;
	gpreGlob.isc_databases = db;
	HSH_insert(symbol);

//   Load up the symbol (hash) table with relation names from this databases.  
	MET_load_hash_table(db);

#ifdef FTN_BLK_DATA
	if ((gpreGlob.sw_language == lang_fortran) && (db->dbb_scope != DBB_EXTERN))
		block_data_list(db);
#endif

//  Since we have a real DATABASE statement, get rid of any artificial
//  databases that were created because of an INCLUDE SQLCA statement. 

	for (DBB* db_ptr = &gpreGlob.isc_databases; *db_ptr;)
		if ((*db_ptr)->dbb_flags & DBB_sqlca)
			*db_ptr = (*db_ptr)->dbb_next;
		else
			db_ptr = &(*db_ptr)->dbb_next;

	return action;
}


//____________________________________________________________
//  
//		Parse end of statement.  All languages except ADA leave
//		the trailing semi-colon dangling.   ADA, however, must
//		eat the semi-colon as part of the statement.  In any case,
//		return TRUE is a semi-colon is/was there, otherwise return
//		FALSE.
//  

bool PAR_end()
{
	if ((gpreGlob.sw_language == lang_ada) || (gpreGlob.sw_language == lang_c) ||
		(isLangCpp(gpreGlob.sw_language)))
	{
		return (MSC_match(KW_SEMI_COLON));
	}

	return (gpreGlob.token_global.tok_keyword == KW_SEMI_COLON);
}


//____________________________________________________________
//  
//		Report an error during parse and unwind.
//  

void PAR_error(const TEXT* string)
{
	CPR_error(string);
	PAR_unwind();
}


//____________________________________________________________
//  
//		Parse an event init statement, preparing
//		to wait on a number of named gpreGlob.events.
//  

act* PAR_event_init(bool sql)
{
//	char req_name[128];

//  make up statement node 

	SQL_resolve_identifier("<identifier>", NULL, MAX_EVENT_SIZE);
	//SQL_resolve_identifier("<identifier>", req_name, sizeof(req_name));
	//strcpy(gpreGlob.token_global.tok_string, req_name); Why? It's already done.
	gpre_nod* init = MSC_node(nod_event_init, 4);
	init->nod_arg[0] = (GPRE_NOD) PAR_symbol(SYM_dummy);
	init->nod_arg[3] = (GPRE_NOD) gpreGlob.isc_databases;

	act* action = MSC_action(0, ACT_event_init);
	action->act_object = (REF) init;

//  parse optional database handle 

	if (!MSC_match(KW_LEFT_PAREN)) {
		gpre_sym* symbol = gpreGlob.token_global.tok_symbol;
		if (symbol && (symbol->sym_type == SYM_database))
			init->nod_arg[3] = (GPRE_NOD) symbol->sym_object;
		else
			CPR_s_error("left parenthesis or database handle");

		PAR_get_token();
		if (!MSC_match(KW_LEFT_PAREN))
			CPR_s_error("left parenthesis");
	}

//  eat any number of event strings until a right paren is found,
//  pushing the gpreGlob.events onto a stack 

	GPRE_NOD node;
	gpre_lls* stack = NULL;
	int count = 0;
	
	while (true) {
		if (MSC_match(KW_RIGHT_PAREN))
			break;

		const gpre_sym* symbol;
		if (!sql && (symbol = gpreGlob.token_global.tok_symbol)
			&& symbol->sym_type == SYM_context)
		{
			gpre_ctx* context;
			gpre_fld* field = EXP_field(&context);
			ref* reference = EXP_post_field(field, context, false);
			node = MSC_node(nod_field, 1);
			node->nod_arg[0] = (GPRE_NOD) reference;
		}
		else {
			node = MSC_node(nod_null, 1);
			if (sql)
				node->nod_arg[0] = (GPRE_NOD) SQL_var_or_string(false);
			else
				node->nod_arg[0] = (GPRE_NOD) PAR_native_value(false, false);
		}
		MSC_push(node, &stack);
		count++;

		MSC_match(KW_COMMA);
	}

//  pop the event strings off the stack 

	gpre_nod* event_list = init->nod_arg[1] = MSC_node(nod_list, (SSHORT) count);
	gpre_nod** ptr = event_list->nod_arg + count;
	while (stack)
		*--ptr = (GPRE_NOD) MSC_pop(&stack);

	MSC_push((GPRE_NOD) action, &gpreGlob.events);

	if (!sql)
		PAR_end();
	return action;
}


//____________________________________________________________
//  
//		Parse an event wait statement, preparing
//		to wait on a number of named gpreGlob.events.
//  

act* PAR_event_wait(bool sql)
{
//	char req_name[132];

//  this is a simple statement, just add a handle 

	act* action = MSC_action(0, ACT_event_wait);
	SQL_resolve_identifier("<identifier>", NULL, MAX_EVENT_SIZE);
	//SQL_resolve_identifier("<identifier>", req_name, sizeof(req_name));
	//strcpy(gpreGlob.token_global.tok_string, req_name); redundant
	action->act_object = (REF) PAR_symbol(SYM_dummy);
	if (!sql)
		PAR_end();

	return action;
}


//____________________________________________________________
//  
//		Perform any last minute stuff necessary at the end of pass1.
//  

void PAR_fini()
{
	if (cur_for)
		CPR_error("unterminated FOR statement");

	if (cur_modify)
		CPR_error("unterminated MODIFY statement");

	if (cur_store)
		CPR_error("unterminated STORE statement");

	if (cur_error)
		CPR_error("unterminated ON_ERROR clause");

	if (cur_item)
		CPR_error("unterminated ITEM statement");
}


//____________________________________________________________
//  
//		Get a token or unwind the parse
//		if we hit end of file
//  

TOK PAR_get_token()
{
	if (CPR_token() == NULL) {
		CPR_error("unexpected EOF");
		PAR_unwind();
	}
	return NULL;
}


//____________________________________________________________
//  
//		Do any initialization necessary.
//		For one thing, set all current indicators
//		to null, since nothing is current.  Also,
//		set up a block to hold the current routine,
//  
//		(The 'routine' indicator tells the code
//		generator where to put ports to support
//		recursive routines and Fortran's strange idea
//		of separate sub-modules.  For PASCAL only, we
//		keep a stack of routines, and pay special attention
//		to the main routine.)
//  

void PAR_init()
{
	SQL_init();

	cur_error = cur_fetch = cur_for = cur_modify = cur_store = NULL;
	cur_statement = cur_item = NULL;

	gpreGlob.cur_routine = MSC_action(0, ACT_routine);
	gpreGlob.cur_routine->act_flags |= ACT_main;
	MSC_push((GPRE_NOD) gpreGlob.cur_routine, &routine_stack);
	routine_decl = true;

	flag_field = NULL;
	brace_count = 0;
}

static inline void gobble(SCHAR*& string)
{
	const SCHAR* s1 = gpreGlob.token_global.tok_string;
	while (*s1) 
		*string++ = *s1++; 
	PAR_get_token();
}

//____________________________________________________________
//  
//		Parse a native expression as a string.
//  

TEXT* PAR_native_value(bool array_ref,
					   bool handle_ref)
{
	SCHAR buffer[512];

	SCHAR* string = buffer;

	while (true) {
	/** PAR_native_values copies the string constants. These are 
	passed to api calls. Make sure to enclose these with
	double quotes.
    **/
		if (gpreGlob.sw_sql_dialect == 1) {
			if (isQuoted(gpreGlob.token_global.tok_type)) {
				//const enum tok_t typ = gpreGlob.token_global.tok_type;
				gpreGlob.token_global.tok_length += 2;
				*string++ = '\"';
				gobble(string);
				*string++ = '\"';
				break;
			}
		}
		else if (gpreGlob.sw_sql_dialect == 2) {
			if (gpreGlob.token_global.tok_type == tok_dblquoted)
				PAR_error("Ambiguous use of double quotes in dialect 2");
			else if (gpreGlob.token_global.tok_type == tok_sglquoted) {
				gpreGlob.token_global.tok_length += 2;
				*string++ = '\"';
				gobble(string);
				*string++ = '\"';
				break;
			}
		}
		else if (gpreGlob.sw_sql_dialect == 3) {
			if (gpreGlob.token_global.tok_type == tok_sglquoted) {
				gpreGlob.token_global.tok_length += 2;
				*string++ = '\"';
				gobble(string);
				*string++ = '\"';
				break;
			}
		}

		if (gpreGlob.token_global.tok_keyword == KW_AMPERSAND || gpreGlob.token_global.tok_keyword == KW_ASTERISK)
			gobble(string);
		if (gpreGlob.token_global.tok_type != tok_ident)
			CPR_s_error("identifier");
		gobble(string);

		/* For ADA, gobble '<attribute> */

		if ((gpreGlob.sw_language == lang_ada) && (gpreGlob.token_global.tok_string[0] == '\'')) {
			gobble(string);
		}
		enum kwwords keyword = gpreGlob.token_global.tok_keyword;
		if (keyword == KW_LEFT_PAREN) {
			int parens = 1;
			while (parens) {
				const enum tok_t typ = gpreGlob.token_global.tok_type;
				if (isQuoted(typ))
					*string++ = (typ == tok_sglquoted) ? '\'' : '\"';
				gobble(string);
				if (isQuoted(typ))
					*string++ = (typ == tok_sglquoted) ? '\'' : '\"';
				keyword = gpreGlob.token_global.tok_keyword;
				if (keyword == KW_RIGHT_PAREN)
					parens--;
				else if (keyword == KW_LEFT_PAREN)
					parens++;
			}
			gobble(string);
			keyword = gpreGlob.token_global.tok_keyword;
		}
		while (keyword == KW_L_BRCKET) {
			int brackets = 1;
			while (brackets) {
				gobble(string);
				keyword = gpreGlob.token_global.tok_keyword;
				if (keyword == KW_R_BRCKET)
					brackets--;
				else if (keyword == KW_L_BRCKET)
					brackets++;
			}
			gobble(string);
			keyword = gpreGlob.token_global.tok_keyword;
		}

		while ((keyword == KW_CARAT) && (gpreGlob.sw_language == lang_pascal)) {
			gobble(string);
			keyword = gpreGlob.token_global.tok_keyword;
		}

		if (
			(keyword == KW_DOT
			 && (!handle_ref || gpreGlob.sw_language == lang_c
				 || gpreGlob.sw_language == lang_ada)) || keyword == KW_POINTS
			|| (keyword == KW_COLON && !gpreGlob.sw_sql && !array_ref))
		{
			gobble(string);
		}
		else
			break;
	}

	int length = string - buffer;
	SCHAR* const s2 = string = (SCHAR *) MSC_alloc(length + 1);
	const SCHAR* s1 = buffer;

	if (length) {
		do {
			*string++ = *s1++;
		} while (--length);
	}

	return s2;
}


//____________________________________________________________
//  
//		Find a pseudo-field for null.  If there isn't one,
//		make one.
//  

gpre_fld* PAR_null_field()
{

	if (flag_field)
		return flag_field;

	flag_field = MET_make_field("gds__null_flag", dtype_short, sizeof(SSHORT),
								false);

	return flag_field;
}


//____________________________________________________________
//  
//		Parse the RESERVING clause of the start_transaction & set transaction
//  	statements, creating a partial TPB in the process.  The
//  	TPB just hangs off the end of the transaction block.
//  

void PAR_reserving( USHORT flags, bool parse_sql)
{
	DBB database;

	while (true) {
		// find a relation name, or maybe a list of them 

		if ((!parse_sql) && terminator())
			break;

		do {
			gpre_rel* relation = EXP_relation();
			if (!relation)
				CPR_s_error("relation name");
			database = relation->rel_database;
			rrl* lock_block = (rrl*) MSC_alloc(RRL_LEN);
			lock_block->rrl_next = database->dbb_rrls;
			lock_block->rrl_relation = relation;
			database->dbb_rrls = lock_block;
		} while (MSC_match(KW_COMMA));

		/*
		 * get the lock level and mode and apply them to all the
		 * relations in the list
		 */

		MSC_match(KW_FOR);
		USHORT lock_level = (flags & TRA_con) ? isc_tpb_protected : isc_tpb_shared;
		USHORT lock_mode = isc_tpb_lock_read;

		if (MSC_match(KW_PROTECTED))
			lock_level = isc_tpb_protected;
		else if (MSC_match(KW_EXCLUSIVE))
			lock_level = isc_tpb_exclusive;
		else if (MSC_match(KW_SHARED))
			lock_level = isc_tpb_shared;

		if (MSC_match(KW_WRITE)) {
			if (flags & TRA_ro)
				CPR_error("write lock requested for a read_only transaction");
			lock_mode = isc_tpb_lock_write;
		}
		else
			MSC_match(KW_READ);

		for (database = gpreGlob.isc_databases; database; database = database->dbb_next)
		{
			for (rrl* lock_block = database->dbb_rrls; lock_block;
				lock_block = lock_block->rrl_next)
			{
				if (!lock_block->rrl_lock_level)
				{
					fb_assert(lock_level <= MAX_UCHAR);
					fb_assert(lock_mode <= MAX_UCHAR);
					lock_block->rrl_lock_level = (UCHAR) lock_level;
					lock_block->rrl_lock_mode = (UCHAR) lock_mode;
				}
			}
		}
		if (!(MSC_match(KW_COMMA)))
			break;
	}
}


//____________________________________________________________
//  
//		Initialize the request and the ready.
//  

gpre_req* PAR_set_up_dpb_info(rdy* ready, act* action, USHORT buffercount)
{
	ready->rdy_database->dbb_buffercount = buffercount;
	gpre_req* request = MSC_request(REQ_ready);
	request->req_database = ready->rdy_database;
	request->req_actions = action;
	ready->rdy_request = request;

	return request;
}


//____________________________________________________________
//  
//		Make a symbol from the current token, and advance
//		to the next token.  If a symbol type other than
//		SYM_dummy, the symbol can be overloaded, but not
//		redefined.
//  

gpre_sym* PAR_symbol(enum sym_t type)
{
	gpre_sym* symbol;

	for (symbol = gpreGlob.token_global.tok_symbol; symbol; symbol = symbol->sym_homonym)
		if (type == SYM_dummy || symbol->sym_type == type) {
			TEXT s[ERROR_LENGTH];
			fb_utils::snprintf(s, sizeof(s), 
				"symbol %s is already in use", gpreGlob.token_global.tok_string);
			PAR_error(s);
		}

	symbol = MSC_symbol(SYM_cursor, gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length, 0);
	PAR_get_token();

	return symbol;
}


//____________________________________________________________
//  
//		There's been a parse error, so unwind out.
//  

void PAR_unwind()
{
	throw std::exception();
}


//____________________________________________________________
//  
//		mark databases specified in start_transaction and set transaction
//		statements.
//  

void PAR_using_db()
{
	while (true) {
		gpre_sym* symbol = MSC_find_symbol(gpreGlob.token_global.tok_symbol, SYM_database);
		if (symbol) {
			DBB db = (DBB) symbol->sym_object;
			db->dbb_flags |= DBB_in_trans;
		}
		else
			CPR_s_error("database handle");
		PAR_get_token();
		if (!MSC_match(KW_COMMA))
			break;
	}
}


#ifdef FTN_BLK_DATA
//____________________________________________________________
//  
//  
//		Damn fortran sometimes only allows global
//		initializations in block data.  This collects
//		names of dbs to be so handled.  
//  

static void block_data_list( const dbb* db)
{
	if (db->dbb_scope == DBB_EXTERN)
		return;
	const TEXT* name = db->dbb_name->sym_string;
	dbd* list = gpreGlob.global_db_list;

	if (gpreGlob.global_db_count)
		if (gpreGlob.global_db_count > MAX_DATABASES) {
			PAR_error
				("Database limit exceeded: 32 databases per source file.");
		}
		else {
			for (const dbd* const end = gpreGlob.global_db_list + gpreGlob.global_db_count;
				list < end; list++)
			{
				if (!(strcmp(name, list->dbb_name)))
					return;
			}
		}

	if (gpreGlob.global_db_count >= MAX_DATABASES)
		return;

	strcpy(list->dbb_name, name);
	gpreGlob.global_db_count++;
}
#endif


//____________________________________________________________
//  
//  
//		For reasons best left unnamed, we need
//		to skip the contents of a parenthesized
//		list	
//  

static bool match_parentheses()
{
	USHORT paren_count = 0;

	if (MSC_match(KW_LEFT_PAREN)) {
		paren_count++;
		while (paren_count) {
			if (MSC_match(KW_RIGHT_PAREN))
				paren_count--;
			else if (MSC_match(KW_LEFT_PAREN))
				paren_count++;
			else
				PAR_get_token();
		}
		return true;
	}
	else
		return false;
}


//____________________________________________________________
//  
//		Parse a free standing ANY expression.
//  

static act* par_any()
{
//  For time being flag as an error

	PAR_error("Free standing any not supported");

	gpre_sym* symbol = NULL;

//  Make up request block.  Since this might not be a database statement,
//  stay ready to back out if necessay. 

	gpre_req* request = MSC_request(REQ_any);

	par_options(request, true);
	gpre_rse* rec_expr = EXP_rse(request, symbol);
	EXP_rse_cleanup(rec_expr);
	act* action = MSC_action(request, ACT_any);

	request->req_rse = rec_expr;
	gpre_ctx* context = rec_expr->rse_context[0];
	gpre_rel* relation = context->ctx_relation;
	request->req_database = relation->rel_database;

	act* function = MSC_action(0, ACT_function);
	function->act_object = (REF) action;
	function->act_next = gpreGlob.global_functions;
	gpreGlob.global_functions = function;

	return action;
}


//____________________________________________________________
//  
//		Parse a free reference to a database field in general
//		program context.  If the next keyword isn't a context
//		varying, this isn't an array element reference.
//  

static act* par_array_element()
{
	if (!MSC_find_symbol(gpreGlob.token_global.tok_symbol, SYM_context))
		return NULL;

	gpre_ctx* context;
	gpre_fld* field = EXP_field(&context);
	gpre_req* request = context->ctx_request;
	gpre_nod* node = EXP_array(request, field, false, false);
	ref* reference = MSC_reference(&request->req_references);
	reference->ref_expr = node;
	gpre_fld* element = field->fld_array;
	reference->ref_field = element;
	element->fld_symbol = field->fld_symbol;
	reference->ref_context = context;
	node->nod_arg[0] = (GPRE_NOD) reference;

	act* action = MSC_action(request, ACT_variable);
	action->act_object = reference;

	return action;
}


//____________________________________________________________
//  
//		Parse an AT END clause.
//  

static act* par_at()
{
	if (!MSC_match(KW_END) || !cur_fetch)
		return NULL;

	act* action = (act*) cur_fetch->lls_object;

	return MSC_action(action->act_request, ACT_at_end);
}


//____________________________________________________________
//  
//		Parse a BASED ON clause.  If this
//		is fortran and we don't have a database
//		declared yet, don't parse it completely.
//		If this is PLI look for a left paren or
//		a semi colon to avoid stomping a
//		DECLARE i FIXED BIN BASED (X);
//		or DECLARE LIST (10) FIXED BINARY BASED;
//  

static act* par_based()
{
	bool notSegment = false;	// a COBOL specific patch

	MSC_match(KW_ON);
	act* action = MSC_action(0, ACT_basedon);
	bas* based_on = (bas*) MSC_alloc(BAS_LEN);
	action->act_object = (REF) based_on;

	if ((gpreGlob.sw_language != lang_fortran) || gpreGlob.isc_databases)
	{
		TEXT s[ERROR_LENGTH];
		gpre_rel* relation = EXP_relation();
		if (!MSC_match(KW_DOT))
			CPR_s_error("dot in qualified field reference");
		SQL_resolve_identifier("<fieldname>", NULL, NAME_SIZE + 1);
		if (gpreGlob.token_global.tok_length >= NAME_SIZE)
			PAR_error("Field length too long");
			
		gpre_fld* field = MET_field(relation, gpreGlob.token_global.tok_string);
		if (!field) {
			fb_utils::snprintf(s, sizeof(s),
				"undefined field %s", gpreGlob.token_global.tok_string);
			PAR_error(s);
		}
		if (SQL_DIALECT_V5 == gpreGlob.sw_sql_dialect) {
			const USHORT field_dtype = field->fld_dtype;
			if ((dtype_sql_date == field_dtype) ||
				(dtype_sql_time == field_dtype) ||
				(dtype_int64 == field_dtype))
			{
				PAR_error
					("BASED ON impermissible datatype for a dialect-1 program");
			}
		}
		PAR_get_token();
		char tmpChar[2];			// a COBOL specific patch
		if (gpreGlob.sw_language == lang_cobol && gpreGlob.token_global.tok_keyword == KW_DOT) {
			strcpy(tmpChar, gpreGlob.token_global.tok_string);
		}
		if (MSC_match(KW_DOT)) {
			if (!MSC_match(KW_SEGMENT)) {
				if (gpreGlob.sw_language != lang_cobol)
					PAR_error
						("only .SEGMENT allowed after qualified field name");
				else {
					strcpy(based_on->bas_terminator, tmpChar);
					notSegment = true;
				}
			}
			else if (!(field->fld_flags & FLD_blob)) {
				fb_utils::snprintf(s, sizeof(s), "field %s is not a blob",
						field->fld_symbol->sym_string);
				PAR_error(s);
			}
			if (!notSegment)	/* this is flag is to solve KW_DOT problem
								   in COBOL. should be false for all other lang */
				based_on->bas_flags |= BAS_segment;
		}
		based_on->bas_field = field;
	}
	else {
		based_on->bas_rel_name = (STR) MSC_alloc(gpreGlob.token_global.tok_length + 1);
		MSC_copy(gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length,
			based_on->bas_rel_name->str_string);
		PAR_get_token();
		if (!MSC_match(KW_DOT))
			PAR_error("expected qualified field name");
		else {
			based_on->bas_fld_name = (STR) MSC_alloc(gpreGlob.token_global.tok_length + 1);
			MSC_copy(gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length,
				based_on->bas_fld_name->str_string);
			bool ambiguous_flag = false;
			PAR_get_token();
			if (MSC_match(KW_DOT)) {
				based_on->bas_db_name = based_on->bas_rel_name;
				based_on->bas_rel_name = based_on->bas_fld_name;
				based_on->bas_fld_name = (STR) MSC_alloc(gpreGlob.token_global.tok_length + 1);
				MSC_copy(gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length,
					based_on->bas_fld_name->str_string);
				if (gpreGlob.token_global.tok_keyword == KW_SEGMENT)
					ambiguous_flag = true;
				PAR_get_token();
				if (MSC_match(KW_DOT)) {
					if (!MSC_match(KW_SEGMENT))
						PAR_error("too many qualifiers on field name");
					based_on->bas_flags |= BAS_segment;
					ambiguous_flag = false;
				}
			}
			if (ambiguous_flag)
				based_on->bas_flags |= BAS_ambiguous;
		}
	}

	switch (gpreGlob.sw_language) {
	case lang_internal:
	case lang_fortran:
	case lang_epascal:
	case lang_c:
	case lang_cxx:
		do {
			MSC_push((GPRE_NOD) PAR_native_value(false, false),
				 &based_on->bas_variables);
		} while (MSC_match(KW_COMMA));
		/* 
		   ** bug_4031.  based_on->bas_variables are now in reverse order.
		   ** we must reverse the order so we can output them to the .c 
		   ** file correctly.
		 */
		if (based_on->bas_variables->lls_next) {
			gpre_lls* t1 = based_on->bas_variables;	// last one in the old list
			gpre_lls* t2 = NULL;			// last one in the new list
			gpre_lls* hold = t2;			// beginning of new list

			// while we still have a next one, keep going thru 
			while (t1->lls_next) {
				// now find the last one in the list 
				while (t1->lls_next->lls_next)
					t1 = t1->lls_next;

				// if this is the first time thru, set hold 
				if (hold == NULL) {
					hold = t1->lls_next;
					t2 = hold;
				}
				else {
					/* not first time thru, add this one to the end 
					   ** of the new list */

					t2->lls_next = t1->lls_next;
					t2 = t2->lls_next;
				}
				// now null out the last one, and start again 
				t1->lls_next = NULL;
				t1 = based_on->bas_variables;
			}
			/* ok, we're done, tack the original lls onto the very
			   ** end of the new list. */

			t2->lls_next = t1;
			if (hold)
				based_on->bas_variables = hold;
		}
	default:
		break;
	}

	if (notSegment)
		return action;
	if (gpreGlob.token_global.tok_keyword == KW_SEMI_COLON ||
		(gpreGlob.sw_language == lang_cobol && gpreGlob.token_global.tok_keyword == KW_DOT))
	{
		strcpy(based_on->bas_terminator, gpreGlob.token_global.tok_string);
		PAR_get_token();
	}

	return action;
}


//____________________________________________________________
//  
//		If this is a PASCAL program, and we're
//  	in a code block, then increment the 
//		brace count.  If we're in a routine
//		declaration, then we've reached the start
//		of the code block and should mark it as
//		a new routine.
//  

static act* par_begin()
{

	if (gpreGlob.sw_language == lang_pascal) {
		routine_decl = false;
		gpreGlob.cur_routine->act_count++;
	}
	return NULL;
}


//____________________________________________________________
//  
//		Parse a blob handle and return the blob.
//  

static blb* par_blob()
{
	gpre_sym* symbol = MSC_find_symbol(gpreGlob.token_global.tok_symbol, SYM_blob);

	if (!symbol)
		CPR_s_error("blob handle");

	PAR_get_token();

	return (blb*) symbol->sym_object;
}


//____________________________________________________________
//  
//		Parse a GET_SEGMENT, PUT_SEGMENT, CLOSE_BLOB or CANCEL_BLOB.
//  

static act* par_blob_action( ACT_T type)
{
	blb* blob = par_blob();
	act* action = MSC_action(blob->blb_request, type);
	action->act_object = (REF) blob;

//   Need to eat the semicolon if present  

	if (gpreGlob.sw_language == lang_c)
		MSC_match(KW_SEMI_COLON);
	else
		PAR_end();

	return action;
}


//____________________________________________________________
//  
//		Parse a blob segment or blob field reference. 
//  

static act* par_blob_field()
{
	const SSHORT first = gpreGlob.token_global.tok_first;

	blb* blob = par_blob();

	ACT_T type;
	if (MSC_match(KW_DOT)) {
		if (MSC_match(KW_SEGMENT))
			type = ACT_segment;
		else if (MSC_match(KW_LENGTH))
			type = ACT_segment_length;
		else
			CPR_s_error("SEGMENT or LENGTH");
	}
	else
		type = ACT_blob_handle;

	act* action = MSC_action(blob->blb_request, type);

	if (first)
		action->act_flags |= ACT_first;

	action->act_object = (REF) blob;

	return action;
}


//____________________________________________________________
//  
//		If this is a PASCAL program, and we're
//  	in a code block, then a case statement
//		will end with an END, so it adds to the
//		begin count.
//  

static act* par_case()
{

	if ((gpreGlob.sw_language == lang_pascal) && (!routine_decl))
		gpreGlob.cur_routine->act_count++;

	return NULL;
}


//____________________________________________________________
//  
//		Parse degenerate CLEAR_HANDLES command.
//  

static act* par_clear_handles()
{

	return MSC_action(0, ACT_clear_handles);
}


//____________________________________________________________
//  
//		Parse a DERIVED_FROM clause.  Like
//		BASED ON but for C/C++ prototypes.
//  

static act* par_derived_from()
{
	if ((gpreGlob.sw_language != lang_c) && (!isLangCpp(gpreGlob.sw_language))) {
		return (NULL);
    }

	act* action = MSC_action(0, ACT_basedon);
	bas* based_on = (bas*) MSC_alloc(BAS_LEN);
	action->act_object = (REF) based_on;

	gpre_rel* relation = EXP_relation();
	if (!MSC_match(KW_DOT))
		CPR_s_error("dot in qualified field reference");

	SQL_resolve_identifier("<Field Name>", NULL, NAME_SIZE);
	
	gpre_fld* field = MET_field(relation, gpreGlob.token_global.tok_string);
	if (!field) {
		TEXT s[ERROR_LENGTH];
		fb_utils::snprintf(s, sizeof(s),
			"undefined field %s", gpreGlob.token_global.tok_string);
		PAR_error(s);
	}
	PAR_get_token();
	based_on->bas_field = field;


	based_on->bas_variables = (gpre_lls*) MSC_alloc(LLS_LEN);
	based_on->bas_variables->lls_next = NULL;
	based_on->bas_variables->lls_object =
		(GPRE_NOD) PAR_native_value(false, false);

	strcpy(based_on->bas_terminator, gpreGlob.token_global.tok_string);
	PAR_get_token();

	return action;
}


//____________________________________________________________
//  
//  
//     If the language is PASCAL, and if we're
//     the body of a routine,  every END counts
//     against the number of BEGIN's and CASE's
//     and when the count comes to zero, we SHOULD
//     be at the end of the current routine, so
//     pop it off the routine stack.
//  

static act* par_end_block()
{
	if (gpreGlob.sw_language == lang_pascal &&
		!routine_decl && --gpreGlob.cur_routine->act_count == 0 && routine_stack)
	{
		gpreGlob.cur_routine = (act*) MSC_pop(&routine_stack);
	}

	return NULL;
}


//____________________________________________________________
//  
//		Parse an END_ERROR statement.  Piece of cake.
//  

static act* par_end_error()
{

//  avoid parsing an ada exception end_error -
//  check for a semicolon 

	if (!PAR_end() && gpreGlob.sw_language == lang_ada)
		return NULL;

	if (!cur_error)
		PAR_error("END_ERROR used out of context");

	if (!((act*) MSC_pop(&cur_error)))
		return NULL;

//   Need to eat the semicolon for c if present  

	if (gpreGlob.sw_language == lang_c)
		MSC_match(KW_SEMI_COLON);

	return MSC_action(0, ACT_enderror);
}


//____________________________________________________________
//  
//		Parse END_FETCH statement (clause?).
//  

static act* par_end_fetch()
{
	if (!cur_fetch)
		PAR_error("END_FETCH used out of context");

	act* begin_action = (act*) MSC_pop(&cur_fetch);

	act* action = MSC_action(begin_action->act_request, ACT_hctef);
	begin_action->act_pair = action;
	action->act_pair = begin_action;

	PAR_end();
	return action;
}


//____________________________________________________________
//  
//		Parse a FOR loop terminator.
//  

static act* par_end_for()
{
	if (!cur_for)
		PAR_error("unmatched END_FOR");

	act* begin_action = (act*) MSC_pop(&cur_for);
	if (!begin_action)
		return NULL;

	PAR_end();
	gpre_req* request = begin_action->act_request;

//  If the action is a blob for, make up a blob end. 

	if (begin_action->act_type == ACT_blob_for) {
		blb* blob = (blb*) begin_action->act_object;
		act* action = MSC_action(request, ACT_endblob);
		action->act_object = (REF) blob;
		begin_action->act_pair = action;
		action->act_pair = begin_action;
		HSH_remove(blob->blb_symbol);
		blob->blb_flags |= BLB_symbol_released;
		return action;
	}

//  If there isn't a database assigned, the FOR statement itself
//  failed.  Since an error has been given, just return quietly. 

	if (!request->req_database)
		return NULL;

	act* action = MSC_action(request, ACT_endfor);
	begin_action->act_pair = action;
	action->act_pair = begin_action;
	EXP_rse_cleanup(request->req_rse);

	for (blb* blob = request->req_blobs; blob; blob = blob->blb_next)
	{
		if (!(blob->blb_flags & BLB_symbol_released))
			HSH_remove(blob->blb_symbol);
	}

	return action;
}


//____________________________________________________________
//  
//		Parse and process END_MODIFY.  The processing mostly includes
//		copying field references to proper context at proper level.
//  

static act* par_end_modify()
{
	if (!cur_modify)
		PAR_error("unmatched END_MODIFY");

	PAR_end();
	upd* modify = (upd*) MSC_pop(&cur_modify);

	if (gpreGlob.errors_global)
		return NULL;

	gpre_req* request = modify->upd_request;

	// used at the end of this function
	act* begin_action = request->req_actions;
	while ((upd*) begin_action->act_object != modify)
		begin_action = begin_action->act_next;

//  Build assignments for all fields and null flags referenced 

	gpre_lls* stack = NULL;
	int count = 0;

	for (ref* reference = request->req_references; reference;
		 reference = reference->ref_next)
	{
		if (reference->ref_context == modify->upd_source &&
			reference->ref_level >= modify->upd_level &&
			!reference->ref_master)
		{
			ref* change = MSC_reference(&modify->upd_references);
			change->ref_context = modify->upd_update;
			change->ref_field = reference->ref_field;
			change->ref_source = reference;
			change->ref_flags = reference->ref_flags;

			gpre_nod* item = MSC_node(nod_assignment, 2);
			item->nod_arg[0] = MSC_unary(nod_value, (GPRE_NOD) change);
			item->nod_arg[1] = MSC_unary(nod_field, (GPRE_NOD) change);
			MSC_push((GPRE_NOD) item, &stack);
			count++;

			if (reference->ref_null) {
				ref* flag = MSC_reference(&modify->upd_references);
				flag->ref_context = change->ref_context;
				flag->ref_field = flag_field;
				flag->ref_master = change;
				flag->ref_source = reference->ref_null;
				change->ref_null = flag;

				item = MSC_node(nod_assignment, 2);
				item->nod_arg[0] = MSC_unary(nod_value, (GPRE_NOD) flag);
				item->nod_arg[1] = MSC_unary(nod_field, (GPRE_NOD) flag);
				MSC_push((GPRE_NOD) item, &stack);
				count++;
			}
		}
	}

//  Build a list node of the assignments 

	gpre_nod* assignments = MSC_node(nod_list, (SSHORT) count);
	modify->upd_assignments = assignments;
	gpre_nod** ptr = assignments->nod_arg + count;

	while (stack)
		*--ptr = (GPRE_NOD) MSC_pop(&stack);

	act* action = MSC_action(request, ACT_endmodify);
	action->act_object = (REF) modify;
	begin_action->act_pair = action;
	action->act_pair = begin_action;

	return action;
}


//____________________________________________________________
//  
//		Parse a stream END statement.
//  

static act* par_end_stream()
{
	gpre_sym* symbol = gpreGlob.token_global.tok_symbol;
	if (!symbol || symbol->sym_type != SYM_stream)
		CPR_s_error("stream cursor");

	gpre_req* request = (gpre_req*) symbol->sym_object;
	HSH_remove(symbol);

	EXP_rse_cleanup(request->req_rse);
	PAR_get_token();
	PAR_end();

	return MSC_action(request, ACT_s_end);
}


//____________________________________________________________
//  
//		Process an END_STORE.
//  

static act* par_end_store(bool special)
{
	REF reference;

	if (!cur_store)
		PAR_error("unmatched END_STORE");

	PAR_end();

	act* begin_action = (act*) MSC_pop(&cur_store);
	gpre_req* request = begin_action->act_request;

	if (request->req_type == REQ_store) {
		if (gpreGlob.errors_global)
			return NULL;

		// Make up an assignment list for all field references 

		int count = 0;
		for (reference = request->req_references; reference;
			 reference = reference->ref_next)
		{
			if (!reference->ref_master)
				count++;
		}

		gpre_nod* const assignments = MSC_node(nod_list, (SSHORT) count);
		request->req_node = assignments;
		count = 0;

		for (reference = request->req_references; reference;
			 reference = reference->ref_next)
		{
			if (reference->ref_master)
				continue;
			gpre_nod* item = MSC_node(nod_assignment, 2);
			item->nod_arg[0] = MSC_unary(nod_value, (GPRE_NOD) reference);
			item->nod_arg[1] = MSC_unary(nod_field, (GPRE_NOD) reference);
			assignments->nod_arg[count++] = item;
		}
	}
	else {
		/* if the request type is store2, we have store ...returning_values.
		 * The next action on the cur_store stack points to a upd structure
		 * which will give us the assignments for this one.
		 */

		act* action2 = (act*) MSC_pop(&cur_store);
		upd* return_values = (upd*) action2->act_object;

		// Build assignments for all fields and null flags referenced 

		gpre_lls* stack = NULL;
		int count = 0;

		for (reference = request->req_references; reference;
			 reference = reference->ref_next)
		{
			if (reference->ref_context == return_values->upd_update &&
					reference->ref_level >= return_values->upd_level &&
					!reference->ref_master)
			{
				ref* change = MSC_reference(&return_values->upd_references);
				change->ref_context = return_values->upd_update;
				change->ref_field = reference->ref_field;
				change->ref_source = reference;
				change->ref_flags = reference->ref_flags;

				gpre_nod* item = MSC_node(nod_assignment, 2);
				item->nod_arg[0] = MSC_unary(nod_field, (GPRE_NOD) change);
				item->nod_arg[1] = MSC_unary(nod_value, (GPRE_NOD) change);
				MSC_push((GPRE_NOD) item, &stack);
				count++;
			}
		}

		// Build a list node of the assignments 

		gpre_nod* const assignments = MSC_node(nod_list, (SSHORT) count);
		return_values->upd_assignments = assignments;
		gpre_nod** ptr = assignments->nod_arg + count;

		while (stack)
			*--ptr = (GPRE_NOD) MSC_pop(&stack);
	}
	
	gpre_ctx* context = request->req_contexts;
	if (context)
		HSH_remove(context->ctx_symbol);

	act* action;
	if (special)
		action = MSC_action(request, ACT_endstore_special);
	else
		action = MSC_action(request, ACT_endstore);
	begin_action->act_pair = action;
	action->act_pair = begin_action;
	return action;
}


//____________________________________________________________
//  
//		Parse a ERASE statement.
//  

static act* par_erase()
{
	gpre_sym* symbol = gpreGlob.token_global.tok_symbol;
	if (!symbol || symbol->sym_type != SYM_context)
		CPR_s_error("context variable");

	gpre_ctx* source = symbol->sym_object;
	gpre_req* request = source->ctx_request;
	if (request->req_type != REQ_for && request->req_type != REQ_cursor)
		PAR_error("invalid context for modify");

	PAR_get_token();
	PAR_end();

//  Make an update block to hold everything known about the modify 

	upd* erase = (upd*) MSC_alloc(UPD_LEN);
	erase->upd_request = request;
	erase->upd_source = source;

	act* action = MSC_action(request, ACT_erase);
	action->act_object = (REF) erase;

	return action;
}


//____________________________________________________________
//  
//		Parse a stream FETCH statement.
//  

static act* par_fetch()
{
	gpre_sym* symbol = gpreGlob.token_global.tok_symbol;
	if (!symbol || symbol->sym_type != SYM_stream)
		return NULL;

	gpre_req* request = (gpre_req*) symbol->sym_object;
	PAR_get_token();
	PAR_end();

	act* action = MSC_action(request, ACT_s_fetch);
	MSC_push((GPRE_NOD) action, &cur_fetch);

	return action;
}


//____________________________________________________________
//  
//		Parse a FINISH statement.
//  

static act* par_finish()
{
	act* action = MSC_action(0, ACT_finish);

	if (!terminator())
		while (true) {
			gpre_sym* symbol = gpreGlob.token_global.tok_symbol;
			if (symbol && (symbol->sym_type == SYM_database))
			{
				rdy* ready = (rdy*) MSC_alloc(RDY_LEN);
				ready->rdy_next = (rdy*) action->act_object;
				action->act_object = (REF) ready;
				ready->rdy_database = (DBB) symbol->sym_object;
				CPR_eol_token();
			}
			else
				CPR_s_error("database handle");
			if (terminator())
				break;
			if (!MSC_match(KW_COMMA))
				break;
		}

	if (gpreGlob.sw_language == lang_ada)
		MSC_match(KW_SEMI_COLON);
	return action;
}


//____________________________________________________________
//  
//		Parse a FOR clause, returning an action.
//		We don't know where we are a host language FOR, a record looping
//		FOR, or a blob FOR.  Parse a little ahead and try to find out.
//		Avoid stepping on user routines that use GDML keywords
//  

static act* par_for()
{
	TEXT s[ERROR_LENGTH];
	gpre_sym* symbol = NULL;
	bool dup_symbol = false;

	if (!(gpreGlob.token_global.tok_keyword == KW_FIRST) && !(gpreGlob.token_global.tok_keyword == KW_LEFT_PAREN))
	{
		if (gpreGlob.token_global.tok_symbol)
			dup_symbol = true;

		symbol = MSC_symbol(SYM_cursor, gpreGlob.token_global.tok_string, gpreGlob.token_global.tok_length, 0);
		PAR_get_token();

		if (!MSC_match(KW_IN)) {
			MSC_free((UCHAR *) symbol);
			return NULL;
		}
		if (dup_symbol) {
			fb_utils::snprintf(s, sizeof(s),
				"symbol %s is already in use", gpreGlob.token_global.tok_string);
			PAR_error(s);
		}

		const gpre_sym* temp = gpreGlob.token_global.tok_symbol;
		if (temp && temp->sym_type == SYM_context)
			return par_open_blob(ACT_blob_for, symbol);
	}

//  Make up request block.  Since this might not be a database statement,
//  stay ready to back out if necessay. 

	gpre_req* request = MSC_request(REQ_for);

	gpre_rse* rec_expr;
	if (!par_options(request, true) || !(rec_expr = EXP_rse(request, symbol))) {
		MSC_free_request(request);
		return NULL;
	}

	act* action = MSC_action(request, ACT_for);
	MSC_push((GPRE_NOD) action, &cur_for);

	request->req_rse = rec_expr;
	gpre_ctx* context = rec_expr->rse_context[0];
	gpre_rel* relation = context->ctx_relation;
	request->req_database = relation->rel_database;

	gpre_ctx** ptr = rec_expr->rse_context;
	for (const gpre_ctx* const* const end = ptr + rec_expr->rse_count;
		 ptr < end; ptr++)
	{
		context = *ptr;
		context->ctx_next = request->req_contexts;
		request->req_contexts = context;
	}

	return action;
}

//____________________________________________________________
//  
//  	A function declaration is interesting in
//		FORTRAN because it starts a new sub-module
//		and we have to begin everything all over.
//		In PASCAL it's interesting because it may
//		indicate a good place to put message declarations.
//		Unfortunately that requires a loose parse of the
//		routine header, but what the hell...
//  

static act* par_function()
{

	if (gpreGlob.sw_language == lang_fortran)
		return par_subroutine();

	if (gpreGlob.sw_language == lang_pascal)
		return par_procedure();

	return NULL;
}


//____________________________________________________________
//  
//		Check a left brace (or whatever) for start of a new
//		routine.
//  

static act* par_left_brace()
{
	if (brace_count++ > 0)
		return NULL;

	act* action = MSC_action(0, ACT_routine);
	gpreGlob.cur_routine = action;
	action->act_flags |= ACT_mark;

	return action;
}


//____________________________________________________________
//  
//		Parse a MODIFY statement.
//  

static act* par_modify()
{

//  Set up modify and action blocks.  This is done here to leave the
//  structure in place to cleanly handle END_MODIFY under error conditions. 

	upd* modify = (upd*) MSC_alloc(UPD_LEN);
	MSC_push((GPRE_NOD) modify, &cur_modify);

//  If the next token isn't a context variable, we can't continue 

	gpre_sym* symbol = gpreGlob.token_global.tok_symbol;
	if (!symbol || symbol->sym_type != SYM_context) {
		SCHAR s[ERROR_LENGTH];
		sprintf(s, "%s is not a valid context variable", gpreGlob.token_global.tok_string);
		PAR_error(s);
	}

	gpre_ctx* source = symbol->sym_object;
	gpre_req* request = source->ctx_request;
	if (request->req_type != REQ_for && request->req_type != REQ_cursor)
		PAR_error("invalid context for modify");

	act* action = MSC_action(request, ACT_modify);
	action->act_object = (REF) modify;

	PAR_get_token();
	MSC_match(KW_USING);

//  Make an update context by cloning the source context 

	gpre_ctx* update = MSC_context(request);
	update->ctx_symbol = source->ctx_symbol;
	update->ctx_relation = source->ctx_relation;

//  Make an update block to hold everything known about the modify 

	modify->upd_request = request;
	modify->upd_source = source;
	modify->upd_update = update;
	modify->upd_level = ++request->req_level;

	return action;
}


//____________________________________________________________
//  
//		This rather degenerate routine exists to allow both:
//  
//			ON_ERROR
//			ON ERROR
//  
//		so the more dim of our users avoid mistakes.
//  

static act* par_on()
{
	if (!(MSC_match(KW_ERROR)))
		return NULL;

	return par_on_error();
}


//____________________________________________________________
//  

//		Parse a trailing ON_ERROR clause.
//  

static act* par_on_error()
{
	if (!cur_statement)
		PAR_error("ON_ERROR used out of context");

	PAR_end();
	act* action = MSC_action(0, ACT_on_error);
	cur_statement->act_error = action;
	action->act_object = (REF) cur_statement;

	MSC_push((GPRE_NOD) action, &cur_error);

	if (cur_statement->act_pair)
		cur_statement->act_pair->act_error = action;

	return action;
}


//____________________________________________________________
//  
//		Parse an "open blob" type statement.  These include OPEN_BLOB,
//		CREATE_BLOB, and blob FOR.
//  

static act* par_open_blob( ACT_T act_op, gpre_sym* symbol)
{
//  If somebody hasn't already parsed up a symbol for us, parse the
//  symbol and the mandatory IN now. 

	if (!symbol) {
		symbol = PAR_symbol(SYM_dummy);
		if (!MSC_match(KW_IN))
			CPR_s_error("IN");
	}

//  The next thing we should find is a field reference.  Get it. 
	gpre_ctx* context;
	gpre_fld* field = EXP_field(&context);
	if (!field)
		return NULL;

	TEXT s[ERROR_LENGTH];
	if (!(field->fld_flags & FLD_blob)) {
		fb_utils::snprintf(s, sizeof(s),
			"Field %s is not a blob", field->fld_symbol->sym_string);
		PAR_error(s);
	}

	if (field->fld_array_info) {
		fb_utils::snprintf(s, sizeof(s),
				"Field %s is an array and can not be opened as a blob",
				field->fld_symbol->sym_string);
		PAR_error(s);
	}

	gpre_req* request = context->ctx_request;
	ref* reference = EXP_post_field(field, context, false);

	blb* blob = (blb*) MSC_alloc(BLB_LEN);
	blob->blb_symbol = symbol;
	blob->blb_reference = reference;

//   See if we need a blob filter (do we have a subtype to subtype clause?)  

	bool filter_is_defined = false;
	for (;;)
		if (MSC_match(KW_FILTER)) {
			blob->blb_const_from_type = (MSC_match(KW_FROM)) ?
				PAR_blob_subtype(request->req_database) : field->fld_sub_type;
			if (!MSC_match(KW_TO))
				CPR_s_error("TO");
			blob->blb_const_to_type = PAR_blob_subtype(request->req_database);
			filter_is_defined = true;
		}
		else if (MSC_match(KW_STREAM))
			blob->blb_type = isc_bpb_type_stream;
		else
			break;

	if (!(blob->blb_seg_length = field->fld_seg_length))
		blob->blb_seg_length = 512;

	blob->blb_request = request;
	blob->blb_next = request->req_blobs;
	request->req_blobs = blob;

	symbol->sym_type = SYM_blob;
	symbol->sym_object = (gpre_ctx*) blob;
	HSH_insert(symbol);
// ** You just inserted the context variable into the hash table.
//The current token however might be the same context variable. 
//If so, get the symbol for it.
//*  
	if (gpreGlob.token_global.tok_keyword == KW_none)
		gpreGlob.token_global.tok_symbol = HSH_lookup(gpreGlob.token_global.tok_string);

	act* action = MSC_action(request, act_op);
	action->act_object = (REF) blob;

	if (act_op == ACT_blob_for)
		MSC_push((GPRE_NOD) action, &cur_for);

//   Need to eat the semicolon if present  

	if (gpreGlob.sw_language == lang_c)
		MSC_match(KW_SEMI_COLON);
	else
		PAR_end();

	return action;
}


//____________________________________________________________
//  
//		Parse request options.  Return true if successful, otherwise
//		false.  If a flag is set, don't give an error on false.
//  

static bool par_options(gpre_req* request,
						bool flag)
{
	if (!MSC_match(KW_LEFT_PAREN))
		return true;

	while (true) {
		if (MSC_match(KW_RIGHT_PAREN))
			return true;
		if (MSC_match(KW_REQUEST_HANDLE)) {
			request->req_handle = PAR_native_value(false, true);
			request->req_flags |= REQ_exp_hand;
		}
		else if (MSC_match(KW_TRANSACTION_HANDLE))
			request->req_trans = PAR_native_value(false, true);
		else if (MSC_match(KW_LEVEL))
			request->req_request_level = PAR_native_value(false, false);
		else {
			if (!flag)
				CPR_s_error("request option");
			return false;
		}
		MSC_match(KW_COMMA);
	}
}


//____________________________________________________________
//  
//		If this is PLI, then we've got a new procedure.
//  
//		If this is PASCAL, then we've come upon
//		a program, module, function, or procedure header.  
//		Alas and alack, we have to decide if this is
//		a real header or a forward/external declaration.
//  
//		In either case, we make a mark-only action block,
//		because that's real cheap.  If it's a real routine,
//		we make the action the current routine.
//  

static act* par_procedure()
{
	act* action;

	if (gpreGlob.sw_language == lang_pascal) {
		routine_decl = true;
		action = scan_routine_header();
		if (!(action->act_flags & ACT_decl)) {
			MSC_push((GPRE_NOD) gpreGlob.cur_routine, &routine_stack);
			gpreGlob.cur_routine = action;
		}
	}
	else
		action = NULL;
	return action;
}


//____________________________________________________________
//  
//		Parse a READY statement.
//  

static act* par_ready()
{
	gpre_req* request;
	gpre_sym* symbol;
	DBB db;
	bool need_handle = false;
	USHORT default_buffers = 0;

	act* action = MSC_action(0, ACT_ready);

	if (gpreGlob.token_global.tok_keyword == KW_CACHE)
		CPR_s_error("database name or handle");

	while (!terminator()) {
		/* this default mechanism is left here for backwards 
		   compatibility, but it is no longer documented and
		   is not something we should maintain for all ready 
		   options since it needlessly complicates the ready
		   statement without providing any extra functionality */

		if (MSC_match(KW_DEFAULT)) {
			if (!MSC_match(KW_CACHE))
				CPR_s_error("database name or handle");
			default_buffers = atoi(gpreGlob.token_global.tok_string);
			CPR_eol_token();
			MSC_match(KW_BUFFERS);
			continue;
		}

		rdy* ready = (rdy*) MSC_alloc(RDY_LEN);
		ready->rdy_next = (rdy*) action->act_object;
		action->act_object = (REF) ready;

		if (!(symbol = gpreGlob.token_global.tok_symbol) || symbol->sym_type != SYM_database) {
			ready->rdy_filename = PAR_native_value(false, false);
			if (MSC_match(KW_AS))
				need_handle = true;
		}

		if (!(symbol = gpreGlob.token_global.tok_symbol) || symbol->sym_type != SYM_database) {
			if (!gpreGlob.isc_databases || gpreGlob.isc_databases->dbb_next || need_handle) {
				need_handle = false;
				CPR_s_error("database handle");
			}
			ready->rdy_database = gpreGlob.isc_databases;
		}

		need_handle = false;
		if (!ready->rdy_database)
			ready->rdy_database = (DBB) symbol->sym_object;
		if (terminator())
			break;
		CPR_eol_token();

		// pick up the possible parameters, in any order 

		USHORT buffers = 0;
		db = ready->rdy_database;
		for (;;) {
			if (MSC_match(KW_CACHE)) {
				buffers = atoi(gpreGlob.token_global.tok_string);
				CPR_eol_token();
				MSC_match(KW_BUFFERS);
			}
			else if (MSC_match(KW_USER))
				db->dbb_r_user = PAR_native_value(false, false);
			else if (MSC_match(KW_PASSWORD))
				db->dbb_r_password = PAR_native_value(false, false);
			else if (MSC_match(KW_LC_MESSAGES))
				db->dbb_r_lc_messages = PAR_native_value(false, false);
			else if (MSC_match(KW_LC_CTYPE)) {
				db->dbb_r_lc_ctype = PAR_native_value(false, false);
				db->dbb_know_subtype = 2;
			}
			else
				break;
		}

		request = NULL;
		if (buffers)
			request = PAR_set_up_dpb_info(ready, action, buffers);

		/* if there are any options that take host variables as arguments, 
		   make sure that we generate variables for the request so that the 
		   dpb can be extended at runtime */

		if (db->dbb_r_user || db->dbb_r_password ||
			db->dbb_r_lc_messages || db->dbb_r_lc_ctype)
		{
			if (!request)
				request = PAR_set_up_dpb_info(ready, action, default_buffers);
			request->req_flags |= REQ_extend_dpb;
		}

		/* ...and if there are compile time user or password specified,
		   make sure there will be a dpb generated for them */

		if (!request && (db->dbb_c_user || db->dbb_c_password ||
						 db->dbb_c_lc_messages || db->dbb_c_lc_ctype))
		{
			request = PAR_set_up_dpb_info(ready, action, default_buffers);
		}

		MSC_match(KW_COMMA);
	}

	PAR_end();

	if (action->act_object) {
		if (default_buffers)
			for (rdy* ready = (rdy*) action->act_object; ready;
				 ready = ready->rdy_next)
			{
				if (!ready->rdy_request)
					request = PAR_set_up_dpb_info(ready, action, default_buffers);
			}
		return action;
	}

//  No explicit databases -- pick up all known 

	for (db = gpreGlob.isc_databases; db; db = db->dbb_next)
		if (db->dbb_runtime || !(db->dbb_flags & DBB_sqlca)) {
			rdy* ready = (rdy*) MSC_alloc(RDY_LEN);
			ready->rdy_next = (rdy*) action->act_object;
			action->act_object = (REF) ready;
			ready->rdy_database = db;
		}

	if (!action->act_object)
		PAR_error("no database available to READY");
	else
		for (rdy* ready = (rdy*) action->act_object; ready; ready = ready->rdy_next) {
			request = ready->rdy_request;
			if (default_buffers && !ready->rdy_request)
				request = PAR_set_up_dpb_info(ready, action, default_buffers);

			/* if there are any options that take host variables as arguments, 
			   make sure that we generate variables for the request so that the 
			   dpb can be extended at runtime */

			db = ready->rdy_database;
			if (db->dbb_r_user || db->dbb_r_password ||
				db->dbb_r_lc_messages || db->dbb_r_lc_ctype) 
			{
				if (!request)
					request = PAR_set_up_dpb_info(ready, action, default_buffers);
				request->req_flags |= REQ_extend_dpb;
			}

			/* ...and if there are compile time user or password specified,
			   make sure there will be a dpb generated for them */

			if (!request && (db->dbb_c_user || db->dbb_c_password ||
							 db->dbb_c_lc_messages || db->dbb_c_lc_ctype))
			{
				request = PAR_set_up_dpb_info(ready, action, default_buffers);
			}
		}

	return action;
}


//____________________________________________________________
//  
//		Parse a returning values clause in a STORE
//		returning an action. 
//		Act as if we were at end_store, then set up
//		for a further set of fields for returned values.
//  

static act* par_returning_values()
{

	REF reference;

	if (!cur_store)
		PAR_error("STORE must precede RETURNING_VALUES");

	act* begin_action = (act*) MSC_pop(&cur_store);
	gpre_req* request = begin_action->act_request;

//  First take care of the impending store:
//  Make up an assignment list for all field references  and
//  clone the references while we are at it 

	int count = 0;
	for (reference = request->req_references; reference;
		 reference = reference->ref_next)
	{
		if (!reference->ref_master)
			count++;
	}

	GPRE_NOD assignments = MSC_node(nod_list, (SSHORT) count);
	request->req_node = assignments;
	count = 0;

	for (reference = request->req_references; reference;
		 reference = reference->ref_next)
	{
		REF save_ref = MSC_reference(&begin_action->act_object);
		save_ref->ref_context = reference->ref_context;
		save_ref->ref_field = reference->ref_field;
		save_ref->ref_source = reference;
		save_ref->ref_flags = reference->ref_flags;

		if (reference->ref_master)
			continue;
		GPRE_NOD item = MSC_node(nod_assignment, 2);
		item->nod_arg[0] = MSC_unary(nod_value, (GPRE_NOD) save_ref);
		item->nod_arg[1] = MSC_unary(nod_field, (GPRE_NOD) save_ref);
		assignments->nod_arg[count++] = item;
	}

//  Next make an updated context for post_store actions 

	upd* new_values = (upd*) MSC_alloc(UPD_LEN);
	gpre_ctx* source = request->req_contexts;
	request->req_type = REQ_store2;

	gpre_ctx* new_ctx = MSC_context(request);
	new_ctx->ctx_symbol = source->ctx_symbol;
	new_ctx->ctx_relation = source->ctx_relation;
	new_ctx->ctx_symbol->sym_object = new_ctx; // pointing to itself?

//  make an update block to hold everything known about referenced
//  fields 

	act* action = MSC_action(request, ACT_store2);
	action->act_object = (REF) new_values;

	new_values->upd_request = request;
	new_values->upd_source = source;
	new_values->upd_update = new_ctx;
	new_values->upd_level = ++request->req_level;

//  both actions go on the cur_store stack, the store topmost 

	MSC_push((GPRE_NOD) action, &cur_store);
	MSC_push((GPRE_NOD) begin_action, &cur_store);
	return action;
}


//____________________________________________________________
//  
//		Do something about a right brace.
//  

static act* par_right_brace()
{
	if (--brace_count < 0)
		brace_count = 0;

	return NULL;
}


//____________________________________________________________
//  
//		Parse a RELEASE_REQUEST statement.
//  

static act* par_release()
{
	act* action = MSC_action(0, ACT_release);

	MSC_match(KW_FOR);

	gpre_sym* symbol = gpreGlob.token_global.tok_symbol;
	if (symbol && (symbol->sym_type == SYM_database)) {
		action->act_object = (REF) symbol->sym_object;
		PAR_get_token();
	}

	PAR_end();

	return action;
}


//____________________________________________________________
//  
//		Handle a GET_SLICE or PUT_SLICE statement.
//  

static act* par_slice( ACT_T type)
{
	gpre_ctx* context;
	gpre_fld* field = EXP_field(&context);

	ary* info = field->fld_array_info;
	if (!info)
		CPR_s_error("array field");

	gpre_req* request = MSC_request(REQ_slice);
	slc* slice = (slc*) MSC_alloc(SLC_LEN(info->ary_dimension_count));
	request->req_slice = slice;
	slice->slc_dimensions = info->ary_dimension_count;
	slice->slc_field = field;
	slice->slc_field_ref = EXP_post_field(field, context, false);
	slice->slc_parent_request = context->ctx_request;

	if (!MSC_match(KW_L_BRCKET))
		CPR_s_error("left bracket");

	USHORT n = 0;
	for (slc::slc_repeat* tail = slice->slc_rpt; ++n <= slice->slc_dimensions;
		++tail)
	{
		tail->slc_lower = tail->slc_upper = EXP_subscript(request);
		if (MSC_match(KW_COLON))
			tail->slc_upper = EXP_subscript(request);
		if (!MSC_match(KW_COMMA))
			break;
	}

	if (n != slice->slc_dimensions)
		PAR_error("subscript count mismatch");

	if (!MSC_match(KW_R_BRCKET))
		CPR_s_error("right bracket");

	if (type == ACT_get_slice) {
		if (!MSC_match(KW_INTO))
			CPR_s_error("INTO");
	}
	else if (!MSC_match(KW_FROM))
		CPR_s_error("FROM");

	slice->slc_array = EXP_subscript(0);

	act* action = MSC_action(request, type);
	action->act_object = (REF) slice;

	if (gpreGlob.sw_language == lang_c)
		MSC_match(KW_SEMI_COLON);
	else
		PAR_end();

	return action;
}


//____________________________________________________________
//  
//		Parse a STORE clause, returning an action.
//  

static act* par_store()
{
	gpre_req* request = MSC_request(REQ_store);
	par_options(request, false);
	act* action = MSC_action(request, ACT_store);
	MSC_push((GPRE_NOD) action, &cur_store);

	gpre_ctx* context = EXP_context(request, 0);
	gpre_rel* relation = context->ctx_relation;
	request->req_database = relation->rel_database;
	HSH_insert(context->ctx_symbol);
// ** You just inserted the context variable into the hash table.
//The current token however might be the same context variable. 
//If so, get the symbol for it.
//*  
	if (gpreGlob.token_global.tok_keyword == KW_none)
		gpreGlob.token_global.tok_symbol = HSH_lookup(gpreGlob.token_global.tok_string);
	MSC_match(KW_USING);

	return action;
}


//____________________________________________________________
//  
//		Parse a start stream statement.
//  

static act* par_start_stream()
{
	gpre_req* request = MSC_request(REQ_cursor);
	par_options(request, false);
	act* action = MSC_action(request, ACT_s_start);

	gpre_sym* cursor = PAR_symbol(SYM_dummy);
	cursor->sym_type = SYM_stream;
	cursor->sym_object = (gpre_ctx*) request;

	MSC_match(KW_USING);
	gpre_rse* rec_expr = EXP_rse(request, 0);
	request->req_rse = rec_expr;
	gpre_ctx* context = rec_expr->rse_context[0];
	gpre_rel* relation = context->ctx_relation;
	request->req_database = relation->rel_database;

	gpre_ctx** ptr = rec_expr->rse_context;
	for (const gpre_ctx* const* const end = ptr + rec_expr->rse_count;
		 ptr < end; ptr++)
	{
		context = *ptr;
		context->ctx_next = request->req_contexts;
		request->req_contexts = context;
	}

	HSH_insert(cursor);
	PAR_end();

	return action;
}


//____________________________________________________________
//  
//		Parse a START_TRANSACTION statement, including
//  	transaction handle, transaction options, and
//		reserving list.
//  

static act* par_start_transaction()
{
	act* action = MSC_action(0, ACT_start);

	if (terminator()) {
		PAR_end();
		return action;
	}

	gpre_tra* trans = (gpre_tra*) MSC_alloc(TRA_LEN);

//  get the transaction handle  

	if (!gpreGlob.token_global.tok_symbol)
		trans->tra_handle = PAR_native_value(false, true);

//  loop reading the various transaction options 

	while (!(gpreGlob.token_global.tok_keyword == KW_RESERVING) && !(gpreGlob.token_global.tok_keyword == KW_USING) && 
		!terminator()) 
	{
		if (MSC_match(KW_READ_ONLY)) {
			trans->tra_flags |= TRA_ro;
			continue;
		}
		else if (MSC_match(KW_READ_WRITE))
			continue;

		if (MSC_match(KW_CONSISTENCY)) {
			trans->tra_flags |= TRA_con;
			continue;
		}
// ***    else if (MSC_match (KW_READ_COMMITTED))
// { 
// trans->tra_flags |= TRA_read_committed;
// continue;
// } **
		else if (MSC_match(KW_CONCURRENCY))
			continue;

		if (MSC_match(KW_NO_WAIT)) {
			trans->tra_flags |= TRA_nw;
			continue;
		}
		else if (MSC_match(KW_WAIT))
			continue;

		if (MSC_match(KW_AUTOCOMMIT)) {
			trans->tra_flags |= TRA_autocommit;
			continue;
		}

		if (gpreGlob.sw_language == lang_cobol || gpreGlob.sw_language == lang_fortran)
			break;
		else
			CPR_s_error("transaction keyword");
	}

//  send out for the list of reserved relations 

	if (MSC_match(KW_RESERVING)) {
		trans->tra_flags |= TRA_rrl;
		PAR_reserving(trans->tra_flags, false);
	}
	else if (MSC_match(KW_USING)) {
		trans->tra_flags |= TRA_inc;
		PAR_using_db();
	}

	PAR_end();
	CMP_t_start(trans);
	action->act_object = (REF) trans;

	return action;
}


//____________________________________________________________
//  
//		We have hit either a function or subroutine declaration.
//		If the language is fortran, make the position with a break.
//  

static act* par_subroutine()
{
	if (gpreGlob.sw_language != lang_fortran)
		return NULL;

	act* action = MSC_action(0, ACT_routine);
	action->act_flags |= ACT_mark | ACT_break;
	gpreGlob.cur_routine = action;
	return action;
}


//____________________________________________________________
//  
//		Parse a transaction termination statement: commit,
//		prepare, rollback, or save (commit retaining context).
//  

static act* par_trans( ACT_T act_op)
{
	act* action = MSC_action(0, act_op);

	if (!terminator()) {
		const bool parens = MSC_match(KW_LEFT_PAREN);
		if ((gpreGlob.sw_language == lang_fortran)
			&& (act_op == ACT_commit_retain_context))
		{
			if (!(MSC_match(KW_TRANSACTION_HANDLE)))
				return NULL;
		}
		else
			MSC_match(KW_TRANSACTION_HANDLE);
		action->act_object = (REF) PAR_native_value(false, true);
		if (parens)
			EXP_match_paren();
	}

	if ((gpreGlob.sw_language != lang_fortran) && (gpreGlob.sw_language != lang_pascal))
		MSC_match(KW_SEMI_COLON);

	return action;
}


//____________________________________________________________
//  
//		Parse something of the form:
//  
//			<relation> . <field> . <something>
//  
//		where <something> is currently an enumerated type.
//  

static act* par_type()
{
//  Pick up relation

// ***
//gpre_sym*	symbol;
//symbol = gpreGlob.token_global.tok_symbol;
//relation = (gpre_rel*) symbol->sym_object;
//PAR_get_token();
//** 

	gpre_rel* relation = EXP_relation();

//  No dot and we give up 

	if (!MSC_match(KW_DOT))
		return NULL;

//  Look for field name.  No field name, punt

	SQL_resolve_identifier("<Field Name>", NULL, NAME_SIZE);
	gpre_fld* field = MET_field(relation, gpreGlob.token_global.tok_string);
	if (!field)
		return NULL;

	PAR_get_token();

	if (!MSC_match(KW_DOT))
		CPR_s_error("period");

//  Lookup type.  If we can't find it, complain bitterly 

	SSHORT type;
	if (!MET_type(field, gpreGlob.token_global.tok_string, &type)) {
		TEXT s[ERROR_LENGTH];
		fb_utils::snprintf(s, sizeof(s),
			 "undefined type %s", gpreGlob.token_global.tok_string);
		PAR_error(s);
	}

	PAR_get_token();
	act* action = MSC_action(0, ACT_type_number);
	action->act_object = (REF) (IPTR) type;

	return action;
}

//____________________________________________________________
//  
//		Parse a free reference to a database field in general
//		program context.
//  

static act* par_variable()
{
//
//  Since fortran is fussy about continuations and the like,
//  see if this variable token is the first thing in a statement.
//  

	const USHORT first = gpreGlob.token_global.tok_first;
	gpre_ctx* context;
	gpre_fld* field = EXP_field(&context);

	gpre_fld* cast;
	bool dot = MSC_match(KW_DOT);
	if (dot && (cast = EXP_cast(field))) {
		field = cast;
		dot = MSC_match(KW_DOT);
	}

	bool is_null = false;
	if (dot && MSC_match(KW_NULL)) {
		is_null = true;
		dot = false;
	}

	gpre_req* request = context->ctx_request;
	ref* reference = EXP_post_field(field, context, is_null);

	if (field->fld_array)
		EXP_post_array(reference);

	act* action = MSC_action(request, ACT_variable);

	if (first)
		action->act_flags |= ACT_first;
	if (dot)
		action->act_flags |= ACT_back_token;

	action->act_object = reference;

	if (!is_null)
		return action;

//  We've got a explicit null flag referernce rather than a field
//  reference.  If there's already a null reference for the field,
//  use it; otherwise make one up. 

	if (reference->ref_null) {
		action->act_object = reference->ref_null;
		return action;
	}

//  Check to see if the flag field has been allocated.  If not, sigh, allocate it 

	ref* flag = MSC_reference(&request->req_references);
	flag->ref_context = reference->ref_context;
	flag->ref_field = PAR_null_field();
	flag->ref_level = request->req_level;

	flag->ref_master = reference;
	reference->ref_null = flag;

	action->act_object = flag;

	return action;
}


//____________________________________________________________
//  
//		This is PASCAL, and we've got a function, or procedure header.  
//		Alas and alack, we have to decide if this is a real header or 
//		a forward/external declaration.
//  
//		Basically we scan the thing, skipping parenthesized bits,
//		looking for a semi-colon.  We look at the next token, which may
//		be OPTIONS followed by a parenthesized list of options, or it
//		may be just some options, or it may be nothing.  If the options
//		are EXTERN or FORWARD, we've got a reference, otherwise its a real
//		routine (or possibly program or module). 
//  
//		Fortunately all of these are of the form:
//			<keyword> <name> [( blah, blah )] [: type] ; [<options>;] 
//  
//  

static act* scan_routine_header()
{
	act* action = MSC_action(0, ACT_routine);
	action->act_flags |= ACT_mark;

	while (!(MSC_match(KW_SEMI_COLON)))
		if (!(match_parentheses()))
			PAR_get_token();

	if (MSC_match(KW_OPTIONS) && MSC_match(KW_LEFT_PAREN)) {
		while (!(MSC_match(KW_RIGHT_PAREN))) {
			if (MSC_match(KW_EXTERN) || MSC_match(KW_FORWARD))
				action->act_flags |= ACT_decl;
			else
				PAR_get_token();
		}
		MSC_match(KW_SEMI_COLON);
	}
	else
		for (;;) {
			if (MSC_match(KW_EXTERN) || MSC_match(KW_FORWARD)) {
				action->act_flags |= ACT_decl;
				MSC_match(KW_SEMI_COLON);
			}
			else if (MSC_match(KW_INTERNAL) || MSC_match(KW_ABNORMAL) ||
					 MSC_match(KW_VARIABLE) || MSC_match(KW_VAL_PARAM))
			{
				MSC_match(KW_SEMI_COLON);
			}
			else
				break;
		}

	return action;
}


//____________________________________________________________
//  
//		If this is a external declaration in
//		a BASIC program, set a flag to indicate
//		the situation.
//  

static void set_external_flag()
{
	CPR_token();
}


//____________________________________________________________
//  
//		Check the current token for a logical terminator.  Terminators
//		are semi-colon, ELSE, or ON_ERROR.
//  

static bool terminator()
{

//  For C, changed keyword (KW_SEMICOLON) to MSC_match (KW_SEMICOLON) to eat a
//  semicolon if it is present so as to allow it to be there or not be there.
//  Bug#833.  mao 6/21/89 

//  For C, right brace ("}") must also be a terminator. 

	if (gpreGlob.sw_language == lang_c) {
		if (MSC_match(KW_SEMI_COLON) || gpreGlob.token_global.tok_keyword == KW_ELSE ||
			gpreGlob.token_global.tok_keyword == KW_ON_ERROR || gpreGlob.token_global.tok_keyword == KW_R_BRACE)
		{
			return true;
		}
	}
	else if (gpreGlob.sw_language == lang_ada) {
		if (MSC_match(KW_SEMI_COLON) || gpreGlob.token_global.tok_keyword == KW_ELSE || 
			gpreGlob.token_global.tok_keyword == KW_ON_ERROR)
		{
			return true;
		}
	}
	else {
		if (gpreGlob.token_global.tok_keyword == KW_SEMI_COLON || gpreGlob.token_global.tok_keyword == KW_ELSE ||
			gpreGlob.token_global.tok_keyword == KW_ON_ERROR ||
			(gpreGlob.sw_language == lang_cobol && gpreGlob.token_global.tok_keyword == KW_DOT))
		{
			return true;
		}
	}

	return false;
}