Logo Search packages:      
Sourcecode: firebird3.0 version File versions  Download package

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++
//  SWB (Stepen Boyd) 2007/03/21 - Supressed parsing of QLI keywords if -noqli
//                                 switch given on the command line.
//
//
//____________________________________________________________
//
//

#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"

#ifdef FTN_BLK_DATA
static void       block_data_list(const gpre_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 int        namespace_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)
{
      gpre_sym* symbol = gpreGlob.token_global.tok_symbol;

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

      if (gpreGlob.token_global.tok_keyword >= KW_start_actions &&
            gpreGlob.token_global.tok_keyword <= KW_end_actions)
      {
            const kwwords_t keyword = gpreGlob.token_global.tok_keyword;
            if (! gpreGlob.sw_no_qli)
            {
                  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();
                  }
            }
            else
                  CPR_token();

            try {

                  if (! gpreGlob.sw_no_qli)
                  {
                        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_NAMESPACE:
                              if (gpreGlob.sw_language == lang_internal || gpreGlob.sw_language == lang_cxx ||
                                    gpreGlob.sw_language == lang_cplusplus)
                              {
                                    if (CPR_token())
                                    {
                                          if (gpreGlob.token_global.tok_keyword == KW_L_BRACE)
                                          {
                                                CPR_token();
                                                ++namespace_count;
                                                ++brace_count;
                                                return NULL;
                                          }
                                    }
                              }
                              break;

                        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;
                        }
                  }
                  else
                  {
                        switch (keyword)
                        {
                        case KW_BASED:
                              return par_based();

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

      if (! gpreGlob.sw_no_qli)
      {
            for (; symbol; symbol = symbol->sym_homonym)
            {
                  switch (symbol->sym_type)
                  {
                  case SYM_context:
                        try {
                              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 Firebird::Exception&) {
                              return 0;
                        }
                  case SYM_blob:
                        try {
                              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 Firebird::Exception&) {
                              return 0;
                        }
                  case SYM_relation:
                        try {
                              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 Firebird::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(gpre_dbb* db)
{
      // Check for symbol type name

      if (gpreGlob.token_global.tok_type == tok_ident)
      {
            gpre_fld* field = NULL;
            gpre_rel* relation = MET_get_relation(db, "RDB$FIELDS", "");
            if (!relation || !(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);
      gpre_dbb* db = (gpre_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");

            tok& token = gpreGlob.token_global;

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

#ifdef GPRE_ADA
      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();
      }
#endif

      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::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 (gpre_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))
#ifdef GPRE_COBOL
             ||
            (gpreGlob.sw_language == lang_cobol && isAnsiCobol(gpreGlob.sw_cob_dialect))
#endif
            )
      {
            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
//

void 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;
      namespace_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 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);
            }
            kwwords_t keyword = gpreGlob.token_global.tok_keyword;
            if (keyword == KW_LEFT_PAREN)
            {
                  int parens = 1;
                  while (parens)
                  {
                        const 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;
            }

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

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

      const unsigned int length = string - buffer;
      fb_assert(length < sizeof(buffer));
      string = (SCHAR*) MSC_alloc(length + 1);

      if (length)
            memcpy(string, buffer, length); // MSC_alloc filled the string with zeroes.

      return string;
}


//____________________________________________________________
//
//          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)
{
      gpre_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(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 Firebird::LongJump();
}


//____________________________________________________________
//
//          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)
            {
                  gpre_dbb* db = (gpre_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 gpre_dbb* db)
{
      if (db->dbb_scope == DBB_EXTERN)
            return;

      const TEXT* name = db->dbb_name->sym_string;
      const 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->dbd_name))
                              return;
                  }
            }

      if (gpreGlob.global_db_count >= MAX_DATABASES)
            return;

      strcpy(list->dbd_name, name); // safe while dbd_name is defined bigger than dbb_name->sym_string
      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;
      }

      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");
      return NULL; // make the compiler happy.

      /*
      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)
            {
                  switch (field->fld_dtype)
                  {
                  case dtype_sql_date:
                  case dtype_sql_time:
                  case dtype_int64:
                        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);
                  }
                  // this flag is to solve KW_DOT problem in COBOL. Should be false for all other lang
                  if (!notSegment)
                        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 bool first = gpreGlob.token_global.tok_first;

      blb* blob = par_blob();

      act_t type = ACT_blob_handle;
      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");
      }

      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)
{
      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 (ref* 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 (ref* 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 (ref* 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 = (gpre_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;

      tok& token = gpreGlob.token_global;

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

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

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

            const gpre_sym* temp = token.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++ - namespace_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;
      gpre_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 = (gpre_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()
{
      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 (ref* 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 (ref* 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;

      if (brace_count <= 0)
      {
            if (--namespace_count < 0)
                  namespace_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;
            }
            if (MSC_match(KW_READ_WRITE))
                  continue;

            if (MSC_match(KW_CONSISTENCY))
            {
                  trans->tra_flags |= TRA_con;
                  continue;
            }

            //if (MSC_match (KW_READ_COMMITTED))
            //{
            //    trans->tra_flags |= TRA_read_committed;
            //    continue;
            //}

            if (MSC_match(KW_CONCURRENCY))
                  continue;

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

            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;

            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 bool 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 reference 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.

      // Used reference here because MSC_match() can change tok_leyword.
      kwwords_t& key = gpreGlob.token_global.tok_keyword;

      switch (gpreGlob.sw_language)
      {
      case lang_c:
            if (MSC_match(KW_SEMI_COLON) || key == KW_ELSE || key == KW_ON_ERROR || key == KW_R_BRACE)
            {
                  return true;
            }
            break;
      case lang_ada:
            if (MSC_match(KW_SEMI_COLON) || key == KW_ELSE || key == KW_ON_ERROR)
            {
                  return true;
            }
            break;
      default:
            if (key == KW_SEMI_COLON || key == KW_ELSE || key == KW_ON_ERROR ||
                  (gpreGlob.sw_language == lang_cobol && key == KW_DOT))
            {
                  return true;
            }
      }

      return false;
}


Generated by  Doxygen 1.6.0   Back to index