[m-rev.] for review: agc: fix bug with arrays
Fergus Henderson
fjh at cs.mu.OZ.AU
Tue Jun 4 21:48:56 AEST 2002
Estimated hours taken: 8
Branches: main
library/array.m:
extras/trailed_update/tr_array.m:
runtime/mercury_deep_copy_body.h:
runtime/mercury_library_types.h:
Allocate arrays on the Mercury heap, using MR_incr_hp_msg(),
rather than using MR_GC_malloc(). This is needed for accurate
GC, to ensure that the objects pointed to by the array elements
will get traced by the collector.
Workspace: /home/ceres/fjh/mercury
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.104
diff -u -d -r1.104 array.m
--- library/array.m 18 Feb 2002 07:01:01 -0000 1.104
+++ library/array.m 4 Jun 2002 11:45:32 -0000
@@ -733,22 +733,23 @@
").
:- pragma foreign_decl("C", "
-MR_ArrayType *ML_make_array(MR_Integer size, MR_Word item);
+void ML_init_array(MR_ArrayType *, MR_Integer size, MR_Word item);
").
:- pragma foreign_code("C", "
-MR_ArrayType *
-ML_make_array(MR_Integer size, MR_Word item)
+/*
+** The caller is responsible for allocating the memory for the array.
+** This routine does the job of initializing the already-allocated memory.
+*/
+void
+ML_init_array(MR_ArrayType *array, MR_Integer size, MR_Word item)
{
MR_Integer i;
- MR_ArrayType *array;
- array = MR_make_array(size);
array->size = size;
for (i = 0; i < size; i++) {
array->elements[i] = item;
}
- return array;
}
").
@@ -765,15 +766,15 @@
:- pragma foreign_proc("C",
array__init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe], "
- MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
- Array = (MR_Word) ML_make_array(Size, Item);
+ MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
+ ML_init_array((MR_ArrayType *)Array, Size, Item);
").
:- pragma foreign_proc("C",
array__make_empty_array(Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe], "
- MR_maybe_record_allocation(1, MR_PROC_LABEL, ""array:array/1"");
- Array = (MR_Word) ML_make_array(0, 0);
+ MR_incr_hp_msg(Array, 1, MR_PROC_LABEL, ""array:array/1"");
+ ML_init_array((MR_ArrayType *)Array, 1, 0);
").
:- pragma foreign_proc("C#",
@@ -964,26 +965,29 @@
%-----------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
-MR_ArrayType * ML_resize_array(MR_ArrayType *old_array,
+void ML_resize_array(MR_ArrayType *new_array, MR_ArrayType *old_array,
MR_Integer array_size, MR_Word item);
").
:- pragma foreign_code("C", "
-MR_ArrayType *
-ML_resize_array(MR_ArrayType *old_array, MR_Integer array_size,
- MR_Word item)
+/*
+** The caller is responsible for allocating the storage for the new array.
+** This routine does the job of copying the old array elements to the
+** new array, initializing any additional elements in the new array,
+** and deallocating the old array.
+*/
+void
+ML_resize_array(MR_ArrayType *array, MR_ArrayType *old_array,
+ MR_Integer array_size, MR_Word item)
{
MR_Integer i;
- MR_ArrayType* array;
MR_Integer elements_to_copy;
elements_to_copy = old_array->size;
- if (elements_to_copy == array_size) return old_array;
if (elements_to_copy > array_size) {
elements_to_copy = array_size;
}
- array = (MR_ArrayType *) MR_GC_NEW_ARRAY(MR_Word, array_size + 1);
array->size = array_size;
for (i = 0; i < elements_to_copy; i++) {
array->elements[i] = old_array->elements[i];
@@ -996,9 +1000,9 @@
** since the mode on the old array is `array_di', it is safe to
** deallocate the storage for it
*/
- MR_GC_free(old_array);
-
- return array;
+#ifdef MR_CONSERVATIVE_GC
+ GC_free(old_array);
+#endif
}
").
@@ -1006,9 +1010,14 @@
array__resize(Array0::array_di, Size::in, Item::in,
Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe], "
- MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
- Array = (MR_Word) ML_resize_array(
- (MR_ArrayType *) Array0, Size, Item);
+ if (((MR_ArrayType *)Array0)->size == Size) {
+ Array = Array0;
+ } else {
+ MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL,
+ ""array:array/1"");
+ ML_resize_array((MR_ArrayType *) Array,
+ (MR_ArrayType *) Array0, Size, Item);
+ }
").
:- pragma foreign_proc("C#",
@@ -1034,22 +1043,22 @@
%-----------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
-MR_ArrayType * ML_shrink_array(MR_ArrayType *old_array,
+void ML_shrink_array(MR_ArrayType *array, MR_ArrayType *old_array,
MR_Integer array_size);
").
:- pragma foreign_code("C", "
-MR_ArrayType *
-ML_shrink_array(MR_ArrayType *old_array, MR_Integer array_size)
+/*
+** The caller is responsible for allocating the storage for the new array.
+** This routine does the job of copying the old array elements to the
+** new array and deallocating the old array.
+*/
+void
+ML_shrink_array(MR_ArrayType *array, MR_ArrayType *old_array,
+ MR_Integer array_size)
{
MR_Integer i;
- MR_ArrayType* array;
- MR_Integer old_array_size;
-
- old_array_size = old_array->size;
- if (old_array_size == array_size) return old_array;
- array = (MR_ArrayType *) MR_GC_NEW_ARRAY(MR_Word, array_size + 1);
array->size = array_size;
for (i = 0; i < array_size; i++) {
array->elements[i] = old_array->elements[i];
@@ -1059,15 +1068,18 @@
** since the mode on the old array is `array_di', it is safe to
** deallocate the storage for it
*/
- MR_GC_free(old_array);
-
- return array;
+#ifdef MR_CONSERVATIVE_GC
+ GC_free(old_array);
+#endif
}
").
array__shrink(Array0, Size, Array) :-
- ( Size > array__size(Array0) ->
+ OldSize = array__size(Array0),
+ ( Size > OldSize ->
error("array__shrink: can't shrink to a larger size")
+ ; Size = OldSize ->
+ Array = Array0
;
array__shrink_2(Array0, Size, Array)
).
@@ -1078,9 +1090,9 @@
:- pragma foreign_proc("C",
array__shrink_2(Array0::array_di, Size::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe], "
- MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
- Array = (MR_Word) ML_shrink_array(
- (MR_ArrayType *) Array0, Size);
+ MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
+ ML_shrink_array((MR_ArrayType *)Array, (MR_ArrayType *) Array0,
+ Size);
").
:- pragma foreign_proc("C#",
@@ -1095,12 +1107,16 @@
%-----------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
-MR_ArrayType *ML_copy_array(MR_ArrayType *old_array);
+void ML_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array);
").
:- pragma foreign_code("C", "
-MR_ArrayType *
-ML_copy_array(MR_ArrayType *old_array)
+/*
+** The caller is responsible for allocating the storage for the new array.
+** This routine does the job of copying the array elements.
+*/
+void
+ML_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array)
{
/*
** Any changes to this function will probably also require
@@ -1108,33 +1124,31 @@
*/
MR_Integer i;
- MR_ArrayType* array;
MR_Integer array_size;
array_size = old_array->size;
- array = MR_make_array(array_size);
array->size = array_size;
for (i = 0; i < array_size; i++) {
array->elements[i] = old_array->elements[i];
}
- return array;
+
}
").
:- pragma foreign_proc("C",
array__copy(Array0::array_ui, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe], "
- MR_maybe_record_allocation((((MR_ArrayType *) Array0)->size) + 1,
+ MR_incr_hp_msg(Array, (((const MR_ArrayType *) Array0)->size) + 1,
MR_PROC_LABEL, ""array:array/1"");
- Array = (MR_Word) ML_copy_array((MR_ArrayType *) Array0);
+ ML_copy_array((MR_ArrayType *)Array, (const MR_ArrayType *) Array0);
").
:- pragma foreign_proc("C",
array__copy(Array0::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe], "
- MR_maybe_record_allocation((((MR_ArrayType *) Array0)->size) + 1,
+ MR_incr_hp_msg(Array, (((const MR_ArrayType *) Array0)->size) + 1,
MR_PROC_LABEL, ""array:array/1"");
- Array = (MR_Word) ML_copy_array((MR_ArrayType *) Array0);
+ ML_copy_array((MR_ArrayType *)Array, (const MR_ArrayType *) Array0);
").
:- pragma foreign_proc("C#",
Index: extras/trailed_update/tr_array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/tr_array.m,v
retrieving revision 1.8
diff -u -d -r1.8 tr_array.m
--- extras/trailed_update/tr_array.m 13 Dec 2000 12:13:02 -0000 1.8
+++ extras/trailed_update/tr_array.m 4 Jun 2002 11:43:11 -0000
@@ -285,26 +285,23 @@
%-----------------------------------------------------------------------------%
:- pragma c_header_code("
-MR_ArrayType * ML_tr_resize_array(MR_ArrayType *old_array,
+void ML_tr_resize_array(MR_ArrayType *array, const MR_ArrayType *old_array,
MR_Integer array_size, MR_Word item);
").
:- pragma c_code("
-MR_ArrayType *
-ML_tr_resize_array(MR_ArrayType *old_array, MR_Integer array_size,
- MR_Word item)
+void
+ML_tr_resize_array(MR_ArrayType *array, const MR_ArrayType *old_array,
+ MR_Integer array_size, MR_Word item)
{
MR_Integer i;
- MR_ArrayType* array;
MR_Integer elements_to_copy;
elements_to_copy = old_array->size;
- if (elements_to_copy == array_size) return old_array;
if (elements_to_copy > array_size) {
elements_to_copy = array_size;
}
- array = (MR_ArrayType *) MR_GC_NEW_ARRAY(MR_Word, array_size + 1);
array->size = array_size;
for (i = 0; i < elements_to_copy; i++) {
array->elements[i] = old_array->elements[i];
@@ -317,8 +314,6 @@
** since the mode on the old array is `array_mdi', it is NOT safe to
** deallocate the storage for it
*/
-
- return array;
}
").
@@ -327,7 +322,8 @@
Array::array_uo),
will_not_call_mercury,
"
- Array = (MR_Word) ML_tr_resize_array((MR_ArrayType *) Array0,
+ MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
+ ML_tr_resize_array((MR_ArrayType *)Array, (const MR_ArrayType *)Array0,
Size, Item);
").
@@ -336,7 +332,8 @@
Array::array_uo),
will_not_call_mercury,
"
- Array = (MR_Word) ML_tr_resize_array((MR_ArrayType *) Array0,
+ MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
+ ML_tr_resize_array((MR_ArrayType *)Array, (const MR_ArrayType *)Array0,
Size, Item);
").
@@ -344,26 +341,24 @@
%-----------------------------------------------------------------------------%
:- pragma c_header_code("
-MR_ArrayType * ML_tr_shrink_array(MR_ArrayType *old_array,
+void ML_tr_shrink_array(MR_ArrayType *, const MR_ArrayType *old_array,
MR_Integer array_size);
").
:- pragma c_code("
-MR_ArrayType *
-ML_tr_shrink_array(MR_ArrayType *old_array, MR_Integer array_size)
+void
+ML_tr_shrink_array(MR_ArrayType *array, const MR_ArrayType *old_array,
+ MR_Integer array_size)
{
MR_Integer i;
- MR_ArrayType* array;
MR_Integer old_array_size;
old_array_size = old_array->size;
- if (old_array_size == array_size) return old_array;
if (old_array_size < array_size) {
MR_fatal_error(
""tr_array__shrink: can't shrink to a larger size"");
}
- array = (MR_ArrayType *) MR_GC_NEW_ARRAY(MR_Word, array_size + 1);
array->size = array_size;
for (i = 0; i < array_size; i++) {
array->elements[i] = old_array->elements[i];
@@ -373,8 +368,6 @@
** since the mode on the old array is `array_mdi', it is NOT safe to
** deallocate the storage for it
*/
-
- return array;
}
").
@@ -382,27 +375,29 @@
tr_array__shrink(Array0::array_mui, Size::in, Array::array_uo),
will_not_call_mercury,
"
- Array = (MR_Word) ML_tr_shrink_array(
- (MR_ArrayType *) Array0, Size);
+ MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
+ ML_tr_shrink_array((MR_ArrayType *) Array,
+ (const MR_ArrayType *) Array0, Size);
").
:- pragma c_code(
tr_array__shrink(Array0::in, Size::in, Array::array_uo),
will_not_call_mercury,
"
- Array = (MR_Word) ML_tr_shrink_array(
- (MR_ArrayType *) Array0, Size);
+ MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
+ ML_tr_shrink_array((MR_ArrayType *) Array,
+ (const MR_ArrayType *) Array0, Size);
").
%-----------------------------------------------------------------------------%
:- pragma c_header_code("
-MR_ArrayType *ML_tr_copy_array(MR_ArrayType *old_array);
+void ML_tr_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array);
").
:- pragma c_code("
-MR_ArrayType *
-ML_tr_copy_array(MR_ArrayType *old_array)
+void
+ML_tr_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array)
{
/*
** Any changes to this function will probably also require
@@ -410,16 +405,13 @@
*/
MR_Integer i;
- MR_ArrayType* array;
MR_Integer array_size;
array_size = old_array->size;
- array = MR_make_array(array_size);
array->size = array_size;
for (i = 0; i < array_size; i++) {
array->elements[i] = old_array->elements[i];
}
- return array;
}
").
@@ -427,14 +419,18 @@
tr_array__copy(Array0::array_mui, Array::array_uo),
will_not_call_mercury,
"
- Array = (MR_Word) ML_tr_copy_array((MR_ArrayType *) Array0);
+ MR_incr_hp_msg(Array, ((const MR_ArrayType *)Array0)->size + 1,
+ MR_PROC_LABEL, ""array:array/1"");
+ ML_tr_copy_array((MR_ArrayType *)Array, (const MR_ArrayType *)Array0);
").
:- pragma c_code(
tr_array__copy(Array0::in, Array::array_uo),
will_not_call_mercury,
"
- Array = (MR_Word) ML_tr_copy_array((MR_ArrayType *) Array0);
+ MR_incr_hp_msg(Array, ((const MR_ArrayType *)Array0)->size + 1,
+ MR_PROC_LABEL, ""array:array/1"");
+ ML_tr_copy_array((MR_ArrayType *)Array, (const MR_ArrayType *)Array0);
").
%-----------------------------------------------------------------------------%
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.53
diff -u -d -r1.53 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 12 Apr 2002 01:24:23 -0000 1.53
+++ runtime/mercury_deep_copy_body.h 4 Jun 2002 11:37:00 -0000
@@ -483,7 +483,8 @@
old_array = (MR_ArrayType *) data_value;
array_size = old_array->size;
- new_array = MR_make_array(array_size);
+ MR_incr_saved_hp(new_data, array_size + 1);
+ new_array = (MR_ArrayType *) new_data;
new_array->size = array_size;
for (i = 0; i < array_size; i++) {
new_array->elements[i] = copy_arg(NULL,
@@ -491,7 +492,6 @@
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
(const MR_PseudoTypeInfo) 1, lower_limit, upper_limit);
}
- new_data = (MR_Word) new_array;
leave_forwarding_pointer(data_ptr, new_data);
} else if (in_traverse_range(data_value)) {
MR_ArrayType *old_array;
Index: runtime/mercury_library_types.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_library_types.h,v
retrieving revision 1.8
diff -u -d -r1.8 mercury_library_types.h
--- runtime/mercury_library_types.h 18 Feb 2002 07:01:17 -0000 1.8
+++ runtime/mercury_library_types.h 4 Jun 2002 10:38:44 -0000
@@ -148,15 +148,15 @@
#endif /* MR_NEW_MERCURYFILE_STRUCT */
/*
-** definitions for accessing the representation of the
-** Mercury `array' type
+** Definitions for accessing the representation of the
+** Mercury `array' type.
+** Note that arrays should be allocated on the Mercury heap,
+** using MR_incr_hp_msg().
*/
typedef struct {
MR_Integer size;
MR_Word elements[MR_VARIABLE_SIZED];
} MR_ArrayType;
-
-#define MR_make_array(sz) ((MR_ArrayType *) MR_GC_NEW_ARRAY(MR_Word, (sz) + 1))
#endif /* not MERCURY_LIBRARY_TYPES_H */
--
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