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