mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-14 21:35:49 +00:00
Code Issues Projects Releases Wiki Activity
Files
0023d13f18b16f683c9725c1ce2abe89e02ef594
mercury/runtime/mercury_wrapper.c
Zoltan Somogyi c731d85a1f Add check for misspelt autoconf variable names. 
Estimated hours taken: 0.5
Branches: main

runtime/Mmakefile:
	Add check for misspelt autoconf variable names.

runtime/mercury_wrapper.c:
	Add a mechanism for configuring the sizes of the stacks involved in
	minimal model tabling from the MERCURY_OPTIONS environment variable.

	Conform to our coding standards for braces in if-then-elses.

doc/user_guide.texi:
	Document the new options.
2005-05-09 08:05:05 +00:00

2197 lines
56 KiB
C
Raw Blame History

/*
INIT mercury_sys_init_wrapper
ENDINIT
*/
/*
** Copyright (C) 1994-2005 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 <stdio.h>
#include <string.h>
#if 0 /* XXX the following code breaks on Win32 */
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <sys/resource.h>
#endif /* breaks on Win32 */
#ifdef MR_MSVC_STRUCTURED_EXCEPTIONS
#include <excpt.h>
#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 */
/*
** size 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 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 = 52;
#else
size_t MR_heap_size = 32768; /* 32 Mb */
#endif
size_t MR_detstack_size = 4096;
size_t MR_nondstack_size = 256;
size_t MR_solutions_heap_size = 1024;
size_t MR_global_heap_size = 1024;
size_t MR_trail_size = 128;
size_t MR_debug_heap_size = 4096;
size_t MR_genstack_size = 32;
size_t MR_cutstack_size = 32;
size_t MR_pnegstack_size = 32;
size_t MR_gen_detstack_size = 64;
size_t MR_gen_nonstack_size = 64;
/*
** 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 -- 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 = 32;
#else
size_t MR_heap_zone_size = 16 + 28 * 1024;
#endif
#else
size_t MR_heap_zone_size = 16;
#endif
size_t MR_detstack_zone_size = 16;
size_t MR_nondstack_zone_size = 16;
size_t MR_solutions_heap_zone_size = 16;
size_t MR_global_heap_zone_size = 16;
size_t MR_trail_zone_size = 16;
size_t MR_debug_heap_zone_size = 16;
size_t MR_genstack_zone_size = 16;
size_t MR_cutstack_zone_size = 16;
size_t MR_pnegstack_zone_size = 16;
size_t MR_gen_detstack_zone_size = 16;
size_t MR_gen_nonstack_zone_size = 16;
/*
** 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 = 16;
#else
size_t MR_heap_margin_size = 28 * 1024;
#endif
double MR_heap_expansion_factor = 2.0;
/* primary cache size to optimize for, in bytes */
size_t MR_pcache_size = 8192;
/* 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_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 MR_num_threads = 1;
static MR_bool MR_print_table_statistics = MR_FALSE;
/* timing */
int MR_time_at_last_stat;
int MR_time_at_start;
static int MR_time_at_finish;
/* 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.
** - `aditi__connect/6' in extras/aditi/aditi.m calls
** MR_do_load_aditi_rl_code() in the automatically
** generated C init file.
**
** 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
MR_TypeCtorInfo MR_type_ctor_info_for_univ;
MR_TypeInfo MR_type_info_for_type_info;
MR_TypeInfo 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;
MR_Box (*MR_address_of_do_load_aditi_rl_code)(MR_Box, MR_Box);
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_Label_Layout *, 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_Label_Layout *);
void (*MR_address_of_trace_interrupt_handler)(void);
void (*MR_register_module_layout)(const MR_Module_Layout *);
#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 process_args(int argc, char **argv);
static void process_environment_options(void);
static void process_options(int argc, char **argv);
static void usage(void);
#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.
*/
process_args(argc, argv);
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();
#ifdef MR_NEED_INITIALIZATION_AT_START
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();
#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 */
#ifndef MR_THREAD_SAFE
MR_init_thread(MR_use_now);
#else
{
int i;
MR_init_thread(MR_use_now);
MR_exit_now = MR_FALSE;
for (i = 1 ; i < MR_num_threads ; i++) {
MR_create_thread(NULL);
}
}
#endif /* ! MR_THREAD_SAFE */
#endif /* ! MR_HIGHLEVEL_CODE */
if (MR_memdebug) {
MR_debug_memory();
}
/* 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();
}
#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)();
#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
/*
** 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;
/*
** In case the program terminates with an exception,
** we still want the trace count to be written out.
*/
MR_register_exception_cleanup(
MR_trace_write_label_exec_counts_to_file, 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 runtime_mercury_init() */
#ifdef MR_CONSERVATIVE_GC
#ifdef MR_MPS_GC
MR_bool GC_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, !GC_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;
GC_quiet = MR_TRUE;
/*
** 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 <foo>_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++;
} /* end for */
/*
** 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';
} /* end for */
*args_ptr = args;
*argv_ptr = argv;
*argc_ptr = argc;
return NULL; /* success */
} /* end MR_make_argv() */
/*
** 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
process_args(int argc, char **argv)
{
MR_progname = argv[0];
mercury_argc = argc - 1;
mercury_argv = argv + 1;
}
/*
** process_environment_options() is a function to parse the MERCURY_OPTIONS
** environment variable.
*/
static void
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);
process_options(argc, argv);
MR_GC_free(arg_str);
MR_GC_free(argv);
}
}
enum MR_long_option {
MR_HEAP_SIZE,
MR_DETSTACK_SIZE,
MR_NONDETSTACK_SIZE,
MR_SOLUTIONS_HEAP_SIZE,
MR_TRAIL_SIZE,
MR_HEAP_REDZONE_SIZE,
MR_DETSTACK_REDZONE_SIZE,
MR_NONDETSTACK_REDZONE_SIZE,
MR_SOLUTIONS_HEAP_REDZONE_SIZE,
MR_TRAIL_REDZONE_SIZE,
MR_HEAP_MARGIN_SIZE,
MR_HEAP_EXPANSION_FACTOR,
MR_GENSTACK_SIZE,
MR_CUTSTACK_SIZE,
MR_PNEGSTACK_SIZE,
MR_GEN_DETSTACK_SIZE,
MR_GEN_NONSTACK_SIZE,
MR_GEN_DETSTACK_REDZONE_SIZE,
MR_GEN_NONSTACK_REDZONE_SIZE,
MR_MDB_TTY,
MR_MDB_IN,
MR_MDB_OUT,
MR_MDB_ERR,
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_TABLING_STATISTICS_OPT,
MR_TRACE_COUNT_OPT,
MR_COVERAGE_TEST_OPT,
MR_MEM_USAGE_REPORT
};
struct MR_option MR_long_opts[] = {
{ "heap-size", 1, 0, MR_HEAP_SIZE },
{ "detstack-size", 1, 0, MR_DETSTACK_SIZE },
{ "nondetstack-size", 1, 0, MR_NONDETSTACK_SIZE },
{ "solutions-heap-size", 1, 0, MR_SOLUTIONS_HEAP_SIZE },
{ "trail-size", 1, 0, MR_TRAIL_SIZE },
{ "heap-redzone-size", 1, 0, MR_HEAP_REDZONE_SIZE },
{ "detstack-redzone-size", 1, 0, MR_DETSTACK_REDZONE_SIZE },
{ "nondetstack-redzone-size", 1, 0, MR_NONDETSTACK_REDZONE_SIZE },
{ "solutions-heap-redzone-size",1, 0, MR_SOLUTIONS_HEAP_REDZONE_SIZE },
{ "trail-redzone-size", 1, 0, MR_TRAIL_REDZONE_SIZE },
{ "heap-margin-size", 1, 0, MR_HEAP_MARGIN_SIZE },
{ "heap-expansion-factor", 1, 0, MR_HEAP_EXPANSION_FACTOR },
{ "genstack-size", 1, 0, MR_GENSTACK_SIZE },
{ "cutstack-size", 1, 0, MR_CUTSTACK_SIZE },
{ "pnegstack-size", 1, 0, MR_PNEGSTACK_SIZE },
{ "gen-detstack-size", 1, 0, MR_GEN_DETSTACK_SIZE },
{ "gen-nonstack-size", 1, 0, MR_GEN_NONSTACK_SIZE },
{ "gen-detstack-zone-size", 1, 0, MR_GEN_DETSTACK_REDZONE_SIZE },
{ "gen-nonstack-zone-size", 1, 0, MR_GEN_NONSTACK_REDZONE_SIZE },
{ "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-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 },
{ "tabling-statistics", 0, 0, MR_TABLING_STATISTICS_OPT },
{ "trace-count", 0, 0, MR_TRACE_COUNT_OPT },
{ "coverage-test", 0, 0, MR_COVERAGE_TEST_OPT },
{ "mem-usage-report", 0, 0, MR_MEM_USAGE_REPORT }
};
static void
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) {
usage();
}
MR_heap_size = size;
break;
case MR_DETSTACK_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_detstack_size = size;
break;
case MR_NONDETSTACK_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_nondstack_size = size;
break;
case MR_SOLUTIONS_HEAP_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_solutions_heap_size = size;
break;
case MR_TRAIL_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_trail_size = size;
break;
case MR_HEAP_REDZONE_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_heap_zone_size = size;
break;
case MR_DETSTACK_REDZONE_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_detstack_zone_size = size;
break;
case MR_NONDETSTACK_REDZONE_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_nondstack_zone_size = size;
break;
case MR_SOLUTIONS_HEAP_REDZONE_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_solutions_heap_zone_size = size;
break;
case MR_TRAIL_REDZONE_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_trail_zone_size = size;
break;
case MR_HEAP_MARGIN_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_heap_margin_size = size;
break;
case MR_HEAP_EXPANSION_FACTOR:
if (sscanf(MR_optarg, "%lf",
&MR_heap_expansion_factor) != 1)
{
usage();
}
break;
case MR_GENSTACK_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_genstack_size = size;
break;
case MR_CUTSTACK_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_cutstack_size = size;
break;
case MR_PNEGSTACK_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_pnegstack_size = size;
break;
case MR_GEN_DETSTACK_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_gen_detstack_size = size;
break;
case MR_GEN_NONSTACK_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_gen_nonstack_size = size;
break;
case MR_GEN_DETSTACK_REDZONE_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_gen_detstack_zone_size = size;
break;
case MR_GEN_NONSTACK_REDZONE_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
usage();
}
MR_gen_nonstack_zone_size = 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) {
usage();
}
MR_num_output_args = size;
break;
case 'w':
case MR_MDB_IN_WINDOW:
MR_mdb_in_window = MR_TRUE;
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_TABLING_STATISTICS_OPT:
MR_print_table_statistics = MR_TRUE;
break;
case MR_TRACE_COUNT_OPT:
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_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) {
usage();
}
MR_pcache_size = size * 1024;
break;
case 'd':
if (MR_streq(MR_optarg, "a")) {
MR_calldebug = MR_TRUE;
MR_nondstackdebug = 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_CONSERVATIVE_GC
GC_quiet = MR_FALSE;
#endif
#ifdef MR_NATIVE_GC
MR_agc_debug = MR_TRUE;
#endif
} else if (MR_streq(MR_optarg, "b")) {
MR_nondstackdebug = MR_TRUE;
} else if (MR_streq(MR_optarg, "B")) {
if (sscanf(MR_optarg+1, "%u",
&MR_lld_start_block) != 1)
{
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_CONSERVATIVE_GC
GC_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)
{
usage();
}
} else {
if (sscanf(MR_optarg+1, "%lu", &addr)
!= 1)
{
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 {
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 {
usage();
}
break;
case 'p':
MR_profiling = MR_FALSE;
break;
case 'P':
#ifdef MR_THREAD_SAFE
if (sscanf(MR_optarg, "%u", &MR_num_threads) != 1) {
usage();
}
if (MR_num_threads < 1) {
usage();
}
#endif
break;
case 'r':
if (sscanf(MR_optarg, "%d", &repeats) != 1) {
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_nondstackdebug = 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 {
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:
usage();
} /* end switch */
} /* end while */
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);
}
} /* end process_options() */
static void
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);
} /* end usage() */
/*
** 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
** {
** <various stuff>
** }
** __except(MR_filter_win32_exception(GetExceptionInformation())
** {
** }
**
** This type of contruction 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 */
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)->max =
MR_CONTEXT(MR_ctxt_detstack_zone)->min;
MR_CONTEXT(MR_ctxt_nondetstack_zone)->max =
MR_CONTEXT(MR_ctxt_nondetstack_zone)->min;
#endif
MR_time_at_start = MR_get_user_cpu_miliseconds();
MR_time_at_last_stat = MR_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_time_at_finish = MR_get_user_cpu_miliseconds();
}
#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)->max
- MR_CONTEXT(MR_ctxt_detstack_zone)->min));
printf("max nondstack used: %6ld words\n",
(long) (MR_CONTEXT(MR_ctxt_nondetstack_zone)->max
- MR_CONTEXT(MR_ctxt_nondetstack_zone)->min));
}
#endif
#ifdef MR_MEASURE_REGISTER_USAGE
printf("\n");
MR_print_register_usage_counts();
#endif
if (use_own_timer) {
printf("%8.3fu ",
((double) (MR_time_at_finish - MR_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");
}
}
#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 = saved_hp;
#endif
}
#else /* ! MR_HIGHLEVEL_CODE */
MR_define_extern_entry(MR_do_interpreter);
MR_declare_label(global_success);
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_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("do_interpreter started");
if (MR_detaildebug) {
MR_dumpnondstack();
}
}
#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);
#ifdef MR_LOWLEVEL_DEBUG
if (MR_finaldebug) {
MR_save_transient_registers();
MR_printregs("global succeeded");
if (MR_detaildebug) {
MR_dumpnondstack();
}
}
#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("global failed");
if (MR_detaildebug) {
MR_dumpnondstack();
}
}
#endif
MR_define_label(all_done);
#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("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
/*---------------------------------------------------------------------------*/
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);
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_write_label_exec_counts_to_file(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();
}
#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);
}
#ifndef MR_HIGHLEVEL_CODE
#ifdef MR_THREAD_SAFE
MR_exit_now = MR_TRUE;
pthread_cond_broadcast(&MR_runqueue_cond);
#endif
#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;
}
/*---------------------------------------------------------------------------*/
MR_Box
MR_load_aditi_rl_code(MR_Box connection, MR_Box bytecode_transaction)
{
if (MR_address_of_do_load_aditi_rl_code != NULL) {
return (*MR_address_of_do_load_aditi_rl_code)(connection,
bytecode_transaction);
} else {
MR_fatal_error(
"attempt to load Aditi-RL code from an executable\n"
"not compiled for Aditi execution.\n"
"Add `--aditi' to C2INITFLAGS.\n"
);
}
}
/*---------------------------------------------------------------------------*/
/* 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();
#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
Reference in New Issue View Git Blame Copy Permalink