static void init_release_level (void)
{
char *char_ptr;
int length;
char *location;
char new_release[RELEASE_LEVEL_LEN];
int str_idx;
FILE *release_file_ptr;
char *version_string_location = "COMPILER";
TRACE (Func_Entry, "init_release_level", NULL);
location = getenv(version_string_location);
if (location != NULL) {
length = WORD_LEN(strlen(location) + 14);
str_idx = str_pool_idx;
TBL_REALLOC_CK(str_pool, length);
strcpy(&str_pool[str_idx].name_char, location);
char_ptr = strrchr(&str_pool[str_idx].name_char, SLASH);
if (char_ptr == NULL) {
release_file_ptr = fopen("version.string", "r");
}
else {
strcpy(++char_ptr, "version.string");
release_file_ptr = fopen(&str_pool[str_idx].name_char, "r");
}
/* If not found - default to initial value in release_level #.x.x.x */
if (release_file_ptr != NULL) {
fgets(new_release, RELEASE_LEVEL_LEN, release_file_ptr);
if (new_release != NULL) {
char_ptr = strrchr(new_release, NEWLINE);
*char_ptr = EOS;
strcpy(release_level, new_release);
}
}
str_pool_idx = str_idx;
}
TRACE (Func_Exit, "init_release_level", NULL);
return;
} /* init_release_level */
static void init_compiler (int argc,
char *argv[])
{
extern void init_lex (void);
extern void init_msg_processing (char *[]);
extern void init_src_input (void);
extern void init_type (void);
extern void process_cmd_line (int, char *[]);
extern void init_cond_comp(void);
extern void enter_predefined_macros(void);
extern void init_parse_prog_unit(void);
extern void init_PDGCS (void);
extern void set_up_token_tables(void);
extern void sgi_cmd_line(int *argc, char **argv[]);
extern char *operator_str[];
extern void verify_semantic_tbls(void);
int idx;
TRACE (Func_Entry, "init_compiler", NULL);
init_date_time_info (); /* set compilation data and time */
init_msg_processing (argv); /* initialize for messages. Must */
/* preceed process_cmd_line. */
# ifdef _DEBUG
check_defines_compatibility(); /* Is the compiler built correctly? */
check_enums_for_change(); /* Some enums must not be changed. */
# endif
# if 0
check_license();
# endif
/* allocate memory for data structures required across compilation units. */
/* These must preceed process_cmd_line. */
TBL_ALLOC (global_line_tbl);
TBL_ALLOC (global_name_tbl);
TBL_ALLOC (global_attr_tbl);
TBL_ALLOC (global_type_tbl);
TBL_ALLOC (global_bounds_tbl);
TBL_ALLOC (global_ir_tbl);
TBL_ALLOC (global_ir_list_tbl);
TBL_ALLOC (global_sh_tbl);
TBL_ALLOC (file_path_tbl);
TBL_ALLOC (str_pool);
init_release_level (); /* Set up release_level from system */
str_pool[0].name_long = 0;
str_pool[1].name_long = 0;
str_pool[2].name_long = LARGE_WORD_FOR_TBL_SRCH;
str_pool_idx = 2;
TBL_REALLOC_CK(global_name_tbl, 2);
CLEAR_TBL_NTRY(global_name_tbl, 1);
CLEAR_TBL_NTRY(global_name_tbl, 2);
GN_NAME_IDX(1) = 1;
GN_NAME_LEN(1) = HOST_BYTES_PER_WORD;
GN_NAME_IDX(2) = 2;
GN_NAME_LEN(2) = HOST_BYTES_PER_WORD;
/* Initialize the bounds table for deferred shape arrays */
TBL_REALLOC_CK(global_bounds_tbl, 7);
for (idx = BD_DEFERRED_1_IDX; idx <= BD_DEFERRED_7_IDX; idx++) {
CLEAR_TBL_NTRY(global_bounds_tbl, idx);
GB_ARRAY_CLASS(idx) = Deferred_Shape;
GB_RANK(idx) = idx;
}
/* Initialize the conditional compilation tables. It must be done before */
/* the command line processing because of the -D and -U options. */
init_cond_comp ();
get_machine_chars();
set_up_token_tables();
/* The following routines sets things such as target_ieee, target_triton */
/* two_word_fcd, word_byte_size ect... */
set_compile_info_for_target();
comp_phase = Cmdline_Parsing;
cif_name[0] = NULL_CHAR;
assembly_listing_file[0] = NULL_CHAR;
debug_file_name[0] = NULL_CHAR;
# if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX))
/* sgi_cmd_line does some option manipulation, process SGI specific */
/* command line options, and strips out things that the front-end doesn't */
/* need to see. */
sgi_cmd_line (&argc,&argv);
# endif
process_cmd_line (argc, argv); /* pass input args */
# if defined(_INTEGER_1_AND_2)
if (on_off_flags.integer_1_and_2) {
bit_size_tbl[Integer_1] = 8;
bit_size_tbl[Integer_2] = 16;
bit_size_tbl[Logical_1] = 8;
bit_size_tbl[Logical_2] = 16;
storage_bit_size_tbl[Integer_1] = 8;
storage_bit_size_tbl[Integer_2] = 16;
storage_bit_size_tbl[Logical_1] = 8;
storage_bit_size_tbl[Logical_2] = 16;
storage_bit_prec_tbl[Integer_1] = 8;
storage_bit_prec_tbl[Integer_2] = 16;
storage_bit_prec_tbl[Logical_1] = 8;
storage_bit_prec_tbl[Logical_2] = 16;
stride_mult_unit_in_bits[Integer_1] = 8;
stride_mult_unit_in_bits[Integer_2] = 16;
stride_mult_unit_in_bits[Logical_1] = 8;
stride_mult_unit_in_bits[Logical_2] = 16;
linear_to_arith[Integer_1] = AR_Int_8_S;
linear_to_arith[Integer_2] = AR_Int_16_S;
input_arith_type[Integer_1] = AR_Int_8_U;
input_arith_type[Integer_2] = AR_Int_16_U;
strcpy(arith_type_string[Integer_1], "AR_Int_8_U");
strcpy(arith_type_string[Integer_2], "AR_Int_16_U");
}
# endif
comp_phase = Pass1_Parsing;
/* only -V info requested */
if (argc == 2 && cmd_line_flags.verify_option) {
print_id_line();
exit_compiler(RC_OKAY);
}
if (num_errors != 0) { /* command line errors */
PRINTMSG(0, 912, Log_Summary, 0, num_errors);
exit_compiler(RC_USER_ERROR);
}
/* Call init_cif even if the user did NOT request Compiler Information */
/* File (CIF) output because the CIF is used for messaging. */
init_cif(comp_date_time, release_level);
some_scp_in_err = FALSE;
clearing_blk_stk = FALSE;
init_type();
make_table_changes ();
init_sytb (); /* Must be before src_input for err msgs */
/* Enter conditional compilation predefined macros. This must happen */
/* after process_cmd_line because it calls GETPMC (and the information */
/* from GETPMC is needed to set the predefined macros that depend on the */
/* target machine). This call must also happen after target_triton and */
/* target_ieee have been set so that we can get _CRAYIEEE set correctly. */
/* And finally, this call must come before init_src_input because that */
/* procedure gets the first source line - which could be a conditional */
/* compilation directive. */
enter_predefined_macros();
/* Must do the first call here so that tables needed by conditional */
/* compilation are set up. */
init_parse_prog_unit();
init_src_input();
if (on_off_flags.preprocess_only) {
preprocess_only_driver();
issue_deferred_msgs();
TRACE (Func_Exit, "init_compiler", NULL);
return;
}
init_lex ();
max_field_len = (long) sbrk(0); /* Keep track of memory usage */
# if defined(_HOST_OS_MAX)
max_field_len &= (1 << 32) - 1;
# endif
/* Pathological case: The file is empty. At least an END statement must */
/* be present to constitute a valid Fortran program. */
if (LA_CH_CLASS == Ch_Class_EOF) {
PRINTMSG(0, 1391, Log_Warning, 0, src_file);
issue_deferred_msgs();
}
# ifdef _NAME_SUBSTITUTION_INLINING
if (!dump_flags.preinline)
# endif
init_PDGCS();
# ifdef _DEBUG
verify_semantic_tbls(); /* Make sure flags and messages agree. */
if (strcmp(operator_str[The_Last_Opr], "The_Last_Opr") != 0) {
PRINTMSG(1, 689, Internal, 0);
}
# endif
TRACE (Func_Exit, "init_compiler", NULL);
return;
} /* init_compiler */
void read_global_line_table()
{
int i, found, idx;
long length, lengthp;
long global_line;
long file_line;
char file_name[1024];
long file_name_idx;
long cif_file_id;
long file_name_len;
long incld_file_line;
long incld_file_col;
char path_name[1024];
long path_name_idx;
long path_name_len;
long source_lines;
long num_global_lines;
static int last_global_line_idx = 0;
setLongVar("num_global_lines", &num_global_lines);
TBL_REALLOC_CK (global_line_tbl, num_global_lines);
for (i = last_global_line_idx + 1;
i <= num_global_lines + last_global_line_idx;
i++) {
curr_glb_line = i;
setLongVar("global_line", &global_line);
setLongVar("file_line", &file_line);
setStrVar("file_name", file_name);
trim(file_name);
setLongVar("file_name_idx", &file_name_idx);
setLongVar("cif_file_id", &cif_file_id);
setLongVar("file_name_len", &file_name_len);
setLongVar("incld_file_line", &incld_file_line);
setLongVar("incld_file_col", &incld_file_col);
setStrVar("path_name", path_name);
trim(path_name);
setLongVar("path_name_idx", &path_name_idx);
setLongVar("path_name_len", &path_name_len);
setLongVar("source_lines", &source_lines);
global_line_tbl[i].global_line = global_line;
global_line_tbl[i].file_line = file_line;
global_line_tbl[i].cif_file_id = cif_file_id;
/* Clear the field. It gets set at EOF of each file. */
/* It also holds a running total of file lines at each end statement */
/* because of mif inflexibility. */
global_line_tbl[i].source_lines = source_lines;
global_line_tbl[i].incld_file_line = incld_file_line;
global_line_tbl[i].incld_file_col = incld_file_col;
/* prevent duplication of file name strings in string pool */
global_line_tbl[i].file_name_idx = 0;
global_line_tbl[i].path_name_idx = 0;
length = file_name_len;
lengthp = path_name_len;
/* check for file name already in the string pool */
if (global_line_tbl[i].file_name_idx == 0) {
global_line_tbl[i].file_name_len = length;
global_line_tbl[i].file_name_idx = str_pool_idx+1;
TBL_REALLOC_CK(str_pool, WORD_LEN(length));
for (idx = global_line_tbl[i].file_name_idx;
idx <= str_pool_idx; idx++) {
str_pool[idx].name_long = 0;
}
strcpy(&str_pool[global_line_tbl[i].file_name_idx].name_char,
file_name);
}
if (global_line_tbl[i].path_name_idx == 0) {
global_line_tbl[i].path_name_len = lengthp;
global_line_tbl[i].path_name_idx = str_pool_idx+1;
TBL_REALLOC_CK(str_pool, WORD_LEN(lengthp));
for (idx = global_line_tbl[i].path_name_idx;
idx <= str_pool_idx; idx++) {
str_pool[idx].name_long = 0;
}
strcpy(&str_pool[global_line_tbl[i].path_name_idx].name_char,
path_name);
}
}
last_global_line_idx += num_global_lines;
}
