[m-dev.] For review: Add implementation of reference types (global heap)
Warwick Harvey
wharvey at cs.monash.edu.au
Wed Jun 10 16:38:45 AEST 1998
Okay, here goes one more time... :-) This is a relative diff against the
last diff posted. Most of the changes are "trivial", but the addition to
the reference manual probably warrants some attention (I don't know texinfo,
so I've just done my usual "cut and hack" and it *seems* to have worked...).
================================================================
diff -ur old_mercury/doc/reference_manual.texi mercury/doc/reference_manual.t
exi
--- old_mercury/doc/reference_manual.texi Thu Jun 4 11:03:35 1998
+++ mercury/doc/reference_manual.texi Wed Jun 10 16:03:42 1998
@@ -3555,6 +3555,41 @@
and use @samp{pragma export} to access them from C.
This alternative method also works with conservative garbage collection.
+If you wish to retain references to Mercury terms after backtracking beyond
+their initial allocation point, there are now two functions available to
+assist with this:
+
+ at table @b
+ at item @bullet{} @code{MR_make_permanent()}
+Prototype:
+ at example
+void MR_make_permanent(Word @var{term}, Word *@var{type_info});
+ at end example
+
+Ensures that the Mercury term @var{term} is accessible even after
+backtracking beyond its initial allocation point.
+ at var{type_info} provides the type information for @var{term}.
+
+ at item @bullet{} @code{MR_make_long_lived()}
+Prototype:
+ at example
+void MR_make_long_lived(Word @var{term}, Word *@var{type_info}, Word
*@var{lower_limit});
+ at end example
+
+Ensures that the Mercury term @var{term} is accessible at least until
+execution backtracks beyond the point where the memory at @var{lower_limit}
+was allocated on the heap.
+If @var{lower_limit} is not a heap address, then
+ at samp{MR_make_long_lived(@var{term}, @var{type_info}, @var{lower_limit})}
+is equivalent to @samp{MR_make_permanent(@var{term}, @var{type_info})}.
+
+ at end table
+
+Note that with the current implementation, if no garbage collecting is being
+done, these functions work by copying @var{term} (or the relevant parts
+thereof) to a separate heap area which is never reclaimed.
+With conservative garbage collection, these functions do nothing.
+
Future Mercury implementations may use non-conservative methods
of garbage collection. For such implementations, it will be necessary
to explicitly register pointers passed to C with the garbage collector.
================================================================
diff -ur old_mercury/extras/references/nb_reference.m
mercury/extras/references/nb_reference.m
--- old_mercury/extras/references/nb_reference.m Tue Jun 9 11:53:18 1998
+++ mercury/extras/references/nb_reference.m Wed Jun 10 14:33:05 1998
@@ -50,8 +50,7 @@
:- implementation.
-% This type is not really used. I'd rather define this as c_pointer, but
-% there's a bug in the Mercury compiler that makes that not work.
+% This type is implemented in C.
:- type nb_reference(T) ---> nb_reference(c_pointer).
:- pragma c_header_code("#include ""mercury_deep_copy.h""").
@@ -59,10 +58,14 @@
:- pragma inline(new_nb_reference/2).
:- pragma c_code(new_nb_reference(X::in, Ref::out), will_not_call_mercury, "
incr_hp(Ref, 1);
+#ifndef CONSERVATIVE_GC
save_transient_registers();
- *(Word *)Ref = MR_make_long_lived(X, (Word *) TypeInfo_for_T,
+#endif
+ *(Word *) Ref = MR_make_long_lived(X, (Word *) TypeInfo_for_T,
(Word *) Ref);
+#ifndef CONSERVATIVE_GC
restore_transient_registers();
+#endif
").
:- pragma inline(value/2).
@@ -72,9 +75,13 @@
:- pragma inline(update/2).
:- pragma c_code(update(Ref::in, X::in), will_not_call_mercury, "
+#ifndef CONSERVATIVE_GC
save_transient_registers();
- *(Word *)Ref = MR_make_long_lived(X, (Word *) TypeInfo_for_T,
+#endif
+ *(Word *) Ref = MR_make_long_lived(X, (Word *) TypeInfo_for_T,
(Word *) Ref);
+#ifndef CONSERVATIVE_GC
restore_transient_registers();
+#endif
").
================================================================
diff -ur old_mercury/extras/references/reference.m
mercury/extras/references/reference.m
--- old_mercury/extras/references/reference.m Tue Jun 9 16:57:25 1998
+++ mercury/extras/references/reference.m Wed Jun 10 14:13:47 1998
@@ -48,8 +48,7 @@
:- implementation.
-% This type is not really used. I'd rather define this as c_pointer, but
-% there's a bug in the Mercury compiler that makes that not work.
+% This type is implemented in C.
:- type reference(T) ---> reference(c_pointer).
:- pragma c_header_code("#include ""mercury_trail.h""").
@@ -57,28 +56,28 @@
typedef struct {
void *value;
MR_ChoicepointId id;
- } Reference, *RefPtr;
+ } ME_Reference;
").
:- pragma inline(new_reference/2).
:- pragma c_code(new_reference(X::in, Ref::out), will_not_call_mercury, "
- incr_hp(Ref, (sizeof(Reference) + sizeof(Word) - 1) / sizeof(Word));
- ((RefPtr)Ref)->value = (void *)X;
- ((RefPtr)Ref)->id = MR_current_choicepoint_id();
+ incr_hp(Ref, (sizeof(ME_Reference) + sizeof(Word) - 1) / sizeof(Word));
+ ((ME_Reference *) Ref)->value = (void *) X;
+ ((ME_Reference *) Ref)->id = MR_current_choicepoint_id();
").
:- pragma inline(value/2).
:- pragma c_code(value(Ref::in, X::out), will_not_call_mercury, "
- X = (Word) ((RefPtr)Ref)->value;
+ X = (Word) ((ME_Reference *) Ref)->value;
").
:- pragma inline(update/2).
:- pragma c_code(update(Ref::in, X::in), will_not_call_mercury, "
- RefPtr ref = (RefPtr) Ref;
+ ME_Reference *ref = (ME_Reference *) Ref;
if (ref->id != MR_current_choicepoint_id()) {
- MR_trail_current_value((Word*)(&ref->value));
- MR_trail_current_value((Word*)(&ref->id));
+ MR_trail_current_value((Word *) (&ref->value));
+ MR_trail_current_value((Word *) (&ref->id));
ref->id = MR_current_choicepoint_id();
}
- ref->value = (void *)X;
+ ref->value = (void *) X;
").
================================================================
diff -ur old_mercury/extras/references/scoped_update.m
mercury/extras/references/scoped_update.m
--- old_mercury/extras/references/scoped_update.m Tue Jun 9 16:38:01 1998
+++ mercury/extras/references/scoped_update.m Wed Jun 10 14:35:59 1998
@@ -66,7 +66,7 @@
#include ""mercury_trail.h""
/*
-** To handle the scoping, we use a ScopeHandle data structure, which
+** To handle the scoping, we use a ME_ScopeHandle data structure, which
** holds both the value inside and outside the scope. Then we have
** four functions to handle entering and leaving the scope both
** forwards (on success) and backwards (on failure). The user only
@@ -79,74 +79,77 @@
Word *var;
Word insideval;
Word outsideval;
-} *ScopeHandle;
+} *ME_ScopeHandle;
-void ME_enter_scope_failing(ScopeHandle handle, MR_untrail_reason reason);
-void ME_exit_scope_failing(ScopeHandle handle, MR_untrail_reason reason);
+void ME_enter_scope_failing(ME_ScopeHandle handle, MR_untrail_reason
reason);
+void ME_exit_scope_failing(ME_ScopeHandle handle, MR_untrail_reason reason);
#ifdef ME_DEBUG_SCOPE
-#define show_handle(msg, handle) \
- printf(""%s <%5d, in: %5d, out: %5d\n"", msg, *(int *)handle->var, \
- (int) handle->insideval, (int) handle->outsideval)
-#define untrail_msg(msg) \
+ #define ME_show_handle(msg, handle) \
+ printf(""%s <%5d, in: %5d, out: %5d\n"", (msg), \
+ *(int *) (handle)->var, \
+ (int) (handle)->insideval, \
+ (int) (handle)->outsideval)
+ #define ME_untrail_msg(msg) \
printf(msg)
#else
-#define show_handle(msg, handle)
-#define untrail_msg(msg)
+ #define ME_show_handle(msg, handle)
+ #define ME_untrail_msg(msg)
#endif
").
:- pragma c_code("
void
-ME_enter_scope_failing(ScopeHandle handle, MR_untrail_reason reason)
+ME_enter_scope_failing(ME_ScopeHandle handle, MR_untrail_reason reason)
{
switch (reason) {
case MR_exception:
case MR_undo:
- untrail_msg(""ME_enter_scope_failing: ""
+ ME_untrail_msg(""ME_enter_scope_failing: ""
""exception/undo\n"");
- show_handle(""=> fail back into scope. old: "",
+ ME_show_handle(""=> fail back into scope. old: "",
handle);
handle->outsideval = *handle->var;
*handle->var = handle->insideval;
- show_handle(""=> new: "",
+ ME_show_handle(""=> new: "",
handle);
break;
default:
- untrail_msg(""ME_enter_scope_failing: default\n"");
+ ME_untrail_msg(""ME_enter_scope_failing: default\n"");
break;
}
}
-
-void ME_exit_scope_failing(ScopeHandle handle, MR_untrail_reason reason) {
+void
+ME_exit_scope_failing(ME_ScopeHandle handle, MR_untrail_reason reason)
+{
switch (reason) {
case MR_exception:
case MR_undo:
- untrail_msg(""ME_exit_scope_failing: ""
+ ME_untrail_msg(""ME_exit_scope_failing: ""
""exception/undo\n"");
- show_handle(""<= fail back out of scope. old: "",
+ ME_show_handle(""<= fail back out of scope. old: "",
handle);
*handle->var = handle->outsideval;
- show_handle(""<= new: "",
+ ME_show_handle(""<= new: "",
handle);
break;
case MR_commit:
case MR_solve:
- untrail_msg(""ME_exit_scope_failing: commit/solve\n"");
+ ME_untrail_msg(""ME_exit_scope_failing: ""
+ ""commit/solve\n"");
/* This *may* help GC collect more garbage */
- handle->var = (Word *)0;
- handle->outsideval = handle->insideval = (Word)0;
+ handle->var = (Word *) 0;
+ handle->outsideval = handle->insideval = (Word) 0;
break;
default:
- untrail_msg(""ME_exit_scope_failing: default\n"");
+ ME_untrail_msg(""ME_exit_scope_failing: default\n"");
/* we may need to do something if reason == MR_gc */
break;
}
}
-
").
:- type scoped_update_handle == c_pointer.
@@ -154,26 +157,26 @@
:- pragma c_code(enter_scope(Ptr::in, Scoped_update_handle::muo),
will_not_call_mercury, "
Word rec;
- ScopeHandle handle;
+ ME_ScopeHandle handle;
incr_hp(rec, (sizeof(*handle) + sizeof(Word) - 1) / sizeof(Word));
- handle = (ScopeHandle) rec;
- handle->var = (Word *)Ptr;
- handle->insideval = handle->outsideval = *(Word *)Ptr;
+ handle = (ME_ScopeHandle) rec;
+ handle->var = (Word *) Ptr;
+ handle->insideval = handle->outsideval = *(Word *) Ptr;
MR_trail_function(ME_exit_scope_failing, handle);
- show_handle("">> enter scope: "", handle);
+ ME_show_handle("">> enter scope: "", handle);
Scoped_update_handle = (Word) handle;
").
:- pragma c_code(exit_scope(Handle::mdi), will_not_call_mercury, "
- ScopeHandle handle = (ScopeHandle) Handle;
+ ME_ScopeHandle handle = (ME_ScopeHandle) Handle;
- show_handle(""<< exit scope. old: "", handle);
+ ME_show_handle(""<< exit scope. old: "", handle);
handle->insideval = *handle->var;
*handle->var = handle->outsideval;
MR_trail_function(ME_enter_scope_failing, handle);
- show_handle("" new: "", handle);
+ ME_show_handle("" new: "", handle);
").
================================================================
diff -ur old_mercury/extras/references/tests/ref_test.m
mercury/extras/references/tests/ref_test.m
--- old_mercury/extras/references/tests/ref_test.m Tue Jun 9 12:54:42 1998
+++ mercury/extras/references/tests/ref_test.m Wed Jun 10 14:37:55 1998
@@ -78,17 +78,17 @@
scope_test :-
small_int(I),
semipure value(globalvar, V0),
- impure update(globalvar, V0+I),
- impure scope_test_message("before", V0, V0+I),
+ impure update(globalvar, V0 + I),
+ impure scope_test_message("before", V0, V0 + I),
impure enter_scope(globalvar, Handle),
small_int(J),
semipure value(globalvar, V1),
- impure scope_test_message("inside", V1, V1+(J*10)),
- impure update(globalvar, V1+(J*10)),
+ impure scope_test_message("inside", V1, V1 + (J * 10)),
+ impure update(globalvar, V1 + (J * 10)),
impure exit_scope(Handle),
semipure value(globalvar, V2),
- impure update(globalvar, V2+(I*100)),
- impure scope_test_message("after", V2, V2+(I*100)),
+ impure update(globalvar, V2 + (I * 100)),
+ impure scope_test_message("after", V2, V2 + (I * 100)),
fail.
% This predicate checks nested enter/exit scope calls.
@@ -140,7 +140,7 @@
:- pragma c_code(scope_test_message(Prefix::in, Old::in, New::in),
will_not_call_mercury, "
- printf(""%s scope ref = %d; reset to %d\n"", (char *)Prefix,
- (int)Old, (int)New);
+ printf(""%s scope ref = %d; reset to %d\n"", (char *) Prefix,
+ (int) Old, (int) New);
").
================================================================
diff -ur old_mercury/runtime/mercury_deep_copy.c mercury/runtime/mercury_deep
_copy.c
--- old_mercury/runtime/mercury_deep_copy.c Tue Jun 9 14:10:08 1998
+++ mercury/runtime/mercury_deep_copy.c Wed Jun 10 14:49:28 1998
@@ -348,27 +348,21 @@
}
-
-Word
-MR_make_permanent(Word term, Word *type_info)
-{
- return MR_make_long_lived(term, type_info, NULL);
-}
-
-#define swap(val1, val2, type) \
- do { \
- type swap_tmp; \
- swap_tmp = (val1); \
- (val1) = (val2); \
- (val2) = swap_tmp; \
+#define SWAP(val1, val2, type) \
+ do { \
+ type swap_tmp; \
+ swap_tmp = (val1); \
+ (val1) = (val2); \
+ (val2) = swap_tmp; \
} while (0)
+#ifndef CONSERVATIVE_GC
+/*
+** MR_make_long_lived(): see mercury_deep_copy.h for documentation.
+*/
Word
MR_make_long_lived(Word term, Word *type_info, Word *lower_limit)
{
-#ifdef CONSERVATIVE_GC
- return term;
-#else /* not CONSERVATIVE_GC */
Word result;
MemoryZone *tmp_heap_zone;
Word *tmp_hp;
@@ -380,8 +374,8 @@
}
/* temporarily swap the heap with the global heap */
- swap(heap_zone, global_heap_zone, MemoryZone *);
- swap(MR_hp, global_hp, Word *);
+ SWAP(heap_zone, global_heap_zone, MemoryZone *);
+ SWAP(MR_hp, global_hp, Word *);
/* copy values from the heap to the global heap */
save_transient_registers();
@@ -390,12 +384,12 @@
restore_transient_registers();
/* swap the heap and global heap back again */
- swap(heap_zone, global_heap_zone, MemoryZone *);
- swap(MR_hp, global_hp, Word *);
+ SWAP(heap_zone, global_heap_zone, MemoryZone *);
+ SWAP(MR_hp, global_hp, Word *);
save_transient_registers(); /* Because we played with MR_hp */
return result;
-#endif /* not CONSERVATIVE_GC */
}
+#endif /* not CONSERVATIVE_GC */
================================================================
diff -ur old_mercury/runtime/mercury_deep_copy.h mercury/runtime/mercury_deep
_copy.h
--- old_mercury/runtime/mercury_deep_copy.h Tue Jun 9 11:52:14 1998
+++ mercury/runtime/mercury_deep_copy.h Wed Jun 10 14:59:50 1998
@@ -11,7 +11,8 @@
#include "mercury_types.h" /* for `Word' */
-/* Deep Copy:
+/*
+** Deep Copy:
**
** Copy a data item, completely.
**
@@ -63,19 +64,26 @@
Word deep_copy(Word data, Word *type_info, Word *lower_limit,
Word *upper_limit);
-/* MR_make_permanent:
+/*
+** MR_make_permanent:
**
** Returns a copy of term that can be accessed safely even after
** Mercury execution has backtracked past the point at which the
** term was allocated.
**
-** As with deep_copy(), save_transient_registers() and
-** restore_transient_registers() need to be used around this function.
+** Note that in conservative GC grades nothing needs to be done, and
+** hence the term is just returned.
+**
+** When not using a conservative GC grade, save_transient_registers()
+** and restore_transient_registers() need to be used around this
+** function.
*/
-Word MR_make_permanent(Word term, Word *type_info);
+#define MR_make_permanent(term, type_info) \
+ MR_make_long_lived((term), (type_info), NULL)
-/* MR_make_long_lived:
+/*
+** MR_make_long_lived:
**
** This is the same as MR_make_permanent, except that if limit is an
** address on the heap, parts of term that are "older" than limit will
@@ -88,7 +96,10 @@
** "heap," but don't see how to.
*/
-Word MR_make_long_lived(Word term, Word *type_info,
- Word *lower_limit);
+#ifdef CONSERVATIVE_GC
+ #define MR_make_long_lived(term, type_info, lower_limit) (term)
+#else
+ Word MR_make_long_lived(Word term, Word *type_info, Word *lower_limit);
+#endif
#endif /* not MERCURY_DEEP_COPY_H */
More information about the developers
mailing list