[m-rev.] diff: bug fixes for reserved address data representation

Fergus Henderson fjh at cs.mu.OZ.AU
Thu Oct 25 22:40:26 AEST 2001


With these changes, the compiler now bootstraps in grade hl.gc
with the following in Mmake.stage.params:

	EXTRA_CFLAGS = -DTAGBITS=0 -DMR_NUM_RESERVED_ADDRESSES=1 \
			-DMR_NUM_RESERVED_OBJECTS=2
	EXTRA_MCFLAGS = --num-tag-bits 0 --num-reserved-addresses 1 \
			--num-reserved-objects 2

----------

Estimated hours taken: 12
Branches: main

Fix bugs in my recent change to support using reserved addresses.

runtime/mercury_tags.h:
	Fix the definitions of MR_list_empty(), etc.
	so that they work correctly when --num-reserved-addresses
	and/or --num-reserved-objects are set.

compiler/ml_type_gen.m:
	Fix a problem where the Mercury compiler was using an empty
	struct for the types of the reserved objects that it generates;
	this caused problems because GNU C was then allocating
	distinct zero-sized objects at the same address.

compiler/type_ctor_info.m:
	Fix a bug where it was generating the wrong type_ctor_rep
	for types represented using reserved addresses.

Workspace: /home/ceres/fjh/mercury
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.16
diff -u -d -r1.16 ml_type_gen.m
--- compiler/ml_type_gen.m	25 Oct 2001 02:24:31 -0000	1.16
+++ compiler/ml_type_gen.m	25 Oct 2001 11:00:18 -0000
@@ -320,7 +320,7 @@
 		%
 		\+ (some [Ctor] (
 			list__member(Ctor, Ctors),
-			ml_uses_secondary_tag(TagValues, Ctor, _)
+			ml_needs_secondary_tag(TagValues, Ctor)
 		))
 	->
 		TagMembers = [],
@@ -347,7 +347,7 @@
 			(all [Ctor] (
 				list__member(Ctor, Ctors)
 			=>
-				ml_uses_secondary_tag(TagValues, Ctor, _)
+				ml_needs_secondary_tag(TagValues, Ctor)
 			))
 		->
 			TagMembers = TagMembers0,
@@ -425,28 +425,47 @@
 	).
 
 	%
-	% Check if this constructor uses a secondary tag,
+	% Check if this constructor's representation uses a secondary tag,
 	% and if so, return the secondary tag value.
+	% BEWARE that this is not the same as ml_needs_secondary_tag, below.
 	%
 ml_uses_secondary_tag(ConsTagValues, Ctor, SecondaryTag) :-
-	Ctor = ctor(_ExistQTVars, _Constraints, Name, Args),
-	list__length(Args, Arity),
-	map__lookup(ConsTagValues, cons(Name, Arity), TagVal),
+	TagVal = get_tagval(ConsTagValues, Ctor),
 	get_secondary_tag(TagVal) = yes(SecondaryTag).
 
 	%
+	% Check if this constructor needs a secondary tag.
+	% This is true if its representation uses a secondary
+	% tag, obviously. But it is also true if its
+	% representation is the address of a reserved object;
+	% in that case, for some back-ends (e.g. C)
+	% we need a field of some kind to ensure
+	% that the reserved object had non-zero size,
+	% which in turn is needed to ensure that its
+	% address is distinct from any other reserved objects
+	% for the same type.
+	%
+:- pred ml_needs_secondary_tag(cons_tag_values, constructor).
+:- mode ml_needs_secondary_tag(in, in) is semidet.
+
+ml_needs_secondary_tag(TagValues, Ctor) :-
+	TagVal = get_tagval(TagValues, Ctor),
+	( get_secondary_tag(TagVal) = yes(_)
+	; tagval_is_reserved_addr(TagVal, reserved_object(_, _, _))
+	).
+
+	%
 	% Check if this constructor is a constant whose
-	% value is represented as the address of a reserved object.
+	% value is represented as a reserved address.
 	%
 :- pred ml_uses_reserved_addr(cons_tag_values, constructor, reserved_address).
 :- mode ml_uses_reserved_addr(in, in, out) is semidet.
 
 ml_uses_reserved_addr(ConsTagValues, Ctor, RA) :-
-	Ctor = ctor(_ExistQTVars, _Constraints, Name, Args),
-	list__length(Args, Arity),
-	map__lookup(ConsTagValues, cons(Name, Arity), TagVal),
+	TagVal = get_tagval(ConsTagValues, Ctor),
 	tagval_is_reserved_addr(TagVal, RA).
 
