8
0
mirror of https://github.com/FirebirdSQL/firebird.git synced 2025-02-01 18:00:40 +01:00
firebird-mirror/src/gpre/gpre.cpp
robocop 669b9c550a Commit GPRE enhancements on behalf of Stephen Boyd.
This batch of changes includes:
- Support for FIRST/SKIP clauses
- Support for CURRENT_CONNECTION, CURRENT_ROLE, CURRENT_TRANSACTION and CURRENT_USER context variables
- Changed the BLR generated for RM/Cobol programs to use blr_cstring
rather than blr_text so that CHAR and VARCHAR fields are not written
as "fixed length" fields from Cobol programs.  Incoming CHAR and
VARCHAR fields are right filled with spaces inbound to the Cobol
program and stripped of trailing spaces outbound.
2007-07-29 07:30:42 +00:00

2966 lines
72 KiB
C++

//____________________________________________________________
//
// PROGRAM: Preprocessor
// MODULE: gpre.cpp
// DESCRIPTION: Main line routine
//
// 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/16 15:54:29 fsg
// Added new switch -verbose to gpre that will dump
// parsed lines to stderr
//
// Fixed gpre bug in handling row names in WHERE clauses
// that are reserved words now (DATE etc)
// (this caused gpre to dump core when parsing tan.e)
//
// Fixed gpre bug in handling lower case table aliases
// in WHERE clauses for sql dialect 2 and 3.
// (cause a core dump in a test case from C.R. Zamana)
//
// TMN (Mike Nordell) 11.APR.2001 - Reduce compiler warnings
//
// FSG (Frank Schlottmann-Gödde) 8.Mar.2002 - tiny cobol support
// fixed Bug No. 526204
//
// 2002.10.30 Sean Leyne - Removed support for obsolete "PC_PLATFORM" define
//
// Added support for RM/Cobol
// Stephen W. Boyd 31.Aug.2006
//
// Added -noqli switch to suppress parsing of QLI keywords. This was
// causing problems with Cobol programs since the QLI and Cobol reserved word
// lists intersect.
// Stephen W. Boyd 21.Mar.2007
//____________________________________________________________
//
//
#include "firebird.h"
#include <stdlib.h>
#include <string.h>
#include "../gpre/gpre.h"
#include "../jrd/license.h"
#include "../jrd/intl.h"
#include "../gpre/cmp_proto.h"
#include "../gpre/hsh_proto.h"
#include "../gpre/gpre_proto.h"
#include "../gpre/lang_proto.h"
#include "../gpre/gpre_meta.h"
#include "../gpre/msc_proto.h"
#include "../gpre/par_proto.h"
#include "../gpre/gpreswi.h"
#include "../common/utils_proto.h"
#include "../common/classes/TempFile.h"
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef VMS
#include <descrip.h>
extern "C" {
int lib$get_foreign();
} // extern "C"
#endif
// Globals
GpreGlobals gpreGlob;
const char* const SCRATCH = "fb_query_";
const char* const FOPEN_READ_TYPE = "r";
const char* const FOPEN_WRITE_TYPE = "w";
static bool all_digits(const char*);
static bool arg_is_string(SLONG, TEXT**, const TEXT*);
static SSHORT compare_ASCII7z(const char*, const char*);
static SLONG compile_module(SLONG, const TEXT*);
static bool file_rename(TEXT*, const TEXT*, const TEXT*);
#ifdef GPRE_FORTRAN
static void finish_based(act*);
#endif
static int get_char(FILE*);
static bool get_switches(int, TEXT**, const in_sw_tab_t*, SW_TAB,
TEXT**);
static TOK get_token();
static int nextchar();
static SLONG pass1(const TEXT*);
static void pass2(SLONG);
static void print_switches();
static void remember_label(const TEXT*);
//static FILE* reposition_file(FILE *, SLONG);
static void return_char(SSHORT);
static SSHORT skip_white();
// Program wide globals
static FILE* input_file;
static FILE* trace_file;
static const TEXT* file_name;
static TEXT* out_file_name;
static SLONG position;
static SLONG last_position;
static SLONG line_position;
static SLONG first_position;
static SLONG prior_line_position;
static act* global_last_action;
static act* global_first_action;
static UCHAR classes_array[256];
inline UCHAR classes(int idx)
{
return classes_array[(UCHAR) idx];
}
inline UCHAR classes(UCHAR idx)
{
return classes_array[idx];
}
inline void set_classes(int idx, UCHAR v)
{
classes_array[(UCHAR) idx] = v;
}
inline void set_classes(UCHAR idx, UCHAR v)
{
classes_array[idx] = v;
}
static TEXT input_buffer[512], *input_char;
static DBB sw_databases;
// Added sw_verbose
// FSG 14.Nov.2000
static bool sw_verbose;
static bool sw_standard_out;
static bool sw_first;
static bool sw_lines;
static bool sw_trace;
static bool sw_alsys;
static int line_global;
static int warnings_global;
static int fatals_global;
//static jmp_buf fatal_env;
static const TEXT *comment_start, *comment_stop;
typedef void (*pfn_gen_routine) (const act*, int);
static pfn_gen_routine gen_routine;
static TEXT trace_file_name[MAXPATHLEN];
static SLONG traced_position = 0;
//___________________________________________________________________
// Test if input language is cpp based.
//
bool isLangCpp(lang_t lang)
{
if (lang == lang_cxx || lang == lang_internal) {
return true;
}
return false;
}
// Test if input language is an ANSI-85 Cobol variant
bool isAnsiCobol(cob_t dialect)
{
return (dialect == cob_ansi) || (dialect == cob_rmc);
}
/*
* Type and table definition for the extension tables. Tells GPRE
* the default extensions for DML and host languages.
*/
struct ext_table_t
{
lang_t ext_language;
gpre_cmd_switch ext_in_sw;
const TEXT* in;
const TEXT* out;
};
static const ext_table_t dml_ext_table[] =
{
{ lang_c, IN_SW_GPRE_C, ".e", ".c" },
#ifndef VMS
#ifndef WIN_NT
{ lang_scxx, IN_SW_GPRE_SCXX, ".E", ".C" },
#endif
#endif
{ lang_cxx, IN_SW_GPRE_CXX, ".exx", ".cxx" },
{ lang_cpp, IN_SW_GPRE_CXX, ".epp", ".cpp" },
{ lang_internal, IN_SW_GPRE_G, ".e", ".c" },
{ lang_internal_cxx, IN_SW_GPRE_0, ".epp", ".cpp" },
{ lang_pascal, IN_SW_GPRE_P, ".epas", ".pas" },
#ifdef GPRE_FORTRAN
#ifdef VMS
{ lang_fortran, IN_SW_GPRE_F, ".efor", ".for" },
#else
{ lang_fortran, IN_SW_GPRE_F, ".ef", ".f" },
#endif
#endif // GPRE_FORTRAN
#ifdef GPRE_COBOL
#ifdef VMS
{ lang_cobol, IN_SW_GPRE_COB, ".ecob", ".cob" },
#else
{ lang_cobol, IN_SW_GPRE_COB, ".ecbl", ".cbl" },
#endif
#endif // GPRE_COBOL
#ifdef GPRE_ADA
#ifdef VMS
{ lang_ada, IN_SW_GPRE_ADA, ".eada", ".ada" },
#elif defined(hpux)
{ lang_ada, IN_SW_GPRE_ADA, ".eada", ".ada" },
#else
{ lang_ada, IN_SW_GPRE_ADA, ".ea", ".a" },
#endif
#ifdef ALSYS_ADA
{ lang_ada, IN_SW_GPRE_ALSYS, ".eada", ".ada" },
#endif
#endif // GPRE_ADA
#if (defined( WIN_NT))
{ lang_cplusplus, IN_SW_GPRE_CPLUSPLUS, ".epp", ".cpp" },
#else
{ lang_cplusplus, IN_SW_GPRE_CPLUSPLUS, ".exx", ".cxx" },
#endif
{ lang_undef, IN_SW_GPRE_0, NULL, NULL }
};
const UCHAR CHR_LETTER = 1;
const UCHAR CHR_DIGIT = 2;
const UCHAR CHR_IDENT = 4;
const UCHAR CHR_QUOTE = 8;
const UCHAR CHR_WHITE = 16;
const UCHAR CHR_INTRODUCER = 32;
const UCHAR CHR_DBLQUOTE = 64;
// macro compares chars; case sensitive for some platforms
#ifdef EITHER_CASE
#define SAME(p, q) UPPER7 (*p) == UPPER7 (*q)
#else
#define SAME(p, q) *p == *q
#endif
//____________________________________________________________
//
// Main line routine for C preprocessor. Initializes
// system, performs pass 1 and pass 2. Interprets
// command line.
//
int main(int argc, char* argv[])
{
gpre_sym* symbol;
const ext_table_t* ext_tab;
sw_tab_t sw_table[IN_SW_GPRE_COUNT];
gpreGlob.module_lc_ctype = NULL;
gpreGlob.errors_global = 0;
warnings_global = 0;
fatals_global = 0;
gpreGlob.ADA_create_database = 1;
bool use_lang_internal_gxx_output = false;
strcpy(gpreGlob.ada_package, "");
gpreGlob.ada_flags = 0;
input_char = input_buffer;
#ifdef VMS
argc = VMS_parse(&argv, argc);
#endif
// Initialize character class table
int i;
for (i = 0; i <= 127; ++i) {
set_classes(i, 0);
}
for (i = 128; i <= 255; ++i) {
set_classes(i, CHR_LETTER | CHR_IDENT);
}
for (i = 'a'; i <= 'z'; ++i) {
set_classes(i, CHR_LETTER | CHR_IDENT);
}
for (i = 'A'; i <= 'Z'; ++i) {
set_classes(i, CHR_LETTER | CHR_IDENT);
}
for (i = '0'; i <= '9'; ++i) {
set_classes(i, CHR_DIGIT | CHR_IDENT);
}
set_classes('_', CHR_LETTER | CHR_IDENT | CHR_INTRODUCER);
set_classes('$', CHR_IDENT);
set_classes(' ', CHR_WHITE);
set_classes('\t', CHR_WHITE);
set_classes('\n', CHR_WHITE);
set_classes('\r', CHR_WHITE);
set_classes('\'', CHR_QUOTE);
set_classes('\"', CHR_DBLQUOTE);
set_classes('#', CHR_IDENT);
// zorch 0 through 7 in the fortran label vector
gpreGlob.fortran_labels[0] = 255;
// set switches and so on to default (C) values
DBB db = NULL;
gpreGlob.sw_language = lang_undef;
sw_lines = true;
gpreGlob.sw_auto = true;
gpreGlob.sw_cstring = true;
sw_alsys = false;
gpreGlob.sw_external = false;
sw_standard_out = false;
gpreGlob.sw_cob_dialect = cob_vms;
gpreGlob.sw_cob_dformat = "";
gpreGlob.sw_no_qli = false;
gpreGlob.sw_version = false;
gpreGlob.sw_d_float = false;
gpreGlob.sw_sql_dialect = SQL_DIALECT_V5;
gpreGlob.dialect_specified = false;
gen_routine = C_CXX_action;
comment_start = "/*";
comment_stop = "*/";
gpreGlob.ident_pattern = "gds__%d";
gpreGlob.long_ident_pattern = "gds__%ld";
gpreGlob.transaction_name = "gds__trans";
gpreGlob.database_name = "gds__database";
gpreGlob.utility_name = "gds__utility";
gpreGlob.count_name = "gds__count";
gpreGlob.slack_name = "gds__slack";
gpreGlob.global_db_count = 0;
gpreGlob.default_user = NULL;
gpreGlob.default_password = NULL;
gpreGlob.default_lc_ctype = NULL;
gpreGlob.text_subtypes = NULL;
gpreGlob.override_case = false;
gpreGlob.trusted_auth = false;
gpreGlob.sw_know_interp = FALSE;
gpreGlob.sw_interp = 0;
// FSG 14.Nov.2000
sw_verbose = false;
gpreGlob.sw_sql_dialect = gpreGlob.compiletime_db_dialect = SQL_DIALECT_V5;
//
// Call a subroutine to process the input line
//
TEXT* filename_array[4] = { 0, 0, 0, 0 };
if (!get_switches(argc, argv, gpre_in_sw_table, sw_table, filename_array)) {
CPR_exit(FINI_ERROR);
}
file_name = filename_array[0];
out_file_name = filename_array[1];
const TEXT* db_filename = filename_array[2];
//TEXT* db_base_directory = filename_array[3];
if (!file_name) {
fprintf(stderr, "gpre: no source file named.\n");
CPR_exit(FINI_ERROR);
}
//
// Try to open the input file.
// If the language wasn't supplied, maybe the kind user included a language
// specific extension, and the file name fixer will find it. The file name
// fixer returns FALSE if it can't add an extension, which means there's already
// one of the right type there.
//
TEXT spare_file_name[MAXPATHLEN];
if (gpreGlob.sw_language == lang_undef)
for (ext_tab = dml_ext_table; gpreGlob.sw_language = ext_tab->ext_language;
ext_tab++)
{
strcpy(spare_file_name, file_name);
if (!(file_rename(spare_file_name, ext_tab->in, NULL)))
break;
}
//
// Sigh. No such luck. Maybe there's a file lying around with a plausible
// extension and we can use that.
//
if (gpreGlob.sw_language == lang_undef)
for (ext_tab = dml_ext_table; gpreGlob.sw_language = ext_tab->ext_language;
ext_tab++)
{
strcpy(spare_file_name, file_name);
if (file_rename(spare_file_name, ext_tab->in, NULL) &&
(input_file = fopen(spare_file_name, FOPEN_READ_TYPE)))
{
file_name = spare_file_name;
break;
}
}
//
// Well, if he won't tell me what language it is, or even give me a hint, I'm
// not going to spend all day figuring out what he wants done.
//
if (gpreGlob.sw_language == lang_undef) {
fprintf(stderr,
"gpre: can't find %s with any known extension. Giving up.\n",
file_name);
CPR_exit(FINI_ERROR);
}
//
// Having got here, we know the language, and might even have the file open.
// Better check before reopening it on ourselves. Try the file with the
// extension first (even if we have to add the extension). If we add an
// extension, and find a file with that extension, we make the file name
// point to the expanded file name string in a private buffer.
//
if (!input_file) {
strcpy(spare_file_name, file_name);
for (ext_tab = dml_ext_table;
ext_tab->ext_language != gpreGlob.sw_language;
ext_tab++)
{
; // empty loop body
}
const bool renamed = file_rename(spare_file_name, ext_tab->in, NULL);
if (renamed &&
(input_file = fopen(spare_file_name, FOPEN_READ_TYPE)))
{
file_name = spare_file_name;
}
else if (!(input_file = fopen(file_name, FOPEN_READ_TYPE))) {
if (renamed) {
fprintf(stderr, "gpre: can't open %s or %s\n",
file_name, spare_file_name);
}
else {
fprintf(stderr, "gpre: can't open %s\n", file_name);
}
CPR_exit(FINI_ERROR);
}
}
//
// Now, apply the switches and defaults we've so painfully acquired;
// adding in the language switch in case we inferred it rather than parsing it.
//
const ext_table_t* src_ext_tab = dml_ext_table;
while (src_ext_tab->ext_language != gpreGlob.sw_language) {
++src_ext_tab;
}
sw_table[0].sw_in_sw = src_ext_tab->ext_in_sw;
for (SW_TAB sw_tab = sw_table; sw_tab->sw_in_sw; sw_tab++)
{
switch (sw_tab->sw_in_sw)
{
case IN_SW_GPRE_C:
gpreGlob.sw_language = lang_c;
gpreGlob.ident_pattern = "isc_%d";
gpreGlob.long_ident_pattern = "isc_%ld";
gpreGlob.utility_name = "isc_utility";
gpreGlob.count_name = "isc_count";
gpreGlob.slack_name = "isc_slack";
break;
case IN_SW_GPRE_SCXX:
case IN_SW_GPRE_CXX:
case IN_SW_GPRE_CPLUSPLUS:
gpreGlob.sw_language = lang_cxx;
gpreGlob.ident_pattern = "isc_%d";
gpreGlob.long_ident_pattern = "isc_%ld";
gpreGlob.utility_name = "isc_utility";
gpreGlob.count_name = "isc_count";
gpreGlob.slack_name = "isc_slack";
gpreGlob.transaction_name = "gds_trans";
gpreGlob.database_name = "gds_database";
break;
case IN_SW_GPRE_D:
// allocate database block and link to db chain
db = (DBB) MSC_alloc_permanent(DBB_LEN);
db->dbb_next = gpreGlob.isc_databases;
// put this one in line to be next
gpreGlob.isc_databases = db;
// allocate symbol block
symbol = (gpre_sym*) MSC_alloc_permanent(SYM_LEN);
// make it a database, specifically this one
symbol->sym_type = SYM_database;
symbol->sym_object = (gpre_ctx*) db;
symbol->sym_string = gpreGlob.database_name;
// database block points to the symbol block
db->dbb_name = symbol;
// give it the file name and try to open it
db->dbb_filename = db_filename;
if (!MET_database(db, true))
CPR_exit(FINI_ERROR);
if (gpreGlob.sw_external)
db->dbb_scope = DBB_EXTERN;
#ifdef FTN_BLK_DATA
else {
gpreGlob.global_db_count = 1;
char* dbn = gpreGlob.global_db_list[0].dbb_name;
strncpy(dbn, db->dbb_name->sym_string, dbd::dbb_size);
dbn[dbd::dbb_size - 1] = 0;
}
#endif
break;
case IN_SW_GPRE_E:
gpreGlob.sw_case = true;
break;
case IN_SW_NO_QLI:
gpreGlob.sw_no_qli = true;
break;
#ifndef BOOT_BUILD
#ifdef GPRE_ADA
case IN_SW_GPRE_ADA:
#ifdef VMS
gpreGlob.ada_null_address = "system.address_zero";
#else
gpreGlob.ada_null_address = "0";
#endif
gpreGlob.sw_case = true;
gpreGlob.sw_language = lang_ada;
sw_lines = false;
gpreGlob.sw_cstring = false;
gen_routine = ADA_action;
gpreGlob.utility_name = "isc_utility";
gpreGlob.count_name = "isc_count";
gpreGlob.slack_name = "isc_slack";
gpreGlob.transaction_name = "gds_trans";
gpreGlob.database_name = "isc_database";
gpreGlob.ident_pattern = "isc_%d";
gpreGlob.long_ident_pattern = "isc_%ld";
comment_start = "--";
if (db)
db->dbb_name->sym_string = "isc_database";
comment_stop = "--";
break;
case IN_SW_GPRE_ALSYS:
sw_alsys = true;
gpreGlob.sw_case = true;
gpreGlob.sw_language = lang_ada;
sw_lines = false;
gpreGlob.sw_cstring = false;
gen_routine = ADA_action;
gpreGlob.utility_name = "isc_utility";
gpreGlob.count_name = "isc_count";
gpreGlob.slack_name = "isc_slack";
gpreGlob.transaction_name = "gds_trans";
gpreGlob.database_name = "isc_database";
gpreGlob.ident_pattern = "isc_%d";
gpreGlob.long_ident_pattern = "isc_%ld";
comment_start = "--";
if (db)
db->dbb_name->sym_string = "isc_database";
comment_stop = "--";
break;
#endif // GPRE_ADA
#ifdef GPRE_FORTRAN
case IN_SW_GPRE_F:
gpreGlob.sw_case = true;
gpreGlob.sw_language = lang_fortran;
sw_lines = false;
gpreGlob.sw_cstring = false;
gen_routine = FTN_action;
#ifdef sun
comment_start = "* ";
#else
comment_start = "C ";
#endif
comment_stop = " ";
// Change the patterns for v4.0
gpreGlob.ident_pattern = "isc_%d";
gpreGlob.long_ident_pattern = "isc_%ld";
gpreGlob.utility_name = "isc_utility";
gpreGlob.count_name = "isc_count";
gpreGlob.slack_name = "isc_slack";
break;
#endif // GPRE_FORTRAN
#ifdef GPRE_COBOL
case IN_SW_GPRE_ANSI:
gpreGlob.sw_cob_dialect = cob_ansi;
break;
case IN_SW_GPRE_RMCOBOL:
gpreGlob.sw_cob_dialect = cob_rmc;
gpreGlob.sw_cstring = true;
gen_routine = RMC_action;
break;
case IN_SW_GPRE_COB:
gpreGlob.sw_case = true;
gpreGlob.sw_language = lang_cobol;
comment_stop = " ";
sw_lines = false;
gpreGlob.sw_cstring = false;
gen_routine = COB_action;
break;
#endif // GPRE_COBOL
#ifdef GPRE_PASCAL
case IN_SW_GPRE_P:
gpreGlob.sw_case = true;
gpreGlob.sw_language = lang_pascal;
sw_lines = false;
gpreGlob.sw_cstring = false;
gen_routine = PAS_action;
comment_start = "(*";
comment_stop = "*)";
break;
#endif // GPRE_PASCAL
#endif // !BOOT_BUILD
case IN_SW_GPRE_D_FLOAT:
gpreGlob.sw_d_float = true;
break;
case IN_SW_GPRE_G:
gpreGlob.sw_language = lang_internal;
gen_routine = INT_CXX_action;
gpreGlob.sw_cstring = false;
gpreGlob.transaction_name = "dbb->dbb_sys_trans";
gpreGlob.sw_know_interp = TRUE;
gpreGlob.sw_interp = ttype_metadata;
break;
case IN_SW_GPRE_GXX:
/* When we get executed here the IN_SW_GPRE_G case
* has already been executed. So we just set the
* gen_routine to point to the C++ action, and be
* done with it.
*/
gen_routine = INT_CXX_action;
use_lang_internal_gxx_output = true;
break;
case IN_SW_GPRE_LANG_INTERNAL:
/* We need to reset all the variables (except gpreGlob.sw_language) to the
* default values because the IN_SW_GPRE_G case was already
* executed in the for the very first switch.
**/
gpreGlob.sw_language = lang_internal;
gen_routine = C_CXX_action;
gpreGlob.sw_cstring = true;
gpreGlob.transaction_name = "gds_trans";
gpreGlob.sw_know_interp = FALSE;
gpreGlob.sw_interp = 0;
gpreGlob.ident_pattern = "isc_%d";
gpreGlob.long_ident_pattern = "isc_%ld";
gpreGlob.utility_name = "isc_utility";
gpreGlob.count_name = "isc_count";
gpreGlob.slack_name = "isc_slack";
gpreGlob.database_name = "gds_database";
break;
case IN_SW_GPRE_I:
gpreGlob.sw_ids = true;
break;
case IN_SW_GPRE_M:
gpreGlob.sw_auto = false;
break;
case IN_SW_GPRE_N:
sw_lines = false;
break;
case IN_SW_GPRE_O:
sw_standard_out = true;
gpreGlob.out_file = stdout;
break;
case IN_SW_GPRE_R:
gpreGlob.sw_raw = true;
break;
case IN_SW_GPRE_S:
gpreGlob.sw_cstring = false;
break;
case IN_SW_GPRE_T:
sw_trace = true;
break;
// FSG 14.Nov.2000
case IN_SW_GPRE_VERBOSE:
sw_verbose = true;
break;
default:
break;
}
} // for (...)
if ((gpreGlob.sw_auto) && (gpreGlob.default_user || gpreGlob.default_password
|| gpreGlob.default_lc_ctype))
{
CPR_warn("gpre: -user, -password and -charset switches require -manual");
}
//
// If one of the C++ variants was used/discovered, convert to C++ for
// further internal use.
//
if (gpreGlob.sw_language == lang_cpp || gpreGlob.sw_language == lang_cplusplus)
gpreGlob.sw_language = lang_cxx;
#ifdef ALSYS_ADA
if (sw_alsys) {
for (src_ext_tab = dml_ext_table;; src_ext_tab++)
if (src_ext_tab->ext_in_sw == IN_SW_GPRE_ALSYS)
break;
}
#endif
#ifdef VMS
//
// If we're on VMS, we may have an RMS sequential file rather than
// a stream file, and keeping track of our place will be harder.
// So... for VMS, copy the input to a stream file.
//
// If this is Alpha OpenVMS, then we also have to do some more
// work, since RMS is a little different...
//
FILE *temp;
TEXT temp_name[MAXPATHLEN];
#ifndef __ALPHA
// Replace this kludge with TempFile since gds__temp_file doesn't exist anymore.
temp = (FILE *) gds__temp_file(TRUE, "temp", 0);
strcpy(temp_name, "temporary file");
#else
// Replace this kludge with TempFile since gds__temp_file doesn't exist anymore.
temp = (FILE *) gds__temp_file(TRUE, "temp", temp_name);
#endif
if (temp) {
SSHORT c;
while ((c = get_char(input_file)) != EOF)
putc(c, temp);
fclose(input_file);
#ifdef __ALPHA
fclose(temp);
temp = fopen(temp_name, FOPEN_READ_TYPE);
#endif
}
else {
fprintf(stderr, "gpre: can't open %s\n", temp_name);
CPR_exit(FINI_ERROR);
}
input_file = temp;
#endif
#if defined(GPRE_COBOL) && !defined(BOOT_BUILD)
// if cobol is defined we need both sw_cobol and sw_cob_dialect to
// determine how the string substitution table is set up
//
if (gpreGlob.sw_language == lang_cobol)
if (isAnsiCobol(gpreGlob.sw_cob_dialect)) {
if (db)
db->dbb_name->sym_string = "isc-database";
comment_start = " * ";
gpreGlob.ident_pattern = "isc-%d";
gpreGlob.long_ident_pattern = "isc-%ld";
gpreGlob.transaction_name = "isc-trans";
gpreGlob.database_name = "isc-database";
gpreGlob.utility_name = "isc-utility";
gpreGlob.count_name = "isc-count";
gpreGlob.slack_name = "isc-slack";
}
else { // just to be sure :-)
comment_start = "* ";
gpreGlob.transaction_name = "ISC_TRANS";
}
COB_name_init(isAnsiCobol(gpreGlob.sw_cob_dialect));
#endif
//
// See if user has specified an interpretation on the command line,
// as might be used for SQL access.
//
if (gpreGlob.default_lc_ctype) {
if (all_digits(gpreGlob.default_lc_ctype)) {
/* Numeric name? if so assume user has hard-coded a subtype number */
gpreGlob.sw_interp = atoi(gpreGlob.default_lc_ctype);
gpreGlob.sw_know_interp = TRUE;
}
else if (compare_ASCII7z(gpreGlob.default_lc_ctype, "DYNAMIC") == 0) {
// Dynamic means use the interpretation declared at runtime
gpreGlob.sw_interp = ttype_dynamic;
gpreGlob.sw_know_interp = TRUE;
}
else if (gpreGlob.isc_databases) {
// Name resolution done by MET_load_hash_table
gpreGlob.isc_databases->dbb_c_lc_ctype = gpreGlob.default_lc_ctype;
}
}
//
// Finally, open the output file, if we're not using standard out.
// If only one file name was given, make sure it has the preprocessor
// extension, then back up to that extension, zorch it, and add
// the language extension. Then you've got an output name. Take it
// and add the correct extension. If got an explicit output file
// name, use it as is unless it doesn't have an extension in which
// case use the default language extension. Finally, open the file.
// What could be easier?
//
TEXT spare_out_file_name[MAXPATHLEN];
if (!sw_standard_out) {
const ext_table_t* out_src_ext_tab = src_ext_tab;
if (use_lang_internal_gxx_output) {
out_src_ext_tab = dml_ext_table;
while (out_src_ext_tab->ext_language != lang_internal_cxx) {
++out_src_ext_tab;
}
}
bool renamed = true;
bool explicitt = true;
if (!out_file_name) {
out_file_name = spare_out_file_name;
strcpy(spare_out_file_name, file_name);
if (renamed = file_rename(spare_out_file_name, out_src_ext_tab->in,
out_src_ext_tab->out))
{
explicitt = false;
}
}
if (renamed) {
// Warning: modifying program's args.
TEXT* p;
for (p = out_file_name; *p; p++);
#ifdef VMS
while (p != out_file_name && *p != '.' && *p != ']')
#else
while (p != out_file_name && *p != '.' && *p != '/')
#endif
p--;
if (!explicitt)
*p = 0;
if (*p != '.') {
strcpy(spare_out_file_name, out_file_name);
out_file_name = spare_out_file_name;
file_rename(out_file_name, out_src_ext_tab->out, NULL);
}
}
if (!(strcmp(out_file_name, file_name))) {
fprintf(stderr,
"gpre: output file %s would duplicate input\n",
out_file_name);
CPR_exit(FINI_ERROR);
}
if ((gpreGlob.out_file = fopen(out_file_name, FOPEN_WRITE_TYPE)) == NULL) {
fprintf(stderr, "gpre: can't open output file %s\n",
out_file_name);
CPR_exit(FINI_ERROR);
}
}
// Compile modules until end of file
sw_databases = gpreGlob.isc_databases;
try {
SLONG end_position = 0;
while (end_position = compile_module(end_position, filename_array[3]));
// empty loop body
} // try
catch (const Firebird::Exception&) {} // fall through to the cleanup code
#ifdef FTN_BLK_DATA
if (gpreGlob.sw_language == lang_fortran)
FTN_fini();
#endif
MET_fini(0);
fclose(input_file);
#ifdef VMS
#ifdef __ALPHA
delete(temp_name);
#endif
#endif
if (!sw_standard_out) {
fclose(gpreGlob.out_file);
if (gpreGlob.errors_global)
unlink(out_file_name);
}
if (gpreGlob.errors_global || warnings_global) {
if (!gpreGlob.errors_global)
fprintf(stderr, "No errors, ");
else if (gpreGlob.errors_global == 1)
fprintf(stderr, "1 error, ");
else
fprintf(stderr, "%3d errors, ", gpreGlob.errors_global);
if (!warnings_global)
fprintf(stderr, "no warnings\n");
else if (warnings_global == 1)
fprintf(stderr, "1 warning\n");
else
fprintf(stderr, "%3d warnings\n", warnings_global);
}
CPR_exit((gpreGlob.errors_global) ? FINI_ERROR : FINI_OK);
return 0;
}
//____________________________________________________________
//
// Abort this silly program.
//
void CPR_abort()
{
++fatals_global;
//throw Firebird::Exception();
throw gpre_exception("Program terminated.");
}
#ifdef DEV_BUILD
//____________________________________________________________
//
// Report an assertion failure and abort this silly program.
//
void CPR_assert(const TEXT* file, int line)
{
TEXT buffer[MAXPATHLEN << 1];
fb_utils::snprintf(buffer, sizeof(buffer),
"GPRE assertion failure file '%s' line '%d'", file, line);
CPR_bugcheck(buffer);
}
#endif
//____________________________________________________________
//
// Issue an error message.
//
void CPR_bugcheck(const TEXT* string)
{
fprintf(stderr, "*** INTERNAL BUGCHECK: %s ***\n", string);
MET_fini(0);
CPR_abort();
}
//____________________________________________________________
//
// Mark end of a text description.
//
void CPR_end_text(gpre_txt* text)
{
text->txt_length = (USHORT) (gpreGlob.token_global.tok_position - text->txt_position - 1);
}
//____________________________________________________________
//
// Issue an error message.
//
int CPR_error(const TEXT* string)
{
fprintf(stderr, "(E) %s:%d: %s\n", file_name, line_global + 1, string);
gpreGlob.errors_global++;
return 0;
}
//____________________________________________________________
//
// Exit with status.
//
void CPR_exit( int stat)
{
#ifdef LINUX
if (trace_file_name[0])
{
if (trace_file)
fclose(trace_file);
unlink(trace_file_name);
}
#else
if (trace_file)
fclose(trace_file);
if (trace_file_name[0])
unlink(trace_file_name);
#endif
exit(stat);
}
//____________________________________________________________
//
// Issue an warning message.
//
void CPR_warn(const TEXT* string)
{
fprintf(stderr, "(W) %s:%d: %s\n", file_name, line_global + 1, string);
warnings_global++;
}
//____________________________________________________________
//
// Fortran, being a line oriented language, sometimes needs
// to know when it is at end of line to avoid parsing into the
// next statement. CPR_eol_token normally gets the next token,
// but if the language is FORTRAN and there isn't anything else
// on the line, it fakes a dummy token to indicate end of line.
//
TOK CPR_eol_token()
{
if (gpreGlob.sw_language != lang_fortran)
return CPR_token();
// Save the information from the previous token
gpreGlob.prior_token = gpreGlob.token_global;
gpreGlob.prior_token.tok_position = last_position;
last_position =
gpreGlob.token_global.tok_position + gpreGlob.token_global.tok_length
+ gpreGlob.token_global.tok_white_space - 1;
TEXT* p = gpreGlob.token_global.tok_string;
SSHORT num_chars = 0;
// skip spaces
SSHORT c;
for (c = nextchar(); c == ' '; c = nextchar()) {
num_chars++;
*p++ = (TEXT) c;
}
// in-line comments are equivalent to end of line
if (c == '!')
while (c != '\n' && c != EOF) {
c = nextchar();
num_chars++;
}
// in-line SQL comments are equivalent to end of line
if (gpreGlob.sw_sql && (c == '-')) {
const SSHORT peek = nextchar();
if (peek != '-')
return_char(peek);
else {
while (c != '\n' && c != EOF) {
c = nextchar();
num_chars++;
}
last_position = position - 1;
}
}
if (c == EOF) {
gpreGlob.token_global.tok_symbol = NULL;
gpreGlob.token_global.tok_keyword = KW_none;
return NULL;
}
// Not EOL so back up to the begining and try again
if (c != '\n') {
return_char(c);
while (--num_chars > 0)
return_char(*--p);
return CPR_token();
}
// if we've got EOL, treat it like a semi-colon
// NOTE: the fact that the length of this token is set to 0, is used as an
// indicator elsewhere that it was a faked token
gpreGlob.token_global.tok_string[0] = ';';
gpreGlob.token_global.tok_string[1] = 0;
gpreGlob.token_global.tok_type = tok_punct;
gpreGlob.token_global.tok_length = 0;
gpreGlob.token_global.tok_white_space = 0;
gpreGlob.token_global.tok_position = position;
gpreGlob.token_global.tok_symbol = HSH_lookup(gpreGlob.token_global.tok_string);
gpreGlob.token_global.tok_keyword = (KWWORDS) gpreGlob.token_global.tok_symbol->sym_keyword;
if (sw_trace)
puts(gpreGlob.token_global.tok_string);
return &gpreGlob.token_global;
}
//____________________________________________________________
//
// Write text from the scratch trace file into a buffer.
//
void CPR_get_text( TEXT* buffer, const gpre_txt* text)
{
SLONG start = text->txt_position;
int length = text->txt_length;
// On PC-like platforms, '\n' will be 2 bytes. The txt_position
// will be incorrect for fseek. The position is not adjusted
// just for PC-like platforms because, we use fseek () and
// getc to position ourselves at the token position.
// We should keep both character position and byte position
// and use them appropriately. for now use getc ()
//
#if (defined WIN_NT)
if (fseek(trace_file, 0L, 0))
#else
if (fseek(trace_file, start, 0))
#endif
{
fseek(trace_file, 0L, 2);
CPR_error("fseek failed for trace file");
}
#if (defined WIN_NT)
// move forward to actual position
while (start--)
getc(trace_file);
#endif
TEXT* p = buffer;
while (length--)
*p++ = getc(trace_file);
fseek(trace_file, (SLONG) 0, 2);
}
//____________________________________________________________
//
// A BASIC-specific function which resides here since it reads from
// the input file. Look for a '\n' with no continuation character (&).
// Eat tokens until previous condition is satisfied.
// This function is used to "eat" a BASIC external function definition.
//
void CPR_raw_read()
{
SCHAR token_string[MAX_SYM_SIZE];
bool continue_char = false;
SCHAR* p = token_string;
SSHORT c;
while (c = get_char(input_file))
{
position++;
if ((classes(c) == CHR_WHITE) && sw_trace && token_string) {
*p = 0;
puts(token_string);
token_string[0] = 0;
p = token_string;
}
else
*p++ = (SCHAR) c;
if (c == '\n') { // Changed assignment to comparison. Probable archaic bug
line_global++;
line_position = 0;
if (!continue_char)
return;
continue_char = false;
}
else {
line_position++;
if (classes(c) != CHR_WHITE)
continue_char = (gpreGlob.token_global.tok_keyword == KW_AMPERSAND);
}
}
}
//____________________________________________________________
//
// Generate a syntax error.
//
void CPR_s_error(const TEXT* string)
{
TEXT s[512];
fb_utils::snprintf(s, sizeof(s),
"expected %s, encountered \"%s\"", string, gpreGlob.token_global.tok_string);
CPR_error(s);
PAR_unwind();
}
//____________________________________________________________
//
// Make the current position to save description text.
//
gpre_txt* CPR_start_text()
{
gpre_txt* text = (gpre_txt*) MSC_alloc(TXT_LEN);
text->txt_position = gpreGlob.token_global.tok_position - 1;
return text;
}
//____________________________________________________________
//
// Parse and return the next token.
// If the token is a charset introducer, gobble it, grab the
// next token, and flag that token as being in a non-default
// character set.
//
TOK CPR_token()
{
TOK token = get_token();
if (!token)
return NULL;
if (token->tok_type == tok_introducer) {
gpre_sym* symbol = MSC_find_symbol(HSH_lookup(token->tok_string + 1), SYM_charset);
if (!symbol) {
TEXT err_buffer[100];
sprintf(err_buffer, "Character set not recognized: '%.50s'",
token->tok_string);
CPR_error(err_buffer);
}
token = get_token();
switch (gpreGlob.sw_sql_dialect) {
case SQL_DIALECT_V5:
if (!(isQuoted(token->tok_type)))
CPR_error("Can only tag quoted strings with character set");
else
token->tok_charset = symbol;
break;
default:
if (token->tok_type != tok_sglquoted)
CPR_error("Can only tag quoted strings with character set");
else
token->tok_charset = symbol;
break;
}
}
// use -charset switch if there is one for quoted strings
// only after a database declaration is loaded and MET_load_hash_table run.
else if (gpreGlob.default_lc_ctype && gpreGlob.text_subtypes) {
switch (gpreGlob.sw_sql_dialect) {
case SQL_DIALECT_V5:
if (isQuoted(token->tok_type)) {
token->tok_charset = MSC_find_symbol(HSH_lookup(gpreGlob.default_lc_ctype),
SYM_charset);
}
break;
default:
if (token->tok_type == tok_sglquoted) {
token->tok_charset = MSC_find_symbol(HSH_lookup(gpreGlob.default_lc_ctype),
SYM_charset);
}
break;
}
}
return token;
}
//____________________________________________________________
//
// Return true if the string consists entirely of digits.
//
static bool all_digits(const char* str1)
{
for (; *str1; str1++)
if (!(classes(*str1) & CHR_DIGIT))
return false;
return true;
}
//____________________________________________________________
//
// Check the command line argument which follows
// a switch which requires a string argument.
// If there is a problem, explain and return.
//
static bool arg_is_string(SLONG argc,
TEXT** argvstring,
const TEXT* errstring)
{
const TEXT* str = *++argvstring;
if (!argc || *str == '-') {
fprintf(stderr, "%s", errstring);
print_switches();
return false;
}
return true;
}
//____________________________________________________________
//
// Compare two ASCII 7-bit strings, case insensitive.
// Strings are null-byte terminated.
// Return 0 if strings are equal,
// (negative) if str1 < str2
// (positive) if str1 > str2
//
static SSHORT compare_ASCII7z(const char* str1, const char* str2)
{
for (; *str1; str1++, str2++)
if (UPPER7(*str1) != UPPER7(*str2))
return (UPPER7(*str1) - UPPER7(*str2));
return 0;
}
//____________________________________________________________
//
// Switches have been processed and files have been opened.
// Process a module and generate output.
//
static SLONG compile_module( SLONG start_position, const TEXT* base_directory)
{
// Reset miscellaneous pointers
gpreGlob.isc_databases = sw_databases;
gpreGlob.requests = NULL;
gpreGlob.events = NULL;
global_last_action = global_first_action = gpreGlob.global_functions = NULL;
// Position the input file and initialize various modules
fseek(input_file, start_position, 0);
input_char = input_buffer;
Firebird::PathName filename = TempFile::create(SCRATCH);
strcpy(trace_file_name, filename.c_str());
trace_file = fopen(trace_file_name, "w+b");
if (!trace_file) {
CPR_error("Couldn't open scratch file");
return 0;
}
position = start_position;
MSC_init();
HSH_init();
PAR_init();
CMP_init();
// Take a first pass at the module
SLONG end_position = pass1(base_directory);
// finish up any based_ons that got deferred
#ifdef GPRE_FORTRAN
if (gpreGlob.sw_language == lang_fortran)
finish_based(global_first_action);
#endif
MET_fini(NULL);
PAR_fini();
if (gpreGlob.errors_global)
return end_position;
for (gpre_req* request = gpreGlob.requests; request; request = request->req_next)
{
CMP_compile_request(request);
}
fseek(input_file, start_position, 0);
input_char = input_buffer;
if (!gpreGlob.errors_global)
pass2(start_position);
return end_position;
}
//____________________________________________________________
//
// Add the appropriate extension to a file
// name, if there's not one already. If
// the "appropriate" one is there and a
// new extension is given, use it.
//
static bool file_rename(TEXT* file_nameL,
const TEXT* extension,
const TEXT* new_extension)
{
TEXT *p;
// go to the end of the file name
for (p = file_nameL; *p; p++);
TEXT* terminator = p;
// back up to the last extension (if any)
#if defined(VMS)
while ((p != file_nameL) && (*p != '.') && (*p != ']'))
#elif defined(WIN_NT)
while ((p != file_nameL) && (*p != '.') && (*p != '/') && (*p != '\\'))
#else
while ((p != file_nameL) && (*p != '.') && (*p != '/'))
#endif
--p;
//
// There's a match and the file spec has no extension,
// so add extension.
//
if (*p != '.') {
while (*terminator++ = *extension++);
return true;
}
//
// There's a match and an extension. If the extension in
// the table matches the one on the file, we don't want
// to add a duplicate. Otherwise add it.
//
TEXT* ext = p;
for (const TEXT* q = extension; SAME(p, q); p++, q++)
if (!*p) {
if (new_extension)
while (*ext++ = *new_extension++);
return false;
}
#ifndef VMS
// Didn't match extension, so add the extension
while (*terminator++ = *extension++);
#endif
return true;
}
#ifdef GPRE_FORTRAN
//____________________________________________________________
//
// Scan through the based_on actions
// looking for ones that were deferred
// because we didn't have a database yet.
//
// Look at each action in turn, and if it's
// a based_on with a field name rather than a
// field block pointer, complete the name parse.
// If there's a database name, find the database,
// then the relation within the database, then
// the field. Otherwise, look through all databases
// for the relation.
//
static void finish_based( act* action)
{
gpre_rel* relation;
gpre_fld* field;
TEXT s[MAXPATHLEN << 1];
for (; action; action = action->act_rest) {
if (action->act_type != ACT_basedon)
continue;
/* If there are no databases either on the command line or in
this subroutine or main program, can't do a BASED_ON. */
if (!gpreGlob.isc_databases) {
CPR_error
("No database defined. Needed for a BASED_ON operation");
continue;
}
bas* based_on = (bas*) action->act_object;
if (!based_on->bas_fld_name)
continue;
DBB db = NULL;
if (based_on->bas_db_name) {
gpre_sym* symbol = HSH_lookup(based_on->bas_db_name->str_string);
for (; symbol; symbol = symbol->sym_homonym)
if (symbol->sym_type == SYM_database)
break;
if (symbol) {
db = (DBB) symbol->sym_object;
relation =
MET_get_relation(db, based_on->bas_rel_name->str_string, "");
if (!relation) {
fb_utils::snprintf(s, sizeof(s),
"relation %s is not defined in database %s",
based_on->bas_rel_name->str_string,
based_on->bas_db_name->str_string);
CPR_error(s);
continue;
}
field = MET_field(relation, based_on->bas_fld_name->str_string);
}
else {
if (based_on->bas_flags & BAS_ambiguous) {
/* The reference could have been DB.RELATION.FIELD or
RELATION.FIELD.SEGMENT. It's not the former. Try
the latter. */
based_on->bas_fld_name = based_on->bas_rel_name;
based_on->bas_rel_name = based_on->bas_db_name;
based_on->bas_db_name = NULL;
based_on->bas_flags |= BAS_segment;
}
else {
fb_utils::snprintf(s, sizeof(s), "database %s is not defined",
based_on->bas_db_name->str_string);
CPR_error(s);
continue;
}
}
}
if (!db) {
field = NULL;
for (db = gpreGlob.isc_databases; db; db = db->dbb_next)
if (relation =
MET_get_relation(db, based_on->bas_rel_name->str_string, ""))
{
if (field) {
/* The field reference is ambiguous. It exists in more
than one database. */
fb_utils::snprintf(s, sizeof(s),
"field %s in relation %s ambiguous",
based_on->bas_fld_name->str_string,
based_on->bas_rel_name->str_string);
CPR_error(s);
break;
}
field =
MET_field(relation, based_on->bas_fld_name->str_string);
}
if (db)
continue;
if (!relation && !field) {
sprintf(s, "relation %s is not defined",
based_on->bas_rel_name->str_string);
CPR_error(s);
continue;
}
}
if (!field) {
sprintf(s, "field %s is not defined in relation %s",
based_on->bas_fld_name->str_string,
based_on->bas_rel_name->str_string);
CPR_error(s);
continue;
}
if ((based_on->bas_flags & BAS_segment)
&& !(field->fld_flags & FLD_blob))
{
sprintf(s, "field %s is not a blob",
field->fld_symbol->sym_string);
CPR_error(s);
continue;
}
based_on->bas_field = field;
}
}
#endif
//____________________________________________________________
//
// Return a character to the input stream.
//
static int get_char( FILE * file)
{
if (input_char != input_buffer) {
return (int) *--input_char;
}
else
{
const USHORT pc = getc(file);
// Dump this char to stderr, so we can see
// what input line will cause this ugly
// core dump.
// FSG 14.Nov.2000
if (sw_verbose) {
fprintf(stderr, "%c", pc);
}
return pc;
}
}
//____________________________________________________________
//
//
// Parse the input line arguments, saving
// interesting switches in a switch table.
// The first entry in the switch table is
// reserved for the language, and is set
// later, even if specified here.
//
static bool get_switches(int argc,
TEXT** argv,
const in_sw_tab_t* in_sw_table,
SW_TAB sw_table,
TEXT** file_array)
{
USHORT in_sw = 0; // silence uninitialized warning
//
// Read all the switches and arguments, acting only on those
// that apply immediately, since we may find out more when
// we try to open the file.
//
SW_TAB sw_table_iterator = sw_table;
for (--argc; argc; argc--)
{
TEXT* string = *++argv;
if (*string != '?')
{
if (*string != '-')
{
if (!file_array[1])
{
if (!file_array[0]) {
file_array[0] = string;
}
else {
file_array[1] = string;
}
continue;
}
else
{
// both input and output files have been defined, hence
// there is an unknown switch
in_sw = IN_SW_GPRE_0;
}
}
else
{
// iterate through the switch table, looking for matches
sw_table_iterator++;
sw_table_iterator->sw_in_sw = IN_SW_GPRE_0;
const TEXT* q;
for (const in_sw_tab_t* in_sw_table_iterator = in_sw_table;
q = in_sw_table_iterator->in_sw_name;
in_sw_table_iterator++)
{
const TEXT* p = string + 1;
// handle orphaned hyphen case
if (!*p--)
break;
// compare switch to switch name in table
while (*p) {
if (!*++p) {
sw_table_iterator->sw_in_sw = (gpre_cmd_switch)in_sw_table_iterator->in_sw;
}
if (UPPER7(*p) != *q++) {
break;
}
}
// end of input means we got a match. stop looking
if (!*p)
break;
}
in_sw = sw_table_iterator->sw_in_sw;
}
}
/*
* Check here for switches that affect file look ups
* and -D so we don't lose their arguments.
* Give up here if we find a bad switch.
*/
if (*string == '?') {
in_sw = IN_SW_GPRE_0;
}
switch (in_sw) {
case IN_SW_GPRE_C:
gpreGlob.sw_language = lang_c;
sw_table_iterator--;
break;
case IN_SW_GPRE_CXX:
gpreGlob.sw_language = lang_cxx;
sw_table_iterator--;
break;
case IN_SW_GPRE_CPLUSPLUS:
gpreGlob.sw_language = lang_cplusplus;
sw_table_iterator--;
break;
case IN_SW_GPRE_GXX:
/* If we decrement sw_tab the switch is removed
* from the table and not processed in the main
* switch statement. Since IN_SW_GPRE_G will always
* be processed for lang_internal, we leave our
* switch in so we can clean up the mess left behind
* by IN_SW_GPRE_G
*/
gpreGlob.sw_language = lang_internal;
break;
case IN_SW_GPRE_G:
gpreGlob.sw_language = lang_internal;
sw_table_iterator--;
break;
#ifdef GPRE_FORTRAN
case IN_SW_GPRE_F:
gpreGlob.sw_language = lang_fortran;
sw_table_iterator--;
break;
#endif
#ifdef GPRE_PASCAL
case IN_SW_GPRE_P:
gpreGlob.sw_language = lang_pascal;
sw_table_iterator--;
break;
#endif
case IN_SW_GPRE_X:
gpreGlob.sw_external = true;
sw_table_iterator--;
break;
#ifdef GPRE_COBOL
case IN_SW_GPRE_COB:
gpreGlob.sw_language = lang_cobol;
sw_table_iterator--;
break;
#endif
case IN_SW_GPRE_LANG_INTERNAL :
gpreGlob.sw_language = lang_internal;
/*sw_tab--;*/
break;
case IN_SW_GPRE_D:
if (!arg_is_string
(--argc, argv,
"Command line syntax: -d requires database name:\n "))
{
return false;
}
file_array[2] = *++argv;
string = *argv;
if (*string == '=')
if (!arg_is_string
(--argc, argv,
"Command line syntax: -d requires database name:\n "))
{
return false;
}
else
file_array[2] = *++argv;
break;
case IN_SW_GPRE_BASE:
if (!arg_is_string
(--argc, argv,
"Command line syntax: -b requires database base directory:\n "))
{
return false;
}
file_array[3] = *++argv;
string = *argv;
if (*string == '=')
if (!arg_is_string
(--argc, argv,
"Command line syntax: -b requires database base directory:\n "))
{
return false;
}
else
file_array[3] = *++argv;
break;
case IN_SW_GPRE_HANDLES:
if (!arg_is_string(
--argc,
argv,
"Command line syntax: -h requires handle package name\n"))
{
return false;
}
strncpy(gpreGlob.ada_package, *++argv, MAXPATHLEN);
gpreGlob.ada_package[MAXPATHLEN - 2] = 0;
strcat(gpreGlob.ada_package, ".");
break;
case IN_SW_GPRE_SQLDA:
if (!arg_is_string(
--argc,
argv,
"Command line syntax: -sqlda requires NEW\n "))
{
return false;
}
if (**argv != 'n' || **argv != 'N') {
fprintf(stderr,
"-sqlda : Deprecated Feature: you must use XSQLDA\n ");
print_switches();
return false;
}
break;
case IN_SW_GPRE_SQLDIALECT:
{
int inp;
if (!arg_is_string(
--argc,
argv,
"Command line syntax: -SQL_DIALECT requires value 1, 2 or 3 \n "))
{
return false;
}
++argv;
inp = atoi(*argv);
if (inp < 1 || inp > 3) {
fprintf(stderr,
"Command line syntax: -SQL_DIALECT requires value 1, 2 or 3 \n ");
print_switches();
return false;
}
else {
gpreGlob.sw_sql_dialect = inp;
}
gpreGlob.dialect_specified = true;
break;
}
case IN_SW_GPRE_Z:
if (!gpreGlob.sw_version) {
printf("gpre version %s\n", GDS_VERSION);
}
gpreGlob.sw_version = true;
break;
case IN_SW_GPRE_0:
if (*string != '?') {
fprintf(stderr, "gpre: unknown switch %s\n", string);
}
print_switches();
return false;
case IN_SW_GPRE_USER:
if (!arg_is_string(
--argc,
argv,
"Command line syntax: -user requires user name string:\n "))
{
return false;
}
gpreGlob.default_user = *++argv;
break;
case IN_SW_GPRE_PASSWORD:
if (!arg_is_string(
--argc,
argv,
"Command line syntax: -password requires password string:\n "))
{
return false;
}
gpreGlob.default_password = fb_utils::get_passwd(*++argv);
break;
#ifdef TRUSTED_AUTH
case IN_SW_GPRE_TRUSTED:
gpreGlob.trusted_auth = true;
break;
#endif
case IN_SW_GPRE_INTERP:
if (!arg_is_string(
--argc,
argv,
"Command line syntax: -charset requires character set name:\n "))
{
return false;
}
gpreGlob.default_lc_ctype = (const TEXT*) * ++argv;
break;
case IN_SW_GPRE_DATE_FMT:
if (!arg_is_string(
--argc,
argv,
"Command line syntax: -dfm requires date format string:\n "))
{
return false;
}
gpreGlob.sw_cob_dformat = *++argv;
break;
}
}
sw_table_iterator++;
sw_table_iterator->sw_in_sw = IN_SW_GPRE_0;
return true;
}
//____________________________________________________________
//
// Parse and return the next token.
//
static TOK get_token()
{
// Save the information from the previous token
gpreGlob.prior_token = gpreGlob.token_global;
gpreGlob.prior_token.tok_position = last_position;
last_position =
gpreGlob.token_global.tok_position + gpreGlob.token_global.tok_length
+ gpreGlob.token_global.tok_white_space - 1;
int start_line = line_global;
SLONG start_position = position;
gpreGlob.token_global.tok_charset = NULL;
SSHORT c = skip_white();
#ifdef GPRE_COBOL
// Skip over cobol line continuation characters
if (gpreGlob.sw_language == lang_cobol && !isAnsiCobol(gpreGlob.sw_cob_dialect))
while (line_position == 1) {
c = skip_white();
start_line = line_global;
}
#endif
// Skip fortran line continuation characters
#ifdef GPRE_FORTRAN
if (gpreGlob.sw_language == lang_fortran) {
while (line_position == 6) {
c = skip_white();
start_line = line_global;
}
if (gpreGlob.sw_sql && line_global != start_line) {
return_char(c);
gpreGlob.token_global.tok_string[0] = ';';
gpreGlob.token_global.tok_string[1] = 0;
gpreGlob.token_global.tok_type = tok_punct;
gpreGlob.token_global.tok_length = 0;
gpreGlob.token_global.tok_white_space = 0;
gpreGlob.token_global.tok_position = start_position + 1;
gpreGlob.token_global.tok_symbol = HSH_lookup(gpreGlob.token_global.tok_string);
gpreGlob.token_global.tok_keyword = (KWWORDS) gpreGlob.token_global.tok_symbol->sym_keyword;
return &gpreGlob.token_global;
}
}
#endif
// Get token rolling
TEXT* p = gpreGlob.token_global.tok_string;
const TEXT* const end = p + sizeof(gpreGlob.token_global.tok_string);
*p++ = (TEXT) c;
if (c == EOF) {
gpreGlob.token_global.tok_symbol = NULL;
gpreGlob.token_global.tok_keyword = KW_none;
return NULL;
}
gpreGlob.token_global.tok_position = position;
gpreGlob.token_global.tok_white_space = 0;
UCHAR char_class = classes(c);
#ifdef GPRE_ADA
if ((gpreGlob.sw_language == lang_ada) && (c == '\'')) {
const SSHORT c1 = nextchar();
const SSHORT c2 = nextchar();
if (c2 != '\'') {
char_class = CHR_LETTER;
}
return_char(c2);
return_char(c1);
}
#endif
bool label = false;
if (gpreGlob.sw_sql && (char_class & CHR_INTRODUCER)) {
while (classes(c = nextchar()) & CHR_IDENT) {
if (p < end) {
*p++ = (TEXT) c;
}
}
return_char(c);
gpreGlob.token_global.tok_type = tok_introducer;
}
else if (char_class & CHR_LETTER) {
while (true) {
while (classes(c = nextchar()) & CHR_IDENT)
*p++ = (TEXT) c;
if (c != '-' || gpreGlob.sw_language != lang_cobol)
break;
if (gpreGlob.sw_language == lang_cobol && isAnsiCobol(gpreGlob.sw_cob_dialect))
*p++ = (TEXT) c;
else
*p++ = '_';
}
return_char(c);
gpreGlob.token_global.tok_type = tok_ident;
}
else if (char_class & CHR_DIGIT) {
#ifdef GPRE_FORTRAN
if (gpreGlob.sw_language == lang_fortran && line_position < 7)
label = true;
#endif
while (classes(c = nextchar()) & CHR_DIGIT)
*p++ = (TEXT) c;
if (label) {
*p = 0;
remember_label(gpreGlob.token_global.tok_string);
}
if (c == '.') {
*p++ = (TEXT) c;
while (classes(c = nextchar()) & CHR_DIGIT)
*p++ = (TEXT) c;
}
if (!label && (c == 'E' || c == 'e')) {
*p++ = (TEXT) c;
c = nextchar();
if (c == '+' || c == '-')
*p++ = (TEXT) c;
else
return_char(c);
while (classes(c = nextchar()) & CHR_DIGIT)
*p++ = (TEXT) c;
}
return_char(c);
gpreGlob.token_global.tok_type = tok_number;
}
else if ((char_class & CHR_QUOTE) || (char_class & CHR_DBLQUOTE)) {
gpreGlob.token_global.tok_type = (char_class & CHR_QUOTE) ? tok_sglquoted : tok_dblquoted;
for (;;) {
SSHORT next = nextchar();
if (gpreGlob.sw_language == lang_cobol && isAnsiCobol(gpreGlob.sw_cob_dialect) && next == '\n') {
if (prior_line_position == 73) {
// should be a split literal
next = skip_white();
if (next != '-' || line_position != 7) {
CPR_error("unterminated quoted string");
break;
}
next = skip_white();
if (next != c) {
CPR_error("unterminated quoted string");
break;
}
next = nextchar();
gpreGlob.token_global.tok_white_space += line_position - 1;
}
else {
CPR_error("unterminated quoted string");
break;
}
}
else if (next == EOF
|| (next == '\n' && (p[-1] != '\\' || gpreGlob.sw_sql)))
{
return_char(*p);
/* Decrement, then increment line counter, for accuracy of
the error message for an unterminated quoted string. */
line_global--;
CPR_error("unterminated quoted string");
line_global++;
break;
}
/* If we can hold the literal do so, else assume it is in part
of program we do not care about */
if (next == '\\' && !gpreGlob.sw_sql &&
((gpreGlob.sw_language == lang_c) || (isLangCpp(gpreGlob.sw_language))))
{
const USHORT peek = nextchar();
if (peek == '\n') {
gpreGlob.token_global.tok_white_space += 2;
}
else if (p < end) {
*p++ = (TEXT) next;
if (p < end) {
*p++ = (TEXT) peek;
}
}
continue;
}
if (p < end)
*p++ = (TEXT) next;
if (next == c)
/* If 2 quotes in a row, treat 2nd as literal - bug #1530 */
{
const USHORT peek = nextchar();
if (peek != c) {
return_char(peek);
break;
}
else
gpreGlob.token_global.tok_white_space++;
}
}
}
else if (c == '.') {
if (classes(c = nextchar()) & CHR_DIGIT) {
*p++ = (TEXT) c;
while (classes(c = nextchar()) & CHR_DIGIT)
*p++ = (TEXT) c;
if ((c == 'E' || c == 'e')) {
*p++ = (TEXT) c;
c = nextchar();
if (c == '+' || c == '-')
*p++ = (TEXT) c;
else
return_char(c);
while (classes(c = nextchar()) & CHR_DIGIT)
*p++ = (TEXT) c;
}
return_char(c);
gpreGlob.token_global.tok_type = tok_number;
}
else {
return_char(c);
gpreGlob.token_global.tok_type = tok_punct;
*p++ = nextchar();
*p = 0;
if (!HSH_lookup(gpreGlob.token_global.tok_string))
return_char(*--p);
}
}
else {
gpreGlob.token_global.tok_type = tok_punct;
*p++ = nextchar();
*p = 0;
if (!HSH_lookup(gpreGlob.token_global.tok_string))
return_char(*--p);
}
gpre_sym* symbol;
gpreGlob.token_global.tok_length = p - gpreGlob.token_global.tok_string;
*p++ = 0;
if (isQuoted(gpreGlob.token_global.tok_type)) {
strip_quotes(gpreGlob.token_global);
/** If the dialect is 1 then anything that is quoted is
a string. Don not lookup in the hash table to prevent
parsing confusion.
**/
if (gpreGlob.sw_sql_dialect != SQL_DIALECT_V5)
gpreGlob.token_global.tok_symbol = symbol = HSH_lookup(gpreGlob.token_global.tok_string);
else
gpreGlob.token_global.tok_symbol = symbol = NULL;
if (symbol && symbol->sym_type == SYM_keyword)
gpreGlob.token_global.tok_keyword = (KWWORDS) symbol->sym_keyword;
else
gpreGlob.token_global.tok_keyword = KW_none;
}
else if (gpreGlob.sw_case) {
if (!gpreGlob.override_case) {
gpreGlob.token_global.tok_symbol = symbol = HSH_lookup2(gpreGlob.token_global.tok_string);
if (symbol && symbol->sym_type == SYM_keyword)
gpreGlob.token_global.tok_keyword = (KWWORDS) symbol->sym_keyword;
else
gpreGlob.token_global.tok_keyword = KW_none;
}
else {
gpreGlob.token_global.tok_symbol = symbol = HSH_lookup(gpreGlob.token_global.tok_string);
if (symbol && symbol->sym_type == SYM_keyword)
gpreGlob.token_global.tok_keyword = (KWWORDS) symbol->sym_keyword;
else
gpreGlob.token_global.tok_keyword = KW_none;
gpreGlob.override_case = false;
}
}
else {
gpreGlob.token_global.tok_symbol = symbol = HSH_lookup(gpreGlob.token_global.tok_string);
if (symbol && symbol->sym_type == SYM_keyword)
gpreGlob.token_global.tok_keyword = (KWWORDS) symbol->sym_keyword;
else
gpreGlob.token_global.tok_keyword = KW_none;
}
// ** Take care of GDML context variables. Context variables are inserted
//into the hash table as it is. There is no upper casing of the variable
//name done. Hence in all likelyhood we might have missed it while looking it
//up if -e switch was specified. Hence
//IF symbol is null AND it is not a quoted string AND -e switch was specified
//THEN search again using HSH_lookup2().
//*
if ((gpreGlob.token_global.tok_symbol == NULL) && (!isQuoted(gpreGlob.token_global.tok_type))
&& gpreGlob.sw_case)
{
gpreGlob.token_global.tok_symbol = symbol = HSH_lookup2(gpreGlob.token_global.tok_string);
if (symbol && symbol->sym_type == SYM_keyword)
gpreGlob.token_global.tok_keyword = (KWWORDS) symbol->sym_keyword;
else
gpreGlob.token_global.tok_keyword = KW_none;
}
// for FORTRAN, make note of the first token in a statement
fb_assert(first_position <= MAX_USHORT);
gpreGlob.token_global.tok_first = (USHORT) first_position;
first_position = FALSE;
if (sw_trace)
puts(gpreGlob.token_global.tok_string);
return &gpreGlob.token_global;
}
//____________________________________________________________
//
// Get the next character from the input stream.
// Also, for Fortran, mark the beginning of a statement
//
static int nextchar()
{
position++;
line_position++;
const SSHORT c = get_char(input_file);
if (c == '\n') {
line_global++;
prior_line_position = line_position;
line_position = 0;
}
// For silly fortran, mark the first token in a statement so
// we can decide to start the database field substitution string
// with a continuation indicator if appropriate.
if (line_position == 1) {
first_position = TRUE;
/* If the first character on a Fortran line is a tab, bump up the
position indicator. */
#ifdef GPRE_FORTRAN
if (gpreGlob.sw_language == lang_fortran && c == '\t')
line_position = 7;
#endif
}
// if this is a continuation line, the next token is not
// the start of a statement.
#ifdef GPRE_FORTRAN
if (gpreGlob.sw_language == lang_fortran && line_position == 6 && c != ' '
&& c != '0')
{
first_position = FALSE;
}
#endif
#ifdef GPRE_COBOL
if (gpreGlob.sw_language == lang_cobol &&
(!isAnsiCobol(gpreGlob.sw_cob_dialect) && line_position == 1 && c == '-') ||
(isAnsiCobol(gpreGlob.sw_cob_dialect) && line_position == 7 && c == '-'))
{
first_position = FALSE;
}
#endif
if (position > traced_position) {
traced_position = position;
fputc(c, trace_file);
}
return c;
}
//____________________________________________________________
//
// Make first pass at input file. This involves
// passing thru tokens looking for keywords. When
// a keyword is found, try to parse an action. If
// the parse is successful (an action block is returned)
// link the new action into the system data structures
// for processing on pass 2.
//
static SLONG pass1(const TEXT* base_directory)
{
// FSG 14.Nov.2000
if (sw_verbose) {
fprintf(stderr,
"*********************** PASS 1 ***************************\n");
}
while (CPR_token())
{
while (gpreGlob.token_global.tok_symbol)
{
const SLONG start = gpreGlob.token_global.tok_position;
act* action = PAR_action(base_directory);
if (action)
{
action->act_position = start;
if (!(action->act_flags & ACT_back_token)) {
action->act_length = last_position - start;
}
else {
action->act_length =
gpreGlob.prior_token.tok_position +
gpreGlob.prior_token.tok_length - 1 - start;
}
if (global_first_action) {
global_last_action->act_rest = action;
}
else {
global_first_action = action;
}
// Allow for more than one action to be generated by a token.
do
{
global_last_action = action;
if (action = action->act_rest)
{
if (action->act_type == ACT_database)
{
/* CREATE DATABASE has two actions the second one
is do generate global decl at the start of the
program file. */
global_last_action->act_rest = NULL;
action->act_rest = global_first_action;
global_first_action = action;
action->act_position = -1;
action->act_length = -1;
break;
}
else
{
action->act_position = global_last_action->act_position;
action->act_length = 0;
}
}
} while (action);
if (global_last_action->act_flags & ACT_break) {
return last_position;
}
if (!gpreGlob.token_global.tok_length &&
((int) gpreGlob.token_global.tok_keyword == (int) KW_SEMI_COLON))
{
break;
}
}
}
}
if (gpreGlob.isc_databases &&
(gpreGlob.isc_databases->dbb_flags & DBB_sqlca) &&
!gpreGlob.isc_databases->dbb_filename)
{
CPR_error("No database specified");
}
return 0;
}
//____________________________________________________________
//
// Make a second pass thru the input file turning actions into
// comments, substituting text for actions, and generating the
// output file.
//
static void pass2( SLONG start_position)
{
SSHORT c = 0;
// FSG 14.Nov.2000
if (sw_verbose) {
fprintf(stderr,
"*********************** PASS 2 ***************************\n");
}
bool suppress_output = false;
const bool sw_block_comments =
gpreGlob.sw_language == lang_c ||
isLangCpp(gpreGlob.sw_language) ||
gpreGlob.sw_language == lang_pascal;
// Put out a distintive module header
if (!sw_first)
{
sw_first = true;
for (int i = 0; i < 5; ++i)
{
fprintf(gpreGlob.out_file,
"%s********** Preprocessed module -- do not edit **************%s\n",
comment_start, comment_stop);
}
fprintf(gpreGlob.out_file,
"%s**************** gpre version %s *********************%s\n",
comment_start, GDS_VERSION, comment_stop);
}
#ifdef GPRE_ADA
if ((gpreGlob.sw_language == lang_ada) &&
(gpreGlob.ada_flags & gpreGlob.ADA_create_database))
{
fprintf(gpreGlob.out_file, "with unchecked_conversion;\nwith system;\n");
}
#endif
// Let's prepare for worst case: a lot of small dirs, many "\" to duplicate.
char backlash_fixed_file_name[MAXPATHLEN + MAXPATHLEN];
{ // scope
char* p = backlash_fixed_file_name;
for (const char* q = file_name; *q;)
{
if ((*p++ = *q++) == '\\')
*p++ = '\\';
}
*p = 0;
} // scope
//
//if (sw_lines)
// fprintf (gpreGlob.out_file, "#line 1 \"%s\"\n", backlash_fixed_file_name);
//
SLONG line = 0;
bool line_pending = sw_lines;
SLONG current = 1 + start_position;
SLONG column = 0;
SSHORT comment_start_len = strlen(comment_start);
SSHORT to_skip = 0;
// Dump text until the start of the next action, then process the action.
for (const act* action = global_first_action; action; action = action->act_rest)
{
/* Dump text until the start of the next action. If a line marker
is pending and we see an end of line, dump out the marker. */
for (; current < action->act_position; current++)
{
c = get_char(input_file);
if (c == EOF) {
CPR_error("internal error -- unexpected EOF between actions");
return;
}
if (c == '\n' || !line) {
line++;
if (line_pending) {
if (line == 1)
fprintf(gpreGlob.out_file, "#line %ld \"%s\"\n", line,
backlash_fixed_file_name);
else
fprintf(gpreGlob.out_file, "\n#line %ld \"%s\"", line,
backlash_fixed_file_name);
line_pending = false;
}
if (line == 1 && c == '\n')
line++;
column = -1;
}
putc(c, gpreGlob.out_file);
if (c == '\t') {
column = (column + 8) & ~7;
}
else {
++column;
}
}
// Determine if this action is one which requires line continuation
// handling in certain languages.
const bool continue_flag =
(action->act_type == ACT_variable) ||
(action->act_type == ACT_segment) ||
(action->act_type == ACT_segment_length) ;
// Unless the action is purely a marker, insert a comment initiator
// into the output stream.
const SLONG start = column;
if (!(action->act_flags & ACT_mark)) {
if (gpreGlob.sw_language == lang_fortran) {
fputc('\n', gpreGlob.out_file);
fputs(comment_start, gpreGlob.out_file);
}
else if (gpreGlob.sw_language == lang_cobol)
if (continue_flag)
suppress_output = true;
else {
fputc('\n', gpreGlob.out_file);
fputs(comment_start, gpreGlob.out_file);
to_skip = (column < 7) ? comment_start_len - column : 0;
column = 0;
}
else
fputs(comment_start, gpreGlob.out_file);
}
// Next, dump the text of the action to the output stream.
for (SLONG i = 0; i <= action->act_length; ++i, ++current)
{
if (c == EOF) {
CPR_error("internal error -- unexpected EOF in action");
return;
}
const SSHORT prior = c;
c = get_char(input_file);
if (!suppress_output) {
// close current comment to avoid nesting comments
if (sw_block_comments && !(action->act_flags & ACT_mark) &&
c == comment_start[0])
{
const SSHORT d = get_char(input_file);
return_char(d);
if (d == comment_start[1])
fputs(comment_stop, gpreGlob.out_file);
}
if (gpreGlob.sw_language != lang_cobol || !isAnsiCobol(gpreGlob.sw_cob_dialect)
|| c == '\n' || to_skip-- <= 0)
{
putc(c, gpreGlob.out_file);
}
if (c == '\n') {
line++;
if ((gpreGlob.sw_language == lang_fortran) ||
(gpreGlob.sw_language == lang_ada) ||
(gpreGlob.sw_language == lang_cobol))
{
fputs(comment_start, gpreGlob.out_file);
to_skip =
(column < 7) ? comment_start_len - column : 0;
column = 0;
}
}
// reopen our comment at end of user's comment
if (sw_block_comments && !(action->act_flags & ACT_mark) &&
prior == comment_stop[0] && c == comment_stop[1])
{
fputs(comment_start, gpreGlob.out_file);
}
}
}
// Unless action was purely a marker, insert a comment terminator.
if (!(action->act_flags & ACT_mark) && !suppress_output) {
fputs(comment_stop, gpreGlob.out_file);
if ((gpreGlob.sw_language == lang_fortran) || (gpreGlob.sw_language == lang_cobol))
fputc('\n', gpreGlob.out_file);
}
suppress_output = false;
(*gen_routine) (action, start);
if (action->act_type == ACT_routine &&
!action->act_object &&
((gpreGlob.sw_language == lang_c) || (isLangCpp(gpreGlob.sw_language))))
{
continue;
}
if (action->act_flags & ACT_break)
return;
if (sw_lines)
line_pending = true;
column = 0;
to_skip = 0;
}
// We're out of actions -- dump the remaining text to the output stream.
if (!line && line_pending) {
fprintf(gpreGlob.out_file, "#line 1 \"%s\"\n", backlash_fixed_file_name);
line_pending = false;
}
while ((c = get_char(input_file)) != EOF) {
if (c == '\n' && line_pending) {
fprintf(gpreGlob.out_file, "\n#line %ld \"%s\"", line + 1, backlash_fixed_file_name);
line_pending = false;
}
if (c == EOF) {
CPR_error("internal error -- unexpected EOF in tail");
return;
}
putc(c, gpreGlob.out_file);
}
// Last but not least, generate any remaining functions
for (; gpreGlob.global_functions; gpreGlob.global_functions = gpreGlob.global_functions->act_next)
(*gen_routine) (gpreGlob.global_functions, 0);
}
//____________________________________________________________
//
// Print out the switch table as an
// aid to those who have forgotten or are fishing
//
static void print_switches()
{
const in_sw_tab_t* in_sw_table_iterator;
fprintf(stderr, "\tlegal switches are:\n");
for (in_sw_table_iterator = gpre_in_sw_table;
in_sw_table_iterator->in_sw;
in_sw_table_iterator++)
{
if (in_sw_table_iterator->in_sw_text) {
fprintf(stderr, "%s%s\n", in_sw_table_iterator->in_sw_name,
in_sw_table_iterator->in_sw_text);
}
}
fprintf(stderr, "\n\tand the internal 'illegal' switches are:\n");
for (in_sw_table_iterator = gpre_in_sw_table;
in_sw_table_iterator->in_sw;
in_sw_table_iterator++)
{
if (!in_sw_table_iterator->in_sw_text) {
fprintf(stderr, "%s\n", in_sw_table_iterator->in_sw_name);
}
}
}
//____________________________________________________________
//
// Set a bit in the label vector indicating
// that a label has been used. If the label
// is bigger than the vector, punt.
//
static void remember_label(const TEXT* label_string)
{
SLONG label = atoi(label_string);
if (label < 8192) {
const UCHAR target_byte = label & 7;
label >>= 3;
gpreGlob.fortran_labels[label] |= 1 << target_byte;
}
}
//____________________________________________________________
//
// Return a character to the input stream.
//
static void return_char( SSHORT c)
{
--position;
--line_position;
// note putting back a new line results in incorrect line_position value
if (c == '\n') {
--line_global;
}
*input_char++ = (TEXT) c;
}
//____________________________________________________________
//
// Skip over white space and comments in input stream
//
static SSHORT skip_white()
{
SSHORT c;
while (true) {
if ((c = nextchar()) == EOF)
return c;
c = c & 0xff;
// skip Fortran comments
#ifdef GPRE_FORTRAN
if (gpreGlob.sw_language == lang_fortran &&
line_position == 1 && (c == 'C' || c == 'c' || c == '*'))
{
while ((c = nextchar()) != '\n' && c != EOF);
continue;
}
#endif
#ifdef GPRE_COBOL
// skip sequence numbers when ansi COBOL
if (gpreGlob.sw_language == lang_cobol && isAnsiCobol(gpreGlob.sw_cob_dialect)) {
while (line_position < 7 && (c = nextchar()) != '\n' && c != EOF);
}
// skip COBOL comments and conditional compilation
if (gpreGlob.sw_language == lang_cobol &&
(!isAnsiCobol(gpreGlob.sw_cob_dialect) && line_position == 1 &&
(c == 'C' || c == 'c' || c == '*' || c == '/' || c == '\\') ||
(isAnsiCobol(gpreGlob.sw_cob_dialect) && line_position == 7 && c != '\t' && c != ' '
&& c != '-')))
{
while ((c = nextchar()) != '\n' && c != EOF);
continue;
}
#endif
const UCHAR char_class = classes(c);
if (char_class & CHR_WHITE) {
continue;
}
// skip in-line SQL comments
if (gpreGlob.sw_sql && (c == '-')) {
const SSHORT c2 = nextchar();
if (c2 != '-')
return_char(c2);
else {
while ((c = nextchar()) != '\n' && c != EOF);
last_position = position - 1;
continue;
}
}
/* skip C, C++ and PL/I comments */
if (c == '/' &&
(gpreGlob.sw_language == lang_c ||
isLangCpp(gpreGlob.sw_language)))
{
SSHORT next = nextchar();
if (next != '*') {
if (isLangCpp(gpreGlob.sw_language) && next == '/') {
while ((c = nextchar()) != '\n' && c != EOF);
continue;
}
return_char(next);
return c;
}
c = nextchar();
while ((next = nextchar()) != EOF && !(c == '*' && next == '/'))
c = next;
continue;
}
#if !defined(sun) && defined(GPRE_FORTRAN)
// skip fortran embedded comments on VMS or hpux or sgi
if (c == '!'
&& (gpreGlob.sw_language == lang_fortran))
{
/* If this character is a '!' followed by a '=', this is an
Interbase 'not equal' operator, not a Fortran comment.
Bug #307. mao 6/14/89 */
const SSHORT c3 = nextchar();
if (c3 == '=') {
return_char(c3);
return c;
}
else {
if ((c = c3) != '\n' && c != EOF)
while ((c = nextchar()) != '\n' && c != EOF);
continue;
}
}
#endif
if (c == '-' && (gpreGlob.sw_sql || gpreGlob.sw_language == lang_ada)) {
SSHORT next = nextchar();
if (next != '-') {
return_char(next);
return c;
}
while ((c = nextchar()) != EOF && c != '\n');
continue;
}
// skip PASCAL comments - both types
if (c == '{' && gpreGlob.sw_language == lang_pascal) {
while ((c = nextchar()) != EOF && c != '}');
continue;
}
if (c == '(' && gpreGlob.sw_language == lang_pascal) {
SSHORT next = nextchar();
if (next != '*') {
return_char(next);
return c;
}
c = nextchar();
while ((next = nextchar()) != EOF && !(c == '*' && next == ')'))
c = next;
continue;
}
break;
}
return c;
}