Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 00006 This program is free software; you can redistribute it and/or modify it 00007 under the terms of version 2 of the GNU General Public License as 00008 published by the Free Software Foundation. 00009 00010 This program is distributed in the hope that it would be useful, but 00011 WITHOUT ANY WARRANTY; without even the implied warranty of 00012 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00013 00014 Further, this software is distributed without any warranty that it is 00015 free of the rightful claim of any third person regarding infringement 00016 or the like. Any license provided herein, whether implied or 00017 otherwise, applies only to this software file. Patent licenses, if 00018 any, provided herein do not apply to combinations of this program with 00019 other software, or any other product whatsoever. 00020 00021 You should have received a copy of the GNU General Public License along 00022 with this program; if not, write the Free Software Foundation, Inc., 59 00023 Temple Place - Suite 330, Boston MA 02111-1307, USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 00038 static char USMID[] = "\n@(#)5.0_pl/sources/main.c 5.15 10/14/99 15:25:09\n"; 00039 00040 # include "defines.h" /* Machine dependent ifdefs */ 00041 00042 # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) /* Needed for timing information. */ 00043 # include <sys/time.h> 00044 # include <sys/resource.h> 00045 # endif 00046 00047 # include <time.h> 00048 00049 # include "host.m" /* Host machine dependent macros.*/ 00050 # include "host.h" /* Host machine dependent header.*/ 00051 # include "target.m" /* Target machine dependent macros.*/ 00052 # include "target.h" /* Target machine dependent header.*/ 00053 00054 # include "globals.m" 00055 # include "tokens.m" 00056 # include "sytb.m" 00057 # include "debug.m" 00058 00059 # ifdef _ARITH_H 00060 # include "arith.h" 00061 # endif 00062 00063 # include "globals.h" 00064 # include "tokens.h" 00065 # include "sytb.h" 00066 # include "main.h" 00067 # include "type.h" 00068 # include "intrin.h" 00069 00070 extern const char *fe_vers_ID(void); 00071 extern const char *fe_vers_number(void); 00072 extern const char *fe_vers_name(void); 00073 00074 extern void print_buffered_messages (void); 00075 00076 /*****************************************************************\ 00077 |* function prototypes of static functions declared in this file *| 00078 \*****************************************************************/ 00079 00080 # if 0 00081 static void check_license (void); 00082 # endif 00083 00084 # ifdef _DEBUG 00085 static void check_defines_compatibility (void); 00086 static void check_enums_for_change(void); 00087 # endif 00088 00089 static void get_machine_chars (void); 00090 static int init_compiler (int, char *[]); 00091 static void init_date_time_info (void); 00092 static void init_release_level (void); 00093 static void make_table_changes (void); 00094 static void print_id_line (void); 00095 static void set_compile_info_for_target (void); 00096 00097 00098 /******************************************************************************\ 00099 |* *| 00100 |* Description: *| 00101 |* main entry into the Fortran 90 compiler; initializes the compiler, *| 00102 |* processes the command line, parses the input source and converts the *| 00103 |* internal representation to what VPR expects. *| 00104 |* *| 00105 |* Input parameters: *| 00106 |* argc number of command line arguments *| 00107 |* argv argument strings *| 00108 |* *| 00109 |* Output parameters: *| 00110 |* none *| 00111 |* *| 00112 |* Returns: nothing *| 00113 |* *| 00114 \******************************************************************************/ 00115 00116 # ifdef _TARGET_OS_MAX 00117 void the_real_main (int argc, 00118 char *argv[]) 00119 # else 00120 int main (int argc, 00121 char *argv[]) 00122 # endif 00123 00124 { 00125 int column_num; 00126 long field_len; 00127 int line_num; 00128 char *msg_name; 00129 int save_statement_number = 0; 00130 00131 # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) 00132 double end_time; 00133 double start_time; 00134 /* char time[20]; */ 00135 double total_cpu_time; 00136 struct rusage ru; 00137 # else 00138 00139 # if !defined(_HOST_OS_UNICOS) 00140 long end_clock; 00141 # endif 00142 float end_time; 00143 float start_time; 00144 float total_cpu_time; 00145 # endif 00146 00147 # if defined(_HOST_OS_UNICOS) && defined(_DEBUG) 00148 lowmem_check(); 00149 # endif 00150 00151 # if defined(_TARGET32) && defined(_DEBUG) 00152 setbuf(stdout, NULL); 00153 setbuf(stderr, NULL); 00154 # endif 00155 00156 00157 # if defined(_HOST_OS_UNICOS) 00158 00159 /* Lots of start up - ignore first call. See the comment block that */ 00160 /* precedes procedure cif_summary_rec in fecif.c for a discussion of the */ 00161 /* timing methods used by the different platforms. */ 00162 00163 SECOND(&start_time); 00164 00165 00166 /* M_LOWFIT will eventually be in malloc.h. */ 00167 /* When it is remove this definition. */ 00168 00169 # define M_LOWFIT 0107 /* Use lowest-fit algorithm for allocation. */ 00170 00171 mallopt(M_LOWFIT, 1); 00172 00173 # elif defined(_HOST_OS_MAX) 00174 00175 /* Use clock() on MPP's (in particular T3E's) because at the time this */ 00176 /* change was made, neither SECOND() nor SECONDR() worked on T3E's. */ 00177 /* LRR 4 Mar 1997 */ 00178 00179 clock(); 00180 start_time = 0; 00181 00182 /* M_LOWFIT will eventually be in malloc.h. */ 00183 /* When it is remove this definition. */ 00184 00185 # define M_LOWFIT 0107 /* Use lowest-fit algorithm for allocation. */ 00186 00187 mallopt(M_LOWFIT, 1); 00188 00189 # elif defined(_HOST_OS_SOLARIS) 00190 00191 /* clock() is only semi-useful on a Sun because it rolls over in just over */ 00192 /* 2147 seconds (about 36 minutes). So on a Sun, we use clock() and */ 00193 /* time() both. If elapsed time <= 2147 seconds, the accounting info will */ 00194 /* show milliseconds (from clock()), else it will show seconds (because */ 00195 /* that is the accuracy of time()). This resolution should be good enough */ 00196 /* for a compilation exceeding 36 minutes. */ 00197 00198 start_time = (float) time(NULL); 00199 clock(); 00200 00201 # elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) 00202 00203 getrusage (RUSAGE_SELF, &ru); 00204 start_time = (double) ru.ru_utime.tv_sec + 00205 (double) ru.ru_utime.tv_usec * 1e-6 + 00206 (double) ru.ru_stime.tv_sec + 00207 (double) ru.ru_stime.tv_usec * 1e-6; 00208 00209 # else 00210 00211 start_time = 0; 00212 00213 # endif 00214 00215 00216 comp_phase = Pass1_Parsing; 00217 stmt_start_line = 1; /* Set in case mem problems */ 00218 00219 if (init_compiler(argc, argv)) /* init and process cmd line */ 00220 return 1; /* -h option */ 00221 00222 if (on_off_flags.preprocess_only) { 00223 goto PREPROCESS_ONLY_SKIP; 00224 } 00225 00226 stmt_start_line = 0; 00227 00228 while (LA_CH_CLASS != Ch_Class_EOF) { 00229 00230 comp_phase = Pass1_Parsing; 00231 num_prog_unit_errors = 0; /* Accum errs for pgm unit */ 00232 00233 OUTPUT_PASS_HEADER(Syntax_Pass); 00234 00235 if (save_statement_number != 0) { 00236 statement_number = save_statement_number; 00237 } 00238 00239 parse_prog_unit(); 00240 save_statement_number = statement_number; 00241 00242 if (LA_CH_CLASS == Ch_Class_EOF) { 00243 issue_deferred_msgs(); 00244 } 00245 00246 /* get current field length and save largest value */ 00247 00248 field_len = (long) sbrk(0); 00249 00250 # if defined(_HOST_OS_MAX) 00251 field_len &= (1 << 32) - 1; 00252 # endif 00253 00254 if (field_len > max_field_len) { /* Max set in init_compiler */ 00255 max_field_len = field_len; /* Track max usage */ 00256 } 00257 00258 PRINT_IR_TBL; /* If -u ir and DEBUG compiler, print ir. */ 00259 00260 OUTPUT_PASS_HEADER(Semantics_Pass); 00261 00262 semantics_pass_driver(); /* PASS 2 */ 00263 00264 if (SCP_IN_ERR(curr_scp_idx)) { 00265 some_scp_in_err = TRUE; 00266 } 00267 00268 PRINT_ALL_SYM_TBLS; /* If debug print -u options */ 00269 PRINT_FORTRAN_OUT; /* Print ir in a fortran format */ 00270 00271 line_num = SH_GLB_LINE(SCP_LAST_SH_IDX(curr_scp_idx)); 00272 column_num = SH_COL_NUM(SCP_LAST_SH_IDX(curr_scp_idx)); 00273 00274 if (num_prog_unit_errors == 0) { 00275 if (opt_flags.inline_lvl > Inline_Lvl_0) { 00276 comp_phase = Inlining; 00277 inline_processing(SCP_FIRST_SH_IDX(curr_scp_idx)); 00278 PRINT_IR_TBL3; 00279 } 00280 } 00281 00282 insert_global_directives = TRUE; 00283 00284 comp_phase = Pdg_Conversion; 00285 if (dump_flags.preinline) { /* Do not do a full compile */ 00286 00287 if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module || 00288 ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Function || 00289 ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Subroutine) { 00290 curr_scp_idx = MAIN_SCP_IDX; 00291 create_mod_info_file(); /* Creates a name for the file. */ 00292 create_mod_info_tbl(); /* Creates the table. */ 00293 output_mod_info_file(); /* Writes the table. */ 00294 free_tables(); /* Frees the tables. */ 00295 } 00296 }/* if dump_flags.preinline */ 00297 00298 else { 00299 if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module) { 00300 create_mod_info_file(); /* Creates a name for the file. */ 00301 } 00302 00303 if (num_prog_unit_errors == 0 && (binary_output || assembly_output)) { 00304 cvrt_to_pdg(compiler_gen_date); 00305 } 00306 00307 else if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module) { 00308 if (!SCP_IN_ERR(MAIN_SCP_IDX)) { 00309 curr_scp_idx = MAIN_SCP_IDX; 00310 create_mod_info_tbl(); /* Creates the table. */ 00311 output_mod_info_file(); /* Writes the table. */ 00312 } 00313 00314 free_tables(); /* Frees the tables. */ 00315 } 00316 else { 00317 free_tables(); /* Frees the tables. */ 00318 } 00319 } 00320 00321 /* ALERT - At this point, the symbol tables are invalid. */ 00322 00323 /* Spit out the End Unit for the current program unit. The End Unit */ 00324 /* is needed if the Compiler Information File (CIF) is being produced */ 00325 /* and for the buffered message file. */ 00326 00327 stmt_start_line = line_num; 00328 stmt_start_col = column_num; 00329 00330 if (scp_tbl == NULL_IDX) { /* Table has been freed. */ 00331 cif_end_unit_rec(program_unit_name); 00332 } 00333 else { 00334 cif_end_unit_rec(AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx))); 00335 } 00336 00337 } /* while */ 00338 00339 clean_up_module_files(); 00340 00341 # ifdef _NAME_SUBSTITUTION_INLINING 00342 if (!dump_flags.preinline) 00343 # endif 00344 terminate_PDGCS(); 00345 00346 PRINT_GL_TBL; /* Prints to debug_file ifdef _DEBUG and -u gl */ 00347 PRINT_GN_TBL; /* Prints to debug_file ifdef _DEBUG and -u gn */ 00348 00349 00350 PREPROCESS_ONLY_SKIP: 00351 00352 00353 # if defined(_HOST_OS_UNICOS) 00354 00355 SECOND(&end_time); 00356 00357 # elif defined(_HOST_OS_MAX) 00358 00359 end_clock = clock(); 00360 end_time = 0; 00361 00362 # elif defined(_HOST_OS_SOLARIS) 00363 00364 end_time = (float) time(NULL); 00365 end_clock = clock(); 00366 00367 # elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) 00368 00369 getrusage(RUSAGE_SELF, &ru); 00370 end_time = (double) ru.ru_utime.tv_sec + 00371 (double) ru.ru_utime.tv_usec * 1e-6 + 00372 (double) ru.ru_stime.tv_sec + 00373 (double) ru.ru_stime.tv_usec * 1e-6; 00374 00375 # else 00376 00377 end_time = 0; 00378 00379 # endif 00380 00381 00382 total_cpu_time = end_time - start_time; 00383 00384 if (cif_need_unit_rec && cif_first_pgm_unit) { 00385 00386 /* Catastrophic errors, like a free source form program was compiled */ 00387 /* in fixed source form mode, so no Unit record was output. Output */ 00388 /* enough records to keep libcif tools happy. This routine needs to be */ 00389 /* called whether or not a CIF is being written because the buffered */ 00390 /* message file also must have the correct format. */ 00391 00392 cif_fake_a_unit(); 00393 } 00394 00395 00396 /* CAUTION: The following code assumes that non-Cray platforms measure */ 00397 /* memory usage in terms of bytes and that there are 4 bytes per word. */ 00398 00399 cif_summary_rec(release_level, 00400 compiler_gen_date, 00401 compiler_gen_time, 00402 total_cpu_time, 00403 00404 # if defined(_HOST_OS_UNICOS) 00405 00406 (long) 0, 00407 (some_scp_in_err) ? -3 : max_field_len); 00408 00409 # elif defined(_HOST_OS_MAX) 00410 00411 end_clock, 00412 (some_scp_in_err) ? -3 : max_field_len); 00413 00414 # elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) 00415 00416 (long) 0, 00417 (some_scp_in_err) ? -3 : max_field_len/4); 00418 00419 # else /* defined(_HOST_OS_SOLARIS) */ 00420 00421 end_clock, 00422 (some_scp_in_err) ? -3 : max_field_len/4); 00423 00424 # endif 00425 00426 00427 /* Output compilation summary info if the -V option was specified on the */ 00428 /* command line. Also, issue the summary information if any messages were */ 00429 /* actually issued. */ 00430 00431 if (cmd_line_flags.verify_option || 00432 num_errors > 0 || 00433 num_warnings > 0 || 00434 num_cautions > 0 || 00435 num_notes > 0 || 00436 num_comments > 0 || 00437 num_ansi > 0 || 00438 (num_optz_msgs > 0 && opt_flags.msgs)) { 00439 print_buffered_messages(); 00440 print_id_line(); 00441 00442 /* Output the summary lines. The compilation time is in seconds. */ 00443 /* CAUTION: The following non-Cray code assumes a 32-bit word. */ 00444 00445 # if defined(_HOST_OS_UNICOS) 00446 00447 PRINTMSG (0, 104, Log_Summary, 0, (double) total_cpu_time); 00448 msg_name = "cf90"; 00449 00450 # elif defined(_HOST_OS_MAX) 00451 00452 PRINTMSG (0, 104, Log_Summary, 0, (double) end_clock/1000000.0); 00453 msg_name = "cf90"; 00454 00455 # elif defined(_HOST_OS_LINUX) 00456 msg_name = "sgif90"; 00457 00458 # elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) 00459 00460 /* IRIX cannot handle the int to float change necessary to get the */ 00461 /* time printed correctly, so we'll convert it to a character string */ 00462 /* and use a different message. */ 00463 /* */ 00464 /* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */ 00465 /* he did not want this line in the summary lines. */ 00466 00467 /* sprintf(time, "%-1.2f", (double) total_cpu_time); 00468 PRINTMSG (0, 1310, Log_Summary, 0, time); */ 00469 msg_name = "cf90"; 00470 00471 # elif defined(_HOST_OS_SOLARIS) 00472 00473 PRINTMSG (0, 104, Log_Summary, 0, 00474 (total_cpu_time <= 2147.0) ? (float) end_clock/1000000.0 : 00475 (float) total_cpu_time); 00476 msg_name = "cf90"; 00477 00478 # endif 00479 00480 00481 /* Maximum field length (maximum amount of memory used) in words */ 00482 /* (decimal). */ 00483 /* CAUTION: Non-Cray platforms are assumed to measure memory usage in */ 00484 /* bytes and we assume 4 bytes per word. */ 00485 00486 # if defined(_HOST_OS_UNICOS) 00487 00488 PRINTMSG (0, 105, Log_Summary, 0, max_field_len); 00489 00490 # elif ! (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) 00491 00492 /* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */ 00493 /* he did not want this line in the summary lines. */ 00494 00495 PRINTMSG (0, 105, Log_Summary, 0, max_field_len/4); 00496 00497 # endif 00498 00499 00500 /* Number of source lines compiled. */ 00501 00502 # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) && !defined(_TARGET_SV2) 00503 00504 PRINTMSG (0, 1401, Log_Summary, 0, --curr_glb_line); 00505 00506 # else 00507 00508 PRINTMSG (0, 106, Log_Summary, 0, --curr_glb_line); 00509 00510 # endif 00511 00512 00513 /* Number of messages issued. */ 00514 00515 # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) && !defined(_TARGET_SV2) 00516 00517 PRINTMSG (0, 1403, Log_Summary, 0, 00518 num_errors, 00519 num_warnings, 00520 (opt_flags.msgs == 0) ? 00521 (num_cautions + num_notes + num_comments) : 00522 (num_cautions + num_notes + num_comments + num_optz_msgs), 00523 num_ansi); 00524 00525 # else 00526 00527 PRINTMSG (0, 107, Log_Summary, 0, 00528 num_errors, 00529 num_warnings, 00530 (opt_flags.msgs == 0) ? 00531 (num_cautions + num_notes + num_comments) : 00532 (num_cautions + num_notes + num_comments + num_optz_msgs), 00533 num_ansi); 00534 00535 00536 /* Code: in words; data: in words. */ 00537 00538 /* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */ 00539 /* he did not want this line in the summary lines. */ 00540 00541 # if !defined(_TARGET_SV2) /* Prints blank for sv2 right now. */ 00542 PRINTMSG (0, 108, Log_Summary, 0, code_size, data_size); 00543 # endif 00544 00545 # endif 00546 00547 if (num_errors > 0 || 00548 num_warnings > 0 || 00549 num_cautions > 0 || 00550 num_notes > 0 || 00551 num_comments > 0 || 00552 num_ansi > 0 || 00553 (num_optz_msgs > 0 && opt_flags.msgs)) { 00554 PRINTMSG (0, 1636, Log_Summary, 0, msg_name, msg_name); 00555 } 00556 } /* End of summary printing. */ 00557 00558 00559 # ifdef _DEBUG 00560 00561 /* Get memory usage reports for these global tables. */ 00562 00563 final_src_input(); 00564 00565 MEM_REPORT(file_path_tbl); 00566 MEM_REPORT(global_attr_tbl); 00567 MEM_REPORT(global_bounds_tbl); 00568 MEM_REPORT(global_line_tbl); 00569 MEM_REPORT(global_name_tbl); 00570 MEM_REPORT(global_type_tbl); 00571 MEM_REPORT(str_pool); 00572 00573 # endif 00574 00575 exit_compiler ((num_errors == 0) ? RC_OKAY : RC_USER_ERROR); 00576 00577 } /* main */ 00578 00579 00580 /******************************************************************************\ 00581 |* *| 00582 |* Description: *| 00583 |* initialize the compiler; allocate initial data structure memory on the *| 00584 |* heap, initialize variables, the source stack, the symbol table and do *| 00585 |* command line processing. *| 00586 |* *| 00587 |* Input parameters: *| 00588 |* argc number of command line arguments *| 00589 |* argv argument strings *| 00590 |* *| 00591 |* Output parameters: *| 00592 |* none *| 00593 |* *| 00594 |* Returns: nothing *| 00595 |* *| 00596 \******************************************************************************/ 00597 00598 static int init_compiler (int argc, 00599 char *argv[]) 00600 { 00601 extern void init_lex (void); 00602 extern void init_msg_processing (char *[]); 00603 extern void init_src_input (void); 00604 extern void init_type (void); 00605 extern int process_cmd_line (int, char *[]); 00606 extern void init_cond_comp(void); 00607 extern void enter_predefined_macros(void); 00608 extern void init_parse_prog_unit(void); 00609 extern void init_PDGCS (void); 00610 extern void set_up_token_tables(void); 00611 extern void sgi_cmd_line(int *argc, char **argv[]); 00612 extern char *operator_str[]; 00613 extern void verify_semantic_tbls(void); 00614 00615 int idx; 00616 00617 TRACE (Func_Entry, "init_compiler", NULL); 00618 00619 init_date_time_info (); /* set compilation data and time */ 00620 init_msg_processing (argv); /* initialize for messages. Must */ 00621 /* preceed process_cmd_line. */ 00622 00623 # ifdef _DEBUG 00624 check_defines_compatibility(); /* Is the compiler built correctly? */ 00625 check_enums_for_change(); /* Some enums must not be changed. */ 00626 # endif 00627 00628 # if 0 00629 check_license(); 00630 # endif 00631 00632 /* allocate memory for data structures required across compilation units. */ 00633 /* These must preceed process_cmd_line. */ 00634 00635 TBL_ALLOC (global_line_tbl); 00636 TBL_ALLOC (global_name_tbl); 00637 TBL_ALLOC (global_attr_tbl); 00638 TBL_ALLOC (global_type_tbl); 00639 TBL_ALLOC (global_bounds_tbl); 00640 TBL_ALLOC (global_ir_tbl); 00641 TBL_ALLOC (global_ir_list_tbl); 00642 TBL_ALLOC (global_sh_tbl); 00643 TBL_ALLOC (file_path_tbl); 00644 TBL_ALLOC (str_pool); 00645 00646 init_release_level (); /* Set up release_level from system */ 00647 str_pool[0].name_long = 0; 00648 str_pool[1].name_long = 0; 00649 str_pool[2].name_long = LARGE_WORD_FOR_TBL_SRCH; 00650 str_pool_idx = 2; 00651 00652 TBL_REALLOC_CK(global_name_tbl, 2); 00653 CLEAR_TBL_NTRY(global_name_tbl, 1); 00654 CLEAR_TBL_NTRY(global_name_tbl, 2); 00655 GN_NAME_IDX(1) = 1; 00656 GN_NAME_LEN(1) = HOST_BYTES_PER_WORD; 00657 GN_NAME_IDX(2) = 2; 00658 GN_NAME_LEN(2) = HOST_BYTES_PER_WORD; 00659 00660 /* Initialize the bounds table for deferred shape arrays */ 00661 00662 TBL_REALLOC_CK(global_bounds_tbl, 7); 00663 00664 for (idx = BD_DEFERRED_1_IDX; idx <= BD_DEFERRED_7_IDX; idx++) { 00665 CLEAR_TBL_NTRY(global_bounds_tbl, idx); 00666 GB_ARRAY_CLASS(idx) = Deferred_Shape; 00667 GB_RANK(idx) = idx; 00668 } 00669 00670 /* Initialize the conditional compilation tables. It must be done before */ 00671 /* the command line processing because of the -D and -U options. */ 00672 00673 init_cond_comp (); 00674 00675 get_machine_chars(); 00676 00677 set_up_token_tables(); 00678 00679 /* The following routines sets things such as target_ieee, target_triton */ 00680 /* two_word_fcd, word_byte_size ect... */ 00681 00682 set_compile_info_for_target(); 00683 00684 comp_phase = Cmdline_Parsing; 00685 00686 cif_name[0] = NULL_CHAR; 00687 00688 assembly_listing_file[0] = NULL_CHAR; 00689 00690 debug_file_name[0] = NULL_CHAR; 00691 00692 # if defined(GENERATE_WHIRL) 00693 /* sgi_cmd_line does some option manipulation, process SGI specific */ 00694 /* command line options, and strips out things that the front-end doesn't */ 00695 /* need to see. */ 00696 00697 sgi_cmd_line (&argc,&argv); 00698 # else 00699 /* 00700 * Solaris workaround 00701 * we need to force it to call sgi_cmd_line() even on Solaris 00702 */ 00703 sgi_cmd_line(&argc,&argv); 00704 # endif 00705 00706 /* 00707 * Solaris NOTE: 00708 * After sgi_cmd_line, argv has been changed! 00709 * 00710 */ 00711 00712 if (process_cmd_line (argc, argv)) /* pass input args */ 00713 return 1; /*option is -h*/ 00714 00715 # if defined(_INTEGER_1_AND_2) 00716 00717 if (on_off_flags.integer_1_and_2) { 00718 bit_size_tbl[Integer_1] = 8; 00719 bit_size_tbl[Integer_2] = 16; 00720 bit_size_tbl[Logical_1] = 8; 00721 bit_size_tbl[Logical_2] = 16; 00722 00723 storage_bit_size_tbl[Integer_1] = 8; 00724 storage_bit_size_tbl[Integer_2] = 16; 00725 storage_bit_size_tbl[Logical_1] = 8; 00726 storage_bit_size_tbl[Logical_2] = 16; 00727 00728 storage_bit_prec_tbl[Integer_1] = 8; 00729 storage_bit_prec_tbl[Integer_2] = 16; 00730 storage_bit_prec_tbl[Logical_1] = 8; 00731 storage_bit_prec_tbl[Logical_2] = 16; 00732 00733 stride_mult_unit_in_bits[Integer_1] = 8; 00734 stride_mult_unit_in_bits[Integer_2] = 16; 00735 stride_mult_unit_in_bits[Logical_1] = 8; 00736 stride_mult_unit_in_bits[Logical_2] = 16; 00737 00738 linear_to_arith[Integer_1] = AR_Int_8_S; 00739 linear_to_arith[Integer_2] = AR_Int_16_S; 00740 00741 input_arith_type[Integer_1] = AR_Int_8_U; 00742 input_arith_type[Integer_2] = AR_Int_16_U; 00743 00744 strcpy(arith_type_string[Integer_1], "AR_Int_8_U"); 00745 strcpy(arith_type_string[Integer_2], "AR_Int_16_U"); 00746 } 00747 # endif 00748 00749 comp_phase = Pass1_Parsing; 00750 00751 /* only -V info requested */ 00752 00753 if (argc == 2 && cmd_line_flags.verify_option) { 00754 print_id_line(); 00755 exit_compiler(RC_OKAY); 00756 } 00757 00758 if (num_errors != 0) { /* command line errors */ 00759 PRINTMSG(0, 912, Log_Summary, 0, num_errors); 00760 exit_compiler(RC_USER_ERROR); 00761 } 00762 00763 /* Call init_cif even if the user did NOT request Compiler Information */ 00764 /* File (CIF) output because the CIF is used for messaging. */ 00765 00766 init_cif(comp_date_time, release_level); 00767 00768 some_scp_in_err = FALSE; 00769 clearing_blk_stk = FALSE; 00770 00771 init_type(); 00772 00773 make_table_changes (); 00774 00775 init_sytb (); /* Must be before src_input for err msgs */ 00776 00777 /* Enter conditional compilation predefined macros. This must happen */ 00778 /* after process_cmd_line because it calls GETPMC (and the information */ 00779 /* from GETPMC is needed to set the predefined macros that depend on the */ 00780 /* target machine). This call must also happen after target_triton and */ 00781 /* target_ieee have been set so that we can get _CRAYIEEE set correctly. */ 00782 /* And finally, this call must come before init_src_input because that */ 00783 /* procedure gets the first source line - which could be a conditional */ 00784 /* compilation directive. */ 00785 00786 enter_predefined_macros(); 00787 00788 /* Must do the first call here so that tables needed by conditional */ 00789 /* compilation are set up. */ 00790 init_parse_prog_unit(); 00791 00792 init_src_input(); 00793 00794 if (on_off_flags.preprocess_only) { 00795 preprocess_only_driver(); 00796 issue_deferred_msgs(); 00797 00798 TRACE (Func_Exit, "init_compiler", NULL); 00799 00800 return 0; 00801 } 00802 00803 init_lex (); 00804 00805 max_field_len = (long) sbrk(0); /* Keep track of memory usage */ 00806 00807 # if defined(_HOST_OS_MAX) 00808 max_field_len &= (1 << 32) - 1; 00809 # endif 00810 00811 00812 /* Pathological case: The file is empty. At least an END statement must */ 00813 /* be present to constitute a valid Fortran program. */ 00814 00815 if (LA_CH_CLASS == Ch_Class_EOF) { 00816 PRINTMSG(0, 1391, Log_Warning, 0, src_file); 00817 issue_deferred_msgs(); 00818 } 00819 00820 00821 # ifdef _NAME_SUBSTITUTION_INLINING 00822 if (!dump_flags.preinline) 00823 # endif 00824 00825 init_PDGCS(); 00826 00827 # ifdef _DEBUG 00828 00829 #if 0 00830 /* verify_semantic_tbls(); */ /* Make sure flags and messages agree. */ 00831 00832 if (strcmp(operator_str[The_Last_Opr], "The_Last_Opr") != 0) { 00833 PRINTMSG(1, 689, Internal, 0); 00834 } 00835 #endif 00836 # endif 00837 00838 TRACE (Func_Exit, "init_compiler", NULL); 00839 00840 return 0; 00841 00842 } /* init_compiler */ 00843 00844 00845 /******************************************************************************\ 00846 |* *| 00847 |* Description: *| 00848 |* Initialize the compiler date and time info; comp_date_time has the *| 00849 |* format "Ddd Mmm dd, yyyy hh:mm:ss\0". *| 00850 |* *| 00851 |* Input parameters: *| 00852 |* NONE *| 00853 |* *| 00854 |* Output parameters: *| 00855 |* NONE *| 00856 |* *| 00857 |* Returns: *| 00858 |* NOTHING *| 00859 |* *| 00860 \******************************************************************************/ 00861 00862 static void init_date_time_info (void) 00863 00864 { 00865 time_t begin_time; 00866 static char *date_time_str; /*Ptr to-> Ddd Mmm dd hh:mm:ss yyyy\n */ 00867 00868 00869 TRACE (Func_Entry, "init_date_time_info", NULL); 00870 00871 time (&begin_time); 00872 date_time_str = ctime (&begin_time); 00873 00874 /* change date_time_str in format: Ddd Mmm dd hh:mm:ss yyyy\n\0 */ 00875 /* to comp_date_time in format: Ddd Mmm dd, yyyy hh:mm:ss\0 */ 00876 /* Note: CIF processing also depends on this format for the contents of */ 00877 /* comp_date_time. */ 00878 00879 memcpy (comp_date_time, date_time_str, 10); /* Ddd Mmm dd */ 00880 comp_date_time[10] = COMMA; 00881 memcpy (comp_date_time+11, date_time_str+19, 5); /* yyyy */ 00882 comp_date_time[16] = BLANK; 00883 memcpy (comp_date_time+17, date_time_str+10, 9); /* hh:mm:ss */ 00884 comp_date_time[26] = EOS; 00885 00886 TRACE (Func_Exit, "init_date_time_info", NULL); 00887 00888 return; 00889 00890 } /* init_date_time_info */ 00891 00892 00893 /******************************************************************************\ 00894 |* *| 00895 |* Description: *| 00896 |* Do license manager stuff for solaris and dpe compilers. *| 00897 |* *| 00898 |* FlexLM is license manager that controls access to shipped *| 00899 |* executables according to application specific rules. *| 00900 |* *| 00901 |* cray_lm_checkout obtains a license using a predefined licensing *| 00902 |* policy based on the product code passed as the first parameter. *| 00903 |* *| 00904 |* Input parameters: *| 00905 |* NONE *| 00906 |* *| 00907 |* Output parameters: *| 00908 |* NONE *| 00909 |* *| 00910 |* Returns: *| 00911 |* NOTHING *| 00912 |* *| 00913 \******************************************************************************/ 00914 # if 0 00915 00916 static void check_license (void) 00917 00918 { 00919 # define CRAY_LM_NQE 1 00920 # define CRAY_LM_DPE 2 00921 # define CRAY_LM_F90E 3 00922 00923 # define LM_NOWAIT 0 00924 # define LM_WAIT 1 00925 00926 extern int cray_lm_checkout(int, char *, int, int, char *, double); 00927 int ignore = 0; 00928 double version = 1.0; 00929 00930 00931 TRACE (Func_Entry, "check_license", NULL); 00932 00933 # if defined(_TARGET_OS_UNICOS) || defined(_TARGET_OS_MAX) 00934 if (cray_lm_checkout(CRAY_LM_DPE, "", LM_NOWAIT, ignore, "", version)) { 00935 # else 00936 if (cray_lm_checkout(CRAY_LM_F90E, "", LM_NOWAIT, ignore, "", version)) { 00937 # endif 00938 00939 /* This compiler is not licensed on this hardware. */ 00940 00941 PRINTMSG(0, 631, Log_Error, 0); 00942 exit_compiler(RC_USER_ERROR); 00943 } 00944 00945 TRACE (Func_Exit, "check_license", NULL); 00946 00947 return; 00948 00949 } /* check_license */ 00950 00951 # endif 00952 00953 00954 /******************************************************************************\ 00955 |* *| 00956 |* Description: *| 00957 |* Check defines compatibility. *| 00958 |* *| 00959 |* Input parameters: *| 00960 |* NONE *| 00961 |* *| 00962 |* Output parameters: *| 00963 |* NONE *| 00964 |* *| 00965 |* Returns: *| 00966 |* NOTHING *| 00967 |* *| 00968 \******************************************************************************/ 00969 00970 static void check_defines_compatibility(void) 00971 00972 { 00973 00974 TRACE (Func_Entry, "check_defines_compatibility", NULL); 00975 00976 /* Make sure that both pairs of a defines are not set. */ 00977 00978 # if defined(_MODULE_TO_DOT_o) && defined(_MODULE_TO_DOT_M) 00979 PRINTMSG(1, 1114, Internal, 0, 00980 "_MODULE_TO_DOT_o", 00981 "_MODULE_TO_DOT_M"); 00982 # endif 00983 00984 # if defined(_HEAP_REQUEST_IN_BYTES) && defined(_HEAP_REQUEST_IN_WORDS) 00985 PRINTMSG(1, 1114, Internal, 0, 00986 "_HEAP_REQUEST_IN_BYTES", 00987 "_HEAP_REQUEST_IN_WORDS"); 00988 # endif 00989 00990 # if defined(_HOST32) && defined(_HOST64) 00991 PRINTMSG(1, 1114, Internal, 0, 00992 "_HOST32", 00993 "_HOST64"); 00994 # endif 00995 00996 # if defined(_TARGET32) && defined(_TARGET64) 00997 PRINTMSG(1, 1114, Internal, 0, 00998 "_TARGET32", 00999 "_TARGET64"); 01000 # endif 01001 01002 # if defined(_TARGET_WORD_ADDRESS) && defined(_TARGET_BYTE_ADDRESS) 01003 PRINTMSG(1, 1114, Internal, 0, 01004 "_TARGET_WORD_ADDRESS", 01005 "_TARGET_BYTE_ADDRESS"); 01006 # endif 01007 01008 # if 0 01009 /* Make sure at least one defines of a pair is set. */ 01010 01011 # if !defined(_MODULE_TO_DOT_o) && !defined(_MODULE_TO_DOT_M) 01012 01013 if (!on_off_flags.module_to_mod) { /* Need -em or one of these defined */ 01014 PRINTMSG(1, 1116, Internal, 0, 01015 "_MODULE_TO_DOT_o", 01016 "_MODULE_TO_DOT_M"); 01017 } 01018 # endif 01019 # endif 01020 01021 # if !defined(_HEAP_REQUEST_IN_BYTES) && !defined(_HEAP_REQUEST_IN_WORDS) 01022 PRINTMSG(1, 1116, Internal, 0, 01023 "_HEAP_REQUEST_IN_BYTES", 01024 "_HEAP_REQUEST_IN_WORDS"); 01025 # endif 01026 01027 # if !defined(_HOST32) && !defined(_HOST64) 01028 PRINTMSG(1, 1116, Internal, 0, 01029 "_HOST32", 01030 "_HOST64"); 01031 # endif 01032 01033 # if !defined(_TARGET32) && !defined(_TARGET64) 01034 PRINTMSG(1, 1116, Internal, 0, 01035 "_TARGET32", 01036 "_TARGET64"); 01037 # endif 01038 01039 # if !defined(_TARGET_WORD_ADDRESS) && !defined(_TARGET_BYTE_ADDRESS) 01040 PRINTMSG(1, 1116, Internal, 0, 01041 "_TARGET_WORD_ADDRESS", 01042 "_TARGET_BYTE_ADDRESS"); 01043 # endif 01044 01045 TRACE (Func_Exit, "check_defines_compatibility", NULL); 01046 01047 return; 01048 01049 } /* check_defines_compatibility */ 01050 01051 01052 /******************************************************************************\ 01053 |* *| 01054 |* Description: *| 01055 |* This routine fills in some tables according to target or command *| 01056 |* line changes. *| 01057 |* *| 01058 |* Input parameters: *| 01059 |* NONE *| 01060 |* *| 01061 |* Output parameters: *| 01062 |* NONE *| 01063 |* *| 01064 |* Returns: *| 01065 |* NOTHING *| 01066 |* *| 01067 \******************************************************************************/ 01068 01069 static void make_table_changes(void) 01070 01071 { 01072 int i; 01073 int k; 01074 01075 TRACE (Func_Entry, "make_table_changes", NULL); 01076 01077 # ifdef _ARITH_H 01078 # if defined(_TARGET64) 01079 01080 if (target_ieee) { 01081 # if defined(_TARGET_OS_MAX) || defined(_WHIRL_HOST64_TARGET64) 01082 linear_to_arith[Real_4] = AR_Float_IEEE_NR_32; 01083 linear_to_arith[Real_8] = AR_Float_IEEE_NR_64; 01084 linear_to_arith[Real_16] = AR_Float_IEEE_NR_128; 01085 linear_to_arith[Complex_4] = AR_Complex_IEEE_NR_32; 01086 linear_to_arith[Complex_8] = AR_Complex_IEEE_NR_64; 01087 linear_to_arith[Complex_16] = AR_Complex_IEEE_NR_128; 01088 01089 input_arith_type[Real_4] = AR_Float_IEEE_NR_32; 01090 input_arith_type[Real_8] = AR_Float_IEEE_NR_64; 01091 input_arith_type[Real_16] = AR_Float_IEEE_NR_128; 01092 input_arith_type[Complex_4] = AR_Complex_IEEE_NR_32; 01093 input_arith_type[Complex_8] = AR_Complex_IEEE_NR_64; 01094 input_arith_type[Complex_16] = AR_Complex_IEEE_NR_128; 01095 01096 strcpy(arith_type_string[Real_4], "AR_Float_IEEE_NR_32"); 01097 strcpy(arith_type_string[Real_8], "AR_Float_IEEE_NR_64"); 01098 strcpy(arith_type_string[Real_16], "AR_Float_IEEE_NR_128"); 01099 strcpy(arith_type_string[Complex_4], "AR_Complex_IEEE_NR_32"); 01100 strcpy(arith_type_string[Complex_8], "AR_Complex_IEEE_NR_64"); 01101 strcpy(arith_type_string[Complex_16], "AR_Complex_IEEE_NR_128"); 01102 # else 01103 linear_to_arith[Real_4] = AR_Float_IEEE_NR_64; 01104 linear_to_arith[Real_8] = AR_Float_IEEE_NR_64; 01105 linear_to_arith[Real_16] = AR_Float_IEEE_NR_128; 01106 linear_to_arith[Complex_4] = AR_Complex_IEEE_NR_64; 01107 linear_to_arith[Complex_8] = AR_Complex_IEEE_NR_64; 01108 linear_to_arith[Complex_16] = AR_Complex_IEEE_NR_128; 01109 01110 input_arith_type[Real_4] = AR_Float_IEEE_NR_64; 01111 input_arith_type[Real_8] = AR_Float_IEEE_NR_64; 01112 input_arith_type[Real_16] = AR_Float_IEEE_NR_128; 01113 input_arith_type[Complex_4] = AR_Complex_IEEE_NR_64; 01114 input_arith_type[Complex_8] = AR_Complex_IEEE_NR_64; 01115 input_arith_type[Complex_16] = AR_Complex_IEEE_NR_128; 01116 01117 strcpy(arith_type_string[Real_4], "AR_Float_IEEE_NR_64"); 01118 strcpy(arith_type_string[Real_8], "AR_Float_IEEE_NR_64"); 01119 strcpy(arith_type_string[Real_16], "AR_Float_IEEE_NR_128"); 01120 strcpy(arith_type_string[Complex_4], "AR_Complex_IEEE_NR_64"); 01121 strcpy(arith_type_string[Complex_8], "AR_Complex_IEEE_NR_64"); 01122 strcpy(arith_type_string[Complex_16], "AR_Complex_IEEE_NR_128"); 01123 # endif 01124 } 01125 # endif 01126 # endif 01127 01128 if (CG_LOGICAL_DEFAULT_TYPE != LOGICAL_DEFAULT_TYPE) { 01129 01130 /* change the result types for the logical comparison tables */ 01131 01132 for (i = 0; i < Num_Linear_Types; i++ ) { 01133 for (k = 0; k < Num_Linear_Types; k++ ) { 01134 01135 if (eq_ne_tbl[i][k].type == CG_LOGICAL_DEFAULT_TYPE) { 01136 eq_ne_tbl[i][k].type = LOGICAL_DEFAULT_TYPE; 01137 } 01138 01139 if (lg_tbl[i][k].type == CG_LOGICAL_DEFAULT_TYPE) { 01140 lg_tbl[i][k].type = LOGICAL_DEFAULT_TYPE; 01141 } 01142 01143 if (gt_lt_tbl[i][k].type == CG_LOGICAL_DEFAULT_TYPE) { 01144 gt_lt_tbl[i][k].type = LOGICAL_DEFAULT_TYPE; 01145 } 01146 } 01147 } 01148 } 01149 01150 TRACE (Func_Exit, "make_table_changes", NULL); 01151 01152 return; 01153 01154 } /* make_table_changes */ 01155 01156 01157 /******************************************************************************\ 01158 |* *| 01159 |* Description: *| 01160 |* The following 3 routines are to be provided so that outside compiler *| 01161 |* pieces may call them to see what they're linked with. *| 01162 |* *| 01163 |* Input parameters: *| 01164 |* NONE *| 01165 |* *| 01166 |* Output parameters: *| 01167 |* NONE *| 01168 |* *| 01169 |* Returns: *| 01170 |* NOTHING *| 01171 |* *| 01172 \******************************************************************************/ 01173 01174 const char *fe_vers_name(void) 01175 { 01176 /* This function returns a string containing a printable */ 01177 /* name of the Fortran 90 frontend component. */ 01178 01179 return ("fe90"); 01180 01181 } /* fe_vers_name */ 01182 01183 01184 const char *fe_vers_ID(void) 01185 { 01186 /* This function returns a string containing the single-letter */ 01187 /* identifier for the Fortran 90 frontend component. */ 01188 01189 return ("f"); 01190 01191 } /* fe_vers_ID */ 01192 01193 01194 const char *fe_vers_number(void) 01195 { 01196 01197 /* This function returns a string containing the version */ 01198 /* number of the Fortran 90 frontend component. */ 01199 01200 return (frontend_version); 01201 01202 } /*fe_vers_number */ 01203 01204 01205 /******************************************************************************\ 01206 |* *| 01207 |* Description: *| 01208 |* Print the version information line for -V, whether it is used alone *| 01209 |* or with a full compilation. *| 01210 |* *| 01211 |* Input parameters: *| 01212 |* NONE *| 01213 |* *| 01214 |* Output parameters: *| 01215 |* NONE *| 01216 |* *| 01217 |* Returns: *| 01218 |* NOTHING *| 01219 |* *| 01220 \******************************************************************************/ 01221 01222 static void print_id_line(void) 01223 { 01224 01225 char version_string[16] = "######"; 01226 01227 01228 TRACE (Func_Exit, "print_id_line", NULL); 01229 01230 /* The Cray (PVP/MPP) compiler id line is: */ 01231 /* */ 01232 /* Cray CF90 Version n.n.n (levels) curr-date curr-time */ 01233 /* */ 01234 /* The id line for other platforms may vary somewhat from this. */ 01235 01236 # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) && !defined(_TARGET_SV2) 01237 sprintf(version_string, "%s%s", fe_vers_ID(), fe_vers_number()); 01238 # elif defined(_HOST_OS_SOLARIS) 01239 sprintf(version_string, "%s%s%s%s%s%s%s%s", 01240 fe_vers_ID(), fe_vers_number(), 01241 "p", "XX", 01242 "g", "XXX", 01243 arith_vers_ID(), arith_vers_number()); 01244 # else 01245 sprintf(version_string, "%s%s%s%s%s%s%s%s", 01246 fe_vers_ID(), fe_vers_number(), 01247 opt_vers_ID(), opt_vers_number(), 01248 be_vers_ID(), be_vers_number(), 01249 arith_vers_ID(), arith_vers_number()); 01250 # endif 01251 01252 01253 # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) && (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) 01254 01255 PRINTMSG (0, 1402, Log_Summary, 0, 01256 release_level, 01257 version_string, 01258 comp_date_time); 01259 01260 # else 01261 01262 PRINTMSG (0, 103, Log_Summary, 0, 01263 release_level, 01264 version_string, 01265 comp_date_time); 01266 01267 # endif 01268 01269 01270 TRACE (Func_Exit, "print_id_line", NULL); 01271 01272 return; 01273 01274 } /* print_id_line */ 01275 01276 01277 /******************************************************************************\ 01278 |* *| 01279 |* Description: *| 01280 |* Get_machine_chars is called to set the machine characteristics table *| 01281 |* for the compiler from the environment variable TARGET. *| 01282 |* *| 01283 |* Input parameters: *| 01284 |* NONE *| 01285 |* *| 01286 |* Output parameters: *| 01287 |* NONE *| 01288 |* *| 01289 |* Returns: *| 01290 |* NOTHING *| 01291 |* *| 01292 \******************************************************************************/ 01293 01294 static void get_machine_chars (void) 01295 01296 { 01297 # if defined(_TARGET_OS_UNICOS) || defined(_TARGET_OS_MAX) 01298 01299 # if defined(_GETPMC_AVAILABLE) 01300 extern int GETPMC(long *, char *); /* UNICOS library routine */ 01301 # else 01302 int idx; 01303 char *name; 01304 # endif 01305 01306 01307 TRACE (Func_Entry, "get_machine_chars", NULL); 01308 01309 # if defined(_GETPMC_AVAILABLE) 01310 01311 /* Use target_machine to get information about the host machine. */ 01312 /* This information is used by ntr_const_tbl to choose the algorithm */ 01313 /* it uses to convert and store floating point constants. */ 01314 01315 if (GETPMC (target_machine.mc_tbl, "host") == 0) { 01316 PRINTMSG (0, 584, Log_Error, 0, "GETPMC"); 01317 } 01318 01319 host_ieee = target_machine.fld.mcieee; 01320 01321 /* Set machine characteristics table based on the target environment. */ 01322 /* The target environment is either the machine the compiler is running */ 01323 /* on or the machine specified by the TARGET environment variable. */ 01324 01325 if (GETPMC (target_machine.mc_tbl, "target") == 0) { 01326 PRINTMSG (0, 584, Log_Error, 0, "GETPMC"); 01327 } 01328 01329 # else 01330 01331 name = getenv("TARGET"); 01332 01333 if (name == NULL) { 01334 PRINTMSG(0, 1052, Log_Error, 0); 01335 TRACE (Func_Exit, "get_machine_chars", NULL); 01336 exit_compiler(RC_USER_ERROR); 01337 } 01338 else { 01339 strcpy(target_machine.fld.mcpmt, name); 01340 01341 /* GETPMC translates the target machine name to upper case. */ 01342 01343 for (idx = 0; idx <= strlen(target_machine.fld.mcpmt); ++idx) { 01344 target_machine.fld.mcpmt[idx] = toupper(target_machine.fld.mcpmt[idx]); 01345 } 01346 } 01347 01348 # endif 01349 01350 TRACE (Func_Exit, "get_machine_chars", NULL); 01351 01352 # endif 01353 return; 01354 01355 } /* get_machine_chars */ 01356 01357 01358 /******************************************************************************\ 01359 |* *| 01360 |* Description: *| 01361 |* set_compile_info_for_target sets flags used for compilation based on *| 01362 |* the target being compiled for. *| 01363 |* *| 01364 |* Input parameters: *| 01365 |* NONE *| 01366 |* *| 01367 |* Output parameters: *| 01368 |* NONE *| 01369 |* *| 01370 |* Returns: *| 01371 |* NOTHING *| 01372 |* *| 01373 \******************************************************************************/ 01374 01375 static void set_compile_info_for_target (void) 01376 01377 { 01378 01379 01380 # if defined(_TARGET_OS_UNICOS) || defined(_TARGET_OS_MAX) 01381 union {long int_form; 01382 char char_form[9]; 01383 } cpu_type; 01384 # endif 01385 01386 TRACE (Func_Entry, "set_compile_info_for_target", NULL); 01387 01388 # if defined(_TARGET_SV2) 01389 target_os = Target_Sv2; 01390 # elif defined(_TARGET_OS_UNICOS) 01391 target_os = Target_Unicos; 01392 # elif defined(_TARGET_OS_LINUX) 01393 target_os = Target_Linux; 01394 # elif defined(_TARGET_OS_MAX) 01395 target_os = Target_Max; 01396 # elif defined(GENERATE_WHIRL) 01397 target_os = Target_Irix; 01398 # elif defined(_TARGET_OS_SOLARIS) 01399 target_os = Target_Solaris; 01400 # endif 01401 01402 01403 # if defined(_TWO_WORD_FCD) 01404 two_word_fcd = TRUE; 01405 # else 01406 two_word_fcd = FALSE; 01407 # endif 01408 01409 # if defined(_CHAR_LEN_IN_BYTES) 01410 char_len_in_bytes = TRUE; 01411 # else 01412 char_len_in_bytes = FALSE; 01413 # endif 01414 01415 # ifdef _TARGET_OS_UNICOS 01416 01417 # ifdef _GETPMC_AVAILABLE 01418 cpu_type.int_form = target_machine.fld.mcpmt; 01419 cpu_type.char_form[8] = '\0'; 01420 01421 if (strcmp("CRAY-TS", cpu_type.char_form) == 0) { 01422 two_word_fcd = TRUE; 01423 target_safevl = 128; 01424 storage_bit_size_tbl[CRI_Ch_Ptr_8] = 128; 01425 target_triton = TRUE; 01426 } 01427 else if (strcmp("CRAY-C90", cpu_type.char_form) == 0) { 01428 target_safevl = 128; 01429 } 01430 else if (strcmp("CRAY-SV1", cpu_type.char_form) == 0) { 01431 target_sv1 = TRUE; 01432 } 01433 else if (strcmp("CRAY-YMP", cpu_type.char_form) == 0) { 01434 cpu_type.int_form = target_machine.fld.mc_subtype1; 01435 cpu_type.char_form[8] = '\0'; 01436 01437 if (strcmp("CRAY-SV1", cpu_type.char_form) == 0) { 01438 target_sv1 = TRUE; 01439 } 01440 } 01441 01442 # else 01443 01444 if (strcmp("CRAY-TS", target_machine.fld.mcpmt) == 0) { 01445 two_word_fcd = TRUE; 01446 target_safevl = 128; 01447 storage_bit_size_tbl[CRI_Ch_Ptr_8] = 128; 01448 target_triton = TRUE; 01449 } 01450 else if (strcmp("CRAY-C90", target_machine.fld.mcpmt) == 0) { 01451 target_safevl = 128; 01452 } 01453 # if !defined(_TARGET_SV2) 01454 else if (strcmp("CRAY-SV1", target_machine.fld.mcpmt) == 0) { 01455 target_sv1 = TRUE; 01456 } 01457 else if ((strcmp("CRAY-YMP", target_machine.fld.mcpmt) == 0) && 01458 (strcmp("CRAY-SV1", target_machine.fld.mc_subtype1) == 0)) { 01459 target_sv1 = TRUE; 01460 } 01461 # endif 01462 01463 # endif 01464 01465 # endif 01466 01467 01468 # ifdef _TARGET_OS_MAX 01469 01470 # if defined(_GETPMC_AVAILABLE) 01471 cpu_type.int_form = target_machine.fld.mcpmt; 01472 cpu_type.char_form[8] = '\0'; 01473 01474 if (strcmp("CRAY-T3E", cpu_type.char_form) == 0) { 01475 char_len_in_bytes = TRUE; 01476 target_t3e = TRUE; 01477 } 01478 # else 01479 /* Assume this is a DPE compiler going from SOLARIS to Cray. */ 01480 01481 if (strcmp("CRAY-T3E", target_machine.fld.mcpmt) == 0) { 01482 char_len_in_bytes = TRUE; 01483 target_t3e = TRUE; 01484 } 01485 # endif 01486 01487 # endif 01488 01489 01490 # if defined(_TARGET_IEEE) 01491 target_ieee = TRUE; 01492 # else 01493 target_ieee = target_triton && target_machine.fld.mcieee; 01494 # endif 01495 01496 # if defined(_TARGET_SV2) 01497 true_value = 1; /* TRUE_VALUE */ 01498 # else 01499 if (target_ieee && target_triton) { 01500 true_value = 1; /* TRUE_VALUE */ 01501 } 01502 # endif 01503 01504 /* Set maximum character length based on machine type. */ 01505 01506 # if defined(_TARGET_OS_UNICOS) 01507 01508 if (target_triton) { 01509 max_character_length = 2147483647; /* (2**31) - 1 chars */ 01510 } 01511 else { 01512 max_character_length = 2097151; /* In byte size */ 01513 } 01514 01515 # elif defined(_TARGET_OS_MAX) 01516 01517 if (target_t3e) { 01518 01519 /* Set based on the maximum storage size from machine target info */ 01520 01521 max_character_length = 134217727; /* (2**27) - 1 chars */ 01522 } 01523 else { 01524 max_character_length = 2097151; /* In byte size */ 01525 } 01526 01527 # elif defined(GENERATE_WHIRL) 01528 01529 max_character_length = 268435455; /* (2**28) -1 chars */ 01530 01531 # else 01532 01533 max_character_length = 268435455; /* (2**28) -1 chars */ 01534 01535 # endif 01536 01537 01538 TRACE (Func_Exit, "set_compile_info_for_target", NULL); 01539 01540 return; 01541 01542 } /* set_compile_info_for_target */ 01543 01544 /******************************************************************************\ 01545 |* *| 01546 |* Description: *| 01547 |* init_release_level gets the compilers release string from a system *| 01548 |* file. It sets the global variable release_string. *| 01549 |* *| 01550 |* Input parameters: *| 01551 |* NONE *| 01552 |* *| 01553 |* Output parameters: *| 01554 |* NONE *| 01555 |* *| 01556 |* Returns: *| 01557 |* NOTHING *| 01558 |* *| 01559 \******************************************************************************/ 01560 /* 01561 a side effect of this function was the insertion of a string into 01562 str_pool; I removed this side effect, because the element 01563 inserted was always overwritten immediately after init_release_level 01564 returned ([email protected]) 01565 */ 01566 01567 static void init_release_level (void) 01568 01569 { 01570 char *char_ptr; 01571 /*int length;*/ 01572 char *location; 01573 char new_release[RELEASE_LEVEL_LEN]; 01574 /*int str_idx;*/ 01575 FILE *release_file_ptr; 01576 char *version_string_location = "COMPILER"; 01577 01578 01579 TRACE (Func_Entry, "init_release_level", NULL); 01580 01581 location = getenv(version_string_location); 01582 01583 if (location != NULL) { 01584 /*length = WORD_LEN(strlen(location) + 14);*/ 01585 /*str_idx = str_pool_idx;*/ 01586 01587 /*TBL_REALLOC_CK(str_pool, length);*/ 01588 01589 /*strcpy(&str_pool[str_idx].name_char, location);*/ 01590 01591 /*char_ptr = strrchr(&str_pool[str_idx].name_char, SLASH);*/ 01592 char_ptr = strrchr(location, SLASH); 01593 01594 if (char_ptr == NULL) { 01595 release_file_ptr = fopen("version.string", "r"); 01596 } 01597 else { 01598 strcpy(++char_ptr, "version.string"); 01599 /*release_file_ptr = fopen(&str_pool[str_idx].name_char, "r");*/ 01600 release_file_ptr = fopen(location, "r"); 01601 } 01602 01603 /* If not found - default to initial value in release_level #.x.x.x */ 01604 01605 if (release_file_ptr != NULL) { 01606 fgets(new_release, RELEASE_LEVEL_LEN, release_file_ptr); 01607 01608 if (new_release != NULL) { 01609 char_ptr = strrchr(new_release, NEWLINE); 01610 *char_ptr = EOS; 01611 strcpy(release_level, new_release); 01612 } 01613 } 01614 01615 /*str_pool_idx = str_idx;*/ 01616 } 01617 01618 TRACE (Func_Exit, "init_release_level", NULL); 01619 01620 return; 01621 01622 } /* init_release_level */ 01623 01624 # if defined(_DEBUG) 01625 /******************************************************************************\ 01626 |* *| 01627 |* Description: *| 01628 |* Check to make sure that the opr enum has only been changed at the *| 01629 |* bottom. This is not a failsafe check, but it is designed to make *| 01630 |* sure that nothing gets added or deleted at least. *| 01631 |* *| 01632 |* Input parameters: *| 01633 |* NONE *| 01634 |* *| 01635 |* Output parameters: *| 01636 |* NONE *| 01637 |* *| 01638 |* Returns: *| 01639 |* NOTHING *| 01640 |* *| 01641 \******************************************************************************/ 01642 static void check_enums_for_change(void) 01643 { 01644 01645 TRACE (Func_Entry, "check_enums_for_change", NULL); 01646 01647 if (Null_Opr != 0 || 01648 Defined_Un_Opr != 1 || 01649 Alloc_Opr != 2 || 01650 Eqv_Opr != 25 || 01651 Nint_Opr != 50 || 01652 Char_Opr != 75 || 01653 Rrspacing_Opr != 100 || 01654 Minval_Opr != 125 || 01655 Stop_Opr != 150 || 01656 Dv_Set_A_Contig != 175 || 01657 Aloc_Opr != 200 || 01658 Init_Reloc_Opr != 225 || 01659 Prefertask_Cdir_Opr != 250 || 01660 Wait_Cmic_Opr != 275 || 01661 Set_Ieee_Exception_Opr != 300 || 01662 Local_Pe_Dim_Opr != 325 || 01663 Fissionable_Star_Opr != 350 || 01664 End_Singleprocess_Par_Opr != 375 || 01665 Fetch_And_Nand_Opr != 400 || 01666 Endparallel_Open_Mp_Opr != 425 || 01667 Omp_In_Parallel_Opr != 450 || 01668 Io_Item_Type_Code_Opr != 475 || 01669 Copyin_Bound_Opr != 480) { 01670 01671 # if 0 01672 printf("Char_Opr %d\n ", Char_Opr); 01673 printf("Stop_Opr %d\n ", Stop_Opr); 01674 printf("Aloc_Opr %d\n ", Aloc_Opr); 01675 printf("Prefertask_Cdir_Opr %d\n ", Prefertask_Cdir_Opr); 01676 printf("Local_Pe_Dim_Opr %d\n ", Local_Pe_Dim_Opr); 01677 printf("Fetch_And_Nand_Opr %d\n ", Fetch_And_Nand_Opr); 01678 printf("Omp_In_Parallel_Opr %d\n ", Omp_In_Parallel_Opr); 01679 printf("Copyin_Bound_Opr %d\n ", Copyin_Bound_Opr); 01680 # endif 01681 01682 PRINTMSG(1, 1643, Internal, 0, "Operator"); 01683 } 01684 01685 TRACE (Func_Exit, "check_enums_for_change", NULL); 01686 01687 return; 01688 01689 } /* check_enums_for_change */ 01690 # endif