/* ** vim: ts=4 sw=4 expandtab */ /* INIT mercury_sys_init_wrapper ENDINIT */ /* ** Copyright (C) 1994-2007 The University of Melbourne. ** This file may only be copied under the terms of the GNU Library General ** Public License - see the file COPYING.LIB in the Mercury distribution. */ /* ** file: mercury_wrapper.c ** main authors: zs, fjh ** ** This file contains the startup and termination entry points ** for the Mercury runtime. ** ** It defines mercury_runtime_init(), which is invoked from ** mercury_init() in the C file generated by util/mkinit.c. ** The code for mercury_runtime_init() initializes various things, and ** processes options (which are specified via an environment variable). ** ** It also defines mercury_runtime_main(), which invokes ** MR_call_engine(MR_do_interpreter), which invokes main/2. ** ** It also defines mercury_runtime_terminate(), which performs ** various cleanups that are needed to terminate cleanly. */ #include "mercury_imp.h" #ifdef MR_DEEP_PROFILING #include "mercury_deep_profiling.h" #endif #include #include #if 0 /* XXX the following code breaks on Win32 */ #include #include #include #include #endif /* breaks on Win32 */ #ifdef MR_MSVC_STRUCTURED_EXCEPTIONS #include #endif #include "mercury_getopt.h" #include "mercury_timing.h" #include "mercury_init.h" #include "mercury_dummy.h" #include "mercury_stack_layout.h" #include "mercury_trace_base.h" #include "mercury_deep_profiling.h" #include "mercury_memory.h" /* for MR_copy_string() */ #include "mercury_memory_handlers.h" /* for MR_default_handler */ #include "mercury_thread.h" /* for MR_debug_threads */ /* global variables concerned with testing (i.e. not with the engine) */ /* command-line options */ /* ** Sizes of data areas (including redzones), in kilobytes ** (but we later multiply by 1024 to convert to bytes). ** ** Note that it is OK to allocate a large heap, since we will only touch ** the part of it that we use; we're really only allocating address space, ** not physical memory. But the other areas should be kept small, at least ** in the case when conservative GC is enabled, since the conservative GC ** will scan them. ** ** Note that for the accurate collector, the total heap size that we use ** will be twice the heap size specified here, since it is a two-space ** collector. ** ** Changes to MR_heap_size, MR_detstack_size or MR_nondetstack_size should be ** reflected in the user guide. Changes to MR_heap_size may also require ** changing MR_heap_zone_size and/or the MR_heap_margin_size, which are ** defined below. */ #ifdef MR_DEBUG_AGC_SMALL_HEAP size_t MR_heap_size = 13 * sizeof(MR_Word); #else size_t MR_heap_size = 8192 * sizeof(MR_Word); #endif #ifdef MR_STACK_SEGMENTS size_t MR_detstack_size = 64 * sizeof(MR_Word); size_t MR_nondetstack_size = 16 * sizeof(MR_Word); size_t MR_small_detstack_size = 8 * sizeof(MR_Word); size_t MR_small_nondetstack_size = 8 * sizeof(MR_Word); #else size_t MR_detstack_size = 4096 * sizeof(MR_Word); size_t MR_nondetstack_size = 64 * sizeof(MR_Word); size_t MR_small_detstack_size = 512 * sizeof(MR_Word); size_t MR_small_nondetstack_size = 8 * sizeof(MR_Word); #endif size_t MR_solutions_heap_size = 256 * sizeof(MR_Word); size_t MR_global_heap_size = 256 * sizeof(MR_Word); size_t MR_trail_size = 32 * sizeof(MR_Word); size_t MR_debug_heap_size = 1024 * sizeof(MR_Word); size_t MR_genstack_size = 8 * sizeof(MR_Word); size_t MR_cutstack_size = 8 * sizeof(MR_Word); size_t MR_pnegstack_size = 8 * sizeof(MR_Word); size_t MR_gen_detstack_size = 16 * sizeof(MR_Word); size_t MR_gen_nondetstack_size = 16 * sizeof(MR_Word); /* ** size of the redzones at the end of data areas, in kilobytes ** ** For accurate GC, although we start out with a big heap (32 Mb on 32-bit ** architectures -- see above), we don't want to touch all of it unless we ** really need to. So with accurate GC in LLDS grades, we start out with ** a 28 Mb redzone, leaving an active heap size of 4Mb. The collector ** should (XXX it currently doesn't) resize this redzone automatically at ** the end of each collection. ** ** For MLDS grades, we don't use redzones to schedule GC; ** instead GCs are scheduled, based on MR_heap_margin_size (see below), ** by explicit calls to MR_GC_check() */ #if defined(MR_NATIVE_GC) && !defined(MR_HIGHLEVEL_CODE) #ifdef MR_DEBUG_AGC_SMALL_HEAP size_t MR_heap_zone_size = 8 * sizeof(MR_Word); #else size_t MR_heap_zone_size = (4 + 7 * 1024) * sizeof(MR_Word); #endif #else size_t MR_heap_zone_size = 4 * sizeof(MR_Word); #endif size_t MR_detstack_zone_size = 4 * sizeof(MR_Word); size_t MR_nondetstack_zone_size = 4 * sizeof(MR_Word); size_t MR_solutions_heap_zone_size = 4 * sizeof(MR_Word); size_t MR_global_heap_zone_size = 4 * sizeof(MR_Word); size_t MR_trail_zone_size = 4 * sizeof(MR_Word); size_t MR_debug_heap_zone_size = 4 * sizeof(MR_Word); size_t MR_genstack_zone_size = 4 * sizeof(MR_Word); size_t MR_cutstack_zone_size = 4 * sizeof(MR_Word); size_t MR_pnegstack_zone_size = 4 * sizeof(MR_Word); size_t MR_gen_detstack_zone_size = 4 * sizeof(MR_Word); size_t MR_gen_nondetstack_zone_size = 4 * sizeof(MR_Word); /* ** MR_heap_margin_size is used for accurate GC with the MLDS->C back-end. ** It is used to decide when to actually do a garbage collection. ** At each call to MR_GC_check(), which is normally done before ** each allocation, we check whether there is less than this ** amount of heap space still available, and if not, we call ** MR_garbage_collect(). ** ** XXX Actually, this variable is only used to set the initial value ** of heap_zone->gc_threshold. ** The collector recomputes heap_zone->gc_threshold automatically at ** the end of each collection. ** ** Like the sizes above, it is measured in kilobytes ** (but we later multiply by 1024 to convert to bytes). */ #ifdef MR_DEBUG_AGC_SMALL_HEAP size_t MR_heap_margin_size = 4 * sizeof(MR_Word); #else size_t MR_heap_margin_size = 7 * 1024 * sizeof(MR_Word); #endif double MR_heap_expansion_factor = 2.0; /* ** When we use stack segments, we reserve the last MR_stack_margin_size bytes ** of each stack segment for leaf procedures. This way, leaf procedures that ** do not need this much stack space can allocate their stack space *without* ** incurring the cost of a test. ** ** MR_stack_margin_size is never consulted directly; instead, its value is used ** to set the MR_zone_extend_threshold field in a stack's memory zone. */ size_t MR_stack_margin_size = 128; /* primary cache size to optimize for, in bytes */ size_t MR_pcache_size = 8192; /* soft limits on the number of contexts we can create */ MR_Unsigned MR_max_contexts_per_thread = 2; MR_Unsigned MR_max_outstanding_contexts; /* file names for mdb's debugger I/O streams */ const char *MR_mdb_in_filename = NULL; const char *MR_mdb_out_filename = NULL; const char *MR_mdb_err_filename = NULL; MR_bool MR_mdb_in_window = MR_FALSE; MR_bool MR_mdb_decl_print_progress = MR_TRUE; MR_bool MR_mdb_benchmark_silent = MR_FALSE; /* use readline() in the debugger even if the input stream is not a tty */ MR_bool MR_force_readline = MR_FALSE; /* ** Low level debugging options. ** ** If MR_watch_addr is not NULL, then the some of the low level debugging ** messages will print the value it points to. ** ** If MR_watch_csd_addr is not NULL, then the some of the low level debugging ** messages will print the MR_CallSiteDynamic structure it points to. Since ** this structure is typically in memory that not part of the address space of ** the program at startup, this printing will be inhibited until ** MR_watch_csd_started is set to true, which will happen when you call a ** procedure whose entry label matches the string in MR_watch_csd_start_name. ** ** If the low level debugging of calls is enabled, MR_lld_cur_call is the ** sequence number of the last call executed by the program. ** ** Getting low level debugging messages from *every* call, *every* heap ** allocation etc usually results in an avalanche of data that buries the ** information you are looking for, and often runs filesystems out of space. ** Therefore we inhibit these messages unless any one of four conditions ** apply. We implement this by making MR_lld_print_enabled, which controls ** the printing of these messages, the logical OR of MR_lld_print_name_enabled, ** MR_lld_print_csd_enabled, MR_lld_print_region_enabled and ** MR_lld_debug_enabled, which are flags implementing the four conditions. ** (We rely on these flags being 0 or 1 (i.e. MR_FALSE or MR_TRUE) so we can ** implement logical OR as bitwise OR, which is faster.) ** ** One condition is MR_lld_start_block calls starting with a call to a ** predicate whose entry label matches MR_lld_start_name. Another is ** MR_lld_start_block calls starting with a call at which the value of the ** MR_next_call_site_dynamic global variable matches the value in ** MR_watch_csd_addr. The third is calls whose sequence number is in a range ** specified by MR_lld_print_more_min_max, which should point to a string ** containing a comma-separated list of integer intervals (the last interval ** may be open ended). The fourth is calls between debugger commands that ** enable and disable low level messages. ** ** MR_lld_start_until and MR_lld_csd_until give the end call numbers of the ** blocks printed for the first two conditions. MR_lld_print_{min,max} give the ** boundaries of the (current or next) block for the third condition. */ MR_Word *MR_watch_addr = NULL; MR_CallSiteDynamic *MR_watch_csd_addr = NULL; MR_bool MR_watch_csd_started = MR_FALSE; const char *MR_watch_csd_start_name = ""; /* must not be NULL */ unsigned long MR_lld_cur_call = 0; MR_bool MR_lld_print_enabled = MR_FALSE; MR_bool MR_lld_print_name_enabled = MR_FALSE; MR_bool MR_lld_print_csd_enabled = MR_FALSE; MR_bool MR_lld_print_region_enabled = MR_FALSE; const char *MR_lld_start_name = ""; /* must not be NULL */ unsigned MR_lld_start_block = 100; /* by default, print stuff */ /* for a block of 100 calls */ unsigned long MR_lld_start_until = (unsigned long) -1; unsigned long MR_lld_csd_until = (unsigned long) -1; unsigned long MR_lld_print_min = (unsigned long) -1; unsigned long MR_lld_print_max = 0; char *MR_lld_print_more_min_max = NULL; /* other options */ MR_bool MR_check_space = MR_FALSE; static MR_bool benchmark_all_solns = MR_FALSE; static MR_bool use_own_timer = MR_FALSE; static int repeats = 1; #define MAX_MEM_USAGE_REPORT_ATTEMPTS 100 #define MAX_MEM_USAGE_REPORT_FILENAME_SIZE 1024 static MR_bool mem_usage_report = MR_FALSE; static int MR_num_output_args = 0; unsigned int MR_num_threads = 1; static MR_bool MR_print_table_statistics = MR_FALSE; /* timing */ int MR_user_time_at_last_stat; int MR_user_time_at_start; static int MR_user_time_at_finish; int MR_real_time_at_last_stat; int MR_real_time_at_start; /* time profiling */ enum MR_TimeProfileMethod MR_time_profile_method = MR_profile_user_plus_system_time; const char *MR_progname; int mercury_argc; /* not counting progname */ char **mercury_argv; int mercury_exit_status = 0; MR_bool MR_profiling = MR_TRUE; MR_bool MR_print_deep_profiling_statistics = MR_FALSE; MR_bool MR_deep_profiling_save_results = MR_TRUE; MR_bool MR_complexity_save_results = MR_TRUE; #ifdef MR_TYPE_CTOR_STATS #include "mercury_type_info.h" #include "mercury_array_macros.h" typedef struct { MR_ConstString type_stat_module; MR_ConstString type_stat_name; int type_stat_ctor_rep; long type_stat_count; } MR_TypeNameStat; struct MR_TypeStat_Struct { long type_ctor_reps[MR_TYPECTOR_REP_UNKNOWN + 1]; MR_TypeNameStat *type_ctor_names; int type_ctor_name_max; int type_ctor_name_next; }; /* we depend on these five structs being initialized to zero */ MR_TypeStat MR_type_stat_mer_unify; MR_TypeStat MR_type_stat_c_unify; MR_TypeStat MR_type_stat_mer_compare; MR_TypeStat MR_type_stat_c_compare; #endif /* ** EXTERNAL DEPENDENCIES ** ** - The Mercury runtime initialization, namely mercury_runtime_init(), ** calls the functions init_gc() and init_modules(), which are in ** the automatically generated C init file; mercury_init_io(), which is ** in the Mercury library; and it calls the predicate io__init_state/2 ** in the Mercury library. ** - The Mercury runtime main, namely mercury_runtime_main(), ** calls main/2 in the user's program. ** - The Mercury runtime finalization, namely mercury_runtime_terminate(), ** calls io__finalize_state/2 in the Mercury library. ** ** But, to enable Quickstart of shared libraries on Irix 5, ** and in general to avoid various other complications ** with shared libraries and/or Windows DLLs, ** we need to make sure that we don't have any undefined ** external references when building the shared libraries. ** Hence the statically linked init file saves the addresses of those ** procedures in the following global variables. ** This ensures that there are no cyclic dependencies; ** the order is user program -> trace -> browser -> library -> runtime -> gc, ** where `->' means "depends on", i.e. "references a symbol of". ** In the case of the compiler, we insert mdbcomp between browser and library. */ void (*MR_address_of_mercury_init_io)(void); void (*MR_address_of_init_modules)(void); void (*MR_address_of_init_modules_type_tables)(void); void (*MR_address_of_init_modules_debugger)(void); #ifdef MR_RECORD_TERM_SIZES void (*MR_address_of_init_modules_complexity)(void); #endif #ifdef MR_DEEP_PROFILING void (*MR_address_of_write_out_proc_statics)(FILE *fp); #endif void (*MR_address_of_init_modules_required)(void); void (*MR_address_of_final_modules_required)(void); MR_TypeCtorInfo MR_type_ctor_info_for_univ; MR_TypeCtorInfo MR_type_info_for_type_info; MR_TypeCtorInfo MR_type_info_for_pseudo_type_info; MR_TypeInfo MR_type_info_for_list_of_univ; MR_TypeInfo MR_type_info_for_list_of_int; MR_TypeInfo MR_type_info_for_list_of_char; MR_TypeInfo MR_type_info_for_list_of_string; MR_TypeInfo MR_type_info_for_list_of_type_info; MR_TypeInfo MR_type_info_for_list_of_pseudo_type_info; char *(*MR_address_of_trace_getline)(const char *, FILE *, FILE *); char *(*MR_address_of_trace_get_command)(const char *, FILE *, FILE *); const char *(*MR_address_of_trace_browse_all_on_level)(FILE *, const MR_LabelLayout *, MR_Word *, MR_Word *, int, MR_bool); #ifdef MR_USE_EXTERNAL_DEBUGGER void (*MR_address_of_trace_init_external)(void); void (*MR_address_of_trace_final_external)(void); #endif #ifdef MR_CONSERVATIVE_GC void (*MR_address_of_init_gc)(void); #endif #ifdef MR_HIGHLEVEL_CODE void MR_CALL (*MR_program_entry_point)(void); /* normally main_2_p_0 (main/2) */ #else MR_Code *MR_program_entry_point; /* normally mercury__main_2_0 (main/2) */ #endif const char *MR_runtime_flags = ""; void (*MR_library_initializer)(void); /* normally ML_io_init_state (io.init_state/2)*/ void (*MR_library_finalizer)(void); /* normally ML_io_finalize_state (io.finalize_state/2) */ void (*MR_io_stderr_stream)(MercuryFilePtr *); void (*MR_io_stdout_stream)(MercuryFilePtr *); void (*MR_io_stdin_stream)(MercuryFilePtr *); void (*MR_io_print_to_cur_stream)(MR_Word, MR_Word); void (*MR_io_print_to_stream)(MR_Word, MercuryFilePtr, MR_Word); void (*MR_DI_output_current_ptr)(MR_Integer, MR_Integer, MR_Integer, MR_Word, MR_String, MR_String, MR_Integer, MR_Integer, MR_Integer, MR_Word, MR_String, MR_Word, MR_Word); /* normally ML_DI_output_current (output_current/13) */ MR_bool (*MR_DI_found_match)(MR_Integer, MR_Integer, MR_Integer, MR_Word, MR_String, MR_String, MR_Integer, MR_Integer, MR_Integer, MR_Word, MR_String, MR_Word); /* normally ML_DI_found_match (output_current/12) */ void (*MR_DI_read_request_from_socket)(MR_Word, MR_Word *, MR_Integer *); MR_Code *(*MR_exec_trace_func_ptr)(const MR_LabelLayout *); void (*MR_address_of_trace_interrupt_handler)(void); void (*MR_register_module_layout)(const MR_ModuleLayout *); #ifdef MR_RECORD_TERM_SIZES MR_ComplexityProc *MR_complexity_procs; int MR_num_complexity_procs; #endif #ifdef MR_USE_GCC_NONLOCAL_GOTOS #define SAFETY_BUFFER_SIZE 1024 /* size of stack safety buffer */ #define MAGIC_MARKER_2 142 /* a random character */ #endif static void MR_process_args(int argc, char **argv); static void MR_process_environment_options(void); static void MR_process_options(int argc, char **argv); static void MR_usage(void); static MR_bool MR_matches_exec_name(const char *option); #ifdef MR_TYPE_CTOR_STATS static void MR_print_type_ctor_stats(void); static void MR_print_one_type_ctor_stat(FILE *fp, const char *op, MR_TypeStat *type_stat); #endif #ifdef MR_HIGHLEVEL_CODE static void MR_do_interpreter(void); #else MR_declare_entry(MR_do_interpreter); #endif /*---------------------------------------------------------------------------*/ void mercury_runtime_init(int argc, char **argv) { MR_bool saved_debug_enabled; MR_bool saved_trace_count_enabled; #if MR_NUM_REAL_REGS > 0 MR_Word c_regs[MR_NUM_REAL_REGS]; #endif /* ** Save the callee-save registers; we're going to start using them ** as global registers variables now, which will clobber them, ** and we need to preserve them, because they're callee-save, ** and our caller may need them ;-) */ MR_save_regs_to_mem(c_regs); #ifdef __linux__ /* ** XXX Ensure that we link in atexit(). ** XXX This works around a bug in gcc 2.95.3 (prerelease) and/or ** libc 2.2.2 on Debian Linux, where we'd get a link error when ** building libmer_rt.so with --no-undefined, due to a reference ** to atexit() from crtendS.o, which gets linked last, after any ** libraries such as `-lc'. */ MR_global_pointer = (void *) atexit; #endif #if defined(MR_LOWLEVEL_DEBUG) || defined(MR_TABLE_DEBUG) if (MR_unbufdebug) { /* ** Ensure stdio & stderr are unbuffered even if redirected. ** Using setvbuf() is more complicated than using setlinebuf(), ** but also more portable. */ setvbuf(stdout, NULL, _IONBF, 0); setvbuf(stderr, NULL, _IONBF, 0); } #endif /* ** This must be done before MR_init_conservative_GC(), ** to ensure that the GC's signal handler gets installed ** after our signal handler. This is needed because ** our signal handler assumes that signals which it can't ** handle are fatal. */ #if 1 /* XXX still some problems with this for MPS? -fjh */ /* #ifndef MR_MPS_GC */ MR_setup_signals(); #endif #ifdef MR_CONSERVATIVE_GC MR_init_conservative_GC(); #endif /* ** Process the command line and the options in the environment ** variable MERCURY_OPTIONS, and save results in global variables. */ MR_process_args(argc, argv); MR_process_environment_options(); #ifdef MR_STACK_FRAME_STATS MR_init_stack_frame_stats(); #endif /* MR_STACK_FRAME_STATS */ /* ** Some of the rest of this function may call Mercury code ** that may have been compiled with tracing (e.g. the initialization ** routines in the library called via MR_library_initializer). ** Since this initialization code shouldn't be traced, we disable ** tracing until the end of this function. */ saved_debug_enabled = MR_debug_enabled; saved_trace_count_enabled = MR_trace_count_enabled; MR_debug_enabled = MR_FALSE; MR_trace_count_enabled = MR_FALSE; MR_update_trace_func_enabled(); #if defined(MR_NEED_INITIALIZATION_AT_START) || defined(MR_MINIMAL_MODEL_DEBUG) MR_do_init_modules(); #endif (*MR_address_of_mercury_init_io)(); #ifdef MR_THREAD_SAFE /* MR_init_thread_stuff() must be called prior to MR_init_memory() */ MR_init_thread_stuff(); MR_primordial_thread = pthread_self(); #endif /* ** XXX The condition here used to be ** #if defined(MR_HIGHLEVEL_CODE) && defined(MR_CONSERVATIVE_GC) ** and was part of a change by Fergus to remove an unnecessary ** dependency on the complicated Mercury engine code. Unfortunately ** this is no longer the case because other such dependencies have ** since crept in. Using the original condition would cause hlc.par ** programs to immediately SEGFAULT via reference to an uninitialised ** Mercury engine. */ #if 0 MR_init_memory(); #ifdef MR_USE_TRAIL /* initialize the trail */ MR_trail_zone = MR_create_zone("trail", 0, MR_trail_size, MR_next_offset(), MR_trail_zone_size, MR_default_handler); MR_trail_ptr = (MR_TrailEntry *) MR_trail_zone->min; MR_ticket_counter = 1; MR_ticket_high_water = 1; #endif #else /* ** Start up the Mercury engine. We don't yet know how many slots will be ** needed for thread-local mutable values so allocate the maximum number. */ MR_init_thread(MR_use_now); MR_SET_THREAD_LOCAL_MUTABLES( MR_create_thread_local_mutables(MR_MAX_THREAD_LOCAL_MUTABLES)); #ifdef MR_THREAD_SAFE { int i; MR_exit_now = MR_FALSE; for (i = 1 ; i < MR_num_threads ; i++) { MR_create_thread(NULL); } while (MR_num_idle_engines < MR_num_threads-1) { /* busy wait until the worker threads are ready */ } } #endif /* ! MR_THREAD_SAFE */ #endif /* ! 0 */ if (MR_memdebug) { MR_debug_memory(stderr); } /* initialize profiling */ #if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \ || defined(MR_MPROF_PROFILE_MEMORY) if (MR_profiling) { MR_prof_init(); } #endif #ifdef MR_DEEP_PROFILING_TIMING if (MR_deep_profiling_save_results) { MR_deep_prof_init(); MR_deep_prof_turn_on_time_profiling(); } #ifdef MR_DEEP_PROFILING_LOG if (MR_deep_prof_log_file != NULL) { MR_deep_log_proc_statics(MR_deep_prof_log_file); } #endif #endif #ifdef MR_RECORD_TERM_SIZES if (MR_complexity_save_results) { MR_do_init_modules_complexity(); MR_check_complexity_init(); } #endif /* ** We need to call MR_save_registers(), since we're about to call ** a C->Mercury interface function, and the C->Mercury interface convention ** expects them to be saved. And before we can do that, we need to call ** MR_restore_transient_registers(), since we've just returned ** from a C call. */ MR_restore_transient_registers(); MR_save_registers(); MR_trace_init(); /* Initialize the Mercury library. */ (*MR_library_initializer)(); /* Run any user-defined initialisation predicates. */ (*MR_address_of_init_modules_required)(); /* ** Copy the stuff we have set up in registers, stacks etc to the ** current context of the engine. */ #ifndef MR_HIGHLEVEL_CODE #ifndef __LCC__ MR_save_context(&(MR_ENGINE(MR_eng_context))); #else { /* XXX Work around lcc bug -- lcc 4.1 miscompiles the original code */ size_t offset = offsetof(MercuryEngine, MR_eng_context); char *tmp = (char *) MR_cur_engine(); MR_Context *eng_context = (tmp += offset, (MR_Context *) tmp); MR_save_context(eng_context); } #endif #endif #ifdef MR_USE_MINIMAL_MODEL_OWN_STACKS MR_ENGINE(MR_eng_main_context) = MR_ENGINE(MR_eng_this_context); #endif /* ** Now the real tracing starts; undo any updates to the trace state ** made by the trace code in the library initializer. */ MR_debug_enabled = saved_debug_enabled; MR_trace_count_enabled = saved_trace_count_enabled; MR_update_trace_func_enabled(); MR_trace_start(MR_debug_enabled); if (MR_debug_enabled) { MR_selected_trace_func_ptr = MR_exec_trace_func_ptr; /* MR_debug_enabled overrides MR_trace_count_enabled */ MR_trace_count_enabled = MR_FALSE; } else if (MR_trace_count_enabled) { MR_register_module_layout = MR_insert_module_info_into_module_table; MR_selected_trace_func_ptr = MR_trace_count; /* ** Even if the program terminates with an exception, ** we still want the trace count file to be written out. */ MR_register_exception_cleanup(MR_trace_record_label_exec_counts, NULL); } /* ** Restore the callee-save registers before returning, ** since they may be used by the C code that called us. */ MR_restore_regs_from_mem(c_regs); } /* end mercury_runtime_init() */ #ifdef MR_CONSERVATIVE_GC #ifdef MR_MPS_GC MR_bool MR_mps_quiet = MR_TRUE; #endif #ifdef MR_HIGHTAGS /* MR_HIGHTAGS disguises pointers and hides them from gc */ #error "MR_HIGHTAGS is incompatible with MR_CONSERVATIVE_GC" #endif void MR_init_conservative_GC(void) { #ifdef MR_MPS_GC mercury_mps_init(MR_heap_size * 1024, !MR_mps_quiet); #else /* MR_BOEHM_GC */ /* ** Sometimes Mercury apps fail the GC_is_visible() test. ** dyn_load.c traverses the entire address space and registers ** all segments that could possibly have been written to, which ** makes us suspect that &MR_runqueue_head is not in the registered ** roots. So we force a write to that address, which seems to make ** the problem go away. */ MR_runqueue_head = NULL; /* ** Call GC_INIT() to tell the garbage collector about this DLL. ** (This is necessary to support Windows DLLs using gnu-win32.) */ GC_INIT(); /* ** call the init_gc() function defined in _init.c, ** which calls GC_INIT() to tell the GC about the main program. ** (This is to work around a Solaris 2.X (X <= 4) linker bug, ** and also to support Windows DLLs using gnu-win32.) */ (*MR_address_of_init_gc)(); /* ** Double-check that the garbage collector knows about ** global variables in shared libraries. */ GC_is_visible(&MR_runqueue_head); /* ** The following code is necessary to tell the conservative ** garbage collector that we are using tagged pointers. ** ** With MR_RECORD_TERM_SIZES, we not only add tags in the bottom ** MR_LOW_TAG_BITS bits of the word, we add the tag to a pointer ** not just to the first MR_Word in the block, but also to a pointer ** to the second MR_Word. */ { int i; int limit; limit = (1 << MR_LOW_TAG_BITS); #ifdef MR_RECORD_TERM_SIZES limit += sizeof(MR_Word); #endif for (i = 1; i < limit; i++) { GC_REGISTER_DISPLACEMENT(i); } } #endif /* MR_BOEHM_GC */ } #endif /* MR_CONSERVATIVE_GC */ void MR_do_init_modules(void) { static MR_bool done = MR_FALSE; if (! done) { (*MR_address_of_init_modules)(); MR_close_prof_decl_file(); done = MR_TRUE; } } void MR_do_init_modules_type_tables(void) { static MR_bool done = MR_FALSE; if (! done) { (*MR_address_of_init_modules_type_tables)(); done = MR_TRUE; /* ** Some system-defined types have the code to register ** their type_ctor_infos in the initialization function ** invoked by MR_do_init_modules. */ MR_do_init_modules(); } } void MR_do_init_modules_debugger(void) { static MR_bool done = MR_FALSE; if (! done) { (*MR_address_of_init_modules_debugger)(); done = MR_TRUE; } } #ifdef MR_RECORD_TERM_SIZES void MR_do_init_modules_complexity(void) { static MR_bool done = MR_FALSE; if (! done) { (*MR_address_of_init_modules_complexity)(); done = MR_TRUE; } } #endif /* ** Given a string, parse it into arguments and create an argv vector for it. ** The return value is NULL if the string parses OK, or an error message ** if it didn't (e.g. if it contained an unterminated quoted string). ** Also returns args, argv, and argc. It is the caller's responsibility to ** MR_GC_free() args and argv when they are no longer needed. */ const char * MR_make_argv(const char *string, char **args_ptr, char ***argv_ptr, int *argc_ptr) { char *args; char **argv; const char *s = string; char *d; int args_len = 0; int argc = 0; int i; /* ** First do a pass over the string to count how much space we need to ** allocate. */ for (;;) { /* skip leading whitespace */ while(MR_isspace(*s)) { s++; } /* are there any more args? */ if(*s != '\0') { argc++; } else { break; } /* copy arg, translating backslash escapes */ if (*s == '"') { s++; /* "double quoted" arg - scan until next double quote */ while (*s != '"') { if (s == '\0') { *args_ptr = NULL; *argv_ptr = NULL; *argc_ptr = argc; return "unterminated quoted string"; } if (*s == '\\') { s++; } args_len++; s++; } s++; } else { /* ordinary white-space delimited arg */ while(*s != '\0' && !MR_isspace(*s)) { if (*s == '\\') { s++; } args_len++; s++; } } args_len++; } /* ** Allocate the space. */ args = MR_GC_NEW_ARRAY(char, args_len); argv = MR_GC_NEW_ARRAY(char *, argc + 1); /* ** Now do a pass over the string, copying the arguments into `args' ** setting up the contents of `argv' to point to the arguments. */ s = string; d = args; for(i = 0; i < argc; i++) { /* skip leading whitespace */ while(MR_isspace(*s)) { s++; } /* are there any more args? */ if(*s != '\0') { argv[i] = d; } else { argv[i] = NULL; break; } /* copy arg, translating backslash escapes */ if (*s == '"') { s++; /* "double quoted" arg - scan until next double quote */ while (*s != '"') { if (*s == '\\') { s++; } *d++ = *s++; } s++; } else { /* ordinary white-space delimited arg */ while(*s != '\0' && !MR_isspace(*s)) { if (*s == '\\') { s++; } *d++ = *s++; } } *d++ = '\0'; } *args_ptr = args; *argv_ptr = argv; *argc_ptr = argc; return NULL; /* success */ } /* ** MR_process_args() is a function that sets some global variables from the ** command line. `mercury_arg[cv]' are `arg[cv]' without the program name. ** `progname' is program name. */ static void MR_process_args(int argc, char **argv) { MR_progname = argv[0]; mercury_argc = argc - 1; mercury_argv = argv + 1; } /* ** MR_process_environment_options() is a function to parse the MERCURY_OPTIONS ** environment variable. */ static void MR_process_environment_options(void) { char *env_options; env_options = getenv("MERCURY_OPTIONS"); if (env_options == NULL) { env_options = (char *) ""; } if (env_options[0] != '\0' || MR_runtime_flags[0] != '\0') { const char *cmd; char *arg_str, **argv; char *dummy_command_line; const char *error_msg; int argc; int cmd_len; int runtime_flags_len; /* ** getopt() expects the options to start in argv[1], not argv[0], ** so we need to insert a dummy program name (we use "mercury_runtime") ** at the start of the options before passing them to MR_make_argv() ** and then to getopt(). */ cmd = "mercury_runtime "; cmd_len = strlen(cmd); runtime_flags_len = strlen(MR_runtime_flags); dummy_command_line = MR_GC_NEW_ARRAY(char, cmd_len + runtime_flags_len + 1 + strlen(env_options) + 1); strcpy(dummy_command_line, cmd); strcpy(dummy_command_line + cmd_len, MR_runtime_flags); dummy_command_line[cmd_len + runtime_flags_len] = ' '; strcpy(dummy_command_line + cmd_len + runtime_flags_len + 1, env_options); error_msg = MR_make_argv(dummy_command_line, &arg_str, &argv, &argc); if (error_msg != NULL) { MR_fatal_error("error parsing the MERCURY_OPTIONS " "environment variable:\n%s\n", error_msg); } MR_GC_free(dummy_command_line); MR_process_options(argc, argv); MR_GC_free(arg_str); MR_GC_free(argv); } } enum MR_long_option { MR_HEAP_SIZE = 256, MR_HEAP_SIZE_KWORDS, MR_DETSTACK_SIZE, MR_DETSTACK_SIZE_KWORDS, MR_NONDETSTACK_SIZE, MR_NONDETSTACK_SIZE_KWORDS, MR_SMALL_DETSTACK_SIZE, MR_SMALL_DETSTACK_SIZE_KWORDS, MR_SMALL_NONDETSTACK_SIZE, MR_SMALL_NONDETSTACK_SIZE_KWORDS, MR_SOLUTIONS_HEAP_SIZE, MR_SOLUTIONS_HEAP_SIZE_KWORDS, MR_TRAIL_SIZE, MR_TRAIL_SIZE_KWORDS, MR_HEAP_REDZONE_SIZE, MR_HEAP_REDZONE_SIZE_KWORDS, MR_DETSTACK_REDZONE_SIZE, MR_DETSTACK_REDZONE_SIZE_KWORDS, MR_NONDETSTACK_REDZONE_SIZE, MR_NONDETSTACK_REDZONE_SIZE_KWORDS, MR_SOLUTIONS_HEAP_REDZONE_SIZE, MR_SOLUTIONS_HEAP_REDZONE_SIZE_KWORDS, MR_TRAIL_REDZONE_SIZE, MR_TRAIL_REDZONE_SIZE_KWORDS, MR_HEAP_MARGIN_SIZE, MR_HEAP_MARGIN_SIZE_KWORDS, MR_HEAP_EXPANSION_FACTOR, MR_GENSTACK_SIZE, MR_GENSTACK_SIZE_KWORDS, MR_CUTSTACK_SIZE, MR_CUTSTACK_SIZE_KWORDS, MR_PNEGSTACK_SIZE, MR_PNEGSTACK_SIZE_KWORDS, MR_GEN_DETSTACK_SIZE, MR_GEN_DETSTACK_SIZE_KWORDS, MR_GEN_NONDETSTACK_SIZE, MR_GEN_NONDETSTACK_SIZE_KWORDS, MR_GEN_DETSTACK_REDZONE_SIZE, MR_GEN_DETSTACK_REDZONE_SIZE_KWORDS, MR_GEN_NONDETSTACK_REDZONE_SIZE, MR_GEN_NONDETSTACK_REDZONE_SIZE_KWORDS, MR_MAX_CONTEXTS_PER_THREAD, MR_MDB_TTY, MR_MDB_IN, MR_MDB_OUT, MR_MDB_ERR, MR_MDB_DISABLE_PROGRESS, MR_MDB_BENCHMARK_SILENT, MR_MDB_IN_WINDOW, MR_FORCE_READLINE, MR_NUM_OUTPUT_ARGS, MR_DEBUG_THREADS_OPT, MR_DEEP_PROF_DEBUG_FILE_OPT, MR_DEEP_PROF_LOG_FILE_OPT, MR_DEEP_PROF_LOG_PROG_OPT, MR_TABLING_STATISTICS_OPT, MR_TRACE_COUNT_OPT, MR_TRACE_COUNT_IF_EXEC_OPT, MR_TRACE_COUNT_SUMMARY_FILE_OPT, MR_TRACE_COUNT_SUMMARY_CMD_OPT, MR_TRACE_COUNT_SUMMARY_MAX_OPT, MR_COVERAGE_TEST_OPT, MR_COVERAGE_TEST_IF_EXEC_OPT, MR_TRACE_COUNT_FILE, MR_MEM_USAGE_REPORT }; struct MR_option MR_long_opts[] = { { "heap-size", 1, 0, MR_HEAP_SIZE }, { "heap-size-kwords", 1, 0, MR_HEAP_SIZE_KWORDS }, { "detstack-size", 1, 0, MR_DETSTACK_SIZE }, { "det-stack-size", 1, 0, MR_DETSTACK_SIZE }, { "detstack-size-kwords", 1, 0, MR_DETSTACK_SIZE_KWORDS }, { "det-stack-size-kwords", 1, 0, MR_DETSTACK_SIZE_KWORDS }, { "nondetstack-size", 1, 0, MR_NONDETSTACK_SIZE }, { "nondet-stack-size", 1, 0, MR_NONDETSTACK_SIZE }, { "nondetstack-size-kwords", 1, 0, MR_NONDETSTACK_SIZE_KWORDS }, { "nondet-stack-size-kwords", 1, 0, MR_NONDETSTACK_SIZE_KWORDS }, { "small-detstack-size", 1, 0, MR_SMALL_DETSTACK_SIZE }, { "small-det-stack-size", 1, 0, MR_SMALL_DETSTACK_SIZE }, { "small-detstack-size-kwords", 1, 0, MR_SMALL_DETSTACK_SIZE_KWORDS }, { "small-det-stack-size-kwords", 1, 0, MR_SMALL_DETSTACK_SIZE_KWORDS }, { "small-nondetstack-size", 1, 0, MR_SMALL_NONDETSTACK_SIZE }, { "small-nondet-stack-size", 1, 0, MR_SMALL_NONDETSTACK_SIZE }, { "small-nondetstack-size-kwords", 1, 0, MR_SMALL_NONDETSTACK_SIZE_KWORDS }, { "small-nondet-stack-size-kwords", 1, 0, MR_SMALL_NONDETSTACK_SIZE_KWORDS }, { "solutions-heap-size", 1, 0, MR_SOLUTIONS_HEAP_SIZE }, { "solutions-heap-size-kwords", 1, 0, MR_SOLUTIONS_HEAP_SIZE_KWORDS }, { "trail-size", 1, 0, MR_TRAIL_SIZE }, { "trail-size-kwords", 1, 0, MR_TRAIL_SIZE_KWORDS }, { "heap-redzone-size", 1, 0, MR_HEAP_REDZONE_SIZE }, { "heap-redzone-size-kwords", 1, 0, MR_HEAP_REDZONE_SIZE_KWORDS }, { "detstack-redzone-size", 1, 0, MR_DETSTACK_REDZONE_SIZE }, { "det-stack-redzone-size", 1, 0, MR_DETSTACK_REDZONE_SIZE }, { "detstack-redzone-size-kwords", 1, 0, MR_DETSTACK_REDZONE_SIZE_KWORDS }, { "det-stack-redzone-size-kwords", 1, 0, MR_DETSTACK_REDZONE_SIZE_KWORDS }, { "nondetstack-redzone-size", 1, 0, MR_NONDETSTACK_REDZONE_SIZE }, { "nondet-stack-redzone-size", 1, 0, MR_NONDETSTACK_REDZONE_SIZE }, { "nondetstack-redzone-size-kwords", 1, 0, MR_NONDETSTACK_REDZONE_SIZE_KWORDS }, { "nondet-stack-redzone-size-kwords", 1, 0, MR_NONDETSTACK_REDZONE_SIZE_KWORDS }, { "solutions-heap-redzone-size",1, 0, MR_SOLUTIONS_HEAP_REDZONE_SIZE }, { "solutions-heap-redzone-size-kwords", 1, 0, MR_SOLUTIONS_HEAP_REDZONE_SIZE_KWORDS }, { "trail-redzone-size", 1, 0, MR_TRAIL_REDZONE_SIZE }, { "trail-redzone-size-kwords", 1, 0, MR_TRAIL_REDZONE_SIZE_KWORDS }, { "heap-margin-size", 1, 0, MR_HEAP_MARGIN_SIZE }, { "heap-margin-size-kwords", 1, 0, MR_HEAP_MARGIN_SIZE_KWORDS }, { "heap-expansion-factor", 1, 0, MR_HEAP_EXPANSION_FACTOR }, { "genstack-size", 1, 0, MR_GENSTACK_SIZE }, { "genstack-size-kwords", 1, 0, MR_GENSTACK_SIZE_KWORDS }, { "cutstack-size", 1, 0, MR_CUTSTACK_SIZE }, { "cutstack-size-kwords", 1, 0, MR_CUTSTACK_SIZE_KWORDS }, { "pnegstack-size", 1, 0, MR_PNEGSTACK_SIZE }, { "pnegstack-size-kwords", 1, 0, MR_PNEGSTACK_SIZE_KWORDS }, { "gen-detstack-size", 1, 0, MR_GEN_DETSTACK_SIZE }, { "gen-detstack-size-kwords", 1, 0, MR_GEN_DETSTACK_SIZE_KWORDS }, { "gen-nondetstack-size", 1, 0, MR_GEN_NONDETSTACK_SIZE }, { "gen-nondetstack-size-kwords", 1, 0, MR_GEN_NONDETSTACK_SIZE_KWORDS }, { "gen-detstack-zone-size", 1, 0, MR_GEN_DETSTACK_REDZONE_SIZE }, { "gen-detstack-zone-size-kwords", 1, 0, MR_GEN_DETSTACK_REDZONE_SIZE_KWORDS }, { "gen-nondetstack-zone-size", 1, 0, MR_GEN_NONDETSTACK_REDZONE_SIZE }, { "gen-nondetstack-zone-size-kwords", 1, 0, MR_GEN_NONDETSTACK_REDZONE_SIZE_KWORDS }, { "max-contexts-per-thread", 1, 0, MR_MAX_CONTEXTS_PER_THREAD }, { "mdb-tty", 1, 0, MR_MDB_TTY }, { "mdb-in", 1, 0, MR_MDB_IN }, { "mdb-out", 1, 0, MR_MDB_OUT }, { "mdb-err", 1, 0, MR_MDB_ERR }, { "mdb-in-window", 0, 0, MR_MDB_IN_WINDOW }, { "mdb-disable-progress", 0, 0, MR_MDB_DISABLE_PROGRESS }, { "mdb-benchmark-silent", 0, 0, MR_MDB_BENCHMARK_SILENT }, { "force-readline", 0, 0, MR_FORCE_READLINE }, { "num-output-args", 1, 0, MR_NUM_OUTPUT_ARGS }, { "debug-threads", 0, 0, MR_DEBUG_THREADS_OPT }, { "deep-debug-file", 0, 0, MR_DEEP_PROF_DEBUG_FILE_OPT }, { "deep-log-file", 1, 0, MR_DEEP_PROF_LOG_FILE_OPT }, { "deep-log-prog", 1, 0, MR_DEEP_PROF_LOG_PROG_OPT }, { "tabling-statistics", 0, 0, MR_TABLING_STATISTICS_OPT }, { "trace-count", 0, 0, MR_TRACE_COUNT_OPT }, { "trace-count-if-exec", 1, 0, MR_TRACE_COUNT_IF_EXEC_OPT }, { "coverage-test", 0, 0, MR_COVERAGE_TEST_OPT }, { "coverage-test-if-exec", 1, 0, MR_COVERAGE_TEST_IF_EXEC_OPT }, { "tc-output-file", 1, 0, MR_TRACE_COUNT_FILE }, { "trace-count-output-file", 1, 0, MR_TRACE_COUNT_FILE }, { "tc-summary-file", 1, 0, MR_TRACE_COUNT_SUMMARY_FILE_OPT }, { "trace-count-summary-file", 1, 0, MR_TRACE_COUNT_SUMMARY_FILE_OPT }, { "tc-summary-cmd", 1, 0, MR_TRACE_COUNT_SUMMARY_CMD_OPT }, { "trace-count-summary-cmd", 1, 0, MR_TRACE_COUNT_SUMMARY_CMD_OPT }, { "tc-summary-max", 1, 0, MR_TRACE_COUNT_SUMMARY_MAX_OPT }, { "trace-count-summary-max", 1, 0, MR_TRACE_COUNT_SUMMARY_MAX_OPT }, { "mem-usage-report", 0, 0, MR_MEM_USAGE_REPORT }, /* This needs to be kept at the end. */ { NULL, 0, 0, 0 } }; static void MR_process_options(int argc, char **argv) { unsigned long size; int c; int long_index; while ((c = MR_getopt_long(argc, argv, "acC:d:D:e:i:m:n:o:pP:r:sStT:xX", MR_long_opts, &long_index)) != EOF) { switch (c) { case MR_HEAP_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_heap_size = size; break; case MR_HEAP_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_heap_size = size * sizeof(MR_Word); break; case MR_DETSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_detstack_size = size; break; case MR_DETSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_detstack_size = size * sizeof(MR_Word); break; case MR_NONDETSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_nondetstack_size = size; break; case MR_NONDETSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_nondetstack_size = size * sizeof(MR_Word); break; case MR_SMALL_DETSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_small_detstack_size = size; break; case MR_SMALL_DETSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_small_detstack_size = size * sizeof(MR_Word); break; case MR_SMALL_NONDETSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_small_nondetstack_size = size; break; case MR_SMALL_NONDETSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_small_nondetstack_size = size * sizeof(MR_Word); break; case MR_SOLUTIONS_HEAP_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_solutions_heap_size = size; break; case MR_SOLUTIONS_HEAP_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_solutions_heap_size = size * sizeof(MR_Word); break; case MR_TRAIL_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_trail_size = size; break; case MR_TRAIL_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_trail_size = size * sizeof(MR_Word); break; case MR_HEAP_REDZONE_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_heap_zone_size = size; break; case MR_HEAP_REDZONE_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_heap_zone_size = size * sizeof(MR_Word); break; case MR_DETSTACK_REDZONE_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_detstack_zone_size = size; break; case MR_DETSTACK_REDZONE_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_detstack_zone_size = size * sizeof(MR_Word); break; case MR_NONDETSTACK_REDZONE_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_nondetstack_zone_size = size; break; case MR_NONDETSTACK_REDZONE_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_nondetstack_zone_size = size * sizeof(MR_Word); break; case MR_SOLUTIONS_HEAP_REDZONE_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_solutions_heap_zone_size = size; break; case MR_SOLUTIONS_HEAP_REDZONE_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_solutions_heap_zone_size = size * sizeof(MR_Word); break; case MR_TRAIL_REDZONE_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_trail_zone_size = size; break; case MR_TRAIL_REDZONE_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_trail_zone_size = size * sizeof(MR_Word); break; case MR_HEAP_MARGIN_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_heap_margin_size = size; break; case MR_HEAP_MARGIN_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_heap_margin_size = size * sizeof(MR_Word); break; case MR_HEAP_EXPANSION_FACTOR: if (sscanf(MR_optarg, "%lf", &MR_heap_expansion_factor) != 1) { MR_usage(); } break; case MR_GENSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_genstack_size = size; break; case MR_GENSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_genstack_size = size * sizeof(MR_Word); break; case MR_CUTSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_cutstack_size = size; break; case MR_CUTSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_cutstack_size = size * sizeof(MR_Word); break; case MR_PNEGSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_pnegstack_size = size; break; case MR_PNEGSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_pnegstack_size = size * sizeof(MR_Word); break; case MR_GEN_DETSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_gen_detstack_size = size; break; case MR_GEN_DETSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_gen_detstack_size = size * sizeof(MR_Word); break; case MR_GEN_NONDETSTACK_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_gen_nondetstack_size = size; break; case MR_GEN_NONDETSTACK_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_gen_nondetstack_size = size * sizeof(MR_Word); break; case MR_GEN_DETSTACK_REDZONE_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_gen_detstack_zone_size = size; break; case MR_GEN_DETSTACK_REDZONE_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_gen_detstack_zone_size = size * sizeof(MR_Word); break; case MR_GEN_NONDETSTACK_REDZONE_SIZE: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_gen_nondetstack_zone_size = size; break; case MR_GEN_NONDETSTACK_REDZONE_SIZE_KWORDS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_gen_nondetstack_zone_size = size * sizeof(MR_Word); break; case MR_MAX_CONTEXTS_PER_THREAD: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_max_contexts_per_thread = size; break; case 'i': case MR_MDB_IN: MR_mdb_in_filename = MR_copy_string(MR_optarg); break; case 'o': case MR_MDB_OUT: MR_mdb_out_filename = MR_copy_string(MR_optarg); break; case 'e': case MR_MDB_ERR: MR_mdb_err_filename = MR_copy_string(MR_optarg); break; case 'm': case MR_MDB_TTY: MR_mdb_in_filename = MR_copy_string(MR_optarg); MR_mdb_out_filename = MR_copy_string(MR_optarg); MR_mdb_err_filename = MR_copy_string(MR_optarg); break; case 'n': case MR_NUM_OUTPUT_ARGS: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_num_output_args = size; break; case 'w': case MR_MDB_IN_WINDOW: MR_mdb_in_window = MR_TRUE; break; case MR_MDB_DISABLE_PROGRESS: MR_mdb_decl_print_progress = MR_FALSE; break; case MR_MDB_BENCHMARK_SILENT: MR_mdb_benchmark_silent = MR_TRUE; break; case MR_FORCE_READLINE: MR_force_readline = MR_TRUE; #ifdef MR_NO_USE_READLINE printf("Mercury runtime: `--force-readline' is specified " "in MERCURY_OPTIONS\n"); printf("but readline() is not available.\n"); fflush(stdout); exit(1); #endif break; case MR_DEBUG_THREADS_OPT: #ifdef MR_THREAD_SAFE MR_debug_threads = MR_TRUE; #endif break; case MR_DEEP_PROF_DEBUG_FILE_OPT: MR_deep_prof_debug_file_flag = MR_TRUE; break; case MR_DEEP_PROF_LOG_FILE_OPT: #if defined(MR_DEEP_PROFILING) && defined(MR_DEEP_PROFILING_LOG) MR_deep_prof_log_file = fopen(MR_optarg, "w"); if (MR_deep_prof_log_file == NULL) { perror(MR_optarg); exit(1); } #else printf("Mercury runtime: `--deep-log-file' is specified " "in MERCURY_OPTIONS\n"); printf("but support for it is not enabled.\n"); fflush(stdout); exit(1); #endif break; case MR_DEEP_PROF_LOG_PROG_OPT: #if defined(MR_DEEP_PROFILING) && defined(MR_DEEP_PROFILING_LOG) MR_deep_prof_log_file = popen(MR_optarg, "w"); if (MR_deep_prof_log_file == NULL) { perror(MR_optarg); exit(1); } #else printf("Mercury runtime: `--deep-log-prog' is specified " "in MERCURY_OPTIONS\n"); printf("but support for it is not enabled.\n"); fflush(stdout); exit(1); #endif break; case MR_TABLING_STATISTICS_OPT: MR_print_table_statistics = MR_TRUE; break; case MR_TRACE_COUNT_OPT: MR_trace_count_enabled = MR_TRUE; break; case MR_TRACE_COUNT_IF_EXEC_OPT: if (MR_matches_exec_name(MR_optarg)) { MR_trace_count_enabled = MR_TRUE; } break; case MR_COVERAGE_TEST_OPT: MR_coverage_test_enabled = MR_TRUE; MR_trace_count_enabled = MR_TRUE; break; case MR_COVERAGE_TEST_IF_EXEC_OPT: if (MR_matches_exec_name(MR_optarg)) { MR_coverage_test_enabled = MR_TRUE; MR_trace_count_enabled = MR_TRUE; } break; case MR_TRACE_COUNT_FILE: if (MR_trace_count_summary_file != NULL) { MR_fatal_error( "--trace-count-file and --trace-count-summary-file" " are mutually exclusive\n"); } MR_trace_counts_file = MR_copy_string(MR_optarg); break; case MR_TRACE_COUNT_SUMMARY_FILE_OPT: if (MR_trace_counts_file != NULL) { MR_fatal_error( "--trace-count-file and --trace-count-summary-file" " are mutually exclusive\n"); } MR_trace_count_summary_file = MR_copy_string(MR_optarg); break; case MR_TRACE_COUNT_SUMMARY_CMD_OPT: MR_trace_count_summary_cmd = MR_copy_string(MR_optarg); break; case MR_TRACE_COUNT_SUMMARY_MAX_OPT: if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } if (size < 2) { MR_usage(); } MR_trace_count_summary_max = size; break; case MR_MEM_USAGE_REPORT: mem_usage_report = MR_TRUE; break; case 'a': benchmark_all_solns = MR_TRUE; break; case 'c': MR_check_space = MR_TRUE; break; case 'C': if (sscanf(MR_optarg, "%lu", &size) != 1) { MR_usage(); } MR_pcache_size = size * 1024; break; case 'd': if (MR_streq(MR_optarg, "a")) { MR_calldebug = MR_TRUE; MR_nondetstackdebug = MR_TRUE; MR_detstackdebug = MR_TRUE; MR_heapdebug = MR_TRUE; MR_gotodebug = MR_TRUE; MR_sregdebug = MR_TRUE; MR_finaldebug = MR_TRUE; MR_tracedebug = MR_TRUE; #ifdef MR_MPS_GC MR_mps_quiet = MR_FALSE; #endif #ifdef MR_NATIVE_GC MR_agc_debug = MR_TRUE; #endif } else if (MR_streq(MR_optarg, "b")) { MR_nondetstackdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "B")) { if (sscanf(MR_optarg+1, "%u", &MR_lld_start_block) != 1) { MR_usage(); } } else if (MR_streq(MR_optarg, "c")) { MR_calldebug = MR_TRUE; } else if (MR_streq(MR_optarg, "d")) { MR_detaildebug = MR_TRUE; } else if (MR_streq(MR_optarg, "e")) { MR_standardize_event_details = MR_TRUE; } else if (MR_streq(MR_optarg, "f")) { MR_finaldebug = MR_TRUE; } else if (MR_streq(MR_optarg, "g")) { MR_gotodebug = MR_TRUE; } else if (MR_streq(MR_optarg, "G")) { #ifdef MR_MPS_GC MR_mps_quiet = MR_FALSE; #elif defined(MR_NATIVE_GC) MR_agc_debug = MR_TRUE; #else ; /* ignore inapplicable option */ #endif } else if (MR_streq(MR_optarg, "h")) { MR_heapdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "H")) { MR_hashdebug = MR_TRUE; } else if (MR_optarg[0] == 'i') { MR_lld_print_more_min_max = strdup(MR_optarg + 1); MR_setup_call_intervals(&MR_lld_print_more_min_max, &MR_lld_print_min, &MR_lld_print_max); } else if (MR_optarg[0] == 'I') { MR_watch_csd_start_name = strdup(MR_optarg+1); } else if (MR_optarg[0] == 'j') { MR_lld_start_name = strdup(MR_optarg+1); } else if (MR_streq(MR_optarg, "m")) { MR_memdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "o")) { MR_ordregdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "p")) { MR_progdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "P")) { MR_calldebug = MR_TRUE; MR_gotodebug = MR_TRUE; MR_finaldebug = MR_TRUE; } else if (MR_streq(MR_optarg, "r")) { MR_sregdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "R")) { MR_anyregdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "s")) { MR_detstackdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "S")) { MR_tablestackdebug = MR_TRUE; } else if (MR_streq(MR_optarg, "t")) { MR_tracedebug = MR_TRUE; } else if (MR_streq(MR_optarg, "T")) { MR_tabledebug = MR_TRUE; } else if (MR_streq(MR_optarg, "u")) { MR_unbufdebug = MR_TRUE; } else if (MR_optarg[0] == 'w' || MR_optarg[0] == 'W') { long addr; if (MR_optarg[1] == '0' && MR_optarg[2] == 'x') { if (sscanf(MR_optarg+3, "%lx", &addr) != 1) { MR_usage(); } } else { if (sscanf(MR_optarg+1, "%lu", &addr) != 1) { MR_usage(); } } MR_anyregdebug = MR_TRUE; if (MR_optarg[0] == 'w') { MR_watch_addr = (MR_Word *) addr; } else { MR_watch_csd_addr = (MR_CallSiteDynamic *) addr; } /* ** The watch code is called only from the ** debug messages controlled by MR_calldebug. */ MR_calldebug = MR_TRUE; } else { MR_usage(); } use_own_timer = MR_FALSE; break; case 'D': MR_debug_enabled = MR_TRUE; MR_debug_ever_enabled = MR_TRUE; if (MR_streq(MR_optarg, "i")) { MR_trace_handler = MR_TRACE_INTERNAL; #ifdef MR_USE_EXTERNAL_DEBUGGER } else if (MR_streq(MR_optarg, "e")) { MR_trace_handler = MR_TRACE_EXTERNAL; #endif } else { MR_usage(); } break; case 'p': MR_profiling = MR_FALSE; break; case 'P': #ifdef MR_THREAD_SAFE if (sscanf(MR_optarg, "%u", &MR_num_threads) != 1) { MR_usage(); } if (MR_num_threads < 1) { MR_usage(); } #endif break; case 'r': if (sscanf(MR_optarg, "%d", &repeats) != 1) { MR_usage(); } break; case 's': MR_deep_profiling_save_results = MR_FALSE; MR_complexity_save_results = MR_FALSE; break; case 'S': MR_print_deep_profiling_statistics = MR_TRUE; break; case 't': use_own_timer = MR_TRUE; MR_calldebug = MR_FALSE; MR_nondetstackdebug = MR_FALSE; MR_detstackdebug = MR_FALSE; MR_heapdebug = MR_FALSE; MR_gotodebug = MR_FALSE; MR_sregdebug = MR_FALSE; MR_finaldebug = MR_FALSE; break; case 'T': if (MR_streq(MR_optarg, "r")) { MR_time_profile_method = MR_profile_real_time; } else if (MR_streq(MR_optarg, "v")) { MR_time_profile_method = MR_profile_user_time; } else if (MR_streq(MR_optarg, "p")) { MR_time_profile_method = MR_profile_user_plus_system_time; } else { MR_usage(); } break; case 'x': #ifdef MR_BOEHM_GC GC_dont_gc = MR_TRUE; #endif break; case 'X': #ifdef MR_VERIFY_FAKE_REGISTERS MR_verify_fake_registers(); #endif break; default: MR_usage(); } } MR_max_outstanding_contexts = MR_max_contexts_per_thread * MR_num_threads; if (MR_lld_print_min > 0 || MR_lld_start_name != NULL) { MR_lld_print_enabled = 0; } if (MR_optind != argc) { printf("The MERCURY_OPTIONS environment variable contains " "the word `%s'\n" "which is not an option. Please refer to the " "Environment Variables section\n" "of the Mercury User's Guide for details.\n", argv[MR_optind]); fflush(stdout); exit(1); } #if !defined(MR_HIGHLEVEL_CODE) && defined(MR_THREAD_SAFE) if (MR_small_detstack_size > MR_detstack_size) { printf("The small detstack size must be smaller than the " "regular detstack size.\n"); fflush(stdout); exit(1); } if (MR_small_nondetstack_size > MR_nondetstack_size) { printf("The small nondetstack size must be smaller than the " "regular nondetstack size.\n"); fflush(stdout); exit(1); } #endif } static void MR_usage(void) { printf("The MERCURY_OPTIONS environment variable " "contains an invalid option.\n" "Please refer to the Environment Variables section of " "the Mercury\nUser's Guide for details.\n"); fflush(stdout); exit(1); } static MR_bool MR_matches_exec_name(const char *option) { char *s; const char *exec_name; s = strrchr(MR_progname, '/'); if (s == NULL) { exec_name = MR_progname; } else { exec_name = s + 1; } if (MR_streq(option, exec_name)) { return MR_TRUE; } else { return MR_FALSE; } } /* ** Get the next interval from *more_str_ptr, which should point to a string ** containing a comma-separated list of integer intervals. The last interval ** may be open ended. */ void MR_setup_call_intervals(char **more_str_ptr, unsigned long *min_ptr, unsigned long *max_ptr) { char *more_str; unsigned long min, max; int n; more_str = *more_str_ptr; /* Relying on the return value from sscanf() with %n is non-portable, so we need to call sscanf() twice here. */ if (sscanf(more_str, "%lu-%lu", &min, &max) == 2) { sscanf(more_str, "%lu-%lu%n", &min, &max, &n); more_str += n; if (more_str[0] == ',') { more_str++; } } else if (sscanf(more_str, "%lu-", &min) == 1) { more_str = NULL; max = (unsigned long) -1; } else { more_str = NULL; min = 0; max = (unsigned long) -1; } *more_str_ptr = more_str; *min_ptr = min; *max_ptr = max; } /*---------------------------------------------------------------------------*/ void mercury_runtime_main(void) { #if MR_NUM_REAL_REGS > 0 MR_Word c_regs[MR_NUM_REAL_REGS]; #endif #if defined(MR_LOWLEVEL_DEBUG) && defined(MR_USE_GCC_NONLOCAL_GOTOS) unsigned char safety_buffer[SAFETY_BUFFER_SIZE]; #endif #ifdef MR_DEEP_PROFILING MR_CallSiteDynList **saved_cur_callback; MR_CallSiteDynamic *saved_cur_csd; #endif static int repcounter; #ifdef MR_MSVC_STRUCTURED_EXCEPTIONS /* ** Under Win32 we use the following construction to handle exceptions. ** __try ** { ** ** } ** __except(MR_filter_win32_exception(GetExceptionInformation()) ** { ** } ** ** This type of construction allows us to retrieve all the information ** we need (exception type, address, etc) to display a "meaningful" ** message to the user. Using signal() in Win32 is less powerful, ** since we can only trap a subset of all possible exceptions, and ** we can't retrieve the exception address. The VC runtime implements ** signal() by surrounding main() with a __try __except block and ** calling the signal handler in the __except filter, exactly the way ** we do it here. */ __try { #endif /* ** Save the C callee-save registers ** and restore the Mercury registers */ MR_save_regs_to_mem(c_regs); MR_restore_registers(); #if defined(MR_LOWLEVEL_DEBUG) && defined(MR_USE_GCC_NONLOCAL_GOTOS) /* ** double-check to make sure that we're not corrupting ** the C stack with these non-local gotos, by filling ** a buffer with a known value and then later checking ** that it still contains only this value */ MR_global_pointer_2 = safety_buffer; /* defeat optimization */ MR_memset(safety_buffer, MAGIC_MARKER_2, SAFETY_BUFFER_SIZE); #endif #ifdef MR_LOWLEVEL_DEBUG #ifndef MR_CONSERVATIVE_GC MR_ENGINE(MR_eng_heap_zone)->max = MR_ENGINE(MR_eng_heap_zone)->min; #endif MR_CONTEXT(MR_ctxt_detstack_zone)->MR_zone_max = MR_CONTEXT(MR_ctxt_detstack_zone)->MR_zone_min; MR_CONTEXT(MR_ctxt_nondetstack_zone)->MR_zone_max = MR_CONTEXT(MR_ctxt_nondetstack_zone)->MR_zone_min; #endif MR_user_time_at_start = MR_get_user_cpu_milliseconds(); MR_user_time_at_last_stat = MR_user_time_at_start; MR_real_time_at_start = MR_get_real_milliseconds(); MR_real_time_at_last_stat = MR_real_time_at_start; for (repcounter = 0; repcounter < repeats; repcounter++) { #ifdef MR_DEEP_PROFILING saved_cur_callback = MR_current_callback_site; saved_cur_csd = MR_current_call_site_dynamic; MR_setup_callback(MR_program_entry_point); #endif #ifdef MR_HIGHLEVEL_CODE MR_do_interpreter(); #else MR_debugmsg0("About to call engine\n"); (void) MR_call_engine(MR_ENTRY(MR_do_interpreter), MR_FALSE); MR_debugmsg0("Returning from MR_call_engine()\n"); #endif #ifdef MR_DEEP_PROFILING MR_current_call_site_dynamic = saved_cur_csd; MR_current_callback_site = saved_cur_callback; #endif } if (use_own_timer) { MR_user_time_at_finish = MR_get_user_cpu_milliseconds(); } #if defined(MR_USE_GCC_NONLOCAL_GOTOS) && defined(MR_LOWLEVEL_DEBUG) { int i; for (i = 0; i < SAFETY_BUFFER_SIZE; i++) { MR_assert(safety_buffer[i] == MAGIC_MARKER_2); } } #endif if (MR_detaildebug) { MR_debugregs("after final call"); } #ifdef MR_LOWLEVEL_DEBUG if (MR_memdebug) { printf("\n"); #ifndef MR_CONSERVATIVE_GC printf("max heap used: %6ld words\n", (long) (MR_ENGINE(MR_eng_heap_zone)->max - MR_ENGINE(MR_eng_heap_zone)->min)); #endif printf("max detstack used: %6ld words\n", (long)(MR_CONTEXT(MR_ctxt_detstack_zone)->MR_zone_max - MR_CONTEXT(MR_ctxt_detstack_zone)->MR_zone_min)); printf("max nondetstack used: %6ld words\n", (long) (MR_CONTEXT(MR_ctxt_nondetstack_zone)->MR_zone_max - MR_CONTEXT(MR_ctxt_nondetstack_zone)->MR_zone_min)); } #endif #ifdef MR_MEASURE_REGISTER_USAGE printf("\n"); MR_print_register_usage_counts(); #endif #ifdef MR_DO_CALL_STATS { char *stats_file_name; FILE *stats_fp; stats_file_name = getenv("HO_CALL_STATS"); if (stats_file_name != NULL) { stats_fp = fopen(stats_file_name, "a"); if (stats_fp != NULL) { MR_print_hidden_arg_stats(stats_fp); (void) fclose(stats_fp); } } } #endif if (use_own_timer) { printf("%8.3fu ", ((double) (MR_user_time_at_finish - MR_user_time_at_start)) / 1000); } #ifdef MR_TYPE_CTOR_STATS MR_print_type_ctor_stats(); #endif #ifdef MR_STACK_FRAME_STATS MR_print_stack_frame_stats(); #endif /* MR_STACK_FRAME_STATS */ /* ** Save the Mercury registers and ** restore the C callee-save registers before returning, ** since they may be used by the C code that called us. */ MR_save_registers(); MR_restore_regs_from_mem(c_regs); #ifdef MR_MSVC_STRUCTURED_EXCEPTIONS } __except(MR_filter_win32_exception(GetExceptionInformation())) { /* Everything is done in MR_filter_win32_exception */ } #endif } /* end mercury_runtime_main() */ #ifdef MR_TYPE_CTOR_STATS #define MR_INIT_CTOR_NAME_ARRAY_SIZE 10 void MR_register_type_ctor_stat(MR_TypeStat *type_stat, MR_TypeCtorInfo type_ctor_info) { int i; MR_TypeCtorRep rep; rep = MR_type_ctor_rep(type_ctor_info); type_stat->type_ctor_reps[MR_GET_ENUM_VALUE(rep)]++; for (i = 0; i < type_stat->type_ctor_name_next; i++) { /* ** We can compare pointers instead of using strcmp, ** because the pointers in the array come from the ** type_ctor_infos themselves, and there is only one ** static type_ctor_info for each modulename.typename ** combination. */ if (type_stat->type_ctor_names[i].type_stat_module == type_ctor_info->type_ctor_module_name && type_stat->type_ctor_names[i].type_stat_name == type_ctor_info->type_ctor_name) { type_stat->type_ctor_names[i].type_stat_count++; return; } } MR_ensure_room_for_next(type_stat->type_ctor_name, MR_TypeNameStat, MR_INIT_CTOR_NAME_ARRAY_SIZE); i = type_stat->type_ctor_name_next; type_stat->type_ctor_names[i].type_stat_module = type_ctor_info->type_ctor_module_name; type_stat->type_ctor_names[i].type_stat_name = type_ctor_info->type_ctor_name; type_stat->type_ctor_names[i].type_stat_ctor_rep = rep; type_stat->type_ctor_names[i].type_stat_count = 1; type_stat->type_ctor_name_next++; } static void MR_print_type_ctor_stats(void) { FILE *fp; fp = fopen(MR_TYPE_CTOR_STATS, "a"); if (fp == NULL) { return; } MR_print_one_type_ctor_stat(fp, "UNIFY", &MR_type_stat_mer_unify); MR_print_one_type_ctor_stat(fp, "UNIFY_C", &MR_type_stat_c_unify); MR_print_one_type_ctor_stat(fp, "COMPARE", &MR_type_stat_mer_compare); MR_print_one_type_ctor_stat(fp, "COMPARE_C", &MR_type_stat_c_compare); (void) fclose(fp); } static void MR_print_one_type_ctor_stat(FILE *fp, const char *op, MR_TypeStat *type_stat) { int i; for (i = 0; i < (int) MR_TYPECTOR_REP_UNKNOWN; i++) { if (type_stat->type_ctor_reps[i] > 0) { fprintf(fp, "%s %s %ld\n", op, MR_ctor_rep_name[i], type_stat->type_ctor_reps[i]); } } for (i = 0; i < type_stat->type_ctor_name_next; i++) { fprintf(fp, "%s %s %s %s %ld\n", op, type_stat->type_ctor_names[i].type_stat_module, type_stat->type_ctor_names[i].type_stat_name, MR_ctor_rep_name[MR_GET_ENUM_VALUE(type_stat-> type_ctor_names[i].type_stat_ctor_rep)], type_stat->type_ctor_names[i].type_stat_count); } } #endif #ifdef MR_HIGHLEVEL_CODE static void MR_do_interpreter(void) { #if !defined(MR_CONSERVATIVE_GC) && !defined(MR_NATIVE_GC) /* ** Save the heap pointer here and restore it at the end ** of this function, so that you can run benchmarks in ** a loop in grade `hlc' without running out of memory. */ MR_Word *saved_hp = MR_hp; #endif #ifdef MR_MPROF_PROFILE_TIME if (MR_profiling) { MR_prof_turn_on_time_profiling(); } #endif /* call the entry point (normally the Mercury predicate main/2) */ { MR_Word outputs[4]; typedef void MR_CALL (*EntryPoint1)(MR_Word *); typedef void MR_CALL (*EntryPoint2)(MR_Word *, MR_Word *); typedef void MR_CALL (*EntryPoint3)(MR_Word *, MR_Word *, MR_Word *); typedef void MR_CALL (*EntryPoint4)(MR_Word *, MR_Word *, MR_Word *, MR_Word *); switch (MR_num_output_args) { case 0: (*MR_program_entry_point)(); break; case 1: (*(EntryPoint1)MR_program_entry_point)(&outputs[0]); break; case 2: (*(EntryPoint2)MR_program_entry_point)(&outputs[0], &outputs[1]); break; case 3: (*(EntryPoint3)MR_program_entry_point)(&outputs[0], &outputs[1], &outputs[2]); break; case 4: (*(EntryPoint4)MR_program_entry_point)(&outputs[0], &outputs[1], &outputs[2], &outputs[3]); break; default: MR_fatal_error("sorry, not implemented: " "--num-output-args > 4"); } } #if defined(MR_HIGHLEVEL_CODE) && defined(MR_THREAD_SAFE) assert(pthread_self() == MR_primordial_thread); MR_LOCK(&MR_thread_barrier_lock, "MR_do_interpreter"); while (MR_thread_barrier_count > 0) { while (MR_WAIT(&MR_thread_barrier_cond, &MR_thread_barrier_lock) != 0) { } } MR_UNLOCK(&MR_thread_barrier_lock, "MR_do_interpreter"); #endif #ifdef MR_MPROF_PROFILE_TIME if (MR_profiling) { MR_prof_turn_off_time_profiling(); } #endif #if !defined(MR_CONSERVATIVE_GC) && !defined(MR_NATIVE_GC) MR_hp_word = (MR_Word) saved_hp; #endif } #else /* ! MR_HIGHLEVEL_CODE */ MR_define_extern_entry(MR_do_interpreter); MR_declare_label(global_success); MR_declare_label(global_success_2); MR_declare_label(global_fail); MR_declare_label(all_done); MR_declare_label(wrapper_not_reached); MR_BEGIN_MODULE(interpreter_module) MR_init_entry_an(MR_do_interpreter); MR_init_label_an(global_success); MR_init_label_an(global_success_2); MR_init_label_an(global_fail); MR_init_label_an(all_done); MR_init_label_an(wrapper_not_reached); MR_BEGIN_CODE MR_define_entry(MR_do_interpreter); MR_incr_sp(4); MR_stackvar(1) = MR_hp_word; MR_stackvar(2) = MR_succip_word; MR_stackvar(3) = MR_maxfr_word; MR_stackvar(4) = MR_curfr_word; MR_succip_word = (MR_Word) MR_LABEL(wrapper_not_reached); MR_mkframe("interpreter", 1, MR_LABEL(global_fail)); MR_nondet_stack_trace_bottom = MR_maxfr; MR_stack_trace_bottom = MR_LABEL(global_success); #ifdef MR_LOWLEVEL_DEBUG if (MR_finaldebug) { MR_save_transient_registers(); MR_printregs(stdout, "do_interpreter started"); if (MR_detaildebug) { MR_dumpnondetstack(stdout); } } #endif if (MR_program_entry_point == NULL) { MR_fatal_error("no program entry point supplied"); } #ifdef MR_MPROF_PROFILE_TIME MR_set_prof_current_proc(MR_program_entry_point); if (MR_profiling) { MR_prof_turn_on_time_profiling(); } #endif MR_noprof_call(MR_program_entry_point, MR_LABEL(global_success)); MR_define_label(global_success); /* ** Don't let the original Mercury thread continue onto MR_global_success_2 ** until all other threads have terminated. */ MR_LOCK(&MR_thread_barrier_lock, "global_success"); if (MR_thread_barrier_count == 0) { MR_UNLOCK(&MR_thread_barrier_lock, "global_success"); MR_GOTO_LABEL(global_success_2); } else { MR_Context *this_ctxt; this_ctxt = MR_ENGINE(MR_eng_this_context); MR_save_context(this_ctxt); this_ctxt->MR_ctxt_resume = MR_LABEL(global_success_2); MR_thread_barrier_context = this_ctxt; MR_UNLOCK(&MR_thread_barrier_lock, "global_success"); MR_ENGINE(MR_eng_this_context) = NULL; MR_runnext(); } MR_define_label(global_success_2); #ifdef MR_LOWLEVEL_DEBUG if (MR_finaldebug) { MR_save_transient_registers(); MR_printregs(stdout, "global succeeded"); if (MR_detaildebug) { MR_dumpnondetstack(stdout); } } #endif if (benchmark_all_solns) { MR_redo(); } else { MR_GOTO_LABEL(all_done); } MR_define_label(global_fail); #ifdef MR_LOWLEVEL_DEBUG if (MR_finaldebug) { MR_save_transient_registers(); MR_printregs(stdout, "global failed"); if (MR_detaildebug) { MR_dumpnondetstack(stdout); } } #endif MR_define_label(all_done); assert(MR_runqueue_head == NULL); #ifndef MR_HIGHLEVEL_CODE assert(MR_spark_queue_head == NULL); #endif #ifdef MR_MPROF_PROFILE_TIME if (MR_profiling) { MR_prof_turn_off_time_profiling(); } #endif MR_hp_word = MR_stackvar(1); MR_succip_word = MR_stackvar(2); MR_maxfr_word = MR_stackvar(3); MR_curfr_word = MR_stackvar(4); MR_decr_sp(4); #ifdef MR_LOWLEVEL_DEBUG if (MR_finaldebug && MR_detaildebug) { MR_save_transient_registers(); MR_printregs(stdout, "after popping..."); } #endif MR_proceed(); #ifndef MR_USE_GCC_NONLOCAL_GOTOS return 0; #endif MR_define_label(wrapper_not_reached); MR_fatal_error("reached wrapper_not_reached"); MR_END_MODULE #endif /* MR_HIGHLEVEL_CODE */ /*---------------------------------------------------------------------------*/ #ifdef MR_HIGHLEVEL_CODE void MR_dummy_main(void) { MR_fatal_error("invalid attempt to call through Mercury entry point."); } #else /* ! MR_HIGHLEVEL_CODE */ MR_define_extern_entry(MR_dummy_main); MR_BEGIN_MODULE(dummy_main_module) MR_init_entry_an(MR_dummy_main); MR_BEGIN_CODE MR_define_entry(MR_dummy_main); MR_fatal_error("invalid attempt to call through Mercury entry point."); MR_END_MODULE #endif /* ! MR_HIGHLEVEL_CODE */ /*---------------------------------------------------------------------------*/ int mercury_runtime_terminate(void) { #if MR_NUM_REAL_REGS > 0 MR_Word c_regs[MR_NUM_REAL_REGS]; #endif /* ** Save the callee-save registers; we're going to start using them ** as global registers variables now, which will clobber them, ** and we need to preserve them, because they're callee-save, ** and our caller may need them. */ MR_save_regs_to_mem(c_regs); /* run any user-defined finalisation predicates */ (*MR_address_of_final_modules_required)(); MR_trace_end(); (*MR_library_finalizer)(); /* ** Restore the registers before calling MR_trace_final() ** as MR_trace_final() expect them to be valid. */ MR_restore_registers(); MR_trace_final(); if (MR_trace_count_enabled) { MR_trace_record_label_exec_counts(NULL); } #if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \ || defined(MR_MPROF_PROFILE_MEMORY) if (MR_profiling) { MR_prof_finish(); } #endif #ifdef MR_DEEP_PROFILING MR_deep_prof_turn_off_time_profiling(); if (MR_deep_profiling_save_results) { MR_write_out_profiling_tree(); } #ifdef MR_DEEP_PROFILING_LOG (void) fclose(MR_deep_prof_log_file); #endif #endif #ifdef MR_RECORD_TERM_SIZES if (MR_complexity_save_results) { MR_write_complexity_procs(); } #endif if (MR_print_table_statistics) { MR_table_report_statistics(stdout); } #if !defined(MR_HIGHLEVEL_CODE) && defined(MR_THREAD_SAFE) MR_LOCK(&MR_runqueue_lock, "exit_now"); MR_exit_now = MR_TRUE; pthread_cond_broadcast(&MR_runqueue_cond); MR_UNLOCK(&MR_runqueue_lock, "exit_now"); assert(MR_primordial_thread == pthread_self()); MR_primordial_thread = (MercuryThread) 0; #endif #if 0 /* XXX the following code breaks on Win32 */ if (mem_usage_report) { char buf[MAX_MEM_USAGE_REPORT_FILENAME_SIZE]; int i; int fd; FILE *fp; fp = NULL; for (i = 1; i < MAX_MEM_USAGE_REPORT_ATTEMPTS; i++) { sprintf(buf, ".mem_usage_report%02d", i); fd = open(buf, O_WRONLY | O_CREAT | O_EXCL, 0600); if (fd >= 0) { fp = fdopen(fd, "w"); break; } } if (fp != NULL) { struct rusage rusage; fprintf(fp, "io actions %10d\n", MR_io_tabling_counter_hwm); if (getrusage(RUSAGE_SELF, &rusage) == 0) { fprintf(fp, "max resident %10ld\n", rusage.ru_maxrss); fprintf(fp, "integral shared %10ld\n", rusage.ru_ixrss); fprintf(fp, "integral unshared %10ld\n", rusage.ru_idrss); fprintf(fp, "integral stack %10ld\n", rusage.ru_isrss); fprintf(fp, "page reclaims %10ld\n", rusage.ru_minflt); fprintf(fp, "page faults %10ld\n", rusage.ru_majflt); fprintf(fp, "swaps %10ld\n", rusage.ru_nswap); } (void) fclose(fp); } } #endif /* breaks on Win32 */ MR_terminate_engine(); /* ** Restore the callee-save registers before returning, ** since they may be used by the C code that called us. */ MR_restore_regs_from_mem(c_regs); return mercury_exit_status; } /*---------------------------------------------------------------------------*/ /* forward decls to suppress gcc warnings */ void mercury_sys_init_wrapper_init(void); void mercury_sys_init_wrapper_init_type_tables(void); #ifdef MR_DEEP_PROFILING void mercury_sys_init_wrapper_write_out_proc_statics(FILE *fp); #endif void mercury_sys_init_wrapper_init(void) { #ifndef MR_HIGHLEVEL_CODE interpreter_module(); dummy_main_module(); #endif } void mercury_sys_init_wrapper_init_type_tables(void) { /* no types to register */ } #ifdef MR_DEEP_PROFILING void mercury_sys_init_wrapper_write_out_proc_statics(FILE *fp) { /* no proc_statics to write out */ } #endif