+
 :- pred tagval_is_reserved_addr(cons_tag::in, reserved_address::out)
 	is semidet.
 
@@ -454,6 +473,13 @@
 tagval_is_reserved_addr(shared_with_reserved_addresses(_, TagVal), RA) :-
 	tagval_is_reserved_addr(TagVal, RA).
 
+:- func get_tagval(cons_tag_values, constructor) = cons_tag.
+
+get_tagval(ConsTagValues, Ctor) = TagVal :-
+	Ctor = ctor(_ExistQTVars, _Constraints, Name, Args),
+	list__length(Args, Arity),
+	map__lookup(ConsTagValues, cons(Name, Arity), TagVal).
+
 	%
 	% Generate a definition for the class used for the secondary tag
 	% type.  This is needed for discriminated unions for which some
@@ -513,15 +539,23 @@
 	unqualify_name(CtorName, UnqualCtorName),
 	list__length(Args, CtorArity),
 
-	( ml_uses_reserved_addr(ConsTagValues, Ctor, ReservedAddr) ->
+	TagVal = get_tagval(ConsTagValues, Ctor),
+	( tagval_is_reserved_addr(TagVal, ReservedAddr) ->
 		( ReservedAddr = reserved_object(_, _, _) ->
 			%
-			% Generate a reserved object for this constructor
+			% Generate a reserved object for this constructor.
+			% Note that we use the SecondaryTagClassId for the
+			% type of this reserved object; we can't use the
+			% BaseClassId because for some back-ends,
+			% we need to ensure that the type used for the
+			% reserved object has at least one data member,
+			% to make sure that each reserved object gets a
+			% distinct address.
 			%
 			MLDS_ReservedObjName = ml_format_reserved_object_name(
 				UnqualCtorName, CtorArity),
 			MLDS_ReservedObjDefn = ml_gen_static_const_defn(
-				MLDS_ReservedObjName, BaseClassId,
+				MLDS_ReservedObjName, SecondaryTagClassId,
 				public, no_initializer, Context),
 			MLDS_Defns = [MLDS_ReservedObjDefn | MLDS_Defns0]
 		;
@@ -570,12 +604,12 @@
 		% we inherit either the base class for this type,
 		% or the secondary tag class, depending on whether
 		% we need a secondary tag
-		( ml_uses_secondary_tag(ConsTagValues, Ctor, TagVal) ->
+		( get_secondary_tag(TagVal) = yes(SecondaryTag) ->
 			ParentClassId = SecondaryTagClassId,
-			MaybeTagVal = yes(TagVal)
+			MaybeSecTagVal = yes(SecondaryTag)
 		;
 			ParentClassId = BaseClassId,
-			MaybeTagVal = no
+			MaybeSecTagVal = no
 		),
 		Imports = [],
 		Inherits = [ParentClassId],
@@ -594,7 +628,7 @@
 				BaseClassQualifier, UnqualCtorName, CtorArity),
 			CtorFunction = gen_constructor_function(BaseClassId,
 				CtorClassType, CtorClassQualifier,
-				SecondaryTagClassId, MaybeTagVal, Members,
+				SecondaryTagClassId, MaybeSecTagVal, Members,
 				MLDS_Context),
 			Ctors = [CtorFunction]
 		;
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.15
diff -u -d -r1.15 type_ctor_info.m
--- compiler/type_ctor_info.m	24 Oct 2001 13:34:38 -0000	1.15
+++ compiler/type_ctor_info.m	25 Oct 2001 11:41:19 -0000
@@ -326,12 +326,11 @@
 					num_tag_bits, NumTagBits),
 				int__pow(2, NumTagBits, NumTags),
 				MaxPtag = NumTags - 1,
-				TypeCtorRep = du(EqualityAxioms),
 				type_ctor_info__make_du_tables(Ctors,
 					ConsTagMap, MaxPtag, RttiTypeId,
-					ModuleInfo,
+					EqualityAxioms, ModuleInfo,
 					TypeTables, NumPtags,
-					FunctorsInfo, LayoutInfo)
+					FunctorsInfo, LayoutInfo, TypeCtorRep)
 			)
 		)
 	).
