[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