/*! @decl program load_module(string module_name) *! *! Load a binary module. *! *! This function loads a module written in C or some other language *! into Pike. The module is initialized and any programs or constants *! defined will immediately be available. *! *! When a module is loaded the C function @tt{pike_module_init()@} will *! be called to initialize it. When Pike exits @tt{pike_module_exit()@} *! will be called. These two functions @b{must@} be available in the module. *! *! @note *! The current working directory is normally not searched for *! dynamic modules. Please use @expr{"./name.so"@} instead of just *! @expr{"name.so"@} to load modules from the current directory. */ void f_load_module(INT32 args) { extern int global_callable_flags; void *module; modfun init, exit; struct module_list *new_module; struct pike_string *module_name; ONERROR err; module_name = Pike_sp[-args].u.string; if((Pike_sp[-args].type != T_STRING) || (module_name->size_shift) || string_has_null(module_name)) { Pike_error("Bad argument 1 to load_module()\n"); } { struct module_list *mp; for (mp = dynamic_module_list; mp; mp = mp->next) if (mp->name == module_name && mp->module_prog) { pop_n_elems(args); ref_push_program(mp->module_prog); return; } } /* Removing RTLD_GLOBAL breaks some PiGTK themes - Hubbe */ /* Using RTLD_LAZY is faster, but makes it impossible to * detect linking problems at runtime.. */ module=dlopen(module_name->str, RTLD_NOW /*|RTLD_GLOBAL*/ ); if(!module) { struct object *err_obj = low_clone (module_load_error_program); #define LOADERR_STRUCT(OBJ) \ ((struct module_load_error_struct *) (err_obj->storage + module_load_error_offset)) const char *err = dlerror(); if (err) { if (err[strlen (err) - 1] == '\n') push_string (make_shared_binary_string (err, strlen (err) - 1)); else push_text (err); } else push_constant_text ("Unknown reason"); add_ref (LOADERR_STRUCT (err_obj)->path = Pike_sp[-args - 1].u.string); add_ref (LOADERR_STRUCT (err_obj)->reason = Pike_sp[-1].u.string); if (Pike_sp[-args].u.string->len < 1024) { throw_error_object (err_obj, "load_module", Pike_sp - args - 1, args, "load_module(\"%s\") failed: %s\n", module_name->str, Pike_sp[-1].u.string->str); } else { throw_error_object (err_obj, "load_module", Pike_sp - args - 1, args, "load_module() failed: %s\n", Pike_sp[-1].u.string->str); } } #ifdef PIKE_DEBUG { struct module_list *mp; for (mp = dynamic_module_list; mp; mp = mp->next) if (mp->module == module && mp->module_prog) { fprintf(stderr, "load_module(): Module loaded twice:\n" "Old name: %s\n" "New name: %s\n", mp->name->str, module_name->str); pop_n_elems(args); ref_push_program(mp->module_prog); return; } } #endif /* PIKE_DEBUG */ init = CAST_TO_FUN(dlsym(module, "pike_module_init")); if (!init) { init = CAST_TO_FUN(dlsym(module, "_pike_module_init")); if (!init) { dlclose(module); Pike_error("pike_module_init missing in dynamic module \"%S\".\n", module_name); } } exit = CAST_TO_FUN(dlsym(module, "pike_module_exit")); if (!exit) { exit = CAST_TO_FUN(dlsym(module, "_pike_module_exit")); if (!exit) { dlclose(module); Pike_error("pike_module_exit missing in dynamic module \"%S\".\n", module_name); } } #if defined(__NT__) && defined(_M_IA64) { fprintf(stderr, "pike_module_init: 0x%p\n" " func: 0x%p\n" " gp: 0x%p\n", init, ((void **)init)[0], ((void **)init)[1]); fprintf(stderr, "pike_module_exit: 0x%p\n" " func: 0x%p\n" " gp: 0x%p\n", exit, ((void **)exit)[0], ((void **)exit)[1]); } #endif /* __NT__ && _M_IA64 */ new_module=ALLOC_STRUCT(module_list); new_module->next=dynamic_module_list; dynamic_module_list=new_module; new_module->module=module; copy_shared_string(new_module->name, Pike_sp[-args].u.string); new_module->module_prog = NULL; new_module->init=init; new_module->exit=exit; enter_compiler(new_module->name, 1); start_new_program(); global_callable_flags|=CALLABLE_DYNAMIC; #ifdef PIKE_DEBUG { struct svalue *save_sp=Pike_sp; #endif SET_ONERROR(err, cleanup_compilation, NULL); #if defined(__NT__) && defined(_M_IA64) fprintf(stderr, "Calling pike_module_init()...\n"); #endif /* __NT__ && _M_IA64 */ (*(modfun)init)(); #if defined(__NT__) && defined(_M_IA64) fprintf(stderr, "pike_module_init() done.\n"); #endif /* __NT__ && _M_IA64 */ UNSET_ONERROR(err); #ifdef PIKE_DEBUG if(Pike_sp != save_sp) Pike_fatal("load_module(%s) left %ld droppings on stack!\n", module_name->str, PTRDIFF_T_TO_LONG(Pike_sp - save_sp)); } #endif pop_n_elems(args); { struct program *p = end_program(); exit_compiler(); if (p) { if ( #if 0 p->num_identifier_references #else /* !0 */ 1 #endif /* 0 */ ) { push_program(p); add_ref(new_module->module_prog = Pike_sp[-1].u.program); } else { /* No identifier references -- Disabled module. */ free_program(p); push_undefined(); } } else { /* Initialization failed. */ new_module->exit(); dlclose(module); dynamic_module_list = new_module->next; free_string(new_module->name); free(new_module); Pike_error("Failed to initialize dynamic module \"%S\".\n", module_name); } } }
static void check_license (void) { # define CRAY_LM_NQE 1 # define CRAY_LM_DPE 2 # define CRAY_LM_F90E 3 # define LM_NOWAIT 0 # define LM_WAIT 1 extern int cray_lm_checkout(int, char *, int, int, char *, double); int ignore = 0; double version = 1.0; TRACE (Func_Entry, "check_license", NULL); # if defined(_TARGET_OS_UNICOS) || defined(_TARGET_OS_MAX) if (cray_lm_checkout(CRAY_LM_DPE, "", LM_NOWAIT, ignore, "", version)) { # else if (cray_lm_checkout(CRAY_LM_F90E, "", LM_NOWAIT, ignore, "", version)) { # endif /* This compiler is not licensed on this hardware. */ PRINTMSG(0, 631, Log_Error, 0); exit_compiler(RC_USER_ERROR); } TRACE (Func_Exit, "check_license", NULL); return; } /* check_license */ # endif /******************************************************************************\ |* *| |* Description: *| |* Check defines compatibility. *| |* *| |* Input parameters: *| |* NONE *| |* *| |* Output parameters: *| |* NONE *| |* *| |* Returns: *| |* NOTHING *| |* *| \******************************************************************************/ static void check_defines_compatibility(void) { TRACE (Func_Entry, "check_defines_compatibility", NULL); /* Make sure that both pairs of a defines are not set. */ # if defined(_MODULE_TO_DOT_o) && defined(_MODULE_TO_DOT_M) PRINTMSG(1, 1114, Internal, 0, "_MODULE_TO_DOT_o", "_MODULE_TO_DOT_M"); # endif # if defined(_HEAP_REQUEST_IN_BYTES) && defined(_HEAP_REQUEST_IN_WORDS) PRINTMSG(1, 1114, Internal, 0, "_HEAP_REQUEST_IN_BYTES", "_HEAP_REQUEST_IN_WORDS"); # endif # if defined(_HOST32) && defined(_HOST64) PRINTMSG(1, 1114, Internal, 0, "_HOST32", "_HOST64"); # endif # if defined(_TARGET32) && defined(_TARGET64) PRINTMSG(1, 1114, Internal, 0, "_TARGET32", "_TARGET64"); # endif # if defined(_TARGET_WORD_ADDRESS) && defined(_TARGET_BYTE_ADDRESS) PRINTMSG(1, 1114, Internal, 0, "_TARGET_WORD_ADDRESS", "_TARGET_BYTE_ADDRESS"); # endif # if 0 /* Make sure at least one defines of a pair is set. */ # if !defined(_MODULE_TO_DOT_o) && !defined(_MODULE_TO_DOT_M) if (!on_off_flags.module_to_mod) { /* Need -em or one of these defined */ PRINTMSG(1, 1116, Internal, 0, "_MODULE_TO_DOT_o", "_MODULE_TO_DOT_M"); } # endif # endif # if !defined(_HEAP_REQUEST_IN_BYTES) && !defined(_HEAP_REQUEST_IN_WORDS) PRINTMSG(1, 1116, Internal, 0, "_HEAP_REQUEST_IN_BYTES", "_HEAP_REQUEST_IN_WORDS"); # endif # if !defined(_HOST32) && !defined(_HOST64) PRINTMSG(1, 1116, Internal, 0, "_HOST32", "_HOST64"); # endif # if !defined(_TARGET32) && !defined(_TARGET64) PRINTMSG(1, 1116, Internal, 0, "_TARGET32", "_TARGET64"); # endif # if !defined(_TARGET_WORD_ADDRESS) && !defined(_TARGET_BYTE_ADDRESS) PRINTMSG(1, 1116, Internal, 0, "_TARGET_WORD_ADDRESS", "_TARGET_BYTE_ADDRESS"); # endif TRACE (Func_Exit, "check_defines_compatibility", NULL); return; } /* check_defines_compatibility */
static void get_machine_chars (void) { # if defined(_TARGET_OS_UNICOS) || defined(_TARGET_OS_MAX) # if defined(_GETPMC_AVAILABLE) extern int GETPMC(long *, char *); /* UNICOS library routine */ # else int idx; char *name; # endif TRACE (Func_Entry, "get_machine_chars", NULL); # if defined(_GETPMC_AVAILABLE) /* Use target_machine to get information about the host machine. */ /* This information is used by ntr_const_tbl to choose the algorithm */ /* it uses to convert and store floating point constants. */ if (GETPMC (target_machine.mc_tbl, "host") == 0) { PRINTMSG (0, 584, Log_Error, 0, "GETPMC"); } host_ieee = target_machine.fld.mcieee; /* Set machine characteristics table based on the target environment. */ /* The target environment is either the machine the compiler is running */ /* on or the machine specified by the TARGET environment variable. */ if (GETPMC (target_machine.mc_tbl, "target") == 0) { PRINTMSG (0, 584, Log_Error, 0, "GETPMC"); } # else name = getenv("TARGET"); if (name == NULL) { PRINTMSG(0, 1052, Log_Error, 0); TRACE (Func_Exit, "get_machine_chars", NULL); exit_compiler(RC_USER_ERROR); } else { strcpy(target_machine.fld.mcpmt, name); /* GETPMC translates the target machine name to upper case. */ for (idx = 0; idx <= strlen(target_machine.fld.mcpmt); ++idx) { target_machine.fld.mcpmt[idx] = toupper(target_machine.fld.mcpmt[idx]); } } # endif TRACE (Func_Exit, "get_machine_chars", NULL); # endif return; } /* get_machine_chars */
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 */
int main (int argc, char *argv[]) # endif { int column_num; long field_len; int line_num; char *msg_name; int save_statement_number = 0; # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) double end_time; double start_time; /* char time[20]; */ double total_cpu_time; struct rusage ru; # else # if !defined(_HOST_OS_UNICOS) long end_clock; # endif float end_time; float start_time; float total_cpu_time; # endif # if defined(_HOST_OS_UNICOS) && defined(_DEBUG) lowmem_check(); # endif # if defined(_TARGET32) && defined(_DEBUG) setbuf(stdout, NULL); setbuf(stderr, NULL); # endif # if defined(_HOST_OS_UNICOS) /* Lots of start up - ignore first call. See the comment block that */ /* precedes procedure cif_summary_rec in fecif.c for a discussion of the */ /* timing methods used by the different platforms. */ SECOND(&start_time); /* M_LOWFIT will eventually be in malloc.h. */ /* When it is remove this definition. */ # define M_LOWFIT 0107 /* Use lowest-fit algorithm for allocation. */ mallopt(M_LOWFIT, 1); # elif defined(_HOST_OS_MAX) /* Use clock() on MPP's (in particular T3E's) because at the time this */ /* change was made, neither SECOND() nor SECONDR() worked on T3E's. */ /* LRR 4 Mar 1997 */ clock(); start_time = 0; /* M_LOWFIT will eventually be in malloc.h. */ /* When it is remove this definition. */ # define M_LOWFIT 0107 /* Use lowest-fit algorithm for allocation. */ mallopt(M_LOWFIT, 1); # elif defined(_HOST_OS_SOLARIS) /* clock() is only semi-useful on a Sun because it rolls over in just over */ /* 2147 seconds (about 36 minutes). So on a Sun, we use clock() and */ /* time() both. If elapsed time <= 2147 seconds, the accounting info will */ /* show milliseconds (from clock()), else it will show seconds (because */ /* that is the accuracy of time()). This resolution should be good enough */ /* for a compilation exceeding 36 minutes. */ start_time = (float) time(NULL); clock(); # elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) getrusage (RUSAGE_SELF, &ru); start_time = (double) ru.ru_utime.tv_sec + (double) ru.ru_utime.tv_usec * 1e-6 + (double) ru.ru_stime.tv_sec + (double) ru.ru_stime.tv_usec * 1e-6; # else start_time = 0; # endif comp_phase = Pass1_Parsing; stmt_start_line = 1; /* Set in case mem problems */ init_compiler(argc, argv); /* init and process cmd line */ if (on_off_flags.preprocess_only) { goto PREPROCESS_ONLY_SKIP; } stmt_start_line = 0; while (LA_CH_CLASS != Ch_Class_EOF) { comp_phase = Pass1_Parsing; num_prog_unit_errors = 0; /* Accum errs for pgm unit */ OUTPUT_PASS_HEADER(Syntax_Pass); if (save_statement_number != 0) { statement_number = save_statement_number; } parse_prog_unit(); save_statement_number = statement_number; if (LA_CH_CLASS == Ch_Class_EOF) { issue_deferred_msgs(); } /* get current field length and save largest value */ field_len = (long) sbrk(0); # if defined(_HOST_OS_MAX) field_len &= (1 << 32) - 1; # endif if (field_len > max_field_len) { /* Max set in init_compiler */ max_field_len = field_len; /* Track max usage */ } PRINT_IR_TBL; /* If -u ir and DEBUG compiler, print ir. */ OUTPUT_PASS_HEADER(Semantics_Pass); semantics_pass_driver(); /* PASS 2 */ if (SCP_IN_ERR(curr_scp_idx)) { some_scp_in_err = TRUE; } PRINT_ALL_SYM_TBLS; /* If debug print -u options */ PRINT_FORTRAN_OUT; /* Print ir in a fortran format */ line_num = SH_GLB_LINE(SCP_LAST_SH_IDX(curr_scp_idx)); column_num = SH_COL_NUM(SCP_LAST_SH_IDX(curr_scp_idx)); if (num_prog_unit_errors == 0) { if (opt_flags.inline_lvl > Inline_Lvl_0) { comp_phase = Inlining; inline_processing(SCP_FIRST_SH_IDX(curr_scp_idx)); PRINT_IR_TBL3; } } insert_global_directives = TRUE; comp_phase = Pdg_Conversion; if (dump_flags.preinline) { /* Do not do a full compile */ if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module || ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Function || ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Subroutine) { curr_scp_idx = MAIN_SCP_IDX; #ifdef KEY /* Bug 3477 */ if (create_mod_info_file()) { /* Creates a name for the file. */ create_mod_info_tbl(); /* Creates the table. */ output_mod_info_file(); /* Writes the table. */ } #else create_mod_info_file(); /* Creates a name for the file. */ create_mod_info_tbl(); /* Creates the table. */ output_mod_info_file(); /* Writes the table. */ #endif /* KEY Bug 3477 */ free_tables(); /* Frees the tables. */ } } else { #ifdef KEY /* Bug 3477 */ int do_output_file = FALSE; #endif /* KEY Bug 3477 */ if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module) { #ifdef KEY /* Bug 3477 */ do_output_file = create_mod_info_file(); /* Creates a name for the file. */ #else create_mod_info_file(); /* Creates a name for the file. */ #endif /* KEY Bug 3477 */ } if (num_prog_unit_errors == 0 && (binary_output || assembly_output)) { cvrt_to_pdg(compiler_gen_date); } else if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module) { if (!SCP_IN_ERR(MAIN_SCP_IDX)) { curr_scp_idx = MAIN_SCP_IDX; #ifdef KEY /* Bug 3477 */ if (do_output_file) { create_mod_info_tbl(); /* Creates the table. */ output_mod_info_file(); /* Writes the table. */ } #else create_mod_info_tbl(); /* Creates the table. */ output_mod_info_file(); /* Writes the table. */ #endif /* KEY Bug 3477 */ } free_tables(); /* Frees the tables. */ } else { free_tables(); /* Frees the tables. */ } } /* ALERT - At this point, the symbol tables are invalid. */ /* Spit out the End Unit for the current program unit. The End Unit */ /* is needed if the Compiler Information File (CIF) is being produced */ /* and for the buffered message file. */ stmt_start_line = line_num; stmt_start_col = column_num; if (scp_tbl == NULL_IDX) { /* Table has been freed. */ cif_end_unit_rec(program_unit_name); } else { cif_end_unit_rec(AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx))); } } /* while */ clean_up_module_files(); # ifdef _NAME_SUBSTITUTION_INLINING if (!dump_flags.preinline) # endif terminate_PDGCS(); PRINT_GL_TBL; /* Prints to debug_file ifdef _DEBUG and -u gl */ PRINT_GN_TBL; /* Prints to debug_file ifdef _DEBUG and -u gn */ PREPROCESS_ONLY_SKIP: # if defined(_HOST_OS_UNICOS) SECOND(&end_time); # elif defined(_HOST_OS_MAX) end_clock = clock(); end_time = 0; # elif defined(_HOST_OS_SOLARIS) end_time = (float) time(NULL); end_clock = clock(); # elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) getrusage(RUSAGE_SELF, &ru); end_time = (double) ru.ru_utime.tv_sec + (double) ru.ru_utime.tv_usec * 1e-6 + (double) ru.ru_stime.tv_sec + (double) ru.ru_stime.tv_usec * 1e-6; # else end_time = 0; # endif total_cpu_time = end_time - start_time; if (cif_need_unit_rec && cif_first_pgm_unit) { /* Catastrophic errors, like a free source form program was compiled */ /* in fixed source form mode, so no Unit record was output. Output */ /* enough records to keep libcif tools happy. This routine needs to be */ /* called whether or not a CIF is being written because the buffered */ /* message file also must have the correct format. */ cif_fake_a_unit(); } /* CAUTION: The following code assumes that non-Cray platforms measure */ /* memory usage in terms of bytes and that there are 4 bytes per word. */ cif_summary_rec(release_level, compiler_gen_date, compiler_gen_time, total_cpu_time, # if defined(_HOST_OS_UNICOS) (long) 0, (some_scp_in_err) ? -3 : max_field_len); # elif defined(_HOST_OS_MAX) end_clock, (some_scp_in_err) ? -3 : max_field_len); # elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) (long) 0, (some_scp_in_err) ? -3 : max_field_len/4); # else /* defined(_HOST_OS_SOLARIS) */ end_clock, (some_scp_in_err) ? -3 : max_field_len/4); # endif /* Output compilation summary info if the -V option was specified on the */ /* command line. Also, issue the summary information if any messages were */ /* actually issued. */ if (cmd_line_flags.verify_option || num_errors > 0 || num_warnings > 0 || num_cautions > 0 || num_notes > 0 || num_comments > 0 || num_ansi > 0 || (num_optz_msgs > 0 && opt_flags.msgs)) { print_buffered_messages(); print_id_line(); /* Output the summary lines. The compilation time is in seconds. */ /* CAUTION: The following non-Cray code assumes a 32-bit word. */ # if defined(_HOST_OS_UNICOS) PRINTMSG (0, 104, Log_Summary, 0, (double) total_cpu_time); msg_name = "cf90"; # elif defined(_HOST_OS_MAX) PRINTMSG (0, 104, Log_Summary, 0, (double) end_clock/1000000.0); msg_name = "cf90"; # elif defined(_HOST_OS_LINUX) msg_name = PSC_NAME_PREFIX "f95"; # elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) /* IRIX cannot handle the int to float change necessary to get the */ /* time printed correctly, so we'll convert it to a character string */ /* and use a different message. */ /* */ /* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */ /* he did not want this line in the summary lines. */ /* sprintf(time, "%-1.2f", (double) total_cpu_time); PRINTMSG (0, 1310, Log_Summary, 0, time); */ msg_name = "cf90"; # elif defined(_HOST_OS_SOLARIS) PRINTMSG (0, 104, Log_Summary, 0, (total_cpu_time <= 2147.0) ? (float) end_clock/1000000.0 : (float) total_cpu_time); msg_name = "cf90"; # endif /* Maximum field length (maximum amount of memory used) in words */ /* (decimal). */ /* CAUTION: Non-Cray platforms are assumed to measure memory usage in */ /* bytes and we assume 4 bytes per word. */ # if defined(_HOST_OS_UNICOS) PRINTMSG (0, 105, Log_Summary, 0, max_field_len); # elif ! (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) /* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */ /* he did not want this line in the summary lines. */ PRINTMSG (0, 105, Log_Summary, 0, max_field_len/4); # endif /* Number of source lines compiled. */ # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) && !defined(_TARGET_SV2) PRINTMSG (0, 1401, Log_Summary, 0, --curr_glb_line); # else PRINTMSG (0, 106, Log_Summary, 0, --curr_glb_line); # endif /* Number of messages issued. */ # if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) && !defined(_TARGET_SV2) PRINTMSG (0, 1403, Log_Summary, 0, num_errors, num_warnings, (opt_flags.msgs == 0) ? (num_cautions + num_notes + num_comments) : (num_cautions + num_notes + num_comments + num_optz_msgs), num_ansi); # else PRINTMSG (0, 107, Log_Summary, 0, num_errors, num_warnings, (opt_flags.msgs == 0) ? (num_cautions + num_notes + num_comments) : (num_cautions + num_notes + num_comments + num_optz_msgs), num_ansi); /* Code: in words; data: in words. */ /* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */ /* he did not want this line in the summary lines. */ # if !defined(_TARGET_SV2) /* Prints blank for sv2 right now. */ PRINTMSG (0, 108, Log_Summary, 0, code_size, data_size); # endif # endif if (num_errors > 0 || num_warnings > 0 || num_cautions > 0 || num_notes > 0 || num_comments > 0 || num_ansi > 0 || (num_optz_msgs > 0 && opt_flags.msgs)) { PRINTMSG (0, 1636, Log_Summary, 0, msg_name, msg_name); } } /* End of summary printing. */ # ifdef _DEBUG /* Get memory usage reports for these global tables. */ final_src_input(); MEM_REPORT(file_path_tbl); MEM_REPORT(global_attr_tbl); MEM_REPORT(global_bounds_tbl); MEM_REPORT(global_line_tbl); MEM_REPORT(global_name_tbl); MEM_REPORT(global_type_tbl); MEM_REPORT(str_pool); # endif exit_compiler ((num_errors == 0) ? RC_OKAY : RC_USER_ERROR); } /* main */