diff: Accurate GC.
Tyson Dowd
trd at cs.mu.OZ.AU
Thu Jul 16 02:25:10 AEST 1998
Zoltan was interested in viewing another diff of this change.
Since last time I've cleaned up, and incorporated Zoltan's
addition of the entry label table.
===================================================================
Estimated hours taken: 90
An initial implementation of the accurate garbage collector.
library/builtin.m:
library/mercury_builtin.m:
library/std_util.m:
runtime/mercury_tabling.h:
Deep copy terms using the address of the value instead of
just the value.
library/io.m:
Initialize the garbage collector's rootset with the globals.
runtime/Mmakefile:
Add new files to the Mmakefile.
runtime/mercury_accurate_gc.h:
runtime/mercury_accurate_gc.c:
The new garbage collector.
runtime/mercury_agc_debug.c:
runtime/mercury_agc_debug.h:
Debugging utilities for the new garbage collector.
runtime/mercury_deep_copy.c:
runtime/mercury_deep_copy.h:
runtime/mercury_deep_copy_body.h:
Put the deep copy code in mercury_deep_copy_body.h, and #include
it with appropriate #defines in order to get a variant for
deep_copy(), and one for agc_deep_copy().
agc_deep_copy() forwards pointers as it copies.
Also, deep_copy (all variants) have been modified to take
a pointer to the data to be copied, because some variants
need to be able to modify it.
runtime/mercury_engine.c:
runtime/mercury_engine.h:
Add a second heap_zone which is the to-space of
the copying collector.
Add a debug_heap_zone, which is used as a scratch
heap for debugging.
runtime/mercury_label.c:
Instead of
realloc(entry_table, ....)
do
entry_table = realloc(entry_table, ....)
to avoid horrible bugs.
Also, make sure the tables get initialized before looking up
an entry label.
runtime/mercury_imp.h:
Include mercury_debug.h before most of the modules.
(mercury_engine.h adds a new MemoryZone only if we are
debugging accurate GC).
runtime/mercury_memory.c:
Setup the debug_memory_zone sizes.
Remove an unnecessary prototype.
runtime/mercury_memory_handlers.c:
Add code to get the program counter and the stack pointer
from the signal context.
Call MR_schedule_agc() from default_handler() if doing accurate gc.
runtime/mercury_memory_zones.c:
Setup the hardzone regardless of whether redzones are used.
Add some more debugging information.
runtime/mercury_regorder.h:
runtime/machdeps/alpha_regs.h:
runtime/machdeps/i386_regs.h:
Add definitions to make the real machine registers name/number
for MR_sp available.
runtime/mercury_trace_internal.c:
runtime/mercury_trace_util.c:
runtime/mercury_trace_util.h:
Add MR_trace_write_variable(), which writes terms given their
value and type_info.
runtime/mercury_wrapper.c:
runtime/mercury_wrapper.h:
Change the size of the heap redzone when doing accurate GC.
Use a small heap when debugging agc.
runtime/mercury_debug.h:
runtime/mercury_conf_param.h:
Add new debugging macros and document them.
runtime/mercury_type_info.c:
Add const to the pointer arguments of MR_make_type_info.
Index: WORK_IN_PROGRESS
===================================================================
RCS file: /home/staff/zs/imp/mercury/WORK_IN_PROGRESS,v
retrieving revision 1.8
diff -u -r1.8 WORK_IN_PROGRESS
--- WORK_IN_PROGRESS 1998/07/13 16:31:23 1.8
+++ WORK_IN_PROGRESS 1998/07/15 15:34:30
@@ -28,6 +28,11 @@
* We now allow programmers to give names to the arguments of constructor
function symbols. (Disabled, due to lack of a suitable operator.)
+* There is a new garbage collector that does accurate garbage
+ collection (.agc grade). It is currently limited to deterministic
+ code, and needs a great deal of tuning and optimization. It also
+ needs testing.
+
We also have some code that goes at least some part of the way towards
implementing the features below. However, for these features, the
code has not yet been committed and thus is not part of the standard
Index: library/builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/builtin.m,v
retrieving revision 1.2
diff -u -r1.2 builtin.m
--- builtin.m 1998/07/01 10:11:32 1.2
+++ builtin.m 1998/07/15 09:39:49
@@ -490,12 +490,12 @@
aliasing, and in particular the lack of support for `ui' modes.
:- pragma c_code(copy(Value::ui, Copy::uo), "
save_transient_registers();
- Copy = deep_copy(Value, TypeInfo_for_T, NULL, NULL);
+ Copy = deep_copy(&Value, TypeInfo_for_T, NULL, NULL);
restore_transient_registers();
").
:- pragma c_code(copy(Value::in, Copy::uo), "
save_transient_registers();
- Copy = deep_copy(Value, TypeInfo_for_T, NULL, NULL);
+ Copy = deep_copy(&Value, TypeInfo_for_T, NULL, NULL);
restore_transient_registers();
").
*************/
@@ -531,7 +531,7 @@
value = r2;
save_transient_registers();
- copy = deep_copy(value, (Word *) type_info, NULL, NULL);
+ copy = deep_copy(&value, (Word *) type_info, NULL, NULL);
restore_transient_registers();
#ifdef COMPACT_ARGS
Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.158
diff -u -r1.158 io.m
--- io.m 1998/06/27 08:42:25 1.158
+++ io.m 1998/07/03 04:45:04
@@ -2242,7 +2242,7 @@
:- pragma export(io__init_state(di, uo), "ML_io_init_state").
io__init_state -->
- io__gc_init,
+ io__gc_init(type_of(StreamNames), type_of(Globals)),
{ map__init(StreamNames) },
{ ops__init_op_table(OpTable) },
{ type_to_univ("<globals>", Globals) },
@@ -2264,14 +2264,17 @@
% we don't bother.)
[].
-:- pred io__gc_init(io__state, io__state).
-:- mode io__gc_init(di, uo) is det.
+:- pred io__gc_init(type_info, type_info, io__state, io__state).
+:- mode io__gc_init(in, in, di, uo) is det.
-:- pragma c_code(io__gc_init(IO0::di, IO::uo), "
+:- pragma c_code(io__gc_init(StreamNamesType::in, UserGlobalsType::in,
+ IO0::di, IO::uo), "
/* for Windows DLLs, we need to call GC_INIT() from each DLL */
#ifdef CONSERVATIVE_GC
GC_INIT();
#endif
+ MR_add_root(&ML_io_stream_names, (Word *) StreamNamesType);
+ MR_add_root(&ML_io_user_globals, (Word *) UserGlobalsType);
update_io(IO0, IO);
").
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/mercury_builtin.m,v
retrieving revision 1.98
diff -u -r1.98 mercury_builtin.m
--- mercury_builtin.m 1998/05/25 21:47:41 1.98
+++ mercury_builtin.m 1998/06/26 05:13:20
@@ -755,12 +755,12 @@
aliasing, and in particular the lack of support for `ui' modes.
:- pragma c_code(copy(Value::ui, Copy::uo), "
save_transient_registers();
- Copy = deep_copy(Value, TypeInfo_for_T, NULL, NULL);
+ Copy = deep_copy(&Value, TypeInfo_for_T, NULL, NULL);
restore_transient_registers();
").
:- pragma c_code(copy(Value::in, Copy::uo), "
save_transient_registers();
- Copy = deep_copy(Value, TypeInfo_for_T, NULL, NULL);
+ Copy = deep_copy(&Value, TypeInfo_for_T, NULL, NULL);
restore_transient_registers();
").
*************/
@@ -796,7 +796,7 @@
value = r2;
save_transient_registers();
- copy = deep_copy(value, (Word *) type_info, NULL, NULL);
+ copy = deep_copy(&value, (Word *) type_info, NULL, NULL);
restore_transient_registers();
#ifdef COMPACT_ARGS
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.123
diff -u -r1.123 std_util.m
--- std_util.m 1998/06/11 13:31:56 1.123
+++ std_util.m 1998/06/24 02:20:32
@@ -676,9 +676,10 @@
update_prof_current_proc(
LABEL(mercury__std_util__builtin_aggregate_4_0));
{
- Word copied_solution;
+ Word copied_solution, solution;
/* we found a solution (in r1) */
+ solution = r1;
#ifdef MR_USE_TRAIL
/* check for outstanding delayed goals (``floundering'') */
@@ -694,7 +695,7 @@
** is transient, before/after calling deep_copy().
*/
save_transient_registers();
- copied_solution = deep_copy(r1, (Word *) element_type_info_fv,
+ copied_solution = deep_copy(&solution, (Word *) element_type_info_fv,
(Word *) saved_hp_fv,
MR_ENGINE(solutions_heap_zone)->top);
restore_transient_registers();
@@ -749,7 +750,7 @@
** is transient, before/after calling deep_copy().
**/
save_transient_registers();
- copied_collection = deep_copy(sofar_fv,
+ copied_collection = deep_copy(&sofar_fv,
(Word *) collection_type_info_fv,
(Word *) saved_solhp_fv,
MR_ENGINE(solutions_heap_zone)->top);
Index: runtime/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/Mmakefile,v
retrieving revision 1.32
diff -u -r1.32 Mmakefile
--- Mmakefile 1998/07/07 19:57:36 1.32
+++ Mmakefile 1998/07/09 07:09:20
@@ -24,12 +24,14 @@
# keep this list in alphabetical order, please
HDRS = \
mercury_accurate_gc.h \
+ mercury_agc_debug.h \
mercury_calls.h \
mercury_conf.h \
mercury_conf_param.h \
mercury_context.h \
mercury_debug.h \
mercury_deep_copy.h \
+ mercury_deep_copy_body.h \
mercury_dummy.h \
mercury_dlist.h \
mercury_engine.h \
@@ -92,7 +94,10 @@
# keep this list in alphabetical order, please
-CFILES = mercury_context.c \
+CFILES = \
+ mercury_accurate_gc.c \
+ mercury_agc_debug.c \
+ mercury_context.c \
mercury_deep_copy.c \
mercury_dlist.c \
mercury_dummy.c \
Index: runtime/mercury_accurate_gc.c
===================================================================
RCS file: mercury_accurate_gc.c
diff -N mercury_accurate_gc.c
--- /dev/null Wed May 28 10:49:58 1997
+++ mercury_accurate_gc.c Mon Jul 13 16:44:28 1998
@@ -0,0 +1,495 @@
+/*
+** Copyright (C) 1998 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.
+*/
+
+/*
+** This module contains the accurate garbage collector.
+*/
+
+#include "mercury_imp.h"
+
+#ifdef NATIVE_GC
+
+#include "mercury_trace_util.h"
+#include "mercury_deep_copy.h"
+#include "mercury_agc_debug.h"
+
+/*
+** Function prototypes.
+*/
+static void garbage_collect(Code *saved_success, Word *stack_pointer,
+ Word *current_frame);
+static void garbage_collect_roots(void);
+static void copy_value(MR_Live_Lval locn, Word *type_info, bool copy_regs,
+ Word *stack_pointer, Word *current_frame);
+
+/*
+** Global variables (only used in this module, however).
+*/
+static Code *saved_success = (Code *) NULL;
+static Word *saved_success_location = (Word *) NULL;
+static bool gc_scheduled = FALSE;
+static bool gc_running = FALSE;
+
+/* The list of roots */
+static MR_RootList root_list = NULL;
+
+/* The last root on the list */
+static MR_RootList last_root = NULL;
+
+
+Define_extern_entry(mercury__garbage_collect_0_0);
+
+
+/*
+** MR_schedule_agc:
+** Schedule garbage collection.
+**
+** We do this by replacing the succip that is saved in
+** the current procedure's stack frame with the address
+** of the garbage collector. When the current procedure
+** returns, it will call the garbage collectior.
+**
+** (We go to this trouble because then the stacks will
+** be in a known state -- each stack frame is described
+** by information associated with the continuation label
+** that the code will return to).
+*/
+void
+MR_schedule_agc(Code *pc_at_signal, Word *sp_at_signal)
+{
+ MR_Stack_Layout_Label *layout;
+ const MR_Stack_Layout_Entry *entry_layout;
+ MR_Lval_Type type;
+ MR_Live_Lval location;
+ const char *reason;
+ MR_Entry *entry_label = NULL;
+ int determinism, number;
+
+ if (gc_running) {
+ /*
+ ** This is bad news, but it can happen if you don't
+ ** collect any garbage. We should try to avoid it by
+ ** resizing the heaps so they don't become too full.
+ **
+ ** It might also be worthwhile eventually turning off
+ ** the redzone in the destination heap (but only when
+ ** the large problem of handling collections with little
+ ** garbage has been solved).
+ */
+
+ fprintf(stderr, "Garbage collection scheduled while "
+ "collector is already running\n");
+ fprintf(stderr, "Trying to continue...\n");
+ return;
+ }
+
+#ifdef MR_DEBUG_AGC_SCHEDULING
+ fprintf(stderr, "PC at signal: %ld (%lx)\n",
+ (long) pc_at_signal, (long) pc_at_signal);
+ fprintf(stderr, "SP at signal: %ld (%lx)\n",
+ (long) sp_at_signal, (long) sp_at_signal);
+ fflush(NULL);
+#endif
+
+ /* Search for the entry label */
+
+#if 0
+ label = lookup_label_addr(pc_at_signal);
+ while (label == NULL || label->e_layout == NULL) {
+ /*
+ ** Linear search through the label table (should be
+ ** replaced with a binary search through a different
+ ** table).
+ */
+ pc_at_signal = (Code *) ((Word) pc_at_signal - 1);
+ label = lookup_label_addr(pc_at_signal);
+ }
+#endif
+ entry_label = MR_prev_entry_by_addr(pc_at_signal);
+ entry_layout = entry_label->e_layout;
+
+#if 0
+ if (label->e_entry == FALSE) {
+ entry_layout = layout->MR_sll_entry;
+ } else {
+ entry_layout = (MR_Stack_Layout_Entry *) layout;
+ }
+#endif
+
+ determinism = entry_layout->MR_sle_detism;
+
+ if (determinism < 0) {
+ /*
+ ** This means we have reached some handwritten code that has
+ ** no further information about the stack frame.
+ */
+ fprintf(stderr, "LABEL NAME: %s has no stack layout info\n",
+ entry_label->e_name);
+ fprintf(stderr, "Trying to continue...\n");
+ return;
+ }
+
+#ifdef MR_DEBUG_AGC_SCHEDULING
+ fprintf(stderr, "scheduling called at: %s (%ld %lx)\n",
+ entry_label->e_name, (long) entry_label->e_addr,
+ (long) entry_label->e_addr);
+ fflush(NULL);
+#endif
+
+ /*
+ ** If we have already scheduled a garbage collection, undo the
+ ** last change, and do a new one.
+ */
+ if (gc_scheduled) {
+#ifdef MR_DEBUG_AGC_SCHEDULING
+ fprintf(stderr, "GC scheduled again. Replacing old scheduling,"
+ " and trying to schedule again.\n");
+#endif
+ *saved_success_location = (Word) saved_success;
+ }
+ gc_scheduled = TRUE;
+
+ if (MR_DETISM_DET_STACK(determinism)) {
+ location = entry_layout->MR_sle_succip_locn;
+ type = MR_LIVE_LVAL_TYPE(location);
+ number = MR_LIVE_LVAL_NUMBER(location);
+
+ if (type != MR_LVAL_TYPE_STACKVAR) {
+ fatal_error("can only handle stackvars");
+ }
+
+ /*
+ ** Save the old succip and its location.
+ */
+ saved_success_location = &based_detstackvar(sp_at_signal,
+ number);
+ saved_success = (Code *) *saved_success_location;
+
+#ifdef MR_DEBUG_AGC_SCHEDULING
+ fprintf(stderr, "old succip: %ld (%lx) new: %ld (%lx)",
+ (long) saved_success,
+ (long) saved_success,
+ (long) ENTRY(mercury__garbage_collect_0_0),
+ (long) ENTRY(mercury__garbage_collect_0_0));
+#endif
+
+ /*
+ ** Replace the old succip with the address of the
+ ** garbage collector.
+ */
+ *saved_success_location = (Word) mercury__garbage_collect_0_0;
+
+ } else {
+ /*
+ ** XXX we don't support nondet stack frames yet.
+ */
+ fatal_error("cannot schedule in nondet stack frame");
+ }
+
+
+#ifdef MR_DEBUG_AGC_SCHEDULING
+ fprintf(stderr, "Accurate GC scheduled.\n");
+#endif
+}
+
+BEGIN_MODULE(native_gc)
+BEGIN_CODE
+
+/*
+** Our garbage collection entry label.
+**
+** It saves the registers -- we use the saved registers
+** for garbage collection and leave the real ones alone.
+*/
+Define_entry(mercury__garbage_collect_0_0);
+
+ /* record that the collector is running */
+ gc_running = TRUE;
+
+ save_registers();
+ garbage_collect(saved_success, MR_sp, MR_curfr);
+ restore_registers();
+ gc_scheduled = FALSE;
+ gc_running = FALSE;
+
+ MR_succip = saved_success;
+ proceed();
+ fatal_error("Unreachable code reached");
+
+END_MODULE
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** garbage_collect:
+**
+** The main garbage collection routine.
+**
+** (We use 4 space tabs here because of the depth of indentation).
+*/
+void
+garbage_collect(Code *success_ip, Word *stack_pointer, Word *current_frame)
+{
+ MR_Internal *label, *first_label;
+ int i, var_count, count;
+ MR_Determinism determinism;
+ const MR_Stack_Layout_Label *internal_layout;
+ const MR_Stack_Layout_Vars *vars;
+ MemoryZone *old_heap, *new_heap;
+ Word *type_params;
+ bool succeeded;
+ bool top_frame = TRUE;
+ MR_MemoryList allocated_memory_cells = NULL;
+ Word *old_hp;
+ MR_Stack_Layout_Entry *entry_layout;
+ Word *first_stack_pointer, *first_current_frame;
+
+
+ old_heap = MR_ENGINE(heap_zone);
+ new_heap = MR_ENGINE(heap_zone2);
+
+#ifdef MR_DEBUG_AGC_COLLECTION
+ fprintf(stderr, "\ngarbage_collect() called.\n");
+
+ fprintf(stderr, "old_heap->min: %lx \t old_heap->hardmax: %lx\n",
+ (long) old_heap->min, (long) old_heap->hardmax);
+ fprintf(stderr, "new_heap->min: %lx \t new_heap->hardmax: %lx\n",
+ (long) new_heap->min, (long) new_heap->hardmax);
+
+ fprintf(stderr, "MR_virtual_hp: %lx\n", (long) MR_virtual_hp);
+#endif
+
+ old_hp = MR_virtual_hp;
+
+ /*
+ ** The new heap pointer starts at the bottom of the new heap.
+ */
+ MR_virtual_hp = new_heap->min;
+
+ /*
+ ** Swap the two heaps.
+ */
+ {
+ MemoryZone *tmp;
+
+ tmp = MR_ENGINE(heap_zone2);
+ MR_ENGINE(heap_zone2) = MR_ENGINE(heap_zone);
+ MR_ENGINE(heap_zone) = tmp;
+ }
+
+#ifdef MR_DEBUG_AGC_COLLECTION
+ fprintf(stderr, "Swapped heaps\n");
+ fprintf(stderr, "MR_virtual_hp: %lx\n", (long) MR_virtual_hp);
+#endif
+
+ label = MR_lookup_internal_by_addr(success_ip);
+ internal_layout = label->i_layout;
+ entry_layout = internal_layout->MR_sll_entry;
+
+#ifdef MR_DEBUG_AGC_COLLECTION
+ first_label = label;
+ first_stack_pointer = stack_pointer;
+ first_current_frame = current_frame;
+ fprintf(stderr, "BEFORE:\n");
+ MR_agc_dump_stack_frames(first_label, old_heap, first_stack_pointer,
+ first_current_frame);
+ MR_agc_dump_roots(root_list);
+#endif
+
+ /*
+ ** For each stack frame ...
+ */
+ do {
+ MR_Stack_Walk_Step_Result result;
+ const char *problem;
+ const MR_Stack_Layout_Label *return_label_layout;
+
+ var_count = internal_layout->MR_sll_var_count;
+ vars = &(internal_layout->MR_sll_var_info);
+
+ /* Get the type parameters from the stack frame. */
+
+ type_params = MR_trace_materialize_typeinfos_base(vars,
+ top_frame, stack_pointer, current_frame);
+
+ /* Copy each live variable */
+
+ for (i = 0; i < var_count; i++) {
+ MR_Stack_Layout_Var sl_var;
+ MR_Live_Type sl_type;
+ Word *pseudo_type_info, *type_info;
+
+ sl_var = vars->MR_slvs_pairs[i];
+ if (MR_LIVE_TYPE_IS_VAR(sl_var.MR_slv_live_type)) {
+ pseudo_type_info = MR_LIVE_TYPE_GET_VAR_TYPE(
+ sl_var.MR_slv_live_type);
+ type_info = MR_make_type_info(type_params, pseudo_type_info,
+ &allocated_memory_cells);
+ copy_value(sl_var.MR_slv_locn, type_info, top_frame,
+ stack_pointer, current_frame);
+ MR_deallocate(allocated_memory_cells);
+ allocated_memory_cells = NULL;
+ }
+ }
+
+ free(type_params);
+
+ result = MR_stack_walk_step(entry_layout, &return_label_layout,
+ (Word **) &stack_pointer, ¤t_frame, &problem);
+
+ if (result == STEP_ERROR_BEFORE || result == STEP_ERROR_AFTER) {
+ fatal_error(problem);
+ }
+
+ if (return_label_layout == NULL) {
+ break;
+ }
+ entry_layout = return_label_layout->MR_sll_entry;
+ internal_layout = return_label_layout;
+ top_frame = FALSE;
+ } while (TRUE); /* end for each stack frame... */
+
+ /*
+ ** Copy any roots that are not on the stack.
+ */
+ garbage_collect_roots();
+
+#ifdef MR_DEBUG_AGC_COLLECTION
+ fprintf(stderr, "AFTER:\n");
+
+ MR_agc_dump_stack_frames(first_label, new_heap, first_stack_pointer,
+ first_current_frame);
+ MR_agc_dump_roots(root_list);
+
+ fprintf(stderr, "old heap: %ld bytes, new heap: %ld bytes\n",
+ (long) ((char *) old_hp - (char *) old_heap->min),
+ (long) ((char *) MR_virtual_hp - (char *) new_heap->min));
+ fprintf(stderr, "%ld bytes recovered\n",
+ (long) ((char *) old_hp - (char *) old_heap->min) -
+ ((char *) MR_virtual_hp - (char *) new_heap->min));
+#endif
+
+ /* Reset the redzone on the old heap */
+ reset_redzone(old_heap);
+
+#ifdef MR_DEBUG_AGC_COLLECTION
+ fprintf(stderr, "garbage_collect() done.\n\n");
+#endif
+
+}
+
+/*
+** copy_value:
+** Copies a value in a register or stack frame,
+** replacing the original with the new copy.
+**
+** The copying is done using agc_deep_copy, which is
+** the accurate GC verison of deep_copy (it leaves
+** forwarding pointers in the old copy of the data, if
+** it is on the old heap).
+*/
+void
+copy_value(MR_Live_Lval locn, Word *type_info, bool copy_regs,
+ Word *stack_pointer, Word *current_frame)
+{
+ int locn_num;
+
+ locn_num = (int) MR_LIVE_LVAL_NUMBER(locn);
+ switch (MR_LIVE_LVAL_TYPE(locn)) {
+ case MR_LVAL_TYPE_R:
+ if (copy_regs) {
+ virtual_reg(locn_num) = agc_deep_copy(
+ &virtual_reg(locn_num), type_info,
+ MR_ENGINE(heap_zone2->min),
+ MR_ENGINE(heap_zone2->hardmax));
+ }
+ break;
+
+ case MR_LVAL_TYPE_F:
+ break;
+
+ case MR_LVAL_TYPE_STACKVAR:
+ based_detstackvar(stack_pointer, locn_num) =
+ agc_deep_copy(&based_detstackvar(
+ stack_pointer,locn_num),
+ type_info, MR_ENGINE(heap_zone2->min),
+ MR_ENGINE(heap_zone2->hardmax));
+ break;
+
+ case MR_LVAL_TYPE_FRAMEVAR:
+ bt_var(current_frame, locn_num) = agc_deep_copy(
+ &bt_var(current_frame, locn_num), type_info,
+ MR_ENGINE(heap_zone2->min),
+ MR_ENGINE(heap_zone2->hardmax));
+ break;
+
+ case MR_LVAL_TYPE_SUCCIP:
+ break;
+
+ case MR_LVAL_TYPE_MAXFR:
+ break;
+
+ case MR_LVAL_TYPE_CURFR:
+ break;
+
+ case MR_LVAL_TYPE_HP:
+ break;
+
+ case MR_LVAL_TYPE_SP:
+ break;
+
+ case MR_LVAL_TYPE_UNKNOWN:
+ break;
+
+ default:
+ break;
+ }
+}
+
+/*
+** garbage_collect_roots:
+**
+** Copies the extra roots. The roots are overwritten
+** with the new data.
+*/
+void
+garbage_collect_roots(void)
+{
+ MR_RootList current = root_list;
+
+ while (current != NULL) {
+ *current->root = agc_deep_copy(current->root,
+ current->type_info, MR_ENGINE(heap_zone2->min),
+ MR_ENGINE(heap_zone2->hardmax));
+ current = current->next;
+ }
+
+}
+
+/*
+** MR_agc_add_root_internal:
+**
+** Adds a new root to the extra roots.
+*/
+void
+MR_agc_add_root(Word *root_addr, Word *type_info)
+{
+ MR_RootList node;
+
+ node = checked_malloc(sizeof(*node));
+ node->root = root_addr;
+ node->type_info = type_info;
+
+ if (root_list == NULL) {
+ root_list = node;
+ last_root = node;
+ } else {
+ last_root->next = node;
+ last_root = node;
+ }
+}
+
+#endif /* NATIVE_GC */
Index: runtime/mercury_accurate_gc.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_accurate_gc.h,v
retrieving revision 1.7
diff -u -r1.7 mercury_accurate_gc.h
--- mercury_accurate_gc.h 1998/03/11 05:58:23 1.7
+++ mercury_accurate_gc.h 1998/07/03 04:52:26
@@ -15,5 +15,41 @@
/*---------------------------------------------------------------------------*/
+/*
+** MR_schedule_agc:
+** Schedule a garbage collection as soon as possible. The PC
+** (program counter) is used to find the procedure that is
+** executing. The stack pointer is then used to replace the saved
+** continuation pointer with the address of the garbage collector
+** routine.
+*/
+extern void MR_schedule_agc(Code *pc_at_signal, Word *sp_at_signal);
+
+/*
+** Roots apart from the stacks are stored in this data structure.
+**
+** Essentially, this is a list of any pointers into the heap that are
+** not stored on the heap or the det/nondet stacks.
+**
+** Each node stores the address of the root, and its type. When a
+** garbage collection occurs, the root will be modified.
+*/
+
+struct MR_RootNode {
+ Word *root;
+ Word *type_info;
+ struct MR_RootNode* next;
+};
+
+typedef struct MR_RootNode *MR_RootList;
+
+/*
+** MR_agc_add_root:
+** Adds the root whose address is supplied in root_addr with type
+** described by type_info to the list of additional roots.
+*/
+
+extern void MR_agc_add_root(Word *root_addr, Word *type_info);
+
/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_ACCURATE_GC_H */
Index: runtime/mercury_agc_debug.c
===================================================================
RCS file: mercury_agc_debug.c
diff -N mercury_agc_debug.c
--- /dev/null Wed May 28 10:49:58 1997
+++ mercury_agc_debug.c Mon Jul 13 15:26:02 1998
@@ -0,0 +1,243 @@
+/*
+** Copyright (C) 1998 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.
+*/
+
+/*
+** Debugging support for the accurate garbage collector.
+*/
+
+#include "mercury_imp.h"
+#include "mercury_trace_util.h"
+#include "mercury_deep_copy.h"
+#include "mercury_agc_debug.h"
+
+/*
+** Function prototypes.
+*/
+static void dump_live_value(MR_Live_Lval locn, MemoryZone *heap_zone,
+ Word * stack_pointer, Word *current_frame,
+ bool do_regs);
+
+/*---------------------------------------------------------------------------*/
+
+
+void
+MR_agc_dump_roots(MR_RootList roots)
+{
+ fflush(NULL);
+ fprintf(stderr, "Dumping roots\n");
+
+ while (roots != NULL) {
+
+#ifdef MR_DEBUG_AGC_PRINT_VARS
+
+ /*
+ ** Restore the registers, because we need to save them
+ ** to a more permanent backing store (we are going to
+ ** call Mercury soon, and we don't want it messing with
+ ** the saved registers).
+ */
+ restore_registers();
+ MR_copy_regs_to_saved_regs(MAX_REAL_REG + NUM_SPECIAL_REG);
+
+ MR_hp = MR_ENGINE(debug_heap_zone->min);
+ MR_virtual_hp = MR_ENGINE(debug_heap_zone->min);
+
+ fflush(NULL);
+ MR_trace_write_variable((Word) roots->type_info, *roots->root);
+ fflush(NULL);
+ fprintf(stderr, "\n");
+
+ MR_copy_saved_regs_to_regs(MAX_REAL_REG + NUM_SPECIAL_REG);
+ save_registers();
+#endif
+ roots = roots->next;
+ }
+}
+
+void
+MR_agc_dump_stack_frames(MR_Internal *label, MemoryZone *heap_zone,
+ Word *stack_pointer, Word *current_frame)
+{
+ int i, var_count;
+ const MR_Stack_Layout_Vars *vars;
+ Word *type_params, type_info, value;
+ MR_Stack_Layout_Entry *entry_layout;
+ const MR_Stack_Layout_Label *layout;
+ Code *success_ip;
+ bool top_frame = TRUE;
+
+ layout = label->i_layout;
+ entry_layout = layout->MR_sll_entry;
+
+ /*
+ ** For each stack frame...
+ */
+
+ while (MR_DETISM_DET_STACK(entry_layout->MR_sle_detism)) {
+ fprintf(stderr, " label: %s\n", label->i_name);
+
+ if (success_ip == MR_stack_trace_bottom) {
+ break;
+ }
+
+ var_count = layout->MR_sll_var_count;
+ vars = &(layout->MR_sll_var_info);
+
+ type_params = MR_trace_materialize_typeinfos_base(vars,
+ top_frame, stack_pointer, current_frame);
+
+ for (i = 0; i < var_count; i++) {
+ MR_Stack_Layout_Var sl_var;
+ MR_Live_Type sl_type;
+
+
+ fprintf(stderr, "%-12s\t", vars->MR_slvs_names[i]);
+
+ sl_var = vars->MR_slvs_pairs[i];
+
+ dump_live_value(sl_var.MR_slv_locn, heap_zone,
+ stack_pointer, current_frame, top_frame);
+ fprintf(stderr, "\n");
+ fflush(NULL);
+
+#ifdef MR_DEBUG_AGC_PRINT_VARS
+ /*
+ ** Restore the registers, because we need to
+ ** save them to a more permanent backing store
+ ** (we are going to call Mercury soon, and we
+ ** don't want it messing with the saved
+ ** registers).
+ */
+ restore_registers();
+ MR_copy_regs_to_saved_regs(MAX_REAL_REG +
+ NUM_SPECIAL_REG);
+
+ MR_hp = MR_ENGINE(debug_heap_zone->min);
+ MR_virtual_hp = MR_ENGINE(debug_heap_zone->min);
+
+ if (MR_trace_get_type_and_value_base(&sl_var,
+ top_frame, stack_pointer,
+ current_frame, type_params,
+ &type_info, &value)) {
+ printf("\t");
+ MR_trace_write_variable(type_info, value);
+ printf("\n");
+ }
+
+ MR_copy_saved_regs_to_regs(MAX_REAL_REG +
+ NUM_SPECIAL_REG);
+ save_registers();
+#endif /* MR_DEBUG_AGC_PRINT_VARS */
+
+ fflush(NULL);
+
+ }
+ free(type_params);
+
+ /*
+ ** Move to the next stack frame.
+ */
+ {
+ MR_Live_Lval location;
+ MR_Lval_Type type;
+ int number;
+
+ location = entry_layout->MR_sle_succip_locn;
+ type = MR_LIVE_LVAL_TYPE(location);
+ number = MR_LIVE_LVAL_NUMBER(location);
+ if (type != MR_LVAL_TYPE_STACKVAR) {
+ fatal_error("can only handle stackvars");
+ }
+
+ success_ip = (Code *)
+ based_detstackvar(stack_pointer, number);
+ stack_pointer = stack_pointer -
+ entry_layout->MR_sle_stack_slots;
+ label = MR_lookup_internal_by_addr(success_ip);
+ }
+
+ top_frame = FALSE;
+
+ layout = label->i_layout;
+ entry_layout = layout->MR_sll_entry;
+ }
+}
+
+static void
+dump_live_value(MR_Live_Lval locn, MemoryZone *heap_zone, Word *stack_pointer,
+ Word *current_frame, bool do_regs)
+{
+ int locn_num;
+ Word value = 0;
+ int difference;
+ bool have_value = FALSE;
+
+ locn_num = (int) MR_LIVE_LVAL_NUMBER(locn);
+ switch (MR_LIVE_LVAL_TYPE(locn)) {
+ case MR_LVAL_TYPE_R:
+ if (do_regs) {
+ value = virtual_reg(locn_num);
+ have_value = TRUE;
+ fprintf(stderr, "r%d\t", locn_num);
+ }
+ break;
+
+ case MR_LVAL_TYPE_F:
+ fprintf(stderr, "f%d\t", locn_num);
+ break;
+
+ case MR_LVAL_TYPE_STACKVAR:
+ value = based_detstackvar(stack_pointer, locn_num);
+ have_value = TRUE;
+ fprintf(stderr, "stackvar%d", locn_num);
+ break;
+
+ case MR_LVAL_TYPE_FRAMEVAR:
+ value = bt_var(current_frame, locn_num);
+ have_value = TRUE;
+ fprintf(stderr, "framevar%d", locn_num);
+ break;
+
+ case MR_LVAL_TYPE_SUCCIP:
+ fprintf(stderr, "succip");
+ break;
+
+ case MR_LVAL_TYPE_MAXFR:
+ fprintf(stderr, "maxfr");
+ break;
+
+ case MR_LVAL_TYPE_CURFR:
+ fprintf(stderr, "curfr");
+ break;
+
+ case MR_LVAL_TYPE_HP:
+ fprintf(stderr, "hp");
+ break;
+
+ case MR_LVAL_TYPE_SP:
+ fprintf(stderr, "sp");
+ break;
+
+ case MR_LVAL_TYPE_UNKNOWN:
+ fprintf(stderr, "unknown");
+ break;
+
+ default:
+ fprintf(stderr, "DEFAULT");
+ break;
+ }
+ if (have_value) {
+ if (value >= (Word) heap_zone->min &&
+ value < (Word) heap_zone->hardmax) {
+ difference = (Word *) value - (Word *) heap_zone->min;
+ fprintf(stderr, "\thp[%d]\t(%lx)", difference,
+ (long) value);
+ } else {
+ fprintf(stderr, "\t \t(%lx)", (long) value);
+ }
+ }
+}
+
Index: runtime/mercury_agc_debug.h
===================================================================
RCS file: mercury_agc_debug.h
diff -N mercury_agc_debug.h
--- /dev/null Wed May 28 10:49:58 1997
+++ mercury_agc_debug.h Mon Jul 6 17:08:00 1998
@@ -0,0 +1,36 @@
+/*
+** Copyright (C) 1998 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.
+*/
+
+#ifndef MERCURY_AGC_DEBUG_H
+#define MERCURY_AGC_DEBUG_H
+
+/*
+** mercury_agc_debug.h -
+** Debugging support for accurate garbage collection.
+*/
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** MR_agc_dump_stack_frames:
+** Dump the stack, writing all information available about each
+** stack frame.
+**
+** label is the topmost label on the stack, heap_zone is the zone
+** which the data is stored upon.
+*/
+
+extern void MR_agc_dump_stack_frames(MR_Internal *label, MemoryZone
+ *heap_zone, Word * stack_pointer, Word *current_frame);
+
+/*
+** MR_agc_dump_roots:
+** Dump the extra rootset, writing all information about each root.
+*/
+extern void MR_agc_dump_roots(MR_RootList roots);
+
+/*---------------------------------------------------------------------------*/
+#endif /* not MERCURY_AGC_DEBUG_H */
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.7
diff -u -r1.7 mercury_conf_param.h
--- mercury_conf_param.h 1998/07/09 04:37:41 1.7
+++ mercury_conf_param.h 1998/07/13 06:00:12
@@ -133,6 +133,26 @@
** (Since this affects binary compatibility,
** this is a "compilation model" option which affects the grade.)
**
+** MR_DEBUG_AGC_SCHEDULING
+** Display debugging information while scheduling accurate garbage
+** collection.
+**
+** MR_DEBUG_AGC_COLLECTION
+** Display debugging information while collecting garbage using the
+** accurate garbage collector.
+**
+** MR_DEBUG_AGC_FORWARDING
+** Display debugging information when leaving or finding forwarding
+** pointers during accurate garbage collection.
+**
+** MR_DEBUG_AGC_PRINT_VARS
+** Display the values of live variables during accurate garbage
+** collection.
+**
+** MR_DEBUG_AGC
+** Turn on all debugging information for accurate garbage
+** collection. (Equivalent to all MR_DEBUG_AGC_* macros above).
+**
** MR_LABEL_STRUCTS_INCLUDE_NUMBER
** Include a label number in each label layout structure.
*/
Index: runtime/mercury_debug.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_debug.h,v
retrieving revision 1.4
diff -u -r1.4 mercury_debug.h
--- mercury_debug.h 1998/03/16 12:23:25 1.4
+++ mercury_debug.h 1998/06/30 05:39:44
@@ -31,6 +31,17 @@
#endif
+ /*
+ ** Define these variables to turn on more debugging information
+ ** for accurate garbage collection.
+ */
+#if MR_DEBUG_AGC
+ #define MR_DEBUG_AGC_SCHEDULING
+ #define MR_DEBUG_AGC_COLLECTION
+ #define MR_DEBUG_AGC_FORWARDING
+ #define MR_DEBUG_AGC_PRINT_VARS
+#endif
+
#ifndef MR_LOWLEVEL_DEBUG
#define dump_push_msg(msg) ((void)0)
Index: runtime/mercury_deep_copy.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_deep_copy.c,v
retrieving revision 1.10
diff -u -r1.10 mercury_deep_copy.c
--- mercury_deep_copy.c 1998/07/13 22:44:05 1.10
+++ mercury_deep_copy.c 1998/07/15 14:01:54
@@ -5,7 +5,11 @@
*/
/*
-** This module defines the deep_copy() function.
+** This module defines the deep_copy() functions.
+**
+** Deep copy is used for a number of different purposes. Each variant
+** has the same basic control structure, but differs in how memory
+** is allocated, or whether forwarding pointers are left behind.
*/
#include "mercury_imp.h"
@@ -13,337 +17,81 @@
#include "mercury_type_info.h"
#include "mercury_memory.h"
-#define in_range(X) ((X) >= lower_limit && (X) <= upper_limit)
-/*
-** Prototypes.
-*/
-static Word deep_copy_arg(Word data, Word *type_info, Word *arg_type_info,
- Word *lower_limit, Word *upper_limit);
-static Word * deep_copy_type_info(Word *type_info,
- Word *lower_limit, Word *upper_limit);
-
MR_DECLARE_STRUCT(mercury_data___base_type_info_pred_0);
MR_DECLARE_STRUCT(mercury_data___base_type_info_func_0);
/*
** deep_copy(): see mercury_deep_copy.h for documentation.
-**
-** Due to the depth of the control here, we'll use 4 space indentation.
-**
-** NOTE : changes to this function will probably also have to be reflected
-** in the function std_util::ML_expand() and mercury_table_any.c
*/
-Word
-deep_copy(Word data, Word *type_info, Word *lower_limit, Word *upper_limit)
-{
- Word *base_type_info, *base_type_layout, *base_type_functors;
- Word functors_indicator;
- Word layout_entry, *entry_value, *data_value;
- enum MR_DataRepresentation data_rep;
- int data_tag;
- Word new_data;
-
- data_tag = tag(data);
- data_value = (Word *) body(data, data_tag);
-
- base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info);
- base_type_layout = MR_BASE_TYPEINFO_GET_TYPELAYOUT(base_type_info);
- layout_entry = base_type_layout[data_tag];
-
- base_type_functors = MR_BASE_TYPEINFO_GET_TYPEFUNCTORS(base_type_info);
- functors_indicator = MR_TYPEFUNCTORS_INDICATOR(base_type_functors);
-
- entry_value = (Word *) strip_tag(layout_entry);
-
- data_rep = MR_categorize_data(functors_indicator, layout_entry);
-
- switch (data_rep) {
- case MR_DATAREP_ENUM: /* fallthru */
- case MR_DATAREP_COMPLICATED_CONST:
- new_data = data; /* just a copy of the actual item */
- break;
-
- case MR_DATAREP_COMPLICATED: {
- Word secondary_tag;
- Word *new_entry;
- Word *argument_vector, *type_info_vector;
- int arity, i;
-
- /*
- ** if the vector containing the secondary tags and the
- ** arguments is in range, copy it.
- */
- if (in_range(data_value)) {
- secondary_tag = *data_value;
- argument_vector = data_value + 1;
- new_entry = (Word *) entry_value[secondary_tag +1];
- arity = new_entry[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
- type_info_vector = new_entry + TYPELAYOUT_SIMPLE_ARGS_OFFSET;
-
- /* allocate space for new args, and secondary tag */
- incr_saved_hp(new_data, arity + 1);
-
- /* copy secondary tag */
- field(0, new_data, 0) = secondary_tag;
-
- /* copy arguments */
- for (i = 0; i < arity; i++) {
- field(0, new_data, i + 1) = deep_copy_arg(
- argument_vector[i], type_info,
- (Word *) type_info_vector[i], lower_limit,
- upper_limit);
- }
-
- /* tag this pointer */
- new_data = (Word) mkword(data_tag, new_data);
- } else {
- new_data = data;
- }
- break;
- }
-
- case MR_DATAREP_SIMPLE: {
- int arity, i;
- Word *argument_vector, *type_info_vector;
- argument_vector = data_value;
-
- /* If the argument vector is in range, copy the arguments */
- if (in_range(argument_vector)) {
- arity = entry_value[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
- type_info_vector = entry_value + TYPELAYOUT_SIMPLE_ARGS_OFFSET;
-
- /* allocate space for new args. */
- incr_saved_hp(new_data, arity);
-
- /* copy arguments */
- for (i = 0; i < arity; i++) {
- field(0, new_data, i) = deep_copy_arg(argument_vector[i],
- type_info, (Word *) type_info_vector[i], lower_limit,
- upper_limit);
- }
- /* tag this pointer */
- new_data = (Word) mkword(data_tag, new_data);
- } else {
- new_data = data;
- }
- break;
- }
-
- case MR_DATAREP_NOTAG:
- new_data = deep_copy_arg(data, type_info,
- (Word *) *MR_TYPELAYOUT_NO_TAG_VECTOR_ARGS(entry_value),
- lower_limit, upper_limit);
- break;
-
- case MR_DATAREP_EQUIV:
- new_data = deep_copy_arg(data, type_info,
- (Word *) MR_TYPELAYOUT_EQUIV_TYPE((Word *) entry_value),
- lower_limit, upper_limit);
- break;
-
- case MR_DATAREP_EQUIV_VAR:
- new_data = deep_copy(data, (Word *) type_info[(Word) entry_value],
- lower_limit, upper_limit);
- break;
-
- case MR_DATAREP_INT:
- case MR_DATAREP_CHAR:
- new_data = data;
- break;
-
- case MR_DATAREP_FLOAT:
- #ifdef BOXED_FLOAT
- if (in_range(data_value)) {
- /*
- ** force a deep copy by converting to float
- ** and back
- */
- new_data = float_to_word(word_to_float(data));
- } else {
- new_data = data;
- }
- #else
- new_data = data;
- #endif
- break;
-
- case MR_DATAREP_STRING:
- if (in_range(data_value)) {
- incr_saved_hp_atomic(new_data,
- (strlen((String) data_value) + sizeof(Word))
- / sizeof(Word));
- strcpy((String) new_data, (String) data_value);
- } else {
- new_data = data;
- }
- break;
-
- case MR_DATAREP_PRED: {
- /*
- ** predicate closures store the number of curried
- ** arguments as their first argument, the
- ** Code * as their second, and then the
- ** arguments
- **
- ** Their type-infos have a pointer to
- ** base_type_info for pred/0, arity, and then
- ** argument typeinfos.
- **/
- if (in_range(data_value)) {
- int args, i;
- Word *new_closure;
-
- /* get number of curried arguments */
- args = data_value[0];
-
- /* create new closure */
- incr_saved_hp(LVALUE_CAST(Word, new_closure), args + 2);
-
- /* copy number of arguments */
- new_closure[0] = args;
-
- /* copy pointer to code for closure */
- new_closure[1] = data_value[1];
-
- /* copy arguments */
- for (i = 0; i < args; i++) {
- new_closure[i + 2] = deep_copy(data_value[i + 2],
- (Word *) type_info[i + TYPEINFO_OFFSET_FOR_PRED_ARGS],
- lower_limit, upper_limit);
- }
- new_data = (Word) new_closure;
- } else {
- new_data = data;
- }
- }
- break;
-
- case MR_DATAREP_UNIV:
- /* if the univ is stored in range, copy it */
- if (in_range(data_value)) {
- Word *new_data_ptr;
-
- /* allocate space for a univ */
- incr_saved_hp(new_data, 2);
- new_data_ptr = (Word *) new_data;
- new_data_ptr[UNIV_OFFSET_FOR_TYPEINFO] =
- (Word) deep_copy_type_info( (Word *)
- data_value[UNIV_OFFSET_FOR_TYPEINFO],
- lower_limit, upper_limit);
- new_data_ptr[UNIV_OFFSET_FOR_DATA] = deep_copy(
- data_value[UNIV_OFFSET_FOR_DATA],
- (Word *) data_value[UNIV_OFFSET_FOR_TYPEINFO],
- lower_limit, upper_limit);
- } else {
- new_data = data;
- }
- break;
-
- case MR_DATAREP_VOID:
- fatal_error("Cannot deep copy a void type");
- break;
-
- case MR_DATAREP_ARRAY: {
- int i;
-
- if (in_range(data_value)) {
- MR_ArrayType *new_array;
- MR_ArrayType *old_array;
- Integer array_size;
-
- old_array = (MR_ArrayType *) data_value;
- array_size = old_array->size;
- new_array = MR_make_array(array_size);
- new_array->size = array_size;
- for (i = 0; i < array_size; i++) {
- new_array->elements[i] = deep_copy_arg(
- old_array->elements[i], type_info,
- (Word *) 1, lower_limit, upper_limit);
- }
- new_data = (Word) new_array;
- } else {
- new_data = data;
- }
- break;
- }
-
- case MR_DATAREP_TYPEINFO:
- new_data = (Word) deep_copy_type_info(data_value,
- lower_limit, upper_limit);
- break;
-
- case MR_DATAREP_C_POINTER:
- if (in_range(data_value)) {
- /*
- ** This error occurs if we try to deep_copy() a
- ** `c_pointer' type that points to memory allocated
- ** on the Mercury heap.
- */
- fatal_error("Cannot copy a c_pointer type");
- } else {
- new_data = data;
- }
- break;
-
- case MR_DATAREP_UNKNOWN: /* fallthru */
- default:
- fatal_error("Unknown layout type in deep copy");
- break;
- }
+
+#undef in_range
+#define in_range(X) (lower_limit == NULL || ((X) >= lower_limit && \
+ (X) <= upper_limit))
+
+#undef maybeconst
+#define maybeconst const
+
+#undef copy
+#define copy deep_copy
+
+#undef copy_arg
+#define copy_arg deep_copy_arg
+
+#undef copy_type_info
+#define copy_type_info deep_copy_type_info
- return new_data;
-} /* end deep_copy() */
+#undef leave_forwarding_pointer
+#define leave_forwarding_pointer(DataPtr, NewData)
+#undef found_forwarding_pointer
+#define found_forwarding_pointer(Data)
+
+#include "mercury_deep_copy_body.h"
+
+
/*
-** deep_copy_arg is like deep_copy() except that it takes a
-** pseudo_type_info (namely arg_pseudo_type_info) rather than
-** a type_info. The pseudo_type_info may contain type variables,
-** which refer to arguments of the term_type_info.
+** agc_deep_copy(): see mercury_deep_copy.h for documentation.
*/
-static Word
-deep_copy_arg(Word data, Word *term_type_info, Word *arg_pseudo_type_info,
- Word *lower_limit, Word *upper_limit)
-{
- MR_MemoryList allocated_memory_cells;
- Word *new_type_info;
- Word new_data;
-
- allocated_memory_cells = NULL;
- new_type_info = MR_make_type_info(term_type_info, arg_pseudo_type_info,
- &allocated_memory_cells);
- new_data = deep_copy(data, new_type_info, lower_limit, upper_limit);
- MR_deallocate(allocated_memory_cells);
- return new_data;
-}
+#undef in_range
+#define in_range(X) ((X) >= lower_limit && (X) <= upper_limit)
+#undef maybeconst
+#define maybeconst
-static Word *
-deep_copy_type_info(Word *type_info, Word *lower_limit, Word *upper_limit)
-{
- if (in_range(type_info)) {
- Word *base_type_info;
- Word *new_type_info;
- Integer arity, i;
-
- /* XXX this doesn't handle higher-order types properly */
-
- base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info);
- arity = MR_BASE_TYPEINFO_GET_TYPE_ARITY(base_type_info);
- incr_saved_hp(LVALUE_CAST(Word, new_type_info), arity + 1);
- new_type_info[0] = type_info[0];
- for (i = 1; i < arity + 1; i++) {
- new_type_info[i] = (Word) deep_copy_type_info(
- (Word *) type_info[i],
- lower_limit, upper_limit);
+#undef copy
+#define copy agc_deep_copy
+
+#undef copy_arg
+#define copy_arg agc_deep_copy_arg
+
+#undef copy_type_info
+#define copy_type_info agc_deep_copy_type_info
+
+#ifdef MR_DEBUG_AGC_FORWARDING
+ #define FORWARD_DEBUG_MSG(Msg, Data) \
+ fprintf(stderr, Msg, Data);
+#else
+ #define FORWARD_DEBUG_MSG(Msg, Data)
+#endif
+
+#undef leave_forwarding_pointer
+#define leave_forwarding_pointer(DataPtr, NewData) \
+ if (in_range(DataPtr)) { \
+ FORWARD_DEBUG_MSG("forwarding to %lx\n",\
+ (long) NewData); \
+ *DataPtr = NewData; \
}
- return new_type_info;
- } else {
- return type_info;
- }
-}
+#undef found_forwarding_pointer
+#define found_forwarding_pointer(Data) \
+ FORWARD_DEBUG_MSG("not on this heap: %lx\n", (long) Data);
+
+#include "mercury_deep_copy_body.h"
+
+
+/*---------------------------------------------------------------------------*/
#define SWAP(val1, val2, type) \
do { \
@@ -375,7 +123,7 @@
/* copy values from the heap to the global heap */
save_transient_registers();
- result = deep_copy(term, type_info, lower_limit,
+ result = deep_copy(&term, type_info, lower_limit,
MR_global_heap_zone->top);
restore_transient_registers();
Index: runtime/mercury_deep_copy.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_deep_copy.h,v
retrieving revision 1.5
diff -u -r1.5 mercury_deep_copy.h
--- mercury_deep_copy.h 1998/06/18 04:30:41 1.5
+++ mercury_deep_copy.h 1998/07/03 05:13:51
@@ -12,7 +12,7 @@
#include "mercury_types.h" /* for `Word' */
/*
-** Deep Copy:
+** deep_copy:
**
** Copy a data item, completely.
**
@@ -25,10 +25,8 @@
**
** The caller must provide the type_info describing
** the type of this data structure. It must also
-** provide the heap_limit - if no limit is desired,
-** NULL or the bottom of the heap may be passed.
-** deep_copy returns the address of the new, copied
-** data structure.
+** provide the upper and lower limits - if no limits are desired,
+** pass NULL as the lower_limit.
**
** Deep copy returns the actual data that it copied,
** which may need to be stored on the heap, or put in
@@ -61,14 +59,41 @@
**
** Deep copy does not preserve sharing of subterms. Each
** subterm is copied in full, except for data items that are
-** stored outside the heap.
+** stored outside the heap limits.
** XXX For some applications, sharing is useful. For others we
** want a copy that is completely unique. We should modify
** deep_copy to do both.
*/
-Word deep_copy(Word data, Word *type_info, Word *lower_limit,
- Word *upper_limit);
+Word deep_copy(const Word *data_ptr, const Word *type_info,
+ const Word *lower_limit, const Word *upper_limit);
+
+/*
+** agc_deep_copy:
+**
+** Just like deep_copy(), but it will leave forwarding pointers
+** in the old data (destructively). lower_limit and upper_limit
+** give the boundaries for copying data, and the boundaries for
+** leaving forwarding pointers.
+**
+** Data will be copied to wherever the heap pointer is pointing.
+**
+** A forwarding pointer will be left simply by copying the new
+** value of the data into the old location. If the data was a
+** tagged pointer, the pointer will now refer to the rest of the
+** data on the new heap. (If the data wasn't a tagged pointer, it
+** will be a constant anyway).
+**
+** The upper and lower limits allow forwarding pointers to be
+** detected and treated just as if they were pointers off the
+** heap (say to a constant data structure in the data segment of
+** the program).
+**
+** Note: You cannot pass NULL as the lower_limit to agc_deep_copy
+** (which is possible with normal deep_copy).
+*/
+Word agc_deep_copy(Word *data_ptr, const Word *type_info,
+ const Word *lower_limit, const Word *upper_limit);
/*
** MR_make_permanent:
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: mercury_deep_copy_body.h
diff -N mercury_deep_copy_body.h
--- /dev/null Wed May 28 10:49:58 1997
+++ mercury_deep_copy_body.h Thu Jul 16 00:02:27 1998
@@ -0,0 +1,359 @@
+/*
+** Copyright (C) 1997-1998 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 internals of deep copy.
+**
+** Functions such as "copy", "copy_arg", "copy_type_info", "in_range",
+** etc can be #defined to whatever functions are needed for a particular
+** copying application.
+*/
+
+
+/*
+** Prototypes.
+*/
+static Word copy_arg(maybeconst Word *data_ptr, const Word *type_info,
+ const Word *arg_type_info, const Word *lower_limit,
+ const Word *upper_limit);
+static Word *copy_type_info(maybeconst Word *type_info,
+ const Word *lower_limit, const Word *upper_limit);
+
+Word
+copy(maybeconst Word *data_ptr, const Word *type_info,
+ const Word *lower_limit, const Word *upper_limit)
+{
+ Word *base_type_info, *base_type_layout, *base_type_functors;
+ Word functors_indicator;
+ Word layout_entry, *entry_value, *data_value;
+ enum MR_DataRepresentation data_rep;
+ int data_tag;
+ Word new_data, data;
+
+ data = *data_ptr;
+
+ data_tag = tag(data);
+ data_value = (Word *) body(data, data_tag);
+
+ base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info);
+ base_type_layout = MR_BASE_TYPEINFO_GET_TYPELAYOUT(base_type_info);
+ layout_entry = base_type_layout[data_tag];
+
+ base_type_functors = MR_BASE_TYPEINFO_GET_TYPEFUNCTORS(base_type_info);
+ functors_indicator = MR_TYPEFUNCTORS_INDICATOR(base_type_functors);
+
+ entry_value = (Word *) strip_tag(layout_entry);
+
+ data_rep = MR_categorize_data(functors_indicator, layout_entry);
+
+ switch (data_rep) {
+ case MR_DATAREP_ENUM: /* fallthru */
+ case MR_DATAREP_COMPLICATED_CONST:
+ new_data = data; /* just a copy of the actual item */
+ break;
+
+ case MR_DATAREP_COMPLICATED: {
+ Word secondary_tag;
+ Word *new_entry;
+ Word *argument_vector, *type_info_vector;
+ int arity, i;
+
+ /*
+ ** if the vector containing the secondary tags and the
+ ** arguments is in range, copy it.
+ */
+ if (in_range(data_value)) {
+ secondary_tag = *data_value;
+ argument_vector = data_value + 1;
+ new_entry = (Word *) entry_value[secondary_tag +1];
+ arity = new_entry[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
+ type_info_vector = new_entry + TYPELAYOUT_SIMPLE_ARGS_OFFSET;
+
+ /* allocate space for new args, and secondary tag */
+ incr_saved_hp(new_data, arity + 1);
+
+ /* copy secondary tag */
+ field(0, new_data, 0) = secondary_tag;
+
+ /* copy arguments */
+ for (i = 0; i < arity; i++) {
+ field(0, new_data, i + 1) = copy_arg(
+ &argument_vector[i], type_info,
+ (Word *) type_info_vector[i], lower_limit,
+ upper_limit);
+ }
+
+ /* tag this pointer */
+ new_data = (Word) mkword(data_tag, new_data);
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ break;
+ }
+
+ case MR_DATAREP_SIMPLE: {
+ int arity, i;
+ Word *argument_vector, *type_info_vector;
+ argument_vector = data_value;
+
+ /* If the argument vector is in range, copy the arguments */
+ if (in_range(argument_vector)) {
+ arity = entry_value[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
+ type_info_vector = entry_value + TYPELAYOUT_SIMPLE_ARGS_OFFSET;
+
+ /* allocate space for new args. */
+ incr_saved_hp(new_data, arity);
+
+ /* copy arguments */
+ for (i = 0; i < arity; i++) {
+ field(0, new_data, i) = copy_arg(&argument_vector[i],
+ type_info, (Word *) type_info_vector[i], lower_limit,
+ upper_limit);
+ }
+ /* tag this pointer */
+ new_data = (Word) mkword(data_tag, new_data);
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ break;
+ }
+
+ case MR_DATAREP_NOTAG:
+ new_data = copy_arg(data_ptr, type_info,
+ (Word *) *MR_TYPELAYOUT_NO_TAG_VECTOR_ARGS(entry_value),
+ lower_limit, upper_limit);
+ break;
+
+ case MR_DATAREP_EQUIV:
+ new_data = copy_arg(data_ptr, type_info,
+ (const Word *) MR_TYPELAYOUT_EQUIV_TYPE((Word *)
+ entry_value), lower_limit, upper_limit);
+ break;
+
+ case MR_DATAREP_EQUIV_VAR:
+ new_data = copy(data_ptr, (Word *) type_info[(Word) entry_value],
+ lower_limit, upper_limit);
+ break;
+
+ case MR_DATAREP_INT:
+ case MR_DATAREP_CHAR:
+ new_data = data;
+ break;
+
+ case MR_DATAREP_FLOAT:
+ #ifdef BOXED_FLOAT
+ if (in_range(data_value)) {
+ /*
+ ** force a deep copy by converting to float
+ ** and back
+ */
+ new_data = float_to_word(word_to_float(data));
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ #else
+ new_data = data;
+ #endif
+ break;
+
+ case MR_DATAREP_STRING:
+ if (in_range(data_value)) {
+ incr_saved_hp_atomic(new_data,
+ (strlen((String) data_value) + sizeof(Word))
+ / sizeof(Word));
+ strcpy((String) new_data, (String) data_value);
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ break;
+
+ case MR_DATAREP_PRED: {
+ /*
+ ** predicate closures store the number of curried arguments
+ ** as their first argument, the Code * as their second, and
+ ** then the arguments
+ **
+ ** Their type-infos have a pointer to base_type_info for
+ ** pred/0, arity, and then argument typeinfos.
+ */
+ if (in_range(data_value)) {
+ int args, i;
+ Word *new_closure;
+
+ /* get number of curried arguments */
+ args = data_value[0];
+
+ /* create new closure */
+ incr_saved_hp(LVALUE_CAST(Word, new_closure), args + 2);
+
+ /* copy number of arguments */
+ new_closure[0] = args;
+
+ /* copy pointer to code for closure */
+ new_closure[1] = data_value[1];
+
+ /* copy arguments */
+ for (i = 0; i < args; i++) {
+ new_closure[i + 2] = copy(&data_value[i + 2],
+ (const Word *)
+ type_info[i + TYPEINFO_OFFSET_FOR_PRED_ARGS],
+ lower_limit, upper_limit);
+ }
+ new_data = (Word) new_closure;
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ }
+ break;
+
+ case MR_DATAREP_UNIV:
+ /* if the univ is stored in range, copy it */
+ if (in_range(data_value)) {
+ Word *new_data_ptr;
+
+ /* allocate space for a univ */
+ incr_saved_hp(new_data, 2);
+ new_data_ptr = (Word *) new_data;
+ new_data_ptr[UNIV_OFFSET_FOR_TYPEINFO] =
+ (Word) copy_type_info(
+ &data_value[UNIV_OFFSET_FOR_TYPEINFO],
+ lower_limit, upper_limit);
+ new_data_ptr[UNIV_OFFSET_FOR_DATA] = copy(
+ &data_value[UNIV_OFFSET_FOR_DATA],
+ (const Word *) data_value[UNIV_OFFSET_FOR_TYPEINFO],
+ lower_limit, upper_limit);
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ break;
+
+ case MR_DATAREP_VOID:
+ fatal_error("Cannot copy a void type");
+ break;
+
+ case MR_DATAREP_ARRAY: {
+ int i;
+
+ if (in_range(data_value)) {
+ MR_ArrayType *new_array;
+ MR_ArrayType *old_array;
+ Integer array_size;
+
+ old_array = (MR_ArrayType *) data_value;
+ array_size = old_array->size;
+ new_array = MR_make_array(array_size);
+ new_array->size = array_size;
+ for (i = 0; i < array_size; i++) {
+ new_array->elements[i] = copy_arg(
+ &old_array->elements[i], type_info,
+ (const Word *) 1, lower_limit, upper_limit);
+ }
+ new_data = (Word) new_array;
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ break;
+ }
+
+ case MR_DATAREP_TYPEINFO:
+ new_data = (Word) copy_type_info(data_ptr,
+ lower_limit, upper_limit);
+ break;
+
+ case MR_DATAREP_C_POINTER:
+ if (in_range(data_value)) {
+ /*
+ ** This error occurs if we try to copy() a
+ ** `c_pointer' type that points to memory allocated
+ ** on the Mercury heap.
+ */
+ fatal_error("Cannot copy a c_pointer type");
+ } else {
+ new_data = data;
+ }
+ break;
+
+ case MR_DATAREP_UNKNOWN: /* fallthru */
+ default:
+ fatal_error("Unknown layout type in deep copy");
+ break;
+ }
+
+ return new_data;
+}
+
+/*
+** copy_arg is like copy() except that it takes a
+** pseudo_type_info (namely arg_pseudo_type_info) rather than
+** a type_info. The pseudo_type_info may contain type variables,
+** which refer to arguments of the term_type_info.
+*/
+static Word
+copy_arg(maybeconst Word *data_ptr, const Word *term_type_info,
+ const Word *arg_pseudo_type_info, const Word *lower_limit,
+ const Word *upper_limit)
+{
+ MR_MemoryList allocated_memory_cells;
+ Word *new_type_info;
+ Word new_data;
+
+ allocated_memory_cells = NULL;
+ new_type_info = MR_make_type_info(term_type_info, arg_pseudo_type_info,
+ &allocated_memory_cells);
+ new_data = copy(data_ptr, new_type_info, lower_limit, upper_limit);
+ MR_deallocate(allocated_memory_cells);
+
+ return new_data;
+}
+
+
+static Word *
+copy_type_info(maybeconst Word *type_info_ptr, const Word *lower_limit,
+ const Word *upper_limit)
+{
+ Word *type_info = (Word *) *type_info_ptr;
+
+ if (in_range(type_info)) {
+ Word *base_type_info;
+ Word *new_type_info;
+ Integer arity, i;
+
+ /* XXX this doesn't handle higher-order types properly */
+
+ base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO((Word *)
+ type_info);
+ arity = MR_BASE_TYPEINFO_GET_TYPE_ARITY(base_type_info);
+ incr_saved_hp(LVALUE_CAST(Word, new_type_info), arity + 1);
+ new_type_info[0] = type_info[0];
+ for (i = 1; i < arity + 1; i++) {
+ new_type_info[i] = (Word) copy_type_info(
+ (Word *) type_info[i],
+ lower_limit, upper_limit);
+ }
+ leave_forwarding_pointer(type_info_ptr, (Word) new_type_info);
+ return new_type_info;
+ } else {
+ found_forwarding_pointer(type_info);
+ return type_info;
+ }
+}
+
+
+
Index: runtime/mercury_engine.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_engine.c,v
retrieving revision 1.10
diff -u -r1.10 mercury_engine.c
--- mercury_engine.c 1998/07/13 22:44:06 1.10
+++ mercury_engine.c 1998/07/15 13:42:00
@@ -80,6 +80,16 @@
heap_zone_size, default_handler);
eng->e_hp = eng->heap_zone->min;
+#ifdef NATIVE_GC
+ eng->heap_zone2 = create_zone("heap2", 1, heap_size, next_offset(),
+ heap_zone_size, default_handler);
+
+ #ifdef MR_DEBUG_AGC_PRINT_VARS
+ eng->debug_heap_zone = create_zone("debug_heap", 1, debug_heap_size,
+ next_offset(), debug_heap_zone_size, default_handler);
+ #endif
+#endif
+
eng->solutions_heap_zone = create_zone("solutions_heap", 1,
solutions_heap_size, next_offset(),
solutions_heap_zone_size, default_handler);
Index: runtime/mercury_engine.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_engine.h,v
retrieving revision 1.7
diff -u -r1.7 mercury_engine.h
--- mercury_engine.h 1998/07/07 08:04:12 1.7
+++ mercury_engine.h 1998/07/09 07:09:26
@@ -201,6 +201,12 @@
MemoryZone *solutions_heap_zone;
MemoryZone *global_heap_zone;
#endif
+#ifdef NATIVE_GC
+ MemoryZone *heap_zone2;
+ #ifdef MR_DEBUG_AGC_PRINT_VARS
+ MemoryZone *debug_heap_zone;
+ #endif
+#endif
#ifndef SPEED
MemoryZone *dumpstack_zone;
int dumpindex;
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_imp.h,v
retrieving revision 1.7
diff -u -r1.7 mercury_imp.h
--- mercury_imp.h 1998/06/09 02:08:02 1.7
+++ mercury_imp.h 1998/07/01 08:03:44
@@ -37,6 +37,7 @@
#include "mercury_regs.h" /* must come before system headers */
#include "mercury_std.h"
+#include "mercury_debug.h"
#include "mercury_types.h"
#include "mercury_string.h"
@@ -65,7 +66,6 @@
#include "mercury_trail.h"
#endif
-#include "mercury_debug.h"
#include "mercury_prof.h"
#include "mercury_misc.h"
Index: runtime/mercury_label.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_label.c,v
retrieving revision 1.7
diff -u -r1.7 mercury_label.c
--- mercury_label.c 1998/07/03 02:35:13 1.7
+++ mercury_label.c 1998/07/08 06:37:13
@@ -109,7 +109,8 @@
if (entry_array_next >= entry_array_size) {
entry_array_size *= 2;
- if (realloc(entry_array, entry_array_size * sizeof(MR_Entry))
+ if ((entry_array = realloc(entry_array,
+ entry_array_size * sizeof(MR_Entry)))
== NULL) {
fatal_error("run out of memory for entry label array");
}
@@ -152,6 +153,9 @@
int hi;
int mid;
int i;
+
+ MR_do_init_label_tables();
+ do_init_modules();
if (!entry_array_sorted) {
qsort(entry_array, entry_array_next, sizeof(MR_Entry),
Index: runtime/mercury_memory.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_memory.c,v
retrieving revision 1.11
diff -u -r1.11 mercury_memory.c
--- mercury_memory.c 1998/06/18 04:30:44 1.11
+++ mercury_memory.c 1998/07/01 08:06:50
@@ -98,8 +98,6 @@
/*---------------------------------------------------------------------------*/
-static void setup_mprotect(void);
-
#ifdef HAVE_SIGINFO
static bool try_munprotect(void *address, void *context);
static char *explain_context(void *context);
@@ -144,6 +142,8 @@
solutions_heap_size = 0;
global_heap_zone_size = 0;
global_heap_size = 0;
+ debug_heap_zone_size = 0;
+ debug_heap_size = 0;
#else
heap_zone_size = round_up(heap_zone_size * 1024, unit);
heap_size = round_up(heap_size * 1024, unit);
@@ -152,8 +152,9 @@
solutions_heap_size = round_up(solutions_heap_size * 1024, unit);
global_heap_zone_size = round_up(global_heap_zone_size * 1024, unit);
global_heap_size = round_up(global_heap_size * 1024, unit);
+ debug_heap_zone_size = round_up(debug_heap_zone_size * 1024, unit);
+ debug_heap_size = round_up(debug_heap_size * 1024, unit);
#endif
-
detstack_size = round_up(detstack_size * 1024, unit);
detstack_zone_size = round_up(detstack_zone_size * 1024, unit);
nondstack_size = round_up(nondstack_size * 1024, unit);
Index: runtime/mercury_memory.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_memory.h,v
retrieving revision 1.6
diff -u -r1.6 mercury_memory.h
--- mercury_memory.h 1998/06/09 02:08:05 1.6
+++ mercury_memory.h 1998/07/03 04:38:11
@@ -105,5 +105,16 @@
extern size_t unit;
extern size_t page_size;
+/*
+** Users need to call MR_add_root() for any global variable which
+** contains pointers to the Mercury heap. This information is only
+** used for agc grades.
+*/
+#ifdef NATIVE_GC
+ #define MR_add_root(root_ptr, type_info) \
+ MR_agc_add_root((root_ptr), (type_info))
+#else
+ #define MR_add_root(root_ptr, type_info) /* nothing */
+#endif
#endif /* not MERCURY_MEMORY_H */
Index: runtime/mercury_memory_handlers.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_memory_handlers.c,v
retrieving revision 1.4
diff -u -r1.4 mercury_memory_handlers.c
--- mercury_memory_handlers.c 1998/07/13 22:44:10 1.4
+++ mercury_memory_handlers.c 1998/07/15 13:42:05
@@ -106,10 +106,11 @@
** alignment boundary. `align' must be a power of 2.
*/
-static void setup_mprotect(void);
static void print_dump_stack(void);
static bool try_munprotect(void *address, void *context);
static char *explain_context(void *context);
+static Code *get_pc_from_context(void *the_context);
+static Word *get_sp_from_context(void *the_context);
#define STDERR 2
@@ -224,6 +225,10 @@
zone->name, zone->id, (void *) zone->redzone,
(void *) zone->top);
}
+ #ifdef NATIVE_GC
+ MR_schedule_agc(get_pc_from_context(context),
+ get_sp_from_context(context));
+ #endif
return TRUE;
} else {
char buf[2560];
@@ -519,6 +524,113 @@
#endif /* not HAVE_SIGINFO_T && not HAVE_SIGCONTEXT_STRUCT */
+/*
+** get_pc_from_context:
+** Given the signal context, return the program counter at the time
+** of the signal, if available. If it is unavailable, return NULL.
+*/
+static Code *
+get_pc_from_context(void *the_context)
+{
+ Code *pc_at_signal = NULL;
+#if defined(HAVE_SIGCONTEXT_STRUCT)
+
+ #ifdef PC_ACCESS
+ struct sigcontext_struct *context = the_context;
+
+ pc_at_signal = (Code *) context->PC_ACCESS;
+ #else
+ pc_at_signal = (Code *) NULL;
+ #endif
+
+#elif defined(HAVE_SIGINFO_T)
+
+ #ifdef PC_ACCESS
+
+ struct sigcontext *context = the_context;
+
+ #ifdef PC_ACCESS_GREG
+ pc_at_signal = (Code *) context->gregs[PC_ACCESS];
+ #else
+ pc_at_signal = (Code *) context->PC_ACCESS;
+ #endif
+
+ #else /* not PC_ACCESS */
+
+ /* if PC_ACCESS is not set, we don't know the context */
+ pc_at_signal = (Code *) NULL;
+
+ #endif /* not PC_ACCESS */
+
+#else /* not HAVE_SIGINFO_T && not HAVE_SIGCONTEXT_STRUCT */
+
+ pc_at_signal = (Code *) NULL;
+
+#endif
+
+ return pc_at_signal;
+}
+
+/*
+** get_sp_from_context:
+** Given the signal context, return the Mercury register "MR_sp" at
+** the time of the signal, if available. If it is unavailable,
+** return NULL.
+**
+** XXX Only define this function in accurate gc grades for the moment,
+** because it's unlikely to compile everywhere. It relies on
+** MR_real_reg_number_sp being defined, which is the name/number of the
+** machine register that is used for MR_sp.
+** Need to fix this so it works when the register is in a fake reg too.
+*/
+static Word *
+get_sp_from_context(void *the_context)
+{
+ Word *sp_at_signal = NULL;
+#ifdef NATIVE_GC
+ #if defined(HAVE_SIGCONTEXT_STRUCT)
+
+ #ifdef PC_ACCESS
+ struct sigcontext_struct *context = the_context;
+
+ sp_at_signal = (Word *) context->MR_real_reg_number_sp;
+ #else
+ sp_at_signal = (Word *) NULL;
+ #endif
+
+ #elif defined(HAVE_SIGINFO_T)
+
+ #ifdef PC_ACCESS
+
+ struct sigcontext *context = the_context;
+
+ #ifdef PC_ACCESS_GREG
+ sp_at_signal = (Word *) context->gregs[MR_real_reg_number_sp];
+ #else
+ sp_at_signal = (Word *) context->sc_regs[MR_real_reg_number_sp];
+ #endif
+
+ #else /* not PC_ACCESS */
+
+ /*
+ ** if PC_ACCESS is not set, we don't know how to get at the
+ ** registers
+ */
+ sp_at_signal = (Word *) NULL;
+
+ #endif /* not PC_ACCESS */
+
+ #else /* not HAVE_SIGINFO_T && not HAVE_SIGCONTEXT_STRUCT */
+
+ sp_at_signal = (Word *) NULL;
+
+ #endif
+#else
+ sp_at_signal = (Word *) NULL;
+#endif/* NATIVE_GC */
+
+ return sp_at_signal;
+}
static void
print_dump_stack(void)
Index: runtime/mercury_memory_zones.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_memory_zones.c,v
retrieving revision 1.4
diff -u -r1.4 mercury_memory_zones.c
--- mercury_memory_zones.c 1998/06/09 02:08:07 1.4
+++ mercury_memory_zones.c 1998/07/01 04:16:20
@@ -318,9 +318,9 @@
#endif /* MR_CHECK_OVERFLOW_VIA_MPROTECT */
/*
- ** setup the hardzone (only if the redzone is unavailable)
+ ** setup the hardzone
*/
-#if defined(HAVE_MPROTECT) && !defined(MR_CHECK_OVERFLOW_VIA_MPROTECT)
+#if defined(HAVE_MPROTECT)
zone->hardmax = (Word *) round_up((Unsigned)zone->top - unit, unit);
if (mprotect((char *)zone->hardmax, unit, MY_PROT) < 0) {
char buf[2560];
@@ -389,6 +389,8 @@
#ifdef MR_CHECK_OVERFLOW_VIA_MPROTECT
fprintf(stderr, "%-16s#%d-redzone = %p\n",
zone->name, zone->id, (void *) zone->redzone);
+ fprintf(stderr, "%-16s#%d-redzone_base = %p\n",
+ zone->name, zone->id, (void *) zone->redzone_base);
#endif /* MR_CHECK_OVERFLOW_VIA_MPROTECT */
#ifdef HAVE_MPROTECT
fprintf(stderr, "%-16s#%d-hardmax = %p\n",
Index: runtime/mercury_regorder.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_regorder.h,v
retrieving revision 1.8
diff -u -r1.8 mercury_regorder.h
--- mercury_regorder.h 1998/06/18 04:30:45 1.8
+++ mercury_regorder.h 1998/06/24 02:26:15
@@ -67,6 +67,9 @@
#define r31 count_usage(R_RN(31), mr36)
#define r32 count_usage(R_RN(32), mr37)
+ /* Keep this in sync with the actual defintion below */
+#define MR_real_reg_number_sp MR_real_reg_number_mr1
+
#define MR_engine_base LVALUE_CAST(Word *, count_usage(MR_SP_RN, mr0))
/*
@@ -187,6 +190,8 @@
** the definitions of MR_NUM_SPECIAL_REG, MR_MAX_SPECIAL_REG_MR,
** and MR_saved_*.
*/
+#define MR_real_reg_number_sp MR_real_reg_number_mr0
+
#define MR_succip LVALUE_CAST(Code *, count_usage(MR_SI_RN, mr1))
#define MR_hp LVALUE_CAST(Word *, count_usage(MR_HP_RN, mr5))
#define MR_sp LVALUE_CAST(Word *, count_usage(MR_SP_RN, mr0))
Index: runtime/mercury_stack_trace.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_stack_trace.c,v
retrieving revision 1.12
diff -u -r1.12 mercury_stack_trace.c
--- mercury_stack_trace.c 1998/07/04 06:04:21 1.12
+++ mercury_stack_trace.c 1998/07/10 06:28:39
@@ -14,12 +14,6 @@
#include "mercury_stack_trace.h"
#include <stdio.h>
-typedef enum {
- STEP_ERROR_BEFORE, /* the current entry_layout has no valid info */
- STEP_ERROR_AFTER, /* the current entry_layout has valid info,
- but the next one does not */
- STEP_OK /* both have valid info */
-} MR_Stack_Walk_Step_Result;
static const char * detism_names[] = {
"failure", /* 0 */
@@ -39,11 +33,6 @@
"cc_multi" /* 14 */
};
-static MR_Stack_Walk_Step_Result MR_stack_walk_step(
- const MR_Stack_Layout_Entry *,
- const MR_Stack_Layout_Label **,
- Word **, Word **, const char **);
-
static void MR_dump_stack_record_init(void);
static void MR_dump_stack_record_frame(FILE *fp,
const MR_Stack_Layout_Entry *);
@@ -146,7 +135,7 @@
}
-static MR_Stack_Walk_Step_Result
+MR_Stack_Walk_Step_Result
MR_stack_walk_step(const MR_Stack_Layout_Entry *entry_layout,
const MR_Stack_Layout_Label **return_label_layout,
Word **stack_trace_sp_ptr, Word **stack_trace_curfr_ptr,
Index: runtime/mercury_stack_trace.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_stack_trace.h,v
retrieving revision 1.7
diff -u -r1.7 mercury_stack_trace.h
--- mercury_stack_trace.h 1998/07/03 02:35:25 1.7
+++ mercury_stack_trace.h 1998/07/10 06:35:19
@@ -68,4 +68,35 @@
Code *MR_stack_trace_bottom;
+
+typedef enum {
+ STEP_ERROR_BEFORE, /* the current entry_layout has no valid info */
+ STEP_ERROR_AFTER, /* the current entry_layout has valid info,
+ but the next one does not */
+ STEP_OK /* both have valid info */
+} MR_Stack_Walk_Step_Result;
+
+
+/*
+** MR_stack_walk_step:
+** This function takes the entry_layout for the current stack
+** frame (which is the topmost stack frame from the two stack
+** pointers given), and moves down one stack frame, setting the
+** stack pointers to their new levels.
+**
+** return_label_layout will be set to the stack_layout of the
+** continuation label, or NULL if the bottom of the stack has
+** been reached.
+**
+** The meaning of the return value for MR_stack_walk_step is
+** described in its type definiton above. If an error is
+** encountered, problem_ptr will be set to a string representation
+** of the error.
+*/
+extern MR_Stack_Walk_Step_Result MR_stack_walk_step(
+ const MR_Stack_Layout_Entry *entry_layout,
+ const MR_Stack_Layout_Label **return_label_layout,
+ Word **stack_trace_sp_ptr, Word **stack_trace_curfr_ptr,
+ const char **problem_ptr);
+
#endif /* MERCURY_STACK_TRACE_H */
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.4
diff -u -r1.4 mercury_tabling.h
--- mercury_tabling.h 1998/07/13 22:44:11 1.4
+++ mercury_tabling.h 1998/07/15 13:42:09
@@ -73,9 +73,11 @@
#define MR_TABLE_SAVE_ANSWER(Offset, ABlock, Value, TypeInfo) \
do { \
save_transient_registers(); \
+ { Word local_val = Value; \
(*((AnswerBlock)ABlock))[Offset] = \
- deep_copy(Value, (Word *) (Word) &TypeInfo, \
+ deep_copy(&local_val, (Word *) (Word) &TypeInfo,\
NULL, NULL); \
+ } \
restore_transient_registers(); \
} while(0)
Index: runtime/mercury_thread.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_thread.c,v
retrieving revision 1.2
diff -u -r1.2 mercury_thread.c
--- mercury_thread.c 1998/06/15 07:00:15 1.2
+++ mercury_thread.c 1998/07/07 11:11:43
@@ -27,6 +27,8 @@
Declare_entry(do_runnext);
+MR_MAKE_STACK_LAYOUT_ENTRY(do_runnext);
+
#ifdef MR_THREAD_SAFE
MercuryThread *
create_thread(int x)
Index: runtime/mercury_trace_internal.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_trace_internal.c,v
retrieving revision 1.7
diff -u -r1.7 mercury_trace_internal.c
--- mercury_trace_internal.c 1998/06/18 06:08:12 1.7
+++ mercury_trace_internal.c 1998/07/01 04:21:33
@@ -608,29 +608,8 @@
{
printf("\t");
- /*
- ** XXX It would be nice if we could call an exported C
- ** function version of the browser predicate, and thus
- ** avoid going through call_engine, but for some unknown
- ** reason, that seemed to cause the Mercury code in the
- ** browser to clobber part of the C stack.
- **
- ** Probably that was due to a bug which has since been
- ** fixed, so we should change the code below back again...
- **
- ** call_engine() expects the transient registers to be
- ** in fake_reg, others in their normal homes.
- ** That is the case on entry to this function.
- ** But r1 or r2 may be transient, so we need to save/restore
- ** transient regs around the assignments to them.
- */
-
MR_trace_enabled = FALSE;
- restore_transient_registers();
- r1 = type_info;
- r2 = value;
- save_transient_registers();
- call_engine(MR_library_trace_browser);
+ MR_trace_write_variable(type_info, value);
MR_trace_enabled = TRUE;
}
Index: runtime/mercury_trace_util.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_trace_util.c,v
retrieving revision 1.6
diff -u -r1.6 mercury_trace_util.c
--- mercury_trace_util.c 1998/06/18 06:08:14 1.6
+++ mercury_trace_util.c 1998/07/03 04:57:17
@@ -313,3 +313,32 @@
saved_regs_valid, base_sp, base_curfr, &succeeded);
return succeeded;
}
+
+void
+MR_trace_write_variable(Word type_info, Word value)
+{
+
+ /*
+ ** XXX It would be nice if we could call an exported C function
+ ** version of the browser predicate, and thus avoid going
+ ** through call_engine, but for some unknown reason, that seemed
+ ** to cause the Mercury code in the browser to clobber part of
+ ** the C stack.
+ **
+ ** Probably that was due to a bug which has since been fixed, so
+ ** we should change the code below back again...
+ **
+ ** call_engine() expects the transient registers to be in
+ ** fake_reg, others in their normal homes. That is the case on
+ ** entry to this function. But r1 or r2 may be transient, so we
+ ** need to save/restore transient regs around the assignments to
+ ** them.
+ */
+
+ restore_transient_registers();
+ r1 = type_info;
+ r2 = value;
+ save_transient_registers();
+ call_engine(MR_library_trace_browser);
+}
+
Index: runtime/mercury_trace_util.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_trace_util.h,v
retrieving revision 1.3
diff -u -r1.3 mercury_trace_util.h
--- mercury_trace_util.h 1998/06/18 06:08:16 1.3
+++ mercury_trace_util.h 1998/07/03 04:57:42
@@ -28,4 +28,10 @@
bool saved_regs_valid, Word *base_sp, Word *base_curfr,
Word *type_params, Word *type_info, Word *value);
+/*
+** MR_trace_write_variable:
+** Write a variable to stdout.
+*/
+extern void MR_trace_write_variable(Word type_info, Word value);
+
#endif /* MERCURY_TRACE_UTIL_H */
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.9
diff -u -r1.9 mercury_type_info.c
--- mercury_type_info.c 1998/07/13 22:44:14 1.9
+++ mercury_type_info.c 1998/07/15 13:42:12
@@ -452,7 +452,7 @@
*/
Word *
-MR_make_type_info(Word *term_type_info, Word *arg_pseudo_type_info,
+MR_make_type_info(const Word *term_type_info, const Word *arg_pseudo_type_info,
MR_MemoryList *allocated)
{
int i, arity, extra_args;
@@ -478,7 +478,7 @@
/* no arguments - optimise common case */
if (base_type_info == arg_pseudo_type_info) {
- return arg_pseudo_type_info;
+ return base_type_info;
}
if (MR_BASE_TYPEINFO_IS_HO(base_type_info)) {
@@ -533,7 +533,7 @@
}
}
if (type_info == NULL) {
- return arg_pseudo_type_info;
+ return (Word *) (Word) arg_pseudo_type_info;
} else {
return type_info;
}
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.9
diff -u -r1.9 mercury_type_info.h
--- mercury_type_info.h 1998/06/10 06:56:17 1.9
+++ mercury_type_info.h 1998/07/03 05:48:40
@@ -662,7 +662,7 @@
*/
#define MR_TYPEINFO_GET_BASE_TYPEINFO(TypeInfo) \
- ((*TypeInfo) ? ((Word *) *TypeInfo) : TypeInfo)
+ ((*TypeInfo) ? (Word *) *TypeInfo : (Word *) (Word) TypeInfo)
#define MR_TYPEINFO_GET_HIGHER_ARITY(TypeInfo) \
((Integer) (Word *) (TypeInfo)[TYPEINFO_OFFSET_FOR_PRED_ARITY])
@@ -795,8 +795,8 @@
};
typedef struct MR_MemoryCellNode *MR_MemoryList;
-Word * MR_make_type_info(Word *term_type_info, Word *arg_pseudo_type_info,
- MR_MemoryList *allocated);
+Word * MR_make_type_info(const Word *term_type_info,
+ const Word *arg_pseudo_type_info, MR_MemoryList *allocated);
void MR_deallocate(MR_MemoryList allocated_memory_cells);
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.17
diff -u -r1.17 mercury_wrapper.c
--- mercury_wrapper.c 1998/07/13 22:44:15 1.17
+++ mercury_wrapper.c 1998/07/15 13:42:14
@@ -45,21 +45,31 @@
/* size of data areas (including redzones), in kilobytes */
/* (but we later multiply by 1024 to convert to bytes) */
-size_t heap_size = 4096;
+#ifdef MR_DEBUG_AGC
+ size_t heap_size = 128;
+#else
+ size_t heap_size = 4096;
+#endif
size_t detstack_size = 2048;
size_t nondstack_size = 128;
size_t solutions_heap_size = 1024;
size_t global_heap_size = 1024;
size_t trail_size = 128;
+size_t debug_heap_size = 4096;
/* 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;
+#ifdef NATIVE_GC
+ size_t heap_zone_size = 96;
+#else
+ size_t heap_zone_size = 16;
+#endif
size_t detstack_zone_size = 16;
size_t nondstack_zone_size = 16;
size_t solutions_heap_zone_size = 16;
size_t global_heap_zone_size = 16;
size_t trail_zone_size = 16;
+size_t debug_heap_zone_size = 16;
/* primary cache size to optimize for, in kilobytes */
/* (but we later multiply by 1024 to convert to bytes) */
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.9
diff -u -r1.9 mercury_wrapper.h
--- mercury_wrapper.h 1998/07/03 05:51:26 1.9
+++ mercury_wrapper.h 1998/07/04 06:02:56
@@ -81,6 +81,7 @@
extern size_t solutions_heap_size;
extern size_t trail_size;
extern size_t global_heap_size;
+extern size_t debug_heap_size;
/* sizes of the red zones */
extern size_t heap_zone_size;
@@ -89,6 +90,7 @@
extern size_t solutions_heap_zone_size;
extern size_t trail_zone_size;
extern size_t global_heap_zone_size;
+extern size_t debug_heap_zone_size;
/* size of the primary cache */
extern size_t pcache_size;
Index: runtime/machdeps/alpha_regs.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/machdeps/alpha_regs.h,v
retrieving revision 1.9
diff -u -r1.9 alpha_regs.h
--- alpha_regs.h 1998/06/09 02:08:47 1.9
+++ alpha_regs.h 1998/06/18 07:26:26
@@ -32,6 +32,14 @@
register Word mr5 __asm__("$14"); /* register s5 */
register Word mr6 __asm__("$15"); /* the frame pointer (fp) */
+#define MR_real_reg_number_mr0 9
+#define MR_real_reg_number_mr1 10
+#define MR_real_reg_number_mr2 11
+#define MR_real_reg_number_mr3 12
+#define MR_real_reg_number_mr4 13
+#define MR_real_reg_number_mr5 14
+#define MR_real_reg_number_mr6 15
+
#define save_regs_to_mem(save_area) ( \
save_area[0] = mr0, \
save_area[1] = mr1, \
Index: runtime/machdeps/i386_regs.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/machdeps/i386_regs.h,v
retrieving revision 1.15
diff -u -r1.15 i386_regs.h
--- i386_regs.h 1998/06/09 07:25:37 1.15
+++ i386_regs.h 1998/06/18 08:44:47
@@ -61,10 +61,16 @@
register Word mr0 __asm__("esi"); /* sp */
register Word mr1 __asm__("edi"); /* succip */
+#define MR_real_reg_number_mr0 esi
+#define MR_real_reg_number_mr1 edi
+
#if PIC_REG
#define mr2 MR_fake_reg[2]
#else
register Word mr2 __asm__("ebx"); /* r1 */
+
+ #define MR_real_reg_number_mr2 ebx
+
#endif
#if PIC_REG
--
Tyson Dowd # There isn't any reason why Linux can't be
# implemented as an enterprise computing solution.
trd at cs.mu.oz.au # Find out what you've been missing while you've
http://www.cs.mu.oz.au/~trd # been rebooting Windows NT. -- InfoWorld, 1998.
More information about the developers
mailing list