[m-rev.] for review: fix agc forwarding pointers, et al
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Jun 6 15:24:26 AEST 2002
With these changes, and another bug fix which I will post in
a minute, the ICFP 2000 competition entry now works with
`--grade hlc.agc --no-reclaim-heap-on-failure', for all
of the test cases in the `examples' directory.
Previously it was getting heap overflow errors on some
test cases, because the sharing-elimination behaviour
of the old collector meant that sometimes the "to-space"
needed to be bigger than the "from-space".
(The compiler still doesn't bootstrap, however,
so obviously there is at least one bug still remaining ;-)
----------
Estimated hours taken: 16
Branches: main
Three changes related to accurate GC:
(1) Fix the handling of forwarding pointers.
(2) Change the interface to MR_(agc_)deep_copy() so that the first argument is
a value, not a pointer; the only reason that it was made a pointer was
because of the previous, broken, code for handling forwarding pointers.
(3) Delete the code for handling saved heap pointers, since it doesn't work
properly, and because the code conflicted with change (2).
The method this code used is not the right one to use, anyway, so the
effort of maintaining it would be a waste.
It doesn't work properly for two reasons:
(i) For heap reclamation on failure to work at all,
we also need at least some degree of liveness-accuracy.
Otherwise a local variable may get initialized to point
to the heap, then the heap is reset, then the memory
is overwritten with new allocations, and then a collection
occurs, at which point the local variable now points to
a value of the wrong type.
(ii) The method of handling saved heap pointers during GC
means that we lose heap reclamation on failure after a
GC occurs. A better method would be to just allocate a
word of heap space at each choice point.
runtime/mercury_deep_copy_body.h:
runtime/mercury_deep_copy.h:
runtime/mercury_deep_copy.c:
Rewrite the code handling forwarding pointers:
store forwarding pointers in the object being copied,
not in the pointer to it, and use a bitmap to distinguish
which objects contain forwarding pointers.
Change the interface to MR_(agc_)deep_copy() so that the first
argument is a value, not a pointer.
runtime/mercury_accurate_gc.c:
Add code to MR_garbage_collect() to initialize the forwarding
pointer bitmap.
runtime/mercury_accurate_gc.c:
library/builtin.m:
library/private_builtin.m:
library/exception.m:
library/std_util.m:
Update calls to MR_(agc_)deep_copy() to reflect the new interface.
runtime/mercury_accurate_gc.h:
runtime/mercury_accurate_gc.c:
Delete the code for handling saved heap pointers.
runtime/mercury_type_info.c:
compiler/mlds_to_c.m:
When allocating type_infos or typeclass_infos on the Mercury heap,
allocate an extra word at the start, for use as a forwarding
pointer. With most objects, we can just overwrite the fields
of the old copy of the object (in the "from-space"), but we
can't do that for type_infos or typeclass_infos, since they need
to remain valid during garbage collection, because the GC's
tracing code uses them.
XXX remember to check that this diff includes all
the relevant files that have been changed!
Workspace: /home/ceres/fjh/mercury
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.130
diff -u -d -r1.130 mlds_to_c.m
--- compiler/mlds_to_c.m 30 May 2002 12:55:06 -0000 1.130
+++ compiler/mlds_to_c.m 6 Jun 2002 03:38:13 -0000
@@ -2718,7 +2718,23 @@
globals__io_get_gc_method(GC_Method),
( { GC_Method = accurate } ->
mlds_indent(Context, Indent + 1),
- io__write_string("MR_GC_check();\n")
+ io__write_string("MR_GC_check();\n"),
+ % For types which hold RTTI that will be traversed
+ % by the collector at GC-time, we need to allocate
+ % an extra word at the start, to hold the forwarding
+ % pointer. Normally we would just overwrite the
+ % first word of the object in the "from" space,
+ % but this can't be done for objects which will be
+ % referenced during the garbage collection process.
+ ( { type_needs_forwarding_pointer_space(Type) = yes } ->
+ mlds_indent(Context, Indent + 1),
+ io__write_string(
+ "/* reserve space for GC forwarding pointer*/\n"),
+ mlds_indent(Context, Indent + 1),
+ io__write_string("MR_hp_alloc(1);\n")
+ ;
+ []
+ )
;
[]
),
@@ -2853,6 +2869,35 @@
mlds_output_target_code_component(_Context, name(Name)) -->
mlds_output_fully_qualified_name(Name),
io__write_string("\n").
+
+:- func type_needs_forwarding_pointer_space(mlds__type) = bool.
+type_needs_forwarding_pointer_space(mlds__type_info_type) = yes.
+type_needs_forwarding_pointer_space(mlds__pseudo_type_info_type) = yes.
+type_needs_forwarding_pointer_space(mercury_type(Type, _, _)) =
+ (if is_introduced_type_info_type(Type) then yes else no).
+type_needs_forwarding_pointer_space(mercury_array_type(_)) = no.
+type_needs_forwarding_pointer_space(mlds__cont_type(_)) = no.
+type_needs_forwarding_pointer_space(mlds__commit_type) = no.
+type_needs_forwarding_pointer_space(mlds__native_bool_type) = no.
+type_needs_forwarding_pointer_space(mlds__native_int_type) = no.
+type_needs_forwarding_pointer_space(mlds__native_float_type) = no.
+type_needs_forwarding_pointer_space(mlds__native_char_type) = no.
+type_needs_forwarding_pointer_space(mlds__foreign_type(_)) = no.
+type_needs_forwarding_pointer_space(mlds__class_type(_, _, _)) = no.
+type_needs_forwarding_pointer_space(mlds__array_type(_)) = no.
+type_needs_forwarding_pointer_space(mlds__ptr_type(_)) = no.
+type_needs_forwarding_pointer_space(mlds__func_type(_)) = no.
+type_needs_forwarding_pointer_space(mlds__generic_type) = no.
+type_needs_forwarding_pointer_space(mlds__generic_env_ptr_type) = no.
+type_needs_forwarding_pointer_space(mlds__rtti_type(_)) = _ :-
+ % these should all be statically allocated, not dynamically allocated,
+ % so we should never get here
+ unexpected(this_file,
+ "type_needs_forwarding_pointer_space: rtti_type").
+type_needs_forwarding_pointer_space(mlds__unknown_type) = _ :-
+ unexpected(this_file,
+ "type_needs_forwarding_pointer_space: unknown_type").
+
:- pred mlds_output_init_args(list(mlds__rval), list(mlds__type), mlds__context,
int, mlds__lval, mlds__tag, indent, io__state, io__state).
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.70
diff -u -d -r1.70 builtin.m
--- library/builtin.m 20 May 2002 08:26:12 -0000 1.70
+++ library/builtin.m 5 Jun 2002 06:47:09 -0000
@@ -876,12 +876,12 @@
aliasing, and in particular the lack of support for `ui' modes.
:- pragma c_code(copy(Value::ui, Copy::uo), "
MR_save_transient_registers();
- Copy = MR_deep_copy(&Value, TypeInfo_for_T, NULL, NULL);
+ Copy = MR_deep_copy(Value, TypeInfo_for_T, NULL, NULL);
MR_restore_transient_registers();
").
:- pragma c_code(copy(Value::in, Copy::uo), "
MR_save_transient_registers();
- Copy = MR_deep_copy(&Value, TypeInfo_for_T, NULL, NULL);
+ Copy = MR_deep_copy(Value, TypeInfo_for_T, NULL, NULL);
MR_restore_transient_registers();
").
*************/
@@ -909,7 +909,7 @@
MR_Box value, MR_Box *copy)
{
MR_Word val = (MR_Word) value;
- *copy = (MR_Box) MR_deep_copy(&val, (MR_TypeInfo) type_info,
+ *copy = (MR_Box) MR_deep_copy(val, (MR_TypeInfo) type_info,
NULL, NULL);
}
@@ -966,7 +966,7 @@
value = MR_stackvar(2); \
\
MR_save_transient_registers(); \
- copy = MR_deep_copy(&value, type_info, NULL, NULL); \
+ copy = MR_deep_copy(value, type_info, NULL, NULL); \
MR_restore_transient_registers(); \
\
MR_stackvar(1) = copy; \
@@ -989,7 +989,7 @@
value = MR_r2; \
\
MR_save_transient_registers(); \
- copy = MR_deep_copy(&value, type_info, NULL, NULL); \
+ copy = MR_deep_copy(value, type_info, NULL, NULL); \
MR_restore_transient_registers(); \
\
MR_r1 = copy; \
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.62
diff -u -d -r1.62 exception.m
--- library/exception.m 5 Jun 2002 05:10:05 -0000 1.62
+++ library/exception.m 5 Jun 2002 06:48:23 -0000
@@ -1860,7 +1860,7 @@
assert(MR_EXCEPTION_STRUCT->MR_excp_heap_ptr <=
MR_EXCEPTION_STRUCT->MR_excp_heap_zone->top);
MR_save_transient_registers();
- exception = MR_deep_copy(&exception,
+ exception = MR_deep_copy(exception,
(MR_TypeInfo) &mercury_data_std_util__type_ctor_info_univ_0,
MR_EXCEPTION_STRUCT->MR_excp_heap_ptr,
MR_EXCEPTION_STRUCT->MR_excp_heap_zone->top);
@@ -1877,7 +1877,7 @@
assert(MR_EXCEPTION_STRUCT->MR_excp_solns_heap_ptr <=
MR_ENGINE(MR_eng_solutions_heap_zone)->top);
MR_save_transient_registers();
- exception = MR_deep_copy(&exception,
+ exception = MR_deep_copy(exception,
(MR_TypeInfo) &mercury_data_std_util__type_ctor_info_univ_0,
saved_solns_heap_ptr,
MR_ENGINE(MR_eng_solutions_heap_zone)->top);
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.100
diff -u -d -r1.100 private_builtin.m
--- library/private_builtin.m 27 Mar 2002 05:18:45 -0000 1.100
+++ library/private_builtin.m 5 Jun 2002 06:48:50 -0000
@@ -1183,7 +1183,7 @@
"
#ifdef MR_NATIVE_GC
*(MR_Word *)Pointer =
- MR_agc_deep_copy((MR_Word *) Pointer,
+ MR_agc_deep_copy(* (MR_Word *) Pointer,
(MR_TypeInfo) TypeInfo_for_T,
MR_ENGINE(MR_eng_heap_zone2->min),
MR_ENGINE(MR_eng_heap_zone2->hardmax));
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.266
diff -u -d -r1.266 std_util.m
--- library/std_util.m 25 Apr 2002 09:31:52 -0000 1.266
+++ library/std_util.m 5 Jun 2002 06:49:22 -0000
@@ -1164,7 +1164,7 @@
OldVar, NewVal, TypeInfo_for_T) \\
do { \\
MR_save_transient_hp(); \\
- NewVal = MR_deep_copy(&OldVal, (MR_TypeInfo) TypeInfo_for_T,\\
+ NewVal = MR_deep_copy(OldVal, (MR_TypeInfo) TypeInfo_for_T,\\
(const MR_Word *) SolutionsHeapPtr, \\
MR_ENGINE(MR_eng_solutions_heap_zone)->top); \\
MR_restore_transient_hp(); \\
Index: runtime/mercury_accurate_gc.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_accurate_gc.c,v
retrieving revision 1.20
diff -u -d -r1.20 mercury_accurate_gc.c
--- runtime/mercury_accurate_gc.c 4 Jun 2002 09:33:38 -0000 1.20
+++ runtime/mercury_accurate_gc.c 5 Jun 2002 15:57:51 -0000
@@ -60,39 +60,6 @@
/* The last root on the list */
static MR_RootList last_root = NULL;
-/*
-** During garbage collection, when traversing from the roots, we may
-** encounter saved heap pointers. We want to handle these by just
-** resetting them to point to the first free byte of the new heap,
-** but until the collection has finished, we don't know much of the
-** new heap will be used. So when traversing saved heap pointers,
-** we just put them onto a list; when we've finished traversing
-** all the roots, we can then fill in the correct values for the
-** saved heap pointers.
-**
-** To avoid the need for dynamic allocation,
-** the list is stored in saved heap pointers themselves.
-** We represent the list by just chaining the saved heap pointers
-** together, so that each saved heap pointer points to the next one.
-** The `MR_saved_heap_pointers_list' variable points to the start of
-** this list.
-*/
-MR_Word *MR_saved_heap_pointers_list;
-
-static void
-fixup_saved_heap_pointers(MR_Word *new_hp)
-{
- MR_Word *p;
- MR_Word next;
-
- for (p = MR_saved_heap_pointers_list; p != NULL; p = (MR_Word *) next)
- {
- next = *p;
- *p = (MR_Word) new_hp;
- }
- MR_saved_heap_pointers_list = NULL;
-}
-
#ifdef MR_HIGHLEVEL_CODE
/*
@@ -109,6 +76,10 @@
{
MR_MemoryZone *old_heap, *new_heap;
MR_Word *old_hp, *new_hp;
+ size_t heap_size_in_words;
+ size_t num_words_for_bitmap;
+ size_t num_bytes_for_bitmap;
+ static size_t prev_num_bytes_for_bitmap;
old_heap = MR_ENGINE(MR_eng_heap_zone);
new_heap = MR_ENGINE(MR_eng_heap_zone2);
@@ -132,6 +103,21 @@
MR_virtual_hp = new_heap->min;
/*
+ ** Initialize the forwarding pointer bitmap.
+ */
+ heap_size_in_words = old_heap->hardmax - old_heap->min;
+ num_words_for_bitmap = (heap_size_in_words + MR_WORDBITS - 1) / MR_WORDBITS;
+ num_bytes_for_bitmap = num_words_for_bitmap * sizeof(MR_Word);
+ if (MR_has_forwarding_pointer == NULL
+ || num_bytes_for_bitmap > prev_num_bytes_for_bitmap)
+ {
+ MR_has_forwarding_pointer = MR_realloc(MR_has_forwarding_pointer,
+ num_bytes_for_bitmap);
+ prev_num_bytes_for_bitmap = num_bytes_for_bitmap;
+ }
+ memset(MR_has_forwarding_pointer, 0, num_bytes_for_bitmap);
+
+ /*
** Swap the two heaps.
*/
{
@@ -157,8 +143,6 @@
*/
garbage_collect_roots();
- fixup_saved_heap_pointers(MR_virtual_hp);
-
#ifdef MR_DEBUG_AGC_COLLECTION
fprintf(stderr, "Clearing old heap:\n");
@@ -732,7 +716,7 @@
case MR_LONG_LVAL_TYPE_R:
if (copy_regs) {
MR_virtual_reg(locn_num) = MR_agc_deep_copy(
- &MR_virtual_reg(locn_num), type_info,
+ MR_virtual_reg(locn_num), type_info,
MR_ENGINE(MR_eng_heap_zone2->min),
MR_ENGINE(MR_eng_heap_zone2->hardmax));
}
@@ -743,7 +727,7 @@
case MR_LONG_LVAL_TYPE_STACKVAR:
MR_based_stackvar(stack_pointer, locn_num) =
- MR_agc_deep_copy(&MR_based_stackvar(
+ MR_agc_deep_copy(MR_based_stackvar(
stack_pointer,locn_num),
type_info,
MR_ENGINE(MR_eng_heap_zone2->min),
@@ -753,7 +737,7 @@
case MR_LONG_LVAL_TYPE_FRAMEVAR:
MR_based_framevar(current_frame, locn_num) =
MR_agc_deep_copy(
- &MR_based_framevar(current_frame, locn_num),
+ MR_based_framevar(current_frame, locn_num),
type_info,
MR_ENGINE(MR_eng_heap_zone2->min),
MR_ENGINE(MR_eng_heap_zone2->hardmax));
@@ -798,7 +782,7 @@
if (copy_regs) {
locn_num = MR_SHORT_LVAL_NUMBER(locn);
MR_virtual_reg(locn_num) = MR_agc_deep_copy(
- &MR_virtual_reg(locn_num), type_info,
+ MR_virtual_reg(locn_num), type_info,
MR_ENGINE(MR_eng_heap_zone2->min),
MR_ENGINE(MR_eng_heap_zone2->hardmax));
}
@@ -807,7 +791,7 @@
case MR_SHORT_LVAL_TYPE_STACKVAR:
locn_num = MR_SHORT_LVAL_NUMBER(locn);
MR_based_stackvar(stack_pointer, locn_num) =
- MR_agc_deep_copy(&MR_based_stackvar(
+ MR_agc_deep_copy(MR_based_stackvar(
stack_pointer,locn_num),
type_info,
MR_ENGINE(MR_eng_heap_zone2->min),
@@ -818,7 +802,7 @@
locn_num = MR_SHORT_LVAL_NUMBER(locn);
MR_based_framevar(current_frame, locn_num) =
MR_agc_deep_copy(
- &MR_based_framevar(current_frame,
+ MR_based_framevar(current_frame,
locn_num),
type_info,
MR_ENGINE(MR_eng_heap_zone2->min),
@@ -847,7 +831,7 @@
MR_RootList current = root_list;
while (current != NULL) {
- *current->root = MR_agc_deep_copy(current->root,
+ *current->root = MR_agc_deep_copy(*current->root,
current->type_info, MR_ENGINE(MR_eng_heap_zone2->min),
MR_ENGINE(MR_eng_heap_zone2->hardmax));
current = current->next;
Index: runtime/mercury_accurate_gc.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_accurate_gc.h,v
retrieving revision 1.13
diff -u -d -r1.13 mercury_accurate_gc.h
--- runtime/mercury_accurate_gc.h 5 Mar 2002 08:49:17 -0000 1.13
+++ runtime/mercury_accurate_gc.h 5 Jun 2002 07:57:54 -0000
@@ -60,11 +60,5 @@
extern void MR_agc_add_root(MR_Word *root_addr, MR_TypeInfo type_info);
-/*
-** A list of the saved heap pointers.
-** See documentation in mercury_accurate_gc.c.
-*/
-extern MR_Word *MR_saved_heap_pointers_list;
-
/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_ACCURATE_GC_H */
Index: runtime/mercury_deep_copy.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.c,v
retrieving revision 1.28
diff -u -d -r1.28 mercury_deep_copy.c
--- runtime/mercury_deep_copy.c 5 Mar 2002 08:49:17 -0000 1.28
+++ runtime/mercury_deep_copy.c 5 Jun 2002 15:55:44 -0000
@@ -29,12 +29,6 @@
#define in_range(X) (lower_limit == NULL || \
((X) >= lower_limit && (X) <= upper_limit))
-#undef in_traverse_range
-#define in_traverse_range(X) (MR_FALSE)
-
-#undef maybeconst
-#define maybeconst const
-
#undef copy
#define copy MR_deep_copy
@@ -47,14 +41,14 @@
#undef copy_typeclass_info
#define copy_typeclass_info MR_deep_copy_typeclass_info
-#undef leave_forwarding_pointer
-#define leave_forwarding_pointer(DataPtr, NewData)
+#undef if_forwarding_pointer
+#define if_forwarding_pointer(Data, ACTION)
-#undef found_forwarding_pointer
-#define found_forwarding_pointer(Data)
+#undef leave_forwarding_pointer
+#define leave_forwarding_pointer(Data, Offset, NewData)
-#undef handle_saved_heap_pointers
-#define handle_saved_heap_pointers MR_FALSE
+#undef found_out_of_range_pointer
+#define found_out_of_range_pointer(Data)
#include "mercury_deep_copy_body.h"
@@ -64,17 +58,10 @@
*/
#ifdef MR_NATIVE_GC
+ /* in_range() is true iff X is in the from-space */
#undef in_range
#define in_range(X) ((X) >= lower_limit && (X) <= upper_limit)
-#undef in_traverse_range(X)
-#define in_traverse_range(X) \
- ((X) >= MR_ENGINE(MR_eng_solutions_heap_zone)->min && \
- (X) <= MR_ENGINE(MR_eng_solutions_heap_zone)->hardmax)
-
-#undef maybeconst
-#define maybeconst
-
#undef copy
#define copy MR_agc_deep_copy
@@ -91,23 +78,50 @@
#define FORWARD_DEBUG_MSG(Msg, Data) \
fprintf(stderr, Msg, Data)
#else
- #define FORWARD_DEBUG_MSG(Msg, Data)
+ #define FORWARD_DEBUG_MSG(Msg, Data) ((void)0)
#endif
+/*
+** This points to a bitmap, which is used to record which objects
+** have already been copied and now hold forwarding pointers.
+*/
+MR_Word *MR_has_forwarding_pointer;
+
+#define mark_as_forwarding_pointer(Data) \
+ do { \
+ size_t fwdptr_offset = \
+ (MR_Word *)(Data) - (MR_Word *)lower_limit; \
+ size_t fwdptr_word = fwdptr_offset / MR_WORDBITS; \
+ size_t fwdptr_bit = fwdptr_offset % MR_WORDBITS; \
+ MR_has_forwarding_pointer[fwdptr_word] |= (1 << fwdptr_bit); \
+ } while (0)
+
+#undef if_forwarding_pointer
+#define if_forwarding_pointer(Data, ACTION) \
+ do { \
+ size_t fwdptr_offset = \
+ (MR_Word *)(Data) - (MR_Word *)lower_limit; \
+ size_t fwdptr_word = fwdptr_offset / MR_WORDBITS; \
+ size_t fwdptr_bit = fwdptr_offset % MR_WORDBITS; \
+ if (MR_has_forwarding_pointer[fwdptr_word] & \
+ (1 << fwdptr_bit)) \
+ { \
+ ACTION; \
+ } \
+ } while (0)
+
#undef leave_forwarding_pointer
-#define leave_forwarding_pointer(DataPtr, NewData) \
- if (in_range(DataPtr)) { \
- FORWARD_DEBUG_MSG("forwarding to %lx\n",\
+#define leave_forwarding_pointer(Data, Offset, NewData) \
+ do { \
+ FORWARD_DEBUG_MSG("forwarding to %lx\n", \
(long) NewData); \
- *DataPtr = NewData; \
- }
-
-#undef found_forwarding_pointer
-#define found_forwarding_pointer(Data) \
- FORWARD_DEBUG_MSG("not on this heap: %lx\n", (long) Data);
+ *(((MR_Word *)Data) + Offset) = NewData; \
+ mark_as_forwarding_pointer(Data); \
+ } while (0)
-#undef handle_saved_heap_pointers
-#define handle_saved_heap_pointers MR_TRUE
+#undef found_out_of_range_pointer
+#define found_out_of_range_pointer(Data) \
+ FORWARD_DEBUG_MSG("not on this heap: %lx\n", (long) Data)
#include "mercury_deep_copy_body.h"
@@ -148,7 +162,7 @@
/* copy values from the heap to the global heap */
MR_save_transient_hp();
- result = MR_deep_copy(&term, type_info, lower_limit,
+ result = MR_deep_copy(term, type_info, lower_limit,
MR_ENGINE(MR_eng_global_heap_zone)->top);
MR_restore_transient_hp();
Index: runtime/mercury_deep_copy.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.h,v
retrieving revision 1.13
diff -u -d -r1.13 mercury_deep_copy.h
--- runtime/mercury_deep_copy.h 13 Feb 2002 09:56:39 -0000 1.13
+++ runtime/mercury_deep_copy.h 5 Jun 2002 08:39:52 -0000
@@ -64,7 +64,7 @@
** MR_deep_copy to do both.
*/
-MR_Word MR_deep_copy(const MR_Word *data_ptr, MR_TypeInfo type_info,
+MR_Word MR_deep_copy(MR_Word data, MR_TypeInfo type_info,
const MR_Word *lower_limit, const MR_Word *upper_limit);
/*
@@ -92,8 +92,15 @@
** (which is possible with normal MR_deep_copy).
*/
-MR_Word MR_agc_deep_copy(MR_Word *data_ptr, MR_TypeInfo type_info,
+MR_Word MR_agc_deep_copy(MR_Word data, MR_TypeInfo type_info,
const MR_Word *lower_limit, const MR_Word *upper_limit);
+
+/*
+** This holds a bitmap used by MR_agc_deep_copy() to record which
+** objects have already been copied and hence contain forwarding
+** pointers. It gets initialized by MR_garbage_collect().
+*/
+extern MR_Word *MR_has_forwarding_pointer;
/*
** MR_make_permanent:
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.54
diff -u -d -r1.54 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 4 Jun 2002 14:28:57 -0000 1.54
+++ runtime/mercury_deep_copy_body.h 5 Jun 2002 17:20:42 -0000
@@ -19,31 +19,74 @@
** Prototypes.
*/
-static MR_Word copy_arg(maybeconst MR_Word *parent_data_ptr,
- maybeconst MR_Word *data_ptr,
+static MR_Word copy_arg(const MR_Word *parent_data_ptr, MR_Word data,
const MR_DuFunctorDesc *functor_descriptor,
const MR_TypeInfoParams type_params,
const MR_PseudoTypeInfo arg_pseudotype_info,
const MR_Word *lower_limit,
const MR_Word *upper_limit);
-static MR_TypeInfo copy_type_info(maybeconst MR_TypeInfo *type_info_ptr,
+static MR_TypeInfo copy_type_info(MR_TypeInfo type_info,
const MR_Word *lower_limit,
const MR_Word *upper_limit);
-static MR_Word copy_typeclass_info(maybeconst MR_Word
- *typeclass_info_ptr, const MR_Word *lower_limit,
+static MR_Word copy_typeclass_info(MR_Word typeclass_info,
+ const MR_Word *lower_limit,
const MR_Word *upper_limit);
+/*
+** We need to make sure that we don't clobber any part of
+** the closure which might be used by the collector for
+** tracing stack frames of closure wrapper functions.
+** So we store the forwarding pointer for closure in the MR_closure_code
+** field (which is not used by the collector), rather than
+** at offset zero (where it would clobber the closure layout,
+** which is used by the collector).
+*/
+#define CLOSURE_FORWARDING_PTR_OFFSET \
+ (offsetof(MR_Closure, MR_closure_code) / sizeof(MR_Word))
+
+/*
+** We must not clobber type_infos or typeclass_infos with forwarding pointers,
+** since they may be referenced by the garbage collector during
+** collection. Unfortunately in this case there is no spare field
+** which we can use. So we allocate an extra word before the front of
+** the object (see the code for new_object in compiler/mlds_to_c.m),
+** and use that for the forwarding pointer. Hence the offsets here
+** are -1, meaning one word before the start of the object.
+*/
+#define TYPEINFO_FORWARDING_PTR_OFFSET -1
+#define TYPECLASSINFO_FORWARDING_PTR_OFFSET -1
+
+/*
+** RETURN_IF_OUT_OF_RANGE(MR_Word *pointer, int forwarding_pointer_offset):
+** Check if `pointer' is either out of range, or has already been
+** processed, and if so, return (from the function that called this macro)
+** with the appropriate value.
+**
+** If the pointer is out of range, we return the value unchanged.
+** If the pointer has already been processed, then return the forwarding
+** pointer that was saved in the object, which will be stored at
+** pointer[forwarding_pointer_offset].
+*/
+#define RETURN_IF_OUT_OF_RANGE(pointer, offset, rettype) \
+ do { \
+ if (!in_range(pointer)) { \
+ found_out_of_range_pointer(pointer); \
+ return (rettype) (pointer); \
+ } \
+ if_forwarding_pointer((pointer), \
+ return (rettype) (pointer)[offset]); \
+ } while (0)
+
+
+
MR_Word
-copy(maybeconst MR_Word *data_ptr, MR_TypeInfo type_info,
+copy(MR_Word data, MR_TypeInfo type_info,
const MR_Word *lower_limit, const MR_Word *upper_limit)
{
- MR_Word data;
MR_Word new_data;
MR_TypeCtorInfo type_ctor_info;
MR_DuTypeLayout du_type_layout;
- data = *data_ptr;
-
try_again:
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
@@ -148,11 +191,12 @@
cur_slot = 1; \
} \
} while(0)
- \
+
#define MR_handle_sectag_remote_or_none(have_sectag) \
do { \
data_value = (MR_Word *) MR_body(data, ptag); \
- if (in_range(data_value)) { \
+ RETURN_IF_OUT_OF_RANGE(data_value, 0, MR_Word); \
+ { \
const MR_DuFunctorDesc *functor_desc; \
const MR_DuExistInfo *exist_info; \
int sectag; \
@@ -200,15 +244,15 @@
\
for (i = 0; i < num_ti_plain; i++) { \
MR_field(0, new_data, cur_slot) = (MR_Word) \
- copy_type_info((MR_TypeInfo *) \
- &data_value[cur_slot], \
+ copy_type_info((MR_TypeInfo) \
+ data_value[cur_slot], \
lower_limit, upper_limit); \
cur_slot++; \
} \
\
for (i = 0; i < num_tci; i++) { \
MR_field(0, new_data, cur_slot) = (MR_Word) \
- copy_typeclass_info(&data_value[cur_slot], \
+ copy_typeclass_info(data_value[cur_slot], \
lower_limit, upper_limit); \
cur_slot++; \
} \
@@ -222,7 +266,7 @@
parent_data++; \
} \
MR_field(0, new_data, cur_slot) = \
- copy_arg(parent_data, &data_value[cur_slot], \
+ copy_arg(parent_data, data_value[cur_slot], \
functor_desc, \
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR( \
type_info), \
@@ -230,7 +274,7 @@
lower_limit, upper_limit); \
} else { \
MR_field(0, new_data, cur_slot) = \
- copy(&data_value[cur_slot], \
+ copy(data_value[cur_slot], \
MR_pseudo_type_info_is_ground( \
functor_desc->MR_du_functor_arg_types[i]), \
lower_limit, upper_limit); \
@@ -239,10 +283,7 @@
} \
\
new_data = (MR_Word) MR_mkword(ptag, new_data); \
- leave_forwarding_pointer(data_ptr, new_data); \
- } else { \
- new_data = data; \
- found_forwarding_pointer(data); \
+ leave_forwarding_pointer(data_value, 0, new_data); \
} \
} while(0)
@@ -268,7 +309,7 @@
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
- new_data = copy_arg(NULL, data_ptr, NULL,
+ new_data = copy_arg(NULL, data, NULL,
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_notag->
MR_notag_functor_arg_type, lower_limit, upper_limit);
@@ -283,7 +324,7 @@
break;
case MR_TYPECTOR_REP_EQUIV:
- new_data = copy_arg(NULL, data_ptr, NULL,
+ new_data = copy_arg(NULL, data, NULL,
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv,
lower_limit, upper_limit);
@@ -308,7 +349,9 @@
assert(MR_tag(data) == 0);
data_value = (MR_Word *) MR_body(data, MR_mktag(0));
- if (in_range(data_value)) {
+ RETURN_IF_OUT_OF_RANGE(data_value, 0, MR_Word);
+
+ {
MR_restore_transient_hp();
#ifdef MR_HIGHLEVEL_CODE
/*
@@ -322,10 +365,7 @@
new_data = MR_float_to_word(MR_word_to_float(data));
#endif
MR_save_transient_hp();
- leave_forwarding_pointer(data_ptr, new_data);
- } else {
- new_data = data;
- found_forwarding_pointer(data);
+ leave_forwarding_pointer(data_value, 0, new_data);
}
}
#else
@@ -339,17 +379,17 @@
** Not all Mercury strings are aligned; in particular,
** string constants containing the empty string may be
** allocated unaligned storage by the C compiler.
+ ** So we can't do `assert(MR_tag(data) == 0)' here.
*/
- if (in_range((MR_Word *) data)) {
+ RETURN_IF_OUT_OF_RANGE((MR_Word *) data, 0, MR_Word);
+
+ {
MR_incr_saved_hp_atomic(new_data,
(strlen((MR_String) data) + sizeof(MR_Word)) /
sizeof(MR_Word));
strcpy((MR_String) new_data, (MR_String) data);
- leave_forwarding_pointer(data_ptr, new_data);
- } else {
- new_data = data;
- found_forwarding_pointer(data);
+ leave_forwarding_pointer(data, 0, new_data);
}
}
break;
@@ -362,16 +402,17 @@
assert(MR_tag(data) == 0);
data_value = (MR_Word *) MR_body(data, MR_mktag(0));
+ RETURN_IF_OUT_OF_RANGE(data_value, CLOSURE_FORWARDING_PTR_OFFSET,
+ MR_Word);
+
/*
** Closures have the structure given by the MR_Closure type.
**
** Their type_infos have a pointer to type_ctor_info for
** pred/0 or func/0, the number of argument typeinfos,
** and then the argument typeinfos themselves.
- **
- ** XXX pred needs to handle traversals.
*/
- if (in_range(data_value)) {
+ {
MR_Unsigned args, i;
MR_Closure *old_closure;
MR_Closure *new_closure;
@@ -406,7 +447,7 @@
closure_layout->MR_closure_arg_pseudo_type_info[i];
new_closure->MR_closure_hidden_args_0[i] =
copy_arg(NULL,
- &old_closure->MR_closure_hidden_args_0[i], NULL,
+ old_closure->MR_closure_hidden_args_0[i], NULL,
type_info_arg_vector, arg_pseudo_type_info,
lower_limit, upper_limit);
}
@@ -416,12 +457,8 @@
}
new_data = (MR_Word) new_closure;
- leave_forwarding_pointer(data_ptr, new_data);
- } else if (in_traverse_range(data_value)) {
- MR_fatal_error("sorry, unimplemented: traversal of closures");
- } else {
- new_data = data;
- found_forwarding_pointer(data);
+ leave_forwarding_pointer(data, CLOSURE_FORWARDING_PTR_OFFSET,
+ new_data);
}
}
break;
@@ -434,7 +471,9 @@
assert(MR_tag(data) == 0);
data_value = (MR_Word *) MR_body(data, MR_mktag(0));
- if (in_range(data_value)) {
+ RETURN_IF_OUT_OF_RANGE(data_value, 0, MR_Word);
+
+ {
MR_Word *new_data_ptr;
MR_TypeInfo *arg_typeinfo_vector;
@@ -451,15 +490,12 @@
MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
for (i = 0; i < arity; i++) {
/* type_infos are counted from one */
- new_data_ptr[i] = copy(&data_value[i],
+ new_data_ptr[i] = copy(data_value[i],
(const MR_TypeInfo) arg_typeinfo_vector[i + 1],
lower_limit, upper_limit);
}
- leave_forwarding_pointer(data_ptr, new_data);
+ leave_forwarding_pointer(data, 0, new_data);
}
- } else {
- new_data = data;
- found_forwarding_pointer(data);
}
}
break;
@@ -476,7 +512,9 @@
assert(MR_tag(data) == 0);
data_value = (MR_Word *) MR_body(data, MR_mktag(0));
- if (in_range(data_value)) {
+ RETURN_IF_OUT_OF_RANGE(data_value, 0, MR_Word);
+
+ {
MR_ArrayType *new_array;
MR_ArrayType *old_array;
MR_Integer array_size;
@@ -488,34 +526,18 @@
new_array->size = array_size;
for (i = 0; i < array_size; i++) {
new_array->elements[i] = copy_arg(NULL,
- &old_array->elements[i], NULL,
- MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- (const MR_PseudoTypeInfo) 1, lower_limit, upper_limit);
- }
- leave_forwarding_pointer(data_ptr, new_data);
- } else if (in_traverse_range(data_value)) {
- MR_ArrayType *old_array;
- MR_Integer array_size;
-
- old_array = (MR_ArrayType *) data_value;
- array_size = old_array->size;
- for (i = 0; i < array_size; i++) {
- (void) copy_arg(NULL,
- &old_array->elements[i], NULL,
+ old_array->elements[i], NULL,
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
(const MR_PseudoTypeInfo) 1, lower_limit, upper_limit);
}
- new_data = data;
- } else {
- new_data = data;
- found_forwarding_pointer(data);
+ leave_forwarding_pointer(data, 0, new_data);
}
}
break;
case MR_TYPECTOR_REP_TYPEINFO:
case MR_TYPECTOR_REP_TYPEDESC:
- new_data = (MR_Word) copy_type_info((MR_TypeInfo *) data_ptr,
+ new_data = (MR_Word) copy_type_info((MR_TypeInfo) data,
lower_limit, upper_limit);
break;
@@ -533,7 +555,7 @@
break;
case MR_TYPECTOR_REP_TYPECLASSINFO:
- new_data = (MR_Word) copy_typeclass_info(data_ptr,
+ new_data = (MR_Word) copy_typeclass_info(data,
lower_limit, upper_limit);
break;
@@ -551,7 +573,7 @@
data_tag = MR_tag(data);
data_value = (MR_Word *) MR_body(data, data_tag);
- if (in_range(data_value) || in_traverse_range(data_value)) {
+ if (in_range(data_value)) {
/*
** This error occurs if we try to copy() a
** `c_pointer' type that points to memory allocated
@@ -571,33 +593,7 @@
break;
case MR_TYPECTOR_REP_HP:
-#if handle_saved_heap_pointers
- /*
- ** We can't copy saved heap pointer values now,
- ** since we don't know what the new heap pointer will be
- ** after garbage collection has finished.
- ** Instead we just push the saved heap pointer onto a list,
- ** and fill in the correct value later.
- ** See fixup_saved_heap_pointers() in mercury_accurate_gc.c.
- */
- #ifdef MR_DEBUG_AGC_SAVED_HPS
- fprintf(stderr, "found saved heap pointer: "
- "addr = %p, val = %p, chain = %p\n",
- (void *) data_ptr, (void *) data,
- (void *) MR_saved_heap_pointers_list);
- #endif
- /* insert this pointer at the start of the list */
- new_data = *data_ptr = (MR_Word) MR_saved_heap_pointers_list;
- MR_saved_heap_pointers_list = data_ptr;
- break;
-#else
- /*
- ** Copying of saved heap pointers should only occur in native GC
- ** grades. For `--gc none', there can be saved heap pointers,
- ** but they should never be copied.
- */
- MR_fatal_error("Unexpected: copying saved heap pointer");
-#endif
+ MR_fatal_error("Sorry, not implemented: copying saved heap pointer");
case MR_TYPECTOR_REP_CURFR: /* fallthru */
case MR_TYPECTOR_REP_MAXFR:
@@ -632,7 +628,7 @@
*/
static MR_Word
-copy_arg(maybeconst MR_Word *parent_data_ptr, maybeconst MR_Word *data_ptr,
+copy_arg(const MR_Word *parent_data_ptr, MR_Word data,
const MR_DuFunctorDesc *functor_descriptor,
const MR_TypeInfoParams type_params,
const MR_PseudoTypeInfo arg_pseudo_type_info,
@@ -647,19 +643,20 @@
arg_pseudo_type_info, parent_data_ptr,
functor_descriptor, &allocated_memory_cells);
- new_data = copy(data_ptr, new_type_info, lower_limit, upper_limit);
+ new_data = copy(data, new_type_info, lower_limit, upper_limit);
MR_deallocate(allocated_memory_cells);
return new_data;
}
static MR_TypeInfo
-copy_type_info(maybeconst MR_TypeInfo *type_info_ptr,
+copy_type_info(MR_TypeInfo type_info,
const MR_Word *lower_limit, const MR_Word *upper_limit)
{
- MR_TypeInfo type_info = *type_info_ptr;
+ RETURN_IF_OUT_OF_RANGE((MR_Word *) type_info,
+ TYPEINFO_FORWARDING_PTR_OFFSET, MR_TypeInfo);
- if (in_range((MR_Word *) type_info)) {
+ {
MR_TypeCtorInfo type_ctor_info;
MR_Word *new_type_info_arena;
MR_TypeInfo *type_info_args;
@@ -703,25 +700,25 @@
type_ctor_info, new_type_info_args);
}
for (i = 1; i <= arity; i++) {
- new_type_info_args[i] = copy_type_info(&type_info_args[i],
+ new_type_info_args[i] = copy_type_info(type_info_args[i],
lower_limit, upper_limit);
}
- leave_forwarding_pointer((MR_Word *) type_info_ptr,
- (MR_Word) new_type_info_arena);
+ leave_forwarding_pointer((MR_Word) type_info,
+ TYPEINFO_FORWARDING_PTR_OFFSET, (MR_Word) new_type_info_arena);
return (MR_TypeInfo) new_type_info_arena;
- } else {
- found_forwarding_pointer(type_info);
- return type_info;
}
}
static MR_Word
-copy_typeclass_info(maybeconst MR_Word *typeclass_info_ptr,
+copy_typeclass_info(MR_Word typeclass_info_param,
const MR_Word *lower_limit, const MR_Word *upper_limit)
{
- MR_Word *typeclass_info = (MR_Word *) *typeclass_info_ptr;
+ MR_Word *typeclass_info = (MR_Word *) typeclass_info_param;
- if (in_range(typeclass_info)) {
+ RETURN_IF_OUT_OF_RANGE(typeclass_info,
+ TYPECLASSINFO_FORWARDING_PTR_OFFSET, MR_Word);
+
+ {
MR_Word *base_typeclass_info;
MR_Word *new_typeclass_info;
int num_arg_typeinfos;
@@ -755,7 +752,7 @@
*/
for (i = 1; i < num_unconstrained + 1; i++) {
new_typeclass_info[i] = (MR_Word) copy_type_info(
- (MR_TypeInfo *)(&typeclass_info[i]), lower_limit, upper_limit);
+ (MR_TypeInfo) typeclass_info[i], lower_limit, upper_limit);
}
/*
** Next, copy all the typeclass infos: both the ones for
@@ -768,7 +765,7 @@
i++)
{
new_typeclass_info[i] = (MR_Word) copy_typeclass_info(
- &typeclass_info[i], lower_limit, upper_limit);
+ typeclass_info[i], lower_limit, upper_limit);
}
/*
@@ -781,13 +778,11 @@
i++)
{
new_typeclass_info[i] = (MR_Word) copy_type_info(
- (MR_TypeInfo *) &typeclass_info[i], lower_limit, upper_limit);
+ (MR_TypeInfo) typeclass_info[i], lower_limit, upper_limit);
}
- leave_forwarding_pointer(typeclass_info_ptr,
- (MR_Word) new_typeclass_info);
+ leave_forwarding_pointer(typeclass_info,
+ TYPECLASSINFO_FORWARDING_PTR_OFFSET,
+ (MR_Word) new_typeclass_info);
return (MR_Word) new_typeclass_info;
- } else {
- found_forwarding_pointer(typeclass_info);
- return (MR_Word) typeclass_info;
}
}
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.51
diff -u -d -r1.51 mercury_type_info.c
--- runtime/mercury_type_info.c 12 Apr 2002 01:24:24 -0000 1.51
+++ runtime/mercury_type_info.c 5 Jun 2002 16:37:18 -0000
@@ -56,10 +56,21 @@
#define exist_func_string "MR_create_type_info_maybe_existq"
#define MAYBE_DECLARE_ALLOC_ARG
#define MAYBE_PASS_ALLOC_ARG
-#define ALLOCATE_WORDS(target, size) MR_incr_saved_hp( \
- MR_LVALUE_CAST(MR_Word, \
- (target)), \
- (size))
+#ifdef MR_NATIVE_GC
+ #define ALLOCATE_WORDS(target, size) \
+ do { \
+ /* reserve one extra word for GC forwarding pointer */ \
+ /* (see comments in compiler/mlds_to_c.m for details) */ \
+ MR_incr_saved_hp(MR_LVALUE_CAST(MR_Word, (target)), 1); \
+ MR_incr_saved_hp(MR_LVALUE_CAST(MR_Word, (target)), (size)); \
+ } while (0)
+#else /* !MR_NATIVE_GC */
+ #define ALLOCATE_WORDS(target, size) \
+ do { \
+ MR_incr_saved_hp(MR_LVALUE_CAST(MR_Word, (target)), (size)); \
+ } while (0)
+#endif /* !MR_NATIVE_GC */
+
#include "mercury_make_type_info_body.h"
#undef usual_func
#undef exist_func
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
The University of Melbourne | of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list