diff: deep_copy bug fixes & unique_array change
Fergus Henderson
fjh at cs.mu.oz.au
Thu Apr 24 02:04:45 AEST 1997
Hi,
Tyson, can you please review this one?
-----------------------------------------------------------------------------
Lots of bug fixes for deep_copy().
Also an efficiency improvement for uniq_array.
runtime/type_info.h:
Add definitions for accessing the representation of uniq_arrays.
Add TYPELAYOUT_TYPEINFO_VALUE, TYPELAYOUT_UNIQ_ARRAY_VALUE,
and TYPELAYOUT_C_POINTER_VALUE.
All of those types need special unification predicates
and special treatment in deep_copy.
They may also need special treatment elsewhere.
Also rename TYPELAYOUT_NO_NAME_VALUE as TYPELAYOUT_VOID_VALUE.
runtime/deep_copy.h:
Add code to deep_copy() to copy uniq_arrays, type_infos,
and c_pointers. Avoid unnecessary copying for higher-order types.
Fix bugs in copying of boxed floats and univ.
library/uniq_array.m:
Change the representation of uniq_array so that it is more
efficient (avoid an unnecessary extra level of indirection).
Move the definition of the uniq_array type to runtime/type_info.h,
so that it can be used by deep_copy().
Use `MR_' and `ML_' prefixes as per our C coding standards.
Index: deep_copy.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/deep_copy.c,v
retrieving revision 1.10
diff -u -r1.10 deep_copy.c
--- deep_copy.c 1997/04/10 16:05:13 1.10
+++ deep_copy.c 1997/04/23 16:04:04
@@ -20,6 +20,8 @@
static Word get_base_type_layout_entry(Word data, Word *type_info);
static Word * make_type_info(Word *term_type_info, Word *arg_pseudo_type_info,
bool *allocated);
+static Word * deep_copy_type_info(Word *type_info,
+ Word *lower_limit, Word *upper_limit);
/*
** Due to the depth of the control here, we'll use 4 space indentation.
@@ -76,8 +78,20 @@
break;
case TYPELAYOUT_FLOAT_VALUE:
- new_data = data;
- break;
+ #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 TYPELAYOUT_INT_VALUE:
new_data = data;
@@ -96,7 +110,9 @@
incr_saved_hp(new_data, 2);
new_data_ptr = (Word *) new_data;
new_data_ptr[UNIV_OFFSET_FOR_TYPEINFO] =
- data_value[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],
@@ -108,41 +124,90 @@
case TYPELAYOUT_PREDICATE_VALUE:
{
- /* 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.
- */
- int args;
- Word *new_closure;
+ /*
+ ** 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;
+ Word *new_closure;
/* get number of curried arguments */
- args = data_value[0];
+ args = data_value[0];
/* create new closure */
- incr_saved_hp(LVALUE_CAST(Word, new_closure), args + 2);
+ incr_saved_hp(LVALUE_CAST(Word, new_closure),
+ args + 2);
/* copy number of arguments */
- new_closure[0] = args;
+ new_closure[0] = args;
/* copy pointer to code for closure */
- new_closure[1] = data_value[1];
+ 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;
+ 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 TYPELAYOUT_VOID_VALUE:
+ fatal_error("Attempt to use a VOID tag in deep_copy");
+ break;
+
+ case TYPELAYOUT_UNIQ_ARRAY_VALUE:
+ if (in_range(data_value)) {
+ MR_UniqArrayType *new_array;
+ MR_UniqArrayType *old_array;
+ Integer array_size;
+
+ old_array = (MR_UniqArrayType *) data_value;
+ array_size = old_array->size;
+ new_array = MR_make_uniq_array(array_size);
+ new_array->size = array_size;
+ for (i = 0; i < array_size; i++) {
+ new_array->elements[i] = old_array->elements[i];
+ }
+ new_data = (Word) new_array;
+ } else {
+ new_data = data;
+ }
+ break;
+
+ case TYPELAYOUT_TYPEINFO_VALUE:
+ new_data = (Word) deep_copy_type_info(data_value,
+ lower_limit, upper_limit);
+ break;
+
+ case TYPELAYOUT_C_POINTER_VALUE:
+ 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("Attempt to use a C_POINTER tag "
+ "in deep_copy");
+ } else {
+ new_data = data;
+ }
+ break;
+
default:
fatal_error("Invalid tag value in deep_copy");
break;
@@ -157,9 +222,10 @@
argument_vector = data_value;
- /* If the argument vector is in range, copy the
- * arguments.
- */
+ /*
+ ** 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;
@@ -190,10 +256,11 @@
Word secondary_tag;
Word *new_entry;
- /* if the vector containing the secondary
- * tags and the arguments is in range,
- * copy it.
- */
+ /*
+ ** 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;
@@ -202,9 +269,10 @@
type_info_vector = new_entry +
TYPELAYOUT_SIMPLE_ARGS_OFFSET;
- /* allocate space for new args, and
- * secondary tag
- */
+ /*
+ ** allocate space for new args, and
+ ** secondary tag
+ */
incr_saved_hp(new_data, arity + 1);
/* copy secondary tag */
@@ -365,3 +433,26 @@
return arg_pseudo_type_info;
}
} /* end make_type_info() */
+
+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;
+
+ base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info);
+ arity = MR_BASE_TYPEINFO_GET_TYPE_ARITY(base_type_info);
+ new_type_info = make_many(Word, arity + 1);
+ new_type_info[0] = type_info[0];
+ for (i = 1; i < arity + 1; i++) {
+ new_type_info[i] = deep_copy_type_info(
+ (Word *) type_info[i],
+ lower_limit, upper_limit);
+ }
+ return new_type_info;
+ } else {
+ return type_info;
+ }
+}
Index: type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/type_info.h,v
retrieving revision 1.23
diff -u -r1.23 type_info.h
--- type_info.h 1997/04/22 02:24:09 1.23
+++ type_info.h 1997/04/23 13:42:45
@@ -6,9 +6,10 @@
/*
** type_info.h -
-** Definitions for accessing the type_infos and type_layouts
-** generated by the Mercury compiler.
-** Also contains definitions for accessing the Mercury `univ' type.
+** Definitions for accessing the type_infos, type_layouts, and
+** type_functors tables generated by the Mercury compiler.
+** Also contains definitions for accessing the Mercury `univ' type
+** and the Mercury `uniq_array' type.
*/
#ifndef TYPE_INFO_H
@@ -302,7 +303,10 @@
#define TYPELAYOUT_CHARACTER_VALUE ((Integer) 5)
#define TYPELAYOUT_UNIV_VALUE ((Integer) 6)
#define TYPELAYOUT_PREDICATE_VALUE ((Integer) 7)
-#define TYPELAYOUT_NO_NAME_VALUE ((Integer) 8)
+#define TYPELAYOUT_VOID_VALUE ((Integer) 8)
+#define TYPELAYOUT_UNIQ_ARRAY_VALUE ((Integer) 9)
+#define TYPELAYOUT_TYPEINFO_VALUE ((Integer) 10)
+#define TYPELAYOUT_C_POINTER_VALUE ((Integer) 11)
/*
** Highest allowed type variable number
@@ -727,4 +731,17 @@
/*---------------------------------------------------------------------------*/
+/*
+** definitions for accessing the representation of the
+** Mercury `uniq_array' type
+*/
+
+typedef struct {
+ Integer size;
+ Word elements[1]; /* really this is variable-length */
+} MR_UniqArrayType;
+
+#define MR_make_uniq_array(sz) ((MR_UniqArrayType *) make_many(Word, (sz) + 1))
+
+/*---------------------------------------------------------------------------*/
#endif /* not TYPEINFO_H */
Index: ../library/uniq_array.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/uniq_array.m,v
retrieving revision 1.18
diff -u -r1.18 uniq_array.m
--- uniq_array.m 1997/04/05 06:45:56 1.18
+++ uniq_array.m 1997/04/23 14:00:29
@@ -6,7 +6,8 @@
% File: uniq_array.m
% Main author: fjh
-% Stability: VERY LOW
+% Stability: low
+% This module will probably be renamed as `array'.
% This module provides dynamically-sized one-dimensional arrays.
% Array indices start at zero.
@@ -24,8 +25,8 @@
% so to work-around that problem, we currently don't use
% unique modes in this module.
-% :- inst uniq_array(I) = unique(unique_array(I)).
-:- inst uniq_array(I) = bound(unique_array(I)).
+% :- inst uniq_array(I) = unique(uniq_array(I)).
+:- inst uniq_array(I) = bound(uniq_array(I)).
:- inst uniq_array == uniq_array(ground).
:- inst uniq_array_skel == uniq_array(free).
@@ -118,12 +119,18 @@
:- pred uniq_array__resize(uniq_array(T), int, T, uniq_array(T)).
:- mode uniq_array__resize(uniq_array_di, in, in, uniq_array_uo) is det.
- % uniq_array__from_list takes a list (of nonzero length),
+ % uniq_array__from_list takes a list,
% and returns a uniq_array containing those elements in
% the same order that they occured in the list.
:- pred uniq_array__from_list(list(T), uniq_array(T)).
:- mode uniq_array__from_list(in, uniq_array_uo) is det.
+ % uniq_array/1 is a function that does the same thing
+ % as the predicate uniq_array__from_list.
+ % The syntax `uniq_array([...])' is accepted by io__read.
+:- func uniq_array(list(T)) = uniq_array(T).
+:- mode uniq_array(in) = uniq_array_uo is det.
+
% uniq_array__to_list takes a uniq_array and returns a list containing
% the elements of the uniq_array in the same order that they
% occurred in the uniq_array.
@@ -186,14 +193,8 @@
% Arrays are implemented using the C interface.
-:- pragma(c_header_code, "
-
- typedef struct {
- Integer size;
- Word *elements;
- } UniqArrayType;
-
-").
+% The C type which defines the representation of arrays is
+% MR_UniqArrayType; it is defined in runtime/type_info.h.
%-----------------------------------------------------------------------------%
@@ -207,15 +208,11 @@
#ifdef USE_TYPE_LAYOUT
- /* This isn't really an integer, but we don't yet have a way of
- * describing C types.
- */
-
const struct mercury_data_uniq_array__base_type_layout_uniq_array_1_struct {
TYPE_LAYOUT_FIELDS
} mercury_data_uniq_array__base_type_layout_uniq_array_1 = {
make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG,
- mkbody(TYPELAYOUT_INT_VALUE))
+ mkbody(TYPELAYOUT_UNIQ_ARRAY_VALUE))
};
const struct mercury_data_uniq_array__base_type_functors_uniq_array_1_struct {
@@ -235,12 +232,15 @@
BEGIN_CODE
Define_entry(mercury____Unify___uniq_array__uniq_array_1_0);
+ /* XXX */
fatal_error(""cannot unify uniq_arrays"");
Define_entry(mercury____Index___uniq_array__uniq_array_1_0);
- fatal_error(""cannot index uniq_array"");
+ index_out = -1;
+ proceed();
Define_entry(mercury____Compare___uniq_array__uniq_array_1_0);
+ /* XXX */
fatal_error(""cannot compare uniq_arrays"");
Define_entry(mercury____TermToType___uniq_array__uniq_array_1_0);
@@ -266,24 +266,21 @@
%-----------------------------------------------------------------------------%
:- pragma(c_header_code, "
-UniqArrayType *mercury_make_uniq_array(Integer size, Word item);
+MR_UniqArrayType *ML_make_uniq_array(Integer size, Word item);
").
:- pragma(c_code, "
-UniqArrayType *
-mercury_make_uniq_array(Integer size, Word item)
+MR_UniqArrayType *
+ML_make_uniq_array(Integer size, Word item)
{
Integer i;
- Word *array_elements;
- UniqArrayType *array;
+ MR_UniqArrayType *array;
- array_elements = make_many(Word, size);
+ array = MR_make_uniq_array(size);
+ array->size = size;
for (i = 0; i < size; i++) {
- array_elements[i] = item;
+ array->elements[i] = item;
}
- array = make(UniqArrayType);
- array->elements = array_elements;
- array->size = size;
return array;
}
").
@@ -291,13 +288,13 @@
:- pragma(c_code,
uniq_array__init(Size::in, Item::in, UniqArray::uniq_array_uo),
"
- UniqArray = (Word) mercury_make_uniq_array(Size, Item);
+ UniqArray = (Word) ML_make_uniq_array(Size, Item);
").
:- pragma(c_code,
uniq_array__make_empty_array(UniqArray::uniq_array_uo),
"
- UniqArray = (Word) mercury_make_uniq_array(0, 0);
+ UniqArray = (Word) ML_make_uniq_array(0, 0);
").
%-----------------------------------------------------------------------------%
@@ -312,10 +309,10 @@
").
:- pragma(c_code, uniq_array__max(UniqArray::uniq_array_ui, Max::out), "
- Max = ((UniqArrayType *)UniqArray)->size - 1;
+ Max = ((MR_UniqArrayType *)UniqArray)->size - 1;
").
:- pragma(c_code, uniq_array__max(UniqArray::in, Max::out), "
- Max = ((UniqArrayType *)UniqArray)->size - 1;
+ Max = ((MR_UniqArrayType *)UniqArray)->size - 1;
").
uniq_array__bounds(Array, Min, Max) :-
@@ -325,10 +322,10 @@
%-----------------------------------------------------------------------------%
:- pragma(c_code, uniq_array__size(UniqArray::uniq_array_ui, Max::out), "
- Max = ((UniqArrayType *)UniqArray)->size;
+ Max = ((MR_UniqArrayType *)UniqArray)->size;
").
:- pragma(c_code, uniq_array__size(UniqArray::in, Max::out), "
- Max = ((UniqArrayType *)UniqArray)->size;
+ Max = ((MR_UniqArrayType *)UniqArray)->size;
").
%-----------------------------------------------------------------------------%
@@ -357,14 +354,14 @@
:- pragma(c_code, uniq_array__lookup(UniqArray::uniq_array_ui, Index::in,
Item::out), "{
- UniqArrayType *uniq_array = (UniqArrayType *)UniqArray;
+ MR_UniqArrayType *uniq_array = (MR_UniqArrayType *)UniqArray;
if ((Unsigned) Index >= (Unsigned) uniq_array->size) {
fatal_error(""uniq_array__lookup: array index out of bounds"");
}
Item = uniq_array->elements[Index];
}").
:- pragma(c_code, uniq_array__lookup(UniqArray::in, Index::in, Item::out), "{
- UniqArrayType *uniq_array = (UniqArrayType *)UniqArray;
+ MR_UniqArrayType *uniq_array = (MR_UniqArrayType *)UniqArray;
if ((Unsigned) Index >= (Unsigned) uniq_array->size) {
fatal_error(""uniq_array__lookup: array index out of bounds"");
}
@@ -375,7 +372,7 @@
:- pragma(c_code, uniq_array__set(UniqArray0::uniq_array_di, Index::in,
Item::in, UniqArray::uniq_array_uo), "{
- UniqArrayType *uniq_array = (UniqArrayType *)UniqArray0;
+ MR_UniqArrayType *uniq_array = (MR_UniqArrayType *)UniqArray0;
if ((Unsigned) Index >= (Unsigned) uniq_array->size) {
fatal_error(""uniq_array__set: array index out of bounds"");
}
@@ -386,43 +383,37 @@
%-----------------------------------------------------------------------------%
:- pragma(c_header_code, "
-UniqArrayType * mercury_resize_uniq_array(UniqArrayType *old_array,
+MR_UniqArrayType * ML_resize_uniq_array(MR_UniqArrayType *old_array,
Integer array_size, Word item);
").
:- pragma(c_code, "
-UniqArrayType *
-mercury_resize_uniq_array(UniqArrayType *old_array, Integer array_size,
+MR_UniqArrayType *
+ML_resize_uniq_array(MR_UniqArrayType *old_array, Integer array_size,
Word item)
{
Integer i;
- Word *array_elements;
- UniqArrayType* array;
+ MR_UniqArrayType* array;
Integer old_array_size;
- Word *old_array_elements;
old_array_size = old_array->size;
if (old_array_size == array_size) return old_array;
- old_array_elements = old_array->elements;
- array_elements = make_many(Word, array_size);
+ array = (MR_UniqArrayType *) make_many(Word, array_size + 1);
+ array->size = array_size;
for (i = 0; i < old_array_size; i++) {
- array_elements[i] = old_array_elements[i];
+ array->elements[i] = old_array->elements[i];
}
for (; i < array_size; i++) {
- array_elements[i] = item;
+ array->elements[i] = item;
}
/*
** since the mode on the old array is `uniq_array_di', it is safe to
** deallocate the storage for it
*/
- oldmem(old_array->elements);
oldmem(old_array);
- array = make(UniqArrayType);
- array->elements = array_elements;
- array->size = array_size;
return array;
}
").
@@ -431,37 +422,35 @@
uniq_array__resize(UniqArray0::uniq_array_di, Size::in, Item::in,
UniqArray::uniq_array_uo),
"
- UniqArray = (Word) mercury_resize_uniq_array(
- (UniqArrayType *) UniqArray0, Size, Item);
+ UniqArray = (Word) ML_resize_uniq_array(
+ (MR_UniqArrayType *) UniqArray0, Size, Item);
").
%-----------------------------------------------------------------------------%
:- pragma(c_header_code, "
-UniqArrayType *mercury_copy_uniq_array(UniqArrayType *old_array);
+MR_UniqArrayType *ML_copy_uniq_array(MR_UniqArrayType *old_array);
").
:- pragma(c_code, "
-UniqArrayType *
-mercury_copy_uniq_array(UniqArrayType *old_array)
+MR_UniqArrayType *
+ML_copy_uniq_array(MR_UniqArrayType *old_array)
{
+ /*
+ ** Any changes to this function will probably also require
+ ** changes to deepcopy() in runtime/deep_copy.c.
+ */
+
Integer i;
- Word *array_elements;
- UniqArrayType* array;
+ MR_UniqArrayType* array;
Integer array_size;
- Word *old_array_elements;
array_size = old_array->size;
- old_array_elements = old_array->elements;
-
- array_elements = make_many(Word, array_size);
+ array = MR_make_uniq_array(array_size);
+ array->size = array_size;
for (i = 0; i < array_size; i++) {
- array_elements[i] = old_array_elements[i];
+ array->elements[i] = old_array->elements[i];
}
-
- array = make(UniqArrayType);
- array->elements = array_elements;
- array->size = array_size;
return array;
}
").
@@ -470,18 +459,21 @@
uniq_array__copy(UniqArray0::uniq_array_ui, UniqArray::uniq_array_uo),
"
UniqArray =
- (Word) mercury_copy_uniq_array((UniqArrayType *) UniqArray0);
+ (Word) ML_copy_uniq_array((MR_UniqArrayType *) UniqArray0);
").
:- pragma(c_code,
uniq_array__copy(UniqArray0::in, UniqArray::uniq_array_uo),
"
UniqArray =
- (Word) mercury_copy_uniq_array((UniqArrayType *) UniqArray0);
+ (Word) ML_copy_uniq_array((MR_UniqArrayType *) UniqArray0);
").
%-----------------------------------------------------------------------------%
+uniq_array(List) = Array :-
+ uniq_array__from_list(List, Array).
+
uniq_array__from_list([], Array) :-
uniq_array__make_empty_array(Array).
uniq_array__from_list(List, Array) :-
@@ -549,11 +541,8 @@
)
;
% Otherwise find the middle element of the range
- % and check against that. NOTE: I used ">> 1"
- % rather than "// 2" because division always
- % rounds towards zero whereas shift right always
- % rounds down. (Indices can be negative.)
- Mid is (Lo + Hi) >> 1,
+ % and check against that.
+ Mid is (Lo + Hi) >> 1, % `>> 1' is hand-optimized `div 2'.
uniq_array__lookup(Array, Mid, XMid),
call(Compare, XMid, El, Comp),
( Comp = (<),
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
More information about the developers
mailing list