diff: fix bugs with copying of type_infos & univs

[Fergus Henderson]

Estimated hours taken: 3

Some bug fixes and improvements for copying of univs and type_infos.

runtime/mercury_deep_copy_body.h:
	- Fix some bugs with copying of univs and type_infos:
		* in copy_type_info(), it was setting `new_type_info[0]'
		  to `type_info[0]' instead of `base_type_info'; this
		  did the wrong thing in the case where type_info is
		  equal to base_type_info.
		* extend copy_type_info() to handle higher-order types
		* when copying univs, make sure to copy the data before
		  the type_info, to avoid the problem of overwriting
		  the type_info with a forwarding pointer before we
		  have made use of it to copy the data;

	- Improve the efficiency of copying of type_infos
	  (and hence also univs):
		* in copy_type_info(), optimize the handling of the
		  type_info == base_type_info case: just return a
		  base_type_info, rather than allocating and
		  constructing a new type_info.

	- Update the comments accordingly.

Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.3
diff -u -r1.3 mercury_deep_copy_body.h
--- mercury_deep_copy_body.h	1999/02/22 17:18:21	1.3
+++ mercury_deep_copy_body.h	1999/02/23 09:17:53
@@ -226,14 +226,21 @@
                 /* allocate space for a univ */
                 incr_saved_hp(new_data, 2);
                 new_data_ptr = (Word *) new_data;
-                new_data_ptr[UNIV_OFFSET_FOR_TYPEINFO] = 
-                    (Word) copy_type_info( 
-                        &data_value[UNIV_OFFSET_FOR_TYPEINFO],
-                        lower_limit, upper_limit);
+		/*
+		** Copy the fields across.
+		** Note: we must copy the data before the type_info,
+		** because when copying the data, we need the type_info
+		** to still contain the type rather than just holding
+		** a forwarding pointer.
+		*/
                 new_data_ptr[UNIV_OFFSET_FOR_DATA] = copy(
                         &data_value[UNIV_OFFSET_FOR_DATA], 
                         (const Word *) data_value[UNIV_OFFSET_FOR_TYPEINFO],
                         lower_limit, upper_limit);
+                new_data_ptr[UNIV_OFFSET_FOR_TYPEINFO] = 
+                    (Word) copy_type_info( 
+                        &data_value[UNIV_OFFSET_FOR_TYPEINFO],
+                        lower_limit, upper_limit);
                 leave_forwarding_pointer(data_ptr, new_data);
             } else {
                 new_data = data;
@@ -329,30 +336,49 @@
 {
 	Word *type_info = (Word *) *type_info_ptr;
 
+
 	if (in_range(type_info)) {
 		Word *base_type_info;
 		Word *new_type_info;
-		Integer arity, i;
+		Integer arity, offset, i;
 
-		/* XXX this doesn't handle higher-order types properly */
+		/*
+		** Note that we assume base_type_infos will always be
+		** allocated statically, so we never copy them.
+		*/
 
 		base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO((Word *)
 			type_info);
-		arity = MR_BASE_TYPEINFO_GET_TYPE_ARITY(base_type_info);
-		incr_saved_hp(LVALUE_CAST(Word, new_type_info), arity + 1);
-		new_type_info[0] = type_info[0];
-		for (i = 1; i < arity + 1; i++) {
-			new_type_info[i] = (Word) copy_type_info(
-				&type_info[i],
+		/*
+		** optimize special case: if there's no arguments,
+		** we don't need to construct a type_info; instead,
+		** we can just return the base_type_info.
+		*/
+		if (type_info == base_type_info) {
+			return base_type_info;
+		}
+		if (MR_BASE_TYPEINFO_IS_HO(base_type_info)) {
+			arity = MR_TYPEINFO_GET_HIGHER_ARITY(type_info);
+			incr_saved_hp(LVALUE_CAST(Word, new_type_info),
+				arity + 2);
+			new_type_info[0] = (Word) base_type_info;
+			new_type_info[1] = arity;
+			offset = 2;
+		} else {
+			arity = MR_BASE_TYPEINFO_GET_TYPE_ARITY(base_type_info);
+			incr_saved_hp(LVALUE_CAST(Word, new_type_info),
+				arity + 1);
+			new_type_info[0] = (Word) base_type_info;
+			offset = 1;
+		}
+		for (i = offset; i < arity + offset; i++) {
+			new_type_info[i] = (Word) copy_type_info(&type_info[i],
 				lower_limit, upper_limit);
 		}
-                leave_forwarding_pointer(type_info_ptr, (Word) new_type_info);
+		leave_forwarding_pointer(type_info_ptr, (Word) new_type_info);
 		return new_type_info;
 	} else {
 		found_forwarding_pointer(type_info);
 		return type_info;
 	}
 }
-
-
-

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "Binaries may die
WWW: <http://www.cs.mu.oz.au/~fjh>  |   but source code lives forever"
PGP: finger fjh at 128.250.37.3        |     -- leaked Microsoft memo.