diff: Runtime support for stack_layouts
Tyson Richard DOWD
trd at cs.mu.oz.au
Mon Oct 27 12:04:20 AEDT 1997
Hi,
This diff is the changes needed to the runtime and library for stack
layouts to work.
Could someone please review these?
===================================================================
Estimated hours taken: 25
Add library and runtime support for stack layouts.
IMPORTANT NOTE: If you have made any modifications to .mod files in
the runtime, you should know that this diff removes all .mod files.
It should be possible to re-apply your changes to the corresponding .c
files.
library/array.m:
library/benchmarking.m:
library/mercury_builtin.m:
library/std_util.m:
library/string.m:
Add MR_MAKE_STACK_LAYOUT_* macros to add basic stack layouts for
handwritten C code.
runtime/Mmakefile:
Add mercury_accurate_gc.h to header files, remove all mod files,
and make sure runtime.init uses the ORIG_CS not MOD_CS.
Fix the rules for "clean_o" and "clean_mod_c", which used
wildcards like "*.o" to remove files. The one that removed
all .c files corresponding with *.mod, instead of using MOD_CS
was particularly vicious.
runtime/call.c:
runtime/context.c:
runtime/engine.c:
runtime/type_info.c:
runtime/wrapper.c:
New .c files, as generated from .mod files, with a few
MR_MAKE_STACK_LAYOUTS added.
runtime/*.mod:
Deleted .mod files.
runtime/calls.h:
Instead of doing ASM_FIXUP_REGS as part of the call macro, do
it as part of the proceed macro.
As part of the call macro, the succip would always be set
to the "fixup_gp" label, so it was difficult to find the
caller using the succip. Using this technique, it is set
correctly.
(There's a small cost - with the call macro, you only did
ASM_FIXUP_REGS after you returned from a non-local call, using
"proceed" you do this at every call. The only way I can see
to avoid this cost is to actually change the code generator
so that it outputs two labels for continuations, one used
for local calls, and one for non-local calls. The nonlocal
label does ASM_FIXUP_REGS and falls through to the local label).
But the current cost is about 30k in the compiler on the alpha,
and any speed difference appears to be lost in noise (note that
for non-local calls, the new code is probably a little more
efficient).
runtime/label.c:
runtime/label.h:
runtime/goto.h:
Insert references to stack layouts into the label table.
Use the label table when NATIVE_GC is defined.
runtime/imp.h:
Include mercury_accurate_gc.h
runtime/mercury_accurate_gc.h:
Add a heap of macros to define stack layouts for handwritten
code, and access various fields of the stack layouts.
util/mkinit.c:
Add NATIVE_GC to the list of defines where we need to run
the label initialization code (we use the label table, like
profiling does).
Fix this code so the two instances of this list of #defines are
replaced by a single string constant. I've been bitten _twice_
by this double definition, and I refuse to be bitten again.
Index: library/array.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/array.m,v
retrieving revision 1.38
diff -u -r1.38 array.m
--- array.m 1997/09/06 18:23:36 1.38
+++ array.m 1997/09/18 07:22:40
@@ -244,8 +244,11 @@
:- pragma(c_code, "
Define_extern_entry(mercury____Unify___array__array_1_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Unify___array__array_1_0);
Define_extern_entry(mercury____Index___array__array_1_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Index___array__array_1_0);
Define_extern_entry(mercury____Compare___array__array_1_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Compare___array__array_1_0);
#ifdef USE_TYPE_LAYOUT
Index: library/benchmarking.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/benchmarking.m,v
retrieving revision 1.2
diff -u -r1.2 benchmarking.m
--- benchmarking.m 1997/08/05 04:10:00 1.2
+++ benchmarking.m 1997/09/12 06:41:58
@@ -130,6 +130,9 @@
Define_extern_entry(mercury__benchmarking__benchmark_nondet_5_0);
Declare_label(mercury__benchmarking__benchmark_nondet_5_0_i1);
Declare_label(mercury__benchmarking__benchmark_nondet_5_0_i2);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__benchmarking__benchmark_nondet_5_0);
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__benchmarking__benchmark_nondet_5_0, 1);
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__benchmarking__benchmark_nondet_5_0, 2);
BEGIN_MODULE(benchmark_nondet_module)
init_entry(mercury__benchmarking__benchmark_nondet_5_0);
@@ -216,6 +219,8 @@
Define_extern_entry(mercury__benchmarking__benchmark_det_5_0);
Declare_label(mercury__benchmarking__benchmark_det_5_0_i1);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__benchmarking__benchmark_det_5_0);
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__benchmarking__benchmark_det_5_0, 1);
BEGIN_MODULE(benchmark_det_module)
init_entry(mercury__benchmarking__benchmark_det_5_0);
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/mercury_builtin.m,v
retrieving revision 1.84
diff -u -r1.84 mercury_builtin.m
--- mercury_builtin.m 1997/10/14 09:27:19 1.84
+++ mercury_builtin.m 1997/10/23 01:44:18
@@ -717,6 +717,8 @@
:- pragma(c_code, "
Define_extern_entry(mercury__copy_2_0);
Define_extern_entry(mercury__copy_2_1);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__copy_2_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__copy_2_1);
BEGIN_MODULE(copy_module)
init_entry(mercury__copy_2_0);
@@ -797,6 +799,9 @@
Define_extern_entry(mercury____Unify___mercury_builtin__c_pointer_0_0);
Define_extern_entry(mercury____Index___mercury_builtin__c_pointer_0_0);
Define_extern_entry(mercury____Compare___mercury_builtin__c_pointer_0_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Unify___mercury_builtin__c_pointer_0_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Index___mercury_builtin__c_pointer_0_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Compare___mercury_builtin__c_pointer_0_0);
BEGIN_MODULE(unify_c_pointer_module)
init_entry(mercury____Unify___mercury_builtin__c_pointer_0_0);
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.108
diff -u -r1.108 std_util.m
--- std_util.m 1997/10/12 13:32:55 1.108
+++ std_util.m 1997/10/23 01:50:57
@@ -483,6 +483,15 @@
Declare_label(mercury__std_util__builtin_aggregate_4_0_i1);
Declare_label(mercury__std_util__builtin_aggregate_4_0_i2);
Declare_label(mercury__std_util__builtin_aggregate_4_0_i3);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__std_util__builtin_aggregate_4_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__std_util__builtin_aggregate_4_1);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__std_util__builtin_aggregate_4_2);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__std_util__builtin_aggregate_4_3);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__std_util__builtin_aggregate_4_4);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__std_util__builtin_aggregate_4_5);
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__std_util__builtin_aggregate_4_0, 1);
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__std_util__builtin_aggregate_4_0, 2);
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__std_util__builtin_aggregate_4_0, 3);
BEGIN_MODULE(builtin_aggregate_module)
init_entry(mercury__std_util__builtin_aggregate_4_0);
@@ -1153,11 +1162,17 @@
Define_extern_entry(mercury____Unify___std_util__univ_0_0);
Define_extern_entry(mercury____Index___std_util__univ_0_0);
Define_extern_entry(mercury____Compare___std_util__univ_0_0);
-Declare_label(mercury____Compare___std_util__univ_0_0_i1);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Unify___std_util__univ_0_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Index___std_util__univ_0_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Compare___std_util__univ_0_0);
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury____Compare___std_util__univ_0_0, 1);
Define_extern_entry(mercury____Unify___std_util__type_info_0_0);
Define_extern_entry(mercury____Index___std_util__type_info_0_0);
Define_extern_entry(mercury____Compare___std_util__type_info_0_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Unify___std_util__type_info_0_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Index___std_util__type_info_0_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Compare___std_util__type_info_0_0);
BEGIN_MODULE(unify_univ_module)
init_entry(mercury____Unify___std_util__univ_0_0);
Index: library/string.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/string.m,v
retrieving revision 1.96
diff -u -r1.96 string.m
--- string.m 1997/10/11 16:11:25 1.96
+++ string.m 1997/10/23 01:44:30
@@ -1720,6 +1720,8 @@
Define_extern_entry(mercury__string__append_3_3_xx);
Declare_label(mercury__string__append_3_3_xx_i1);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury__string__append_3_3_xx);
+MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__string__append_3_3_xx, 1);
BEGIN_MODULE(string_append_module)
init_entry(mercury__string__append_3_3_xx);
Index: runtime/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/Mmakefile,v
retrieving revision 1.15
diff -u -r1.15 Mmakefile
--- Mmakefile 1997/10/03 04:56:28 1.15
+++ Mmakefile 1997/10/23 05:02:57
@@ -25,13 +25,14 @@
HDRS = calls.h conf.h context.h \
deep_copy.h dlist.h debug.h dummy.h \
engine.h getopt.h goto.h heap.h imp.h init.h label.h \
- memory.h mercury_float.h mercury_grade.h \
+ memory.h mercury_accurate_gc.h mercury_float.h \
mercury_string.h mercury_trace.h mercury_trail.h \
mercury_types.h misc.h \
overflow.h prof.h prof_mem.h regorder.h regs.h \
spinlock.h std.h stacks.h \
table.h tags.h timing.h type_info.h wrapper.h \
$(LIBMER_DLL_H)
+
# Note that `libmer_globals.h' cannot be part of $(HDR),
# since it depends on libmer_def.a, and $(OBJ) : $(HDR) would create a
# circular dependency.
@@ -41,14 +42,21 @@
machdeps/mips_regs.h machdeps/sparc_regs.h \
machdeps/alpha_regs.h machdeps/pa_regs.h \
machdeps/rs6000_regs.h
-MODS = engine.mod wrapper.mod call.mod context.mod type_info.mod
-MOD_CS = engine.c wrapper.c call.c context.c type_info.c
+
+
+# XXX .mod support is being removed. This will soon disappear.
+MODS =
+MOD_CS =
MOD_OS = $(MOD_CS:.c=.o)
-ORIG_CS = deep_copy.c dlist.c dummy.c label.c \
- memory.c misc.c regs.c table.c timing.c prof.c prof_mem.c \
- spinlock.c mercury_float.c mercury_grade.c mercury_trace.c \
+
+
+ORIG_CS = call.c context.c deep_copy.c dlist.c dummy.c engine.c \
+ label.c memory.c misc.c regs.c table.c timing.c \
+ type_info.c prof.c prof_mem.c spinlock.c wrapper.c \
+ mercury_float.c mercury_grade.c mercury_trace.c \
mercury_trail.c
ORIG_OS = $(ORIG_CS:.c=.o)
+ORIG_OS = $(ORIG_CS:.c=.o)
OBJS = $(MOD_OS) $(ORIG_OS)
PIC_OBJS = $(OBJS:.o=.$(EXT_FOR_PIC_OBJECTS))
@@ -96,8 +104,8 @@
$(LDFLAGS) $(LDLIBS) \
$(SHARED_LIBS)
-runtime.init: $(MOD_CS)
- cat `vpath_find $(MOD_CS)` | grep '^INIT ' > runtime.init
+runtime.init: $(ORIG_CS)
+ cat `vpath_find $(ORIG_CS)` | grep '^INIT ' > runtime.init
conf.h.date: $(MERCURY_DIR)/config.status conf.h.in
CONFIG_FILES= CONFIG_HEADERS=conf.h $(MERCURY_DIR)/config.status
@@ -161,13 +169,11 @@
.PHONY: clean_o
clean_o:
- rm -f *.o *.pic_o
+ rm -f $(MOD_OS) $(OBJS) $(PIC_OBJS)
.PHONY: clean_mod_c
clean_mod_c:
- for file in *.mod; do \
- rm -f `basename $$file .mod`.c; \
- done
+ rm -f $(MOD_OS)
realclean:
rm -f libmer.a libmer.so runtime.init
Index: runtime/calls.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/calls.h,v
retrieving revision 1.4
diff -u -r1.4 calls.h
--- calls.h 1997/07/27 15:08:02 1.4
+++ calls.h 1997/10/23 04:35:53
@@ -22,46 +22,15 @@
GOTO_LABEL(label); \
} while (0)
-/*
-** On some systems [basically those using PIC (Position Independent Code)],
-** if we're using gcc non-local gotos to jump between functions then
-** we need to do ASM_FIXUP_REGS after each return from a procedure call.
-*/
-#if defined(USE_GCC_NONLOCAL_GOTOS) && defined(NEED_ASM_FIXUP_REGS)
- #define noprof_call(proc, succ_cont) \
- ({ \
- __label__ fixup_gp; \
- debugcall((proc), (succ_cont)); \
- succip = (&&fixup_gp); \
- set_prof_current_proc(proc); \
- GOTO(proc); \
- fixup_gp: \
- ASM_FIXUP_REGS \
- GOTO(succ_cont); \
- })
- /* same as above, but with GOTO_LABEL rather than GOTO */
- #define noprof_call_localret(proc, succ_cont) \
- ({ \
- __label__ fixup_gp; \
- debugcall((proc), (succ_cont)); \
- succip = (&&fixup_gp); \
- set_prof_current_proc(proc); \
- GOTO(proc); \
- fixup_gp: \
- ASM_FIXUP_REGS \
- GOTO_LABEL(succ_cont); \
- })
-#else
- #define noprof_call(proc, succ_cont) \
+#define noprof_call(proc, succ_cont) \
do { \
debugcall((proc), (succ_cont)); \
succip = (succ_cont); \
set_prof_current_proc(proc); \
GOTO(proc); \
} while (0)
- #define noprof_call_localret(proc, succ_cont) \
+#define noprof_call_localret(proc, succ_cont) \
noprof_call((proc), LABEL(succ_cont))
-#endif
#define localcall(label, succ_cont, current_label) \
do { \
@@ -121,9 +90,17 @@
GOTO(proc); \
} while (0)
+/*
+** On some systems [basically those using PIC (Position Independent Code)],
+** if we're using gcc non-local gotos to jump between functions then
+** we need to do ASM_FIXUP_REGS after each return from a procedure
+** call.
+*/
+
#define proceed() \
do { \
debugproceed(); \
+ ASM_FIXUP_REGS \
GOTO(succip); \
} while (0)
Index: runtime/goto.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/goto.h,v
retrieving revision 1.34
diff -u -r1.34 goto.h
--- goto.h 1997/10/12 05:43:52 1.34
+++ goto.h 1997/10/23 04:54:03
@@ -12,37 +12,46 @@
#include "mercury_types.h" /* for `Code *' */
#include "debug.h" /* for debuggoto() */
+#define paste(a,b) a##b
+#define stringify(string) #string
+#define entry(label) paste(entry_,label)
+#define skip(label) paste(skip_,label)
+
+#ifdef MR_USE_STACK_LAYOUTS
+ #define MR_STACK_LAYOUT(label) (Word *) (Word) \
+ &(paste(mercury_data__stack_layout__,label))
+#else
+ #define MR_STACK_LAYOUT(label) (Word *) NULL
+#endif /* MR_USE_STACK_LAYOUTS */
+
/*
** Taking the address of a label can inhibit gcc's optimization,
** because it assumes that anything can jump there.
** Therefore we want to do it only if we're debugging,
-** or if we need the label address for profiling.
+** or if we need the label address for profiling or
+** accurate garbage collection.
*/
-#if defined(SPEED) && !defined(DEBUG_GOTOS)
-#define make_label(n, a) /* nothing */
+#if defined(SPEED) && !defined(DEBUG_GOTOS) && !defined(NATIVE_GC)
+#define make_label(n, a, l) /* nothing */
#else
-#define make_label(n, a) make_entry(n, a)
+#define make_label(n, a, l) make_entry(n, a, l)
#endif
-#if defined(SPEED) && !defined(DEBUG_GOTOS) && !defined(PROFILE_CALLS)
-#define make_local(n, a) /* nothing */
+#if defined(SPEED) && !defined(DEBUG_GOTOS) && !defined(PROFILE_CALLS) && \
+ !defined(NATIVE_GC)
+#define make_local(n, a, l) /* nothing */
#else
-#define make_local(n, a) make_entry(n, a)
+#define make_local(n, a, l) make_entry(n, a, l)
#endif
#if defined(SPEED) && !defined(DEBUG_LABELS) && !defined(DEBUG_GOTOS) \
- && !defined(PROFILE_CALLS)
-#define make_entry(n, a) /* nothing */
+ && !defined(PROFILE_CALLS) && !defined(NATIVE_GC)
+#define make_entry(n, a, l) /* nothing */
#else
-#define make_entry(n, a) insert_entry(n, a)
+#define make_entry(n, a, l) insert_entry(n, a, MR_STACK_LAYOUT(l))
#endif
-#define paste(a,b) a##b
-#define stringify(string) #string
-#define entry(label) paste(_entry_,label)
-#define skip(label) paste(skip_,label)
-
#ifdef SPLIT_C_FILES
#define MODULE_STATIC_OR_EXTERN extern
#else
@@ -459,7 +468,7 @@
*/
#define init_entry(label) \
PRETEND_ADDRESS_IS_USED(&&label); \
- make_entry(stringify(label), label)
+ make_entry(stringify(label), label, label)
#define ENTRY(label) (&label)
#define STATIC(label) (&label)
@@ -485,7 +494,7 @@
label: \
{
#define init_entry(label) \
- make_entry(stringify(label), &&label); \
+ make_entry(stringify(label), &&label, label); \
entry(label) = &&label
#define ENTRY(label) (entry(label))
#define STATIC(label) (entry(label))
@@ -502,10 +511,10 @@
} \
label: \
{
- #define init_local(label) make_local(stringify(label), &&label)
- #define Declare_label(label) /* no declaration required */
- #define Define_label(label) Define_local(label)
- #define init_label(label) make_label(stringify(label), &&label)
+ #define init_local(label) make_local(stringify(label), &&label, label)
+ #define Declare_label(label) Define_extern_entry(label)
+ #define Define_label(label) Define_entry(label)
+ #define init_label(label) make_label(stringify(label), &&label, label)
#define LOCAL(label) (&&entry(label))
#define LABEL(label) (&&entry(label))
@@ -543,21 +552,21 @@
GOTO(label); \
} \
static Code* label(void) {
- #define init_entry(label) make_entry(stringify(label), label)
+ #define init_entry(label) make_entry(stringify(label), label, label)
#define Declare_local(label) static Code *label(void)
#define Define_local(label) \
GOTO(label); \
} \
static Code* label(void) {
- #define init_local(label) make_local(stringify(label), label)
+ #define init_local(label) make_local(stringify(label), label, label)
#define Declare_label(label) static Code *label(void)
#define Define_label(label) \
GOTO(label); \
} \
static Code* label(void) {
- #define init_label(label) make_label(stringify(label), label)
+ #define init_label(label) make_label(stringify(label), label, label)
#define ENTRY(label) (label)
#define STATIC(label) (label)
Index: runtime/imp.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/imp.h,v
retrieving revision 1.114
diff -u -r1.114 imp.h
--- imp.h 1997/10/02 17:13:57 1.114
+++ imp.h 1997/10/23 01:58:36
@@ -63,6 +63,8 @@
#include "prof.h"
#include "misc.h"
+#include "mercury_accurate_gc.h"
+
#include "mercury_grade.h"
#endif /* not IMP_H */
Index: runtime/label.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/label.c,v
retrieving revision 1.22
diff -u -r1.22 label.c
--- label.c 1997/08/28 17:52:31 1.22
+++ label.c 1997/10/23 04:52:30
@@ -50,15 +50,26 @@
}
Label *
-insert_entry(const char *name, Code *addr)
+insert_entry(const char *name, Code *addr, Word *entry_layout_info)
{
Label *entry;
do_init_entries();
+
+#ifdef MR_USE_STACK_LAYOUTS
+ /*
+ ** The succip will be set to the address stored in the
+ ** layout info. For some reason, this is different to
+ ** the address passed to insert_entry
+ */
+ addr = entry_layout_info[0];
+#endif /* MR_USE_STACK_LAYOUTS */
+
entry = make(Label);
entry->e_name = name;
entry->e_addr = addr;
+ entry->e_layout = entry_layout_info;
#ifdef PROFILE_CALLS
prof_output_addr_decls(name, addr);
Index: runtime/label.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/label.h,v
retrieving revision 1.14
diff -u -r1.14 label.h
--- label.h 1997/07/27 15:08:24 1.14
+++ label.h 1997/08/27 08:20:53
@@ -6,7 +6,10 @@
/*
** label.h defines the interface to the label table, which is a pair of
-** hash tables mapping from procedure names to addresses and vice versa.
+** hash tables, one mapping from procedure names and the other from
+** addresses to label information.
+** The label information includes the name, address of the code, and
+** layout information for that label.
*/
#ifndef LABEL_H
@@ -18,10 +21,11 @@
typedef struct s_label {
const char *e_name; /* name of the procedure */
Code *e_addr; /* address of the code */
+ Word *e_layout; /* layout info for the procedure */
} Label;
extern void do_init_entries(void);
-extern Label *insert_entry(const char *name, Code *addr);
+extern Label *insert_entry(const char *name, Code *addr, Word *layout);
extern Label *lookup_label_name(const char *name);
extern Label *lookup_label_addr(const Code *addr);
extern List *get_all_labels(void);
Index: runtime/mercury_accurate_gc.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_accurate_gc.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_accurate_gc.h
--- mercury_accurate_gc.h 1997/07/27 15:08:27 1.2
+++ mercury_accurate_gc.h 1997/10/23 00:41:55
@@ -4,14 +4,209 @@
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
+#ifndef MERCURY_ACCURATE_GC_H
+#define MERCURY_ACCURATE_GC_H
+
/*
** mercury_accurate_gc.h -
** Definitions for use by the accurate garbage collector (and
** supporting code).
*/
-#ifndef MERCURY_ACCURATE_GC_H
-#define MERCURY_ACCURATE_GC_H
+#ifdef NATIVE_GC
+ #define MR_USE_STACK_LAYOUTS
+#endif
+
+/*
+** Definitions for MR_Code_Model
+*/
+
+typedef enum { MR_CODE_MODEL_DET, MR_CODE_MODEL_NONDET } MR_Code_Model;
+
+/*
+** Definitions for MR_LIVE_LVAL
+**
+** MR_LIVE_LVAL describes an lval. This includes:
+** - stack slots, registers, and special lvals such as succip, hp,
+** etc.
+**
+** The data is encoded using an 8 bit low tag, the rest of the word is a
+** data field describing which stack slot number or register number.
+**
+** Lval Tag Rest
+** r(Num) 0 Num
+** f(Num) 1 Num
+** stackvar(Num) 2 Num
+** framevar(Num) 3 Num
+** succip 4
+** maxfr 5
+** curfr 6
+** hp 7
+** sp 8
+** unknown 9 (The location is not known)
+**
+** The type MR_Lval_Type describes the different tag values.
+**
+*/
+
+typedef enum {
+ MR_LVAL_TYPE_R,
+ MR_LVAL_TYPE_F,
+ MR_LVAL_TYPE_STACKVAR,
+ MR_LVAL_TYPE_FRAMEVAR,
+ MR_LVAL_TYPE_SUCCIP,
+ MR_LVAL_TYPE_MAXFR,
+ MR_LVAL_TYPE_CURFR,
+ MR_LVAL_TYPE_HP,
+ MR_LVAL_TYPE_SP,
+ MR_LVAL_TYPE_UNKNOWN
+} MR_Lval_Type;
+
+#define MR_LIVE_LVAL_TAGBITS 8
+
+#define MR_LIVE_LVAL_TYPE(Lval) \
+ ((MR_Lval_Type) ((Lval) & ((1 << MR_LIVE_LVAL_TAGBITS) - 1)))
+
+#define MR_LIVE_LVAL_NUMBER(Lval) \
+ ((Word) (Lval) >> MR_LIVE_LVAL_TAGBITS)
+
+/*
+** Definitions for MR_LIVE_TYPE
+**
+** MR_LIVE_TYPE describes a live date. This includes:
+** - succip, hp, curfr, maxfr, redoip, and
+** mercury data values (vars) that reference a type and an inst.
+**
+** The data is encoded such that low values (less than
+** TYPELAYOUT_MAX_VARINT) represent succip, hp, etc. Higher values
+** are pointers to a 2 cell, containing a type_info and an instantiation
+** represention.
+**
+*/
+
+typedef enum {
+ MR_LIVE_TYPE_FRAMEVAR,
+ MR_LIVE_TYPE_SUCCIP,
+ MR_LIVE_TYPE_HP,
+ MR_LIVE_TYPE_CURFR,
+ MR_LIVE_TYPE_MAXFR,
+ MR_LIVE_TYPE_REDOIP,
+ MR_LIVE_TYPE_UNWANTED
+} MR_Lval_Type_NonVar;
+
+typedef struct {
+ Word typeinfo;
+ Word inst;
+} MR_Lval_Type_Var;
+
+#define MR_LIVE_TYPE_IS_VAR(T) ( (Word) T > TYPELAYOUT_MAX_VARINT )
+
+#define MR_LIVE_TYPE_GET_NONVAR(T) \
+ ((MR_Lval_Type_NonVar) T)
+
+#define MR_LIVE_TYPE_GET_VAR_TYPE(T) \
+ ((Word) ((MR_Lval_Type_Var *) T)->typeinfo)
+
+#define MR_LIVE_TYPE_GET_VAR_INST(T) \
+ ((Word) ((MR_Lval_Type_Var *) T)->inst)
+
+
+/*
+** Macros to support hand-written C code.
+*/
+
+/*
+** Define a stack layout for a label that you know very little about.
+** It's just a generic entry label, no useful information, except
+** the code address for the label.
+*/
+#ifdef MR_USE_STACK_LAYOUTS
+ #define MR_MAKE_STACK_LAYOUT_ENTRY(l) \
+ const struct mercury_data__stack_layout__##l##_struct { \
+ Code * f1; \
+ Integer f2; \
+ Integer f3; \
+ Integer f4; \
+ } mercury_data__stack_layout__##l = { \
+ STATIC(l), \
+ (Integer) -1, /* Unknown number of stack slots */ \
+ (Integer) -1, /* Unknown code model */ \
+ (Integer) MR_LVAL_TYPE_UNKNOWN /* Unknown succip location */ \
+ };
+#else
+ #define MR_MAKE_STACK_LAYOUT_ENTRY(l)
+#endif /* MR_USE_STACK_LAYOUTS */
+
+/*
+** Define a stack layout for an internal label. Need to supply the
+** label name (l) and the entry label name (e).
+**
+** The only useful information in this structure is the code address
+** and the reference to the entry for this label.
+*/
+#ifdef MR_USE_STACK_LAYOUTS
+ #define MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(l, e) \
+ const struct mercury_data__stack_layout__##l##_struct { \
+ Code * f1; \
+ const Word * f2; \
+ Integer f3; \
+ const Word * f4; \
+ } mercury_data__stack_layout__##l = { \
+ ENTRY(l), \
+ (const Word *) &mercury_data__stack_layout__##e, \
+ (Integer) -1, /* Unknown number of live values */ \
+ (const Word *) NULL /* No list of live valeus */ \
+ };
+#else
+ #define MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(l, e)
+#endif /* MR_USE_STACK_LAYOUTS */
+
+/*
+** Define a stack layout for an internal label that you know very little about.
+** Need to supply the label name (l) and the number (x), eg for
+** label_name_i3, x is 3. It is assumed the entry label for that
+** corresponds to this label is the label name without the _iX suffix.
+**
+** The only useful information in this structure is the code address
+** and the reference to the entry for this label.
+*/
+#ifdef MR_USE_STACK_LAYOUTS
+ #define MR_MAKE_STACK_LAYOUT_INTERNAL(l, x) \
+ const struct mercury_data__stack_layout__##l##_i##x##_struct { \
+ Code * f1; \
+ const Word * f2; \
+ Integer f3; \
+ const Word * f4; \
+ } mercury_data__stack_layout__##l##_i##x = { \
+ ENTRY(l), \
+ (const Word *) &mercury_data__stack_layout__##l, \
+ (Integer) -1, /* Unknown number of live values */ \
+ (const Word *) NULL /* No list of live valeus */ \
+ };
+#else
+ #define MR_MAKE_STACK_LAYOUT_INTERNAL(l, x)
+#endif /* MR_USE_STACK_LAYOUTS */
+
+/*
+** Macros to support stack layouts.
+*/
+#define MR_CONT_STACK_LAYOUT_GET_LABEL_ADDRESS(s) \
+ ((Code *) field(0, (s), 0))
+
+#define MR_ENTRY_STACK_LAYOUT_GET_LABEL_ADDRESS(s) \
+ MR_CONT_STACK_LAYOUT_GET_LABEL_ADDRESS(s)
+
+#define MR_CONT_STACK_LAYOUT_GET_ENTRY_LAYOUT(s) \
+ (field(0, (s), 1))
+
+#define MR_ENTRY_STACK_LAYOUT_GET_NUM_SLOTS(s) \
+ (field(0, (s), 1))
+
+#define MR_ENTRY_STACK_LAYOUT_GET_CODE_MODEL(s) \
+ (field(0, (s), 2))
+
+#define MR_ENTRY_STACK_LAYOUT_GET_SUCCIP_LOC(s) \
+ (field(0, (s), 3))
/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_ACCURATE_GC_H */
Index: util/mkinit.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/util/mkinit.c,v
retrieving revision 1.20
diff -u -r1.20 mkinit.c
--- mkinit.c 1997/09/05 22:33:55 1.20
+++ mkinit.c 1997/09/23 14:09:14
@@ -170,6 +170,15 @@
"}\n"
;
+
+static const char if_need_to_init[] =
+ "#if (defined(USE_GCC_NONLOCAL_GOTOS) && !defined(USE_ASM_LABELS)) \\\n"
+ " || defined(PROFILE_CALLS) || defined(DEBUG_GOTOS) \\\n"
+ " || defined(DEBUG_LABELS) || defined(NATIVE_GC) \\\n"
+ " || !defined(SPEED)\n\n"
+ ;
+
+
/* --- function prototypes --- */
static void parse_options(int argc, char *argv[]);
static void usage(void);
@@ -299,11 +308,7 @@
{
int filenum;
- fputs("#if (defined(USE_GCC_NONLOCAL_GOTOS) && "
- "!defined(USE_ASM_LABELS)) \\\n", stdout);
- fputs("\t|| defined(PROFILE_CALLS) || defined(DEBUG_GOTOS) \\\n",
- stdout);
- fputs("\t|| defined(DEBUG_LABELS) || !defined(SPEED)\n\n", stdout);
+ fputs(if_need_to_init, stdout);
fputs("static void init_modules_0(void)\n", stdout);
fputs("{\n", stdout);
@@ -325,11 +330,8 @@
fputs("static void init_modules(void)\n", stdout);
fputs("{\n", stdout);
- fputs("#if (defined(USE_GCC_NONLOCAL_GOTOS) && "
- "!defined(USE_ASM_LABELS)) \\\n", stdout);
- fputs("\t|| defined(PROFILE_CALLS) || defined(DEBUG_GOTOS) \\\n",
- stdout);
- fputs("\t|| defined(DEBUG_LABELS) || !defined(SPEED)\n\n", stdout);
+ fputs(if_need_to_init, stdout);
+
for (i = 0; i <= num_modules; i++)
printf("\tinit_modules_%d();\n", i);
fputs("#endif\n", stdout);
New File: runtime/call.c
===================================================================
/*
INIT mercury_sys_init_call
ENDINIT
*/
/*
** Copyright (C) 1995-1997 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.
*/
/*
** The call.mod module provides much of the functionality for doing
** higher order calls. The rest is provided by code generation of the
** higher_order_call HLDS construct.
**
** The called closure may contain only input arguments. The extra arguments
** provided by the higher-order call may be input or output, and may appear
** in any order.
**
** The input arguments to do_call_*_closure are the closure in r1,
** the number of additional input arguments in r2, the number of output
** arguments to expect in r3, and the additional input arguments themselves
** in r4, r5, etc. The output arguments are returned in registers r1, r2, etc
** for det and nondet calls or registers r2, r3, etc for semidet calls.
**
** The placement of the extra input arguments into r4, r5 etc is done by
** the code generator, as is the movement of the output arguments to their
** eventual destinations.
*/
#include "imp.h"
Define_extern_entry(do_call_det_closure);
Declare_label(det_closure_return);
Define_extern_entry(do_call_semidet_closure);
Declare_label(semidet_closure_return);
Define_extern_entry(do_call_nondet_closure);
Declare_label(nondet_closure_return);
Define_extern_entry(mercury__unify_2_0);
Define_extern_entry(mercury__index_2_0);
Declare_label(mercury__index_2_0_i1);
Define_extern_entry(mercury__compare_3_0);
Define_extern_entry(mercury__compare_3_1);
Define_extern_entry(mercury__compare_3_2);
Define_extern_entry(mercury__compare_3_3);
Declare_label(mercury__compare_3_0_i1);
MR_MAKE_STACK_LAYOUT_ENTRY(do_call_det_closure);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(det_closure_return,
do_call_det_closure);
MR_MAKE_STACK_LAYOUT_ENTRY(do_call_semidet_closure);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(semidet_closure_return,
do_call_semidet_closure);
MR_MAKE_STACK_LAYOUT_ENTRY(do_call_nondet_closure);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(nondet_closure_return,
do_call_nondet_closure);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__unify_2_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__index_2_0);
MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__index_2_0, 1);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__compare_3_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__compare_3_1);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__compare_3_2);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__compare_3_3);
MR_MAKE_STACK_LAYOUT_INTERNAL(mercury__compare_3_0, 1);
BEGIN_MODULE(call_module)
init_entry(do_call_det_closure);
init_label(det_closure_return);
init_entry(do_call_semidet_closure);
init_label(semidet_closure_return);
init_entry(do_call_nondet_closure);
init_label(nondet_closure_return);
init_entry(mercury__unify_2_0);
init_entry(mercury__index_2_0);
init_label(mercury__index_2_0_i1);
init_entry(mercury__compare_3_0);
init_entry(mercury__compare_3_1);
init_entry(mercury__compare_3_2);
init_entry(mercury__compare_3_3);
init_label(mercury__compare_3_0_i1);
BEGIN_CODE
Define_entry(do_call_det_closure);
{
Word closure;
int i, num_in_args, num_extra_args;
closure = r1; /* The closure */
num_in_args = field(0, closure, 0); /* number of input args */
num_extra_args = r2; /* number of immediate input args */
push(r3); /* The number of output args to unpack */
push(num_in_args + num_extra_args); /* The number of input args */
push(succip);
save_registers();
if (num_in_args < 3) {
for (i = 1; i <= num_extra_args; i++) {
virtual_reg(i+num_in_args) = virtual_reg(i+3);
}
} else if (num_in_args > 3) {
for (i = num_extra_args; i>0; i--) {
virtual_reg(i+num_in_args) = virtual_reg(i+3);
}
} /* else do nothing because i == 3 */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i) = field(0, closure, i+1); /* copy args */
}
restore_registers();
call((Code *) field(0, closure, 1), LABEL(det_closure_return),
LABEL(do_call_det_closure));
}
Define_label(det_closure_return);
{
int i, num_in_args, num_out_args;
succip = pop(); /* restore succip */
num_in_args = pop(); /* restore the input arg counter */
num_out_args = pop(); /* restore the ouput arg counter */
#ifdef COMPACT_ARGS
#else
save_registers();
for (i = 1; i <= num_out_args; i++) {
virtual_reg(i) = virtual_reg(i+num_in_args);
}
restore_registers();
#endif
proceed();
}
Define_entry(do_call_semidet_closure);
{
Word closure;
int i, num_in_args, num_extra_args;
closure = r1; /* The closure */
num_in_args = field(0, closure, 0); /* number of input args */
num_extra_args = r2; /* the number of immediate input args */
push(r3); /* The number of output args to unpack */
push(num_in_args + num_extra_args); /* The number of input args */
push(succip);
save_registers();
#ifdef COMPACT_ARGS
if (num_in_args < 3) {
for (i = 1; i <= num_extra_args; i++) {
virtual_reg(i+num_in_args) = virtual_reg(i+3);
}
} else if (num_in_args > 3) {
for (i = num_extra_args; i>0; i--) {
virtual_reg(i+num_in_args) = virtual_reg(i+3);
}
} /* else do nothing because i == 3 */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i) = field(0, closure, i+1); /* copy args */
}
#else
if (num_in_args < 2) {
for (i = 1; i <= num_extra_args; i++) {
virtual_reg(1+i+num_in_args) = virtual_reg(i+3);
}
} else if (num_in_args > 2) {
for (i = num_extra_args; i>0; i--) {
virtual_reg(1+i+num_in_args) = virtual_reg(i+3);
}
} /* else do nothing because i == 2 */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i+1) = field(0, closure, i+1); /* copy args */
}
#endif
restore_registers();
call((Code *) field(0, closure, 1), LABEL(semidet_closure_return),
LABEL(do_call_semidet_closure));
}
Define_label(semidet_closure_return);
{
int i, num_in_args, num_out_args;
succip = pop(); /* restore succip */
num_in_args = pop(); /* restore the input arg counter */
num_out_args = pop(); /* restore the ouput arg counter */
#ifdef COMPACT_ARGS
#else
save_registers();
for (i = 1; i <= num_out_args; i++) {
virtual_reg(i+1) = virtual_reg(i+1+num_in_args);
}
restore_registers();
#endif
proceed();
}
Define_entry(do_call_nondet_closure);
{
Word closure;
int i, num_in_args, num_extra_args;
closure = r1; /* The closure */
num_in_args = field(0, closure, 0); /* number of input args */
num_extra_args = r2; /* number of immediate input args */
mkframe("do_call_nondet_closure", 2, ENTRY(do_fail));
framevar(0) = r3; /* The number of output args to unpack */
framevar(1) = num_in_args + num_extra_args;
/* The number of input args */
save_registers();
if (num_in_args < 3) {
for (i = 1; i <= num_extra_args; i++) {
virtual_reg(i+num_in_args) = virtual_reg(i+3);
}
} else if (num_in_args > 3) {
for (i = num_extra_args; i > 0; i--) {
virtual_reg(i+num_in_args) = virtual_reg(i+3);
}
} /* else do nothing because i == 3 */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i) = field(0, closure, i+1); /* copy args */
}
restore_registers();
call((Code *) field(0, closure, 1), LABEL(nondet_closure_return),
LABEL(do_call_nondet_closure));
}
Define_label(nondet_closure_return);
{
int i, num_in_args, num_out_args;
num_in_args = framevar(1); /* restore the input arg counter */
num_out_args = framevar(0); /* restore the ouput arg counter */
#ifdef COMPACT_ARGS
#else
save_registers();
for (i = 1; i <= num_out_args; i++) {
virtual_reg(i) = virtual_reg(i+num_in_args);
}
restore_registers();
#endif
succeed();
}
/*
** mercury__unify_2_0 is called as `unify(TypeInfo, X, Y)'
** in the mode `unify(in, in, in) is semidet'.
**
** With the simple parameter passing convention, the inputs are in the
** registers r2, r3 and r4. With the compact parameter passing convention,
** the inputs are in the registers r1, r2 and r3.
**
** The only output is the success/failure indication,
** which goes in r1 with both calling conventions.
**
** We call the type-specific unification routine as
** `UnifyPred(...ArgTypeInfos..., X, Y)' is semidet, with all arguments input.
** Again r1 will hold the success/failure continuation; the input arguments
** start either in r1 or r2 depending on the argument passing convention.
*/
Define_entry(mercury__unify_2_0);
{
Code *unify_pred; /* address of the unify pred for this type */
int type_arity; /* number of type_info args */
Word args_base; /* the address of the word before the first */
/* type_info argument */
Word x, y;
int i;
Word base_type_info;
x = mercury__unify__x;
y = mercury__unify__y;
base_type_info = field(0, mercury__unify__typeinfo, 0);
if (base_type_info == 0) {
type_arity = 0;
unify_pred = (Code *) field(0, mercury__unify__typeinfo,
OFFSET_FOR_UNIFY_PRED);
/* args_base will not be needed */
} else {
type_arity = field(0, base_type_info, OFFSET_FOR_COUNT);
unify_pred = (Code *) field(0, base_type_info,
OFFSET_FOR_UNIFY_PRED);
args_base = mercury__unify__typeinfo;
}
save_registers();
/* we call `UnifyPred(...ArgTypeInfos..., X, Y)' */
/* virtual_reg(1) will hold the success/failure indication */
for (i = 1; i <= type_arity; i++) {
virtual_reg(i + mercury__unify__offset) =
field(0, args_base, i);
}
virtual_reg(type_arity + mercury__unify__offset + 1) = x;
virtual_reg(type_arity + mercury__unify__offset + 2) = y;
restore_registers();
tailcall(unify_pred, LABEL(mercury__unify_2_0));
}
/*
** mercury__index_2_0 is called as `index(TypeInfo, X, Index)'
** in the mode `index(in, in, out) is det'.
**
** With both parameter passing conventions, the inputs are in r1 and r2.
** With the simple parameter passing convention, the output is in r3;
** with the compact parameter passing convention, the output is in r1.
**
** We call the type-specific index routine as
** `IndexPred(...ArgTypeInfos..., X, Index)' is det.
** The ArgTypeInfo and X arguments are input, and are passed in r1, r2, ... rN
** with both conventions. The Index argument is output; it is returned in
** r1 with the compact convention and rN+1 with the simple convention.
**
** With the compact convention, we can make the call to the type-specific
** routine a tail call, and we do so. With the simple convention, we can't.
*/
Define_entry(mercury__index_2_0);
{
Code *index_pred; /* address of the index pred for this type */
int type_arity; /* number of type_info args */
Word args_base; /* the address of the word before the first */
/* type_info argument */
Word x;
int i;
Word base_type_info;
x = r2;
base_type_info = field(0, r1, 0);
if (base_type_info == 0) {
type_arity = 0;
index_pred = (Code *) field(0, r1, OFFSET_FOR_INDEX_PRED);
/* args_base will not be needed */
} else {
type_arity = field(0, base_type_info, OFFSET_FOR_COUNT);
index_pred = (Code *) field(0, base_type_info,
OFFSET_FOR_INDEX_PRED);
args_base = r1;
}
save_registers();
/* we call `IndexPred(...ArgTypeInfos..., X, Index)' */
for (i = 1; i <= type_arity; i++) {
virtual_reg(i) = field(0, args_base, i);
}
virtual_reg(type_arity + 1) = x;
restore_registers();
#ifdef COMPACT_ARGS
tailcall(index_pred, LABEL(mercury__index_2_0));
#else
push(succip);
push(type_arity);
call(index_pred, LABEL(mercury__index_2_0_i1),
LABEL(mercury__index_2_0));
#endif
}
/*
** Since mod2c declares this label, we must define it,
** even though it is not needed with COMPACT_ARGS.
*/
Define_label(mercury__index_2_0_i1);
{
#ifdef COMPACT_ARGS
fatal_error("mercury__index_2_0_i1 reached in COMPACT_ARGS mode");
#else
int type_arity;
type_arity = pop();
succip = pop();
save_registers();
r3 = virtual_reg(type_arity + 2);
proceed();
#endif
}
/*
** mercury__compare_3_3 is called as `compare(TypeInfo, Result, X, Y)'
** in the mode `compare(in, out, in, in) is det'.
**
** (The additional entry points replace either or both "in"s with "ui"s.)
**
** With the simple parameter passing convention, the inputs are in r1,
** r3 and r4, while the output is in r2.
**
** With the compact parameter passing convention, the inputs are in r1,
** r2 and r3, while the output is in r1.
**
** We call the type-specific compare routine as
** `ComparePred(...ArgTypeInfos..., Result, X, Y)' is det.
** The ArgTypeInfo arguments are input, and are passed in r1, r2, ... rN
** with both conventions. The X and Y arguments are also input, but are passed
** in different registers (rN+2 and rN+3 with the simple convention and rN+1
** and rN+2 with the compact convention). The Index argument is output; it is
** returned in ** r1 with the compact convention and rN+1 with the simple
** convention.
**
** With the compact convention, we can make the call to the type-specific
** routine a tail call, and we do so. With the simple convention, we can't.
*/
Define_entry(mercury__compare_3_0);
#ifdef PROFILE_CALLS
{
tailcall(ENTRY(mercury__compare_3_3), LABEL(mercury__compare_3_0));
}
#endif
Define_entry(mercury__compare_3_1);
#ifdef PROFILE_CALLS
{
tailcall(ENTRY(mercury__compare_3_3), LABEL(mercury__compare_3_1));
}
#endif
Define_entry(mercury__compare_3_2);
#ifdef PROFILE_CALLS
{
tailcall(ENTRY(mercury__compare_3_3), LABEL(mercury__compare_3_2));
}
#endif
Define_entry(mercury__compare_3_3);
{
Code *compare_pred; /* address of the compare pred for this type */
int type_arity; /* number of type_info args */
Word args_base; /* the address of the word before the first */
/* type_info argument */
Word x, y;
int i;
Word base_type_info;
x = mercury__compare__x;
y = mercury__compare__y;
base_type_info = field(0, mercury__compare__typeinfo, 0);
if (base_type_info == 0) {
type_arity = 0;
compare_pred = (Code *) field(0, mercury__compare__typeinfo,
OFFSET_FOR_COMPARE_PRED);
/* args_base will not be needed */
} else {
type_arity = field(0, base_type_info, OFFSET_FOR_COUNT);
compare_pred = (Code *) field(0, base_type_info,
OFFSET_FOR_COMPARE_PRED);
args_base = mercury__compare__typeinfo;
}
save_registers();
/* we call `ComparePred(...ArgTypeInfos..., Result, X, Y)' */
for (i = 1; i <= type_arity; i++) {
virtual_reg(i) = field(0, args_base, i);
}
virtual_reg(type_arity + mercury__compare__offset + 1) = x;
virtual_reg(type_arity + mercury__compare__offset + 2) = y;
restore_registers();
#ifdef COMPACT_ARGS
tailcall(compare_pred, LABEL(mercury__compare_3_3));
#else
push(succip);
push(type_arity);
call(compare_pred, LABEL(mercury__compare_3_0_i1),
LABEL(mercury__compare_3_3));
#endif
}
/*
** Since mod2c declares this label, we must define it,
** even though it is not needed with COMPACT_ARGS.
*/
Define_label(mercury__compare_3_0_i1);
{
#ifdef COMPACT_ARGS
fatal_error("mercury__compare_3_0_i1 reached in COMPACT_ARGS mode");
#else
int type_arity;
type_arity = pop();
succip = pop();
save_registers();
r2 = virtual_reg(type_arity + 1);
proceed();
#endif
}
END_MODULE
void mercury_sys_init_call(void); /* suppress gcc warning */
void mercury_sys_init_call(void) {
call_module();
}
New File: runtime/context.c
===================================================================
/*
INIT mercury_sys_init_context
ENDINIT
*/
/*
** Copyright (C) 1995-1997 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.
*/
/* context.mod - handles multithreading stuff. */
#include "imp.h"
#include <stdio.h>
#include <unistd.h> /* for getpid() and fork() */
#ifdef PARALLEL
#include <signal.h>
#endif
#include "context.h"
#include "engine.h" /* for `memdebug' */
#ifdef PARALLEL
unsigned numprocs = 1;
#endif
#ifdef PARALLEL
pid_t *procid;
AtomicBool *procwaiting;
#endif
int my_procnum;
pid_t my_procid;
Word *min_heap_reclamation_point;
Context *this_context;
Context **runqueue_ptr;
Context **free_context_list_ptr;
SpinLock *runqueue_lock;
SpinLock *free_context_list_lock;
Context *do_schedule_cptr;
Code *do_schedule_resume;
Word *do_join_and_terminate_sync_term;
Word *do_join_and_continue_sync_term;
Code *do_join_and_continue_where_to;
static void init_free_context_list(void);
void
init_processes(void)
{
int i;
pid_t pid;
my_procnum = 0;
my_procid = getpid();
runqueue_lock = allocate_lock();
runqueue_ptr = allocate_object(Context *);
*runqueue_ptr = NULL;
#ifdef PARALLEL
procid = allocate_array(pid_t, numprocs);
procwaiting = allocate_array(AtomicBool, numprocs);
procid[0] = my_procid;
procwaiting[0] = FALSE;
for (i = 1; i < numprocs; i++) {
if ((pid = fork()) < 0) {
fatal_error("failed to fork()");
}
if (pid == 0) { /* child */
my_procnum = i;
procid[i] = my_procid = getpid();
procwaiting[i] = FALSE;
return;
}
}
#endif
}
void
shutdown_processes(void)
{
#ifdef PARALLEL
/* XXX not yet implemented */
if (numprocs > 1) {
fprintf(stderr, "Mercury runtime: shutdown_processes()"
" not yet implemented\n");
}
#endif
}
void
init_process_context(void)
{
/*
** Each process has its own heap, in shared memory;
** each process may only allocate from its own heap,
** although it may access or modify data allocated
** by other processes in different heaps.
*/
init_heap();
if (my_procnum == 0) { /* the original process */
init_free_context_list();
this_context = new_context();
/* load the registers so we don't clobber hp */
restore_transient_registers();
load_context(this_context);
save_transient_registers();
if (memdebug) debug_memory();
}
}
static void
init_free_context_list(void)
{
int i;
Context *tmp;
free_context_list_lock = allocate_lock();
free_context_list_ptr = allocate_object(Context *);
*free_context_list_ptr = allocate_array(Context, INITIAL_NUM_CONTEXTS);
tmp = *free_context_list_ptr;
for (i = 0; i < INITIAL_NUM_CONTEXTS; i++) {
if (i != INITIAL_NUM_CONTEXTS - 1) {
tmp[i].next = &(tmp[i+1]);
} else {
tmp[i].next = NULL;
}
tmp[i].resume = NULL;
tmp[i].context_succip = NULL;
tmp[i].detstack_zone = NULL;
tmp[i].context_sp = NULL;
tmp[i].nondetstack_zone = NULL;
tmp[i].context_curfr = NULL;
tmp[i].context_maxfr = NULL;
}
}
Context *
new_context(void)
{
Context *c;
get_lock(free_context_list_lock);
MR_assert(free_context_list_ptr != NULL);
if (*free_context_list_ptr == NULL) {
fatal_error("no free contexts");
} else {
c = *free_context_list_ptr;
*free_context_list_ptr = c->next;
}
release_lock(free_context_list_lock);
c->next = NULL;
c->resume = NULL;
c->context_succip = ENTRY(do_not_reached);
if (c->detstack_zone != NULL) {
reset_zone(c->detstack_zone);
} else {
c->detstack_zone = create_zone("detstack", 0,
detstack_size, next_offset(), detstack_zone_size,
default_handler);
}
c->context_sp = c->detstack_zone->min;
if (c->nondetstack_zone != NULL) {
reset_zone(c->nondetstack_zone);
} else {
c->nondetstack_zone = create_zone("nondetstack", 0,
nondstack_size, next_offset(), nondstack_zone_size,
default_handler);
}
c->context_maxfr = c->nondetstack_zone->min;
c->context_curfr = c->nondetstack_zone->min;
bt_redoip(c->context_curfr) = ENTRY(do_not_reached);
bt_prevfr(c->context_curfr) = NULL;
bt_succip(c->context_curfr) = ENTRY(do_not_reached);
bt_succfr(c->context_curfr) = NULL;
#ifdef MR_USE_TRAIL
if (c->trail_zone != NULL) {
reset_zone(c->trail_zone);
} else {
c->trail_zone = create_zone("trail", 0,
trail_size, next_offset(), trail_zone_size,
default_handler);
}
c->context_trail_ptr = (MR_TrailEntry *) c->trail_zone->min;
c->context_ticket_counter = 0;
#endif
c->context_hp = NULL;
return c;
}
void
delete_context(Context *c)
{
get_lock(free_context_list_lock);
MR_assert(free_context_list_ptr != NULL);
c->next = *free_context_list_ptr;
*free_context_list_ptr = c;
release_lock(free_context_list_lock);
}
void
flounder(void)
{
fatal_error("computation floundered");
}
Define_extern_entry(do_runnext);
Define_extern_entry(do_schedule);
Define_extern_entry(do_join_and_terminate);
Define_extern_entry(do_join_and_continue);
MR_MAKE_STACK_LAYOUT_ENTRY(do_runnext);
MR_MAKE_STACK_LAYOUT_ENTRY(do_schedule);
MR_MAKE_STACK_LAYOUT_ENTRY(do_join_and_terminate);
MR_MAKE_STACK_LAYOUT_ENTRY(do_join_and_continue);
BEGIN_MODULE(context_module)
init_entry(do_runnext);
init_entry(do_schedule);
init_entry(do_join_and_terminate);
init_entry(do_join_and_continue);
BEGIN_CODE
/*
** do a context switch: the previous context is assumed to have
** been saved or deallocated or whatever.
*/
Define_entry(do_runnext);
while(1) {
#ifdef PARALLEL
/* If we're running in parallel, then we need to
** do some signal magic in order to avoid a race-
** condition if we have to suspend, waiting for
** the runqueue to become non-empty.
** The following algorithm is adapted from
** "Advanced Programming in the UNIX Environment",
** Stevens:
** - use sigprocmask to block SIGUSR1
** - obtain the spinlock on the runqueue
** - if the runqueue is not empty, get the
** next context off the queue, release the
** lock and reset the signal mask.
** - if the runqueue is empty, mark this process
** as waiting, release the lock and then
** use sigsuspend to atomically renable SIGUSR1
** and suspend the process. When we get a
** SIGUSR1 we resume and mark the process as not
** waiting, then try again to get a context off
** the runqueue.
** - this relies on the schedule code to send the
** SIGUSR1 signal while it has the spinlock to
** ensure that this process will only get sent
** a single signal.
*/
sigset_t newset, oldset, emptyset;
sigemptyset(&newset);
sigemptyset(&emptyset);
sigaddset(&newset, SIGUSR1);
/* block SIGUSR1 while we're in the critical region */
sigprocmask(SIG_BLOCK, &newset, &oldset);
#endif
get_lock(runqueue_lock);
if (*runqueue_ptr != NULL) {
this_context = *runqueue_ptr;
*runqueue_ptr = (*runqueue_ptr)->next;
release_lock(runqueue_lock);
#ifdef PARALLEL
/* restore the original set of signals */
sigprocmask(SIG_SETMASK, &oldset, NULL);
#endif
load_context(this_context);
GOTO(this_context->resume);
}
else
{
#ifdef PARALLEL
int i;
bool is_runnable;
procwaiting[my_procnum] = TRUE;
/*
** check to see that at least one process
** is currently runnable. If none are, then
** we've just floundered.
*/
is_runnable = FALSE;
for(i = 0; i < numprocs; i++)
{
if (procwaiting[i] == FALSE)
{
is_runnable = TRUE;
break;
}
}
if (!is_runnable)
flounder();
#endif
release_lock(runqueue_lock);
#ifdef PARALLEL
sigsuspend(&emptyset);
procwaiting[my_procnum] = FALSE;
#else
/* if we're not using parallelism, then
** the runqueue should never be empty.
*/
flounder();
#endif
}
}
/*
** do_schedule adds the context pointed to by do_schedule_cptr
** to the runqueue, signalling a sleeping process to wake it if
** the runqueue was previously empty.
*/
Define_entry(do_schedule);
{
Context *old;
get_lock(runqueue_lock);
old = *runqueue_ptr;
do_schedule_cptr->next = *runqueue_ptr;
*runqueue_ptr = do_schedule_cptr;
#ifdef PARALLEL
/* Check to see if we need to signal a sleeping process */
if (old == NULL) {
int i;
for(i = 0; i < numprocs; i++) {
if (procwaiting[i] == TRUE) {
kill(procid[i], SIGUSR1);
break;
}
}
}
#endif
release_lock(runqueue_lock);
GOTO(do_schedule_resume);
}
/*
** do_join_and_terminate synchronises with the structure pointed to
** by do_join_and_terminate_sync_term, then terminates the current
** context and does a context switch. If the current context was the
** last context to arrive at the synchronisation point, then we
** resume the parent context rather than do a context switch.
*/
Define_entry(do_join_and_terminate);
{
register Word *sync_term;
Context *ctxt;
sync_term = do_join_and_terminate_sync_term;
get_lock((SpinLock *)&sync_term[SYNC_TERM_LOCK]);
if (--(sync_term[SYNC_TERM_COUNTER]) == 0) {
MR_assert(sync_term[SYNC_TERM_PARENT] != NULL);
release_lock((SpinLock *)&sync_term[SYNC_TERM_LOCK]);
ctxt = (Context *) sync_term[SYNC_TERM_PARENT];
delete_context(this_context);
this_context = ctxt;
load_context(this_context);
GOTO(this_context->resume);
} else {
release_lock((SpinLock *)&sync_term[SYNC_TERM_LOCK]);
delete_context(this_context);
runnext();
}
}
/*
** do_join_and_continue synchronises with the structure pointed to
** by do_join_and_continue_sync_term. If we are the last context to
** arrive here, then we branch to the continuation stored in
** do_join_and_continue_where_to. If we have to wait for other contexts
** to arrive, then we save the current context and store a pointer
** to it in the synchronisation term before doing a context switch.
*/
Define_entry(do_join_and_continue);
{
register Word *sync_term;
sync_term = do_join_and_continue_sync_term;
get_lock((SpinLock *)&sync_term[SYNC_TERM_LOCK]);
if (--(sync_term[SYNC_TERM_COUNTER]) == 0) {
MR_assert(sync_term[SYNC_TERM_PARENT] == NULL);
release_lock((SpinLock *)&sync_term[SYNC_TERM_LOCK]);
GOTO(do_join_and_continue_where_to);
} else {
save_context(this_context);
this_context->resume = do_join_and_continue_where_to;
sync_term[SYNC_TERM_PARENT] = (Word) this_context;
release_lock((SpinLock *)&sync_term[SYNC_TERM_LOCK]);
runnext();
}
}
END_MODULE
void mercury_sys_init_context(void); /* suppress gcc warning */
void mercury_sys_init_context(void) {
context_module();
}
New File: runtime/engine.c
===================================================================
/*
INIT mercury_sys_init_engine
ENDINIT
*/
/*
** Copyright (C) 1993-1997 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 "imp.h"
#include <stdio.h>
#include <string.h>
#include <setjmp.h>
#include "engine.h"
#include "dummy.h"
#ifdef 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
static void call_engine_inner(Code *entry_point);
#ifndef USE_GCC_NONLOCAL_GOTOS
static Code *engine_done(void);
static Code *engine_init_registers(void);
#endif
bool debugflag[MAXFLAG];
jmp_buf *MR_engine_jmp_buf;
/*---------------------------------------------------------------------------*/
/*
** init_engine() calls 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). If PARALLEL is defined,
** this will cause the shared memory to be allocated.
** Next, init_engine() calls init_processes() which fork()s the right
** number of processes, and initializes the data structures for coordinating
** the interaction between multiple processes.
** Then, init_engine() calls init_process_context() which initializes the
** local context for this process including the heap and solutions heap.
** If it is the original process, it allocates the initial context for main.
**
** Finally, if there are multiple processes, init_engine calls
** call_engine(do_runnext) for all but the first one, which makes
** them sleep until work becomes available. The initial process
** returns to the caller.
*/
void
init_engine(void)
{
init_memory();
#ifndef USE_GCC_NONLOCAL_GOTOS
make_label("engine_done", LABEL(engine_done));
#endif
init_processes();
init_process_context();
if (my_procnum == 0) {
return;
} else {
call_engine(ENTRY(do_runnext));
/* not reached */
MR_assert(FALSE);
}
}
/*---------------------------------------------------------------------------*/
/*
** call_engine(Code *entry_point)
**
** This routine calls a Mercury routine from C.
**
** The called routine should be det/semidet/cc_multi/cc_nondet.
** The virtual machine registers must be set up correctly
** before the call. 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 restore_transient_registers() and will then assume that
** all the registers have been correctly set up.
**
** call_engine() will call 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 "regs.h" (directly or via e.g. "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.)
**
** 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 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.
*/
void
call_engine(Code *entry_point)
{
jmp_buf curr_jmp_buf;
jmp_buf * volatile prev_jmp_buf;
/*
** Preserve the value of MR_engine_jmp_buf on the C stack.
** This is so "C calls Mercury which calls C which calls Mercury" etc.
** will work.
*/
prev_jmp_buf = MR_engine_jmp_buf;
MR_engine_jmp_buf = &curr_jmp_buf;
/*
** Mark this as the spot to return to.
** On return, restore the registers (since longjmp may clobber
** them), restore the saved value of MR_engine_jmp_buf, and then
** exit.
*/
if (setjmp(curr_jmp_buf)) {
debugmsg0("...caught longjmp\n");
restore_registers();
MR_engine_jmp_buf = prev_jmp_buf;
return;
}
call_engine_inner(entry_point);
}
#ifdef USE_GCC_NONLOCAL_GOTOS
/* The gcc-specific version */
void
call_engine_inner(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.
*/
unsigned char locals[LOCALS_SIZE];
{
#ifndef SPEED
{
/* ensure that we only make the label once */
static bool initialized = FALSE;
if (!initialized)
{
make_label("engine_done", LABEL(engine_done));
initialized = TRUE;
}
}
#endif
/*
** restore any registers that get clobbered by the C function
** call mechanism
*/
restore_transient_registers();
/*
** We save the address of the locals in a global pointer to make
** sure that gcc can't optimize them away.
*/
global_pointer = locals;
#ifndef SPEED
memset((void *)locals, MAGIC_MARKER, LOCALS_SIZE);
#endif
debugmsg1("in `call_engine', locals at %p\n", (void *)locals);
/*
** Now just call the entry point
*/
noprof_call(entry_point, LABEL(engine_done));
Define_label(engine_done);
/*
** We need to ensure that there is at least one
** real function call in call_engine(), 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() 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.
*/
dummy_function_call();
debugmsg1("in label `engine_done', locals at %p\n", locals);
#ifndef SPEED
/*
** Check how much of the space we reserved for local variables
** was actually used.
*/
if (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",
min(high, LOCALS_SIZE - low));
printf("(low mark = %d, high mark = %d)\n", low, high);
}
#endif /* not SPEED */
/*
** 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.
*/
save_registers();
debugmsg0("longjmping out...\n");
longjmp(*MR_engine_jmp_buf, 1);
}} /* end call_engine_inner() */
/* with nonlocal gotos, we don't save the previous locations */
void
dump_prev_locations(void) {}
#else /* not 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 Code *
engine_done(void)
{
save_registers();
debugmsg0("longjmping out...\n");
longjmp(*MR_engine_jmp_buf, 1);
}
static Code *
engine_init_registers(void)
{
restore_transient_registers();
succip = 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 void (*FuncPtr)(void);
typedef Code *Func(void);
static FuncPtr prev_fps[NUM_PREV_FPS];
static int prev_fp_index = 0;
void
dump_prev_locations(void)
{
int i, pos;
#if defined(SPEED) && !defined(DEBUG_GOTOS)
if (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;
printlabel(prev_fps[pos]);
}
}
}
static void
call_engine_inner(Code *entry_point)
{
reg Func *fp;
/*
** Start up the actual engine.
** The loop is unrolled a bit for efficiency.
*/
fp = engine_init_registers;
fp = (*fp)();
fp = entry_point;
#if defined(SPEED) && !defined(DEBUG_GOTOS)
if (!tracedebug) {
for (;;)
{
fp = (*fp)();
fp = (*fp)();
fp = (*fp)();
fp = (*fp)();
fp = (*fp)();
fp = (*fp)();
fp = (*fp)();
fp = (*fp)();
}
} else
#endif
for (;;)
{
prev_fps[prev_fp_index] = (FuncPtr) fp;
if (++prev_fp_index >= NUM_PREV_FPS)
prev_fp_index = 0;
debuggoto(fp);
debugsreg();
fp = (*fp)();
}
} /* end call_engine_inner() */
#endif /* not USE_GCC_NONLOCAL_GOTOS */
/*---------------------------------------------------------------------------*/
void
terminate_engine(void)
{
/*
** we don't bother to deallocate memory...
** that will happen automatically on process exit anyway.
*/
shutdown_processes();
}
/*---------------------------------------------------------------------------*/
Define_extern_entry(do_redo);
Define_extern_entry(do_fail);
Define_extern_entry(do_succeed);
Define_extern_entry(do_last_succeed);
Define_extern_entry(do_not_reached);
MR_MAKE_STACK_LAYOUT_ENTRY(do_redo);
MR_MAKE_STACK_LAYOUT_ENTRY(do_fail);
MR_MAKE_STACK_LAYOUT_ENTRY(do_succeed);
MR_MAKE_STACK_LAYOUT_ENTRY(do_last_succeed);
MR_MAKE_STACK_LAYOUT_ENTRY(do_not_reached);
BEGIN_MODULE(special_labels_module)
init_entry(do_redo);
init_entry(do_fail);
init_entry(do_succeed);
init_entry(do_last_succeed);
init_entry(do_not_reached);
BEGIN_CODE
Define_entry(do_redo);
redo();
Define_entry(do_fail);
fail();
Define_entry(do_succeed);
succeed();
Define_entry(do_last_succeed);
succeed_discard();
Define_entry(do_not_reached);
printf("reached not_reached\n");
exit(1);
#ifndef USE_GCC_NONLOCAL_GOTOS
return 0;
#endif
END_MODULE
/*---------------------------------------------------------------------------*/
void mercury_sys_init_engine(void); /* suppress gcc warning */
void mercury_sys_init_engine(void) {
special_labels_module();
}
New File: runtime/type_info.c
===================================================================
/*
INIT mercury_sys_init_type_info
ENDINIT
*/
/*
** Copyright (C) 1995-1997 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.
*/
/*
** type_info.c -
** Definitions for type_infos, type_layouts, and
** type_functors tables needed by the Mercury runtime system..
*/
#include "imp.h"
#include "type_info.h"
/*---------------------------------------------------------------------------*/
/* base_type_layout for `pred' */
/* (this is used for all higher-order types) */
const struct mercury_data___base_type_layout_pred_0_struct {
TYPE_LAYOUT_FIELDS
} mercury_data___base_type_layout_pred_0 = {
make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG,
mkbody(TYPELAYOUT_PREDICATE_VALUE))
};
/* base_type_functors for `pred' */
/* (this is used for all higher-order types) */
const struct mercury_data___base_type_functors_pred_0_struct {
Integer f1;
} mercury_data___base_type_functors_pred_0 = {
MR_TYPEFUNCTORS_SPECIAL
};
/*
** base_type_info for `func'
** (this is used for all higher-order func types)
**
** Note: we use the special predicates, functors and layout for
** `pred'.
*/
Declare_entry(mercury__builtin_unify_pred_2_0);
Declare_entry(mercury__builtin_index_pred_2_0);
Declare_entry(mercury__builtin_compare_pred_3_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_func_0_struct {
Integer f1;
Code *f2;
Code *f3;
Code *f4;
#ifdef USE_TYPE_TO_TERM
Code *f5;
Code *f6;
#endif
#ifdef USE_TYPE_LAYOUT
const Word *f7;
const Word *f8;
const Word *f9;
#endif
} mercury_data___base_type_info_func_0 = {
((Integer) 0),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_pred_3_0)),
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_pred_0,
(const Word *) & mercury_data___base_type_functors_pred_0,
(const Word *) string_const("func", 4)
#endif
};
/*
** base_type_info for `pred'
** (this is used for all higher-order pred types)
*/
Declare_entry(mercury__builtin_unify_pred_2_0);
Declare_entry(mercury__builtin_index_pred_2_0);
Declare_entry(mercury__builtin_compare_pred_3_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_pred_0_struct {
Integer f1;
Code *f2;
Code *f3;
Code *f4;
#ifdef USE_TYPE_TO_TERM
Code *f5;
Code *f6;
#endif
#ifdef USE_TYPE_LAYOUT
const Word *f7;
const Word *f8;
const Word *f9;
#endif
} mercury_data___base_type_info_pred_0 = {
((Integer) 0),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_pred_3_0)),
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_pred_0,
(const Word *) & mercury_data___base_type_functors_pred_0,
(const Word *) string_const("pred", 4)
#endif
};
Define_extern_entry(mercury__builtin_unify_pred_2_0);
Define_extern_entry(mercury__builtin_index_pred_2_0);
Define_extern_entry(mercury__builtin_compare_pred_3_0);
Declare_label(mercury__builtin_compare_pred_3_0_i4);
Define_extern_entry(mercury__builtin_unify_pred_2_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__builtin_unify_pred_2_0);
BEGIN_MODULE(mercury__builtin_unify_pred_module)
init_entry(mercury__builtin_unify_pred_2_0);
BEGIN_CODE
/* code for predicate 'builtin_unify_pred'/2 in mode 0 */
Define_entry(mercury__builtin_unify_pred_2_0);
incr_sp_push_msg(2, "mercury_builtin:builtin_unify_pred");
fatal_error("attempted unification of higher-order terms");
END_MODULE
Define_extern_entry(mercury__builtin_index_pred_2_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__builtin_index_pred_2_0);
BEGIN_MODULE(mercury__builtin_index_pred_module)
init_entry(mercury__builtin_index_pred_2_0);
BEGIN_CODE
/* code for predicate 'builtin_index_pred'/2 in mode 0 */
Define_entry(mercury__builtin_index_pred_2_0);
r1 = (Integer) -1;
proceed();
END_MODULE
Define_extern_entry(mercury__builtin_compare_pred_3_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__builtin_compare_pred_3_0);
BEGIN_MODULE(mercury__builtin_compare_pred_module)
init_entry(mercury__builtin_compare_pred_3_0);
BEGIN_CODE
/* code for predicate 'builtin_compare_pred'/3 in mode 0 */
Define_entry(mercury__builtin_compare_pred_3_0);
incr_sp_push_msg(2, "mercury_builtin:builtin_compare_pred");
fatal_error("attempted comparison of higher-order terms");
END_MODULE
/*---------------------------------------------------------------------------*/
void mercury_sys_init_type_info(void); /* suppress gcc warning */
void mercury_sys_init_type_info(void) {
mercury__builtin_unify_pred_module();
mercury__builtin_index_pred_module();
mercury__builtin_compare_pred_module();
}
New File: runtime/wrapper.c
===================================================================
/*
INIT mercury_sys_init_wrapper
ENDINIT
*/
/*
** Copyright (C) 1994-1997 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: wrapper.mod
** 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
** call_engine(do_interpreter), which invokes main/2.
**
** It also defines mercury_runtime_terminate(), which performs
** various cleanups that are needed to terminate cleanly.
*/
#include "imp.h"
#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include "timing.h"
#include "getopt.h"
#include "init.h"
#include "dummy.h"
/* 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) */
size_t heap_size = 4096;
size_t detstack_size = 2048;
size_t nondstack_size = 128;
size_t solutions_heap_size = 1024;
size_t trail_size = 128;
/* size of the redzones at the end of data areas, in kilobytes */
/* (but we later multiply by 1024 to convert to bytes) */
size_t heap_zone_size = 16;
size_t detstack_zone_size = 16;
size_t nondstack_zone_size = 16;
size_t solutions_heap_zone_size = 16;
size_t trail_zone_size = 16;
/* primary cache size to optimize for, in kilobytes */
/* (but we later multiply by 1024 to convert to bytes) */
size_t pcache_size = 8192;
/* other options */
int r1val = -1;
int r2val = -1;
int r3val = -1;
bool check_space = FALSE;
static bool benchmark_all_solns = FALSE;
static bool use_own_timer = FALSE;
static int repeats = 1;
/* timing */
int time_at_last_stat;
int time_at_start;
static int time_at_finish;
const char * progname;
int mercury_argc; /* not counting progname */
char ** mercury_argv;
int mercury_exit_status = 0;
/*
** 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 -> library -> runtime -> gc,
** where `->' means "depends on", i.e. "references a symbol of".
*/
void (*address_of_mercury_init_io)(void);
void (*address_of_init_modules)(void);
#ifdef CONSERVATIVE_GC
void (*address_of_init_gc)(void);
#endif
Code *program_entry_point;
/* normally mercury__main_2_0 (main/2) */
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) */
#ifdef USE_GCC_NONLOCAL_GOTOS
#define SAFETY_BUFFER_SIZE 1024 /* size of stack safety buffer */
#define MAGIC_MARKER_2 142 /* a random character */
#endif
static void process_args(int argc, char **argv);
static void process_environment_options(void);
static void process_options(int argc, char **argv);
static void usage(void);
static void make_argv(const char *, char **, char ***, int *);
#ifdef MEASURE_REGISTER_USAGE
static void print_register_usage_counts(void);
#endif
Declare_entry(do_interpreter);
/*---------------------------------------------------------------------------*/
void
mercury_runtime_init(int argc, char **argv)
{
#if NUM_REAL_REGS > 0
Word c_regs[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 ;-)
*/
save_regs_to_mem(c_regs);
#ifndef SPEED
/*
** 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
#ifdef CONSERVATIVE_GC
GC_quiet = TRUE;
/*
** Call GC_INIT() to tell the garbage collector about this DLL.
** (This is necessary to support Windows DLLs using gnu-win32.)
*/
GC_INIT();
/*
** call the init_gc() function defined in <foo>_init.c,
** which calls GC_INIT() to tell the GC about the main program.
** (This is to work around a Solaris 2.X (X <= 4) linker bug,
** and also to support Windows DLLs using gnu-win32.)
*/
(*address_of_init_gc)();
/* double-check that the garbage collector knows about
global variables in shared libraries */
GC_is_visible(fake_reg);
/* The following code is necessary to tell the conservative */
/* garbage collector that we are using tagged pointers */
{
int i;
for (i = 1; i < (1 << TAGBITS); i++) {
GC_register_displacement(i);
}
}
#endif
/* process the command line and the options in the environment
variable MERCURY_OPTIONS, and save results in global vars */
process_args(argc, argv);
process_environment_options();
#if (defined(USE_GCC_NONLOCAL_GOTOS) && !defined(USE_ASM_LABELS)) || \
defined(PROFILE_CALLS) || defined(PROFILE_TIME)
do_init_modules();
#endif
(*address_of_mercury_init_io)();
/* start up the Mercury engine */
init_engine();
/*
** We need to call 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 restore_transient_registers(),
** since we've just returned from a C call.
*/
restore_transient_registers();
save_registers();
/* initialize the Mercury library */
(*MR_library_initializer)();
/*
** Restore the callee-save registers before returning,
** since they may be used by the C code that called us.
*/
restore_regs_from_mem(c_regs);
} /* end runtime_mercury_main() */
void
do_init_modules(void)
{
static bool done = FALSE;
if (! done) {
(*address_of_init_modules)();
done = TRUE;
}
}
/*
** Given a string, parse it into arguments and create an argv vector for it.
** Returns args, argv, and argc. It is the caller's responsibility to oldmem()
** args and argv when they are no longer needed.
*/
static void
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(isspace((unsigned char)*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') {
fatal_error(
"Mercury runtime: unterminated quoted string\n"
"in MERCURY_OPTIONS environment variable\n"
);
}
if (*s == '\\')
s++;
args_len++; s++;
}
s++;
} else {
/* ordinary white-space delimited arg */
while(*s != '\0' && !isspace((unsigned char)*s)) {
if (*s == '\\')
s++;
args_len++; s++;
}
}
args_len++;
} /* end for */
/*
** Allocate the space
*/
args = make_many(char, args_len);
argv = make_many(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(isspace((unsigned char)*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' && !isspace((unsigned char)*s)) {
if (*s == '\\')
s++;
*d++ = *s++;
}
}
*d++ = '\0';
} /* end for */
*args_ptr = args;
*argv_ptr = argv;
*argc_ptr = argc;
} /* end make_argv() */
/**
** process_args() is a function that sets some global variables from the
** command line. `mercury_arg[cv]' are `arg[cv]' without the program name.
** `progname' is program name.
**/
static void
process_args( int argc, char ** argv)
{
progname = argv[0];
mercury_argc = argc - 1;
mercury_argv = argv + 1;
}
/**
** process_environment_options() is a function to parse the MERCURY_OPTIONS
** environment variable.
**/
static void
process_environment_options(void)
{
char* options;
options = getenv("MERCURY_OPTIONS");
if (options != NULL) {
char *arg_str, **argv;
char *dummy_command_line;
int argc;
int c;
/*
getopt() expects the options to start in argv[1],
not argv[0], so we need to insert a dummy program
name (we use "x") at the start of the options before
passing them to make_argv() and then to getopt().
*/
dummy_command_line = make_many(char, strlen(options) + 3);
strcpy(dummy_command_line, "x ");
strcat(dummy_command_line, options);
make_argv(dummy_command_line, &arg_str, &argv, &argc);
oldmem(dummy_command_line);
process_options(argc, argv);
oldmem(arg_str);
oldmem(argv);
}
}
static void
process_options(int argc, char **argv)
{
unsigned long size;
int c;
while ((c = getopt(argc, argv, "acd:hLlP:p:r:s:tw:xz:1:2:3:")) != EOF)
{
switch (c)
{
case 'a':
benchmark_all_solns = TRUE;
break;
case 'c':
check_space = TRUE;
break;
case 'd':
if (streq(optarg, "b"))
nondstackdebug = TRUE;
else if (streq(optarg, "c"))
calldebug = TRUE;
else if (streq(optarg, "d"))
detaildebug = TRUE;
else if (streq(optarg, "g"))
gotodebug = TRUE;
else if (streq(optarg, "G"))
#ifdef CONSERVATIVE_GC
GC_quiet = FALSE;
#else
fatal_error("-dG: GC not enabled");
#endif
else if (streq(optarg, "s"))
detstackdebug = TRUE;
else if (streq(optarg, "h"))
heapdebug = TRUE;
else if (streq(optarg, "f"))
finaldebug = TRUE;
else if (streq(optarg, "p"))
progdebug = TRUE;
else if (streq(optarg, "m"))
memdebug = TRUE;
else if (streq(optarg, "r"))
sregdebug = TRUE;
else if (streq(optarg, "t"))
tracedebug = TRUE;
else if (streq(optarg, "a")) {
calldebug = TRUE;
nondstackdebug = TRUE;
detstackdebug = TRUE;
heapdebug = TRUE;
gotodebug = TRUE;
sregdebug = TRUE;
finaldebug = TRUE;
tracedebug = TRUE;
#ifdef CONSERVATIVE_GC
GC_quiet = FALSE;
#endif
}
else
usage();
use_own_timer = FALSE;
break;
case 'h':
usage();
break;
case 'L':
do_init_modules();
break;
case 'l': {
List *ptr;
List *label_list;
label_list = get_all_labels();
for_list (ptr, label_list) {
Label *label;
label = (Label *) ldata(ptr);
printf("%lu %lx %s\n",
(unsigned long) label->e_addr,
(unsigned long) label->e_addr,
label->e_name);
}
exit(0);
}
#ifdef PARALLEL
case 'P':
if (sscanf(optarg, "%u", &numprocs) != 1)
usage();
if (numprocs < 1)
usage();
break;
#endif
case 'p':
if (sscanf(optarg, "%lu", &size) != 1)
usage();
pcache_size = size * 1024;
break;
case 'r':
if (sscanf(optarg, "%d", &repeats) != 1)
usage();
break;
case 's':
if (sscanf(optarg+1, "%lu", &size) != 1)
usage();
if (optarg[0] == 'h')
heap_size = size;
else if (optarg[0] == 'd')
detstack_size = size;
else if (optarg[0] == 'n')
nondstack_size = size;
else if (optarg[0] == 'l')
entry_table_size = size *
1024 / (2 * sizeof(List *));
#ifdef MR_USE_TRAIL
else if (optarg[0] == 't')
trail_size = size;
#endif
else
usage();
break;
case 't':
use_own_timer = TRUE;
calldebug = FALSE;
nondstackdebug = FALSE;
detstackdebug = FALSE;
heapdebug = FALSE;
gotodebug = FALSE;
sregdebug = FALSE;
finaldebug = FALSE;
break;
case 'w': {
Label *which_label;
which_label = lookup_label_name(optarg);
if (which_label == NULL)
{
fprintf(stderr, "Mercury runtime: "
"label name `%s' unknown\n",
optarg);
exit(1);
}
program_entry_point = which_label->e_addr;
break;
}
case 'x':
#ifdef CONSERVATIVE_GC
GC_dont_gc = 1;
#endif
break;
case 'z':
if (sscanf(optarg+1, "%lu", &size) != 1)
usage();
if (optarg[0] == 'h')
heap_zone_size = size;
else if (optarg[0] == 'd')
detstack_zone_size = size;
else if (optarg[0] == 'n')
nondstack_zone_size = size;
#ifdef MR_USE_TRAIL
else if (optarg[0] == 't')
trail_zone_size = size;
#endif
else
usage();
break;
case '1':
if (sscanf(optarg, "%d", &r1val) != 1)
usage();
break;
case '2':
if (sscanf(optarg, "%d", &r2val) != 1)
usage();
break;
case '3':
if (sscanf(optarg, "%d", &r3val) != 1)
usage();
break;
default:
usage();
} /* end switch */
} /* end while */
} /* end process_options() */
static void
usage(void)
{
printf("Mercury runtime usage:\n"
"MERCURY_OPTIONS=\"[-hclt] [-d[abcdghs]] [-[sz][hdn]#]\n"
" [-p#] [-r#] [-1#] [-2#] [-3#] [-w name]\"\n"
"-h \t\tprint this usage message\n"
"-c \t\tcheck cross-function stack usage\n"
"-l \t\tprint all labels\n"
"-L \t\tcheck for duplicate labels\n"
"-t \t\tuse own timer\n"
"-x \t\tdisable garbage collection\n"
"-dg \t\tdebug gotos\n"
"-dc \t\tdebug calls\n"
"-db \t\tdebug backtracking\n"
"-dh \t\tdebug heap\n"
"-ds \t\tdebug detstack\n"
"-df \t\tdebug final success/failure\n"
"-da \t\tdebug all\n"
"-dm \t\tdebug memory allocation\n"
"-dG \t\tdebug garbage collection\n"
"-dd \t\tdetailed debug\n"
"-sh<n> \t\tallocate n kb for the heap\n"
"-sd<n> \t\tallocate n kb for the det stack\n"
"-sn<n> \t\tallocate n kb for the nondet stack\n"
#ifdef MR_USE_TRAIL
"-st<n> \t\tallocate n kb for the trail\n"
#endif
"-sl<n> \t\tallocate n kb for the label table\n"
"-zh<n> \t\tallocate n kb for the heap redzone\n"
"-zd<n> \t\tallocate n kb for the det stack redzone\n"
"-zn<n> \t\tallocate n kb for the nondet stack redzone\n"
#ifdef MR_USE_TRAIL
"-zt<n> \t\tallocate n kb for the trail redzone\n"
#endif
"-P<n> \t\tnumber of processes to use for parallel execution\n"
"\t\tapplies only if Mercury is configured with --enable-parallel\n"
"-p<n> \t\tprimary cache size in kbytes\n"
"-r<n> \t\trepeat n times\n"
"-w<name> \tcall predicate with given name (default: main/2)\n"
"-1<x> \t\tinitialize register r1 with value x\n"
"-2<x> \t\tinitialize register r2 with value x\n"
"-3<x> \t\tinitialize register r3 with value x\n");
fflush(stdout);
exit(1);
} /* end usage() */
/*---------------------------------------------------------------------------*/
void
mercury_runtime_main(void)
{
#if NUM_REAL_REGS > 0
Word c_regs[NUM_REAL_REGS];
#endif
#if !defined(SPEED) && defined(USE_GCC_NONLOCAL_GOTOS)
unsigned char safety_buffer[SAFETY_BUFFER_SIZE];
#endif
static int repcounter;
/*
** Save the C callee-save registers
** and restore the Mercury registers
*/
save_regs_to_mem(c_regs);
restore_registers();
#if !defined(SPEED) && defined(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
*/
global_pointer_2 = safety_buffer; /* defeat optimization */
memset(safety_buffer, MAGIC_MARKER_2, SAFETY_BUFFER_SIZE);
#endif
#ifndef SPEED
#ifndef CONSERVATIVE_GC
heap_zone->max = heap_zone->min;
#endif
detstack_zone->max = detstack_zone->min;
nondetstack_zone->max = nondetstack_zone->min;
#endif
time_at_start = MR_get_user_cpu_miliseconds();
time_at_last_stat = time_at_start;
for (repcounter = 0; repcounter < repeats; repcounter++) {
debugmsg0("About to call engine\n");
call_engine(ENTRY(do_interpreter));
debugmsg0("Returning from call_engine()\n");
}
if (use_own_timer) {
time_at_finish = MR_get_user_cpu_miliseconds();
}
#if defined(USE_GCC_NONLOCAL_GOTOS) && !defined(SPEED)
{
int i;
for (i = 0; i < SAFETY_BUFFER_SIZE; i++)
MR_assert(safety_buffer[i] == MAGIC_MARKER_2);
}
#endif
if (detaildebug) {
debugregs("after final call");
}
#ifndef SPEED
if (memdebug) {
printf("\n");
#ifndef CONSERVATIVE_GC
printf("max heap used: %6ld words\n",
(long) (heap_zone->max - heap_zone->min));
#endif
printf("max detstack used: %6ld words\n",
(long)(detstack_zone->max - detstack_zone->min));
printf("max nondstack used: %6ld words\n",
(long) (nondetstack_zone->max - nondetstack_zone->min));
}
#endif
#ifdef MEASURE_REGISTER_USAGE
printf("\n");
print_register_usage_counts();
#endif
if (use_own_timer) {
printf("%8.3fu ",
((double) (time_at_finish - time_at_start)) / 1000);
}
/*
** 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.
*/
save_registers();
restore_regs_from_mem(c_regs);
} /* end mercury_runtime_main() */
#ifdef MEASURE_REGISTER_USAGE
static void
print_register_usage_counts(void)
{
int i;
printf("register usage counts:\n");
for (i = 0; i < MAX_RN; i++) {
if (1 <= i && i <= ORD_RN) {
printf("r%d", i);
} else {
switch (i) {
case SI_RN:
printf("succip");
break;
case HP_RN:
printf("hp");
break;
case SP_RN:
printf("sp");
break;
case CF_RN:
printf("curfr");
break;
case MF_RN:
printf("maxfr");
break;
case MR_TRAIL_PTR_RN:
printf("MR_trail_ptr");
break;
case MR_TICKET_COUNTER_RN:
printf("MR_ticket_counter");
break;
default:
printf("UNKNOWN%d", i);
break;
}
}
printf("\t%lu\n", num_uses[i]);
} /* end for */
} /* end print_register_usage_counts() */
#endif
Define_extern_entry(do_interpreter);
Declare_label(global_success);
Declare_label(global_fail);
Declare_label(all_done);
MR_MAKE_STACK_LAYOUT_ENTRY(do_interpreter);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(global_success, do_interpreter);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(global_fail, do_interpreter);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(all_done, do_interpreter);
BEGIN_MODULE(interpreter_module)
init_entry(do_interpreter);
init_label(global_success);
init_label(global_fail);
init_label(all_done);
BEGIN_CODE
Define_entry(do_interpreter);
push(hp);
push(succip);
push(maxfr);
mkframe("interpreter", 1, LABEL(global_fail));
if (program_entry_point == NULL) {
fatal_error("no program entry point supplied");
}
#ifdef PROFILE_TIME
prof_init_time_profile();
#endif
noprof_call(program_entry_point, LABEL(global_success));
Define_label(global_success);
#ifndef SPEED
if (finaldebug) {
save_transient_registers();
printregs("global succeeded");
if (detaildebug)
dumpnondstack();
}
#endif
if (benchmark_all_solns)
redo();
else
GOTO_LABEL(all_done);
Define_label(global_fail);
#ifndef SPEED
if (finaldebug) {
save_transient_registers();
printregs("global failed");
if (detaildebug)
dumpnondstack();
}
#endif
Define_label(all_done);
#ifdef PROFILE_TIME
prof_turn_off_time_profiling();
prof_output_addr_table();
#endif
#ifdef PROFILE_CALLS
prof_output_addr_pair_table();
#endif
maxfr = (Word *) pop();
succip = (Code *) pop();
hp = (Word *) pop();
#ifndef SPEED
if (finaldebug && detaildebug) {
save_transient_registers();
printregs("after popping...");
}
#endif
proceed();
#ifndef USE_GCC_NONLOCAL_GOTOS
return 0;
#endif
END_MODULE
/*---------------------------------------------------------------------------*/
int
mercury_runtime_terminate(void)
{
#if NUM_REAL_REGS > 0
Word c_regs[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.
*/
save_regs_to_mem(c_regs);
(*MR_library_finalizer)();
terminate_engine();
/*
** Restore the callee-save registers before returning,
** since they may be used by the C code that called us.
*/
restore_regs_from_mem(c_regs);
return mercury_exit_status;
}
/*---------------------------------------------------------------------------*/
void mercury_sys_init_wrapper(void); /* suppress gcc warning */
void mercury_sys_init_wrapper(void) {
interpreter_module();
}
--
Tyson Dowd # To fix this, edit BLAH\BlahKey\Blah\Whatever
# in the registry.
trd at cs.mu.oz.au # *WARNING* Editing the registry can DESTROY
http://www.cs.mu.oz.au/~trd # your machine forever. Do not do it.
More information about the developers
mailing list