mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-16 22:35:41 +00:00
Code Issues Projects Releases Wiki Activity
Files
b82b599ec3b50b8c4a232d50f94c57c8a158ddb7
mercury/runtime/mercury_wrapper.c
Zoltan Somogyi b82b599ec3 Implement coverage testing. The output format is a bit crude, but people 
Estimated hours taken: 60
Branches: main

Implement coverage testing. The output format is a bit crude, but people
have been asking for this capability.

The main problem tackled in this diff is that coverage testing requires
gathering information from a lot of program executions, and the execution count
files for all these executions require a huge amount of disk space. We now
therefore put a limit on the number of files we keep; when this limit is
exceeded, the program execution that reaches the limit will automatically
summarize all these files back into a single file before it exits.

This diff also tackles the same problem along a different axis by changing
the format of execution count files to make them smaller. One way is to factor
out and represent just once some information that is common to many procedures:
the file name and the module name. Another is to abbreviate some keywords,
e.g. "fproc" instead of "proc function". The third is not to write out the
defining module's name unless it differs from the declaring module's name,
which it almost never does. (The two differ only when the compiler is invoked
with intermodule optimization, and creates a specialized version of a predicate
in a module other than its home module.)

Since we are changing the trace count file format anyway, make another change
useful for coverage testing: record the entire provenance of the trace counts
in the file, including the name of the program and what files went into unions
and diffs of trace count files.

When doing coverage testing of the compiler, the compiler *must* be in a debug
grade. However, the tools for summarizing trace files, invoked from the
compiler executable when the compiler is being coverage tested, *cannot* be
in debug grade, because debug grade disables tail recursion, and without tail
recursion the summarization program runs out of stack space. This diff
therefore arranges for the slice directory to not be affected by the parameters
applying to the rest of the workspace (including the top level Mmake.params).

Mmakefile:
	Don't apply the top level mmake's parameters to recursive mmakes in
	the slice directory.

	Factor out some common code.

configure.in:
	Require that the installed compiler contain the renamed standard
	library function names installed by my diff on Sep 20, since the
	slice directory needs them, and cannot get them from the workspace.

mdbcomp/trace_counts.m:
	Update the parsing code to parse the new format for trace count files,
	and update the code for writing out trace counts to generate the new
	format.

	Replace the proc_label_and_filename type with the proc_label_in_context
	type, which makes it easier to keep track of the current module as well
	as the current file (this is required by the new, more compact format
	for trace count files).

	When considering the union of multiple trace counts files, keep track
	of whether they contained all counts or just the nonzero counts. This
	requires keeping track of this info for single files as well.

	Provide ways to represent and to compute differences between trace
	count files, to support the new program in slice/mtc_diff.m.

mdbcomp/slice_and_dice.m:
	Reformat to conform to our Mercury style guide.

	Conform to the change to trace_counts.m.

compiler/tupling.m:
	Conform to the change to mdbcomp.

runtime/mercury_wrapper.c:
	Implement the new option values used to implement coverage testing.
	These allow control of the limit on the number of execution count
	files, and collecting execution counts only from a specified
	executable.

	Add MR_ prefixes.

runtime/mercury_trace_base.[ch]:
	Provide the mechanism for summarizing execution counts when we reach
	the limit on the number of execution counts files.

	Update the code that writes out trace counts files to generate
	the new format for trace counts files. Make this code take the boolean
	that says whether to include labels with zero counts in the output
	as an explicit parameter, not as a global variable.

	Break up an excessively large function.

scripts/mtc:
	Add the options needed to control the process of automatic
	summarization of trace counts files.

slice/.mgnuc_copts:
slice/.mgnuc_opts:
slice/SLICE_FLAGS.in:
	Make these files empty, since we don't want to refer to the rest of the
	workspace. (We could delete them as well, but CVS doesn't handle
	resurrection of deleted files very well, and we don't want to burn any
	bridges.)

slice/Mmakefile:
	Add the new executables, and make the code in this directory
	independent of the other directories in the workspace.

	Since we need the code of the modules in the mdbcomp directory
	but don't want to link to the object files in that directory (since
	the grades may differ), make copies of those modules in this directory.