@@ -490,12 +489,14 @@
 % (including reserved_addr types).
 
 :- pred type_ctor_info__make_du_tables(list(constructor)::in,
-	cons_tag_values::in, int::in, rtti_type_id::in, module_info::in,
-	list(rtti_data)::out, int::out,
-	type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
+	cons_tag_values::in, int::in, rtti_type_id::in, equality_axioms::in,
+	module_info::in, list(rtti_data)::out, int::out,
+	type_ctor_functors_info::out, type_ctor_layout_info::out,
+	type_ctor_rep::out) is det.
 
 type_ctor_info__make_du_tables(Ctors, ConsTagMap, MaxPtag, RttiTypeId,
-		ModuleInfo, TypeTables, NumPtags, FunctorInfo, LayoutInfo) :-
+		EqualityAxioms, ModuleInfo, TypeTables, NumPtags, 
+		FunctorInfo, LayoutInfo, TypeCtorRep) :-
 	module_info_globals(ModuleInfo, Globals),
 	(
 		globals__lookup_bool_option(Globals, reserve_tag, yes)
@@ -526,14 +527,16 @@
 		TypeTables0),
 	( map__is_empty(ReservedAddrMap) ->
 		TypeTables = TypeTables0,
-		LayoutInfo = DuLayoutInfo
+		LayoutInfo = DuLayoutInfo,
+		TypeCtorRep = du(EqualityAxioms)
 	;
 		type_ctor_info__make_reserved_addr_layout(RttiTypeId,
 			ReservedAddrMap, ValueOrderedTableRttiName,
 			RALayoutRttiName, RALayoutTables),
 				% XXX does it matter what order they go in?
 		TypeTables = RALayoutTables ++ TypeTables0,
-		LayoutInfo = reserved_addr_layout(RALayoutRttiName)
+		LayoutInfo = reserved_addr_layout(RALayoutRttiName),
+		TypeCtorRep = reserved_addr(EqualityAxioms)
 	).
 
 :- pred type_ctor_info__make_reserved_addr_layout(rtti_type_id::in,
Index: runtime/mercury_tags.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tags.h,v
retrieving revision 1.13
diff -u -d -r1.13 mercury_tags.h
--- runtime/mercury_tags.h	27 Jun 2001 13:41:34 -0000	1.13
+++ runtime/mercury_tags.h	25 Oct 2001 05:42:22 -0000
@@ -95,8 +95,17 @@
   #define MR_FIRST_UNRESERVED_RAW_TAG  0
 #endif
 
-#define MR_RAW_TAG_NIL          MR_FIRST_UNRESERVED_RAW_TAG
-#define MR_RAW_TAG_CONS         (MR_FIRST_UNRESERVED_RAW_TAG + 1)
+#if TAGBITS == 0 && \
+	(MR_NUM_RESERVED_ADDRESSES > 0 || MR_NUM_RESERVED_OBJECTS > 0)
+  /*
+  ** In this case, we represent the empty list as a reserved address,
+  ** rather than using tag bits.
+  */
+  #define MR_RAW_TAG_CONS       MR_FIRST_UNRESERVED_RAW_TAG
+#else
+  #define MR_RAW_TAG_NIL        MR_FIRST_UNRESERVED_RAW_TAG
+  #define MR_RAW_TAG_CONS       (MR_FIRST_UNRESERVED_RAW_TAG + 1)
+#endif
 
 #define MR_RAW_UNIV_TAG         MR_FIRST_UNRESERVED_RAW_TAG
 
@@ -104,42 +113,77 @@
 #define	MR_TAG_CONS		MR_mktag(MR_RAW_TAG_CONS)
 
 #ifdef MR_RESERVE_TAG
-    #define MR_TAG_VAR          MR_mktag(MR_RAW_TAG_VAR)
+  #define MR_TAG_VAR		MR_mktag(MR_RAW_TAG_VAR)
 #endif
 
 #define	MR_UNIV_TAG		MR_mktag(MR_RAW_UNIV_TAG)
 
-#if TAGBITS > 0
-
-#define	MR_list_is_empty(list)	(MR_tag(list) == MR_TAG_NIL)
-#define	MR_list_head(list)	MR_field(MR_TAG_CONS, (list), 0)
-#define	MR_list_tail(list)	MR_field(MR_TAG_CONS, (list), 1)
-#define	MR_list_empty()		((MR_Word) MR_mkword(MR_TAG_NIL, MR_mkbody(0)))
-#define	MR_list_cons(head,tail)	((MR_Word) MR_mkword(MR_TAG_CONS, \
-					MR_create2((head),(tail))))
-#define	MR_list_empty_msg(proclabel)	\
-				((MR_Word) MR_mkword(MR_TAG_NIL, MR_mkbody(0)))
-#define	MR_list_cons_msg(head,tail,proclabel) \
+#if TAGBITS > 0 || (TAGBITS == 0 && \
+	(MR_NUM_RESERVED_ADDRESS > 0 || MR_NUM_RESERVED_OBJECTS > 0))
+  /*
+  ** Cons cells are represented using two words.
+  */
+  #if TAGBITS == 0 && MR_NUM_RESERVED_ADDRESSES > 0
+    /*
+    ** We represent empty lists as null pointers.
+    */
+    #define MR_list_empty()		((MR_Word) NULL)
+    #define MR_list_is_empty(list)	((list) == MR_list_empty())
+  #elif TAGBITS == 0 && MR_NUM_RESERVED_OBJECTS > 0
+    /*
+    ** We represent empty lists as the address of a reserved object,
+    ** which will be generated by the compiler in the code for library/list.m.
+    ** (The mangled name `f_111_...' of this object
+    ** is the mangled form of the name `obj_[]_0'.)
+    */
+    extern const struct mercury__list__list_1_s
+    	mercury__list__list_1__f_111_98_106_95_91_93_95_48;
+    #define MR_list_empty()
+	((MR_Word) (& mercury__list__list_1__f_111_98_106_95_91_93_95_48))
+    #define MR_list_is_empty(list)	((list) == MR_list_empty())
+  #else
+    /*
+    ** We use the primary tag to distinguish between empty and non-empty lists.
+    */
+    #define MR_list_is_empty(list) (MR_tag(list) == MR_TAG_NIL)
+    #define MR_list_empty()	((MR_Word) MR_mkword(MR_TAG_NIL, MR_mkbody(0)))
+  #endif
+  #define MR_list_head(list)	MR_field(MR_TAG_CONS, (list), 0)
+  #define MR_list_tail(list)	MR_field(MR_TAG_CONS, (list), 1)
+  #define MR_list_cons(head,tail) ((MR_Word) MR_mkword(MR_TAG_CONS, \
+					  MR_create2((head),(tail))))
+  #define MR_list_empty_msg(proclabel)	\
+				MR_list_empty()
+  #define MR_list_cons_msg(head,tail,proclabel) \
 				((MR_Word) MR_mkword(MR_TAG_CONS, \
 					MR_create2_msg((head),(tail), \
 						proclabel, "list:list/1")))
 
 #else
