firebird/firebird-mirror
firebird/firebird-mirror
8
0
Fork 1
mirror of https://github.com/FirebirdSQL/firebird.git synced 2025-01-26 07:23:08 +01:00
Code Issues
7d47e6217d
firebird-mirror/src/gpre/par.cpp
asfernandes 5dda9c1677 Misc
2009-06-27 03:03:56 +00:00

3339 lines
80 KiB
C++
Raw Blame History

//____________________________________________________________
//
// 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 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;
}
View Git Blame Copy Permalink