Files
mercury/runtime/mercury_engine.c
Zoltan Somogyi e854a5f9d9 Major improvements to tabling, of two types.
Estimated hours taken: 32
Branches: main

Major improvements to tabling, of two types. The first is the implementation
of the loopcheck and memo forms of tabling for model_non procedures, and the
second is a start on the implementation of a new method of implementing
minimal model tabling, one that has the potential for a proper fix of the
problem that we currently merely detect with the pneg stack (the detection
is followed by a runtime abort). Since this new method relies on giving each
own generator its own stack, the grade component denoting it is "mmos"
(minimal model own stack). The true name of the existing method is changed
from "mm" to "mmsc" (minimal model stack copy). The grade component "mm"
is now a shorthand for "mmsc"; when the new method works, "mm" will be changed
to be a shorthand for "mmos".

configure.in:
scripts/canonical_grade.sh-subr:
scripts/init_grade_options.sh-subr:
scripts/parse_grade_options.sh-subr:
scripts/final_grade_options.sh-subr:
compiler/options.m:
	Handle the new way of handling minimal model grades.

scripts/mgnuc.in:
compiler/compile_target_code.m:
	Conform to the changes in minimal model grade options.

compiler/table_gen.m:
	Implement the transformations required by the loopcheck and memo
	tabling of model_non procedures, and the minimal model own stack
	transformation.

	The new implementation transformations use foreign_procs with extra
	args, since there is no point in implementing them both that way and
	with separate calls to library predicates. This required making the
	choice of which method to use at the top level of each transformation.

	Fix an oversight that hasn't caused problems yet but may in the future:
	mark goals wrapping the original goals as not impure for determinism
	computations.

compiler/handle_options.m:
	Handle the new arrangement of the options for minimal model tabling.
	Detect simultaneous calls for both forms of minimal model tabling,
	and generate an error message. Allow for more than one error message
	generated at once; report them all once rather than separately.

compiler/globals.m:
	Add a mechanism to allow a fix a problem detected by the changes
	to handle_options: the fact that we currently may generate a usage
	message more than once for invocations with more than one error.

compiler/mercury_compile.m:
compiler/make.program_target.m:
compiler/make.util.m:
	Use the new mechanism in handle_options to avoid generating duplicate
	usage messages.

compiler/error_util.m:
	Add a utility predicate for use by handle_options.

compiler/hlds_pred.m:
	Allow memo tabling for model_non predicates, and handle own stack
	tabling.

compiler/hlds_out.m:
	Print information about the modes of the arguments of foreign_procs,
	since this is useful in debugging transformations such as tabling
	that generate them.

compiler/prog_data.m:
compiler/layout_out.m:
compiler/prog_out.m:
runtime/mercury_stack_layout.h:
	Mention the new evaluation method.

compiler/goal_util.m:
	Change the predicates for creating calls and foreign_procs to allow
	more than one goal feature to be attached to the new goal. table_gen.m
	now uses this capability.

compiler/add_heap_ops.m:
compiler/add_trail_ops.m:
compiler/polymorphism.m:
compiler/simplify.m:
compiler/size_prof.m:
compiler/typecheck.m:
compiler/unify_proc.m:
	Conform to the changes in goal_util.

compiler/code_info.m:
compiler/make_hlds.m:
compiler/modules.m:
compiler/prog_io_pragma.m:
	Conform to the new the options controlling minimal model
	tabling.

compiler/prog_util.m:
	Add a utility predicate for use by table_gen.m.

library/std_util.m:
	Conform to the changes in the macros for minimal model tabling grades.

library/table_builtin.m:
	Add the types and predicates required by the new transformations.

	Delete an obsolete comment.

runtime/mercury_grade.h:
	Handle the new minimal model grade component.

runtime/mercury_conf_param.h:
	List macros controlling minimal model grades.

runtime/mercury_tabling.[ch]:
	Define the types needed by the new transformations,

	Implement the performance-critical predicates that need to be
	hand-written for memo tabling of model_non predicates.

	Add utility predicates for debugging.

runtime/mercury_tabling_preds.h:
	Add the implementations of the predicates required by the new
	transformations.

runtime/mercury_mm_own_stacks.[ch]:
	This new module contains the first draft of the implementation
	of the own stack implementation of minimal model tabling.