+  /*
+  ** TAGBITS == 0 && 
+  ** MR_NUM_RESERVED_ADDRESS == 0 &&
+  ** MR_NUM_RESERVED_OBJECTS == 0
+  **
+  ** In this case, cons cells are represented using three words.
+  ** The first word is a secondary tag that we use to distinguish between
+  ** empty and non-empty lists.
+  */
 
-#define	MR_list_is_empty(list)	(MR_field(MR_mktag(0), (list), 0) \
+  #define	MR_list_is_empty(list)	(MR_field(MR_mktag(0), (list), 0) \
 					== MR_RAW_TAG_NIL)
-#define	MR_list_head(list)	MR_field(MR_mktag(0), (list), 1)
-#define	MR_list_tail(list)	MR_field(MR_mktag(0), (list), 2)
-#define	MR_list_empty()		((MR_Word) MR_mkword(MR_mktag(0), \
+  #define	MR_list_head(list)	MR_field(MR_mktag(0), (list), 1)
+  #define	MR_list_tail(list)	MR_field(MR_mktag(0), (list), 2)
+  #define	MR_list_empty()		((MR_Word) MR_mkword(MR_mktag(0), \
 					MR_create1(MR_RAW_TAG_NIL)))
-#define	MR_list_cons(head,tail)	((MR_Word) MR_mkword(MR_mktag(0), \
+  #define	MR_list_cons(head,tail)	((MR_Word) MR_mkword(MR_mktag(0), \
 					MR_create3(MR_RAW_TAG_CONS, \
 						(head), (tail))))
-#define	MR_list_empty_msg(proclabel) \
+  #define	MR_list_empty_msg(proclabel) \
 				((MR_Word) MR_mkword(MR_mktag(0), \
 					MR_create1_msg(MR_RAW_TAG_NIL, \
 						proclabel, "list:list/1")))
-#define	MR_list_cons_msg(head,tail,proclabel) \
+  #define	MR_list_cons_msg(head,tail,proclabel) \
 				((MR_Word) MR_mkword(MR_mktag(0), \
 					MR_create3_msg(MR_RAW_TAG_CONS, \
 						(head), (tail), \
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  | "... it seems to me that 15 years of
The University of Melbourne         | email is plenty for one lifetime."
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- Prof. Donald E. Knuth
--------------------------------------------------------------------------
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