[m-rev.] diff: fix bugs with existential types & secondary tags
Fergus Henderson
fjh at cs.mu.OZ.AU
Sun Apr 29 18:53:49 AEST 2001
I'll test this a bit more and add a regression test before committing it.
----------
Estimated hours taken: 5
Branches: main, release
Fix bugs with the handling of existentially typed data types with
secondary tags in various parts of the RTTI code.
Most of these bugs were due to passing in the pointer to the secondary
tag, rather than the pointer to the first real argument (one word
past the secondary tag).
library/std_util.m:
Fix bugs in ML_expand() and du_get_functor_info.
runtime/mercury_tabling.c:
Fix bug in MR_table_type().
runtime/mercury_deep_copy_body.h:
Fix bug in MR_agc_deep_copy(), the accurate GC version of deep_copy().
Also fix another bug in the same function: when copying existentially
typed data types, it was trying to use the type_infos in the original
data after they had already been replaced by forwarding pointers.
runtime/mercury_type_info.h:
Add some extra emphasis to a comment, to hopefully reduce the
likelihood of this bug re-occurring.
Workspace: /mnt/hg/home/hg/fjh/ws-hg3/mercury
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.226
diff -u -d -r1.226 std_util.m
--- library/std_util.m 2001/03/18 23:10:10 1.226
+++ library/std_util.m 2001/04/29 07:33:48
@@ -2952,8 +2952,7 @@
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
type_info),
functor_desc->MR_du_functor_arg_types[i],
- (MR_Word *) MR_body(data, ptag),
- functor_desc);
+ arg_vector, functor_desc);
} else {
expand_info->arg_type_infos[i] =
MR_pseudo_type_info_is_ground(
@@ -3910,8 +3909,7 @@
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
type_info),
functor_desc->MR_du_functor_arg_types[i],
- (MR_Word *) MR_body(value, Ptag),
- functor_desc);
+ arg_vector, functor_desc);
} else {
arg_type_info = MR_pseudo_type_info_is_ground(
functor_desc->MR_du_functor_arg_types[i]);
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.36
diff -u -d -r1.36 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 2001/03/18 23:10:12 1.36
+++ runtime/mercury_deep_copy_body.h 2001/04/29 07:37:51
@@ -84,6 +84,7 @@
** if (in_range(data_value)) {
** const MR_DuFunctorDesc *functor_desc;
** const MR_DuExistInfo *exist_info;
+** bool have_sectag;
** int sectag;
** int cell_size;
** int cur_slot;
@@ -92,7 +93,9 @@
** int num_tci;
** int i;
**
-** if (ptag_layout->MR_sectag_locn == MR_SECTAG_NONE) {
+** have_sectag =
+** (ptag_layout->MR_sectag_locn != MR_SECTAG_NONE);
+** if (!have_sectag) {
** sectag = 0;
** } else {
** sectag = data_value[0];
@@ -102,7 +105,7 @@
** arity = functor_desc->MR_du_functor_orig_arity;
** exist_info = functor_desc->MR_du_functor_exist_info;
**
-** if (ptag_layout->MR_sectag_locn == MR_SECTAG_NONE) {
+** if (!have_sectag) {
** cell_size = arity;
** } else {
** cell_size = 1 + arity;
@@ -119,7 +122,7 @@
**
** MR_incr_saved_hp(new_data, cell_size);
**
-** if (ptag_layout->MR_sectag_locn == MR_SECTAG_NONE) {
+** if (!have_sectag) {
** cur_slot = 0;
** } else {
** MR_field(0, new_data, 0) = sectag;
@@ -143,8 +146,13 @@
**
** for (i = 0; i < arity; i++) {
** if (MR_arg_type_may_contain_var(functor_desc, i)) {
+** MR_Word *parent_data = (MR_Word *) new_data;
+** if (have_sectag) {
+** // skip past the secondary tag
+** parent_data++;
+** }
** MR_field(0, new_data, cur_slot) =
-** copy_arg(data_value, &data_value[cur_slot],
+** copy_arg(parent_data, &data_value[cur_slot],
** functor_desc,
** MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
** type_info),
@@ -176,6 +184,7 @@
#define MR_DC_decl \
const MR_DuFunctorDesc *functor_desc; \
const MR_DuExistInfo *exist_info; \
+ bool have_sectag; \
int sectag; \
int cell_size; \
int cur_slot; \
@@ -214,8 +223,13 @@
#define MR_DC_copy_plain_args \
for (i = 0; i < arity; i++) { \
if (MR_arg_type_may_contain_var(functor_desc, i)) { \
+ MR_Word *parent_data = (MR_Word *) new_data; \
+ if (have_sectag) { \
+ /* skip past the secondary tag */ \
+ parent_data++; \
+ } \
MR_field(0, new_data, cur_slot) = \
- copy_arg(data_value, &data_value[cur_slot], \
+ copy_arg(parent_data, &data_value[cur_slot],\
functor_desc, \
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR( \
type_info), \
@@ -240,6 +254,7 @@
data_value = (MR_Word *) MR_body(data, ptag);
if (in_range(data_value)) {
MR_DC_decl
+ have_sectag = TRUE;
sectag = data_value[0];
MR_DC_functor_desc
cell_size = 1 + arity;
@@ -273,6 +288,7 @@
data_value = (MR_Word *) MR_body(data, ptag);
if (in_range(data_value)) {
MR_DC_decl
+ have_sectag = FALSE;
sectag = 0;
MR_DC_functor_desc
cell_size = arity;
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.40
diff -u -d -r1.40 mercury_tabling.c
--- runtime/mercury_tabling.c 2001/03/18 23:10:12 1.40
+++ runtime/mercury_tabling.c 2001/04/29 07:31:27
@@ -712,8 +712,7 @@
arg_type_info = MR_make_type_info_maybe_existq(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
functor_desc->MR_du_functor_arg_types[i],
- (MR_Word *) MR_body(data, ptag),
- functor_desc, &allocated_memory_cells);
+ arg_vector, functor_desc, &allocated_memory_cells);
} else {
arg_type_info = MR_pseudo_type_info_is_ground(
functor_desc->MR_du_functor_arg_types[i]);
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.69
diff -u -d -r1.69 mercury_type_info.h
--- runtime/mercury_type_info.h 2001/04/06 06:19:28 1.69
+++ runtime/mercury_type_info.h 2001/04/29 07:49:24
@@ -1155,7 +1155,7 @@
** which (directly or indirectly) contains the typeinfos of the existentially
** quantified type variables, and the descriptor of the function symbol,
** which describes how those typeinfos can be found in the cell. The cell
-** address is supposed to point past the remote secondary tag, if any;
+** address is supposed to point PAST the remote secondary tag, if any;
** it should point to the first argument, whether it is a user visible argument
** or a typeinfo/typeclass_info inserted into the cell by the compiler.
**
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
| 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