runtime/mercury_imp.h:
	Include the new file if the grade needs it.

runtime/Mmakefile:
	Mention the new files, and sort the lists of filenames.

runtime/mercury_tabling_macros.h:
	Add a macro for allocating answer blocks without requiring them to be
	pointed to directly by trie nodes.

runtime/mercury_minimal_model.[ch]:
	The structure type holding answer lists is now in mercury_tabling.h,
	since it is now also needed by memo tabling of model_non predicates.
	It no longer has a field for an answer num, because while it is ok
	to require a separate grade for debugging minimal model tabling,
	it is not ok to require a separate grade for debugging memo tabling
	of model_non predicates. Instead of printing the answer numbers,
	print the answers themselves when we need to identify solutions
	for debugging.

	Change function names, macro names, error messages etc where this is
	useful to distinguish the two kinds of minimal model tabling.

	Fix some oversights wrt transient registers.

runtime/mercury_context.[ch]:
runtime/mercury_engine.[ch]:
runtime/mercury_memory.[ch]:
runtime/mercury_wrapper.[ch]:
	With own stack tabling, each subgoal has its own context, so record
	the identity of the subgoal owning a context in the context itself.
	The main computation's context is the exception: it has no owner.

	Record not just the main context, but also the contexts of subgoals
	in the engine.

	Add variables for holding the sizes of the det and nondet stacks
	of the contexts of subgoals (which should in general be smaller
	than the sizes of the corresponding stacks of the main context),
	and initialize them as needed.

	Initialize the variables holding the sizes of the gen, cut and pneg
	stacks, even in grades where the stacks are not used, for safety.

	Fix some out-of-date documentation, and conform to our coding
	guidelines.

runtime/mercury_memory_zones.[ch]:
	Add a function to test whether a pointer is in a zone, to help
	debugging.

runtime/mercury_debug.[ch]:
	Add some functions to help debugging in the presence of multiple
	contexts, and factor out some common code to help with this.

	Delete the obsolete, unused function MR_printdetslot_as_label.

runtime/mercury_context.h:
runtime/mercury_bootstrap.h:
	Move a bootstrapping #define from mercury_context.h to
	mercury_bootstrap.h.

runtime/mercury_context.h:
runtime/mercury_bootstrap.h:
	Move a bootstrapping #define from mercury_context.h to
	mercury_bootstrap.h.

runtime/mercury_types.h:
	Add some more forward declarations of type names.

runtime/mercury_dlist.[ch]:
	Rename a field to avoid assignments that dereference NULL.

runtime/mercury_debug.c:
runtime/mercury_memory.c:
runtime/mercury_ml_expand_body.h:
runtime/mercury_stack_trace.c:
runtime/mercury_stacks.[ch]:
trace/mercury_trace_util.c
	Update uses of the macros that control minimal model tabling.

runtime/mercury_stack_trace.c:
	Provide a mechanism to allow stack traces to be suppressed entirely.
	The intention is that by using this mechanism, by the testing system
	won't have to provide separate .exp files for hlc grades, nondebug
	LLDS grades and debug LLDS grades, as we do currently. The mechanism
	is the environment variable MERCURY_SUPPRESS_STACK_TRACE.

tools/bootcheck:
tools/test_mercury:
	Specify MERCURY_SUPPRESS_STACK_TRACE.

trace/mercury_trace.c:
	When performing retries across tabled calls, handle memo tabled
	model_non predicates, for which the call table tip variable holds
	a record with a back pointer to a trie node, instead of the trie node
	itself.

trace/mercury_trace_internal.c:
	When printing tables, handle memo tabled model_non predicates. Delete
	the code now moved to runtime/mercury_tabling.c.

	Add functions for printing the data structures for own stack minimal
	model tabling.

tests/debugger/print_table.{m,inp,exp}:
	Update this test case to also test the printing of tables for
	memo tabled model_non predicates.

tests/debugger/retry.{m,inp,exp}:
	Update this test case to also test retries across memo tabled
	model_non predicates.

tests/tabling/loopcheck_nondet.{m,exp}:
tests/tabling/loopcheck_nondet_non_loop.{m,exp}:
	New test cases to test loopcheck tabled model_non predicates.
	One test case has a loop to detect, one doesn't.