slice/mcov.m:
	Add this module, the code for the Mercury coverage test tool.

slice/mtc_diff.m:
	Add this module, the code for computing the diff between two trace
	counts files. The intended use is to compare two trace counts files
	dumped at different stages of execution. (Since foreign_procs can be
	used to invoke the C functions in the runtime that write out the trace
	counts files in the middle of a program's execution, not just the end.)

slice/mdice.m:
slice/mslice.m:
slice/mtc_union.m:
	Convert to four space indentation.

tools/bootcheck:
	Since the slice directory's grade is independent of the grade of the
	other directories, don't copy it to the stage2 and stage3 by default.
	If it is copied, then still compile it (and otherwise handle it)
	separate from the other directories.

	Add an option for gathering coverage test data during bootchecking.
2006-09-22 03:50:48 +00:00

2480 lines
77 KiB
C
Raw Blame History

/*
** vim: ts=4 sw=4 expandtab
*/
/*
INIT mercury_sys_init_wrapper
ENDINIT
*/
/*
** Copyright (C) 1994-2006 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, MR_detstack_size or MR_nondstack_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
size_t MR_detstack_size = 1024 * sizeof(MR_Word);
size_t MR_nondstack_size = 64 * sizeof(MR_Word);
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_nonstack_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_nondstack_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_nonstack_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;
/* 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_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_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 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();
#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();
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 */
#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(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();
}
#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)();
#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_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 runtime_mercury_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 <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++;
}
/*
** 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,
MR_HEAP_SIZE_KWORDS,
MR_DETSTACK_SIZE,
MR_DETSTACK_SIZE_KWORDS,
MR_NONDETSTACK_SIZE,
MR_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_NONSTACK_SIZE,
MR_GEN_NONSTACK_SIZE_KWORDS,
MR_GEN_DETSTACK_REDZONE_SIZE,
MR_GEN_DETSTACK_REDZONE_SIZE_KWORDS,
MR_GEN_NONSTACK_REDZONE_SIZE,
MR_GEN_NONSTACK_REDZONE_SIZE_KWORDS,
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_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 },
{ "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-nonstack-size", 1, 0, MR_GEN_NONSTACK_SIZE },
{ "gen-nonstack-size-kwords", 1, 0, MR_GEN_NONSTACK_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-nonstack-zone-size", 1, 0, MR_GEN_NONSTACK_REDZONE_SIZE },
{ "gen-nonstack-zone-size-kwords",
1, 0, MR_GEN_NONSTACK_REDZONE_SIZE_KWORDS },
{ "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 },
{ "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_nondstack_size = size;
break;
case MR_NONDETSTACK_SIZE_KWORDS:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
MR_usage();
}
MR_nondstack_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_nondstack_zone_size = size;
break;
case MR_NONDETSTACK_REDZONE_SIZE_KWORDS:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
MR_usage();
}
MR_nondstack_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_NONSTACK_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
MR_usage();
}
MR_gen_nonstack_size = size;
break;
case MR_GEN_NONSTACK_SIZE_KWORDS:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
MR_usage();
}
MR_gen_nonstack_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_NONSTACK_REDZONE_SIZE:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
MR_usage();
}
MR_gen_nonstack_zone_size = size;
break;
case MR_GEN_NONSTACK_REDZONE_SIZE_KWORDS:
if (sscanf(MR_optarg, "%lu", &size) != 1) {
MR_usage();
}
MR_gen_nonstack_zone_size = size * sizeof(MR_Word);
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_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_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_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_nondstackdebug = 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_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 {
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();
}
}
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);
}
}
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
** {
** <various stuff>
** }
** __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 */
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 nondstack 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");
}
}
#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_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);
/* 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();
}
#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);
assert(MR_primordial_thread == pthread_self());
MR_primordial_thread = (MercuryThread) 0;
/* XXX seems to be needed or short programs may have no output */
fflush(stdout);
#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;
}
/*---------------------------------------------------------------------------*/
/* 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