[m-rev.] diff: agc deep copy bug fix

[Fergus Henderson]

Estimated hours taken: 16
Branches: main

Fix a bug in the accurate GC version of the deep copy code.

runtime/mercury_deep_copy_body.h:
runtime/mercury_deep_copy.c:
	When copying type_infos and typeclass_infos, ensure that we
	allocate the extra word for the forwarding pointer.

Workspace: /home/jupiter/fjh/ws-jupiter/mercury
Index: runtime/mercury_deep_copy.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.c,v
retrieving revision 1.31
diff -u -d -r1.31 mercury_deep_copy.c
--- runtime/mercury_deep_copy.c	26 May 2003 10:45:18 -0000	1.31
+++ runtime/mercury_deep_copy.c	17 Dec 2003 12:25:16 -0000
@@ -40,6 +40,9 @@
 #undef  copy_typeclass_info
 #define copy_typeclass_info	MR_deep_copy_typeclass_info
 
+#undef  use_forwarding_pointers
+#define use_forwarding_pointers() MR_FALSE
+
 #undef  if_forwarding_pointer
 #define if_forwarding_pointer(Data, ACTION)
 
@@ -78,6 +81,9 @@
 #else
   #define FORWARD_DEBUG_MSG(Msg, Data) ((void)0)
 #endif
+
+#undef  use_forwarding_pointers
+#define use_forwarding_pointers() MR_TRUE
 
 /*
 ** This points to a bitmap, which is used to record which objects
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.63
diff -u -d -r1.63 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h	20 Oct 2003 07:29:31 -0000	1.63
+++ runtime/mercury_deep_copy_body.h	17 Dec 2003 12:31:03 -0000
@@ -729,7 +729,8 @@
         MR_TypeInfo     *new_type_info_args;
         int             arity;
         int             i;
-
+        int             forwarding_pointer_size;
+        
         /*
         ** Note that we assume type_ctor_infos will always be
         ** allocated statically, so we never copy them.
@@ -747,21 +748,27 @@
             return (MR_TypeInfo) type_ctor_info;
         }
 
+        /* compute how many words to reserve for the forwarding pointer */
+        forwarding_pointer_size = (use_forwarding_pointers() ? 1 : 0);
+
         if (MR_type_ctor_has_variable_arity(type_ctor_info)) {
             arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
             type_info_args =
                 MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
             MR_offset_incr_saved_hp(
-                MR_LVALUE_CAST(MR_Word, new_type_info_arena), 0,
-                MR_var_arity_type_info_size(arity));
+                MR_LVALUE_CAST(MR_Word, new_type_info_arena),
+                forwarding_pointer_size,
+                MR_var_arity_type_info_size(arity) + forwarding_pointer_size);
             MR_fill_in_var_arity_type_info(new_type_info_arena,
                 type_ctor_info, arity, new_type_info_args);
         } else {
             arity = type_ctor_info->MR_type_ctor_arity;
             type_info_args = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
             MR_offset_incr_saved_hp(
-                MR_LVALUE_CAST(MR_Word, new_type_info_arena), 0,
-                MR_fixed_arity_type_info_size(arity));
+                MR_LVALUE_CAST(MR_Word, new_type_info_arena),
+                forwarding_pointer_size,
+                MR_fixed_arity_type_info_size(arity) + forwarding_pointer_size
+            );
             MR_fill_in_fixed_arity_type_info(new_type_info_arena,
                 type_ctor_info, new_type_info_args);
         }
@@ -794,6 +801,7 @@
         int     num_instance_constraints;
         int     num_unconstrained;
         int     i;
+        int     forwarding_pointer_size;
 
         /*
         ** Note that we assume base_typeclass_infos will always be
@@ -802,6 +810,9 @@
 
         base_typeclass_info = (MR_Word *) *typeclass_info;
 
+        /* compute how many words to reserve for the forwarding pointer */
+        forwarding_pointer_size = (use_forwarding_pointers() ? 1 : 0);
+
         num_instance_constraints =
             MR_typeclass_info_num_instance_constraints(typeclass_info);
         num_unconstrained =
@@ -809,8 +820,10 @@
                 - num_instance_constraints;
         num_super = MR_typeclass_info_num_superclasses(typeclass_info);
         num_arg_typeinfos = MR_typeclass_info_num_type_infos(typeclass_info);
-        MR_offset_incr_saved_hp(MR_LVALUE_CAST(MR_Word, new_typeclass_info), 0,
-            num_instance_constraints + num_super + num_arg_typeinfos + 1);
+        MR_offset_incr_saved_hp(MR_LVALUE_CAST(MR_Word, new_typeclass_info),
+            forwarding_pointer_size,
+            forwarding_pointer_size + 1 /* for basetypeclass_info */
+            + num_instance_constraints + num_super + num_arg_typeinfos);
 
         new_typeclass_info[0] = (MR_Word) base_typeclass_info;
 

-- 
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
--------------------------------------------------------------------------