tests/tabling/memo_non.{m,exp}:
tests/tabling/tc_memo.{m,exp}:
tests/tabling/tc_memo2.{m,exp}:
	New test cases to test memo tabled model_non predicates.
	One test case has a loop to detect, one has a need for minimal model
	tabling to detect, and the third doesn't have either.

tests/tabling/Mmakefile:
	Add the new test cases, and reenable the existing tc_loop test case.

	Rename some make variables and targets to make them better reflect
	their meaning.

tests/tabling/test_mercury:
	Conform to the change in the name of the make target.
2004-07-20 04:41:55 +00:00

776 lines
21 KiB
C

/*
INIT mercury_sys_init_engine
ENDINIT
*/
/*
** Copyright (C) 1993-2001, 2003-2004 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.
*/
#include "mercury_imp.h"
#include <stdio.h>
#include <string.h>
#include <setjmp.h>
#include "mercury_engine.h"
#include "mercury_memory_zones.h" /* for MR_create_zone() */
#include "mercury_memory_handlers.h" /* for MR_default_handler() */
#include "mercury_dummy.h"
#ifndef MR_HIGHLEVEL_CODE
#ifdef MR_USE_GCC_NONLOCAL_GOTOS
#define LOCALS_SIZE 10024 /* amount of space to reserve for local vars */
#define MAGIC_MARKER 187 /* a random character */
#define MAGIC_MARKER_2 142 /* another random character */
#endif /* MR_USE_GCC_NONLOCAL_GOTOS */
static void call_engine_inner(MR_Code *entry_point) MR_NO_RETURN;
#ifndef MR_USE_GCC_NONLOCAL_GOTOS
static MR_Code *engine_done(void);
static MR_Code *engine_init_registers(void);
#endif
#endif /* !MR_HIGHLEVEL_CODE */
MR_bool MR_debugflag[MR_MAXFLAG];
MR_Debug_Flag_Info MR_debug_flag_info[MR_MAXFLAG] = {
{ "prog", MR_PROGFLAG },
{ "goto", MR_GOTOFLAG },
{ "call", MR_CALLFLAG },
{ "heap", MR_HEAPFLAG },
{ "detstack", MR_DETSTACKFLAG },
{ "nondstack", MR_NONDSTACKFLAG },
{ "final", MR_FINALFLAG },
{ "mem", MR_MEMFLAG },
{ "sreg", MR_SREGFLAG },
{ "trace", MR_TRACEFLAG },
{ "table", MR_TABLEFLAG },
{ "hash", MR_TABLEHASHFLAG },
{ "tablestack", MR_TABLESTACKFLAG },
{ "unbuf", MR_UNBUFFLAG },
{ "agc", MR_AGC_FLAG },
{ "ordreg", MR_ORDINARY_REG_FLAG },
{ "anyreg", MR_ANY_REG_FLAG },
{ "printlocn", MR_PRINT_LOCN_FLAG },
{ "enabled", MR_LLD_DEBUG_ENABLED_FLAG },
{ "notnearest", MR_NOT_NEAREST_FLAG },
{ "debugslots", MR_DEBUG_SLOTS_FLAG },
{ "deepdebugfile", MR_DEEP_PROF_DEBUG_FILE_FLAG },
{ "detail", MR_DETAILFLAG }
};
#ifndef MR_THREAD_SAFE
MercuryEngine MR_engine_base;
#endif
/*---------------------------------------------------------------------------*/
/*
** MR_init_engine() calls MR_init_memory() which sets up all the necessary
** stuff for allocating memory-zones and other runtime areas (such as
** the zone structures and context structures).
*/
void
MR_init_engine(MercuryEngine *eng)
{
/*
** First, ensure that the truly global stuff has been initialized
** (if it was already initialized, this does nothing).
*/
MR_init_memory();
#if !defined(MR_USE_GCC_NONLOCAL_GOTOS) && !defined(MR_HIGHLEVEL_CODE)
{
static MR_bool made_engine_done_label = MR_FALSE;
if (!made_engine_done_label) {
MR_make_label("engine_done", MR_LABEL(engine_done),
engine_done);
made_engine_done_label = MR_TRUE;
}
}
#endif
/*
** Second, initialize the per-engine (i.e. normally per Posix thread)
** stuff.
*/
#ifndef MR_CONSERVATIVE_GC
eng->MR_eng_heap_zone = MR_create_zone("heap", 1,
MR_heap_size, MR_next_offset(),
MR_heap_zone_size, MR_default_handler);
eng->MR_eng_hp = eng->MR_eng_heap_zone->min;
#ifdef MR_NATIVE_GC
eng->MR_eng_heap_zone2 = MR_create_zone("heap2", 1,
MR_heap_size, MR_next_offset(),
MR_heap_zone_size, MR_default_handler);
#ifdef MR_DEBUG_AGC_PRINT_VARS
eng->MR_eng_debug_heap_zone = MR_create_zone("debug_heap", 1,
MR_debug_heap_size, MR_next_offset(),
MR_debug_heap_zone_size, MR_default_handler);
#endif
#endif /* MR_NATIVE_GC */
#ifdef MR_MIGHT_RECLAIM_HP_ON_FAILURE
eng->MR_eng_solutions_heap_zone = MR_create_zone("solutions_heap", 1,
MR_solutions_heap_size, MR_next_offset(),
MR_solutions_heap_zone_size, MR_default_handler);
eng->MR_eng_sol_hp = eng->MR_eng_solutions_heap_zone->min;
eng->MR_eng_global_heap_zone = MR_create_zone("global_heap", 1,
MR_global_heap_size, MR_next_offset(),
MR_global_heap_zone_size, MR_default_handler);
eng->MR_eng_global_hp = eng->MR_eng_global_heap_zone->min;
#endif /* MR_MIGHT_RECLAIM_HP_ON_FAILURE */
#endif /* !MR_CONSERVATIVE_GC */
#ifdef MR_THREAD_SAFE
eng->MR_eng_owner_thread = pthread_self();
eng->MR_eng_c_depth = 0;
eng->MR_eng_saved_owners = NULL;
#endif
/*
** Finally, allocate an initial context (Mercury thread)
** in the engine and initialize the per-context stuff.
*/
eng->MR_eng_this_context = MR_create_context("main", NULL);
}
/*---------------------------------------------------------------------------*/
void MR_finalize_engine(MercuryEngine *eng)
{
/*
** XXX there are lots of other resources in MercuryEngine that
** might need to be finalized.
*/
MR_destroy_context(eng->MR_eng_this_context);
}
/*---------------------------------------------------------------------------*/
MercuryEngine *
MR_create_engine(void)
{
MercuryEngine *eng;
/*
** We need to use MR_GC_NEW_UNCOLLECTABLE() here,
** rather than MR_GC_NEW(), since the engine pointer
** will normally be stored in thread-local storage, which is
** not traced by the conservative garbage collector.
*/
eng = MR_GC_NEW_UNCOLLECTABLE(MercuryEngine);
MR_init_engine(eng);
return eng;
}
void
MR_destroy_engine(MercuryEngine *eng)
{
MR_finalize_engine(eng);
MR_GC_free(eng);
}
/*---------------------------------------------------------------------------*/
#ifdef MR_HIGHLEVEL_CODE
/*
** This debugging hook is empty in the high-level code case:
** we don't save the previous locations.
*/
void
MR_dump_prev_locations(void) {}
#else /* !MR_HIGHLEVEL_CODE */
/*
** MR_Word *
** MR_call_engine(MR_Code *entry_point, MR_bool catch_exceptions)
**
** This routine calls a Mercury routine from C.
**
** The called routine should be det/semidet/cc_multi/cc_nondet.
**
** If the called routine returns normally (this includes the case of a
** semidet/cc_nondet routine failing, i.e. returning with
** MR_r1 = MR_FALSE), then MR_call_engine() will return NULL.
**
** If the called routine exits by throwing an exception, then the
** behaviour depends on the `catch_exceptions' flag.
** if `catch_exceptions' is true, then MR_call_engine() will return the
** Mercury exception object thrown. If `catch_exceptions' is false,
** then MR_call_engine() will not return; instead, the code for `throw'
** will unwind the stacks (including the C stack) back to the nearest
** enclosing exception handler.
**
** The virtual machine registers must be set up correctly before the call
** to MR_call_engine(). Specifically, the non-transient real registers
** must have valid values, and the fake_reg copies of the transient
** (register window) registers must have valid values; call_engine()
** will call MR_restore_transient_registers() and will then assume that
** all the registers have been correctly set up.
**
** call_engine() will call MR_save_registers() before returning.
** That will copy the real registers we use to the fake_reg array.
**
** Beware, however, that if you are planning to return to C code that did
** not #include "mercury_regs.h" (directly or via e.g. "mercury_imp.h"),
** and you have fiddled with the Mercury registers or invoked
** call_engine() or anything like that, then you will need to
** save the real registers that C is using before modifying the
** Mercury registers and then restore them afterwards.
**
** The called routine may invoke C functions; currently this
** is done by just invoking them directly, although that will
** have to change if we start using the caller-save registers.
**
** The called routine may invoke C functions which in turn
** invoke call_engine() to invoke invoke Mercury routines (which
** in turn invoke C functions which ... etc. ad infinitum.)
**
** MR_call_engine() calls setjmp() and then invokes call_engine_inner()
** which does the real work. call_engine_inner() exits by calling
** longjmp() to return to MR_call_engine(). There are two
** different implementations of call_engine_inner(), one for gcc,
** and another portable version that works on standard ANSI C compilers.
*/
MR_Word *
MR_call_engine(MR_Code *entry_point, MR_bool catch_exceptions)
{
jmp_buf curr_jmp_buf;
jmp_buf * volatile prev_jmp_buf;
#if defined(MR_MPROF_PROFILE_TIME)
MR_Code * volatile prev_proc;
#endif
/*
** Preserve the value of MR_ENGINE(MR_eng_jmp_buf) on the C stack.
** This is so "C calls Mercury which calls C which calls Mercury" etc.
** will work.
*/
MR_restore_transient_registers();
prev_jmp_buf = MR_ENGINE(MR_eng_jmp_buf);
MR_ENGINE(MR_eng_jmp_buf) = &curr_jmp_buf;
/*
** Create an exception handler frame on the nondet stack
** so that we can catch and return Mercury exceptions.
*/
if (catch_exceptions) {
MR_create_exception_handler("call_engine",
MR_C_LONGJMP_HANDLER, 0, MR_ENTRY(MR_do_fail));
}
/*
** Mark this as the spot to return to.
*/
#ifdef MR_DEBUG_JMPBUFS
printf("engine setjmp %p\n", curr_jmp_buf);
#endif
if (setjmp(curr_jmp_buf)) {
MR_Word * this_frame;
MR_Word * exception;
#ifdef MR_DEBUG_JMPBUFS
printf("engine caught jmp %p %p\n",
prev_jmp_buf, MR_ENGINE(MR_eng_jmp_buf));
#endif
MR_debugmsg0("...caught longjmp\n");
/*
** On return,
** set MR_prof_current_proc to be the caller proc again
** (if time profiling is enabled),
** restore the registers (since longjmp may clobber them),
** and restore the saved value of MR_ENGINE(MR_eng_jmp_buf).
*/
MR_update_prof_current_proc(prev_proc);
MR_restore_registers();
MR_ENGINE(MR_eng_jmp_buf) = prev_jmp_buf;
if (catch_exceptions) {
/*
** Figure out whether or not we got an exception.
** If we got an exception, then all of the necessary
** cleanup such as stack unwinding has already been
** done, so all we have to do here is to return the
** exception.
*/
exception = MR_ENGINE(MR_eng_exception);
if (exception != NULL) {
return exception;
}
/*
** If we added an exception hander, but we didn't
** get an exception, then we need to remove the
** exception handler frames from the nondet stack
** and prune the trail ticket allocated by
** MR_create_exception_handler().
*/
this_frame = MR_curfr;
MR_maxfr_word = MR_prevfr_slot_word(this_frame);
MR_curfr_word = MR_succfr_slot_word(this_frame);
#ifdef MR_USE_TRAIL
MR_prune_ticket();
#endif
}
return NULL;
}
MR_ENGINE(MR_eng_jmp_buf) = &curr_jmp_buf;
/*
** If call profiling is enabled, and this is a case of
** Mercury calling C code which then calls Mercury,
** then we record the Mercury caller / Mercury callee pair
** in the table of call counts, if possible.
*/
#ifdef MR_MPROF_PROFILE_CALLS
#ifdef MR_MPROF_PROFILE_TIME
if (MR_prof_current_proc != NULL) {
MR_PROFILE(entry_point, MR_prof_current_proc);
}
#else
/*
** XXX There's not much we can do in this case
** to keep the call counts accurate, since
** we don't know who the caller is.
*/
#endif
#endif /* MR_MPROF_PROFILE_CALLS */
/*
** If time profiling is enabled, then we need to
** save MR_prof_current_proc so that we can restore it
** when we return. We must then set MR_prof_current_proc
** to the procedure that we are about to call.
**
** We do this last thing before calling call_engine_inner(),
** since we want to credit as much as possible of the time
** in C code to the caller, not to the callee.
** Note that setting and restoring MR_prof_current_proc
** here in call_engine() means that time in call_engine_inner()
** unfortunately gets credited to the callee.
** That is not ideal, but we can't move this code into
** call_engine_inner() since call_engine_inner() can't
** have any local variables and this code needs the
** `prev_proc' local variable.
*/
#ifdef MR_MPROF_PROFILE_TIME
prev_proc = MR_prof_current_proc;
MR_set_prof_current_proc(entry_point);
#endif
call_engine_inner(entry_point);
}
#ifdef MR_USE_GCC_NONLOCAL_GOTOS
/* The gcc-specific version */
static void
call_engine_inner(MR_Code *entry_point)
{
/*
** Allocate some space for local variables in other
** procedures. This is done because we may jump into the middle
** of a C function, which may assume that space on the stack
** has already beened allocated for its variables. Such space
** would generally be used for expression temporary variables.
** How did we arrive at the correct value of LOCALS_SIZE?
** Good question. I think it's more voodoo than science.
**
** This used to be done by just calling
** alloca(LOCALS_SIZE), but on the mips that just decrements the
** stack pointer, whereas local variables are referenced
** via the frame pointer, so it didn't work.
** This technique should work and should be vaguely portable,
** just so long as local variables and temporaries are allocated in
** the same way in every function.
**
** WARNING!
** Do not add local variables to call_engine_inner that you expect
** to remain live across Mercury execution - Mercury execution will
** scribble on the stack frame for this function.
*/
unsigned char locals[LOCALS_SIZE];
{
#ifdef MR_LOWLEVEL_DEBUG
{
/* ensure that we only make the label once */
static MR_bool initialized = MR_FALSE;
if (!initialized)
{
MR_make_label("engine_done", MR_LABEL(engine_done),
engine_done);
initialized = MR_TRUE;
}
}
#endif
/*
** restore any registers that get clobbered by the C function
** call mechanism
*/
MR_restore_transient_registers();
/*
** We save the address of the locals in a global pointer to make
** sure that gcc can't optimize them away.
*/
MR_global_pointer = locals;
#ifdef MR_LOWLEVEL_DEBUG
memset((void *)locals, MAGIC_MARKER, LOCALS_SIZE);
#endif
MR_debugmsg1("in `call_engine_inner', locals at %p\n", (void *)locals);
/*
** We need to ensure that there is at least one
** real function call in call_engine_inner(), because
** otherwise gcc thinks that it doesn't need to
** restore the caller-save registers (such as
** the return address!) because it thinks call_engine_inner() is
** a leaf routine which doesn't call anything else,
** and so it thinks that they won't have been clobbered.
**
** This probably isn't necessary now that we exit from this function
** using longjmp(), but it doesn't do much harm, so I'm leaving it in.
**
** Also for gcc versions >= egcs1.1, we need to ensure that
** there is at least one jump to an unknown label.
*/
goto *MR_dummy_identify_function(&&dummy_label);
dummy_label:
/*
** Increment the number of times we've entered this
** engine from C, and mark the current context as being
** owned by this thread.
*/
#ifdef MR_THREAD_SAFE
MR_ENGINE(MR_eng_c_depth)++;
{
MercuryThreadList *new_element;
new_element = MR_GC_NEW(MercuryThreadList);
new_element->thread =
MR_ENGINE(MR_eng_this_context)->MR_ctxt_owner_thread;
new_element->next = MR_ENGINE(MR_eng_saved_owners);
MR_ENGINE(MR_eng_saved_owners) = new_element;
}
MR_ENGINE(MR_eng_this_context)->MR_ctxt_owner_thread =
MR_ENGINE(MR_eng_owner_thread);
#endif
/*
** Now just call the entry point
*/
MR_noprof_call(entry_point, MR_LABEL(engine_done));
MR_define_label(engine_done);
/*
** Decrement the number of times we've entered this
** engine from C and restore the owning thread in
** the current context.
*/
#ifdef MR_THREAD_SAFE
assert(MR_ENGINE(MR_eng_this_context)->MR_ctxt_owner_thread
== MR_ENGINE(MR_eng_owner_thread));
MR_ENGINE(MR_eng_c_depth)--;
{
MercuryThreadList *tmp;
MercuryThread val;
tmp = MR_ENGINE(MR_eng_saved_owners);
if (tmp != NULL)
{
val = tmp->thread;
MR_ENGINE(MR_eng_saved_owners) = tmp->next;
MR_GC_free(tmp);
} else {
val = 0;
}
MR_ENGINE(MR_eng_this_context)->MR_ctxt_owner_thread = val;
}
#endif
MR_debugmsg1("in label `engine_done', locals at %p\n", locals);
#ifdef MR_LOWLEVEL_DEBUG
/*
** Check how much of the space we reserved for local variables
** was actually used.
*/
if (MR_check_space) {
int low = 0, high = LOCALS_SIZE;
int used_low, used_high;
while (low < high && locals[low] == MAGIC_MARKER) {
low++;
}
while (low < high && locals[high - 1] == MAGIC_MARKER) {
high--;
}
used_low = high;
used_high = LOCALS_SIZE - low;
printf("max locals used: %3d bytes (probably)\n",
MR_min(high, LOCALS_SIZE - low));
printf("(low mark = %d, high mark = %d)\n", low, high);
}
#endif /* MR_LOWLEVEL_DEBUG */
/*
** Despite the above precautions with allocating a large chunk
** of unused stack space, the return address may still have been
** stored on the top of the stack, past our dummy locals,
** where it may have been clobbered.
** Hence the only safe way to exit is with longjmp().
**
** Since longjmp() may clobber the registers, we need to
** save them first.
*/
MR_ENGINE(MR_eng_exception) = NULL;
MR_save_registers();
#ifdef MR_DEBUG_JMPBUFS
printf("engine longjmp %p\n", MR_ENGINE(MR_eng_jmp_buf));
#endif
MR_debugmsg0("longjmping out...\n");
longjmp(*(MR_ENGINE(MR_eng_jmp_buf)), 1);
}} /* end call_engine_inner() */
/* with nonlocal gotos, we don't save the previous locations */
void
MR_dump_prev_locations(void) {}
#else /* not MR_USE_GCC_NONLOCAL_GOTOS */
/*
** The portable version
**
** To keep the main dispatch loop tight, instead of returning a null
** pointer to indicate when we've finished executing, we just longjmp()
** out. We need to save the registers before calling longjmp(),
** since doing a longjmp() might clobber them.
**
** With register windows, we need to restore the registers to
** their initialized values from their saved copies.
** This must be done in a function engine_init_registers() rather
** than directly from call_engine_inner() because otherwise their value
** would get mucked up because of the function call from call_engine_inner().
*/
static MR_Code *
engine_done(void)
{
MR_ENGINE(MR_eng_exception) = NULL;
MR_save_registers();
MR_debugmsg0("longjmping out...\n");
longjmp(*(MR_ENGINE(MR_eng_jmp_buf)), 1);
}
static MR_Code *
engine_init_registers(void)
{
MR_restore_transient_registers();
MR_succip_word = (MR_Word) (MR_Code *) engine_done;
return NULL;
}
/*
** For debugging purposes, we keep a circular buffer of
** the last 40 locations that we jumped to. This is
** very useful for determining the cause of a crash,
** since it runs a lot faster than -dg.
*/
#define NUM_PREV_FPS 40
typedef MR_Code *Func(void);
static MR_Code *prev_fps[NUM_PREV_FPS];
static int prev_fp_index = 0;
void
MR_dump_prev_locations(void)
{
int i, pos;
#if !defined(MR_DEBUG_GOTOS)
if (MR_tracedebug)
#endif
{
printf("previous %d locations:\n", NUM_PREV_FPS);
for (i = 0; i < NUM_PREV_FPS; i++) {
pos = (i + prev_fp_index) % NUM_PREV_FPS;
MR_printlabel(stdout, prev_fps[pos]);
}
}
}
static void
call_engine_inner(MR_Code *entry_point)
{
register Func *fp;
/*
** Start up the actual engine.
** The loop is unrolled a bit for efficiency.
*/
fp = engine_init_registers;
fp = (Func *) (*fp)();
fp = (Func *) entry_point;
#if !defined(MR_DEBUG_GOTOS)
if (!MR_tracedebug) {
for (;;)
{
fp = (Func *) (*fp)();
fp = (Func *) (*fp)();
fp = (Func *) (*fp)();
fp = (Func *) (*fp)();
fp = (Func *) (*fp)();
fp = (Func *) (*fp)();
fp = (Func *) (*fp)();
fp = (Func *) (*fp)();
}
} else
#endif
for (;;)
{
prev_fps[prev_fp_index] = (MR_Code *) fp;
if (++prev_fp_index >= NUM_PREV_FPS)
prev_fp_index = 0;
MR_debuggoto(fp);
MR_debugsreg();
fp = (Func *) (*fp)();
}
} /* end call_engine_inner() */
#endif /* not MR_USE_GCC_NONLOCAL_GOTOS */
#endif /* !MR_HIGHLEVEL_CODE */
/*---------------------------------------------------------------------------*/
void
MR_terminate_engine(void)
{
/*
** we don't bother to deallocate memory...
** that will happen automatically on process exit anyway.
*/
}
/*---------------------------------------------------------------------------*/
#ifndef MR_HIGHLEVEL_CODE
MR_define_extern_entry(MR_do_redo);
MR_define_extern_entry(MR_do_fail);
MR_define_extern_entry(MR_do_succeed);
MR_define_extern_entry(MR_do_last_succeed);
MR_define_extern_entry(MR_do_not_reached);
MR_define_extern_entry(MR_exception_handler_do_fail);
MR_BEGIN_MODULE(special_labels_module)
MR_init_entry_an(MR_do_redo);
MR_init_entry_an(MR_do_fail);
MR_init_entry_an(MR_do_succeed);
MR_init_entry_an(MR_do_last_succeed);
MR_init_entry_an(MR_do_not_reached);
MR_init_entry_an(MR_exception_handler_do_fail);
MR_BEGIN_CODE
MR_define_entry(MR_do_redo);
MR_redo();
MR_define_entry(MR_do_fail);
MR_fail();
MR_define_entry(MR_do_succeed);
MR_succeed();
MR_define_entry(MR_do_last_succeed);
MR_succeed_discard();
MR_define_entry(MR_do_not_reached);
MR_fatal_error("reached not_reached\n");
MR_define_entry(MR_exception_handler_do_fail);
/*
** `MR_exception_handler_do_fail' is the same as `MR_do_fail':
** it just invokes MR_fail(). The reason we don't just use
** `MR_do_fail' for this is that when unwinding the stack we
** check for a redoip of `MR_exception_handler_do_fail' and
** handle it specially.
*/
MR_fail();
MR_END_MODULE
#endif /* !MR_HIGHLEVEL_CODE */
/* forward decls to suppress gcc warnings */
void mercury_sys_init_engine_init(void);
void mercury_sys_init_engine_init_type_tables(void);
#ifdef MR_DEEP_PROFILING
void mercury_sys_init_engine_write_out_proc_statics(FILE *fp);
#endif
void mercury_sys_init_engine_init(void)
{
#ifndef MR_HIGHLEVEL_CODE
special_labels_module();
#endif
}
void mercury_sys_init_engine_init_type_tables(void)
{
/* no types to register */
}
#ifdef MR_DEEP_PROFILING
void mercury_sys_init_engine_write_out_proc_statics(FILE *fp)
{
/* no proc_statics to write out */
}
#endif
/*---------------------------------------------------------------------------*/